diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index cd1822c4d5..2d9c376954 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -40,13 +40,13 @@ jobs:
- ubuntu-latest
- windows-latest
ocaml-compiler:
- - 5.2.x
+ - ocaml-base-compiler.5.3.0~beta2
# The type of runner that the job will run on
runs-on: ${{ matrix.os }}
# Some tests requiring specific ppxes are disabled by default
env:
- MERLIN_TESTS: all
+ MERLIN_TESTS: no-ppx
# Steps represent a sequence of tasks that will be executed as part of the job
steps:
@@ -62,19 +62,12 @@ jobs:
- name: Install dependencies
run: |
opam pin menhirLib 20201216 --no-action
- opam install --yes ppx_string ppx_compare
- opam install . --deps-only --with-test --yes
+ opam install menhir csexp alcotest yojson conf-jq ocamlfind --yes
- - name: Build and test in release mode (windows)
- if: matrix.os == 'windows-latest'
+ - name: Build and test in release mode
run: |
opam exec -- dune runtest -p merlin-lib,dot-merlin-reader,ocaml-index,merlin
- - name: Build and test in release mode (macos/linux)
- if: matrix.os != 'windows-latest'
- run: |
- opam install . --with-test --yes
-
- name: Build in dev mode to check parser changes
if: matrix.os == 'ubuntu-latest'
run: |
@@ -84,7 +77,7 @@ jobs:
- name: Check that the changes are correctly formatted
- if: matrix.os == 'ubuntu-latest'
+ if: matrix.os == 'none'
run: |
opam install ocamlformat.0.26.2
opam exec -- dune build @fmt
diff --git a/.github/workflows/ocaml-lsp-compat.yml b/.github/workflows/ocaml-lsp-compat.yml
index b7a4ccd140..ba836a9b4a 100644
--- a/.github/workflows/ocaml-lsp-compat.yml
+++ b/.github/workflows/ocaml-lsp-compat.yml
@@ -4,7 +4,7 @@ name: Check ocaml-lsp compat
# events but only for the master branch
on:
push:
- branches: [ master ]
+ branches: [ main ]
paths-ignore:
- '**.md'
- '**.txt'
@@ -14,7 +14,7 @@ on:
- 'vim/**'
- '**/emacs-lint.yml'
pull_request:
- branches: [ master ]
+ branches: [ main ]
paths-ignore:
- '**.md'
- '**.txt'
@@ -34,7 +34,7 @@ jobs:
os:
- ubuntu-latest
ocaml-compiler:
- - 5.2.x
+ - ocaml-base-compiler.5.3.0~alpha1
# The type of runner that the job will run on
runs-on: ${{ matrix.os }}
@@ -51,7 +51,7 @@ jobs:
- name: Check that Merlin and OCaml-LSP are co-installable
run: |
- opam --cli=2.1 pin --with-version=dev --no-action https://github.com/voodoos/ocaml-lsp.git#5.2-preview
- opam --cli=2.1 pin --with-version=5.0-502 --no-action .
- opam install ocaml-lsp-server --with-test --ignore-constraints-on=ocamlformat
+ opam --cli=2.1 pin --with-version=dev --no-action https://github.com/voodoos/ocaml-lsp.git#merlin-503-compat
+ opam --cli=2.1 pin --with-version=5.3-503 --no-action .
+ opam install ocaml-lsp-server --ignore-constraints-on=ocamlformat
diff --git a/CHANGES.md b/CHANGES.md
index f3ca754ebf..fbe09a20b7 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,6 +1,8 @@
unreleased
==========
+ + merlin binary
+ - Support for OCaml 5.3
+ vim plugin
- Added support for search-by-type (#1846)
This is exposed through the existing `:MerlinSearch` command, that
diff --git a/merlin-lib.opam b/merlin-lib.opam
index 6e6bde2545..24641206f6 100644
--- a/merlin-lib.opam
+++ b/merlin-lib.opam
@@ -10,7 +10,7 @@ build: [
["dune" "build" "-p" name "-j" jobs]
]
depends: [
- "ocaml" {>= "5.2" & < "5.3"}
+ "ocaml" {>="5.3" & <"5.4"}
"dune" {>= "3.0.0"}
"csexp" {>= "1.5.1"}
"alcotest" {with-test & >= "1.3.0" }
diff --git a/merlin.opam b/merlin.opam
index 8fd90ec134..42ddcd51fd 100644
--- a/merlin.opam
+++ b/merlin.opam
@@ -11,7 +11,6 @@ build: [
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
- "ocaml" {>= "5.2" & < "5.3"}
"dune" {>= "3.0.0"}
"merlin-lib" {= version}
"dot-merlin-reader" {= version}
@@ -22,7 +21,6 @@ depends: [
]
conflicts: [
"seq" {!= "base"}
- "base-effects"
]
synopsis:
"Editor helper, provides completion, typing and source browsing in Vim and Emacs"
diff --git a/src/analysis/ast_iterators.ml b/src/analysis/ast_iterators.ml
index 8f9e0feaf1..9cd2604144 100644
--- a/src/analysis/ast_iterators.ml
+++ b/src/analysis/ast_iterators.ml
@@ -133,8 +133,9 @@ let iter_on_defs ~uid_to_locs_tbl =
match exp_extra with
| Texp_newtype' (typ_id, typ_name, uid) ->
log "Found newtype %s wit id %a (%a)\n%!" typ_name.txt Logger.fmt
- (Fun.flip Ident.print_with_scope typ_id) Logger.fmt (fun fmt ->
- Location.print_loc fmt typ_name.loc);
+ (Fun.flip (Format_doc.compat Ident.print_with_scope) typ_id)
+ Logger.fmt
+ (fun fmt -> Location.print_loc fmt typ_name.loc);
register_uid uid typ_name;
()
| _ -> ());
diff --git a/src/analysis/construct.ml b/src/analysis/construct.ml
index 19745aceae..5e4b5c35f1 100644
--- a/src/analysis/construct.ml
+++ b/src/analysis/construct.ml
@@ -37,26 +37,28 @@ module Util = struct
let construct s =
Ast_helper.Exp.construct (Location.mknoloc (Longident.Lident s)) None
in
+ let const_string str = Ast_helper.Const.string str in
+ let const_integer ?suffix str = Ast_helper.Const.integer ?suffix str in
+ let const_float ?suffix str = Ast_helper.Const.float ?suffix str in
+ let const_char c = Ast_helper.Const.char c in
let ident s =
Ast_helper.Exp.ident (Location.mknoloc (Longident.Lident s))
in
List.iter
~f:(fun (k, v) -> Hashtbl.add tbl k v)
- Parsetree.
- [ (Predef.path_int, constant (Pconst_integer ("0", None)));
- (Predef.path_float, constant (Pconst_float ("0.0", None)));
- (Predef.path_char, constant (Pconst_char 'c'));
- ( Predef.path_string,
- constant (Pconst_string ("", Location.none, None)) );
- (Predef.path_bool, construct "false");
- (Predef.path_unit, construct "()");
- (Predef.path_exn, ident "exn");
- (Predef.path_array, Ast_helper.Exp.array []);
- (Predef.path_nativeint, constant (Pconst_integer ("0", Some 'n')));
- (Predef.path_int32, constant (Pconst_integer ("0", Some 'l')));
- (Predef.path_int64, constant (Pconst_integer ("0", Some 'L')));
- (Predef.path_lazy_t, Ast_helper.Exp.lazy_ (construct "()"))
- ]
+ [ (Predef.path_int, constant (const_integer "0"));
+ (Predef.path_float, constant (const_float "0.0"));
+ (Predef.path_char, constant (const_char 'c'));
+ (Predef.path_string, constant (const_string ""));
+ (Predef.path_bool, construct "false");
+ (Predef.path_unit, construct "()");
+ (Predef.path_exn, ident "exn");
+ (Predef.path_array, Ast_helper.Exp.array []);
+ (Predef.path_nativeint, constant (const_integer ~suffix:'n' "0"));
+ (Predef.path_int32, constant (const_integer ~suffix:'l' "0"));
+ (Predef.path_int64, constant (const_integer ~suffix:'L' "0"));
+ (Predef.path_lazy_t, Ast_helper.Exp.lazy_ (construct "()"))
+ ]
in
tbl
@@ -495,7 +497,7 @@ module Gen = struct
val_kind = Val_reg;
val_loc = Location.none;
val_attributes = [];
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ())
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ())
}
in
let env =
diff --git a/src/analysis/context.ml b/src/analysis/context.ml
index 9af52030e6..a7131a2745 100644
--- a/src/analysis/context.ml
+++ b/src/analysis/context.ml
@@ -66,7 +66,8 @@ let cursor_on_longident_end ~cursor:cursor_pos
(* FIXME: this is britle, but lids don't have precise enough location
information to handle these cases correctly. *)
let name_lenght = String.length name in
- if Pprintast.needs_parens name then name_lenght + 2 else name_lenght
+ if Pprintast.needs_parens ~kind:Other name then name_lenght + 2
+ else name_lenght
in
let constr_pos =
{ loc.loc_end with pos_cnum = end_offset - cstr_name_size }
diff --git a/src/analysis/destruct.ml b/src/analysis/destruct.ml
index bae8b20ab4..3b17c2d56f 100644
--- a/src/analysis/destruct.ml
+++ b/src/analysis/destruct.ml
@@ -214,7 +214,7 @@ let rec get_match = function
get_match parents
| Expression m -> (
match m.Typedtree.exp_desc with
- | Typedtree.Texp_match (e, _, _) -> (m, e.exp_type)
+ | Typedtree.Texp_match (e, _, _, _) -> (m, e.exp_type)
| Typedtree.Texp_function _ -> (
let typ = m.exp_type in
(* Function must have arrow type. This arrow type
diff --git a/src/analysis/env_lookup.ml b/src/analysis/env_lookup.ml
index 741b46056f..824a087c27 100644
--- a/src/analysis/env_lookup.ml
+++ b/src/analysis/env_lookup.ml
@@ -96,7 +96,7 @@ let by_longident (nss : Namespace.inferred list) ident env =
"got constructor, fetching path and loc in type namespace";
let path, loc = path_and_loc_of_cstr cd env in
log ~title:"lookup" "found path: %a" Logger.fmt (fun fmt ->
- Path.print fmt path);
+ (Format_doc.compat Path.print) fmt path);
let path = Path.Pdot (path, cd.cstr_name) in
raise (Found (path, Constructor, cd.cstr_uid, loc))
| `Constr ->
@@ -142,7 +142,7 @@ let by_longident (nss : Namespace.inferred list) ident env =
with Found (path, namespace, decl_uid, loc) ->
log ~title:"env_lookup"
"found: '%a' in namespace %s with decl_uid %a\nat loc %a" Logger.fmt
- (fun fmt -> Path.print fmt path)
+ (fun fmt -> (Format_doc.compat Path.print) fmt path)
(Shape.Sig_component_kind.to_string namespace)
Logger.fmt
(fun fmt -> Shape.Uid.print fmt decl_uid)
diff --git a/src/analysis/index_occurrences.ml b/src/analysis/index_occurrences.ml
index 0f5b008603..9102e4cdc8 100644
--- a/src/analysis/index_occurrences.ml
+++ b/src/analysis/index_occurrences.ml
@@ -28,7 +28,8 @@ let decl_of_path_or_lid env namespace path lid =
let iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid =
let add uid loc = Stamped_hashtable.add index ~stamp (uid, loc) () in
let f ~namespace env path (lid : Longident.t Location.loc) =
- log ~title:"index_buffer" "Path: %a" Logger.fmt (Fun.flip Path.print path);
+ log ~title:"index_buffer" "Path: %a" Logger.fmt
+ (Fun.flip (Format_doc.compat Path.print) path);
let not_ghost { Location.loc = { loc_ghost; _ }; _ } = not loc_ghost in
let lid = { lid with loc = set_fname ~file:current_buffer_path lid.loc } in
let index_decl () =
diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml
index 9cec399ff0..0f19feb868 100644
--- a/src/analysis/inlay_hints.ml
+++ b/src/analysis/inlay_hints.ml
@@ -59,7 +59,7 @@ let structure_iterator hint_let_binding hint_pattern_binding
| Texp_letop { body; _ } ->
let () = log ~title:"expression" "on let-op" in
case_iterator hint_let_binding iterator body
- | Texp_match (expr, cases, _) ->
+ | Texp_match (expr, cases, _, _) ->
let () = log ~title:"expression" "on match" in
let () = iterator.expr iterator expr in
List.iter ~f:(case_iterator hint_pattern_binding iterator) cases
diff --git a/src/analysis/jump.ml b/src/analysis/jump.ml
index 327262027f..396a098d4e 100644
--- a/src/analysis/jump.ml
+++ b/src/analysis/jump.ml
@@ -119,7 +119,7 @@ let rec skip_non_moving pos = function
let get_cases_from_match node =
match node with
- | Expression { exp_desc = Texp_match (_, cases, _); _ } -> cases
+ | Expression { exp_desc = Texp_match (_, cases, _, _); _ } -> cases
| _ -> []
let find_case_pos cases pos direction =
diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml
index 5f6e3a6543..329c8343ae 100644
--- a/src/analysis/locate.ml
+++ b/src/analysis/locate.ml
@@ -496,7 +496,7 @@ let find_loc_of_uid ~config ~local_defs uid comp_unit =
log ~title "The declaration has no location.";
`None
in
- if Env.get_unit_name () = comp_unit then begin
+ if Env.get_current_unit_name () = comp_unit then begin
log ~title "We look for %a in the current compilation unit." Logger.fmt
(fun fmt -> Shape.Uid.print fmt uid);
log ~title "Looking for %a in the uid_to_loc table" Logger.fmt (fun fmt ->
@@ -791,7 +791,7 @@ let doc_from_uid ~config ~loc uid =
begin
match uid with
| (Shape.Uid.Item { comp_unit; _ } | Shape.Uid.Compilation_unit comp_unit)
- when Env.get_unit_name () <> comp_unit ->
+ when Env.get_current_unit_name () <> comp_unit ->
log ~title:"get_doc"
"the doc (%a) you're looking for is in another\n\
\ compilation unit (%s)" Logger.fmt
@@ -853,7 +853,7 @@ let get_doc ~config:mconfig ~env ~local_defs ~comments ~pos =
match path with
| `Completion_entry (namespace, path, _loc) ->
log ~title:"get_doc" "completion: looking for the doc of '%a'"
- Logger.fmt (fun fmt -> Path.print fmt path);
+ Logger.fmt (fun fmt -> (Format_doc.compat Path.print) fmt path);
let from_path = from_path ~config ~env ~local_defs ~namespace path in
begin
diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml
index 78dcc2d5c8..42eb8fc5d6 100644
--- a/src/analysis/occurrences.ml
+++ b/src/analysis/occurrences.ml
@@ -31,7 +31,7 @@ let last_loc (loc : Location.t) lid =
| Longident.Lident _ -> loc
| _ ->
let last_segment = Longident.last lid in
- let needs_parens = Pprintast.needs_parens last_segment in
+ let needs_parens = Pprintast.needs_parens ~kind:Other last_segment in
if not needs_parens then
let last_size = last_segment |> String.length in
{ loc with
@@ -269,7 +269,7 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path =
let def_uid_is_in_current_unit =
let uid_comp_unit = comp_unit_of_uid def_uid in
Option.value_map ~default:false uid_comp_unit
- ~f:(String.equal @@ Env.get_unit_name ())
+ ~f:(String.equal @@ Env.get_current_unit_name ())
in
let status =
match (scope, String.Set.to_list out_of_sync_files) with
diff --git a/src/analysis/parsetree_utils.ml b/src/analysis/parsetree_utils.ml
new file mode 100644
index 0000000000..0713586015
--- /dev/null
+++ b/src/analysis/parsetree_utils.ml
@@ -0,0 +1,5 @@
+open Parsetree
+
+type nonrec constant_desc = constant_desc
+
+let constant_desc c = c.pconst_desc
diff --git a/src/analysis/parsetree_utils.mli b/src/analysis/parsetree_utils.mli
new file mode 100644
index 0000000000..eb5bab8eb9
--- /dev/null
+++ b/src/analysis/parsetree_utils.mli
@@ -0,0 +1,8 @@
+(** Utilities to provide a slightly more stable Parsetree API for alternative
+ clients like [ocaml-lsp]. *)
+
+open Parsetree
+
+type nonrec constant_desc = constant_desc
+
+val constant_desc : constant -> constant_desc
diff --git a/src/analysis/syntax_doc.ml b/src/analysis/syntax_doc.ml
index 6b1bb28ebe..30f7650c66 100644
--- a/src/analysis/syntax_doc.ml
+++ b/src/analysis/syntax_doc.ml
@@ -1,5 +1,7 @@
open Browse_raw
+let { Logger.log } = Logger.for_section "syntax-doc"
+
type syntax_info = Query_protocol.syntax_doc_result option
let syntax_doc_url endpoint =
@@ -7,6 +9,11 @@ let syntax_doc_url endpoint =
base_url ^ endpoint
let get_syntax_doc cursor_loc node : syntax_info =
+ log ~title:"get" "Looking for syntax doc of a node %a" Logger.fmt (fun fmt ->
+ Format.pp_print_list ~pp_sep:Format.pp_print_space
+ (fun fmt (_, node) ->
+ Format.fprintf fmt "%s" (Browse_raw.string_of_node node))
+ fmt node);
match node with
| (_, Type_kind _)
:: (_, Type_declaration _)
diff --git a/src/analysis/tail_analysis.ml b/src/analysis/tail_analysis.ml
index ab56483345..3f9ee77d6b 100644
--- a/src/analysis/tail_analysis.ml
+++ b/src/analysis/tail_analysis.ml
@@ -76,8 +76,8 @@ let expr_tail_positions = function
| Texp_extension_constructor _
| Texp_letop _
| Texp_hole -> []
- | Texp_match (_, cs, _) -> List.map cs ~f:(fun c -> Case c)
- | Texp_try (_, cs) -> List.map cs ~f:(fun c -> Case c)
+ | Texp_match (_, cs, _, _) -> List.map cs ~f:(fun c -> Case c)
+ | Texp_try (_, cs, _) -> List.map cs ~f:(fun c -> Case c)
| Texp_letmodule (_, _, _, _, e)
| Texp_letexception (_, e)
| Texp_let (_, _, e)
diff --git a/src/analysis/type_utils.ml b/src/analysis/type_utils.ml
index 799d8222a7..2615254f31 100644
--- a/src/analysis/type_utils.ml
+++ b/src/analysis/type_utils.ml
@@ -113,7 +113,8 @@ module Printtyp = struct
let expand_sig env mty = Env.with_cmis @@ fun () -> Env.scrape_alias env mty
let verbose_type_scheme env ppf t =
- Printtyp.type_scheme ppf (expand_type env t)
+ let t = expand_type env t in
+ Printtyp.type_scheme ppf t
let verbose_type_declaration env id ppf t =
Printtyp.type_declaration id ppf (expand_type_decl env t)
@@ -265,7 +266,7 @@ let print_cstr_desc ppf cstr_desc =
let print_constr ppf env lid =
let cstr_desc = Env.find_constructor_by_name lid.Asttypes.txt env in
(* FIXME: support Reader printer *)
- print_cstr_desc ppf cstr_desc
+ (Format_doc.compat print_cstr_desc) ppf cstr_desc
exception Fallback
let type_in_env ?(verbosity = Verbosity.default) ?keywords ~context env ppf expr
@@ -344,7 +345,8 @@ let type_in_env ?(verbosity = Verbosity.default) ?keywords ~context env ppf expr
false))
let print_constr ~verbosity env ppf cd =
- Printtyp.wrap_printing_env env ~verbosity @@ fun () -> print_cstr_desc ppf cd
+ Printtyp.wrap_printing_env env ~verbosity @@ fun () ->
+ (Format_doc.compat print_cstr_desc) ppf cd
(* From doc-ock
https://github.com/lpw25/doc-ock/blob/master/src/docOckAttrs.ml *)
diff --git a/src/analysis/typedtree_utils.ml b/src/analysis/typedtree_utils.ml
index abcccfb107..b155efbf5b 100644
--- a/src/analysis/typedtree_utils.ml
+++ b/src/analysis/typedtree_utils.ml
@@ -70,3 +70,30 @@ let pat_alias_pat_id_and_loc = function
| Typedtree.{ pat_desc = Tpat_alias (pat, id, loc, _); _ } ->
Some (pat, id, loc)
| _ -> None
+
+open Typedtree
+
+type texp_match =
+ { expr : expression;
+ computation_cases : computation case list;
+ value_cases : value case list;
+ partial : partial
+ }
+
+type texp_try =
+ { expr : expression;
+ value_cases : value case list;
+ effect_cases : value case list
+ }
+
+let texp_match_of_expr expr =
+ match expr.exp_desc with
+ | Texp_match (expr, computation_cases, value_cases, partial) ->
+ Some { expr; computation_cases; value_cases; partial }
+ | _ -> None
+
+let texp_try_of_expr expr =
+ match expr.exp_desc with
+ | Texp_try (expr, value_cases, effect_cases) ->
+ Some { expr; value_cases; effect_cases }
+ | _ -> None
diff --git a/src/analysis/typedtree_utils.mli b/src/analysis/typedtree_utils.mli
index 91ed0859b2..d5701a3383 100644
--- a/src/analysis/typedtree_utils.mli
+++ b/src/analysis/typedtree_utils.mli
@@ -26,3 +26,21 @@ val pat_var_id_and_loc :
val pat_alias_pat_id_and_loc :
Typedtree.pattern ->
(Typedtree.pattern * Ident.t * string Location.loc) option
+
+open Typedtree
+
+type texp_match =
+ { expr : expression;
+ computation_cases : computation case list;
+ value_cases : value case list;
+ partial : partial
+ }
+
+type texp_try =
+ { expr : expression;
+ value_cases : value case list;
+ effect_cases : value case list
+ }
+
+val texp_match_of_expr : expression -> texp_match option
+val texp_try_of_expr : expression -> texp_try option
diff --git a/src/config/gen_config.ml b/src/config/gen_config.ml
index 688132aff1..2b83498710 100644
--- a/src/config/gen_config.ml
+++ b/src/config/gen_config.ml
@@ -15,6 +15,7 @@ let ocamlversion :
| `OCaml_4_03_0 | `OCaml_4_04_0 | `OCaml_4_05_0 | `OCaml_4_06_0
| `OCaml_4_07_0 | `OCaml_4_07_1 | `OCaml_4_08_0 | `OCaml_4_09_0
| `OCaml_4_10_0 | `OCaml_4_11_0 | `OCaml_4_12_0 | `OCaml_4_13_0
- | `OCaml_4_14_0 | `OCaml_5_0_0 | `OCaml_5_1_0 | `OCaml_5_2_0 ] = %s
+ | `OCaml_4_14_0 | `OCaml_5_0_0 | `OCaml_5_1_0 | `OCaml_5_2_0
+ | `OCaml_5_3_0 ] = %s
|}
ocaml_version_val
diff --git a/src/kernel/extension.ml b/src/kernel/extension.ml
index 3ce0d45d9e..9132f48eda 100644
--- a/src/kernel/extension.ml
+++ b/src/kernel/extension.ml
@@ -64,7 +64,7 @@ let ext_meta =
\ end"
];
public_def = [];
- keywords = [ (">.", GREATERDOT) ];
+ keywords = [ (">.", METAOCAML_BRACKET_CLOSE) ];
packages = []
}
@@ -124,7 +124,7 @@ let parse_sig =
(Parser_raw.interface lexer lexbuf : Parsetree.signature)
let type_sig env sg =
- let sg = Typemod.transl_signature env sg in
+ let sg = Typemod.type_interface env sg in
sg.Typedtree.sig_type
(*
diff --git a/src/kernel/mconfig.ml b/src/kernel/mconfig.ml
index 16dfa0ef18..fe35c6370a 100644
--- a/src/kernel/mconfig.ml
+++ b/src/kernel/mconfig.ml
@@ -831,3 +831,15 @@ let unitname t =
| Some prefix -> prefix ^ basename
| None -> basename
end
+
+let intf_or_impl t =
+ let extension = Filename.extension t.query.filename in
+ try
+ List.find_map t.merlin.suffixes ~f:(fun (impl, intf) ->
+ if String.equal extension impl then Some Unit_info.Impl
+ else if String.equal extension intf then Some Unit_info.Intf
+ else None)
+ with Not_found -> Unit_info.Impl
+
+let unit_info t =
+ Unit_info.make ~source_file:t.query.filename (intf_or_impl t) (unitname t)
diff --git a/src/kernel/mconfig.mli b/src/kernel/mconfig.mli
index 1b4430b4a6..525e0eaf69 100644
--- a/src/kernel/mconfig.mli
+++ b/src/kernel/mconfig.mli
@@ -129,3 +129,7 @@ val global_modules : ?include_current:bool -> t -> string list
val filename : t -> string
val unitname : t -> string
+
+val intf_or_impl : t -> Unit_info.intf_or_impl
+
+val unit_info : t -> Unit_info.t
diff --git a/src/kernel/mocaml.ml b/src/kernel/mocaml.ml
index 4f9fc0fa52..0eb6ce4603 100644
--- a/src/kernel/mocaml.ml
+++ b/src/kernel/mocaml.ml
@@ -35,7 +35,7 @@ let setup_reader_config config =
let open Mconfig in
let open Clflags in
let ocaml = config.ocaml in
- Env.set_unit_name (Mconfig.unitname config);
+ Env.set_current_unit (Mconfig.unit_info config);
Location.input_name := config.query.filename;
fast := ocaml.unsafe;
classic := ocaml.classic;
@@ -66,37 +66,44 @@ let default_out_type_extension = !Oprint.out_type_extension
let default_out_phrase = !Oprint.out_phrase
let replacement_printer = ref None
+let replacement_printer_doc = ref None
let oprint default inj ppf x =
match !replacement_printer with
| None -> default ppf x
| Some printer -> printer ppf (inj x)
+let oprint_doc default inj ppf x =
+ match !replacement_printer_doc with
+ | None -> default ppf x
+ | Some printer -> printer ppf (inj x)
+
let () =
let open Extend_protocol.Reader in
Oprint.out_value := oprint default_out_value (fun x -> Out_value x);
- Oprint.out_type := oprint default_out_type (fun x -> Out_type x);
+ Oprint.out_type := oprint_doc default_out_type (fun x -> Out_type x);
Oprint.out_class_type :=
- oprint default_out_class_type (fun x -> Out_class_type x);
+ oprint_doc default_out_class_type (fun x -> Out_class_type x);
Oprint.out_module_type :=
- oprint default_out_module_type (fun x -> Out_module_type x);
- Oprint.out_sig_item := oprint default_out_sig_item (fun x -> Out_sig_item x);
+ oprint_doc default_out_module_type (fun x -> Out_module_type x);
+ Oprint.out_sig_item :=
+ oprint_doc default_out_sig_item (fun x -> Out_sig_item x);
Oprint.out_signature :=
- oprint default_out_signature (fun x -> Out_signature x);
+ oprint_doc default_out_signature (fun x -> Out_signature x);
Oprint.out_type_extension :=
- oprint default_out_type_extension (fun x -> Out_type_extension x);
+ oprint_doc default_out_type_extension (fun x -> Out_type_extension x);
Oprint.out_phrase := oprint default_out_phrase (fun x -> Out_phrase x)
let default_printer ppf =
let open Extend_protocol.Reader in
function
| Out_value x -> default_out_value ppf x
- | Out_type x -> default_out_type ppf x
- | Out_class_type x -> default_out_class_type ppf x
- | Out_module_type x -> default_out_module_type ppf x
- | Out_sig_item x -> default_out_sig_item ppf x
- | Out_signature x -> default_out_signature ppf x
- | Out_type_extension x -> default_out_type_extension ppf x
+ | Out_type x -> Format_doc.compat default_out_type ppf x
+ | Out_class_type x -> Format_doc.compat default_out_class_type ppf x
+ | Out_module_type x -> Format_doc.compat default_out_module_type ppf x
+ | Out_sig_item x -> Format_doc.compat default_out_sig_item ppf x
+ | Out_signature x -> Format_doc.compat default_out_signature ppf x
+ | Out_type_extension x -> Format_doc.compat default_out_type_extension ppf x
| Out_phrase x -> default_out_phrase ppf x
let with_printer printer f = let_ref replacement_printer (Some printer) f
diff --git a/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t b/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t
index 120db8e512..1111fef1db 100644
--- a/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t
+++ b/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t
@@ -33,7 +33,7 @@
uid: Main.3; locs: "g": File "main.ml", line 9, characters 6-7
uid: Main.4; locs: "g": File "main.ml", line 3, characters 6-7
uid: Main.5; locs: "B": File "main.ml", line 2, characters 7-8
- uid: Stdlib__String.173; locs:
+ uid: Stdlib__String.174; locs:
"String.equal": File "main.ml", line 1, characters 8-20
}, 0 approx shapes: {}, and shapes for CUS .
@@ -50,7 +50,7 @@
uid: Main.3; locs: "g": File "main.ml", line 9, characters 6-7
uid: Main.4; locs: "g": File "main.ml", line 3, characters 6-7
uid: Main.5; locs: "B": File "main.ml", line 2, characters 7-8
- uid: Stdlib__String.173; locs:
+ uid: Stdlib__String.174; locs:
"String.equal": File "main.ml", line 1, characters 8-20
}, 0 approx shapes: {}, and shapes for CUS .
diff --git a/src/ocaml/merlin_specific/browse_raw.ml b/src/ocaml/merlin_specific/browse_raw.ml
index 33040443bc..8e2ce8763d 100644
--- a/src/ocaml/merlin_specific/browse_raw.ml
+++ b/src/ocaml/merlin_specific/browse_raw.ml
@@ -360,8 +360,8 @@ let rec of_expression_desc loc = function
| _, None -> id_fold
| _, Some e -> of_expression e)
ls
- | Texp_match (e, cs, _) -> of_expression e ** list_fold of_case cs
- | Texp_try (e, cs) -> of_expression e ** list_fold of_case cs
+ | Texp_match (e, cs, _, _) -> of_expression e ** list_fold of_case cs
+ | Texp_try (e, cs, _) -> of_expression e ** list_fold of_case cs
| Texp_tuple es | Texp_construct (_, _, es) | Texp_array es ->
list_fold of_expression es
| Texp_variant (_, Some e)
diff --git a/src/ocaml/parsing/ast_helper.ml b/src/ocaml/parsing/ast_helper.ml
index 5e093022bc..78e68b900c 100644
--- a/src/ocaml/parsing/ast_helper.ml
+++ b/src/ocaml/parsing/ast_helper.ml
@@ -30,21 +30,29 @@ type attrs = attribute list
let default_loc = ref Location.none
-let const_string s = Pconst_string (s, !default_loc, None)
+let const_string s =
+ let pconst_desc = Pconst_string (s, !default_loc, None) in
+ let pconst_loc = !default_loc in
+ {pconst_loc; pconst_desc}
let with_default_loc l f =
Misc.protect_refs [Misc.R (default_loc, l)] f
module Const = struct
- let integer ?suffix i = Pconst_integer (i, suffix)
- let int ?suffix i = integer ?suffix (Int.to_string i)
- let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i)
- let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
- let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
- let float ?suffix f = Pconst_float (f, suffix)
- let char c = Pconst_char c
+ let mk ?(loc = !default_loc) d =
+ {pconst_desc = d;
+ pconst_loc = loc}
+
+ let integer ?loc ?suffix i = mk ?loc (Pconst_integer (i, suffix))
+ let int ?loc ?suffix i = integer ?loc ?suffix (Int.to_string i)
+ let int32 ?loc ?(suffix='l') i = integer ?loc ~suffix (Int32.to_string i)
+ let int64 ?loc ?(suffix='L') i = integer ?loc ~suffix (Int64.to_string i)
+ let nativeint ?loc ?(suffix='n') i =
+ integer ?loc ~suffix (Nativeint.to_string i)
+ let float ?loc ?suffix f = mk ?loc (Pconst_float (f, suffix))
+ let char ?loc c = mk ?loc (Pconst_char c)
let string ?quotation_delimiter ?(loc= !default_loc) s =
- Pconst_string (s, loc, quotation_delimiter)
+ mk ~loc (Pconst_string (s, loc, quotation_delimiter))
end
module Attr = struct
@@ -172,6 +180,7 @@ module Pat = struct
let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b))
let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)
+ let effect_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_effect(a, b))
let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
end
@@ -619,7 +628,6 @@ module Te = struct
pext_loc = loc;
pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
}
-
end
module Csig = struct
@@ -691,7 +699,7 @@ let no_label = Nolabel
let extract_str_payload = function
| PStr [{ pstr_desc = Pstr_eval (
{Parsetree. pexp_loc; pexp_desc =
- Parsetree.Pexp_constant (Parsetree.Pconst_string (msg, _, _)) ; _ }, _
+ Parsetree.Pexp_constant ({pconst_desc = Parsetree.Pconst_string (msg, _, _); _}) ; _ }, _
); _ }] ->
Some (msg, pexp_loc)
| _ -> None
diff --git a/src/ocaml/parsing/ast_helper.mli b/src/ocaml/parsing/ast_helper.mli
index 70f59e5b97..afca340e00 100644
--- a/src/ocaml/parsing/ast_helper.mli
+++ b/src/ocaml/parsing/ast_helper.mli
@@ -46,15 +46,16 @@ val with_default_loc: loc -> (unit -> 'a) -> 'a
(** {1 Constants} *)
module Const : sig
- val char : char -> constant
+ val mk : ?loc:loc -> constant_desc -> constant
+ val char : ?loc:loc -> char -> constant
val string :
?quotation_delimiter:string -> ?loc:Location.t -> string -> constant
- val integer : ?suffix:char -> string -> constant
- val int : ?suffix:char -> int -> constant
- val int32 : ?suffix:char -> int32 -> constant
- val int64 : ?suffix:char -> int64 -> constant
- val nativeint : ?suffix:char -> nativeint -> constant
- val float : ?suffix:char -> string -> constant
+ val integer : ?loc:loc -> ?suffix:char -> string -> constant
+ val int : ?loc:loc -> ?suffix:char -> int -> constant
+ val int32 : ?loc:loc -> ?suffix:char -> int32 -> constant
+ val int64 : ?loc:loc -> ?suffix:char -> int64 -> constant
+ val nativeint : ?loc:loc -> ?suffix:char -> nativeint -> constant
+ val float : ?loc:loc -> ?suffix:char -> string -> constant
end
(** {1 Attributes} *)
@@ -128,6 +129,7 @@ module Pat:
val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern
val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern
val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+ val effect_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
end
diff --git a/src/ocaml/parsing/ast_iterator.ml b/src/ocaml/parsing/ast_iterator.ml
index 94d5806fb3..389a9a4042 100644
--- a/src/ocaml/parsing/ast_iterator.ml
+++ b/src/ocaml/parsing/ast_iterator.ml
@@ -493,6 +493,7 @@ module P = struct
| Ppat_type s -> iter_loc sub s
| Ppat_lazy p -> sub.pat sub p
| Ppat_unpack s -> iter_loc sub s
+ | Ppat_effect (p1,p2) -> sub.pat sub p1; sub.pat sub p2
| Ppat_exception p -> sub.pat sub p
| Ppat_extension x -> sub.extension sub x
| Ppat_open (lid, p) ->
diff --git a/src/ocaml/parsing/ast_mapper.ml b/src/ocaml/parsing/ast_mapper.ml
index e3997095a9..66e244e0ef 100644
--- a/src/ocaml/parsing/ast_mapper.ml
+++ b/src/ocaml/parsing/ast_mapper.ml
@@ -95,14 +95,18 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
module C = struct
(* Constants *)
- let map sub c = match c with
- | Pconst_integer _
- | Pconst_char _
- | Pconst_float _
- -> c
- | Pconst_string (s, loc, quotation_delimiter) ->
- let loc = sub.location sub loc in
- Const.string ~loc ?quotation_delimiter s
+ let map sub { pconst_desc; pconst_loc } =
+ let loc = sub.location sub pconst_loc in
+ let desc =
+ match pconst_desc with
+ | Pconst_integer _
+ | Pconst_char _
+ | Pconst_float _ ->
+ pconst_desc
+ | Pconst_string (s, loc, quotation_delimiter) ->
+ Pconst_string (s, sub.location sub loc, quotation_delimiter)
+ in
+ Const.mk ~loc desc
end
module T = struct
@@ -549,6 +553,8 @@ module P = struct
| Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s)
| Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p)
| Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p)
+ | Ppat_effect(p1, p2) ->
+ effect_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
| Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x)
end
@@ -828,21 +834,21 @@ let default_mapper =
let extension_of_error {kind; main; sub} =
if kind <> Location.Report_error then
raise (Invalid_argument "extension_of_error: expected kind Report_error");
- let str_of_pp pp_msg = Format.asprintf "%t" pp_msg in
+ let str_of_msg msg = Format.asprintf "%a" Format_doc.Doc.format msg in
let extension_of_sub sub =
{ loc = sub.loc; txt = "ocaml.error" },
PStr ([Str.eval (Exp.constant
- (Pconst_string (str_of_pp sub.txt, sub.loc, None)))])
+ (Const.string ~loc:sub.loc (str_of_msg sub.txt)))])
in
{ loc = main.loc; txt = "ocaml.error" },
PStr (Str.eval (Exp.constant
- (Pconst_string (str_of_pp main.txt, main.loc, None))) ::
+ (Const.string ~loc:main.loc (str_of_msg main.txt))) ::
List.map (fun msg -> Str.extension (extension_of_sub msg)) sub)
let attribute_of_warning loc s =
Attr.mk
{loc; txt = "ocaml.ppwarning" }
- (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, loc, None)))]))
+ (PStr ([Str.eval ~loc (Exp.constant (Const.string ~loc s))]))
let cookies = ref String.Map.empty
@@ -935,7 +941,8 @@ module PpxContext = struct
let restore fields =
let field name payload =
let rec get_string = function
- | { pexp_desc = Pexp_constant (Pconst_string (str, _, None)) } -> str
+ | {pexp_desc = Pexp_constant
+ {pconst_desc = Pconst_string (str, _, None); _}} -> str
| _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
{ %s }] string syntax" name
and get_bool pexp =
diff --git a/src/ocaml/parsing/asttypes.ml b/src/ocaml/parsing/asttypes.ml
new file mode 100644
index 0000000000..0a5e73a4da
--- /dev/null
+++ b/src/ocaml/parsing/asttypes.ml
@@ -0,0 +1,72 @@
+(**************************************************************************)
+(* *)
+(* 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
+ | NoVariance
+
+type injectivity =
+ | Injective
+ | NoInjectivity
+
+let string_of_label = function
+ Nolabel -> ""
+ | Labelled s -> s
+ | Optional s -> "?"^s
diff --git a/src/ocaml/parsing/asttypes.mli b/src/ocaml/parsing/asttypes.mli
index 7a4f1c1913..e3cf5ae4e7 100644
--- a/src/ocaml/parsing/asttypes.mli
+++ b/src/ocaml/parsing/asttypes.mli
@@ -65,3 +65,5 @@ type variance =
type injectivity =
| Injective
| NoInjectivity
+
+val string_of_label: arg_label -> string
diff --git a/src/ocaml/parsing/attr_helper.ml b/src/ocaml/parsing/attr_helper.ml
index 390124199b..f531cf95b0 100644
--- a/src/ocaml/parsing/attr_helper.ml
+++ b/src/ocaml/parsing/attr_helper.ml
@@ -39,9 +39,9 @@ let has_no_payload_attribute alt_names attrs =
| None -> false
| Some _ -> true
-open Format
+open Format_doc
-let report_error ppf = function
+let report_error_doc ppf = function
| Multiple_attributes name ->
fprintf ppf "Too many %a attributes" Style.inline_code name
| No_payload_expected name ->
@@ -51,7 +51,9 @@ let () =
Location.register_error_of_exn
(function
| Error (loc, err) ->
- Some (Location.error_of_printer ~loc report_error err)
+ Some (Location.error_of_printer ~loc report_error_doc err)
| _ ->
None
)
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/src/ocaml/parsing/attr_helper.mli b/src/ocaml/parsing/attr_helper.mli
index a94042a290..2782cba80a 100644
--- a/src/ocaml/parsing/attr_helper.mli
+++ b/src/ocaml/parsing/attr_helper.mli
@@ -35,4 +35,5 @@ val has_no_payload_attribute : string -> attributes -> bool
exception Error of Location.t * error
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
diff --git a/src/ocaml/parsing/builtin_attributes.ml b/src/ocaml/parsing/builtin_attributes.ml
index 6add5ac375..2336d52f52 100644
--- a/src/ocaml/parsing/builtin_attributes.ml
+++ b/src/ocaml/parsing/builtin_attributes.ml
@@ -36,12 +36,22 @@ let attr_order a1 a2 =
| 0 -> Int.compare a1.loc.loc_start.pos_cnum a2.loc.loc_start.pos_cnum
| n -> n
+let compiler_stops_before_attributes_consumed () =
+ let stops_before_lambda =
+ match !Clflags.stop_after with
+ | None -> false
+ | Some pass -> Clflags.Compiler_pass.(compare pass Lambda) < 0
+ in
+ stops_before_lambda || !Clflags.print_types
+
let warn_unused () =
let keys = List.of_seq (Attribute_table.to_seq_keys unused_attrs) in
- let keys = List.sort attr_order keys in
- List.iter (fun sloc ->
- Location.prerr_warning sloc.loc (Warnings.Misplaced_attribute sloc.txt))
- keys
+ Attribute_table.clear unused_attrs;
+ if not (compiler_stops_before_attributes_consumed ()) then
+ let keys = List.sort attr_order keys in
+ List.iter (fun sloc ->
+ Location.prerr_warning sloc.loc (Warnings.Misplaced_attribute sloc.txt))
+ keys
(* These are the attributes that are tracked in the builtin_attrs table for
misplaced attribute warnings. *)
@@ -93,8 +103,8 @@ let register_attr current_phase name =
if is_builtin_attr name.txt then
Attribute_table.replace unused_attrs name ()
-
-let string_of_cst = function
+let string_of_cst const =
+ match const.pconst_desc with
| Pconst_string(s, _, _) -> Some s
| _ -> None
@@ -108,37 +118,39 @@ let string_of_opt_payload p =
| Some s -> s
| None -> ""
+module Style = Misc.Style
let error_of_extension ext =
let submessage_from main_loc main_txt = function
| {pstr_desc=Pstr_extension
(({txt = ("ocaml.error"|"error"); loc}, p), _)} ->
begin match p with
| PStr([{pstr_desc=Pstr_eval
- ({pexp_desc=Pexp_constant(Pconst_string(msg,_,_))}, _)}
+ ({pexp_desc=Pexp_constant
+ {pconst_desc=Pconst_string(msg, _, _); _}}, _)}
]) ->
- { Location.loc; txt = fun ppf -> Format.pp_print_text ppf msg }
+ Location.msg ~loc "%a" Format_doc.pp_print_text msg
| _ ->
- { Location.loc; txt = fun ppf ->
- Format.fprintf ppf
- "Invalid syntax for sub-message of extension '%s'." main_txt }
+ Location.msg ~loc "Invalid syntax for sub-message of extension %a."
+ Style.inline_code main_txt
end
| {pstr_desc=Pstr_extension (({txt; loc}, _), _)} ->
- { Location.loc; txt = fun ppf ->
- Format.fprintf ppf "Uninterpreted extension '%s'." txt }
+ Location.msg ~loc "Uninterpreted extension '%a'."
+ Style.inline_code txt
| _ ->
- { Location.loc = main_loc; txt = fun ppf ->
- Format.fprintf ppf
- "Invalid syntax for sub-message of extension '%s'." main_txt }
+ Location.msg ~loc:main_loc
+ "Invalid syntax for sub-message of extension %a."
+ Style.inline_code main_txt
in
match ext with
| ({txt = ("ocaml.error"|"error") as txt; loc}, p) ->
begin match p with
| PStr [] -> raise Location.Already_displayed_error
| PStr({pstr_desc=Pstr_eval
- ({pexp_desc=Pexp_constant(Pconst_string(msg,_,_))}, _)}::
+ ({pexp_desc=Pexp_constant
+ {pconst_desc=Pconst_string(msg, _, _)}}, _)}::
inner) ->
let sub = List.map (submessage_from loc txt) inner in
- Location.error_of_printer ~loc ~sub Format.pp_print_text msg
+ Location.error_of_printer ~loc ~sub Format_doc.pp_print_text msg
| _ ->
Location.errorf ~loc "Invalid syntax for extension '%s'." txt
end
@@ -186,7 +198,8 @@ let kind_and_message = function
Pstr_eval
({pexp_desc=Pexp_apply
({pexp_desc=Pexp_ident{txt=Longident.Lident id}},
- [Nolabel,{pexp_desc=Pexp_constant (Pconst_string(s,_,_))}])
+ [Nolabel,{pexp_desc=Pexp_constant
+ {pconst_desc=Pconst_string(s,_,_); _}}])
},_)}] ->
Some (id, s)
| PStr[
@@ -265,7 +278,10 @@ let rec attrs_of_sig = function
| _ ->
[]
-let alerts_of_sig sg = alerts_of_attrs (attrs_of_sig sg)
+let alerts_of_sig ~mark sg =
+ let a = attrs_of_sig sg in
+ if mark then mark_alerts_used a;
+ alerts_of_attrs a
let rec attrs_of_str = function
| {pstr_desc = Pstr_attribute a} :: tl ->
@@ -273,7 +289,10 @@ let rec attrs_of_str = function
| _ ->
[]
-let alerts_of_str str = alerts_of_attrs (attrs_of_str str)
+let alerts_of_str ~mark str =
+ let a = attrs_of_str str in
+ if mark then mark_alerts_used a;
+ alerts_of_attrs a
let warn_payload loc txt msg =
Location.prerr_warning loc (Warnings.Attribute_payload (txt, msg))
@@ -294,7 +313,7 @@ let warning_attribute ?(ppwarning = true) =
let process_alert loc name = function
| PStr[{pstr_desc=
Pstr_eval(
- {pexp_desc=Pexp_constant(Pconst_string(s,_,_))},
+ {pexp_desc=Pexp_constant {pconst_desc=Pconst_string(s,_,_); _}},
_)
}] ->
begin
@@ -303,15 +322,19 @@ let warning_attribute ?(ppwarning = true) =
with Arg.Bad msg -> warn_payload loc name.txt msg
end
| k ->
- (* Don't [mark_used] in the [Some] cases - that happens in [Env] or
- [type_mod] if they are in a valid place. Do [mark_used] in the
- [None] case, which is just malformed and covered by the "Invalid
- payload" warning. *)
match kind_and_message k with
| Some ("all", _) ->
warn_payload loc name.txt "The alert name 'all' is reserved"
- | Some _ -> ()
+ | Some _ ->
+ (* Do [mark_used] in the [Some] case only if Warning 53 is
+ disabled. Later, they will be marked used (provided they are in a
+ valid place) in [compile_common], when they are extracted to be
+ persisted inside the [.cmi] file. *)
+ if not (Warnings.is_active (Misplaced_attribute ""))
+ then mark_used name
| None -> begin
+ (* Do [mark_used] in the [None] case, which is just malformed and
+ covered by the "Invalid payload" warning. *)
mark_used name;
warn_payload loc name.txt "Invalid payload"
end
@@ -327,7 +350,7 @@ let warning_attribute ?(ppwarning = true) =
begin match attr_payload with
| PStr [{ pstr_desc=
Pstr_eval({pexp_desc=Pexp_constant
- (Pconst_string (s, _, _))},_);
+ {pconst_desc=Pconst_string (s, _, _); _}},_);
pstr_loc }] ->
(mark_used attr_name;
Location.prerr_warning pstr_loc (Warnings.Preprocessor s))
diff --git a/src/ocaml/parsing/builtin_attributes.mli b/src/ocaml/parsing/builtin_attributes.mli
index 4eb5ef91f2..4176bcb93e 100644
--- a/src/ocaml/parsing/builtin_attributes.mli
+++ b/src/ocaml/parsing/builtin_attributes.mli
@@ -75,7 +75,8 @@ val register_attr : current_phase -> string Location.loc -> unit
val mark_payload_attrs_used : Parsetree.payload -> unit
(** Issue misplaced attribute warnings for all attributes created with
- [mk_internal] but not yet marked used. *)
+ [mk_internal] but not yet marked used. Does nothing if compilation
+ is stopped before lambda due to command-line flags. *)
val warn_unused : unit -> unit
(** {3 Warning 53 helpers for environment attributes}
@@ -115,8 +116,8 @@ val check_alerts_inclusion:
def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes ->
Parsetree.attributes -> string -> unit
val alerts_of_attrs: Parsetree.attributes -> Misc.alerts
-val alerts_of_sig: Parsetree.signature -> Misc.alerts
-val alerts_of_str: Parsetree.structure -> Misc.alerts
+val alerts_of_sig: mark:bool -> Parsetree.signature -> Misc.alerts
+val alerts_of_str: mark:bool -> Parsetree.structure -> Misc.alerts
val check_deprecated_mutable:
Location.t -> Parsetree.attributes -> string -> unit
@@ -172,7 +173,7 @@ val select_attributes :
(** [attr_equals_builtin attr s] is true if the name of the attribute is [s] or
["ocaml." ^ s]. This is useful for manually inspecting attribute names, but
note that doing so will not result in marking the attribute used for the
- purpose of warning 53, so it is usually preferrable to use [has_attribute]
+ purpose of warning 53, so it is usually preferable to use [has_attribute]
or [select_attributes]. *)
val attr_equals_builtin : Parsetree.attribute -> string -> bool
diff --git a/src/ocaml/parsing/docstrings.ml b/src/ocaml/parsing/docstrings.ml
index a39f75d259..32b8e8c468 100644
--- a/src/ocaml/parsing/docstrings.ml
+++ b/src/ocaml/parsing/docstrings.ml
@@ -91,8 +91,9 @@ let docs_attr ds =
let open Parsetree in
let body = ds.ds_body in
let loc = ds.ds_loc in
+ let const = { pconst_desc= Pconst_string(body,loc,None); pconst_loc= loc } in
let exp =
- { pexp_desc = Pexp_constant (Pconst_string(body, loc, None));
+ { pexp_desc = Pexp_constant const;
pexp_loc = loc;
pexp_loc_stack = [];
pexp_attributes = []; }
@@ -143,8 +144,9 @@ let text_attr ds =
let open Parsetree in
let body = ds.ds_body in
let loc = ds.ds_loc in
+ let const = { pconst_desc= Pconst_string(body,loc,None); pconst_loc= loc } in
let exp =
- { pexp_desc = Pexp_constant (Pconst_string(body, loc, None));
+ { pexp_desc = Pexp_constant const;
pexp_loc = loc;
pexp_loc_stack = [];
pexp_attributes = []; }
diff --git a/src/ocaml/parsing/dune b/src/ocaml/parsing/dune
index ac394faf26..d505362d33 100644
--- a/src/ocaml/parsing/dune
+++ b/src/ocaml/parsing/dune
@@ -5,5 +5,5 @@
(name ocaml_parsing)
(public_name merlin-lib.ocaml_parsing)
(flags -open Ocaml_utils -open Merlin_utils (:standard -w -9))
- (modules_without_implementation asttypes parsetree)
+ (modules_without_implementation parsetree)
(libraries merlin_utils ocaml_utils))
diff --git a/src/ocaml/parsing/location.ml b/src/ocaml/parsing/location.ml
index 781a2e846b..1e00939387 100644
--- a/src/ocaml/parsing/location.ml
+++ b/src/ocaml/parsing/location.ml
@@ -122,13 +122,6 @@ let echo_eof () =
print_newline ();
incr num_loc_lines
-(* This is used by the toplevel and the report printers below. *)
-let separate_new_message ppf =
- if not (is_first_message ()) then begin
- Format.pp_print_newline ppf ();
- incr num_loc_lines
- end
-
(* Code printing errors and warnings must be wrapped using this function, in
order to update [num_loc_lines].
@@ -214,8 +207,19 @@ let absolute_path s = (* This function could go into Filename *)
let show_filename file =
(* if !Clflags.absname then absolute_path file else *) file
-let print_filename ppf file =
- Format.pp_print_string ppf (show_filename file)
+module Fmt = Format_doc
+
+module Doc = struct
+
+ (* This is used by the toplevel and the report printers below. *)
+ let separate_new_message ppf () =
+ if not (is_first_message ()) then begin
+ Fmt.pp_print_newline ppf ();
+ incr num_loc_lines
+ end
+
+ let filename ppf file =
+ Fmt.pp_print_string ppf (show_filename file)
(* Best-effort printing of the text describing a location, of the form
'File "foo.ml", line 3, characters 10-12'.
@@ -223,59 +227,73 @@ let print_filename ppf file =
Some of the information (filename, line number or characters numbers) in the
location might be invalid; in which case we do not print it.
*)
-let print_loc ppf loc =
- (* setup_tags (); *)
- let file_valid = function
- | "_none_" ->
- (* This is a dummy placeholder, but we print it anyway to please editors
- that parse locations in error messages (e.g. Emacs). *)
- true
- | "" | "//toplevel//" -> false
- | _ -> true
- in
- let line_valid line = line > 0 in
- let chars_valid ~startchar ~endchar = startchar <> -1 && endchar <> -1 in
-
- let file =
- (* According to the comment in location.mli, if [pos_fname] is "", we must
- use [!input_name]. *)
- if loc.loc_start.pos_fname = "" then !input_name
- else loc.loc_start.pos_fname
- in
- let line = loc.loc_start.pos_lnum in
- let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
- let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_bol in
-
- let first = ref true in
- let capitalize s =
- if !first then (first := false; String.capitalize_ascii s)
- else s in
- let comma () =
- if !first then () else Format.fprintf ppf ", " in
-
- Format.fprintf ppf "@{<loc>";
-
- if file_valid file then
- Format.fprintf ppf "%s \"%a\"" (capitalize "file") print_filename file;
-
- (* Print "line 1" in the case of a dummy line number. This is to please the
- existing setup of editors that parse locations in error messages (e.g.
- Emacs). *)
- comma ();
- Format.fprintf ppf "%s %i" (capitalize "line")
- (if line_valid line then line else 1);
-
- if chars_valid ~startchar ~endchar then (
+ let loc ppf loc =
+ let file_valid = function
+ | "_none_" ->
+ (* This is a dummy placeholder, but we print it anyway to please
+ editors that parse locations in error messages (e.g. Emacs). *)
+ true
+ | "" | "//toplevel//" -> false
+ | _ -> true
+ in
+ let line_valid line = line > 0 in
+ let chars_valid ~startchar ~endchar = startchar <> -1 && endchar <> -1 in
+
+ let file =
+ (* According to the comment in location.mli, if [pos_fname] is "", we must
+ use [!input_name]. *)
+ if loc.loc_start.pos_fname = "" then !input_name
+ else loc.loc_start.pos_fname
+ in
+ let startline = loc.loc_start.pos_lnum in
+ let endline = loc.loc_end.pos_lnum in
+ let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
+ let endchar = loc.loc_end.pos_cnum - loc.loc_end.pos_bol in
+
+ let first = ref true in
+ let capitalize s =
+ if !first then (first := false; String.capitalize_ascii s)
+ else s in
+ let comma () =
+ if !first then () else Fmt.fprintf ppf ", " in
+
+ Fmt.fprintf ppf "@{<loc>";
+
+ if file_valid file then
+ Fmt.fprintf ppf "%s \"%a\"" (capitalize "file") filename file;
+
+ (* Print "line 1" in the case of a dummy line number. This is to please the
+ existing setup of editors that parse locations in error messages (e.g.
+ Emacs). *)
comma ();
- Format.fprintf ppf "%s %i-%i" (capitalize "characters") startchar endchar
- );
+ let startline = if line_valid startline then startline else 1 in
+ let endline = if line_valid endline then endline else startline in
+ begin if startline = endline then
+ Fmt.fprintf ppf "%s %i" (capitalize "line") startline
+ else
+ Fmt.fprintf ppf "%s %i-%i" (capitalize "lines") startline endline
+ end;
- Format.fprintf ppf "@}"
+ if chars_valid ~startchar ~endchar then (
+ comma ();
+ Fmt.fprintf ppf "%s %i-%i" (capitalize "characters") startchar endchar
+ );
+
+ Fmt.fprintf ppf "@}"
+
+ (* Print a comma-separated list of locations *)
+ let locs ppf locs =
+ Fmt.pp_print_list ~pp_sep:(fun ppf () -> Fmt.fprintf ppf ",@ ")
+ loc ppf locs
+ let quoted_filename ppf f = Misc.Style.as_inline_code filename ppf f
+
+end
+
+let print_filename = Fmt.compat Doc.filename
+let print_loc = Fmt.compat Doc.loc
+let print_locs = Fmt.compat Doc.locs
+let separate_new_message ppf = Fmt.compat Doc.separate_new_message ppf ()
-(* Print a comma-separated list of locations *)
-let print_locs ppf locs =
- Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
- print_loc ppf locs
(******************************************************************************)
(* An interval set structure; additionally, it stores user-provided information
@@ -614,10 +632,11 @@ let lines_around_from_current_input ~start_pos ~end_pos =
(******************************************************************************)
(* Reporting errors and warnings *)
-type msg = (Format.formatter -> unit) loc
+
+type msg = Fmt.t loc
let msg ?(loc = none) fmt =
- Format.kdprintf (fun txt -> { loc; txt }) fmt
+ Fmt.kdoc_printf (fun txt -> { loc; txt }) fmt
type report_kind =
| Report_error
@@ -632,11 +651,12 @@ type report = {
kind : report_kind;
main : msg;
sub : msg list;
+ footnote: Fmt.t option;
source : error_source;
}
let loc_of_report { main; _ } = main.loc
-let print_msg fmt msg = msg.txt fmt
+let print_msg fmt msg = Fmt.Doc.format fmt msg.txt
let print_main fmt { main; _ } = print_msg fmt main
let print_sub_msg = print_msg
@@ -651,7 +671,7 @@ type report_printer = {
pp_main_loc : report_printer -> report ->
Format.formatter -> t -> unit;
pp_main_txt : report_printer -> report ->
- Format.formatter -> (Format.formatter -> unit) -> unit;
+ Format.formatter -> Fmt.t -> unit;
pp_submsgs : report_printer -> report ->
Format.formatter -> msg list -> unit;
pp_submsg : report_printer -> report ->
@@ -659,9 +679,8 @@ type report_printer = {
pp_submsg_loc : report_printer -> report ->
Format.formatter -> t -> unit;
pp_submsg_txt : report_printer -> report ->
- Format.formatter -> (Format.formatter -> unit) -> unit;
+ Format.formatter -> Fmt.t -> unit;
}
-
(*
let is_dummy_loc loc =
(* Fixme: this should be just [loc.loc_ghost] and the function should be
@@ -725,7 +744,10 @@ let batch_mode_printer : report_printer =
*)
()
in
- let pp_txt ppf txt = Format.fprintf ppf "@[%t@]" txt in
+ let pp_txt ppf txt = Format.fprintf ppf "@[%a@]" Fmt.Doc.format txt in
+ let pp_footnote ppf f =
+ Option.iter (Format.fprintf ppf "@,%a" pp_txt) f
+ in
let pp self ppf report =
(* setup_tags (); *)
separate_new_message ppf;
@@ -734,13 +756,14 @@ let batch_mode_printer : report_printer =
to be aligned with the main message box
*)
print_updating_num_loc_lines ppf (fun ppf () ->
- Format.fprintf ppf "@[<v>%a%a%a: %a%a%a%a@]@."
+ Format.fprintf ppf "@[<v>%a%a%a: %a%a%a%a%a@]@."
Format.pp_open_tbox ()
(self.pp_main_loc self report) report.main.loc
(self.pp_report_kind self report) report.kind
Format.pp_set_tab ()
(self.pp_main_txt self report) report.main.txt
(self.pp_submsgs self report) report.sub
+ pp_footnote report.footnote
Format.pp_close_tbox ()
) ()
in
@@ -821,24 +844,26 @@ let print_report ppf report =
(* Reporting errors *)
type error = report
+type delayed_msg = unit -> Fmt.t option
let report_error ppf err =
print_report ppf err
-let mkerror loc sub txt source =
- { kind = Report_error; main = { loc; txt }; sub; source }
+let mkerror loc sub footnote source txt =
+ { kind = Report_error; main = { loc; txt }; sub; footnote=footnote (); source }
+
+let errorf ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) ?(source = Typer) =
+ Fmt.kdoc_printf (mkerror loc sub footnote source)
-let errorf ?(loc = none) ?(sub = []) ?(source=Typer) =
- Format.kdprintf (fun msg -> mkerror loc sub msg source)
+let error ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) ?(source = Typer) msg_str =
+ mkerror loc sub footnote source Fmt.Doc.(string msg_str empty)
-let error ?(loc = none) ?(sub = []) ?(source=Typer) msg_str =
- mkerror loc sub (fun ppf -> Format.pp_print_string ppf msg_str) source
+let error_of_printer ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) ?(source = Typer) pp x =
+ mkerror loc sub footnote source (Fmt.doc_printf "%a" pp x)
-let error_of_printer ?(loc = none) ?(sub = []) ?(source=Typer) pp x =
- mkerror loc sub (fun ppf -> pp ppf x) source
+let error_of_printer_file ?(source = Typer) print x =
+ error_of_printer ~source ~loc:(in_file !input_name) print x
-let error_of_printer_file ?source print x =
- error_of_printer ?source ~loc:(in_file !input_name) print x
(******************************************************************************)
(* Reporting warnings: generating a report from a warning number using the
@@ -848,14 +873,13 @@ let default_warning_alert_reporter ?(source = Typer) report mk (loc: t) w : repo
match report w with
| `Inactive -> None
| `Active { Warnings.id; message; is_error; sub_locs } ->
- let msg_of_str str = fun ppf -> Format.pp_print_string ppf str in
+ let msg_of_str str = Format_doc.Doc.(empty |> string str) in
let kind = mk is_error id in
let main = { loc; txt = msg_of_str message } in
let sub = List.map (fun (loc, sub_message) ->
{ loc; txt = msg_of_str sub_message }
) sub_locs in
- Some { kind; main; sub; source }
-
+ Some { kind; main; sub; footnote=None; source }
let default_warning_reporter =
default_warning_alert_reporter
@@ -910,7 +934,7 @@ let deprecated ?def ?use loc message =
module Style = Misc.Style
let auto_include_alert lib =
- let message = Format.asprintf "\
+ let message = Fmt.asprintf "\
OCaml's lib directory layout changed in 5.0. The %a subdirectory has been \
automatically added to the search path, but you should add %a to the \
command-line to silence this alert (e.g. by adding %a to the list of \
@@ -929,7 +953,7 @@ let auto_include_alert lib =
prerr_alert none alert
let deprecated_script_alert program =
- let message = Format.asprintf "\
+ let message = Fmt.asprintf "\
Running %a where the first argument is an implicit basename with no \
extension (e.g. %a) is deprecated. Either rename the script \
(%a) or qualify the basename (%a)"
@@ -966,6 +990,7 @@ let error_of_exn exn =
in
loop !error_of_exn
+
let () =
register_error_of_exn
(function
@@ -995,5 +1020,5 @@ let () =
| _ -> None
)
-let raise_errorf ?(loc = none) ?(sub = []) ?(source = Typer)=
- Format.kdprintf (fun txt -> raise (Error (mkerror loc sub txt source)))
+let raise_errorf ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) ?(source = Typer) =
+ Fmt.kdoc_printf (fun txt -> raise (Error (mkerror loc sub footnote source txt)))
diff --git a/src/ocaml/parsing/location.mli b/src/ocaml/parsing/location.mli
index 6681309d53..2d90be34ec 100644
--- a/src/ocaml/parsing/location.mli
+++ b/src/ocaml/parsing/location.mli
@@ -84,10 +84,10 @@ val input_lexbuf: Lexing.lexbuf option ref
toplevel phrase. *)
val input_phrase_buffer: Buffer.t option ref
+
(** {1 Toplevel-specific functions} *)
val echo_eof: unit -> unit
-val separate_new_message: formatter -> unit
val reset: unit -> unit
@@ -173,11 +173,20 @@ val show_filename: string -> string
Otherwise, returns the filename unchanged. *)
val print_filename: formatter -> string -> unit
-
val print_loc: formatter -> t -> unit
val print_locs: formatter -> t list -> unit
+val separate_new_message: formatter -> unit
+
+module Doc: sig
+ val separate_new_message: unit Format_doc.printer
+ val filename: string Format_doc.printer
+ val quoted_filename: string Format_doc.printer
+ val loc: t Format_doc.printer
+ val locs: t list Format_doc.printer
+end
(** {1 Toplevel-specific location highlighting} *)
+
(*
val highlight_terminfo:
Lexing.lexbuf -> formatter -> t list -> unit
@@ -187,9 +196,9 @@ val highlight_terminfo:
(** {2 The type of reports and report printers} *)
-type msg = (Format.formatter -> unit) loc
+type msg = Format_doc.t loc
-val msg: ?loc:t -> ('a, Format.formatter, unit, msg) format4 -> 'a
+val msg: ?loc:t -> ('a, Format_doc.formatter, unit, msg) format4 -> 'a
type report_kind =
| Report_error
@@ -204,9 +213,11 @@ type report = {
kind : report_kind;
main : msg;
sub : msg list;
+ footnote: Format_doc.t option;
source : error_source;
}
+
(* Exposed for Merlin *)
val loc_of_report: report -> t
val print_main : formatter -> report -> unit
@@ -222,7 +233,7 @@ type report_printer = {
pp_main_loc : report_printer -> report ->
Format.formatter -> t -> unit;
pp_main_txt : report_printer -> report ->
- Format.formatter -> (Format.formatter -> unit) -> unit;
+ Format.formatter -> Format_doc.t -> unit;
pp_submsgs : report_printer -> report ->
Format.formatter -> msg list -> unit;
pp_submsg : report_printer -> report ->
@@ -230,7 +241,7 @@ type report_printer = {
pp_submsg_loc : report_printer -> report ->
Format.formatter -> t -> unit;
pp_submsg_txt : report_printer -> report ->
- Format.formatter -> (Format.formatter -> unit) -> unit;
+ Format.formatter -> Format_doc.t -> 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
@@ -240,6 +251,7 @@ type report_printer = {
(** {2 Report printers used in the compiler} *)
val batch_mode_printer: report_printer
+
(*
val terminfo_toplevel_printer: Lexing.lexbuf -> report_printer
@@ -309,7 +321,7 @@ val default_alert_reporter: t -> Warnings.alert -> report option
val print_alert: t -> formatter -> Warnings.alert -> unit
(** Prints an alert. This is simply the composition of [report_alert] and
- [print_report]. *)
+ [print_report]. *)
val prerr_alert_ref: (t -> Warnings.alert -> unit) ref
@@ -336,15 +348,19 @@ val deprecated_script_alert: string -> unit
type error = report
(** An [error] is a [report] which [report_kind] must be [Report_error]. *)
-val error: ?loc:t -> ?sub:msg list -> ?source:error_source -> string -> error
+type delayed_msg = unit -> Format_doc.t option
+
+val error: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+ ?source:error_source -> string -> error
-val errorf: ?loc:t -> ?sub:msg list -> ?source:error_source ->
- ('a, Format.formatter, unit, error) format4 -> 'a
+val errorf: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+ ?source:error_source -> ('a, Format_doc.formatter, unit, error) format4 -> 'a
-val error_of_printer: ?loc:t -> ?sub:msg list -> ?source:error_source ->
- (formatter -> 'a -> unit) -> 'a -> error
+val error_of_printer: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+ ?source:error_source -> (Format_doc.formatter -> 'a -> unit) -> 'a -> error
-val error_of_printer_file: ?source:error_source -> (formatter -> 'a -> unit) -> 'a -> error
+val error_of_printer_file: ?source:error_source ->
+ (Format_doc.formatter -> 'a -> unit) -> 'a -> error
(** {1 Automatically reporting errors for raised exceptions} *)
@@ -367,8 +383,8 @@ 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 -> ?source:error_source ->
- ('a, Format.formatter, unit, 'b) format4 -> 'a
+val raise_errorf: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+ ?source:error_source -> ('a, Format_doc.formatter, unit, 'b) format4 -> 'a
val report_exception: formatter -> exn -> unit
(** Reraise the exception if it is unknown. *)
diff --git a/src/ocaml/parsing/parsetree.mli b/src/ocaml/parsing/parsetree.mli
index 2f0a40c26c..e22a9a7813 100644
--- a/src/ocaml/parsing/parsetree.mli
+++ b/src/ocaml/parsing/parsetree.mli
@@ -22,7 +22,12 @@
open Asttypes
-type constant =
+type constant = {
+ pconst_desc : constant_desc;
+ pconst_loc : Location.t;
+}
+
+and constant_desc =
| Pconst_integer of string * char option
(** Integer constants such as [3] [3l] [3L] [3n].
@@ -270,6 +275,7 @@ and pattern_desc =
[Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)]
*)
| Ppat_exception of pattern (** Pattern [exception P] *)
+ | Ppat_effect of pattern * pattern (* Pattern [effect P P] *)
| Ppat_extension of extension (** Pattern [[%id]] *)
| Ppat_open of Longident.t loc * pattern (** Pattern [M.(P)] *)
diff --git a/src/ocaml/parsing/pprintast.ml b/src/ocaml/parsing/pprintast.ml
index ef87dcb4af..9a1b9bd9a4 100644
--- a/src/ocaml/parsing/pprintast.ml
+++ b/src/ocaml/parsing/pprintast.ml
@@ -81,39 +81,161 @@ let last_is c str =
let first_is_in cs str =
str <> "" && List.mem str.[0] cs
+(** The OCaml grammar generates [longident]s from five different rules:
+ - module longident (a sequence of uppercase identifiers [A.B.C])
+ - constructor longident, either
+ - a module [longident]
+ - [[]], [()], [true], [false]
+ - an optional module [longident] followed by [(::)] ([A.B.(::)])
+ - class longident, an optional module [longident] followed by a lowercase
+ identifier.
+ - value longident, an optional module [longident] followed by either:
+ - a lowercase identifier ([A.x])
+ - an operator (and in particular the [mod] keyword), ([A.(+), B.(mod)])
+ - type [longident]: a tree of applications and projections of
+ uppercase identifiers followed by a projection ending with
+ a lowercase identifier (for ordinary types), or any identifier
+ (for module types) (e.g [A.B(C.D(E.F).K)(G).X.Y.t])
+All these [longident]s share a common core and optionally add some extensions.
+Unfortunately, these extensions intersect while having different escaping
+and parentheses rules depending on the kind of [longident]:
+ - [true] or [false] can be either constructor [longident]s,
+ or value, type or class [longident]s using the raw identifier syntax.
+ - [mod] can be either an operator value [longident], or a class or type
+ [longident] using the raw identifier syntax.
+Thus in order to print correctly [longident]s, we need to keep track of their
+kind using the context in which they appear.
+*)
+type longindent_kind =
+ | Constr (** variant constructors *)
+ | Type (** core types, module types, class types, and classes *)
+ | Other (** values and modules *)
+
(* which identifiers are in fact operators needing parentheses *)
-let needs_parens txt =
- let fix = fixity_of_string txt in
- is_infix fix
- || is_mixfix fix
- || is_kwdop fix
- || first_is_in prefix_symbols txt
+let needs_parens ~kind txt =
+ match kind with
+ | Type -> false
+ | Constr | Other ->
+ let fix = fixity_of_string txt in
+ is_infix fix
+ || is_mixfix fix
+ || is_kwdop fix
+ || first_is_in prefix_symbols txt
(* some infixes need spaces around parens to avoid clashes with comment
syntax *)
let needs_spaces txt =
first_is '*' txt || last_is '*' txt
-(* Turn an arbitrary variable name into a valid OCaml identifier by adding \#
- in case it is a keyword, or parenthesis when it is an infix or prefix
- operator. *)
-let ident_of_name ppf txt =
- let format : (_, _, _) format =
- if Lexer.is_keyword txt then "\\#%s"
- else if not (needs_parens txt) then "%s"
- else if needs_spaces txt then "(@;%s@;)"
- else "(%s)"
- in fprintf ppf format txt
-
-let ident_of_name_loc ppf s = ident_of_name ppf s.txt
+let tyvar_of_name s =
+ if String.length s >= 2 && s.[1] = '\'' then
+ (* without the space, this would be parsed as
+ a character literal *)
+ "' " ^ s
+ else if Lexer.is_keyword s then
+ "'\\#" ^ s
+ else if String.equal s "_" then
+ s
+ else
+ "'" ^ s
-let protect_longident ppf print_longident longprefix txt =
- if not (needs_parens txt) then
- fprintf ppf "%a.%a" print_longident longprefix ident_of_name txt
+module Doc = struct
+(* Turn an arbitrary variable name into a valid OCaml identifier by adding \#
+ in case it is a keyword, or parenthesis when it is an infix or prefix
+ operator. *)
+ let ident_of_name ~kind ppf txt =
+ let format : (_, _, _) format =
+ if Lexer.is_keyword txt then begin
+ match kind, txt with
+ | Constr, ("true"|"false") -> "%s"
+ | _ -> "\\#%s"
+ end
+ else if not (needs_parens ~kind txt) then "%s"
+ else if needs_spaces txt then "(@;%s@;)"
+ else "(%s)"
+ in Format_doc.fprintf ppf format txt
+
+ let protect_longident ~kind ppf print_longident longprefix txt =
+ if not (needs_parens ~kind txt) then
+ Format_doc.fprintf ppf "%a.%a"
+ print_longident longprefix
+ (ident_of_name ~kind) txt
else if needs_spaces txt then
- fprintf ppf "%a.(@;%s@;)" print_longident longprefix txt
+ Format_doc.fprintf ppf "%a.(@;%s@;)" print_longident longprefix txt
else
- fprintf ppf "%a.(%s)" print_longident longprefix txt
+ Format_doc.fprintf ppf "%a.(%s)" print_longident longprefix txt
+
+ let rec any_longident ~kind f = function
+ | Lident s -> ident_of_name ~kind f s
+ | Ldot(y,s) ->
+ protect_longident ~kind f (any_longident ~kind:Other) y s
+ | Lapply (y,s) ->
+ Format_doc.fprintf f "%a(%a)"
+ (any_longident ~kind:Other) y
+ (any_longident ~kind:Other) s
+
+ let value_longident ppf l = any_longident ~kind:Other ppf l
+ let longident = value_longident
+ let constr ppf l = any_longident ~kind:Constr ppf l
+ let type_longident ppf l = any_longident ~kind:Type ppf l
+
+ let tyvar ppf s =
+ Format_doc.fprintf ppf "%s" (tyvar_of_name s)
+
+ (* Expressions are considered nominal if they can be used as the subject of a
+ sentence or action. In practice, we consider that an expression is nominal
+ if they satisfy one of:
+ - Similar to an identifier: words separated by '.' or '#'.
+ - Do not contain spaces when printed.
+ - Is a constant that is short enough.
+ *)
+ let nominal_exp t =
+ let open Format_doc.Doc in
+ let longident ?(is_constr=false) l =
+ let kind= if is_constr then Constr else Other in
+ Format_doc.doc_printer (any_longident ~kind) l.Location.txt in
+ let rec nominal_exp doc exp =
+ match exp.pexp_desc with
+ | _ when exp.pexp_attributes <> [] -> None
+ | Pexp_ident l ->
+ Some (longident l doc)
+ | Pexp_variant (lbl, None) ->
+ Some (printf "`%s" lbl doc)
+ | Pexp_construct (l, None) ->
+ Some (longident ~is_constr:true l doc)
+ | Pexp_field (parent, lbl) ->
+ Option.map
+ (printf ".%t" (longident lbl))
+ (nominal_exp doc parent)
+ | Pexp_send (parent, meth) ->
+ Option.map
+ (printf "#%s" meth.txt)
+ (nominal_exp doc parent)
+ (* String constants are syntactically too complex. For example, the
+ quotes conflict with the 'inline_code' style and they might contain
+ spaces. *)
+ | Pexp_constant { pconst_desc = Pconst_string _; _ } -> None
+ (* Char, integer and float constants are nominal. *)
+ | Pexp_constant { pconst_desc = Pconst_char c; _ } ->
+ Some (msg "%C" c)
+ | Pexp_constant
+ { pconst_desc = Pconst_integer (cst, suf) | Pconst_float (cst, suf);
+ _ } ->
+ Some (msg "%s%t" cst (option char suf))
+ | _ -> None
+ in
+ nominal_exp empty t
+end
+
+let value_longident ppf l = Format_doc.compat Doc.value_longident ppf l
+let type_longident ppf l = Format_doc.compat Doc.type_longident ppf l
+
+let ident_of_name ppf i =
+ Format_doc.compat (Doc.ident_of_name ~kind:Other) ppf i
+
+let constr ppf l = Format_doc.compat Doc.constr ppf l
+
+let ident_of_name_loc ppf s = ident_of_name ppf s.txt
type space_formatter = (unit, Format.formatter, unit) format
@@ -143,10 +265,10 @@ type construct =
let view_expr x =
match x.pexp_desc with
- | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
- | Pexp_construct ( {txt= Lident "true"; _},_) -> `btrue
- | Pexp_construct ( {txt= Lident "false"; _},_) -> `bfalse
- | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
+ | Pexp_construct ( {txt= Lident "()"; _},None) -> `tuple
+ | Pexp_construct ( {txt= Lident "true"; _},None) -> `btrue
+ | Pexp_construct ( {txt= Lident "false"; _},None) -> `bfalse
+ | Pexp_construct ( {txt= Lident "[]";_},None) -> `nil
| Pexp_construct ( {txt= Lident"::";_},Some _) ->
let rec loop exp acc = match exp with
| {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
@@ -225,15 +347,10 @@ let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
else fu f x
-let rec longident f = function
- | Lident s -> ident_of_name f s
- | Ldot(y,s) -> protect_longident f longident y s
- | Lapply (y,s) ->
- pp f "%a(%a)" longident y longident s
+let with_loc pr ppf x = pr ppf x.txt
+let value_longident_loc = with_loc value_longident
-let longident_loc f x = pp f "%a" longident x.txt
-
-let constant f = function
+let constant_desc f = function
| Pconst_char i ->
pp f "%C" i
| Pconst_string (i, _, None) ->
@@ -249,6 +366,8 @@ let constant f = function
| Pconst_float (i, Some m) ->
paren (first_is '-' i) (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
+let constant f const = constant_desc f const.pconst_desc
+
(* trailing space*)
let mutable_flag f = function
| Immutable -> ()
@@ -277,20 +396,9 @@ let iter_loc f ctxt {txt; loc = _} = f ctxt txt
let constant_string f s = pp f "%S" s
-let tyvar_of_name s =
- if String.length s >= 2 && s.[1] = '\'' then
- (* without the space, this would be parsed as
- a character literal *)
- "' " ^ s
- else if Lexer.is_keyword s then
- "'\\#" ^ s
- else if String.equal s "_" then
- s
- else
- "'" ^ s
-let tyvar ppf s =
- Format.fprintf ppf "%s" (tyvar_of_name s)
+
+let tyvar ppf v = Format_doc.compat Doc.tyvar ppf v
let tyvar_loc f str = tyvar f str.txt
let string_quot f x = pp f "`%a" ident_of_name x
@@ -343,7 +451,7 @@ and core_type1 ctxt f x =
|[] -> ()
|[x]-> pp f "%a@;" (core_type1 ctxt) x
| _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
- l longident_loc li
+ l (with_loc type_longident) li
| Ptyp_variant (l, closed, low) ->
let first_is_inherit = match l with
| {Parsetree.prf_desc = Rinherit _}::_ -> true
@@ -397,17 +505,20 @@ and core_type1 ctxt f x =
| Ptyp_class (li, l) -> (*FIXME*)
pp f "@[<hov2>%a#%a@]"
(list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
- longident_loc li
+ (with_loc type_longident) li
| Ptyp_package (lid, cstrs) ->
let aux f (s, ct) =
- pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct in
+ pp f "type %a@ =@ %a"
+ (with_loc type_longident) s
+ (core_type ctxt) ct in
(match cstrs with
- |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
+ |[] -> pp f "@[<hov2>(module@ %a)@]" (with_loc type_longident) lid
|_ ->
- pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
+ pp f "@[<hov2>(module@ %a@ with@ %a)@]"
+ (with_loc type_longident) lid
(list aux ~sep:"@ and@ ") cstrs)
| Ptyp_open(li, ct) ->
- pp f "@[<hov2>%a.(%a)@]" longident_loc li (core_type ctxt) ct
+ pp f "@[<hov2>%a.(%a)@]" value_longident_loc li (core_type ctxt) ct
| Ptyp_extension e -> extension ctxt f e
| (Ptyp_arrow _ | Ptyp_alias _ | Ptyp_poly _) ->
paren true (core_type ctxt) f x
@@ -461,12 +572,13 @@ and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
else
(match po with
| Some ([], x) ->
- pp f "%a@;%a" longident_loc li (simple_pattern ctxt) x
+ (* [true] and [false] are handled above *)
+ pp f "%a@;%a" value_longident_loc li (simple_pattern ctxt) x
| Some (vl, x) ->
- pp f "%a@ (type %a)@;%a" longident_loc li
+ pp f "%a@ (type %a)@;%a" value_longident_loc li
(list ~sep:"@ " ident_of_name_loc) vl
(simple_pattern ctxt) x
- | None -> pp f "%a" longident_loc li)
+ | None -> pp f "%a" value_longident_loc li)
| _ -> simple_pattern ctxt f x
and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
@@ -483,7 +595,7 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
| Ppat_unpack { txt = Some s } ->
pp f "(module@ %s)@ " s
| Ppat_type li ->
- pp f "#%a" longident_loc li
+ pp f "#%a" (with_loc type_longident) li
| Ppat_record (l, closed) ->
let longident_x_pattern f (li, p) =
match (li,p) with
@@ -491,9 +603,9 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
{ppat_desc=Ppat_var {txt;_};
ppat_attributes=[]; _})
when s = txt ->
- pp f "@[<2>%a@]" longident_loc li
+ pp f "@[<2>%a@]" value_longident_loc li
| _ ->
- pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
+ pp f "@[<2>%a@;=@;%a@]" value_longident_loc li (pattern1 ctxt) p
in
begin match closed with
| Closed ->
@@ -512,6 +624,8 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
pp f "@[<2>(lazy@;%a)@]" (simple_pattern ctxt) p
| Ppat_exception p ->
pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+ | Ppat_effect(p1, p2) ->
+ pp f "@[<2>effect@;%a, @;%a@]" (pattern1 ctxt) p1 (pattern1 ctxt) p2
| Ppat_extension e -> extension ctxt f e
| Ppat_open (lid, p) ->
let with_paren =
@@ -520,7 +634,7 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
| Ppat_construct (({txt=Lident ("()"|"[]"|"true"|"false");_}), None) ->
false
| _ -> true in
- pp f "@[<2>%a.%a @]" longident_loc lid
+ pp f "@[<2>%a.%a @]" value_longident_loc lid
(paren with_paren @@ pattern1 ctxt) p
| _ -> paren true (pattern ctxt) f x
@@ -560,7 +674,7 @@ and sugar_expr ctxt f e =
rem_args =
let print_path ppf = function
| None -> ()
- | Some m -> pp ppf ".%a" longident m in
+ | Some m -> pp ppf ".%a" value_longident m in
match assign, rem_args with
| false, [] ->
pp f "@[%a%a%s%a%s@]"
@@ -759,12 +873,12 @@ and expression ctxt f x =
(match view_expr x with
| `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
| `normal ->
- pp f "@[<2>%a@;%a@]" longident_loc li
+ pp f "@[<2>%a@;%a@]" (with_loc constr) li
(simple_expr ctxt) eo
| _ -> assert false)
| Pexp_setfield (e1, li, e2) ->
pp f "@[<2>%a.%a@ <-@ %a@]"
- (simple_expr ctxt) e1 longident_loc li (simple_expr ctxt) e2
+ (simple_expr ctxt) e1 value_longident_loc li (simple_expr ctxt) e2
| Pexp_ifthenelse (e1, e2, eo) ->
(* @;@[<2>else@ %a@]@] *)
let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
@@ -783,7 +897,7 @@ and expression ctxt f x =
pp f "@[<hv>%a@]"
(list (expression (under_semi ctxt)) ~sep:";@;") lst
| Pexp_new (li) ->
- pp f "@[<hov2>new@ %a@]" longident_loc li;
+ pp f "@[<hov2>new@ %a@]" (with_loc type_longident) li;
| Pexp_setinstvar (s, e) ->
pp f "@[<hov2>%a@ <-@ %a@]" ident_of_name s.txt (expression ctxt) e
| Pexp_override l -> (* FIXME *)
@@ -838,7 +952,7 @@ and expression2 ctxt f x =
if x.pexp_attributes <> [] then expression ctxt f x
else match x.pexp_desc with
| Pexp_field (e, li) ->
- pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
+ pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e value_longident_loc li
| Pexp_send (e, s) ->
pp f "@[<hov2>%a#%a@]" (simple_expr ctxt) e ident_of_name s.txt
@@ -856,10 +970,10 @@ and simple_expr ctxt f x =
| `list xs ->
pp f "@[<hv0>[%a]@]"
(list (expression (under_semi ctxt)) ~sep:";@;") xs
- | `simple x -> longident f x
+ | `simple x -> constr f x
| _ -> assert false)
| Pexp_ident li ->
- longident_loc f li
+ value_longident_loc f li
(* (match view_fixity_of_exp x with *)
(* |`Normal -> longident_loc f li *)
(* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
@@ -880,9 +994,11 @@ and simple_expr ctxt f x =
match e with
| {pexp_desc=Pexp_ident {txt;_};
pexp_attributes=[]; _} when li.txt = txt ->
- pp f "@[<hov2>%a@]" longident_loc li
+ pp f "@[<hov2>%a@]" value_longident_loc li
| _ ->
- pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
+ pp f "@[<hov2>%a@;=@;%a@]"
+ value_longident_loc li
+ (simple_expr ctxt) e
in
pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
(option ~last:" with@;" (simple_expr ctxt)) eo
@@ -980,7 +1096,7 @@ and class_type ctxt f x =
(fun f l -> match l with
| [] -> ()
| _ -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
- longident_loc li
+ (with_loc type_longident) li
(attributes ctxt) x.pcty_attributes
| Pcty_arrow (l, co, cl) ->
pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
@@ -991,7 +1107,7 @@ and class_type ctxt f x =
attributes ctxt f x.pcty_attributes
| Pcty_open (o, e) ->
pp f "@[<2>let open%s %a in@;%a@]"
- (override o.popen_override) longident_loc o.popen_expr
+ (override o.popen_override) value_longident_loc o.popen_expr
(class_type ctxt) e
(* [class type a = object end] *)
@@ -1111,7 +1227,7 @@ and class_expr ctxt f x =
(fun f l-> if l <>[] then
pp f "[%a]@ "
(list (core_type ctxt) ~sep:",") l) l
- longident_loc li
+ (with_loc type_longident) li
| Pcl_constraint (ce, ct) ->
pp f "(%a@ :@ %a)"
(class_expr ctxt) ce
@@ -1119,7 +1235,7 @@ and class_expr ctxt f x =
| Pcl_extension e -> extension ctxt f e
| Pcl_open (o, e) ->
pp f "@[<2>let open%s %a in@;%a@]"
- (override o.popen_override) longident_loc o.popen_expr
+ (override o.popen_override) value_longident_loc o.popen_expr
(class_expr ctxt) e
and module_type ctxt f x =
@@ -1136,7 +1252,7 @@ and module_type ctxt f x =
pp f "@[<hov2>%a@ ->@ %a@]"
(module_type1 ctxt) mt1 (module_type ctxt) mt2
| Some name ->
- pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" name
+ pp f "@[<hov2>(%s@ :@ %a)@ ->@ %a@]" name
(module_type ctxt) mt1 (module_type ctxt) mt2
end
| Pmty_with (mt, []) -> module_type ctxt f mt
@@ -1150,29 +1266,33 @@ and with_constraint ctxt f = function
| Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
pp f "type@ %a %a =@ %a"
(type_params ctxt) ls
- longident_loc li (type_declaration ctxt) td
+ (with_loc type_longident) li (type_declaration ctxt) td
| Pwith_module (li, li2) ->
- pp f "module %a =@ %a" longident_loc li longident_loc li2;
+ pp f "module %a =@ %a" value_longident_loc li value_longident_loc li2;
| Pwith_modtype (li, mty) ->
- pp f "module type %a =@ %a" longident_loc li (module_type ctxt) mty;
+ pp f "module type %a =@ %a"
+ (with_loc type_longident) li
+ (module_type ctxt) mty;
| Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
pp f "type@ %a %a :=@ %a"
(type_params ctxt) ls
- longident_loc li
+ (with_loc type_longident) li
(type_declaration ctxt) td
| Pwith_modsubst (li, li2) ->
- pp f "module %a :=@ %a" longident_loc li longident_loc li2
+ pp f "module %a :=@ %a" value_longident_loc li value_longident_loc li2
| Pwith_modtypesubst (li, mty) ->
- pp f "module type %a :=@ %a" longident_loc li (module_type ctxt) mty;
+ pp f "module type %a :=@ %a"
+ (with_loc type_longident) li
+ (module_type ctxt) mty;
and module_type1 ctxt f x =
if x.pmty_attributes <> [] then module_type ctxt f x
else match x.pmty_desc with
| Pmty_ident li ->
- pp f "%a" longident_loc li;
+ pp f "%a" (with_loc type_longident) li;
| Pmty_alias li ->
- pp f "(module %a)" longident_loc li;
+ pp f "(module %a)" (with_loc type_longident) li;
| Pmty_signature (s) ->
pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
(list (signature_item ctxt)) s (* FIXME wrong indentation*)
@@ -1223,7 +1343,7 @@ and signature_item ctxt f x : unit =
pmty_attributes=[]; _};_} as pmd) ->
pp f "@[<hov>module@ %s@ =@ %a@]%a"
(Option.value pmd.pmd_name.txt ~default:"_")
- longident_loc alias
+ value_longident_loc alias
(item_attributes ctxt) pmd.pmd_attributes
| Psig_module pmd ->
pp f "@[<hov>module@ %s@ :@ %a@]%a"
@@ -1232,20 +1352,20 @@ and signature_item ctxt f x : unit =
(item_attributes ctxt) pmd.pmd_attributes
| Psig_modsubst pms ->
pp f "@[<hov>module@ %s@ :=@ %a@]%a" pms.pms_name.txt
- longident_loc pms.pms_manifest
+ value_longident_loc pms.pms_manifest
(item_attributes ctxt) pms.pms_attributes
| Psig_open od ->
pp f "@[<hov2>open%s@ %a@]%a"
(override od.popen_override)
- longident_loc od.popen_expr
+ value_longident_loc od.popen_expr
(item_attributes ctxt) od.popen_attributes
| Psig_include incl ->
pp f "@[<hov2>include@ %a@]%a"
(module_type ctxt) incl.pincl_mod
(item_attributes ctxt) incl.pincl_attributes
| Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
- pp f "@[<hov2>module@ type@ %s%a@]%a"
- s.txt
+ pp f "@[<hov2>module@ type@ %a%a@]%a"
+ ident_of_name s.txt
(fun f md -> match md with
| None -> ()
| Some mt ->
@@ -1297,7 +1417,7 @@ and module_expr ctxt f x =
(module_expr ctxt) me
(module_type ctxt) mt
| Pmod_ident (li) ->
- pp f "%a" longident_loc li;
+ pp f "%a" value_longident_loc li;
| Pmod_functor (Unit, me) ->
pp f "functor ()@;->@;%a" (module_expr ctxt) me
| Pmod_functor (Named (s, mt), me) ->
@@ -1348,7 +1468,7 @@ and binding ctxt f {pvb_pat=p; pvb_expr=x; pvb_constraint = ct; _} =
(simple_pattern ctxt) p (core_type ctxt) typ (expression ctxt) x
| Some (Pvc_constraint { locally_abstract_univars = vars; typ }) ->
pp f "%a@;: type@;%a.@;%a@;=@;%a"
- (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
+ (simple_pattern ctxt) p (list ident_of_name ~sep:"@;")
(List.map (fun x -> x.txt) vars)
(core_type ctxt) typ (expression ctxt) x
| Some (Pvc_coercion {ground=None; coercion }) ->
@@ -1439,8 +1559,8 @@ and structure_item ctxt f x =
(module_expr ctxt) od.popen_expr
(item_attributes ctxt) od.popen_attributes
| Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
- pp f "@[<hov2>module@ type@ %s%a@]%a"
- s.txt
+ pp f "@[<hov2>module@ type@ %a%a@]%a"
+ ident_of_name s.txt
(fun f md -> match md with
| None -> ()
| Some mt ->
@@ -1629,7 +1749,7 @@ and type_extension ctxt f x =
| l ->
pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
x.ptyext_params
- longident_loc x.ptyext_path
+ (with_loc type_longident) x.ptyext_path
private_flag x.ptyext_private (* Cf: #7200 *)
(list ~sep:"" extension_constructor)
x.ptyext_constructors
@@ -1676,7 +1796,7 @@ and extension_constructor ctxt f x =
(x.pext_name.txt, v, l, r, x.pext_attributes)
| Pext_rebind li ->
pp f "%s@;=@;%a%a" x.pext_name.txt
- longident_loc li
+ (with_loc constr) li
(attributes ctxt) x.pext_attributes
and case_list ctxt f l : unit =
@@ -1710,7 +1830,7 @@ and directive_argument f x =
| Pdir_string (s) -> pp f "@ %S" s
| Pdir_int (n, None) -> pp f "@ %s" n
| Pdir_int (n, Some m) -> pp f "@ %s%c" n m
- | Pdir_ident (li) -> pp f "@ %a" longident li
+ | Pdir_ident (li) -> pp f "@ %a" value_longident li
| Pdir_bool (b) -> pp f "@ %s" (string_of_bool b)
let toplevel_phrase f x =
@@ -1760,8 +1880,10 @@ let signature_item = signature_item reset_ctxt
let binding = binding reset_ctxt
let payload = payload reset_ctxt
let case_list = case_list reset_ctxt
+let longident = value_longident
module Style = Misc.Style
+
(* merlin: moved from parse.ml *)
let prepare_error err =
let source = Location.Parser in
@@ -1793,30 +1915,30 @@ let prepare_error err =
Location.errorf ~source ~loc
"In this scoped type, variable %a \
is reserved for the local type %a."
- (Style.as_inline_code tyvar) var
+ (Style.as_inline_code Doc.tyvar) var
Style.inline_code var
| Other loc ->
Location.errorf ~source ~loc "Syntax error"
| Ill_formed_ast (loc, s) ->
- Location.errorf ~source ~loc
+ Location.errorf ~loc
"broken invariant in parsetree: %s" s
| Invalid_package_type (loc, ipt) ->
let invalid ppf ipt = match ipt with
| Syntaxerr.Parameterized_types ->
- Format.fprintf ppf "parametrized types are not supported"
+ Format_doc.fprintf ppf "parametrized types are not supported"
| Constrained_types ->
- Format.fprintf ppf "constrained types are not supported"
+ Format_doc.fprintf ppf "constrained types are not supported"
| Private_types ->
- Format.fprintf ppf "private types are not supported"
+ Format_doc.fprintf ppf "private types are not supported"
| Not_with_type ->
- Format.fprintf ppf "only %a constraints are supported"
+ Format_doc.fprintf ppf "only %a constraints are supported"
Style.inline_code "with type t ="
| Neither_identifier_nor_with_type ->
- Format.fprintf ppf
+ Format_doc.fprintf ppf
"only module type identifier and %a constraints are supported"
Style.inline_code "with type"
in
- Location.errorf ~source ~loc "invalid package type: %a" invalid ipt
+ Location.errorf ~source ~loc "Syntax error: invalid package type: %a" invalid ipt
| Removed_string_set loc ->
Location.errorf ~source ~loc
"Syntax error: strings are immutable, there is no assignment \
diff --git a/src/ocaml/parsing/pprintast.mli b/src/ocaml/parsing/pprintast.mli
index bf73501394..ae32930a66 100644
--- a/src/ocaml/parsing/pprintast.mli
+++ b/src/ocaml/parsing/pprintast.mli
@@ -24,6 +24,8 @@
type space_formatter = (unit, Format.formatter, unit) format
val longident : Format.formatter -> Longident.t -> unit
+val constr : Format.formatter -> Longident.t -> unit
+
val expression : Format.formatter -> Parsetree.expression -> unit
val string_of_expression : Parsetree.expression -> string
@@ -61,6 +63,24 @@ val tyvar: Format.formatter -> string -> unit
position, or for keywords by escaping them with \#. No-op on "_". *)
(* merlin *)
+type longindent_kind =
+| Constr (** variant constructors *)
+| Type (** core types, module types, class types, and classes *)
+| Other (** values and modules *)
+
val case_list : Format.formatter -> Parsetree.case list -> unit
val ident_of_name : Format.formatter -> string -> unit
-val needs_parens : string -> bool
+val needs_parens : kind:longindent_kind -> string -> bool
+
+
+(** {!Format_doc} functions for error messages *)
+module Doc:sig
+ val longident: Longident.t Format_doc.printer
+ val constr: Longident.t Format_doc.printer
+ val tyvar: string Format_doc.printer
+
+ (** Returns a format document if the expression reads nicely as the subject
+ of a sentence in a error message. *)
+ val nominal_exp : Parsetree.expression -> Format_doc.t option
+end
+
diff --git a/src/ocaml/parsing/printast.ml b/src/ocaml/parsing/printast.ml
index d7d569214e..552f2cb8fe 100644
--- a/src/ocaml/parsing/printast.ml
+++ b/src/ocaml/parsing/printast.ml
@@ -59,16 +59,6 @@ let fmt_char_option f = function
| None -> fprintf f "None"
| Some c -> fprintf f "Some %c" c
-let fmt_constant f x =
- match x with
- | Pconst_integer (i,m) -> fprintf f "PConst_int (%s,%a)" i fmt_char_option m;
- | Pconst_char (c) -> fprintf f "PConst_char %02x" (Char.code c)
- | Pconst_string (s, strloc, None) ->
- fprintf f "PConst_string(%S,%a,None)" s fmt_location strloc
- | Pconst_string (s, strloc, Some delim) ->
- fprintf f "PConst_string (%S,%a,Some %S)" s fmt_location strloc delim
- | Pconst_float (s,m) -> fprintf f "PConst_float (%s,%a)" s fmt_char_option m
-
let fmt_mutable_flag f x =
match x with
| Immutable -> fprintf f "Immutable"
@@ -108,6 +98,18 @@ let line i f s (*...*) =
fprintf f "%s" (String.make ((2*i) mod 72) ' ');
fprintf f s (*...*)
+let fmt_constant i f x =
+ line i f "constant %a\n" fmt_location x.pconst_loc;
+ let i = i+1 in
+ match x.pconst_desc with
+ | Pconst_integer (j,m) -> line i f "PConst_int (%s,%a)\n" j fmt_char_option m
+ | Pconst_char c -> line i f "PConst_char %02x\n" (Char.code c)
+ | Pconst_string (s, strloc, None) ->
+ line i f "PConst_string(%S,%a,None)\n" s fmt_location strloc
+ | Pconst_string (s, strloc, Some delim) ->
+ line i f "PConst_string (%S,%a,Some %S)\n" s fmt_location strloc delim
+ | Pconst_float (s,m) -> line i f "PConst_float (%s,%a)\n" s fmt_char_option m
+
let list i f ppf l =
match l with
| [] -> line i ppf "[]\n"
@@ -204,9 +206,13 @@ and pattern i ppf x =
| Ppat_alias (p, s) ->
line i ppf "Ppat_alias %a\n" fmt_string_loc s;
pattern i ppf p;
- | Ppat_constant (c) -> line i ppf "Ppat_constant %a\n" fmt_constant c;
+ | Ppat_constant (c) ->
+ line i ppf "Ppat_constant\n";
+ fmt_constant i ppf c;
| Ppat_interval (c1, c2) ->
- line i ppf "Ppat_interval %a..%a\n" fmt_constant c1 fmt_constant c2;
+ line i ppf "Ppat_interval\n";
+ fmt_constant i ppf c1;
+ fmt_constant i ppf c2;
| Ppat_tuple (l) ->
line i ppf "Ppat_tuple\n";
list i pattern ppf l;
@@ -245,6 +251,10 @@ and pattern i ppf x =
| Ppat_exception p ->
line i ppf "Ppat_exception\n";
pattern i ppf p
+ | Ppat_effect(p1, p2) ->
+ line i ppf "Ppat_effect\n";
+ pattern i ppf p1;
+ pattern i ppf p2
| Ppat_open (m,p) ->
line i ppf "Ppat_open \"%a\"\n" fmt_longident_loc m;
pattern i ppf p
@@ -258,7 +268,9 @@ and expression i ppf x =
let i = i+1 in
match x.pexp_desc with
| Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident_loc li;
- | Pexp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c;
+ | Pexp_constant (c) ->
+ line i ppf "Pexp_constant\n";
+ fmt_constant i ppf c;
| Pexp_let (rf, l, e) ->
line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
list i value_binding ppf l;
diff --git a/src/ocaml/parsing/unit_info.ml b/src/ocaml/parsing/unit_info.ml
index 03e8d44949..87c8ae8318 100644
--- a/src/ocaml/parsing/unit_info.ml
+++ b/src/ocaml/parsing/unit_info.ml
@@ -13,18 +13,24 @@
(* *)
(**************************************************************************)
+type intf_or_impl = Intf | Impl
type modname = string
type filename = string
type file_prefix = string
+type error = Invalid_encoding of string
+exception Error of error
+
type t = {
source_file: filename;
prefix: file_prefix;
modname: modname;
+ kind: intf_or_impl;
}
let source_file (x: t) = x.source_file
let modname (x: t) = x.modname
+let kind (x: t) = x.kind
let prefix (x: t) = x.prefix
let basename_chop_extensions basename =
@@ -32,37 +38,38 @@ let basename_chop_extensions basename =
| dot_pos -> String.sub basename 0 dot_pos
| exception Not_found -> basename
-let modulize s = String.capitalize_ascii s
+let strict_modulize s =
+ match Misc.Utf8_lexeme.capitalize s with
+ | Ok x -> x
+ | Error _ -> raise (Error (Invalid_encoding s))
+
+let modulize s = match Misc.Utf8_lexeme.capitalize s with Ok x | Error x -> x
-(* We re-export the [Misc] definition *)
-let normalize = Misc.normalized_unit_filename
+(* We re-export the [Misc] definition, and ignore encoding errors under the
+ assumption that we should focus our effort on not *producing* badly encoded
+ module names *)
+let normalize x = Misc.normalized_unit_filename x
-let modname_from_source source_file =
- source_file |> Filename.basename |> basename_chop_extensions |> modulize
+let stem source_file =
+ source_file |> Filename.basename |> basename_chop_extensions
-let start_char = function
- | 'A' .. 'Z' -> true
- | _ -> false
+let strict_modname_from_source source_file =
+ source_file |> stem |> strict_modulize
-let is_identchar_latin1 = function
- | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246'
- | '\248'..'\255' | '\'' | '0'..'9' -> true
- | _ -> false
+let lax_modname_from_source source_file =
+ source_file |> stem |> modulize
(* Check validity of module name *)
-let is_unit_name name =
- String.length name > 0
- && start_char name.[0]
- && String.for_all is_identchar_latin1 name
+let is_unit_name name = Misc.Utf8_lexeme.is_valid_identifier name
let check_unit_name file =
if not (is_unit_name (modname file)) then
Location.prerr_warning (Location.in_file (source_file file))
(Warnings.Bad_module_name (modname file))
-let make ?(check_modname=true) ~source_file prefix =
- let modname = modname_from_source prefix in
- let p = { modname; prefix; source_file } in
+let make ?(check_modname=true) ~source_file kind prefix =
+ let modname = strict_modname_from_source prefix in
+ let p = { modname; prefix; source_file; kind } in
if check_modname then check_unit_name p;
p
@@ -79,7 +86,7 @@ module Artifact = struct
let prefix x = Filename.remove_extension (filename x)
let from_filename filename =
- let modname = modname_from_source filename in
+ let modname = lax_modname_from_source filename in
{ modname; filename; source_file = None }
end
@@ -120,3 +127,14 @@ let find_normalized_cmi f =
let filename = modname f ^ ".cmi" in
let filename = Load_path.find_normalized filename in
{ Artifact.filename; modname = modname f; source_file = Some f.source_file }
+
+let report_error = function
+ | Invalid_encoding name ->
+ Location.errorf "Invalid encoding of output name: %s." name
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err -> Some (report_error err)
+ | _ -> None
+ )
diff --git a/src/ocaml/parsing/unit_info.mli b/src/ocaml/parsing/unit_info.mli
index 466a07a228..04002b2520 100644
--- a/src/ocaml/parsing/unit_info.mli
+++ b/src/ocaml/parsing/unit_info.mli
@@ -21,24 +21,32 @@
(** {1:modname_from_strings Module name convention and computation} *)
+type intf_or_impl = Intf | Impl
type modname = string
type filename = string
type file_prefix = string
+type error = Invalid_encoding of filename
+exception Error of error
+
(** [modulize s] capitalizes the first letter of [s]. *)
val modulize: string -> modname
(** [normalize s] uncapitalizes the first letter of [s]. *)
val normalize: string -> string
-(** [modname_from_source filename] is [modulize stem] where [stem] is the
+(** [lax_modname_from_source filename] is [modulize stem] where [stem] is the
basename of the filename [filename] stripped from all its extensions.
For instance, [modname_from_source "/pa.th/x.ml.pp"] is ["X"]. *)
-val modname_from_source: filename -> modname
+val lax_modname_from_source: filename -> modname
+
+(** Same as {!lax_modname_from_source} but raises an {!error.Invalid_encoding}
+ error on filename with invalid utf8 encoding. *)
+val strict_modname_from_source: filename -> modname
(** {2:module_name_validation Module name validation function}*)
-(** [is_unit_name ~strict name] is true only if [name] can be used as a
+(** [is_unit_name name] is true only if [name] can be used as a
valid module name. *)
val is_unit_name : modname -> bool
@@ -67,19 +75,24 @@ val prefix: t -> file_prefix
or compilation artifact.*)
val modname: t -> modname
+(** [kind u] is the kind (interface or implementation) of the unit. *)
+val kind: t -> intf_or_impl
+
(** [check_unit_name u] prints a warning if the derived module name [modname u]
should not be used as a module name as specified
by {!is_unit_name}[ ~strict:true]. *)
val check_unit_name : t -> unit
-(** [make ~check ~source_file prefix] associates both the
+(** [make ~check ~source_file kind prefix] associates both the
[source_file] and the module name {!modname_from_source}[ target_prefix] to
the prefix filesystem path [prefix].
If [check_modname=true], this function emits a warning if the derived module
name is not valid according to {!check_unit_name}.
*)
-val make: ?check_modname:bool -> source_file:filename -> file_prefix -> t
+val make:
+ ?check_modname:bool -> source_file:filename ->
+ intf_or_impl -> file_prefix -> t
(** {1:artifact_function Build artifacts }*)
module Artifact: sig
diff --git a/src/ocaml/preprocess/lexer_raw.mli b/src/ocaml/preprocess/lexer_raw.mli
index 67965e90ae..3942ee7e98 100644
--- a/src/ocaml/preprocess/lexer_raw.mli
+++ b/src/ocaml/preprocess/lexer_raw.mli
@@ -22,7 +22,14 @@ type error =
| Unterminated_string_in_comment of Location.t * Location.t
| Empty_character_literal
| Keyword_as_label of string
+ | Capitalized_label of string
| Invalid_literal of string
+ | Invalid_directive of string * string option
+ | Invalid_encoding of string
+ | Invalid_char_in_ident of Uchar.t
+ | Non_lowercase_delimiter of string
+ | Capitalized_raw_identifier of string
+ | Unknown_keyword of string
exception Error of error * Location.t
(* Keywords, manipulated by extensions *)
diff --git a/src/ocaml/preprocess/lexer_raw.mll b/src/ocaml/preprocess/lexer_raw.mll
index d80597c833..d5f7feb434 100644
--- a/src/ocaml/preprocess/lexer_raw.mll
+++ b/src/ocaml/preprocess/lexer_raw.mll
@@ -29,7 +29,14 @@ type error =
| Unterminated_string_in_comment of Location.t * Location.t
| Empty_character_literal
| Keyword_as_label of string
+ | Capitalized_label of string
| Invalid_literal of string
+ | Invalid_directive of string * string option
+ | Invalid_encoding of string
+ | Invalid_char_in_ident of Uchar.t
+ | Non_lowercase_delimiter of string
+ | Capitalized_raw_identifier of string
+ | Unknown_keyword of string
exception Error of error * Location.t
@@ -51,6 +58,9 @@ let rec (>>=) (m : 'a result) (f : 'a -> 'b result) : 'b result =
Refill (fun () -> u () >>= f)
| Fail _ as e -> e
+let (let*) = (>>=)
+let (let+) = fun m f -> (>>=) m (fun x -> return (f x))
+
type preprocessor = (Lexing.lexbuf -> Parser_raw.token) -> Lexing.lexbuf -> Parser_raw.token
type state = {
@@ -79,68 +89,97 @@ let rec catch m f = match m with
(* The table of keywords *)
-let keyword_table : keywords =
- create_hashtable 149 [
- "and", AND;
- "as", AS;
- "assert", ASSERT;
- "begin", BEGIN;
- "class", CLASS;
- "constraint", CONSTRAINT;
- "do", DO;
- "done", DONE;
- "downto", DOWNTO;
- "else", ELSE;
- "end", END;
- "exception", EXCEPTION;
- "external", EXTERNAL;
- "false", FALSE;
- "for", FOR;
- "fun", FUN;
- "function", FUNCTION;
- "functor", FUNCTOR;
- "if", IF;
- "in", IN;
- "include", INCLUDE;
- "inherit", INHERIT;
- "initializer", INITIALIZER;
- "lazy", LAZY;
- "let", LET;
- "match", MATCH;
- "method", METHOD;
- "module", MODULE;
- "mutable", MUTABLE;
- "new", NEW;
- "nonrec", NONREC;
- "object", OBJECT;
- "of", OF;
- "open", OPEN;
- "or", OR;
+let all_keywords =
+ let v5_3 = Some (5,3) in
+ let v1_0 = Some (1,0) in
+ let v1_6 = Some (1,6) in
+ let v4_2 = Some (4,2) in
+ let always = None in
+ [
+ "and", AND, always;
+ "as", AS, always;
+ "assert", ASSERT, v1_6;
+ "begin", BEGIN, always;
+ "class", CLASS, v1_0;
+ "constraint", CONSTRAINT, v1_0;
+ "do", DO, always;
+ "done", DONE, always;
+ "downto", DOWNTO, always;
+ "effect", EFFECT, v5_3;
+ "else", ELSE, always;
+ "end", END, always;
+ "exception", EXCEPTION, always;
+ "external", EXTERNAL, always;
+ "false", FALSE, always;
+ "for", FOR, always;
+ "fun", FUN, always;
+ "function", FUNCTION, always;
+ "functor", FUNCTOR, always;
+ "if", IF, always;
+ "in", IN, always;
+ "include", INCLUDE, always;
+ "inherit", INHERIT, v1_0;
+ "initializer", INITIALIZER, v1_0;
+ "lazy", LAZY, v1_6;
+ "let", LET, always;
+ "match", MATCH, always;
+ "method", METHOD, v1_0;
+ "module", MODULE, always;
+ "mutable", MUTABLE, always;
+ "new", NEW, v1_0;
+ "nonrec", NONREC, v4_2;
+ "object", OBJECT, v1_0;
+ "of", OF, always;
+ "open", OPEN, always;
+ "or", OR, always;
(* "parser", PARSER; *)
- "private", PRIVATE;
- "rec", REC;
- "sig", SIG;
- "struct", STRUCT;
- "then", THEN;
- "to", TO;
- "true", TRUE;
- "try", TRY;
- "type", TYPE;
- "val", VAL;
- "virtual", VIRTUAL;
- "when", WHEN;
- "while", WHILE;
- "with", WITH;
-
- "lor", INFIXOP3("lor"); (* Should be INFIXOP2 *)
- "lxor", INFIXOP3("lxor"); (* Should be INFIXOP2 *)
- "mod", INFIXOP3("mod");
- "land", INFIXOP3("land");
- "lsl", INFIXOP4("lsl");
- "lsr", INFIXOP4("lsr");
- "asr", INFIXOP4("asr");
+ "private", PRIVATE, v1_0;
+ "rec", REC, always;
+ "sig", SIG, always;
+ "struct", STRUCT, always;
+ "then", THEN, always;
+ "to", TO, always;
+ "true", TRUE, always;
+ "try", TRY, always;
+ "type", TYPE, always;
+ "val", VAL, always;
+ "virtual", VIRTUAL, v1_0;
+ "when", WHEN, always;
+ "while", WHILE, always;
+ "with", WITH, always;
+
+ "lor", INFIXOP3("lor"), always; (* Should be INFIXOP2 *)
+ "lxor", INFIXOP3("lxor"), always; (* Should be INFIXOP2 *)
+ "mod", INFIXOP3("mod"), always;
+ "land", INFIXOP3("land"), always;
+ "lsl", INFIXOP4("lsl"), always;
+ "lsr", INFIXOP4("lsr"), always;
+ "asr", INFIXOP4("asr"), always
]
+let keyword_table = Hashtbl.create 149
+
+let populate_keywords (version,keywords) =
+ let greater (x:(int*int) option) (y:(int*int) option) =
+ match x, y with
+ | None, _ | _, None -> true
+ | Some x, Some y -> x >= y
+ in
+ let tbl = keyword_table in
+ Hashtbl.clear tbl;
+ let add_keyword (name, token, since) =
+ if greater version since then Hashtbl.replace tbl name (Some token)
+ in
+ List.iter ~f:add_keyword all_keywords;
+ List.iter ~f:(fun name ->
+ match List.find ~f:(fun (n,_,_) -> n = name) all_keywords with
+ | (_,tok,_) -> Hashtbl.replace tbl name (Some tok)
+ | exception Not_found -> Hashtbl.replace tbl name None
+ ) keywords
+
+(* FIXME: Merlin: this could be made configurable *)
+let () = populate_keywords (None,[])
+
let keywords l = create_hashtable 11 l
let list_keywords =
@@ -150,8 +189,11 @@ let list_keywords =
Hashtbl.fold add_kw keywords init
let store_string_char buf c = Buffer.add_char buf c
+let store_string_utf_8_uchar buf u = Buffer.add_utf_8_uchar buf u
+let store_string buf s = Buffer.add_string buf s
let store_substring buf s ~pos ~len = Buffer.add_substring buf s pos len
+let store_lexeme buf lexbuf = store_string buf (Lexing.lexeme lexbuf)
let store_normalized_newline buf newline =
(* #12502: we normalize "\r\n" to "\n" at lexing time,
to avoid behavior difference due to OS-specific
@@ -180,13 +222,18 @@ let store_normalized_newline buf newline =
(* To store the position of the beginning of a string and comment *)
let in_comment state = state.comment_start_loc <> []
+let print_warnings = ref true
(* Escaped chars are interpreted in strings unless they are in comments. *)
-let store_escaped_uchar state lexbuf u =
+let store_escaped_char state lexbuf c =
if in_comment state
- then Buffer.add_string state.buffer (Lexing.lexeme lexbuf)
- else Buffer.add_utf_8_uchar state.buffer u
+ then store_lexeme state.buffer lexbuf
+ else store_string_char state.buffer c
+let store_escaped_uchar state lexbuf u =
+ if in_comment state
+ then store_lexeme state.buffer lexbuf
+ else store_string_utf_8_uchar state.buffer u
let compute_quoted_string_idloc {Location.loc_start = orig_loc; _ } shift id =
let id_start_pos = orig_loc.Lexing.pos_cnum + shift in
@@ -213,6 +260,16 @@ let wrap_string_lexer f state lexbuf =
state.string_start_loc <- Location.none;
return (Buffer.contents state.buffer, loc)
+let wrap_comment_lexer state comment lexbuf =
+ let start_loc = Location.curr lexbuf in
+ state.comment_start_loc <- [start_loc];
+ Buffer.reset state.buffer;
+ let+ end_loc = comment state lexbuf in
+ let s = Buffer.contents state.buffer in
+ Buffer.reset state.buffer;
+ s,
+ { start_loc with Location.loc_end = end_loc.Location.loc_end }
+
(* to translate escape sequences *)
let digit_value c =
@@ -286,17 +343,65 @@ let uchar_for_uchar_escape lexbuf =
illegal_escape lexbuf
(Printf.sprintf "%X is not a Unicode scalar value" cp)
+let validate_encoding lexbuf raw_name =
+ match Utf8_lexeme.normalize raw_name with
+ | Error _ -> fail lexbuf (Invalid_encoding raw_name)
+ | Ok name -> return name
+
+let ident_for_extended lexbuf raw_name =
+ let* name = validate_encoding lexbuf raw_name in
+ match Utf8_lexeme.validate_identifier name with
+ | Utf8_lexeme.Valid -> return name
+ | Utf8_lexeme.Invalid_character u -> fail lexbuf (Invalid_char_in_ident u)
+ | Utf8_lexeme.Invalid_beginning _ ->
+ assert false (* excluded by the regexps *)
+
+let validate_delim lexbuf raw_name =
+ let* name = validate_encoding lexbuf raw_name in
+ if Utf8_lexeme.is_lowercase name then return name
+ else fail lexbuf (Non_lowercase_delimiter name)
+
+let validate_ext lexbuf name =
+ let* name = validate_encoding lexbuf name in
+ match Utf8_lexeme.validate_identifier ~with_dot:true name with
+ | Utf8_lexeme.Valid -> return name
+ | Utf8_lexeme.Invalid_character u -> fail lexbuf (Invalid_char_in_ident u)
+ | Utf8_lexeme.Invalid_beginning _ ->
+ assert false (* excluded by the regexps *)
+
+let lax_delim raw_name =
+ match Utf8_lexeme.normalize raw_name with
+ | Error _ -> None
+ | Ok name ->
+ if Utf8_lexeme.is_lowercase name then Some name
+ else None
+
let keyword_or state s default =
try Hashtbl.find state.keywords s
- with Not_found -> try Hashtbl.find keyword_table s
- with Not_found -> default
+ with Not_found ->
+ try Option.value ~default @@ Hashtbl.find keyword_table s
+ with Not_found -> default
+
+let is_keyword name =
+ Hashtbl.mem keyword_table name
-let is_keyword name = Hashtbl.mem keyword_table name
let () = Lexer.is_keyword_ref := is_keyword
-let check_label_name lexbuf name =
- if is_keyword name
- then fail lexbuf (Keyword_as_label name)
+let find_keyword lexbuf name default =
+ match Hashtbl.find keyword_table name with
+ | Some x -> return x
+ | None -> fail lexbuf (Unknown_keyword name)
+ | exception Not_found -> return default
+
+let find_keyword state lexbuf ~name ~default =
+ try return @@ Hashtbl.find state.keywords name
+ with Not_found -> find_keyword lexbuf name default
+
+let check_label_name ?(raw_escape=false) lexbuf name =
+ if Utf8_lexeme.is_capitalized name then
+ fail lexbuf (Capitalized_label name)
+ else if not raw_escape && is_keyword name then
+ fail lexbuf (Keyword_as_label name)
else return name
(* Update the current location with file name and line number. *)
@@ -314,15 +419,13 @@ let update_loc lexbuf _file line absolute chars =
pos_bol = pos.pos_cnum - chars;
}
-(* Warn about Latin-1 characters used in idents *)
-let warn_latin1 lexbuf =
- Location.deprecated (Location.curr lexbuf)
- "ISO-Latin1 characters in identifiers"
+(* TODO Merlin should we support this ?*)
+let handle_docstrings = ref false
(* Error report *)
-open Format
+open Format_doc
let prepare_error loc = function
| Illegal_character c ->
@@ -356,8 +459,36 @@ let prepare_error loc = function
| Keyword_as_label kwd ->
Location.errorf ~loc
"%a is a keyword, it cannot be used as label name" Style.inline_code kwd
+ | Capitalized_label lbl ->
+ Location.errorf ~loc
+ "%a cannot be used as label name, \
+ it must start with a lowercase letter" Style.inline_code lbl
| Invalid_literal s ->
Location.errorf ~loc "Invalid literal %s" s
+ | Invalid_directive (dir, explanation) ->
+ Location.errorf ~loc "Invalid lexer directive %S%t" dir
+ (fun ppf -> match explanation with
+ | None -> ()
+ | Some expl -> fprintf ppf ": %s" expl)
+ | Invalid_encoding s ->
+ Location.errorf ~loc "Invalid encoding of identifier %s." s
+ | Invalid_char_in_ident u ->
+ Location.errorf ~loc "Invalid character U+%X in identifier"
+ (Uchar.to_int u)
+ | Capitalized_raw_identifier lbl ->
+ Location.errorf ~loc
+ "%a cannot be used as a raw identifier, \
+ it must start with a lowercase letter" Style.inline_code lbl
+ | Non_lowercase_delimiter name ->
+ Location.errorf ~loc
+ "%a cannot be used as a quoted string delimiter,@ \
+ it must contain only lowercase letters."
+ Style.inline_code name
+ | Unknown_keyword name ->
+ Location.errorf ~loc
+ "%a has been defined as an additional keyword.@ \
+ This version of OCaml does not support this keyword."
+ Style.inline_code name
(* FIXME: Invalid_directive? *)
let () =
@@ -375,14 +506,26 @@ let newline = ('\013'* '\010')
let blank = [' ' '\009' '\012']
let lowercase = ['a'-'z' '_']
let uppercase = ['A'-'Z']
-let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9' '\128'-'\255']
+let identstart = lowercase | uppercase
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
+let utf8 = ['\192'-'\255'] ['\128'-'\191']*
+let identstart_ext = identstart | utf8
+let identchar_ext = identchar | utf8
+let delim_ext = (lowercase | uppercase | utf8)*
+(* ascii uppercase letters in quoted string delimiters ({delim||delim}) are
+ rejected by the delimiter validation function, we accept them temporarily to
+ have the same error message for ascii and non-ascii uppercase letters *)
+
+(* TODO REMOVE *)
let lowercase_latin1 = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
let uppercase_latin1 = ['A'-'Z' '\192'-'\214' '\216'-'\222']
let identchar_latin1 = identchar
(*['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']*)
+(* END TODO REMOVE *)
+
let symbolchar =
['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
-let symbolcharnopercent =
+let symbolcharnopercent = (* TODO ???? *)
['!' '$' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
let dotsymbolchar =
['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|']
@@ -392,6 +535,7 @@ let kwdopchar =
['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|']
let ident = (lowercase | uppercase) identchar*
+let ident_ext = identstart_ext identchar_ext*
let extattrident = ident ('.' ident)*
let decimal_literal =
@@ -438,11 +582,11 @@ rule token state = parse
| blank +
{ token state lexbuf }
| ".<"
- { return DOTLESS }
+ { return METAOCAML_BRACKET_OPEN }
| ">."
{ return (keyword_or state (Lexing.lexeme lexbuf) (INFIXOP0 ">.")) }
| ".~"
- { return (keyword_or state (Lexing.lexeme lexbuf) DOTTILDE) }
+ { return (keyword_or state (Lexing.lexeme lexbuf) METAOCAML_ESCAPE) }
| "_"
{ return UNDERSCORE }
| "~"
@@ -452,40 +596,36 @@ rule token state = parse
{ fail lexbuf
(Reserved_sequence (".~", Some "is reserved for use in MetaOCaml")) }
*)
- | "~" raw_ident_escape (lowercase identchar * as name) ':'
- { return (LABEL name) }
- | "~" (lowercase identchar * as name) ':'
+ | "~" (identstart identchar * as name) ':'
{ lABEL (check_label_name lexbuf name) }
- | "~" (lowercase_latin1 identchar_latin1 * as name) ':'
- { warn_latin1 lexbuf;
- return (LABEL name) }
+ | "~" (raw_ident_escape? as escape) (ident_ext as raw_name) ':'
+ { ident_for_extended lexbuf raw_name
+ >>= check_label_name ~raw_escape:(escape<>"") lexbuf
+ |> lABEL }
| "?"
{ return QUESTION }
- | "?" raw_ident_escape (lowercase identchar * as name) ':'
- { return (OPTLABEL name) }
| "?" (lowercase identchar * as name) ':'
{ oPTLABEL (check_label_name lexbuf name) }
- | "?" (lowercase_latin1 identchar_latin1 * as name) ':'
- { warn_latin1 lexbuf; return (OPTLABEL name) }
- | raw_ident_escape (lowercase identchar * as name)
- { return (LIDENT name) }
+ | "?" (raw_ident_escape? as escape) (ident_ext as raw_name) ':'
+ { ident_for_extended lexbuf raw_name
+ >>= check_label_name ~raw_escape:(escape<>"") lexbuf
+ |> oPTLABEL }
+ (* | raw_ident_escape (lowercase identchar * as name)
+ { return (LIDENT name) } *)
| lowercase identchar * as name
- { return (try Hashtbl.find state.keywords name
- with Not_found ->
- try Hashtbl.find keyword_table name
- with Not_found ->
- LIDENT name) }
- | lowercase_latin1 identchar_latin1 * as name
- { warn_latin1 lexbuf; return (LIDENT name) }
+ { (find_keyword state lexbuf ~name ~default:(LIDENT name)) }
| uppercase identchar * as name
{ (* Capitalized keywords for OUnit *)
- return (try Hashtbl.find state.keywords name
- with Not_found ->
- try Hashtbl.find keyword_table name
- with Not_found ->
- UIDENT name) }
- | uppercase_latin1 identchar_latin1 * as name
- { warn_latin1 lexbuf; return (UIDENT name) }
+ (find_keyword state lexbuf ~name ~default:(UIDENT name))}
+ | (raw_ident_escape? as escape) (ident_ext as raw_name)
+ { let* name = ident_for_extended lexbuf raw_name in
+ if Utf8_lexeme.is_capitalized name then begin
+ if escape="" then return (UIDENT name)
+ else return (UIDENT name)
+ (* we don't have capitalized keywords, and thus no needs for
+ capitalized raw identifiers. *)
+ (*fail lexbuf (Capitalized_raw_identifier name)*)
+ end else return (LIDENT name) }
| int_literal as lit { return (INT (lit, None)) }
| (int_literal as lit) (literal_modifier as modif)
{ return (INT (lit, Some modif)) }
@@ -498,37 +638,36 @@ rule token state = parse
| "\""
{ wrap_string_lexer string state lexbuf >>= fun (str, loc) ->
return (STRING (str, loc, None)) }
- | "\'\'"
- { wrap_string_lexer string state lexbuf >>= fun (str, loc) ->
- return (STRING (str, loc, None)) }
- | "{" (lowercase* as delim) "|"
- { wrap_string_lexer (quoted_string delim) state lexbuf
- >>= fun (str, loc) ->
- return (STRING (str, loc, Some delim)) }
- | "{%" (extattrident as id) "|"
+ | "{" (delim_ext as raw_name) '|'
+ { let* delim = validate_delim lexbuf raw_name in
+ let+ s, loc = wrap_string_lexer (quoted_string delim) state lexbuf in
+ STRING (s, loc, Some delim) }
+ | "{%" (extattrident as raw_id) "|"
{ let orig_loc = Location.curr lexbuf in
- wrap_string_lexer (quoted_string "") state lexbuf
- >>= fun (str, loc) ->
+ let* id = validate_ext lexbuf raw_id in
+ let+ s, loc =wrap_string_lexer (quoted_string "") state lexbuf in
let idloc = compute_quoted_string_idloc orig_loc 2 id in
- return (QUOTED_STRING_EXPR (id, idloc, str, loc, Some "")) }
- | "{%" (extattrident as id) blank+ (lowercase* as delim) "|"
+ QUOTED_STRING_EXPR (id, idloc, s, loc, Some "") }
+ | "{%" (extattrident as raw_id) blank+ (delim_ext as raw_delim) "|"
{ let orig_loc = Location.curr lexbuf in
- wrap_string_lexer (quoted_string delim) state lexbuf
- >>= fun (str, loc) ->
+ let* id = validate_ext lexbuf raw_id in
+ let* delim = validate_delim lexbuf raw_delim in
+ let+ s, loc = wrap_string_lexer (quoted_string delim) state lexbuf in
let idloc = compute_quoted_string_idloc orig_loc 2 id in
- return (QUOTED_STRING_EXPR (id, idloc, str, loc, Some delim)) }
- | "{%%" (extattrident as id) "|"
+ QUOTED_STRING_EXPR (id, idloc, s, loc, Some delim) }
+ | "{%%" (extattrident as raw_id) "|"
{ let orig_loc = Location.curr lexbuf in
- wrap_string_lexer (quoted_string "") state lexbuf
- >>= fun (str, loc) ->
+ let* id = validate_ext lexbuf raw_id in
+ let+ s, loc = wrap_string_lexer (quoted_string "") state lexbuf in
let idloc = compute_quoted_string_idloc orig_loc 3 id in
- return (QUOTED_STRING_ITEM (id, idloc, str, loc, Some "")) }
- | "{%%" (extattrident as id) blank+ (lowercase* as delim) "|"
+ QUOTED_STRING_ITEM (id, idloc, s, loc, Some "") }
+ | "{%%" (extattrident as raw_id) blank+ (delim_ext as raw_delim) "|"
{ let orig_loc = Location.curr lexbuf in
- wrap_string_lexer (quoted_string delim) state lexbuf
- >>= fun (str, loc) ->
+ let* id = validate_ext lexbuf raw_id in
+ let* delim = validate_delim lexbuf raw_delim in
+ let+ s, loc = wrap_string_lexer (quoted_string delim) state lexbuf in
let idloc = compute_quoted_string_idloc orig_loc 3 id in
- return (QUOTED_STRING_ITEM (id, idloc, str, loc, Some delim)) }
+ QUOTED_STRING_ITEM (id, idloc, s, loc, Some delim) }
| "\'" newline "\'"
{ update_loc lexbuf None 1 false 1;
(* newline is ('\013'* '\010') *)
@@ -537,34 +676,45 @@ rule token state = parse
{ return (CHAR c) }
| "\'\\" (['\\' '\'' '\"' 'n' 't' 'b' 'r' ' '] as c) "\'"
{ return (CHAR (char_for_backslash c)) }
- | "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'"
- { char_for_octal_code state lexbuf 3 >>= fun c -> return (CHAR c) }
| "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'"
{ char_for_decimal_code state lexbuf 2 >>= fun c -> return (CHAR c) }
+ | "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'"
+ { char_for_octal_code state lexbuf 3 >>= fun c -> return (CHAR c) }
| "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'"
{ return (CHAR (char_for_hexadecimal_code lexbuf 3)) }
| "\'" ("\\" [^ '#'] as esc)
{ fail lexbuf (Illegal_escape (esc, None)) }
| "(*"
- { let start_loc = Location.curr lexbuf in
- state.comment_start_loc <- [start_loc];
- Buffer.reset state.buffer;
- comment state lexbuf >>= fun end_loc ->
- let s = Buffer.contents state.buffer in
- Buffer.reset state.buffer;
- return (COMMENT (s, { start_loc with
- Location.loc_end = end_loc.Location.loc_end }))
+ { let+ s, loc = wrap_comment_lexer state comment lexbuf in
+ COMMENT (s, loc) }
+ | "(**"
+ { let+ s, loc = wrap_comment_lexer state comment lexbuf in
+ if !handle_docstrings then
+ DOCSTRING (Docstrings.docstring s loc)
+ else
+ COMMENT ("*" ^ s, loc)
}
+ | "(**" (('*'+) as stars)
+ { let+ s, loc =
+ wrap_comment_lexer
+ state
+ (fun state lexbuf ->
+ store_string state.buffer ("*" ^ stars);
+ comment state lexbuf)
+ lexbuf
+ in
+ COMMENT (s, loc) }
| "(*)"
- { let loc = Location.curr lexbuf in
- Location.prerr_warning loc Warnings.Comment_start;
- state.comment_start_loc <- [loc];
- Buffer.reset state.buffer;
- comment state lexbuf >>= fun end_loc ->
- let s = Buffer.contents state.buffer in
- Buffer.reset state.buffer;
- return (COMMENT (s, { loc with Location.loc_end = end_loc.Location.loc_end }))
- }
+ { if !print_warnings then
+ Location.prerr_warning (Location.curr lexbuf) Warnings.Comment_start;
+ let+ s, loc = wrap_comment_lexer state comment lexbuf in
+ COMMENT (s, loc) }
+ | "(*" (('*'*) as stars) "*)"
+ { if !handle_docstrings && stars="" then
+ (* (**) is an empty docstring *)
+ return (DOCSTRING(Docstrings.docstring "" (Location.curr lexbuf)))
+ else
+ return (COMMENT (stars, Location.curr lexbuf)) }
| "*)"
{ let loc = Location.curr lexbuf in
Location.prerr_warning loc Warnings.Comment_not_end;
@@ -573,13 +723,12 @@ rule token state = parse
lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 };
return STAR
}
- | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
- ("\"" ([^ '\010' '\013' '\"' ] * as name) "\"")?
- [^ '\010' '\013'] * newline
- { update_loc lexbuf name (int_of_string num) true 0;
- token state lexbuf
+ | "#"
+ { let at_beginning_of_line pos = (pos.pos_cnum = pos.pos_bol) in
+ if not (at_beginning_of_line lexbuf.lex_start_p)
+ then return HASH
+ else try directive state lexbuf with Failure _ -> return HASH
}
- | "#" { return HASH }
| "&" { return AMPERSAND }
| "&&" { return AMPERAMPER }
| "`" { return BACKQUOTE }
@@ -632,7 +781,7 @@ rule token state = parse
{ return (PREFIXOP op) }
| ['~' '?'] symbolchar_or_hash + as op
{ return (PREFIXOP op) }
- | ['=' '<' '|' '&' '$' '>'] symbolchar * as op
+ | ['=' '<' '>' '|' '&' '$'] symbolchar * as op
{ return (keyword_or state op
(INFIXOP0 op)) }
| ['@' '^'] symbolchar * as op
@@ -657,18 +806,35 @@ rule token state = parse
| _ as illegal_char
{ fail lexbuf (Illegal_character illegal_char) }
+and directive state = parse
+ | ([' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
+ ("\"" ([^ '\010' '\013' '\"' ] * as name) "\"") as directive)
+ [^ '\010' '\013'] *
+ {
+ match int_of_string num with
+ | exception _ ->
+ (* PR#7165 *)
+ let explanation = "line number out of range" in
+ fail lexbuf (Invalid_directive ("#" ^ directive, Some explanation))
+ | line_num ->
+ (* Documentation says that the line number should be
+ positive, but we have never guarded against this and it
+ might have useful hackish uses. *)
+ update_loc lexbuf (Some name) (line_num - 1) true 0;
+ token state lexbuf
+ }
and comment state = parse
"(*"
{ state.comment_start_loc <- (Location.curr lexbuf) :: state.comment_start_loc;
- Buffer.add_string state.buffer (Lexing.lexeme lexbuf);
- comment state lexbuf
- }
+ store_lexeme state.buffer lexbuf;
+ comment state lexbuf
+ }
| "*)"
{ match state.comment_start_loc with
| [] -> assert false
| [_] -> state.comment_start_loc <- []; return (Location.curr lexbuf)
| _ :: l -> state.comment_start_loc <- l;
- Buffer.add_string state.buffer (Lexing.lexeme lexbuf);
+ store_lexeme state.buffer lexbuf;
comment state lexbuf
}
| "\""
@@ -689,35 +855,37 @@ and comment state = parse
| e -> fail_loc e l
)
) >>= fun _loc ->
- state.string_start_loc <- Location.none;
- Buffer.add_string buffer (String.escaped (Buffer.contents state.buffer));
- state.buffer <- buffer;
- Buffer.add_char state.buffer '\"';
- comment state lexbuf }
- | "{" ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
- {
- state.string_start_loc <- Location.curr lexbuf;
- Buffer.add_string state.buffer (Lexing.lexeme lexbuf);
- (catch (quoted_string delim state lexbuf) (fun e l -> match e with
- | Unterminated_string ->
- begin match state.comment_start_loc with
- | [] -> assert false
- | loc :: _ ->
- let start = List.hd (List.rev state.comment_start_loc) in
- state.comment_start_loc <- [];
- fail_loc (Unterminated_string_in_comment (start, l)) loc
- end
- | e -> fail_loc e l
- )
- ) >>= fun _loc ->
state.string_start_loc <- Location.none;
- Buffer.add_char state.buffer '|';
- Buffer.add_string state.buffer delim;
- Buffer.add_char state.buffer '}';
+ Buffer.add_string buffer (String.escaped (Buffer.contents state.buffer));
+ state.buffer <- buffer;
+ store_string_char state.buffer '\"';
comment state lexbuf }
+ | "{" ('%' '%'? extattrident blank*)? (delim_ext as raw_delim) "|"
+ { match lax_delim raw_delim with
+ | None -> store_lexeme state.buffer lexbuf; comment state lexbuf
+ | Some delim ->
+ state.string_start_loc <- Location.curr lexbuf;
+ Buffer.add_string state.buffer (Lexing.lexeme lexbuf);
+ (catch (quoted_string delim state lexbuf) (fun e l -> match e with
+ | Unterminated_string ->
+ begin match state.comment_start_loc with
+ | [] -> assert false
+ | loc :: _ ->
+ let start = List.hd (List.rev state.comment_start_loc) in
+ state.comment_start_loc <- [];
+ fail_loc (Unterminated_string_in_comment (start, l)) loc
+ end
+ | e -> fail_loc e l
+ )
+ ) >>= fun _loc ->
+ state.string_start_loc <- Location.none;
+ Buffer.add_char state.buffer '|';
+ Buffer.add_string state.buffer delim;
+ Buffer.add_char state.buffer '}';
+ comment state lexbuf }
| "\'\'"
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
| "\'" (newline as nl) "\'"
{ update_loc lexbuf None 1 false 1;
store_string_char state.buffer '\'';
@@ -725,16 +893,16 @@ and comment state = parse
store_string_char state.buffer '\'';
comment state lexbuf
}
- | "\'" [^ '\\' '\'' '\010' '\013' ] "'"
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
- | "\'\\" ['\\' '\"' '\'' 'n' 't' 'b' 'r' ' '] "'"
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
- | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
+ | "\'" [^ '\\' '\'' '\010' '\013' ] "\'"
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
+ | "\'\\" ['\\' '\"' '\'' 'n' 't' 'b' 'r' ' '] "\'"
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
+ | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'"
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
| "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'"
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
- | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "'"
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
+ | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'"
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
| eof
{ match state.comment_start_loc with
| [] -> assert false
@@ -748,29 +916,37 @@ and comment state = parse
store_normalized_newline state.buffer nl;
comment state lexbuf
}
- | (lowercase | uppercase) identchar *
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
+ | ident
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
| _
- { Buffer.add_string state.buffer (Lexing.lexeme lexbuf); comment state lexbuf }
+ { store_lexeme state.buffer lexbuf; comment state lexbuf }
and string state = parse
'\"'
{ return lexbuf.lex_start_p }
- | '\\' newline ([' ' '\t'] * as space)
+ | '\\' (newline as nl) ([' ' '\t'] * as space)
{ update_loc lexbuf None 1 false (String.length space);
+ if in_comment state then begin
+ store_string_char state.buffer '\\';
+ store_normalized_newline state.buffer nl;
+ store_string state.buffer space;
+ end;
string state lexbuf
}
- | '\\' ['\\' '\'' '\"' 'n' 't' 'b' 'r' ' ']
- { Buffer.add_char state.buffer
- (char_for_backslash (Lexing.lexeme_char lexbuf 1));
+ | '\\' (['\\' '\'' '\"' 'n' 't' 'b' 'r' ' '] as c)
+ { store_escaped_char state lexbuf (char_for_backslash c);
string state lexbuf }
| '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
{ char_for_decimal_code state lexbuf 1 >>= fun c ->
- Buffer.add_char state.buffer c;
- string state lexbuf }
+ store_escaped_char state lexbuf c;
+ string state lexbuf }
+ | '\\' 'o' ['0'-'7'] ['0'-'7'] ['0'-'7']
+ { char_for_octal_code state lexbuf 2 >>= fun c ->
+ store_escaped_char state lexbuf c;
+ string state lexbuf }
| '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F']
- { Buffer.add_char state.buffer (char_for_hexadecimal_code lexbuf 2);
- string state lexbuf }
+ { store_escaped_char state lexbuf (char_for_hexadecimal_code lexbuf 2);
+ string state lexbuf }
| '\\' 'u' '{' hex_digit+ '}'
{ store_escaped_uchar state lexbuf (uchar_for_uchar_escape lexbuf);
string state lexbuf }
@@ -779,13 +955,11 @@ and string state = parse
then string state lexbuf
else begin
(* Should be an error, but we are very lax.
- fail (Illegal_escape (Lexing.lexeme lexbuf),
- (Location.curr lexbuf)
+ error lexbuf (Illegal_escape (Lexing.lexeme lexbuf, None))
*)
let loc = Location.curr lexbuf in
Location.prerr_warning loc Warnings.Illegal_backslash;
- Buffer.add_char state.buffer (Lexing.lexeme_char lexbuf 0);
- Buffer.add_char state.buffer (Lexing.lexeme_char lexbuf 1);
+ store_lexeme state.buffer lexbuf;
string state lexbuf
end
}
@@ -812,16 +986,15 @@ and quoted_string delim state = parse
{ let loc = state.string_start_loc in
state.string_start_loc <- Location.none;
fail_loc Unterminated_string loc }
- | "|" lowercase* "}"
+ | "|" (ident_ext? as raw_edelim) "}"
{
- let edelim = Lexing.lexeme lexbuf in
- let edelim = String.sub edelim ~pos:1 ~len:(String.length edelim - 2) in
+ let* edelim = validate_encoding lexbuf raw_edelim in
if delim = edelim then return lexbuf.lex_start_p
- else (Buffer.add_string state.buffer (Lexing.lexeme lexbuf);
+ else (store_lexeme state.buffer lexbuf;
quoted_string delim state lexbuf)
}
- | _
- { Buffer.add_char state.buffer (Lexing.lexeme_char lexbuf 0);
+ | (_ as c)
+ { store_string_char state.buffer c;
quoted_string delim state lexbuf }
and skip_sharp_bang state = parse
diff --git a/src/ocaml/preprocess/parser_printer.ml b/src/ocaml/preprocess/parser_printer.ml
index 6b7830e814..56981d2a21 100644
--- a/src/ocaml/preprocess/parser_printer.ml
+++ b/src/ocaml/preprocess/parser_printer.ml
@@ -65,6 +65,9 @@ let print_symbol = function
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_MINUSDOT) -> "-."
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_MINUS) -> "-"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_METHOD) -> "method"
+ | MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_ESCAPE) -> ".~"
+ | MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_OPEN) -> ".<"
+ | MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_CLOSE) -> ">."
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_MATCH) -> "match"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_LPAREN) -> ")"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_LIDENT) -> "LIDENT"
@@ -100,7 +103,6 @@ let print_symbol = function
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_HASH) -> "#"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACKET) -> ">]"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACE) -> ">}"
- | MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_GREATERDOT) -> ">."
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_GREATER) -> ">"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_FUNCTOR) -> "functor"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_FUNCTION) -> "function"
@@ -115,10 +117,9 @@ let print_symbol = function
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_EOF) -> "EOF"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_END) -> "end"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_ELSE) -> "else"
+ | MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_EFFECT) -> "effect"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_DOWNTO) -> "downto"
- | MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_DOTTILDE) -> ".~"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_DOTOP) -> "DOTOP"
- | MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_DOTLESS) -> ".<"
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_DOTDOT) -> ".."
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_DOT) -> "."
| MenhirInterpreter.X (MenhirInterpreter.T MenhirInterpreter.T_DONE) -> "done"
@@ -412,6 +413,9 @@ let print_value (type a) : a MenhirInterpreter.symbol -> a -> string = function
| MenhirInterpreter.T MenhirInterpreter.T_MINUSDOT -> (fun _ -> "-.")
| MenhirInterpreter.T MenhirInterpreter.T_MINUS -> (fun _ -> "-")
| MenhirInterpreter.T MenhirInterpreter.T_METHOD -> (fun _ -> "method")
+ | MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_ESCAPE -> (fun _ -> ".~")
+ | MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_OPEN -> (fun _ -> ".<")
+ | MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_CLOSE -> (fun _ -> ">.")
| MenhirInterpreter.T MenhirInterpreter.T_MATCH -> (fun _ -> "match")
| MenhirInterpreter.T MenhirInterpreter.T_LPAREN -> (fun _ -> ")")
| MenhirInterpreter.T MenhirInterpreter.T_LIDENT -> (Printf.sprintf "LIDENT(%S)")
@@ -447,7 +451,6 @@ let print_value (type a) : a MenhirInterpreter.symbol -> a -> string = function
| MenhirInterpreter.T MenhirInterpreter.T_HASH -> (fun _ -> "#")
| MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACKET -> (fun _ -> ">]")
| MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACE -> (fun _ -> ">}")
- | MenhirInterpreter.T MenhirInterpreter.T_GREATERDOT -> (fun _ -> ">.")
| MenhirInterpreter.T MenhirInterpreter.T_GREATER -> (fun _ -> ">")
| MenhirInterpreter.T MenhirInterpreter.T_FUNCTOR -> (fun _ -> "functor")
| MenhirInterpreter.T MenhirInterpreter.T_FUNCTION -> (fun _ -> "function")
@@ -462,10 +465,9 @@ let print_value (type a) : a MenhirInterpreter.symbol -> a -> string = function
| MenhirInterpreter.T MenhirInterpreter.T_EOF -> (fun _ -> "EOF")
| MenhirInterpreter.T MenhirInterpreter.T_END -> (fun _ -> "end")
| MenhirInterpreter.T MenhirInterpreter.T_ELSE -> (fun _ -> "else")
+ | MenhirInterpreter.T MenhirInterpreter.T_EFFECT -> (fun _ -> "effect")
| MenhirInterpreter.T MenhirInterpreter.T_DOWNTO -> (fun _ -> "downto")
- | MenhirInterpreter.T MenhirInterpreter.T_DOTTILDE -> (fun _ -> ".~")
| MenhirInterpreter.T MenhirInterpreter.T_DOTOP -> (fun _ -> "DOTOP")
- | MenhirInterpreter.T MenhirInterpreter.T_DOTLESS -> (fun _ -> ".<")
| MenhirInterpreter.T MenhirInterpreter.T_DOTDOT -> (fun _ -> "..")
| MenhirInterpreter.T MenhirInterpreter.T_DOT -> (fun _ -> ".")
| MenhirInterpreter.T MenhirInterpreter.T_DONE -> (fun _ -> "done")
@@ -758,6 +760,9 @@ let print_token = function
| MINUSDOT -> print_value (MenhirInterpreter.T MenhirInterpreter.T_MINUSDOT) ()
| MINUS -> print_value (MenhirInterpreter.T MenhirInterpreter.T_MINUS) ()
| METHOD -> print_value (MenhirInterpreter.T MenhirInterpreter.T_METHOD) ()
+ | METAOCAML_ESCAPE -> print_value (MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_ESCAPE) ()
+ | METAOCAML_BRACKET_OPEN -> print_value (MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_OPEN) ()
+ | METAOCAML_BRACKET_CLOSE -> print_value (MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_CLOSE) ()
| MATCH -> print_value (MenhirInterpreter.T MenhirInterpreter.T_MATCH) ()
| LPAREN -> print_value (MenhirInterpreter.T MenhirInterpreter.T_LPAREN) ()
| LIDENT v -> print_value (MenhirInterpreter.T MenhirInterpreter.T_LIDENT) v
@@ -793,7 +798,6 @@ let print_token = function
| HASH -> print_value (MenhirInterpreter.T MenhirInterpreter.T_HASH) ()
| GREATERRBRACKET -> print_value (MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACKET) ()
| GREATERRBRACE -> print_value (MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACE) ()
- | GREATERDOT -> print_value (MenhirInterpreter.T MenhirInterpreter.T_GREATERDOT) ()
| GREATER -> print_value (MenhirInterpreter.T MenhirInterpreter.T_GREATER) ()
| FUNCTOR -> print_value (MenhirInterpreter.T MenhirInterpreter.T_FUNCTOR) ()
| FUNCTION -> print_value (MenhirInterpreter.T MenhirInterpreter.T_FUNCTION) ()
@@ -808,10 +812,9 @@ let print_token = function
| EOF -> print_value (MenhirInterpreter.T MenhirInterpreter.T_EOF) ()
| END -> print_value (MenhirInterpreter.T MenhirInterpreter.T_END) ()
| ELSE -> print_value (MenhirInterpreter.T MenhirInterpreter.T_ELSE) ()
+ | EFFECT -> print_value (MenhirInterpreter.T MenhirInterpreter.T_EFFECT) ()
| DOWNTO -> print_value (MenhirInterpreter.T MenhirInterpreter.T_DOWNTO) ()
- | DOTTILDE -> print_value (MenhirInterpreter.T MenhirInterpreter.T_DOTTILDE) ()
| DOTOP v -> print_value (MenhirInterpreter.T MenhirInterpreter.T_DOTOP) v
- | DOTLESS -> print_value (MenhirInterpreter.T MenhirInterpreter.T_DOTLESS) ()
| DOTDOT -> print_value (MenhirInterpreter.T MenhirInterpreter.T_DOTDOT) ()
| DOT -> print_value (MenhirInterpreter.T MenhirInterpreter.T_DOT) ()
| DONE -> print_value (MenhirInterpreter.T MenhirInterpreter.T_DONE) ()
@@ -888,6 +891,9 @@ let token_of_terminal (type a) (t : a MenhirInterpreter.terminal) (v : a) : toke
| MenhirInterpreter.T_MINUSDOT -> MINUSDOT
| MenhirInterpreter.T_MINUS -> MINUS
| MenhirInterpreter.T_METHOD -> METHOD
+ | MenhirInterpreter.T_METAOCAML_ESCAPE -> METAOCAML_ESCAPE
+ | MenhirInterpreter.T_METAOCAML_BRACKET_OPEN -> METAOCAML_BRACKET_OPEN
+ | MenhirInterpreter.T_METAOCAML_BRACKET_CLOSE -> METAOCAML_BRACKET_CLOSE
| MenhirInterpreter.T_MATCH -> MATCH
| MenhirInterpreter.T_LPAREN -> LPAREN
| MenhirInterpreter.T_LIDENT -> LIDENT v
@@ -923,7 +929,6 @@ let token_of_terminal (type a) (t : a MenhirInterpreter.terminal) (v : a) : toke
| MenhirInterpreter.T_HASH -> HASH
| MenhirInterpreter.T_GREATERRBRACKET -> GREATERRBRACKET
| MenhirInterpreter.T_GREATERRBRACE -> GREATERRBRACE
- | MenhirInterpreter.T_GREATERDOT -> GREATERDOT
| MenhirInterpreter.T_GREATER -> GREATER
| MenhirInterpreter.T_FUNCTOR -> FUNCTOR
| MenhirInterpreter.T_FUNCTION -> FUNCTION
@@ -938,10 +943,9 @@ let token_of_terminal (type a) (t : a MenhirInterpreter.terminal) (v : a) : toke
| MenhirInterpreter.T_EOF -> EOF
| MenhirInterpreter.T_END -> END
| MenhirInterpreter.T_ELSE -> ELSE
+ | MenhirInterpreter.T_EFFECT -> EFFECT
| MenhirInterpreter.T_DOWNTO -> DOWNTO
- | MenhirInterpreter.T_DOTTILDE -> DOTTILDE
| MenhirInterpreter.T_DOTOP -> DOTOP v
- | MenhirInterpreter.T_DOTLESS -> DOTLESS
| MenhirInterpreter.T_DOTDOT -> DOTDOT
| MenhirInterpreter.T_DOT -> DOT
| MenhirInterpreter.T_DONE -> DONE
diff --git a/src/ocaml/preprocess/parser_raw.ml b/src/ocaml/preprocess/parser_raw.ml
index 190b5b4887..194ad3ead3 100644
--- a/src/ocaml/preprocess/parser_raw.ml
+++ b/src/ocaml/preprocess/parser_raw.ml
@@ -16,7 +16,7 @@ module MenhirBasics = struct
| VAL
| UNDERSCORE
| UIDENT of (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
# 22 "src/ocaml/preprocess/parser_raw.ml"
)
@@ -28,7 +28,7 @@ module MenhirBasics = struct
| THEN
| STRUCT
| STRING of (
-# 876 "src/ocaml/preprocess/parser_raw.mly"
+# 895 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string option)
# 34 "src/ocaml/preprocess/parser_raw.ml"
)
@@ -41,12 +41,12 @@ module MenhirBasics = struct
| RBRACKET
| RBRACE
| QUOTED_STRING_ITEM of (
-# 881 "src/ocaml/preprocess/parser_raw.mly"
+# 900 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string * Location.t * string option)
# 47 "src/ocaml/preprocess/parser_raw.ml"
)
| QUOTED_STRING_EXPR of (
-# 878 "src/ocaml/preprocess/parser_raw.mly"
+# 897 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string * Location.t * string option)
# 52 "src/ocaml/preprocess/parser_raw.ml"
)
@@ -54,7 +54,7 @@ module MenhirBasics = struct
| QUESTION
| PRIVATE
| PREFIXOP of (
-# 862 "src/ocaml/preprocess/parser_raw.mly"
+# 881 "src/ocaml/preprocess/parser_raw.mly"
(string)
# 60 "src/ocaml/preprocess/parser_raw.ml"
)
@@ -64,7 +64,7 @@ module MenhirBasics = struct
| PERCENT
| OR
| OPTLABEL of (
-# 855 "src/ocaml/preprocess/parser_raw.mly"
+# 874 "src/ocaml/preprocess/parser_raw.mly"
(string)
# 70 "src/ocaml/preprocess/parser_raw.ml"
)
@@ -79,17 +79,20 @@ module MenhirBasics = struct
| MINUSDOT
| MINUS
| METHOD
+ | METAOCAML_ESCAPE
+ | METAOCAML_BRACKET_OPEN
+ | METAOCAML_BRACKET_CLOSE
| MATCH
| LPAREN
| LIDENT of (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 88 "src/ocaml/preprocess/parser_raw.ml"
+# 91 "src/ocaml/preprocess/parser_raw.ml"
)
| LETOP of (
-# 820 "src/ocaml/preprocess/parser_raw.mly"
+# 839 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 93 "src/ocaml/preprocess/parser_raw.ml"
+# 96 "src/ocaml/preprocess/parser_raw.ml"
)
| LET
| LESSMINUS
@@ -107,63 +110,62 @@ module MenhirBasics = struct
| LBRACE
| LAZY
| LABEL of (
-# 825 "src/ocaml/preprocess/parser_raw.mly"
+# 844 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 113 "src/ocaml/preprocess/parser_raw.ml"
+# 116 "src/ocaml/preprocess/parser_raw.ml"
)
| INT of (
-# 824 "src/ocaml/preprocess/parser_raw.mly"
+# 843 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 118 "src/ocaml/preprocess/parser_raw.ml"
+# 121 "src/ocaml/preprocess/parser_raw.ml"
)
| INITIALIZER
| INHERIT
| INFIXOP4 of (
-# 818 "src/ocaml/preprocess/parser_raw.mly"
+# 837 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 125 "src/ocaml/preprocess/parser_raw.ml"
+# 128 "src/ocaml/preprocess/parser_raw.ml"
)
| INFIXOP3 of (
-# 817 "src/ocaml/preprocess/parser_raw.mly"
+# 836 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 130 "src/ocaml/preprocess/parser_raw.ml"
+# 133 "src/ocaml/preprocess/parser_raw.ml"
)
| INFIXOP2 of (
-# 816 "src/ocaml/preprocess/parser_raw.mly"
+# 835 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 135 "src/ocaml/preprocess/parser_raw.ml"
+# 138 "src/ocaml/preprocess/parser_raw.ml"
)
| INFIXOP1 of (
-# 815 "src/ocaml/preprocess/parser_raw.mly"
+# 834 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 140 "src/ocaml/preprocess/parser_raw.ml"
+# 143 "src/ocaml/preprocess/parser_raw.ml"
)
| INFIXOP0 of (
-# 814 "src/ocaml/preprocess/parser_raw.mly"
+# 833 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 145 "src/ocaml/preprocess/parser_raw.ml"
+# 148 "src/ocaml/preprocess/parser_raw.ml"
)
| INCLUDE
| IN
| IF
| HASHOP of (
-# 873 "src/ocaml/preprocess/parser_raw.mly"
+# 892 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 153 "src/ocaml/preprocess/parser_raw.ml"
+# 156 "src/ocaml/preprocess/parser_raw.ml"
)
| HASH
| GREATERRBRACKET
| GREATERRBRACE
- | GREATERDOT
| GREATER
| FUNCTOR
| FUNCTION
| FUN
| FOR
| FLOAT of (
-# 803 "src/ocaml/preprocess/parser_raw.mly"
+# 822 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 167 "src/ocaml/preprocess/parser_raw.ml"
+# 169 "src/ocaml/preprocess/parser_raw.ml"
)
| FALSE
| EXTERNAL
@@ -173,28 +175,27 @@ module MenhirBasics = struct
| EOF
| END
| ELSE
+ | EFFECT
| DOWNTO
- | DOTTILDE
| DOTOP of (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 182 "src/ocaml/preprocess/parser_raw.ml"
+# 184 "src/ocaml/preprocess/parser_raw.ml"
)
- | DOTLESS
| DOTDOT
| DOT
| DONE
| DOCSTRING of (
-# 898 "src/ocaml/preprocess/parser_raw.mly"
+# 917 "src/ocaml/preprocess/parser_raw.mly"
(Docstrings.docstring)
-# 191 "src/ocaml/preprocess/parser_raw.ml"
+# 192 "src/ocaml/preprocess/parser_raw.ml"
)
| DO
| CONSTRAINT
| COMMENT of (
-# 897 "src/ocaml/preprocess/parser_raw.mly"
+# 916 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t)
-# 198 "src/ocaml/preprocess/parser_raw.ml"
+# 199 "src/ocaml/preprocess/parser_raw.ml"
)
| COMMA
| COLONGREATER
@@ -203,9 +204,9 @@ module MenhirBasics = struct
| COLON
| CLASS
| CHAR of (
-# 783 "src/ocaml/preprocess/parser_raw.mly"
+# 801 "src/ocaml/preprocess/parser_raw.mly"
(char)
-# 209 "src/ocaml/preprocess/parser_raw.ml"
+# 210 "src/ocaml/preprocess/parser_raw.ml"
)
| BEGIN
| BARRBRACKET
@@ -216,9 +217,9 @@ module MenhirBasics = struct
| ASSERT
| AS
| ANDOP of (
-# 821 "src/ocaml/preprocess/parser_raw.mly"
+# 840 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 222 "src/ocaml/preprocess/parser_raw.ml"
+# 223 "src/ocaml/preprocess/parser_raw.ml"
)
| AND
| AMPERSAND
@@ -271,6 +272,7 @@ let mkmod ~loc ?attrs d = Mod.mk ~loc:(make_loc loc) ?attrs d
let mkstr ~loc d = Str.mk ~loc:(make_loc loc) d
let mkclass ~loc ?attrs d = Cl.mk ~loc:(make_loc loc) ?attrs d
let mkcty ~loc ?attrs d = Cty.mk ~loc:(make_loc loc) ?attrs d
+let mkconst ~loc c = Const.mk ~loc:(make_loc loc) c
let pstr_typext (te, ext) =
(Pstr_typext te, ext)
@@ -363,20 +365,31 @@ let neg_string f =
then String.sub f 1 (String.length f - 1)
else "-" ^ f
-let mkuminus ~oploc name arg =
- match name, arg.pexp_desc with
- | "-", Pexp_constant(Pconst_integer (n,m)) ->
- Pexp_constant(Pconst_integer(neg_string n,m))
- | ("-" | "-."), Pexp_constant(Pconst_float (f, m)) ->
- Pexp_constant(Pconst_float(neg_string f, m))
+(* Pre-apply the special [-], [-.], [+] and [+.] prefix operators into
+ constants if possible, otherwise turn them into the corresponding prefix
+ operators [~-], [~-.], etc.. *)
+let mkuminus ~sloc ~oploc name arg =
+ match name, arg.pexp_desc, arg.pexp_attributes with
+ | "-",
+ Pexp_constant({pconst_desc = Pconst_integer (n,m); pconst_loc=_}),
+ [] ->
+ Pexp_constant(mkconst ~loc:sloc (Pconst_integer(neg_string n, m)))
+ | ("-" | "-."),
+ Pexp_constant({pconst_desc = Pconst_float (f, m); pconst_loc=_}), [] ->
+ Pexp_constant(mkconst ~loc:sloc (Pconst_float(neg_string f, m)))
| _ ->
Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
-let mkuplus ~oploc name arg =
+let mkuplus ~sloc ~oploc name arg =
let desc = arg.pexp_desc in
- match name, desc with
- | "+", Pexp_constant(Pconst_integer _)
- | ("+" | "+."), Pexp_constant(Pconst_float _) -> desc
+ match name, desc, arg.pexp_attributes with
+ | "+",
+ Pexp_constant({pconst_desc = Pconst_integer _ as desc; pconst_loc=_}),
+ []
+ | ("+" | "+."),
+ Pexp_constant({pconst_desc = Pconst_float _ as desc; pconst_loc=_}),
+ [] ->
+ Pexp_constant(mkconst ~loc:sloc desc)
| _ ->
Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
@@ -697,7 +710,8 @@ let wrap_mksig_ext ~loc (item, ext) =
let mk_quotedext ~loc (id, idloc, str, strloc, delim) =
let exp_id = mkloc id idloc in
- let e = ghexp ~loc (Pexp_constant (Pconst_string (str, strloc, delim))) in
+ let const = Const.mk ~loc:strloc (Pconst_string (str, strloc, delim)) in
+ let e = ghexp ~loc (Pexp_constant const) in
(exp_id, PStr [mkstrexp e []])
let text_str pos = Str.text (rhs_text pos)
@@ -874,6 +888,11 @@ let mkfunction params body_constraint body =
| Some newtypes ->
mkghost_newtype_function_body newtypes body_constraint body_exp
+let mk_functor_typ args mty =
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmty ~loc:(startpos, mty.pmty_loc.loc_end) (Pmty_functor (arg, acc)))
+ mty args
+
(* Alternatively, we could keep the generic module type in the Parsetree
and extract the package type during type-checking. In that case,
the assertions below should be turned into explicit checks. *)
@@ -933,7 +952,7 @@ let merloc startpos ?endpos x =
{ x with pexp_attributes = attr :: x.pexp_attributes }
-# 937 "src/ocaml/preprocess/parser_raw.ml"
+# 956 "src/ocaml/preprocess/parser_raw.ml"
module Tables = struct
@@ -943,164 +962,166 @@ module Tables = struct
fun _tok ->
match _tok with
| AMPERAMPER ->
- 126
+ 127
| AMPERSAND ->
- 125
+ 126
| AND ->
- 124
+ 125
| ANDOP _ ->
- 123
+ 124
| AS ->
- 122
+ 123
| ASSERT ->
- 121
+ 122
| BACKQUOTE ->
- 120
+ 121
| BANG ->
- 119
+ 120
| BAR ->
- 118
+ 119
| BARBAR ->
- 117
+ 118
| BARRBRACKET ->
- 116
+ 117
| BEGIN ->
- 115
+ 116
| CHAR _ ->
- 114
+ 115
| CLASS ->
- 113
+ 114
| COLON ->
- 112
+ 113
| COLONCOLON ->
- 111
+ 112
| COLONEQUAL ->
- 110
+ 111
| COLONGREATER ->
- 109
+ 110
| COMMA ->
- 108
+ 109
| COMMENT _ ->
- 107
+ 108
| CONSTRAINT ->
- 106
+ 107
| DO ->
- 105
+ 106
| DOCSTRING _ ->
- 104
+ 105
| DONE ->
- 103
+ 104
| DOT ->
- 102
+ 103
| DOTDOT ->
+ 102
+ | DOTOP _ ->
101
- | DOTLESS ->
+ | DOWNTO ->
100
- | DOTOP _ ->
+ | EFFECT ->
99
- | DOTTILDE ->
+ | ELSE ->
98
- | DOWNTO ->
+ | END ->
97
- | ELSE ->
+ | EOF ->
96
- | END ->
+ | EOL ->
95
- | EOF ->
+ | EQUAL ->
94
- | EOL ->
+ | EXCEPTION ->
93
- | EQUAL ->
+ | EXTERNAL ->
92
- | EXCEPTION ->
+ | FALSE ->
91
- | EXTERNAL ->
+ | FLOAT _ ->
90
- | FALSE ->
+ | FOR ->
89
- | FLOAT _ ->
+ | FUN ->
88
- | FOR ->
+ | FUNCTION ->
87
- | FUN ->
+ | FUNCTOR ->
86
- | FUNCTION ->
+ | GREATER ->
85
- | FUNCTOR ->
+ | GREATERRBRACE ->
84
- | GREATER ->
+ | GREATERRBRACKET ->
83
- | GREATERDOT ->
+ | HASH ->
82
- | GREATERRBRACE ->
+ | HASHOP _ ->
81
- | GREATERRBRACKET ->
+ | IF ->
80
- | HASH ->
+ | IN ->
79
- | HASHOP _ ->
+ | INCLUDE ->
78
- | IF ->
+ | INFIXOP0 _ ->
77
- | IN ->
+ | INFIXOP1 _ ->
76
- | INCLUDE ->
+ | INFIXOP2 _ ->
75
- | INFIXOP0 _ ->
+ | INFIXOP3 _ ->
74
- | INFIXOP1 _ ->
+ | INFIXOP4 _ ->
73
- | INFIXOP2 _ ->
+ | INHERIT ->
72
- | INFIXOP3 _ ->
+ | INITIALIZER ->
71
- | INFIXOP4 _ ->
+ | INT _ ->
70
- | INHERIT ->
+ | LABEL _ ->
69
- | INITIALIZER ->
+ | LAZY ->
68
- | INT _ ->
+ | LBRACE ->
67
- | LABEL _ ->
+ | LBRACELESS ->
66
- | LAZY ->
+ | LBRACKET ->
65
- | LBRACE ->
+ | LBRACKETAT ->
64
- | LBRACELESS ->
+ | LBRACKETATAT ->
63
- | LBRACKET ->
+ | LBRACKETATATAT ->
62
- | LBRACKETAT ->
+ | LBRACKETBAR ->
61
- | LBRACKETATAT ->
+ | LBRACKETGREATER ->
60
- | LBRACKETATATAT ->
+ | LBRACKETLESS ->
59
- | LBRACKETBAR ->
+ | LBRACKETPERCENT ->
58
- | LBRACKETGREATER ->
+ | LBRACKETPERCENTPERCENT ->
57
- | LBRACKETLESS ->
+ | LESS ->
56
- | LBRACKETPERCENT ->
+ | LESSMINUS ->
55
- | LBRACKETPERCENTPERCENT ->
+ | LET ->
54
- | LESS ->
+ | LETOP _ ->
53
- | LESSMINUS ->
+ | LIDENT _ ->
52
- | LET ->
+ | LPAREN ->
51
- | LETOP _ ->
+ | MATCH ->
50
- | LIDENT _ ->
+ | METAOCAML_BRACKET_CLOSE ->
49
- | LPAREN ->
+ | METAOCAML_BRACKET_OPEN ->
48
- | MATCH ->
+ | METAOCAML_ESCAPE ->
47
| METHOD ->
46
@@ -1253,14 +1274,12 @@ module Tables = struct
Obj.repr ()
| DOTDOT ->
Obj.repr ()
- | DOTLESS ->
- Obj.repr ()
| DOTOP _v ->
Obj.repr _v
- | DOTTILDE ->
- Obj.repr ()
| DOWNTO ->
Obj.repr ()
+ | EFFECT ->
+ Obj.repr ()
| ELSE ->
Obj.repr ()
| END ->
@@ -1289,8 +1308,6 @@ module Tables = struct
Obj.repr ()
| GREATER ->
Obj.repr ()
- | GREATERDOT ->
- Obj.repr ()
| GREATERRBRACE ->
Obj.repr ()
| GREATERRBRACKET ->
@@ -1361,6 +1378,12 @@ module Tables = struct
Obj.repr ()
| MATCH ->
Obj.repr ()
+ | METAOCAML_BRACKET_CLOSE ->
+ Obj.repr ()
+ | METAOCAML_BRACKET_OPEN ->
+ Obj.repr ()
+ | METAOCAML_ESCAPE ->
+ Obj.repr ()
| METHOD ->
Obj.repr ()
| MINUS ->
@@ -1455,22 +1478,22 @@ module Tables = struct
Obj.repr ()
and default_reduction =
- (16, "\000\000\000\000\000\000\003\014\003\r\003\012\003\011\003\n\002\221\003\t\003\b\003\007\003\006\003\005\003\004\003\003\003\002\003\001\003\000\002\255\002\254\002\253\002\252\002\251\002\250\002\249\002\248\002\247\002\220\002\246\002\245\002\244\002\243\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\229\002\228\002\227\002\226\002\225\002\224\002\223\002\222\000\000\000\000\000\"\000~\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\212\001\191\001\209\001\208\001\207\001\213\001\217\001\211\001\210\001\192\001\215\001\206\001\205\001\204\001\203\001\202\001\200\001\216\001\214\000\000\000\000\000\000\001\004\000\000\000\000\001\195\000\000\000\000\000\000\001\197\000\000\000\000\000\000\001\199\001\221\001\218\001\201\001\193\001\219\001\220\000\000\003N\003O\000\000\000\000\000 \001n\000\128\000\000\001\000\001\001\000\000\000\000\000\000\001\246\001\245\000\000\000\000\000\031\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003K\000\000\003F\000\000\000\000\003H\000\000\003J\000\000\003G\003I\000\000\003A\000\000\003@\003<\002]\000\000\003?\000\000\002^\000\000\000\000\000\000\000\000\000_\000\000\000\000\000]\000\000\000\000\001l\000\000\000\000\000\000\000\000\000\000\002\190\001z\000\000\000\000\000\000\000\000\000\000\000\000\002F\000\000\000\000\000\000\000\000\000\000\000\000\000Z\000\000\000\000\000\000\000\000\000\000\002\208\000\000\002\150\002\151\000\000\002\148\002\149\000\000\000\000\000\000\000\000\000\000\001\144\001\143\000\000\002\206\000\000\000\000\000\000\000\000\000\000\001\142\000\000\000\000\000\000\001\007\000\017\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001x\000\000\000\000\001{\001y\001\128\000:\002\172\000\000\001>\003&\003%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000\000\001\015\000\000\002\152\000\000\000\000\000\000\001\225\000\000\000\000\000x\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\001o\001~\000\000\001m\000W\000\027\000\000\000\000\001\166\000\024\000\000\000\000\000\000\000\000\000o\000\000\000\000\000\000\000\000\000\000\000\000\003;\000\238\000p\000\131\000q\000\023\000\000\000\000\000\000\000\000\000\028\000\025\000\018\000\000\000r\000n\000\000\000\000\000\000\000\019\000\030\000\000\000\240\002k\002Y\000\000\000u\000\000\002Z\000\000\000\000\001\222\000\000\000\000\000\000\000\000\003'\000\000\003(\000\000\000\000\000t\000\000\000\000\000\000\000v\000\000\000w\000\000\000y\000\000\000\000\000z\002O\002N\000\000\000\000\000\000\000\000\000\000\000\000\000X\000\000\002\213\000[\000^\000Y\002\202\003P\002\203\002\027\002\205\000\000\000\000\002\210\002\147\002\212\000\000\000\000\000\000\002\216\000\000\000\000\000\000\002\023\002\014\000\000\000\000\000\000\000\000\000\000\002\r\000\000\002\026\002\219\000\000\000\000\000\000\000\000\001\168\000\000\000\000\002\025\002\211\000f\000\000\000\000\000e\000\000\002\204\000\000\000\000\000\000\000\000\002\218\000\000\000\000\000\000\002\015\002\024\002\018\000\000\000d\000\000\002\217\000\000\002\215\000\000\002\153\000\000\000\000\002x\002\214\000\000\000\000\000\000\000\000\001\227\001Y\001Z\002\155\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\026\001\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002K\000\000\000\000\001\151\000\000\000\000\000\000\000\000\000\000\000\000\003g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\000\000\000\000\001\150\000\000\000\000\000\000\001w\001\158\001v\001\155\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002W\000\000\000\000\002X\002J\000\000\000\000\001\149\000\000\000\242\000\000\000\000\001\136\000\000\000\000\001\140\000\000\001\248\000\000\000\000\001\247\001\139\001\137\000\000\001\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002#\000\000\000\000\000\000\000\000\000\000\000\000\001\024\002\"\001\025\000\000\000\000\000\000\000\230\000\000\001\028\001\029\000\000\000\231\002I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002T\002R\000\000\000\000\000\000\000\000\000\000\000\000\002\176\001|\002\181\002\179\000\000\000\000\000\000\002\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\019\001\018\000\000\001\020\000\000\000\000\000\000\002\187\000\000\000\000\000\000\002\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Q\002\189\002\178\002\177\000\000\000\000\000\203\002|\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\000\000\000\000\000\000\000\000\000\000\000\000\000\202\000\201\000\000\000\000\000\000\000\236\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\017\000\000\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\002Q\000\000\000\000\000\000\001\"\000\000\000\000\001!\001 \000\000\001\244\000\000\000\000\000\136\003\018\002H\000\000\000\000\000\000\000\000\001%\000\000\000\000\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\031\002\029\002\030\000\000\000\000\000\000\001\030\000\000\000\000\001D\000\020\001'\000\000\000\000\000\000\002\163\000\000\000\000\002\162\000\000\000\000\000\000\000\000\002\165\000\000\000\000\002q\000\000\000\000\002\169\000\000\000\000\002\167\002\184\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002M\002L\000\199\002r\000\000\002\164\000\000\000\000\002\168\000\000\000\000\002\166\001/\000\000\000\000\0010\000\000\000\000\000\204\000\000\0012\0011\000\000\000\000\002\185\000\000\002\197\000\000\002\196\000\000\002\200\000\000\002\199\000\000\000\000\002\186\000\000\000\000\000\000\0029\000\000\000\000\000\000\000\000\002{\0028\000\000\002\193\000\000\000\000\000\000\001}\000\000\000{\000|\000\000\000\000\000\000\000\000\000\152\000\000\000\142\000\000\000\000\001\\\000\000\001]\001[\002S\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\171\000\000\002\170\000\000\000\000\000\000\000\000\000\000\002\157\000\000\002\156\000\000\000\000\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002u\002\183\000\000\002\182\000\000\002\198\000\141\000\000\000\000\000\000\000\000\000\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\138\000\000\001\131\000\000\000\000\000\000\000`\000\000\000\000\000a\000\000\000\000\000\000\000\000\001\160\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\000\000\000\000\000j\000\000\001\012\001\n\000\000\000\000\000\000\000\245\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\139\000b\000\000\000\000\0027\000\000\000\000\001&\001\242\000\000\001\022\001\023\001-\000\000\000\000\000\000\000\000\000\000\002\195\000\000\002\194\002\180\000\000\000\000\000\000\000\000\002\173\000\000\000\000\002\174\000\000\002\159\000\000\002\160\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\250\000\000\000\000\002\000\000\000\000\000\001\252\000\000\000\000\001\254\000\000\001\249\000\000\000\000\001\255\000\000\000\000\001\251\000\000\000\000\001\253\000\000\001\188\000\000\000\000\000\000\001\187\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001:\003\031\000\000\000\000\003\030\000\000\000\000\000\000\000\000\000\000\002(\000\000\000\000\000\000\000\000\000\000\000\000\003$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\170\000\000\002.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\016\000\000\000\000\002~\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\190\000\000\000\000\000\000\001\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\157\000\000\000\000\000\000\000\000\000\000\001\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001<\002\140\000\000\000\000\000\000\002\138\000\000\000\000\000\000\002\137\000\000\001\133\000\000\000\000\000\000\000\000\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Y\000\000\000\000\000\000\000\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001\165\000\000\001\164\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\0025\000\000\0024\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000H\000F\000\000\000J\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000I\000\000\000D\000E\000\000\001M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0018\000V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000S\000\000\000U\000T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0016\002\145\002\130\000\000\002\136\002\131\002\143\002\142\002\141\002\139\001G\000\000\002\128\000\000\000\000\000\000\000\000\000\000\002F\000\000\000\000\001@\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\181\001\177\000\000\000\000\000\000\000\250\000\000\000\000\002<\002F\000\000\000\000\001B\002:\002;\000\000\000\000\000\000\000\000\000\000\001\184\001\180\001\176\000\000\000\000\000\251\000\000\000\000\001\183\001\179\001\175\001\173\002\133\002\129\002\146\001F\002%\002\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003T\000\000\000\000\003V\000\000\000/\000\000\000\000\003\\\000\000\003[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003S\000\000\000\000\003U\000\000\000\000\000\000\0020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001k\000\000\000\000\001i\001g\000\000\0000\000\000\000\000\003_\000\000\003^\000\000\000\000\000\000\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001j\000\000\000\000\001h\001f\000\000\000\000\000\000\0002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000O\000\000\000\000\000\000\000\000\000\000\000\000\000,\000\000\000\000\000N\000\000\000*\001*\000\000\0009\000&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001(\000\000\000M\000\000\000\000\000P\000\000\000\000\001\229\000\000\000.\000\000\000\000\000\000\000-\000\000\000\000\000\000\0001\000\000\000Q\000\000\0003\0004\000\000\001O\000\000\000\000\000\000\000\000\000\000\000\000\0007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0014\003\"\003\025\000\000\000\000\003\029\003\015\003\024\003!\003 \001K\000\000\000\000\003\022\000\000\003\026\003\023\003#\002$\000\000\000\000\003\020\000#\003\019\000\000\000\000\000\132\000\000\001\006\000\000\000\000\001J\001I\000\000\001\134\000\000\000\000\002\207\000\000\000;\000\000\000\000\000<\000\000\000\000\002\175\000\000\000\000\000\000\000\000\002-\000\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000\000\003\028\002A\002B\002=\002?\002>\002@\000\000\000\000\000\000\000\130\000\000\000\000\002F\000\000\000\254\000\000\000\000\000\000\000\000\003\027\000\000\000\127\000\000\000\000\000\000\000\000\001d\001^\000\000\000\000\001_\001\186\000\000\001\185\000\000\000\000\000\239\000\000\000\000\000\000\000\029\000\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\182\001\178\000\000\001\174\003:\000\000\002F\000\000\000\253\000\000\000\000\000\000\000\000\002\135\002E\002C\002D\000\000\000\000\000\000\002F\000\000\000\252\000\000\000\000\000\000\000\000\002\134\000\000\001\146\000\000\000s\000\000\003W\000\000\000$\000\000\000\000\000\000\000\000\000\151\000\000\001\002\000\001\000\000\000\000\001\005\000\002\000\000\000\000\000\000\001q\001r\000\003\000\000\000\000\000\000\000\000\001t\001u\001s\000\021\001p\000\022\000\000\002\001\000\000\000\004\000\000\002\002\000\000\000\005\000\000\002\003\000\000\000\000\002\004\000\006\000\000\000\007\000\000\002\005\000\000\000\b\000\000\002\006\000\000\000\t\000\000\002\007\000\000\000\n\000\000\002\b\000\000\000\011\000\000\002\t\000\000\000\000\002\n\000\012\000\000\000\000\002\011\000\r\000\000\000\000\000\000\000\000\000\000\003/\003*\003+\003.\003,\000\000\0033\000\014\000\000\0032\000\000\001Q\000\000\000\000\0030\000\000\0031\000\000\000\000\000\000\000\000\001U\001V\000\000\000\000\001T\001S\000\015\000\000\000\000\000\000\003M\000\000\003L")
+ (16, "\000\000\000\000\000\000\003\014\003\r\003\012\003\011\003\n\002\221\003\t\003\b\003\007\003\006\003\005\003\004\003\003\003\002\003\001\003\000\002\255\002\254\002\253\002\252\002\251\002\250\002\249\002\248\002\247\002\220\002\246\002\245\002\244\002\243\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\229\002\228\002\227\002\226\002\225\002\224\002\223\002\222\000\000\000\000\000\"\000~\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\212\001\191\001\209\001\208\001\207\001\213\001\217\001\211\001\210\001\192\001\215\001\206\001\205\001\204\001\203\001\202\001\200\001\216\001\214\000\000\000\000\000\000\001\004\000\000\000\000\001\195\000\000\000\000\000\000\001\197\000\000\000\000\000\000\001\199\001\221\001\218\001\201\001\193\001\219\001\220\000\000\003N\003O\000\000\000\000\000 \001n\000\128\000\000\001\000\001\001\000\000\000\000\000\000\001\246\001\245\000\000\000\000\000\031\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003K\000\000\003F\000\000\000\000\003H\000\000\003J\000\000\003G\003I\000\000\003A\000\000\003@\003<\002^\000\000\003?\000\000\002_\000\000\000\000\000\000\000\000\000_\000\000\000\000\000]\000\000\000\000\001l\000\000\000\000\000\000\000\000\000\000\002\190\001z\000\000\000\000\000\000\000\000\000\000\000\000\002G\000\000\000\000\000\000\000\000\000\000\000\000\000Z\000\000\000\000\000\000\000\000\000\000\002\208\000\000\002\151\002\152\000\000\002\149\002\150\000\000\000\000\000\000\000\000\000\000\001\144\001\143\000\000\002\206\000\000\000\000\000\000\000\000\000\000\001\142\000\000\000\000\000\000\001\007\000\017\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001x\000\000\000\000\001{\001y\001\128\000:\002\172\000\000\001>\003&\003%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000\000\001\015\000\000\002\153\000\000\000\000\000\000\001\225\000\000\000\000\000x\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\001o\001~\000\000\001m\000W\000\027\000\000\000\000\001\166\000\024\000\000\000\000\000\000\000\000\000o\000\000\000\000\000\000\000\000\000\000\000\000\003;\000\238\000p\000\131\000q\000\023\000\000\000\000\000\000\000\000\000\028\000\025\000\018\000\000\000r\000n\000\000\000\000\000\000\000\019\000\030\000\000\000\240\002l\002Z\000\000\000u\000\000\002[\000\000\000\000\001\222\000\000\000\000\000\000\000\000\003'\000\000\003(\000\000\000\000\000t\000\000\000\000\000\000\000v\000\000\000w\000\000\000y\000\000\000\000\000z\002P\002O\000\000\000\000\000\000\000\000\000\000\000\000\000X\000\000\002\213\000[\000^\000Y\002\202\003P\002\203\002\028\002\205\000\000\000\000\002\210\002\148\002\212\000\000\000\000\000\000\002\216\000\000\000\000\000\000\000\000\002\024\000\000\000\000\002\019\002\219\002\211\000f\000\000\002\014\000\000\000\000\000\000\000\000\000\000\002\r\000\000\000\000\000\000\000\000\001\168\000\000\000\000\002\026\000\000\000\000\000e\000\000\002\204\000\000\000\000\000\000\000\000\002\218\000\000\000\000\000\000\002\015\002\025\002\027\002\018\000\000\000d\000\000\002\217\000\000\002\215\000\000\002\154\000\000\000\000\002y\002\214\000\000\000\000\000\000\000\000\001\227\001Y\001Z\002\156\000\000\002\155\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\026\001\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\000\000\000\000\001\152\000\000\000\000\000\000\000\000\000\000\000\000\003g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\000\000\000\000\001\151\000\000\000\000\000\000\001w\001\158\001v\000\000\000\000\000\000\000\000\000\000\002K\001\155\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\000\000\000\000\002Y\000\000\001\150\000\000\000\242\000\000\000\000\001\136\000\000\000\000\001\140\000\000\001\248\000\000\000\000\001\247\001\139\001\137\000\000\001\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\176\001|\002\181\002\179\000\000\000\000\000\000\002\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002$\000\000\000\000\000\000\000\000\000\000\000\000\001\024\002#\001\025\000\000\000\000\000\000\000\230\000\000\001\028\001\029\000\000\000\231\002J\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002U\002S\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\019\001\018\000\000\001\020\000\000\000\000\000\000\002\187\000\000\000\000\000\000\002\159\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Q\002\189\002\178\002\177\000\000\000\000\000\203\002}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\000\000\000\000\000\000\000\000\000\000\000\000\000\202\000\201\000\000\000\000\000\000\000\236\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\017\000\000\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\002R\000\000\000\000\000\000\001\"\000\000\000\000\001!\001 \000\000\001\244\000\000\000\000\000\136\003\018\002I\000\000\000\000\000\000\000\000\001%\000\000\000\000\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002 \002\030\002\031\000\000\000\000\000\000\001\030\000\000\000\000\001D\000\020\001'\000\000\000\000\000\000\002\161\000\000\000\000\002\160\000\000\000\000\000\000\000\000\002\163\000\000\000\000\002r\000\000\000\000\002\167\000\000\000\000\002\165\002\184\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002N\002M\000\199\002s\000\000\002\162\000\000\000\000\002\166\000\000\000\000\002\164\000\000\000{\000|\000\000\000\000\000\000\000\000\000\152\000\000\000\142\000\000\000\000\001\\\000\000\001]\001[\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001/\000\000\000\000\0010\000\000\000\000\000\204\000\000\0012\0011\000\000\000\000\002\185\000\000\002\197\000\000\002\196\000\000\002\200\000\000\002\199\000\000\000\000\002\186\000\000\000\000\000\000\002:\000\000\000\000\000\000\000\000\002|\0029\000\000\002\193\000\000\000\000\000\000\001}\000\000\002\171\000\000\002\170\000\000\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002v\002\183\000\000\002\182\000\000\002\198\000\141\000\000\000\000\000\000\000\000\000\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\138\000\000\001\131\000\000\000\000\000\000\000`\000\000\000\000\000a\000\000\000\000\000\000\000\000\001\160\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\000\000\000\000\000j\000\000\001\012\001\n\000\000\000\000\000\000\000\245\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\139\000b\000\000\000\000\0028\000\000\000\000\001&\001\242\000\000\001\022\001\023\001-\000\000\000\000\000\000\000\000\000\000\002\195\000\000\002\194\002\180\000\000\000\000\000\000\000\000\002\173\000\000\000\000\002\174\000\000\002\157\000\000\002\158\000\000\000\000\000\000\000\000\002\169\002\168\000\000\000\000\000\000\000\000\001\250\000\000\000\000\002\000\000\000\000\000\001\252\000\000\000\000\001\254\000\000\001\249\000\000\000\000\001\255\000\000\000\000\001\251\000\000\000\000\001\253\000\000\001\188\000\000\000\000\000\000\001\187\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001:\003\031\000\000\000\000\003\030\000\000\000\000\000\000\000\000\000\000\002)\000\000\000\000\000\000\000\000\000\000\000\000\003$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\170\000\000\002/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\016\000\000\000\000\002\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\190\000\000\000\000\000\000\001\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\157\000\000\000\000\000\000\000\000\000\000\001\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001<\002\141\000\000\000\000\000\000\002\139\000\000\000\000\000\000\002\138\000\000\001\133\000\000\000\000\000\000\000\000\002\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Y\000\000\000\000\000\000\000\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001\165\000\000\001\164\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\0026\000\000\0025\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000H\000F\000\000\000J\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000I\000\000\000D\000E\000\000\001M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0018\000V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000S\000\000\000U\000T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0016\002\146\002\131\000\000\002\137\002\132\002\144\002\143\002\142\002\140\001G\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002G\000\000\000\000\001@\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\181\001\177\000\000\000\000\000\000\000\250\000\000\000\000\002=\002G\000\000\000\000\001B\002;\002<\000\000\000\000\000\000\000\000\000\000\001\184\001\180\001\176\000\000\000\000\000\251\000\000\000\000\001\183\001\179\001\175\001\173\002\134\002\130\002\147\001F\002&\002\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003T\000\000\000\000\003V\000\000\000/\000\000\000\000\003\\\000\000\003[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003S\000\000\000\000\003U\000\000\000\000\000\000\0021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001k\000\000\000\000\001i\001g\000\000\0000\000\000\000\000\003_\000\000\003^\000\000\000\000\000\000\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001j\000\000\000\000\001h\001f\000\000\000\000\000\000\0002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000O\000\000\000\000\000\000\000\000\000\000\000\000\000,\000\000\000\000\000N\000\000\000*\001*\000\000\0009\000&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001(\000\000\000M\000\000\000\000\000P\000\000\000\000\001\229\000\000\000.\000\000\000\000\000\000\000-\000\000\000\000\000\000\0001\000\000\000Q\000\000\0003\0004\000\000\001O\000\000\000\000\000\000\000\000\000\000\000\000\0007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0014\003\"\003\025\000\000\000\000\003\029\003\015\003\024\003!\003 \001K\000\000\000\000\003\022\000\000\003\026\003\023\003#\002%\000\000\000\000\003\020\000#\003\019\000\000\000\000\000\132\000\000\001\006\000\000\000\000\001J\001I\000\000\001\134\000\000\000\000\002\207\000\000\000;\000\000\000\000\000<\000\000\000\000\002\175\000\000\000\000\000\000\000\000\002.\000\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000\000\003\028\002B\002C\002>\002@\002?\002A\000\000\000\000\000\000\000\130\000\000\000\000\002G\000\000\000\254\000\000\000\000\000\000\000\000\003\027\000\000\000\127\000\000\000\000\000\000\000\000\001d\001^\000\000\000\000\001_\001\186\000\000\001\185\000\000\000\000\000\239\000\000\000\000\000\000\000\029\000\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\182\001\178\000\000\001\174\003:\000\000\002G\000\000\000\253\000\000\000\000\000\000\000\000\002\136\002F\002D\002E\000\000\000\000\000\000\002G\000\000\000\252\000\000\000\000\000\000\000\000\002\135\000\000\001\146\000\000\000s\000\000\003W\000\000\000$\000\000\000\000\000\000\000\000\000\151\000\000\001\002\000\001\000\000\000\000\001\005\000\002\000\000\000\000\000\000\001q\001r\000\003\000\000\000\000\000\000\000\000\001t\001u\001s\000\021\001p\000\022\000\000\002\001\000\000\000\004\000\000\002\002\000\000\000\005\000\000\002\003\000\000\000\000\002\004\000\006\000\000\000\007\000\000\002\005\000\000\000\b\000\000\002\006\000\000\000\t\000\000\002\007\000\000\000\n\000\000\002\b\000\000\000\011\000\000\002\t\000\000\000\000\002\n\000\012\000\000\000\000\002\011\000\r\000\000\000\000\000\000\000\000\000\000\003/\003*\003+\003.\003,\000\000\0033\000\014\000\000\0032\000\000\001Q\000\000\000\000\0030\000\000\0031\000\000\000\000\000\000\000\000\001U\001V\000\000\000\000\001T\001S\000\015\000\000\000\000\000\000\003M\000\000\003L")
and error =
- (127, "'\225 \197\138\173\2433\208\020\007\242(\000q\192F\194\000\139\133\027\226O\160\b\015\128P\000c\129\247\217\016 \191\141@\0010p=\199\005\129A\160\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\250\217\189f\235\252\205\255%C\252J\136<\240>\251\"\004\023\241\168\000&\014\007\184\224\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\001\022\n7\196\159@\016\031\000\160\000\199\003\239\178 A\127\026\128\002`\224{\142\011\002\131B~\018-X\170\2233=\001@\127\002\128\015\028\000\000\000\000\b\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\0000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\000\000\000\000\000\000\000\000\000\000\128\007\224\012$\000\003\226\016\b\016\002\005\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000`\000\014\002\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000X\011:\000\131%!\192\193\145\003\176\"D\"\128\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\224 A\139\132\000\002\000\000\000\000\000\000\004\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\004\002\012\016@\000\000\128\000\000\000\000\000 \b\b\000\004\024 \128\000\001\000\000\000\000\000\000@\016\016\000\b0@\000\000\002\000\000\000\000\000\"@\021@\004\024I\014\000\b\128\029\129\003 \004\004\128 \128\b \002\020\000\016\0001\000\000@\000\t\000A\000\016@\004 \000 \000b\000\000\128\000\012\000\000\147\004\019\000\016\002\000\000\000\000\000\004\000\024\000\001$\b&\000 \004\000\000\000\000\000\b\0000\000\002H\016L\000\000\b\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\001\000\004\000\000@\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001$\000 \000\000\004\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\004\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\128\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000$\001\020\016A\000\016\192\000\128\001\216\001\018\000@2\000\007\129\000\012\\(\000\016\004\000@\000 \000\144\004P\001\132\018C\128\002 \006`D\024A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\144\0008\b\000b\225@\000\128 \002\000\001\000\003\000\bp\016 \197\194\000\001\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\022\002\238\000 \201Hp0D@\236\000\179\b\176\024\000\003\000\000\006.\016\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\012\000\000\024\184@\000\"\000\000\128\000\000\000@\004\000\000\000\016\000\000\000D\000\000\000 \000\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000}\246D\b/\227P\000L\028\015q\193`PhO\194E\171\021[\230g\160(\015\224P\001\227\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\002L\016L\000@\b\000\000\000\000\000\016\000`\000\004\144 \152\000\128\016\000\000\000\000\000 \000\192\000\t A0\000\000 \000\000\000\000\000@\001\128\000\018@\002`\000\000@\000\000\000\000\000\128\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\t\000E\004\016@$0\000\"\000v\000@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\144\192\000\136\001\152\001\002\000G\223d@\130\2545\000\004\193\192\247\028\022\005\006\132\252$Z\177U\190fz\002\128\254\005\000\0308\b\216@\017p\163|I\244\001\001\240\n\000\012p\017\176\128\"\193F\248\147\232\002\003\224\020\000\024\224#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\001\016\n\003\004\142@\000\003\000\160\000\198\000 \000\004\002\000\020\016\160`\000\000\b\001\000\000\000@\000\b\000\000(!@\192\000\000\016\002\000\000\000\128\000\016\000\000PB\001\128\000\000 \004\000\000\000\200@\016 \0010H\180\000@4\000\000\b \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200b\017\248\0119H\180\248\1966\004\000\201e\128\000\004\000\000\000\000\000\b\000\000@\000\000\000\000\003\000\000\000@\000\000\004\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128 \000\016`\128\000\000\004\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\012\b\001\000\000\002\004\016\000\000 \000\000\000\000\000\024\016\002\000\000\004\b\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\252$\024\177U\190f\250\002\128\254%\000\0148\t\248H1b\171|\204\244\005\001\252J\000\028p\019\240\145b\197V\249\153\232\n\003\249\148\0008\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\016\002\002\000\004\b \000\000@\000\000\000\b\0000 \004\004\000\b\016@\000\000\128\000\000\000\000\000`@\b\000\000\016 \128\000\001\000\000\000\000\000\000\192\128\016\000\000 @\000\000\002\000\000\000\000\000\003\129\000 \000\000@\128\000\000\004\000\000\000\000\000#a\000E\130\141\241'\208\004\007\192(\0001\192F\194\000\139\005\027\226G\160\b\015\128P\000c\128\004\000\000\001\000\001\000\016\000\000\000\000\000\000\000\000\b\000\000\000\000\002\000 \000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\128\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\253n\255\179}\254\255\255\147\163\254e\132\014y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000F\194\000\139\133\027\226O\160\b\015\128P\000c\128\141\132\001\022\n7\196\159@\016\031\000\160\000\199\001\027\b\002,\020o\137\030\128 >\001@\001\142\0026\024\132~*\223R=>a|\131\1283]`d!\b\128P\024$r\000\000\024\005\000\0060\b\216@\017`\163|H\244\001\001\240\n\000\014p#\222\221\235\253_o\159\223\253\184}\253\183\255\207#a\000E\130\141\241#\208\004\007\192(\0001\192\006B\000\129\000\t\130E\160\002\001\128\000\000A\000\012\132\001\002\000\019\004\139@\004\003@\000\000\162\000\025\b\018\004\000&\t\022\128\b\006\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\"\000\000\000\000\000\000\000\000\016\000\001\000\000\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\014\002\000\024\184@\000 \000\000\000\000\016\000\192\000\156\004\0001p\128\000@\000\000\000\000\160\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\128\006\000\000\224 \001\139\132\000\002\000\000\000\000\005\000\004\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\028\004\0001p\128\000@\000\000\000\000 \000\128\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\018\000\238\000 \200Hp0D@\236\000\177\b\176\024\000\003\128\128\006.\016\000\b\000\000\000\000\000\004H\011\184\000\131!!\192\193\017\003\176\002\196\"\192`\000\012\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\192\194\000\000\000\000\000\000\000\000\006\000\000\224 A\139\132\000\002\000\000\000\000\000\000\012\000\001\128\000\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002,\005\220\000A\146\144\224`\136\129\216\001b\017`0\000\006\000\000\012\\ \000\016\000\000\000\000\000\b\176\023p\001\006JC\129\130\"\007`\005\136E\128@\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\144\007p\001\006BC\129\130\"\007`\005\136E\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\022\002\238\000 \201Hp0D@\236\000\177\b\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\016\000\000\016\000\000@\000\000\000\b\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\014\002\000\024\184@\000 \000\000\000\000\000\000\000\000\128\000\000\000\001\000\000\004\000\000\000\000\129\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\016\000\000\000\002$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000@\000\000\000\b\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\001\000\000\000\000 \000\000\000@\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\128\000\000\004\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\002\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000@\000\000\000\128\000\000\000\000\000\002 \000\000\000\000\000\000\000\001\000\000\000\000\000\200@\016 \0010H\180\000@4\000\000\b \001\144\128 `\002`\147H\000\128`\000\000\016@\003!\000@\128\004\193&\144\001\000\192\000\000 \128\006B\000\129\000\t\130E \002\001\128\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e#j\018\002\152$\214\000 \025@\129\181T\000\000@\000 \001\000\000\004\000\000 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000L\164mB@S\004\155\192\004\003h\b6\170\128\b\000\000\000\000\004\001\020\000\000\000\000\000\000\000\0002\016\132\b\000L\018-\000\016\r\000\000\018\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\0160\0010I\180\000@4\000\000\b \001\144\128 @\002`\147h\000\128h\000\000\016@\003!\000@\128\004\193\"\208\001\000\208\000\000 \128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\216\000\000\128\000 \000\000\000P\000LQ\0002\016\004\b\000L\018-\000\016\r\000\000\002\b\002\000\003`\000\002\000\000\128\000\000\001@\0011D\000\200@\016 \0010H\180\000@4\000\000\b \b\000\r\128\000\b\000\002\000\000\000\005\000\004\197\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000&B6\129\000)\130M\160\002\001\180\000\019U@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0012\017\180\b\001L\018m\000\016\r\160\000\154\170\000t1\b\252\005\156\164Z|b\027\002\000d\178\192\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000 \000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\001\002\000\019\004\138@\004\003\000\000\000\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\004\000\000 \000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\b\000\000\000\000\000\019\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\025\b\002\004\000&\t\022\128\b\006\128\000\001\004\001\000\001\176\000\001\000\000@\000\000\000\160\000\152\162\000`\000\014\002\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\000\208\000\000 \128 \0006\000\000 \000\b\000\000\000\020\000\019\020@\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000\t\002 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\t\002\000\019\004\139@\004\003@\000\000\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\000\000\000\001\000\000\000\000\000\002B\136\001\144\129 @\002`\145h\000\128h\000\000\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\000\000\000\000\016\000\000\000\000\000$\b\128\000\000\136\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\016\000\000\004\000\000\000\000\000\000\000\000\000\000\000\002 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018k\000\144\012\128\000\154+\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\004\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\016\000\000\000\000\b\000\000\000\016\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\004\000\000\000\000#a\000E\130\141\241#\208\004\007\192(\0001\192\006B\b\129\144I\130M\160\002\001\160\000\000A\000\012\b\001\001\000\002\004\016\000\000 \000\000\000\004\000\024\016\002\002\000\004\b \000\000@\000\000\000\000\0000 \004\000\000\b\016@\000\000\128\000\000\000\000\000`@\b\000\000\016 \000\000\001\000\000\000\000\000\000\000\000\000\000\000 \001\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\b\002\002\000\001\006\b\000\000\000@\000\000\000\000\000\016\004\132\000\002\012\016\000\000\000\128\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000@\016\016\000\b0@\000\000\002\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017 \n\160\002\012\004\135\000\004@\014\192\001\016\002\000@\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\001\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\b\000\000\024\000\003\192\128\006.\016\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\014\002\000\024\184@\000 \000\000\000\000\000\017 \n\160\002\012\004\135\000\004@\014\192\001\016\n\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000D\128*\128\b0\018\028\000\017\000;\000$@(\137\000U\000\016`$8\000\"\000v\000H\128\016\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000@\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\b\144\005P\001\006\002C\128\002 \007`\004\136\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\000\000\004\001\001\000\000\131\004\000\000\000 \000\000\000\000\002$\001T\000A\128\144\224\000\136\001\216\000\"\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000@\000\000\000@\000\000\000\000\016\000\000\000\000\000\000\000\000\000\"@\021@\004\024I\014\000\b\128\029\129\003 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\000\128\000\000\000\000\b\144\005P\001\006\002C\128\002 \007`\000\136\001\000@\016\016\000\b0@\000\000\002\000\000\000\000\000\"@\021@\004\024\t\014\000\b\128\029\128\002 \004\000\000\000\000\000\000\000\000\000\000\000\b\002\002\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\018\000\170\000 \194Hp\000D\000\236\b\017\000 \b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\144\005P\001\006\018C\128\002 \007`@\136\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\"@\021@\004\024\t\014\000\b\128\029\128\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002$\001T\000A\128\144\224\000\136\001\216\000\"\000D\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\002\000\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\006\004\000\128\000\001\002\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002$\001T\000A\132\144\224\000\200\001\216\000&\000@p \132\000\000\b\016\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000 \001\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\b\000\000\000\000\000\128\000\016\000\000 \000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\144\005P\001\006\018C\128\003 \007`@\152\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\004\000\000\000\000\000\000#a\000E\130\141\241#\208\004\007\192(\0001\192F\194\004\139\005\027\226G\160\b\015\128P\000c\128\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\002\000@\000\000\000\0026\016\004X(\223\018=\000@|\002\128\003\028\000d \b\128P\024$r\000\000\024\005\000\0060\016\000\004@\000\000\000\000\000\000\192\002\004\129 \000\001\144\128\"\001@`\145\200\000\000`\020\000\024\192#a\000E\130\141\241#\208\004\007\192(\0001\192\006B\000\136\133\001\130O \000\001\128P\000c\000\012\132\001\016\n\003\004\158@\000\003\000\160\000\198\000\025\b\002 \020\006\t\028\128\000\006\001@\001\140\0026\016\004\\(\223\018}\000@|\018\128\003\028\004l \b\176Q\190$\250\000\128\248%\000\0068\b\216@\017`\163|H\244\001\001\240J\000\012p\017\176\128\"\225F\248\147\232\002\003\224\020\000\024\224#a\000E\130\141\241'\208\004\007\192(\0001\192F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\000d \b\016\000\152$Z\000 \026\000\000\004\016\004\000\000\000\000\004\000\001\000\000\000\000\000\002@\136\017\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003)\000P\208\004\193&\176\001\000\192\000\000 \128\006R\000\161 \t\130M`\002\001\128\000\000A\000\012\164\001B@\019\004\138\192\004\003\000\000\000\130\000\016\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000d \b\016\000\152$Z\000 \026\000\000\004\016\000\000\002\000\000\000\000\001\000\000\000\002\000\002`\136\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\b\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\232b\017\248\0119H\180\248\1966\004\000\201e\128\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\001\002\000\019\004\138@\004\003\000\000\000\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000e \n\018\002\152$V\000 \025\000\000\148\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\128\000\006\000\000\192\000\001\139\132\000\002\000\000\000\000\000\000\004\000\000\000\000A\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@|\002\128\003\028\000d \b\024\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010I\180\000@4\000\000\b\160\001\144\128 @\002`\145h\000\128h\000\000\017@D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\192\200@\016 \0010H\180\000@4\000\000\b \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006B\000\129\128\t\130M\160\002\001\160\000\000A\000\012\132\001\002\000\019\004\155@\004\003@\000\000\130\000\025\b\002\004\000&\t\022\128\b\006\128\000\001\004\000\000\000\000\000\000\000\000@\000\000\000\128\000\144\"\004l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\017\000\1600H\228\000\0000\n\000\012`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002=\237\222\191\213\246\185\253\255\219\135\223\219\127\253\240\016\000\000\000\000\012\0028\000\000\000\000\000\000\000\004l1\b\252U\190\164z|\194\249\007\000f\186\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\176\132\"\193F\248\145\232\002\003\224\020\000\024\224#a\bE\130\141\241#\208\004\007\192(\0001\192\006\004\000\128\128\001\002\b\000\000\016\000\000\000\000\000\012\b\001\000\000\002\004\016\000\000 \000\000\000\000\000\024\016\002\000\000\004\b\000\000\000@\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\b\000\000 \b\b\000\004\024 \000\000\001\000\000\000\000\000\016\000\002\000\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\bE\130\141\241#\208\004\007\192(\0001\192F\194\016\139\005\027\226G\160\b\015\128P\000c\128\012\132!\002\000\019\004\139@\004\003\000\000\000\130\000\000\000\000\000\000\000\000 \000\000\000@\000L\017\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\001\000\000\000\000\b\216@\017`\163|H\244\001\001\240\n\000\012p\001\144\128\"!@`\147\200\000\000`\020\000\024\192\003!\000D\002\128\193'\144\000\000\192(\0001\128\006B\000\136\005\001\130G \000\001\128P\000c\001\018R\238\015\160\248Xp?\237\192\239M\1918x\025\b\002 \020\006\t\028\128\000\006\001@\001\140\004{\219\189\127\171\237s\251\255\183\015\191\182\255\251\224\000\000\000\000\000\016\000P\000\000\000\000\000\000\000\b\216@\017`\163|H\244\001\001\240\n\000\012p\001\144\128 `\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130E\160\002\001\160\000\000E\000\000\000l\000\000\000\000\000\000\000\000\000\000 (\001\027\bZ,\020o\137\030\128 >\001@\001\206\0026\016\004X(\223\018=\000@|\002\128\003\028\000d \b\024\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010I\180\000@4\000\000\b\160\001\144\128 @\002`\145h\000\128h\000\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\143{w\175\245}\174\127\127\246\225\247\246\223\255<\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\000\000`\000\014\002\000\024\184@\000 \000\000\000\000\000\000\000\006@\000\000\000\001\000\000\000\002\000\000\000\000\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000\000\000\025\000\000\000\000\004\000\000\000\b\000\004\000\000\006\000\000\224 \001\139\132\000\002\000\000\000\000\000\000\000\000d\000\000\000\000\016\000\000\000 \000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000D\002\128\193#\144\000\000\192(\0001\128\143{w\175\245}\174\127\127\246\225\247\246\223\255|\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000(\000\000\000\000\000\000\000\004l \b\176Q\190$z\000\128\248\005\000\0068\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209\239n\245\254\175\181\207\239\254\220>\254\219\255\231\162J]\193\244\031\011\014\007\253\184\029\233\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\132l \b\176Q\190$z\000\128\248\005\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003!\000@\192\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\139@\004\003@\000\000\138\002$\165\220\031A\240\176\224\127\203\129\222\011~p\244IK\184>\131\225a\192\255\151\003\188\022\252\225\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\239n\245\254\175\181\207\239\254\220>\254\219\255\231\162J]\193\244\031\011\014\007\253\184\029\233\183\231\015#a\000E\130\141\241#\208\004\007\192(\0001\192\006B\000\129\128\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t\022\128\b\006\128\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\025\253n\241\250\175\253\207\247\255]\254\250[\255\247\190\251\"\004\023\241\168\000&\014\007\184\224\176(4#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\0002\016\004\012\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010H\180\000@4\000\000\b\160\"J]\193\244\031\011\014\007\252\184\029\224\183\231\015D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003!\000@\192\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\139@\004\003@\000\000\138\002$\165\220\031A\240\176\224\127\203\129\222\011~p\244IK\184>\131\225a\192\255\151\003\188\022\252\225\228l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\0160\0010I\180\000@4\000\000\b\160\001\144\128 @\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193\"\208\001\000\208\000\000\"\128\137)w\007\208|,8\031\242\224w\130\223\156=\018R\238\015\160\248Xp?\229\192\239\005\1918y\027\b\002,\020o\137\030\128 >\001@\001\142\0002\016\004\012\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010H\180\000@4\000\000\b\160\"J]\193\244\031\011\014\007\252\184\029\224\183\231\015D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003!\000@\192\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\139@\004\003@\000\000\138\002$\165\220\031A\240\176\224\127\203\129\222\011~p\244IK\184>\131\225a\192\255\151\003\188\022\252\225\228l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\0160\0010I\180\000@4\000\000\b\160\001\144\128 @\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193\"\208\001\000\208\000\000\"\128\137)w\007\208|,8\031\242\224w\130\223\156=\018R\238\015\160\248Xp?\229\192\239\005\1918y\027\b\002,\020o\137\030\128 >\001@\001\142\0002\016\004\012\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010H\180\000@4\000\000\b\160\"J]\193\244\031\011\014\007\252\184\029\224\183\231\015D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003!\000@\192\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\139@\004\003@\000\000\138\002$\165\220\031A\240\176\224\127\203\129\222\011~p\244IK\184>\131\225a\192\255\151\003\188\022\252\225\228l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\0160\0010I\180\000@4\000\000\b\160\001\144\128 @\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193\"\208\001\000\208\000\000\"\128\137)w\007\208|,8\031\242\224w\130\223\156=\018R\238\015\160\248Xp?\229\192\239\005\1918y\027\b\002,\020o\137\030\128 >\001@\001\142\0002\016\004\012\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010H\180\000@4\000\000\b\160\"J]\193\244\031\011\014\007\252\184\029\224\183\231\015D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003!\000@\192\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\139@\004\003@\000\000\138\002$\165\220\031A\240\176\224\127\203\129\222\011~p\244IK\184>\131\225a\192\255\151\003\188\022\252\225\228l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\0160\0010I\180\000@4\000\000\b\160\001\144\128 @\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193\"\208\001\000\208\000\000\"\128\137)w\007\208|,8\031\242\224w\130\223\156=\018R\238\015\160\248Xp?\229\192\239\005\1918y\027\b\002,\020o\137\030\128 >\001@\001\142\0002\016\004\012\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010H\180\000@4\000\000\b\160\"J]\193\244\031\011\014\007\252\184\029\224\183\231\015D\148\187\131\232>\022\028\015\249p;\193o\206\030F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003!\000@\192\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\139@\004\003@\000\000\138\002$\165\220\031A\240\176\224\127\203\129\222\011~p\244IK\184>\131\225a\192\255\151\003\188\022\252\225\228l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\0160\0010I\180\000@4\000\000\b\160\001\144\128 @\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193\"\208\001\000\208\000\000\"\128\137)w\007\208|,8\031\242\224w\130\223\156=\018R\238\015\160\248Xp?\229\192\239\005\1918x\025\b\002\004\000&\t6\128\b\006\000\000\001\004\0002\016\004\b\000L\018-\000\016\012\000\000\002\b\000\245$Z\019\004\154g\214\003 \031`\001\188U\b\216@\017`\163|H\244\001\001\240\n\000\012p\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\128\000\000\000\004l \b\176Q\190$z\000\128\248\005\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000@\000\000\000\0026\016\004X(\223\018=\000@|\002\128\003\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\017\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004l \b\176Q\190$z\000\128\248\005\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\016\000\019\004@\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000@\000\000\000\0026\016\004X(\223\018=\000@|\002\128\003\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\002\000\002@\136\017\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006B\000\129\000\t\130E\160\002\001\160\000\000A\000\000\000\000\000\000\000\000\016\000\000\000 \000$\b\128\025\b\002\004\000&\t\022\128\b\006\128\000\001\004\000\000\000\000\000\000\000\000@\000\000\000\128\000\144\"\000d \b\016\000\152$Z\000 \026\000\000\004\016\000\000\000\000\000\000\000\001\000\000\000\002\000\002@\136\000\000\000\000\000\000`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000@\000H\017\0002\016\004\b\000L\018-\000\016\r\000\000\002\b\000\000\000\000\000\000\000\000\128\000\000\001\000\001 D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\017@\004\016\t\012\000\012\128\025\128\000 \004\004\128\"\128\b\"\018\024\012\025\0003\000 @\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004IK\184>\131\225a\192\255\151\003\188\022\252\225\228l \b\176Q\190$z\000\128\248\005\000\0068\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\004l \b\176Q\190$z\000\128\248\005\000\0068\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\155\003\224\012\004\004\003\224\016\b\000\011\012\006F\194\022\139\005\027\226G\160\b\015\128P\000s\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\017`\163|H\244\001\001\240\n\000\012p\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\001\016\n\003\004\142@\000\003\000\160\000\198\002=\237\222\191\213\246\185\253\255\219\135\223\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\004l \b\176Q\190$z\000\128\248\005\000\0068\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000#\222\221\235\253_o\159\223\253\184}\253\183\255\207#a\000E\130\141\241#\208\004\007\192(\0001\192\006B\000\129\128\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t\022\128\b\006\128\000\001\020\004IK\184>\131\225a\192\255\151\003\188\022\252\225\232\146\151p}\007\194\195\129\255.\007x-\249\195\200\216@\017`\163|H\244\001\001\240\n\000\012p\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\190\223?\191\251p\251\251o\255\158F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\143{w\175\245}\190\127\127\246\225\247\246\223\255<\141\132\001\022\n7\196\143@\016\031\000\160\000\199\000\025\b\002\006\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$Z\000 \026\000\000\004P\017%.\224\250\015\133\135\003\254\\\014\240[\243\135\162J]\193\244\031\011\014\007\252\184\029\224\183\231\015\001\000\000\000\000\000\192\002\128\000\000\000\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\002=\237\222\191\213\246\249\253\255\219\135\223\219\127\252\2426\016\004X(\223\018=\000@|\002\128\003\028\000d \b\024\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010I\180\000@4\000\000\b\160\001\144\128 @\002`\145h\000\128h\000\000\017@D\148\187\131\232>\022\028\015\249p;\193o\206\030\137)w\007\208|,8\031\242\224w\130\223\156<\141\132\001\022\n7\196\143@\016\031\000\160\000\199\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\004{\219\189\127\171\237\243\251\255\183\015\191\182\255\249\228l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\0160\0010I\180\000@4\000\000\b\160\001\144\128 @\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193\"\208\001\000\208\000\000\"\128\137)w\007\208|,8\031\242\224w\130\223\156=\018R\238\015\160\248Xp?\229\192\239\005\1918y\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\b\247\183z\255W\219\231\247\255n\031\127m\255\243\200\216@\017`\163|H\244\001\001\240\n\000\012p\001\144\128 `\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130E\160\002\001\160\000\000E\001\018R\238\015\160\248Xp?\229\192\239\005\1918z$\165\220\031A\240\176\224\127\203\129\222\011~p\240\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000\b\216@\017`\163|H\244\001\001\240\n\000\012p\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\190\223?\191\251p\251\251o\255\158F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\209%.\224\250\015\133\135\003\254\\\014\240[\243\135\145\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\143{w\175\245}\190\127\127\246\225\247\246\223\255<\141\132\001\022\n7\196\143@\016\031\000\160\000\199\000\025\b\002\006\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$Z\000 \026\000\000\004P\017%.\224\250\015\133\135\003\254\\\014\240[\243\135\162J]\193\244\031\011\014\007\252\184\029\224\183\231\015#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\030\246\239_\234\251|\254\255\237\195\239\237\191\254y\027\b\002,\020o\137\030\128 >\001@\001\142\0002\016\004\012\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$\218\000 \026\000\000\004P\000\200@\016 \0010H\180\000@4\000\000\b\160\"J]\193\244\031\011\014\007\252\184\029\224\183\231\015D\148\187\131\232>\022\028\015\249p;\193o\206\030\143{w\175\245}\190\127\127\246\225\247\246\223\255<\141\132\001\022\n7\196\143@\016\031\000\160\000\199\000\025\b\002\006\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018m\000\016\r\000\000\002(\000d \b\016\000\152$Z\000 \026\000\000\004P\017%.\224\250\015\133\135\003\254\\\014\240[\243\135\162J]\193\244\031\011\014\007\252\184\029\224\183\231\015G\189\187\215\250\190\215?\191\251p\251\251o\255\190\143{w\175\245}\174\127\127\242\225\247\210\223\255<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\004\000\004\129\016#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000A\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000d \b\016\000\152$Z\000 \024\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\bD\002\128\193#\144\000\000\192(\0001\128\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\176\129\"\193F\248\145\232\002\003\224\020\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\017\000\1600H\228\000\0000\n\000\012` \000\000\000\000\000\000\000\000\001\128\000\t\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\000\000\000\000\000\000\000\000 \000\018\000\000\000\000\136\000\000\000\000\000\000\000\000@\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000 \000 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\012\000\000H\000\000\000\b\000\000\000\000\006\001\028\000\000\000\000\000\000\000\004\000\001\016\000\000\000\000\000\0000\000\129 H\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017%.\224\250\015\133\135\003\254\\\014\240[\243\135\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\b\002,\020o\137\030\128 >\001P\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\"J]\193\244\031\011\014\007\252\184\029\224\183\231\015\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\132\001\003\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t6\128\b\006\128\000\001\020\0002\016\004\b\000L\018-\000\016\r\000\000\002(\b\146\151p}\007\194\195\129\255.\007x-\249\195\200\216@\017`\163|H\244\001\001\240\n\000\012p\001\144\128 `\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130E\160\002\001\160\000\000E\001\018R\238\015\160\248Xp?\229\192\239\005\1918z$\165\220\031A\240\176\224\127\203\129\222\011~p\244IK\184>\131\225a\192\255\151\003\188\022\252\225\228l \b\176Q\190$z\000\128\248\005\000\0068\000\200@\0160\0010I\180\000@4\000\000\b\160\001\144\128 @\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193\"\208\001\000\208\000\000\"\128\137)w\007\208|,8\031\242\224w\130\223\156=\018R\238\015\160\248Xp?\229\192\239\005\1918x\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017%.\224\250\015\133\135\003\254\220\014\244\219\243\135\129\144\128 `\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130E\160\002\001\160\000\000E\000\000\000\000\000\000\000\000\000\000\000\128\000\000 \b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000>\000\192@@>\003\000\128\000\176@`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\239n\245\254\175\181\207\239\254\220>\254\219\255\239\128\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006B\000\129\128\t\130M\160\002\001\160\000\000E\000\012\132\001\002\000\019\004\155@\004\003@\000\000\138\000\025\b\002\004\000&\t\022\128\b\006\128\000\001\020\000\000\001\016\000\000\000\000\000\000\004\000\000\000\128 \000\000\018 |\001\128\128\128|\n\001\000\001`\128\192\000\004\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000 \000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000 \000\000@\130\000\000\004\000\000\000\000\000\003\002\000@\000\000\129\000\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\b\000\016\000\000\000\000\000\000\141\132\001\022\n7\196\143@\016\031\000\160\000\199\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\004\000\000\000@\000\000\000\000\000\000\000\000`\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\004\000\000@\000\003\002\000@\000\000\129\000\000\000\b\000\000\000\000\000\t\000E\000\016A$8\0002\000f\000\000\128\016\004\001\001\000\000\131\004\000\000\000 \000\000\000\000\002\000\000\000\000\000\128\000 \000\000\000@\000\000\000\0000 \004\000\000\b\016\000\000\000\128\000\000\000\000\000\144\004P\001\004\018C\128\003 \006`\000\b\001\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\017\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\000\002\000\004\0000\000\000\002\000\000\000\000\000\018\000\000\000\000\b\000`\000\000\004\000\000\000\000\000$\000\000\000\000\016\000@\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000 \000@\000\000\000\004\000\0000\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000\b\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\006\000\000\224 \001\139\132\000\002\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\b\000\000\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\000\000\000\001\016\000\000\000\000@\000\001\000\000\000\000\002\000\000\002 \000\000\000\000\128\000\000\000\000\000\000\000\000\000\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000 \002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\"\000\000\000\000\b\000\000 \000\000\000\000@\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\011\001E\000\016`\1648\0002\000f\000@\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000,\005\020\000A\002\144\224\000\200\001\152\001\002\016@0\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000@\000\000\000\192\000\024\000\0001p\160\000@\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\011\000E\000\016@\1648\0002\000f\000@\132\016\022\002\138\000 \193Hp\000d\000\204\000\129\b \000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\176\004P\001\004\nC\128\003 \006`\004\bA\001`(\160\002\012\020\135\000\006@\012\192\b\016\130\000\000\000\000\000\000\000\002\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016D\b\000L\018m\000\016\012\000\000\002\b\000d \136\016\000\152$Z\000 \024\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\144\128 @\002`\145h\000\128`\000\000\016@\004\128\"\128\b \018\024\000\025\0003\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\144\128 `\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130E\160\002\001\160\000\000E\001\018R\238\015\160\248Xp?\229\192\239\005\1918z$\165\220\031A\240\176\224\127\203\129\222\011~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000@@\000\129\004\000\000\b\000\000\000\000\000\006\004\000\128\000\001\002\b\000\000\016\000\000\000\000\000\012\b\001\000\000\002\004\000\000\000 \000\000\000\000\000\000\000@\000\000\004\000 \000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \b\b\000\004\024 \000\000\001\000\000\000\000\000\016\000\002\000\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\004\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000d \b\016\000\152$Z\000 \026\000\000\004P\017%.\224\250\015\133\135\003\254\\\014\240[\243\135\129\144\128 `\002`\147h\000\128h\000\000\017@\003!\000@\128\004\193&\208\001\000\208\000\000\"\128\006B\000\129\000\t\130E\160\002\001\160\000\000E\000\000\000 \000\000\000\000\000\000\000\000\000\0002\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\000\128\000\000\000\000\b\000\001\000\000\002\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128 \000\016`\128\000\000\004\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\001\000\000\131\004\000\000\000 \000\000\000\000\002\000\000@\000\000\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000|\001\128\128\128|\002\001\000\001\240\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128 \000\016`\128\000\000\004\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\001\000\000\131\004\000\000\000 \000\000\000\000\002\000\000@\000\000\128\000 \000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \b\b\000\004\024 \000\000\001\000\000\000\000\000\016\000\002\000\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \146\028\000\017\0003\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\b\001\000\000\002\004\016\000\000 \000\000\000\000\000\024\016\002\000\000\004\b\000\000\000@\000\000\000\000\000H\002(\000\130\t!\192\001\016\0030\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\224\001\000\016\000\000\001\000\000\000\000\000\000\000\000\000\128\000\000 \000 \002\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\018\000\138\000 \128H`\000D\000\236\000\001\000\000\b\002\002\000\001\006\b\000\000\000@\000\000\000\000\004H\002(\000\131\001!\192\001\016\0030\000\004\000\000\144\004P\001\004\002C\000\002 \006`\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\128\002\000\000\000\000\002\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000 \000\002\000\000$\001\020\000A\000\144\192\000\136\001\152\000\002\000@H\002(\000\130\001!\000\001\016\0030\000\004\000\128`\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\004\000\000@\000\004\128\"\128\b \018\024\000\017\0003\000\000@\b\t\000E\000\016@$ \000\"\000f\000\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\b\000\000\144\004P\001\004\002C\000\002 \006`\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\251\"\004\023\241\168\000&\014\007\184\224\176(4'\225\"\213\138\173\2433\208\020\007\240(\000\241\192\006B\000\129\000\t\130E\160\002\001\160\000\000A\000@\000\b\000\000\000\000\016\000\000\000\000\000$\b\129\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\190\200\129\005\252j\000\t\131\129\2388,\n\r\t\248H\181b\171|\204\244\005\001\252\n\000<p\001\129\000 \000@\130\000\000\004\000\000\000\000\000\003\002\000@\000\000\129\004\000\000\b\000\000\000\000\000\006\004\000\128\000\001\002\000\000\000\016\000\000\000\000\000\018\000\138\000 \130Hp\000D\000\204\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\004\000\000\000\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000$\001\020\000A\016\144\224`\136\001\216\001\002\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\001 H\160\002\b\004\134\000\004@\012\192\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \018\024\000\017\0003\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\138\000 \136Hp0D\000\236\000\129\000\000\t\000\000\002\000\004\0000\000\000\002\000\000\000\000\000\018\000\000\000\000\b\000`\000\000\004\000\000\000\000\000$\000\000\000\000\016\000@\000\000\b\000\000\000\000\001 \b\160\003\b\004\135\000\004@\014\192\0000\000\000\144\000\000\000\000@\001\000\000\000 \000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\000\t\000E\000\016@$8\000\"\000f\004\000\132\000\004\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000H\002(\000\130\001!\192\001\016\0030\000\004\000\000\144\004P\001\004\002C\000\002 \006`\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\017@\004\016\t\014\000\b\128\025\128\000 \000\004\128\"\128\b \018\024\000\017\0003\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\030\000\139\192`\131\031H\000D\000\192\000\001\000\000$\001\020\000A\000\016\128\000\128\001\152\000\002\000\000\016\000\000\004\000\000\000@\000\000\000\000\000\000\016\000 \000\000\b\000\000\000\128\000\000\000\000\000\000\000\000@\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \130\024\000\016\0003\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002(\000\130\b!\128\001\000\0030 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\224\001\000\016\000\000\001\000\000\000\000\000\000\000\000\000\128\000\000 \000 \002\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\018\000\138\000 \128\b`\000@\000\236\000\t\000\000\b\002\002\000\001\006\b\000\000\000@\000\000\000\000\004H\002(\000\131\000!\192\001\000\0030\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\001\000\000\000\000\001\000\000\000\000\000\000\000\000\001\128\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\b\000\002\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\138\000 \130\b`\000@\000\204\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000@\016\016\000\b0@\000\000\002\000\000\000\000\000\"@\017@\004\024\001\014\000\b\000\025\128\000 \004\004\128\"\128\b \002\016\000\016\0003\000\000@\b\006\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\000\128\000\000\000\000\b\144\004P\001\006\000C\128\002\000\006`\000\b\001\001 \b\160\002\b\000\132\000\004\000\012\192\000\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\016\000\001\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\016\192\000\128\001\152\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \b\b\000\004\024 \000\000\001\000\000\000\000\000\017 \b\160\002\012\000\135\000\004\000\012\192\000\016\000\002@\017@\004\016\001\012\000\b\000\025\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\002\002\002\001\006\b \000\000@\000\000\000\000\000\016\004\004\000\002\012\016@\000\000\128\000\000\000\000\000 \b\b\000\004\024 \000\000\001\000\000\000\000\000\017 \b\160\002\012\000\135\000\004\000\012\192\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\128\006\000\000\000@\000\000\000\000\002@\000\000\000\001\000\012\000\000\000\128\000\000\000\000\004\128\000\000\000\002\000\b\000\000\001\000\000\000\000\000$\001\020\000a\000\016\224\000\128\001\152\000\006\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\001\000\000\000\b\000\b\000\192\000\000\000\000\000\000\000\002\000\000\000\000\000\016\001\128\000\000\000\000\000\000\000\004\000\000\000\000\000 \001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\b\000\000\146\000\016\000\000\002\000\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000 \001\000(\129\000\000\000\000\000\000\000\000\004\000\000\128\000\002\130\020\004\000\000\001\000 \000\000\b\000\001\000\000\005\004 \b\000\000\002\000@\000\000\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\000\000@\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\016\000\000@B\000\128\000\000 \004\000\000\002\000\000\000\000\016\016\001\000\000\000\000\000\000\000\000\004\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\000\028\004\0001p\128\000@\000\000\000\000\000\002\000\000@\000\001\001\014\002\000\000\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\016\000\000\128\b\000\000\000\000\000\000\000\000 \000\000 \000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\006\000\000\224 \001\139\132\000\002\000\000\000\000\000\000\016\000\002\000\000\b\b`\016\000\000\004\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\000 \005\016`\000\000\000\000\000\000\000\000 \000\b\000@\n @\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\002\000\000\000\000\000\000\000\128\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\b\000\000\000\b\000\002\000\016\002\136\016\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\001\000\000\000@\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\b\000\000\000\000\000\016\000\000\000\000\b\000\000\000\000\016\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\005P\001\004BC\128\130 \007`\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\002\000\000\000\002\000\000\128\004\000\162\004\000\000\000\000\000\000\000\000\018\000\170\000 \136Hp\016D\000\236\000\129\000 \000\004\000\000\016\016\224 \000\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\014\002\000\024\184\192\000 \000\000\000\000\000\000\192\000\028\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\004\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\b\000\001\000\000\004\0048\024\000\000\002\000@\000\000\016\000\002\000\000\b\b`\016\000\000\004\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000 \000\000\128\134\001\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\000\000\004\004 \b\000\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\144\224\000\136\001\152\000\002\000@H\002(\000\130\001!\000\001\016\0030\000\004\000\129\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\002\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000 \001\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\001\000\b\001D\b\000\000\000\000\000\000\000\000$\001\020\000A\000\144\224\000\136\001\152\000\002\000@H\002(\000\130\001!\000\001\016\0030\000\004\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000 \003\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\000\176\021P\001\006\bC\128\002 \007`\000\024\001\000\192\000\024\000\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\000\006\000\000\224 \001\139\132\000\002\000\000\000\000\005\000\000\000\b\000\000\000\000\016\000\000\000\000\000 \b\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\000`\000\012\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\001\128\0008\t\000j\225\000\000\128\000\000\000\000\000\005\128\170\128\b0B\028\000\017\000;\000\000@\b\011\001U\000\016`\1328\000\"\000v\000\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001T\000A\000\016\224\000\128\001\216\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\160\002\b\000\134\000\004\000\012\192\000\016\002\002@\017@\004\016\001\b\000\b\000\025\128\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\016\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000`\000\014\002@\026\184@\000 \000\000\000\000\000\001 \b\160\002\b\000\134\000\004\000\012\192\000\016\002\002@\017@\004\016\001\b\000\b\000\025\128\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\016\128\000\128\001\152\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\016\192\000\128\001\152\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\004P\001\004\000B\000\002\000\006`\000\b\001\000\128\000\t \0010\001\000 \000\000\000\000\000@\001\000\000\018@\002`\000\000@\000\000\000\000\000\128\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\t\000E\000\016@$0\000\"\000v\000@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\144\192\000\136\001\152\001\002\000@H\002(\000\130\001!\000\001\016\0030\000\004\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\017@\004\016\001\b\000\b\000\025\128\000 \004\002\000\000$\128\004\192\004\000\128\000\000\000\000\001\000\004\000\000I\000\t\128\000\001\000\000\000\000\000\002\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\0002\000\007\129\000\012\\(\000\016\004\000@\000 \000`\000N\002\000\024\184@\000 \000\000\000\000P\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\128\138\000 \130Hh\000D\001\204\000\129\000 $\001\020\000a\000\144\224\000\136\001\152\001\006\016@H\002(\000\130\001!\192\001\016\0030\002\004 \128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\160\002\b\004\134\000\004@\012\192\b\016\130\000\144\000\000\000\000@\001\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\138\000 \128\b`\000@\000\204\000\129\000 $\001\020\000A\000\016\128\000\128\001\152\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\017@\004\016\t\014\000\b\128\029\128\016 \004\001 \000\b\000\000\128\002\128\000\000@\004\000\002\000\002@\000\000\000\001\000\005\000\000\000\128\b\000\004\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\017@\006\016\t\014\000\b\128\025\128\016a\004\004\128\"\128\b \018\028\000\017\0003\000 B\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\001\000\000\000\000\000\000\000\000\004@\000\000 \000 \003\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\016\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\012\128\000\n\b\000 \000\b\000@\026 @\000\000@\000\000\000\000\001\000\000 \000\000\160\133\003\000\000\000@\b\000\000\002\000\000@\000\001A\b\006\000\000\000\128\016\000\000\004\000\000\128\000\002\002\016\012\000\000\001\000 \000\000\016\000\000\000\000\128\128\b\000\000\000\000\000\000\002\000\000\000\000\000\001\001\000\016\000\000\000\000\000\000\000\000\000\000\000\000\002\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\144\000\b\216@\017`\163|H\244\001\001\240\n\000\012p\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\004\000\000\016\016\192`\000\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\b\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\128\000\016\000\000@C\129\128\000\000 \004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\002@\000#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\b\000\128\000\000\000\000\000\000 \000\000\000\002\000\000\016\001\000\000\000\000\000\000\000\000\000\000\000\004\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\012\164\001B@\019\004\138\192\004\003 \000\002\130\000\028\000\003\128\128\006.\016\000\b\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\192\000\028\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\004\000\000\000\000#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000 \000\000\128\134\003\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\012\164\001B@\019\004\138\192\004\003 \000\002\130\000\028\000\003\128\128\006.\016\000\b\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\192\000\028\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\004\000\000\000\000#a\000E\130\141\241#\208\004\007\192(\0001\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\017`\163|I\244\001\001\240\n\000\012p\017\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\004\000\000\128\000\002\002\024\012\000\000\001\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\001\000\b\003D\024\000\000\b\000\000\000\004\000\b\000\002\000\016\006\1360\000\000\016\000\000\000\000\000\016\000\004\000 \r\016 \000\000 \000\000\000\000\000 \000\b\000@\026 @\000\000@\000\000\000\000\000\200A\0162\0010I\180\000@0\000\000\b >\251\"\004\023\241\168\000&\014\007\184\224\176(4\003!\004@\128\004\193&\208\001\000\192\000\000 \128\006B\b\129\000\t\130E\160\002\001\128\000\000A\000\012\132\001\002\000\019\004\139@\004\003\000\000\000\130\000\000\000\000\000\000\000\000@\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\128\000\000\000\000\000\000 \000@\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\002\000\000\000\002\000\000\128\004\001\162\004\000\000\004\000\000\000\000\000\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\202@\020$\0010I\172\000@0\000\000\b \001\148\128(H\002`\145X\000\128`\000\000\016@\003)\000P\144\020\193\"\176\001\000\192\000\000 \128\002\000\000\128\004\001\162\004\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000 \b\000\002\000\016\006\136\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\245%Z\131TZg\247\130 \030e\004\0305\001\234J\181\006\168\180\207\239\004@<\202\b<j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128*\128\b\"\018\028\012\017\0003\000 \192(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001T\000A\016\144\224`\136\001\152\001\006\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \n\160\002\b\132\135\003\004@\012\192\b0\n\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\002\000\000\000\002\000\000\128\004\001\162\004\000\000\004\000\000\000\000\000\018\000\170\000 \136Hp0D\000\204\000\131\000\160\025\b\"\004\000&\t\022\128\b\006\000\000\001\004\0002\016\004\b\000L\018-\000\016\012\000\000\002\b\000\000\000\000\000\000\000\001\000\001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\002\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\224$\001\171\132\000\002\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000 !\192\192\000\000\016\002\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000@\000\001\001\012\006\000\000\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\128\004\001\162\004\000\000\004\000\000\000\000\000\016\000\002\000\000\b\bp0\000\000\004\000\128\000\128 \000\004\000\000\016\016\192`\000\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\014\002\000\024\184\192\000 \000\000\000\000\000\000\192\000\028\004\0001p\128\000@\000\000\000\000\000\002\000\000@\000\001\001\012\006\000\000\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\004\000\000\016\016\192`\000\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000 \000\000\128\132\003\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \018\028\000\017\0003\000\000@\b\006\000\000\224$\001\171\132\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\b\000\002\000\016\006\136\016\000\000\016\000\000\000\000\000H\002(\000\130\001!\192\001\016\0030\000\004\000\128e \n\018\000\152$V\000 \025\000\000\020\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\017@\004\016\t\012\000\b\128\025\128\000 \004\004\128\"\128\b \018\016\000\017\0003\000\000@\b\016\000\000\000\000\000\128\012\000\000\000\000\000\000\000\000 \000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000e \n\018\000\152$V\000 \025\000\000\020\016\001 \b\160\002\b\004\134\000\004@\012\192\000\016\002\002@\017@\004\016\t\b\000\b\128\025\128\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\144\128\000\128\001\152\000\002\000\0002\016D\012\000L\018m\000\016\012\000\000\002\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\144\128\000\136\001\152\000\002\000@H\002(\000\130\001!\128\001\016\0030\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\160\002\b\004\132\000\004@\012\192\000\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\144\192\000\128\001\152\000\002\000\000H\002(\000\130\001!\000\001\000\0030\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \018\016\000\025\0003\000\000@\b\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\004P\001\004\002C\000\002\000\006`\000\b\000\001 \b\160\002\b\004\132\000\004\000\012\192\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002$\001T\000A\132\144\224\000\136\001\216\000\"\000D\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\001\000\000\000\000\000\002`\136\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\016\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\004\000\000\016\016\128`\000\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\144\128 @\002`\145h\000\128h\000\000\017@D\148\187\131\232>\022\028\015\249p;\193o\206\030\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000$\000\001\000\000\016\000@\000\000\b\000\000\000@\000H\000\000\000\000 \000\128\000\000\016\000\000\000\128\000\144\000\000\000\000@\001\000\000\000 \000\000\000\000\004\128\"\128\012 \018\028\000\017\000;\000\000\194\000\002@\000\000\000\001\000\004\000\000\000\128\000\000\000\000\018\000\138\000 \128Hp\000D\000\204\000\001\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002(\000\130\001!\128\001\016\0030\000\004 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002(\000\194\001!\192\001\016\003\176\000\012 \000$\000\000\000\000\016\000@\000\000\b\000\000\000\000\001 \b\160\002\b\004\135\000\004@\012\192\000\016\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\t\000E\004\016@$0\000\"\000v\000@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\020\000A\000\144\192\000\136\001\152\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000H\000\002\000\000 \000\128\000\000\016\000\000\000\128\000\144\000\000\000\000@\001\000\000\000 \000\000\001\000\004\128\"\128\b \018\024\000\017\0003\000\000B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\001\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\002\000\000\000\000\000\000\192\000\024\000\0001q\128\000D\000\001\000\000\000\001\128\0000\000\000b\225\000\000\136\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000@\000\000\001\000\000\000\004@\000\000\000\000\000\024\000\003\000\000\006.\016\000\b\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\006\000\000\224 \001\139\132\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000 \000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\016\000\000\000\000\b\000\000\000\000\000\016\000\000\000\000 \000\000\000\000\016\000\000\000\000\000 \000\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\000\128\000\000\000\000\000\000\b\b\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000E\000\016@$8\000\"\000f\000@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\129\000\012\\(\000\016\004\000@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\160\002\b\000\134\000\004\000\012\192\b\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\002@\000\016\000\001\000\004\000\000\000\128\000\000\004\000\004\128\000\000\000\002\000\b\000\000\001\000\000\000\b\000$\001\020\000A\000\016\192\000\128\001\152\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\t\000E\004\016@\0040\000 \000v\000D\128\016\012\128\001\224@\003\023\n\000\004\001\000\016\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002(\000\130\000!\128\001\000\0030\002\004\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\144\000\004\000\000@\001\000\000\000 \000\000\001\000\001 \000\000\000\000\128\002\000\000\000@\000\000\002\000\t\000E\000\016@\0040\000 \000f\000\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\000\000\002\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\017@\004\016\t\012\000\b\128\025\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\004l \b\176Q\190$z\000\128\248\005\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\004\000A\000\016\128\000\128\001\144\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\000\000\000`\001\000\000\000 \000\000\000\000\000\000\136\007\224\012$\000\003\226\016\b\016\003\005\022\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000@\000\000\000@\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000@\003\240\006\018\000\001\241\b\004\b\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000\000\000\001\000\004\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\014\002\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`@\b\000\000\016 \000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\128\128\000A\130\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000 \000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006B\000\129\000\t\130E\160\002\001\160\000\000A\000\000\000\000\000\000\000\000\016\000\000\000\b\000$\b\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\003\000\000\000\000\000\000\000\000\000\001?\t\006,Uo\153\158\128\168?\145@\003\142\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\180$\016\001\004\026B\002\002 \014@\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\001\004\000A\000\144\128\000\136\001\144\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\016\000\016\0000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000 \000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\240\144b\197V\249\153\232\n\131\249\020\0008\224'\225 \197\138\173\2433\208\021\007\242(\000q\192\t\000A\000\016@$ \000\"\000d\000\000\128\000\018\000\130\000 \128H@\000D\000\200\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\004\016\001\004\002C\000\002 \006@\000\b\000\001 \b \002\b\004\132\000\004@\012\128\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\130\000 \128H`\000D\000\200\000\001\000\000$\001\004\000A\000\144\128\000\136\001\144\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
+ (128, "'\225 \197\138\173\190fz\002\129\252\128\0008\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224}\246D\b/\226*\000\t\131\131\220h\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000/\235f\245\155\175\190f\255\146\163\252Q\016y\224}\246D\b/\226*\000\t\131\131\220h\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$\250\000\129\240\000\000\024\224}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\000\000\000\000@\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\128\007\224\012\004\128\000|D\002\004\001\002\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\128\179\160\b2\nC\129\131$\014\193\018!\020\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016 \024\184@\000 \000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@@ \024 \128\000\002\000\000\000\000\000\001\000@@\000 \024 \128\000\002\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128*\128\b0\018C\128\002 \014\193\003 \004\004\128 \128\b \000B\128\002\000\012@\000 \000\004\128 \128\b \000B\000\002\000\012@\000 \000\003\000\000$\193\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128\"\130\b \000C\000\002\000\014\192\017 \004\003 \000x\016\000\024\184P\000 \016\002\000\001\000\004\128\"\128\012 \018C\128\002 \012\193\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000p\016\000\024\184P\000 \016\002\000\001\000\003\000\bp\016 \024\184@\000 \000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000E\128\187\128\b2\nC\129\130$\014\192\022a\022\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000$\000\002\000\000\000\001\000\016\000\000\000\b\000\000\000$\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\193\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\000\016\000\000\000\000\000\128\003\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128\"\130\b \002C\000\002 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\016 \004}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000D\002\129\152$r\000\0000\000\000\024\192\004\000\000\128@\002\016B\129\128\000\000@\016\000\000\004\000\000\128\000\002\016B\129\128\000\000@\016\000\000\004\000\000\128\000\002\016B\001\128\000\000@\016\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\136G\224,\028\164Z|d6\020\001\146\203\000\000\b\000\000\000\000\000\002\000\000 \000\000\000\000\003\000\000\000@\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \197\138\173\190f\250\002\129\252@\0008\224'\225 \197\138\173\190fz\002\129\252@\0008\224'\225\"\197\138\173\190fz\002\129\252\192\0008\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000@@\000\016 \128\000\002\000\000\000\000\128\003\002\000@@\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\007\002\000@\000\000\016 \000\000\002\000\000\000\000\000#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\001\000\000\000@\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000/\235w\253\155\239\190\255\255\147\167\252\210\0169\228\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000D\002\129\152$r\000\0000\000\000\024\192#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\136G\226\173\190\164z|\197\242\004\001\154\235\003!\bD\002\129\152$r\000\0000\000\000\024\192#a\000E\130\141\190$z\000\129\240\000\000\028\224G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 4\016\000\020@\003!\002@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\002\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\003\000\002p\016\000\024\184@\000 \000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\003\000\000p\016\000\024\184@\000 \000\000\000\001@\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128;\128\b2\002C\129\130$\014\192\022!\022\003\000\000p\016\000\024\184@\000 \000\000\000\000\000D\128\187\128\b2\002C\129\130$\014\192\022!\022\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\024\024@\000\000\000\000\000\000\000\003\000\000p\016 \024\184@\000 \000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000E\128\187\128\b2\nC\129\130$\014\192\022!\022\003\000\000`\000\000\024\184@\000 \000\000\000\000\000E\128\187\128\b2\nC\129\130$\014\192\022!\022\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128;\128\b2\002C\129\130$\014\192\022!\020\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000E\128\187\128\b2\nC\129\130$\014\192\022!\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\004\000\000\000\128\000\004\000\000\000\001\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\002\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\004\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\002\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\003!\000@\192\004\024$\210\000 0\000\000\016@\003!\000@\128\004\024$\210\000 0\000\000\016@\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019)\027P\144\020\024$\214\000 2\130\006\213P\000\001\000\000\128\004\000\000\002\000\000 \000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019)\027P\144\020\024$\222\000 6\145\006\213P\001\000\000\000\000\000\016\004P\000\000\000\000\000\000\000\003!\b@\128\004\024$Z\000 4\016\000\144@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$Z\000 4\016\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019!\027@\128\020\024$\218\000 6\144\004\213P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019!\027@\128\020\024$\218\000 6\144\004\213P\003\161\136G\224,\028\164Z|d6\020\001\146\203\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\b\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\193\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\128\000\000\000\000\004\133\016\003!\002@\128\004\024$Z\000 4\016\000\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\128\000\000\000\000\004\129\016\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$\214\001 2\000\004\209X\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\002\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\004@\200$\024$\218\000 4\000\000\016@\003\002\000@@\000\016 \128\000\002\000\000\000\000\128\003\002\000@@\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000\003\000H@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\016\000\128\000\000\000\001\000@\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\001\000\000\003\000\000x\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\002 \020\003\000\000p\016\000\024\184@\000 \000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\018 \020D\128*\128\b0\002C\128\002 \014\192\018 \004\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\018 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\001\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000D\128*\128\b0\018C\128\002 \014\193\003 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\002 \004\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\002 \004\000\000\000\000\000\000\000\000\000\000\000\002\001\001\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128*\128\b0\018C\128\002 \014\193\002 \004\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128*\128\b0\018C\128\002 \014\193\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128*\128\b0\002C\128\002 \014\192\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128*\128\b0\018C\128\003 \014\192\002`\004\007\002\b@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\016\000\128\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128*\128\b0\018C\128\003 \014\193\002`\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\002E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\b\000\000\000\b\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\b\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000D\002\129\152$r\000\0000\000\000\024\192@\000\017\000\000\000\000\000\000\000`\002\005\002@\000#a\000E\194\141\190$\250\000\129\240@\000\024\224#a\000E\130\141\190$\250\000\129\240@\000\024\224#a\000E\130\141\190$z\000\129\240@\000\024\224\003!\000DB\129\152$\242\000\0000\000\000\024\192\003!\000D\002\129\152$\242\000\0000\000\000\024\192\003!\000D\002\129\152$r\000\0000\000\000\024\192\003!\000D\002\129\152$r\000\0000\000\000\024\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\218\231\247\255l>\237\183\255\223\001\000\000\000\000\000\024\004p\000\000\000\000\000\000\000#a\136G\226\173\190\164z|\197\242\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\bE\130\141\190$z\000\129\240\000\000\024\224#a\bE\130\141\190$z\000\129\240\000\000\024\224\003\002\000@@\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000@\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\bE\130\141\190$z\000\129\240\000\000\024\224#a\bE\130\141\190$z\000\129\240\000\000\024\224\003!\b@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\193\016\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\000\000\000\016\000\000\128\000\000\000\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\003)\000P\208\004\024$\214\000 0\000\000\016@\003)\000P\144\004\024$\214\000 0\000\000\016@\003)\000P\144\004\024$V\000 0\000\000\016@\002\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\b\000\000\000\000\000\128\000\000\002\000\004\193\016\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\161\136G\224,\028\164Z|d6\020\001\146\203\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\020\024$V\000 2\000\002P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\001\000\000\000\000\016\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000DB\129\152$\242\000\0000\000\000\024\192\003!\000D\002\129\152$\242\000\0000\000\000\024\192\003!\000D\002\129\152$r\000\0000\000\000\024\192D\148\187\131\232>B\195\129\255l\014\237\183\231\015\003!\000D\002\129\152$r\000\0000\000\000\024\192G\189\187\215\250\191\218\231\247\255l>\237\183\255\223\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\027\000\000\000\000\000\000\000\000\000\000\004\005\000#a\011E\130\141\190$z\000\129\240\000\000\028\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\218\231\247\255l>\237\183\255\207\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\025\000\000\000\000\000\128\000\000\002\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\025\000\000\000\000\000\128\000\000\002\000\002\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\025\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000D\002\129\152$r\000\0000\000\000\024\192G\189\187\215\250\191\218\231\247\255l>\237\183\255\223\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\024\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015G\189\187\215\250\191\218\231\247\255l>\237\183\255\207D\148\187\131\232>B\195\129\255l\014\237\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\004#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\218\231\247\255l>\237\183\255\207D\148\187\131\232>B\195\129\255l\014\237\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000g\245\187\199\234\191\254\231\251\255\173\254\232\183\255\239}\246D\b/\226*\000\t\131\131\220h\176(4#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015\003!\000@\128\004\024$\218\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\007\169\"\208\152$\026g\214\003 >\192\006\241T#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\193\016\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\003 \012\192\000 \004\004\128\"\128\b\"\002C\001\131 \012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\155\003\224\012\000\128\128|\004\002\000\005\134\003#a\011E\130\141\190$z\000\129\240\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000D\002\129\152$r\000\0000\000\000\024\192G\189\187\215\250\191\218\231\247\255l>\237\183\255\223\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015\001\000\000\000\000\000\024\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015G\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015G\189\187\215\250\191\218\231\247\255l>\237\183\255\223G\189\187\215\250\191\218\231\247\255,>\232\183\255\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\001\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\bD\002\129\152$r\000\0000\000\000\024\192\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\002E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000D\002\129\152$r\000\0000\000\000\024\192@\000\000\000\000\000\000\000\000\000`\000\005\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\002\000\002@\000\000\000\017\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000`\000\005\000\000\000\001\000\000\000\000\000\024\004p\000\000\000\000\000\000\000@\000\017\000\000\000\000\000\000\000`\002\005\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\148\187\131\232>B\195\129\255l\014\237\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\017\000\000\000\000\000\000\000\b\000\000\004\001\000\000\000\145\003\224\012\000\128\128|\012\002\000\005\130\003\000\000\016\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\128\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000@\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\004\128\"\128\b \018C\128\003 \012\192\000 \004\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\000\000\000\016\000\000\128\000\000\002\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\004\128\"\128\b \018C\128\003 \012\192\000 \004\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\128\001\000\000\000\000@\000\003\000\000`\000\000\024\184P\000 \000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\017\000\000\000\000\000\128\000\004\000\000\000\000\016\000\000\017\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\b\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\128\000\004\000\000\000\000\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\005\128\162\128\b0\nC\128\003 \012\192\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\128\162\128\b \nC\128\003 \012\192\016!\004\003\000\000`\000\000\024\184P\000 \000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\003\000\000`\000\000\024\184P\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\005\128\"\128\b \nC\128\003 \012\192\016!\004\005\128\162\128\b0\nC\128\003 \012\192\016!\004\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\005\128\"\128\b \nC\128\003 \012\192\016!\004\005\128\162\128\b0\nC\128\003 \012\192\016!\004\000\000\000\000\000\000\000\000\128\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\004@\128\004\024$\218\000 0\000\000\016@\003!\004@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 0\000\000\016@\004\128\"\128\b \002C\000\003 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000@@\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\b\000\000\000\016\000\128\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\b\000\000\000\000\000\000\000\000\000\000\006A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\136\003\224\012\000\128\128|\004\002\000\007\194\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \018C\128\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\004\128\"\128\b \018C\128\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000@\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \014\192\000 \000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128\"\128\b0\002C\128\002 \012\192\000 \000\004\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\004\128\"\128\b \002C\000\002 \012\192\000 \004\004\128\"\128\b \002B\000\002 \012\192\000 \004\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\004\128\"\128\b \002C\000\002 \012\192\000 \004\004\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\004\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\002\000\000\000\000\000\128\000\000\000\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\003\002\000@@\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \128\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\004\128\"\128\b \018C\128\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\004\128\"\128\b\"\002C\129\130 \014\192\016 \000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\129\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b\"\002C\129\130 \014\192\016 \000\001 \000\000@\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\004\128\"\128\012 \002C\128\002 \014\192\000`\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\004\128\"\128\b \002C\128\002 \012\193\000!\000\001\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\128\"\128\b \002C\128\002 \012\192\000 \000\004\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\000 \000\004\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\128\"\240\024 \024\250@\002 \012\000\000 \000\004\128\"\128\b \000B\000\002\000\012\192\000 \000\001\000\000\000@\000\000\000\128\000\000\000\000\000\000\128\001\000\000\000@\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \016C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \016C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000@\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000C\000\002\000\014\192\001 \000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128\"\128\b0\000C\128\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\001@\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \016C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128\"\128\b0\000C\128\002\000\012\192\000 \004\004\128\"\128\b \000B\000\002\000\012\192\000 \004\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128\"\128\b0\000C\128\002\000\012\192\000 \004\004\128\"\128\b \000B\000\002\000\012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128\"\128\b0\000C\128\002\000\012\192\000 \000\004\128\"\128\b \000C\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@@ \024 \128\000\002\000\000\000\000\000\001\000@@\000 \024 \128\000\002\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000D\128\"\128\b0\000C\128\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\004\128\"\128\012 \000C\128\002\000\012\192\000`\000\b\128\000\000@\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000@\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\004\000\000\128\000\002\016B\128\128\000\000@\016\000\000\004\000\000\128\000\002\016B\000\128\000\000@\016\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000B\000\128\000\000@\016\000\000\b\000\000\000\000@\b\000\128\000\000\000\000\000\000\000\b\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\004\000\000\128\000\002\000C\128\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\128\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\004\000\000\128\000\002\000C\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\n \192\000\000\000\000\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\128\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128*\128\b\"\002C\128\130 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\004\128*\128\b\"\002C\128\130 \014\192\016 \004\004\000\000\128\000\002\000C\128\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184\192\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\004\000\000\128\000\002\000C\129\128\000\000@\016\000\000\004\000\000\128\000\002\000C\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000C\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000B\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\000 \004\004\128\"\128\b \002B\000\002 \012\192\000 \004\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\000 \004\004\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\005\128\170\128\b0\bC\128\002 \014\192\000`\004\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\001@\000\000\002\000\000\000\000\000\128\000\000\000\000\004\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\005\128\170\128\b0\bC\128\002 \014\192\000 \004\005\128\170\128\b0\bC\128\002 \014\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128*\128\b \000C\128\002\000\014\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000C\000\002\000\012\192\000 \004\004\128\"\128\b \000B\000\002\000\012\192\000 \004\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\004\128\"\128\b \000C\000\002\000\012\192\000 \004\004\128\"\128\b \000B\000\002\000\012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000B\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000C\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000B\000\002\000\012\192\000 \004\002\000\000$\128\004\024\000\128\016\000\000\000\000\000\128\002\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\016 \004\004\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000B\000\002\000\012\192\000 \004\002\000\000$\128\004\024\000\128\016\000\000\000\000\000\128\002\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\003 \000x\016\000\024\184P\000 \016\002\000\001\000\003\000\002p\016\000\024\184@\000 \000\000\000\001@\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\160\"\128\b \018C@\002 \028\192\016 \004\004\128\"\128\012 \002C\128\002 \012\192\016a\004\004\128\"\128\b \002C\128\002 \012\192\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\016!\004\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000C\000\002\000\012\192\016 \004\004\128\"\128\b \000B\000\002\000\012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\128\002 \014\192\016 \004\001 \000\b\000\000\016\000P\000\000\016\002\000\001\000\001 \000\000\000\000\016\000P\000\000\016\002\000\001\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\012 \002C\128\002 \012\192\016a\004\004\128\"\128\b \002C\128\002 \012\192\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\b\128\000\000@\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\004\000\000\128\000\002\016B\129\128\000\000@\016\000\000\004\000\000\128\000\002\016B\001\128\000\000@\016\000\000\004\000\000\128\000\002\000B\001\128\000\000@\016\000\000\b\000\000\000\000@\b\000\128\000\000\000\000\000\000\128\000\000\000\000\000@\b\000\128\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\002@\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\004\000\000\128\000\002\000C\129\128\000\000@\016\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\002@\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\128\000\000\000\000\000\000\128\000\000\000\b\000\000\b\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\003\128\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\003\128\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\004\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\026 \192\000\000\128\000\000\000\128\001\000\000@\002\000\026 \192\000\000\128\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\003!\004@\200\004\024$\218\000 0\000\000\016@}\246D\b/\226*\000\t\131\131\220h\176(4\003!\004@\128\004\024$\218\000 0\000\000\016@\003!\004@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\001\000\001\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\128\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$\214\000 0\000\000\016@\003)\000P\144\004\024$V\000 0\000\000\016@\003)\000P\144\020\024$V\000 0\000\000\016@\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\004\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\169*\212\026\163\154g\247\130 <\192\016x\212\007\169*\212\026\163\154g\247\130 <\192\016x\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128*\128\b\"\002C\129\130 \012\192\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128*\128\b\"\002C\129\130 \012\192\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128*\128\b\"\002C\129\130 \012\192\016`\020\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\004\128*\128\b\"\002C\129\130 \012\192\016`\020\003!\004@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\001\000\001\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000C\129\128\000\000@\016\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\004\000\000\128\000\002\000C\129\128\000\000@\016\000\016\004\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184\192\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\004\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000B\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\000 \004\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\000 \004\003)\000P\144\004\024$V\000 2\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\000 \004\004\128\"\128\b \002B\000\002 \012\192\000 \004\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\004\128\"\128\b \002C\000\002 \012\192\000 \004\004\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002B\000\002\000\012\192\000 \000\003!\004@\192\004\024$\218\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002B\000\002 \012\192\000 \004\004\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002\000\012\192\000 \000\004\128\"\128\b \002B\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002B\000\003 \012\192\000 \004\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002\000\012\192\000 \000\004\128\"\128\b \002B\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000D\128*\128\b0\018C\128\002 \014\192\002 \004@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\193\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\002\000B\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\017@D\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\004\128\"\128\012 \002C\128\002 \014\192\000a\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\012 \002C\128\002 \014\192\000a\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128\"\130\b \002C\000\002 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\004\128\"\128\b \002C\000\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\004\000\000\000\000\000\003\000\000`\000\000\024\184\192\000$\000\002\000\000\000\003\000\000`\000\000\024\184@\000$\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\016\000\000\000\b\000\000\000$\000\000\000\000\000\003\000\000`\000\000\024\184@\000$\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000\b\000\000\000 \000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\128\002 \012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000x\016\000\024\184P\000 \016\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000C\000\002\000\012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\004\128\"\128\b \000C\000\002\000\012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128\"\130\b \000C\000\002\000\014\192\017 \004\003 \000x\016\000\024\184P\000 \016\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \000C\000\002\000\012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\004\128\"\128\b \000C\000\002\000\012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \000B\000\002\000\012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\024\000@\000\000\016\000\000\000\000\000\000\136\007\224\012\004\128\000|D\002\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\128\007\224\012\004\128\000|D\002\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\016\000\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\000\128\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000'\225 \197\138\173\190fz\002\161\252\128\0008\224\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\005\161 \128\b \026B\002\002 \028\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002B\000\002 \012\129\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002B\000\002\000\012\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\001\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \197\138\173\190fz\002\161\252\128\0008\224'\225 \197\138\173\190fz\002\161\252\128\0008\224\004\128 \128\b \002B\000\002 \012\128\000 \000\004\128 \128\b \002B\000\002 \012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002C\000\002 \012\128\000 \000\004\128 \128\b \002B\000\002 \012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002C\000\002 \012\128\000 \000\004\128 \128\b \002B\000\002 \012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
and start =
15
and action =
- ((16, "o\248x\028r\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\150r\202\000\000\000\000\021\164r\202o\248\024\164\000/\001B\171\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\002x\000\177\000\000\000>\005\208\000\000\004\152\000\214\t\192\000\000\005\014\001\134\n\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000\000\000\000\002`\187,\000\000\000\000\000\000\005\244\000\000\000\000\164\026\003:\004\182\000\000\000\000\185R\005\244\000\000v\002\021\164rB\169\228\021\164v\142s\234\021\164z\222\000\000\002\012\000\000q\186\003\b\000\000\027V\000\000\025\192\000\000\000\000\006\248\000\000\005\244\000\000\000\000\000\000\000Z\000\000\027V\000\000\007\142\197\158\203*\179\246\000\000\204\150\185R\000\000x\206\170\132\000\000pdn\138\187,r\202o\248\000\000\000\000s\234\021\164\127`q\186\007\236\197\158\000\000\194\004r\202o\248x\028\021\164\000\003\000\000\017\182w\162\021lnN\166&\000\000\000\023\000\000\000\000\003B\000\000\000\000t\168\001 \025\248\000\242\000\t\000\000\000\000\004n\000\000rB\006\238\007D\021\164\022\242\000\000\021\164o\248o\248\000\000\000\000\000\000t\210t\210\021\164\022\242nH\021\164\128.\030\028\004\140\b\232\000\000\007F\t\190\000\000\000\000\000\000\000\000\000\000\021\164\000\000\000\000\000\000x\028\021\164\000\003l.\184$y\192\000\250\128\240\166&\198,\192\142\000\000\b\232\000\000\bJ\000\000\023B\176\166\206\004\000\000\176\166\206\004\000\000\176\166\176\166\003\000\000X\003\000\005D\000\000\006x\000\000\000\000\006x\000\000\000\000\000\000\176\166\005\244\000\000\000\000\165\138\176\166\164\210\170\132\000\000\006\230\006x\185R\170\132\bB\176\166\000\000\000\000\000\000\000\000\000\000\000\000\129\162\170\132\130\150\003\000\000\000\000\000\000\000\001r\000\000\000\000\167\228\b\172\005\244\000\000\000\000\131\138\000\000\000\000\000\000\002\024\000\000\176\166\000\000\001\002\185\240\000\000\176\166\001\002\176\166o2\000\000p\"\000\000\006\234\004 \000\000\b&\176\166\006\144\000\000\007V\000\000\006f\000\000\000\003\tV\000\000\000\000\000\000\024\002\022\186\166&w\182\021\164\166&\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000z\174\028\182\000\000\000\000\000\000\001\244\029p\192\142\000\000w\182\021\164\166&\000\000\000\000\208\172\166&\2092\166&\209L\000\000\166&\000\000\000\000\167\018t\168\005\140\005\140\000\000\tL\166&\000\000\000\000\000\000\004\212\tl\000\000\025\214\000\000\166&\209\140\176\166\nN\000\000\166&\209\204\001B\000\000\000\000\000\000\t\182\000\000\030\194\000\000\198,\000\000\t\198\000\000n\186\196\224\000\000\000\000\024\218\005d\023.\t\210\000\000\000\000\000\000\000\000\tL\000\000\168\180\007*\t\230\000\019\176\166\003j\nH\000\000\000\000\n\"\t\230\001\162\000\003x\028xlt\210\021\164\022\242\000/\006\244\000\t\000\000\t\250rBrB\n\152rB\000/\006\244\n\166\000\000\n\180rB\000\000\184\138\n*q\186\b\232\002@\186\142\000\000\176\166\180\148\176\166\172Z\181L\176\166\b\148\176\166\181\128\000\000\0114\n\146\nxrB\185(\000\000\n\192\tz\170\006\000\000\000\000\000\000\000\000rB\185\198rB\186d\002\152\003\000\173\018\t\190\003\000\173\176\000\000\187\002\n*\000\000\000\000\187\160\000\156\000\000\024x\000\000\011F\022\242\000\000\170\164nH\000\000\000\228\000\000rB\024\206\000\000\000\000\000\000\169F\000\000\000+\000\003y\192\011~\022\180\132\\\023\136|4\017\182\133\030x\028\021\164\017\182x\028\021\164p\232x\028\021\164\000\003w\182\021\164\192\142\166&p\152\000\003x\028\021\164s\186\004\144\000\000\166&\024\218\176\166\004f\001\162\011\128\000\000\000\000\000\000u\154\005\140\011\194\000\000\166&\000\000\000\000\174>\000\000\000\000\004B\170\132\003\000\011\176\133\224w\182\021\164\192\142\027x\134\162w\182\021\164\192\142\028t\166&\000\000\000\000w\182\021\164\166&\025\214\000\003\017\182\000\000\000\000\000\000\000\000\001\246\026|m\"\000\000{\152|Zt\210\021\164\022\242\005\208rB\027\212\000\000}\028}\222\200\148\023\222\176\166\011J\000\003x\028\021\164\017\182\023\136\017\182\002\242\023Rv\142w\182\021\164\192\142\025\006v\142\135dw\182\021\164\192\142\000\000\017\182\011\028\011\202\002\226\176\166&\162\176\166\027\132\176\166'T\012\n\000\000\000\000\012\006\000\000\017\182\003\238\012&\000\000\030l\000\003\012|\000\000\029p\136&w\182\021\164\192\142\030l\018\178\024\132\000\000\000\000\000\000\000\000\n>\000\003\000\000\000\000\031h\136\232w\182\021\164\192\142 d!`\137\170w\182\021\164\192\142\"\\#X\000\000\019\174\025\128\138lw\182\021\164\192\142\000\000\000\000\000\003r\202\000\003\000\000\000\000\139.w\182\021\164\192\142$T%P\139\240w\182\021\164\192\142&L'H\140\178w\182\021\164\192\142(D)@\141tw\182\021\164\192\142*<+8\1426w\182\021\164\192\142,4-0\142\248w\182\021\164\192\142.,/(\143\186w\182\021\164\192\1420$1 \144|w\182\021\164\192\1422\0283\024\145>w\182\021\164\192\1424\0205\016\146\000w\182\021\164\192\1426\0127\b\146\194w\182\021\164\192\1428\0049\000\147\132w\182\021\164\192\1429\252:\248\148Fw\182\021\164\192\142;\244<\240\149\bw\182\021\164\192\142=\236>\232\149\202w\182\021\164\192\142?\228@\224\150\140w\182\021\164\192\142A\220B\216\151Nw\182\021\164\192\142C\212D\208\152\016w\182\021\164\192\142E\204F\200\152\210w\182\021\164\192\142G\196H\192\153\148w\182\021\164\192\142I\188J\184\021\164\166&s\186\000\003\000\000\187,\005\140\012\004\176\166\011\196\000\003\000\000\001\202\005\244\000\000\176\166\012$\000\003\000\000\012\026\000\003\000\000\000\000\002\226\000\000\012.\133\224\000\000\000\000\000\000\027\206\176\166\012\132\000\003\000\000\031\190\000\003\000\000\166& \186\166&!\182\166&\"\178\001B\000\000\000\000\000\000#\174\166&$\170\000\000\194\004\1940\000\000\000\000\000\000K\180\000\003\012\214\000\000\000\003\012\250\000\000\b\228\025\200v\142\r\186\000\000\171(wZ\000\000v\142\r\236\000\000v\142\r\252\000\000\000\000\017\182\004\234\026\196v\142\014>\005\230\154Vw\182\021\164\192\142L\176M\172v\142\014F\006\226\155\024w\182\021\164\192\142N\168O\164v\142\014R\007\222\155\218w\182\021\164\192\142P\160Q\156\030\250\000\003\014\162\b\218\156\156w\182\021\164\192\142R\152S\148\000\003\014\202\t\214\157^w\182\021\164\192\142T\144U\140\000\003\014\230\n\210\158 w\182\021\164\192\142V\136W\132\n\166\027\000v\142\014\248\011\206\158\226w\182\021\164\192\142X\128Y|v\142\014\250\012\202\159\164w\182\021\164\192\142Zx[tv\142\015\006\r\198\160fw\182\021\164\192\142\\p]l\014\194\161(w\182\021\164\192\142^h_d\015\190\020\170\000\000\000\000\000\000\000\000\015B\000\000v\142\015B\000\000v\142\015B\000\000\000\000%\166\000\003\000\000\007 \000\003\000\000\166&\000\000\000\000\188<\015T\000\000~\160\000\000\014\164\000\000\127l\000\000\015f\000\000\011~\015\018\000\000\023\136\026b\b\232\000\000\022N\024\190\011\202\026\130\000\000\000\000\015\148\000\000\001\146\027x|\246\000\000\012*\000\000\000\000\000\003\014\242\000\003\014\248\000\000``\000\000\015z\000\003\000\000\000\003\000\000\000\000\000\000a\\\015\192\161\234w\182\021\164\192\142bX\162\172w\182\021\164\192\142cTdPeL\163nw\182\021\164\192\142fHgD\000\000\015\"\000\000\026|w\182\021\164\192\142\004p\000\000\171(\000\000\016\186\015\186\000\000w\182\021\164\192\142\030\240\182\012\011\246\r\\\000\000\000\000\015P\000\000\015\202\000\000\000\000\021\164\022\242\003\198\000\003\000\000\025\248\000\242\000\t\006\244\022\242\198\146rB\003\158\022\242\198\246\015p\000\003\000\000\006\244\000\000r\226\021f\022V\000\000\012P\015\228\000\000\015\228\002\172\180\018\006.\000\000\015\186\015B\187,\003\220\176\166\023\004\bX\012\238\004\014\000\000\027\152\015\248\000\000\007\218\000\000\000\000\016\014\170\132\174\212\000\000\182d\202\172\005\234\180\018\015\218\170\132\188\210\1758\015\234\170\132\1896\175\216\003\216\015\192\000\003\000\000\000\000\021\164\201,\000\000\166&\194\004\000\000\000\000\0166\000\000\000\000\000\000w\182\021\164\192\142h@i<\000\000\015~\000\000\000\000t\210\021\164\022\242\003\216\000\000rB\028h\000\000\005\180\000\000\016@\000\000\016h\192\142j8w\182\021\164\192\142\024\172\000\000rB\028j\000\000rB\026r\000\000rB\029\204\000\000\182\234\000\000rB\030b\000\000rB\029f\000\000rB\031\\\000\000\1940\000\000\021\164\022\242\1940\000\000\030d\030\028\004\140\005\244\205\014rB\201l\194\004\000\000\000\242\005\222\000\t\006\244\194\004\206\130\000\242\000\t\006\244\194\004\206\130\000\000\000\000\006\244\194\004\000\000r\202o\248\166&\023\186\000\003\000\000r\202o\248t\210\021\164\022\242\1940\000\000\024\164\000/\001B\015\140\187,\t\218\176\166\194\198\015\192\016j\205l\000\000\194\004\000\000\195Hr\226\021f\022V\199T\028\196\012\166\001\250\r\n\015\176\021\164\194\004\000\000\021\164\194\004\000\000\176\166\176\166\020\208\006&\000\240\003\000\206\220\000\000\000\240\003\000\206\220\000\000\030\146\030\028\004\140\005\244\207:rB\1940\000\000\000\242\007\214\026\014\003\000\206\220\000\000\000\t\015\180rB\1940\130\030\000\242\000\t\015\208rB\1940\130\030\000\000\000\000\007\240\000\003\194h\000\000rB\205\198\194\004\000\000\007\240\000\000v\002\021\164rB\1940\000\000r\226\021f\022V\188<of\022\004\021J\b\128\000\000\006\184\027V\012\200\000\000\016\\\016\bo\206\021lp\180\176\166\rP\000\000z|\021J\006\222\r\018\000\000\002@\000\000\016`\015\236\176\166~l\000\000\021\164\b(\005\226\000\000\r2\000\000\016t\015\252\187,~l\000\000\021lo\206\016\156\024z\000\240\000\003\011\no\206\176\166\r\196\003\000\000\000\176\166\026T\022J\000\000\000\000\189\212\000\000\000\003\r\002o\206\190r~l\000\000\021\164\176\166\rB\176\166m\"~l\000\000\0160\000\000~l\000\000\000\000z|\000\000\1940\207\148\021J\b\128\006\184\016\144\016Lo\206\1940\207\148\000\000\000\000\021J\b\128\006\184\016\166\016,\166\132y$\170\132\016\194\166\132\176\166\022J\016\200\166\132\170\132\016\204\166\132\190\234\191b\000\000\203\162\000\000\000\000\194\004\131\018\021J\b\128\006\184\016\200\016L\166\132\194\004\131\018\000\000\000\000\000\000\176\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\194\004\000\000\172H\021tq\186\016\218\197\158\000\000\194\004\208\004\000\000\000\000\176t\021tq\186\016\242\016~\203*\208\210\006.\0174\000\000\000\000\191\218\195\202\021\164\000\000\201\160\022V\000\000\000\000\194\004\176t\000\000\000\000\000\000\199\174m\182q\174\006.\0176\000\000\000\000\000\000\195\202\021\164\000\000\006.\0178\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\156of\021J\b\128\006\184\017\006\192\142z\028\021lnNy\140\021J\004\014\006.\017\018\004\224\000\003\000\000\016\204\000\003\000\000~l\000\000\b\214\r\134\000\000\rj\000\000\017(\016\176\176\166s*\017J\007\212\000\003\000\000\017\002\000\003\000\000\022J\000\156\012\024\000\000\017Z\193\022\210b\005\140\016\242\176\166\r\188\000\003\000\000\017\016\000\003\000\000\000\000~l\000\000\t$\r\020\000\000\014\012\000\000\017p\016\248\187,\000\000\017~\193\158\210\174\005\140\017\030\176\166\014\028\000\003\000\000\0176\000\003\000\000\000\000\021\164\000\003~l\000\000\021\206\021lz\028z\028\196Xr\202\021\164\201,\166&\b\140\000\000\025\166\000\240\000\003\014 z\028\176\166\014\012\b\232\000\000\021\164\192\142\192\142z\028\rxz\028\000\000n\022o\006\000\000\177\022\000\000\000\000\177\180\000\000\000\000\178R\000\003\014.z\028\178\240\201,\166&\b\140\000\000\b\196\000\000\166\132\017\216\000\000l.\017\162\000\000~l\000\000z\028l.~l\000\000\021\164\176\166~l\000\000\017J\000\000~l\000\000\000\000y\140\000\000\203\214\166\132\017\\z\028\204l\192\142\000\000\194\004\208X\021J\b\128\006\184\017\184\192\142\194\004\208X\000\000\000\000\000\000\209\026x\028\000\000\000\000\000\000\000\000\000\000\000\000\206$\194\004\000\000\208\004\000\000\000\000\000\000\000\000\194\004\209\026\000\000\000\000\000\000\206$\017\242\000\000\017\250\000\000\194\004\209\026\000\000\000\000\017j\000\000\183\136\031^\000\000\028\202\000\000\176\166\014\146\000\000y\140\017z\000\000\018N\192\142k4\018*\000\000\000\000\018\"\030('\004\022V\188<\028\196\021\164\000\000\194\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197@\028\196\021\164\000\000\014\208\197\158\000\000\194\004\000\000\018$\030('\004\194\004\000\000\0186\000\000\n2\014\"\021\164\173\144\000\000\000\000m\206\195\230\000\000\000\000\017\190\000\000\018\026\176\166\000\000\0148\tl\003\000\000\000\000\000\176\166\0032\n\162\176\166\011\158\006.\018R\000\000\000\000\2026\000\000\000\000\203*\000\000\194\004\000\000\018J\030((\000\194h\000\000\000\000\000\000\000\000\0156\202\154\203*\000\000\194\004\000\000\018P\030((\000\194h\000\000\017\234\000\000\031\196\000\000\194\004\000\000\018~\000\000\000\003\017\228\000\003\017\234\000\000\017\254\000\000\000\000v\142\018\b\000\000\000\000\025\128\171\176\018\166\000\000\000\000\000\000\r\196\tz\179^\018\172\000\000\000\000\000\000\000\000\000\000\000\000\018 \000\000\028\196\000\000\018*\000\000\176\166\000\000\007l\000\000\000\003\018.\000\000\000\000\003\000\000\000\t\196\000\000\000\003\000\000\014\160\000\000\022\242\000\000\004\216\000\000rB\000\000\000\156\000\000\n\146\000\000\018@\000\000\166&\027\170\000\000\000\000\011r\018D\000\000\000\000\0188\012`p\232\005\244\200J\000\000\000\000\000\000\000\000\000\000\167f\000\000\000\000\018\236\000\000z\174\000\000\015>\018\242\000\000\018\246\000\000q\216q\216\189p\189p\000\000\000\000{L\189p\000\000\000\000\000\000{L\189p\018f\000\000\018h\000\000"), (16, "\003\165\000\006\003.\0032\003\165\002\170\002\174\003\165\002\218\002z\003\165\0041\003\165\001^\002\230\003\165\007&\003\165\003\165\003\165\001V\003\165\003\165\003\165\001\194\004\241\004\241\b2\002\234\003\165\003f\003j\011\030\003\165\001n\003\165\001~\002\238\000\238\003\138\000\238\003\165\003\165\003\190\003\194\003\165\003\198\003\210\003\222\003\230\007\006\001f\003\165\003\165\002\162\bb\003\006\003\218\003\165\003\165\003\165\bf\bj\bv\b\134\002^\005\138\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\b\158\003\n\003\165\007^\003\165\003\165\003\165\0041\b\170\b\194\tf\005\150\005\154\003\165\003\165\003\165\0042\003\165\003\165\003\165\003\165\b~\b\022\b\130\b\149\016\210\003\165\006\226\003\165\003\165\004\241\003\165\003\165\003\165\003\165\003\165\003\165\005\158\b\146\003\165\003\165\003\165\tz\004^\t\222\007\218\003\165\003\165\003\165\003\165\r9\004\241\004\241\001v\r9\r9\r9\r9\b>\r9\r9\r9\r9\000\238\r9\r9\004\241\r9\r9\r9\004J\r9\r9\r9\r9\004\241\r9\002b\r9\r9\r9\r9\r9\r9\r9\r9\b2\r9\0079\r9\005\014\r9\r9\r9\r9\r9\030\147\r9\r9\000\238\r9\003\226\r9\r9\r9\000\238\000\238\r9\r9\r9\r9\r9\r9\r9\000\238\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\001\137\r9\r9\004\206\r9\r9\r9\001\002\001\174\003\006\004\241\r9\r9\r9\r9\r9\001\134\r9\r9\r9\r9\r9\r9\r9\bB\r9\r9\007\193\r9\r9\003\n\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\000\238\004\241\r9\r9\r9\r9\001\137\001\137\005\030\rB\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\r\t\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\r\t\001\137\004\254\001\137\022\014\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\007\002\001\137\016\142\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\rJ\001\137\001\137\001\137\001Z\004\t\006\133\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\005\206\t\146\001\137\020\170\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\n\237\018\018\007n\002\030\n\237\n\237\n\237\n\237\005\002\n\237\n\237\n\237\n\237\001\190\n\237\n\237\r\r\n\237\n\237\n\237\007v\n\237\n\237\n\237\n\237\003\205\n\237\001\170\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\r\r\n\237\001\182\n\237\003\205\n\237\n\237\n\237\n\237\n\237\007\230\n\237\n\237\007\153\n\237\t\129\n\237\n\237\n\237\002\146\007\238\n\237\n\237\n\237\n\237\n\237\n\237\n\237\007\242\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\018r\n\237\n\237\0045\n\237\n\237\n\237\007\201\001\218\004\186\007^\n\237\n\237\n\237\n\237\n\237\000\238\n\237\n\237\n\237\n\237\n\237\t\246\n\237\n6\nr\n\237\n>\n\237\n\237\003\018\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\000\238\n\237\n\237\n\237\n\237\n\237\004Q\003\022\007\218\002*\004Q\004Q\004Q\004Q\019\018\004Q\004Q\004Q\004Q\t\129\004Q\004Q\rB\004Q\004Q\004Q\000\238\004Q\004Q\004Q\004Q\0045\004Q\b2\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\b2\004Q\004\241\004Q\000\238\004Q\004Q\004Q\004Q\004Q\005:\004Q\004Q\000\238\004Q\017\210\004Q\004Q\004Q\017\170\004\241\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004\241\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\000\238\t\238\nj\004\173\004Q\004Q\004Q\003:\007\149\004\241\b\210\004Q\004Q\004Q\004Q\004Q\018.\004Q\004Q\004Q\004Q\004Q\t\246\004Q\019\022\nr\004Q\001Z\004Q\004Q\004\t\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\000\238\004Q\004Q\004Q\004Q\004Q\004A\004\241\b\214\b\242\004A\004A\004A\004A\007E\004A\004A\004A\004A\000\238\004A\004A\t\169\004A\004A\004A\017N\004A\004A\004A\004A\004\173\004A\t&\004A\004A\004A\004A\004A\004A\004A\004A\001Z\004A\b2\004A\004\t\004A\004A\004A\004A\004A\tF\004A\004A\003>\004A\000\238\004A\004A\004A\003\018\tZ\004A\004A\004A\004A\004A\004A\004A\004:\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\003\022\t\238\nj\006\178\004A\004A\004A\005Y\030\131\001\222\024\250\004A\004A\004A\004A\004A\0042\004A\004A\004A\004A\004A\t\246\004A\006\153\nr\004A\n6\004A\004A\n>\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\019&\004A\004A\004A\004A\004A\n\141\003.\0032\006\030\n\141\n\141\n\141\n\141\007\005\n\141\n\141\n\141\n\141\001\202\n\141\n\141\019\230\n\141\n\141\n\141\004>\n\141\n\141\n\141\n\141\0222\n\141\rB\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\b2\n\141\001\241\n\141\001j\n\141\n\141\n\141\n\141\n\141\b\201\n\141\n\141\000\238\n\141\014b\n\141\n\141\n\141\001\206\006\153\n\141\n\141\n\141\n\141\n\141\n\141\n\141\000\n\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\018\026\n\141\n\141\004B\n\141\n\141\n\141\n6\006y\005Z\n>\n\141\n\141\n\141\n\141\n\141\001\241\n\141\n\141\n\141\n\141\n\141\n\141\n\141\t\182\n\141\n\141\018z\n\141\n\141\005J\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\004\134\004N\n\141\n\141\n\141\n\141\n\157\022\002\004\014\004\026\n\157\n\157\n\157\n\157\004&\n\157\n\157\n\157\n\157\003F\n\157\n\157\002F\n\157\n\157\n\157\005^\n\157\n\157\n\157\n\157\t\173\n\157\002\017\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\002J\n\157\022\n\n\157\021\202\n\157\n\157\n\157\n\157\n\157\006\129\n\157\n\157\0042\n\157\014\134\n\157\n\157\n\157\005\002\007\"\n\157\n\157\n\157\n\157\n\157\n\157\n\157\000\238\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\005\002\n\157\n\157\005R\n\157\n\157\n\157\006\218\006\242\003J\t\173\n\157\n\157\n\157\n\157\n\157\001\190\n\157\n\157\n\157\n\157\n\157\n\157\n\157\017\194\n\157\n\157\004\130\n\157\n\157\016\014\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\n\157\017\202\t\173\n\157\n\157\n\157\n\157\n\149\003.\021\"\000\238\n\149\n\149\n\149\n\149\002n\n\149\n\149\n\149\n\149\001\190\n\149\n\149\0212\n\149\n\149\n\149\004)\n\149\n\149\n\149\n\149\003\158\n\149\016\022\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\030C\n\149\018\026\n\149\022.\n\149\n\149\n\149\n\149\n\149\006y\n\149\n\149\005\002\n\149\014\170\n\149\n\149\n\149\002\198\007\"\n\149\n\149\n\149\n\149\n\149\n\149\n\149\0226\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\004\002\n\149\n\149\004\241\n\149\n\149\n\149\004\241\021\194\b\193\025B\n\149\n\149\n\149\n\149\n\149\004\146\n\149\n\149\n\149\n\149\n\149\n\149\n\149\021j\n\149\n\149\n6\n\149\n\149\n>\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\021v\000\238\n\149\n\149\n\149\n\149\n\129\025\026\004\222\r]\n\129\n\129\n\129\n\129\026\194\n\129\n\129\n\129\n\129\002\174\n\129\n\129\r]\n\129\n\129\n\129\002\210\n\129\n\129\n\129\n\129\000\238\n\129\005B\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\005\t\n\129\025\"\n\129\025\166\n\129\n\129\n\129\n\129\n\129\006y\n\129\n\129\000\238\n\129\014\210\n\129\n\129\n\129\003\150\007\146\n\129\n\129\n\129\n\129\n\129\n\129\n\129\025\174\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\006*\n\129\n\129\001\190\n\129\n\129\n\129\005f\005\t\b\185\007\190\n\129\n\129\n\129\n\129\n\129\006B\n\129\n\129\n\129\n\129\n\129\n\129\n\129\026\198\n\129\n\129\014\018\n\129\n\129\003\158\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\003\162\002\146\n\129\n\129\n\129\n\129\n\137\029\254\001\206\006~\n\137\n\137\n\137\n\137\007\r\n\137\n\137\n\137\n\137\006\150\n\137\n\137\006\186\n\137\n\137\n\137\007\133\n\137\n\137\n\137\n\137\028\246\n\137\rB\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\003\166\n\137\0042\n\137\001z\n\137\n\137\n\137\n\137\n\137\006\206\n\137\n\137\007b\n\137\014\246\n\137\n\137\n\137\004^\006\222\n\137\n\137\n\137\n\137\n\137\n\137\n\137\004\241\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\006\238\n\137\n\137\006^\n\137\n\137\n\137\007\158\030c\006\250\018\214\n\137\n\137\n\137\n\137\n\137\004>\n\137\n\137\n\137\n\137\n\137\n\137\n\137\001\254\n\137\n\137\020j\n\137\n\137\000\238\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\000\238\004\206\n\137\n\137\n\137\n\137\n\133\n\182\004\241\007.\n\133\n\133\n\133\n\133\007\021\n\133\n\133\n\133\n\133\007:\n\133\n\133\001\206\n\133\n\133\n\133\003\201\n\133\n\133\n\133\n\133\007\"\n\133\007R\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\000\238\n\133\0042\n\133\001\138\n\133\n\133\n\133\n\133\n\133\007\170\n\133\n\133\r\014\n\133\015\026\n\133\n\133\n\133\002\174\007\162\n\133\n\133\n\133\n\133\n\133\n\133\n\133\007\210\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\0156\n\133\n\133\003\158\n\133\n\133\n\133\029\014\n.\nV\002\174\n\133\n\133\n\133\n\133\n\133\007\186\n\133\n\133\n\133\n\133\n\133\n\133\n\133\b&\n\133\n\133\022n\n\133\n\133\b\238\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\000\238\t\133\n\133\n\133\n\133\n\133\n\145\001\002\001\174\007\238\n\145\n\145\n\145\n\145\bn\n\145\n\145\n\145\n\145\t\006\n\145\n\145\016v\n\145\n\145\n\145\t\225\n\145\n\145\n\145\n\145\t\218\n\145\t2\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\000\238\n\145\017~\n\145\017\134\n\145\n\145\n\145\n\145\n\145\n2\n\145\n\145\nR\n\145\015F\n\145\n\145\n\145\000\238\016\158\n\145\n\145\n\145\n\145\n\145\n\145\n\145\025b\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n^\n\145\n\145\003\162\n\145\n\145\n\145\t\133\002\134\b\185\r6\n\145\n\145\n\145\n\145\n\145\nn\n\145\n\145\n\145\n\145\n\145\n\145\n\145\t\201\n\145\n\145\000\238\n\145\n\145\n~\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\001\002\001\174\n\145\n\145\n\145\n\145\n\161\002\134\r.\r^\n\161\n\161\n\161\n\161\rR\n\161\n\161\n\161\n\161\rv\n\161\n\161\016\162\n\161\n\161\n\161\021\210\n\161\n\161\n\161\n\161\000\238\n\161\r\254\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\018>\n\161\003\162\n\161\004\029\n\161\n\161\n\161\n\161\n\161\014\n\n\161\n\161\018\002\n\161\015j\n\161\n\161\n\161\022:\r\146\n\161\n\161\n\161\n\161\n\161\n\161\n\161\025\170\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\022\006\n\161\n\161\020\174\n\161\n\161\n\161\025&\006\137\rq\021\242\n\161\n\161\n\161\n\161\n\161\006>\n\161\n\161\n\161\n\161\n\161\n\161\n\161\b\197\n\161\n\161\022\166\n\161\n\161\002b\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\n\161\000\238\bn\n\161\n\161\n\161\n\161\n\153\000\238\006}\007\238\n\153\n\153\n\153\n\153\025\030\n\153\n\153\n\153\n\153\014\030\n\153\n\153\re\n\153\n\153\n\153\022z\n\153\n\153\n\153\n\153\022\194\n\153\t\205\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\026n\n\153\025\178\n\153\0146\n\153\n\153\n\153\n\153\n\153\0042\n\153\n\153\014B\n\153\015\142\n\153\n\153\n\153\000\238\026R\n\153\n\153\n\153\n\153\n\153\n\153\n\153\028\186\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\028\242\n\153\n\153\014^\n\153\n\153\n\153\b\189\r\014\014\130\025\130\n\153\n\153\n\153\n\153\n\153\014\166\n\153\n\153\n\153\n\153\n\153\n\153\n\153\029\250\n\153\n\153\000\238\n\153\n\153\022\130\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\026F\028\n\n\153\n\153\n\153\n\153\n\221\026\166\005\133\014\206\n\221\n\221\n\221\n\221\025\226\n\221\n\221\n\221\n\221\001\190\n\221\n\221\022\130\n\221\n\221\n\221\007\238\n\221\n\221\n\221\n\221\014\242\n\221\007\238\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\000\238\n\221\029\002\n\221\015\022\n\221\n\221\n\221\n\221\n\221\015B\n\221\n\221\015f\n\221\015\170\n\221\n\221\n\221\028\134\015\138\n\221\n\221\n\221\n\221\n\221\n\221\n\221\001\190\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\030s\n\221\n\221\005\t\n\221\n\221\n\221\015\222\007\238\015\234\015\246\n\221\n\221\n\221\n\221\n\221\016*\n\221\n\221\n\221\n\221\n\221\n\221\n\221\016:\n\221\n\221\016J\n\221\n\221\029f\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\016V\002\210\n\221\n\221\n\221\n\221\004=\016\134\016\174\016\182\004=\004=\004=\004=\016\198\004=\004=\004=\004=\016\230\004=\004=\0176\004=\004=\004=\017b\004=\004=\004=\004=\017\142\004=\017\150\004=\004=\004=\004=\004=\004=\004=\004=\017\222\004=\018\006\004=\003\242\004=\004=\004=\004=\004=\018\"\004=\004=\018&\004=\018N\004=\004=\004=\018b\018\130\004=\004=\004=\004=\004=\004=\004=\018\146\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\018\166\t\238\nj\018\210\004=\004=\004=\018\250\019.\0196\020b\004=\004=\004=\004=\004=\020v\004=\004=\004=\004=\004=\t\246\004=\020z\nr\004=\006z\004=\004=\021:\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\021R\004=\004=\004=\004=\004=\nu\021\218\021\222\022\022\nu\nu\nu\nu\022\026\nu\nu\nu\nu\022B\nu\nu\022F\nu\nu\nu\022^\nu\nu\nu\nu\022\214\nu\023\006\nu\nu\nu\nu\nu\nu\nu\nu\023\n\nu\023.\nu\0232\nu\nu\nu\nu\nu\023B\nu\nu\023R\nu\023^\nu\nu\nu\023\146\023\150\nu\nu\nu\nu\nu\nu\nu\023\230\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\024\014\t\238\nj\024\018\nu\nu\nu\024\"\024r\024\146\024\210\nu\nu\nu\nu\nu\024\246\nu\nu\nu\nu\nu\t\246\nu\025\006\nr\nu\025.\nu\nu\0252\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\025>\nu\nu\nu\nu\nu\002!\025N\025j\025z\002!\002\170\002\174\002!\025\142\002z\002!\n*\002!\025\186\002\230\002!\025\190\002!\002!\002!\025\202\002!\002!\002!\001\194\025\218\nZ\025\238\002\234\002!\002!\002!\002!\002!\nb\002!\026\206\002\238\026\218\003\138\027\n\002!\002!\002!\002!\002!\027.\003\210\001\174\027V\002!\027\202\002!\002!\002\162\027\210\027\234\003\218\002!\002!\002!\bf\bj\bv\028\022\014J\005\138\002!\002!\002!\002!\002!\002!\002!\002!\002!\028\030\t\238\nj\028*\002!\002!\002!\0286\028\154\028\174\028\222\005\150\005\154\002!\002!\002!\028\230\002!\002!\002!\002!\b~\014R\b\130\029\030\014\194\002!\029F\002!\002!\029~\002!\002!\002!\002!\002!\002!\005\158\b\146\002!\002!\002!\tz\004^\029\146\029\170\002!\002!\002!\002!\n\201\029\182\029\190\029\199\n\201\002\170\002\174\n\201\029\215\002z\n\201\n\201\n\201\029\234\002\230\n\201\030\006\n\201\n\201\n\201\030#\n\201\n\201\n\201\001\194\0303\n\201\030O\002\234\n\201\n\201\n\201\n\201\n\201\n\201\n\201\030\163\002\238\030\191\003\138\030\202\n\201\n\201\n\201\n\201\n\201\030\255\003\210\001\174\031\019\n\201\031\027\n\201\n\201\002\162\031W\031_\003\218\n\201\n\201\n\201\bf\bj\bv\000\000\n\201\005\138\n\201\n\201\n\201\n\201\n\201\n\201\n\201\n\201\n\201\000\000\n\201\n\201\000\000\n\201\n\201\n\201\000\000\000\000\000\000\000\000\005\150\005\154\n\201\n\201\n\201\000\000\n\201\n\201\n\201\n\201\b~\n\201\b\130\000\000\n\201\n\201\000\000\n\201\n\201\000\000\n\201\n\201\n\201\n\201\n\201\n\201\005\158\b\146\n\201\n\201\n\201\tz\004^\000\000\000\000\n\201\n\201\n\201\n\201\n\197\000\000\000\000\000\000\n\197\002\170\002\174\n\197\000\000\002z\n\197\n\197\n\197\000\000\002\230\n\197\000\000\n\197\n\197\n\197\000\000\n\197\n\197\n\197\001\194\000\000\n\197\000\000\002\234\n\197\n\197\n\197\n\197\n\197\n\197\n\197\000\000\002\238\000\000\003\138\000\000\n\197\n\197\n\197\n\197\n\197\000\000\003\210\001\174\000\000\n\197\000\000\n\197\n\197\002\162\000\000\000\000\003\218\n\197\n\197\n\197\bf\bj\bv\000\000\n\197\005\138\n\197\n\197\n\197\n\197\n\197\n\197\n\197\n\197\n\197\000\000\n\197\n\197\000\000\n\197\n\197\n\197\000\000\000\000\000\000\000\000\005\150\005\154\n\197\n\197\n\197\000\000\n\197\n\197\n\197\n\197\b~\n\197\b\130\000\000\n\197\n\197\000\000\n\197\n\197\000\000\n\197\n\197\n\197\n\197\n\197\n\197\005\158\b\146\n\197\n\197\n\197\tz\004^\000\000\000\000\n\197\n\197\n\197\n\197\002i\000\000\000\000\000\000\002i\002\170\002\174\002i\000\000\002z\002i\n*\002i\000\000\002\230\002i\000\000\002i\002i\002i\000\000\002i\002i\002i\001\194\001\241\nZ\000\000\002\234\002i\002i\002i\002i\002i\nb\002i\000\000\002\238\000\000\003\138\000\000\002i\002i\002i\002i\002i\000\000\003\210\001\174\000\000\002i\000\n\002i\002i\002\162\000\000\000\000\003\218\002i\002i\002i\bf\bj\bv\000\000\014J\005\138\002i\002i\002i\002i\002i\002i\002i\002i\002i\000\000\000\000\002i\001\241\002i\002i\002i\004\241\000\000\000\000\000\000\005\150\005\154\002i\002i\002i\000\000\002i\002i\002i\002i\b~\000\000\b\130\004\241\004\241\002i\004\241\002i\002i\004\241\002i\002i\002i\002i\002i\002i\005\158\b\146\002i\002i\002i\tz\004^\004\241\004\241\002i\002i\002i\002i\004\241\000\000\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\000\004\241\020\214\004\241\004\241\000\238\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\238\004\241\004\241\000\238\004\241\004\241\004\241\000\238\004\241\004\241\004\241\004\241\004\241\000\000\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\001\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\238\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\000\004\241\000\000\024\234\004\241\004\241\004\241\004\241\004\241\000\000\000\n\000\238\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\000\000\000\004\241\004\241\017\250\001\241\004\241\002z\004\241\004\241\000\000\000\000\007\201\ti\004\241\004\241\007\201\001\241\001\241\004\241\000\000\004\241\004\241\004\241\000\000\000\000\004\241\004\241\004\241\004\241\000\000\000\129\004\241\000\129\000\129\000\129\000\129\000\129\000\129\000\129\004\241\000\129\000\000\000\129\000\129\017\254\000\129\000\129\026\014\000\000\000\129\000\129\000\238\000\129\000\129\000\129\000\129\000\000\000\129\018\n\000\129\000\129\000\000\007\165\000\129\000\129\007\185\000\129\000\129\000\129\007\185\000\129\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\003R\002\174\000\129\000\129\007\201\005\154\000\129\000\129\003V\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\ti\001\194\000\129\n6\b\173\000\129\n>\000\129\b\173\000\129\t\173\025Z\006\182\002\174\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\000\000\000\003~\000\129\007\165\000\000\000\129\005]\000\129\002\162\000\222\000\000\000\000\007\157\000\129\br\000\000\007\157\005z\000\000\000\129\000\129\000\129\000\129\b\173\000\000\000\129\000\129\000\129\000\129\002a\000\000\000\000\003\150\002a\002\170\002\174\002a\007\026\002z\002a\000\000\002a\000\000\002\230\002a\b\173\002a\002a\002a\t\250\002a\002a\002a\001\194\000\000\000\000\020.\002\234\002a\002a\002a\002a\002a\015\226\002a\015\238\002\238\000\000\003\138\000\000\002a\002a\002a\002a\002a\b\153\003\210\bz\000\000\002a\000\000\002a\002a\002\162\004\218\007\157\003\218\002a\002a\002a\bf\bj\bv\000\000\000\000\005\138\002a\002a\002a\002a\002a\002a\002a\002a\002a\004\n\t\238\nj\007\161\002a\002a\002a\007\161\000\000\000\238\000\000\005\150\005\154\002a\002a\002a\000\000\002a\002a\002a\002a\b~\t\246\b\130\000\000\nr\002a\bY\002a\002a\000\000\002a\002a\002a\002a\002a\002a\005\158\b\146\002a\002a\002a\tz\004^\007^\000\238\002a\002a\002a\002a\002u\004\241\000\000\000\000\002u\000\000\006N\002u\bY\005\250\002u\000\000\002u\b\030\000\000\002u\006b\002u\002u\002u\006j\002u\002u\002u\bY\000\000\007\161\bY\t\210\002u\002u\002u\002u\002u\bY\002u\007\218\007^\bY\019N\000\000\002u\002u\002u\002u\002u\000\000\007\165\000\n\000\000\002u\007\165\002u\002u\000\238\000\238\bJ\000\000\002u\002u\002u\007\189\004\169\001\241\001\241\007\189\000\000\002u\002u\002u\002u\002u\002u\002u\002u\002u\001\241\t\238\nj\007\218\002u\002u\002u\n\014\t\185\000\000\t\185\t\185\000\000\002u\002u\002u\000\000\002u\002u\002u\002u\000\238\t\246\000\000\000\000\nr\002u\000\238\002u\002u\000\000\002u\002u\002u\002u\002u\002u\022b\000\000\002u\002u\002u\000\000\000\000\br\000\000\002u\002u\002u\002u\002q\tF\019R\000\000\002q\019^\001\254\002q\004\169\002z\002q\tZ\002q\000\000\000\000\002q\000\000\002q\002q\002q\000\000\002q\002q\002q\006N\004\241\000\000\005\250\b\222\002q\002q\002q\002q\002q\006b\002q\000\000\r\017\006j\000\000\000\000\002q\002q\002q\002q\002q\tF\029\226\001\206\000\000\002q\000\000\002q\002q\t\185\000\000\tZ\r\017\002q\002q\002q\018\n\006J\002:\000\000\001\241\001\241\002q\002q\002q\002q\002q\002q\002q\002q\002q\002>\t\238\nj\000\238\002q\002q\002q\014\022\000\000\000\000\000\000\000\000\005\154\002q\002q\002q\000\n\002q\002q\002q\002q\014.\t\246\014:\000\000\nr\002q\000\238\002q\002q\000\000\002q\002q\002q\002q\002q\002q\016b\000\000\002q\002q\002q\0069\000\000\001\241\007^\002q\002q\002q\002q\002e\tm\000\000\000\000\002e\000\000\003\162\002e\tv\002\174\002e\026:\002e\000\000\019f\002e\000\000\002e\002e\002e\000\000\002e\002e\002e\006N\t\229\000\000\005\250\006V\002e\002e\002e\002e\002e\006b\002e\0069\007\218\006j\000\000\000\238\002e\002e\002e\002e\002e\000\000\t\150\001\174\000\000\002e\003\150\002e\002e\021&\000\238\0069\016.\002e\002e\002e\016>\016N\016Z\t\238\nj\000\000\002e\002e\002e\002e\002e\002e\002e\002e\002e\000\000\t\238\nj\000\000\002e\002e\002e\014V\000\000\t\246\000\000\tm\nr\002e\002e\002e\000\000\002e\002e\002e\002e\014z\t\246\014\158\000\000\nr\002e\019j\002e\002e\000\000\002e\002e\002e\002e\002e\002e\015:\r\005\002e\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002\025\015^\000\000\015\130\002\025\000\000\003\162\002\025\r\005\000\000\002\025\002\022\002\025\000\000\002\026\002\025\000\000\002\025\002\025\002\025\000\000\002\025\002\025\002\025\012\213\012\213\000\000\002&\012\213\002\025\002\025\002\025\002\025\002\025\b\169\002\025\000\000\000\000\b\169\000\000\000\000\002\025\002\025\002\025\002\025\002\025\007^\t\150\016\146\000\000\002\025\000\000\002\025\002\025\0022\000\000\000\000\016.\002\025\002\025\002\025\016>\016N\016Z\000\000\t\190\000\238\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\b\169\000\000\002\025\000\000\002\025\002\025\002\025\000\000\000\000\000\238\000\000\000\000\007\218\002\025\002\025\002\025\000\000\002\025\002\025\002\025\002\025\012\213\b\169\000\000\000\000\0026\002\025\011)\002\025\002\025\000\238\tF\002\025\002\025\002\025\002\025\002\025\000\000\nF\002\025\002\025\tZ\030\175\000\000\007^\007^\002\025\002\025\002\025\002\025\t\157\000\000\000\000\000\000\t\157\000\000\006N\t\157\011)\005\250\t\157\004\218\t\157\019\030\019Z\t\157\006b\t\157\t\157\t\157\006j\t\157\t\157\t\157\011)\000\000\000\000\011)\r\138\t\157\t\157\t\157\t\157\t\157\011)\t\157\007\218\007\218\011)\000\000\000\000\t\157\t\157\t\157\t\157\t\157\002\174\002\230\000\000\002z\t\157\000\000\t\157\t\157\000\238\000\238\000\000\000\000\t\157\t\157\t\157\000\000\027\254\000\000\003\002\000\000\000\000\t\157\t\157\t\157\t\157\t\157\t\157\t\157\t\157\t\157\000\000\003\014\t\157\000\000\t\157\t\157\t\157\000\000\000\000\000\000\000\000\020\162\000\000\t\157\t\157\t\157\000\000\t\157\t\157\t\157\t\157\000\000\000\000\005\138\000\000\018\n\t\157\000\238\t\157\t\157\000\000\tF\t\157\t\157\t\157\t\157\t\157\000\000\000\000\t\157\t\157\tZ\000\000\000\000\005\150\007^\t\157\t\157\t\157\t\157\002m\000\000\005\154\000\000\002m\000\000\003\162\002m\000\000\000\000\002m\000\000\002m\000\000\019\146\002m\000\000\002m\002m\002m\005\158\002m\002m\002m\006N\000\000\000\000\005\250\028\002\002m\002m\002m\002m\002m\006b\002m\000\000\007\218\006j\000\000\000\000\002m\002m\002m\002m\002m\007^\005\210\000\000\000\000\002m\000\000\002m\002m\000\000\000\238\000\000\003\234\002m\002m\002m\006\138\000\000\003\246\000\000\019r\000\000\002m\002m\002m\002m\002m\002m\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\007\218\002m\002m\002m\001\241\002m\002m\002m\002m\000\000\b\185\000\000\000\000\b\185\002m\019\150\002m\002m\000\238\n\134\002m\002m\002m\002m\002m\000\000\000\000\002m\002m\002m\000\n\025b\000\000\007^\002m\002m\002m\002m\t\141\001\241\001\241\019\190\t\141\000\000\002\174\t\141\001\241\000\000\t\141\000\000\t\141\b\185\019\134\t\141\001\241\t\141\t\141\t\141\001\241\t\141\t\141\t\141\001\241\001\241\020\254\b\185\000\n\t\141\t\141\t\141\t\141\t\141\000\000\t\141\000\000\007\218\000\000\001\241\000\000\t\141\t\141\t\141\t\141\t\141\000\000\nv\003\150\000\000\t\141\000\n\t\141\t\141\b\185\000\238\001\241\000\000\t\141\t\141\t\141\r\246\006\134\014\002\000\000\000\000\000\000\t\141\t\141\t\141\t\141\t\141\t\141\t\141\t\141\t\141\000\000\002\174\t\141\001\241\t\141\t\141\t\141\b\185\007\173\000\000\000\000\000\000\007\173\t\141\t\141\t\141\000\000\t\141\t\141\t\141\t\141\000\000\000\000\000\000\000\000\000\000\t\141\000\238\t\141\t\141\000\000\tF\t\141\t\141\t\141\t\141\t\141\000\000\000\000\t\141\t\141\tZ\014\198\003\150\007^\007^\t\141\t\141\t\141\t\141\003\161\000\000\000\000\000\000\003\161\000\000\014\234\003\161\015\014\000\000\003\161\000\000\003\161\019\158\027\246\n\198\000\000\003\161\011\026\003\161\007\173\003\161\003\161\003\161\006N\000\000\000\000\005\250\000\000\011.\011v\011\142\011F\011\166\006b\003\161\007\218\007\218\006j\000\000\000\000\003\161\003\161\011\190\011\214\003\161\007^\tF\000\000\000\000\003\161\000\000\011\238\003\161\000\238\000\238\000\000\tZ\003\161\003\161\000\238\000\000\000\000\000\000\000\000\029\154\000\000\003\161\003\161\n\222\011^\012\006\012\030\012N\003\161\003\161\000\000\000\000\003\161\000\000\003\161\003\161\012f\000\000\000\000\000\000\000\000\000\000\007\218\003\161\003\161\012~\000\000\003\161\003\161\003\161\003\161\000\000\000\000\000\000\000\000\000\000\003\161\000\238\003\161\003\161\000\238\012\222\003\161\012\246\0126\003\161\003\161\000\000\000\000\003\161\012\150\003\161\000\000\000\000\000\000\000\000\003\161\003\161\012\174\012\198\002\205\000\000\000\000\000\000\002\205\000\000\000\000\002\205\r\158\000\000\002\205\000\000\002\205\000\000\000\000\002\205\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\r\166\000\000\000\000\r\174\000\000\002\205\002\205\002\205\002\205\002\205\r\182\002\205\000\000\000\000\r\190\000\000\000\000\002\205\002\205\002\205\002\205\002\205\000\000\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\000\000\000\000\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\002\205\002\205\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\002\205\000\238\002\205\002\205\000\000\tF\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\002\205\tZ\000\000\000\000\000\000\000\000\002\205\002\205\002\205\002\205\002\201\000\000\000\000\000\000\002\201\000\000\000\000\002\201\bU\000\000\002\201\000\000\002\201\000\000\000\000\002\201\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\bU\000\000\000\000\005\250\000\000\002\201\002\201\002\201\002\201\002\201\bU\002\201\000\000\000\000\bU\000\000\000\000\002\201\002\201\002\201\002\201\002\201\000\000\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\000\000\000\000\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\222\002\201\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\002\201\bm\002\201\002\201\000\000\002\201\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\157\000\000\000\000\000\000\002\157\000\000\000\000\002\157\bm\000\000\002\157\000\000\002\157\000\000\000\000\002\157\000\000\002\157\002\157\002\157\000\000\002\157\002\157\002\157\bm\000\000\000\000\005\250\000\000\002\157\002\157\002\157\002\157\002\157\bm\002\157\000\000\000\000\bm\000\000\000\000\002\157\002\157\002\157\002\157\002\157\000\000\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\002\157\002\157\002\157\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\002\157\002\157\002\157\002\157\002\157\002\157\002\157\000\000\000\000\002\157\000\000\002\157\002\157\002\157\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\002\157\000\000\002\157\002\157\002\157\002\157\000\000\000\000\000\000\000\000\000\000\002\157\000\238\002\157\002\157\000\000\tF\002\157\002\157\002\157\002\157\002\157\000\000\000\000\002\157\002\157\tZ\000\000\000\000\000\000\000\000\002\157\002\157\002\157\002\157\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\b\129\000\000\002\153\000\000\002\153\000\000\000\000\002\153\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\006N\000\000\000\000\005\250\000\000\002\153\002\153\002\153\002\153\002\153\b\129\002\153\000\000\000\000\b\129\000\000\000\000\002\153\002\153\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\n\222\002\153\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\002\153\b}\002\153\002\153\000\000\002\153\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\b}\000\000\002\181\000\000\002\181\000\000\000\000\002\181\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\r\210\000\000\000\000\b}\000\000\002\181\002\181\002\181\002\181\002\181\b}\002\181\000\000\000\000\b}\000\000\000\000\002\181\002\181\002\181\002\181\002\181\000\000\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\002\181\000\238\002\181\002\181\000\000\tF\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\002\181\tZ\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\bQ\000\000\002\177\000\000\002\177\000\000\000\000\n\198\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\bQ\000\000\000\000\005\250\000\000\002\177\002\177\002\177\011F\002\177\bQ\002\177\000\000\000\000\bQ\000\000\000\000\002\177\002\177\002\177\002\177\002\177\000\000\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\222\011^\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\002\177\000\238\002\177\002\177\000\000\002\177\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\213\000\000\000\000\000\000\002\213\000\000\000\000\002\213\016\002\000\000\002\213\000\000\002\213\000\000\000\000\002\213\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\r\166\000\000\000\000\r\174\000\000\002\213\002\213\002\213\002\213\002\213\r\182\002\213\000\000\000\000\r\190\000\000\000\000\002\213\002\213\002\213\002\213\002\213\000\000\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\000\000\000\000\000\000\002\213\002\213\002\213\012\221\012\221\000\000\000\000\012\221\000\000\002\213\002\213\002\213\002\213\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\002\213\000\000\017\250\000\000\000\000\002z\002\213\000\238\002\213\002\213\000\000\tF\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\002\213\tZ\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\002\209\000\000\000\000\000\000\002\209\000\000\000\000\002\209\012\221\000\000\002\209\000\000\002\209\017\254\000\000\002\209\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\012\217\012\217\000\000\018\n\012\217\002\209\002\209\002\209\002\209\002\209\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\000\000\000\000\000\000\002\209\000\000\002\209\002\209\005\154\000\000\000\000\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\238\002\209\002\209\n\222\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\000\000\002\209\002\209\002\209\028>\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\002\209\012\217\017\250\000\000\000\000\002z\002\209\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\149\000\000\000\000\000\000\002\149\000\000\000\000\002\149\000\000\000\000\002\149\000\000\002\149\017\254\000\000\002\149\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\018\n\000\000\002\149\002\149\002\149\002\149\002\149\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\002\149\000\000\000\000\000\000\000\000\002\149\000\000\002\149\002\149\005\154\000\000\000\000\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\002\149\002\149\002\149\002\149\002\149\000\000\000\000\002\149\000\000\002\149\002\149\002\149\024>\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\tF\002\149\002\149\002\149\002\149\002\149\000\000\000\000\002\149\002\149\tZ\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\002\145\000\000\000\000\000\000\002\145\000\000\000\000\002\145\000\000\000\000\002\145\000\000\002\145\000\000\000\000\002\145\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\002\145\002\145\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\222\002\145\002\145\002\145\002\145\002\145\002\145\000\000\000\000\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\002\145\002\145\002\145\002\145\002\145\002\145\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\002\145\002\145\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\002\173\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\tF\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\002\173\tZ\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\n\198\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\011F\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n\222\011^\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\002\169\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\002\165\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\000\000\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\tF\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\002\165\tZ\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\n\198\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\011F\002\161\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\000\000\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\n\222\011^\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\002\161\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\245\000\000\000\000\000\000\002\245\000\000\000\000\002\245\000\000\000\000\002\245\000\000\002\245\000\000\000\000\002\245\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\245\000\000\002\245\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\245\000\000\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\000\000\000\000\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\245\002\245\002\245\002\245\002\245\000\000\000\000\002\245\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\tF\002\245\002\245\002\245\002\245\002\245\000\000\000\000\002\245\002\245\tZ\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\241\000\000\000\000\000\000\002\241\000\000\000\000\002\241\000\000\000\000\002\241\000\000\002\241\000\000\000\000\n\198\000\000\002\241\002\241\002\241\000\000\002\241\002\241\002\241\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\002\241\000\000\000\000\000\000\000\000\000\000\002\241\002\241\011\190\011\214\002\241\000\000\000\000\000\000\000\000\002\241\000\000\011\238\002\241\000\000\000\000\000\000\000\000\002\241\002\241\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\241\002\241\n\222\011^\012\006\012\030\012N\002\241\002\241\000\000\000\000\002\241\000\000\002\241\002\241\012f\000\000\000\000\000\000\000\000\000\000\000\000\002\241\002\241\012~\000\000\002\241\002\241\002\241\002\241\000\000\000\000\000\000\000\000\000\000\002\241\000\000\002\241\002\241\000\000\002\241\002\241\002\241\0126\002\241\002\241\000\000\000\000\002\241\012\150\002\241\000\000\000\000\000\000\000\000\002\241\002\241\012\174\012\198\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\002\197\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\000\000\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\tF\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\002\197\tZ\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\n\198\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\011F\002\193\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\000\000\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\222\011^\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\002\193\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\002\189\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\000\000\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\tF\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\002\189\tZ\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\n\198\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\011F\002\185\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\000\000\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\222\011^\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\002\185\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\229\000\000\000\000\000\000\002\229\000\000\000\000\002\229\000\000\000\000\002\229\000\000\002\229\000\000\000\000\002\229\000\000\002\229\002\229\002\229\000\000\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\000\000\002\229\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\000\000\000\000\000\000\000\000\002\229\000\000\002\229\002\229\000\000\000\000\000\000\000\000\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\000\000\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\000\000\002\229\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\002\229\000\000\002\229\002\229\000\000\tF\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\002\229\tZ\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\225\000\000\000\000\000\000\002\225\000\000\000\000\002\225\000\000\000\000\002\225\000\000\002\225\000\000\000\000\n\198\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\002\225\011\190\011\214\002\225\000\000\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\000\000\000\000\000\000\002\225\002\225\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\n\222\011^\012\006\012\030\002\225\002\225\002\225\000\000\000\000\002\225\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\002\225\002\225\002\225\0126\002\225\002\225\000\000\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\141\000\000\000\000\000\000\002\141\000\000\000\000\002\141\000\000\000\000\002\141\000\000\002\141\000\000\000\000\002\141\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\141\000\000\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\000\000\000\000\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\000\000\000\000\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\tF\002\141\002\141\002\141\002\141\002\141\000\000\000\000\002\141\002\141\tZ\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\137\000\000\000\000\000\000\002\137\000\000\000\000\002\137\000\000\000\000\002\137\000\000\002\137\000\000\000\000\n\198\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\002\137\011F\002\137\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\002\137\002\137\002\137\000\000\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\000\000\000\000\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\222\011^\002\137\002\137\002\137\002\137\002\137\000\000\000\000\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\002\137\002\137\002\137\002\137\002\137\002\137\000\000\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\002\137\002\137\002\137\002\137\002\133\000\000\000\000\000\000\002\133\000\000\000\000\002\133\000\000\000\000\002\133\000\000\002\133\000\000\000\000\002\133\000\000\002\133\002\133\002\133\000\000\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\133\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\133\000\000\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\000\000\000\000\000\000\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\000\000\000\000\002\133\000\000\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\tF\002\133\002\133\002\133\002\133\002\133\000\000\000\000\002\133\002\133\tZ\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\n\198\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\011\190\011\214\002\129\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n\222\011^\012\006\012\030\002\129\002\129\002\129\000\000\000\000\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\0126\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\0035\000\000\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\0035\000\000\0035\000\000\000\000\0035\000\000\0035\0035\0035\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0035\000\000\000\000\000\000\000\000\0035\000\000\0035\0035\000\000\000\000\000\000\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0035\0035\0035\0035\0035\000\000\000\000\0035\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\000\000\0035\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\0035\000\000\0035\0035\000\000\tF\0035\0035\0035\0035\0035\000\000\000\000\0035\0035\tZ\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0031\000\000\000\000\000\000\0031\000\000\000\000\0031\000\000\000\000\0031\000\000\0031\000\000\000\000\n\198\000\000\0031\0031\0031\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\0031\000\000\0031\000\000\000\000\000\000\000\000\000\000\0031\0031\011\190\011\214\0031\000\000\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\n\222\011^\012\006\0031\0031\0031\0031\000\000\000\000\0031\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\0031\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\0031\0031\0031\0126\0031\0031\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\0031\0031\0031\0031\002}\000\000\000\000\000\000\002}\000\000\000\000\002}\000\000\000\000\002}\000\000\002}\000\000\000\000\002}\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002}\000\000\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002}\002}\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\000\000\002}\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\tF\002}\002}\002}\002}\002}\000\000\000\000\002}\002}\tZ\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\n\198\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\011\190\011\214\002y\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n\222\011^\012\006\012\030\002y\002y\002y\000\000\000\000\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\002y\000\000\002y\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\0126\002y\002y\000\000\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\002y\002y\002y\002y\002\237\000\000\000\000\000\000\002\237\000\000\000\000\002\237\000\000\000\000\002\237\000\000\002\237\000\000\000\000\002\237\000\000\002\237\002\237\002\237\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\000\000\000\000\000\000\002\237\000\000\002\237\002\237\000\000\000\000\000\000\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\000\000\002\237\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\002\237\000\000\002\237\002\237\000\000\tF\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\002\237\tZ\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\233\000\000\000\000\000\000\002\233\000\000\000\000\002\233\000\000\000\000\002\233\000\000\002\233\000\000\000\000\n\198\000\000\002\233\002\233\002\233\000\000\002\233\002\233\002\233\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\002\233\000\000\002\233\000\000\000\000\000\000\000\000\000\000\002\233\002\233\011\190\011\214\002\233\000\000\000\000\000\000\000\000\002\233\000\000\002\233\002\233\000\000\000\000\000\000\000\000\002\233\002\233\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\233\002\233\n\222\011^\012\006\012\030\002\233\002\233\002\233\000\000\000\000\002\233\000\000\002\233\002\233\002\233\000\000\000\000\000\000\000\000\000\000\000\000\002\233\002\233\002\233\000\000\002\233\002\233\002\233\002\233\000\000\000\000\000\000\000\000\000\000\002\233\000\000\002\233\002\233\000\000\002\233\002\233\002\233\0126\002\233\002\233\000\000\000\000\002\233\002\233\002\233\000\000\000\000\000\000\000\000\002\233\002\233\002\233\002\233\002\221\000\000\000\000\000\000\002\221\000\000\000\000\002\221\000\000\000\000\002\221\000\000\002\221\000\000\000\000\002\221\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\000\000\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\000\000\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\tF\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\002\221\tZ\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\217\000\000\000\000\000\000\002\217\000\000\000\000\002\217\000\000\000\000\002\217\000\000\002\217\000\000\000\000\n\198\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\002\217\000\000\002\217\000\000\000\000\000\000\000\000\000\000\002\217\002\217\011\190\011\214\002\217\000\000\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\000\000\000\000\000\000\002\217\002\217\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\n\222\011^\012\006\012\030\002\217\002\217\002\217\000\000\000\000\002\217\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\002\217\002\217\002\217\0126\002\217\002\217\000\000\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\253\000\000\000\000\000\000\002\253\000\000\000\000\002\253\000\000\000\000\002\253\000\000\002\253\000\000\000\000\002\253\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\253\000\000\002\253\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\253\000\000\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\000\000\000\000\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\253\002\253\002\253\002\253\002\253\000\000\000\000\002\253\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\tF\002\253\002\253\002\253\002\253\002\253\000\000\000\000\002\253\002\253\tZ\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\249\000\000\000\000\000\000\002\249\000\000\000\000\002\249\000\000\000\000\002\249\000\000\002\249\000\000\000\000\n\198\000\000\002\249\002\249\002\249\000\000\002\249\002\249\002\249\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\002\249\000\000\000\000\000\000\000\000\000\000\002\249\002\249\011\190\011\214\002\249\000\000\000\000\000\000\000\000\002\249\000\000\011\238\002\249\000\000\000\000\000\000\000\000\002\249\002\249\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\n\222\011^\012\006\012\030\012N\002\249\002\249\000\000\000\000\002\249\000\000\002\249\002\249\012f\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\012~\000\000\002\249\002\249\002\249\002\249\000\000\000\000\000\000\000\000\000\000\002\249\000\000\002\249\002\249\000\000\002\249\002\249\002\249\0126\002\249\002\249\000\000\000\000\002\249\012\150\002\249\000\000\000\000\000\000\000\000\002\249\002\249\012\174\012\198\003\005\000\000\000\000\000\000\003\005\000\000\000\000\003\005\000\000\000\000\003\005\000\000\003\005\000\000\000\000\003\005\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\005\000\000\003\005\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\005\000\000\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\000\000\000\000\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\005\003\005\003\005\003\005\003\005\000\000\000\000\003\005\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\tF\003\005\003\005\003\005\003\005\003\005\000\000\000\000\003\005\003\005\tZ\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\001\000\000\000\000\000\000\003\001\000\000\000\000\003\001\000\000\000\000\003\001\000\000\003\001\000\000\000\000\n\198\000\000\003\001\003\001\003\001\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\003\001\000\000\003\001\000\000\000\000\000\000\000\000\000\000\003\001\003\001\011\190\011\214\003\001\000\000\000\000\000\000\000\000\003\001\000\000\011\238\003\001\000\000\000\000\000\000\000\000\003\001\003\001\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\n\222\011^\012\006\012\030\012N\003\001\003\001\000\000\000\000\003\001\000\000\003\001\003\001\012f\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\012~\000\000\003\001\003\001\003\001\003\001\000\000\000\000\000\000\000\000\000\000\003\001\000\000\003\001\003\001\000\000\003\001\003\001\003\001\0126\003\001\003\001\000\000\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\003\001\003\001\012\174\012\198\003\r\000\000\000\000\000\000\003\r\000\000\000\000\003\r\000\000\000\000\003\r\000\000\003\r\000\000\000\000\003\r\000\000\003\r\003\r\003\r\000\000\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\r\000\000\003\r\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\r\000\000\000\000\000\000\000\000\003\r\000\000\003\r\003\r\000\000\000\000\000\000\000\000\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\r\003\r\003\r\003\r\003\r\000\000\000\000\003\r\000\000\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\000\000\003\r\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\003\r\000\000\003\r\003\r\000\000\tF\003\r\003\r\003\r\003\r\003\r\000\000\000\000\003\r\003\r\tZ\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\t\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\003\t\000\000\003\t\000\000\000\000\n\198\000\000\003\t\003\t\003\t\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\003\t\000\000\003\t\000\000\000\000\000\000\000\000\000\000\003\t\003\t\011\190\011\214\003\t\000\000\000\000\000\000\000\000\003\t\000\000\011\238\003\t\000\000\000\000\000\000\000\000\003\t\003\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\n\222\011^\012\006\012\030\012N\003\t\003\t\000\000\000\000\003\t\000\000\003\t\003\t\012f\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\012~\000\000\003\t\003\t\003\t\003\t\000\000\000\000\000\000\000\000\000\000\003\t\000\000\003\t\003\t\000\000\003\t\003\t\003\t\0126\003\t\003\t\000\000\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\003\t\003\t\012\174\012\198\t\149\000\000\000\000\000\000\t\149\000\000\000\000\t\149\000\000\000\000\t\149\000\000\t\149\000\000\000\000\t\149\000\000\t\149\t\149\t\149\000\000\t\149\t\149\t\149\000\000\000\000\000\000\000\000\000\000\t\149\t\149\t\149\t\149\t\149\000\000\t\149\000\000\000\000\000\000\000\000\000\000\t\149\t\149\t\149\t\149\t\149\000\000\000\000\000\000\000\000\t\149\000\000\t\149\t\149\000\000\000\000\000\000\000\000\t\149\t\149\t\149\000\000\000\000\000\000\000\000\000\000\000\000\t\149\t\149\t\149\t\149\t\149\t\149\t\149\t\149\t\149\000\000\000\000\t\149\000\000\t\149\t\149\t\149\000\000\000\000\000\000\000\000\000\000\000\000\t\149\t\149\t\149\000\000\t\149\t\149\t\149\t\149\000\000\000\000\000\000\000\000\000\000\t\149\000\000\t\149\t\149\000\000\tF\t\149\t\149\t\149\t\149\t\149\000\000\000\000\t\149\t\149\tZ\000\000\000\000\000\000\000\000\t\149\t\149\t\149\t\149\t\145\000\000\000\000\000\000\t\145\000\000\000\000\t\145\000\000\000\000\t\145\000\000\t\145\000\000\000\000\n\198\000\000\t\145\t\145\t\145\000\000\t\145\t\145\t\145\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\t\145\000\000\000\000\000\000\000\000\000\000\t\145\t\145\011\190\011\214\t\145\000\000\000\000\000\000\000\000\t\145\000\000\011\238\t\145\000\000\000\000\000\000\000\000\t\145\t\145\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\145\t\145\n\222\011^\012\006\012\030\012N\t\145\t\145\000\000\000\000\t\145\000\000\t\145\t\145\012f\000\000\000\000\000\000\000\000\000\000\000\000\t\145\t\145\012~\000\000\t\145\t\145\t\145\t\145\000\000\000\000\000\000\000\000\000\000\t\145\000\000\t\145\t\145\000\000\t\145\t\145\t\145\0126\t\145\t\145\000\000\000\000\t\145\012\150\t\145\000\000\000\000\000\000\000\000\t\145\t\145\012\174\012\198\003\021\000\000\000\000\000\000\003\021\000\000\000\000\003\021\000\000\000\000\003\021\000\000\003\021\000\000\000\000\003\021\000\000\003\021\003\021\003\021\000\000\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\021\000\000\003\021\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\021\000\000\000\000\000\000\000\000\003\021\000\000\003\021\003\021\000\000\000\000\000\000\000\000\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\021\003\021\003\021\003\021\003\021\000\000\000\000\003\021\000\000\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\000\000\003\021\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\003\021\000\000\003\021\003\021\000\000\tF\003\021\003\021\003\021\003\021\003\021\000\000\000\000\003\021\003\021\tZ\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\017\000\000\000\000\000\000\003\017\000\000\000\000\003\017\000\000\000\000\003\017\000\000\003\017\000\000\000\000\n\198\000\000\003\017\003\017\003\017\000\000\003\017\003\017\003\017\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003\017\000\000\000\000\000\000\000\000\000\000\003\017\003\017\011\190\011\214\003\017\000\000\000\000\000\000\000\000\003\017\000\000\011\238\003\017\000\000\000\000\000\000\000\000\003\017\003\017\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\n\222\011^\012\006\012\030\012N\003\017\003\017\000\000\000\000\003\017\000\000\003\017\003\017\012f\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\012~\000\000\003\017\003\017\003\017\003\017\000\000\000\000\000\000\000\000\000\000\003\017\000\000\003\017\003\017\000\000\012\222\003\017\012\246\0126\003\017\003\017\000\000\000\000\003\017\012\150\003\017\000\000\000\000\000\000\000\000\003\017\003\017\012\174\012\198\t\137\000\000\000\000\000\000\t\137\000\000\000\000\t\137\000\000\000\000\t\137\000\000\t\137\000\000\000\000\n\198\000\000\t\137\t\137\t\137\000\000\t\137\t\137\t\137\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\t\137\000\000\000\000\000\000\000\000\000\000\t\137\t\137\011\190\011\214\t\137\000\000\000\000\000\000\000\000\t\137\000\000\011\238\t\137\000\000\000\000\000\000\000\000\t\137\t\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\137\t\137\n\222\011^\012\006\012\030\012N\t\137\t\137\000\000\000\000\t\137\000\000\t\137\t\137\012f\000\000\000\000\000\000\000\000\000\000\000\000\t\137\t\137\012~\000\000\t\137\t\137\t\137\t\137\000\000\000\000\000\000\000\000\000\000\t\137\000\000\t\137\t\137\000\000\t\137\t\137\t\137\0126\t\137\t\137\000\000\000\000\t\137\012\150\t\137\000\000\000\000\000\000\000\000\t\137\t\137\012\174\012\198\003e\000\000\000\000\000\000\003e\000\000\000\000\003e\000\000\000\000\003e\000\000\003e\000\000\000\000\003e\000\000\003e\003e\003e\000\000\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003e\000\000\003e\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003e\000\000\000\000\000\000\000\000\003e\000\000\003e\003e\000\000\000\000\000\000\000\000\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003e\003e\003e\003e\003e\000\000\000\000\003e\000\000\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\000\000\003e\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\003e\000\000\003e\003e\000\000\tF\003e\003e\003e\003e\003e\000\000\000\000\003e\003e\tZ\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003a\000\000\000\000\000\000\003a\000\000\000\000\003a\000\000\000\000\003a\000\000\003a\000\000\000\000\n\198\000\000\003a\003a\003a\000\000\003a\003a\003a\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003a\000\000\000\000\000\000\000\000\000\000\003a\003a\011\190\011\214\003a\000\000\000\000\000\000\000\000\003a\000\000\011\238\003a\000\000\000\000\000\000\000\000\003a\003a\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\n\222\011^\012\006\012\030\012N\003a\003a\000\000\000\000\003a\000\000\003a\003a\012f\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\012~\000\000\003a\003a\003a\003a\000\000\000\000\000\000\000\000\000\000\003a\000\000\003a\003a\000\000\012\222\003a\012\246\0126\003a\003a\000\000\000\000\003a\012\150\003a\000\000\000\000\000\000\000\000\003a\003a\012\174\012\198\003\133\000\000\000\000\000\000\003\133\000\000\000\000\003\133\000\000\000\000\003\133\000\000\003\133\000\000\000\000\003\133\000\000\003\133\003\133\003\133\000\000\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\133\000\000\003\133\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\133\000\000\000\000\000\000\000\000\003\133\000\000\003\133\003\133\000\000\000\000\000\000\000\000\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\133\003\133\003\133\003\133\003\133\000\000\000\000\003\133\000\000\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\000\000\003\133\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\003\133\000\000\003\133\003\133\000\000\tF\003\133\003\133\003\133\003\133\003\133\000\000\000\000\003\133\003\133\tZ\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\129\000\000\000\000\000\000\003\129\000\000\000\000\003\129\000\000\000\000\003\129\000\000\003\129\000\000\000\000\n\198\000\000\003\129\003\129\003\129\000\000\003\129\003\129\003\129\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003\129\000\000\000\000\000\000\000\000\000\000\003\129\003\129\011\190\011\214\003\129\000\000\000\000\000\000\000\000\003\129\000\000\011\238\003\129\000\000\000\000\000\000\000\000\003\129\003\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\n\222\011^\012\006\012\030\012N\003\129\003\129\000\000\000\000\003\129\000\000\003\129\003\129\012f\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\012~\000\000\003\129\003\129\003\129\003\129\000\000\000\000\000\000\000\000\000\000\003\129\000\000\003\129\003\129\000\000\012\222\003\129\012\246\0126\003\129\003\129\000\000\000\000\003\129\012\150\003\129\000\000\000\000\000\000\000\000\003\129\003\129\012\174\012\198\003u\000\000\000\000\000\000\003u\000\000\000\000\003u\000\000\000\000\003u\000\000\003u\000\000\000\000\003u\000\000\003u\003u\003u\000\000\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003u\000\000\003u\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003u\000\000\000\000\000\000\000\000\003u\000\000\003u\003u\000\000\000\000\000\000\000\000\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003u\003u\003u\003u\003u\000\000\000\000\003u\000\000\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\000\000\003u\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\003u\000\000\003u\003u\000\000\tF\003u\003u\003u\003u\003u\000\000\000\000\003u\003u\tZ\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003q\000\000\000\000\000\000\003q\000\000\000\000\003q\000\000\000\000\003q\000\000\003q\000\000\000\000\n\198\000\000\003q\003q\003q\000\000\003q\003q\003q\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003q\000\000\000\000\000\000\000\000\000\000\003q\003q\011\190\011\214\003q\000\000\000\000\000\000\000\000\003q\000\000\011\238\003q\000\000\000\000\000\000\000\000\003q\003q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\n\222\011^\012\006\012\030\012N\003q\003q\000\000\000\000\003q\000\000\003q\003q\012f\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\012~\000\000\003q\003q\003q\003q\000\000\000\000\000\000\000\000\000\000\003q\000\000\003q\003q\000\000\012\222\003q\012\246\0126\003q\003q\000\000\000\000\003q\012\150\003q\000\000\000\000\000\000\000\000\003q\003q\012\174\012\198\003M\000\000\000\000\000\000\003M\000\000\000\000\003M\000\000\000\000\003M\000\000\003M\000\000\000\000\003M\000\000\003M\003M\003M\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003M\000\000\003M\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003M\000\000\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003M\003M\003M\003M\003M\000\000\000\000\003M\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\003M\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\tF\003M\003M\003M\003M\003M\000\000\000\000\003M\003M\tZ\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003I\000\000\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\003I\000\000\003I\000\000\000\000\n\198\000\000\003I\003I\003I\000\000\003I\003I\003I\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003I\000\000\000\000\000\000\000\000\000\000\003I\003I\011\190\011\214\003I\000\000\000\000\000\000\000\000\003I\000\000\011\238\003I\000\000\000\000\000\000\000\000\003I\003I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003I\003I\n\222\011^\012\006\012\030\012N\003I\003I\000\000\000\000\003I\000\000\003I\003I\012f\000\000\000\000\000\000\000\000\000\000\000\000\003I\003I\012~\000\000\003I\003I\003I\003I\000\000\000\000\000\000\000\000\000\000\003I\000\000\003I\003I\000\000\012\222\003I\012\246\0126\003I\003I\000\000\000\000\003I\012\150\003I\000\000\000\000\000\000\000\000\003I\003I\012\174\012\198\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\003]\000\000\003]\000\000\000\000\003]\000\000\003]\003]\003]\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\000\000\003]\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\000\000\000\000\000\000\000\000\003]\000\000\003]\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\003]\003]\003]\003]\000\000\000\000\003]\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\003]\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\003]\000\000\003]\003]\000\000\tF\003]\003]\003]\003]\003]\000\000\000\000\003]\003]\tZ\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003Y\000\000\000\000\000\000\003Y\000\000\000\000\003Y\000\000\000\000\003Y\000\000\003Y\000\000\000\000\n\198\000\000\003Y\003Y\003Y\000\000\003Y\003Y\003Y\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003Y\000\000\000\000\000\000\000\000\000\000\003Y\003Y\011\190\011\214\003Y\000\000\000\000\000\000\000\000\003Y\000\000\011\238\003Y\000\000\000\000\000\000\000\000\003Y\003Y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\n\222\011^\012\006\012\030\012N\003Y\003Y\000\000\000\000\003Y\000\000\003Y\003Y\012f\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\012~\000\000\003Y\003Y\003Y\003Y\000\000\000\000\000\000\000\000\000\000\003Y\000\000\003Y\003Y\000\000\012\222\003Y\012\246\0126\003Y\003Y\000\000\000\000\003Y\012\150\003Y\000\000\000\000\000\000\000\000\003Y\003Y\012\174\012\198\003U\000\000\000\000\000\000\003U\000\000\000\000\003U\000\000\000\000\003U\000\000\003U\000\000\000\000\003U\000\000\003U\003U\003U\000\000\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003U\000\000\003U\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003U\000\000\000\000\000\000\000\000\003U\000\000\003U\003U\000\000\000\000\000\000\000\000\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003U\003U\003U\003U\003U\000\000\000\000\003U\000\000\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\000\000\003U\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\003U\000\000\003U\003U\000\000\tF\003U\003U\003U\003U\003U\000\000\000\000\003U\003U\tZ\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003Q\000\000\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\003Q\000\000\003Q\000\000\000\000\n\198\000\000\003Q\003Q\003Q\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\011\190\011\214\003Q\000\000\000\000\000\000\000\000\003Q\000\000\011\238\003Q\000\000\000\000\000\000\000\000\003Q\003Q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\n\222\011^\012\006\012\030\012N\003Q\003Q\000\000\000\000\003Q\000\000\003Q\003Q\012f\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\012~\000\000\003Q\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\003Q\000\000\003Q\003Q\000\000\012\222\003Q\012\246\0126\003Q\003Q\000\000\000\000\003Q\012\150\003Q\000\000\000\000\000\000\000\000\003Q\003Q\012\174\012\198\003m\000\000\000\000\000\000\003m\000\000\000\000\003m\000\000\000\000\003m\000\000\003m\000\000\000\000\003m\000\000\003m\003m\003m\000\000\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003m\000\000\003m\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003m\000\000\000\000\000\000\000\000\003m\000\000\003m\003m\000\000\000\000\000\000\000\000\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003m\003m\003m\003m\003m\000\000\000\000\003m\000\000\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\000\000\003m\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\003m\000\000\003m\003m\000\000\tF\003m\003m\003m\003m\003m\000\000\000\000\003m\003m\tZ\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003i\000\000\000\000\000\000\003i\000\000\000\000\003i\000\000\000\000\003i\000\000\003i\000\000\000\000\n\198\000\000\003i\003i\003i\000\000\003i\003i\003i\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003i\000\000\000\000\000\000\000\000\000\000\003i\003i\011\190\011\214\003i\000\000\000\000\000\000\000\000\003i\000\000\011\238\003i\000\000\000\000\000\000\000\000\003i\003i\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\n\222\011^\012\006\012\030\012N\003i\003i\000\000\000\000\003i\000\000\003i\003i\012f\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\012~\000\000\003i\003i\003i\003i\000\000\000\000\000\000\000\000\000\000\003i\000\000\003i\003i\000\000\012\222\003i\012\246\0126\003i\003i\000\000\000\000\003i\012\150\003i\000\000\000\000\000\000\000\000\003i\003i\012\174\012\198\003\141\000\000\000\000\000\000\003\141\000\000\000\000\003\141\000\000\000\000\003\141\000\000\003\141\000\000\000\000\003\141\000\000\003\141\003\141\003\141\000\000\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\141\000\000\003\141\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\141\000\000\000\000\000\000\000\000\003\141\000\000\003\141\003\141\000\000\000\000\000\000\000\000\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\000\000\000\000\003\141\000\000\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\000\000\003\141\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\003\141\000\000\003\141\003\141\000\000\tF\003\141\003\141\003\141\003\141\003\141\000\000\000\000\003\141\003\141\tZ\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\137\000\000\000\000\000\000\003\137\000\000\000\000\003\137\000\000\000\000\003\137\000\000\003\137\000\000\000\000\n\198\000\000\003\137\003\137\003\137\000\000\003\137\003\137\003\137\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003\137\000\000\000\000\000\000\000\000\000\000\003\137\003\137\011\190\011\214\003\137\000\000\000\000\000\000\000\000\003\137\000\000\011\238\003\137\000\000\000\000\000\000\000\000\003\137\003\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\n\222\011^\012\006\012\030\012N\003\137\003\137\000\000\000\000\003\137\000\000\003\137\003\137\012f\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\012~\000\000\003\137\003\137\003\137\003\137\000\000\000\000\000\000\000\000\000\000\003\137\000\000\003\137\003\137\000\000\012\222\003\137\012\246\0126\003\137\003\137\000\000\000\000\003\137\012\150\003\137\000\000\000\000\000\000\000\000\003\137\003\137\012\174\012\198\003}\000\000\000\000\000\000\003}\000\000\000\000\003}\000\000\000\000\003}\000\000\003}\000\000\000\000\003}\000\000\003}\003}\003}\000\000\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003}\000\000\003}\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003}\000\000\000\000\000\000\000\000\003}\000\000\003}\003}\000\000\000\000\000\000\000\000\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003}\003}\003}\003}\003}\000\000\000\000\003}\000\000\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\000\000\003}\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\003}\000\000\003}\003}\000\000\tF\003}\003}\003}\003}\003}\000\000\000\000\003}\003}\tZ\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003y\000\000\000\000\000\000\003y\000\000\000\000\003y\000\000\000\000\003y\000\000\003y\000\000\000\000\n\198\000\000\003y\003y\003y\000\000\003y\003y\003y\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003y\000\000\000\000\000\000\000\000\000\000\003y\003y\011\190\011\214\003y\000\000\000\000\000\000\000\000\003y\000\000\011\238\003y\000\000\000\000\000\000\000\000\003y\003y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\n\222\011^\012\006\012\030\012N\003y\003y\000\000\000\000\003y\000\000\003y\003y\012f\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\012~\000\000\003y\003y\003y\003y\000\000\000\000\000\000\000\000\000\000\003y\000\000\003y\003y\000\000\012\222\003y\012\246\0126\003y\003y\000\000\000\000\003y\012\150\003y\000\000\000\000\000\000\000\000\003y\003y\012\174\012\198\003E\000\000\000\000\000\000\003E\000\000\000\000\003E\000\000\000\000\003E\000\000\003E\000\000\000\000\003E\000\000\003E\003E\003E\000\000\003E\003E\003E\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003E\000\000\003E\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003E\000\000\000\000\000\000\000\000\003E\000\000\003E\003E\000\000\000\000\000\000\000\000\003E\003E\003E\000\000\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003E\003E\003E\003E\003E\000\000\000\000\003E\000\000\003E\003E\003E\000\000\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\000\000\003E\003E\003E\003E\000\000\000\000\000\000\000\000\000\000\003E\000\000\003E\003E\000\000\tF\003E\003E\003E\003E\003E\000\000\000\000\003E\003E\tZ\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003A\000\000\000\000\000\000\003A\000\000\000\000\003A\000\000\000\000\003A\000\000\003A\000\000\000\000\n\198\000\000\003A\003A\003A\000\000\003A\003A\003A\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\003A\000\000\000\000\000\000\000\000\000\000\003A\003A\011\190\011\214\003A\000\000\000\000\000\000\000\000\003A\000\000\011\238\003A\000\000\000\000\000\000\000\000\003A\003A\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003A\003A\n\222\011^\012\006\012\030\012N\003A\003A\000\000\000\000\003A\000\000\003A\003A\012f\000\000\000\000\000\000\000\000\000\000\000\000\003A\003A\012~\000\000\003A\003A\003A\003A\000\000\000\000\000\000\000\000\000\000\003A\000\000\003A\003A\000\000\012\222\003A\012\246\0126\003A\003A\000\000\000\000\003A\012\150\003A\000\000\000\000\000\000\000\000\003A\003A\012\174\012\198\t\153\000\000\000\000\000\000\t\153\000\000\000\000\t\153\000\000\000\000\t\153\000\000\t\153\000\000\000\000\n\198\000\000\t\153\t\153\t\153\000\000\t\153\t\153\t\153\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\t\153\000\000\000\000\000\000\000\000\000\000\t\153\t\153\011\190\011\214\t\153\000\000\000\000\000\000\000\000\t\153\000\000\011\238\t\153\000\000\000\000\000\000\000\000\t\153\t\153\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\153\t\153\n\222\011^\012\006\012\030\012N\t\153\t\153\000\000\000\000\t\153\000\000\t\153\t\153\012f\000\000\000\000\000\000\000\000\000\000\000\000\t\153\t\153\012~\000\000\t\153\t\153\t\153\t\153\000\000\000\000\000\000\000\000\000\000\t\153\000\000\t\153\t\153\000\000\t\153\t\153\t\153\0126\t\153\t\153\000\000\000\000\t\153\012\150\t\153\000\000\000\000\000\000\000\000\t\153\t\153\012\174\012\198\t\241\000\000\000\000\000\000\t\241\000\000\000\000\t\241\000\000\000\000\t\241\000\000\t\241\000\000\000\000\t\241\000\000\t\241\t\241\t\241\000\000\t\241\t\241\t\241\000\000\000\000\000\000\000\000\000\000\t\241\t\241\t\241\t\241\t\241\000\000\t\241\000\000\000\000\000\000\000\000\000\000\t\241\t\241\t\241\t\241\t\241\000\000\000\000\000\000\000\000\t\241\000\000\t\241\t\241\000\000\000\000\000\000\000\000\t\241\t\241\t\241\000\000\000\000\000\000\000\000\000\000\000\000\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\000\000\000\000\t\241\000\000\t\241\t\241\t\241\000\000\000\000\000\000\000\000\000\000\000\000\t\241\t\241\t\241\000\000\t\241\t\241\t\241\t\241\000\000\000\000\000\000\000\000\000\000\t\241\000\000\t\241\t\241\000\000\tF\t\241\t\241\t\241\t\241\t\241\000\000\000\000\t\241\t\241\tZ\000\000\000\000\000\000\000\000\t\241\t\241\t\241\t\241\002U\000\000\000\000\000\000\002U\000\000\000\000\002U\000\000\000\000\002U\000\000\002U\000\000\000\000\002U\000\000\002U\002U\002U\000\000\002U\002U\002U\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\002U\002U\002U\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\002U\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\000\000\002U\002U\016\250\002U\000\000\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\tF\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\tZ\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002M\000\000\000\000\000\000\002M\000\000\000\000\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\002M\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\002M\002M\002M\002M\000\000\000\000\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\tF\002M\002M\002M\002M\002M\000\000\000\000\002M\002M\tZ\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002I\000\000\000\000\000\000\002I\000\000\000\000\002I\000\000\000\000\002I\000\000\002I\000\000\000\000\n\198\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\011\190\011\214\002I\000\000\000\000\000\000\000\000\002I\000\000\011\238\002I\000\000\000\000\000\000\000\000\002I\002I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\n\222\011^\012\006\012\030\012N\002I\002I\000\000\000\000\002I\000\000\002I\002I\012f\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\012~\000\000\002I\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\012\222\002I\012\246\0126\002I\002I\000\000\000\000\002I\012\150\002I\000\000\000\000\000\000\000\000\002I\002I\012\174\012\198\002Q\000\000\000\000\000\000\002Q\000\000\000\000\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\n\198\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\011\190\011\214\002Q\000\000\000\000\000\000\000\000\002Q\000\000\011\238\002Q\000\000\000\000\000\000\000\000\002Q\002Q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\n\222\011^\012\006\012\030\012N\002Q\002Q\000\000\000\000\002Q\000\000\002Q\002Q\012f\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\012~\000\000\002Q\002Q\017\022\002Q\000\000\000\000\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\012\222\002Q\012\246\0126\002Q\002Q\000\000\000\000\002Q\012\150\002Q\000\000\000\000\000\000\000\000\002Q\002Q\012\174\012\198\002E\000\000\000\000\000\000\002E\000\000\000\000\002E\000\000\000\000\002E\000\000\002E\000\000\000\000\002E\000\000\002E\002E\002E\000\000\002E\002E\002E\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002E\000\000\002E\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002E\000\000\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\000\000\000\000\000\000\002E\002E\002E\000\000\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\000\000\002E\002E\002E\000\000\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\000\000\002E\002E\002E\002E\000\000\000\000\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\tF\002E\002E\002E\002E\002E\000\000\000\000\002E\002E\tZ\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002A\000\000\000\000\000\000\002A\000\000\000\000\002A\000\000\000\000\002A\000\000\002A\000\000\000\000\n\198\000\000\002A\002A\002A\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\002A\000\000\000\000\000\000\000\000\000\000\002A\002A\011\190\011\214\002A\000\000\000\000\000\000\000\000\002A\000\000\011\238\002A\000\000\000\000\000\000\000\000\002A\002A\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\n\222\011^\012\006\012\030\012N\002A\002A\000\000\000\000\002A\000\000\002A\002A\012f\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\012~\000\000\002A\002A\002A\002A\000\000\000\000\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\012\222\002A\012\246\0126\002A\002A\000\000\000\000\002A\012\150\002A\000\000\000\000\000\000\000\000\002A\002A\012\174\012\198\003=\000\000\000\000\000\000\003=\000\000\000\000\003=\000\000\000\000\003=\000\000\003=\000\000\000\000\003=\000\000\003=\003=\003=\000\000\003=\003=\003=\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\003=\003=\000\000\003=\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\003=\003=\000\000\000\000\000\000\000\000\003=\000\000\003=\003=\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\003=\003=\003=\003=\003=\003=\000\000\000\000\003=\000\000\003=\003=\003=\000\000\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\003=\003=\003=\003=\000\000\000\000\000\000\000\000\000\000\003=\000\000\003=\003=\000\000\tF\003=\003=\003=\003=\003=\000\000\000\000\003=\003=\tZ\000\000\000\000\000\000\000\000\003=\003=\003=\003=\0039\000\000\000\000\000\000\0039\000\000\000\000\0039\000\000\000\000\0039\000\000\0039\000\000\000\000\n\198\000\000\0039\0039\0039\000\000\0039\0039\0039\000\000\000\000\000\000\000\000\000\000\011.\011v\011\142\011F\011\166\000\000\0039\000\000\000\000\000\000\000\000\000\000\0039\0039\011\190\011\214\0039\000\000\000\000\000\000\000\000\0039\000\000\011\238\0039\000\000\000\000\000\000\000\000\0039\0039\000\238\000\000\000\000\000\000\000\000\000\000\000\000\0039\0039\n\222\011^\012\006\012\030\012N\0039\0039\000\000\000\000\0039\000\000\0039\0039\012f\000\000\000\000\000\000\000\000\000\000\000\000\0039\0039\012~\000\000\0039\0039\0039\0039\000\000\000\000\000\000\000\000\000\000\0039\000\000\0039\0039\000\000\012\222\0039\012\246\0126\0039\0039\000\000\000\000\0039\012\150\0039\000\000\000\000\000\000\000\000\0039\0039\012\174\012\198\0029\000\000\000\000\000\000\0029\000\000\000\000\0029\000\000\000\000\0029\000\000\0029\000\000\000\000\0029\000\000\0029\0029\0029\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\0029\0029\000\000\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\0029\0029\000\000\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\000\000\0029\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\000\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\0029\0029\0029\0029\0029\0029\000\000\000\000\0029\0029\tZ\000\000\000\000\000\000\000\000\0029\0029\0029\0029\002=\000\000\000\000\000\000\002=\000\000\000\000\002=\000\000\000\000\002=\000\000\002=\000\000\000\000\002=\000\000\002=\002=\002=\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002=\000\000\002=\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002=\002=\002=\002=\002=\000\000\000\000\002=\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\000\000\002=\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\002=\002=\002=\002=\002=\002=\000\000\000\000\002=\002=\tZ\000\000\000\000\000\000\000\000\002=\002=\002=\002=\000\006\000\000\000\000\007\141\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\001\006\000\000\000\000\000\000\002\134\000\000\000\000\000\000\007\141\001\194\000\000\000\000\000\000\003\214\001\014\t\158\t\162\001\026\001\030\000\000\000\000\000\000\002\238\000\000\003\138\000\000\019\002\000\000\t\194\t\198\007\141\003\198\003\210\003\222\t\202\007\006\000\000\001.\007\141\002\162\000\000\000\000\003\218\007\141\007\141\000\238\bf\bj\bv\b\134\000\000\005\138\007\141\007\141\0012\0016\001:\001>\001B\000\000\000\000\b\158\001F\000\000\000\000\000\000\000\000\001J\000\000\b\170\b\194\tf\005\150\005\154\000\000\000\000\001N\000\000\000\000\007\141\000\000\000\000\b~\001R\b\130\000\000\000\000\000\000\000\000\000\000\007\141\000\000\000\000\000\000\001\142\006>\000\000\000\000\005\158\b\146\000\000\001\146\000\000\016\"\004^\t\222\026\214\001\154\000\006\001\158\001\162\001\153\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\001\006\000\000\000\000\000\000\t\154\000\000\000\000\000\000\001\153\001\194\000\000\000\000\000\000\003\214\001\014\t\158\t\162\001\026\001\030\000\000\000\000\000\000\002\238\000\000\003\138\000\000\t\166\000\000\t\194\t\198\001\153\003\198\003\210\003\222\t\202\007\006\000\000\001.\001\153\002\162\000\000\000\000\003\218\001\153\001\153\000\238\bf\bj\bv\b\134\000\000\005\138\001\153\001\153\0012\0016\001:\001>\001B\000\000\000\000\b\158\001F\000\000\000\000\017\250\000\000\001J\002z\b\170\b\194\tf\005\150\005\154\000\000\000\000\001N\001\190\000\000\001\153\000\000\000\000\b~\001R\b\130\000\000\024f\000\000\000\000\028\206\001\153\000\000\000\000\000\000\001\142\006z\000\000\000\000\005\158\b\146\000\000\001\146\000\000\016\"\004^\t\222\017\254\001\154\000\000\001\158\001\162\000\145\002\170\002\174\000\145\000\000\002z\000\000\n*\002\146\018\n\002\230\024\138\000\000\000\145\000\000\000\145\000\000\000\145\000\000\000\145\001\194\000\000\nZ\000\000\002\234\003\130\003R\002\174\000\241\000\000\nb\000\145\000\000\002\238\003V\003\138\005\154\000\145\004\186\000\000\b6\000\145\005\137\003\210\001\174\001\194\000\145\000\241\024\150\000\145\002\162\000\000\000\000\003\218\000\145\000\145\000\145\bf\bj\bv\005\173\014J\005\138\000\145\000\145\024*\000\000\000\000\003~\000\241\000\145\002\250\005\173\000\000\000\145\002\162\000\000\000\241\000\000\000\000\000\000\000\000\000\241\005\150\005\154\000\145\000\145\000\000\000\000\000\145\000\145\000\241\000\241\b~\000\000\b\130\006\158\000\000\000\000\t\213\000\000\000\145\005\173\000\000\007\026\000\000\000\000\000\145\000\145\005\158\b\146\000\000\000\000\000\000\tz\004^\000\000\000\145\000\241\000\145\000\169\002\170\002\174\000\169\000\000\002z\000\000\n*\000\000\000\241\002\230\000\000\005\173\000\169\000\000\000\169\005\173\000\169\000\238\000\169\001\194\000\000\nZ\000\000\002\234\000\000\000\000\000\000\000\000\000\000\nb\000\169\000\000\002\238\000\000\003\138\000\000\000\169\000\000\tU\000\000\000\169\000\000\003\210\001\174\002\158\000\169\001\241\000\000\000\169\002\162\021\182\000\000\003\218\000\169\000\169\000\169\bf\bj\bv\000\000\014J\005\138\000\169\000\169\006N\000\000\000\000\005\250\000\000\000\169\000\000\000\000\t\213\000\169\006b\000\n\000\000\tU\006j\000\000\000\000\000\000\005\150\005\154\000\169\000\169\000\000\000\000\000\169\000\169\000\000\001\241\b~\000\000\b\130\000\000\000\000\000\000\000\000\tU\000\169\001\190\000\000\001\241\001\241\000\000\000\169\000\169\005\158\b\146\000\000\000\000\000\000\tz\004^\000\000\000\169\000\006\000\169\001\194\000\246\002\170\002\174\002\178\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\021\226\003^\tU\000\000\000\000\005\029\004\218\003b\001\194\tU\020&\002\146\002\234\022Z\003f\003j\000\000\002\162\000\000\003n\000\000\002\238\000\000\003\138\022r\019\186\tQ\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\020\030\002\162\000\000\000\000\003\218\0206\001\186\001\190\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020>\000\000\b\158\000\000\001\194\001\234\000\000\tQ\b\190\000\000\b\170\b\194\tf\005\150\005\154\020R\020\142\000\000\000\000\005\029\005\029\000\000\000\000\b~\000\249\b\130\000\000\001\230\002\154\tQ\000\000\000\000\002\150\000\000\002\162\004\014\004\026\020\202\024\190\005\158\b\146\004&\000\000\000\249\tz\004^\t\222\000\006\016\206\000\000\000\246\002\170\002\174\002\178\002\218\002z\000\000\000\000\004*\000\000\002\230\000\000\028\214\005=\tQ\000\249\000\238\021\234\004\218\003b\001\194\tQ\000\000\000\249\002\234\000\000\003f\003j\000\249\000\000\028\194\003n\000\000\002\238\000\000\003\138\000\000\019\186\000\249\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\020\030\002\162\000\000\000\000\003\218\0206\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\006N\000\249\000\000\005\250\000\000\000\000\000\000\020>\000\000\b\158\006b\030\210\000\249\000\000\006j\000\000\000\000\b\170\b\194\tf\005\150\005\154\020R\020\142\000\000\000\000\030\243\017.\000\000\000\000\b~\000\000\b\130\000\000\000\000\000\000\000\000\000\000\017\250\000\000\000\000\002z\000\000\r\005\012\241\024\190\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\000\006\000\000\000\000\000\246\002\170\002\174\002\178\002\218\002z\r\005\000\000\000\000\002\022\002\230\000\000\002\026\031\"\000\000\000\000\000\000\000\000\000\000\003b\001\194\000\000\017\254\000\000\002\234\002&\003f\003j\002.\012\241\000\000\003n\000\000\002\238\000\000\003\138\018\n\019\186\024j\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\020\030\002\162\000\000\0022\003\218\0206\001\254\000\000\bf\bj\bv\b\134\000\000\005\138\005\154\000\000\002\002\000\000\000\000\0076\000\000\020>\000\000\b\158\001\194\030\210\024v\000\000\000\000\000\000\000\000\b\170\b\194\tf\005\150\005\154\020R\020\142\000\000\000\000\005E\003B\000\000\024*\b~\000\000\b\130\0072\001\206\000\000\0026\000\000\000\000\000\000\002\162\000\000\000\000\000\000\000\000\024\190\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\007>\000>\000\000\001\241\000\000\000B\001\241\000\000\000\000\000\000\000\000\000\000\000F\000\000\000\000\000\000\000\000\000\000\000J\000\000\000N\000R\000V\000Z\000^\000b\000f\000\000\000\000\000\n\000j\000n\000\000\000r\000\000\000v\000\000\rE\000\000\000\000\000\000\000\000\000\000\000\000\001\241\000\000\000\000\000\000\000\000\000z\000\000\000\000\000~\000\130\000\000\000\000\rE\001\241\001\241\000\134\000\138\000\142\000\000\000\000\000\000\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\rE\000\174\000\178\000\182\000\000\000\000\000\000\001\241\rE\000\186\000\000\000\190\000\194\rE\rE\000\238\000\000\000\000\000\000\000\198\000\000\000\202\rE\rE\000\000\000\000\000\000\000\206\000\210\000\000\000\214\004y\002\254\002\174\004y\000\000\002z\000\000\006\214\000\000\000\000\002\230\000\000\000\000\004y\000\000\000\000\000\000\004y\rE\004y\001\194\000\000\006\246\000\000\000\000\001\241\001\241\003\002\000\000\rE\b\206\004y\000\000\000\000\000\000\000\000\000\000\004y\000\000\000\000\003\014\000\000\000\000\b\250\001\174\001\241\004y\000\000\001\241\004y\002\162\001\241\000\n\003\234\004y\004y\011%\003\238\001\241\003\246\000\000\t\n\005\138\000\000\001\241\000\000\000\000\001\241\001\241\000\000\004y\004y\000\000\000\000\005\142\000\000\000\000\000\000\000\000\000\000\001\241\000\000\000\000\005\150\005\154\004y\004y\r\026\000\000\004y\004y\001\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011%\n6\000\000\011%\r\"\004y\005\158\000\000\000\000\000\000\011%\000\000\004^\000\000\011%\000\000\004y\002\254\002\174\006\026\000\000\002z\000\000\000\000\000\000\000\000\002\230\001\006\000\000\000\000\000\000\002\134\000\000\000\000\000\000\001\241\001\194\000\000\001\241\001\241\001\n\001\014\001\018\003\030\001\026\001\030\001\241\000\000\000\000\000\000\000\000\000\000\000\000\003\"\000\000\001\"\006:\001\241\000\000\003\026\001\174\001*\000\000\000\000\001.\000\n\002\162\000\000\000\000\003\234\000\000\000\000\000\000\003\238\000\000\003\246\005~\000\000\005\138\000\000\001\241\0012\0016\001:\001>\001B\000\000\001\241\000\000\001F\005\142\000\000\000\000\001\241\001J\000\000\000\000\000\000\000\000\005\150\005\154\000\000\005\218\001N\000\000\000\000\000\000\000\000\000\000\000\000\001R\000\000\000\000\000\000\000\000\000\000\001\241\000\000\000\000\000\000\000\000\001\142\006>\000\000\000\000\005\158\000\000\000\000\001\146\000\000\001\150\004^\000\000\000\000\001\154\000\000\001\158\001\162\002\254\002\174\b\254\000\000\002z\000\000\000\000\000\000\000\000\002\230\001\006\000\000\000\000\003r\002\134\000\000\000\000\000\000\000\000\001\194\000\000\000\000\000\000\001\n\001\014\001\018\003\030\001\026\001\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\"\000\000\001\"\006:\000\000\000\000\003\026\001\174\001*\000\000\000\000\001.\000\000\002\162\000\000\000\000\003\234\001\241\000\000\000\000\003\238\000\000\003\246\005~\000\000\005\138\000\000\001\241\0012\0016\001:\001>\001B\000\000\000\000\001\241\001F\005\142\000\000\000\000\000\000\001J\000\000\000\n\000\000\000\000\005\150\005\154\000\000\005\218\001N\000\000\001\241\000\000\000\000\000\000\000\000\001R\001\241\001\241\000\000\000\000\000\000\000\000\000\000\001\241\000\000\000\000\001\142\006>\000\000\001\241\005\158\000\000\000\000\001\146\000\000\001\150\004^\000\000\000\000\001\154\000\006\001\158\001\162\000\246\002\170\002\174\002\n\002\218\002z\000\000\000\000\000\000\001\241\002\230\000\000\000\000\020\206\000\000\t\189\000\000\t\189\t\189\003b\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\020\210\000\000\002\238\000\000\003\138\000\000\020\250\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\020\030\002\162\000\000\000\000\003\218\0206\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\142\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\254\b\194\tf\005\150\005\154\020R\021\162\000\000\000\000\005\017\005\017\000\000\000\000\b~\000\000\b\130\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\021\178\005\158\b\146\t\189\002\230\000\000\tz\004^\t\222\t\181\000\000\t\181\t\181\000\000\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\001\241\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\001\241\001\241\000\000\002\162\001\241\000\000\003\218\000\000\001\241\001\241\bf\bj\bv\b\134\000\000\005\138\000\000\000\n\000\000\001\241\000\000\000\000\000\000\000\000\000\000\b\158\001\241\000\n\000\000\000\000\001\241\000\000\001\241\t\254\b\194\tf\005\150\005\154\001\241\001\241\000\000\000\000\001\241\001\241\000\000\001\241\b~\001\241\b\130\001\241\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\005\158\b\146\t\181\000\000\001\241\tz\004^\t\222\001\241\000\000\001\241\001\241\001\241\000\000\001\241\001\241\000\n\001\241\001\241\007\n\001\241\001\241\000\000\001\241\000\000\017\178\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\001\241\000\000\000\000\001\241\000\000\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\001\241\000\000\000\000\000\000\000\n\000\000\000\000\000\000\001\241\000\000\001\241\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\005\173\017\238\000\000\000\000\005\173\001\241\005\173\005\173\001\241\000\000\001\241\001\241\000\000\000\000\000\000\005\173\000\000\005\173\005\173\005\173\000\000\005\173\005\173\005\173\001\241\001\241\000\000\000\000\000\000\001\241\001\241\001\241\000\000\000\000\001\241\005\173\000\000\000\000\000\000\000\000\000\000\005\173\005\173\000\000\000\000\005\173\000\000\005\173\005\173\005\173\005\173\000\000\000\000\005\173\000\000\000\000\000\000\000\000\005\173\005\173\005\173\000\000\005\173\000\000\005\173\000\000\005\173\005\173\005\173\007\014\000\000\000\000\000\000\000\000\005\173\000\000\000\000\000\000\005\173\000\000\000\000\000\000\005\173\000\000\005\173\005\173\000\000\000\000\000\000\005\173\005\173\005\173\000\000\005\173\005\173\000\000\005\173\000\000\000\000\024\230\000\000\005\173\005\173\005\173\000\000\005\173\000\000\005\173\005\173\000\000\000\000\002\142\005\173\000\000\000\000\000\000\000\000\005\173\003b\000\000\000\000\005\173\000\006\005\173\005\173\000\000\002\170\002\174\000\000\002\218\002z\000\000\005\173\005\173\005\173\002\230\005\173\005\173\000\000\000\000\025V\000\000\003\242\000\000\000\000\001\194\000\000\000\000\020\030\002\234\000\000\003f\003j\0206\023:\005\173\000\000\000\000\002\238\000\000\003\138\000\000\025\250\026\n\003\190\003\194\005\173\003\198\003\210\003\222\003\230\007\006\000\000\002\174\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\0055\000\000\001\194\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\026\246\000\000\000\000\000\000\024\218\t\254\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\026\022\003\150\000\000\026\026\b~\021\250\b\130\002\162\000\000\000\000\000\000\000\000\000\000\000\000\026J\000\000\000\000\000\000\000\000\000\000\005\158\b\146\018\242\000\000\003b\tz\004^\t\222\011A\000\000\000\246\011A\011A\002\178\000\000\011A\000\000\011A\026Z\000\000\011A\000\000\000\000\005=\011A\011A\022&\011A\011A\003b\011A\000\000\011A\000\000\020\030\r\005\012\241\011A\000\000\0206\011A\003n\000\000\000\000\000\000\000\000\000\000\019\186\011A\022R\011A\000\000\000\000\011A\011A\r\005\027r\000\000\002\022\020\030\011A\002\026\000\000\011A\0206\000\000\011A\011A\002\"\011A\000\000\011A\011A\000\000\002&\005-\000\000\002.\012\241\000\000\020>\000\000\000\000\000\000\011A\000\000\022\182\000\000\000\000\005\t\000\000\000\000\005\t\011A\011A\020R\020\142\011A\000\000\011A\000\000\0022\005\t\000\000\000\000\000\000\005\186\000\000\005\t\000\000\000\000\000\000\000\000\011A\011A\000\000\011A\011A\024\190\011A\005\t\011A\000\000\011A\000A\011A\005\t\011A\000A\000A\000\000\000A\000A\000\000\000\000\005\t\000\000\000A\005\t\000\000\000\000\000\000\007=\005\t\002\210\000\000\000\000\000A\0026\000\000\000\000\000A\000\000\000A\000A\000\000\000\000\000\000\000\000\005\t\000A\000\000\000A\005\t\000\000\000\000\000A\000A\000\000\000A\000A\000A\000A\000A\005\t\005\t\000\000\000A\005\t\000\000\000A\000\000\000\000\000\000\000A\000A\000A\000A\000\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\t\000\000\000A\000\000\r9\000\000\000\000\000\000\000\000\000\000\000A\000A\000A\000A\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\221\000A\000=\000A\005\221\000\000\000=\000=\000\000\000=\000=\000\000\000\000\000\000\000\000\000=\000\000\000A\000A\000\000\0079\000\000\000A\000A\000A\000=\000\000\000\000\000\000\000=\000\000\000=\000=\000\000\000\000\000\000\000\000\000\000\000=\000\000\000=\000\000\000\000\000\000\000=\000=\000\000\000=\000=\000=\000=\000=\000\000\000\000\000\000\000=\000\000\000\000\000=\r9\r9\000\000\000=\000=\000=\000=\000\000\000=\000\000\000\000\000\000\000\000\000\000\005\221\000\000\000\000\000\000\000=\000\000\r9\r9\000\000\000\000\r9\000\000\000=\000=\000=\000=\000=\005\221\000\000\000\000\005\221\000\000\000\000\000\000\005\225\000=\012\149\000=\005\225\000\000\012\149\012\149\000\000\012\149\012\149\000\000\000\000\000\000\000\000\012\149\000\000\000=\000=\000\000\007I\000\000\000=\000=\000=\012\149\000\000\000\000\000\000\012\149\000\000\012\149\012\149\000\000\000\000\000\000\000\000\000\000\012\149\000\000\012\149\000\000\000\000\000\000\012\149\012\149\000\000\012\149\012\149\012\149\012\149\012\149\000\000\000\000\000\000\012\149\000\000\000\000\012\149\r9\r9\000\000\012\149\012\149\012\149\012\149\000\000\012\149\000\000\000\000\000\000\000\000\000\000\005\225\000\000\000\000\000\000\012\149\000\000\000\000\r9\000\000\000\000\r9\000\000\012\149\012\149\012\149\012\149\012\149\005\225\000\000\000\000\005\225\000\000\000\000\000\000\000\000\012\149\012\145\012\149\000\000\000\000\012\145\012\145\000\000\012\145\012\145\000\000\000\000\000\000\000\000\012\145\000\000\012\149\012\149\000\000\007E\000\000\012\149\012\149\012\149\012\145\000\000\000\000\000\000\012\145\000\000\012\145\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\012\145\000\000\000\000\000\000\012\145\012\145\000\000\012\145\012\145\012\145\012\145\012\145\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\000\000\012\145\012\145\012\145\012\145\000\000\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\t\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\012\145\012\145\012\145\012\145\000\000\000\000\000\000\000\000\000\000\005\t\000\000\000\000\012\145\000\006\012\145\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\012\145\012\145\000\000\005\t\000\000\012\145\012\145\012\145\001\194\000\000\000\000\005\t\002\234\000\000\003f\003j\005\t\002\210\000\238\000\000\000\000\002\238\000\000\003\138\000\000\005\t\005\t\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\005\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\005\t\000\000\000\000\000\000\000\000\t\254\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\000\b\130\000\000\r\005\012\241\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\005\158\b\146\0162\002\230\000\000\tz\004^\t\222\r\005\000\000\016B\002\022\000\000\001\194\002\026\000\000\000\000\002\234\000\000\003f\003j\002\190\000\000\000\000\000\000\000\000\002\238\002&\003\138\000\000\002.\012\241\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\0022\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\254\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\0026\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019>\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\222\b\194\tf\005\150\005\154\012\205\000\000\000\000\000\000\012\205\000\000\001\190\012\205\b~\000\000\b\130\000\000\000\000\000\000\000\000\004\178\000\000\012\205\012\205\012\205\000\000\012\205\012\205\012\205\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\000\000\000\000\000\000\012\205\000\000\000\000\000\000\000\000\000\000\012\205\012\205\000\000\000\000\012\205\000\000\000\000\002\146\000\000\012\205\000\000\000\000\012\205\000\000\000\000\000\000\000\000\012\205\012\205\012\205\000\000\000\000\000\000\000\000\000\000\004\233\012\205\012\205\004\233\000\000\000\000\000\000\000\000\012\205\000\000\000\000\000\000\004\186\004\233\000\000\000\000\012\205\004\233\000\000\004\233\000\000\000\000\000\000\012\205\012\205\012\205\000\000\012\205\012\205\000\000\000\000\004\233\000\000\000\000\000\000\000\000\000\000\004\233\000\000\012\205\000\000\012\205\012\205\000\000\000\000\000\000\012\205\000\000\000\000\004\233\000\000\012\205\000\000\000\000\004\233\012\205\t\165\012\205\012\205\000\000\t\165\000\000\001\190\t\165\000\000\000\000\000\000\000\000\000\000\000\000\004\233\t\165\000\000\t\165\t\165\t\165\000\000\t\165\t\165\t\165\000\000\000\000\000\000\000\000\000\000\004\233\004\233\000\000\000\000\004\233\004\233\t\165\000\000\000\000\000\000\000\000\000\000\t\165\t\165\000\000\000\000\t\165\000\000\000\000\002\146\000\000\t\165\000\000\004\233\t\165\000\000\000\000\000\000\000\000\t\165\t\165\t\165\000\000\000\000\021F\000\000\000\000\004\209\t\165\t\165\004\209\000\000\000\000\000\000\000\000\t\165\000\000\000\000\000\000\004\186\004\209\000\000\000\000\t\165\004\209\000\000\004\209\000\000\000\000\000\000\t\165\t\165\t\165\000\000\t\165\t\165\000\000\000\000\004\209\000\000\000\000\000\000\000\000\000\000\004\209\000\000\t\165\000\000\t\165\t\165\000\000\000\000\000\000\t\165\000\000\000\000\004\209\000\000\t\165\000\000\000\000\004\209\t\165\t\161\t\165\t\165\000\000\t\161\000\000\001\190\t\161\000\000\000\000\000\000\000\000\000\000\000\000\004\209\t\161\000\000\t\161\t\161\t\161\000\000\t\161\t\161\t\161\000\000\000\000\000\000\000\000\000\000\004\209\004\209\000\000\000\000\004\209\004\209\t\161\000\000\000\000\000\000\000\000\000\000\t\161\t\161\000\000\000\000\t\161\000\000\000\000\002\146\000\000\t\161\000\000\004\209\t\161\000\000\000\000\000\000\000\000\t\161\t\161\t\161\000\000\000\000\023\130\000\000\000\000\000\000\t\161\t\161\000\000\000\000\000\000\000\000\000\000\t\161\000\000\000\000\000\000\004\186\000\000\000\000\000\000\t\161\000\000\000\000\000\000\000\000\000\000\000\000\t\161\t\161\t\161\000\000\t\161\t\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\161\000\006\t\161\t\161\000\000\002\170\002\174\t\161\002\218\002z\000\000\000\000\t\161\000\000\002\230\000\000\t\161\000\000\t\161\t\161\000\000\000\000\000\000\000\000\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017f\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017>\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t6\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tJ\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\022\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\138\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\202\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\226\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\006\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0112\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011J\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011b\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011z\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\146\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\170\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\194\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\218\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\242\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\n\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\"\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012:\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012R\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012j\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\130\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\154\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\178\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\202\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\226\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\250\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014f\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\138\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\174\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\214\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\250\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\030\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015J\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015n\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\146\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\174\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\234\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\254\b\194\tf\005\150\005\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b~\000\006\b\130\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\210\003\222\003\230\007\006\000\000\000\000\000\000\002\162\000\000\000\000\003\218\000\000\000\000\000\000\bf\bj\bv\b\134\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\026\b\194\tf\005\150\005\154\000\000\000y\000\000\000y\000y\000\000\000\000\000\000\b~\000\000\b\130\000\000\000y\000\000\000y\000y\000\000\000\000\000y\000y\000y\000\000\t=\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\t\222\000y\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000y\000\000\000\000\000y\000\000\000y\000\000\000\000\000y\000\000\000\000\000\000\000\000\000y\000y\000y\000\000\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000y\000\000\000\000\000\000\000y\000\000\000\000\000\000\000\000\000\000\000\000\000y\000y\000y\012\209\000y\000y\000\000\012\209\000\000\000\000\012\209\000\000\t=\000\000\000\000\000\000\000y\000\000\004v\000y\012\209\012\209\012\209\000y\012\209\012\209\012\209\000\000\000y\000\000\000\000\000\000\000y\000\000\000y\000\000\000\000\000\000\012\209\000\000\000\000\000\000\000\000\000\000\012\209\012\209\000\000\000\000\012\209\000\000\000\000\000\000\000\000\012\209\000\000\000\000\012\209\000\000\000\000\000\000\000\000\012\209\012\209\012\209\000\000\000\000\000\000\000\000\000\000\000\000\012\209\012\209\000\000\000\000\000\000\000\000\000\000\012\209\000\000\000\000\000\000\012\209\000\000\000\000\000\000\012\209\000\000\000\000\000\000\000\000\000\000\000\000\012\209\012\209\012\209\003\177\012\209\012\209\000\000\003\177\000\000\000\000\003\177\000\000\000\000\000\000\000\000\000\000\012\209\000\000\012\209\012\209\003\177\003\177\003\177\012\209\003\177\003\177\003\177\000\000\012\209\000\000\000\000\000\000\012\209\000\000\012\209\012\209\000\000\000\000\003\177\000\000\000\000\000\000\000\000\000\000\003\177\004n\000\000\000\000\003\177\000\000\000\000\000\000\000\000\003\177\000\000\000\000\003\177\000\000\000\000\000\000\000\000\003\177\003\177\003\177\000\000\000\000\000\000\000\000\000\000\000\000\003\177\003\177\000\000\000\000\000\000\000\000\000\000\003\177\000\000\000\000\000\000\003\177\000\000\011M\000\000\003\177\002\254\002\174\000\000\000\000\002z\000\000\003\177\003\177\003\177\002\230\003\177\003\177\000\000\011M\011M\000\000\011M\011M\000\000\001\194\000\000\000\000\003\177\000\000\003\177\003\177\003\002\000\000\000\000\003\177\000\000\000\000\000\000\000\000\003\177\000\000\000\000\011M\003\177\003\014\003\177\003\177\003\026\001\174\000\000\000\000\000\000\001\186\001\190\002\162\000\000\000\000\003\234\000\000\000\000\011M\003\238\000\000\003\246\005~\000\000\005\138\000\000\000\000\000\000\000\000\001\194\001\234\001\214\000\000\000\000\000\000\000\000\005\142\000\000\000\000\001\226\000\000\000\000\021\226\000\000\000\000\005\150\005\154\000\000\005\218\011M\000\000\011M\001\230\0236\000\000\022Z\000\000\002\150\000\000\002\162\004\014\004\026\000\000\000\000\000\000\011M\023F\000\000\011M\011M\000\000\005\158\000\000\011M\000\000\011M\000\000\004^\011I\011M\000\000\002\254\002\174\004*\000\000\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\011I\011I\000\000\011I\011I\000\000\001\194\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011I\000\000\003\014\000\000\012\177\006\022\001\174\012\177\000\000\000\000\000\000\000\000\002\162\000\000\000\000\003\234\000\000\012\177\011I\003\238\000\000\003\246\005~\012\177\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\177\005\142\000\000\000\000\000\000\000\000\012\177\000\000\000\000\000\000\005\150\005\154\000\000\005\218\011I\012\177\011I\000\000\012\177\000\000\000\000\000\000\000\000\012\177\000\000\000\000\000\000\000\000\001\177\000\000\011I\000\000\001\177\011I\011I\001\177\005\158\000\000\011I\012\177\011I\000\000\004^\012\177\011I\001\177\001\177\001\177\000\000\001\177\001\177\001\177\000\000\000\000\012\177\012\177\000\000\000\000\012\177\000\000\000\000\000\000\000\000\001\177\000\000\000\000\030\202\000\000\000\000\001\177\001\177\000\000\000\000\001\177\000\000\000\000\000\000\012\177\001\177\000\000\000\000\001\177\000\000\000\000\000\000\000\000\001\177\001\177\001\177\000\000\000\000\000\000\000\000\000\000\000\000\001\177\001\177\000\000\000\000\000\000\000\000\000\000\001\177\000\000\000\000\000\000\001\177\000\000\000\000\000\000\001\177\000\000\000\000\000\000\000\000\000\000\000\000\001\177\001\177\001\177\000\000\001\177\001\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\177\000\000\001\177\001\177\002\254\002\174\000\000\001\177\002z\000\000\006\214\000\000\001\177\002\230\000\000\000\000\004\218\000\000\001\177\000\000\000\000\000\000\000\000\001\194\000\000\006\246\000\000\000\000\000\000\000\000\003\002\000\000\000\000\b\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\014\000\000\000\000\b\250\001\174\000\000\000\000\000\000\000\000\000\000\002\162\000\000\000\000\003\234\000\000\000\000\011%\003\238\000\000\003\246\000\000\t\n\005\138\000\000\000\000\000\000\000\000\000\000\000\000\006%\000\000\004\181\000\000\006%\005\142\000\000\006%\000\000\000\000\000\000\000\000\000\000\000\000\005\150\005\154\000\000\006%\r\026\006%\000\000\006%\000\000\006%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011%\006%\000\000\011%\011%\000\000\005\158\006%\006%\000\000\011%\000\000\004^\006%\011%\004\181\006%\000\000\000\000\006%\000\000\000\000\000\000\000\000\006%\006%\006%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006%\006%\000\000\000\000\006%\003\253\000\000\000\000\000\000\003\253\000\000\000\000\003\253\000\000\000\000\006%\006%\006%\000\000\006%\006%\000\000\003\253\000\000\003\253\000\000\003\253\007\238\003\253\003\253\000\000\000\000\000\000\000\000\006%\000\000\000\000\006%\006%\003\253\003\253\003\253\000\000\003\253\000\000\003\253\003\253\003\253\000\000\006%\000\000\000\000\005\181\000\000\000\000\003\253\000\000\003\253\003\253\000\000\000\000\000\000\000\000\003\253\003\253\003\253\000\000\000\000\000\000\005\185\000\000\000\000\003\253\000\000\000\000\003\253\000\000\000\000\000\000\003\253\003\253\003\253\003\253\003\253\000\000\000\000\000\000\000\000\000\000\000\000\001\186\001\190\000\000\000\000\003\253\003\253\003\253\000\000\003\253\003\253\003\253\006\025\000\000\000\000\000\000\006\025\005\181\000\000\006\025\001\194\001\234\003\253\003\253\003\253\003\253\003\253\003\253\003\253\006\025\000\000\006\025\000\000\006\025\005\185\006\025\000\000\000\000\000\000\003\253\000\000\003\253\003\253\001\230\002\146\003\253\000\000\006\025\002\150\000\000\002\162\004\014\004\026\006\025\006\025\000\000\003\253\004&\000\000\b2\000\000\000\000\006\025\000\000\000\000\006\025\000\000\000\000\000\000\000\000\006\025\006\025\000\238\000\000\004*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\025\006\025\000\000\000\000\006\025\000\000\000\000\n\198\000\000\000\000\014&\t\177\000\000\t\177\t\177\006\025\006\025\006\025\000\000\006\025\006\025\011.\011v\011\142\011F\011\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\025\011\190\011\214\006\025\006\025\000\000\000\000\000\000\000\000\000\000\011\238\000\000\000\000\000\000\000\000\006\025\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\222\011^\012\006\012\030\012N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017V\012f\001\006\000\000\000\000\000\000\002\134\000\000\000\000\000\000\012~\000\000\000\000\000\000\000\000\001\n\001\014\001\018\001\022\001\026\001\030\000\000\000\000\000\000\000\000\000\000\012\222\000\000\012\246\0126\001\"\001&\000\000\000\000\t\177\012\150\001*\000\000\000\000\001.\000\000\000\000\000\000\012\174\012\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0012\0016\001:\001>\001B\000\000\000\000\000\000\001F\000\000\000\000\004\249\000\000\001J\004\249\000\000\t\021\000\000\000\000\000\000\t\021\000\000\001N\t\021\004\249\000\000\000\000\000\000\004\249\001R\004\249\000\000\000\000\t\021\000\000\t\021\000\000\t\021\000\000\t\021\001\142\029\230\004\249\000\000\000\000\000\000\000\000\001\146\004\249\001\150\000\000\t\021\000\000\001\154\000\000\001\158\001\162\t\021\t\021\000\000\004\249\000\000\000\000\000\000\000\000\004\249\t\021\000\000\000\000\t\021\000\000\000\000\000\000\000\000\t\021\t\021\t\021\000\000\000\000\000\000\000\000\004\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\021\000\000\000\000\000\000\t\021\000\000\004\249\004\249\000\000\000\000\004\249\004\249\000\000\000\000\000\000\t\021\t\021\t\021\r\133\t\021\t\021\000\000\r\133\000\000\000\000\r\133\000\000\000\000\000\000\004\249\000\000\t\021\000\000\000\000\t\021\r\133\000\000\r\133\t\021\r\133\023\218\r\133\000\000\000\000\000\000\000\000\000\000\004\218\000\000\t\021\000\000\000\000\000\000\r\133\000\000\000\000\000\000\000\000\000\000\r\133\r\133\000\000\000\000\000\000\000\000\0042\000\000\000\000\r\133\000\000\000\000\r\133\000\000\000\000\000\000\000\000\r\133\r\133\r\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\186\001\190\000\000\000\000\000\000\000\000\r\133\000\000\000\000\000\000\r\133\r\137\000\000\000\000\000\000\r\137\000\000\000\000\r\137\001\194\001\234\r\133\r\133\r\133\000\000\r\133\r\133\000\000\r\137\000\000\r\137\000\000\r\137\004>\r\137\000\000\000\000\000\000\000\000\000\000\r\133\000\000\001\230\002\154\r\133\000\000\r\137\002\150\000\000\002\162\004\014\004\026\r\137\r\137\000\000\r\133\004&\000\000\0042\000\000\000\000\r\137\000\000\000\000\r\137\000\000\000\000\000\000\000\000\r\137\r\137\r\137\000\000\004*\000\000\000\000\000\000\005}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\137\000\000\002\254\002\174\r\137\000\000\002z\000\000\006\214\000\000\028\194\002\230\000\000\000\000\000\000\r\137\r\137\r\137\000\000\r\137\r\137\001\194\000\000\006\246\000\000\000\000\000\000\004>\003\002\000\000\000\000\b\206\000\000\000\000\r\137\000\000\000\000\000\000\r\137\003\157\000\000\003\014\000\000\000\000\b\250\001\174\000\000\000\000\000\000\r\137\000\000\002\162\000\000\000\000\003\234\000\000\000\000\000\000\003\238\000\000\003\246\000\000\t\n\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\142\001\161\000\000\001\190\001\161\000\000\000\000\000\000\000\000\005\150\005\154\000\000\t}\003\157\001\161\000\000\000\000\000\000\001\161\000\000\001\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\157\000\000\001\161\003\157\000\000\005\158\000\000\000\000\001\161\001\161\000\000\004^\000\000\000\000\000\000\002\146\000\000\001\161\000\000\000\000\001\161\003\225\000\000\001\190\003\225\001\161\001\161\001\161\000\000\000\000\000\000\000\000\ty\000\000\003\225\000\000\000\000\000\000\003\225\000\000\003\225\001\161\001\161\000\000\000\000\004\186\000\000\000\000\000\000\000\000\000\000\000\000\003\225\000\000\000\000\000\000\001\161\001\161\003\225\001\157\001\161\001\161\000\000\000\000\000\000\002\146\000\000\003\225\000\000\000\000\003\225\000\000\001\161\000\000\000\000\003\225\003\225\003\225\000\000\001\161\000\000\000\000\000\000\000\000\001\161\000\000\000\000\000\000\000\000\000\000\001\161\003\225\003\225\000\000\000\000\004\186\000\000\000\000\000\000\000\000\000\000\003\221\000\000\001\190\003\221\000\000\003\225\003\225\000\000\000\000\003\225\003\225\ty\000\000\003\221\000\000\000\000\000\000\003\221\000\000\003\221\000\000\003\225\000\000\000\000\000\000\000\000\000\000\000\000\003\225\000\000\000\000\003\221\000\000\003\225\000\000\000\000\000\000\003\221\001\157\003\225\000\000\000\000\000\000\000\000\002\146\000\000\003\221\000\000\000\000\003\221\000\000\000\000\000\000\000\000\003\221\003\221\003\221\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\221\003\221\000\000\000\000\004\186\000\000\000\000\000\000\005\001\000\000\000\000\005\001\000\000\000\000\000\000\003\221\003\221\000\000\000\000\003\221\003\221\005\001\000\000\000\000\000\000\005\001\000\000\005\001\000\000\000\000\000\000\003\221\000\000\000\246\001\186\001\190\002\n\000\000\003\221\005\001\000\000\000\000\000\000\003\221\000\000\005\001\020\206\000\000\000\000\003\221\005\017\000\000\003b\001\194\001\234\001\214\000\000\005\001\000\000\000\000\000\000\000\000\005\001\001\226\020\210\000\000\000\000\000\000\000\000\000\000\020\250\000\000\000\000\000\000\000\000\000\000\001\230\002\138\005\001\000\000\000\000\002\150\020\030\002\162\004\014\004\026\000\000\0206\000\000\000\153\004&\000\000\000\153\005\001\005\001\000\000\000\000\005\001\005\001\000\000\000\000\000\000\000\153\021\142\000\153\000\000\000\153\004*\000\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\001\000\000\020R\021\162\000\153\000\000\005\017\005\017\000\000\000\000\000\153\024\002\000\000\000\000\000\153\000\000\000\000\000\000\000\000\000\153\000\000\000\000\000\153\000\000\000\000\021\178\000\000\000\153\000\153\000\238\004Z\000\000\004^\000\000\000\000\000\000\000\153\000\153\000\000\000\000\000\000\000\000\000\000\000\153\000\000\000\000\000\000\000\153\000\000\000\000\000\000\000\000\000\221\000\000\000\000\000\221\000\000\000\000\000\153\000\153\000\000\000\000\000\153\000\153\000\000\000\221\000\000\000\221\000\000\000\221\000\000\000\221\000\000\000\000\000\153\000\000\000\000\000\000\000\000\000\000\000\153\000\153\000\000\000\221\000\000\000\000\000\000\000\000\000\000\000\221\000\153\000\000\000\153\000\221\000\000\000\000\000\000\000\000\000\221\000\000\000\000\000\221\000\000\000\000\000\000\000\000\000\221\000\221\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\221\000\221\000\000\000\000\000\000\000\000\000\000\000\221\000\000\000\000\000\000\000\221\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\161\000\000\000\000\000\221\000\221\000\000\000\000\000\221\000\221\000\000\000\161\000\000\000\161\000\000\000\161\000\000\000\161\000\000\000\000\000\221\000\000\000\000\000\000\000\000\000\000\000\221\000\221\000\000\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\221\000\000\000\221\000\161\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\161\000\161\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\161\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\161\000\161\000\000\000\000\000\161\000\161\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\161\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\161\000\000\000\161\000\157\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\001\006\000\000\000\000\000\000\000\157\000\000\000\000\000\000\000\157\000\000\000\000\000\000\000\000\001\n\001\014\001\018\001\022\001\026\001\030\000\157\000\157\000\000\000\000\000\157\000\157\000\000\000\000\000\000\001\"\001&\000\000\000\000\000\000\000\000\001*\000\157\000\000\001.\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\000\000\157\0012\0016\001:\001>\001B\000\000\000\000\000\000\001F\000\000\000\000\001}\000\000\001J\001}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001N\000\000\001}\000\000\001\186\001\190\001}\001R\001}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\142\030\002\001}\001}\000\000\001\194\001\234\001\146\001}\001\150\000\000\000\000\000\000\001\154\005\181\001\158\001\162\001}\000\000\000\000\001}\000\000\000\000\000\000\000\000\001}\001}\001}\001\230\002\146\000\000\000\000\000\000\002\150\000\000\002\162\004\014\004\026\000\000\000\000\000\000\001}\004&\000\000\018\022\001}\r\129\000\000\000\000\000\000\r\129\000\000\000\000\r\129\000\000\000\000\001}\001}\000\000\004*\001}\001}\000\000\r\129\000\000\r\129\000\000\r\129\005\181\r\129\000\000\000\000\001}\000\000\000\000\000\000\000\000\000\000\001}\001}\000\000\r\129\000\000\000\000\001}\000\000\000\000\r\129\r\129\000\000\001}\000\000\000\000\000\000\000\000\000\000\r\129\000\000\000\000\r\129\000\000\000\000\000\000\000\000\r\129\r\129\r\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\129\000\000\000\000\000\000\r\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\129\r\129\r\129\r}\r\129\r\129\000\000\r}\000\000\000\000\r}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\129\r}\000\000\r}\r\129\r}\000\000\r}\000\000\000\000\t\025\000\000\000\000\004\218\t\025\r\129\000\000\t\025\000\000\r}\000\000\000\000\000\000\000\000\000\000\r}\r}\t\025\000\000\t\025\000\000\t\025\000\000\t\025\r}\000\000\000\000\r}\000\000\000\000\000\000\000\000\r}\r}\r}\t\025\000\000\000\000\000\000\000\000\000\000\t\025\t\025\000\000\000\000\000\000\000\000\000\000\r}\000\000\t\025\000\000\r}\t\025\000\000\000\000\000\000\000\000\t\025\t\025\000\238\000\000\000\000\r}\r}\r}\000\000\r}\r}\000\000\000\000\000\000\000\000\000\000\t\025\000\000\000\000\000\000\t\025\007\138\000\000\000\000\r}\000\000\000\000\n\198\r}\000\000\007\169\t\025\t\025\t\025\007\169\t\025\t\025\000\000\000\000\r}\000\000\011.\011v\011\142\011F\011\166\000\000\t\025\000\000\000\000\t\025\000\000\000\000\000\000\t\025\011\190\011\214\000\000\000\000\000\000\001\157\000\000\001\190\001\157\011\238\t\025\000\000\000\000\000\000\000\000\000\000\ty\000\238\001\157\000\000\000\000\000\000\001\157\000\000\001\157\000\000\n\222\011^\012\006\012\030\012N\000\000\000\000\000\000\000\000\000\000\001\157\007\169\000\000\012f\000\000\000\000\001\157\000\000\000\000\000\000\000\000\000\000\012~\002\146\000\000\001\157\000\000\000\000\001\157\000\000\000\000\000\000\000\000\001\157\001\157\001\157\000\000\000\000\012\222\000\000\012\246\0126\000\000\000\000\000\000\000\000\000\000\012\150\000\000\001\157\001\157\000\000\000\000\004\186\000\000\012\174\012\198\n\198\000\000\000\000\000\000\019z\000\000\000\000\001\157\001\157\000\000\000\000\001\157\001\157\000\000\011.\011v\011\142\011F\011\166\000\000\000\000\000\000\000\000\001\157\000\000\000\000\000\000\000\000\011\190\011\214\001\157\000\000\000\000\000\000\000\000\001\157\000\000\011\238\000\000\000\000\000\000\001\157\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\222\011^\012\006\012\030\012N\000\000\000\000\000\000\000\000\000\000\006M\000\000\000\000\012f\006M\000\000\000\000\006M\000\000\000\000\000\000\000\000\012~\000\000\000\000\000\000\000\000\006M\000\000\006M\000\000\006M\000\000\006M\000\000\000\000\000\000\000\000\012\222\019~\012\246\0126\019\138\000\000\000\000\006M\000\000\012\150\000\000\000\000\000\000\006M\006M\000\000\000\000\012\174\012\198\b2\000\000\000\000\006M\000\000\000\000\006M\000\000\000\000\000\000\000\000\006M\006M\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006M\000\000\000\000\000\000\006M\000\000\000\000\000\000\000\000\002\170\002\174\000\000\000\000\002z\000\000\006M\006M\006M\002\230\006M\006M\000\000\000\000\006\249\000\000\000\000\000\000\000\000\001\194\000\000\000\000\000\000\002\234\000\000\006M\000\000\000\000\000\000\006M\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\000\000\000\000\006M\000\000\003\210\001\174\000\000\000\000\007^\000\000\000\000\002\162\006I\000\000\003\218\006I\000\000\000\000\bf\bj\bv\000\000\000\000\005\138\000\000\006I\000\000\006I\000\000\006I\000\000\006I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006I\005\150\005\154\000\000\000\000\000\000\006I\007\218\000\000\000\000\000\000\b~\000\000\b\130\000\000\006I\000\000\000\000\006I\000\000\000\000\000\000\000\000\006I\006I\000\238\000\000\005\158\b\146\000\000\000\000\000\000\tz\004^\000\000\000\000\000\000\000\000\000\000\006I\000\000\000\000\000\000\006I\r\141\000\000\000\000\000\000\r\141\000\000\000\000\r\141\000\000\000\000\006I\006I\006I\000\000\006I\006I\000\000\r\141\000\000\r\141\000\000\r\141\000\000\r\141\000\000\000\000\001\186\001\190\000\000\006I\000\000\000\000\000\000\006I\000\000\r\141\000\000\000\000\000\000\000\000\002\134\r\141\r\141\000\000\006I\001\194\001\234\001\214\000\000\000\000\r\141\000\000\000\000\r\141\000\000\001\226\000\000\000\000\r\141\r\141\000\238\000\000\001\242\000\000\000\000\000\000\000\000\000\000\001\230\002\138\000\000\000\000\000\000\002\150\r\141\002\162\004\014\004\026\r\141\r\145\000\000\000\000\004&\r\145\000\000\000\000\r\145\000\000\000\000\r\141\r\141\r\141\000\000\r\141\r\141\000\000\r\145\000\000\r\145\004*\r\145\000\000\r\145\000\000\000\000\007y\007y\000\000\r\141\000\000\000\000\000\000\r\141\000\000\r\145\000\000\000\000\000\000\000\000\000\000\r\145\007\218\000\000\r\141\007y\007y\007y\000\000\000\000\r\145\000\000\018\002\r\145\000\000\007y\000\000\000\000\r\145\r\145\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007y\007y\000\000\000\000\000\000\007y\r\145\007y\007y\007y\r\145\007^\000\000\000\000\007y\006a\000\000\000\000\006a\000\000\000\000\r\145\r\145\r\145\000\000\r\145\r\145\000\000\006a\000\000\006a\007y\006a\000\000\006a\000\000\000\000\r\149\r\149\000\000\r\145\000\000\000\000\000\000\r\145\000\000\006a\000\000\000\000\000\000\000\000\000\000\006a\007\218\000\000\r\145\r\149\r\149\r\149\007r\000\000\006a\000\000\000\000\006a\000\000\r\149\000\000\000\000\006a\006a\000\238\000\000\000\000\000\000\000\000\000\000\005\018\000\000\r\149\r\149\000\000\000\000\000\000\r\149\006a\r\149\r\149\r\149\006a\006e\000\000\000\000\r\149\006e\000\000\000\000\006e\000\000\000\000\006a\006a\006a\000\000\006a\006a\000\000\006e\000\000\006e\r\149\006e\000\000\006e\000\000\000\000\001\186\001\190\r&\006a\000\000\000\000\000\000\006a\000\000\006e\000\000\000\000\000\000\000\000\000\000\006e\006e\000\000\006a\001\194\001\198\001\214\000\000\000\000\006e\000\000\000\000\006e\000\000\001\226\000\000\000\000\006e\006e\006e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\230\002\138\000\000\000\000\000\000\002\150\006e\002\162\004\014\004\026\006e\006]\000\000\000\000\004&\006]\000\000\000\000\006]\000\000\000\000\006e\006e\006e\000\000\006e\006e\000\000\006]\000\000\006]\004*\006]\000\000\006]\000\000\000\000\000\000\000\000\000\000\006e\000\000\000\000\000\000\006e\000\000\006]\000\000\000\000\000\000\000\000\000\000\006]\007\218\000\000\b\002\000\000\000\000\000\000\000\000\000\000\006]\000\000\000\000\006]\000\000\000\000\000\000\000\000\006]\006]\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006]\000\000\000\000\000\000\006]\000\000\000\000\000\000\003\205\002\170\002\174\003\205\000\000\002z\000\000\006]\006]\006]\002\230\006]\006]\003\205\000\000\007!\000\000\003\205\000\000\003\205\001\194\000\000\000\000\000\000\002\234\000\000\006]\000\000\000\000\000\000\006]\003\205\018\018\002\238\000\000\003\138\000\000\003\205\000\000\000\000\000\000\006]\000\000\003\210\001\174\000\000\003\205\000\000\000\000\003\205\002\162\000\000\000\000\003\218\003\205\003\205\003\205\bf\bj\bv\000\000\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\205\000\000\000\000\000\000\003\205\003\217\000\000\001\190\003\217\000\000\000\000\000\000\000\000\005\150\005\154\003\205\003\205\028F\003\217\003\205\003\205\000\000\003\217\b~\003\217\b\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\217\018r\003\205\005\158\b\146\000\000\003\217\003\205\tz\004^\000\000\000\000\000\000\002\146\000\000\003\217\000\000\000\000\003\217\003\213\000\000\001\190\003\213\003\217\003\217\003\217\000\000\000\000\000\000\000\000\000\000\000\000\003\213\000\000\000\000\000\000\003\213\000\000\003\213\003\217\003\217\000\000\000\000\004\186\000\000\000\000\000\000\000\000\000\246\000\000\003\213\002\178\000\000\000\000\003\217\003\217\003\213\000\000\003\217\003\217\000\000\031\"\000\000\002\146\000\000\003\213\000\000\003b\003\213\000\000\003\217\000\000\000\000\003\213\003\213\003\213\000\000\003\217\000\000\003n\000\000\000\000\003\217\000\000\000\000\019\186\000\000\000\000\003\217\003\213\003\213\000\000\000\000\004\186\027r\000\000\000\000\020\030\001-\000\000\000\000\001-\0206\000\000\003\213\003\213\000\000\000\000\003\213\003\213\000\000\001-\000\000\001-\000\000\001-\000\000\001-\020>\000\000\003\213\000\000\030\210\000\000\000\000\000\000\000\000\003\213\000\000\001-\000\000\000\000\003\213\020R\020\142\001-\000\000\005E\003\213\001-\000\000\000\000\000\000\000\000\001-\000\000\000\000\001-\000\000\000\000\000\000\000\000\001-\001-\000\238\000\000\024\190\000\000\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\001-\000\000\000\000\000\000\000\000\001)\000\000\000\000\001)\000\000\000\000\001-\001-\001-\000\000\001-\001-\000\000\001)\000\000\001)\000\000\001)\000\000\001)\000\000\000\000\001-\000\000\000\000\000\000\000\000\000\000\000\000\001-\000\000\001)\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\001-\001)\000\000\000\000\000\000\000\000\001)\000\000\000\000\001)\000\000\000\000\000\000\000\000\001)\001)\000\238\000\000\000\000\000\000\001Y\000\000\012\233\001Y\001)\000\000\000\000\000\000\000\000\000\000\001)\012\233\000\000\001Y\001)\001Y\000\000\001Y\000\000\001Y\000\000\000\000\000\000\000\000\000\000\001)\001)\001)\000\000\001)\001)\001Y\000\000\000\000\000\000\000\000\000\000\001Y\012\233\000\000\000\000\001)\000\000\000\000\012\233\000\000\000\000\000\000\001)\001Y\000\000\000\000\000\000\000\000\001Y\001Y\001Y\000\000\000\000\001)\001\029\000\000\002\t\001\029\000\000\000\000\000\000\000\000\000\000\000\000\001Y\002\t\000\000\001\029\012\233\001\029\000\000\001\029\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001Y\001Y\001Y\000\000\001Y\001Y\001\029\000\000\000\000\000\000\000\000\000\000\001\029\002\t\000\000\000\000\000\000\000\000\000\000\002\t\000\000\000\000\000\000\001Y\001\029\000\000\000\000\000\000\000\000\001\029\001\029\001\029\000\000\000\000\001Y\001\169\000\000\017\250\001\169\000\000\002z\000\000\000\000\000\000\000\000\001\029\000\000\000\000\001\169\002\t\000\000\000\000\001\169\000\000\001\169\000\000\000\000\000\000\000\000\000\000\001\029\001\029\001\029\000\000\001\029\001\029\001\169\000\000\000\000\000\000\000\000\000\000\001\169\000\000\000\000\000\000\000\000\000\000\017\254\000\000\000\000\001\169\000\000\001\029\001\169\000\000\000\000\000\000\000\000\001\169\001\169\000\000\018\n\000\000\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\169\000\000\000\000\000\000\001\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\154\001\169\001\169\000\000\000\000\001\169\001\169\002\254\002\174\000\000\000\000\002z\000\000\006\214\000\000\000\000\002\230\001\169\000\000\000\000\000\000\005\214\000\000\003\242\001\169\000\000\001\194\000\000\006\246\000\000\000\000\000\000\000\000\003\002\000\000\001\169\b\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\026f\000\000\003\014\000\000\000\000\003\026\001\174\000\000\000\000\000\000\000\000\000\000\002\162\000\000\000\000\003\234\000\000\000\000\000\000\003\238\000\000\003\246\005~\t\n\005\138\000\000\000\000\000\000\000\000\000\000\000\000\002\254\002\174\000\000\000\000\002z\005\142\006\214\000\000\000\000\002\230\000\000\000\000\000\000\000\000\005\150\005\154\000\000\005\218\024\214\001\194\000\000\006\246\000\000\000\000\000\000\000\000\003\002\000\000\000\000\b\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006z\027&\003\014\005\158\000\000\b\250\001\174\b\182\000\000\004^\000\000\000\000\002\162\000\000\000\000\003\234\000\000\000\000\000\000\003\238\000\000\003\246\000\000\t\n\005\138\000\000\000\000\000\000\000\000\000\000\000\000\002\254\002\174\000\000\000\000\002z\005\142\006\214\000\000\000\000\002\230\000\000\000\000\000\000\000\000\005\150\005\154\000\000\000\000\r\026\001\194\000\000\006\246\000\000\000\000\000\000\000\000\003\002\000\000\000\000\b\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\025n\003\014\005\158\000\000\b\250\001\174\000\000\000\000\004^\000\000\000\000\002\162\005\t\000\000\003\234\005\t\000\000\000\000\003\238\000\000\003\246\000\000\t\n\005\138\000\000\005\t\000\000\000\000\000\000\005\t\007^\005\t\000\000\000\000\005\t\005\142\000\000\005\t\000\000\000\000\000\000\000\000\000\000\005\t\005\150\005\154\000\000\005\t\r\026\005\t\000\000\005\t\000\000\005\t\000\000\000\000\000\000\000\000\005\t\000\000\000\000\005\t\005\t\000\000\000\000\005\t\005\t\002\210\025\206\000\000\005\158\005\t\007\218\000\000\000\000\005\t\004^\b2\000\000\005\t\005\t\005\t\005\t\005\t\000\000\000\000\005\t\000\000\005\t\002\210\000\238\000\000\000\000\005\t\000\000\000\000\000\000\005\t\005\t\005\t\000\000\005\t\005\t\000\000\005\t\005\t\000\000\000\000\005\t\b\165\000\000\005\t\b\165\007\138\000\000\000\000\005\t\002\210\000\000\005\t\005\t\000\000\b\165\005\t\005\t\028>\b\165\000\000\b\165\000\000\000\000\005\t\005\t\000\000\000\000\005\t\000\000\000\000\000\000\000\000\b\165\000\000\005\t\000\000\000\000\000\000\b\165\005\t\005\t\000\000\b\165\005\t\005\t\005\t\000\000\b\165\000\000\000\000\b\165\007\238\000\000\000\000\000\000\b\165\b\165\000\238\000\000\000\000\000\000\000\000\005\t\000\000\b\165\b\165\b\161\024>\000\000\b\161\000\000\b\165\000\000\000\000\000\000\b\165\000\000\000\000\000\000\b\161\000\000\000\000\000\000\b\161\000\000\b\161\b\165\b\165\b\165\000\000\b\165\b\165\000\000\000\000\000\000\000\000\000\000\b\161\000\000\000\000\000\000\000\000\b\165\b\161\000\000\000\000\000\000\b\161\000\000\b\165\000\000\000\000\b\161\000\000\000\000\b\161\000\000\000\000\000\000\000\000\b\161\b\161\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\161\b\161\003\205\000\000\000\000\003\205\000\000\b\161\000\000\000\000\000\000\b\161\000\000\000\000\000\000\003\205\000\000\001\186\001\190\003\205\000\000\003\205\b\161\b\161\b\161\000\000\b\161\b\161\000\000\000\000\000\000\000\000\000\000\003\205\018\018\000\000\001\194\001\234\b\161\003\205\000\000\000\000\000\000\000\000\000\000\b\161\000\000\000\000\003\205\000\000\000\000\003\205\000\000\000\000\000\000\000\000\003\205\003\205\003\205\001\230\002\154\000\000\000\000\000\000\002\150\000\000\002\162\004\014\004\026\000\000\000\000\000\000\003\205\004&\004\241\004\241\003\205\000\000\004\241\000\000\000\000\000\000\000\000\004\241\000\000\000\000\000\000\003\205\003\205\004\241\004*\003\205\003\205\004\241\005\129\000\000\000\000\000\000\000\000\000\000\004\241\026\030\000\000\003\205\0266\000\000\000\000\000\000\000\000\018r\003\205\000\000\028\194\004\241\000\000\003\205\004\241\004\241\000\000\000\000\000\000\003\205\000\000\004\241\000\000\000\000\004\241\000\000\000\000\000\238\004\241\000\000\004\241\004\241\000\000\004\241\000\000\000\000\000\000\000\000\000\000\000\000\002\254\002\174\000\000\000\000\002z\004\241\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\004\241\004\241\t\217\000\000\000\000\001\194\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\014\004\241\000\000\003\026\001\174\000\000\000\000\004\241\003\205\000\000\002\162\003\205\000\000\003\234\000\000\000\000\000\000\003\238\000\000\003\246\005~\003\205\005\138\000\000\000\000\003\205\000\000\003\205\000\000\000\000\000\000\000\000\000\000\000\000\005\142\000\000\000\000\000\000\000\000\003\205\018\018\000\000\000\000\005\150\005\154\003\205\005\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\205\012\225\000\000\003\205\012\225\000\000\000\000\000\000\003\205\003\205\003\205\000\000\000\000\000\000\012\225\005\158\000\000\t\217\012\225\000\000\012\225\004^\000\000\000\000\003\205\000\000\005\173\000\000\003\205\000\000\000\000\000\000\012\225\000\000\000\000\000\000\000\000\000\000\012\225\003\205\003\205\028v\000\000\003\205\003\205\000\000\000\000\012\225\000\000\000\000\012\225\000\000\000\000\000\000\000\000\012\225\012\225\000\000\000\000\000\000\000\000\018r\003\205\000\000\000\000\000\000\000\000\003\205\000\000\000\000\000\000\012\225\000\000\002\254\002\174\012\225\000\000\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\012\225\012\225\002r\006\142\012\225\012\225\001\194\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000\000\000\000\012\225\000\000\000\000\000\000\0292\000\000\000\000\012\225\000\000\000\000\003\014\000\000\000\000\003\026\001\174\000\000\000\000\000\000\012\225\000\000\002\162\006\001\000\000\003\234\006\001\000\000\000\000\003\238\000\000\003\246\005~\000\000\005\138\000\000\006\001\000\000\000\000\000\000\006\001\000\000\006\001\000\000\000\000\000\000\005\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\001\005\150\005\154\000\000\005\218\000\000\006\001\000\000\000\000\000\000\000\000\000\000\b2\000\000\000\000\006\001\000\000\000\000\006\001\006\005\000\000\000\000\006\005\006\001\006\001\000\238\000\000\005\158\000\000\006\198\000\000\000\000\006\005\004^\000\000\000\000\006\005\000\000\006\005\006\001\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\000\000\000\000\006\005\000\000\000\000\000\000\006\001\006\001\006\005\000\000\006\001\006\001\000\000\000\000\b2\000\000\000\000\006\005\003\205\000\000\006\005\003\205\000\000\000\000\000\000\006\005\006\005\000\238\000\000\006\001\000\000\003\205\000\000\000\000\000\000\003\205\000\000\003\205\000\000\000\000\006\001\006\005\006\005\000\000\000\000\006\005\000\000\000\000\000\000\003\205\018\018\000\000\000\000\000\000\000\000\003\205\006\005\006\005\000\000\000\000\006\005\006\005\000\000\006\169\003\205\000\000\006\169\003\205\000\000\000\000\000\000\000\000\003\205\003\205\003\205\000\000\006\169\000\000\000\000\006\005\006\169\000\000\006\169\000\000\000\000\000\000\000\000\000\000\003\205\000\000\006\005\000\000\003\205\000\000\006\169\000\000\000\000\000\000\000\000\000\000\006\169\000\000\000\000\003\205\003\205\020\158\000\000\003\205\003\205\006\169\000\000\000\000\006\169\000\000\000\000\000\000\000\000\006\169\006\169\000\238\000\000\000\000\000\000\000\000\000\000\018r\003\205\000\000\000\000\000\000\000\000\000\000\000\000\006\169\000\000\000\000\000\000\006\169\000\000\000\000\000\000\012\161\000\000\002\174\012\161\000\000\030\218\000\000\006\169\006\169\024b\030\222\006\169\006\169\012\161\000\000\000\000\000\000\000\000\000\000\012\161\000\000\000\000\000\000\006\169\000\000\000\000\000\000\000\000\000\000\000\000\006\169\012\161\000\000\000\000\000\000\000\000\000\000\012\161\002\254\002\174\000\000\006\169\002z\001\002\001\174\000\000\012\161\002\230\000\000\012\161\000\000\000\000\006\253\000\000\012\161\000\000\000\000\001\194\000\000\000\000\000\000\000\000\030\226\000\000\003\002\000\000\000\000\000\000\000\000\000\000\012\161\000\000\000\000\000\000\012\161\000\000\000\000\003\014\000\000\000\000\003\026\001\174\000\000\000\000\030\230\012\161\012\161\002\162\000\000\012\161\003\234\000\000\000\000\000\000\003\238\000\000\003\246\005~\000\000\005\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\161\000\000\000\000\005\142\000\000\000\000\b\213\b\213\000\000\000\000\b\213\000\000\005\150\005\154\000\000\b\213\000\000\000\000\000\000\000\000\000\000\018\186\000\000\000\000\000\000\b\213\000\000\000\000\000\000\000\000\000\000\000\000\b\213\007^\000\000\000\000\000\000\007\181\005\158\000\000\007\181\000\000\000\000\000\000\004^\b\213\000\000\000\000\b\213\b\213\007\181\000\000\000\000\000\000\007\181\b\213\007\181\000\000\b\213\000\000\000\000\000\000\b\213\001\173\b\213\b\213\001\173\b\213\007\181\000\000\000\000\000\000\000\000\000\000\007\181\007\218\001\173\000\000\000\000\b\213\001\173\000\000\001\173\007\181\000\000\000\000\007\181\000\000\b\213\b\213\000\000\007\181\007\181\000\238\001\173\000\000\000\000\000\000\000\000\000\000\001\173\000\000\000\000\000\000\000\000\000\000\000\000\007\181\000\000\001\173\000\000\007\181\001\173\000\000\b\213\000\000\000\000\001\173\001\173\000\000\b\213\000\000\007\181\007\181\000\000\000\000\007\181\007\181\000\000\000\000\000\000\000\000\000\000\001\173\000\000\000\000\000\000\001\173\006\173\000\000\000\000\006\173\000\000\000\000\000\000\007\181\000\000\000\000\001\173\001\173\000\000\006\173\001\173\001\173\000\000\006\173\000\000\006\173\000\000\000\000\000\000\000\000\000\000\000\000\001\173\000\000\000\000\000\000\000\000\006\173\000\000\001\173\000\000\000\000\000\000\006\173\024>\000\000\000\000\000\000\000\000\000\000\001\173\000\000\006\173\000\000\000\000\006\173\012\225\000\000\000\000\012\225\006\173\006\173\000\238\000\000\000\000\000\000\001\186\001\190\000\000\012\225\000\000\000\000\000\000\012\225\000\000\012\225\006\173\000\000\000\000\000\000\006\173\005\173\000\000\000\000\000\000\001\194\001\198\012\225\000\000\000\000\000\000\006\173\006\173\012\225\000\000\006\173\006\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\225\000\000\006\173\001\230\002\146\012\225\012\225\000\000\002\150\006\173\002\162\004\014\004\026\000\000\000\000\000\000\000\000\004&\000\000\018\022\006\173\012\225\000\000\000\000\001\186\002v\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\004*\000\000\012\225\012\225\002r\000\000\012\225\012\225\000\000\001\194\001\234\001\214\002~\000\000\000\000\000\000\000\000\000\000\012\225\001\226\000\000\000\000\029j\000\000\000\000\012\225\000\000\000\000\000\000\000\000\000\000\000\000\002\130\002\138\000\000\000\000\012\225\002\150\000\000\002\162\004\014\004\026\000\000\000\000\000\000\000\000\024\022\000\000\024\026\001E\000\000\000\000\001E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001E\004*\001E\000\000\001E\000\000\001E\000\000\000\000\000\000\000\000\005\154\000\000\000\209\000\000\000\000\000\209\000\000\001E\000\000\000\000\000\000\000\000\024&\001E\000\000\000\209\000\000\000\000\000\000\000\209\000\000\000\209\000\000\000\000\000\000\001E\000\000\000\000\000\000\024*\001E\001E\000\238\000\209\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\000\000\000\000\000\001E\000\000\000\209\000\000\000\000\000\209\000\000\000\000\000\000\000\000\000\209\000\209\000\238\000\000\000\000\001E\001E\001E\000\000\001E\001E\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\209\000\213\000\000\000\000\000\213\000\000\000\000\000\000\001E\000\000\000\000\000\209\000\209\000\000\000\213\000\209\000\209\000\000\000\213\001E\000\213\000\000\000\000\001\186\002v\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\213\000\000\000\209\000\000\000\000\000\000\000\213\000\000\000\000\000\000\001\194\001\234\001\214\000\209\000\000\000\213\000\000\000\000\000\213\000\000\001\226\000\000\000\000\000\213\000\213\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\002\138\000\000\000\000\000\000\002\150\000\213\002\162\004\014\004\026\000\213\000\000\000\000\000\000\024\022\000\000\029\022\007\177\000\000\000\000\007\177\000\213\000\213\000\000\000\000\000\213\000\213\000\000\000\000\000\000\007\177\004*\000\000\000\000\007\177\000\000\007\177\000\000\000\000\000\000\000\000\005\154\000\000\000\000\000\213\000\000\000\000\000\000\007\177\000\000\000\000\000\000\000\000\029\"\007\177\000\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\177\006\161\000\000\007\177\006\161\000\000\000\000\024*\007\177\007\177\000\000\020z\000\000\000\000\006\161\000\000\000\000\000\000\006\161\000\000\006\161\000\000\000\000\000\000\007\177\000\000\000\000\000\000\007\177\000\000\000\000\000\000\006\161\000\000\000\000\000\000\000\000\000\000\006\161\007\177\007\177\019\206\007^\007\177\007\177\000\000\006\r\006\161\000\000\006\r\006\161\000\000\000\000\000\000\000\000\006\161\006\161\000\000\000\000\006\r\000\000\000\000\007\177\006\r\000\000\006\r\000\000\000\000\000\000\000\000\000\000\006\161\000\000\000\000\000\000\006\161\000\000\006\r\007}\007}\000\000\000\000\000\000\006\r\007\218\000\000\006\161\006\161\000\000\000\000\006\161\006\161\000\000\012Q\004\030\006\r\012Q\007}\007}\007}\006\r\006\r\000\238\000\000\000\000\000\000\012Q\007}\000\000\006\161\012Q\000\000\012Q\000\000\000\000\000\000\006\r\000\000\000\000\000\000\007}\007}\000\000\000\000\012Q\007}\000\000\007}\007}\007}\012Q\006\r\006\r\000\000\007}\006\r\006\r\000\000\000\000\012Q\004\225\000\000\012Q\004\225\000\000\000\000\000\000\012Q\000\000\000\000\000\000\007}\000\000\004\225\006\r\000\000\000\000\004\225\000\000\004\225\000\000\000\000\000\000\012Q\n\182\000\000\000\000\012Q\000\000\000\000\000\000\004\225\000\000\000\000\000\000\000\000\000\000\004\225\012Q\012Q\000\000\000\000\012Q\012Q\000\000\005\t\004\225\000\000\005\t\004\225\004\018\000\000\007}\000\000\004\225\000\000\000\000\000\000\005\t\000\000\000\000\012Q\005\t\000\000\005\t\000\000\000\000\000\000\000\000\000\000\004\225\000\000\r\014\000\000\004\225\000\000\005\t\000\000\000\000\000\000\000\000\000\000\005\t\000\000\000\000\004\225\004\225\000\000\0042\004\225\004\225\000\000\007\177\000\000\005\t\007\177\000\000\000\000\000\000\005\t\002\210\000\000\000\000\000\000\000\000\007\177\000\000\000\000\004\225\007\177\000\000\007\177\000\000\000\000\000\000\005\t\000\000\000\000\000\000\019\246\000\000\000\000\000\000\007\177\000\000\000\000\000\000\000\000\000\000\007\177\005\t\005\t\000\000\000\000\005\t\005\t\000\000\004\217\000\000\000\000\004\217\007\177\004>\000\000\000\000\000\000\007\177\007\177\000\000\000\000\004\217\000\000\000\000\005\t\004\217\000\000\004\217\000\000\000\000\000\000\000\000\000\000\007\177\000\000\000\000\000\000\000\000\000\000\004\217\000\000\000\000\000\000\000\000\000\000\004\217\000\000\000\000\007\177\007\177\019\206\000\000\007\177\007\177\004\217\000\000\000\000\004\217\000\000\000\000\000\000\000\000\004\217\000\000\004\249\000\000\000\000\004\249\021\014\000\000\000\000\007\177\000\000\000\000\000\000\000\000\000\000\004\249\004\217\000\000\000\000\004\249\004\217\004\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\217\004\217\004\249\000\000\004\217\004\217\000\000\000\000\004\249\000\000\000\000\000\000\000\000\004\201\000\000\000\000\004\201\004\249\000\000\000\000\004\249\000\000\000\000\004\217\000\000\004\249\004\201\000\000\000\000\000\000\004\201\000\000\004\201\000\000\022\246\000\000\000\000\000\000\000\000\000\000\000\000\004\249\000\000\000\000\004\201\004\249\000\000\000\000\000\000\000\000\004\201\000\000\000\000\b=\000\000\000\000\004\249\004\249\000\000\004\201\004\249\004\249\004\201\000\000\000\000\000\000\000\000\004\201\000\000\b=\b=\000\000\b=\b=\000\000\001\186\001\190\000\000\000\000\004\249\000\000\000\000\000\000\004\201\000\000\000\000\000\000\004\201\000\000\000\000\023\218\003\242\000\000\b=\001\194\001\234\001\214\000\000\004\201\004\201\000\000\000\000\004\201\004\201\001\226\000\000\000\000\000\000\000\000\000\000\000\246\b=\000\000\002\178\000\000\000\000\000\000\001\230\002\138\000\000\bI\004\201\002\150\003^\002\162\004\014\004\026\005\029\000\000\003b\000\000\004&\027F\b-\000\000\000\000\bI\bI\000\000\bI\bI\003n\b=\000\000\b=\000\000\000\000\019\186\004*\b-\b-\000\000\b-\b-\000\000\000\000\027r\000\000\005\242\020\030\bI\b=\b=\000\000\0206\bM\b=\000\000\b=\000\000\000\000\000\000\b=\b-\000\000\000\000\000\000\000\000\000\238\000\000\020>\bM\bM\000\000\bM\bM\000\000\004Z\000\000\004^\000\000\b-\000\000\000\000\000\000\020R\020\142\bA\000\000\005\029\005\029\000\000\000\000\000\000\000\000\bM\000\000\000\000\000\000\bI\000\000\bI\000\000\bA\bA\000\000\bA\bA\024\190\000\000\000\000\000\000\b-\000\238\b-\bI\000\000\000\000\005\250\bI\000\000\000\000\000\000\bI\000\000\bI\000\000\bA\b-\bI\000\000\005\250\b-\000\000\000\000\000\000\b-\000\000\b-\000\000\000\000\000\000\b-\000\000\bM\000\238\bM\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bM\000\000\000\000\005\250\bM\001\186\001\190\025r\bM\000\000\bM\000\000\000\000\000\000\bM\000\000\bA\000\000\bA\000\000\000\000\000\000\000\000\000\000\001\194\001\198\001\214\000\000\000\000\000\000\000\000\000\000\006N\000\000\001\226\005\250\bA\000\000\000\000\000\000\bA\000\000\bA\001\186\001\190\025\210\bA\001\230\002\138\000\000\000\000\000\000\002\150\000\000\002\162\004\014\004\026\000\000\000\000\000\000\000\000\004&\001\194\001\198\001\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\226\000\000\000\000\000\000\000\000\000\000\004*\000\000\000\000\000\000\000\000\000\000\000\000\001\230\002\138\000\000\000\000\000\000\002\150\000\000\002\162\004\014\004\026\000\000\000\000\000\000\000\000\004&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004*"))
+ ((16, "o\222w\196r\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\198r\130\000\000\000\000\020\210r\130o\222\003>\004<\000c\170\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Q\006\208\000E\000\000\001\030\005D\000\000\000\170\002<\005z\000\000\004\026\002\158\007@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\162\000\000\000\000\0030\191\172\000\000\000\000\000\000\001\n\000\000\000\000\162p\003\198\004.\000\000\000\000\204\226\001\n\000\000v(\020\210pF\168&\020\210z\148wD\020\210{\\\000\000\000\020\000\000{\\\002\016\000\000\023&\000\000\001h\000\000\000\000\000\028\000\000\001\n\000\000\000\000\000\000\007\026\000\000\023&\000\000\001R\188\208\170H\178\162\000\000\2026\204\226\000\000x\176\129 \000\000\183\"\028\022\191\172r\130o\222\000\000\000\000wD\020\210{\188{\\\007\186\197.\000\000\200\208r\130o\222w\196\020\210\000\003\000\000\016\220w\154\020\192\130\160\164,\000\000\003\028\000\000\000\000\003\226\000\000\000\000s`\0262\024\226\002\240\000\244\000\000\000\000\003>\000\000pF\005l\005\250\020\210\023\184\000\000\020\210o\222o\222\000\000\000\000\000\000r\232r\232\020\210\023\184n*\020\210\127\250\022&\007\216\007\142\000\000\005\154\tV\000\000\000\000\000\000\000\000\000\000\020\210\000\000\000\000\000\000\016\220\000\003w\196\020\210\000\003l\012\182\192y\164\000\252\128\182\164,\195N\195\224\000\000\007\142\000\000\006L\000\000\025\n\169\148z\006\000\000\169\148z\006\000\000\169\148\169\148\003\006\006\212\001R\015~\000\000\007j\000\000\000\000\t\164\000\000\000\000\000\000\169\148\001\n\000\000\000\000\165x\169\148\163H\129 \000\000\007\192\022J\204\226\129 \b\016\169\148\000\000\000\000\000\000\000\000\000\000\000\000\129\162\129 \130\152\003\006\000\000\000\000\000\000\001\"\000\000\000\000\166<\b\174\001\n\000\000\000\000\131\142\000\000\000\000\000\000\002\028\000\000\169\148\000\000\001\004\173$\000\000\169\148\001\004\169\148\027<\000\000\028&\000\000\000 \bh\000\000\b\016\169\148\t\014\000\000\tf\000\000\003\026\000\000\000\003\001\168\000\000\000\000\000\000\030<\004>\164,w\196\020\210\164,\000\000\003\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000z\148\025\140\000\000\000\000\000\000\001\248\026~\191J\000\000w\196\020\210\164,\164,\000\000\b\154\164,\000\000\000\000\000\000\000\000\164,\000\000\182\142\164,\205\240\164,\2064\000\000\164\208s`\t6\016|\000\000\n\020\164,\000\000\026\172\n:\000\000k\250\000\000\164,\206`\169\148\004\194\000\000\164,\206x\000c\000\000\000\000\000\000\000\000\nJ\000\000m\226\000\000\196B\000\000\n^\000\000qv\191J\000\000\000\000o2\005\024\025Z\007p\000\000\000\000\000\000\000\000\t\166\000\000\167\014\b6\nN\004\222\169\148\005:\011H\000\000\000\000\t4\nN\000\012\000\003x\024v\246r\232\020\210\023\184\002\202\005\214\003\240\000\000\n\210pF\1622o&\002\202\005\214\006\172\000\000\011\134pF\000\000\183V\bf{\\\007\142\001\018\207P\000\000\169\148\179\002\169\148\170\198\179\196\169\148\004\216\169\148\180H\000\000\n\138\n\162\007\006pF\183\216\000\000\007\210\b\140\168(\000\000\000\000\000\000\011\152pF\184ZpF\184\220\000\000\000\000pF\185^\019\198\001R\171\136\tV\001R\172\n\000\000\185\224\bf\000\000\027\166\000\000\029^\000\000\011\186\023\184\000\000\168\170n*\000\000\000D\000\000pF\030\\\000\000\000\000\000\000\167\164\000\000\bF\000\003y\164\000\140\021F\132b\022\186y$w\196\020\210p\208w\196\020\210\016\220\016\220\000\000\000\000\000\000\000\000\001\250\024\130m\002\000\000{\128|<r\232\020\210\023\184\004\194pF\030v\000\000|\248}\180\195N\025H\169\148\b\208\000\003w\196\020\210\000\003\186d\020\210\191J\164,\023\234\000\003x\024\020\210uJ\002@\000\000\164,n\212\169\148\005\220\000\012\012^\000\000\000\000\000\000tT\t6\012|\000\000\164,\000\000\000\000\172\194\000\000\000\000\002J\129 \003\006\012\\\133\030\186d\020\210\191J\026\178\133\218\186d\020\210\191J\027\176\164,\000\000\000\000w\196\020\210\164,\029@\000\003w\196\020\210\016\220\022\186\016\220\002\248\017\194v:\186d\020\210\191J\024@v:\134\150\186d\020\210\191J\000\000\016\220\nx\012r\003\236\169\148%\130\169\148\022\022\169\148&\128\r\006\000\000\000\000\012\244\000\000\016\220\003\246\r\004\000\000\023\160\000\003\rz\000\000\028\174\135R\186d\020\210\191J\029\172\017\218\023\184\000\000\000\000\000\000\000\000\000\133\000\003\000\000\000\000\030\170\136\014\186d\020\210\191J\031\168 \166\136\202\186d\020\210\191J!\164\"\162\000\000\018\216\024\182\137\134\186d\020\210\191J\000\000\000\000\000\003r\130\000\003\000\000\000\000\138B\186d\020\210\191J#\160$\158\138\254\186d\020\210\191J%\156&\154\139\186\186d\020\210\191J'\152(\150\140v\186d\020\210\191J)\148*\146\1412\186d\020\210\191J+\144,\142\141\238\186d\020\210\191J-\140.\138\142\170\186d\020\210\191J/\1360\134\143f\186d\020\210\191J1\1322\130\144\"\186d\020\210\191J3\1284~\144\222\186d\020\210\191J5|6z\145\154\186d\020\210\191J7x8v\146V\186d\020\210\191J9t:r\147\018\186d\020\210\191J;p<n\147\206\186d\020\210\191J=l>j\148\138\186d\020\210\191J?h@f\149F\186d\020\210\191JAdBb\150\002\186d\020\210\191JC`D^\150\190\186d\020\210\191JE\\FZ\151z\186d\020\210\191JGXHV\1526\186d\020\210\191JITJR\020\210\164,uJ\000\003\000\000\191\172\t6\012\226\169\148\nz\000\003\000\000\n\236\001\n\000\000\169\148\n\204\000\003\000\000\r\028\000\003\000\000\000\000\003\236\000\000\r.\133\030\000\000\000\000\000\000\026F\169\148\n\210\000\003\000\000\030>\000\003\000\000\164,\031<\164, :\164,!8\000c\000\000\000\000\000\000\"6\164,#4\000\000\192\178\192\178\000\000\000\000\000\000KP\000\003\r\200\000\000\000\003\r\214\000\000\tT\018\192v:\r\228\000\000\169Tw\b\000\000v:\014\000\000\000v:\014\002\000\000\000\000\016\220\004\244\019\190v:\014$\005\242\152\242\186d\020\210\191JLNMLv:\014.\006\240\153\174\186d\020\210\191JNJOHv:\014<\007\238\154j\186d\020\210\191JPFQD\025\152\000\003\014Z\b\236\155&\186d\020\210\191JRBS@\000\003\014\\\t\234\155\226\186d\020\210\191JT>U<\000\003\014b\n\232\156\158\186d\020\210\191JV:W8\n\202\022\030v:\014j\011\230\157Z\186d\020\210\191JX6Y4v:\014h\012\228\158\022\186d\020\210\191JZ2[0v:\014r\r\226\158\210\186d\020\210\191J\\.],\014\224\159\142\186d\020\210\191J^*_(\015\222\019\214\000\000\000\000\000\000\000\000\014\128\000\000v:\014\130\000\000v:\014\134\000\000\011$\000\000\000\000\000\003\r\230\000\003\014\006\000\000`&\000\000\014\130\000\003\000\000\000\003\000\000\000\000\000\000a$\014\202\160J\186d\020\210\191Jb\"\161\006\186d\020\210\191Jc d\030e\028\161\194\186d\020\210\191Jf\026g\024\000\000$2\000\003\000\000\nf\000\003\000\000\164,\000\000\000\000\187\b\014\190\000\000~p\000\000\r\254\000\000\127>\000\000\014\198\000\000\000\140\014T\000\000\022\186\021\188\007\142\000\000\023\242\021F\007\234\007\142\000\000\000\000\014\212\000\000\001d\024\154|\024\000\000\025\180\000\000\014H\000\000\014\230\000\000\186d\020\210\191J\027\016\180\156\t\016\004\182\000\000\000\000\014p\000\000\014\254\000\000\000\000\020\210\023\184\tD\000\003\000\000\024\226\002\240\000\244\005\214\023\184\197\\pF\006h\023\184\197\254\014\144\000\003\000\000\005\214\000\000\025\172\020\142\028\000\000\000\n\128\015\n\000\000\015\024\003\024\171\154\005\194\000\000\014\226\014t\191\172\011b\169\148\028\186\020\180\b\232\020\180\000\000\028\206\015*\000\000\005\238\000\000\000\000\015H\129 \173b\000\000\181>\187\166\011f\171\154\015*\129 \187\148\174\028\0150\129 \187\244\174\214\003\224\014\238\000\003\000\000\000\000\020\210\199p\000\000\164,\192\178\000\000\000\000\015f\000\000\000\000\000\000\186d\020\210\191Jh\022i\020\000\000\014\166\000\000\000\000r\232\020\210\023\184\003\196\000\000pF\031Z\000\000\006x\000\000\015j\000\000\015\156\191Jj\018\015J\000\000\000\000\186d\020\210\191J&\194\000\000pF\031t\000\000pF\023\174\000\000pF X\000\000\181\170\000\000pF r\000\000pF\029\162\000\000pF!V\000\000\192\178\000\000\020\210\023\184\192\178\000\000\025\172\022&\007\216\001\n\202\176pF\199\254\192\178\000\000\002\240\000\244\000\244\005\214\192\178\174\160\002\240\000\244\005\214\192\178\174\160\000\000\000\000\005\214\192\178\000\000r\130o\222\164,\026\228\000\003\000\000r\130o\222r\232\020\210\023\184\192\178\000\000\003>\004<\000c\014\208\191\172\011\196\169\148\193J\014\252\015\182\203&\000\000\192\178\000\000\193\198\025\172\020\142\028\000\198, \158\011\n\001\242\012\134\014\246\020\210\192\178\000\000\020\210\192\178\000\000\175\166\207h\023\176\004\234\001\"\001R\175x\000\000\001\"\001R\175x\000\000\026\154\022&\007\216\001\n\202\176pF\192\178\000\000\002\240\001\158\026\196\001R\175x\000\000\000\244\015\000pF\192\178\205 \002\240\000\244\015\004pF\192\178\205 \000\000\000\000\0068\000\003\192\178\000\000pF\2036\175x\000\000\0068\000\000v(\020\210pF\192\178\000\000\025\172\020\142\028\000\194Bn\194\028 \020 \004\148\000\000\b\188\023&\t\232\000\000\015\136\015>rp\020\192n\188\169\148\007\216\000\000}@\020\148\007\234\011\182\000\000\0120\000\000\015\152\015&\169\148|\248\000\000\000<\b\184\011v\000\000\012V\000\000\015\170\0154\191\172|\248\000\000\020\210rp\015\224\019\252\001\"\000\003\011|rp\169\148\n\230\003\006\000\000\169\148\007\138\b\136\000\000\000\000\188z\000\000\000\003\011\190rp\188\254|\248\000\000\020\210\169\148\012,\169\148m\002|\248\000\000\015j\000\000|\248\000\000\000\000}@\000\000\192\178\203\226\020 \004\148\b\188\015\200\015\134rp\192\178\203\226\000\000\000\000\020 \004\148\b\188\015\224\015r\164Vx\186\129 \016\000\164V\169\148\022V\016\016\164V\129 \016(\164V\189\184\190:\000\000\201F\000\000\000\000\192\178\2050\020 \004\148\b\188\016\028\015\168\164V\192\178\2050\000\000\000\000\000\000\207h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175x\000\000\203\240\020\192pB\016$\197.\000\000\200\208\203\240\000\000\000\000\205\138\020\192pB\016&\015\178\170H\169\148\005\194\016n\000\000\000\000\190\154\194B\020\210\000\000\200,\028\000\000\000\000\000\200\208\205\138\000\000\000\000\000\000\198\150t\188t\\\005\194\016|\000\000\000\000\000\000\194B\020\210\000\000\005\194\016\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\180n\194\020 \004\148\b\188\016N\191Jp\250\020\192\130\160|\132\021\014\005\166\005\194\016j\004\234\000\003\000\000\016$\000\003\000\000|\248\000\000\t\230\012\152\000\000\012\142\000\000\016z\016\012\169\148u\\\016\144\005\232\000\003\000\000\016B\000\003\000\000\021\168\000<\012\206\000\000\016\158\191\216\207\152\t6\016B\169\148\012\\\000\003\000\000\016X\000\003\000\000\000\000|\248\000\000\n\180\r\"\000\000\r*\000\000\016\190\016H\191\172\000\000\016\198\192f\207\224\t6\016r\169\148\012\200\000\003\000\000\016\138\000\003\000\000\000\000\020\210\000\003|\248\000\000\021,\020\210p\250p\250\194\198r\130\020\210\199p\164,\002\164\000\000\021\026\001\"\000\003\r\012p\250\169\148\012B\007\142\000\000\020\210\191J\191Jp\250\011\bp\250\000\000m\248n\234\000\000\176\028\000\000\000\000\176J\000\000\000\000\177\014\000\003\r\024p\250\177<\199p\164,\002\164\000\000\006\190\000\000\164V\017*\000\000l\012\016\236\000\000|\248\000\000p\250l\012|\248\000\000\020\210\169\148|\248\000\000\016\162\000\000|\248\000\000\000\000|\132\000\000\201t\164V\016\192p\250\202\012\191J\000\000\192\178\204B\020 \004\148\b\188\017\026\191J\192\178\204B\000\000\000\000\000\000\173\230x\024\000\000\000\000\000\000\000\000\000\000\000\000\129\144\192\178\000\000\203\240\000\000\000\000\000\000\000\000\175x\173\230\000\000\000\000\000\000\129\144\017\\\000\000\017^\000\000\175x\173\230\000\000\000\000\016\202\000\000\182F!p\000\000l\240\000\000\169\148\rh\000\000|\132\016\204\000\000\017\152\191Jk\016\017v\000\000\000\000\017lkL\029\164\028\000\194B \158\020\210\000\000\192\178\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\142 \158\020\210\000\000\r\174\197.\000\000\200\208\000\000\017rkL\029\164\192\178\000\000\017\136\000\000\006\230\rp\020\210\2082\000\000\000\000'>\208j\000\000\000\000\017&\000\000\017|\169\148\000\000\rl\t\248\003\006\000\000\000\000\169\148\023\196\0268\169\148\0276\005\194\017\176\000\000\000\000\200\162\000\000\000\000\170H\000\000\200\208\000\000\017\164kL\030\162\175x\000\000\000\000\000\000\000\000\r\240\197.\170H\000\000\200\208\000\000\017\166kL\030\162\175x\000\000\017*\000\000!\218\000\000\192\178\000\000\017\202\000\000\000\003\017(\000\003\0174\000\000\017N\000\000\000\000~p\017R\000\000\000\000\031\160\170\b\017\252\000\000\000\000\000\000\011\234\b\140\177\234\018\004\000\000\000\000\000\000\000\000\000\000\000\000\017~\000\000 \158\000\000\017\144\000\000\169\148\000\000\012\142\000\000\000\003\017\146\000\000\000\000\001R\000\000\003\244\000\000\000\003\000\000\005\226\000\000\023\184\000\000\005:\000\000pF\000\000\006h\000\000\n\162\000\000\017\162\000\000\164,\023\234\000\000\000\000\t\138\017\186\000\000\000\000\017\178\n\136p\208\001\n\199\026\000\000\000\000\000\000\000\000\000\000\205\220\000\000\000\000\018b\000\000s\156\000\000\014\016\018d\000\000\018f\000\000q\194q\194\208\020\208\020\000\000\000\000\192\178\208\020\000\000\000\000\000\000\192\178\208\020\017\204\000\000\017\216\000\000"), (16, "\003\165\000\006\001\002\001\174\003\165\002\170\002\174\003\165\002\218\002z\003\165\001V\003\165\n\202\002\230\003\165\r\t\003\165\003\165\003\165\002F\003\165\003\165\003\165\001\194\001n\007\193\001~\002\234\003\165\003f\003j\0112\003\165\004\241\003\165\r\t\002\238\t\177\003\138\002J\003\165\003\165\003\190\003\194\003\165\003\198\003\202\003\165\003\206\003\218\003\230\003\238\007\030\bZ\003\165\003\165\002\162\004\241\r\"\003\226\003\165\003\165\003\165\b\130\b\134\b\146\b\166\001^\005\146\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\t\022\000\238\003\165\004\241\003\165\003\165\bN\t\"\t:\t\222\005\158\005\162\003\165\003\165\003\165\000\238\003\165\003\165\003\165\000\238\003\165\007\026\t\177\016F\003\165\001Z\003\165\003\165\004\t\003\165\003\165\003\165\003\165\003\165\003\165\005\166\b\154\003\165\003\165\003\165\b\178\004f\t\242\b\138\003\165\003\165\003\165\003\165\r9\003.\0032\002\030\r9\r9\r9\r9\t\177\r9\r9\r9\r9\001\202\r9\r9\019\230\r9\r9\r9\b^\r9\r9\r9\r9\004\241\r9\017z\r9\r9\r9\r9\r9\r9\r9\r9\001f\r9\004\214\r9\005\022\r9\r9\r9\r9\r9\r9\r9\r9\001\190\r9\r9\001\137\r9\003\234\r9\r9\r9\001\206\r\017\r9\r9\r9\r9\r9\r9\r9\000\238\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r\017\r9\r9\000\238\r9\r9\002:\003.\021\"\004\241\r9\r9\r9\r9\r9\002n\r9\r9\r9\002>\r9\r9\0212\r9\r9\007\130\r9\r9\005n\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\r9\007\138\004\241\r9\r9\r9\r9\001\137\001\137\005&\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\r\r\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\0176\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\r\r\001\137\005\006\001\137\tJ\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001v\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\004f\001\137\001\137\007\149\001\137\001\137\tN\tj\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\020\170\001\137\001\137\005\214\b\202\001\137\001\134\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\001\137\n\237\004\241\004\241\002*\n\237\n\237\n\237\n\237\005\n\n\237\n\237\n\237\n\237\001\190\n\237\n\237\004\241\n\237\n\237\n\237\002\210\n\237\n\237\n\237\n\237\t\158\n\237\004\241\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\005\t\n\237\005b\n\237\000\238\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\007\153\n\237\n\237\018\006\n\237\003:\n\237\n\237\n\237\002\146\000\238\n\237\n\237\n\237\n\237\n\237\n\237\n\237\000\n\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\003\205\n\237\n\237\005\t\n\237\n\237\001\241\001\241\003\006\004\194\n\237\n\237\n\237\n\237\n\237\003\205\n\237\n\237\n\237\001\241\n\237\n\n\005f\n\134\n\237\001\170\n\237\n\237\003\n\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\n\237\019\006\n\237\n\237\n\237\n\237\n\237\004Q\018f\003.\0032\004Q\004Q\004Q\004Q\005\n\004Q\004Q\004Q\004Q\001\182\004Q\004Q\007>\004Q\004Q\004Q\003>\004Q\004Q\004Q\004Q\bN\004Q\001\218\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\001Z\004Q\000\238\004Q\004\t\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004:\004Q\004Q\000\238\004Q\007\185\004Q\004Q\004Q\007\185\003\018\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004\241\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\003\022\n\002\n~\021\194\004Q\004Q\004\241\004\241\019\n\007\201\004Q\004Q\004Q\004Q\004Q\030c\004Q\004Q\004Q\000\238\004Q\n\n\004F\n\134\004Q\nJ\004Q\004Q\nR\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\004Q\006r\004Q\004Q\004Q\004Q\004Q\004A\001\241\005\130\r]\004A\004A\004A\004A\0041\004A\004A\004A\004A\001\222\004A\004A\r]\004A\004A\004A\b\138\004A\004A\004A\004A\bN\004A\000\n\004A\004A\004A\004A\004A\004A\004A\004A\006\202\004A\000\238\004A\005Y\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\t\209\004A\0045\004A\004A\004A\001\241\007\005\004A\004A\004A\004A\004A\004A\004A\003F\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\007\166\n\002\n~\0041\004A\004A\bN\007\r\b\238\024\250\004A\004A\004A\004A\004A\001j\004A\004A\004A\000\238\004A\n\n\006\250\n\134\004A\nJ\004A\004A\nR\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\004A\001z\004A\004A\004A\004A\004A\n\133\0045\004\241\030\131\n\133\n\133\n\133\n\133\004\173\n\133\n\133\n\133\n\133\004\241\n\133\n\133\018\014\n\133\n\133\n\133\004)\n\133\n\133\n\133\n\133\000\238\n\133\006y\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\007:\n\133\018\014\n\133\003J\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\006y\n\133\n\133\000\238\n\133\014v\n\133\n\133\n\133\003\158\007r\n\133\n\133\n\133\n\133\n\133\n\133\n\133\004\n\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\017\182\n\133\n\133\004\173\n\133\n\133\007:\019\026\030s\025B\n\133\n\133\n\133\n\133\n\133\b\018\n\133\n\133\n\133\017\190\n\133\n\133\007\238\n\133\n\133\nJ\n\133\n\133\nR\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\n\133\026\194\000\238\n\133\n\133\n\133\n\133\n\149\021j\001Z\004\t\n\149\n\149\n\149\n\149\003\201\n\149\n\149\n\149\n\149\004\241\n\149\n\149\007:\n\149\n\149\n\149\021v\n\149\n\149\n\149\n\149\017\198\n\149\030\147\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\004:\n\149\000\238\n\149\002^\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\nJ\n\149\n\149\nR\n\149\014\154\n\149\n\149\n\149\000\238\007\021\n\149\n\149\n\149\n\149\n\149\n\149\n\149\004J\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\004\241\n\149\n\149\006\210\n\149\n\149\002\174\007\133\026\198\004R\n\149\n\149\n\149\n\149\n\149\001\138\n\149\n\149\n\149\tq\n\149\n\149\t\233\n\149\n\149\007\190\n\149\n\149\001\190\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\n\149\007\254\004\241\n\149\n\149\n\149\n\149\n\141\022\002\002b\003\150\n\141\n\141\n\141\n\141\021\242\n\141\n\141\n\141\n\141\000\238\n\141\n\141\017\030\n\141\n\141\n\141\t\229\n\141\n\141\n\141\n\141\002\198\n\141\004:\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\004:\n\141\022\n\n\141\004\241\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\006\129\n\141\n\141\000\238\n\141\014\190\n\141\n\141\n\141\tq\004\154\n\141\n\141\n\141\n\141\n\141\n\141\n\141\007v\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\004\138\n\141\n\141\005B\n\141\n\141\007\210\006\242\007\n\007\206\n\141\n\141\n\141\n\141\n\141\bN\n\141\n\141\n\141\tm\n\141\n\141\007\178\n\141\n\141\022.\n\141\n\141\000\238\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\n\141\004\230\b~\n\141\n\141\n\141\n\141\ny\0226\029\254\001\206\ny\ny\ny\ny\005J\ny\ny\ny\ny\000\238\ny\ny\0182\ny\ny\ny\004\029\ny\ny\ny\ny\b\197\ny\002\017\ny\ny\ny\ny\ny\ny\ny\ny\017r\ny\005R\ny\021\202\ny\ny\ny\ny\ny\ny\ny\ny\000\238\ny\ny\t\173\ny\014\230\ny\ny\ny\tm\003\162\ny\ny\ny\ny\ny\ny\ny\005\250\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\t\018\ny\ny\005Z\ny\ny\002\174\007\018\018\202\006:\ny\ny\ny\ny\ny\bN\ny\ny\ny\004J\ny\ny\t\205\ny\ny\003\166\ny\ny\000\238\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\b\153\017\158\ny\ny\ny\ny\n\129\025\026\001\002\001\174\n\129\n\129\n\129\n\129\005\n\n\129\n\129\n\129\n\129\001\190\n\129\n\129\004V\n\129\n\129\n\129\021\210\n\129\n\129\n\129\n\129\014&\n\129\003\158\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\000\238\n\129\025\"\n\129\006F\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\006y\n\129\n\129\005\n\n\129\015\n\n\129\n\129\n\129\002\146\006V\n\129\n\129\n\129\n\129\n\129\n\129\n\129\006\150\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\006\174\n\129\n\129\006\230\n\129\n\129\003\162\002\174\007\182\028\246\n\129\n\129\n\129\n\129\n\129\002\134\n\129\n\129\n\129\001\254\n\129\n\129\006\246\n\129\n\129\025\166\n\129\n\129\002b\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\n\129\nB\nj\n\129\n\129\n\129\n\129\n}\025\174\001\002\001\174\n}\n}\n}\n}\000\238\n}\n}\n}\n}\016\182\n}\n}\001\206\n}\n}\n}\022z\n}\n}\n}\n}\b\189\n}\rV\n}\n}\n}\n}\n}\n}\n}\n}\002\134\n}\rJ\n}\016\018\n}\n}\n}\n}\n}\n}\n}\n}\000\238\n}\n}\000\238\n}\015.\n}\n}\n}\016\190\017\246\n}\n}\n}\n}\n}\n}\n}\007\006\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\rf\n}\n}\r\166\n}\n}\015J\rV\003\158\rV\n}\n}\n}\n}\n}\026n\n}\n}\n}\0222\n}\n}\007F\n}\n}\r^\n}\n}\022\130\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\007f\b\205\n}\n}\n}\n}\n\137\006R\016\022\007\230\n\137\n\137\n\137\n\137\rV\n\137\n\137\n\137\n\137\r\"\n\137\n\137\022\006\n\137\n\137\n\137\bB\n\137\n\137\n\137\n\137\022n\n\137\006\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\018\"\n\137\018n\n\137\022\014\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\b\018\n\137\n\137\004:\n\137\015Z\n\137\n\137\n\137\022\166\022:\n\137\n\137\n\137\n\137\n\137\n\137\n\137\026R\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\tf\n\137\n\137\b\018\n\137\n\137\020j\003\162\025&\006\133\n\137\n\137\n\137\n\137\n\137\t~\n\137\n\137\n\137\000\238\n\137\n\137\t\170\n\137\n\137\029\250\n\137\n\137\b\201\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\n\137\nF\000\238\n\137\n\137\n\137\n\137\n\153\022\194\025\030\020\174\n\153\n\153\n\153\n\153\006}\n\153\n\153\n\153\n\153\re\n\153\n\153\025b\n\153\n\153\n\153\000\238\n\153\n\153\n\153\n\153\025\130\n\153\022\130\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\nf\n\153\025\178\n\153\b\189\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\000\238\n\153\n\153\030C\n\153\015~\n\153\n\153\n\153\025\170\nr\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\130\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\025\226\n\153\n\153\rq\n\153\n\153\028\n\b\193\028\242\028\186\n\153\n\153\n\153\n\153\n\153\n\146\n\153\n\153\n\153\026F\n\153\n\153\rB\n\153\n\153\026\166\n\153\n\153\001\190\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\n\153\rr\b\018\n\153\n\153\n\153\n\153\n\145\b\018\000\238\r\138\n\145\n\145\n\145\n\145\014\018\n\145\n\145\n\145\n\145\001\190\n\145\n\145\014\030\n\145\n\145\n\145\0142\n\145\n\145\n\145\n\145\028\134\n\145\005\133\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\014J\n\145\014V\n\145\005\t\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\029\002\n\145\n\145\014r\n\145\015\162\n\145\n\145\n\145\029f\014\150\n\145\n\145\n\145\n\145\n\145\n\145\n\145\014\186\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\014\226\n\145\n\145\015\006\n\145\n\145\002\210\015*\015V\015z\n\145\n\145\n\145\n\145\n\145\015\158\n\145\n\145\n\145\015\242\n\145\n\145\015\254\n\145\n\145\016\n\n\145\n\145\016\"\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\016*\016:\n\145\n\145\n\145\n\145\n\221\016Z\016\210\016\226\n\221\n\221\n\221\n\221\016\242\n\221\n\221\n\221\n\221\016\254\n\221\n\221\017.\n\221\n\221\n\221\017N\n\221\n\221\n\221\n\221\017V\n\221\017\130\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\017\138\n\221\017\210\n\221\017\250\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\003\250\n\221\n\221\018\022\n\221\015\190\n\221\n\221\n\221\018\026\018B\n\221\n\221\n\221\n\221\n\221\n\221\n\221\018V\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\018v\n\221\n\221\018\134\n\221\n\221\018\154\018\198\018\238\019\"\n\221\n\221\n\221\n\221\n\221\019*\n\221\n\221\n\221\004B\n\221\n\221\0196\n\221\n\221\020b\n\221\n\221\020v\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\n\221\020z\006\146\n\221\n\221\n\221\n\221\004=\021:\004:\021R\004=\004=\004=\004=\021\218\004=\004=\004=\004=\021\222\004=\004=\022\022\004=\004=\004=\022\026\004=\004=\004=\004=\022B\004=\022F\004=\004=\004=\004=\004=\004=\004=\004=\022^\004=\022\214\004=\023\006\004=\004=\004=\004=\004=\004=\004=\004=\023\n\004=\004=\023.\004=\004F\004=\004=\004=\0232\023B\004=\004=\004=\004=\004=\004=\004=\023R\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\023^\n\002\n~\023\146\004=\004=\023\150\023\230\024\014\024\018\004=\004=\004=\004=\004=\024\"\004=\004=\004=\006\153\004=\n\n\024r\n\134\004=\024\146\004=\004=\024\210\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\004=\024\246\004=\004=\004=\004=\004=\002!\025\006\025.\006:\002!\002\170\002\174\002!\0252\002z\002!\n>\002!\025>\002\230\002!\025N\002!\002!\002!\025j\002!\002!\002!\001\194\025z\nn\025\142\002\234\002!\002!\002!\002!\002!\nv\002!\025\186\002\238\025\190\003\138\025\202\002!\002!\002!\002!\002!\003\198\003\202\002!\025\218\003\218\001\174\025\238\002!\006\153\002!\002!\002\162\026\206\026\218\003\226\002!\002!\002!\b\130\b\134\b\146\027\n\014^\005\146\002!\002!\002!\002!\002!\002!\002!\002!\002!\027.\n\002\n~\027V\002!\002!\027\202\027\210\027\234\028\022\005\158\005\162\002!\002!\002!\028\030\002!\002!\002!\028*\002!\014f\0286\014\214\002!\028\154\002!\002!\028\174\002!\002!\002!\002!\002!\002!\005\166\b\154\002!\002!\002!\b\178\004f\028\222\028\230\002!\002!\002!\002!\n\201\029\030\029F\029~\n\201\002\170\002\174\n\201\029\146\002z\n\201\n\201\n\201\029\170\002\230\n\201\029\182\n\201\n\201\n\201\029\190\n\201\n\201\n\201\001\194\029\199\n\201\029\215\002\234\n\201\n\201\n\201\n\201\n\201\n\201\n\201\029\234\002\238\n\014\003\138\030\006\n\201\n\201\n\201\n\201\n\201\003\198\003\202\n\201\030#\003\218\001\174\015\246\n\201\016\002\n\201\n\201\002\162\0303\030O\003\226\n\201\n\201\n\201\b\130\b\134\b\146\030\163\n\201\005\146\n\201\n\201\n\201\n\201\n\201\n\201\n\201\n\201\n\201\030\191\n\201\n\201\030\202\n\201\n\201\030\255\031\019\031\027\031W\005\158\005\162\n\201\n\201\n\201\031_\n\201\n\201\n\201\000\000\n\201\n\201\000\000\n\201\n\201\000\000\n\201\n\201\000\000\n\201\n\201\n\201\n\201\n\201\n\201\005\166\b\154\n\201\n\201\n\201\b\178\004f\000\000\000\000\n\201\n\201\n\201\n\201\n\197\000\000\000\000\000\000\n\197\002\170\002\174\n\197\000\000\002z\n\197\n\197\n\197\000\000\002\230\n\197\000\000\n\197\n\197\n\197\000\000\n\197\n\197\n\197\001\194\000\000\n\197\000\000\002\234\n\197\n\197\n\197\n\197\n\197\n\197\n\197\000\000\002\238\014*\003\138\000\000\n\197\n\197\n\197\n\197\n\197\003\198\003\202\n\197\000\000\003\218\001\174\014B\n\197\014N\n\197\n\197\002\162\000\000\000\000\003\226\n\197\n\197\n\197\b\130\b\134\b\146\000\000\n\197\005\146\n\197\n\197\n\197\n\197\n\197\n\197\n\197\n\197\n\197\000\000\n\197\n\197\000\000\n\197\n\197\000\000\000\000\000\000\000\000\005\158\005\162\n\197\n\197\n\197\000\000\n\197\n\197\n\197\000\000\n\197\n\197\000\000\n\197\n\197\000\000\n\197\n\197\000\000\n\197\n\197\n\197\n\197\n\197\n\197\005\166\b\154\n\197\n\197\n\197\b\178\004f\000\000\000\000\n\197\n\197\n\197\n\197\002i\000\000\000\000\000\000\002i\002\170\002\174\002i\000\000\002z\002i\n>\002i\000\000\002\230\002i\000\000\002i\002i\002i\000\000\002i\002i\002i\001\194\004\241\nn\000\000\002\234\002i\002i\002i\002i\002i\nv\002i\000\000\002\238\014j\003\138\004\241\002i\002i\002i\002i\002i\003\198\003\202\002i\000\000\003\218\001\174\014\142\002i\014\178\002i\002i\002\162\000\000\000\000\003\226\002i\002i\002i\b\130\b\134\b\146\000\000\014^\005\146\002i\002i\002i\002i\002i\002i\002i\002i\002i\000\000\000\000\002i\000\238\002i\002i\b\n\000\000\000\000\004\241\005\158\005\162\002i\002i\002i\b\018\002i\002i\002i\004\241\002i\000\238\004\241\b\022\002i\000\000\002i\002i\000\000\002i\002i\002i\002i\002i\002i\005\166\b\154\002i\002i\002i\b\178\004f\004\241\004\241\002i\002i\002i\002i\004\241\000\000\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\000\004\241\022b\004\241\004\241\000\000\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\238\004\241\004\241\000\238\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\238\004\241\004\241\004\241\004\241\004\241\000\238\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\238\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\000\000\000\004\241\000\000\007\165\004\241\004\241\004\241\007\165\004\241\004\241\000\000\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\004\241\000\238\000\000\004\241\004\241\004\241\004\241\000\238\000\000\004\241\004\241\000\000\000\000\000\000\004\241\000\000\000\238\004\241\004\241\000\000\000\000\004\241\004\241\004\241\000\000\017\n\004\241\004\241\004\241\004\241\000\000\000\129\004\241\000\129\000\129\000\129\000\129\000\129\000\129\000\129\004\241\000\129\004\241\000\129\000\129\000\000\000\129\000\129\000\000\007\165\000\129\000\129\000\000\000\129\000\129\000\129\000\129\024\234\000\129\b\142\000\129\000\129\000\000\026:\000\129\000\129\004\241\000\129\000\129\000\129\000\000\000\129\026\014\000\129\000\129\000\129\000\129\000\129\000\238\000\129\000\129\000\129\000\129\000\129\001\241\000\000\000\129\000\129\012\213\012\213\000\129\000\129\012\213\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\004J\000\000\000\129\n\002\n~\000\129\000\000\000\129\000\n\000\129\000\000\000\000\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\tm\015N\n\n\000\129\n\134\000\129\001\241\000\000\000\000\000\222\000\238\025Z\000\000\000\129\000\000\015r\000\000\015\150\001\241\000\129\000\129\000\129\000\129\004\142\004V\000\129\000\129\000\129\000\129\002a\000\000\004\022\004\"\002a\002\170\002\174\002a\004.\002z\002a\012\213\002a\000\238\002\230\002a\000\000\002a\002a\002a\000\000\002a\002a\002a\001\194\000\000\000\000\nZ\002\234\002a\002a\002a\002a\002a\000\000\002a\000\000\002\238\000\000\003\138\000\000\002a\002a\002a\002a\002a\003\198\003\202\002a\000\000\003\218\b\150\000\000\002a\000\000\002a\002a\002\162\tm\r\005\003\226\002a\002a\002a\b\130\b\134\b\146\000\000\t\177\005\146\002a\002a\002a\002a\002a\002a\002a\002a\002a\r\005\n\002\n~\002\022\002a\002a\002\026\000\000\000\000\000\000\005\158\005\162\002a\002a\002a\000\000\002a\002a\002a\002&\002a\n\n\000\000\n\134\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\005\166\b\154\002a\002a\002a\b\178\004f\002\174\007r\002a\002a\002a\002a\002u\0022\001\241\000\000\002u\003R\002\174\002u\000\000\000\000\002u\000\000\002u\003V\019f\002u\000\000\002u\002u\002u\000\000\002u\002u\002u\001\194\t\133\000\000\t6\000\n\002u\002u\002u\002u\002u\000\000\002u\000\000\007\238\n\138\003\150\000\000\002u\002u\002u\002u\002u\0026\007\201\002u\000\000\003~\007\201\014\n\002u\014\022\002u\002u\002\162\000\238\001\241\000\000\002u\002u\002u\000\000\000\000\000\000\016B\000\000\000\238\002u\002u\002u\002u\002u\002u\002u\002u\002u\000\000\n\002\n~\000\000\002u\002u\0072\n\"\t\189\000\238\t\189\t\189\002u\002u\002u\000\000\002u\002u\002u\000\000\002u\n\n\000\000\n\134\002u\019j\002u\002u\003\162\002u\002u\002u\002u\002u\002u\t\133\020\214\002u\002u\002u\003\162\030\175\000\000\007\201\002u\002u\002u\002u\002q\000\000\000\000\000\000\002q\000\000\006b\002q\000\000\006\"\002q\nJ\002q\000\000\nR\002q\006v\002q\002q\002q\006~\002q\002q\002q\b\206\001\174\000\000\001\241\001\241\002q\002q\002q\002q\002q\016\214\002q\b\206\017:\016\230\016\246\017\002\002q\002q\002q\002q\002q\016\214\000\000\002q\t\190\016\230\016\246\017\002\002q\000\n\002q\002q\t\189\000\000\t\210\007\157\002q\002q\002q\007\157\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\002q\002q\002q\002q\002q\002q\000\000\n\002\n~\000\000\002q\002q\001\241\000\000\006\206\002\174\000\000\000\000\002q\002q\002q\000\000\002q\002q\002q\000\000\002q\n\n\000\000\n\134\002q\005]\002q\002q\000\000\002q\002q\002q\002q\002q\002q\000\000\000\000\002q\002q\002q\002\174\000\000\002\230\000\000\002q\002q\002q\002q\002e\001\241\001\241\019\190\002e\001\241\003\150\002e\007\157\b]\002e\003\002\002e\000\000\000\000\002e\001\241\002e\002e\002e\000\000\002e\002e\002e\003\014\000\000\000\000\004\018\000\n\002e\002e\002e\002e\002e\000\000\002e\014\218\003\150\000\000\b]\000\000\002e\002e\002e\002e\002e\001\241\000\000\002e\005\146\014\254\000\000\015\"\002e\b]\002e\002e\b]\t\n\001\241\001\241\002e\002e\002e\b]\000\000\000\000\000\000\b]\005\158\002e\002e\002e\002e\002e\002e\002e\002e\002e\000\000\n\002\n~\0079\002e\002e\004\214\001\241\000\000\000\000\000\000\000\000\002e\002e\002e\005\166\002e\002e\002e\000\000\002e\n\n\000\000\n\134\002e\000\000\002e\002e\003\162\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\000\001\241\001\241\020\254\002e\002e\002e\002e\002\025\000\000\000\238\000\000\002\025\003\006\000\000\002\025\001\241\011)\002\025\000\000\002\025\000\000\000\000\002\025\007E\002\025\002\025\002\025\000\n\002\025\002\025\002\025\005\218\003\n\000\000\020.\000\000\002\025\002\025\002\025\002\025\002\025\003\242\002\025\000\000\000\000\006\162\011)\003\254\002\025\002\025\002\025\002\025\002\025\b\157\029\014\002\025\000\000\000\000\001\241\000\000\002\025\011)\002\025\002\025\011)\r\158\0069\000\000\002\025\002\025\002\025\011)\007\173\003\018\000\000\011)\007\173\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\000\000\000\000\002\025\000\000\002\025\002\025\t\137\003\022\000\000\000\238\000\000\tY\002\025\002\025\002\025\000\000\002\025\002\025\002\025\000\000\002\025\000\000\000\000\0069\002\025\000\000\002\025\002\025\000\000\t\190\002\025\002\025\002\025\002\025\002\025\000\000\000\000\002\025\002\025\t\210\021&\000\000\0069\007r\002\025\002\025\002\025\002\025\t\161\000\000\000\238\007\173\t\161\tY\006b\t\161\000\000\006\"\t\161\000\000\t\161\000\000\b2\t\161\006v\t\161\t\161\t\161\006~\t\161\t\161\t\161\000\000\000\000\tY\000\000\t\190\t\161\t\161\t\161\t\161\t\161\000\000\t\161\000\000\007\238\t\210\000\000\000\000\t\161\t\161\t\161\t\161\t\161\017\238\t\137\t\161\002z\000\000\000\000\000\000\t\161\000\000\t\161\t\161\005\173\000\238\001\241\tY\t\161\t\161\t\161\004\226\000\000\000\000\tY\000\000\005\173\t\161\t\161\t\161\t\161\t\161\t\161\t\161\t\161\t\161\000\000\tU\t\161\000\000\t\161\t\161\000\000\000\000\000\000\000\n\000\000\017\242\t\161\t\161\t\161\000\000\t\161\t\161\t\161\000\000\t\161\000\000\000\000\005\173\t\161\017\254\t\161\t\161\001\241\t\190\t\161\t\161\t\161\t\161\t\161\000\000\000\000\t\161\t\161\t\210\001\241\001\241\000\000\tU\t\161\t\161\t\161\t\161\002m\000\000\000\000\005\162\002m\005\173\000\000\002m\005\173\000\000\002m\000\000\002m\000\000\000\000\002m\tU\002m\002m\002m\000\000\002m\002m\002m\b\177\000\000\000\000\000\000\b\177\002m\002m\002m\002m\002m\b\173\002m\002\158\000\000\b\173\000\000\000\000\002m\002m\002m\002m\002m\000\000\000\000\002m\000\000\tU\000\000\000\000\002m\004\226\002m\002m\tU\000\000\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\b\177\002m\002m\002m\002m\002m\002m\002m\002m\002m\b\173\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\007r\000\000\b\177\002m\002m\002m\000\000\002m\002m\002m\000\000\002m\b\173\000\000\000\000\002m\000\000\002m\002m\b:\n\154\002m\002m\002m\002m\002m\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\007r\002m\002m\002m\002m\t\145\004\226\017\238\007\238\t\145\002z\000\000\t\145\000\000\000\238\t\145\004\226\t\145\000\000\019\146\t\145\000\000\t\145\t\145\t\145\000\000\t\145\t\145\t\145\000\238\000\000\000\000\000\000\000\000\t\145\t\145\t\145\t\145\t\145\000\000\t\145\000\000\007\238\000\000\t\238\000\000\t\145\t\145\t\145\t\145\t\145\017\242\000\000\t\145\000\000\000\000\000\000\000\000\t\145\006b\t\145\t\145\006\"\000\238\000\000\017\254\t\145\t\145\t\145\006v\000\000\000\000\000\000\006~\000\000\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\000\000\000\000\t\145\000\000\t\145\t\145\000\000\005\162\000\000\007r\000\000\007\161\t\145\t\145\t\145\007\161\t\145\t\145\t\145\000\000\t\145\000\000\007r\000\000\t\145\019\150\t\145\t\145\bf\t\190\t\145\t\145\t\145\t\145\t\145\028>\000\000\t\145\t\145\t\210\000\000\b\246\000\000\000\000\t\145\t\145\t\145\t\145\003\161\000\000\017\238\007\238\003\161\002z\000\000\003\161\000\238\000\238\003\161\000\000\003\161\000\000\000\000\n\218\007\238\003\161\011.\003\161\000\000\003\161\003\161\003\161\000\238\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003\161\000\000\000\238\007\161\r\178\000\000\003\161\003\161\011\210\011\234\003\161\017\242\000\000\003\161\000\000\000\000\000\000\000\000\003\161\r\186\012\002\003\161\r\194\000\000\000\000\017\254\003\161\003\161\000\238\r\202\000\000\000\000\000\000\r\210\000\000\003\161\003\161\n\242\011r\012\026\0122\012b\003\161\003\161\000\000\000\000\003\161\000\000\003\161\012z\000\000\005\162\000\000\007r\000\000\000\000\003\161\003\161\012\146\000\000\003\161\003\161\003\161\000\000\003\161\000\000\007r\000\000\003\161\000\000\003\161\003\161\019\018\012\242\003\161\r\n\012J\003\161\003\161\024>\000\000\003\161\012\170\003\161\000\000\019Z\000\000\000\000\003\161\003\161\012\194\012\218\002\205\000\000\001\254\007\238\002\205\002z\000\000\002\205\000\000\000\238\002\205\000\000\002\205\000\000\000\000\002\205\007\238\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\238\000\000\000\000\000\000\000\000\002\205\002\205\002\205\002\205\002\205\000\000\002\205\000\000\000\238\000\000\bY\000\000\002\205\002\205\002\205\002\205\002\205\029\226\001\206\002\205\000\000\000\000\000\000\000\000\002\205\bY\002\205\002\205\006\"\000\000\000\000\017\254\002\205\002\205\002\205\bY\000\000\000\000\000\000\bY\000\000\002\205\002\205\002\205\002\205\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\000\000\002\205\002\205\000\000\005\162\000\000\007r\000\000\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\000\002\205\000\000\007r\000\000\002\205\000\000\002\205\002\205\019r\t\190\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\002\205\t\210\000\000\019\134\000\000\000\000\002\205\002\205\002\205\002\205\002\201\000\000\002\174\007\238\002\201\002z\000\000\002\201\000\000\bq\002\201\000\000\002\201\000\000\000\000\002\201\007\238\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\238\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\201\000\000\002\201\000\000\000\238\000\000\bq\000\000\002\201\002\201\002\201\002\201\002\201\020\162\000\000\002\201\000\000\000\000\000\000\000\000\002\201\bq\002\201\002\201\006\"\000\000\000\000\017\254\002\201\002\201\002\201\bq\000\000\000\000\000\000\bq\000\000\002\201\002\201\n\242\002\201\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\000\000\002\201\002\201\000\000\005\162\000\000\007r\000\000\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\002\201\000\000\007r\000\000\002\201\000\000\002\201\002\201\019\158\002\201\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\002\201\002\201\000\000\027\246\000\000\000\000\002\201\002\201\002\201\002\201\002\157\000\000\000\000\007\238\002\157\000\000\000\000\002\157\000\000\000\238\002\157\000\000\002\157\000\000\000\000\002\157\007\238\002\157\002\157\002\157\000\000\002\157\002\157\002\157\000\238\000\000\000\000\007r\000\000\002\157\002\157\002\157\002\157\002\157\000\000\002\157\000\000\000\238\000\000\b\133\000\000\002\157\002\157\002\157\002\157\002\157\029\154\000\000\002\157\000\000\000\000\000\000\000\000\002\157\006b\002\157\002\157\006\"\000\000\000\000\000\000\002\157\002\157\002\157\b\133\000\000\000\000\000\000\b\133\007\238\002\157\002\157\002\157\002\157\002\157\002\157\002\157\002\157\002\157\000\000\000\000\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\000\000\000\238\002\157\002\157\002\157\000\000\002\157\002\157\002\157\000\000\002\157\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\t\190\002\157\002\157\002\157\002\157\002\157\000\000\000\000\002\157\002\157\t\210\000\000\000\000\000\000\000\000\002\157\002\157\002\157\002\157\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\000\000\b\129\002\153\000\000\002\153\000\000\000\000\002\153\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\153\000\000\002\153\000\000\000\000\000\000\b\129\000\000\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\000\000\000\000\000\000\002\153\r\230\002\153\002\153\b\129\000\000\000\000\000\000\002\153\002\153\002\153\b\129\000\000\000\000\000\000\b\129\000\000\002\153\002\153\n\242\002\153\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\000\000\002\153\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\002\153\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\238\002\181\000\000\002\181\000\000\000\000\002\181\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\181\000\000\002\181\000\000\000\000\000\000\bU\000\000\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\000\000\000\000\000\000\000\000\002\181\bU\002\181\002\181\006\"\000\000\000\000\000\000\002\181\002\181\002\181\bU\000\000\000\000\000\000\bU\000\000\002\181\002\181\002\181\002\181\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\t\190\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\002\181\t\210\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\238\002\177\000\000\002\177\000\000\000\000\n\218\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\011Z\002\177\000\000\002\177\000\000\000\000\000\000\016\170\000\000\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\000\000\000\000\000\000\000\000\002\177\r\186\002\177\002\177\r\194\000\000\000\000\000\000\002\177\002\177\002\177\r\202\000\000\000\000\000\000\r\210\000\000\002\177\002\177\n\242\011r\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\002\177\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\213\000\000\000\000\000\000\002\213\012\221\012\221\002\213\000\000\012\221\002\213\000\000\002\213\000\000\000\000\002\213\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\002\213\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\000\000\000\238\000\000\000\000\002\213\000\000\002\213\002\213\000\000\000\000\000\000\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\002\213\002\213\002\213\002\213\002\213\000\000\012\221\002\213\000\000\002\213\002\213\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\002\213\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\t\190\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\002\213\t\210\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\002\209\000\000\000\000\000\000\002\209\012\217\012\217\002\209\000\000\012\217\002\209\000\000\002\209\000\000\000\000\002\209\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\002\209\000\000\000\000\000\000\019N\000\000\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\000\000\000\238\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\242\002\209\002\209\002\209\002\209\002\209\002\209\000\000\012\217\002\209\000\000\002\209\002\209\000\000\000\000\000\000\001\190\000\000\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\002\209\028\206\000\000\000\000\002\209\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\149\t\190\019R\000\000\002\149\019^\002\146\002\149\000\000\000\000\002\149\t\210\002\149\000\000\000\000\002\149\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\002\149\000\000\002\149\004\194\000\000\000\000\005\137\000\000\002\149\002\149\002\149\002\149\002\149\000\000\000\000\002\149\000\000\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\000\000\000\000\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\002\149\002\149\002\149\002\149\002\149\000\000\000\000\002\149\000\000\002\149\002\149\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\002\149\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\t\190\002\149\002\149\002\149\002\149\002\149\000\000\000\000\002\149\002\149\t\210\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\002\145\000\000\000\000\000\000\002\145\000\000\000\000\002\145\000\000\000\000\002\145\000\000\002\145\000\000\000\000\002\145\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\002\145\002\145\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\002\145\002\145\002\145\000\000\000\000\002\145\000\000\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\242\002\145\002\145\002\145\002\145\002\145\002\145\000\000\000\000\002\145\000\000\002\145\002\145\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\002\145\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\002\145\002\145\002\145\002\145\002\145\002\145\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\002\145\002\145\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\002\173\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\000\000\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\t\190\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\002\173\t\210\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\n\218\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\011Z\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n\242\011r\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\002\169\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\002\165\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\000\000\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\000\000\002\165\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\t\190\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\002\165\t\210\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\n\218\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\011Z\002\161\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\000\000\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\n\242\011r\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\000\000\002\161\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\002\161\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\245\000\000\000\000\000\000\002\245\000\000\000\000\002\245\000\000\000\000\002\245\000\000\002\245\000\000\000\000\002\245\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\245\000\000\002\245\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\245\000\000\000\000\002\245\000\000\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\000\000\000\000\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\245\002\245\002\245\002\245\002\245\000\000\000\000\002\245\000\000\002\245\002\245\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\000\000\002\245\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\t\190\002\245\002\245\002\245\002\245\002\245\000\000\000\000\002\245\002\245\t\210\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\002\241\000\000\000\000\000\000\002\241\000\000\000\000\002\241\000\000\000\000\002\241\000\000\002\241\000\000\000\000\n\218\000\000\002\241\002\241\002\241\000\000\002\241\002\241\002\241\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\002\241\000\000\000\000\000\000\000\000\000\000\002\241\002\241\011\210\011\234\002\241\000\000\000\000\002\241\000\000\000\000\000\000\000\000\002\241\000\000\012\002\002\241\000\000\000\000\000\000\000\000\002\241\002\241\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\241\002\241\n\242\011r\012\026\0122\012b\002\241\002\241\000\000\000\000\002\241\000\000\002\241\012z\000\000\000\000\000\000\000\000\000\000\000\000\002\241\002\241\012\146\000\000\002\241\002\241\002\241\000\000\002\241\000\000\000\000\000\000\002\241\000\000\002\241\002\241\000\000\002\241\002\241\002\241\012J\002\241\002\241\000\000\000\000\002\241\012\170\002\241\000\000\000\000\000\000\000\000\002\241\002\241\012\194\012\218\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\002\197\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\000\000\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\t\190\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\002\197\t\210\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\n\218\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\011Z\002\193\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\000\000\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\242\011r\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\002\193\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\002\189\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\000\000\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\t\190\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\002\189\t\210\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\n\218\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\011Z\002\185\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\000\000\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\242\011r\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\002\185\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\229\000\000\000\000\000\000\002\229\000\000\000\000\002\229\000\000\000\000\002\229\000\000\002\229\000\000\000\000\002\229\000\000\002\229\002\229\002\229\000\000\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\000\000\002\229\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\000\000\000\000\000\000\000\000\002\229\000\000\002\229\002\229\000\000\000\000\000\000\000\000\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\000\000\002\229\002\229\000\000\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\000\000\002\229\002\229\002\229\000\000\002\229\000\000\000\000\000\000\002\229\000\000\002\229\002\229\000\000\t\190\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\002\229\t\210\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\225\000\000\000\000\000\000\002\225\000\000\000\000\002\225\000\000\000\000\002\225\000\000\002\225\000\000\000\000\n\218\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\002\225\011\210\011\234\002\225\000\000\000\000\002\225\000\000\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\000\000\000\000\000\000\002\225\002\225\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\n\242\011r\012\026\0122\002\225\002\225\002\225\000\000\000\000\002\225\000\000\002\225\002\225\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\000\000\002\225\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\002\225\002\225\002\225\012J\002\225\002\225\000\000\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\141\000\000\000\000\000\000\002\141\000\000\000\000\002\141\000\000\000\000\002\141\000\000\002\141\000\000\000\000\002\141\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\141\000\000\000\000\002\141\000\000\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\000\000\000\000\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\000\000\000\000\002\141\000\000\002\141\002\141\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\002\141\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\t\190\002\141\002\141\002\141\002\141\002\141\000\000\000\000\002\141\002\141\t\210\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\137\000\000\000\000\000\000\002\137\000\000\000\000\002\137\000\000\000\000\002\137\000\000\002\137\000\000\000\000\n\218\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\002\137\011Z\002\137\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\002\137\002\137\002\137\000\000\000\000\002\137\000\000\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\000\000\000\000\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\242\011r\002\137\002\137\002\137\002\137\002\137\000\000\000\000\002\137\000\000\002\137\002\137\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\002\137\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\002\137\002\137\002\137\002\137\002\137\002\137\000\000\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\002\137\002\137\002\137\002\137\002\133\000\000\000\000\000\000\002\133\000\000\000\000\002\133\000\000\000\000\002\133\000\000\002\133\000\000\000\000\002\133\000\000\002\133\002\133\002\133\000\000\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\133\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\133\000\000\000\000\002\133\000\000\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\000\000\000\000\000\000\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\000\000\000\000\002\133\000\000\002\133\002\133\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\002\133\000\000\002\133\002\133\002\133\000\000\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\t\190\002\133\002\133\002\133\002\133\002\133\000\000\000\000\002\133\002\133\t\210\000\000\000\000\000\000\000\000\002\133\002\133\002\133\002\133\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\n\218\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\011\210\011\234\002\129\000\000\000\000\002\129\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n\242\011r\012\026\0122\002\129\002\129\002\129\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\012J\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\0035\000\000\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\0035\000\000\0035\000\000\000\000\0035\000\000\0035\0035\0035\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\000\000\0035\0035\000\000\000\000\000\000\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0035\0035\0035\0035\0035\000\000\000\000\0035\000\000\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\0035\0035\0035\000\000\0035\0035\0035\000\000\0035\000\000\000\000\000\000\0035\000\000\0035\0035\000\000\t\190\0035\0035\0035\0035\0035\000\000\000\000\0035\0035\t\210\000\000\000\000\000\000\000\000\0035\0035\0035\0035\0031\000\000\000\000\000\000\0031\000\000\000\000\0031\000\000\000\000\0031\000\000\0031\000\000\000\000\n\218\000\000\0031\0031\0031\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\0031\000\000\0031\000\000\000\000\000\000\000\000\000\000\0031\0031\011\210\011\234\0031\000\000\000\000\0031\000\000\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\n\242\011r\012\026\0031\0031\0031\0031\000\000\000\000\0031\000\000\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\0031\0031\0031\000\000\0031\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\0031\0031\0031\012J\0031\0031\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\0031\0031\0031\0031\002}\000\000\000\000\000\000\002}\000\000\000\000\002}\000\000\000\000\002}\000\000\002}\000\000\000\000\002}\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002}\000\000\000\000\002}\000\000\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002}\002}\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\t\190\002}\002}\002}\002}\002}\000\000\000\000\002}\002}\t\210\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\n\218\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\011\210\011\234\002y\000\000\000\000\002y\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n\242\011r\012\026\0122\002y\002y\002y\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\002y\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\012J\002y\002y\000\000\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\002y\002y\002y\002y\002\237\000\000\000\000\000\000\002\237\000\000\000\000\002\237\000\000\000\000\002\237\000\000\002\237\000\000\000\000\002\237\000\000\002\237\002\237\002\237\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\000\000\000\000\000\000\000\000\002\237\000\000\002\237\002\237\000\000\000\000\000\000\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\000\000\002\237\002\237\000\000\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\000\000\002\237\002\237\002\237\000\000\002\237\000\000\000\000\000\000\002\237\000\000\002\237\002\237\000\000\t\190\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\002\237\t\210\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\233\000\000\000\000\000\000\002\233\000\000\000\000\002\233\000\000\000\000\002\233\000\000\002\233\000\000\000\000\n\218\000\000\002\233\002\233\002\233\000\000\002\233\002\233\002\233\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\002\233\000\000\002\233\000\000\000\000\000\000\000\000\000\000\002\233\002\233\011\210\011\234\002\233\000\000\000\000\002\233\000\000\000\000\000\000\000\000\002\233\000\000\002\233\002\233\000\000\000\000\000\000\000\000\002\233\002\233\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\233\002\233\n\242\011r\012\026\0122\002\233\002\233\002\233\000\000\000\000\002\233\000\000\002\233\002\233\000\000\000\000\000\000\000\000\000\000\000\000\002\233\002\233\002\233\000\000\002\233\002\233\002\233\000\000\002\233\000\000\000\000\000\000\002\233\000\000\002\233\002\233\000\000\002\233\002\233\002\233\012J\002\233\002\233\000\000\000\000\002\233\002\233\002\233\000\000\000\000\000\000\000\000\002\233\002\233\002\233\002\233\002\221\000\000\000\000\000\000\002\221\000\000\000\000\002\221\000\000\000\000\002\221\000\000\002\221\000\000\000\000\002\221\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\000\000\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\000\000\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\000\000\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\000\000\002\221\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\t\190\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\002\221\t\210\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\217\000\000\000\000\000\000\002\217\000\000\000\000\002\217\000\000\000\000\002\217\000\000\002\217\000\000\000\000\n\218\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\002\217\000\000\002\217\000\000\000\000\000\000\000\000\000\000\002\217\002\217\011\210\011\234\002\217\000\000\000\000\002\217\000\000\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\000\000\000\000\000\000\002\217\002\217\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\n\242\011r\012\026\0122\002\217\002\217\002\217\000\000\000\000\002\217\000\000\002\217\002\217\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\000\000\002\217\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\002\217\002\217\002\217\012J\002\217\002\217\000\000\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\253\000\000\000\000\000\000\002\253\000\000\000\000\002\253\000\000\000\000\002\253\000\000\002\253\000\000\000\000\002\253\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\253\000\000\002\253\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\253\000\000\000\000\002\253\000\000\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\000\000\000\000\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\253\002\253\002\253\002\253\002\253\000\000\000\000\002\253\000\000\002\253\002\253\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\000\000\002\253\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\t\190\002\253\002\253\002\253\002\253\002\253\000\000\000\000\002\253\002\253\t\210\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\249\000\000\000\000\000\000\002\249\000\000\000\000\002\249\000\000\000\000\002\249\000\000\002\249\000\000\000\000\n\218\000\000\002\249\002\249\002\249\000\000\002\249\002\249\002\249\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\002\249\000\000\000\000\000\000\000\000\000\000\002\249\002\249\011\210\011\234\002\249\000\000\000\000\002\249\000\000\000\000\000\000\000\000\002\249\000\000\012\002\002\249\000\000\000\000\000\000\000\000\002\249\002\249\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\n\242\011r\012\026\0122\012b\002\249\002\249\000\000\000\000\002\249\000\000\002\249\012z\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\012\146\000\000\002\249\002\249\002\249\000\000\002\249\000\000\000\000\000\000\002\249\000\000\002\249\002\249\000\000\002\249\002\249\002\249\012J\002\249\002\249\000\000\000\000\002\249\012\170\002\249\000\000\000\000\000\000\000\000\002\249\002\249\012\194\012\218\003\005\000\000\000\000\000\000\003\005\000\000\000\000\003\005\000\000\000\000\003\005\000\000\003\005\000\000\000\000\003\005\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\005\000\000\003\005\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\005\000\000\000\000\003\005\000\000\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\000\000\000\000\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\005\003\005\003\005\003\005\003\005\000\000\000\000\003\005\000\000\003\005\003\005\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\000\000\003\005\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\t\190\003\005\003\005\003\005\003\005\003\005\000\000\000\000\003\005\003\005\t\210\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\003\001\000\000\000\000\000\000\003\001\000\000\000\000\003\001\000\000\000\000\003\001\000\000\003\001\000\000\000\000\n\218\000\000\003\001\003\001\003\001\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\003\001\000\000\003\001\000\000\000\000\000\000\000\000\000\000\003\001\003\001\011\210\011\234\003\001\000\000\000\000\003\001\000\000\000\000\000\000\000\000\003\001\000\000\012\002\003\001\000\000\000\000\000\000\000\000\003\001\003\001\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\n\242\011r\012\026\0122\012b\003\001\003\001\000\000\000\000\003\001\000\000\003\001\012z\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\012\146\000\000\003\001\003\001\003\001\000\000\003\001\000\000\000\000\000\000\003\001\000\000\003\001\003\001\000\000\003\001\003\001\003\001\012J\003\001\003\001\000\000\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\003\001\003\001\012\194\012\218\003\r\000\000\000\000\000\000\003\r\000\000\000\000\003\r\000\000\000\000\003\r\000\000\003\r\000\000\000\000\003\r\000\000\003\r\003\r\003\r\000\000\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\r\000\000\003\r\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\r\000\000\000\000\003\r\000\000\000\000\000\000\000\000\003\r\000\000\003\r\003\r\000\000\000\000\000\000\000\000\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\r\003\r\003\r\003\r\003\r\000\000\000\000\003\r\000\000\003\r\003\r\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\003\r\000\000\003\r\003\r\003\r\000\000\003\r\000\000\000\000\000\000\003\r\000\000\003\r\003\r\000\000\t\190\003\r\003\r\003\r\003\r\003\r\000\000\000\000\003\r\003\r\t\210\000\000\000\000\000\000\000\000\003\r\003\r\003\r\003\r\003\t\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\003\t\000\000\003\t\000\000\000\000\n\218\000\000\003\t\003\t\003\t\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\003\t\000\000\003\t\000\000\000\000\000\000\000\000\000\000\003\t\003\t\011\210\011\234\003\t\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\012\002\003\t\000\000\000\000\000\000\000\000\003\t\003\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\n\242\011r\012\026\0122\012b\003\t\003\t\000\000\000\000\003\t\000\000\003\t\012z\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\012\146\000\000\003\t\003\t\003\t\000\000\003\t\000\000\000\000\000\000\003\t\000\000\003\t\003\t\000\000\003\t\003\t\003\t\012J\003\t\003\t\000\000\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\003\t\003\t\012\194\012\218\t\153\000\000\000\000\000\000\t\153\000\000\000\000\t\153\000\000\000\000\t\153\000\000\t\153\000\000\000\000\t\153\000\000\t\153\t\153\t\153\000\000\t\153\t\153\t\153\000\000\000\000\000\000\000\000\000\000\t\153\t\153\t\153\t\153\t\153\000\000\t\153\000\000\000\000\000\000\000\000\000\000\t\153\t\153\t\153\t\153\t\153\000\000\000\000\t\153\000\000\000\000\000\000\000\000\t\153\000\000\t\153\t\153\000\000\000\000\000\000\000\000\t\153\t\153\t\153\000\000\000\000\000\000\000\000\000\000\000\000\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\000\000\000\000\t\153\000\000\t\153\t\153\000\000\000\000\000\000\000\000\000\000\000\000\t\153\t\153\t\153\000\000\t\153\t\153\t\153\000\000\t\153\000\000\000\000\000\000\t\153\000\000\t\153\t\153\000\000\t\190\t\153\t\153\t\153\t\153\t\153\000\000\000\000\t\153\t\153\t\210\000\000\000\000\000\000\000\000\t\153\t\153\t\153\t\153\t\149\000\000\000\000\000\000\t\149\000\000\000\000\t\149\000\000\000\000\t\149\000\000\t\149\000\000\000\000\n\218\000\000\t\149\t\149\t\149\000\000\t\149\t\149\t\149\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\t\149\000\000\000\000\000\000\000\000\000\000\t\149\t\149\011\210\011\234\t\149\000\000\000\000\t\149\000\000\000\000\000\000\000\000\t\149\000\000\012\002\t\149\000\000\000\000\000\000\000\000\t\149\t\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\149\t\149\n\242\011r\012\026\0122\012b\t\149\t\149\000\000\000\000\t\149\000\000\t\149\012z\000\000\000\000\000\000\000\000\000\000\000\000\t\149\t\149\012\146\000\000\t\149\t\149\t\149\000\000\t\149\000\000\000\000\000\000\t\149\000\000\t\149\t\149\000\000\t\149\t\149\t\149\012J\t\149\t\149\000\000\000\000\t\149\012\170\t\149\000\000\000\000\000\000\000\000\t\149\t\149\012\194\012\218\003\021\000\000\000\000\000\000\003\021\000\000\000\000\003\021\000\000\000\000\003\021\000\000\003\021\000\000\000\000\003\021\000\000\003\021\003\021\003\021\000\000\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\021\000\000\003\021\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\021\000\000\000\000\003\021\000\000\000\000\000\000\000\000\003\021\000\000\003\021\003\021\000\000\000\000\000\000\000\000\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\021\003\021\003\021\003\021\003\021\000\000\000\000\003\021\000\000\003\021\003\021\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\003\021\000\000\003\021\003\021\003\021\000\000\003\021\000\000\000\000\000\000\003\021\000\000\003\021\003\021\000\000\t\190\003\021\003\021\003\021\003\021\003\021\000\000\000\000\003\021\003\021\t\210\000\000\000\000\000\000\000\000\003\021\003\021\003\021\003\021\003\017\000\000\000\000\000\000\003\017\000\000\000\000\003\017\000\000\000\000\003\017\000\000\003\017\000\000\000\000\n\218\000\000\003\017\003\017\003\017\000\000\003\017\003\017\003\017\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003\017\000\000\000\000\000\000\000\000\000\000\003\017\003\017\011\210\011\234\003\017\000\000\000\000\003\017\000\000\000\000\000\000\000\000\003\017\000\000\012\002\003\017\000\000\000\000\000\000\000\000\003\017\003\017\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\n\242\011r\012\026\0122\012b\003\017\003\017\000\000\000\000\003\017\000\000\003\017\012z\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\012\146\000\000\003\017\003\017\003\017\000\000\003\017\000\000\000\000\000\000\003\017\000\000\003\017\003\017\000\000\012\242\003\017\r\n\012J\003\017\003\017\000\000\000\000\003\017\012\170\003\017\000\000\000\000\000\000\000\000\003\017\003\017\012\194\012\218\t\141\000\000\000\000\000\000\t\141\000\000\000\000\t\141\000\000\000\000\t\141\000\000\t\141\000\000\000\000\n\218\000\000\t\141\t\141\t\141\000\000\t\141\t\141\t\141\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\t\141\000\000\000\000\000\000\000\000\000\000\t\141\t\141\011\210\011\234\t\141\000\000\000\000\t\141\000\000\000\000\000\000\000\000\t\141\000\000\012\002\t\141\000\000\000\000\000\000\000\000\t\141\t\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\141\t\141\n\242\011r\012\026\0122\012b\t\141\t\141\000\000\000\000\t\141\000\000\t\141\012z\000\000\000\000\000\000\000\000\000\000\000\000\t\141\t\141\012\146\000\000\t\141\t\141\t\141\000\000\t\141\000\000\000\000\000\000\t\141\000\000\t\141\t\141\000\000\t\141\t\141\t\141\012J\t\141\t\141\000\000\000\000\t\141\012\170\t\141\000\000\000\000\000\000\000\000\t\141\t\141\012\194\012\218\003e\000\000\000\000\000\000\003e\000\000\000\000\003e\000\000\000\000\003e\000\000\003e\000\000\000\000\003e\000\000\003e\003e\003e\000\000\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003e\000\000\003e\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003e\000\000\000\000\003e\000\000\000\000\000\000\000\000\003e\000\000\003e\003e\000\000\000\000\000\000\000\000\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003e\003e\003e\003e\003e\000\000\000\000\003e\000\000\003e\003e\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\000\000\003e\003e\003e\000\000\003e\000\000\000\000\000\000\003e\000\000\003e\003e\000\000\t\190\003e\003e\003e\003e\003e\000\000\000\000\003e\003e\t\210\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003a\000\000\000\000\000\000\003a\000\000\000\000\003a\000\000\000\000\003a\000\000\003a\000\000\000\000\n\218\000\000\003a\003a\003a\000\000\003a\003a\003a\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003a\000\000\000\000\000\000\000\000\000\000\003a\003a\011\210\011\234\003a\000\000\000\000\003a\000\000\000\000\000\000\000\000\003a\000\000\012\002\003a\000\000\000\000\000\000\000\000\003a\003a\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\n\242\011r\012\026\0122\012b\003a\003a\000\000\000\000\003a\000\000\003a\012z\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\012\146\000\000\003a\003a\003a\000\000\003a\000\000\000\000\000\000\003a\000\000\003a\003a\000\000\012\242\003a\r\n\012J\003a\003a\000\000\000\000\003a\012\170\003a\000\000\000\000\000\000\000\000\003a\003a\012\194\012\218\003\133\000\000\000\000\000\000\003\133\000\000\000\000\003\133\000\000\000\000\003\133\000\000\003\133\000\000\000\000\003\133\000\000\003\133\003\133\003\133\000\000\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\133\000\000\003\133\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\133\000\000\000\000\003\133\000\000\000\000\000\000\000\000\003\133\000\000\003\133\003\133\000\000\000\000\000\000\000\000\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\133\003\133\003\133\003\133\003\133\000\000\000\000\003\133\000\000\003\133\003\133\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\003\133\000\000\003\133\003\133\003\133\000\000\003\133\000\000\000\000\000\000\003\133\000\000\003\133\003\133\000\000\t\190\003\133\003\133\003\133\003\133\003\133\000\000\000\000\003\133\003\133\t\210\000\000\000\000\000\000\000\000\003\133\003\133\003\133\003\133\003\129\000\000\000\000\000\000\003\129\000\000\000\000\003\129\000\000\000\000\003\129\000\000\003\129\000\000\000\000\n\218\000\000\003\129\003\129\003\129\000\000\003\129\003\129\003\129\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003\129\000\000\000\000\000\000\000\000\000\000\003\129\003\129\011\210\011\234\003\129\000\000\000\000\003\129\000\000\000\000\000\000\000\000\003\129\000\000\012\002\003\129\000\000\000\000\000\000\000\000\003\129\003\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\n\242\011r\012\026\0122\012b\003\129\003\129\000\000\000\000\003\129\000\000\003\129\012z\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\012\146\000\000\003\129\003\129\003\129\000\000\003\129\000\000\000\000\000\000\003\129\000\000\003\129\003\129\000\000\012\242\003\129\r\n\012J\003\129\003\129\000\000\000\000\003\129\012\170\003\129\000\000\000\000\000\000\000\000\003\129\003\129\012\194\012\218\003u\000\000\000\000\000\000\003u\000\000\000\000\003u\000\000\000\000\003u\000\000\003u\000\000\000\000\003u\000\000\003u\003u\003u\000\000\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003u\000\000\003u\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003u\000\000\000\000\003u\000\000\000\000\000\000\000\000\003u\000\000\003u\003u\000\000\000\000\000\000\000\000\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003u\003u\003u\003u\003u\000\000\000\000\003u\000\000\003u\003u\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\003u\000\000\003u\003u\003u\000\000\003u\000\000\000\000\000\000\003u\000\000\003u\003u\000\000\t\190\003u\003u\003u\003u\003u\000\000\000\000\003u\003u\t\210\000\000\000\000\000\000\000\000\003u\003u\003u\003u\003q\000\000\000\000\000\000\003q\000\000\000\000\003q\000\000\000\000\003q\000\000\003q\000\000\000\000\n\218\000\000\003q\003q\003q\000\000\003q\003q\003q\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003q\000\000\000\000\000\000\000\000\000\000\003q\003q\011\210\011\234\003q\000\000\000\000\003q\000\000\000\000\000\000\000\000\003q\000\000\012\002\003q\000\000\000\000\000\000\000\000\003q\003q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\n\242\011r\012\026\0122\012b\003q\003q\000\000\000\000\003q\000\000\003q\012z\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\012\146\000\000\003q\003q\003q\000\000\003q\000\000\000\000\000\000\003q\000\000\003q\003q\000\000\012\242\003q\r\n\012J\003q\003q\000\000\000\000\003q\012\170\003q\000\000\000\000\000\000\000\000\003q\003q\012\194\012\218\003M\000\000\000\000\000\000\003M\000\000\000\000\003M\000\000\000\000\003M\000\000\003M\000\000\000\000\003M\000\000\003M\003M\003M\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003M\000\000\003M\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003M\000\000\000\000\003M\000\000\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003M\003M\003M\003M\003M\000\000\000\000\003M\000\000\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\003M\003M\003M\000\000\003M\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\t\190\003M\003M\003M\003M\003M\000\000\000\000\003M\003M\t\210\000\000\000\000\000\000\000\000\003M\003M\003M\003M\003I\000\000\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\003I\000\000\003I\000\000\000\000\n\218\000\000\003I\003I\003I\000\000\003I\003I\003I\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003I\000\000\000\000\000\000\000\000\000\000\003I\003I\011\210\011\234\003I\000\000\000\000\003I\000\000\000\000\000\000\000\000\003I\000\000\012\002\003I\000\000\000\000\000\000\000\000\003I\003I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003I\003I\n\242\011r\012\026\0122\012b\003I\003I\000\000\000\000\003I\000\000\003I\012z\000\000\000\000\000\000\000\000\000\000\000\000\003I\003I\012\146\000\000\003I\003I\003I\000\000\003I\000\000\000\000\000\000\003I\000\000\003I\003I\000\000\012\242\003I\r\n\012J\003I\003I\000\000\000\000\003I\012\170\003I\000\000\000\000\000\000\000\000\003I\003I\012\194\012\218\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\003]\000\000\003]\000\000\000\000\003]\000\000\003]\003]\003]\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\000\000\003]\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\000\000\003]\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\003]\003]\003]\003]\000\000\000\000\003]\000\000\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\003]\003]\003]\000\000\003]\000\000\000\000\000\000\003]\000\000\003]\003]\000\000\t\190\003]\003]\003]\003]\003]\000\000\000\000\003]\003]\t\210\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003Y\000\000\000\000\000\000\003Y\000\000\000\000\003Y\000\000\000\000\003Y\000\000\003Y\000\000\000\000\n\218\000\000\003Y\003Y\003Y\000\000\003Y\003Y\003Y\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003Y\000\000\000\000\000\000\000\000\000\000\003Y\003Y\011\210\011\234\003Y\000\000\000\000\003Y\000\000\000\000\000\000\000\000\003Y\000\000\012\002\003Y\000\000\000\000\000\000\000\000\003Y\003Y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\n\242\011r\012\026\0122\012b\003Y\003Y\000\000\000\000\003Y\000\000\003Y\012z\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\012\146\000\000\003Y\003Y\003Y\000\000\003Y\000\000\000\000\000\000\003Y\000\000\003Y\003Y\000\000\012\242\003Y\r\n\012J\003Y\003Y\000\000\000\000\003Y\012\170\003Y\000\000\000\000\000\000\000\000\003Y\003Y\012\194\012\218\003U\000\000\000\000\000\000\003U\000\000\000\000\003U\000\000\000\000\003U\000\000\003U\000\000\000\000\003U\000\000\003U\003U\003U\000\000\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003U\000\000\003U\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003U\000\000\000\000\003U\000\000\000\000\000\000\000\000\003U\000\000\003U\003U\000\000\000\000\000\000\000\000\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003U\003U\003U\003U\003U\000\000\000\000\003U\000\000\003U\003U\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\003U\000\000\003U\003U\003U\000\000\003U\000\000\000\000\000\000\003U\000\000\003U\003U\000\000\t\190\003U\003U\003U\003U\003U\000\000\000\000\003U\003U\t\210\000\000\000\000\000\000\000\000\003U\003U\003U\003U\003Q\000\000\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\003Q\000\000\003Q\000\000\000\000\n\218\000\000\003Q\003Q\003Q\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\011\210\011\234\003Q\000\000\000\000\003Q\000\000\000\000\000\000\000\000\003Q\000\000\012\002\003Q\000\000\000\000\000\000\000\000\003Q\003Q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\n\242\011r\012\026\0122\012b\003Q\003Q\000\000\000\000\003Q\000\000\003Q\012z\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\012\146\000\000\003Q\003Q\003Q\000\000\003Q\000\000\000\000\000\000\003Q\000\000\003Q\003Q\000\000\012\242\003Q\r\n\012J\003Q\003Q\000\000\000\000\003Q\012\170\003Q\000\000\000\000\000\000\000\000\003Q\003Q\012\194\012\218\003m\000\000\000\000\000\000\003m\000\000\000\000\003m\000\000\000\000\003m\000\000\003m\000\000\000\000\003m\000\000\003m\003m\003m\000\000\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003m\000\000\003m\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003m\000\000\000\000\003m\000\000\000\000\000\000\000\000\003m\000\000\003m\003m\000\000\000\000\000\000\000\000\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003m\003m\003m\003m\003m\000\000\000\000\003m\000\000\003m\003m\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\003m\000\000\003m\003m\003m\000\000\003m\000\000\000\000\000\000\003m\000\000\003m\003m\000\000\t\190\003m\003m\003m\003m\003m\000\000\000\000\003m\003m\t\210\000\000\000\000\000\000\000\000\003m\003m\003m\003m\003i\000\000\000\000\000\000\003i\000\000\000\000\003i\000\000\000\000\003i\000\000\003i\000\000\000\000\n\218\000\000\003i\003i\003i\000\000\003i\003i\003i\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003i\000\000\000\000\000\000\000\000\000\000\003i\003i\011\210\011\234\003i\000\000\000\000\003i\000\000\000\000\000\000\000\000\003i\000\000\012\002\003i\000\000\000\000\000\000\000\000\003i\003i\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\n\242\011r\012\026\0122\012b\003i\003i\000\000\000\000\003i\000\000\003i\012z\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\012\146\000\000\003i\003i\003i\000\000\003i\000\000\000\000\000\000\003i\000\000\003i\003i\000\000\012\242\003i\r\n\012J\003i\003i\000\000\000\000\003i\012\170\003i\000\000\000\000\000\000\000\000\003i\003i\012\194\012\218\003\141\000\000\000\000\000\000\003\141\000\000\000\000\003\141\000\000\000\000\003\141\000\000\003\141\000\000\000\000\003\141\000\000\003\141\003\141\003\141\000\000\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\141\000\000\003\141\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\141\000\000\000\000\003\141\000\000\000\000\000\000\000\000\003\141\000\000\003\141\003\141\000\000\000\000\000\000\000\000\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\000\000\000\000\003\141\000\000\003\141\003\141\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\003\141\000\000\003\141\003\141\003\141\000\000\003\141\000\000\000\000\000\000\003\141\000\000\003\141\003\141\000\000\t\190\003\141\003\141\003\141\003\141\003\141\000\000\000\000\003\141\003\141\t\210\000\000\000\000\000\000\000\000\003\141\003\141\003\141\003\141\003\137\000\000\000\000\000\000\003\137\000\000\000\000\003\137\000\000\000\000\003\137\000\000\003\137\000\000\000\000\n\218\000\000\003\137\003\137\003\137\000\000\003\137\003\137\003\137\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003\137\000\000\000\000\000\000\000\000\000\000\003\137\003\137\011\210\011\234\003\137\000\000\000\000\003\137\000\000\000\000\000\000\000\000\003\137\000\000\012\002\003\137\000\000\000\000\000\000\000\000\003\137\003\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\n\242\011r\012\026\0122\012b\003\137\003\137\000\000\000\000\003\137\000\000\003\137\012z\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\012\146\000\000\003\137\003\137\003\137\000\000\003\137\000\000\000\000\000\000\003\137\000\000\003\137\003\137\000\000\012\242\003\137\r\n\012J\003\137\003\137\000\000\000\000\003\137\012\170\003\137\000\000\000\000\000\000\000\000\003\137\003\137\012\194\012\218\003}\000\000\000\000\000\000\003}\000\000\000\000\003}\000\000\000\000\003}\000\000\003}\000\000\000\000\003}\000\000\003}\003}\003}\000\000\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003}\000\000\003}\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003}\000\000\000\000\003}\000\000\000\000\000\000\000\000\003}\000\000\003}\003}\000\000\000\000\000\000\000\000\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003}\003}\003}\003}\003}\000\000\000\000\003}\000\000\003}\003}\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\003}\000\000\003}\003}\003}\000\000\003}\000\000\000\000\000\000\003}\000\000\003}\003}\000\000\t\190\003}\003}\003}\003}\003}\000\000\000\000\003}\003}\t\210\000\000\000\000\000\000\000\000\003}\003}\003}\003}\003y\000\000\000\000\000\000\003y\000\000\000\000\003y\000\000\000\000\003y\000\000\003y\000\000\000\000\n\218\000\000\003y\003y\003y\000\000\003y\003y\003y\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003y\000\000\000\000\000\000\000\000\000\000\003y\003y\011\210\011\234\003y\000\000\000\000\003y\000\000\000\000\000\000\000\000\003y\000\000\012\002\003y\000\000\000\000\000\000\000\000\003y\003y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\n\242\011r\012\026\0122\012b\003y\003y\000\000\000\000\003y\000\000\003y\012z\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\012\146\000\000\003y\003y\003y\000\000\003y\000\000\000\000\000\000\003y\000\000\003y\003y\000\000\012\242\003y\r\n\012J\003y\003y\000\000\000\000\003y\012\170\003y\000\000\000\000\000\000\000\000\003y\003y\012\194\012\218\003E\000\000\000\000\000\000\003E\000\000\000\000\003E\000\000\000\000\003E\000\000\003E\000\000\000\000\003E\000\000\003E\003E\003E\000\000\003E\003E\003E\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003E\000\000\003E\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003E\000\000\000\000\003E\000\000\000\000\000\000\000\000\003E\000\000\003E\003E\000\000\000\000\000\000\000\000\003E\003E\003E\000\000\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003E\003E\003E\003E\003E\000\000\000\000\003E\000\000\003E\003E\000\000\000\000\000\000\000\000\000\000\000\000\003E\003E\003E\000\000\003E\003E\003E\000\000\003E\000\000\000\000\000\000\003E\000\000\003E\003E\000\000\t\190\003E\003E\003E\003E\003E\000\000\000\000\003E\003E\t\210\000\000\000\000\000\000\000\000\003E\003E\003E\003E\003A\000\000\000\000\000\000\003A\000\000\000\000\003A\000\000\000\000\003A\000\000\003A\000\000\000\000\n\218\000\000\003A\003A\003A\000\000\003A\003A\003A\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\003A\000\000\000\000\000\000\000\000\000\000\003A\003A\011\210\011\234\003A\000\000\000\000\003A\000\000\000\000\000\000\000\000\003A\000\000\012\002\003A\000\000\000\000\000\000\000\000\003A\003A\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003A\003A\n\242\011r\012\026\0122\012b\003A\003A\000\000\000\000\003A\000\000\003A\012z\000\000\000\000\000\000\000\000\000\000\000\000\003A\003A\012\146\000\000\003A\003A\003A\000\000\003A\000\000\000\000\000\000\003A\000\000\003A\003A\000\000\012\242\003A\r\n\012J\003A\003A\000\000\000\000\003A\012\170\003A\000\000\000\000\000\000\000\000\003A\003A\012\194\012\218\t\157\000\000\000\000\000\000\t\157\000\000\000\000\t\157\000\000\000\000\t\157\000\000\t\157\000\000\000\000\n\218\000\000\t\157\t\157\t\157\000\000\t\157\t\157\t\157\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\t\157\000\000\000\000\000\000\000\000\000\000\t\157\t\157\011\210\011\234\t\157\000\000\000\000\t\157\000\000\000\000\000\000\000\000\t\157\000\000\012\002\t\157\000\000\000\000\000\000\000\000\t\157\t\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\157\t\157\n\242\011r\012\026\0122\012b\t\157\t\157\000\000\000\000\t\157\000\000\t\157\012z\000\000\000\000\000\000\000\000\000\000\000\000\t\157\t\157\012\146\000\000\t\157\t\157\t\157\000\000\t\157\000\000\000\000\000\000\t\157\000\000\t\157\t\157\000\000\t\157\t\157\t\157\012J\t\157\t\157\000\000\000\000\t\157\012\170\t\157\000\000\000\000\000\000\000\000\t\157\t\157\012\194\012\218\t\245\000\000\000\000\000\000\t\245\000\000\000\000\t\245\000\000\000\000\t\245\000\000\t\245\000\000\000\000\t\245\000\000\t\245\t\245\t\245\000\000\t\245\t\245\t\245\000\000\000\000\000\000\000\000\000\000\t\245\t\245\t\245\t\245\t\245\000\000\t\245\000\000\000\000\000\000\000\000\000\000\t\245\t\245\t\245\t\245\t\245\000\000\000\000\t\245\000\000\000\000\000\000\000\000\t\245\000\000\t\245\t\245\000\000\000\000\000\000\000\000\t\245\t\245\t\245\000\000\000\000\000\000\000\000\000\000\000\000\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\000\000\000\000\t\245\000\000\t\245\t\245\000\000\000\000\000\000\000\000\000\000\000\000\t\245\t\245\t\245\000\000\t\245\t\245\t\245\000\000\t\245\000\000\000\000\000\000\t\245\000\000\t\245\t\245\000\000\t\190\t\245\t\245\t\245\t\245\t\245\000\000\000\000\t\245\t\245\t\210\000\000\000\000\000\000\000\000\t\245\t\245\t\245\t\245\002U\000\000\000\000\000\000\002U\000\000\000\000\002U\000\000\000\000\002U\000\000\002U\000\000\000\000\002U\000\000\002U\002U\002U\000\000\002U\002U\002U\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\002U\002U\002U\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\002U\000\000\002U\002U\016n\000\000\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\t\190\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\t\210\000\000\000\000\000\000\000\000\002U\002U\002U\002U\002M\000\000\000\000\000\000\002M\000\000\000\000\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\002M\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\000\000\002M\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\002M\002M\002M\002M\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\t\190\002M\002M\002M\002M\002M\000\000\000\000\002M\002M\t\210\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002I\000\000\000\000\000\000\002I\000\000\000\000\002I\000\000\000\000\002I\000\000\002I\000\000\000\000\n\218\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\011\210\011\234\002I\000\000\000\000\002I\000\000\000\000\000\000\000\000\002I\000\000\012\002\002I\000\000\000\000\000\000\000\000\002I\002I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\n\242\011r\012\026\0122\012b\002I\002I\000\000\000\000\002I\000\000\002I\012z\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\012\146\000\000\002I\002I\002I\000\000\002I\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\012\242\002I\r\n\012J\002I\002I\000\000\000\000\002I\012\170\002I\000\000\000\000\000\000\000\000\002I\002I\012\194\012\218\002Q\000\000\000\000\000\000\002Q\000\000\000\000\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\n\218\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\011\210\011\234\002Q\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002Q\000\000\012\002\002Q\000\000\000\000\000\000\000\000\002Q\002Q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\n\242\011r\012\026\0122\012b\002Q\002Q\000\000\000\000\002Q\000\000\002Q\012z\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\012\146\000\000\002Q\002Q\016\138\000\000\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\012\242\002Q\r\n\012J\002Q\002Q\000\000\000\000\002Q\012\170\002Q\000\000\000\000\000\000\000\000\002Q\002Q\012\194\012\218\002E\000\000\000\000\000\000\002E\000\000\000\000\002E\000\000\000\000\002E\000\000\002E\000\000\000\000\002E\000\000\002E\002E\002E\000\000\002E\002E\002E\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002E\000\000\002E\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002E\000\000\000\000\002E\000\000\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\000\000\000\000\000\000\002E\002E\002E\000\000\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\000\000\002E\002E\000\000\000\000\000\000\000\000\000\000\000\000\002E\002E\002E\000\000\002E\002E\002E\000\000\002E\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\t\190\002E\002E\002E\002E\002E\000\000\000\000\002E\002E\t\210\000\000\000\000\000\000\000\000\002E\002E\002E\002E\002A\000\000\000\000\000\000\002A\000\000\000\000\002A\000\000\000\000\002A\000\000\002A\000\000\000\000\n\218\000\000\002A\002A\002A\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\002A\000\000\000\000\000\000\000\000\000\000\002A\002A\011\210\011\234\002A\000\000\000\000\002A\000\000\000\000\000\000\000\000\002A\000\000\012\002\002A\000\000\000\000\000\000\000\000\002A\002A\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\n\242\011r\012\026\0122\012b\002A\002A\000\000\000\000\002A\000\000\002A\012z\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\012\146\000\000\002A\002A\002A\000\000\002A\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\012\242\002A\r\n\012J\002A\002A\000\000\000\000\002A\012\170\002A\000\000\000\000\000\000\000\000\002A\002A\012\194\012\218\003=\000\000\000\000\000\000\003=\000\000\000\000\003=\000\000\000\000\003=\000\000\003=\000\000\000\000\003=\000\000\003=\003=\003=\000\000\003=\003=\003=\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\003=\003=\000\000\003=\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\003=\003=\000\000\000\000\003=\000\000\000\000\000\000\000\000\003=\000\000\003=\003=\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\003=\003=\003=\003=\003=\003=\000\000\000\000\003=\000\000\003=\003=\000\000\000\000\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\003=\003=\003=\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\003=\000\000\t\190\003=\003=\003=\003=\003=\000\000\000\000\003=\003=\t\210\000\000\000\000\000\000\000\000\003=\003=\003=\003=\0039\000\000\000\000\000\000\0039\000\000\000\000\0039\000\000\000\000\0039\000\000\0039\000\000\000\000\n\218\000\000\0039\0039\0039\000\000\0039\0039\0039\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\0039\000\000\000\000\000\000\000\000\000\000\0039\0039\011\210\011\234\0039\000\000\000\000\0039\000\000\000\000\000\000\000\000\0039\000\000\012\002\0039\000\000\000\000\000\000\000\000\0039\0039\000\238\000\000\000\000\000\000\000\000\000\000\000\000\0039\0039\n\242\011r\012\026\0122\012b\0039\0039\000\000\000\000\0039\000\000\0039\012z\000\000\000\000\000\000\000\000\000\000\000\000\0039\0039\012\146\000\000\0039\0039\0039\000\000\0039\000\000\000\000\000\000\0039\000\000\0039\0039\000\000\012\242\0039\r\n\012J\0039\0039\000\000\000\000\0039\012\170\0039\000\000\000\000\000\000\000\000\0039\0039\012\194\012\218\0029\000\000\000\000\000\000\0029\000\000\000\000\0029\000\000\000\000\0029\000\000\0029\000\000\000\000\0029\000\000\0029\0029\0029\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\0029\0029\000\000\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\0029\0029\000\000\000\000\0029\000\000\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\0029\0029\0029\000\000\0029\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\0029\0029\0029\0029\0029\0029\000\000\000\000\0029\0029\t\210\000\000\000\000\000\000\000\000\0029\0029\0029\0029\002=\000\000\000\000\000\000\002=\000\000\000\000\002=\000\000\000\000\002=\000\000\002=\000\000\000\000\002=\000\000\002=\002=\002=\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002=\000\000\002=\b\189\000\000\000\000\b\189\000\000\002=\002=\002=\002=\002=\000\000\000\000\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\025b\000\000\000\000\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002=\002=\002=\002=\002=\000\000\b\189\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b\189\002=\002=\002=\000\000\002=\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\002=\002=\002=\002=\002=\002=\000\000\000\000\002=\002=\t\210\000\000\b\189\000\000\000\000\002=\002=\002=\002=\000\006\000\000\000\000\007\141\002\170\002\174\000\000\002\218\002z\006^\000\000\000\000\000\000\002\230\001\006\000\000\000\000\000\000\002\134\000\000\000\000\b\189\007\141\001\194\000\000\000\000\000\000\003\222\001\014\b\214\b\218\001\026\001\030\000\000\000\000\000\000\002\238\000\000\003\138\000\000\018\246\000\000\b\250\b\254\007\141\003\198\003\202\000\000\003\206\003\218\003\230\t\002\007\030\000\238\001.\007\141\002\162\000\000\000\000\003\226\007\141\007\141\000\238\b\130\b\134\b\146\b\166\000\000\005\146\007\141\007\141\0012\0016\001:\001>\001B\000\000\000\000\t\022\001F\000\000\000\000\000\000\001J\000\000\t\"\t:\t\222\005\158\005\162\000\000\000\000\001N\000\000\000\000\007\141\000\000\000\000\006b\001R\000\000\006\"\006j\000\000\000\000\007\141\000\000\000\000\006v\001\142\006R\000\000\006~\005\166\b\154\000\000\001\146\000\000\016\202\004f\t\242\026\214\001\154\000\006\001\158\001\162\001\153\002\170\002\174\000\000\002\218\002z\027\254\000\000\000\000\000\000\002\230\001\006\000\000\000\000\000\000\b\210\000\000\000\000\000\000\001\153\001\194\000\000\000\000\000\000\003\222\001\014\b\214\b\218\001\026\001\030\000\000\000\000\000\000\002\238\000\000\003\138\000\000\b\222\000\000\b\250\b\254\001\153\003\198\003\202\000\000\003\206\003\218\003\230\t\002\007\030\000\238\001.\001\153\002\162\000\000\000\000\003\226\001\153\001\153\000\238\b\130\b\134\b\146\b\166\000\000\005\146\001\153\001\153\0012\0016\001:\001>\001B\000\000\000\000\t\022\001F\000\000\000\000\000\000\001J\000\000\t\"\t:\t\222\005\158\005\162\000\000\000\000\001N\000\000\000\000\001\153\000\000\000\000\006b\001R\000\000\006\"\028\002\000\000\000\000\001\153\000\000\000\000\006v\001\142\006\146\000\000\006~\005\166\b\154\000\000\001\146\000\000\016\202\004f\t\242\000\000\001\154\000\000\001\158\001\162\000\145\002\170\002\174\000\145\006\158\002z\000\000\n>\000\000\000\000\002\230\000\000\000\000\000\145\000\000\000\145\000\000\000\145\000\000\000\145\001\194\000\000\nn\000\000\002\234\003\130\003R\002\174\000\000\000\000\nv\000\145\000\000\002\238\003V\003\138\000\000\000\145\000\000\000\000\bR\000\145\003\198\003\202\000\000\001\194\003\218\001\174\000\238\000\145\000\000\000\000\000\145\002\162\000\000\000\000\003\226\000\145\000\145\000\145\b\130\b\134\b\146\000\000\014^\005\146\000\145\000\145\000\000\000\000\000\000\003~\000\000\000\145\000\000\000\000\000\000\000\145\002\162\000\000\000\000\000\000\000\000\000\000\000\000\005\158\005\162\000\145\000\145\000\000\000\000\000\145\000\145\006b\000\000\000\000\006\"\000\000\000\249\000\000\001\241\000\000\000\145\006v\021\182\000\000\0072\006~\000\145\000\145\005\166\b\154\000\000\000\000\000\000\b\178\004f\000\249\000\145\000\000\000\145\000\169\002\170\002\174\000\169\004\169\002z\000\000\n>\000\n\000\000\002\230\000\000\000\000\000\169\000\000\000\169\000\000\000\169\000\249\000\169\001\194\000\000\nn\021\234\002\234\000\000\003\253\001\241\000\000\000\249\nv\000\169\000\000\002\238\000\249\003\138\000\000\000\169\000\000\001\241\001\241\000\169\003\198\003\202\000\249\003\253\003\218\001\174\000\238\000\169\007\189\000\000\000\169\002\162\007\189\000\000\003\226\000\169\000\169\000\169\b\130\b\134\b\146\000\000\014^\005\146\000\169\000\169\003\253\000\249\000\000\000\000\000\000\000\169\000\000\000\000\005\181\000\169\004\169\000\249\000\000\000\000\000\000\000\000\000\000\005\158\005\162\000\169\000\169\003\253\000\000\000\169\000\169\006b\000\000\000\238\006\"\tV\000\000\000\000\000\000\000\000\000\169\006v\000\000\000\000\000\000\006~\000\169\000\169\005\166\b\154\000\000\000\000\000\000\b\178\004f\000\000\000\169\000\006\000\169\000\000\000\246\002\170\002\174\002\178\002\218\002z\005\181\000\000\000\000\000\000\002\230\000\000\000\000\003^\000\000\000\000\0069\005\029\006b\003b\001\194\006\"\020&\000\000\002\234\000\000\003f\003j\006v\000\000\000\000\003n\006~\002\238\000\000\003\138\000\000\019\186\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\r\005\020\030\002\162\001\254\000\000\003\226\0206\000\000\000\000\b\130\b\134\b\146\b\166\002\002\005\146\000\000\000\000\000\000\000\000\000\000\r\005\001\194\020>\002\022\t\022\000\000\002\026\000\000\000\000\000\000\000\000\t\"\t:\t\222\005\158\005\162\020R\020\142\003B\002&\005\029\005\029\000\000\000\000\000\000\002.\012\241\007J\001\206\000\000\000\000\000\000\000\000\000\000\002\162\000\000\000\000\020\202\024\190\005\166\b\154\000\000\000\000\000\000\b\178\004f\t\242\000\006\000\000\0022\000\246\002\170\002\174\002\178\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\007R\005=\000\000\000\000\000\000\000\000\000\000\003b\001\194\000\000\000\000\002\174\002\234\000\000\003f\003j\000\000\000\000\000\000\003n\000\000\002\238\000\000\003\138\000\000\019\186\000\000\003\190\003\194\001\194\003\198\003\202\0026\003\206\003\218\003\230\003\238\007\030\000\000\000\000\020\030\002\162\024\218\000\000\003\226\0206\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\026\022\003\150\000\000\026\026\000\000\000\000\020>\002\162\t\022\000\000\030\210\000\000\000\000\000\000\026J\t\"\t:\t\222\005\158\005\162\020R\020\142\000\000\000\000\030\243\017F\000\000\000\000\000\000\000\000\006\182\000\000\000\000\t\217\000\000\000\000\000\000\026Z\000\000\000\000\000\000\000\000\024\190\005\166\b\154\000\000\000\000\000\000\b\178\004f\t\242\000\006\000\000\000\000\000\246\002\170\002\174\002\178\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\031\"\000\000\000\000\000\000\000\000\000\000\003b\001\194\000\238\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\003n\000\000\002\238\000\000\003\138\000\000\019\186\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\020\030\002\162\000\000\000\000\003\226\0206\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\006b\000\000\000\000\006\"\000\000\000\000\000\000\020>\t\217\t\022\006v\030\210\000\000\000\000\006~\000\000\t\"\t:\t\222\005\158\005\162\020R\020\142\001\190\000\000\005E\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\001\194\000>\024\190\005\166\b\154\000B\000\000\000\000\b\178\004f\t\242\000\000\000F\021\226\000\000\000\000\000\000\000\000\000J\000\000\000N\000R\000V\000Z\000^\000b\000f\002\146\000\000\022Z\000j\000\000\000\000\002\162\000n\000\000\000r\000\000\000v\000\000\022r\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\000\000\000\000\000z\000\000\000\000\000~\000\130\000\000\000\000\000\000\001\241\000\000\000\134\000\138\000\142\000\000\000\000\000\000\000\n\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\000\000\182\000\000\001\241\000\000\000\186\000\000\000\190\000\194\000\000\001\241\000\000\000\000\000\000\000\000\000\198\001\241\000\202\002\254\002\174\0066\000\000\002z\000\206\000\210\000\000\000\214\002\230\001\006\000\000\000\000\000\000\002\134\000\000\000\000\000\000\000\000\001\194\001\241\000\000\000\000\001\n\001\014\001\018\003\030\001\026\001\030\000\246\000\000\000\000\002\178\000\000\000\000\000\000\003\"\000\000\001\"\006N\000\000\000\000\005=\000\000\000\000\003\026\001\174\001*\003b\000\000\001.\000\000\002\162\000\000\003r\003\242\000\000\000\000\000\000\003\246\003n\003\254\005\134\000\000\005\146\000\000\019\186\0012\0016\001:\001>\001B\000\000\000\000\000\000\001F\005\150\000\000\027r\001J\000\000\020\030\000\000\000\000\005\158\005\162\0206\005\226\001N\000\000\000\000\000\000\000\000\005\238\000\000\001R\000\000\000\000\000\000\000\000\000\000\000\000\020>\000\000\000\000\001\142\006R\000\000\000\000\005\166\000\000\000\000\001\146\000\000\001\150\004f\020R\020\142\001\154\000\000\001\158\001\162\002\254\002\174\tv\000\000\002z\017\238\000\000\000\000\002z\002\230\001\006\000\000\000\000\000\000\002\134\000\000\024\190\000\000\000\000\001\194\000\000\000\000\000\000\001\n\001\014\001\018\003\030\001\026\001\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\"\000\000\001\"\006N\000\000\000\000\000\000\000\000\000\000\003\026\001\174\001*\000\000\017\242\001.\000\000\002\162\017\238\000\000\003\242\002z\000\000\000\000\003\246\000\000\003\254\005\134\017\254\005\146\024j\000\000\0012\0016\001:\001>\001B\000\000\000\000\024f\001F\005\150\000\000\000\000\001J\000\000\000\000\000\000\000\000\005\158\005\162\000\000\005\226\001N\005\162\000\000\000\000\000\000\005\238\000\000\001R\000\000\017\242\000\000\000\000\024v\000\000\000\000\000\000\000\000\001\142\006R\000\000\000\000\005\166\000\000\017\254\001\146\024\138\001\150\004f\000\000\024*\001\154\000\000\001\158\001\162\004y\002\254\002\174\004y\000\000\002z\000\000\006\238\000\000\rE\002\230\000\000\000\000\004y\000\000\005\162\000\000\004y\000\000\004y\001\194\000\000\007\014\000\000\000\000\000\000\024\150\003\002\rE\000\000\tF\004y\000\000\000\000\000\000\000\000\000\000\004y\000\000\000\000\003\014\000\000\000\000\024*\000\000\000\000\tr\001\174\000\000\004y\rE\000\000\004y\002\162\000\000\000\000\003\242\004y\004y\011%\003\246\rE\003\254\000\000\t\130\005\146\rE\rE\000\238\000\000\000\000\000\000\000\000\004y\004y\rE\rE\005\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\158\005\162\004y\004y\r.\000\000\004y\004y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\rE\000\000\000\000\011%\nJ\000\000\011%\r6\004y\005\166\rE\000\000\001\241\011%\000\000\004f\000\006\011%\000\000\004y\002\170\002\174\001\241\002\218\002z\000\000\000\000\000\000\000\000\002\230\001\241\000\000\000\000\000\000\t\193\000\000\t\193\t\193\000\n\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\001\241\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\001\241\001\241\003\190\003\194\000\000\003\198\003\202\001\241\003\206\003\218\003\230\003\238\007\030\001\241\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\001\241\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\n\018\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\000\000\000\000\000\000\000\006\000\000\000\000\001\241\002\170\002\174\000\000\002\218\002z\000\000\005\166\b\154\t\193\002\230\001\241\b\178\004f\t\242\t\185\000\000\t\185\t\185\000\n\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\001\241\001\241\002\238\000\000\003\138\000\000\001\241\000\000\003\190\003\194\000\000\003\198\003\202\001\241\003\206\003\218\003\230\003\238\007\030\001\241\001\241\000\000\002\162\001\241\000\000\003\226\001\241\000\n\000\000\b\130\b\134\b\146\b\166\001\241\005\146\000\000\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\t\022\001\241\001\241\000\000\000\000\000\000\000\000\n\018\t:\t\222\005\158\005\162\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\001\241\001\241\000\000\001\241\001\241\001\241\000\n\000\000\000\000\001\241\000\000\007&\000\000\000\000\000\000\005\166\b\154\t\185\000\000\001\241\b\178\004f\t\242\001\241\001\241\001\241\001\241\000\n\000\000\000\000\001\241\000\000\001\241\000\000\001\241\001\241\000\000\001\241\001\241\001\241\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\001\241\001\241\001\241\000\000\000\000\001\241\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\000\000\001\241\000\n\001\241\001\241\007\"\000\000\001\241\000\000\001\241\000\000\017\166\000\000\001\241\001\241\001\241\001\241\001\241\001\241\000\000\001\241\001\241\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\001\241\000\000\000\000\001\241\001\241\000\000\001\241\001\241\001\241\001\241\000\000\000\000\001\241\001\241\000\000\000\000\005\173\001\241\001\241\001\241\005\173\001\241\005\173\005\173\000\000\005\173\000\000\005\173\005\173\001\241\001\241\005\173\017\226\005\173\005\173\005\173\005\173\005\173\005\173\005\173\005\173\000\000\005\173\000\000\005\173\000\000\000\000\000\000\000\000\000\000\000\000\005\173\000\000\000\000\001\241\000\000\005\173\005\173\005\173\000\000\001\241\005\173\005\173\005\173\000\000\000\000\000\000\005\173\000\000\005\173\000\000\000\000\005\173\000\000\r9\000\000\000\000\005\173\005\173\005\173\000\000\000\000\005\173\005\173\005\173\000\000\005\173\005\173\000\000\000\000\000\000\000\000\005\221\005\173\000\000\000\000\005\221\005\173\005\173\000\000\005\173\000\000\005\173\000\000\000\000\000\000\000\000\005\173\005\173\005\173\000\000\005\173\005\173\005\173\005\173\000\000\005\173\005\173\000\000\000\000\000\000\000\000\005\173\000\000\005\173\005\173\000\000\000\000\002\142\005\173\000\000\000\000\000\000\023:\005\173\000\000\000\000\000\000\005\173\000\006\005\173\005\173\000\000\002\170\002\174\005\173\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\r9\r9\000\000\000\000\000\000\003\250\000\000\000\000\001\194\000\000\000\000\000\000\002\234\005\221\003f\003j\000\000\000\000\000\000\000\000\r9\002\238\r9\003\138\000\000\000\000\000\000\003\190\003\194\005\221\003\198\003\202\005\221\003\206\003\218\003\230\003\238\007\030\007}\007}\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\004&\000\000\000\000\007}\007}\007}\000\000\000\000\000\000\t\022\000\000\000\000\000\000\007}\000\000\000\000\n\018\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007}\007}\000\000\000\000\000\000\007}\000\000\007}\007}\007}\000\000\000\000\000\000\000\000\007}\005\166\b\154\018\230\000\000\000\000\b\178\004f\t\242\011A\000\000\000\246\011A\011A\002\n\000\000\011A\007}\011A\000\000\000\000\011A\000\000\000\000\020\206\011A\011A\000\000\011A\011A\003b\011A\000\000\011A\000\000\000\000\000\000\000\000\011A\000\000\000\000\011A\020\210\000\000\000\000\000\000\000\000\000\000\020\250\011A\000\000\011A\000\000\000\000\004\026\000\000\007}\011A\011A\000\000\000\000\000\000\000\000\020\030\011A\000\000\000\000\011A\0206\000\000\011A\011A\000\000\011A\000\000\011A\011A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\142\000\000\000\000\000\000\011A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011A\011A\020R\021\162\011A\000\000\011A\005\017\000\000\000\000\000\000\000\000\005\194\000\000\000\000\000\000\r\005\012\241\000\000\011A\011A\000\000\011A\011A\021\178\011A\000\000\011A\000\000\011A\000A\011A\000\000\011A\000A\000A\r\005\000A\000A\002\022\000\000\000\000\002\026\000A\000\000\000\000\000\000\000\000\007=\002\"\000\000\000\000\000\000\000A\000\000\002&\000\000\000A\000\000\000A\000A\002.\012\241\000\000\r\005\012\241\000A\000\000\000A\000\000\000\000\000\000\000A\000A\000\000\000A\000A\000\000\000A\000A\000A\000A\000A\000\000\r\005\0022\000A\002\022\000\000\000A\002\026\000\000\000\000\000A\000A\000A\000A\002\190\000A\000\000\000\000\000\000\000\000\002&\000\000\r9\000\000\000\000\000A\002.\012\241\000\000\000\000\000\000\000\000\000A\000A\000A\000A\000A\000\000\000\000\000\000\005\225\000=\000\000\000\000\005\225\000=\000=\0026\000=\000=\0022\000\000\000\000\000\000\000=\000\000\000\000\000\000\000\000\0079\000A\000A\000\000\000\000\000=\000A\000A\000A\000=\000\000\000=\000=\000\000\000\000\000\000\000\000\000\000\000=\000\000\000=\024\230\000\000\000\000\000=\000=\000\000\000=\000=\000\000\000=\000=\000=\000=\000=\000\000\0026\000\000\000=\000\000\003b\000=\000\000\r9\r9\000=\000=\000=\000=\000\000\000=\000\000\000\000\000\000\000\000\000\000\005\225\000\000\000\000\000\000\000=\000\000\025V\r9\000\000\r9\000\000\000=\000=\000=\000=\000=\005\225\020\030\000\000\005\225\012\149\000\000\0206\005\t\012\149\012\149\000\000\012\149\012\149\000\000\000\000\025\250\026\n\012\149\000\000\000\000\000\000\000\000\007I\000=\000=\000\000\005\t\012\149\000=\000=\000=\012\149\000\000\012\149\012\149\000\000\000\000\000\000\000\000\000\000\012\149\0055\012\149\021\250\000\000\000\000\012\149\012\149\005\t\012\149\012\149\026\246\012\149\012\149\012\149\012\149\012\149\000\000\000\000\005\t\012\149\000\000\003b\012\149\005\t\002\210\000\238\012\149\012\149\012\149\012\149\000\000\012\149\005\t\005\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\149\000\000\022&\000\000\000\000\000\000\000\000\012\149\012\149\012\149\012\149\012\149\000\000\020\030\000\000\000\000\012\145\005\t\0206\000\000\012\145\012\145\000\000\012\145\012\145\000\000\000\000\005\t\022R\012\145\000\000\000\000\000\000\000\000\007E\012\149\012\149\000\000\000\000\012\145\012\149\012\149\012\149\012\145\000\000\012\145\012\145\000\000\000\000\000\000\000\000\000\000\012\145\005-\012\145\000\000\000\000\000\000\012\145\012\145\000\000\012\145\012\145\022\182\012\145\012\145\012\145\012\145\012\145\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\000\000\012\145\012\145\012\145\012\145\000\000\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\000\000\012\145\012\145\012\145\012\145\012\145\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\246\002\170\002\174\002\n\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\020\206\000\000\000\000\012\145\012\145\000\000\003b\001\194\012\145\012\145\012\145\002\234\000\000\003f\003j\000\000\000\000\000\000\020\210\000\000\002\238\000\000\003\138\000\000\020\250\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\020\030\002\162\000\000\000\000\003\226\0206\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\142\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\n\018\t:\t\222\005\158\005\162\020R\021\162\000\000\000\000\005\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\021\178\005\166\b\154\016\218\002\230\000\000\b\178\004f\t\242\000\000\000\000\016\234\000\000\000\000\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\n\018\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\019>\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\001\186\001\190\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\194\001\234\t\022\000\000\000\000\000\000\000\000\000\000\000\000\018\210\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\230\002\146\000\000\000\000\000\000\002\150\000\000\002\162\004\022\004\"\012Q\005\166\b\154\012Q\004.\012\205\b\178\004f\t\242\012\205\000\000\001\190\012\205\012Q\000\000\000\000\000\000\012Q\000\000\012Q\004\186\0042\012\205\012\205\012\205\000\000\012\205\012\205\012\205\000\000\000\000\012Q\000\000\000\000\000\000\000\000\000\000\012Q\000\000\000\000\012\205\000\000\000\000\000\000\000\000\000\000\012\205\012\205\000\000\012Q\012\205\000\000\012Q\000\000\000\000\000\000\002\146\012Q\012\205\000\000\000\000\012\205\000\000\000\000\000\000\000\000\012\205\012\205\012\205\000\000\000\000\000\000\000\000\012Q\n\202\012\205\012\205\012Q\000\000\000\000\000\000\000\000\012\205\000\000\000\000\000\000\004\194\012Q\012Q\012\205\000\000\012Q\012Q\000\000\000\000\000\000\012\205\012\205\012\205\000\000\012\205\012\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012Q\000\000\012\205\000\000\012\205\012\205\000\000\000\000\000\000\012\205\000\000\r\"\000\000\000\000\012\205\000\000\000\000\000\000\012\205\t\169\012\205\012\205\000\000\t\169\000\000\001\190\t\169\000\241\000\000\000\000\000\000\000\000\000\000\000\000\t\169\000\000\t\169\t\169\t\169\000\000\t\169\t\169\t\169\000\000\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\169\000\000\000\000\000\000\000\000\000\000\t\169\t\169\000\000\000\000\t\169\000\000\000\000\000\000\000\241\000\000\002\146\000\000\t\169\002\250\000\000\t\169\000\000\000\000\000\000\000\241\t\169\t\169\t\169\000\000\000\241\000\000\000\000\000\000\000\000\t\169\t\169\000\000\000\000\000\241\000\241\000\000\t\169\000\000\000\000\000\000\004\194\000\000\000\000\t\169\000\000\000\000\000\000\000\000\000\000\000\000\t\169\t\169\t\169\000\000\t\169\t\169\000\000\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\000\t\169\000\000\t\169\t\169\000\241\000\000\000\000\t\169\000\000\000\000\000\000\000\000\t\169\000\000\000\000\000\000\t\169\t\165\t\169\t\169\000\000\t\165\000\000\001\190\t\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\165\000\000\t\165\t\165\t\165\000\000\t\165\t\165\t\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\165\000\000\000\000\000\000\000\000\000\000\t\165\t\165\000\000\000\000\t\165\000\000\000\000\000\000\000\000\000\000\002\146\000\000\t\165\000\000\000\000\t\165\000\000\000\000\000\000\000\000\t\165\t\165\t\165\000\000\000\000\000\000\000\000\000\000\000\000\t\165\t\165\000\000\000\000\000\000\000\000\000\000\t\165\000\000\000\000\000\000\004\194\000\000\000\000\t\165\000\000\000\000\000\000\000\000\000\000\000\000\t\165\t\165\t\165\000\000\t\165\t\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\165\000\006\t\165\t\165\000\000\002\170\002\174\t\165\002\218\002z\000\000\000\000\t\165\000\000\002\230\000\000\t\165\000\000\t\165\t\165\000\000\000\000\000\000\000\000\001\194\000\000\000\000\000\000\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\017Z\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\t\174\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\t\194\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\n*\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\n\158\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\n\222\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\n\246\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011\026\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011F\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011^\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011v\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011\142\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011\166\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011\190\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011\214\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\011\238\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012\006\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012\030\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\0126\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012N\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012f\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012~\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012\150\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012\174\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012\198\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012\222\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\012\246\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\r\014\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\014z\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\014\158\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\014\194\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\014\234\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\015\014\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\0152\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\015^\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\015\130\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\015\166\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\015\194\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\016^\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\022\000\000\000\000\000\000\000\000\000\000\000\000\016r\t:\t\222\005\158\005\162\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\170\002\174\000\000\002\218\002z\000\000\000\000\000\000\000\000\002\230\000\000\000\000\000\000\000\000\000\000\005\166\b\154\000\000\000\000\001\194\b\178\004f\t\242\002\234\000\000\003f\003j\000\000\000\000\000\000\000\000\000\000\002\238\000\000\003\138\000\000\000\000\000\000\003\190\003\194\000\000\003\198\003\202\000\000\003\206\003\218\003\230\003\238\007\030\000\000\000\000\000\000\002\162\000\000\000\000\003\226\003.\007N\000\000\b\130\b\134\b\146\b\166\000\000\005\146\000\000\000\000\002\002\000\000\000\000\007>\000\000\000\000\000\000\t\022\001\194\000\000\000\000\000\000\000\000\000\000\016\142\t:\t\222\005\158\005\162\000y\000\000\000y\000y\000\000\000\000\003B\000\000\000\000\000\000\000\000\000y\000\000\000y\000y\007J\001\206\000y\000y\000y\000\000\tA\002\162\005\166\b\154\000\000\000\000\000\000\b\178\004f\t\242\000y\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000y\000\000\000\000\000\000\000\000\000\000\000y\000\000\000y\007R\000\000\000y\000\000\000\000\000\000\000\000\000y\000y\000y\000\000\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000y\000\000\000\000\000y\000\000\000\000\000\000\000\000\000\000\000\000\000y\000y\000y\000\000\000y\000y\000\000\000\000\000\000\000\000\000\000\tA\000\000\000\000\000\000\000y\000\000\012\209\000y\000\000\000\000\012\209\000y\000\000\012\209\000\000\000\000\000y\000\000\000\000\000\000\000y\004~\000y\012\209\012\209\012\209\000\000\012\209\012\209\012\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\209\000\000\000\000\000\000\000\000\000\000\012\209\012\209\000\000\000\000\012\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\209\000\000\000\000\012\209\000\000\000\000\000\000\000\000\012\209\012\209\012\209\000\000\000\000\000\000\000\000\000\000\000\000\012\209\012\209\000\000\000\000\000\000\000\000\000\000\012\209\000\000\000\000\000\000\012\209\000\000\000\000\012\209\000\000\000\000\000\000\000\000\000\000\000\000\012\209\012\209\012\209\000\000\012\209\012\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\209\000\000\012\209\012\209\000\000\000\000\000\000\012\209\000\000\000\000\011M\000\000\012\209\002\254\002\174\000\000\012\209\002z\012\209\012\209\000\000\000\000\002\230\000\000\000\000\000\000\011M\011M\000\000\011M\011M\000\000\001\194\000\000\001\186\001\190\000\000\000\000\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011M\000\000\003\014\001\194\001\234\001\214\000\000\000\000\003\026\001\174\000\000\000\000\000\000\001\226\000\000\002\162\021\226\000\000\003\242\000\000\000\000\011M\003\246\000\000\003\254\005\134\000\000\005\146\000\000\001\230\0236\000\000\022Z\000\000\002\150\000\000\002\162\004\022\004\"\005\150\000\000\000\000\011I\023F\000\000\002\254\002\174\005\158\005\162\002z\005\226\011M\000\000\011M\002\230\000\000\005\238\000\000\011I\011I\0042\011I\011I\000\000\001\194\000\000\011M\000\000\000\000\011M\011M\003\002\005\166\000\000\011M\000\000\011M\000\000\004f\000\000\011M\000\000\011I\000\000\003\014\000\000\000\000\000\000\000\000\000\000\0062\001\174\000\000\000\000\000\000\000\000\000\000\002\162\000\000\000\000\003\242\000\000\000\000\011I\003\246\000\000\003\254\005\134\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\150\000\000\000\000\003\177\000\000\000\000\000\000\003\177\005\158\005\162\003\177\005\226\011I\000\000\011I\000\000\000\000\005\238\000\000\000\000\003\177\003\177\003\177\000\000\003\177\003\177\003\177\011I\000\000\000\000\011I\011I\000\000\005\166\000\000\011I\000\000\011I\003\177\004f\000\000\011I\000\000\000\000\003\177\004v\000\000\000\000\003\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\177\000\000\000\000\003\177\000\000\000\000\000\000\000\000\003\177\003\177\003\177\000\000\000\000\000\000\000\000\000\000\000\000\003\177\003\177\000\000\000\000\000\000\000\000\000\000\003\177\000\000\000\000\000\000\003\177\000\000\000\000\003\177\000\000\000\000\000\000\000\000\000\000\000\000\003\177\003\177\003\177\000\000\003\177\003\177\000\000\001\177\000\000\000\000\000\000\001\177\000\000\000\000\001\177\003\177\000\000\003\177\003\177\000\000\000\000\000\000\003\177\000\000\001\177\001\177\001\177\003\177\001\177\001\177\001\177\003\177\000\000\003\177\003\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\177\000\000\000\000\000\000\000\000\000\000\001\177\001\177\000\000\000\000\001\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\177\000\000\000\000\001\177\000\000\000\000\000\000\000\000\001\177\001\177\001\177\000\000\000\000\000\000\000\000\000\000\000\000\001\177\001\177\000\000\000\000\000\000\000\000\000\000\001\177\000\000\000\000\000\000\001\177\000\000\000\000\001\177\000\000\000\000\000\000\000\000\000\000\000\000\001\177\001\177\001\177\000\000\001\177\001\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\177\000\000\001\177\001\177\002\254\002\174\000\000\001\177\002z\000\000\006\238\000\000\001\177\002\230\000\000\000\000\004\226\000\000\001\177\000\000\000\000\000\000\000\000\001\194\000\000\007\014\000\000\000\000\000\000\000\000\003\002\000\000\000\000\tF\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\014\000\000\000\000\000\000\000\000\000\000\tr\001\174\000\000\000\000\000\000\000\000\000\000\002\162\000\000\000\000\003\242\000\000\000\000\011%\003\246\000\000\003\254\000\000\t\130\005\146\000\000\000\000\000\000\000\000\000\000\006%\000\000\000\000\004\181\006%\000\000\005\150\006%\000\000\000\000\000\000\000\000\000\000\000\000\005\158\005\162\000\000\006%\r.\006%\000\000\006%\000\000\006%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011%\000\000\006%\011%\011%\000\000\005\166\000\000\006%\006%\011%\000\000\004f\000\000\011%\004\181\000\000\006%\000\000\000\000\006%\000\000\000\000\006%\000\000\000\000\000\000\000\000\006%\006%\006%\000\000\003\253\003\253\000\000\000\000\003\253\003\253\000\000\003\253\003\253\000\000\000\000\000\000\006%\006%\000\000\000\000\006%\003\253\003\253\003\253\003\253\003\253\003\253\003\253\003\253\000\000\006%\006%\006%\000\000\006%\006%\000\000\000\000\000\000\003\253\003\253\b\018\000\000\000\000\000\000\003\253\003\253\003\253\006%\000\000\000\000\006%\006%\000\000\005\181\005\185\000\000\003\253\003\253\000\000\003\253\003\253\000\000\006%\000\000\003\253\003\253\003\253\003\253\000\000\006\025\000\000\000\000\000\000\006\025\000\000\000\000\006\025\000\000\000\000\000\000\003\253\003\253\000\000\000\000\003\253\003\253\006\025\000\000\006\025\000\000\006\025\000\000\006\025\000\000\003\253\003\253\003\253\003\253\003\253\003\253\003\253\000\000\000\000\000\000\006\025\005\181\005\185\000\000\000\000\000\000\006\025\006\025\003\253\003\253\003\253\000\000\003\253\003\253\000\000\bN\000\000\000\000\006\025\000\000\000\000\006\025\000\000\003\253\003\253\000\000\006\025\006\025\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\025\006\025\000\000\000\000\006\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\025\006\025\006\025\000\000\006\025\006\025\000\000\000\000\000\000\n\218\000\000\000\000\014:\t\181\000\000\t\181\t\181\000\000\006\025\000\000\000\000\006\025\006\025\011B\011\138\011\162\011Z\011\186\000\000\000\000\000\000\001\186\001\190\006\025\000\000\000\000\000\000\011\210\011\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\250\000\000\012\002\001\194\001\234\001\214\000\000\000\000\000\000\000\000\000\238\000\000\000\000\001\226\000\000\000\000\000\000\000\000\000\000\n\242\011r\012\026\0122\012b\000\000\000\000\000\000\000\000\000\000\001\230\002\138\012z\000\000\000\000\002\150\000\000\002\162\004\022\004\"\000\000\012\146\000\000\000\000\004.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\006\000\000\000\000\012\242\002\134\r\n\012J\000\000\0042\000\000\000\000\t\181\012\170\001\n\001\014\001\018\001\022\001\026\001\030\000\000\012\194\012\218\001\186\002v\000\000\000\000\002z\000\000\001\"\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\001.\001\194\001\234\001\214\002~\004b\000\000\004f\000\000\000\000\000\000\001\226\000\000\000\000\000\000\000\000\000\000\0012\0016\001:\001>\001B\000\000\000\000\000\000\001F\000\000\002\130\002\138\001J\000\000\000\000\002\150\000\000\002\162\004\022\004\"\000\000\001N\000\000\t\025\024\022\000\000\024\026\t\025\001R\000\000\t\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\142\029\230\t\025\0042\t\025\000\000\t\025\001\146\t\025\001\150\000\000\000\000\005\162\001\154\000\000\001\158\001\162\000\000\000\000\000\000\t\025\000\000\000\000\024&\000\000\000\000\t\025\t\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\025\000\000\024*\t\025\000\000\000\000\000\000\000\000\t\025\t\025\t\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\025\000\000\000\000\000\000\t\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\025\t\025\t\025\000\000\t\025\t\025\r\133\000\000\000\000\000\000\r\133\000\000\000\000\r\133\000\000\t\025\000\000\000\000\t\025\000\000\001\186\001\190\t\025\r\133\000\000\r\133\000\000\r\133\000\000\r\133\000\000\004\226\000\000\t\025\000\000\000\000\000\000\000\000\000\000\001\194\001\234\r\133\000\000\000\000\000\000\000\000\000\000\r\133\r\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\r\133\000\000\000\000\r\133\000\000\000\000\001\230\002\146\r\133\r\133\r\133\002\150\r\137\002\162\004\022\004\"\r\137\000\000\000\000\r\137\004.\000\000\018\n\000\000\r\133\000\000\000\000\000\000\r\133\r\137\000\000\r\137\000\000\r\137\000\000\r\137\000\000\0042\r\133\r\133\r\133\000\000\r\133\r\133\000\000\000\000\000\000\r\137\000\000\004F\000\000\000\000\000\000\r\137\r\137\000\000\r\133\000\000\000\000\000\000\r\133\000\000\004:\000\000\000\000\r\137\000\000\000\000\r\137\000\000\000\000\r\133\000\000\r\137\r\137\r\137\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\137\000\000\000\000\000\000\r\137\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\137\r\137\r\137\000\000\r\137\r\137\002\254\002\174\000\000\000\000\002z\004F\006\238\000\000\000\000\002\230\000\000\000\000\r\137\000\000\000\000\000\000\r\137\000\000\000\000\001\194\000\000\007\014\000\000\000\000\000\000\000\000\003\002\r\137\000\000\tF\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\157\000\000\003\014\000\000\000\000\000\000\000\000\000\000\tr\001\174\000\000\000\000\007y\007y\000\000\002\162\000\000\000\000\003\242\000\000\000\000\000\000\003\246\000\000\003\254\000\000\t\130\005\146\000\000\000\000\000\000\007y\007y\007y\000\000\000\000\000\000\000\000\000\000\005\150\000\000\007y\001\161\000\000\001\190\001\161\000\000\005\158\005\162\000\000\000\000\003\157\000\000\t\129\000\000\001\161\000\000\007y\007y\001\161\000\000\001\161\007y\000\000\007y\007y\007y\003\157\000\000\000\000\003\157\007y\005\166\001\161\000\000\000\000\000\000\000\000\004f\001\161\001\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007y\002\146\000\000\001\161\000\000\000\000\001\161\000\000\000\000\000\000\000\000\001\161\001\161\001\161\000\000\000\000\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\178\000\000\000\000\000\000\001\161\001\161\000\000\000\000\004\194\000\000\003^\000\000\000\000\000\000\005\029\000\000\003b\000\000\001\161\001\161\000\000\005\026\001\161\001\161\003\225\000\000\001\190\003\225\003n\000\000\000\000\000\000\000\000\001\161\019\186\t}\000\000\003\225\000\000\000\000\001\161\003\225\000\000\003\225\000\000\001\161\027r\000\000\000\000\020\030\000\000\001\161\000\000\000\000\0206\003\225\000\000\000\000\000\000\000\000\000\000\003\225\001\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020>\002\146\000\000\003\225\000\000\000\000\003\225\000\000\000\000\000\000\000\000\003\225\003\225\003\225\020R\020\142\000\000\000\000\005\029\005\029\004\225\000\000\000\000\004\225\000\000\000\000\000\000\003\225\003\225\000\000\000\000\004\194\000\000\004\225\000\000\000\000\024\190\004\225\000\000\004\225\000\000\003\225\003\225\000\000\000\000\003\225\003\225\003\221\000\000\001\190\003\221\004\225\000\000\000\000\000\000\000\000\003\225\004\225\t}\000\000\003\221\000\000\000\000\003\225\003\221\000\000\003\221\000\000\003\225\004\225\000\000\000\000\004\225\000\000\003\225\000\000\000\000\004\225\003\221\000\000\000\000\000\000\000\000\000\000\003\221\001\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\225\002\146\000\000\003\221\004\225\000\000\003\221\000\000\000\000\000\000\000\000\003\221\003\221\003\221\004\225\004\225\000\000\000\000\004\225\004\225\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\221\003\221\000\000\000\000\004\194\000\000\000\000\000\000\005\t\004\225\000\000\005\t\000\000\000\000\003\221\003\221\000\000\000\000\003\221\003\221\019\246\005\t\000\000\000\000\000\000\005\t\000\000\005\t\000\000\003\221\000\000\000\246\001\186\001\190\002\n\000\000\003\221\000\000\000\000\005\t\000\000\003\221\000\000\000\000\020\206\005\t\000\000\003\221\005\017\000\000\003b\001\194\001\234\001\214\004:\000\000\000\000\005\t\000\000\000\000\005\t\001\226\020\210\000\000\000\000\005\t\002\210\000\000\020\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\230\002\138\000\000\000\000\005\t\002\150\020\030\002\162\004\022\004\"\000\000\0206\000\000\000\153\004.\000\000\000\153\000\000\005\t\005\t\000\000\000\000\005\t\005\t\000\000\000\000\000\153\021\142\000\153\004F\000\153\0042\000\153\000\000\000\000\000\000\000\221\000\000\000\000\000\221\005\t\020R\021\162\000\000\000\153\024>\000\000\000\000\000\000\000\221\000\153\000\221\000\000\000\221\000\153\000\221\000\000\000\000\000\000\000\000\000\000\000\000\000\153\021\178\000\000\000\153\000\000\000\221\000\000\000\000\000\153\000\153\000\238\000\221\000\000\000\000\000\000\000\221\000\000\000\153\000\153\000\000\000\000\000\000\000\000\000\221\000\153\000\000\000\221\000\000\000\153\000\000\000\000\000\221\000\221\000\238\000\000\000\000\000\000\000\000\000\153\000\153\000\221\000\221\000\153\000\153\000\000\000\000\000\000\000\221\000\000\000\000\000\000\000\221\000\000\000\153\000\000\000\000\000\000\000\000\000\000\000\153\000\153\000\221\000\221\000\000\000\000\000\221\000\221\000\000\000\000\000\153\000\000\000\153\000\161\000\000\000\000\000\161\000\221\000\000\000\000\000\000\000\000\000\000\000\221\000\221\000\000\000\161\000\000\000\161\000\000\000\161\000\000\000\161\000\221\000\000\000\221\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\157\000\161\000\157\000\000\000\157\000\161\000\157\000\000\000\000\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\161\000\000\000\157\000\000\000\000\000\161\000\161\000\238\000\157\000\000\000\000\000\000\000\157\000\000\000\161\000\161\000\000\000\000\000\000\000\000\000\157\000\161\000\000\000\157\000\000\000\161\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\161\000\161\000\157\000\157\000\161\000\161\000\000\000\000\000\000\000\157\000\000\000\000\000\000\000\157\000\000\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\161\000\157\000\157\000\000\000\000\000\157\000\157\000\000\000\000\000\161\000\000\000\161\001\006\000\000\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\001\n\001\014\001\018\001\022\001\026\001\030\000\000\000\157\000\000\000\157\000\000\000\000\000\000\000\000\000\000\001\"\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0012\0016\001:\001>\001B\000\000\000\000\000\000\001F\000\000\000\000\000\000\001J\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001N\000\000\000\000\001}\000\000\000\000\001}\001R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001}\001\142\030\002\000\000\001}\000\000\001}\000\000\001\146\000\000\001\150\000\000\000\000\000\000\001\154\000\000\001\158\001\162\001}\001}\000\000\000\000\000\000\000\000\001}\000\000\000\000\000\000\000\000\000\000\000\000\r\129\000\000\005\181\000\000\r\129\001}\000\000\r\129\001}\000\000\000\000\000\000\000\000\001}\001}\001}\000\000\r\129\000\000\r\129\000\000\r\129\000\000\r\129\000\000\000\000\000\000\000\000\000\000\001}\000\000\000\000\000\000\001}\000\000\r\129\000\000\000\000\000\000\000\000\000\000\r\129\r\129\001}\001}\000\000\000\000\001}\001}\000\000\000\000\000\000\000\000\r\129\005\181\000\000\r\129\000\000\001}\000\000\000\000\r\129\r\129\r\129\001}\001}\000\000\000\000\000\000\000\000\001}\000\000\000\000\000\000\000\000\000\000\001}\r\129\000\000\000\000\000\000\r\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\129\r\129\r\129\000\000\r\129\r\129\r}\000\000\000\000\000\000\r}\000\000\000\000\r}\000\000\000\000\000\000\000\000\r\129\000\000\000\000\000\000\r\129\r}\000\000\r}\000\000\r}\000\000\r}\000\000\004\226\000\000\r\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r}\000\000\000\000\000\000\000\000\000\000\r}\r}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r}\000\000\000\000\r}\000\000\000\000\000\000\000\000\r}\r}\r}\000\000\000\000\t\029\000\000\000\000\000\000\t\029\000\000\000\000\t\029\000\000\000\000\000\000\r}\000\000\000\000\000\000\r}\000\000\t\029\000\000\t\029\000\000\t\029\000\000\t\029\000\000\r}\r}\r}\000\000\r}\r}\000\000\000\000\000\000\000\000\t\029\000\000\000\000\000\000\000\000\007\158\t\029\t\029\r}\000\000\000\000\000\000\r}\000\000\000\000\000\000\000\000\000\000\t\029\000\000\000\000\t\029\n\218\r}\000\000\007\169\t\029\t\029\000\238\007\169\000\000\000\000\000\000\000\000\000\000\000\000\011B\011\138\011\162\011Z\011\186\000\000\t\029\000\000\000\000\000\000\t\029\000\000\000\000\000\000\011\210\011\234\000\000\000\000\000\000\000\000\t\029\t\029\t\029\000\000\t\029\t\029\012\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\t\029\000\000\000\000\t\029\000\000\000\000\000\000\t\029\n\242\011r\012\026\0122\012b\000\000\000\000\000\000\000\000\000\000\t\029\007\169\012z\001\157\000\000\001\190\001\157\000\000\000\000\000\000\000\000\012\146\000\000\000\000\t}\000\000\001\157\000\000\000\000\000\000\001\157\000\000\001\157\000\000\000\000\000\000\012\242\000\000\r\n\012J\000\000\000\000\000\000\000\000\001\157\012\170\000\000\000\000\000\000\000\000\001\157\000\000\000\000\012\194\012\218\000\000\000\000\000\000\000\000\000\000\002\146\000\000\001\157\000\000\000\000\001\157\000\000\000\000\000\000\000\000\001\157\001\157\001\157\000\000\000\000\000\000\000\000\000\000\n\218\000\000\000\000\000\000\019z\000\000\000\000\000\000\001\157\001\157\000\000\000\000\004\194\000\000\011B\011\138\011\162\011Z\011\186\000\000\000\000\000\000\001\157\001\157\000\000\000\000\001\157\001\157\011\210\011\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\157\000\000\000\000\012\002\000\000\000\000\000\000\001\157\000\000\000\000\000\000\000\238\001\157\000\000\000\000\000\000\000\000\000\000\001\157\000\000\n\242\011r\012\026\0122\012b\000\000\006Q\000\000\000\000\000\000\006Q\000\000\012z\006Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\146\000\000\006Q\000\000\006Q\000\000\006Q\000\000\006Q\000\000\000\000\000\000\000\000\000\000\000\000\012\242\019~\r\n\012J\019\138\006Q\000\000\000\000\b=\012\170\000\000\006Q\006Q\000\000\000\000\000\000\000\000\012\194\012\218\000\000\bN\000\000\000\000\006Q\b=\b=\006Q\b=\b=\000\000\000\000\006Q\006Q\000\238\000\000\000\000\002\170\002\174\000\000\000\000\002z\000\000\000\000\000\000\000\000\002\230\000\000\006Q\b=\000\000\006\249\006Q\000\000\000\000\000\000\001\194\000\000\000\000\000\000\002\234\000\000\006Q\006Q\006Q\000\000\006Q\006Q\000\000\002\238\b=\003\138\000\000\000\000\000\000\000\000\000\000\000\000\003\198\003\202\006Q\000\000\003\218\001\174\006Q\000\000\001\186\001\190\000\000\002\162\000\000\000\000\003\226\000\000\000\000\006Q\b\130\b\134\b\146\000\000\b=\005\146\b=\000\000\000\000\001\194\001\234\007r\000\000\000\000\000\000\006I\000\000\000\000\006I\006\026\000\000\000\000\b=\b=\000\000\005\158\005\162\b=\006I\b=\006I\000\000\006I\b=\006I\001\230\002\154\000\000\000\000\000\000\002\150\000\000\002\162\004\022\004\"\000\000\006I\000\000\000\000\004.\005\166\b\154\006I\007\238\000\000\b\178\004f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006I\000\000\0042\006I\000\000\028\214\000\000\000\000\006I\006I\000\238\000\000\r\141\000\000\000\000\000\000\r\141\000\000\000\000\r\141\000\000\000\000\028\194\000\000\006I\000\000\000\000\000\000\006I\r\141\000\000\r\141\000\000\r\141\000\000\r\141\000\000\000\000\006I\006I\006I\000\000\006I\006I\000\000\000\000\000\000\r\141\000\000\000\000\000\000\000\000\000\000\r\141\r\141\000\000\006I\000\000\000\000\000\000\006I\000\000\000\000\000\000\000\000\r\141\000\000\000\000\r\141\000\000\000\000\006I\000\000\r\141\r\141\000\238\000\000\007r\000\000\000\000\000\000\006M\000\000\000\000\006M\000\000\000\000\000\000\000\000\r\141\000\000\000\000\000\000\r\141\006M\000\000\006M\000\000\006M\000\000\006M\000\000\000\000\r\141\r\141\r\141\000\000\r\141\r\141\000\000\000\000\000\000\006M\000\000\000\000\000\000\000\000\000\000\006M\007\238\000\000\r\141\000\000\000\000\000\000\r\141\000\000\000\000\000\000\000\000\006M\000\000\000\000\006M\000\000\000\000\r\141\000\000\006M\006M\000\238\000\000\007r\000\000\000\000\000\000\006a\000\000\000\000\006a\000\000\000\000\000\000\000\000\006M\000\000\000\000\000\000\006M\006a\000\000\006a\000\000\006a\000\000\006a\000\000\000\000\006M\006M\006M\000\000\006M\006M\000\000\000\000\000\000\006a\000\000\000\000\000\000\000\000\000\000\006a\007\238\000\000\006M\000\000\000\000\000\000\006M\000\000\000\000\000\000\000\000\006a\000\000\000\000\006a\000\000\000\000\006M\000\000\006a\006a\000\238\000\000\r\145\000\000\000\000\000\000\r\145\000\000\000\000\r\145\000\000\000\000\000\000\000\000\006a\000\000\000\000\000\000\006a\r\145\000\000\r\145\000\000\r\145\000\000\r\145\000\000\000\000\006a\006a\006a\000\000\006a\006a\000\000\000\000\000\000\r\145\000\000\000\000\000\000\000\000\000\000\r\145\007\238\000\000\006a\000\000\000\000\000\000\006a\000\000\000\000\000\000\000\000\r\145\000\000\000\000\r\145\000\000\000\000\006a\000\000\r\145\r\145\000\238\000\000\006e\000\000\000\000\000\000\006e\000\000\000\000\006e\000\000\000\000\000\000\000\000\r\145\000\000\000\000\000\000\r\145\006e\000\000\006e\000\000\006e\000\000\006e\000\000\000\000\r\145\r\145\r\145\000\000\r\145\r\145\000\000\000\000\000\000\006e\000\000\000\000\000\000\000\000\000\000\006e\006e\000\000\r\145\000\000\000\000\000\000\r\145\000\000\000\000\000\000\000\000\006e\000\000\000\000\006e\000\000\000\000\r\145\000\000\006e\006e\006e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\000\000\000\000\001\241\000\000\006e\000\000\000\000\001\241\006e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\241\006e\006e\006e\000\000\006e\006e\001\241\000\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006e\001\241\000\000\000\000\006e\000\000\000\000\001\241\001\241\000\000\000\000\000\000\000\000\000\000\001\241\b&\000\000\001\241\000\000\000\000\001\241\001\241\000\000\001\241\001\241\000\000\001\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\241\000\000\000\000\000\000\000\000\000\000\002\170\002\174\001\241\001\241\002z\001\241\000\000\000\000\000\000\002\230\000\000\001\241\000\000\000\000\007!\000\000\000\000\000\000\000\000\001\194\000\000\000\000\000\000\002\234\000\000\000\000\000\000\001\241\000\000\000\000\000\000\001\241\002\238\001\241\003\138\000\000\000\000\000\000\000\000\000\000\000\000\003\198\003\202\000\000\000\000\003\218\001\174\000\000\000\000\000\000\000\000\000\000\002\162\000\000\000\000\003\226\000\000\000\000\000\000\b\130\b\134\b\146\000\000\000\000\005\146\000\000\000\000\000\000\000\000\003\217\000\000\001\190\003\217\000\000\000\000\000\000\000\000\000\000\000\000\001\186\001\190\000\000\003\217\000\000\005\158\005\162\003\217\000\000\003\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\194\001\198\003\217\000\000\000\000\000\000\000\000\000\000\003\217\000\000\000\000\005\166\b\154\000\000\000\000\000\000\b\178\004f\002\146\003\213\003\217\001\190\003\213\003\217\000\000\000\000\001\230\002\146\003\217\003\217\003\217\002\150\003\213\002\162\004\022\004\"\003\213\000\000\003\213\000\000\004.\000\000\018\n\000\000\003\217\003\217\000\000\000\000\004\194\000\000\003\213\000\000\000\000\000\000\000\000\000\000\003\213\0042\003\217\003\217\000\000\000\000\003\217\003\217\000\000\000\000\002\146\000\000\003\213\000\000\000\000\003\213\000\000\003\217\000\000\000\000\003\213\003\213\003\213\000\000\003\217\000\000\000\000\000\000\000\000\003\217\001-\000\000\000\000\001-\000\000\003\217\003\213\003\213\000\000\000\000\004\194\000\000\000\000\001-\000\000\001-\000\000\001-\000\000\001-\003\213\003\213\000\000\000\000\003\213\003\213\000\000\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\003\213\000\000\001-\000\000\000\000\000\000\001-\003\213\012\225\000\000\000\000\012\225\003\213\000\000\001-\000\000\000\000\001-\003\213\000\000\000\000\012\225\001-\001-\000\238\012\225\000\000\012\225\000\000\000\000\000\000\001)\001-\005\173\001)\000\000\000\000\000\000\001-\012\225\000\000\000\000\001-\000\000\001)\012\225\001)\000\000\001)\000\000\001)\000\000\001-\001-\001-\000\000\001-\001-\000\000\000\000\012\225\000\000\001)\000\000\000\000\012\225\012\225\001-\001)\000\000\000\000\000\000\001)\000\000\001-\000\000\000\000\000\000\000\000\000\000\001)\012\225\000\000\001)\000\000\001-\000\000\000\000\001)\001)\000\238\000\000\000\000\000\000\000\000\012\225\012\225\002r\001)\012\225\012\225\000\000\000\000\000\000\001)\000\000\000\000\000\000\001)\000\000\012\225\000\000\000\000\000\000\0292\000\000\000\000\012\225\001)\001)\001)\000\000\001)\001)\001Y\000\000\012\233\001Y\012\225\000\000\000\000\000\000\000\000\001)\000\000\012\233\000\000\001Y\000\000\001Y\001)\001Y\000\000\001Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\001Y\000\000\000\000\000\000\000\000\000\000\001Y\012\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\233\000\000\000\000\000\000\000\000\001Y\000\000\000\000\000\000\000\000\001Y\001Y\001Y\000\000\000\000\000\000\000\000\000\000\001\029\000\000\002\t\001\029\000\000\000\000\000\000\000\000\001Y\000\000\000\000\002\t\012\233\001\029\000\000\001\029\000\000\001\029\000\000\001\029\000\000\000\000\001Y\001Y\001Y\000\000\001Y\001Y\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\029\002\t\000\000\000\000\000\000\000\000\000\000\001Y\000\000\000\000\002\t\001\169\000\000\017\238\001\169\001\029\002z\000\000\001Y\000\000\001\029\001\029\001\029\000\000\001\169\000\000\000\000\000\000\001\169\000\000\001\169\000\000\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\002\t\000\000\001\169\000\000\000\000\000\000\000\000\000\000\001\169\000\000\001\029\001\029\001\029\000\000\001\029\001\029\000\000\017\242\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\000\000\000\001\169\001\169\000\000\017\254\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\029\001\169\000\000\000\000\000\000\001\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\162\001\169\001\169\002\254\002\174\001\169\001\169\002z\000\000\006\238\000\000\000\000\002\230\000\000\000\000\000\000\001\169\005\222\000\000\t\221\000\000\000\000\001\194\001\169\007\014\000\000\000\000\000\000\000\000\003\002\000\000\000\000\tF\000\000\001\169\000\000\000\000\000\000\000\000\000\000\026f\000\000\003\014\000\000\000\000\000\000\000\000\000\000\003\026\001\174\000\000\000\000\001\186\001\190\r:\002\162\000\000\000\000\003\242\000\000\000\000\000\000\003\246\000\000\003\254\005\134\t\130\005\146\000\000\000\000\000\000\001\194\001\198\001\214\002\254\002\174\000\000\000\000\002z\005\150\006\238\001\226\000\000\002\230\000\000\000\000\000\000\005\158\005\162\000\000\005\226\024\214\000\000\001\194\000\000\007\014\005\238\001\230\002\138\000\000\003\002\000\000\002\150\tF\002\162\004\022\004\"\000\000\000\000\006\146\027&\004.\005\166\003\014\t\221\000\000\t.\000\000\004f\tr\001\174\000\000\000\000\000\000\000\000\000\000\002\162\000\000\0042\003\242\000\000\000\000\000\000\003\246\000\000\003\254\000\000\t\130\005\146\000\000\000\000\000\000\000\000\000\000\000\000\002\254\002\174\000\000\000\000\002z\005\150\006\238\000\000\000\000\002\230\000\000\000\000\000\000\005\158\005\162\000\000\000\000\r.\000\000\001\194\000\000\007\014\000\000\000\000\000\000\000\000\003\002\000\000\000\000\tF\000\000\000\000\000\000\007r\000\000\000\000\025n\005\t\005\166\003\014\005\t\000\000\000\000\000\000\004f\tr\001\174\000\000\000\000\000\000\005\t\000\000\002\162\000\000\005\t\003\242\005\t\000\000\000\000\003\246\000\000\003\254\000\000\t\130\005\146\000\000\000\000\000\000\005\t\000\000\000\000\000\000\000\000\000\000\005\t\007\238\005\150\000\000\005\t\000\000\000\000\000\000\000\000\bN\005\158\005\162\005\t\000\000\r.\005\t\000\000\000\000\000\000\000\000\005\t\002\210\000\238\000\000\000\000\000\000\000\000\000\000\000\000\005\t\005\t\000\000\000\000\025\206\000\000\005\166\005\t\005\t\000\000\b\169\005\t\004f\b\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\t\005\t\b\169\000\000\005\t\005\t\b\169\000\000\b\169\000\000\000\000\b\018\000\000\000\000\000\000\005\t\000\000\000\000\000\000\000\000\b\169\000\000\005\t\000\000\000\000\000\000\b\169\028>\000\000\000\000\b\169\000\000\000\000\005\t\000\000\000\000\000\000\000\000\b\169\000\000\000\000\b\169\000\000\000\000\000\000\000\000\b\169\b\169\000\238\000\000\000\000\b\165\000\000\000\000\b\165\b\169\b\169\000\000\000\000\000\000\000\000\000\000\b\169\000\000\b\165\000\000\b\169\000\000\b\165\000\000\b\165\000\000\000\000\000\000\000\000\000\000\b\169\b\169\b\169\000\000\b\169\b\169\b\165\000\000\000\000\000\000\000\000\000\000\b\165\000\000\000\000\b\169\b\165\000\000\000\000\000\000\000\000\000\000\b\169\000\000\b\165\000\000\000\000\b\165\000\000\000\000\000\000\000\000\b\165\b\165\000\238\000\000\000\000\003\205\000\000\000\000\003\205\b\165\b\165\000\000\000\000\000\000\000\000\000\000\b\165\000\000\003\205\000\000\b\165\000\000\003\205\000\000\003\205\000\000\000\000\000\000\000\000\000\000\b\165\b\165\b\165\000\000\b\165\b\165\003\205\018\006\000\000\000\000\000\000\000\000\003\205\000\000\000\000\b\165\000\000\000\000\000\000\000\000\000\000\000\000\b\165\000\000\003\205\000\000\000\000\003\205\000\000\000\000\000\000\000\000\003\205\003\205\003\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\241\004\241\000\000\000\000\004\241\000\000\003\205\000\000\000\000\004\241\003\205\000\000\000\000\000\000\000\000\004\241\000\000\000\000\000\000\004\241\003\205\003\205\028F\000\000\003\205\003\205\004\241\026\030\000\000\000\000\0266\000\000\000\000\000\000\000\000\003\205\000\000\000\000\000\000\004\241\000\000\018f\003\205\000\000\000\000\004\241\004\241\003\205\000\000\000\000\000\000\000\000\004\241\003\205\000\000\004\241\000\000\000\000\000\238\004\241\000\000\004\241\004\241\000\000\004\241\000\000\000\000\000\000\002\254\002\174\000\000\000\000\002z\000\000\000\000\000\000\004\241\002\230\000\000\000\000\000\000\000\000\006\253\000\000\004\241\004\241\000\000\001\194\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\014\000\000\004\241\000\000\000\000\000\000\003\026\001\174\004\241\000\000\000\000\000\000\000\000\002\162\000\000\000\000\003\242\000\000\000\000\000\000\003\246\000\000\003\254\005\134\000\000\005\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\254\002\174\000\000\005\150\002z\000\000\000\000\000\000\000\000\002\230\000\000\005\158\005\162\000\000\005\226\000\000\003\250\000\000\000\000\001\194\005\238\000\000\000\000\000\000\000\000\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\166\000\000\006\222\003\014\000\000\000\000\004f\000\000\000\000\003\026\001\174\000\000\000\000\002\254\002\174\000\000\002\162\002z\000\000\003\242\000\000\000\000\002\230\003\246\000\000\003\254\005\134\000\000\005\146\006\166\000\000\000\000\001\194\000\000\000\000\000\000\000\000\000\000\000\000\003\002\005\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\158\005\162\003\205\005\226\003\014\003\205\000\000\000\000\000\000\005\238\003\026\001\174\000\000\000\000\000\000\003\205\000\000\002\162\000\000\003\205\003\242\003\205\000\000\000\000\003\246\005\166\003\254\005\134\000\000\005\146\000\000\004f\000\000\003\205\018\006\000\000\000\000\000\000\000\000\003\205\000\000\005\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\158\005\162\003\205\005\226\000\000\003\205\000\000\000\000\000\000\005\238\003\205\003\205\003\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\166\003\205\000\000\000\000\000\000\003\205\004f\000\000\012\225\000\000\000\000\012\225\000\000\000\000\000\000\003\205\003\205\028v\000\000\003\205\003\205\012\225\000\000\000\000\000\000\012\225\000\000\012\225\000\000\000\000\000\000\006\001\000\000\005\173\006\001\000\000\018f\003\205\000\000\012\225\000\000\000\000\003\205\000\000\006\001\012\225\000\000\000\000\006\001\000\000\006\001\000\000\000\000\000\000\000\000\000\000\000\000\012\225\000\000\000\000\012\225\000\000\006\001\000\000\000\000\012\225\012\225\000\000\006\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bN\000\000\000\000\006\001\012\225\000\000\006\001\000\000\012\225\000\000\000\000\006\001\006\001\000\238\000\000\000\000\000\000\000\000\012\225\012\225\002r\000\000\012\225\012\225\000\000\000\000\000\000\006\001\006\001\000\000\000\000\006\001\000\000\012\225\000\000\006\005\000\000\029j\006\005\000\000\012\225\006\001\006\001\000\000\000\000\006\001\006\001\000\000\006\005\000\000\000\000\012\225\006\005\000\000\006\005\000\000\000\000\000\000\003\205\000\000\000\000\003\205\000\000\006\001\000\000\000\000\006\005\000\000\000\000\000\000\000\000\003\205\006\005\000\000\006\001\003\205\000\000\003\205\000\000\000\000\000\000\bN\000\000\000\000\006\005\000\000\000\000\006\005\000\000\003\205\018\006\000\000\006\005\006\005\000\238\003\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\205\006\005\006\005\003\205\006\169\006\005\000\000\006\169\003\205\003\205\003\205\000\000\000\000\000\000\000\000\006\005\006\005\006\169\000\000\006\005\006\005\006\169\000\000\006\169\003\205\000\000\000\000\000\000\003\205\000\000\000\000\000\000\000\000\000\000\000\000\006\169\000\000\006\005\003\205\003\205\020\158\006\169\003\205\003\205\000\000\000\000\000\000\000\000\006\005\000\000\000\000\000\000\000\000\006\169\000\000\000\000\006\169\000\000\000\000\018f\003\205\006\169\006\169\000\238\000\000\000\000\000\000\000\000\000\000\000\000\012\161\000\000\002\174\012\161\000\000\030\218\000\000\006\169\000\000\000\000\030\222\006\169\000\000\012\161\000\000\000\000\000\000\000\000\000\000\012\161\000\000\006\169\006\169\024b\000\000\006\169\006\169\000\000\000\000\000\000\000\000\012\161\000\000\000\000\000\000\000\000\006\169\012\161\000\000\000\000\000\000\000\000\000\000\006\169\b\217\b\217\001\002\001\174\b\217\012\161\000\000\000\000\012\161\b\217\006\169\000\000\000\000\012\161\000\000\018\174\000\000\000\000\000\000\b\217\000\000\030\226\000\000\000\000\000\000\000\000\b\217\000\000\000\000\012\161\000\000\000\000\000\000\012\161\000\000\000\000\000\000\000\000\000\000\b\217\000\000\000\000\030\230\012\161\012\161\b\217\b\217\012\161\000\000\000\000\000\000\000\000\b\217\000\000\000\000\b\217\000\000\000\000\000\000\b\217\000\000\b\217\b\217\000\000\b\217\012\161\007r\000\000\000\000\000\000\007\181\000\000\000\000\007\181\000\000\000\000\b\217\000\000\000\000\000\000\000\000\000\000\000\000\007\181\b\217\b\217\000\000\007\181\000\000\007\181\000\000\000\000\000\000\001\173\000\000\000\000\001\173\000\000\000\000\000\000\000\000\007\181\000\000\000\000\000\000\000\000\001\173\007\181\007\238\b\217\001\173\000\000\001\173\000\000\000\000\b\217\000\000\000\000\000\000\007\181\000\000\000\000\007\181\000\000\001\173\000\000\000\000\007\181\007\181\000\238\001\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\173\007\181\000\000\001\173\000\000\007\181\000\000\000\000\001\173\001\173\006\173\000\000\000\000\006\173\000\000\007\181\007\181\000\000\000\000\007\181\007\181\000\000\000\000\006\173\001\173\000\000\000\000\006\173\001\173\006\173\000\000\000\000\000\000\005\t\000\000\000\000\005\t\007\181\001\173\001\173\000\000\006\173\001\173\001\173\000\000\000\000\005\t\006\173\000\000\000\000\005\t\000\000\005\t\001\173\000\000\000\000\000\000\000\000\000\000\006\173\001\173\000\000\006\173\000\000\005\t\024>\000\000\006\173\006\173\000\238\005\t\001\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\t\006\173\000\000\005\t\000\000\006\173\000\000\000\000\005\t\002\210\001E\000\000\000\000\001E\000\000\006\173\006\173\000\000\000\000\006\173\006\173\000\000\000\000\001E\005\t\001E\000\000\001E\005\t\001E\006\173\000\000\000\000\000\209\000\000\000\000\000\209\006\173\005\t\005\t\000\000\001E\005\t\005\t\000\000\000\000\000\209\001E\006\173\000\000\000\209\000\000\000\209\007\158\000\000\000\000\000\000\000\000\000\000\000\000\005\t\000\000\001E\000\000\000\209\000\000\000\000\001E\001E\000\238\000\209\005\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\209\001E\000\000\000\209\000\000\000\000\000\000\000\000\000\209\000\209\000\238\000\000\000\000\000\000\000\000\001E\001E\001E\000\000\001E\001E\000\000\000\000\000\000\000\209\000\000\000\000\000\213\000\209\000\000\000\213\000\000\000\000\000\000\000\000\000\000\000\000\001E\000\209\000\209\000\213\000\000\000\209\000\209\000\213\000\000\000\213\000\000\001E\001\186\002v\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\213\000\000\000\209\000\000\000\000\000\000\000\213\000\000\000\000\000\000\001\194\001\234\001\214\000\209\000\000\000\000\000\000\000\000\000\213\000\000\001\226\000\213\000\000\000\000\000\000\000\000\000\213\000\213\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\002\138\000\000\000\000\000\000\002\150\000\213\002\162\004\022\004\"\000\213\000\000\000\000\000\000\024\022\007\177\029\022\000\000\007\177\000\000\000\213\000\213\000\000\000\000\000\213\000\213\000\000\000\000\007\177\000\000\000\000\0042\007\177\000\000\007\177\000\000\000\000\000\000\000\000\000\000\005\162\000\000\000\213\000\000\000\000\000\000\007\177\000\000\000\000\000\000\000\000\029\"\007\177\000\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\177\000\000\000\000\007\177\024*\000\000\000\000\000\000\007\177\007\177\006\161\000\000\000\000\006\161\007r\000\000\000\000\000\000\006\r\000\000\020z\006\r\000\000\006\161\007\177\000\000\000\000\006\161\007\177\006\161\000\000\006\r\000\000\000\000\000\000\006\r\000\000\006\r\007\177\007\177\019\206\006\161\007\177\007\177\000\000\000\000\000\000\006\161\000\000\006\r\000\000\000\000\000\000\000\000\000\000\006\r\007\238\021\014\000\000\006\161\007\177\000\000\006\161\000\000\000\000\000\000\000\000\006\161\006\161\000\000\006\r\000\000\000\000\000\000\000\000\006\r\006\r\000\238\000\000\000\000\000\000\000\000\000\000\006\161\000\000\000\000\000\000\006\161\000\000\000\000\000\000\006\r\000\000\000\000\000\000\000\000\000\000\006\161\006\161\000\000\000\000\006\161\006\161\000\000\004\217\006\r\006\r\004\217\000\000\006\r\006\r\004\249\000\000\000\000\004\249\000\000\000\000\004\217\000\000\006\161\000\000\004\217\000\000\004\217\004\249\000\000\000\000\006\r\004\249\000\000\004\249\000\000\000\000\000\000\000\000\004\217\000\000\000\000\000\000\000\000\000\000\004\217\004\249\000\000\000\000\000\000\000\000\000\000\004\249\000\000\000\000\000\000\004\201\004\217\000\000\004\201\004\217\000\000\000\000\000\000\004\249\004\217\000\000\004\249\000\000\004\201\000\000\000\000\004\249\004\201\000\000\004\201\000\000\000\000\000\000\000\000\000\000\004\217\000\000\000\000\000\000\004\217\000\000\004\201\004\249\000\000\000\000\000\000\004\249\004\201\000\000\004\217\004\217\000\000\000\000\004\217\004\217\000\000\004\249\004\249\000\000\004\201\004\249\004\249\004\201\000\000\000\000\000\000\000\000\004\201\000\000\000\000\000\000\004\217\000\000\000\000\000\000\000\000\000\000\000\000\004\249\000\000\000\000\000\000\022\246\004\201\000\000\000\000\000\000\004\201\000\000\023\218\000\000\001\186\001\190\000\000\000\000\000\000\000\000\004\201\004\201\000\000\000\000\004\201\004\201\000\000\000\000\002\134\000\000\000\000\000\000\000\000\001\194\001\234\001\214\000\000\000\000\000\000\000\000\000\000\000\000\004\201\001\226\004\233\000\000\000\000\004\233\000\000\000\000\001\242\000\000\004\209\027F\000\000\004\209\000\000\004\233\000\000\001\230\002\138\004\233\000\000\004\233\002\150\004\209\002\162\004\022\004\"\004\209\000\000\004\209\000\000\004.\000\000\004\233\000\000\000\000\000\000\000\000\000\000\004\233\000\000\004\209\000\000\000\000\000\000\000\000\000\000\004\209\0042\000\000\000\000\000\000\000\000\000\000\004\233\005\001\000\000\000\000\005\001\004\233\000\000\000\000\004\209\000\000\000\000\000\000\000\000\004\209\005\001\000\000\000\000\000\000\005\001\000\000\005\001\004\233\000\000\000\000\017\246\000\000\000\000\000\000\000\000\004\209\000\000\000\000\005\001\000\000\000\000\004\233\004\233\000\000\005\001\004\233\004\233\000\000\012\177\004\209\004\209\012\177\000\000\004\209\004\209\000\000\bM\000\000\000\000\005\001\000\000\012\177\000\000\004\233\005\001\000\000\000\000\012\177\000\000\000\000\000\000\004\209\bM\bM\021F\bM\bM\000\000\000\000\012\177\005\001\000\000\023\130\000\000\000\000\012\177\000\000\000\000\000\000\000\000\b-\000\000\000\000\000\000\005\001\005\001\bM\012\177\005\001\005\001\012\177\000\000\000\000\000\000\000\000\012\177\b-\b-\000\000\b-\b-\000\000\bQ\000\000\000\000\000\000\005\001\000\238\000\000\000\000\000\000\012\177\000\000\000\000\bA\012\177\000\000\024\002\bQ\bQ\b-\bQ\bQ\000\000\000\000\012\177\012\177\000\000\000\000\012\177\bA\bA\000\000\bA\bA\000\000\030\202\bM\000\000\bM\000\000\b-\bQ\000\000\000\000\000\000\000\000\012\177\000\000\000\000\000\000\000\000\bM\000\000\bA\006\"\bM\000\000\000\000\000\000\bM\000\000\bM\000\238\000\000\000\000\bM\000\000\000\000\000\000\000\000\b-\000\000\b-\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b-\000\000\000\000\006\"\b-\000\000\000\000\bQ\b-\bQ\b-\000\000\000\000\000\000\b-\000\000\000\000\000\000\000\000\bA\000\000\bA\bQ\000\000\000\000\006\"\bQ\000\000\000\000\000\000\bQ\000\000\bQ\000\000\006b\000\000\bQ\006\"\bA\r\149\r\149\000\000\bA\000\000\bA\000\000\000\000\000\000\bA\000\000\000\246\000\000\000\000\002\n\000\000\000\000\000\000\000\000\r\149\r\149\r\149\007\134\000\000\020\206\000\000\000\000\000\000\005\017\r\149\003b\000\000\000\000\000\000\000\000\000\000\001\186\001\190\025r\000\000\000\000\000\000\020\210\000\000\000\000\r\149\r\149\000\000\020\250\000\000\r\149\000\000\r\149\r\149\r\149\001\194\001\198\001\214\000\000\r\149\000\000\000\000\000\000\020\030\000\000\001\226\000\000\000\000\0206\000\000\000\000\000\000\001\186\001\190\025\210\000\000\r\149\000\000\000\000\000\000\000\000\001\230\002\138\000\000\021\142\000\000\002\150\000\000\002\162\004\022\004\"\001\194\001\198\001\214\000\000\004.\000\000\000\246\020R\021\162\002\178\001\226\005\017\005\017\000\000\000\000\000\000\000\000\000\000\000\000\031\"\000\000\0042\001\186\001\190\000\000\003b\001\230\002\138\000\000\021\178\000\000\002\150\000\000\002\162\004\022\004\"\000\000\003n\000\000\000\000\004.\001\194\001\234\019\186\000\000\000\000\000\000\000\000\000\000\000\000\001\186\001\190\000\000\000\000\000\000\027r\000\000\0042\020\030\000\000\000\000\000\000\000\000\0206\000\000\000\000\000\000\001\230\002\154\001\194\001\234\000\000\002\150\000\000\002\162\004\022\004\"\000\000\000\000\020>\000\000\004.\000\000\030\210\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020R\020\142\001\230\002\154\005E\0042\000\000\002\150\005}\002\162\004\022\004\"\000\000\000\000\000\000\000\000\004.\000\000\000\000\000\000\000\000\000\000\024\190\000\000\000\000\028\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0042\000\000\000\000\005\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\028\194"))
and lhs =
- (8, "\014\r\012\011\n\t\b\007\006\005\004\003\002\001\000\232\232\231\231\230\229\229\228\228\228\228\228\228\228\228\228\228\227\227\226\225\224\224\224\224\224\224\224\224\223\223\223\223\223\223\223\223\222\222\222\221\221\220\219\219\219\218\218\217\217\217\217\217\217\216\216\216\216\216\216\216\215\215\215\215\215\214\214\214\214\213\212\211\211\211\211\210\210\210\210\209\209\209\208\208\208\208\207\206\206\206\205\205\204\204\203\203\203\202\202\202\202\202\202\202\202\202\201\201\200\200\199\199\198\197\196\195\194\194\193\193\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\191\191\190\189\189\189\189\188\188\188\188\187\187\186\185\185\185\185\185\185\184\183\182\182\181\181\180\180\179\178\178\177\176\176\175\174\173\173\173\172\172\171\170\170\170\170\170\170\169\169\169\169\169\169\169\169\168\168\167\167\167\167\167\167\166\166\165\165\165\164\164\163\163\163\163\162\162\161\161\160\160\159\159\158\158\157\157\156\156\155\155\154\154\153\153\152\152\152\151\151\151\151\150\150\149\149\148\148\147\147\147\147\147\146\146\146\146\145\145\145\144\144\144\144\144\144\144\143\143\143\143\143\143\143\142\142\141\141\140\140\140\140\140\140\139\139\138\138\137\137\136\136\135\135\134\133\133\133\132\132\131\131\131\131\131\131\131\131\131\130\130\129\128\128\128\128\128\128\128\128\128\128\127~}||{{{{{zyyxxwwwwwwwwwwwwwwvvuuttsssssssssssssssssssssssssssssssrrqqppoonnmmlllkkjjiihhggffffffffffedcba`_^]\\[ZZZZZZZYYXXWWWWWVVVVVVUUTTTTTSSRRQPOONNNNNMMLLKKKJJJJJJIIIHHGGFFEEDDCCBBBAA@@??>>==<<;;::::::998877777766655544433210000000000000000000/////....----------------------------------------------,,++++++++++++++++***************************************************))((''&&&&&&&&&&&&&&&&%%$$#######\"\"\"\"!! \031\031\030\029\028\028\028\027\027\026\026\026\026\026\026\026\026\026\026\025\025\024\023\023\022\021\021\021\021\021\020\019\019\018\018\018\017\017\017\016\016\016\016\016\016\015\015")
+ (8, "\014\r\012\011\n\t\b\007\006\005\004\003\002\001\000\232\232\231\231\230\229\229\228\228\228\228\228\228\228\228\228\228\227\227\226\225\224\224\224\224\224\224\224\224\223\223\223\223\223\223\223\223\222\222\222\221\221\220\219\219\219\218\218\217\217\217\217\217\217\216\216\216\216\216\216\216\215\215\215\215\215\214\214\214\214\213\212\211\211\211\211\210\210\210\210\209\209\209\208\208\208\208\207\206\206\206\205\205\204\204\203\203\203\202\202\202\202\202\202\202\202\202\201\201\200\200\199\199\198\197\196\195\194\194\193\193\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\192\191\191\190\189\189\189\189\188\188\188\188\187\187\186\185\185\185\185\185\185\184\183\182\182\181\181\180\180\179\178\178\177\176\176\175\174\173\173\173\172\172\171\170\170\170\170\170\170\169\169\169\169\169\169\169\169\168\168\167\167\167\167\167\167\166\166\165\165\165\164\164\163\163\163\163\162\162\161\161\160\160\159\159\158\158\157\157\156\156\155\155\154\154\153\153\152\152\152\151\151\151\151\150\150\149\149\148\148\147\147\147\147\147\146\146\146\146\145\145\145\144\144\144\144\144\144\144\143\143\143\143\143\143\143\142\142\141\141\140\140\140\140\140\140\139\139\138\138\137\137\136\136\135\135\134\133\133\133\132\132\131\131\131\131\131\131\131\131\131\130\130\129\128\128\128\128\128\128\128\128\128\128\127~}||{{{{{zyyxxwwwwwwwwwwwwwwvvuuttsssssssssssssssssssssssssssssssrrqqppoonnmmlllkkjjiihhggffffffffffedcba`_^]\\[ZZZZZZZZYYXXWWWWWVVVVVVUUTTTTTSSRRQPOONNNNNMMLLKKKJJJJJJIIIHHGGFFEEDDCCBBBAA@@??>>==<<;;::::::998877777766655544433210000000000000000000/////....---------------------------------------------,,++++++++++++++++***************************************************))((''&&&&&&&&&&&&&&&&%%$$#######\"\"\"\"!! \031\031\030\029\028\028\028\027\027\026\026\026\026\026\026\026\026\026\026\025\025\024\023\023\022\021\021\021\021\021\020\019\019\018\018\018\017\017\017\016\016\016\016\016\016\015\015")
and goto =
- ((16, "\002\168\001\133\000S\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001#\001\234\000)\0019\000\179\000\017\000\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\155\000\000\000\000\000\000\000\000\000\000\000M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \204\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\214\000n\000\000\000N\000\029\000\193\000\000\000\196\000\017\000\218\001l\000Z\000\000\000\000\000\000\000b\000\000\000\000\000\016\000\000\000\000\000\000\000\000\002D\000\000\001d\000\000\000\000\000\000\000\000\000\000\000d\000\000\000,\002\234\000\015\000\000\000\000\011\1728\214\000\000\000\000\025\152\000\000\012x\000\0009p\003\134\003\152\000\000\000\000\001\166\001\236\001\182\004h\000v\002\234\002\216\000{\003\148\000\200\001\246\003\208\014\128\000\000\005(\002\n\004\216\002\bBV\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\162\000\000\002<\005\024\003\020\000\000\000\000\000\000\000\000\002t\000\000\000\000\005\"\004~\000\000\005,\007<\t\028\000\000\000\000\000\000\002\186\003\"\005J\005\196\bX\005\1389\188\003*\005\194\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\242\000\000\000\000\000\000\003\156\006\002\014\242\007\180\005(\"\144\000\000:\028\005\152:\164:\192\000\000\000\249\000\000\000\000\000\000\004\140Kx\004\210\000\000\012:\004\236\000\000\012\162\bb\000\254\000\000\004P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r0\004~\000\000\000\000\000\000\017@\000\000\nP\000\000\000\000\004~K\156\"*\000\000\017\228\000\000\000\000\000\000\000\000\000\000\000\000\002\134\011\210\002\134\004\006\000\000\000\000\000\000\004n\000\000\000\000\000\000\000\000\005\006\000\000\000\000\002\134\000\000\000\000\000\000\000\000\000\000\tR\000\000\006\210\005\162\000\000K\252\006\224X\252\000\000\000\000\000\000\000\000\004n\000\000\000\000\000\000\rH\000\000\000\000\000\000\000\000\000\000\000\000\000G\005\154\000\000\000\000\000\000\004n\005\224L\160\005.\007\014?\226\000\000\0050\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\230\000\000\000\000\000\000\000\000\006jL\236\000\000\005Z\007(M*\000\000\000\000\000\000M^\005\146Mx\005\146\000\000N\002\005\146\000\000NF9\162\006p\006\230\000\000\000\000Al\000\000\000\000\000\000\000\000\000\000\000\000\005\146\000\000N|\005\146N~\004n\000\000O\128\005\146\000\204\000\000\005\146\005\146\000\000\000\000\005\146\000\000:\192\000\000\000\000\000\000\005\146;H\000\000\000\000\005\146\000\000\000\167\007\014\000\000\000\000\000\000\000\000\000\000\000\000\020v\000\000\006\186\000\000N\228\004n\000\000\000\000\000\000\000\000\007\012\007\170\015<\007\006\b\002\b\016\0074\b\150\007H\000\154\b\186\000\000\000\000\003\006\003p\000\000\006\022\007V\001\002\bh\000\000\000\000\007\222\000\000\000\252\001*\005\196\000\221\t\212\000\000\000\000Y\022\000\000Y@\t\162\000\000O\012\004nO|\004n\000\000\002r\002\156\000\000\b\206\000\252\000\000\000\000\b\238\000\000\000\000\000\000\000\000\000\000\t\158\000\252\011.\000\252\000\000\004f\000\000\000\000\004\236\000\000\000\000\000\000\nj\000\000\000\000\000\252\000\252\000\000\000\252\000\000\000\000\tB\000\000\000W\bX\000\000\000W\000\000\r\242\000\252\000\000\000\000\000\000\000\000\000\000\000W\015\174\"\194\n\"\t\218:\246\023\022\000\0005l;\152\t&\007x5\160\t>\007\158\016\n\td\007\176\016\132\tp\007\238\004\174;\192\005\146\016\246\tz\007\254\023\132\n|\000\000<`\005\146O\220\004n\nX\000\000\000\000\000\000\000\0009\162\nB\000\000\000\000F\210\000\000\000\000\000\172\000\000\000\000\nz\026\254\002\134\000\000\017n\t\202\b\b\007b\000\000;\246\t\246\bB\025\194\000\000<\198\000\000\000\000\n\020\bRP*\005\146\017\150D\030\000\000\000\000\000\000\000\000\000\000\001\006\r\170\000\000\000\000\000\000\nF\br\n\012\000W\014,\000\252\000\000\000\000\000\000\005\152\000\000Pr\004n\018\014\nd\bvIr\000\000N\176\000\000\000\000\"\248\nn\b\142\030\178\000\000#b<\208\nv\b\156#\152\000\000.\136\000\000\000\000\011\224P\198\004nED\004nP\218\004n\000\000\000\000\000\000\000\000\000\000S\192\000\000\000\000\000\000\004\"\018\128\000\000\000\000\000\000=\132\n\146\b\160$$\000\000Z(\000\000\000\000\000\000\000\000\000\000\n^\018\250\000\000\000\000\nn=\206\n\176\b\182$`\000\000\nn=\226\n\182\b\230$\150\000\000\nn\000\000ZB\000\000>T\n\188\b\238% \000\000\nn\019V\004|\019\162\000\000\000\000>\138\n\210\t\"%^\000\000\nn>\188\n\228\t.%\196\000\000\nn?^\011\n\t<%\232\000\000\nn?\144\011\012\tB&&\000\000\nn?\194\011\020\tJ&\140\000\000\nn@8\011&\tZ&\238\000\000\nn@L\0114\tl'T\000\000\nn@\150\011<\t\186'\142\000\000\nnAJ\011X\t\192'\198\000\000\nnA\208\011v\t\248(P\000\000\nnB\026\011\128\n\002(\136\000\000\nnBB\011\136\n\006(\148\000\000\nnBx\011\152\n\014(\250\000\000\nnB\140\011\160\n\016)\\\000\000\nnC\128\011\174\n(*\002\000\000\nnC\246\011\218\nP*\030\000\000\nnD\n\011\222\nT*h\000\000\nnDT\011\236\nX+\b\000\000\nnDh\011\242\nd+*\000\000\nnD|\011\252\n\142+\202\000\000\nn\n\162\015\186\019j\020B\000\000ED\012\172\000\000Qj\004n\020\234\000\000\000\000\012B\000\000Q~\004n\0216\000\000\000\000\021\190\000\000\000\000\002j\000\000\000\000\022\"\000\000\000\000\000\000\000\000Q\194\004n\022\194\000\000\012\b\023\"\000\000Rn\005\146R|\005\146R\144\005\146\003$\000\000\000\000\000\000\000\000Sv\005\146\000\000\002\162\0054\000\000\000\000\000\000\nn\023\142\000\000\000\000\023\236\000\000\000\000\000\000\000\000+\164\000\000\000\000\nn,\000\000\000,r\000\000\000\000,\206\000\000\000\000\000\000Z\146\000\000\000\000-.\000\000\000\000Ev\012D\n\208-\152\000\000\nn-\138\000\000\000\000E\212\012L\n\228-\212\000\000\nn.\146\000\000\000\000F*\012z\n\236.\156\000\000\nn\004\138\024^\000\000\000\000FL\012\132\011\018/\018\000\000\nn\024\188\000\000\000\000Ft\012\136\011\026/\\\000\000\nn\025\026\000\000\000\000G\"\012\162\011.0\026\000\000\nn\000\000\000\0000b\000\000\000\000G\220\012\182\01180\144\000\000\nn0j\000\000\000\000H\014\012\228\011:0\220\000\000\nn18\000\000\000\000H\026\012\234\011H1\158\000\000\nn\000\000Hd\012\252\011T2\016\000\000\nn\000\000;\184\000\000\000\000\nn\000\000\000\000\000\0002F\000\000\000\0002\156\000\000\000\000\000\000\012\b\025v\000\000\000\000\026$\000\000H\132\000\000\000\000D\030\000\000\000\0002\230\000\000\000\000\000\0003J\000\000\000\000\000\000\014\"\000\000\000\000S8\000\000\000B\000\000\007\\\r\190\000\000\002f\000\000\000\000\000\000\000\000\000\000\001\006\000\000\000\000\r\020\000\000\000\000\026b\000\000\026\174\000\000\000\000\nn\000\000\000\000\027\016\000\000\027N\000\000\000\000\000\000\000\000\000\000H\200\r\026\011z3l\000\000I\162\r`\011\1363\176\000\000\nn\nnI\236\rj\011\1384R\000\000\nn\000\000\000\000\000\000\000\000\rl\011\1504\132\000\000\000\000\nn\000\000\000\000\000\000\000\000\rr\011\1544\200\000\000\nn\000\000\014\168\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\188\011\196\000W\028\026\000\000\r\152\011\190\014Z\001<\012\216\000W\015`\000\252\012\218\000W\000\000\028L\000\000\006<\000\000\r\230\011\230\002\216\000\000\000\000\000\000\000\000\000\000\014\n\003\178\000\235\000\000\000\000\000\000J\000\000\000Y\224\000\000\011\234\000\000\011\242\000\000\000\000\000\000\000\000\000\151\000\000\000\000\000\000)\188\002\134\000\000\002\134\0064\000\000\005\230\000\000*\178\002\134\002\134\000\000/\148\002\134\002\134\011\244\000\000\028\214\000\000\000\000\011\254\014\238\000\0005\020\006\252\000\000\000\000\000\000\000\000\000\000\000\000\r\254\012&5\134\000\000\nn\000\000\000\000\000\000\000\000\014\n\012P\rv\000W\000\000\0176\000\252\000\000\015f\000\000\000\000\000\000\000\0005\236\000\000\014\030\012\1406*\000\000\000\000\018\220\000\252\000\000\019\004\000\252\000\000\019\"\000\252\000\000\nn\000\000\020\198\000\252\000\000\021\140\000\252\000\000\022\\\000\252\000\000\000\026\000\000\012\170\r\142\001\168\000\000\014.\014F\012\182\014\192\015V\022\144\000\252\007\128\000\000\012\194\015~\015\134\007H\007\156\015P\012\196\015\150\007\142\007\168\015`\000\000\000\000\b(\b\134\000\000\004\186\004\136S\138\005\146\029\b\000\000\006\198\001\184\015\014\r\012\014x\004\236\000\000\015\016\r\016\004`\000\0006N\000\000S\212\004n\000\000\015\186\015\212\000\000\b\174\000\000\004n\015D\r \004\b\015\128\002\228\000\000\000\000\000\000\000\000\r(\b\186\000\000\rH\b\228\000\000\t\224\028J\015d\015f\r|\005\198\t@\000\000\r\160\007\228\t\242\000\000\015l\015p\r\172\015\208\015V\022\214\000\252\000\000\r\182\016:\000\000\b\138\n0\000\000\016>\000\000\025\244\001\206\016\012\r\214\016j\000\000\026\134\003\002\016:\000\000\000\000\000\195\003\134\n2\000\000\027\214\000\252\n\134\000\000\005\030\000\000\016\016\r\218\0298\004>\000\000\016\020\r\246\006F\015\128\016\022\016$\r\250\017\148\000\000\0168\002\140\000\000\000\000\000\000\000\000\000\182\014\016\016\nT\030\004n\000\000\004R\014\030\016\212\000\000\000\000\000\000\000\000\000\000\000\000T8\004\176\000\000\014,\017<\000\000\000\000\000\000\000\000\000\000\000\0006z\n\216\000\000\014:\001\b\000\000\014J\014h\006\"\000\000\001nI\188\000\000\005N\000\000U\006\004n\004n\000\000\000\000\005\180\000\000\t\006\000\000\001\132\005\180\005\180\000\000\014pJ>\004nUH\004n\011\000\000\000\000\000\000\000\012D\000\000\000\000\004\132\000\000\005\190\016\158\014~\017\190\016h\000\000\000\000\002\180\006h\016\176\000\000\000\000\014\136\017\204\016p\000\000\000\000\nd\000\000*\200\000\000U\028\002\222\004n\000\000UlL`\000\000V\004\000\000\000\000\000\000\005\180\000\000\000\000\012\192\016\184\014\150\017\212\016\136\000\000\000\000V.\012\250\016\208\000\000\000\000\000\000/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r*\000\000\016\222\014\156\006\218\000\000\017\218\017\138\r\128\016\230\000\000\000\000\016\234\014\160\b\128\000\000\000\000\n(\bb\002\224\000\000\000\000\000\000\b\018\016\188\014\186\000\000\016\208\b\018\000\000\017\182\r\212\017\022\000\000\000\000\000\000\004n\002\182\006\196\006L\000\000\000\000\000\000\000\000\016\236\014\210\000\000\006\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004n\016\208\014\226\018>\016\226\000\000 \014\001\003\014\228\016\180\001r\002T\014\230\017t\000\000\0182\029\176\000\000\000\000\030\018\000\000\014x\000\000\004\242\000\000\000\000\000\000\000\000\000\000\000\000V\236\004n\000\000\0188\030\132\000\000\000\000\030\232\000\000\003b\014\246\017\222\000\000\000\000\021V7f\017\148\000\000W\004\004n\031N\000\000\000\000\031\156\000\000\000\000\014\158\000\000\002\206\000\000\000\000\000\000\000\000\000\000\000\0007x\000\000\000\0007 7\232\017\150\000\000W\022\004n V\000\000\000\000 \178\000\000\000\000\015\014!\004\014\176\000\000\015$\015@\000\145\001P\015L\b\202\015t\017\2428z\014\178\000\000\015\160\015\162\tr\000\000\003\182J\228\000\000\006\244\000\000\015\176\001\156\002\140\006\194\016\194\n\240\000\000Y\164;\184\000\000\b\150\000\000\000\000\b\150\000\000\000\000\b\150\nB\000\000\012\228\b\150\017\2468\142\014\186\000\000\b\150\000\000W0\000\000\000\000\b\150\000\000\000\000\014\190\000\000\r\020\t\220\015\n\000\000\015\180J\144\015\018\000\000\000\000\000\000\015 \000\000\000\000\001\234\000\000\b\150W@\000\000\016\030\b\150\"X\000\000\015$\017R\015\184\018r\017\028\000\000%\128\015T\017b\000\000\000\000\000\000\n$\007\006\000\000\000\000\000\000\000\000\000\000\000\000\n^\015\160\000\000\017t\000\000\000\000\000\000\000\000\015\210\016\232\000\000\000\000\000\000\n^\000\000\000\000\000\000\000\000\015\236\024\200\000\000\000\000\000\000\000\000\000W\000\252\000\000\005\146\000\000X\020\004n\000\000\003\202\000\000\000\000\000\0008\132\000\000\000\000\000\000\000\000\000\000\018\022\006\148\b\152\016\188\005\024\015\244\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\236\006T\016\012\000\000\b\000\018x\018,\015\238\000\000\000\000\018 \n\254\007X\000\000\000\000\000\000\016\018\000\000\0164\015\248\000\000\000\000\002\134\020\004\000\000\000\000\000\000\000\000\000\000\027\252\000\000\000\000\b\230\007\224\000\000\000\000X.\004n\004nX\178\004n\007\182\000\000\000\000\000\000\004n\000\000\000\000\n\198\0180\0164\000\000\000\000\018$\003N\000\144\000\000\000\000\000\000\000\000\b\240\018x\011j\018<\016\182\000\000\000\000\0184\003x\006\242\000\000\000\000\000\000\000\252\000\000\016\206\000\000\000\000\000\000!,\000\000!\212\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\003F\000\135\000\000\000\000\000\000\000\000\000\000\006\016\000\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003V\000\000\000\000\000\000K&\000\000\004n\000\000\014$\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001H\000\000\000\000\000\000\005\014\000\000\000W\000\000\001&\000\000\000\252\000\000\005\238\000\000\000\000\000\000Bp\005\146\000\000\000\000\002T\000\000\000\000\000\000\000\000\001\006\005x\017p\000\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000=F\000\000\016\240\000\000\000\000\000\000\000\000\006L\b,\022\154\030\160\000\000\000\000\017\000Sd\000\000\000\000\000\000\017\006Z\026\000\000\000\000\000\000\000\000"), (16, "\006\219\0007\002`\002a\001j\000\231\000;\004\136\000\235\000\236\000\231\007l\005\235\000\235\000\255\000m\001j\002\133\006\220\006\235\003y\006\222\001\000\001\026\000\231\002\138\001\027\000\235\000\255\001\214\006\223\006\236\007f\001Y\000\145\005`\006\155\000\150\002\161\001\238\005\236\007d\005\237\001\242\000?\001\018\0007\001\002\000j\004\136\001\029\000\231\007Q\005\235\000\235\000\255\004\147\004\149\004\151\002\020\006\224\001\219\000\231\001\177\006\239\000\235\000\236\000@\006\015\000\151\006\157\000\145\005\238\007Y\001\231\000\145\000\145\000\155\001\231\000\154\000\238\005\236\007u\005\237\001\243\004\026\006\158\001\\\001\002\007\r\005b\006\160\007\012\006\155\003y\006\201\001#\006\225\004\150\004\149\004\151\000Y\002\167\001\244\007\187\002a\001j\006\226\005\239\001i\001j\001\031\007L\005\238\002d\002\020\002\169\000\235\005\240\005\241\006\219\005\242\002`\002a\001j\001\156\001j\006\157\001 \001k\002E\006\240\001m\001n\001\018\001&\000\238\002\133\006\220\006\235\000]\006\222\000\127\006\158\006.\002\138\006\241\001\210\006\160\005\239\006\223\006\236\006\181\003y\004&\001j\006\229\001\012\002\161\005\240\005\241\006\231\005\242\001\018\001&\001\255\004\234\000\231\005\244\002\176\000\235\000\255\002\177\005\246\006\000\006\233\006\022\006\023\000a\002\170\006\224\0012\002\021\000u\006\239\006.\000:\006*\002\191\001(\001\142\002\172\001)\006\234\001\012\001*\001+\006\024\006(\001\210\001\018\001&\006 \004\172\004\027\006+\007j\003y\001r\005\244\007w\000\238\002\193\002\000\005\246\006\000\007\188\006\225\002\169\000\235\001s\001,\002\167\000\235\0016\007U\001\012\006\226\006*\001i\001j\0009\001\018\001\021\002d\000|\002\169\000\235\002\021\000~\006\219\007\163\002`\002a\001j\000\145\006+\007!\001\231\001k\002E\006\240\001m\001n\000\130\002G\007V\002\133\006\220\006\235\007\155\006\222\001\012\002\t\002\003\002\138\006\241\001\012\001\018\001\021\006\223\006\236\001\214\001\018\001\021\007\164\006\229\002H\002\161\005F\000\231\006\231\001\238\000\235\000\236\001\132\001\242\0007\001\018\002\176\005\164\004w\002\177\003y\001\141\006\233\001\142\001q\007\156\002\170\006\224\000\235\000\231\005\165\006\239\000\235\000\236\005\188\002\191\000\132\001\142\002\172\003y\006\234\002\020\001\212\002\003\000\149\001\012\006D\007\175\002a\001j\000\238\001\018\001\021\007\n\001\243\001r\001\012\007\151\005\164\002\193\006\155\006\194\001\018\001\021\006\225\000\133\001\022\001s\003\\\002\167\000\235\005\165\004z\001\244\006\226\005\172\001i\001j\001\237\000\145\0011\002d\000\150\002\169\000\235\000\148\004\031\006\219\006\196\002`\002a\001j\004\238\000\237\006\157\007\152\001k\002E\006\240\001m\001n\001\018\006\153\006n\002\133\006\220\007q\006\198\006\222\005\164\006\158\005Q\002\138\006\241\005t\006\160\007\177\006\223\006\236\006\176\005\164\006\200\005\165\006\229\001\026\002\161\005\166\001\027\006\231\000\175\001N\000\179\001\132\005\165\000\238\006\199\002\176\005\171\000\174\002\177\003]\001\141\006\233\001\142\001q\003y\002\170\006\224\006\196\006\015\001P\001\029\003q\001j\006\166\002\191\005\158\001\142\002\172\007\178\006\234\002\169\000\235\000\180\002\021\006r\001\214\006\198\000\231\006\253\007|\000\235\000\255\006\242\001\249\001r\001\238\000\235\000\184\002\193\001\242\006F\001\018\001\237\006\225\001\012\001\234\001s\000\189\002\167\000\235\001\018\001&\003y\006\226\006\199\001\238\001#\000\238\000=\001\242\002d\001\018\002\169\000\235\004\027\007\004\006\219\001\012\002`\002a\001j\001\031\000\202\001\018\001\021\001C\003{\006\240\004\136\0007\001\243\006\153\007T\002\133\006\220\006\235\0007\006\222\001 \001\026\005*\002\138\006\241\000\235\001\018\001&\006\223\006\236\001\214\001\244\001\243\002\007\006\229\007b\002\161\007s\007}\006\231\001\238\000\238\000\206\001\132\001\242\007\139\001\018\002\176\006\022\006\023\002\177\004\152\001\141\006\233\001\142\001q\005W\002\170\006\224\006\b\004\149\004\151\007+\005\164\001p\006\165\002\191\004\235\001\142\002\172\006'\006\234\007~\0012\006 \004\172\005\165\007\133\001\018\005*\005\196\001(\000\235\001\214\001)\001\243\002\005\001*\001+\005\211\002\193\004\132\004\172\001\238\006g\006\225\005-\001\242\001\142\001\018\002\167\005\024\001j\005\\\001\244\006\226\000\235\006i\000\145\001\031\000\177\001\231\002d\001,\002\169\000\235\0016\007\134\006\219\000\222\002`\002a\001j\000\228\007W\007X\001 \000\231\001\237\006\240\000\235\000\236\001\018\001&\0007\002\133\006\220\006\235\001\243\006\222\001i\001j\003y\002\138\006\241\007W\007X\007\135\006\223\006\236\006 \004\172\007\005\007\140\006\229\001\142\002\161\001\244\006\155\006\231\001k\001z\000\185\001m\001n\0007\007\136\002\176\001\012\006K\002\177\006 \004\172\006\233\001\018\001\021\000\238\002\170\006\224\006\196\000\243\003\132\006\244\0048\000\235\000\255\002\191\001(\001\142\002\172\001)\006\234\006\157\001*\001+\002\011\000\170\004\155\006\198\003y\002`\002a\001j\000\182\001{\001\014\001|\002/\006\158\001^\002\193\001\018\001e\006\160\005h\006\225\001\251\006\167\003\146\004\156\002\167\005\181\001\018\004\192\006\252\006\226\006\199\002\022\001q\003y\000\235\000\238\002d\003\205\002\169\000\235\000\235\000\255\006\219\001\130\002`\002a\001j\005'\004\172\0010\005\187\005\183\001\006\006\240\002\020\001s\007\190\007\191\000\235\002\133\007\193\001\181\001j\006\222\007\159\001\t\002Y\002\138\006\241\003y\005\185\002\011\006\223\007\195\003\234\005\137\005\183\001\025\006\229\006O\002\161\001k\002t\006\231\001m\001n\000\145\001\254\001\218\001\231\001\237\002\176\005\186\001\018\002\177\005\185\002\023\006\233\000\190\001:\007\160\002\170\006\224\002\022\002c\005\020\000\235\001\026\005*\005c\002\191\000\235\001\142\002\172\0015\006\234\002d\005\186\002\169\000\235\001\132\001\012\007\131\002\201\004\000\003s\003t\001\018\001&\001\133\000\203\001\142\001q\003y\002\193\000\212\001\012\004\152\003y\006\225\000\215\003z\001\018\001\021\002\167\0019\001\026\0015\006\219\006\226\002`\002a\001j\007\210\005\t\000\223\002d\001F\002\169\000\235\001\130\001[\002\011\007\202\005b\002\133\007\203\000\238\002\023\006\222\007\198\003y\001s\002\138\007\167\000\235\004\152\002\021\006\223\007\211\001\172\002\170\007\019\004\158\001\142\001a\002\161\000\226\006\241\001\170\002\171\004\233\001\142\002\172\002\022\001\031\0059\000\235\006\229\000\238\004\003\004\b\001\018\006\231\000\238\005\173\007\168\001x\006\224\000\238\005\189\002\176\001 \005\160\002\177\000\229\001\238\006\233\001\018\001&\001\242\002\170\001\018\003y\000\238\000\145\001\214\005\249\001\231\002\004\002\191\0007\001\142\002\172\001\031\006\234\001\238\001\132\007\021\000\239\001\242\005\155\001\018\007\022\000\235\006\225\001\133\000\244\001\142\001q\002\167\001 \004\136\004{\002\193\006\226\000\238\001\018\001&\002\023\001\129\001\243\002d\006\015\002\169\000\235\005*\001\138\006\219\000\235\002`\002a\001j\001(\007\023\007\215\001)\005\167\007\132\001*\001+\001\243\005\167\004\160\000\238\002\133\006\220\006\250\007\024\006\222\001i\001j\003y\002\138\006\241\005\197\003\\\003y\006\223\006\236\001\244\006\028\004\149\004\151\006\229\004\163\002\161\004z\000\238\006\231\001k\001z\001(\001m\001n\001)\000\238\002\176\001*\001+\002\177\000\231\004\164\006\233\000\235\000\236\001\137\002\170\006\224\004\136\002`\002a\001j\002Q\005l\004\172\002\191\001\176\001\142\002\172\007\031\006\234\001\142\003y\004\167\002\133\000\231\007\025\007\026\000\235\000\236\001L\006\155\002\138\001{\001\187\001|\002/\001J\004\201\002\193\007\027\007\028\003y\007c\006\225\002\161\005\167\004\028\004\178\002\167\006\022\006\023\007\029\004\172\006\226\007&\003y\006$\004\149\004\151\001b\002d\003y\002\169\000\235\006\157\004\252\006\219\001\130\002`\002a\001j\006\031\001y\007V\001\192\006 \004\172\006\240\001\198\001s\006\158\007\202\000\235\002\133\007\203\006\160\004\180\006\222\001\200\006\164\002Y\002\138\006\241\007*\005\015\001\209\006\223\007\206\000\238\004\173\005\001\000j\006\229\001\026\002\161\000\238\001\027\006\231\002\167\001N\006\150\004\136\002$\004\247\000\145\002\176\006\003\001\231\002\177\004z\002d\006\233\002\169\000\235\007\023\002\170\006\224\004\253\000\238\001P\001\029\002'\001\214\005\002\002\191\001\215\001\142\002\172\007\024\006\234\002*\000\238\001\238\001\012\001\132\005=\001\242\000\238\001\018\001\018\001\021\001\018\002\173\001\133\004z\001\142\001q\000\238\002\193\001\012\007G\004\149\004\151\006\225\000\238\001\018\001&\0007\002\167\007@\002\011\002-\003y\006\226\007_\002\176\001#\005\006\002\177\0023\002d\000\238\002\169\000\235\002P\002\170\006\219\001\243\002`\002a\001j\001\031\003y\007\209\002\191\001C\001\142\002\172\003y\002\015\000\238\002\011\002\022\002\133\006\220\000\235\001\244\006\222\001 \000\238\006\184\002\138\006\241\002U\001\018\001&\006\223\006\246\002\193\003y\007?\002\\\006\229\001\026\002\161\004h\001\027\006\231\005K\001=\002\024\004z\001\197\002\022\001\018\002\176\000\235\002l\002\177\002z\000\238\006\233\006\012\004\172\005\007\002\170\006\224\001\203\000\238\001B\001\029\002\130\001\214\000\238\002\191\001\236\001\142\002\172\002\136\006\234\002\165\0012\001\238\001\211\005\"\003y\001\242\002\023\001\018\001(\005/\002\181\001)\001\224\001\012\001*\001+\001M\002\193\001\012\001\018\001&\000\238\006\225\005\235\001\018\001&\002\011\002\167\005\169\000\238\0052\000\235\006\226\001\026\002\187\001#\001\027\002\023\002\196\002d\001,\002\169\000\235\0016\001\226\000\238\001\243\000\238\007\017\004\172\001\031\005\236\006-\005\237\001C\002\012\006\249\006\219\002\022\000\238\001\029\000\235\001\241\006\162\002\207\001\244\000\238\001 \000\238\001\026\002\213\006\241\001\027\001\018\001&\006\220\005:\002\219\006\222\000\238\002\225\006\229\006\145\005\238\002\231\000\235\006\231\006\223\002\002\001\026\004c\006\137\002\237\003y\002\176\001\214\001\029\002\177\001\246\001\026\006\233\002\243\005\212\000\238\002\170\001\238\001#\000\238\004_\001\242\002#\001\018\006\188\002\191\006\015\001\142\002\172\006\224\006\234\005\239\0012\001\031\002&\002\023\003y\003y\001\029\002\011\001(\005\240\005\241\001)\005\242\000\238\001*\001+\001M\002\193\001 \000\238\002\249\002)\001#\002\255\001\018\001&\000\238\002,\001\026\000\238\001\243\001\027\0022\000\238\006\225\006.\002m\001\031\006\018\002\022\001,\000\238\000\235\0016\006\226\005>\002>\003y\002;\001\244\000\238\003\005\005\214\002A\001 \001\029\003\011\001\031\003\017\005\244\001\018\001&\003\023\003\029\005\246\006\000\006\169\001\031\006\227\000\235\002L\0012\002O\006\015\001 \003#\005L\005]\006*\001(\001\018\001&\001)\006\228\001 \001*\001+\006/\003y\000\238\001\018\005\217\000\238\006\229\002T\003)\006+\003/\006\231\0035\007)\001#\006\022\006\023\002\023\003;\006\162\0012\003y\002[\001\026\001,\006\233\001\027\0016\001(\001\031\007N\001)\005a\000\238\001*\001+\006\024\006(\000\238\003A\000\238\006 \004\172\006\234\000\238\000\238\001 \002k\001(\003E\001\029\001)\001\018\001&\001*\001+\001\026\000\238\001(\001\027\001,\005\218\002y\0016\001*\001+\000\231\002\129\006\015\000\235\000\236\002\135\003\156\005\148\005\165\001\026\005\223\000\238\005\220\000\238\001;\000\238\003\165\001\029\002\148\002\164\003\174\000\238\001\214\003|\001,\001\248\002\190\005\180\006\022\006\023\001#\006\155\001\238\0012\002\180\006\015\001\242\002\186\001\018\003\184\002\195\001(\000\238\003\193\001)\001\031\007\\\001*\001+\006\024\006(\002\206\000\238\003\202\006 \004\172\007\025\007\026\003\213\003\222\002\212\001\026\001 \001#\001\027\006\157\003\231\001=\001\018\001&\007\027\007\028\003\238\001,\002\011\000\238\0016\001\243\001\031\002\218\002\224\006\158\007\029\004\172\002\230\000\238\006\160\001>\001\029\000\238\006\161\004=\001\026\002\236\001V\001 \001\244\001\031\004B\004I\002\242\001\018\001&\004j\002\248\004R\002\022\004\\\000\238\000\235\006\022\006\023\000\238\001\026\001 \0012\001\027\003y\002\254\001=\001\018\001&\000\238\001(\004i\004o\001)\000\238\000\238\001*\001+\006\024\006(\003\004\001#\000\238\006 \004\172\003\n\001>\001\029\000\238\003\016\006\022\006\023\004~\001T\004\143\0012\001\031\003\022\004\145\004\169\001C\003\028\001,\001(\004\174\0016\001)\000\238\003\"\001*\001+\007J\007K\001 \000\238\000\238\006 \004\172\002\023\001\018\001&\000\238\001(\000\238\004\186\001)\003y\001\031\001*\001+\003(\001\026\003.\001#\001\027\001,\005\184\001=\0016\0034\000\238\000\238\003:\001\026\001 \004\195\001\027\003@\001\031\001=\001\018\001&\001C\0077\001.\003y\003K\001>\001\029\002\011\002\011\000\238\003R\000\238\001?\001 \0012\000\238\000\238\001>\001\029\001\018\001&\000\238\001(\004\210\001R\001)\003r\003y\001*\001+\001M\003\155\002`\002a\001j\003\164\004r\004v\004\236\002\022\002\022\000\238\000\235\000\235\004\242\000\231\005\224\002\133\000\235\000\236\004\249\004\255\001#\001(\001,\002\138\001)\0016\003\173\001*\001+\004\n\000\238\003\183\001#\003\192\0012\001\031\002\161\000\231\003y\001C\000\235\000\236\001(\005\232\006\155\001)\003\201\001\031\001*\001+\001M\001C\001 \0073\002\011\005\018\003\212\005\023\001\018\001&\000\238\002`\002a\001j\001 \005&\002\011\005\245\006\155\005.\001\018\001&\002\023\002\023\001,\000\238\002\133\0016\006\157\003\221\003y\000\238\003\230\004\196\002\138\0051\002\022\000\238\000\238\000\235\007\147\003\237\004\021\000j\006\158\004\237\004\029\002\161\002\022\006\160\002\167\000\235\006\157\006\171\004*\0012\004<\002`\002a\001j\005\253\0058\002d\001(\002\169\000\235\001)\0012\006\158\001*\001+\001M\002\133\006\160\000\238\001(\000\238\006\187\001)\005<\002\138\001*\001+\001M\000\238\005B\007\007\007\149\000\238\001\214\005H\004A\002\018\002\161\002\173\001,\004H\004Q\0016\001\238\004[\002\023\006\020\001\242\000\238\001\018\005S\001,\005f\004a\0016\002\167\003y\002\023\002`\002a\001j\002\176\001\214\004n\002\177\002o\005k\002d\005p\002\169\000\235\002\170\001\238\002\133\000\238\003y\001\242\002\011\001\018\005z\002\191\002\138\001\142\002\172\003y\003y\005\128\004\205\001\243\003y\004p\003y\000\238\005\139\002\161\002`\002a\001j\000\238\002\173\005\150\002\167\004}\000\238\002\193\004\168\005\019\001\244\005\168\002\022\002\133\004\176\000\235\002d\004\185\002\169\000\235\001\243\002\138\000\238\004\194\000\238\002\176\005\154\004\179\002\177\004\203\005\175\006E\003y\004\209\002\161\002\170\003y\005\191\000\238\001\244\000\238\004\248\005\201\003y\002\191\003y\001\142\002\172\002\173\005\226\006h\000\238\005\248\004\241\006\002\002`\002a\001j\000\238\006\130\006\141\002\167\003F\001j\006\175\000\238\006\185\006\014\002\193\003y\002\133\002\176\000\238\002d\002\177\002\169\000\235\002\023\002\138\006\"\000\238\002\170\003b\001z\004g\001m\001n\0062\0068\006<\002\191\002\161\001\142\002\172\004\243\000\238\004\246\006X\002\167\000\238\001\026\002`\002a\001j\006\189\002\173\000\238\003y\006\193\006\128\002d\000\238\002\169\000\235\002\193\006\197\002\133\006\209\000\238\001\214\006\186\000\238\004t\000\238\002\138\003g\003s\003t\002\176\001\238\004M\002\177\003y\001\242\006\133\001\018\000\238\002\161\002\170\005\005\006\172\006\216\002\173\004\251\005\004\003y\003y\002\191\000\238\001\142\002\172\005\000\005\003\005\017\005\022\002\167\000\238\000\238\000\238\005!\006\138\001\130\002`\002a\001j\002\176\000\238\002d\002\177\002\169\000\235\002\193\005 \001s\001\243\002\170\000\235\002\133\000\238\006\230\005%\003y\006\168\006\144\002\191\002\138\001\142\002\172\001\031\000\238\006\152\0049\006\191\001\244\006\211\0050\005;\0057\002\161\002\173\005G\002\167\005A\000\238\006\237\001 \003w\003x\002\193\000\238\006\219\001\018\001&\002d\0072\002\169\000\235\006\247\007%\002`\002a\001j\002\176\000\231\007\020\002\177\000\235\000\236\006\220\000\238\005C\006\222\002\170\005Z\002\133\005N\007 \005Y\001\132\007.\006\223\002\191\002\138\001\142\002\172\002\173\003y\001\133\0041\001\142\001q\000\238\000\238\007P\006\155\002\161\0070\005T\003y\000\238\005X\000\238\002\167\000\238\001\026\002\193\001(\001\027\002\176\001)\006\224\002\177\001*\001+\002d\003y\002\169\000\235\002\170\002`\002a\001j\005e\003y\005j\005\200\003y\002\191\006\157\001\142\002\172\001\029\005o\000\238\002\133\005r\005v\005~\0073\002`\002a\001j\002\138\005\133\006\158\000\238\002\173\006\225\000\238\006\160\005\144\002\193\005\199\006\205\002\133\002\161\005\192\006\226\007^\002\167\005\193\005\198\002\138\005\202\005\203\000\238\005\234\005\227\004'\002\176\007i\002d\002\177\002\169\000\235\002\161\005\228\001#\005\233\002\170\005\255\006\238\005\251\005\252\005\254\006)\001\026\007\196\002\191\001\027\001\142\002\172\001\031\006\r\001\214\007\207\006\228\004\199\007\212\002`\002a\001j\006\017\002\173\001\238\006\019\006\229\006\021\001\242\001 \001\018\006\231\002\193\001\029\002\133\001\018\001&\006!\0061\002\167\0063\0064\002\138\0069\006=\006\233\002\176\006A\003\255\002\177\006S\002d\006Z\002\169\000\235\002\161\002\170\006^\006v\002\167\006\139\006\163\006\173\006\234\006\218\002\191\006\212\001\142\002\172\001\243\006\213\002d\006\217\002\169\000\235\006\232\002`\002a\001j\001#\007\015\007#\001<\002\173\007$\007(\007O\007S\001\244\002\193\001(\002\133\007]\001)\001\031\007a\001*\001+\007\182\002\138\000\000\000\000\000\000\002\173\000\000\002\159\003_\000\000\000\000\002\177\0040\001 \002\161\000\000\000\000\000\000\002\170\001\018\001&\002\167\000\000\000\000\001,\000\000\000\000\002\191\002\176\001\142\002\172\002\177\000\000\002d\000\000\002\169\000\235\000\000\002\170\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\002\193\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\002\173\001'\000\000\002\175\000\000\000\000\002\193\000\000\000\000\001(\002\161\000\000\001)\002\167\000\000\001*\001+\000\000\000\000\000\000\002`\002a\001j\002\176\000\000\002d\002\177\002\169\000\235\000\000\000\000\001i\001j\002\170\000\000\002\133\000\000\000\000\000\000\000\000\003W\001,\002\191\002\138\001\142\002\172\000\000\000\000\003Z\002\203\000\000\001k\002E\000\000\001m\001n\002\161\002\173\002`\002a\001j\000\000\001\214\000\000\000\000\004\214\002\193\000\000\000\000\000\000\000\000\000\000\001\238\002\133\002\167\000\000\001\242\000\000\001\018\002F\002\176\002\138\001\214\002\177\000\000\004\217\002d\002\202\002\169\000\235\002\170\000\000\001\238\000\000\002\161\000\000\001\242\001\214\001\018\002\191\004\220\001\142\002\172\000\000\000\000\000\000\000\000\001\238\000\000\000\000\000\000\001\242\000\000\001\018\000\000\001\026\000\000\001\243\002\173\000\000\002\167\000\000\000\000\002\193\000\000\000\000\000\000\000\000\000\000\000\000\001r\000\000\002d\000\000\002\169\000\235\001\244\001\243\002`\002a\001j\002\176\001s\000\000\002\177\000\235\000\000\000\000\000\000\000\000\000\000\002\170\001\243\002\133\000\000\000\000\001\244\000\000\002\167\000\000\002\191\002\138\001\142\002\172\002\173\001i\001j\003H\000\000\000\000\002d\001\244\002\169\000\235\002\161\000\000\000\000\002G\000\000\000\000\000\000\000\000\004\183\000\000\002\193\001k\002E\002\176\001m\001n\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\170\003[\003a\000\000\000\000\002\173\001\031\000\000\000\000\002\191\001\132\001\142\002\172\000\000\000\000\000\000\002F\000\000\000\000\001\141\000\000\001\142\001q\001 \000\000\002`\002a\001j\002\176\001\018\001&\002\177\0075\002\193\000\000\000\000\000\000\000\000\002\170\000\000\002\133\002\167\000\000\000\000\000\000\000\000\000\000\002\191\002\138\001\142\002\172\000\000\000\000\002d\003O\002\169\000\235\000\000\000\000\000\000\000\000\002\161\000\000\002`\002a\001j\000\000\001r\000\000\000\000\000\000\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\133\001s\001i\001j\000\235\000\000\001(\002\173\002\138\001)\000\000\000\000\001*\001+\003V\000\000\000\000\000\000\000\000\006f\000\000\002\161\001k\002E\000\000\001m\001n\000\000\000\000\000\000\002\176\000\000\001\214\002\177\000\000\004\225\002G\000\000\0073\000\000\002\170\000\000\001\238\000\000\000\000\000\000\001\242\002\167\001\018\002\191\002F\001\142\002\172\002`\002a\001j\000\000\003[\003a\002d\000\000\002\169\000\235\000\000\000\000\000\000\001\132\000\000\002\133\000\000\000\000\000\000\000\000\002\193\000\000\001\141\002\138\001\142\001q\000\000\000\000\000\000\003Y\000\000\000\000\002\167\000\000\001\243\000\000\002\161\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\001r\000\000\002`\002a\001j\001\244\000\000\000\000\000\000\000\000\000\000\000\000\001s\002\176\000\000\000\235\002\177\002\133\000\000\000\000\000\000\000\000\000\000\002\170\000\000\002\138\000\000\000\000\002\173\000\000\001\214\000\000\002\191\004\228\001\142\002\172\000\000\000\000\002\161\000\000\001\238\000\000\000\000\000\000\001\242\000\000\001\018\002G\000\000\000\000\000\000\002\176\002\167\000\000\002\177\000\000\002\193\000\000\000\000\000\000\006\219\002\170\000\000\000\000\002d\000\000\002\169\000\235\003[\003a\002\191\000\000\001\142\002\172\000\000\007\202\000\000\001\132\007\203\000\000\000\000\006\222\002`\002a\001j\001\243\001\141\000\000\001\142\001q\006\223\000\000\000\000\000\000\002\193\000\000\002\173\002\133\000\000\000\000\000\000\000\000\002\167\000\000\001\244\002\138\000\000\000\000\000\000\000\000\000\000\003f\000\000\000\000\002d\000\000\002\169\000\235\002\161\002\176\006\224\000\000\002\177\000\000\002`\002a\001j\000\000\000\000\002\170\002`\002a\001j\000\000\001\214\000\000\000\000\004\231\002\191\000\000\001\142\002\172\000\000\000\000\001\238\002\133\002\173\004\024\001\242\000\000\001\018\000\000\000\000\002\138\004 \000\000\000\000\006\225\000\000\003i\001\214\000\000\002\193\004\245\000\000\000\000\002\161\006\226\000\000\003_\001\238\000\000\002\177\003`\001\242\000\000\001\018\000\000\004X\002\170\001i\001j\002\167\000\000\002`\002a\001j\007\205\002\191\001\243\001\142\002\172\000\000\000\000\002d\001\214\002\169\000\235\005E\002\133\001k\002E\000\000\001m\001n\001\238\006\228\002\138\001\244\001\242\000\000\001\018\002\193\003\127\000\000\001\243\006\229\000\000\000\000\000\000\002\161\006\231\000\000\000\000\002c\000\000\002\173\000\000\002F\000\000\002\167\002`\002a\001j\001\244\006\233\004#\000\000\002\169\000\235\000\255\000\000\002d\000\000\002\169\000\235\002\133\000\000\000\000\002\176\001\243\000\000\002\177\006\234\002\138\000\000\000\000\000\000\000\000\002\170\003\130\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\191\001\244\001\142\002\172\000\000\004\027\002\173\000\000\000\000\000\000\000\000\001r\000\000\000\000\000\000\000\000\002\167\000\000\000\000\000\000\002`\002a\001j\001s\002\193\000\000\000\235\000\000\002d\002\176\002\169\000\235\002\177\002\170\000\000\002\133\000\000\000\000\000\000\002\170\000\000\000\000\002\171\002\138\001\142\002\172\000\000\000\000\002\191\003\179\001\142\002\172\000\000\000\000\000\000\000\000\002\161\000\000\002G\000\000\002\173\000\000\000\000\002\167\000\000\000\000\000\000\002`\002a\001j\000\000\006\219\002\193\000\000\000\000\002d\000\000\002\169\000\235\002I\003a\000\000\002\133\002\176\000\000\000\000\002\177\000\000\001\132\006\220\002\138\000\000\006\222\002\170\000\000\000\000\003\188\001\141\000\000\001\142\001q\006\223\002\191\002\161\001\142\002\172\000\000\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\000\000\002\193\000\000\000\000\002\133\002\176\006\224\002d\002\177\002\169\000\235\000\000\002\138\000\000\000\000\002\170\000\000\000\000\003\197\000\000\000\000\000\000\000\000\000\000\002\191\002\161\001\142\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\002a\001j\000\000\002\173\000\000\000\000\002\167\006\225\000\000\000\000\000\000\000\000\002\193\000\000\002\133\000\000\000\000\006\226\002d\000\000\002\169\000\235\002\138\000\000\001\026\000\000\002\176\0079\004\002\002\177\000\000\000\000\000\000\000\000\000\000\002\161\002\170\000\000\001i\001j\000\000\006\248\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\002\173\001\029\000\000\002\167\000\000\000\000\006\228\000\000\001k\001z\000\000\001m\001n\000\000\000\000\002d\006\229\002\169\000\235\002\193\000\000\006\231\000\000\002\176\000\000\000\000\002\177\000\000\000\000\000\000\000\000\002V\000\000\002\170\000\000\006\233\002`\002a\001j\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\002\173\000\000\002\167\000\000\002\133\001{\006\234\001|\002/\000\000\000\000\000\000\002\138\000\000\002d\001\031\002\169\000\235\004\005\002\193\002`\002a\001j\002\176\000\000\002\161\002\177\000\000\000\000\000\000\000\000\000\000\001 \002\170\000\000\002\133\000\000\000\000\001\018\001&\001\130\000\000\002\191\002\138\001\142\002\172\002\173\000\000\000\000\004+\000\000\000\000\001s\000\000\000\000\000\235\002\161\000\000\002`\002a\001j\000\000\000\000\002Y\000\000\000\000\002\193\000\000\001\214\002\176\000\000\005P\002\177\002\133\000\000\000\000\000\000\000\000\001\238\002\170\000\000\002\138\001\242\000\000\001\018\000\000\000\000\004-\002\191\002\167\001\142\002\172\000\000\001(\002\161\000\000\001)\000\000\000\000\001*\001+\002d\000\000\002\169\000\235\000\000\001\026\002`\002a\001j\000\000\000\000\002\193\000\000\000\000\000\000\000\000\001\132\000\000\000\000\002\167\000\000\002\133\001\243\000\000\001,\001\133\000\000\001\142\001q\002\138\000\000\002d\002\173\002\169\000\235\0043\000\000\002`\002a\001j\001\214\001\244\002\161\005V\000\000\000\000\000\000\000\000\000\000\000\000\001\238\000\000\002\133\000\000\001\242\002\176\001\018\002\167\002\177\000\000\002\138\000\000\000\000\002\173\000\000\002\170\0046\000\000\000\000\002d\000\000\002\169\000\235\002\161\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\176\000\000\000\000\002\177\000\000\000\000\000\000\001\031\000\000\001\243\002\170\000\000\002\193\000\000\000\000\002\173\000\000\000\000\000\000\002\191\002\167\001\142\002\172\000\000\001 \000\000\000\000\000\000\001\244\000\000\001\018\001&\002d\000\000\002\169\000\235\000\000\000\000\002\176\000\000\000\000\002\177\000\000\002\193\000\000\000\000\001\026\000\000\002\170\001\027\000\000\002\167\000\000\002`\002a\001j\000\000\002\191\000\000\001\142\002\172\000\000\000\000\002d\002\173\002\169\000\235\000\000\002\133\000\000\000\000\000\000\000\000\001\029\000\000\005\235\002\138\000\000\002`\002a\001j\002\193\004l\000\000\000\000\001(\000\000\002\176\001)\002\161\002\177\001*\001+\002\133\000\000\002\173\000\000\002\170\000\000\000\000\000\000\002\138\000\000\005\236\000\000\005\237\002\191\004y\001\142\002\172\000\000\000\000\000\000\000\000\002\161\000\000\000\000\002K\002\176\001#\000\000\002\177\001\214\000\000\000\000\005_\000\000\000\000\002\170\000\000\002\193\000\000\001\238\000\000\001\031\005\238\001\242\002\191\001\018\001\142\002\172\000\000\000\000\000\000\000\000\000\000\000\000\002`\002a\001j\000\000\001 \000\000\002\167\000\000\000\000\000\000\001\018\001&\000\000\000\000\002\193\002\133\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\138\005\239\002`\002a\001j\000\000\004\171\001\243\002\167\000\000\000\000\005\240\005\241\002\161\005\242\000\000\000\000\002\133\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\138\001\244\002\173\000\000\000\000\000\000\005\r\000\000\000\000\007;\000\000\000\000\006,\002\161\000\000\000\000\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\002\176\000\000\002\173\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\170\005\244\000\000\000\000\000\000\000\000\005\246\006\000\000\000\002\191\000\000\001\142\002\172\000\000\001,\002\176\000\000\002\167\002\177\000\000\006*\000\000\000\000\000\000\000\000\002\170\002`\002a\001j\002d\000\000\002\169\000\235\002\193\002\191\000\000\001\142\002\172\006+\000\000\000\000\002\133\002\167\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\002d\006@\002\169\000\235\002\193\000\000\000\000\002\173\002\161\000\000\000\000\000\000\000\000\000\000\000\000\001\214\000\000\000\000\005g\000\000\000\000\002`\002a\001j\000\000\001\238\000\000\000\000\000\000\001\242\002\176\001\018\002\173\002\177\000\000\000\000\002\133\000\000\000\000\000\000\002\170\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\002\191\006C\001\142\002\172\000\000\000\000\002\176\000\000\002\161\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\001\243\000\000\002\167\002\193\002\191\000\000\001\142\002\172\002`\002a\001j\000\000\000\000\000\000\002d\000\000\002\169\000\235\000\000\001\244\006\219\000\000\000\000\002\133\000\000\000\000\000\000\000\000\002\193\000\000\000\000\002\138\001i\001j\000\000\007\202\000\000\006R\007\203\000\000\000\000\006\222\000\000\000\000\002\161\000\000\002\173\000\000\000\000\000\000\006\223\002\167\001k\001z\000\000\001m\001n\000\000\002`\002a\001j\000\000\000\000\002d\000\000\002\169\000\235\000\000\000\000\002\176\000\000\000\000\002\177\002\133\000\000\002\131\000\000\000\000\000\000\002\170\006\224\002\138\000\000\000\000\000\000\000\000\000\000\006U\002\191\000\000\001\142\002\172\000\000\000\000\002\161\002\173\001{\000\000\001|\002/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\167\002`\002a\001j\002\193\000\000\000\000\000\000\000\000\006\225\002\176\000\000\002d\002\177\002\169\000\235\002\133\000\000\000\000\006\226\002\170\000\000\000\000\001\130\002\138\000\000\000\000\000\000\000\000\002\191\006b\001\142\002\172\000\000\000\000\001s\000\000\002\161\000\235\007\204\002`\002a\001j\000\000\002\173\000\000\002Y\000\000\000\000\000\000\002\167\000\000\000\000\002\193\000\000\002\133\000\000\000\000\006\228\000\000\000\000\000\000\002d\002\138\002\169\000\235\000\000\002\176\006\229\006e\002\177\000\000\000\000\006\231\000\000\000\000\002\161\002\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\191\006\233\001\142\002\172\000\000\000\000\000\000\000\000\002\173\000\000\000\000\000\000\001i\001j\001\132\002\167\000\000\000\000\000\000\006\234\000\000\000\000\000\000\001\133\002\193\001\142\001q\002d\000\000\002\169\000\235\002\176\001k\002E\002\177\001m\001n\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\000\000\002`\002a\001j\002\191\000\000\001\142\002\172\002\167\000\000\000\000\000\000\000\000\002\173\000\000\000\000\002\133\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\138\000\000\000\000\000\000\002\193\000\000\006z\000\000\000\000\000\000\000\000\000\000\002\176\002\161\000\000\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\170\002`\002a\001j\000\000\000\000\002\173\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\002\133\000\000\000\000\001r\000\000\000\000\001\026\000\000\002\138\001\027\000\000\000\000\000\000\002\176\006}\001s\002\177\002\193\000\235\000\000\000\000\002\161\000\000\002\170\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\002\191\001\029\001\142\002\172\000\000\000\000\000\000\002\167\000\000\002\133\000\000\005\026\000\000\000\000\002`\002a\001j\002\138\006\206\002d\000\000\002\169\000\235\006\129\002\193\000\000\000\000\007h\000\000\002\133\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\007m\000\000\000\000\000\000\001#\001\132\000\000\002\161\002\173\000\000\002\167\000\000\000\000\000\000\001\141\000\000\001\142\001q\000\000\001\031\000\000\000\000\002d\000\000\002\169\000\235\000\000\000\000\006\208\000\000\000\000\002\176\000\000\000\000\002\177\000\000\001 \000\000\000\000\000\000\000\000\002\170\001\018\001&\000\000\000\000\000\000\000\000\000\000\000\000\002\191\002\167\001\142\002\172\002\173\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\000\000\000\000\000\000\002\133\002\167\000\000\000\000\002\193\000\000\000\000\002\176\002\138\000\000\002\177\000\000\000\000\002d\007o\002\169\000\235\002\170\000\000\0012\000\000\002\161\000\000\000\000\000\000\002\173\002\191\001(\001\142\002\172\001)\000\000\000\000\001*\001+\005#\001\026\000\000\000\000\001$\000\000\000\000\000\000\000\000\000\000\002\173\000\000\000\000\002\176\000\000\002\193\002\177\001i\001j\000\000\000\000\000\000\000\000\002\170\001,\000\000\000\000\0016\001\029\000\000\000\000\000\000\002\191\002\176\001\142\002\172\002\177\001k\002E\000\000\001m\001n\000\000\002\170\002`\002a\001j\000\000\000\000\000\000\002\167\000\000\002\191\000\000\001\142\002\172\002\193\000\000\000\000\002\133\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\138\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\002\193\004\190\000\000\000\000\002\161\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000\000\001\031\000\000\000\000\002\138\000\000\002\173\000\000\002`\002a\001j\000\000\000\000\000\000\004e\000\000\000\000\002\161\001 \000\000\000\000\000\000\000\000\002\133\001\018\001&\000\000\000\000\001r\002\176\000\000\002\138\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\170\001s\003\247\000\000\000\235\002\161\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\193\000\000\000\000\006\206\002\133\000\000\000\000\001(\000\000\002\167\001)\000\000\002\138\001*\001+\000\000\000\000\001i\001j\000\000\000\000\002d\003\246\002\169\000\235\002\161\000\000\000\000\002\173\000\000\000\000\000\000\000\000\001\132\000\000\000\000\002\167\001k\001z\001,\001m\001n\001\141\000\000\001\142\001q\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\173\003\137\000\000\006\207\000\000\000\000\000\000\002\137\002\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\000\000\003\137\002\173\001{\000\000\001|\002/\000\000\002\170\001i\001j\002\167\000\000\000\000\000\000\000\000\002\193\002\191\000\000\001\142\002\172\000\000\000\000\002d\000\000\002\169\000\235\000\000\003\137\001k\001z\000\000\001m\001n\000\000\002\170\000\000\000\000\001\130\001i\001j\002\193\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\001s\000\000\002\166\000\235\000\000\002\173\000\000\000\000\000\000\001k\001z\002Y\001m\001n\000\000\000\000\001i\001j\002\193\000\000\000\000\000\000\000\000\001{\000\000\001|\002/\000\000\000\000\000\000\000\000\003\137\002\182\000\000\000\000\000\000\001k\001z\002\170\001m\001n\000\000\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\001{\000\000\001|\002/\000\000\001\130\002\188\000\000\000\000\000\000\000\000\000\000\001\132\000\000\000\000\000\000\000\000\001s\002\193\000\000\000\235\001\133\000\000\001\142\001q\000\000\000\000\001{\002Y\001|\002/\000\000\001i\001j\000\000\001\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\001k\001z\000\000\001m\001n\000\000\002Y\000\000\000\000\000\000\001\130\001i\001j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\002\197\000\000\000\235\000\000\000\000\001i\001j\001\132\001k\001z\002Y\001m\001n\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\001{\000\000\001|\002/\001k\002E\000\000\001m\001n\000\000\002\208\000\000\000\000\000\000\000\000\000\000\001\132\000\000\001i\001j\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\000\000\001{\000\000\001|\002/\001\130\001i\001j\001k\001z\000\000\001m\001n\001\132\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\001\133\000\000\001\142\001q\001k\001z\002Y\001m\001n\002\214\000\000\000\000\000\000\000\000\001\130\001i\001j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\002\220\000\000\000\235\001{\001r\001|\002/\000\000\001k\001z\002Y\001m\001n\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\001{\000\000\001|\002/\000\000\000\000\000\000\000\000\000\000\000\000\002\226\000\000\001\132\000\000\000\000\000\000\000\000\001\130\001i\001j\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\001s\006\206\001{\000\235\001|\002/\001\130\000\000\000\000\001k\001z\002Y\001m\001n\001\132\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\001\133\000\000\001\142\001q\000\000\000\000\002Y\000\000\001\132\002\232\000\000\000\000\000\000\000\000\001\130\001i\001j\001\141\000\000\001\142\001q\000\000\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\001{\006\215\001|\002/\000\000\001k\001z\002Y\001m\001n\000\000\000\000\001\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\002\238\000\000\001\132\000\000\000\000\000\000\000\000\001\130\001i\001j\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\001s\000\000\001{\000\235\001|\002/\000\000\000\000\000\000\001k\001z\002Y\001m\001n\001\132\000\000\000\000\000\000\001i\001j\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\000\000\002\244\000\000\000\000\000\000\000\000\001\130\001k\001z\000\000\001m\001n\000\000\000\000\000\000\001i\001j\000\000\001s\000\000\000\000\000\235\001{\000\000\001|\002/\000\000\000\000\000\000\002Y\002\250\000\000\000\000\000\000\001\132\001k\001z\000\000\001m\001n\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\001{\000\000\001|\002/\000\000\000\000\001\130\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\001{\002Y\001|\002/\001\132\001i\001j\001\130\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\001k\001z\000\000\001m\001n\002Y\000\000\000\000\001i\001j\001\130\000\000\000\000\000\000\001i\001j\000\000\000\000\000\000\000\000\000\000\000\000\001s\003\006\000\000\000\235\000\000\000\000\001k\001z\001\132\001m\001n\002Y\001k\001z\000\000\001m\001n\001\133\000\000\001\142\001q\000\000\001{\000\000\001|\002/\000\000\000\000\000\000\003\012\000\000\000\000\000\000\000\000\000\000\003\018\000\000\001\132\000\000\000\000\000\000\000\000\000\000\001i\001j\000\000\001\133\000\000\001\142\001q\001{\000\000\001|\002/\000\000\000\000\001{\001\130\001|\002/\000\000\000\000\000\000\001k\001z\001\132\001m\001n\000\000\001s\000\000\000\000\000\235\000\000\001\133\000\000\001\142\001q\000\000\000\000\002Y\000\000\000\000\000\000\000\000\001\130\003\024\000\000\000\000\000\000\000\000\001\130\001i\001j\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\001s\000\000\000\000\000\235\001{\002Y\001|\002/\000\000\001k\001z\002Y\001m\001n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\132\003\030\000\000\000\000\000\000\000\000\000\000\000\000\001\130\001\133\000\000\001\142\001q\001\026\000\000\000\000\000\000\000\000\000\000\000\000\001s\000\000\001{\000\235\001|\002/\000\000\000\000\001\132\000\000\000\000\002Y\000\000\000\000\001\132\000\000\000\000\001\133\000\000\001\142\001q\001i\001j\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001i\001j\001\130\000\000\000\000\000\000\001k\001z\000\000\001m\001n\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\001k\001z\000\000\001m\001n\002Y\000\000\000\000\000\000\003$\001\132\000\000\000\000\000\000\000\000\000\000\000\000\001i\001j\001\133\000\000\001\142\001q\003*\000\000\000\000\001\031\000\000\000\000\000\000\001{\000\000\001|\002/\000\000\000\000\000\000\001k\001z\000\000\001m\001n\000\000\001 \001{\000\000\001|\002/\000\000\001\018\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\132\0030\001\026\000\000\000\000\000\000\001\130\000\000\000\000\001\133\000\000\001\142\001q\001\026\000\000\000\000\005\208\000\000\001s\000\000\001\130\000\235\001{\000\000\001|\002/\000\000\000\000\000\000\002Y\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\001i\001j\001\029\000\000\000\000\002Y\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\000\000\000\000\001i\001j\001\130\001k\001z\000\000\001m\001n\000\000\000\000\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\001k\001z\004\154\001m\001n\002Y\0036\000\000\001\132\000\000\000\000\000\000\000\000\000\000\000\000\001\031\000\000\001\133\000\000\001\142\001q\000\000\001\132\003<\000\000\000\000\001\031\001{\000\000\001|\002/\001\133\001 \001\142\001q\000\000\000\000\000\000\001\018\001&\002`\002a\001j\001 \001{\000\000\001|\002/\000\000\001\018\001&\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\001\132\001i\001j\001\130\002\138\000\000\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\003\135\001s\000\000\002\161\000\235\000\000\001\130\001k\001z\000\000\001m\001n\002Y\002`\002a\001j\000\000\000\000\001s\000\000\001(\000\235\000\000\001)\000\000\000\000\001*\001+\002\133\002Y\003B\001(\000\000\000\000\001)\000\000\002\138\001*\001+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\139\000\000\000\000\002\161\000\000\001{\004\162\001|\002/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\000\000\001\132\002\167\000\000\000\000\002`\002a\001j\000\000\000\000\001\133\000\000\001\142\001q\002d\000\000\002\169\000\235\001\132\000\000\002\133\001\130\000\000\000\000\000\000\000\000\000\000\001\133\002\138\001\142\001q\000\000\000\000\001s\000\000\000\000\000\235\000\000\003\141\000\000\000\000\002\161\000\000\000\000\002Y\000\000\002\173\000\000\002\167\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\003\137\000\000\002\138\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\003\144\000\000\000\000\002\161\002\191\000\000\001\142\002\172\002\173\000\000\000\000\000\000\000\000\000\000\001\132\002`\002a\001j\000\000\000\000\000\000\002\167\000\000\001\133\000\000\001\142\001q\000\000\002\193\000\000\002\133\000\000\000\000\002d\003\137\002\169\000\235\000\000\002\138\000\000\000\000\002\170\000\000\000\000\000\000\000\000\000\000\000\000\003\151\000\000\002\191\002\161\001\142\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\002a\001j\000\000\002\173\000\000\002\167\000\000\001i\001j\000\000\000\000\000\000\002\193\000\000\002\133\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\138\000\000\000\000\000\000\000\000\001k\001z\003\137\001m\001n\003\160\000\000\000\000\002\161\002\170\001i\001j\000\000\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\002\173\003\157\000\000\000\000\002\167\000\000\000\000\000\000\001k\001z\000\000\001m\001n\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\193\000\000\001{\000\000\001|\002/\003\137\000\000\000\000\000\000\000\000\003\166\000\000\002\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\002\173\000\000\002\167\000\000\001{\000\000\001|\002/\000\000\001\130\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\193\000\000\000\000\001s\000\000\000\000\000\235\000\000\003\137\000\000\000\000\002`\002a\001j\002Y\002\170\002`\002a\001j\000\000\000\000\001\130\001i\001j\002\191\000\000\001\142\002\172\002\173\000\000\000\000\002\133\000\000\001s\003\241\000\000\000\235\000\000\000\000\002\138\000\000\000\000\001k\001z\002Y\001m\001n\000\000\002\193\003\169\000\000\000\000\002\161\000\000\003\137\000\000\000\000\000\000\003\242\000\000\000\000\002\170\000\000\000\000\000\000\003\175\000\000\000\000\001\132\005\235\002\191\000\000\001\142\002\172\000\000\000\000\000\000\001\133\000\000\001\142\001q\001i\001j\000\000\000\000\000\000\001{\000\000\001|\002/\000\000\000\000\000\000\000\000\002\193\000\000\000\000\005\236\001\132\005\237\000\000\001k\001z\000\000\001m\001n\000\000\001\133\000\000\001\142\001q\002c\000\000\000\000\000\000\000\000\002\167\000\000\001i\001j\000\000\001\130\000\000\002d\003\185\002\169\000\235\000\000\002d\005\238\002\169\000\235\000\000\001s\000\000\000\000\000\235\000\000\001k\001z\000\000\001m\001n\000\000\002Y\001{\000\000\001|\002/\000\000\000\000\000\000\000\000\001\026\000\000\000\000\000\000\000\000\000\000\003\244\002\173\003\194\000\000\000\000\000\000\005\239\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\240\005\241\000\000\005\242\000\000\001\130\000\000\001{\000\000\001|\002/\003\137\000\000\002\170\000\000\000\000\000\000\001s\002\170\000\000\000\235\000\000\002\171\001\132\001\142\002\172\005\243\002\191\002Y\001\142\002\172\000\000\001\133\000\000\001\142\001q\000\000\000\000\001i\001j\000\000\000\000\001\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\244\002\193\000\000\000\000\001s\005\246\006\000\000\235\001k\001z\000\000\001m\001n\000\000\000\000\002Y\001\031\000\000\000\000\006*\000\000\000\000\000\000\002`\002a\001j\000\000\002`\002a\001j\000\000\003\203\001\132\001 \000\000\000\000\000\000\006+\002\133\001\018\001&\001\133\002\133\001\142\001q\000\000\002\138\001i\001j\000\000\002\138\000\000\001{\000\000\001|\002/\003\208\000\000\000\000\002\161\003\217\000\000\000\000\002\161\000\000\000\000\000\000\001k\001z\001\132\001m\001n\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\001i\001j\001\130\000\000\000\000\003\214\000\000\000\000\000\000\001(\000\000\000\000\001)\000\000\001s\001*\001+\000\235\000\000\000\000\001k\001z\000\000\001m\001n\002Y\001{\000\000\001|\002/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\167\000\000\000\000\004\166\002\167\003\223\000\000\002`\002a\001j\000\000\000\000\002d\000\000\002\169\000\235\002d\000\000\002\169\000\235\000\000\000\000\002\133\001\130\000\000\000\000\001{\000\000\001|\002/\002\138\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\003\226\001\132\000\000\002\161\002\173\000\000\002Y\000\000\002\173\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\000\000\001i\001j\001\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\137\000\000\000\000\001s\003\137\000\000\000\235\002\170\000\000\001k\001z\002\170\001m\001n\002Y\000\000\002\191\000\000\001\142\002\172\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\000\000\000\000\001\132\000\000\003\232\000\000\000\000\000\000\000\000\002\167\000\000\001\133\002\193\001\142\001q\000\000\002\193\000\000\001i\001j\000\000\002d\000\000\002\169\000\235\001{\000\000\001|\002/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001k\001z\001\132\001m\001n\000\000\002`\002a\001j\000\000\000\000\001\133\000\000\001\142\001q\002\173\000\000\000\000\000\000\000\000\000\000\002\133\001\130\003\239\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\003\250\000\000\003\137\002\161\000\000\001{\002Y\001|\002/\002\170\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\002\193\003\253\000\000\000\000\002\161\002`\002a\001j\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\000\000\000\000\001\132\000\000\002\133\002Y\000\000\000\000\000\000\002\167\000\000\001\133\002\138\001\142\001q\000\000\000\000\000\000\000\000\000\000\000\000\002d\004\014\002\169\000\235\002\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\167\002\173\002\133\000\000\000\000\001i\001j\001\132\000\000\000\000\002\138\000\000\002d\000\000\002\169\000\235\001\133\000\000\001\142\001q\004\018\000\000\000\000\002\161\000\000\001k\001z\003\137\001m\001n\000\000\000\000\000\000\000\000\002\170\000\000\000\000\002\167\000\000\001i\001j\000\000\000\000\002\191\002\173\001\142\002\172\000\000\004>\002d\000\000\002\169\000\235\000\000\000\000\000\000\000\000\000\000\000\000\001k\001z\000\000\001m\001n\000\000\000\000\000\000\002\193\000\000\001{\003\137\001|\002/\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\002\173\004C\000\000\000\000\000\000\002\191\002\167\001\142\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\001{\001\130\001|\002/\003\137\000\000\000\000\002\193\000\000\000\000\000\000\002\170\000\000\001s\000\000\000\000\000\235\001i\001j\000\000\002\191\000\000\001\142\002\172\002Y\000\000\000\000\000\000\002\173\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001k\001z\000\000\001m\001n\001i\001j\002\193\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\000\000\003\137\000\000\000\000\000\000\002Y\000\000\004J\002\170\001k\001z\000\000\001m\001n\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\001i\001j\001\132\000\000\000\000\001{\000\000\001|\002/\004S\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\002\193\000\000\001k\001z\000\000\001m\001n\000\000\000\000\000\000\000\000\000\000\001{\000\000\001|\002/\000\000\000\000\001\132\000\000\003F\001j\001\130\000\000\000\000\004]\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\003b\001z\000\000\001m\001n\002Y\001{\001\130\001|\002/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\002`\002a\001j\000\000\000\000\000\000\000\000\002Y\000\000\000\000\000\000\000\000\000\000\000\000\001i\001j\000\000\000\000\001\130\000\000\003g\003s\003t\004W\000\000\000\000\002`\002a\001j\000\000\001s\000\000\000\000\000\235\001k\001z\001\132\001m\001n\000\000\000\000\002Y\000\000\000\000\000\000\001\133\000\000\001\142\001q\004O\000\000\000\000\000\000\000\000\000\000\000\000\001\130\004\187\000\000\000\000\000\000\001\132\000\000\000\000\000\000\001i\001j\000\000\001s\000\000\001\133\000\235\001\142\001q\000\000\000\000\000\000\000\000\001{\000\000\001|\002/\000\000\000\000\000\000\001k\001z\000\000\001m\001n\000\000\000\000\000\000\000\000\000\000\001\132\001i\001j\000\000\000\000\002c\003w\004\177\000\000\001\133\000\000\001\142\001q\004\207\000\000\000\000\000\000\002d\001\130\002\169\000\235\001k\001z\000\000\001m\001n\001\026\000\000\000\000\001\027\001s\002c\000\000\000\235\001{\000\000\001|\002/\001\132\000\000\000\000\002Y\000\000\002d\004\211\002\169\000\235\001\133\001\026\001\142\001q\001\027\000\000\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\026\000\000\001{\000\000\001|\002/\001\130\000\000\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\005\029\000\000\001s\002\170\000\000\000\235\005\026\000\000\000\000\000\000\000\000\000\000\002\171\002Y\001\142\002\172\001\132\000\000\000\000\000\000\001#\001\130\005\147\000\000\000\000\001\133\000\000\001\142\001q\002\170\000\000\000\000\000\000\001s\000\000\001\031\000\235\000\000\002\171\000\000\001\142\002\172\001#\000\000\002Y\001i\001j\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\001\031\001\018\001&\000\000\000\000\006~\000\000\000\000\001k\002E\001\132\001m\001n\000\000\000\000\000\000\000\000\001 \000\000\001\133\000\000\001\142\001q\001\018\001&\000\000\000\000\000\000\000\000\000\000\001\026\000\000\000\000\001\027\000\000\000\000\002F\000\000\000\000\001\026\000\000\001\132\001\027\000\000\000\000\000\000\000\000\000\000\0012\000\000\001\133\000\000\001\142\001q\000\000\000\000\001(\001\029\000\000\001)\000\000\000\000\001*\001+\005#\000\000\001\029\005\026\000\000\000\000\0012\000\000\000\000\000\000\000\000\000\000\005\026\000\000\001(\000\000\000\000\001)\000\000\006c\001*\001+\005#\001r\001,\000\000\000\000\0016\006q\000\000\000\000\001\026\000\000\000\000\001\027\001s\000\000\000\000\000\235\001#\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\001#\0016\000\000\000\000\000\000\000\000\001\031\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001\031\000\000\000\000\000\000\000\000\005\026\000\000\002G\001 \000\000\000\000\000\000\000\000\000\000\001\018\001&\000\000\001 \000\000\000\000\000\000\006{\000\000\001\018\001&\000\000\000\000\000\000\003[\003a\000\000\000\000\000\000\000\000\003F\001j\000\000\001\132\000\000\001i\001j\001#\000\000\000\000\003F\001j\001\141\000\000\001\142\001q\000\000\000\000\000\000\000\000\003b\001z\001\031\001m\001n\001k\001z\0012\001m\001n\003b\001z\000\000\001m\001n\001(\0012\000\000\001)\001 \000\000\001*\001+\005#\001(\001\018\001&\001)\007\t\000\000\001*\001+\005#\001\026\000\000\000\000\001\027\000\000\000\000\000\000\000\000\000\000\000\000\003g\003s\003t\000\000\001,\000\000\001{\0016\001|\002/\003g\003s\003t\001,\000\000\000\000\0016\001\029\000\000\007<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0012\000\000\000\000\000\000\000\000\000\000\000\000\001\130\001(\000\000\000\000\001)\001\130\000\000\001*\001+\005#\001\130\000\000\001s\000\000\000\000\000\235\000\000\001s\000\000\000\000\000\235\000\000\001s\000\000\000\000\000\235\000\000\001#\002Y\000\000\000\000\001\026\000\000\001,\001\027\000\000\0016\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\003w\006\140\000\000\000\000\001i\001j\000\000\000\000\000\000\000\000\003w\006\174\000\000\001\029\001 \000\000\002`\002a\001j\000\000\001\018\001&\000\000\004\139\001k\001z\000\000\001m\001n\000\000\000\000\002\133\001\132\000\000\000\000\000\000\000\000\001\132\007-\002\138\000\000\001\133\001\132\001\142\001q\000\000\001\133\000\000\001\142\001q\000\000\001\133\002\161\001\142\001q\000\000\000\000\000\000\000\000\001#\000\000\000\000\000\000\000\000\002`\002a\001j\0012\001{\000\000\001|\001\146\000\000\000\000\001\031\001(\000\000\000\000\001)\002\133\000\000\001*\001+\007C\000\000\000\000\000\000\002\138\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\000j\001\018\001&\000\000\002\161\000\000\000\000\001\130\000\000\000\000\000\000\001,\000\000\000\000\0016\000\000\000\000\000\000\000\000\001s\002\167\000\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\000\000\001i\001j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0012\000\000\000\000\001i\001j\000\000\000\000\000\000\001(\001k\001z\001)\001m\001n\001*\001+\002\173\000\000\000\000\001\179\002\167\000\000\000\000\001k\001z\000\000\001m\001n\000\000\002`\002a\001j\002d\001\165\002\169\000\235\001\132\000\000\000\000\000\000\001,\000\000\004\222\004\146\002\133\001\133\000\000\001\142\001q\002\170\000\000\000\000\002\138\001{\000\000\001|\001\167\000\000\002\191\000\000\001\142\002\172\000\000\000\000\002\173\002\161\000\000\001{\000\000\001|\001\167\001i\001j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\193\000\000\000\000\000\000\000\000\000\000\001\130\000\000\004\188\001k\001z\000\000\001m\001n\000\000\002\170\000\000\000\000\001s\001\169\001\130\000\235\000\000\000\000\002\191\000\000\001\142\002\172\002`\002a\001j\000\000\001s\000\000\000\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002`\002a\001j\002\167\002\193\001i\001j\002\138\000\000\001{\000\000\001|\001\167\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\161\000\000\000\000\003\241\000\000\001k\001z\000\000\001m\001n\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\001\132\000\000\000\000\000\000\000\000\001\130\000\000\002\133\002\173\001\133\000\000\001\142\001q\000\000\001\132\002\138\000\000\001s\000\000\000\000\000\235\000\000\000\000\001\133\000\000\001\142\001q\000\000\002\161\000\000\001{\000\000\001|\002/\004^\000\000\000\000\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\002\167\001i\001j\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\002d\000\000\002\169\000\235\002c\000\000\000\000\000\000\001\130\001k\001z\000\000\001m\001n\000\000\000\000\002d\002\193\002\169\000\235\001s\000\000\000\000\000\235\000\000\001\132\000\000\000\000\000\000\000\000\000\000\0047\002\173\000\000\001\133\002\167\001\142\001q\000\000\000\000\001i\001j\000\000\000\000\002`\002a\001j\002d\000\000\002\169\000\235\000\000\003\243\001{\000\000\001|\0027\000\000\004U\002\133\001k\001z\000\000\001m\001n\002\170\000\000\002\138\000\000\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\002\173\002\161\002\170\000\000\000\000\000\000\001\132\000\000\000\000\001\130\000\000\002\171\000\000\001\142\002\172\001\133\000\000\001\142\001q\002\193\000\000\001s\006\219\000\000\000\235\001{\004/\001|\002/\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\000\000\000\000\007\193\000\000\002\191\006\222\001\142\002\172\000\000\000\000\000\000\000\000\000\000\002:\006\223\000\000\000\000\002`\002a\001j\000\000\000\000\001\130\000\000\000\000\000\000\000\000\002\167\002\193\000\000\000\000\000\000\002\133\000\000\001s\000\000\000\000\000\235\000\000\002d\002\138\002\169\000\235\000\000\006\224\002X\000\000\000\000\001\132\000\000\000\000\000\000\000\000\002\161\002`\002a\001j\001\133\000\000\001\142\001q\000\000\000\000\000\000\002`\002a\001j\000\000\000\000\002\133\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\138\000\000\002\133\000\000\006\225\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\002\161\006\226\000\000\000\000\000\000\000\000\000\000\003\245\000\000\001\132\002\161\000\000\000\000\000\000\002\170\000\000\000\000\000\000\001\133\000\000\001\142\001q\007\194\002\191\000\000\001\142\002\172\002\167\000\000\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\002d\006\228\002\169\000\235\000\000\000\000\000\000\002\133\002\193\000\000\000\000\006\229\000\000\000\000\000\000\002\138\006\231\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\002\167\000\000\000\000\002\161\000\000\006\233\000\000\002\173\000\000\002\133\002\167\000\000\002d\000\000\002\169\000\235\000\000\002\138\000\000\002`\002a\001j\002d\006\234\002\169\000\235\000\000\000\000\000\000\000\000\002\161\000\000\000\000\003}\002\133\000\000\000\000\000\000\000\000\000\000\002\170\000\000\002\138\000\000\002\173\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\002\173\002\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\167\000\000\000\000\002\183\000\000\000\000\002\193\000\000\000\000\000\000\002\170\000\000\002d\002\189\002\169\000\235\000\000\000\000\000\000\002\191\002\170\001\142\002\172\000\000\000\000\000\000\000\000\002\167\000\000\002\191\000\000\001\142\002\172\002`\002a\001j\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\193\002\173\000\000\000\000\000\000\002\133\000\000\000\000\000\000\002\167\002\193\000\000\000\000\002\138\000\000\002`\002a\001j\000\000\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\161\002\198\002\173\000\000\002\133\000\000\000\000\000\000\002\170\000\000\000\000\000\000\002\138\000\000\002`\002a\001j\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\002\161\000\000\002\173\002\209\002\133\000\000\001i\001j\000\000\000\000\002\170\000\000\002\138\000\000\000\000\000\000\002\193\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\002\161\001k\001l\002\215\001m\001n\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\002\167\000\000\000\000\000\000\002\193\002\191\000\000\001\142\002\172\002`\002a\001j\002d\000\000\002\169\000\235\000\000\000\000\000\000\002`\002a\001j\000\000\000\000\002\133\002\167\000\000\000\000\000\000\002\193\000\000\000\000\002\138\000\000\002\133\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\138\000\000\002\173\002\161\000\000\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\002\161\002`\002a\001j\000\000\000\000\000\000\002d\000\000\002\169\000\235\001r\000\000\000\000\002\173\002\221\002\133\000\000\000\000\000\000\000\000\000\000\002\170\001s\002\138\000\000\000\235\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\002\161\000\000\002\173\002\227\000\000\000\000\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\000\000\000\000\002\167\002\193\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\002\167\002\233\002d\000\000\002\169\000\235\000\000\000\000\002\170\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\193\002\191\000\000\001\142\002\172\000\000\000\000\000\000\001\132\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\001\141\002\173\001\142\001q\002\167\000\000\000\000\000\000\002\193\002\133\000\000\002\173\001i\001j\000\000\000\000\002d\002\138\002\169\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\239\000\000\000\000\002\161\000\000\001k\001\140\002\170\001m\001n\002\245\000\000\000\000\000\000\000\000\000\000\002\191\002\170\001\142\002\172\000\000\002\173\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\251\000\000\002\133\002\193\000\000\000\000\000\000\002\170\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\002\167\000\000\000\000\002\161\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\000\000\001r\000\000\002\133\002\193\000\000\000\000\000\000\002`\002a\001j\002\138\000\000\001s\000\000\000\000\000\235\000\000\000\000\001i\001j\000\000\000\000\002\133\002\161\000\000\000\000\000\000\002\173\000\000\000\000\002\138\001i\001j\000\000\002`\002a\001j\000\000\001k\001z\000\000\001m\001n\002\161\002`\002a\001j\000\000\000\000\002\133\002\167\001k\001z\003\001\001m\001n\000\000\002\138\000\000\002\133\002\170\000\000\002d\000\000\002\169\000\235\000\000\002\138\000\000\002\191\002\161\001\142\002\172\000\000\000\000\000\000\000\000\001\132\000\000\000\000\002\161\000\000\001{\000\000\001|\006\255\001\141\002\167\001\142\001q\000\000\000\000\000\000\002\193\002\173\001{\000\000\001|\007\171\002d\007\173\002\169\000\235\000\000\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\002d\003\007\002\169\000\235\000\000\000\000\000\000\000\000\002\170\000\000\001s\001\130\002\173\000\235\000\000\002\167\000\000\002\191\000\000\001\142\002\172\000\000\000\000\001s\000\000\002\167\000\235\002d\000\000\002\169\000\235\000\000\002\173\000\000\000\000\000\000\000\000\002d\003\r\002\169\000\235\002\193\000\000\000\000\000\000\002\170\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\002\191\000\000\001\142\002\172\003\019\002\173\000\000\000\000\002\133\000\000\000\000\002\170\000\000\000\000\000\000\002\173\002\138\000\000\000\000\000\000\002\191\001\132\001\142\002\172\002\193\000\000\000\000\000\000\000\000\002\161\001\133\003\025\001\142\001q\001\132\000\000\000\000\000\000\002\170\000\000\000\000\003\031\000\000\001\133\002\193\001\142\001q\002\191\002\170\001\142\002\172\000\000\002`\002a\001j\000\000\000\000\002\191\000\000\001\142\002\172\000\000\002`\002a\001j\000\000\000\000\002\133\000\000\000\000\000\000\002\193\002`\002a\001j\002\138\000\000\002\133\000\000\000\000\000\000\002\193\000\000\000\000\000\000\002\138\000\000\000\000\002\161\000\000\000\000\000\000\000\000\002\167\000\000\002b\000\000\000\000\002\161\002`\002a\001j\000\000\000\000\000\000\002d\000\000\002\169\000\235\002`\002a\001j\000\000\000\000\002\133\000\000\000\000\000\000\000\000\002`\002a\001j\002\138\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\002\133\002\161\000\000\002\173\000\000\000\000\000\000\000\000\002\138\000\000\000\000\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\167\000\000\000\000\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\167\003%\002d\000\000\002\169\000\235\000\000\000\000\002\170\000\000\002c\000\000\002d\000\000\002\169\000\235\000\000\002\191\000\000\001\142\002\172\000\000\002d\000\000\002\169\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\173\000\000\000\000\002\167\000\000\000\000\000\000\002\193\000\000\000\000\002\173\000\000\000\000\002\167\000\000\002d\000\000\002\169\000\235\000\000\000\000\000\000\000\000\002\167\000\000\002d\003+\002\169\000\235\000\000\000\000\001\026\000\000\002\170\001\027\002d\0031\002\169\000\235\000\000\000\000\000\000\002\191\002\170\001\142\002\172\000\000\002\173\002`\002a\001j\000\000\002\191\002\170\001\142\002\172\000\000\002\173\001\029\000\000\000\000\000\000\002\171\002\133\001\142\002\172\002\193\002\173\003P\000\000\000\000\002\138\000\000\0037\000\000\000\000\002\193\000\000\000\000\000\000\002\170\000\000\000\000\003=\002\161\000\000\000\000\000\000\000\000\002\191\002\170\001\142\002\172\003C\000\000\002`\002a\001j\000\000\002\191\002\170\001\142\002\172\000\000\001#\000\000\000\000\000\000\000\000\002\191\002\133\001\142\002\172\002\193\000\000\000\000\000\000\000\000\002\138\001\031\000\000\000\000\000\000\002\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\000\000\002\193\000\000\000\000\001 \000\000\002`\002a\001j\000\000\001\018\001&\000\000\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\002\133\000\000\002`\002a\001j\000\000\000\000\002d\002\138\002\169\000\235\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\002\161\002`\002a\001j\002\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0012\002\133\002\161\002\173\000\000\000\000\002\167\000\000\001(\002\138\000\000\001)\000\000\000\000\001*\001+\002\145\000\000\002d\000\000\002\169\000\235\002\161\000\000\000\000\000\000\000\000\000\000\000\000\003\158\000\000\000\000\000\000\000\000\001i\001j\002\170\000\000\000\000\000\000\001,\000\000\000\000\0016\000\000\002\191\000\000\001\142\002\172\002\167\002\173\000\000\000\000\000\000\001k\002D\000\000\001m\001n\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\167\000\000\000\000\002\193\000\000\000\000\000\000\002`\002a\001j\003\167\000\000\002d\000\000\002\169\000\235\000\000\002\170\000\000\000\000\002\167\000\000\002\133\000\000\000\000\000\000\002\191\002\173\001\142\002\172\002\138\000\000\002d\000\000\002\169\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\173\000\000\000\000\000\000\000\000\000\000\002\193\000\000\000\000\003\176\000\000\000\000\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\002\173\000\000\000\000\001r\000\000\002\191\003\186\001\142\002\172\000\000\000\000\000\000\000\000\002\170\000\000\001s\000\000\000\000\000\235\000\000\000\000\000\000\002\191\000\000\001\142\002\172\003\195\000\000\000\000\002\193\000\000\000\000\000\000\002\170\000\000\000\000\002`\002a\001j\000\000\000\000\000\000\002\191\002\167\001\142\002\172\002\193\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\138\000\000\002`\002a\001j\000\000\000\000\002\193\002`\002a\001j\000\000\000\000\002\161\000\000\000\000\000\000\002\133\000\000\000\000\000\000\001\132\000\000\002\133\000\000\002\138\000\000\000\000\002\173\000\000\001\141\002\138\001\142\001q\000\000\000\000\000\000\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\000\000\003\204\000\000\000\000\000\000\000\000\000\000\002\133\002\170\001\181\001j\000\000\000\000\000\000\000\000\002\138\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\002\167\000\000\000\000\000\000\002\161\001k\002t\000\000\001m\001n\000\000\000\000\002d\000\000\002\169\000\235\000\000\002\193\002`\002a\001j\000\000\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\000\000\002\167\000\000\002\133\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\138\000\000\002d\002\173\002\169\000\235\000\000\004\000\003s\003t\000\000\000\000\000\000\002\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\167\002\173\003\215\000\000\000\000\000\000\000\000\002\173\000\000\002\170\000\000\000\000\002d\000\000\002\169\000\235\001\130\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\000\000\000\000\003\224\001s\000\000\000\000\000\235\000\000\003\233\002\170\002`\002a\001j\000\000\000\000\002\170\000\000\002\193\002\191\002\173\001\142\002\172\000\000\000\000\002\191\002\167\001\142\002\172\000\000\000\000\000\000\000\000\004\007\002{\002`\002a\001j\002d\000\000\002\169\000\235\000\000\002\193\000\000\000\000\003\240\000\000\000\000\002\193\002\133\000\000\000\000\002\170\000\000\000\000\001\026\000\000\002\138\001\027\000\000\000\000\002\191\000\000\001\142\002\172\000\000\000\000\000\000\001\132\002\173\002\161\002`\002a\001j\000\000\000\000\000\000\001\133\000\000\001\142\001q\000\000\001\029\000\000\000\000\002\193\002\133\005\158\000\000\001\026\000\000\000\000\001\027\000\000\002\138\004E\000\000\000\000\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\002\161\000\000\000\000\002c\002\191\000\000\001\142\002\172\000\000\001\029\000\000\000\000\000\000\001\026\000\000\002d\001\027\002\169\000\235\004\139\000\000\001#\000\000\000\000\000\000\000\000\000\000\002\167\002\193\000\000\000\000\000\000\000\000\000\000\004\142\000\000\001\031\000\000\000\000\002d\001\029\002\169\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \001\026\001#\000\000\001\027\000\000\001\018\001&\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\000\000\001\031\002\173\000\000\000\000\000\000\000\000\002d\000\000\002\169\000\235\002\170\001\029\000\000\000\000\000\000\000\000\001#\001 \000\000\002\171\000\000\001\142\002\172\001\018\001&\000\000\001\026\004D\000\000\001\027\000\000\001\031\000\000\000\000\002\170\000\000\0012\000\000\002\173\000\000\000\000\000\000\000\000\002\191\001(\001\142\002\172\001)\001 \000\000\001*\001+\005\163\001\029\001\018\001&\000\000\001#\006\148\001\026\000\000\000\000\001\027\000\000\004K\000\000\000\000\002\193\000\000\000\000\0012\002\170\001\031\000\000\000\000\000\000\001,\000\000\001(\0016\002\191\001)\001\142\002\172\001*\001+\001\029\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\001#\001\026\0012\000\000\001\027\002\193\000\000\000\000\000\000\000\000\001(\001,\000\000\001)\004\146\001\031\001*\001+\005\176\001\026\000\000\005\179\001\027\000\000\000\000\000\000\000\000\000\000\001\029\007\143\000\000\000\000\001 \001#\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\001,\0012\000\000\0016\001\029\000\000\001\031\000\000\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\005\176\000\000\000\000\006\192\000\000\000\000\001 \000\000\001\026\000\000\000\000\001\027\001\018\001&\000\000\001#\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\0012\0016\000\000\000\000\001\031\000\000\000\000\001#\001(\001\029\000\000\001)\000\000\000\000\001*\001+\005\163\001G\000\000\000\000\000\000\001 \001\031\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\000\000\001\026\0012\000\000\005\215\000\000\000\000\000\000\001 \001,\001(\000\000\0016\001)\001\018\001&\001*\001+\007\144\000\000\000\000\000\000\000\000\000\000\001#\000\000\001i\001j\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001,\0012\000\000\0016\001k\001z\000\000\001m\001n\001(\000\000\000\000\001)\000\000\001 \001*\001+\001]\000\000\0012\001\018\001&\001i\001j\000\000\000\000\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\0013\000\000\000\000\000\000\000\000\000\000\001,\001k\001z\0016\001m\001n\001\031\001{\000\000\001|\001\171\000\000\001i\001j\000\000\000\000\000\000\000\000\001,\000\000\000\000\0016\000\000\001 \000\000\000\000\0012\000\000\000\000\001\018\001&\000\000\001k\001z\001(\001m\001n\001)\001i\001j\001*\001+\001\130\000\000\000\000\001{\000\000\001|\001\161\000\000\000\000\001i\001j\000\000\001s\000\000\000\000\000\235\001k\001z\000\000\001m\001n\000\000\000\000\000\000\001,\000\000\000\000\001K\000\000\001k\001z\000\000\001m\001n\001{\000\000\001|\001\158\001\130\000\000\000\000\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\001s\000\000\000\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\001{\000\000\001|\001~\000\000\000\000\000\000\000\000\000\000\001\130\000\000\000\000\000\000\001{\001,\001|\001\128\001\132\001i\001j\000\000\001s\000\000\000\000\000\235\000\000\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\000\000\001\130\000\000\000\000\001k\001z\000\000\001m\001n\000\000\000\000\000\000\000\000\001s\001\130\000\000\000\235\000\000\001i\001j\000\000\001\132\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\001k\001z\000\000\001m\001n\000\000\000\000\001i\001j\000\000\001{\000\000\001|\001\131\001\132\001\026\000\000\000\000\001\027\000\000\000\000\000\000\000\000\001\133\000\000\001\142\001q\001k\001z\000\000\001m\001n\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\001\132\000\000\001\029\000\000\001{\001\130\001|\001\157\000\000\001\133\000\000\001\142\001q\001\132\000\000\002}\000\000\001s\000\000\000\000\000\235\000\000\001\133\000\000\001\142\001q\001\026\000\000\000\000\001\027\000\000\001{\000\000\001|\001\149\000\000\000\000\000\000\000\000\001\130\000\000\000\000\000\000\000\000\000\000\000\000\001\026\000\000\001#\001\027\000\000\001s\000\000\001\029\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001\130\000\000\000\000\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001s\000\000\001 \000\235\001\132\000\000\000\000\000\000\001\018\001&\000\000\000\000\000\000\001\133\002c\001\142\001q\000\000\000\000\001i\001j\001#\000\000\000\000\001\026\000\000\002d\001\027\002\169\000\235\000\000\000\000\000\000\000\000\000\000\000\000\001\031\000\000\001\132\001k\001z\001#\001m\001n\000\000\000\000\000\000\001\133\000\000\001\142\001q\001\029\000\000\001 \000\000\0012\001\031\000\000\000\000\001\018\001&\000\000\000\000\001(\000\000\001\132\001)\000\000\000\000\001*\001+\001\151\001\026\001 \001\133\001\027\001\142\001q\000\000\001\018\001&\000\000\000\000\001{\000\000\001|\001\154\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\001,\000\000\001#\0016\001\029\002\171\000\000\001\142\002\172\001i\001j\0012\000\000\000\000\000\000\000\000\000\000\001\031\000\000\001(\000\000\000\000\001)\001\130\000\000\001*\001+\001\186\000\000\001k\001z\0012\001m\001n\001 \001s\000\000\000\000\000\235\001(\001\018\001&\001)\000\000\000\000\001*\001+\001\228\000\000\000\000\001#\001,\001\026\000\000\0016\001\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\000\000\000\000\000\000\001,\000\000\001{\0016\001|\002]\000\000\000\000\001\029\000\000\000\000\001 \000\000\000\000\000\000\000\000\0012\001\018\001&\000\000\000\000\000\000\000\000\001\026\001(\000\000\001\027\001)\000\000\001\132\001*\001+\001\230\001\026\000\000\000\000\001\027\001\130\001\133\000\000\001\142\001q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\001\029\000\000\000\235\000\000\001#\000\000\001,\000\000\000\000\0016\001\029\000\000\000\000\000\000\0012\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\0029\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\001#\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001,\001\026\001#\0016\001\027\000\000\000\000\001\031\000\000\000\000\001\132\001\026\000\000\000\000\001\027\000\000\000\000\001\031\000\000\001\133\000\000\001\142\001q\000\000\001 \000\000\000\000\000\000\001\029\000\000\001\018\001&\000\000\000\000\001 \0012\000\000\000\000\001\029\000\000\001\018\001&\000\000\001(\000\000\001\026\001)\000\000\001\027\001*\001+\002v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\029\000\000\001#\001,\000\000\0012\0016\000\000\000\000\000\000\000\000\000\000\001#\001(\000\000\0012\001)\001\031\000\000\001*\001+\002\143\000\000\001(\000\000\000\000\001)\001\031\000\000\001*\001+\002\147\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\001 \001,\001#\000\000\0016\000\000\001\018\001&\001i\001j\000\000\001,\000\000\000\000\0016\001i\001j\001\031\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001i\001j\000\000\001k\001z\000\000\001m\001n\000\000\001 \001k\001z\000\000\001m\001n\001\018\001&\000\000\0012\000\000\001k\001z\000\000\001m\001n\000\000\001(\000\000\0012\001)\000\000\000\000\001*\001+\003M\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\003T\000\000\000\000\001{\000\000\001|\003k\000\000\000\000\000\000\001{\000\000\001|\003m\001,\000\000\000\000\0016\0012\000\000\001{\000\000\001|\003o\001,\000\000\001(\0016\000\000\001)\000\000\000\000\001*\001+\003d\000\000\000\000\000\000\001\130\002`\002a\001j\000\000\000\000\000\000\001\130\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\235\000\000\001\130\000\000\001s\001,\006\219\000\235\0016\004\024\000\000\000\000\000\000\000\000\001s\000\000\004 \000\235\001i\001j\000\000\007\202\000\000\000\000\007\203\000\000\000\000\006\222\001i\001j\000\000\000\000\000\000\000\000\000\000\000\000\006\223\000\000\001k\001z\004!\001m\001n\000\000\000\000\000\000\000\000\000\000\001k\001z\000\000\001m\001n\000\000\002`\002a\001j\000\000\000\000\000\000\000\000\000\000\001\132\000\000\000\000\000\000\006\224\000\000\000\000\001\132\000\000\001\133\001\026\001\142\001q\001\027\000\000\002\154\001\133\001\132\001\142\001q\001{\000\000\001|\003v\002c\000\000\001\133\000\000\001\142\001q\001{\000\000\001|\005\011\000\000\000\000\004#\001\029\002\169\000\235\000\255\006\225\000\000\000\000\000\000\000\000\000\000\001\026\000\000\000\000\001\027\006\226\000\000\000\000\000\000\001\130\000\000\000\000\000\000\000\000\001\026\000\000\000\000\001\027\000\000\001\130\000\000\001s\000\000\000\000\000\235\007\208\000\000\004\027\001\029\000\000\000\000\001s\000\000\000\000\000\235\000\000\000\000\001#\000\000\000\000\000\000\001\029\000\000\000\000\006\228\000\000\002c\000\000\000\000\000\000\000\000\000\000\001\031\000\000\006\229\002\170\000\000\000\000\002d\006\231\002\169\000\235\000\000\000\000\002\171\000\000\001\142\002\172\000\000\001 \000\000\000\000\000\000\006\233\001#\001\018\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\132\001#\000\000\001\031\000\000\006\234\000\000\000\000\000\000\001\133\001\132\001\142\001q\000\000\000\000\000\000\001\031\000\000\000\000\001\133\001 \001\142\001q\000\000\000\000\000\000\001\018\001&\000\000\000\000\000\000\001\026\000\000\001 \001\027\000\000\0012\002\170\000\000\001\018\001&\000\000\001\026\000\000\001(\005\212\002\171\001)\001\142\002\172\001*\001+\005\028\000\000\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\026\000\000\000\000\001\027\000\000\001\029\000\000\000\000\000\000\0012\000\000\000\000\001,\000\000\000\000\0016\000\000\001(\001\026\000\000\001)\005\212\0012\001*\001+\005|\000\000\001\029\000\000\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\005\136\000\000\001#\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\001,\000\000\005\214\0016\000\000\000\000\001\031\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\000\000\0016\001\031\000\000\000\000\000\000\000\000\000\000\001 \001#\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\001\031\001\018\005\217\005\214\000\000\000\000\001\026\000\000\000\000\005\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \001\031\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\001\026\000\000\000\000\005\212\000\000\000\000\001\029\000\000\001 \000\000\0012\000\000\000\000\000\000\001\018\005\217\000\000\000\000\001(\000\000\000\000\001)\000\000\000\000\001*\001+\005\162\001\029\000\000\001(\000\000\000\000\005\218\000\000\000\000\001*\001+\000\000\000\000\000\000\000\000\000\000\000\000\0012\000\000\005\165\000\000\005\222\000\000\005\220\001,\001(\005\214\0016\001)\000\000\000\000\001*\001+\005\178\000\000\001,\000\000\000\000\000\000\000\000\000\000\001\031\000\000\001(\000\000\000\000\005\218\005\214\000\000\001*\001+\000\000\000\000\000\000\000\000\000\000\000\000\001,\001 \005\165\0016\005\221\001\031\005\220\001\018\005\217\000\000\000\000\000\000\001\026\000\000\000\000\001\027\000\000\000\000\001,\000\000\000\000\000\000\001 \000\000\001\026\000\000\000\000\001\027\001\018\005\217\000\000\000\000\000\000\001\026\000\000\000\000\001\027\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\000\000\001\026\000\000\000\000\005\212\000\000\001\029\000\000\000\000\001\026\000\000\000\000\005\212\000\000\000\000\001\029\000\000\001(\000\000\000\000\005\218\000\000\000\000\001*\001+\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\005\165\000\000\005\219\001\029\005\220\001(\000\000\001#\005\218\000\000\000\000\001*\001+\000\000\000\000\000\000\001,\000\000\000\000\001#\000\000\005\165\001\031\005\231\000\000\005\220\000\000\000\000\001#\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001,\000\000\001 \000\000\005\214\000\000\001\031\000\000\001\018\001&\000\000\000\000\005\214\000\000\001 \000\000\000\000\000\000\000\000\001\031\001\018\001&\000\000\001 \000\000\000\000\000\000\001\031\000\000\001\018\001&\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001\018\005\217\001 \001\026\000\000\000\000\001\027\000\000\001\018\005\217\000\000\000\000\000\000\0012\000\000\000\000\001\026\000\000\000\000\001\027\000\000\001(\000\000\000\000\001)\0012\000\000\001*\001+\006N\001\029\000\000\000\000\001(\0012\000\000\001)\000\000\000\000\001*\001+\006`\001(\001\029\000\000\001)\000\000\000\000\001*\001+\006x\000\000\000\000\001,\000\000\001(\0016\000\000\005\218\000\000\000\000\001*\001+\001(\000\000\001,\005\218\000\000\0016\001*\001+\005\165\000\000\006\179\001,\005\220\001#\0016\000\000\005\165\000\000\006\203\001\026\005\220\000\000\001\027\000\000\001,\000\000\001#\000\000\001\031\000\000\000\000\000\000\001,\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\000\000\001 \001\029\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\000\000\001\026\000\000\001 \001\027\000\000\000\000\000\000\000\000\001\018\001&\000\000\000\000\000\000\001\026\000\000\000\000\001\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\000\000\001\026\000\000\001#\001\027\000\000\000\000\001\029\000\000\0012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001(\001\031\000\000\001)\000\000\0012\001*\001+\007\002\000\000\000\000\001\029\000\000\001(\000\000\000\000\001)\000\000\001 \001*\001+\007B\000\000\001#\001\018\001&\002`\002a\001j\000\000\000\000\000\000\001,\000\000\000\000\0016\001#\000\000\001\031\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\000\000\0016\003\241\000\000\001\031\000\000\000\000\000\000\001 \000\000\001#\000\000\000\000\000\000\001\018\001&\000\000\001\026\000\000\000\000\001\027\001 \000\000\000\000\0012\001\031\006\159\001\018\001&\000\000\000\000\000\000\001(\000\000\000\000\001)\006\219\000\000\001*\001+\007E\000\000\001 \000\000\001\029\002`\002a\001j\001\018\001&\000\000\007\202\000\000\000\000\007\203\000\000\000\000\006\222\002`\002a\001j\0012\000\000\000\000\001,\000\000\006\223\0016\002\168\001(\000\000\000\000\001)\000\000\0012\001*\001+\000\000\000\000\002c\000\000\002\192\001(\000\000\000\000\001)\000\000\000\000\001*\001+\001#\002d\000\000\002\169\000\235\0012\006\224\000\000\002`\002a\001j\001,\000\000\001(\001I\001\031\001)\000\000\000\000\001*\001+\000\000\000\000\000\000\001,\000\000\000\000\001\223\000\000\000\000\000\000\003\148\001 \000\000\000\000\000\000\000\000\003\244\001\018\001&\000\000\000\000\000\000\006\225\000\000\001,\000\000\000\000\001\225\000\000\000\000\000\000\000\000\006\226\000\000\002c\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\170\002d\002c\002\169\000\235\000\000\000\000\007\213\000\000\002\171\000\000\001\142\002\172\000\000\002d\000\000\002\169\000\235\000\000\0012\000\000\000\000\000\000\000\000\000\000\000\000\006\228\001(\000\000\000\000\001)\000\000\000\000\001*\001+\000\000\006\229\000\000\000\000\000\000\000\000\006\231\002c\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002d\006\233\002\169\000\235\000\000\001,\000\000\000\000\004\141\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\000\000\000\000\006\234\000\000\002\171\000\000\001\142\002\172\002\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\171\000\000\001\142\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\171\000\000\001\142\002\172"))
+ ((16, "\002\168\001K\000*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\000\000\000\000\245\000\248\000)\000\151\002\190\001\006\000*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \244\000\000\000\000\000\000\000\152\000\000\000\000\000\000\000\000\000\000\000\000\000\000:\204\000\160\000\000\000\218\003R\014F\000\000\003j\000\017\000\246\003\152\002<\000\000\000\000\000\000\003J\000\000\000\000\002\004\000\000\000\000\000\000\000\000\002f\000\000\001<\000\000\000\000\000\000\000\000\000\000\000\"\000\000\000,\002\248\000\015\000\000\000\000\011\172:\204\000\000\000\000\022\234\000\000\012x\000\000;4\001\246\003\152\000\000\000\000\001\170\003\190\005T\005v\000v\002\248\003\024\000\133\002V\000\200\002.\003\208\014\128\000\000\005(\002@\004d\002*N \000\000\000\000\000\000\000\000\000\000\000\000\000\000;\152\000\000\002X\004\216\003F\000\000\000\000\000\000\000\000\015`\000\000\000\000\006\002\000s\000\000\006\166\007<\t\028\000\000\000\000\000\000\002\212\002\236\006\234\002\136\004~\006\246;\204\003\012\006\252\000\211\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\012\000\000\000\000\000\000)`\014\242\003P\007&\015<\007\180\005(\"\234\000\000<>\005\152<\180=\000\000\000\000\159\000\000\000\000\000\000\004$M\228\0044\000\000\012:\004>\000\000\012\162\bb\000\254\000\000\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r0\003\254\000\000\000\000\000\000\017@\000\000\nP\000\000\000\000\004RN\"\025\192\000\000\028$\000\000\000\000\000\000\000\000\000\000\000\000\001\192\011\210\001\192\002^\000\000\000\000\000\000\004(\000\000\000\000\000\000\000\000\004\162\000\000\000\000\001\192\000\000\000\000\000\000\000\000\000\000\tR\000\000\007(\005:\000\000N\230\007,[ \000\000\000\000\000\000\000\000\004(\000\000\000\000\000\000\rH\000\000\000\000\000\000\000\000\000\000\000\000\001\204\005<\000\000\000\000\000\000\004(\005\150N\234\004\222\0074$\234\000\000\003T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\000\000\006XOr\000\000\005.\007HO\182\026n\000\000\000\0009\024\000\000\000\000\000\000\000\000O\232\000\000\000\000Pt\005\000P\136\005\000\000\000Q@;\152\006@\006t\000\000\000\000GR\000\000\000\000\000\000\000\000\005\000\000\000QJ\005\000P\242\004(\000\000Q\132\005\000\001>\000\000\005\000\005\000\005\000\000\000\000\000\005\000\000\000=\000\000\000\000\000\000\000\005\000=$\000\000\000\000\005\000\000\000\001\"\006\150\000\000\000\000\000\000\000\000\000\000\000\000#\028\000\000\0064\000\000Q\174\004(\000\000\000\000\000\000\000\000\006P\007F\015\174\006\194\006\214\006\236\007`\005\156\007\196\000\154\007\144\000\000\000\000\018N\011.\000\000\007\198\003\220\007>\000\000\000\000\021l\000\000\004\210\002\244\006,\002\028\b\198\000\000\000\000[^\000\000[\162\bd\000\000R0\004(RB\004(\000\000\006l\000\239\000\000\022(\004\210\000\000\000\000\007\156\000\000\000\000\000\000\000\000\000\000\024H\004\210\024\242\004\210\000\000\000\000 \162\004\210\000\000\001\222\000\000\000\000\002\168\000\000\000\000\000\000\b\244\000\000\004\210\000\000\004\210\000\000\000\000\005\196\000\000\000~\004~\000\000\000~\000\000\"\218\004\210\000\000\000\000\000\000\000\000\000\000\000~\016\n#\146\t\000\b\186=\192\021\178\000\000\b$\007\214\016\132\b.\007\238.\2524z\000\000\000\000\000\000\000\000\000\000\003:\r\170\000\000\000\000\000\000\bn\007\244\007,\000~(\006\004\210\000\000\000\000\000\000\005\152\000\000Rl\004(\016\246\b\136\007\254\017n\b\162\b$\004\174=r\005\000\017\150\b\166\b& 6\t\146\000\000>:\005\000R\148\004(\t\178\000\000\000\000\000\000\000\000;\152\t\158\000\000\000\000X\220\000\000\000\000\000\172\000\000\000\000\t\188*\194\001\192\000\000\018\014\t\028\bB\007b\000\000>\138\t\"\bR\020\022\000\000>\198\000\000\000\000\t*\bvS:\005\000\018\134\t>\b\150Bt\000\000C\028\000\000\000\000#\242\td\b\156\030\218\000\000$\152?,\tp\b\160$\198\000\000&\212\000\000\000\000\n\202Sj\004(G\142\004(S\180\004(\000\000\000\000\000\000\000\000\000\000E\214\000\000\000\000\000\000\003(\018\252\000\000\000\000\000\000?z\t\142\b\164$\254\000\000M\232\000\000\000\000\000\000\000\000\000\000\tX\019r\000\000\000\000\td?\130\t\154\b\182%p\000\000\td?\204\t\156\b\188%\210\000\000\td\000\000P\194\000\000@T\t\160\b\200&x\000\000\td\019\206\004\b\020 \000\000\000\000@\186\t\190\b\210&\148\000\000\tdAZ\t\196\b\230&\222\000\000\tdAb\t\198\t\"'~\000\000\tdA\184\t\202\t<'\160\000\000\tdA\192\t\246\tB(@\000\000\tdB`\n\014\tJ(x\000\000\tdB\198\n\018\tV(\178\000\000\tdCL\n\020\tZ)t\000\000\tdCn\n(\tf)\128\000\000\tdC\130\nF\tl)\230\000\000\tdC\244\nd\tx*H\000\000\tdDV\n\138\t|*\134\000\000\tdD\254\n\144\t\184*\238\000\000\tdE\n\n\146\t\186+\016\000\000\tdE\\\n\154\t\192+T\000\000\tdE\132\n\160\t\206,\012\000\000\tdE\254\n\210\t\218,\022\000\000\tdF\232\n\222\n\014,P\000\000\tdF\242\n\228\n\016,\182\000\000\tdG>\n\250\n(-\024\000\000\td\nP\015\186\019\226\020\240\000\000G\142\011\170\000\000T\b\004(\021N\000\000\000\000\011\\\000\000TR\004(\021\170\000\000\000\000\022\b\000\000\000\000\002\130\000\000\000\000\022\188\000\000\000\000\000\000\000\000Tx\004(\023\024\000\000\011\n\023v\000\000T\248\005\000Uj\005\000U\158\005\000\004j\000\000\000\000\000\000\000\000V\n\005\000\000\000\004l\005\\\000\000\000\000\000\000\td\023\192\000\000\000\000\024\154\000\000\000\000\000\000\000\000+\222\000\000\000\000\td-\162\000\000-\212\000\000\000\000.\006\000\000\000\000\000\000Q\018\000\000\000\000.|\000\000\000\000G\222\011L\nT.\170\000\000\td/j\000\000\000\000G\242\011X\nZ/b\000\000\td/\212\000\000\000\000H*\011v\nb0\012\000\000\td\004\"\024\228\000\000\000\000I\000\011\128\n\1420v\000\000\td\025B\000\000\000\000Ir\011\136\n\1440\150\000\000\td\025\158\000\000\000\000I\168\011\152\n\16216\000\000\td\000\000\000\0001\146\000\000\000\000I\188\011\218\n\1981\156\000\000\td28\000\000\000\000I\208\011\236\n\2062\004\000\000\td2\160\000\000\000\000J.\011\242\n\2082j\000\000\td\000\000K(\011\248\011\b3@\000\000\td\000\000=j\000\000\000\000\td\000\000\000\000\000\0003\144\000\000\000\0003\184\000\000\000\000\011\250\000\000\000\000\026L\000\000\026\138\000\000\000\000\td\000\000\000\000\026\214\000\000\0278\000\000\000\000\000\000\000\000\000\000K<\012\022\011\0143\204\000\000KP\012\026\011\0184\002\000\000\td\tdK\134\012$\011\0204\162\000\000\td\000\000\011\n\027v\000\000\000\000\028B\000\000L(\000\000\000\0004z\000\000\000\0005J\000\000\000\000\000\0005l\000\000\000\000\000\000\r^\000\000\000\000\024\020\000\000\000B\000\000\006\n\r\b\000\000\000\202\000\000\000\000\000\000\000\000\000\000\003:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012T\011.5\158\000\000\td\000\000\r\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0114\007\230\000~\028t\000\000\012\182\0118\r\144\004 \b\018\000~1\230\004\210\b\150\000~\000\000\028\254\000\000\004\252\000\000\r\006\011:\0044\000\000\000\000\000\000\000\000\000\000\r(\003\178\000\151\000\000\000\000\000\000K\204\000\000[\244\000\000\011H\000\000\011T\000\000\000\000\000\000\000\000\003\150\000\000\000\000\000\0002\180\001\192\000\000\001\192\0064\000\000\005\230\000\000; \001\192\001\192\000\000@\182\001\192\001\192\011h\000\000\0290\000\000\000\000\011n\014\006\000\0005\186\006N\000\000\000\000\000\000\000\000\000\000\000\000\rr\011z6D\000\000\td\000\000\000\000\000\000\000\000\rv\011\136\b\152\000~\000\0006\144\004\210\000\000\014\200\000\000\000\000\000\000\000\0007\028\000\000\000\000\000\000\000\000\r\132\011\1387>\000\000\000\0007\240\004\210\000\000:@\004\210\000\000;x\004\210\000\000\td\000\000>\158\004\210\000\000G\250\004\210\000\000U\216\004\210\000\000\0038\000\000\011\150\tB\003\242\000\000\r\152\r\170\011\154\014\006\014\162\\\192\004\210\006\184\000\000\011\188\014z\014~\006&\007\164\014L\011\230\014\156\0078\007\234\014j\000\000\000\000\007\132\b\134\000\000\005\190\004\136V\020\005\000\029\216\000\000\006\208\001\184\014\024\011\234\tJ\004\128\000\000\014.\011\244\005\204\000\0007@\000\000Vd\004(\000\000\014\208\014\224\000\000\b\152\000\000\004(\014F\011\254\005r\014p\002\158\000\000\000\000\000\000\000\000\012\026\b\174\000\000\012&\b\208\000\000\t\224\028r\014`\014v\012*\004\158\t@\000\000\0126\0052\n0\000\000\014\154\014\158\012H\014\202\014\162]P\004\210\000\000\012f\015<\000\000\006\026\n2\000\000\015>\000\000]z\005\174\015\016\012\140\015N\000\000]\132\006b\015\030\000\000\000\000\000\217\007*\n\146\000\000]\230\004\210\011h\000\000\000\187\000\000\014\204\012\166^\022\007X\000\000\014\206\012\170\007n\014p\014\210\014\228\012\178\016R\000\000\014\248\006L\000\000\000\000\000\000\000\000\001\001\012\182\014\206Vx\004(\000\000\001\023\012\184\015\142\000\000\000\000\000\000\000\000\000\000\000\000V\232\007p\000\000\012\186\015\238\000\000\000\000\000\000\000\000\000\000\000\0007\154\011\132\000\000\012\194\000\182\000\000\012\196\012\232\b\210\000\000\001\bLr\000\000\004P\000\000V\250\004(\004(\000\000\000\000\007~\000\000\b\224\000\000\001n\007~\007~\000\000\r\nL\212\004(WL\004(\012\012\000\000\000\000\000\000\012D\000\000\000\000\001.\000\000\007\158\015N\r\012\016h\015\012\000\000\000\000\001\132\007\168\015V\000\000\000\000\r \016t\015\026\000\000\000\000\nd\000\000-\182\000\000W\224\002\222\004(\000\000X\"5\154\000\000X2\000\000\000\000\000\000\007~\000\000\000\000\012\250\015`\r\"\016~\015\"\000\000\000\000X^\r*\015h\000\000\000\000\000\000$j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\rD\000\000\015\142\r(\006\194\000\000\016\146\016B\rr\015\162\000\000\000\000\015\166\r.\006\212\000\000\000\000\n(\bb\004\134\000\000\000\000\000\000\b$\015t\r:\000\000\015x\b$\000\000\016\\\r\128\015\188\000\000\000\000\000\000\004(\002\182\003\024\005\138\000\000\000\000\000\000\000\000\015\128\rJ\000\000\006\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004(\015d\rP\016\208\015x\000\000\020\160\001\003\rZ\015J\001)\000n\rd\016\n\000\000\016\196\030:\000\000\000\000\030\172\000\000\r\166\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000X\132\004(\000\000\016\206\031\016\000\000\000\000\031v\000\000\000\199\rj\016\128\000\000\000\0008B8\158\016.\000\000Y(\004(\031\196\000\000\000\000 ~\000\000\000\000\r\188\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\0008\184\000\000\000\0009J9n\016:\000\000YB\004( \218\000\000\000\000!,\000\000\000\000\r|!T\014 \000\000\r\156\r\180\000\145\001P\r\186\007\002\r\194\016\1569\194\014b\000\000\r\200\r\214\t\000\000\000\003\182M\022\000\000\003\012\000\000\r\246\001\156\002\140\006\194\015l\n\240\000\0008(=j\000\000\007\022\000\000\000\000\007\022\000\000\000\000\007\022\t(\000\000\016\030\007\022\016\164:\132\014h\000\000\007\022\000\000Yj\000\000\000\000\007\022\000\000\000\000\014x\000\000\017\248\007\132\014\144\000\000\014\012M.\014\160\000\000\000\000\000\000\014\166\000\000\000\000\000\245\000\000\007\022Z,\000\000\019\152\007\022\\F\000\000\014\192\016\000\014\030\017\030\015\194\000\000\\\160\014\236\016\b\000\000\000\000\000\000\n$\006\194\000\000\000\000\000\000\000\000\000\000\000\000\tX\014\250\000\000\016\"\000\000\000\000\000\000\000\000\015\n\016\232\000\000\000\000\000\000\tX\000\000\000\000\000\000\000\000\015\018],\000\000\000\000\000\000\000\000\000~\004\210\000\000\005\000\000\000ZR\004(\000\000\003\026\000\000\000\000\000\000:\208\000\000\000\000\000\000\000\000\000\000\016\196\002\000\t\020\015t\005\024\014\"\000\000\002d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\128\005J\014,\000\000\003v\017&\016\214\015\020\000\000\000\000\016\206\005\162\004\206\000\000\000\000\000\000\014:\000\000\014H\015\248\000\000\000\000\001\192,\248\000\000\000\000\000\000\000\000\000\0006\162\000\000\000\000\006\152\006F\000\000\000\000Zj\004(\004(Z\144\004(\006\172\000\000\000\000\000\000\004(\000\000\000\000\n\198\016\222\015$\000\000\000\000\016\210\002^\006h\000\000\000\000\000\000\000\000\007\016\017&\011j\016\226\015T\000\000\000\000\016\214\003x\006x\000\000\000\000\000\000\004\210\000\000\015j\000\000\000\000\000\000!\252\000\000\"\184\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\003F\000*\000\000\000\000\000\000\000\000\000\000\000Z\000*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0028\000\000\000\000\000\000M\188\000\000\004(\000\000\014$\000\000\000\000\000\000\001\184\000\000\000\000\000\000\000\173\000\000\000\000\000\000\005\014\000\000\000~\000\000\r\024\000\000\004\210\000\000\000\212\000\000\000\000\000\000I\134\005\000\000\000\000\000\002T\000\000\000\000\000\000\000\000\003:\005x\016\014\000\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000(\158\000\000\015x\000\000\000\000\000\000\000\000\006L\b,\030\200A\022\000\000\000\000\015z\\\246\000\000\000\000\000\000\015\134]\022\000\000\000\000\000\000\000\000"), (16, "\006\219\006\194\002.\002/\001l\000\231\001\239\001\014\000\235\000\236\007\155\005\181\005\235\001\020\001\023\003~\001\243\002\138\006\220\006\235\001\247\006\222\001\020\001\028\005`\002\143\001\029\006\200\006\196\000\231\006\223\006\236\000\235\000\236\007l\000;\006\155\005\183\002\166\005c\005\236\007d\005\237\000\145\006g\002\018\000\154\006\198\007\156\004\133\001\031\000\235\007Q\005\235\006\196\000\231\005\185\006i\000\235\001\001\006\224\001\248\000\231\0007\006\239\000\235\000\236\001\002\006\015\007\131\006\157\005\164\005\238\006\198\006\252\006\199\006D\002\029\005\186\005b\000\235\005\236\007u\005\237\005\165\004D\006\158\007\012\005\188\007\r\0007\006\160\001\004\006\155\005b\006\201\001%\006\225\004\144\004\146\004\148\006\199\002\172\000\238\007\187\002/\001l\006\226\005\239\001k\001l\001!\007L\005\238\0022\000\237\002\174\000\235\005\240\005\241\006\219\005\242\002.\002/\001l\000?\000\238\006\157\001\"\001m\002c\006\240\001o\001p\001\020\001(\000j\002\138\006\220\006\235\000Y\006\222\002\030\006\158\006.\002\143\006\241\001\215\006\160\005\239\006\223\006\236\006\181\004I\000m\001l\006\229\001\014\002\166\005\240\005\241\006\231\005\242\001\020\001(\002\027\0007\000\231\005\244\002\181\000\235\001\001\002\182\005\246\006\000\006\233\006\022\006\023\000]\002\175\006\224\0014\001\161\001l\006\239\006.\000a\006*\002\196\001*\001\131\002\177\001+\006\234\001\014\001,\001-\006\024\006(\007\167\001\020\001(\006 \004\169\004E\006+\007j\001\016\001t\005\244\007w\006F\002\198\001\020\005\246\006\000\007\188\006\225\002\174\000\235\001u\001.\002\172\000\235\0018\007\132\001\014\006\226\006*\001k\001l\007\168\001\020\001\023\0022\000\231\002\174\000\235\000\235\001\001\006\219\001\243\002.\002/\001l\001\247\006+\001\020\000:\001m\002c\006\240\001o\001p\0013\002e\000u\002\138\006\220\006\235\000|\006\222\001\014\002\016\001\254\002\143\006\241\001\014\001\020\001\023\006\223\006\236\004E\001\020\001\023\0009\006\229\002f\002\166\000\231\000\238\006\231\000\235\001\001\000\145\001\129\001\248\000\150\002\028\002\181\005\164\001\183\002\182\0007\001\130\006\233\001\131\001s\001[\002\175\006\224\005\187\000\231\005\165\006\239\000\235\000\236\005\172\002\196\000~\001\131\002\177\000\145\006\234\007Y\001\236\001\004\007\151\001\014\000\151\007\175\002/\001l\000\132\001\020\001\023\007\n\005\183\001t\001\014\007\021\005\164\002\198\006\155\000\149\001\020\001\023\006\225\000\148\001\024\001u\0007\002\172\000\235\005\165\006K\005\185\006\226\005\166\001k\001l\000=\001^\003a\0022\007\152\002\174\000\235\001r\001\014\006\219\001\020\002.\002/\001l\001\020\001(\006\157\005\186\001m\002c\006\240\001o\001p\002\004\006\153\007T\002\138\006\220\007q\001\020\006\222\005\164\006\158\007\139\002\143\006\241\003~\006\160\007\177\006\223\006\236\006\176\005\164\002\b\005\165\006\229\001\028\002\166\005\171\001\029\006\231\006n\001P\000\231\001\129\005\165\000\235\001\001\002\181\005\196\000\179\002\182\000\174\001\130\006\233\001\131\001s\005*\002\175\006\224\000\235\006\015\001R\001\031\003b\002\018\006\166\002\196\005\158\001\131\002\177\007\178\006\234\002\174\000\235\004P\001l\001\014\007\025\007\026\001\224\002\t\007|\001\020\001\023\006\242\000\145\001t\000\155\001\236\006O\002\198\007\027\007\028\004\233\001g\006\225\002\029\007\022\001u\000\235\002\172\000\235\006r\007\029\004\169\006\226\000\180\005*\001%\006\015\000\235\007&\0022\002\007\002\174\000\235\000\170\000\184\006\219\001\020\002.\002/\001l\001!\007W\007X\000\189\001E\007\023\006\240\007\140\003~\001\131\006\153\007\004\002\138\006\220\006\235\000\202\006\222\001\"\001\028\007\024\002\143\006\241\000@\001\020\001(\006\223\006\236\006 \004\169\002\027\0012\006\229\007b\002\166\007s\007}\006\231\001s\002\030\000\231\001\129\000\182\000\235\000\236\002\181\006\022\006\023\002\182\004\149\001\130\006\233\001\131\001s\003\137\002\175\006\224\000\235\001\001\005-\007+\001\131\007\005\006\165\002\196\000\206\001\131\002\177\006'\006\234\007~\0014\006 \004\169\0007\007\133\001\020\001\014\004\235\001*\001\215\004\234\001+\001\020\001(\001,\001-\005\211\002\198\006\196\000\222\003\151\000\238\006\225\001\014\006\022\006\023\000\127\002\172\004\133\001\020\001(\003~\006\226\003v\001l\000\228\001!\006\198\000\130\0022\001.\002\174\000\235\0018\007\134\006\219\006\031\002.\002/\001l\006 \004\169\002\027\001\"\000\231\006\150\006\240\000\235\000\236\001\020\001(\000\133\002\138\006\220\006\235\006\199\006\222\001k\001l\000\245\002\143\006\241\007W\007X\007\135\006\223\006\236\004\147\004\146\004\148\000\175\006\229\002\028\002\166\001`\006\155\006\231\001m\001}\000\185\001o\001p\003~\007\136\002\181\000\238\001\b\002\182\006 \004\169\006\233\001\011\003~\004\238\002\175\006\224\004t\000\238\003\210\006\244\004\021\000\235\001\001\002\196\001*\001\131\002\177\001+\006\234\006\157\001,\001-\002\018\002\027\004\152\001\217\001\254\002.\002/\001l\000\238\001\133\001\014\001\134\002M\006\158\001\027\002\198\001\020\001\023\006\160\003~\006\225\003~\006\167\003\239\004\153\002\172\004\133\000\238\004\189\002\022\006\226\000\145\002\029\007!\001\236\000\235\000\238\0022\004w\002\174\000\235\000\190\003\128\006\219\001\132\002.\002/\001l\000\145\0059\000\177\001\236\005\020\002\028\006\240\001\020\001u\007\190\007\191\000\235\002\138\007\193\001\187\001l\006\222\007\159\002\206\002w\002\143\006\241\004\129\004\169\002\018\006\223\007\195\006\b\004\146\004\148\001<\006\229\0017\002\166\001m\002B\006\231\001o\001p\005\160\005\024\001l\003~\007*\002\181\005F\004x\002\182\001;\002\030\006\233\000\203\0007\007\160\002\175\006\224\002\029\0021\001H\000\235\001\028\005*\000\238\002\196\000\235\001\131\002\177\001]\006\234\0022\007)\002\174\000\235\001\129\007\023\005=\002\028\004*\003x\003y\003a\001\020\001\140\003~\001\131\001s\005*\002\198\007\024\000\235\004\149\000\145\006\225\001\223\001\236\002\018\001\178\002\172\001c\001\028\004w\006\219\006\226\002.\002/\001l\007\210\000\145\004\133\0022\000\150\002\174\000\235\001\132\003\127\002\018\007\202\001\242\002\138\007\203\000\238\002\030\006\222\007\198\002\031\001u\002\143\002\029\000\235\004\149\000\235\006\223\007\211\001\176\002\175\007\019\004\155\001\131\001z\002\166\001\139\006\241\005t\002\176\002\019\001\131\002\177\002\029\001!\007@\000\235\006\229\004F\004-\0042\005Q\006\231\006\028\004\146\004\148\007\031\006\224\001\131\003~\002\181\001\"\000\145\002\182\005\249\001\236\006\233\001\020\001(\003~\002\175\000\145\003~\006\003\001\236\007\025\007\026\005'\004\169\002\196\003~\001\131\002\177\001!\006\234\0007\001\129\005K\002\030\007\027\007\028\004\252\001\145\001\020\006\225\001\140\000\212\001\131\001s\002\172\001\"\007\029\004\169\002\198\006\226\007_\001\020\001(\002\030\001\014\0007\0022\003~\002\174\000\235\001\020\001\023\006\219\001\144\002.\002/\001l\001*\001\242\007\215\001+\001\182\002\002\001,\001-\000\235\004\175\004\157\005\t\002\138\006\220\006\250\001\193\006\222\001k\001l\005W\002\143\006\241\007U\004w\004\133\006\223\006\236\004\133\001\014\001\198\007c\006\229\004\160\002\166\001\020\001(\006\231\001m\001}\001*\001o\001p\001+\000\238\002\181\001,\001-\002\182\000\231\004\161\006\233\000\235\000\236\007V\002\175\006\224\000\215\002.\002/\001l\002o\007V\004\247\002\196\007?\001\131\002\177\006\184\006\234\002\018\003~\004\164\002\138\006$\004\146\004\148\007G\004\146\004\148\006\155\002\143\001\133\003~\001\134\002M\004\177\004\198\002\198\001\014\003~\000\223\001\242\006\225\002\166\001\020\001(\000\226\002\172\002;\000\229\005\\\002\029\006\226\000\235\000\235\003~\005\001\000\239\003~\0022\003~\002\174\000\235\006\157\004\170\006\219\001\132\002.\002/\001l\000\246\001N\006\188\001L\004e\000\238\006\240\001d\001u\006\158\007\202\000\235\002\138\007\203\006\160\001\203\006\222\001{\006\164\002w\002\143\006\241\005h\003~\005\006\006\223\007\206\001\209\005\015\001\204\000j\006\229\001\028\002\166\005\137\001\029\006\231\002\172\001P\000\238\004w\005\173\002\018\001\216\002\181\000\238\002\030\002\182\000\238\0022\006\233\002\174\000\235\006\137\002\175\006\224\000\238\005\189\001R\001\031\004\253\006\162\005\197\002\196\002\018\001\131\002\177\001\229\006\234\000\238\000\238\004g\000\238\001\129\002\029\001\231\000\238\000\235\004w\001\206\001\214\002\178\001\140\001\246\001\131\001s\000\238\002\198\002)\005l\004\169\002\011\006\225\004o\001\242\005\002\002\029\002\172\000\238\000\235\002,\003~\006\226\002:\002\181\001%\0017\002\182\002H\0022\003~\002\174\000\235\005\167\002\175\006\219\006\162\002.\002/\001l\001!\003~\007\209\002\196\001E\001\131\002\177\002K\002Q\005\167\002\018\002\018\002\138\006\220\005\167\004`\006\222\001\"\003~\002\030\002\143\006\241\002n\001\020\001(\006\223\006\246\002\198\000\238\000\238\002s\006\229\001\028\002\166\004\\\001\029\006\231\000\238\001?\004s\004\193\002\030\002\029\002\029\002\181\000\235\000\235\002\182\002z\000\238\006\233\002(\000\238\005\007\002\175\006\224\002+\000\238\001D\001\031\006\012\004\169\005\"\002\196\002\127\001\131\002\177\002\135\006\234\002\141\0014\002\170\005\155\005/\003~\000\235\000\238\000\238\001*\005\169\002\186\001+\000\235\002\192\001,\001-\001O\002\198\0029\002\201\0052\000\238\006\225\005\235\002\212\006\145\002\018\002\172\000\235\000\238\002\018\002G\006\226\001\028\002\218\001%\001\029\002\030\002\030\0022\001.\002\174\000\235\0018\002J\006\169\002P\000\238\000\235\002\\\001!\005\236\006-\005\237\001E\004\237\006\249\006\219\002\029\005\019\001\031\000\235\002\029\000\238\002\224\000\235\000\238\001\"\000\238\001\028\000\238\006\241\001\029\001\020\001(\006\220\005:\002\230\006\222\000\238\002\236\006\229\000\238\005\238\002\242\002Y\006\231\006\223\000\238\001\028\002\248\002_\002\254\000\238\002\181\002j\001\031\002\182\003\004\001\028\006\233\003\n\005\212\000\238\002\175\002m\001%\003\016\002r\003\022\007\017\004\169\002y\002\196\006\015\001\131\002\177\006\224\006\234\005\239\0014\001!\002~\002\030\003~\003~\001\031\002\030\001*\005\240\005\241\001+\005\242\000\238\001,\001-\001O\002\198\001\"\003\028\003\"\002\134\001%\003(\001\020\001(\000\238\002\140\001\028\000\238\003.\001\029\002\153\000\238\006\225\006.\0034\001!\006\018\000\238\001.\000\238\002\169\0018\006\226\003\129\002\195\000\238\002\185\002\191\000\238\002\200\005\214\003~\001\"\001\031\000\238\001!\000\238\005\244\001\020\001(\003:\003@\005\246\006\000\002\211\001!\006\227\002\217\002\223\0014\002\229\006\015\001\"\003F\005>\005L\006*\001*\001\020\001(\001+\006\228\001\"\001,\001-\006/\000\238\000\238\001\020\005\217\000\238\006\229\002\235\003J\006+\003\161\006\231\000\238\003\170\001%\006\022\006\023\003\179\000\238\002\241\0014\002\247\002\253\001\028\001.\006\233\001\029\0018\001*\001!\007N\001+\003\003\001\215\001,\001-\006\024\006(\005]\003\189\003\198\006 \004\169\006\234\000\238\000\238\001\"\003\t\001*\003\207\001\031\001+\001\020\001(\001,\001-\001\028\000\238\001*\001\029\001.\005\218\003\015\0018\001,\001-\000\231\003\218\006\015\000\235\000\236\003\227\003\236\003~\005\165\001\028\005\223\000\238\005\220\000\238\001=\003\021\000\238\001\031\003\027\003!\000\238\003~\001\219\003'\001.\002\012\003-\001\209\006\022\006\023\001%\006\155\001\243\0014\003\243\006\015\001\247\004\026\001\020\004\031\004&\001*\000\238\000\238\001+\001!\007\\\001,\001-\006\024\006(\0033\000\238\004Y\006 \004\169\004f\0039\004l\004{\003?\001\028\001\"\001%\001\029\006\157\004\140\001?\001\020\001(\000\238\003E\004\142\001.\000\238\000\238\0018\001\248\001!\005a\003P\006\158\004\166\001\249\001\254\004\171\006\160\001@\001\031\003~\006\161\004\183\001\028\005\148\001X\001\"\001\255\001!\004\192\004\210\003W\001\020\001(\000\238\003w\004\236\000\238\004\242\000\238\000\238\006\022\006\023\003\160\001\028\001\"\0014\001\029\003~\003\169\001?\001\020\001(\000\238\001*\004\249\000\238\001+\000\238\000\238\001,\001-\006\024\006(\003\178\001%\000\238\006 \004\169\003\188\001@\001\031\000\238\003\197\006\022\006\023\004\255\001V\005\018\0014\001!\003\206\000\238\005\023\001E\000\238\001.\001*\005&\0018\001+\000\238\005\180\001,\001-\007J\007K\001\"\000\238\000\238\006 \004\169\005.\001\020\001(\000\238\001*\000\238\0051\001+\0058\001!\001,\001-\003\217\001\028\005<\001%\001\029\001.\005\184\001?\0018\003\226\000\238\005B\003\235\001\028\001\"\003\242\001\029\004\007\001!\001?\001\020\001(\001E\0077\0010\003~\005H\001@\001\031\001\215\004\025\000\238\004\030\000\238\001A\001\"\0014\004%\000\238\001@\001\031\001\020\001(\000\238\001*\005S\001T\001+\004?\003~\001,\001-\001O\007\163\002.\002/\001l\000\238\005f\004G\005k\004X\003~\000\238\005p\000\238\005z\005\128\005\139\002\138\004^\000\238\005\150\005\168\001%\001*\001.\002\143\001+\0018\000\238\001,\001-\0044\001\219\003~\001%\007\164\0014\001!\002\166\005\154\003~\001E\001\243\000\238\001*\005\224\001\247\001+\001\020\001!\001,\001-\001O\001E\001\"\0073\005\175\005\191\004k\003~\001\020\001(\000\238\002.\002/\001l\001\"\005\201\005\226\005\232\003~\005\248\001\020\001(\006\002\000\238\001.\000\238\002\138\0018\006\014\000\238\005\245\000\238\000\238\000\238\002\143\001\248\006\"\000\238\000\238\0062\007\147\001\249\001\254\000j\0068\004m\004z\002\166\004\165\006<\002\172\004\173\006X\005\253\001\255\0014\000\238\002.\002/\001l\006\020\006\128\0022\001*\002\174\000\235\001+\0014\003~\001,\001-\001O\002\138\000\238\000\238\001*\001\215\006\186\001+\006E\002\143\001,\001-\001O\000\238\000\238\007\007\007\149\000\238\006\133\006h\000\238\006\172\002\166\002\178\001.\006\138\000\238\0018\006\168\004\182\003~\004\191\004\200\003~\000\238\006\144\001.\000\238\004\209\0018\002\172\003~\000\238\002.\002/\001l\002\181\000\238\004\248\002\182\000\238\006\152\0022\003~\002\174\000\235\002\175\004\241\002\138\000\238\001\219\003~\006\191\007f\003~\002\196\002\143\001\131\002\177\006\130\001\243\006\211\004\205\007\020\001\247\000\238\001\020\003~\007 \002\166\002.\002/\001l\004\243\002\178\007.\002\172\000\238\004\246\002\198\000\238\005\005\0070\004\251\000\238\002\138\005\004\000\238\0022\003~\002\174\000\235\006\141\002\143\000\238\006\175\003~\002\181\005\000\004\202\002\182\005\003\005\017\006\185\003~\001\248\002\166\002\175\003~\003~\000\238\001\249\001\254\005\022\005!\006\189\002\196\003~\001\131\002\177\002\178\000\238\005 \006\193\001\255\005%\006\197\002.\002/\001l\000\238\0050\000\238\002\172\003K\001l\001\215\000\238\005;\006\209\002\198\003~\002\138\002\181\000\238\0022\002\182\002\174\000\235\0057\002\143\000\238\003~\002\175\003g\001}\004\176\001o\001p\003~\003~\006\216\002\196\002\166\001\131\002\177\003~\005G\006\230\005A\002\172\005C\001\028\002.\002/\001l\006\237\002\178\005Z\005N\006\247\007%\0022\005Y\002\174\000\235\002\198\005T\002\138\007P\005X\001\219\005e\005j\006\253\005\200\002\143\003l\003x\003y\002\181\001\243\004d\002\182\005o\001\247\005r\001\020\005v\002\166\002\175\005~\005\133\007^\002\178\005\144\005\199\005\192\005\193\002\196\005\198\001\131\002\177\005\202\007i\005\203\005\234\002\172\005\227\005\228\005\233\007\196\007\207\001\132\002.\002/\001l\002\181\007\212\0022\002\182\002\174\000\235\002\198\005\255\001u\001\248\002\175\000\235\002\138\005\251\005\252\001\249\001\254\005\254\006)\002\196\002\143\001\131\002\177\001!\006\r\006\017\004S\006\019\001\255\006\021\006!\0061\0063\002\166\002\178\0064\002\172\0069\006=\006A\001\"\003|\003}\002\198\006S\006\219\001\020\001(\0022\0072\002\174\000\235\006Z\006^\002.\002/\001l\002\181\000\231\006v\002\182\000\235\000\236\006\220\006\139\006\163\006\222\002\175\006\173\002\138\006\218\006\212\006\213\001\129\006\217\006\223\002\196\002\143\001\131\002\177\002\178\006\232\001\140\004)\001\131\001s\007\015\007#\007$\006\155\002\166\007(\007O\007S\007]\007a\007\182\002\172\000\000\001\028\002\198\001*\001\029\002\181\001+\006\224\002\182\001,\001-\0022\000\000\002\174\000\235\002\175\002.\002/\001l\000\000\000\000\000\000\000\000\000\000\002\196\006\157\001\131\002\177\001\031\000\000\000\000\002\138\000\000\000\000\000\000\0073\002.\002/\001l\002\143\000\000\006\158\000\000\002\178\006\225\004\022\006\160\000\000\002\198\000\000\006\171\002\138\002\166\000\000\006\226\000\000\002\172\000\000\000\000\002\143\000\000\000\000\000\000\000\000\000\000\004\014\002\181\000\000\0022\002\182\002\174\000\235\002\166\000\000\001%\000\000\002\175\000\000\006\238\000\000\000\000\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\001!\000\000\000\000\000\000\006\228\000\000\000\000\002.\002/\001l\000\000\002\178\000\000\000\000\006\229\000\000\000\000\001\"\000\000\006\231\002\198\000\000\002\138\001\020\001(\000\000\000\000\002\172\000\000\000\000\002\143\000\000\000\000\006\233\002\181\000\000\000\000\002\182\000\000\0022\000\000\002\174\000\235\002\166\002\175\000\000\000\000\002\172\000\000\000\000\000\000\006\234\000\000\002\196\000\000\001\131\002\177\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\000\000\002.\002/\001l\001>\002\178\000\000\000\000\000\000\000\000\000\000\002\198\001*\000\000\000\000\001+\002\138\000\000\001,\001-\000\000\001\215\000\000\000\000\002\143\002\178\000\000\000\000\002\181\000\000\004\004\002\182\000\000\000\000\000\000\000\000\000\000\002\166\002\175\000\000\000\000\002\172\000\231\000\000\001.\000\235\000\236\002\196\002\181\001\131\002\177\002\182\000\000\0022\000\000\002\174\000\235\000\000\002\175\000\000\002.\002/\001l\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\002\198\000\000\006\155\000\000\002\138\001\219\000\000\000\000\002\014\000\000\000\000\000\000\002\143\000\000\002\178\001\243\000\000\000\000\002\164\001\247\002\198\001\020\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\000\000\006\157\003d\000\000\000\000\002\182\004\r\0022\000\000\002\174\000\235\000\000\002\175\002.\002/\001l\000\000\006\158\000\000\000\000\000\000\002\196\006\160\001\131\002\177\001\248\006\187\000\000\002\138\000\000\000\000\001\249\001\254\000\000\000\000\000\000\002\143\000\000\000\000\002\178\000\000\000\000\002\180\000\000\001\255\002\198\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\002.\002/\001l\002\181\000\000\000\000\002\182\0022\000\000\002\174\000\235\001k\001l\002\175\000\000\002\138\000\000\000\000\000\000\000\000\003\\\000\000\002\196\002\143\001\131\002\177\000\000\000\000\003_\002\208\000\000\001m\002c\000\000\001o\001p\002\166\001k\001l\002\178\000\000\002.\002/\001l\000\000\000\000\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002\138\001m\001}\002d\001o\001p\002\181\000\000\002\143\002\182\0022\000\000\002\174\000\235\002\207\000\000\002\175\000\000\000\000\000\000\000\000\002\166\000\000\000\000\002t\002\196\000\000\001\131\002\177\000\231\000\000\000\000\000\235\000\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\178\000\000\002\172\001\133\000\000\001\134\002M\002\198\001k\001l\000\000\000\000\001t\000\000\0022\000\000\002\174\000\235\006\155\000\000\000\000\000\000\000\000\002\181\001u\000\000\002\182\000\235\001m\002c\000\000\001o\001p\002\175\000\000\000\000\000\000\000\000\001\132\000\000\000\000\000\000\002\196\002\172\001\131\002\177\002\178\002.\002/\001l\001u\000\000\006\157\000\235\000\000\0022\000\000\002\174\000\235\002e\000\000\002w\002\138\000\000\000\000\000\000\002\198\000\000\006\158\002\181\002\143\000\000\002\182\006\160\000\000\000\000\003M\006\205\000\000\002\175\003`\003f\000\000\002\166\000\000\000\000\000\000\002\178\002\196\001\129\001\131\002\177\000\000\000\000\002.\002/\001l\000\000\001\130\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\001t\000\000\002\138\002\181\000\000\002\198\002\182\000\000\001\129\000\000\002\143\000\000\001u\002\175\000\000\000\235\003T\001\140\000\000\001\131\001s\000\000\002\196\002\166\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\002.\002/\001l\002\172\000\000\000\000\000\000\000\000\000\000\002\198\006\206\002\138\000\000\001\215\000\000\0022\000\000\002\174\000\235\002\143\000\000\000\000\000\000\004B\000\000\003[\000\000\000\000\000\000\000\000\004J\000\000\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\002.\002/\001l\000\000\002\178\000\000\001\130\002\172\001\131\001s\000\000\004U\000\000\000\000\000\000\002\138\000\000\000\000\000\000\0022\006\208\002\174\000\235\002\143\000\000\001\219\000\000\002\181\001\220\003^\002\182\000\000\000\000\000\000\000\000\001\243\002\166\002\175\000\000\001\247\000\000\001\020\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\000\000\002\178\000\000\002\172\000\000\000\000\000\000\0021\000\000\000\000\000\000\000\000\000\000\000\000\001\215\0022\000\000\002\174\000\235\004M\002\198\002\174\000\235\001\001\002\181\000\000\000\000\002\182\000\000\000\000\001\248\000\000\000\000\000\000\002\175\000\000\001\249\001\254\000\000\000\000\002.\002/\001l\002\196\000\000\001\131\002\177\002\178\000\000\001\255\002\172\000\000\000\000\000\000\000\000\002\138\004E\000\000\000\000\000\000\000\000\000\000\0022\002\143\002\174\000\235\000\000\002\198\000\000\001\219\002\181\001\028\001\241\002\182\0079\000\000\002\166\000\000\000\000\001\243\002\175\000\000\000\000\001\247\002\175\001\020\002.\002/\001l\002\196\000\000\001\131\002\177\002\176\002\178\001\131\002\177\000\000\001\031\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\000\000\002\198\000\000\003k\000\000\002\181\000\000\000\000\002\182\000\000\002\166\000\000\001\248\000\000\000\000\002\175\000\000\000\000\001\249\001\254\000\000\002.\002/\001l\002\196\000\000\001\131\002\177\002\172\000\000\000\000\001\255\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\0022\000\000\002\174\000\235\002\143\000\000\000\000\001!\002\198\000\000\003n\000\000\000\000\000\000\000\000\000\000\000\000\002\166\002.\002/\001l\000\000\000\000\000\000\001\"\000\000\000\000\000\000\000\000\000\000\001\020\001(\002\178\002\138\002\172\000\000\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\000\000\000\000\0022\003\132\002\174\000\235\000\000\000\000\000\000\000\000\002\166\003d\000\000\000\000\002\182\003e\002.\002/\001l\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\002\178\000\000\000\000\002\172\000\000\004B\000\000\001*\000\000\000\000\001+\000\000\004J\001,\001-\0022\000\000\002\174\000\235\000\000\002\198\000\000\000\000\002\181\000\000\000\000\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\004K\000\000\000\000\001.\002\172\000\000\002\196\000\000\001\131\002\177\000\000\002\178\000\000\002.\002/\001l\0022\000\000\002\174\000\235\001\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\002\198\000\000\000\000\000\000\002\181\000\000\002\143\002\182\000\000\000\000\000\000\000\000\003\135\000\000\002\175\000\000\0021\000\000\002\178\002\166\002.\002/\001l\002\196\000\000\001\131\002\177\000\000\004M\000\000\002\174\000\235\001\001\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\002\181\000\000\002\143\002\182\001\219\000\000\002\198\001\251\003\184\000\000\002\175\000\000\000\000\000\000\001\243\002\166\000\000\000\000\001\247\002\196\001\020\001\131\002\177\000\000\004E\000\000\002.\002/\001l\000\000\000\000\000\000\000\000\000\000\001\215\000\000\000\000\000\000\000\000\000\000\000\000\002\138\002\172\002\198\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\002\175\000\000\0022\003\193\002\174\000\235\000\000\001\248\000\000\002\176\002\166\001\131\002\177\001\249\001\254\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\000\000\000\000\001\255\002\172\000\000\000\000\000\000\000\000\000\000\000\000\002\178\002\138\000\000\001\219\000\000\0022\001\253\002\174\000\235\002\143\000\000\001\028\000\000\001\243\001&\003\202\000\000\001\247\000\000\001\020\000\000\000\000\002\166\002\181\000\000\000\000\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\002\178\001\031\000\000\002\172\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\001\248\000\000\002\181\000\000\000\000\002\182\001\249\001\254\002\198\000\000\000\000\000\000\002\175\000\000\000\000\002.\002/\001l\000\000\001\255\000\000\002\196\000\000\001\131\002\177\000\000\002\178\000\000\002\172\000\000\002\138\000\000\000\000\001k\001l\000\000\000\000\000\000\002\143\000\000\0022\001!\002\174\000\235\004\b\002\198\002.\002/\001l\002\181\000\000\002\166\002\182\001m\001}\000\000\001o\001p\001\"\002\175\000\000\002\138\000\000\000\000\001\020\001(\000\000\000\000\002\196\002\143\001\131\002\177\002\178\000\000\000\000\004\n\000\000\000\000\000\000\000\000\000\000\000\000\002\166\000\000\002.\002/\001l\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\002\181\000\000\001~\002\182\002\138\000\000\000\000\000\000\000\000\000\000\002\175\000\000\002\143\000\000\000\000\000\000\000\000\000\000\004\016\002\196\002\172\001\131\002\177\000\000\001*\002\166\000\000\001+\000\000\000\000\001,\001-\0022\000\000\002\174\000\235\000\000\001\132\002.\002/\001l\000\000\000\000\002\198\000\000\000\000\000\000\000\000\000\000\001u\000\000\002\172\000\235\002\138\000\000\000\000\001.\000\000\000\000\000\000\000\000\002\143\000\000\0022\002\178\002\174\000\235\004\019\000\000\002.\002/\001l\000\000\000\000\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\002\181\000\000\002\172\002\182\000\000\002\143\000\000\000\000\002\178\000\000\002\175\004,\000\000\000\000\0022\000\000\002\174\000\235\002\166\002\196\000\000\001\131\002\177\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\002\181\000\000\000\000\002\182\000\000\001\140\000\000\001\131\001s\000\000\002\175\000\000\002\198\000\000\000\000\002\178\000\000\000\000\000\000\002\196\002\172\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\002\181\000\000\000\000\002\182\000\000\002\198\000\000\000\000\001\028\000\000\002\175\001\029\000\000\002\172\000\000\002.\002/\001l\000\000\002\196\000\000\001\131\002\177\000\000\000\000\0022\002\178\002\174\000\235\000\000\002\138\000\000\000\000\000\000\000\000\001\031\000\000\005\235\002\143\000\000\002.\002/\001l\002\198\004/\000\000\000\000\000\000\000\000\002\181\000\000\002\166\002\182\000\000\000\000\002\138\000\000\002\178\000\000\002\175\000\000\000\000\000\000\002\143\000\000\005\236\000\000\005\237\002\196\004i\001\131\002\177\000\000\000\000\000\000\000\000\002\166\000\000\000\000\000\000\002\181\001%\000\000\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\000\000\002\198\000\000\000\000\000\000\001!\005\238\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\001\"\000\000\002\172\000\000\000\000\000\000\001\020\001(\000\000\000\000\002\198\002\138\000\000\000\000\0022\000\000\002\174\000\235\000\000\002\143\005\239\002.\002/\001l\000\000\004v\000\000\002\172\000\000\000\000\005\240\005\241\002\166\005\242\000\000\000\000\002\138\000\000\000\000\0022\000\000\002\174\000\235\000\000\002\143\000\000\002\178\000\000\000\000\000\000\004\168\000\000\000\000\001)\000\000\000\000\006,\002\166\000\000\000\000\000\000\001*\000\000\000\000\001+\000\000\000\000\001,\001-\002\181\000\000\002\178\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\005\244\000\000\000\000\000\000\000\000\005\246\006\000\000\000\002\196\000\000\001\131\002\177\000\000\001.\002\181\000\000\002\172\002\182\000\000\006*\000\000\000\000\000\000\000\000\002\175\002.\002/\001l\0022\000\000\002\174\000\235\002\198\002\196\000\000\001\131\002\177\006+\000\000\000\000\002\138\002\172\000\000\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\000\000\000\000\0022\005\r\002\174\000\235\002\198\000\000\000\000\002\178\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\000\000\000\000\000\000\000\000\000\000\002\181\000\000\002\178\002\182\000\000\000\000\002\138\000\000\000\000\000\000\002\175\000\000\000\000\000\000\002\143\000\000\000\000\000\000\000\000\002\196\006@\001\131\002\177\000\000\000\000\002\181\000\000\002\166\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\002\172\002\198\002\196\000\000\001\131\002\177\002.\002/\001l\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\006\219\000\000\000\000\002\138\000\000\000\000\000\000\000\000\002\198\000\000\000\000\002\143\001k\001l\000\000\007\202\000\000\006C\007\203\000\000\000\000\006\222\000\000\000\000\002\166\000\000\002\178\000\000\000\000\000\000\006\223\002\172\001m\001}\000\000\001o\001p\000\000\002.\002/\001l\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\002\181\000\000\000\000\002\182\002\138\000\000\002\136\000\000\000\000\000\000\002\175\006\224\002\143\000\000\000\000\000\000\000\000\000\000\006R\002\196\000\000\001\131\002\177\000\000\000\000\002\166\002\178\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\172\002.\002/\001l\002\198\000\000\000\000\000\000\000\000\006\225\002\181\000\000\0022\002\182\002\174\000\235\002\138\000\000\000\000\006\226\002\175\000\000\000\000\001\132\002\143\000\000\000\000\000\000\000\000\002\196\006U\001\131\002\177\000\000\000\000\001u\000\000\002\166\000\235\007\205\002.\002/\001l\000\000\002\178\000\000\002w\000\000\000\000\000\000\002\172\000\000\000\000\002\198\000\000\002\138\000\000\000\000\006\228\000\000\000\000\000\000\0022\002\143\002\174\000\235\000\000\002\181\006\229\006b\002\182\000\000\000\000\006\231\000\000\000\000\002\166\002\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\196\006\233\001\131\002\177\000\000\000\000\000\000\000\000\002\178\000\000\000\000\000\000\001k\001l\001\129\002\172\000\000\000\000\000\000\006\234\000\000\000\000\000\000\001\140\002\198\001\131\001s\0022\000\000\002\174\000\235\002\181\001m\002c\002\182\001o\001p\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\002\196\000\000\001\131\002\177\002\172\000\000\000\000\000\000\000\000\002\178\002d\000\000\002\138\000\000\000\000\000\000\0022\000\000\002\174\000\235\002\143\000\000\000\000\000\000\002\198\000\000\006e\000\000\000\000\000\000\000\000\000\000\002\181\002\166\000\000\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\002.\002/\001l\000\000\000\000\002\178\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\002\138\000\000\000\000\001t\000\000\001\215\001\028\000\000\002\143\001\029\000\000\000\000\000\000\002\181\006z\001u\002\182\002\198\000\235\000\000\000\000\002\166\000\000\002\175\000\000\000\000\002.\002/\001l\000\000\000\000\000\000\002\196\001\031\001\131\002\177\000\000\000\000\000\000\002\172\000\000\002\138\000\000\005\026\000\000\000\000\002.\002/\001l\002\143\002e\0022\000\000\002\174\000\235\006}\002\198\000\000\000\000\007h\001\219\002\138\002\166\002\001\000\000\000\000\000\000\000\000\000\000\002\143\001\243\002g\003f\000\000\001\247\006\129\001\020\000\000\000\000\001%\001\129\000\000\002\166\002\178\000\000\002\172\000\000\000\000\000\000\001\130\000\000\001\131\001s\000\000\001!\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\000\000\000\000\002\181\000\000\000\000\002\182\000\000\001\"\000\000\000\000\000\000\001\248\002\175\001\020\001(\000\000\000\000\001\249\001\254\000\000\000\000\002\196\002\172\001\131\002\177\002\178\002.\002/\001l\000\000\001\255\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\002\138\002\172\000\000\000\000\002\198\000\000\000\000\002\181\002\143\000\000\002\182\000\000\000\000\0022\007m\002\174\000\235\002\175\000\000\0014\000\000\002\166\000\000\000\000\000\000\002\178\002\196\001*\001\131\002\177\001+\000\000\000\000\001,\001-\005#\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\002\181\000\000\002\198\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\001.\000\000\000\000\0018\000\000\000\000\000\000\000\000\002\196\002\181\001\131\002\177\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\002.\002/\001l\000\000\000\000\000\000\002\172\000\000\002\196\000\000\001\131\002\177\002\198\000\000\000\000\002\138\000\000\000\000\0022\000\000\002\174\000\235\000\000\002\143\000\000\002.\002/\001l\000\000\007o\000\000\000\000\002\198\000\000\000\000\000\000\002\166\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\143\000\000\002\178\001k\001l\000\000\000\000\000\000\000\000\000\000\004\187\000\000\000\000\002\166\000\000\000\000\000\000\001\215\000\000\000\000\004\180\000\000\000\000\001m\002c\002\181\001o\001p\002\182\000\000\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\002d\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\0022\000\000\002\174\000\235\002\198\000\000\000\000\000\000\001\219\000\000\000\000\002\025\002\138\002\172\000\000\000\000\000\000\000\000\001\243\000\000\002\143\000\000\001\247\000\000\001\020\0022\000\000\002\174\000\235\000\000\004b\000\000\002\178\002\166\000\000\000\000\000\000\000\000\001t\000\000\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\000\000\001u\000\000\000\000\000\235\000\000\002\181\000\000\002\178\002\182\000\000\002\138\000\000\000\000\001\248\000\000\002\175\000\000\000\000\002\143\001\249\001\254\000\000\000\000\000\000\002\196\000\000\001\131\002\177\003\252\000\000\000\000\002\166\001\255\003\142\000\000\002e\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\002\172\002\198\002\196\000\000\001\131\002\177\005\235\000\000\000\000\003`\003f\000\000\0022\000\000\002\174\000\235\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\001\130\000\000\001\131\001s\002.\002/\001l\005\236\000\000\005\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\178\000\000\002\138\000\000\002\172\000\000\000\000\000\000\000\000\000\000\002\143\001k\001l\000\000\000\000\000\000\0022\000\000\002\174\000\235\003\251\000\000\005\238\002\166\000\000\000\000\003\142\000\000\000\000\001k\001l\001m\001}\002\175\001o\001p\000\000\000\000\000\000\001k\001l\000\000\002\196\000\000\001\131\002\177\000\000\000\000\002\178\001m\001n\000\000\001o\001p\002\142\000\000\000\000\000\000\005\239\001m\001}\000\000\001o\001p\000\000\000\000\002\198\000\000\005\240\005\241\000\000\005\242\000\000\000\000\003\142\001\133\000\000\001\134\002M\000\000\000\000\002\175\002\171\000\000\000\000\000\000\000\000\002\172\000\000\000\000\002\196\000\000\001\131\002\177\005\243\000\000\001k\001l\000\000\0022\000\000\002\174\000\235\001\133\000\000\001\134\002M\000\000\000\000\000\000\001\132\000\000\000\000\000\000\002\198\000\000\001m\001}\005\244\001o\001p\000\000\001u\005\246\006\000\000\235\000\000\000\000\001t\000\000\000\000\002\178\000\000\002w\000\000\000\000\000\000\006*\001\132\002\187\001u\000\000\000\000\000\235\000\000\001k\001l\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\006+\000\000\003\142\000\000\000\000\001\133\002w\001\134\002M\002\175\001m\001}\000\000\001o\001p\000\000\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\002\193\000\000\000\000\000\000\000\000\000\000\000\000\001\132\001\140\002\198\001\131\001s\000\000\000\000\000\000\000\000\000\000\001\129\000\000\001u\000\000\001\133\000\235\001\134\002M\000\000\001\130\001\129\001\131\001s\002w\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\131\001s\001k\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001k\001l\001\132\000\000\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\000\000\001m\001}\000\000\001o\001p\002w\000\000\000\000\000\000\002\202\001\129\002.\002/\001l\000\000\000\000\000\000\001k\001l\001\140\000\000\001\131\001s\002\213\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002M\003\246\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\247\001\129\002\219\000\000\000\000\000\000\000\000\001\132\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\001u\000\000\001\132\000\235\001\133\000\000\001\134\002M\000\000\000\000\000\000\002w\000\000\000\000\001u\000\000\000\000\000\235\000\000\000\000\001k\001l\000\000\000\000\000\000\002w\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0021\000\000\000\000\001k\001l\001\132\001m\001}\000\000\001o\001p\000\000\0022\000\000\002\174\000\235\000\000\001u\000\000\000\000\000\235\000\000\000\000\001m\001}\000\000\001o\001p\002w\002\225\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\001\129\002\231\000\000\003\249\000\000\001\133\000\000\001\134\002M\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\001\129\001k\001l\001\132\002\176\000\000\001\131\002\177\000\000\001\140\000\000\001\131\001s\000\000\000\000\001u\000\000\000\000\000\235\001\215\001\132\001m\001}\000\000\001o\001p\002w\000\000\000\000\001k\001l\000\000\001u\000\000\000\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002w\002\237\006\219\000\000\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\001k\001l\000\000\000\000\000\000\007\193\000\000\001\133\006\222\001\134\002M\000\000\000\000\000\000\002\243\000\000\001\219\006\223\000\000\002=\001m\001}\001\129\001o\001p\000\000\001\243\000\000\000\000\000\000\001\247\001\140\001\020\001\131\001s\001\133\000\000\001\134\002M\001\129\000\000\000\000\001\132\002\249\000\000\000\000\000\000\006\224\001\140\000\000\001\131\001s\000\000\000\000\001u\000\000\000\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\001\133\002w\001\134\002M\000\000\000\000\001\132\001\248\000\000\000\000\000\000\000\000\000\000\001\249\001\254\000\000\000\000\000\000\001u\000\000\006\225\000\235\002.\002/\001l\000\000\001\255\000\000\000\000\002w\006\226\000\000\000\000\001k\001l\001\132\000\000\000\000\000\000\001k\001l\000\000\000\000\000\000\000\000\004\207\000\000\001u\000\000\000\000\000\235\007\194\000\000\001m\001}\001\129\001o\001p\002w\001m\001}\000\000\001o\001p\001\140\000\000\001\131\001s\000\000\006\228\000\000\000\000\000\000\000\000\000\000\000\000\002\255\000\000\000\000\006\229\000\000\000\000\003\005\001\129\006\231\000\000\000\000\000\000\000\000\000\000\001k\001l\001\140\000\000\001\131\001s\000\000\001\133\006\233\001\134\002M\000\000\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\001m\001}\001\129\001o\001p\000\000\006\234\000\000\000\000\000\000\000\000\001\140\0021\001\131\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\132\003\011\0022\000\000\002\174\000\235\001\132\001k\001l\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\000\000\001u\000\000\000\000\000\235\001\133\002w\001\134\002M\000\000\001m\001}\002w\001o\001p\000\000\000\000\000\000\000\000\000\000\000\000\001k\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\017\000\000\000\000\000\000\000\000\000\000\000\000\001\132\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\002\175\000\000\001u\000\000\001\133\000\235\001\134\002M\001\028\002\176\001\129\001\131\002\177\002w\003\023\000\000\001\129\000\000\000\000\001\140\000\000\001\131\001s\001k\001l\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002M\001\132\001k\001l\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\000\000\000\000\000\000\000\000\001m\001}\002w\001o\001p\000\000\003\029\001\129\000\000\000\000\001\132\000\000\000\000\000\000\001k\001l\001\140\000\000\001\131\001s\000\000\000\000\001u\003#\000\000\000\235\000\000\001\133\000\000\001\134\002M\000\000\000\000\002w\001m\001}\001!\001o\001p\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\001\129\003)\000\000\001\020\001(\000\000\001\132\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\001u\000\000\000\000\000\235\001\133\001\132\001\134\002M\002.\002/\001l\002w\000\000\001\129\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\001\140\002\138\001\131\001s\000\000\000\000\002w\000\000\000\000\002\143\001k\001l\000\000\000\000\000\000\001k\001l\001\132\001*\003\140\000\000\001+\002\166\000\000\001,\001-\000\000\000\000\000\000\001u\001m\001}\000\235\001o\001p\001m\001}\000\000\001o\001p\002w\000\000\000\000\001\129\001k\001l\000\000\000\000\000\000\000\000\002i\000\000\001\140\003/\001\131\001s\000\000\000\000\0035\000\000\001\129\000\000\000\000\000\000\001m\001}\000\000\001o\001p\001\140\000\000\001\131\001s\000\000\001\133\000\000\001\134\002M\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\002\172\003;\000\000\000\000\000\000\000\000\000\000\000\000\001\129\001k\001l\000\000\0022\000\000\002\174\000\235\000\000\001\140\000\000\001\131\001s\000\000\001\133\001\132\001\134\002M\000\000\000\000\001\132\001m\001}\000\000\001o\001p\000\000\001u\000\000\000\000\000\235\000\000\001u\000\000\000\000\000\235\002\178\000\000\002w\000\000\000\000\001\028\000\000\002w\003A\000\000\000\000\000\000\000\000\001\132\001k\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001u\003\142\000\000\000\235\001\133\000\000\001\134\002M\002\175\001m\001}\002w\001o\001p\000\000\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\003G\000\000\000\000\000\000\001\129\000\000\000\000\001\132\001\140\002\198\001\131\001s\000\000\001\140\000\000\001\131\001s\000\000\000\000\001u\000\000\001\133\000\235\001\134\002M\002.\002/\001l\000\000\000\000\002w\000\000\000\000\001\129\000\000\000\000\001!\000\000\000\000\000\000\002\138\000\000\001\140\001\028\001\131\001s\005\208\000\000\002\143\000\000\002.\002/\001l\001\"\000\000\000\000\001\132\000\000\003\144\001\020\001(\002\166\0075\000\000\000\000\002\138\000\000\000\000\001u\000\000\001\031\000\235\000\000\002\143\000\000\002.\002/\001l\000\000\002w\000\000\000\000\000\000\003\146\001\129\000\000\002\166\000\000\000\000\000\000\002\138\000\000\000\000\001\140\000\000\001\131\001s\000\000\002\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\149\000\000\000\000\002\166\000\000\000\000\001*\000\000\000\000\001+\000\000\000\000\001,\001-\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\000\000\001!\000\000\001\129\002.\002/\001l\0022\000\000\002\174\000\235\000\000\001\140\000\000\001\131\001s\0073\000\000\001\"\002\138\002\172\000\000\000\000\000\000\001\020\001(\000\000\002\143\001k\001l\000\000\000\000\0022\000\000\002\174\000\235\000\000\003\156\000\000\002\178\002\166\000\000\000\000\000\000\000\000\002\172\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\002\178\003\142\000\000\000\000\002.\002/\001l\003\162\002\175\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\002\196\001+\001\131\002\177\001,\001-\000\000\000\000\002\178\003\142\004Q\001\133\000\000\001\134\002M\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\002\172\002\198\002\196\000\000\001\131\002\177\000\000\001.\000\000\000\000\000\000\003\142\0022\000\000\002\174\000\235\001k\001l\002\175\002.\002/\001l\000\000\001\132\000\000\000\000\002\198\002\196\000\000\001\131\002\177\000\000\000\000\000\000\002\138\001u\001m\001}\000\235\001o\001p\000\000\002\143\000\000\002\178\000\000\002w\000\000\000\000\000\000\000\000\002\198\003\165\000\000\000\000\002\166\000\000\000\000\000\000\003\171\000\000\000\000\000\000\000\000\0021\000\000\000\000\000\000\000\000\000\000\003\142\000\000\002.\002/\001l\000\000\0022\002\175\002\174\000\235\001\133\000\000\001\134\002M\000\000\000\000\002\196\002\138\001\131\002\177\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\000\000\000\000\001\129\001k\001l\000\000\000\000\003\174\000\000\000\000\002\166\001\140\002\198\001\131\001s\000\000\000\000\001\132\000\000\000\000\000\000\002\172\000\000\001m\001}\000\000\001o\001p\000\000\001u\000\000\000\000\000\235\0022\000\000\002\174\000\235\000\000\000\000\000\000\002w\000\000\000\000\002\175\000\000\000\000\003\180\000\000\000\000\000\000\000\000\000\000\002\176\000\000\001\131\002\177\001k\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\178\000\000\001\133\000\000\001\134\002M\000\000\001k\001l\002\172\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\003\142\001m\001}\001\129\001o\001p\000\000\002\175\003\190\000\000\000\000\001\132\001\140\000\000\001\131\001s\002\196\000\000\001\131\002\177\000\000\000\000\000\000\001u\003\199\000\000\000\235\002\178\000\000\001\133\000\000\001\134\002M\000\000\002w\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\003\142\000\000\000\000\000\000\000\000\000\000\000\000\002\175\001k\001l\000\000\001\132\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\001u\000\000\000\000\000\235\001\132\001m\001}\000\000\001o\001p\000\000\002w\001\129\000\000\000\000\000\000\001u\002\198\000\000\000\235\000\000\001\140\000\000\001\131\001s\000\000\000\000\002w\003\208\000\000\002.\002/\001l\000\000\000\000\000\000\001k\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\001\133\000\000\001\134\002M\002\143\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\003\213\000\000\001\129\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\003\219\000\000\001\129\000\000\000\000\001\132\000\000\000\000\000\000\001k\001l\001\140\000\000\001\131\001s\000\000\000\000\001u\000\000\000\000\000\235\001\133\000\000\001\134\002M\000\000\000\000\000\000\002w\001m\001}\000\000\001o\001p\002.\002/\001l\000\000\000\000\000\000\000\000\001\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\000\000\002\172\003\228\000\000\000\000\000\000\001\132\002\143\000\000\000\000\001k\001l\000\000\0022\000\000\002\174\000\235\003\222\001u\000\000\002\166\000\235\000\000\001\133\000\000\001\134\002M\000\000\000\000\002w\001m\001}\001\129\001o\001p\000\000\002.\002/\001l\000\000\000\000\001\140\000\000\001\131\001s\002\178\001\219\000\000\000\000\004q\000\000\002\138\000\000\003\237\001\028\000\000\001\243\000\000\001\132\002\143\001\247\000\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\003\231\001u\003\142\002\166\000\235\001\133\000\000\001\134\002M\002\175\000\000\000\000\002w\000\000\001\129\002\172\000\000\000\000\002\196\000\000\001\131\002\177\000\000\001\140\000\000\001\131\001s\0022\000\000\002\174\000\235\000\000\001\248\000\000\000\000\000\000\000\000\000\000\001\249\001\254\001\132\000\000\002\198\000\000\000\000\000\000\000\000\000\000\001k\001l\000\000\001\255\001u\000\000\000\000\000\235\000\000\000\000\000\000\002\178\000\000\000\000\000\000\002w\000\000\000\000\001\129\002\172\001m\001}\000\000\001o\001p\001!\000\000\001\140\000\000\001\131\001s\0022\000\000\002\174\000\235\000\000\000\000\003\142\000\000\002.\002/\001l\001\"\003\244\002\175\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\002\196\002\138\001\131\002\177\000\000\000\000\002.\002/\001l\002\143\002\178\001\133\000\000\001\134\002M\000\000\001\129\001k\001l\003\255\000\000\002\138\002\166\000\000\002\198\001\140\000\000\001\131\001s\002\143\000\000\000\000\000\000\000\000\000\000\000\000\003\142\001m\001}\004\002\001o\001p\002\166\002\175\001k\001l\001\132\000\000\000\000\000\000\001*\000\000\002\196\001+\001\131\002\177\001,\001-\001u\000\000\004\027\000\235\000\000\000\000\001m\001}\000\000\001o\001p\002w\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\000\000\001\133\004\151\001\134\002M\000\000\002\172\004 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\002.\002/\001l\002\172\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\001\132\000\000\0022\000\000\002\174\000\235\000\000\001\129\001k\001l\0020\000\000\001u\000\000\002\178\000\235\001\140\000\000\001\131\001s\000\000\000\000\000\000\002w\000\000\000\000\000\000\001\132\001m\001}\000\000\001o\001p\000\000\002\178\000\000\000\000\000\000\000\000\001u\003\142\000\000\000\235\000\000\000\000\000\000\000\000\002\175\000\000\000\000\002w\004'\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\003\142\000\000\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002M\002\196\001\129\001\131\002\177\002\198\000\000\000\000\000\000\000\000\000\000\001\140\0021\001\131\001s\000\000\002.\002/\001l\000\000\000\000\000\000\000\000\000\000\0022\002\198\002\174\000\235\000\000\001\129\000\000\002\138\001\132\002.\002/\001l\000\000\000\000\001\140\002\143\001\131\001s\000\000\000\000\001u\000\000\000\000\000\235\002\138\0048\000\000\000\000\002\166\000\000\000\000\002w\002\143\000\000\000\000\001k\001l\000\000\000\000\000\000\001\028\000\000\004<\005\215\000\000\002\166\000\000\000\000\000\000\003K\001l\000\000\000\000\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\000\000\002\175\000\000\001\031\000\000\003g\001}\000\000\001o\001p\002\176\000\000\001\131\002\177\004Z\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\001\140\000\000\001\131\001s\000\000\001\133\000\000\001\134\002M\000\000\0022\000\000\002\174\000\235\000\000\002\172\000\000\000\000\003l\003x\003y\000\000\000\000\000\000\001k\001l\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\001!\000\000\000\000\000\000\000\000\000\000\001\132\000\000\002\178\000\000\001m\001}\000\000\001o\001p\000\000\000\000\001\"\001u\000\000\001\132\000\235\000\000\001\020\001(\002\178\000\000\000\000\000\000\002w\000\000\000\000\001u\004\184\003\142\000\235\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\001\028\000\000\000\000\001\029\000\000\000\000\002\196\003\142\001\131\002\177\001\133\000\000\001\134\002M\002\175\000\000\000\000\000\000\000\000\000\000\000\000\003|\004\174\002\196\000\000\001\131\002\177\001\031\000\000\000\000\002\198\001\215\000\000\000\000\001*\000\000\000\000\001+\000\000\001\129\001,\001-\000\000\000\000\000\000\001\132\000\000\002\198\001\140\000\000\001\131\001s\000\000\001\129\001k\001l\000\000\001u\000\000\000\000\000\235\000\000\001\140\000\000\001\131\001s\001.\000\000\002w\000\000\000\000\001k\001l\001%\001m\001}\000\000\001o\001p\001\028\000\000\000\000\001\029\000\000\000\000\000\000\001\219\000\000\001!\004\196\000\000\001m\001}\000\000\001o\001p\001\243\004\204\000\000\000\000\001\247\000\000\001\020\000\000\000\000\001\"\001\031\000\000\000\000\000\000\000\000\001\020\001(\000\000\004\211\000\000\005\026\000\000\001\133\000\000\001\134\002M\001\129\000\000\001\028\000\000\000\000\001\029\000\000\000\000\000\000\001\140\005\029\001\131\001s\001\133\000\000\001\134\002M\000\000\000\000\001\248\000\000\000\000\000\000\000\000\000\000\001\249\001\254\000\000\000\000\001\031\001%\001\132\000\000\000\000\000\000\000\000\007;\000\000\001\255\005\026\000\000\000\000\000\000\001u\001*\001!\000\235\001+\001\132\000\000\001,\001-\000\000\000\000\002w\005\147\000\000\000\000\000\000\000\000\001u\000\000\001\"\000\235\000\000\002.\002/\001l\001\020\001(\000\000\002w\000\000\000\000\000\000\001%\001.\000\000\000\000\001k\001l\000\000\000\000\000\000\000\000\001\215\000\000\000\000\003\246\000\000\001!\000\000\000\000\000\000\000\000\000\000\006f\000\000\000\000\001m\002c\000\000\001o\001p\000\000\000\000\000\000\001\"\001\129\000\000\000\000\000\000\006\159\001\020\001(\0014\000\000\001\140\000\000\001\131\001s\000\000\000\000\001*\000\000\001\129\001+\002d\000\000\001,\001-\005#\001\028\000\000\001\140\001\029\001\131\001s\000\000\000\000\001\219\000\000\000\000\004\214\000\000\001\028\000\000\000\000\001\029\000\000\001\243\000\000\000\000\000\000\001\247\001.\001\020\000\000\0018\001\031\0014\000\000\000\000\000\000\000\000\0021\000\000\000\000\001*\005\026\000\000\001+\001\031\000\000\001,\001-\005#\0022\001t\002\174\000\235\000\000\005\026\000\000\000\000\006c\001k\001l\000\000\000\000\001u\000\000\000\000\000\235\000\000\001\248\000\000\000\000\006q\000\000\001.\001\249\001\254\0018\000\000\001%\001m\001\128\000\000\001o\001p\001k\001l\003\249\001\255\000\000\000\000\000\000\001%\000\000\001!\000\000\000\000\000\000\000\000\002e\000\000\000\000\006~\000\000\000\000\001m\002c\001!\001o\001p\001\028\001\"\000\000\001\029\000\000\000\000\002\175\001\020\001(\000\000\003`\003f\000\000\000\000\001\"\002\176\000\000\001\131\002\177\001\129\001\020\001(\000\000\002d\000\000\000\000\000\000\001\031\001\130\000\000\001\131\001s\000\000\000\000\000\000\003K\001l\005\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001t\000\000\000\000\000\000\006{\0014\003g\001}\000\000\001o\001p\000\000\001u\001*\000\000\000\235\001+\000\000\0014\001,\001-\005#\000\000\000\000\001%\001t\001*\000\000\000\000\001+\000\000\000\000\001,\001-\005#\000\000\000\000\001u\000\000\001!\000\235\000\000\000\000\000\000\000\000\001.\000\000\000\000\0018\003l\003x\003y\000\000\000\000\000\000\000\000\001\"\000\000\001.\000\000\000\000\0018\001\020\001(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\003K\001l\001\132\001\130\000\000\001\131\001s\000\000\000\000\000\000\003`\003f\000\000\001\215\001u\000\000\000\000\000\235\000\000\001\129\003g\001}\000\000\001o\001p\000\000\0014\000\000\001\130\000\000\001\131\001s\000\000\000\000\001*\000\000\000\000\001+\001k\001l\001,\001-\005#\001\028\000\000\000\000\001\029\003|\006\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001m\001}\000\000\001o\001p\003l\003x\003y\001.\000\000\001\219\0018\001\031\004\217\007<\000\000\000\000\000\000\000\000\000\000\001\243\001\129\000\000\007\t\001\247\000\000\001\020\001\028\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\001\028\000\000\000\000\001\029\001\132\000\000\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\001%\000\000\000\000\000\000\000\000\000\000\001\031\001\248\000\000\000\000\000\000\000\000\000\000\001\249\001\254\001!\004\136\000\000\000\000\000\000\000\000\001\132\001k\001l\000\000\000\000\001\255\000\000\003|\006\174\000\000\007-\001\"\001u\000\000\000\000\000\235\000\000\001\020\001(\000\000\000\000\001m\001}\002w\001o\001p\002.\002/\001l\000\000\000\000\001%\001\215\000\000\000\000\000\000\001!\000\000\000\000\001\129\000\000\002\138\000\000\000\000\000\000\000\000\001!\000\000\001\140\002\143\001\131\001s\000\000\001\"\000\000\000\000\000\000\000\000\000\000\001\020\001(\000\000\002\166\001\"\0014\001\133\000\000\001\134\001\151\001\020\001(\000\000\001*\000\000\000\000\001+\000\000\001\129\001,\001-\007C\000\000\000\000\002.\002/\001l\001\140\001\219\001\131\001s\004\220\000\000\000\000\000j\000\000\000\000\000\000\001\243\002\138\000\000\001\132\001\247\000\000\001\020\001.\000\000\002\143\0018\000\000\000\000\000\000\000\000\001u\000\000\001*\000\235\0014\001+\000\000\002\166\001,\001-\000\000\000\000\001*\000\000\002\172\001+\000\000\000\000\001,\001-\000\000\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\001\248\001k\001l\000\000\004\159\000\000\001\249\001\254\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\004\143\000\000\001\255\000\000\001m\001}\000\000\001o\001p\000\000\000\000\002\178\000\000\000\000\001\185\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001k\001l\002\172\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\0022\004\222\002\174\000\235\001k\001l\001m\001}\002\175\001o\001p\000\000\001\133\000\000\001\134\001\173\001\171\002\196\000\000\001\131\002\177\000\000\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\002\178\000\000\001\175\000\000\000\000\000\000\002.\002/\001l\002\198\000\000\001k\001l\000\000\000\000\001\132\000\000\000\000\001\133\000\000\001\134\001\173\000\000\000\000\000\000\000\000\004\185\001u\000\000\003\246\000\235\001m\001}\002\175\001o\001p\001\133\000\000\001\134\001\173\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\002.\002/\001l\000\000\001\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\001u\002\198\000\000\000\235\000\000\000\000\001\132\002\143\000\000\000\000\001\133\000\000\001\134\002M\000\000\000\000\000\000\000\000\001u\000\000\002\166\000\235\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\0021\000\000\000\000\000\000\001\132\001k\001l\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\001u\000\000\000\000\000\235\000\000\000\000\000\000\000\000\001\129\001m\001}\004\020\001o\001p\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\001\129\002\172\002.\002/\001l\000\000\003\248\000\000\000\000\001\140\000\000\001\131\001s\0022\000\000\002\174\000\235\002\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\143\000\000\001\133\000\000\001\134\002U\000\000\000\000\001k\001l\002\175\000\000\000\000\002\166\001\129\000\000\000\000\000\000\000\000\002\176\002\178\001\131\002\177\001\140\000\000\001\131\001s\000\000\001m\001}\000\000\001o\001p\000\000\000\000\001\215\000\000\001\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004[\000\000\000\000\001u\000\000\000\000\000\235\002\175\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\001\133\002\138\001\134\002M\000\000\002\172\000\000\002X\000\000\002\143\000\000\000\000\000\000\000\000\002\198\000\000\000\000\0022\001\219\002\174\000\235\004\225\002\166\000\000\000\000\002.\002/\001l\001\243\002.\002/\001l\001\247\000\000\001\020\001\132\000\000\000\000\000\000\000\000\002\138\000\000\001\129\000\000\002\138\000\000\000\000\001u\002\143\002\178\000\235\001\140\002\143\001\131\001s\000\000\000\000\000\000\002v\000\000\000\000\002\166\000\000\000\000\000\000\002\166\002.\002/\001l\000\000\000\000\000\000\000\000\001\248\000\000\004\012\000\000\000\000\000\000\001\249\001\254\002\138\002\175\000\000\000\000\000\000\002\172\000\000\000\000\002\143\000\000\002\196\001\255\001\131\002\177\000\000\000\000\000\000\0022\000\000\002\174\000\235\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\002\198\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\131\001s\002\172\000\000\000\000\000\000\002\172\002\178\000\000\000\000\000\000\002.\002/\001l\0022\000\000\002\174\000\235\0022\000\000\002\174\000\235\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\000\000\003\250\002\143\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\002\172\000\000\000\000\002\178\002\166\000\000\002\196\002\178\001\131\002\177\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\002.\002/\001l\000\000\000\000\000\000\001\028\000\000\000\000\000\000\003\130\002\198\000\000\000\000\002\188\002\138\000\000\002\175\000\000\000\000\000\000\002\175\000\000\002\143\000\000\002\178\002\196\000\000\001\131\002\177\002\196\000\000\001\131\002\177\000\000\000\000\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\219\000\000\000\000\000\000\000\000\002\172\002\198\002\194\000\000\000\000\002\198\000\000\000\000\000\000\002\175\007\202\000\000\0022\007\203\002\174\000\235\006\222\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\006\223\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\002.\002/\001l\000\000\000\000\000\000\000\000\002\198\000\000\002\178\001!\002\138\000\000\000\000\000\000\002\138\002\172\000\000\000\000\002\143\006\224\000\000\000\000\002\143\000\000\000\000\000\000\001\"\0022\000\000\002\174\000\235\002\166\001\020\001(\002\203\002\166\000\000\000\000\000\000\000\000\000\000\002\175\002.\002/\001l\000\000\002.\002/\001l\000\000\002\196\000\000\001\131\002\177\000\000\000\000\006\225\002\138\000\000\002\178\000\000\002\138\000\000\000\000\000\000\002\143\006\226\000\000\000\000\002\143\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\002\166\000\000\000\000\000\000\002\166\000\000\000\000\002\214\007\204\001*\000\000\000\000\001+\000\000\002\175\001,\001-\002\172\000\000\000\000\000\000\002\172\000\000\002\196\000\000\001\131\002\177\006\228\000\000\0022\000\000\002\174\000\235\0022\000\000\002\174\000\235\006\229\000\000\000\000\000\000\004\163\006\231\000\000\000\000\000\000\000\000\002\198\002.\002/\001l\000\000\000\000\000\000\000\000\000\000\006\233\000\000\002.\002/\001l\002\178\000\000\002\138\002\172\002\178\000\000\000\000\002\172\000\000\000\000\002\143\000\000\000\000\006\234\000\000\0022\000\000\002\174\000\235\0022\002\128\002\174\000\235\002\166\000\000\000\000\002\220\000\000\000\000\000\000\002\226\000\000\000\000\002\175\000\000\000\000\000\000\002\175\002.\002/\001l\000\000\002\196\000\000\001\131\002\177\002\196\002\178\001\131\002\177\000\000\002\178\000\000\002\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\002\198\000\000\000\000\002\232\002\166\000\000\000\000\002\238\000\000\000\000\002\175\002.\002/\001l\002\175\000\000\000\000\002\172\000\000\002\196\000\000\001\131\002\177\002\196\000\000\001\131\002\177\0021\000\000\0022\000\000\002\174\000\235\000\000\002\130\002.\002/\001l\000\000\0022\000\000\002\174\000\235\002\198\000\000\000\000\000\000\002\198\000\000\000\000\002\138\000\000\002.\002/\001l\000\000\000\000\000\000\002\143\000\000\000\000\002\178\002.\002/\001l\000\000\000\000\002\138\002\172\000\000\000\000\002\166\000\000\000\000\000\000\002\143\000\000\002\138\000\000\000\000\0022\000\000\002\174\000\235\000\000\002\143\000\000\002\244\002\166\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002\196\002\175\001\131\002\177\000\000\000\000\000\000\000\000\0021\002\178\002\176\000\000\001\131\002\177\000\000\000\000\002.\002/\001l\000\000\0022\000\000\002\174\000\235\002\198\000\000\000\000\000\000\000\000\000\000\000\000\002\138\002\172\000\000\000\000\002\250\000\000\000\000\000\000\002\143\000\000\000\000\002\175\000\000\0022\000\000\002\174\000\235\000\000\002\172\000\000\002\196\002\166\001\131\002\177\000\000\000\000\000\000\000\000\002\172\000\000\0022\000\000\002\174\000\235\002.\002/\001l\000\000\000\000\000\000\0022\000\000\002\174\000\235\002\198\002\178\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\002\175\000\000\000\000\002\143\000\000\000\000\000\000\000\000\002\178\002\176\000\000\001\131\002\177\000\000\000\000\000\000\002\166\003\000\002\178\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002\196\003\006\001\131\002\177\000\000\000\000\000\000\000\000\002\175\000\000\0022\003\012\002\174\000\235\000\000\000\000\000\000\002\196\002\175\001\131\002\177\000\000\000\000\000\000\002\198\000\000\000\000\002\196\000\000\001\131\002\177\002.\002/\001l\000\000\000\000\000\000\002.\002/\001l\000\000\002\198\002\178\000\000\000\000\000\000\002\138\002\172\000\000\000\000\000\000\002\198\002\138\000\000\002\143\000\000\000\000\000\000\000\000\0022\002\143\002\174\000\235\000\000\000\000\000\000\000\000\002\166\003\018\000\000\000\000\000\000\000\000\002\166\000\000\002\175\000\000\000\000\002.\002/\001l\000\000\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\002\178\000\000\002\138\000\000\000\000\000\000\000\000\002.\002/\001l\002\143\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\000\000\002\138\002\166\000\000\000\000\003\024\000\000\000\000\000\000\002\143\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002\196\002\166\001\131\002\177\002\172\000\000\002.\002/\001l\000\000\0022\000\000\002\174\000\235\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\000\000\002\198\000\000\002.\002/\001l\002\159\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\002\178\000\000\000\000\002\172\000\000\000\000\002\178\002\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\002\166\000\000\000\000\002\172\000\000\000\000\003\030\000\000\000\000\000\000\000\000\000\000\003$\002\175\000\000\0022\000\000\002\174\000\235\002\175\000\000\000\000\002\196\000\000\001\131\002\177\000\000\002\178\002\196\000\000\001\131\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0021\000\000\002\198\002\178\000\000\000\000\000\000\000\000\002\198\003*\000\000\000\000\0022\000\000\002\174\000\235\002\175\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\0030\000\000\000\000\0022\000\000\002\174\000\235\002\175\002.\002/\001l\000\000\000\000\002.\002/\001l\002\196\000\000\001\131\002\177\002\198\000\000\000\000\002\138\000\000\000\000\000\000\000\000\002\138\000\000\000\000\002\143\000\000\000\000\000\000\002\178\002\143\000\000\000\000\000\000\002\198\000\000\000\000\000\000\002\166\000\000\000\000\000\000\002\175\002\166\000\000\002.\002/\001l\000\000\000\000\000\000\002\176\000\000\001\131\002\177\0036\001k\001l\000\000\000\000\002\138\000\000\002\175\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\002\196\000\000\001\131\002\177\000\000\001m\001\147\000\000\001o\001p\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\028\000\000\002\198\001\029\000\000\000\000\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\0022\001\031\002\174\000\235\000\000\000\000\002.\002/\001l\000\000\000\000\003U\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\000\000\002\138\000\000\000\000\000\000\000\000\002\172\002\178\000\000\002\143\000\000\002\138\002\178\000\000\000\000\000\000\001t\000\000\0022\002\143\002\174\000\235\002\166\000\000\002.\002/\001l\001%\001u\000\000\000\000\000\235\002\166\003<\000\000\000\000\000\000\000\000\003B\002\138\002\175\000\000\001!\000\000\000\000\002\175\000\000\002\143\001\215\002\196\002\178\001\131\002\177\000\000\002\196\000\000\001\131\002\177\000\000\001\"\002\166\000\000\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\003H\000\000\002\198\000\000\000\000\000\000\000\000\002\175\000\000\000\000\002\172\000\000\000\000\000\000\000\000\000\000\002\196\001\129\001\131\002\177\002\172\000\000\0022\000\000\002\174\000\235\001\130\001\219\001\131\001s\004\228\000\000\0022\000\000\002\174\000\235\0014\001\243\000\000\000\000\002\198\001\247\000\000\001\020\001*\000\000\000\000\001+\002\172\000\000\001,\001-\002\150\000\000\002\178\002.\002/\001l\000\000\000\000\0022\000\000\002\174\000\235\002\178\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\000\000\000\000\000\000\001.\000\000\002\143\0018\003\163\000\000\001\248\000\000\000\000\000\000\000\000\002\175\001\249\001\254\003\172\002\166\002\178\000\000\000\000\000\000\002\196\002\175\001\131\002\177\000\000\001\255\000\000\000\000\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\002.\002/\001l\000\000\000\000\000\000\003\181\000\000\002\198\000\000\000\000\001k\001l\002\175\000\000\002\138\000\000\000\000\002\198\000\000\000\000\000\000\002\196\002\143\001\131\002\177\000\000\002.\002/\001l\000\000\001m\001}\000\000\001o\001p\002\166\002.\002/\001l\000\000\000\000\002\138\002\172\000\000\000\000\002\198\002.\002/\001l\002\143\000\000\002\138\000\000\000\000\0022\000\000\002\174\000\235\000\000\002\143\000\000\002\138\002\166\000\000\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\002\166\000\000\001\133\000\000\001\134\007\171\000\000\007\173\000\000\000\000\002\166\000\000\000\000\000\000\002\178\000\000\000\000\000\000\000\000\000\000\000\000\002.\002/\001l\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\001\132\000\000\0022\003\191\002\174\000\235\000\000\002\143\000\000\000\000\002\175\000\000\001u\000\000\000\000\000\235\000\000\002\172\000\000\002\196\002\166\001\131\002\177\000\000\000\000\000\000\000\000\002\172\000\000\0022\000\000\002\174\000\235\000\000\002\178\000\000\000\000\002\172\000\000\0022\000\000\002\174\000\235\002\198\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\200\002\178\000\000\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\002\178\000\000\000\000\000\000\000\000\002\196\001\129\001\131\002\177\000\000\002\178\000\000\000\000\002\172\000\000\001\140\003\209\001\131\001s\000\000\000\000\000\000\000\000\002\175\000\000\0022\003\220\002\174\000\235\002\198\000\000\000\000\002\196\002\175\001\131\002\177\003\229\000\000\002.\002/\001l\000\000\002\196\002\175\001\131\002\177\000\000\000\000\002.\002/\001l\000\000\002\196\002\138\001\131\002\177\002\198\002\178\002.\002/\001l\002\143\000\000\002\138\000\000\000\000\002\198\000\000\000\000\000\000\000\000\002\143\000\000\002\138\002\166\000\000\002\198\000\000\000\000\000\000\000\000\002\143\000\000\003\238\002\166\002.\002/\001l\000\000\000\000\002\175\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002\196\002\138\001\131\002\177\000\000\000\000\000\000\000\000\000\000\002\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\166\000\000\002\198\000\000\000\000\000\000\000\000\001\028\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\0022\000\000\002\174\000\235\000\000\001\031\000\000\000\000\002\172\000\000\0022\000\000\002\174\000\235\000\000\004\136\000\000\001\187\001l\000\000\0022\000\000\002\174\000\235\000\000\000\000\000\000\000\000\000\000\000\000\004\139\000\000\002\178\000\000\000\000\002\172\000\000\001m\002B\000\000\001o\001p\002\178\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\001%\002\178\000\000\000\000\000\000\000\000\000\000\003\245\000\000\000\000\001\028\000\000\000\000\001\029\002\175\001!\000\000\004\"\000\000\000\000\000\000\000\000\000\000\002\196\002\175\001\131\002\177\004!\002\178\004*\003x\003y\001\"\002\196\002\175\001\131\002\177\001\031\001\020\001(\000\000\000\000\005\158\002\196\000\000\001\131\002\177\002\198\000\000\000\000\000\000\000\000\000\000\000\000\004(\000\000\000\000\002\198\000\000\001\028\000\000\002\175\001\029\000\000\000\000\001\132\000\000\002\198\000\000\000\000\002\196\000\000\001\131\002\177\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\000\000\001%\000\000\0014\001\031\000\000\000\000\000\000\000\000\000\000\001\028\001*\002\198\001\029\001+\000\000\001!\001,\001-\000\000\000\000\000\000\001\028\000\000\0041\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\000\000\001\031\000\000\001\020\001(\000\000\006\148\001.\000\000\000\000\004\143\000\000\000\000\001\031\001%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\001!\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\"\001%\000\000\000\000\0014\000\000\001\020\001(\000\000\000\000\000\000\001\028\001*\001%\001\029\001+\001!\000\000\001,\001-\005\163\000\000\000\000\000\000\000\000\002.\002/\001l\001!\000\000\000\000\001\028\000\000\001\"\001\029\000\000\000\000\000\000\001\031\001\020\001(\000\000\000\000\000\000\001.\001\"\000\000\0018\002\173\000\000\000\000\001\020\001(\0014\001k\001l\000\000\000\000\001\031\000\000\000\000\001*\001\028\000\000\001+\001\029\000\000\001,\001-\005\176\000\000\000\000\005\179\000\000\001m\001}\000\000\001o\001p\000\000\007\143\000\000\000\000\000\000\001%\000\000\0014\000\000\000\000\001\031\000\000\000\000\000\000\001.\001*\000\000\0018\001+\0014\001!\001,\001-\005\163\000\000\001%\000\000\001*\000\000\000\000\001+\000\000\000\000\001,\001-\005\176\000\000\001\"\006\192\001\133\001!\001\134\006\255\001\020\001(\000\000\0021\001.\000\000\000\000\0018\000\000\000\000\000\000\000\000\000\000\001%\001\"\0022\001.\002\174\000\235\0018\001\020\001(\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\000\000\000\001\132\000\000\001k\001l\000\000\000\000\000\000\001\028\000\000\000\000\001\029\000\000\001u\000\000\001\"\000\235\0014\000\000\000\000\000\000\001\020\001(\001m\001}\001*\001o\001p\001+\000\000\000\000\001,\001-\007\144\000\000\001\031\000\000\0014\000\000\000\000\000\000\000\000\000\000\001I\000\000\001*\000\000\000\000\001+\000\000\002\175\001,\001-\001_\000\000\000\000\000\000\001.\000\000\002\176\0018\001\131\002\177\000\000\000\000\000\000\000\000\001\133\0014\001\134\001\177\001k\001l\000\000\000\000\000\000\001*\001.\001\129\001+\0018\001%\001,\001-\0015\000\000\000\000\001\140\000\000\001\131\001s\001m\001}\000\000\001o\001p\001!\000\000\000\000\000\000\000\000\000\000\001\132\000\000\000\000\001k\001l\000\000\001.\000\000\000\000\0018\000\000\001\"\001u\000\000\000\000\000\235\000\000\001\020\001(\000\000\000\000\000\000\000\000\001m\001}\000\000\001o\001p\001k\001l\000\000\000\000\000\000\001\133\000\000\001\134\001\167\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0014\000\000\000\000\001\133\001\132\001\134\001\164\000\000\001*\000\000\000\000\001+\000\000\001\129\001,\001-\001u\000\000\000\000\000\235\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\001\133\000\000\001\134\001\163\000\000\000\000\001k\001l\000\000\000\000\001\132\000\000\001.\000\000\000\000\001M\001k\001l\000\000\000\000\000\000\000\000\001u\000\000\000\000\000\235\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\001\132\001m\001}\000\000\001o\001p\000\000\000\000\000\000\002.\002/\001l\001u\000\000\000\000\000\235\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\002\197\000\000\000\000\001\133\000\000\001\134\001\136\000\000\000\000\001\028\000\000\000\000\001\029\001\133\000\000\001\134\001\138\002.\002/\001l\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\001\031\000\000\001\132\000\000\003\153\001k\001l\000\000\000\000\001\129\001k\001l\001\132\000\000\001u\000\000\000\000\000\235\001\140\000\000\001\131\001s\000\000\000\000\001u\001m\001}\000\235\001o\001p\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\001k\001l\0021\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\0022\000\000\002\174\000\235\000\000\000\000\001m\001}\001!\001o\001p\000\000\000\000\000\000\001\028\000\000\001\133\001\029\001\134\001\162\000\000\001\133\000\000\001\134\001\154\001\"\001\129\000\000\0021\000\000\000\000\001\020\001(\000\000\000\000\001\140\001\129\001\131\001s\000\000\0022\001\031\002\174\000\235\000\000\001\140\000\000\001\131\001s\000\000\001\133\001\132\001\134\001\159\000\000\000\000\001\132\000\000\000\000\000\000\000\000\000\000\000\000\001u\000\000\002\175\000\235\000\000\001u\000\000\000\000\000\235\000\000\000\000\002\176\000\000\001\131\002\177\0014\001\028\000\000\000\000\001\029\000\000\000\000\001\132\001*\001%\001\028\001+\000\000\001\029\001,\001-\001\156\000\000\000\000\001u\000\000\000\000\000\235\000\000\001!\000\000\000\000\002\175\001\031\000\000\000\000\001\028\000\000\000\000\001\029\000\000\002\176\001\031\001\131\002\177\001.\001\"\000\000\0018\000\000\000\000\000\000\001\020\001(\000\000\001\129\001\028\000\000\000\000\001\029\001\129\000\000\000\000\001\031\001\140\000\000\001\131\001s\000\000\001\140\000\000\001\131\001s\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\001\031\000\000\000\000\000\000\000\000\001%\001\129\000\000\000\000\000\000\000\000\001!\000\000\000\000\000\000\001\140\0014\001\131\001s\000\000\001!\000\000\000\000\000\000\001*\000\000\001%\001+\001\"\000\000\001,\001-\001\192\000\000\001\020\001(\000\000\001\"\000\000\000\000\000\000\001!\000\000\001\020\001(\000\000\001%\000\000\000\000\001k\001l\000\000\000\000\000\000\000\000\000\000\001.\000\000\001\"\0018\000\000\001!\000\000\000\000\001\020\001(\000\000\000\000\000\000\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\001\"\000\000\001\028\0014\000\000\001\029\001\020\001(\000\000\000\000\000\000\001*\0014\000\000\001+\000\000\000\000\001,\001-\001\233\001*\000\000\000\000\001+\000\000\000\000\001,\001-\001\235\001\031\000\000\000\000\000\000\0014\000\000\001\133\000\000\001\134\002{\001\028\000\000\001*\001\029\001.\001+\000\000\0018\001,\001-\002D\000\000\000\000\001.\0014\000\000\0018\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\001+\000\000\001\031\001,\001-\002W\001\132\000\000\000\000\001.\000\000\001%\0018\000\000\000\000\000\000\000\000\001\028\001u\000\000\001\029\000\235\000\000\000\000\000\000\000\000\001!\000\000\000\000\001.\000\000\000\000\0018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\"\001\031\000\000\000\000\000\000\001%\001\020\001(\000\000\000\000\000\000\001\028\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\028\000\000\000\000\001\029\000\000\000\000\000\000\001\"\001\031\000\000\001\129\000\000\000\000\001\020\001(\000\000\000\000\001%\000\000\001\140\000\000\001\131\001s\0014\000\000\000\000\000\000\001\031\000\000\000\000\000\000\001*\001!\000\000\001+\000\000\000\000\001,\001-\002\148\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\000\000\000\000\001%\001\020\001(\001k\001l\000\000\0014\000\000\000\000\001.\000\000\000\000\0018\000\000\001*\001!\000\000\001+\000\000\001%\001,\001-\002\152\001m\001}\000\000\001o\001p\000\000\000\000\000\000\000\000\001\"\000\000\001!\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\0014\0018\000\000\001\"\000\000\000\000\000\000\000\000\001*\001\020\001(\001+\001k\001l\001,\001-\003R\000\000\000\000\001\133\000\000\001\134\003p\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001m\001}\000\000\001o\001p\0014\001k\001l\001.\000\000\000\000\0018\000\000\001*\000\000\000\000\001+\000\000\000\000\001,\001-\003Y\001\132\000\000\0014\000\000\001m\001}\000\000\001o\001p\000\000\001*\000\000\001u\001+\000\000\000\235\001,\001-\003i\000\000\000\000\000\000\001\133\001.\001\134\003r\0018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001k\001l\000\000\000\000\001.\001k\001l\0018\000\000\000\000\001\133\000\000\001\134\003t\000\000\000\000\000\000\000\000\000\000\001\132\001m\001}\001\215\001o\001p\001m\001}\000\000\001o\001p\000\000\001u\000\000\000\000\000\235\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\001\132\000\000\000\000\001\140\000\000\001\131\001s\001\028\000\000\000\000\001\029\000\000\001u\000\000\000\000\000\235\000\000\001\028\000\000\001\133\001\029\001\134\003{\000\000\001\133\000\000\001\134\005\011\000\000\000\000\000\000\000\000\001\219\000\000\001\031\004\231\000\000\000\000\000\000\000\000\000\000\000\000\001\243\000\000\001\031\000\000\001\247\000\000\001\020\000\000\000\000\001\129\000\000\000\000\001\132\000\000\000\000\000\000\000\000\001\132\001\140\000\000\001\131\001s\000\000\000\000\001u\000\000\000\000\000\235\000\000\001u\000\000\001\028\000\235\000\000\001\029\001\129\000\000\000\000\001%\000\000\001\028\000\000\000\000\001\029\001\140\001\248\001\131\001s\001%\000\000\000\000\001\249\001\254\001!\000\000\000\000\000\000\000\000\001\031\000\000\000\000\000\000\000\000\001!\001\255\000\000\000\000\001\031\000\000\000\000\001\"\000\000\000\000\000\000\000\000\000\000\001\020\001(\000\000\000\000\001\"\001\028\000\000\000\000\001\029\000\000\001\020\001(\000\000\001\129\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001\140\000\000\001\131\001s\000\000\001\140\001%\001\131\001s\000\000\001\031\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\001!\000\000\000\000\000\000\0014\000\000\000\000\000\000\000\000\001!\000\000\000\000\001*\000\000\0014\001+\000\000\001\"\001,\001-\005\028\000\000\001*\001\020\001(\001+\001\"\000\000\001,\001-\005|\000\000\001\020\001(\000\000\001%\001\028\000\000\000\000\005\212\000\000\000\000\000\000\000\000\001.\000\000\000\000\0018\000\000\000\000\001!\000\000\000\000\000\000\001.\000\000\000\000\0018\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\000\000\001\"\000\000\001\028\0014\000\000\005\212\001\020\001(\000\000\000\000\001\028\001*\0014\005\212\001+\000\000\000\000\001,\001-\005\136\001*\000\000\000\000\001+\000\000\000\000\001,\001-\005\162\001\031\000\000\000\000\001\028\000\000\000\000\005\212\000\000\001\031\000\000\000\000\000\000\000\000\005\214\001.\000\000\000\000\0018\000\000\000\000\000\000\000\000\001\028\001.\0014\001\029\0018\000\000\001!\000\000\001\031\000\000\001*\000\000\000\000\001+\000\000\000\000\001,\001-\005\178\000\000\000\000\000\000\000\000\001\"\005\214\000\000\000\000\001\031\000\000\001\020\005\217\000\000\005\214\000\000\000\000\000\000\000\000\001k\001l\001!\000\000\000\000\001.\000\000\000\000\0018\000\000\001!\000\000\000\000\000\000\000\000\000\000\000\000\005\214\000\000\001\"\001m\002b\000\000\001o\001p\001\020\005\217\001\"\000\000\000\000\000\000\000\000\001!\001\020\005\217\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\028\000\000\001*\001\029\001\"\005\218\001!\000\000\001,\001-\001\020\005\217\000\000\001\028\000\000\000\000\001\029\000\000\005\165\000\000\005\222\000\000\005\220\001\"\000\000\000\000\000\000\001\031\000\000\001\020\001(\000\000\000\000\001\028\001.\001*\005\212\000\000\005\218\000\000\001\031\001,\001-\001*\000\000\000\000\005\218\000\000\000\000\001,\001-\005\165\000\000\005\221\001t\005\220\000\000\000\000\000\000\005\165\001\031\005\219\000\000\005\220\000\000\001*\001u\001.\005\218\000\235\000\000\001,\001-\001%\000\000\001.\0014\000\000\000\000\000\000\000\000\005\165\000\000\005\231\001*\005\220\001%\001+\001!\000\000\001,\001-\006N\000\000\000\000\000\000\000\000\001.\000\000\000\000\000\000\001!\000\000\000\000\000\000\001\"\005\214\000\000\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\001.\000\000\001\"\0018\000\000\001!\000\000\000\000\001\020\001(\000\000\000\000\000\000\000\000\001\028\001\129\000\000\005\212\000\000\000\000\000\000\000\000\001\"\000\000\001\130\000\000\001\131\001s\001\020\005\217\000\000\000\000\000\000\001\028\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001\031\0014\000\000\000\000\001\028\000\000\000\000\001\029\000\000\001*\000\000\000\000\001+\000\000\0014\001,\001-\006`\000\000\001\031\000\000\000\000\001*\001\028\000\000\001+\001\029\000\000\001,\001-\006x\001\031\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\001*\000\000\0018\005\218\005\214\000\000\001,\001-\001\031\000\000\000\000\000\000\001.\000\000\000\000\0018\005\165\000\000\006\179\001!\005\220\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001%\001\"\000\000\001!\000\000\000\000\000\000\001\020\005\217\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\000\000\000\001\028\001%\001\"\001\029\000\000\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\000\000\001\"\000\000\001!\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\000\000\001\028\000\000\001\"\001\029\000\000\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\001*\000\000\000\000\005\218\000\000\000\000\001,\001-\000\000\000\000\000\000\0014\000\000\000\000\001\031\000\000\005\165\000\000\006\203\001*\005\220\001\028\001+\0014\001\029\001,\001-\007\002\000\000\001%\000\000\001*\001.\000\000\001+\000\000\000\000\001,\001-\007B\000\000\000\000\0014\000\000\001!\000\000\000\000\000\000\001\031\000\000\001*\001.\000\000\001+\0018\000\000\001,\001-\007E\000\000\001%\001\"\001\028\001.\000\000\001\029\0018\001\020\001(\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\0018\000\000\000\000\000\000\001\031\000\000\000\000\001\"\000\000\001%\000\000\001k\001l\001\020\001(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\000\000\000\000\000\000\000\0014\000\000\001m\002c\000\000\001o\001p\000\000\001*\000\000\000\000\001+\001\"\000\000\001,\001-\000\000\000\000\001\020\001(\000\000\001%\000\000\000\000\000\000\000\000\000\000\001k\001l\000\000\000\000\0014\000\000\000\000\000\000\000\000\001!\000\000\000\000\001*\001.\000\000\001+\001K\000\000\001,\001-\001m\002c\000\000\001o\001p\000\000\001\"\000\000\000\000\000\000\000\000\000\000\001\020\001(\000\000\000\000\000\000\000\000\0014\000\000\006\219\000\000\000\000\000\000\001.\000\000\001*\001\228\000\000\001+\000\000\000\000\001,\001-\001t\007\202\006\219\000\000\007\203\000\000\000\000\006\222\000\000\001\215\000\000\000\000\001u\006\219\000\000\000\235\006\223\007\202\000\000\000\000\007\203\000\000\000\000\006\222\001.\0014\000\000\001\230\000\000\000\000\000\000\006\220\006\223\001*\006\222\000\000\001+\000\000\000\000\001,\001-\000\000\000\000\006\223\000\000\001t\006\224\006\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001u\000\000\000\000\000\235\000\000\006\224\000\000\001\219\001.\000\000\004\245\004\138\000\000\000\000\000\000\000\000\006\224\001\243\000\000\000\000\001\129\001\247\000\000\001\020\001\215\000\000\006\225\000\000\000\000\001\130\000\000\001\131\001s\000\000\000\000\006\206\006\226\000\000\000\000\000\000\000\000\000\000\006\225\006\207\000\000\001\215\000\000\000\000\000\000\000\000\001\215\000\000\006\226\006\225\000\000\000\000\007\208\000\000\000\000\000\000\000\000\000\000\001\248\006\226\000\000\001\129\000\000\000\000\001\249\001\254\000\000\000\000\007\213\000\000\001\130\006\228\001\131\001s\000\000\001\219\000\000\001\255\005E\000\000\000\000\006\229\000\000\006\248\006\215\001\243\006\231\006\228\000\000\001\247\000\000\001\020\000\000\000\000\000\000\001\215\001\219\006\229\006\228\005P\006\233\001\219\006\231\000\000\005V\000\000\001\243\000\000\006\229\000\000\001\247\001\243\001\020\006\231\000\000\001\247\006\233\001\020\006\234\001\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\233\000\000\000\000\001\248\000\000\000\000\000\000\006\234\000\000\001\249\001\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\234\000\000\000\000\000\000\001\255\001\219\001\248\000\000\005_\000\000\000\000\001\248\001\249\001\254\000\000\001\243\000\000\001\249\001\254\001\247\000\000\001\020\000\000\000\000\000\000\001\255\000\000\000\000\000\000\001\219\001\255\000\000\005g\000\000\000\000\000\000\000\000\000\000\000\000\001\243\000\000\000\000\000\000\001\247\000\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\248\000\000\000\000\000\000\000\000\000\000\001\249\001\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\255\000\000\000\000\000\000\000\000\001\248\000\000\000\000\000\000\000\000\000\000\001\249\001\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\255"))
and semantic_action =
[|
@@ -1488,9 +1511,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4137 "src/ocaml/preprocess/parser_raw.mly"
+# 4185 "src/ocaml/preprocess/parser_raw.mly"
( "+" )
-# 1494 "src/ocaml/preprocess/parser_raw.ml"
+# 1517 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1513,9 +1536,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4138 "src/ocaml/preprocess/parser_raw.mly"
+# 4186 "src/ocaml/preprocess/parser_raw.mly"
( "+." )
-# 1519 "src/ocaml/preprocess/parser_raw.ml"
+# 1542 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1538,9 +1561,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3630 "src/ocaml/preprocess/parser_raw.mly"
+# 3671 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1544 "src/ocaml/preprocess/parser_raw.ml"
+# 1567 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1591,15 +1614,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3578 "src/ocaml/preprocess/parser_raw.mly"
+# 3619 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _2 _sloc )
-# 1597 "src/ocaml/preprocess/parser_raw.ml"
+# 1620 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3633 "src/ocaml/preprocess/parser_raw.mly"
+# 3674 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_alias(ty, tyvar) )
-# 1603 "src/ocaml/preprocess/parser_raw.ml"
+# 1626 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__2_inlined1_, _startpos_ty_) in
@@ -1607,15 +1630,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 1613 "src/ocaml/preprocess/parser_raw.ml"
+# 1636 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3635 "src/ocaml/preprocess/parser_raw.mly"
+# 3676 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1619 "src/ocaml/preprocess/parser_raw.ml"
+# 1642 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1662,30 +1685,30 @@ module Tables = struct
let _v : (Ast_helper.let_binding) = let attrs2 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1668 "src/ocaml/preprocess/parser_raw.ml"
+# 1691 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1677 "src/ocaml/preprocess/parser_raw.ml"
+# 1700 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2842 "src/ocaml/preprocess/parser_raw.mly"
+# 2880 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
mklb ~loc:_sloc false body attrs
)
-# 1689 "src/ocaml/preprocess/parser_raw.ml"
+# 1712 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1708,9 +1731,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 4021 "src/ocaml/preprocess/parser_raw.mly"
+# 4069 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1714 "src/ocaml/preprocess/parser_raw.ml"
+# 1737 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1733,9 +1756,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 4022 "src/ocaml/preprocess/parser_raw.mly"
+# 4070 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 1739 "src/ocaml/preprocess/parser_raw.ml"
+# 1762 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1758,9 +1781,9 @@ module Tables = struct
let _startpos = _startpos_type__ in
let _endpos = _endpos_type__ in
let _v : (Parsetree.core_type) =
-# 3766 "src/ocaml/preprocess/parser_raw.mly"
+# 3807 "src/ocaml/preprocess/parser_raw.mly"
( type_ )
-# 1764 "src/ocaml/preprocess/parser_raw.ml"
+# 1787 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1789,35 +1812,35 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 1795 "src/ocaml/preprocess/parser_raw.ml"
+# 1818 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
-# 3799 "src/ocaml/preprocess/parser_raw.mly"
+# 3840 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 1801 "src/ocaml/preprocess/parser_raw.ml"
+# 1824 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3770 "src/ocaml/preprocess/parser_raw.mly"
+# 3811 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_constr (tid, tys) )
-# 1806 "src/ocaml/preprocess/parser_raw.ml"
+# 1829 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 1815 "src/ocaml/preprocess/parser_raw.ml"
+# 1838 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1821 "src/ocaml/preprocess/parser_raw.ml"
+# 1844 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1853,20 +1876,20 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 1859 "src/ocaml/preprocess/parser_raw.ml"
+# 1882 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
-# 3801 "src/ocaml/preprocess/parser_raw.mly"
+# 3842 "src/ocaml/preprocess/parser_raw.mly"
( [ ty ] )
-# 1865 "src/ocaml/preprocess/parser_raw.ml"
+# 1888 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3770 "src/ocaml/preprocess/parser_raw.mly"
+# 3811 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_constr (tid, tys) )
-# 1870 "src/ocaml/preprocess/parser_raw.ml"
+# 1893 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_ty_ in
@@ -1874,15 +1897,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 1880 "src/ocaml/preprocess/parser_raw.ml"
+# 1903 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1886 "src/ocaml/preprocess/parser_raw.ml"
+# 1909 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -1933,9 +1956,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 1939 "src/ocaml/preprocess/parser_raw.ml"
+# 1962 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
@@ -1943,24 +1966,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 1947 "src/ocaml/preprocess/parser_raw.ml"
+# 1970 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1210 "src/ocaml/preprocess/parser_raw.mly"
+# 1230 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 1952 "src/ocaml/preprocess/parser_raw.ml"
+# 1975 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3803 "src/ocaml/preprocess/parser_raw.mly"
+# 3844 "src/ocaml/preprocess/parser_raw.mly"
( tys )
-# 1958 "src/ocaml/preprocess/parser_raw.ml"
+# 1981 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3770 "src/ocaml/preprocess/parser_raw.mly"
+# 3811 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_constr (tid, tys) )
-# 1964 "src/ocaml/preprocess/parser_raw.ml"
+# 1987 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -1968,15 +1991,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 1974 "src/ocaml/preprocess/parser_raw.ml"
+# 1997 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 1980 "src/ocaml/preprocess/parser_raw.ml"
+# 2003 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2012,20 +2035,20 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 2018 "src/ocaml/preprocess/parser_raw.ml"
+# 2041 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
-# 3799 "src/ocaml/preprocess/parser_raw.mly"
+# 3840 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 2024 "src/ocaml/preprocess/parser_raw.ml"
+# 2047 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3774 "src/ocaml/preprocess/parser_raw.mly"
+# 3815 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_class (cid, tys) )
-# 2029 "src/ocaml/preprocess/parser_raw.ml"
+# 2052 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos__2_ in
@@ -2033,15 +2056,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 2039 "src/ocaml/preprocess/parser_raw.ml"
+# 2062 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2045 "src/ocaml/preprocess/parser_raw.ml"
+# 2068 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2084,20 +2107,20 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 2090 "src/ocaml/preprocess/parser_raw.ml"
+# 2113 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
-# 3801 "src/ocaml/preprocess/parser_raw.mly"
+# 3842 "src/ocaml/preprocess/parser_raw.mly"
( [ ty ] )
-# 2096 "src/ocaml/preprocess/parser_raw.ml"
+# 2119 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3774 "src/ocaml/preprocess/parser_raw.mly"
+# 3815 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_class (cid, tys) )
-# 2101 "src/ocaml/preprocess/parser_raw.ml"
+# 2124 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_ty_ in
@@ -2105,15 +2128,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 2111 "src/ocaml/preprocess/parser_raw.ml"
+# 2134 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2117 "src/ocaml/preprocess/parser_raw.ml"
+# 2140 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2171,9 +2194,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 2177 "src/ocaml/preprocess/parser_raw.ml"
+# 2200 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
@@ -2181,24 +2204,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2185 "src/ocaml/preprocess/parser_raw.ml"
+# 2208 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1210 "src/ocaml/preprocess/parser_raw.mly"
+# 1230 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 2190 "src/ocaml/preprocess/parser_raw.ml"
+# 2213 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3803 "src/ocaml/preprocess/parser_raw.mly"
+# 3844 "src/ocaml/preprocess/parser_raw.mly"
( tys )
-# 2196 "src/ocaml/preprocess/parser_raw.ml"
+# 2219 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3774 "src/ocaml/preprocess/parser_raw.mly"
+# 3815 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_class (cid, tys) )
-# 2202 "src/ocaml/preprocess/parser_raw.ml"
+# 2225 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -2206,15 +2229,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 2212 "src/ocaml/preprocess/parser_raw.ml"
+# 2235 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2218 "src/ocaml/preprocess/parser_raw.ml"
+# 2241 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2257,15 +2280,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 2263 "src/ocaml/preprocess/parser_raw.ml"
+# 2286 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3778 "src/ocaml/preprocess/parser_raw.mly"
+# 3819 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_open (mod_ident, type_) )
-# 2269 "src/ocaml/preprocess/parser_raw.ml"
+# 2292 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_type__ in
@@ -2273,15 +2296,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 2279 "src/ocaml/preprocess/parser_raw.ml"
+# 2302 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2285 "src/ocaml/preprocess/parser_raw.ml"
+# 2308 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2312,24 +2335,24 @@ module Tables = struct
let _endpos = _endpos_ident_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3780 "src/ocaml/preprocess/parser_raw.mly"
+# 3821 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_var ident )
-# 2318 "src/ocaml/preprocess/parser_raw.ml"
+# 2341 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_ident_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 2327 "src/ocaml/preprocess/parser_raw.ml"
+# 2350 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2333 "src/ocaml/preprocess/parser_raw.ml"
+# 2356 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2353,23 +2376,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3782 "src/ocaml/preprocess/parser_raw.mly"
+# 3823 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_any )
-# 2359 "src/ocaml/preprocess/parser_raw.ml"
+# 2382 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 2367 "src/ocaml/preprocess/parser_raw.ml"
+# 2390 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3784 "src/ocaml/preprocess/parser_raw.mly"
+# 3825 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2373 "src/ocaml/preprocess/parser_raw.ml"
+# 2396 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2393,23 +2416,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (string Location.loc) = let _1 =
let _1 =
-# 4204 "src/ocaml/preprocess/parser_raw.mly"
+# 4252 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2399 "src/ocaml/preprocess/parser_raw.ml"
+# 2422 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1057 "src/ocaml/preprocess/parser_raw.mly"
+# 1077 "src/ocaml/preprocess/parser_raw.mly"
( mkloc _1 (make_loc _sloc) )
-# 2407 "src/ocaml/preprocess/parser_raw.ml"
+# 2430 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4206 "src/ocaml/preprocess/parser_raw.mly"
+# 4254 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2413 "src/ocaml/preprocess/parser_raw.ml"
+# 2436 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2447,24 +2470,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (string Location.loc) = let _1 =
let _1 =
-# 4205 "src/ocaml/preprocess/parser_raw.mly"
+# 4253 "src/ocaml/preprocess/parser_raw.mly"
( _1 ^ "." ^ _3.txt )
-# 2453 "src/ocaml/preprocess/parser_raw.ml"
+# 2476 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1057 "src/ocaml/preprocess/parser_raw.mly"
+# 1077 "src/ocaml/preprocess/parser_raw.mly"
( mkloc _1 (make_loc _sloc) )
-# 2462 "src/ocaml/preprocess/parser_raw.ml"
+# 2485 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4206 "src/ocaml/preprocess/parser_raw.mly"
+# 4254 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2468 "src/ocaml/preprocess/parser_raw.ml"
+# 2491 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2487,11 +2510,11 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.payload) =
-# 4261 "src/ocaml/preprocess/parser_raw.mly"
+# 4309 "src/ocaml/preprocess/parser_raw.mly"
( Builtin_attributes.mark_payload_attrs_used _1;
_1
)
-# 2495 "src/ocaml/preprocess/parser_raw.ml"
+# 2518 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2538,9 +2561,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4210 "src/ocaml/preprocess/parser_raw.mly"
+# 4258 "src/ocaml/preprocess/parser_raw.mly"
( mk_attr ~loc:(make_loc _sloc) _2 _3 )
-# 2544 "src/ocaml/preprocess/parser_raw.ml"
+# 2567 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2563,9 +2586,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) =
-# 2069 "src/ocaml/preprocess/parser_raw.mly"
+# 2087 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2569 "src/ocaml/preprocess/parser_raw.ml"
+# 2592 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2604,18 +2627,18 @@ module Tables = struct
let _v : (Parsetree.class_expr) = let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2610 "src/ocaml/preprocess/parser_raw.ml"
+# 2633 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2071 "src/ocaml/preprocess/parser_raw.mly"
+# 2089 "src/ocaml/preprocess/parser_raw.mly"
( wrap_class_attrs ~loc:_sloc _3 _2 )
-# 2619 "src/ocaml/preprocess/parser_raw.ml"
+# 2642 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2655,9 +2678,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2073 "src/ocaml/preprocess/parser_raw.mly"
+# 2091 "src/ocaml/preprocess/parser_raw.mly"
( class_of_let_bindings ~loc:_sloc _1 _3 )
-# 2661 "src/ocaml/preprocess/parser_raw.ml"
+# 2684 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2720,34 +2743,34 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 2726 "src/ocaml/preprocess/parser_raw.ml"
+# 2749 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _4 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2735 "src/ocaml/preprocess/parser_raw.ml"
+# 2758 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 2741 "src/ocaml/preprocess/parser_raw.ml"
+# 2764 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2075 "src/ocaml/preprocess/parser_raw.mly"
+# 2093 "src/ocaml/preprocess/parser_raw.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 2751 "src/ocaml/preprocess/parser_raw.ml"
+# 2774 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2817,37 +2840,37 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 2823 "src/ocaml/preprocess/parser_raw.ml"
+# 2846 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2832 "src/ocaml/preprocess/parser_raw.ml"
+# 2855 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 2840 "src/ocaml/preprocess/parser_raw.ml"
+# 2863 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2075 "src/ocaml/preprocess/parser_raw.mly"
+# 2093 "src/ocaml/preprocess/parser_raw.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 2851 "src/ocaml/preprocess/parser_raw.ml"
+# 2874 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2877,9 +2900,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 2079 "src/ocaml/preprocess/parser_raw.mly"
+# 2097 "src/ocaml/preprocess/parser_raw.mly"
( Cl.attr _1 _2 )
-# 2883 "src/ocaml/preprocess/parser_raw.ml"
+# 2906 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2914,18 +2937,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2918 "src/ocaml/preprocess/parser_raw.ml"
+# 2941 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 2923 "src/ocaml/preprocess/parser_raw.ml"
+# 2946 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2082 "src/ocaml/preprocess/parser_raw.mly"
+# 2100 "src/ocaml/preprocess/parser_raw.mly"
( Pcl_apply(_1, _2) )
-# 2929 "src/ocaml/preprocess/parser_raw.ml"
+# 2952 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -2933,15 +2956,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 2939 "src/ocaml/preprocess/parser_raw.ml"
+# 2962 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2085 "src/ocaml/preprocess/parser_raw.mly"
+# 2103 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2945 "src/ocaml/preprocess/parser_raw.ml"
+# 2968 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -2965,23 +2988,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 2084 "src/ocaml/preprocess/parser_raw.mly"
+# 2102 "src/ocaml/preprocess/parser_raw.mly"
( Pcl_extension _1 )
-# 2971 "src/ocaml/preprocess/parser_raw.ml"
+# 2994 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 2979 "src/ocaml/preprocess/parser_raw.ml"
+# 3002 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2085 "src/ocaml/preprocess/parser_raw.mly"
+# 2103 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 2985 "src/ocaml/preprocess/parser_raw.ml"
+# 3008 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3034,33 +3057,33 @@ module Tables = struct
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3040 "src/ocaml/preprocess/parser_raw.ml"
+# 3063 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__6_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3049 "src/ocaml/preprocess/parser_raw.ml"
+# 3072 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 3055 "src/ocaml/preprocess/parser_raw.ml"
+# 3078 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2140 "src/ocaml/preprocess/parser_raw.mly"
+# 2158 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3064 "src/ocaml/preprocess/parser_raw.ml"
+# 3087 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3120,36 +3143,36 @@ module Tables = struct
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3126 "src/ocaml/preprocess/parser_raw.ml"
+# 3149 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _3 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3135 "src/ocaml/preprocess/parser_raw.ml"
+# 3158 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 3143 "src/ocaml/preprocess/parser_raw.ml"
+# 3166 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2140 "src/ocaml/preprocess/parser_raw.mly"
+# 2158 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3153 "src/ocaml/preprocess/parser_raw.ml"
+# 3176 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3189,9 +3212,9 @@ module Tables = struct
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3195 "src/ocaml/preprocess/parser_raw.ml"
+# 3218 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
@@ -3199,11 +3222,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "src/ocaml/preprocess/parser_raw.mly"
+# 2161 "src/ocaml/preprocess/parser_raw.mly"
( let v, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs )
-# 3207 "src/ocaml/preprocess/parser_raw.ml"
+# 3230 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3243,9 +3266,9 @@ module Tables = struct
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3249 "src/ocaml/preprocess/parser_raw.ml"
+# 3272 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
@@ -3253,11 +3276,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2147 "src/ocaml/preprocess/parser_raw.mly"
+# 2165 "src/ocaml/preprocess/parser_raw.mly"
( let meth, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs )
-# 3261 "src/ocaml/preprocess/parser_raw.ml"
+# 3284 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3303,28 +3326,28 @@ module Tables = struct
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3309 "src/ocaml/preprocess/parser_raw.ml"
+# 3332 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3318 "src/ocaml/preprocess/parser_raw.ml"
+# 3341 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2151 "src/ocaml/preprocess/parser_raw.mly"
+# 2169 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 3328 "src/ocaml/preprocess/parser_raw.ml"
+# 3351 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3370,28 +3393,28 @@ module Tables = struct
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3376 "src/ocaml/preprocess/parser_raw.ml"
+# 3399 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3385 "src/ocaml/preprocess/parser_raw.ml"
+# 3408 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2154 "src/ocaml/preprocess/parser_raw.mly"
+# 2172 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs )
-# 3395 "src/ocaml/preprocess/parser_raw.ml"
+# 3418 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3423,9 +3446,9 @@ module Tables = struct
let _v : (Parsetree.class_field) = let _2 =
let _1 = _1_inlined1 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3429 "src/ocaml/preprocess/parser_raw.ml"
+# 3452 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
@@ -3433,10 +3456,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2157 "src/ocaml/preprocess/parser_raw.mly"
+# 2175 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs )
-# 3440 "src/ocaml/preprocess/parser_raw.ml"
+# 3463 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3460,23 +3483,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_field) = let _1 =
let _1 =
-# 2160 "src/ocaml/preprocess/parser_raw.mly"
+# 2178 "src/ocaml/preprocess/parser_raw.mly"
( Pcf_attribute _1 )
-# 3466 "src/ocaml/preprocess/parser_raw.ml"
+# 3489 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1078 "src/ocaml/preprocess/parser_raw.mly"
+# 1098 "src/ocaml/preprocess/parser_raw.mly"
( mkcf ~loc:_sloc _1 )
-# 3474 "src/ocaml/preprocess/parser_raw.ml"
+# 3497 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2161 "src/ocaml/preprocess/parser_raw.mly"
+# 2179 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3480 "src/ocaml/preprocess/parser_raw.ml"
+# 3503 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3506,9 +3529,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 2049 "src/ocaml/preprocess/parser_raw.mly"
+# 2067 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 3512 "src/ocaml/preprocess/parser_raw.ml"
+# 3535 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3553,24 +3576,24 @@ module Tables = struct
let _endpos = _endpos__4_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 2052 "src/ocaml/preprocess/parser_raw.mly"
+# 2070 "src/ocaml/preprocess/parser_raw.mly"
( Pcl_constraint(_4, _2) )
-# 3559 "src/ocaml/preprocess/parser_raw.ml"
+# 3582 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__4_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 3568 "src/ocaml/preprocess/parser_raw.ml"
+# 3591 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2055 "src/ocaml/preprocess/parser_raw.mly"
+# 2073 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3574 "src/ocaml/preprocess/parser_raw.ml"
+# 3597 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3601,24 +3624,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 2054 "src/ocaml/preprocess/parser_raw.mly"
+# 2072 "src/ocaml/preprocess/parser_raw.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) )
-# 3607 "src/ocaml/preprocess/parser_raw.ml"
+# 3630 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 3616 "src/ocaml/preprocess/parser_raw.ml"
+# 3639 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2055 "src/ocaml/preprocess/parser_raw.mly"
+# 2073 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3622 "src/ocaml/preprocess/parser_raw.ml"
+# 3645 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3656,24 +3679,24 @@ module Tables = struct
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 2116 "src/ocaml/preprocess/parser_raw.mly"
+# 2134 "src/ocaml/preprocess/parser_raw.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 3662 "src/ocaml/preprocess/parser_raw.ml"
+# 3685 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_e_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 3671 "src/ocaml/preprocess/parser_raw.ml"
+# 3694 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2117 "src/ocaml/preprocess/parser_raw.mly"
+# 2135 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3677 "src/ocaml/preprocess/parser_raw.ml"
+# 3700 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3704,24 +3727,24 @@ module Tables = struct
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 2116 "src/ocaml/preprocess/parser_raw.mly"
+# 2134 "src/ocaml/preprocess/parser_raw.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 3710 "src/ocaml/preprocess/parser_raw.ml"
+# 3733 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_e_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 3719 "src/ocaml/preprocess/parser_raw.ml"
+# 3742 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2117 "src/ocaml/preprocess/parser_raw.mly"
+# 2135 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3725 "src/ocaml/preprocess/parser_raw.ml"
+# 3748 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3744,9 +3767,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 4011 "src/ocaml/preprocess/parser_raw.mly"
+# 4059 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3750 "src/ocaml/preprocess/parser_raw.ml"
+# 3773 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3786,9 +3809,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2125 "src/ocaml/preprocess/parser_raw.mly"
+# 2143 "src/ocaml/preprocess/parser_raw.mly"
( reloc_pat ~loc:_sloc _2 )
-# 3792 "src/ocaml/preprocess/parser_raw.ml"
+# 3815 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3840,24 +3863,24 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2127 "src/ocaml/preprocess/parser_raw.mly"
+# 2145 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_constraint(_2, _4) )
-# 3846 "src/ocaml/preprocess/parser_raw.ml"
+# 3869 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 3855 "src/ocaml/preprocess/parser_raw.ml"
+# 3878 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2128 "src/ocaml/preprocess/parser_raw.mly"
+# 2146 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3861 "src/ocaml/preprocess/parser_raw.ml"
+# 3884 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3876,9 +3899,9 @@ module Tables = struct
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 2130 "src/ocaml/preprocess/parser_raw.mly"
+# 2148 "src/ocaml/preprocess/parser_raw.mly"
( ghpat ~loc:_sloc Ppat_any )
-# 3882 "src/ocaml/preprocess/parser_raw.ml"
+# 3905 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3915,9 +3938,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 2257 "src/ocaml/preprocess/parser_raw.mly"
+# 2275 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 3921 "src/ocaml/preprocess/parser_raw.ml"
+# 3944 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3934,24 +3957,24 @@ module Tables = struct
let _endpos = _startpos in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 2258 "src/ocaml/preprocess/parser_raw.mly"
+# 2276 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_any )
-# 3940 "src/ocaml/preprocess/parser_raw.ml"
+# 3963 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__0_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 3949 "src/ocaml/preprocess/parser_raw.ml"
+# 3972 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2259 "src/ocaml/preprocess/parser_raw.mly"
+# 2277 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 3955 "src/ocaml/preprocess/parser_raw.ml"
+# 3978 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -3997,28 +4020,28 @@ module Tables = struct
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4003 "src/ocaml/preprocess/parser_raw.ml"
+# 4026 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4012 "src/ocaml/preprocess/parser_raw.ml"
+# 4035 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2267 "src/ocaml/preprocess/parser_raw.mly"
+# 2285 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs )
-# 4022 "src/ocaml/preprocess/parser_raw.ml"
+# 4045 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4076,9 +4099,9 @@ module Tables = struct
let ty : (Parsetree.core_type) = Obj.magic ty in
let _3 : unit = Obj.magic _3 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 4082 "src/ocaml/preprocess/parser_raw.ml"
+# 4105 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let flags : (Asttypes.mutable_flag * Asttypes.virtual_flag) = Obj.magic flags in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -4089,9 +4112,9 @@ module Tables = struct
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4095 "src/ocaml/preprocess/parser_raw.ml"
+# 4118 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined3_ in
@@ -4099,44 +4122,44 @@ module Tables = struct
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let label =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4105 "src/ocaml/preprocess/parser_raw.ml"
+# 4128 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 4113 "src/ocaml/preprocess/parser_raw.ml"
+# 4136 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2292 "src/ocaml/preprocess/parser_raw.mly"
+# 2310 "src/ocaml/preprocess/parser_raw.mly"
(
let mut, virt = flags in
label, mut, virt, ty
)
-# 4122 "src/ocaml/preprocess/parser_raw.ml"
+# 4145 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4130 "src/ocaml/preprocess/parser_raw.ml"
+# 4153 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2270 "src/ocaml/preprocess/parser_raw.mly"
+# 2288 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs )
-# 4140 "src/ocaml/preprocess/parser_raw.ml"
+# 4163 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4194,9 +4217,9 @@ module Tables = struct
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 4200 "src/ocaml/preprocess/parser_raw.ml"
+# 4223 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag * Asttypes.virtual_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -4207,53 +4230,53 @@ module Tables = struct
let _v : (Parsetree.class_type_field) = let _7 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4213 "src/ocaml/preprocess/parser_raw.ml"
+# 4236 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _6 =
let _1 = _1_inlined3 in
-# 3596 "src/ocaml/preprocess/parser_raw.mly"
+# 3637 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4222 "src/ocaml/preprocess/parser_raw.ml"
+# 4245 "src/ocaml/preprocess/parser_raw.ml"
in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4230 "src/ocaml/preprocess/parser_raw.ml"
+# 4253 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 4238 "src/ocaml/preprocess/parser_raw.ml"
+# 4261 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4246 "src/ocaml/preprocess/parser_raw.ml"
+# 4269 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2274 "src/ocaml/preprocess/parser_raw.mly"
+# 2292 "src/ocaml/preprocess/parser_raw.mly"
( let (p, v) = _3 in
let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_method (_4, p, v, _6)) ~attrs:(_2@_7) ~docs )
-# 4257 "src/ocaml/preprocess/parser_raw.ml"
+# 4280 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4299,28 +4322,28 @@ module Tables = struct
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4305 "src/ocaml/preprocess/parser_raw.ml"
+# 4328 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4314 "src/ocaml/preprocess/parser_raw.ml"
+# 4337 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2278 "src/ocaml/preprocess/parser_raw.mly"
+# 2296 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 4324 "src/ocaml/preprocess/parser_raw.ml"
+# 4347 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4352,9 +4375,9 @@ module Tables = struct
let _v : (Parsetree.class_type_field) = let _2 =
let _1 = _1_inlined1 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4358 "src/ocaml/preprocess/parser_raw.ml"
+# 4381 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
@@ -4362,10 +4385,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2281 "src/ocaml/preprocess/parser_raw.mly"
+# 2299 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs )
-# 4369 "src/ocaml/preprocess/parser_raw.ml"
+# 4392 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4389,23 +4412,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type_field) = let _1 =
let _1 =
-# 2284 "src/ocaml/preprocess/parser_raw.mly"
+# 2302 "src/ocaml/preprocess/parser_raw.mly"
( Pctf_attribute _1 )
-# 4395 "src/ocaml/preprocess/parser_raw.ml"
+# 4418 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1076 "src/ocaml/preprocess/parser_raw.mly"
+# 1096 "src/ocaml/preprocess/parser_raw.mly"
( mkctf ~loc:_sloc _1 )
-# 4403 "src/ocaml/preprocess/parser_raw.ml"
+# 4426 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2285 "src/ocaml/preprocess/parser_raw.mly"
+# 2303 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4409 "src/ocaml/preprocess/parser_raw.ml"
+# 4432 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4434,42 +4457,42 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 4440 "src/ocaml/preprocess/parser_raw.ml"
+# 4463 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
let tys =
-# 2243 "src/ocaml/preprocess/parser_raw.mly"
+# 2261 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 4447 "src/ocaml/preprocess/parser_raw.ml"
+# 4470 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2249 "src/ocaml/preprocess/parser_raw.mly"
+# 2267 "src/ocaml/preprocess/parser_raw.mly"
( tys )
-# 4452 "src/ocaml/preprocess/parser_raw.ml"
+# 4475 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2224 "src/ocaml/preprocess/parser_raw.mly"
+# 2242 "src/ocaml/preprocess/parser_raw.mly"
( Pcty_constr (cid, tys) )
-# 4458 "src/ocaml/preprocess/parser_raw.ml"
+# 4481 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1074 "src/ocaml/preprocess/parser_raw.mly"
+# 1094 "src/ocaml/preprocess/parser_raw.mly"
( mkcty ~loc:_sloc _1 )
-# 4467 "src/ocaml/preprocess/parser_raw.ml"
+# 4490 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2227 "src/ocaml/preprocess/parser_raw.mly"
+# 2245 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4473 "src/ocaml/preprocess/parser_raw.ml"
+# 4496 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4520,9 +4543,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 4526 "src/ocaml/preprocess/parser_raw.ml"
+# 4549 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
@@ -4531,30 +4554,30 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 4535 "src/ocaml/preprocess/parser_raw.ml"
+# 4558 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 4540 "src/ocaml/preprocess/parser_raw.ml"
+# 4563 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2245 "src/ocaml/preprocess/parser_raw.mly"
+# 2263 "src/ocaml/preprocess/parser_raw.mly"
( params )
-# 4546 "src/ocaml/preprocess/parser_raw.ml"
+# 4569 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2249 "src/ocaml/preprocess/parser_raw.mly"
+# 2267 "src/ocaml/preprocess/parser_raw.mly"
( tys )
-# 4552 "src/ocaml/preprocess/parser_raw.ml"
+# 4575 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2224 "src/ocaml/preprocess/parser_raw.mly"
+# 2242 "src/ocaml/preprocess/parser_raw.mly"
( Pcty_constr (cid, tys) )
-# 4558 "src/ocaml/preprocess/parser_raw.ml"
+# 4581 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -4562,15 +4585,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1074 "src/ocaml/preprocess/parser_raw.mly"
+# 1094 "src/ocaml/preprocess/parser_raw.mly"
( mkcty ~loc:_sloc _1 )
-# 4568 "src/ocaml/preprocess/parser_raw.ml"
+# 4591 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2227 "src/ocaml/preprocess/parser_raw.mly"
+# 2245 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4574 "src/ocaml/preprocess/parser_raw.ml"
+# 4597 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4594,23 +4617,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
-# 2226 "src/ocaml/preprocess/parser_raw.mly"
+# 2244 "src/ocaml/preprocess/parser_raw.mly"
( Pcty_extension _1 )
-# 4600 "src/ocaml/preprocess/parser_raw.ml"
+# 4623 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1074 "src/ocaml/preprocess/parser_raw.mly"
+# 1094 "src/ocaml/preprocess/parser_raw.mly"
( mkcty ~loc:_sloc _1 )
-# 4608 "src/ocaml/preprocess/parser_raw.ml"
+# 4631 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2227 "src/ocaml/preprocess/parser_raw.mly"
+# 2245 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4614 "src/ocaml/preprocess/parser_raw.ml"
+# 4637 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4667,44 +4690,44 @@ module Tables = struct
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 4671 "src/ocaml/preprocess/parser_raw.ml"
+# 4694 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2263 "src/ocaml/preprocess/parser_raw.mly"
+# 2281 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4676 "src/ocaml/preprocess/parser_raw.ml"
+# 4699 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1022 "src/ocaml/preprocess/parser_raw.mly"
+# 1042 "src/ocaml/preprocess/parser_raw.mly"
( extra_csig _startpos _endpos _1 )
-# 4685 "src/ocaml/preprocess/parser_raw.ml"
+# 4708 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2253 "src/ocaml/preprocess/parser_raw.mly"
+# 2271 "src/ocaml/preprocess/parser_raw.mly"
( Csig.mk _1 _2 )
-# 4691 "src/ocaml/preprocess/parser_raw.ml"
+# 4714 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4699 "src/ocaml/preprocess/parser_raw.ml"
+# 4722 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2229 "src/ocaml/preprocess/parser_raw.mly"
+# 2247 "src/ocaml/preprocess/parser_raw.mly"
( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) )
-# 4708 "src/ocaml/preprocess/parser_raw.ml"
+# 4731 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4734,9 +4757,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_type) =
-# 2235 "src/ocaml/preprocess/parser_raw.mly"
+# 2253 "src/ocaml/preprocess/parser_raw.mly"
( Cty.attr _1 _2 )
-# 4740 "src/ocaml/preprocess/parser_raw.ml"
+# 4763 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4799,34 +4822,34 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 4805 "src/ocaml/preprocess/parser_raw.ml"
+# 4828 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _4 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4814 "src/ocaml/preprocess/parser_raw.ml"
+# 4837 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 4820 "src/ocaml/preprocess/parser_raw.ml"
+# 4843 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2237 "src/ocaml/preprocess/parser_raw.mly"
+# 2255 "src/ocaml/preprocess/parser_raw.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 4830 "src/ocaml/preprocess/parser_raw.ml"
+# 4853 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4896,37 +4919,37 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 4902 "src/ocaml/preprocess/parser_raw.ml"
+# 4925 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 4911 "src/ocaml/preprocess/parser_raw.ml"
+# 4934 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 4919 "src/ocaml/preprocess/parser_raw.ml"
+# 4942 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2237 "src/ocaml/preprocess/parser_raw.mly"
+# 2255 "src/ocaml/preprocess/parser_raw.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 4930 "src/ocaml/preprocess/parser_raw.ml"
+# 4953 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4963,9 +4986,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.class_expr) =
-# 2089 "src/ocaml/preprocess/parser_raw.mly"
+# 2107 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 4969 "src/ocaml/preprocess/parser_raw.ml"
+# 4992 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -4994,42 +5017,42 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 5000 "src/ocaml/preprocess/parser_raw.ml"
+# 5023 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
let tys =
-# 2243 "src/ocaml/preprocess/parser_raw.mly"
+# 2261 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 5007 "src/ocaml/preprocess/parser_raw.ml"
+# 5030 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2249 "src/ocaml/preprocess/parser_raw.mly"
+# 2267 "src/ocaml/preprocess/parser_raw.mly"
( tys )
-# 5012 "src/ocaml/preprocess/parser_raw.ml"
+# 5035 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2096 "src/ocaml/preprocess/parser_raw.mly"
+# 2114 "src/ocaml/preprocess/parser_raw.mly"
( Pcl_constr(cid, tys) )
-# 5018 "src/ocaml/preprocess/parser_raw.ml"
+# 5041 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 5027 "src/ocaml/preprocess/parser_raw.ml"
+# 5050 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2107 "src/ocaml/preprocess/parser_raw.mly"
+# 2125 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5033 "src/ocaml/preprocess/parser_raw.ml"
+# 5056 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5080,9 +5103,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 5086 "src/ocaml/preprocess/parser_raw.ml"
+# 5109 "src/ocaml/preprocess/parser_raw.ml"
in
let tys =
@@ -5091,30 +5114,30 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 5095 "src/ocaml/preprocess/parser_raw.ml"
+# 5118 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 5100 "src/ocaml/preprocess/parser_raw.ml"
+# 5123 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2245 "src/ocaml/preprocess/parser_raw.mly"
+# 2263 "src/ocaml/preprocess/parser_raw.mly"
( params )
-# 5106 "src/ocaml/preprocess/parser_raw.ml"
+# 5129 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2249 "src/ocaml/preprocess/parser_raw.mly"
+# 2267 "src/ocaml/preprocess/parser_raw.mly"
( tys )
-# 5112 "src/ocaml/preprocess/parser_raw.ml"
+# 5135 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2096 "src/ocaml/preprocess/parser_raw.mly"
+# 2114 "src/ocaml/preprocess/parser_raw.mly"
( Pcl_constr(cid, tys) )
-# 5118 "src/ocaml/preprocess/parser_raw.ml"
+# 5141 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -5122,15 +5145,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 5128 "src/ocaml/preprocess/parser_raw.ml"
+# 5151 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2107 "src/ocaml/preprocess/parser_raw.mly"
+# 2125 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5134 "src/ocaml/preprocess/parser_raw.ml"
+# 5157 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5182,24 +5205,24 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 2102 "src/ocaml/preprocess/parser_raw.mly"
+# 2120 "src/ocaml/preprocess/parser_raw.mly"
( Pcl_constraint(_2, _4) )
-# 5188 "src/ocaml/preprocess/parser_raw.ml"
+# 5211 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1080 "src/ocaml/preprocess/parser_raw.mly"
+# 1100 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc _1 )
-# 5197 "src/ocaml/preprocess/parser_raw.ml"
+# 5220 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2107 "src/ocaml/preprocess/parser_raw.mly"
+# 2125 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5203 "src/ocaml/preprocess/parser_raw.ml"
+# 5226 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5256,44 +5279,44 @@ module Tables = struct
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5260 "src/ocaml/preprocess/parser_raw.ml"
+# 5283 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2134 "src/ocaml/preprocess/parser_raw.mly"
+# 2152 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5265 "src/ocaml/preprocess/parser_raw.ml"
+# 5288 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1021 "src/ocaml/preprocess/parser_raw.mly"
+# 1041 "src/ocaml/preprocess/parser_raw.mly"
( extra_cstr _startpos _endpos _1 )
-# 5274 "src/ocaml/preprocess/parser_raw.ml"
+# 5297 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2121 "src/ocaml/preprocess/parser_raw.mly"
+# 2139 "src/ocaml/preprocess/parser_raw.mly"
( Cstr.mk _1 _2 )
-# 5280 "src/ocaml/preprocess/parser_raw.ml"
+# 5303 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5288 "src/ocaml/preprocess/parser_raw.ml"
+# 5311 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2109 "src/ocaml/preprocess/parser_raw.mly"
+# 2127 "src/ocaml/preprocess/parser_raw.mly"
( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) )
-# 5297 "src/ocaml/preprocess/parser_raw.ml"
+# 5320 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5316,9 +5339,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) =
-# 2212 "src/ocaml/preprocess/parser_raw.mly"
+# 2230 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5322 "src/ocaml/preprocess/parser_raw.ml"
+# 5345 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5364,14 +5387,14 @@ module Tables = struct
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3659 "src/ocaml/preprocess/parser_raw.mly"
+# 3700 "src/ocaml/preprocess/parser_raw.mly"
( Optional label )
-# 5370 "src/ocaml/preprocess/parser_raw.ml"
+# 5393 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2218 "src/ocaml/preprocess/parser_raw.mly"
+# 2236 "src/ocaml/preprocess/parser_raw.mly"
( Pcty_arrow(label, domain, codomain) )
-# 5375 "src/ocaml/preprocess/parser_raw.ml"
+# 5398 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
@@ -5379,15 +5402,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1074 "src/ocaml/preprocess/parser_raw.mly"
+# 1094 "src/ocaml/preprocess/parser_raw.mly"
( mkcty ~loc:_sloc _1 )
-# 5385 "src/ocaml/preprocess/parser_raw.ml"
+# 5408 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2219 "src/ocaml/preprocess/parser_raw.mly"
+# 2237 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5391 "src/ocaml/preprocess/parser_raw.ml"
+# 5414 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5434,9 +5457,9 @@ module Tables = struct
let domain : (Parsetree.core_type) = Obj.magic domain in
let _2 : unit = Obj.magic _2 in
let label : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 5440 "src/ocaml/preprocess/parser_raw.ml"
+# 5463 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
@@ -5444,14 +5467,14 @@ module Tables = struct
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3661 "src/ocaml/preprocess/parser_raw.mly"
+# 3702 "src/ocaml/preprocess/parser_raw.mly"
( Labelled label )
-# 5450 "src/ocaml/preprocess/parser_raw.ml"
+# 5473 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2218 "src/ocaml/preprocess/parser_raw.mly"
+# 2236 "src/ocaml/preprocess/parser_raw.mly"
( Pcty_arrow(label, domain, codomain) )
-# 5455 "src/ocaml/preprocess/parser_raw.ml"
+# 5478 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
@@ -5459,15 +5482,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1074 "src/ocaml/preprocess/parser_raw.mly"
+# 1094 "src/ocaml/preprocess/parser_raw.mly"
( mkcty ~loc:_sloc _1 )
-# 5465 "src/ocaml/preprocess/parser_raw.ml"
+# 5488 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2219 "src/ocaml/preprocess/parser_raw.mly"
+# 2237 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5471 "src/ocaml/preprocess/parser_raw.ml"
+# 5494 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5506,14 +5529,14 @@ module Tables = struct
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3663 "src/ocaml/preprocess/parser_raw.mly"
+# 3704 "src/ocaml/preprocess/parser_raw.mly"
( Nolabel )
-# 5512 "src/ocaml/preprocess/parser_raw.ml"
+# 5535 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2218 "src/ocaml/preprocess/parser_raw.mly"
+# 2236 "src/ocaml/preprocess/parser_raw.mly"
( Pcty_arrow(label, domain, codomain) )
-# 5517 "src/ocaml/preprocess/parser_raw.ml"
+# 5540 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in
@@ -5521,15 +5544,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1074 "src/ocaml/preprocess/parser_raw.mly"
+# 1094 "src/ocaml/preprocess/parser_raw.mly"
( mkcty ~loc:_sloc _1 )
-# 5527 "src/ocaml/preprocess/parser_raw.ml"
+# 5550 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2219 "src/ocaml/preprocess/parser_raw.mly"
+# 2237 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5533 "src/ocaml/preprocess/parser_raw.ml"
+# 5556 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5612,9 +5635,9 @@ module Tables = struct
let csig : (Parsetree.class_type) = Obj.magic csig in
let _8 : unit = Obj.magic _8 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 5618 "src/ocaml/preprocess/parser_raw.ml"
+# 5641 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -5630,9 +5653,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5636 "src/ocaml/preprocess/parser_raw.ml"
+# 5659 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -5642,24 +5665,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 5648 "src/ocaml/preprocess/parser_raw.ml"
+# 5671 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5656 "src/ocaml/preprocess/parser_raw.ml"
+# 5679 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2359 "src/ocaml/preprocess/parser_raw.mly"
+# 2377 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
@@ -5667,19 +5690,19 @@ module Tables = struct
ext,
Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
)
-# 5671 "src/ocaml/preprocess/parser_raw.ml"
+# 5694 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 5677 "src/ocaml/preprocess/parser_raw.ml"
+# 5700 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2347 "src/ocaml/preprocess/parser_raw.mly"
+# 2365 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5683 "src/ocaml/preprocess/parser_raw.ml"
+# 5706 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5702,9 +5725,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 4008 "src/ocaml/preprocess/parser_raw.mly"
+# 4056 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5708 "src/ocaml/preprocess/parser_raw.ml"
+# 5731 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5723,17 +5746,21 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 824 "src/ocaml/preprocess/parser_raw.mly"
+# 843 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 5729 "src/ocaml/preprocess/parser_raw.ml"
+# 5752 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
- let _v : (Parsetree.constant) =
-# 3887 "src/ocaml/preprocess/parser_raw.mly"
- ( let (n, m) = _1 in Pconst_integer (n, m) )
-# 5737 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3928 "src/ocaml/preprocess/parser_raw.mly"
+ ( let (n, m) = _1 in
+ mkconst ~loc:_sloc (Pconst_integer (n, m)) )
+# 5764 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5752,17 +5779,20 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 783 "src/ocaml/preprocess/parser_raw.mly"
+# 801 "src/ocaml/preprocess/parser_raw.mly"
(char)
-# 5758 "src/ocaml/preprocess/parser_raw.ml"
+# 5785 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
- let _v : (Parsetree.constant) =
-# 3888 "src/ocaml/preprocess/parser_raw.mly"
- ( Pconst_char _1 )
-# 5766 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3930 "src/ocaml/preprocess/parser_raw.mly"
+ ( mkconst ~loc:_sloc (Pconst_char _1) )
+# 5796 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5781,17 +5811,21 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 876 "src/ocaml/preprocess/parser_raw.mly"
+# 895 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string option)
-# 5787 "src/ocaml/preprocess/parser_raw.ml"
+# 5817 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
- let _v : (Parsetree.constant) =
-# 3889 "src/ocaml/preprocess/parser_raw.mly"
- ( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) )
-# 5795 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3931 "src/ocaml/preprocess/parser_raw.mly"
+ ( let (s, strloc, d) = _1 in
+ mkconst ~loc:_sloc (Pconst_string (s,strloc,d)) )
+# 5829 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5810,17 +5844,21 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 803 "src/ocaml/preprocess/parser_raw.mly"
+# 822 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 5816 "src/ocaml/preprocess/parser_raw.ml"
+# 5850 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
- let _v : (Parsetree.constant) =
-# 3890 "src/ocaml/preprocess/parser_raw.mly"
- ( let (f, m) = _1 in Pconst_float (f, m) )
-# 5824 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3933 "src/ocaml/preprocess/parser_raw.mly"
+ ( let (f, m) = _1 in
+ mkconst ~loc:_sloc (Pconst_float (f, m)) )
+# 5862 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5850,9 +5888,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3963 "src/ocaml/preprocess/parser_raw.mly"
+# 4011 "src/ocaml/preprocess/parser_raw.mly"
( "[]" )
-# 5856 "src/ocaml/preprocess/parser_raw.ml"
+# 5894 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5882,9 +5920,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3964 "src/ocaml/preprocess/parser_raw.mly"
+# 4012 "src/ocaml/preprocess/parser_raw.mly"
( "()" )
-# 5888 "src/ocaml/preprocess/parser_raw.ml"
+# 5926 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5907,9 +5945,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3965 "src/ocaml/preprocess/parser_raw.mly"
+# 4013 "src/ocaml/preprocess/parser_raw.mly"
( "false" )
-# 5913 "src/ocaml/preprocess/parser_raw.ml"
+# 5951 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5932,9 +5970,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3966 "src/ocaml/preprocess/parser_raw.mly"
+# 4014 "src/ocaml/preprocess/parser_raw.mly"
( "true" )
-# 5938 "src/ocaml/preprocess/parser_raw.ml"
+# 5976 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -5953,17 +5991,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 5959 "src/ocaml/preprocess/parser_raw.ml"
+# 5997 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3969 "src/ocaml/preprocess/parser_raw.mly"
+# 4017 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 5967 "src/ocaml/preprocess/parser_raw.ml"
+# 6005 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6000,14 +6038,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (string) = let _1 =
-# 3960 "src/ocaml/preprocess/parser_raw.mly"
+# 4008 "src/ocaml/preprocess/parser_raw.mly"
( "::" )
-# 6006 "src/ocaml/preprocess/parser_raw.ml"
+# 6044 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3970 "src/ocaml/preprocess/parser_raw.mly"
+# 4018 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6011 "src/ocaml/preprocess/parser_raw.ml"
+# 6049 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6030,9 +6068,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3971 "src/ocaml/preprocess/parser_raw.mly"
+# 4019 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6036 "src/ocaml/preprocess/parser_raw.ml"
+# 6074 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6055,9 +6093,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3974 "src/ocaml/preprocess/parser_raw.mly"
+# 4022 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6061 "src/ocaml/preprocess/parser_raw.ml"
+# 6099 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6110,15 +6148,15 @@ module Tables = struct
let _v : (Longident.t) = let _3 =
let (_2, _1) = (_2_inlined1, _1_inlined1) in
-# 3960 "src/ocaml/preprocess/parser_raw.mly"
+# 4008 "src/ocaml/preprocess/parser_raw.mly"
( "::" )
-# 6116 "src/ocaml/preprocess/parser_raw.ml"
+# 6154 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3975 "src/ocaml/preprocess/parser_raw.mly"
+# 4023 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 6122 "src/ocaml/preprocess/parser_raw.ml"
+# 6160 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6155,14 +6193,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _1 =
-# 3960 "src/ocaml/preprocess/parser_raw.mly"
+# 4008 "src/ocaml/preprocess/parser_raw.mly"
( "::" )
-# 6161 "src/ocaml/preprocess/parser_raw.ml"
+# 6199 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3976 "src/ocaml/preprocess/parser_raw.mly"
+# 4024 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 6166 "src/ocaml/preprocess/parser_raw.ml"
+# 6204 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6185,9 +6223,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3977 "src/ocaml/preprocess/parser_raw.mly"
+# 4025 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 6191 "src/ocaml/preprocess/parser_raw.ml"
+# 6229 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6224,9 +6262,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type * Parsetree.core_type) =
-# 2303 "src/ocaml/preprocess/parser_raw.mly"
+# 2321 "src/ocaml/preprocess/parser_raw.mly"
( _1, _3 )
-# 6230 "src/ocaml/preprocess/parser_raw.ml"
+# 6268 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6251,26 +6289,26 @@ module Tables = struct
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 1166 "src/ocaml/preprocess/parser_raw.mly"
+# 1186 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 6257 "src/ocaml/preprocess/parser_raw.ml"
+# 6295 "src/ocaml/preprocess/parser_raw.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 6262 "src/ocaml/preprocess/parser_raw.ml"
+# 6300 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1186 "src/ocaml/preprocess/parser_raw.mly"
+# 1206 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 6268 "src/ocaml/preprocess/parser_raw.ml"
+# 6306 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3462 "src/ocaml/preprocess/parser_raw.mly"
+# 3503 "src/ocaml/preprocess/parser_raw.mly"
( Pcstr_tuple tys )
-# 6274 "src/ocaml/preprocess/parser_raw.ml"
+# 6312 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6309,26 +6347,26 @@ module Tables = struct
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 1170 "src/ocaml/preprocess/parser_raw.mly"
+# 1190 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 6315 "src/ocaml/preprocess/parser_raw.ml"
+# 6353 "src/ocaml/preprocess/parser_raw.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 6320 "src/ocaml/preprocess/parser_raw.ml"
+# 6358 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1186 "src/ocaml/preprocess/parser_raw.mly"
+# 1206 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 6326 "src/ocaml/preprocess/parser_raw.ml"
+# 6364 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3462 "src/ocaml/preprocess/parser_raw.mly"
+# 3503 "src/ocaml/preprocess/parser_raw.mly"
( Pcstr_tuple tys )
-# 6332 "src/ocaml/preprocess/parser_raw.ml"
+# 6370 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6365,9 +6403,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.constructor_arguments) =
-# 3464 "src/ocaml/preprocess/parser_raw.mly"
+# 3505 "src/ocaml/preprocess/parser_raw.mly"
( Pcstr_record _2 )
-# 6371 "src/ocaml/preprocess/parser_raw.ml"
+# 6409 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6390,9 +6428,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constructor_declaration list) =
-# 3378 "src/ocaml/preprocess/parser_raw.mly"
+# 3419 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 6396 "src/ocaml/preprocess/parser_raw.ml"
+# 6434 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6415,14 +6453,14 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.constructor_declaration list) = let cs =
-# 1271 "src/ocaml/preprocess/parser_raw.mly"
+# 1291 "src/ocaml/preprocess/parser_raw.mly"
( List.rev xs )
-# 6421 "src/ocaml/preprocess/parser_raw.ml"
+# 6459 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3380 "src/ocaml/preprocess/parser_raw.mly"
+# 3421 "src/ocaml/preprocess/parser_raw.mly"
( cs )
-# 6426 "src/ocaml/preprocess/parser_raw.ml"
+# 6464 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6445,14 +6483,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3621 "src/ocaml/preprocess/parser_raw.mly"
+# 3662 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6451 "src/ocaml/preprocess/parser_raw.ml"
+# 6489 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3611 "src/ocaml/preprocess/parser_raw.mly"
+# 3652 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6456 "src/ocaml/preprocess/parser_raw.ml"
+# 6494 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6482,9 +6520,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) =
-# 3613 "src/ocaml/preprocess/parser_raw.mly"
+# 3654 "src/ocaml/preprocess/parser_raw.mly"
( Typ.attr _1 _2 )
-# 6488 "src/ocaml/preprocess/parser_raw.ml"
+# 6526 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6507,9 +6545,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3761 "src/ocaml/preprocess/parser_raw.mly"
+# 3802 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6513 "src/ocaml/preprocess/parser_raw.ml"
+# 6551 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6532,9 +6570,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3761 "src/ocaml/preprocess/parser_raw.mly"
+# 3802 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6538 "src/ocaml/preprocess/parser_raw.ml"
+# 6576 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6557,9 +6595,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3761 "src/ocaml/preprocess/parser_raw.mly"
+# 3802 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6563 "src/ocaml/preprocess/parser_raw.ml"
+# 6601 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6596,9 +6634,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 3714 "src/ocaml/preprocess/parser_raw.mly"
+# 3755 "src/ocaml/preprocess/parser_raw.mly"
( type_ )
-# 6602 "src/ocaml/preprocess/parser_raw.ml"
+# 6640 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6661,11 +6699,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 6669 "src/ocaml/preprocess/parser_raw.ml"
+# 6707 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
@@ -6673,24 +6711,24 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6679 "src/ocaml/preprocess/parser_raw.ml"
+# 6717 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 6685 "src/ocaml/preprocess/parser_raw.ml"
+# 6723 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3716 "src/ocaml/preprocess/parser_raw.mly"
+# 3757 "src/ocaml/preprocess/parser_raw.mly"
( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc package_type) attrs )
-# 6694 "src/ocaml/preprocess/parser_raw.ml"
+# 6732 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6728,24 +6766,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3719 "src/ocaml/preprocess/parser_raw.mly"
+# 3760 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_variant([ field ], Closed, None) )
-# 6734 "src/ocaml/preprocess/parser_raw.ml"
+# 6772 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 6743 "src/ocaml/preprocess/parser_raw.ml"
+# 6781 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3736 "src/ocaml/preprocess/parser_raw.mly"
+# 3777 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6749 "src/ocaml/preprocess/parser_raw.ml"
+# 6787 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6795,24 +6833,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 6799 "src/ocaml/preprocess/parser_raw.ml"
+# 6837 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 6804 "src/ocaml/preprocess/parser_raw.ml"
+# 6842 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3813 "src/ocaml/preprocess/parser_raw.mly"
+# 3854 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6810 "src/ocaml/preprocess/parser_raw.ml"
+# 6848 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3721 "src/ocaml/preprocess/parser_raw.mly"
+# 3762 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_variant(fields, Closed, None) )
-# 6816 "src/ocaml/preprocess/parser_raw.ml"
+# 6854 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__4_ in
@@ -6820,15 +6858,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 6826 "src/ocaml/preprocess/parser_raw.ml"
+# 6864 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3736 "src/ocaml/preprocess/parser_raw.mly"
+# 3777 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6832 "src/ocaml/preprocess/parser_raw.ml"
+# 6870 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6885,24 +6923,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 6889 "src/ocaml/preprocess/parser_raw.ml"
+# 6927 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 6894 "src/ocaml/preprocess/parser_raw.ml"
+# 6932 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3813 "src/ocaml/preprocess/parser_raw.mly"
+# 3854 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6900 "src/ocaml/preprocess/parser_raw.ml"
+# 6938 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3723 "src/ocaml/preprocess/parser_raw.mly"
+# 3764 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_variant(field :: fields, Closed, None) )
-# 6906 "src/ocaml/preprocess/parser_raw.ml"
+# 6944 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -6910,15 +6948,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 6916 "src/ocaml/preprocess/parser_raw.ml"
+# 6954 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3736 "src/ocaml/preprocess/parser_raw.mly"
+# 3777 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6922 "src/ocaml/preprocess/parser_raw.ml"
+# 6960 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -6968,24 +7006,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 6972 "src/ocaml/preprocess/parser_raw.ml"
+# 7010 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 6977 "src/ocaml/preprocess/parser_raw.ml"
+# 7015 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3813 "src/ocaml/preprocess/parser_raw.mly"
+# 3854 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 6983 "src/ocaml/preprocess/parser_raw.ml"
+# 7021 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3725 "src/ocaml/preprocess/parser_raw.mly"
+# 3766 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_variant(fields, Open, None) )
-# 6989 "src/ocaml/preprocess/parser_raw.ml"
+# 7027 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__4_ in
@@ -6993,15 +7031,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 6999 "src/ocaml/preprocess/parser_raw.ml"
+# 7037 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3736 "src/ocaml/preprocess/parser_raw.mly"
+# 3777 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7005 "src/ocaml/preprocess/parser_raw.ml"
+# 7043 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7032,24 +7070,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3727 "src/ocaml/preprocess/parser_raw.mly"
+# 3768 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_variant([], Open, None) )
-# 7038 "src/ocaml/preprocess/parser_raw.ml"
+# 7076 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 7047 "src/ocaml/preprocess/parser_raw.ml"
+# 7085 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3736 "src/ocaml/preprocess/parser_raw.mly"
+# 3777 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7053 "src/ocaml/preprocess/parser_raw.ml"
+# 7091 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7099,24 +7137,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7103 "src/ocaml/preprocess/parser_raw.ml"
+# 7141 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 7108 "src/ocaml/preprocess/parser_raw.ml"
+# 7146 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3813 "src/ocaml/preprocess/parser_raw.mly"
+# 3854 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7114 "src/ocaml/preprocess/parser_raw.ml"
+# 7152 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3729 "src/ocaml/preprocess/parser_raw.mly"
+# 3770 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_variant(fields, Closed, Some []) )
-# 7120 "src/ocaml/preprocess/parser_raw.ml"
+# 7158 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__4_ in
@@ -7124,15 +7162,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 7130 "src/ocaml/preprocess/parser_raw.ml"
+# 7168 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3736 "src/ocaml/preprocess/parser_raw.mly"
+# 3777 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7136 "src/ocaml/preprocess/parser_raw.ml"
+# 7174 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7197,18 +7235,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7201 "src/ocaml/preprocess/parser_raw.ml"
+# 7239 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 7206 "src/ocaml/preprocess/parser_raw.ml"
+# 7244 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3841 "src/ocaml/preprocess/parser_raw.mly"
+# 3882 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7212 "src/ocaml/preprocess/parser_raw.ml"
+# 7250 "src/ocaml/preprocess/parser_raw.ml"
in
let fields =
@@ -7216,24 +7254,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7220 "src/ocaml/preprocess/parser_raw.ml"
+# 7258 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 7225 "src/ocaml/preprocess/parser_raw.ml"
+# 7263 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3813 "src/ocaml/preprocess/parser_raw.mly"
+# 3854 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7231 "src/ocaml/preprocess/parser_raw.ml"
+# 7269 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3734 "src/ocaml/preprocess/parser_raw.mly"
+# 3775 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_variant(fields, Closed, Some tags) )
-# 7237 "src/ocaml/preprocess/parser_raw.ml"
+# 7275 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__6_ in
@@ -7241,15 +7279,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 7247 "src/ocaml/preprocess/parser_raw.ml"
+# 7285 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3736 "src/ocaml/preprocess/parser_raw.mly"
+# 3777 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7253 "src/ocaml/preprocess/parser_raw.ml"
+# 7291 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7272,9 +7310,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 4074 "src/ocaml/preprocess/parser_raw.mly"
+# 4122 "src/ocaml/preprocess/parser_raw.mly"
( Upto )
-# 7278 "src/ocaml/preprocess/parser_raw.ml"
+# 7316 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7297,9 +7335,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 4075 "src/ocaml/preprocess/parser_raw.mly"
+# 4123 "src/ocaml/preprocess/parser_raw.mly"
( Downto )
-# 7303 "src/ocaml/preprocess/parser_raw.ml"
+# 7341 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7315,9 +7353,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string Location.loc option) =
-# 4230 "src/ocaml/preprocess/parser_raw.mly"
+# 4278 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 7321 "src/ocaml/preprocess/parser_raw.ml"
+# 7359 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7347,9 +7385,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string Location.loc option) =
-# 4231 "src/ocaml/preprocess/parser_raw.mly"
+# 4279 "src/ocaml/preprocess/parser_raw.mly"
( Some _2 )
-# 7353 "src/ocaml/preprocess/parser_raw.ml"
+# 7391 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7393,9 +7431,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 4243 "src/ocaml/preprocess/parser_raw.mly"
+# 4291 "src/ocaml/preprocess/parser_raw.mly"
( (_2, _3) )
-# 7399 "src/ocaml/preprocess/parser_raw.ml"
+# 7437 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7414,9 +7452,9 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 878 "src/ocaml/preprocess/parser_raw.mly"
+# 897 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string * Location.t * string option)
-# 7420 "src/ocaml/preprocess/parser_raw.ml"
+# 7458 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -7425,9 +7463,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4245 "src/ocaml/preprocess/parser_raw.mly"
+# 4293 "src/ocaml/preprocess/parser_raw.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 7431 "src/ocaml/preprocess/parser_raw.ml"
+# 7469 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7480,9 +7518,9 @@ module Tables = struct
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined3 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7486 "src/ocaml/preprocess/parser_raw.ml"
+# 7524 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs_ = _endpos__1_inlined3_ in
@@ -7492,9 +7530,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 7498 "src/ocaml/preprocess/parser_raw.ml"
+# 7536 "src/ocaml/preprocess/parser_raw.ml"
in
let cid =
@@ -7503,19 +7541,19 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 7509 "src/ocaml/preprocess/parser_raw.ml"
+# 7547 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3531 "src/ocaml/preprocess/parser_raw.mly"
+# 3572 "src/ocaml/preprocess/parser_raw.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 7519 "src/ocaml/preprocess/parser_raw.ml"
+# 7557 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7561,9 +7599,9 @@ module Tables = struct
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7567 "src/ocaml/preprocess/parser_raw.ml"
+# 7605 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
@@ -7573,9 +7611,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 7579 "src/ocaml/preprocess/parser_raw.ml"
+# 7617 "src/ocaml/preprocess/parser_raw.ml"
in
let cid =
@@ -7583,25 +7621,25 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 7589 "src/ocaml/preprocess/parser_raw.ml"
+# 7627 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 4048 "src/ocaml/preprocess/parser_raw.mly"
+# 4096 "src/ocaml/preprocess/parser_raw.mly"
( () )
-# 7596 "src/ocaml/preprocess/parser_raw.ml"
+# 7634 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3531 "src/ocaml/preprocess/parser_raw.mly"
+# 3572 "src/ocaml/preprocess/parser_raw.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 7605 "src/ocaml/preprocess/parser_raw.ml"
+# 7643 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7625,24 +7663,24 @@ module Tables = struct
let _endpos = _endpos_ext_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3752 "src/ocaml/preprocess/parser_raw.mly"
+# 3793 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_extension ext )
-# 7631 "src/ocaml/preprocess/parser_raw.ml"
+# 7669 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_ext_, _startpos_ext_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 7640 "src/ocaml/preprocess/parser_raw.ml"
+# 7678 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3754 "src/ocaml/preprocess/parser_raw.mly"
+# 3795 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7646 "src/ocaml/preprocess/parser_raw.ml"
+# 7684 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7689,10 +7727,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4218 "src/ocaml/preprocess/parser_raw.mly"
+# 4266 "src/ocaml/preprocess/parser_raw.mly"
( mark_symbol_docs _sloc;
mk_attr ~loc:(make_loc _sloc) _2 _3 )
-# 7696 "src/ocaml/preprocess/parser_raw.ml"
+# 7734 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7708,14 +7746,14 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params =
-# 2243 "src/ocaml/preprocess/parser_raw.mly"
+# 2261 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 7714 "src/ocaml/preprocess/parser_raw.ml"
+# 7752 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2060 "src/ocaml/preprocess/parser_raw.mly"
+# 2078 "src/ocaml/preprocess/parser_raw.mly"
( params )
-# 7719 "src/ocaml/preprocess/parser_raw.ml"
+# 7757 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7756,24 +7794,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7760 "src/ocaml/preprocess/parser_raw.ml"
+# 7798 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 7765 "src/ocaml/preprocess/parser_raw.ml"
+# 7803 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2245 "src/ocaml/preprocess/parser_raw.mly"
+# 2263 "src/ocaml/preprocess/parser_raw.mly"
( params )
-# 7771 "src/ocaml/preprocess/parser_raw.ml"
+# 7809 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2060 "src/ocaml/preprocess/parser_raw.mly"
+# 2078 "src/ocaml/preprocess/parser_raw.mly"
( params )
-# 7777 "src/ocaml/preprocess/parser_raw.ml"
+# 7815 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7821,18 +7859,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7825 "src/ocaml/preprocess/parser_raw.ml"
+# 7863 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 7830 "src/ocaml/preprocess/parser_raw.ml"
+# 7868 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 7836 "src/ocaml/preprocess/parser_raw.ml"
+# 7874 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -7841,22 +7879,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7847 "src/ocaml/preprocess/parser_raw.ml"
+# 7885 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 7853 "src/ocaml/preprocess/parser_raw.ml"
+# 7891 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2879 "src/ocaml/preprocess/parser_raw.mly"
+# 2917 "src/ocaml/preprocess/parser_raw.mly"
( let ext, attrs = _2 in
match ext with
| None -> Pfunction_cases (_3, make_loc _sloc, attrs)
@@ -7866,7 +7904,7 @@ module Tables = struct
Pfunction_body
(mkexp_attrs ~loc:_sloc (mkfunction [] None cases) _2)
)
-# 7870 "src/ocaml/preprocess/parser_raw.ml"
+# 7908 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7889,9 +7927,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.function_body) =
-# 2889 "src/ocaml/preprocess/parser_raw.mly"
+# 2927 "src/ocaml/preprocess/parser_raw.mly"
( Pfunction_body _1 )
-# 7895 "src/ocaml/preprocess/parser_raw.ml"
+# 7933 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7914,9 +7952,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2501 "src/ocaml/preprocess/parser_raw.mly"
+# 2519 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 7920 "src/ocaml/preprocess/parser_raw.ml"
+# 7958 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -7994,9 +8032,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 8000 "src/ocaml/preprocess/parser_raw.ml"
+# 8038 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
@@ -8004,21 +8042,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8010 "src/ocaml/preprocess/parser_raw.ml"
+# 8048 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8016 "src/ocaml/preprocess/parser_raw.ml"
+# 8054 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2539 "src/ocaml/preprocess/parser_raw.mly"
+# 2557 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_letmodule(_4, _5, (merloc _endpos__6_ _7)), _3 )
-# 8022 "src/ocaml/preprocess/parser_raw.ml"
+# 8060 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__7_ in
@@ -8026,10 +8064,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8033 "src/ocaml/preprocess/parser_raw.ml"
+# 8071 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8114,9 +8152,9 @@ module Tables = struct
let _3 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8120 "src/ocaml/preprocess/parser_raw.ml"
+# 8158 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
@@ -8125,19 +8163,19 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 8131 "src/ocaml/preprocess/parser_raw.ml"
+# 8169 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3442 "src/ocaml/preprocess/parser_raw.mly"
+# 3483 "src/ocaml/preprocess/parser_raw.mly"
( let vars, args, res = _2 in
Te.decl _1 ~vars ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
-# 8141 "src/ocaml/preprocess/parser_raw.ml"
+# 8179 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
@@ -8145,21 +8183,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8151 "src/ocaml/preprocess/parser_raw.ml"
+# 8189 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8157 "src/ocaml/preprocess/parser_raw.ml"
+# 8195 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2541 "src/ocaml/preprocess/parser_raw.mly"
+# 2559 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_letexception(_4, _6), _3 )
-# 8163 "src/ocaml/preprocess/parser_raw.ml"
+# 8201 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__6_ in
@@ -8167,10 +8205,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8174 "src/ocaml/preprocess/parser_raw.ml"
+# 8212 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8240,28 +8278,28 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8246 "src/ocaml/preprocess/parser_raw.ml"
+# 8284 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8252 "src/ocaml/preprocess/parser_raw.ml"
+# 8290 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 8258 "src/ocaml/preprocess/parser_raw.ml"
+# 8296 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2543 "src/ocaml/preprocess/parser_raw.mly"
+# 2561 "src/ocaml/preprocess/parser_raw.mly"
( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
Pexp_open(od, (merloc _endpos__6_ _7)), _4 )
-# 8265 "src/ocaml/preprocess/parser_raw.ml"
+# 8303 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__7_ in
@@ -8269,10 +8307,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8276 "src/ocaml/preprocess/parser_raw.ml"
+# 8314 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8349,31 +8387,31 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8355 "src/ocaml/preprocess/parser_raw.ml"
+# 8393 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8361 "src/ocaml/preprocess/parser_raw.ml"
+# 8399 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 8369 "src/ocaml/preprocess/parser_raw.ml"
+# 8407 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2543 "src/ocaml/preprocess/parser_raw.mly"
+# 2561 "src/ocaml/preprocess/parser_raw.mly"
( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
Pexp_open(od, (merloc _endpos__6_ _7)), _4 )
-# 8377 "src/ocaml/preprocess/parser_raw.ml"
+# 8415 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__7_ in
@@ -8381,10 +8419,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8388 "src/ocaml/preprocess/parser_raw.ml"
+# 8426 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8454,23 +8492,23 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8460 "src/ocaml/preprocess/parser_raw.ml"
+# 8498 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8466 "src/ocaml/preprocess/parser_raw.ml"
+# 8504 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2549 "src/ocaml/preprocess/parser_raw.mly"
+# 2567 "src/ocaml/preprocess/parser_raw.mly"
( let body_constraint = Option.map (fun x -> Pconstraint x) _4 in
mkfunction _3 body_constraint _6, _2
)
-# 8474 "src/ocaml/preprocess/parser_raw.ml"
+# 8512 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__6_ in
@@ -8478,10 +8516,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8485 "src/ocaml/preprocess/parser_raw.ml"
+# 8523 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8544,18 +8582,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8548 "src/ocaml/preprocess/parser_raw.ml"
+# 8586 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 8553 "src/ocaml/preprocess/parser_raw.ml"
+# 8591 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 8559 "src/ocaml/preprocess/parser_raw.ml"
+# 8597 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -8563,21 +8601,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8569 "src/ocaml/preprocess/parser_raw.ml"
+# 8607 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8575 "src/ocaml/preprocess/parser_raw.ml"
+# 8613 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2553 "src/ocaml/preprocess/parser_raw.mly"
+# 2571 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_match(_3, _5), _2 )
-# 8581 "src/ocaml/preprocess/parser_raw.ml"
+# 8619 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -8585,10 +8623,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8592 "src/ocaml/preprocess/parser_raw.ml"
+# 8630 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8651,18 +8689,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8655 "src/ocaml/preprocess/parser_raw.ml"
+# 8693 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 8660 "src/ocaml/preprocess/parser_raw.ml"
+# 8698 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 8666 "src/ocaml/preprocess/parser_raw.ml"
+# 8704 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -8670,21 +8708,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8676 "src/ocaml/preprocess/parser_raw.ml"
+# 8714 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8682 "src/ocaml/preprocess/parser_raw.ml"
+# 8720 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2555 "src/ocaml/preprocess/parser_raw.mly"
+# 2573 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_try(_3, _5), _2 )
-# 8688 "src/ocaml/preprocess/parser_raw.ml"
+# 8726 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -8692,10 +8730,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8699 "src/ocaml/preprocess/parser_raw.ml"
+# 8737 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8770,27 +8808,27 @@ module Tables = struct
let _7 =
let _1 = _1_inlined4 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8776 "src/ocaml/preprocess/parser_raw.ml"
+# 8814 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8781 "src/ocaml/preprocess/parser_raw.ml"
+# 8819 "src/ocaml/preprocess/parser_raw.ml"
in
let _5 =
let _1 = _1_inlined3 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8789 "src/ocaml/preprocess/parser_raw.ml"
+# 8827 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8794 "src/ocaml/preprocess/parser_raw.ml"
+# 8832 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -8798,21 +8836,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8804 "src/ocaml/preprocess/parser_raw.ml"
+# 8842 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8810 "src/ocaml/preprocess/parser_raw.ml"
+# 8848 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2561 "src/ocaml/preprocess/parser_raw.mly"
+# 2579 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_ifthenelse(_3, (merloc _endpos__4_ _5), Some (merloc _endpos__6_ _7)), _2 )
-# 8816 "src/ocaml/preprocess/parser_raw.ml"
+# 8854 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
@@ -8820,10 +8858,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8827 "src/ocaml/preprocess/parser_raw.ml"
+# 8865 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -8924,18 +8962,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8928 "src/ocaml/preprocess/parser_raw.ml"
+# 8966 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 8933 "src/ocaml/preprocess/parser_raw.ml"
+# 8971 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 8939 "src/ocaml/preprocess/parser_raw.ml"
+# 8977 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -8944,22 +8982,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8950 "src/ocaml/preprocess/parser_raw.ml"
+# 8988 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 8956 "src/ocaml/preprocess/parser_raw.ml"
+# 8994 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -8972,26 +9010,26 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 8976 "src/ocaml/preprocess/parser_raw.ml"
+# 9014 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8982 "src/ocaml/preprocess/parser_raw.ml"
+# 9020 "src/ocaml/preprocess/parser_raw.ml"
in
let _5 =
let _1 = _1_inlined3 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8990 "src/ocaml/preprocess/parser_raw.ml"
+# 9028 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 8995 "src/ocaml/preprocess/parser_raw.ml"
+# 9033 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -8999,21 +9037,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9005 "src/ocaml/preprocess/parser_raw.ml"
+# 9043 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9011 "src/ocaml/preprocess/parser_raw.ml"
+# 9049 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2561 "src/ocaml/preprocess/parser_raw.mly"
+# 2579 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_ifthenelse(_3, (merloc _endpos__4_ _5), Some (merloc _endpos__6_ _7)), _2 )
-# 9017 "src/ocaml/preprocess/parser_raw.ml"
+# 9055 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -9021,10 +9059,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9028 "src/ocaml/preprocess/parser_raw.ml"
+# 9066 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -9120,14 +9158,14 @@ module Tables = struct
let _7 =
let _1 = _1_inlined6 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9126 "src/ocaml/preprocess/parser_raw.ml"
+# 9164 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9131 "src/ocaml/preprocess/parser_raw.ml"
+# 9169 "src/ocaml/preprocess/parser_raw.ml"
in
let _5 =
@@ -9138,18 +9176,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9142 "src/ocaml/preprocess/parser_raw.ml"
+# 9180 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9147 "src/ocaml/preprocess/parser_raw.ml"
+# 9185 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9153 "src/ocaml/preprocess/parser_raw.ml"
+# 9191 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -9158,22 +9196,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9164 "src/ocaml/preprocess/parser_raw.ml"
+# 9202 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9170 "src/ocaml/preprocess/parser_raw.ml"
+# 9208 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -9186,13 +9224,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 9190 "src/ocaml/preprocess/parser_raw.ml"
+# 9228 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9196 "src/ocaml/preprocess/parser_raw.ml"
+# 9234 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -9200,21 +9238,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9206 "src/ocaml/preprocess/parser_raw.ml"
+# 9244 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9212 "src/ocaml/preprocess/parser_raw.ml"
+# 9250 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2561 "src/ocaml/preprocess/parser_raw.mly"
+# 2579 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_ifthenelse(_3, (merloc _endpos__4_ _5), Some (merloc _endpos__6_ _7)), _2 )
-# 9218 "src/ocaml/preprocess/parser_raw.ml"
+# 9256 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined6_ in
@@ -9222,10 +9260,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9229 "src/ocaml/preprocess/parser_raw.ml"
+# 9267 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -9347,18 +9385,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9351 "src/ocaml/preprocess/parser_raw.ml"
+# 9389 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9356 "src/ocaml/preprocess/parser_raw.ml"
+# 9394 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9362 "src/ocaml/preprocess/parser_raw.ml"
+# 9400 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -9367,22 +9405,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9373 "src/ocaml/preprocess/parser_raw.ml"
+# 9411 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9379 "src/ocaml/preprocess/parser_raw.ml"
+# 9417 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -9395,13 +9433,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 9399 "src/ocaml/preprocess/parser_raw.ml"
+# 9437 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9405 "src/ocaml/preprocess/parser_raw.ml"
+# 9443 "src/ocaml/preprocess/parser_raw.ml"
in
let _5 =
@@ -9412,18 +9450,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9416 "src/ocaml/preprocess/parser_raw.ml"
+# 9454 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9421 "src/ocaml/preprocess/parser_raw.ml"
+# 9459 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9427 "src/ocaml/preprocess/parser_raw.ml"
+# 9465 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -9432,22 +9470,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9438 "src/ocaml/preprocess/parser_raw.ml"
+# 9476 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9444 "src/ocaml/preprocess/parser_raw.ml"
+# 9482 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -9460,13 +9498,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 9464 "src/ocaml/preprocess/parser_raw.ml"
+# 9502 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9470 "src/ocaml/preprocess/parser_raw.ml"
+# 9508 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -9474,21 +9512,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9480 "src/ocaml/preprocess/parser_raw.ml"
+# 9518 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9486 "src/ocaml/preprocess/parser_raw.ml"
+# 9524 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2561 "src/ocaml/preprocess/parser_raw.mly"
+# 2579 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_ifthenelse(_3, (merloc _endpos__4_ _5), Some (merloc _endpos__6_ _7)), _2 )
-# 9492 "src/ocaml/preprocess/parser_raw.ml"
+# 9530 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_inlined1_ in
@@ -9496,10 +9534,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9503 "src/ocaml/preprocess/parser_raw.ml"
+# 9541 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -9560,14 +9598,14 @@ module Tables = struct
let _5 =
let _1 = _1_inlined3 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9566 "src/ocaml/preprocess/parser_raw.ml"
+# 9604 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9571 "src/ocaml/preprocess/parser_raw.ml"
+# 9609 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -9575,21 +9613,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9581 "src/ocaml/preprocess/parser_raw.ml"
+# 9619 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9587 "src/ocaml/preprocess/parser_raw.ml"
+# 9625 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2563 "src/ocaml/preprocess/parser_raw.mly"
+# 2581 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_ifthenelse(_3, (merloc _endpos__4_ _5), None), _2 )
-# 9593 "src/ocaml/preprocess/parser_raw.ml"
+# 9631 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
@@ -9597,10 +9635,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9604 "src/ocaml/preprocess/parser_raw.ml"
+# 9642 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -9687,18 +9725,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9691 "src/ocaml/preprocess/parser_raw.ml"
+# 9729 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9696 "src/ocaml/preprocess/parser_raw.ml"
+# 9734 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 9702 "src/ocaml/preprocess/parser_raw.ml"
+# 9740 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -9707,22 +9745,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9713 "src/ocaml/preprocess/parser_raw.ml"
+# 9751 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9719 "src/ocaml/preprocess/parser_raw.ml"
+# 9757 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -9735,13 +9773,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 9739 "src/ocaml/preprocess/parser_raw.ml"
+# 9777 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9745 "src/ocaml/preprocess/parser_raw.ml"
+# 9783 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -9749,21 +9787,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9755 "src/ocaml/preprocess/parser_raw.ml"
+# 9793 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9761 "src/ocaml/preprocess/parser_raw.ml"
+# 9799 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2563 "src/ocaml/preprocess/parser_raw.mly"
+# 2581 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_ifthenelse(_3, (merloc _endpos__4_ _5), None), _2 )
-# 9767 "src/ocaml/preprocess/parser_raw.ml"
+# 9805 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -9771,10 +9809,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9778 "src/ocaml/preprocess/parser_raw.ml"
+# 9816 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -9844,21 +9882,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9850 "src/ocaml/preprocess/parser_raw.ml"
+# 9888 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9856 "src/ocaml/preprocess/parser_raw.ml"
+# 9894 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2565 "src/ocaml/preprocess/parser_raw.mly"
+# 2583 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_while(_3, (merloc _endpos__4_ _5)), _2 )
-# 9862 "src/ocaml/preprocess/parser_raw.ml"
+# 9900 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__6_ in
@@ -9866,10 +9904,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9873 "src/ocaml/preprocess/parser_raw.ml"
+# 9911 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -9967,21 +10005,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 9973 "src/ocaml/preprocess/parser_raw.ml"
+# 10011 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 9979 "src/ocaml/preprocess/parser_raw.ml"
+# 10017 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2572 "src/ocaml/preprocess/parser_raw.mly"
+# 2590 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_for(_3, (merloc _endpos__4_ _5), (merloc _endpos__6_ _7), _6, (merloc _endpos__8_ _9)), _2 )
-# 9985 "src/ocaml/preprocess/parser_raw.ml"
+# 10023 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__10_ in
@@ -9989,10 +10027,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9996 "src/ocaml/preprocess/parser_raw.ml"
+# 10034 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10041,21 +10079,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10047 "src/ocaml/preprocess/parser_raw.ml"
+# 10085 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 10053 "src/ocaml/preprocess/parser_raw.ml"
+# 10091 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2574 "src/ocaml/preprocess/parser_raw.mly"
+# 2592 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_assert _3, _2 )
-# 10059 "src/ocaml/preprocess/parser_raw.ml"
+# 10097 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -10063,10 +10101,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 10070 "src/ocaml/preprocess/parser_raw.ml"
+# 10108 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10115,21 +10153,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10121 "src/ocaml/preprocess/parser_raw.ml"
+# 10159 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 10127 "src/ocaml/preprocess/parser_raw.ml"
+# 10165 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2576 "src/ocaml/preprocess/parser_raw.mly"
+# 2594 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_lazy _3, _2 )
-# 10133 "src/ocaml/preprocess/parser_raw.ml"
+# 10171 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -10137,10 +10175,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2503 "src/ocaml/preprocess/parser_raw.mly"
+# 2521 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 10144 "src/ocaml/preprocess/parser_raw.ml"
+# 10182 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10175,18 +10213,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 10179 "src/ocaml/preprocess/parser_raw.ml"
+# 10217 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 10184 "src/ocaml/preprocess/parser_raw.ml"
+# 10222 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2580 "src/ocaml/preprocess/parser_raw.mly"
+# 2598 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_apply(_1, _2) )
-# 10190 "src/ocaml/preprocess/parser_raw.ml"
+# 10228 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -10194,15 +10232,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10200 "src/ocaml/preprocess/parser_raw.ml"
+# 10238 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10206 "src/ocaml/preprocess/parser_raw.ml"
+# 10244 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10231,24 +10269,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 10235 "src/ocaml/preprocess/parser_raw.ml"
+# 10273 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1210 "src/ocaml/preprocess/parser_raw.mly"
+# 1230 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 10240 "src/ocaml/preprocess/parser_raw.ml"
+# 10278 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2946 "src/ocaml/preprocess/parser_raw.mly"
+# 2984 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 10246 "src/ocaml/preprocess/parser_raw.ml"
+# 10284 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2582 "src/ocaml/preprocess/parser_raw.mly"
+# 2600 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_tuple(_1) )
-# 10252 "src/ocaml/preprocess/parser_raw.ml"
+# 10290 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
@@ -10256,15 +10294,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10262 "src/ocaml/preprocess/parser_raw.ml"
+# 10300 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10268 "src/ocaml/preprocess/parser_raw.ml"
+# 10306 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10300,15 +10338,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 10306 "src/ocaml/preprocess/parser_raw.ml"
+# 10344 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2584 "src/ocaml/preprocess/parser_raw.mly"
+# 2602 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_construct(_1, Some _2) )
-# 10312 "src/ocaml/preprocess/parser_raw.ml"
+# 10350 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
@@ -10316,15 +10354,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10322 "src/ocaml/preprocess/parser_raw.ml"
+# 10360 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10328 "src/ocaml/preprocess/parser_raw.ml"
+# 10366 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10355,24 +10393,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2586 "src/ocaml/preprocess/parser_raw.mly"
+# 2604 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_variant(_1, Some _2) )
-# 10361 "src/ocaml/preprocess/parser_raw.ml"
+# 10399 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10370 "src/ocaml/preprocess/parser_raw.ml"
+# 10408 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10376 "src/ocaml/preprocess/parser_raw.ml"
+# 10414 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10404,9 +10442,9 @@ module Tables = struct
} = _menhir_stack in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let op : (
-# 814 "src/ocaml/preprocess/parser_raw.mly"
+# 833 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 10410 "src/ocaml/preprocess/parser_raw.ml"
+# 10448 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -10416,36 +10454,36 @@ module Tables = struct
let _1 =
let e2 =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10422 "src/ocaml/preprocess/parser_raw.ml"
+# 10460 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10427 "src/ocaml/preprocess/parser_raw.ml"
+# 10465 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3933 "src/ocaml/preprocess/parser_raw.mly"
+# 3981 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 10434 "src/ocaml/preprocess/parser_raw.ml"
+# 10472 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 10443 "src/ocaml/preprocess/parser_raw.ml"
+# 10481 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 10449 "src/ocaml/preprocess/parser_raw.ml"
+# 10487 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e1_ in
@@ -10453,15 +10491,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10459 "src/ocaml/preprocess/parser_raw.ml"
+# 10497 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10465 "src/ocaml/preprocess/parser_raw.ml"
+# 10503 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10514,9 +10552,9 @@ module Tables = struct
let _1_inlined1 : (string Location.loc option) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let op : (
-# 814 "src/ocaml/preprocess/parser_raw.mly"
+# 833 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 10520 "src/ocaml/preprocess/parser_raw.ml"
+# 10558 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -10531,18 +10569,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 10535 "src/ocaml/preprocess/parser_raw.ml"
+# 10573 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 10540 "src/ocaml/preprocess/parser_raw.ml"
+# 10578 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 10546 "src/ocaml/preprocess/parser_raw.ml"
+# 10584 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -10551,22 +10589,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10557 "src/ocaml/preprocess/parser_raw.ml"
+# 10595 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 10563 "src/ocaml/preprocess/parser_raw.ml"
+# 10601 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -10579,35 +10617,35 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 10583 "src/ocaml/preprocess/parser_raw.ml"
+# 10621 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10589 "src/ocaml/preprocess/parser_raw.ml"
+# 10627 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3933 "src/ocaml/preprocess/parser_raw.mly"
+# 3981 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 10596 "src/ocaml/preprocess/parser_raw.ml"
+# 10634 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 10605 "src/ocaml/preprocess/parser_raw.ml"
+# 10643 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 10611 "src/ocaml/preprocess/parser_raw.ml"
+# 10649 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -10615,15 +10653,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10621 "src/ocaml/preprocess/parser_raw.ml"
+# 10659 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10627 "src/ocaml/preprocess/parser_raw.ml"
+# 10665 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10655,9 +10693,9 @@ module Tables = struct
} = _menhir_stack in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let op : (
-# 815 "src/ocaml/preprocess/parser_raw.mly"
+# 834 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 10661 "src/ocaml/preprocess/parser_raw.ml"
+# 10699 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -10667,36 +10705,36 @@ module Tables = struct
let _1 =
let e2 =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10673 "src/ocaml/preprocess/parser_raw.ml"
+# 10711 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10678 "src/ocaml/preprocess/parser_raw.ml"
+# 10716 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3934 "src/ocaml/preprocess/parser_raw.mly"
+# 3982 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 10685 "src/ocaml/preprocess/parser_raw.ml"
+# 10723 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 10694 "src/ocaml/preprocess/parser_raw.ml"
+# 10732 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 10700 "src/ocaml/preprocess/parser_raw.ml"
+# 10738 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e1_ in
@@ -10704,15 +10742,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10710 "src/ocaml/preprocess/parser_raw.ml"
+# 10748 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10716 "src/ocaml/preprocess/parser_raw.ml"
+# 10754 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10765,9 +10803,9 @@ module Tables = struct
let _1_inlined1 : (string Location.loc option) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let op : (
-# 815 "src/ocaml/preprocess/parser_raw.mly"
+# 834 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 10771 "src/ocaml/preprocess/parser_raw.ml"
+# 10809 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -10782,18 +10820,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 10786 "src/ocaml/preprocess/parser_raw.ml"
+# 10824 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 10791 "src/ocaml/preprocess/parser_raw.ml"
+# 10829 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 10797 "src/ocaml/preprocess/parser_raw.ml"
+# 10835 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -10802,22 +10840,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10808 "src/ocaml/preprocess/parser_raw.ml"
+# 10846 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 10814 "src/ocaml/preprocess/parser_raw.ml"
+# 10852 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -10830,35 +10868,35 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 10834 "src/ocaml/preprocess/parser_raw.ml"
+# 10872 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10840 "src/ocaml/preprocess/parser_raw.ml"
+# 10878 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3934 "src/ocaml/preprocess/parser_raw.mly"
+# 3982 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 10847 "src/ocaml/preprocess/parser_raw.ml"
+# 10885 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 10856 "src/ocaml/preprocess/parser_raw.ml"
+# 10894 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 10862 "src/ocaml/preprocess/parser_raw.ml"
+# 10900 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -10866,15 +10904,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10872 "src/ocaml/preprocess/parser_raw.ml"
+# 10910 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10878 "src/ocaml/preprocess/parser_raw.ml"
+# 10916 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -10906,9 +10944,9 @@ module Tables = struct
} = _menhir_stack in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let op : (
-# 816 "src/ocaml/preprocess/parser_raw.mly"
+# 835 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 10912 "src/ocaml/preprocess/parser_raw.ml"
+# 10950 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -10918,36 +10956,36 @@ module Tables = struct
let _1 =
let e2 =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10924 "src/ocaml/preprocess/parser_raw.ml"
+# 10962 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10929 "src/ocaml/preprocess/parser_raw.ml"
+# 10967 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3935 "src/ocaml/preprocess/parser_raw.mly"
+# 3983 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 10936 "src/ocaml/preprocess/parser_raw.ml"
+# 10974 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 10945 "src/ocaml/preprocess/parser_raw.ml"
+# 10983 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 10951 "src/ocaml/preprocess/parser_raw.ml"
+# 10989 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e1_ in
@@ -10955,15 +10993,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 10961 "src/ocaml/preprocess/parser_raw.ml"
+# 10999 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 10967 "src/ocaml/preprocess/parser_raw.ml"
+# 11005 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11016,9 +11054,9 @@ module Tables = struct
let _1_inlined1 : (string Location.loc option) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let op : (
-# 816 "src/ocaml/preprocess/parser_raw.mly"
+# 835 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 11022 "src/ocaml/preprocess/parser_raw.ml"
+# 11060 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -11033,18 +11071,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 11037 "src/ocaml/preprocess/parser_raw.ml"
+# 11075 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11042 "src/ocaml/preprocess/parser_raw.ml"
+# 11080 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11048 "src/ocaml/preprocess/parser_raw.ml"
+# 11086 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -11053,22 +11091,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11059 "src/ocaml/preprocess/parser_raw.ml"
+# 11097 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 11065 "src/ocaml/preprocess/parser_raw.ml"
+# 11103 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -11081,35 +11119,35 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 11085 "src/ocaml/preprocess/parser_raw.ml"
+# 11123 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11091 "src/ocaml/preprocess/parser_raw.ml"
+# 11129 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3935 "src/ocaml/preprocess/parser_raw.mly"
+# 3983 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 11098 "src/ocaml/preprocess/parser_raw.ml"
+# 11136 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11107 "src/ocaml/preprocess/parser_raw.ml"
+# 11145 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11113 "src/ocaml/preprocess/parser_raw.ml"
+# 11151 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -11117,15 +11155,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11123 "src/ocaml/preprocess/parser_raw.ml"
+# 11161 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11129 "src/ocaml/preprocess/parser_raw.ml"
+# 11167 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11157,9 +11195,9 @@ module Tables = struct
} = _menhir_stack in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let op : (
-# 817 "src/ocaml/preprocess/parser_raw.mly"
+# 836 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 11163 "src/ocaml/preprocess/parser_raw.ml"
+# 11201 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -11169,36 +11207,36 @@ module Tables = struct
let _1 =
let e2 =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11175 "src/ocaml/preprocess/parser_raw.ml"
+# 11213 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11180 "src/ocaml/preprocess/parser_raw.ml"
+# 11218 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3936 "src/ocaml/preprocess/parser_raw.mly"
+# 3984 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 11187 "src/ocaml/preprocess/parser_raw.ml"
+# 11225 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11196 "src/ocaml/preprocess/parser_raw.ml"
+# 11234 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11202 "src/ocaml/preprocess/parser_raw.ml"
+# 11240 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e1_ in
@@ -11206,15 +11244,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11212 "src/ocaml/preprocess/parser_raw.ml"
+# 11250 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11218 "src/ocaml/preprocess/parser_raw.ml"
+# 11256 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11267,9 +11305,9 @@ module Tables = struct
let _1_inlined1 : (string Location.loc option) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let op : (
-# 817 "src/ocaml/preprocess/parser_raw.mly"
+# 836 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 11273 "src/ocaml/preprocess/parser_raw.ml"
+# 11311 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -11284,18 +11322,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 11288 "src/ocaml/preprocess/parser_raw.ml"
+# 11326 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11293 "src/ocaml/preprocess/parser_raw.ml"
+# 11331 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11299 "src/ocaml/preprocess/parser_raw.ml"
+# 11337 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -11304,22 +11342,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11310 "src/ocaml/preprocess/parser_raw.ml"
+# 11348 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 11316 "src/ocaml/preprocess/parser_raw.ml"
+# 11354 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -11332,35 +11370,35 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 11336 "src/ocaml/preprocess/parser_raw.ml"
+# 11374 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11342 "src/ocaml/preprocess/parser_raw.ml"
+# 11380 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3936 "src/ocaml/preprocess/parser_raw.mly"
+# 3984 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 11349 "src/ocaml/preprocess/parser_raw.ml"
+# 11387 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11358 "src/ocaml/preprocess/parser_raw.ml"
+# 11396 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11364 "src/ocaml/preprocess/parser_raw.ml"
+# 11402 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -11368,15 +11406,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11374 "src/ocaml/preprocess/parser_raw.ml"
+# 11412 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11380 "src/ocaml/preprocess/parser_raw.ml"
+# 11418 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11408,9 +11446,9 @@ module Tables = struct
} = _menhir_stack in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let op : (
-# 818 "src/ocaml/preprocess/parser_raw.mly"
+# 837 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 11414 "src/ocaml/preprocess/parser_raw.ml"
+# 11452 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -11420,36 +11458,36 @@ module Tables = struct
let _1 =
let e2 =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11426 "src/ocaml/preprocess/parser_raw.ml"
+# 11464 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11431 "src/ocaml/preprocess/parser_raw.ml"
+# 11469 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3937 "src/ocaml/preprocess/parser_raw.mly"
+# 3985 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 11438 "src/ocaml/preprocess/parser_raw.ml"
+# 11476 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11447 "src/ocaml/preprocess/parser_raw.ml"
+# 11485 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11453 "src/ocaml/preprocess/parser_raw.ml"
+# 11491 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e1_ in
@@ -11457,15 +11495,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11463 "src/ocaml/preprocess/parser_raw.ml"
+# 11501 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11469 "src/ocaml/preprocess/parser_raw.ml"
+# 11507 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11518,9 +11556,9 @@ module Tables = struct
let _1_inlined1 : (string Location.loc option) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let op : (
-# 818 "src/ocaml/preprocess/parser_raw.mly"
+# 837 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 11524 "src/ocaml/preprocess/parser_raw.ml"
+# 11562 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -11535,18 +11573,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 11539 "src/ocaml/preprocess/parser_raw.ml"
+# 11577 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11544 "src/ocaml/preprocess/parser_raw.ml"
+# 11582 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11550 "src/ocaml/preprocess/parser_raw.ml"
+# 11588 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -11555,22 +11593,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11561 "src/ocaml/preprocess/parser_raw.ml"
+# 11599 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 11567 "src/ocaml/preprocess/parser_raw.ml"
+# 11605 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -11583,35 +11621,35 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 11587 "src/ocaml/preprocess/parser_raw.ml"
+# 11625 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11593 "src/ocaml/preprocess/parser_raw.ml"
+# 11631 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3937 "src/ocaml/preprocess/parser_raw.mly"
+# 3985 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 11600 "src/ocaml/preprocess/parser_raw.ml"
+# 11638 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11609 "src/ocaml/preprocess/parser_raw.ml"
+# 11647 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11615 "src/ocaml/preprocess/parser_raw.ml"
+# 11653 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -11619,15 +11657,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11625 "src/ocaml/preprocess/parser_raw.ml"
+# 11663 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11631 "src/ocaml/preprocess/parser_raw.ml"
+# 11669 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11668,35 +11706,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11674 "src/ocaml/preprocess/parser_raw.ml"
+# 11712 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11679 "src/ocaml/preprocess/parser_raw.ml"
+# 11717 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3938 "src/ocaml/preprocess/parser_raw.mly"
+# 3986 "src/ocaml/preprocess/parser_raw.mly"
("+")
-# 11686 "src/ocaml/preprocess/parser_raw.ml"
+# 11724 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11694 "src/ocaml/preprocess/parser_raw.ml"
+# 11732 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11700 "src/ocaml/preprocess/parser_raw.ml"
+# 11738 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -11704,15 +11742,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11710 "src/ocaml/preprocess/parser_raw.ml"
+# 11748 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11716 "src/ocaml/preprocess/parser_raw.ml"
+# 11754 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11779,18 +11817,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 11783 "src/ocaml/preprocess/parser_raw.ml"
+# 11821 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11788 "src/ocaml/preprocess/parser_raw.ml"
+# 11826 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 11794 "src/ocaml/preprocess/parser_raw.ml"
+# 11832 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -11799,22 +11837,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11805 "src/ocaml/preprocess/parser_raw.ml"
+# 11843 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 11811 "src/ocaml/preprocess/parser_raw.ml"
+# 11849 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -11827,34 +11865,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 11831 "src/ocaml/preprocess/parser_raw.ml"
+# 11869 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11837 "src/ocaml/preprocess/parser_raw.ml"
+# 11875 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3938 "src/ocaml/preprocess/parser_raw.mly"
+# 3986 "src/ocaml/preprocess/parser_raw.mly"
("+")
-# 11844 "src/ocaml/preprocess/parser_raw.ml"
+# 11882 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11852 "src/ocaml/preprocess/parser_raw.ml"
+# 11890 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11858 "src/ocaml/preprocess/parser_raw.ml"
+# 11896 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -11862,15 +11900,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11868 "src/ocaml/preprocess/parser_raw.ml"
+# 11906 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11874 "src/ocaml/preprocess/parser_raw.ml"
+# 11912 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -11911,35 +11949,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11917 "src/ocaml/preprocess/parser_raw.ml"
+# 11955 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11922 "src/ocaml/preprocess/parser_raw.ml"
+# 11960 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3939 "src/ocaml/preprocess/parser_raw.mly"
+# 3987 "src/ocaml/preprocess/parser_raw.mly"
("+.")
-# 11929 "src/ocaml/preprocess/parser_raw.ml"
+# 11967 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 11937 "src/ocaml/preprocess/parser_raw.ml"
+# 11975 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 11943 "src/ocaml/preprocess/parser_raw.ml"
+# 11981 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -11947,15 +11985,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 11953 "src/ocaml/preprocess/parser_raw.ml"
+# 11991 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 11959 "src/ocaml/preprocess/parser_raw.ml"
+# 11997 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12022,18 +12060,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12026 "src/ocaml/preprocess/parser_raw.ml"
+# 12064 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12031 "src/ocaml/preprocess/parser_raw.ml"
+# 12069 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12037 "src/ocaml/preprocess/parser_raw.ml"
+# 12075 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -12042,22 +12080,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12048 "src/ocaml/preprocess/parser_raw.ml"
+# 12086 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 12054 "src/ocaml/preprocess/parser_raw.ml"
+# 12092 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -12070,34 +12108,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 12074 "src/ocaml/preprocess/parser_raw.ml"
+# 12112 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12080 "src/ocaml/preprocess/parser_raw.ml"
+# 12118 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3939 "src/ocaml/preprocess/parser_raw.mly"
+# 3987 "src/ocaml/preprocess/parser_raw.mly"
("+.")
-# 12087 "src/ocaml/preprocess/parser_raw.ml"
+# 12125 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12095 "src/ocaml/preprocess/parser_raw.ml"
+# 12133 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12101 "src/ocaml/preprocess/parser_raw.ml"
+# 12139 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -12105,15 +12143,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12111 "src/ocaml/preprocess/parser_raw.ml"
+# 12149 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12117 "src/ocaml/preprocess/parser_raw.ml"
+# 12155 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12154,35 +12192,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12160 "src/ocaml/preprocess/parser_raw.ml"
+# 12198 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12165 "src/ocaml/preprocess/parser_raw.ml"
+# 12203 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3940 "src/ocaml/preprocess/parser_raw.mly"
+# 3988 "src/ocaml/preprocess/parser_raw.mly"
("+=")
-# 12172 "src/ocaml/preprocess/parser_raw.ml"
+# 12210 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12180 "src/ocaml/preprocess/parser_raw.ml"
+# 12218 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12186 "src/ocaml/preprocess/parser_raw.ml"
+# 12224 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -12190,15 +12228,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12196 "src/ocaml/preprocess/parser_raw.ml"
+# 12234 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12202 "src/ocaml/preprocess/parser_raw.ml"
+# 12240 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12265,18 +12303,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12269 "src/ocaml/preprocess/parser_raw.ml"
+# 12307 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12274 "src/ocaml/preprocess/parser_raw.ml"
+# 12312 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12280 "src/ocaml/preprocess/parser_raw.ml"
+# 12318 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -12285,22 +12323,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12291 "src/ocaml/preprocess/parser_raw.ml"
+# 12329 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 12297 "src/ocaml/preprocess/parser_raw.ml"
+# 12335 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -12313,34 +12351,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 12317 "src/ocaml/preprocess/parser_raw.ml"
+# 12355 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12323 "src/ocaml/preprocess/parser_raw.ml"
+# 12361 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3940 "src/ocaml/preprocess/parser_raw.mly"
+# 3988 "src/ocaml/preprocess/parser_raw.mly"
("+=")
-# 12330 "src/ocaml/preprocess/parser_raw.ml"
+# 12368 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12338 "src/ocaml/preprocess/parser_raw.ml"
+# 12376 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12344 "src/ocaml/preprocess/parser_raw.ml"
+# 12382 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -12348,15 +12386,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12354 "src/ocaml/preprocess/parser_raw.ml"
+# 12392 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12360 "src/ocaml/preprocess/parser_raw.ml"
+# 12398 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12397,35 +12435,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12403 "src/ocaml/preprocess/parser_raw.ml"
+# 12441 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12408 "src/ocaml/preprocess/parser_raw.ml"
+# 12446 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3941 "src/ocaml/preprocess/parser_raw.mly"
+# 3989 "src/ocaml/preprocess/parser_raw.mly"
("-")
-# 12415 "src/ocaml/preprocess/parser_raw.ml"
+# 12453 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12423 "src/ocaml/preprocess/parser_raw.ml"
+# 12461 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12429 "src/ocaml/preprocess/parser_raw.ml"
+# 12467 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -12433,15 +12471,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12439 "src/ocaml/preprocess/parser_raw.ml"
+# 12477 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12445 "src/ocaml/preprocess/parser_raw.ml"
+# 12483 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12508,18 +12546,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12512 "src/ocaml/preprocess/parser_raw.ml"
+# 12550 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12517 "src/ocaml/preprocess/parser_raw.ml"
+# 12555 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12523 "src/ocaml/preprocess/parser_raw.ml"
+# 12561 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -12528,22 +12566,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12534 "src/ocaml/preprocess/parser_raw.ml"
+# 12572 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 12540 "src/ocaml/preprocess/parser_raw.ml"
+# 12578 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -12556,34 +12594,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 12560 "src/ocaml/preprocess/parser_raw.ml"
+# 12598 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12566 "src/ocaml/preprocess/parser_raw.ml"
+# 12604 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3941 "src/ocaml/preprocess/parser_raw.mly"
+# 3989 "src/ocaml/preprocess/parser_raw.mly"
("-")
-# 12573 "src/ocaml/preprocess/parser_raw.ml"
+# 12611 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12581 "src/ocaml/preprocess/parser_raw.ml"
+# 12619 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12587 "src/ocaml/preprocess/parser_raw.ml"
+# 12625 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -12591,15 +12629,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12597 "src/ocaml/preprocess/parser_raw.ml"
+# 12635 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12603 "src/ocaml/preprocess/parser_raw.ml"
+# 12641 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12640,35 +12678,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12646 "src/ocaml/preprocess/parser_raw.ml"
+# 12684 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12651 "src/ocaml/preprocess/parser_raw.ml"
+# 12689 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3942 "src/ocaml/preprocess/parser_raw.mly"
+# 3990 "src/ocaml/preprocess/parser_raw.mly"
("-.")
-# 12658 "src/ocaml/preprocess/parser_raw.ml"
+# 12696 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12666 "src/ocaml/preprocess/parser_raw.ml"
+# 12704 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12672 "src/ocaml/preprocess/parser_raw.ml"
+# 12710 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -12676,15 +12714,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12682 "src/ocaml/preprocess/parser_raw.ml"
+# 12720 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12688 "src/ocaml/preprocess/parser_raw.ml"
+# 12726 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12751,18 +12789,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12755 "src/ocaml/preprocess/parser_raw.ml"
+# 12793 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12760 "src/ocaml/preprocess/parser_raw.ml"
+# 12798 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 12766 "src/ocaml/preprocess/parser_raw.ml"
+# 12804 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -12771,22 +12809,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12777 "src/ocaml/preprocess/parser_raw.ml"
+# 12815 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 12783 "src/ocaml/preprocess/parser_raw.ml"
+# 12821 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -12799,34 +12837,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 12803 "src/ocaml/preprocess/parser_raw.ml"
+# 12841 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12809 "src/ocaml/preprocess/parser_raw.ml"
+# 12847 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3942 "src/ocaml/preprocess/parser_raw.mly"
+# 3990 "src/ocaml/preprocess/parser_raw.mly"
("-.")
-# 12816 "src/ocaml/preprocess/parser_raw.ml"
+# 12854 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12824 "src/ocaml/preprocess/parser_raw.ml"
+# 12862 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12830 "src/ocaml/preprocess/parser_raw.ml"
+# 12868 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -12834,15 +12872,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12840 "src/ocaml/preprocess/parser_raw.ml"
+# 12878 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12846 "src/ocaml/preprocess/parser_raw.ml"
+# 12884 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12883,35 +12921,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12889 "src/ocaml/preprocess/parser_raw.ml"
+# 12927 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12894 "src/ocaml/preprocess/parser_raw.ml"
+# 12932 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3943 "src/ocaml/preprocess/parser_raw.mly"
+# 3991 "src/ocaml/preprocess/parser_raw.mly"
("*")
-# 12901 "src/ocaml/preprocess/parser_raw.ml"
+# 12939 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 12909 "src/ocaml/preprocess/parser_raw.ml"
+# 12947 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 12915 "src/ocaml/preprocess/parser_raw.ml"
+# 12953 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -12919,15 +12957,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 12925 "src/ocaml/preprocess/parser_raw.ml"
+# 12963 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 12931 "src/ocaml/preprocess/parser_raw.ml"
+# 12969 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -12994,18 +13032,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12998 "src/ocaml/preprocess/parser_raw.ml"
+# 13036 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13003 "src/ocaml/preprocess/parser_raw.ml"
+# 13041 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13009 "src/ocaml/preprocess/parser_raw.ml"
+# 13047 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -13014,22 +13052,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13020 "src/ocaml/preprocess/parser_raw.ml"
+# 13058 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 13026 "src/ocaml/preprocess/parser_raw.ml"
+# 13064 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -13042,34 +13080,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 13046 "src/ocaml/preprocess/parser_raw.ml"
+# 13084 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13052 "src/ocaml/preprocess/parser_raw.ml"
+# 13090 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3943 "src/ocaml/preprocess/parser_raw.mly"
+# 3991 "src/ocaml/preprocess/parser_raw.mly"
("*")
-# 13059 "src/ocaml/preprocess/parser_raw.ml"
+# 13097 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13067 "src/ocaml/preprocess/parser_raw.ml"
+# 13105 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13073 "src/ocaml/preprocess/parser_raw.ml"
+# 13111 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -13077,15 +13115,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13083 "src/ocaml/preprocess/parser_raw.ml"
+# 13121 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13089 "src/ocaml/preprocess/parser_raw.ml"
+# 13127 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13126,35 +13164,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13132 "src/ocaml/preprocess/parser_raw.ml"
+# 13170 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13137 "src/ocaml/preprocess/parser_raw.ml"
+# 13175 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3944 "src/ocaml/preprocess/parser_raw.mly"
+# 3992 "src/ocaml/preprocess/parser_raw.mly"
("%")
-# 13144 "src/ocaml/preprocess/parser_raw.ml"
+# 13182 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13152 "src/ocaml/preprocess/parser_raw.ml"
+# 13190 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13158 "src/ocaml/preprocess/parser_raw.ml"
+# 13196 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -13162,15 +13200,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13168 "src/ocaml/preprocess/parser_raw.ml"
+# 13206 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13174 "src/ocaml/preprocess/parser_raw.ml"
+# 13212 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13237,18 +13275,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13241 "src/ocaml/preprocess/parser_raw.ml"
+# 13279 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13246 "src/ocaml/preprocess/parser_raw.ml"
+# 13284 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13252 "src/ocaml/preprocess/parser_raw.ml"
+# 13290 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -13257,22 +13295,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13263 "src/ocaml/preprocess/parser_raw.ml"
+# 13301 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 13269 "src/ocaml/preprocess/parser_raw.ml"
+# 13307 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -13285,34 +13323,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 13289 "src/ocaml/preprocess/parser_raw.ml"
+# 13327 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13295 "src/ocaml/preprocess/parser_raw.ml"
+# 13333 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3944 "src/ocaml/preprocess/parser_raw.mly"
+# 3992 "src/ocaml/preprocess/parser_raw.mly"
("%")
-# 13302 "src/ocaml/preprocess/parser_raw.ml"
+# 13340 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13310 "src/ocaml/preprocess/parser_raw.ml"
+# 13348 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13316 "src/ocaml/preprocess/parser_raw.ml"
+# 13354 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -13320,15 +13358,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13326 "src/ocaml/preprocess/parser_raw.ml"
+# 13364 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13332 "src/ocaml/preprocess/parser_raw.ml"
+# 13370 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13369,35 +13407,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13375 "src/ocaml/preprocess/parser_raw.ml"
+# 13413 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13380 "src/ocaml/preprocess/parser_raw.ml"
+# 13418 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3945 "src/ocaml/preprocess/parser_raw.mly"
+# 3993 "src/ocaml/preprocess/parser_raw.mly"
("=")
-# 13387 "src/ocaml/preprocess/parser_raw.ml"
+# 13425 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13395 "src/ocaml/preprocess/parser_raw.ml"
+# 13433 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13401 "src/ocaml/preprocess/parser_raw.ml"
+# 13439 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -13405,15 +13443,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13411 "src/ocaml/preprocess/parser_raw.ml"
+# 13449 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13417 "src/ocaml/preprocess/parser_raw.ml"
+# 13455 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13480,18 +13518,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13484 "src/ocaml/preprocess/parser_raw.ml"
+# 13522 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13489 "src/ocaml/preprocess/parser_raw.ml"
+# 13527 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13495 "src/ocaml/preprocess/parser_raw.ml"
+# 13533 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -13500,22 +13538,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13506 "src/ocaml/preprocess/parser_raw.ml"
+# 13544 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 13512 "src/ocaml/preprocess/parser_raw.ml"
+# 13550 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -13528,34 +13566,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 13532 "src/ocaml/preprocess/parser_raw.ml"
+# 13570 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13538 "src/ocaml/preprocess/parser_raw.ml"
+# 13576 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3945 "src/ocaml/preprocess/parser_raw.mly"
+# 3993 "src/ocaml/preprocess/parser_raw.mly"
("=")
-# 13545 "src/ocaml/preprocess/parser_raw.ml"
+# 13583 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13553 "src/ocaml/preprocess/parser_raw.ml"
+# 13591 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13559 "src/ocaml/preprocess/parser_raw.ml"
+# 13597 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -13563,15 +13601,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13569 "src/ocaml/preprocess/parser_raw.ml"
+# 13607 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13575 "src/ocaml/preprocess/parser_raw.ml"
+# 13613 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13612,35 +13650,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13618 "src/ocaml/preprocess/parser_raw.ml"
+# 13656 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13623 "src/ocaml/preprocess/parser_raw.ml"
+# 13661 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3946 "src/ocaml/preprocess/parser_raw.mly"
+# 3994 "src/ocaml/preprocess/parser_raw.mly"
("<")
-# 13630 "src/ocaml/preprocess/parser_raw.ml"
+# 13668 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13638 "src/ocaml/preprocess/parser_raw.ml"
+# 13676 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13644 "src/ocaml/preprocess/parser_raw.ml"
+# 13682 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -13648,15 +13686,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13654 "src/ocaml/preprocess/parser_raw.ml"
+# 13692 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13660 "src/ocaml/preprocess/parser_raw.ml"
+# 13698 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13723,18 +13761,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13727 "src/ocaml/preprocess/parser_raw.ml"
+# 13765 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13732 "src/ocaml/preprocess/parser_raw.ml"
+# 13770 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13738 "src/ocaml/preprocess/parser_raw.ml"
+# 13776 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -13743,22 +13781,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13749 "src/ocaml/preprocess/parser_raw.ml"
+# 13787 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 13755 "src/ocaml/preprocess/parser_raw.ml"
+# 13793 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -13771,34 +13809,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 13775 "src/ocaml/preprocess/parser_raw.ml"
+# 13813 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13781 "src/ocaml/preprocess/parser_raw.ml"
+# 13819 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3946 "src/ocaml/preprocess/parser_raw.mly"
+# 3994 "src/ocaml/preprocess/parser_raw.mly"
("<")
-# 13788 "src/ocaml/preprocess/parser_raw.ml"
+# 13826 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13796 "src/ocaml/preprocess/parser_raw.ml"
+# 13834 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13802 "src/ocaml/preprocess/parser_raw.ml"
+# 13840 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -13806,15 +13844,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13812 "src/ocaml/preprocess/parser_raw.ml"
+# 13850 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13818 "src/ocaml/preprocess/parser_raw.ml"
+# 13856 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13855,35 +13893,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13861 "src/ocaml/preprocess/parser_raw.ml"
+# 13899 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13866 "src/ocaml/preprocess/parser_raw.ml"
+# 13904 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3947 "src/ocaml/preprocess/parser_raw.mly"
+# 3995 "src/ocaml/preprocess/parser_raw.mly"
(">")
-# 13873 "src/ocaml/preprocess/parser_raw.ml"
+# 13911 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 13881 "src/ocaml/preprocess/parser_raw.ml"
+# 13919 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 13887 "src/ocaml/preprocess/parser_raw.ml"
+# 13925 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -13891,15 +13929,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 13897 "src/ocaml/preprocess/parser_raw.ml"
+# 13935 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13903 "src/ocaml/preprocess/parser_raw.ml"
+# 13941 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -13966,18 +14004,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13970 "src/ocaml/preprocess/parser_raw.ml"
+# 14008 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13975 "src/ocaml/preprocess/parser_raw.ml"
+# 14013 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 13981 "src/ocaml/preprocess/parser_raw.ml"
+# 14019 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -13986,22 +14024,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 13992 "src/ocaml/preprocess/parser_raw.ml"
+# 14030 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 13998 "src/ocaml/preprocess/parser_raw.ml"
+# 14036 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -14014,34 +14052,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 14018 "src/ocaml/preprocess/parser_raw.ml"
+# 14056 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14024 "src/ocaml/preprocess/parser_raw.ml"
+# 14062 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3947 "src/ocaml/preprocess/parser_raw.mly"
+# 3995 "src/ocaml/preprocess/parser_raw.mly"
(">")
-# 14031 "src/ocaml/preprocess/parser_raw.ml"
+# 14069 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14039 "src/ocaml/preprocess/parser_raw.ml"
+# 14077 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14045 "src/ocaml/preprocess/parser_raw.ml"
+# 14083 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -14049,15 +14087,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14055 "src/ocaml/preprocess/parser_raw.ml"
+# 14093 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14061 "src/ocaml/preprocess/parser_raw.ml"
+# 14099 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14098,35 +14136,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14104 "src/ocaml/preprocess/parser_raw.ml"
+# 14142 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14109 "src/ocaml/preprocess/parser_raw.ml"
+# 14147 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3948 "src/ocaml/preprocess/parser_raw.mly"
+# 3996 "src/ocaml/preprocess/parser_raw.mly"
("or")
-# 14116 "src/ocaml/preprocess/parser_raw.ml"
+# 14154 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14124 "src/ocaml/preprocess/parser_raw.ml"
+# 14162 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14130 "src/ocaml/preprocess/parser_raw.ml"
+# 14168 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -14134,15 +14172,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14140 "src/ocaml/preprocess/parser_raw.ml"
+# 14178 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14146 "src/ocaml/preprocess/parser_raw.ml"
+# 14184 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14209,18 +14247,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14213 "src/ocaml/preprocess/parser_raw.ml"
+# 14251 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14218 "src/ocaml/preprocess/parser_raw.ml"
+# 14256 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14224 "src/ocaml/preprocess/parser_raw.ml"
+# 14262 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -14229,22 +14267,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14235 "src/ocaml/preprocess/parser_raw.ml"
+# 14273 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 14241 "src/ocaml/preprocess/parser_raw.ml"
+# 14279 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -14257,34 +14295,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 14261 "src/ocaml/preprocess/parser_raw.ml"
+# 14299 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14267 "src/ocaml/preprocess/parser_raw.ml"
+# 14305 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3948 "src/ocaml/preprocess/parser_raw.mly"
+# 3996 "src/ocaml/preprocess/parser_raw.mly"
("or")
-# 14274 "src/ocaml/preprocess/parser_raw.ml"
+# 14312 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14282 "src/ocaml/preprocess/parser_raw.ml"
+# 14320 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14288 "src/ocaml/preprocess/parser_raw.ml"
+# 14326 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -14292,15 +14330,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14298 "src/ocaml/preprocess/parser_raw.ml"
+# 14336 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14304 "src/ocaml/preprocess/parser_raw.ml"
+# 14342 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14341,35 +14379,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14347 "src/ocaml/preprocess/parser_raw.ml"
+# 14385 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14352 "src/ocaml/preprocess/parser_raw.ml"
+# 14390 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3949 "src/ocaml/preprocess/parser_raw.mly"
+# 3997 "src/ocaml/preprocess/parser_raw.mly"
("||")
-# 14359 "src/ocaml/preprocess/parser_raw.ml"
+# 14397 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14367 "src/ocaml/preprocess/parser_raw.ml"
+# 14405 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14373 "src/ocaml/preprocess/parser_raw.ml"
+# 14411 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -14377,15 +14415,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14383 "src/ocaml/preprocess/parser_raw.ml"
+# 14421 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14389 "src/ocaml/preprocess/parser_raw.ml"
+# 14427 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14452,18 +14490,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14456 "src/ocaml/preprocess/parser_raw.ml"
+# 14494 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14461 "src/ocaml/preprocess/parser_raw.ml"
+# 14499 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14467 "src/ocaml/preprocess/parser_raw.ml"
+# 14505 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -14472,22 +14510,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14478 "src/ocaml/preprocess/parser_raw.ml"
+# 14516 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 14484 "src/ocaml/preprocess/parser_raw.ml"
+# 14522 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -14500,34 +14538,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 14504 "src/ocaml/preprocess/parser_raw.ml"
+# 14542 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14510 "src/ocaml/preprocess/parser_raw.ml"
+# 14548 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3949 "src/ocaml/preprocess/parser_raw.mly"
+# 3997 "src/ocaml/preprocess/parser_raw.mly"
("||")
-# 14517 "src/ocaml/preprocess/parser_raw.ml"
+# 14555 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14525 "src/ocaml/preprocess/parser_raw.ml"
+# 14563 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14531 "src/ocaml/preprocess/parser_raw.ml"
+# 14569 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -14535,15 +14573,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14541 "src/ocaml/preprocess/parser_raw.ml"
+# 14579 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14547 "src/ocaml/preprocess/parser_raw.ml"
+# 14585 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14584,35 +14622,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14590 "src/ocaml/preprocess/parser_raw.ml"
+# 14628 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14595 "src/ocaml/preprocess/parser_raw.ml"
+# 14633 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3950 "src/ocaml/preprocess/parser_raw.mly"
+# 3998 "src/ocaml/preprocess/parser_raw.mly"
("&")
-# 14602 "src/ocaml/preprocess/parser_raw.ml"
+# 14640 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14610 "src/ocaml/preprocess/parser_raw.ml"
+# 14648 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14616 "src/ocaml/preprocess/parser_raw.ml"
+# 14654 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -14620,15 +14658,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14626 "src/ocaml/preprocess/parser_raw.ml"
+# 14664 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14632 "src/ocaml/preprocess/parser_raw.ml"
+# 14670 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14695,18 +14733,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14699 "src/ocaml/preprocess/parser_raw.ml"
+# 14737 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14704 "src/ocaml/preprocess/parser_raw.ml"
+# 14742 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14710 "src/ocaml/preprocess/parser_raw.ml"
+# 14748 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -14715,22 +14753,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14721 "src/ocaml/preprocess/parser_raw.ml"
+# 14759 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 14727 "src/ocaml/preprocess/parser_raw.ml"
+# 14765 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -14743,34 +14781,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 14747 "src/ocaml/preprocess/parser_raw.ml"
+# 14785 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14753 "src/ocaml/preprocess/parser_raw.ml"
+# 14791 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3950 "src/ocaml/preprocess/parser_raw.mly"
+# 3998 "src/ocaml/preprocess/parser_raw.mly"
("&")
-# 14760 "src/ocaml/preprocess/parser_raw.ml"
+# 14798 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14768 "src/ocaml/preprocess/parser_raw.ml"
+# 14806 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14774 "src/ocaml/preprocess/parser_raw.ml"
+# 14812 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -14778,15 +14816,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14784 "src/ocaml/preprocess/parser_raw.ml"
+# 14822 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14790 "src/ocaml/preprocess/parser_raw.ml"
+# 14828 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14827,35 +14865,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14833 "src/ocaml/preprocess/parser_raw.ml"
+# 14871 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14838 "src/ocaml/preprocess/parser_raw.ml"
+# 14876 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3951 "src/ocaml/preprocess/parser_raw.mly"
+# 3999 "src/ocaml/preprocess/parser_raw.mly"
("&&")
-# 14845 "src/ocaml/preprocess/parser_raw.ml"
+# 14883 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 14853 "src/ocaml/preprocess/parser_raw.ml"
+# 14891 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 14859 "src/ocaml/preprocess/parser_raw.ml"
+# 14897 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -14863,15 +14901,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 14869 "src/ocaml/preprocess/parser_raw.ml"
+# 14907 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14875 "src/ocaml/preprocess/parser_raw.ml"
+# 14913 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -14938,18 +14976,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14942 "src/ocaml/preprocess/parser_raw.ml"
+# 14980 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14947 "src/ocaml/preprocess/parser_raw.ml"
+# 14985 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 14953 "src/ocaml/preprocess/parser_raw.ml"
+# 14991 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -14958,22 +14996,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14964 "src/ocaml/preprocess/parser_raw.ml"
+# 15002 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 14970 "src/ocaml/preprocess/parser_raw.ml"
+# 15008 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -14986,34 +15024,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 14990 "src/ocaml/preprocess/parser_raw.ml"
+# 15028 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 14996 "src/ocaml/preprocess/parser_raw.ml"
+# 15034 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3951 "src/ocaml/preprocess/parser_raw.mly"
+# 3999 "src/ocaml/preprocess/parser_raw.mly"
("&&")
-# 15003 "src/ocaml/preprocess/parser_raw.ml"
+# 15041 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 15011 "src/ocaml/preprocess/parser_raw.ml"
+# 15049 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 15017 "src/ocaml/preprocess/parser_raw.ml"
+# 15055 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -15021,15 +15059,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 15027 "src/ocaml/preprocess/parser_raw.ml"
+# 15065 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15033 "src/ocaml/preprocess/parser_raw.ml"
+# 15071 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15070,35 +15108,35 @@ module Tables = struct
let e2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15076 "src/ocaml/preprocess/parser_raw.ml"
+# 15114 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15081 "src/ocaml/preprocess/parser_raw.ml"
+# 15119 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3952 "src/ocaml/preprocess/parser_raw.mly"
+# 4000 "src/ocaml/preprocess/parser_raw.mly"
(":=")
-# 15088 "src/ocaml/preprocess/parser_raw.ml"
+# 15126 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 15096 "src/ocaml/preprocess/parser_raw.ml"
+# 15134 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 15102 "src/ocaml/preprocess/parser_raw.ml"
+# 15140 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
@@ -15106,15 +15144,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 15112 "src/ocaml/preprocess/parser_raw.ml"
+# 15150 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15118 "src/ocaml/preprocess/parser_raw.ml"
+# 15156 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15181,18 +15219,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 15185 "src/ocaml/preprocess/parser_raw.ml"
+# 15223 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15190 "src/ocaml/preprocess/parser_raw.ml"
+# 15228 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15196 "src/ocaml/preprocess/parser_raw.ml"
+# 15234 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -15201,22 +15239,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15207 "src/ocaml/preprocess/parser_raw.ml"
+# 15245 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 15213 "src/ocaml/preprocess/parser_raw.ml"
+# 15251 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -15229,34 +15267,34 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 15233 "src/ocaml/preprocess/parser_raw.ml"
+# 15271 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15239 "src/ocaml/preprocess/parser_raw.ml"
+# 15277 "src/ocaml/preprocess/parser_raw.ml"
in
let op =
let _1 =
-# 3952 "src/ocaml/preprocess/parser_raw.mly"
+# 4000 "src/ocaml/preprocess/parser_raw.mly"
(":=")
-# 15246 "src/ocaml/preprocess/parser_raw.ml"
+# 15284 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 15254 "src/ocaml/preprocess/parser_raw.ml"
+# 15292 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2588 "src/ocaml/preprocess/parser_raw.mly"
+# 2606 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix e1 op e2 )
-# 15260 "src/ocaml/preprocess/parser_raw.ml"
+# 15298 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
@@ -15264,15 +15302,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 15270 "src/ocaml/preprocess/parser_raw.ml"
+# 15308 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15276 "src/ocaml/preprocess/parser_raw.ml"
+# 15314 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15306,21 +15344,25 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15312 "src/ocaml/preprocess/parser_raw.ml"
+# 15350 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15317 "src/ocaml/preprocess/parser_raw.ml"
+# 15355 "src/ocaml/preprocess/parser_raw.ml"
in
+ let _endpos__2_ = _endpos__1_inlined1_ in
+ let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 2590 "src/ocaml/preprocess/parser_raw.mly"
- ( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 15324 "src/ocaml/preprocess/parser_raw.ml"
+# 2608 "src/ocaml/preprocess/parser_raw.mly"
+ ( mkuminus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 15366 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -15328,15 +15370,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 15334 "src/ocaml/preprocess/parser_raw.ml"
+# 15376 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15340 "src/ocaml/preprocess/parser_raw.ml"
+# 15382 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15396,18 +15438,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 15400 "src/ocaml/preprocess/parser_raw.ml"
+# 15442 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15405 "src/ocaml/preprocess/parser_raw.ml"
+# 15447 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15411 "src/ocaml/preprocess/parser_raw.ml"
+# 15453 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -15416,22 +15458,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15422 "src/ocaml/preprocess/parser_raw.ml"
+# 15464 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 15428 "src/ocaml/preprocess/parser_raw.ml"
+# 15470 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -15444,20 +15486,24 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 15448 "src/ocaml/preprocess/parser_raw.ml"
+# 15490 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15454 "src/ocaml/preprocess/parser_raw.ml"
+# 15496 "src/ocaml/preprocess/parser_raw.ml"
in
+ let _endpos__2_ = _endpos_xs_ in
+ let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 2590 "src/ocaml/preprocess/parser_raw.mly"
- ( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 15461 "src/ocaml/preprocess/parser_raw.ml"
+# 2608 "src/ocaml/preprocess/parser_raw.mly"
+ ( mkuminus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 15507 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -15465,15 +15511,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 15471 "src/ocaml/preprocess/parser_raw.ml"
+# 15517 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15477 "src/ocaml/preprocess/parser_raw.ml"
+# 15523 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15507,21 +15553,25 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15513 "src/ocaml/preprocess/parser_raw.ml"
+# 15559 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15518 "src/ocaml/preprocess/parser_raw.ml"
+# 15564 "src/ocaml/preprocess/parser_raw.ml"
in
+ let _endpos__2_ = _endpos__1_inlined1_ in
+ let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 2592 "src/ocaml/preprocess/parser_raw.mly"
- ( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 15525 "src/ocaml/preprocess/parser_raw.ml"
+# 2610 "src/ocaml/preprocess/parser_raw.mly"
+ ( mkuplus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 15575 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -15529,15 +15579,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 15535 "src/ocaml/preprocess/parser_raw.ml"
+# 15585 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15541 "src/ocaml/preprocess/parser_raw.ml"
+# 15591 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15597,18 +15647,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 15601 "src/ocaml/preprocess/parser_raw.ml"
+# 15651 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15606 "src/ocaml/preprocess/parser_raw.ml"
+# 15656 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15612 "src/ocaml/preprocess/parser_raw.ml"
+# 15662 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -15617,22 +15667,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15623 "src/ocaml/preprocess/parser_raw.ml"
+# 15673 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 15629 "src/ocaml/preprocess/parser_raw.ml"
+# 15679 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -15645,20 +15695,24 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 15649 "src/ocaml/preprocess/parser_raw.ml"
+# 15699 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15655 "src/ocaml/preprocess/parser_raw.ml"
+# 15705 "src/ocaml/preprocess/parser_raw.ml"
in
+ let _endpos__2_ = _endpos_xs_ in
+ let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 2592 "src/ocaml/preprocess/parser_raw.mly"
- ( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 15662 "src/ocaml/preprocess/parser_raw.ml"
+# 2610 "src/ocaml/preprocess/parser_raw.mly"
+ ( mkuplus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 15716 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -15666,15 +15720,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 15672 "src/ocaml/preprocess/parser_raw.ml"
+# 15726 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2506 "src/ocaml/preprocess/parser_raw.mly"
+# 2524 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15678 "src/ocaml/preprocess/parser_raw.ml"
+# 15732 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15714,9 +15768,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2508 "src/ocaml/preprocess/parser_raw.mly"
+# 2526 "src/ocaml/preprocess/parser_raw.mly"
( expr_of_let_bindings ~loc:_sloc _1 (merloc _endpos__2_ _3) )
-# 15720 "src/ocaml/preprocess/parser_raw.ml"
+# 15774 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15756,9 +15810,9 @@ module Tables = struct
let _3 : unit = Obj.magic _3 in
let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
let _1 : (
-# 820 "src/ocaml/preprocess/parser_raw.mly"
+# 839 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 15762 "src/ocaml/preprocess/parser_raw.ml"
+# 15816 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -15768,9 +15822,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 15774 "src/ocaml/preprocess/parser_raw.ml"
+# 15828 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_pbop_op_ = _startpos__1_ in
@@ -15778,13 +15832,13 @@ module Tables = struct
let _symbolstartpos = _startpos_pbop_op_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2510 "src/ocaml/preprocess/parser_raw.mly"
+# 2528 "src/ocaml/preprocess/parser_raw.mly"
( let (pbop_pat, pbop_exp, rev_ands) = bindings in
let ands = List.rev rev_ands in
let pbop_loc = make_loc _sloc in
let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
mkexp ~loc:_sloc (Pexp_letop{ let_; ands; body}) )
-# 15788 "src/ocaml/preprocess/parser_raw.ml"
+# 15842 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15823,14 +15877,14 @@ module Tables = struct
let _v : (Parsetree.expression) = let _3 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15829 "src/ocaml/preprocess/parser_raw.ml"
+# 15883 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15834 "src/ocaml/preprocess/parser_raw.ml"
+# 15888 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
@@ -15839,9 +15893,9 @@ module Tables = struct
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2516 "src/ocaml/preprocess/parser_raw.mly"
+# 2534 "src/ocaml/preprocess/parser_raw.mly"
( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;(merloc _endpos__2_ _3)])) )
-# 15845 "src/ocaml/preprocess/parser_raw.ml"
+# 15899 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -15906,18 +15960,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 15910 "src/ocaml/preprocess/parser_raw.ml"
+# 15964 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15915 "src/ocaml/preprocess/parser_raw.ml"
+# 15969 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 15921 "src/ocaml/preprocess/parser_raw.ml"
+# 15975 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -15926,22 +15980,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15932 "src/ocaml/preprocess/parser_raw.ml"
+# 15986 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 15938 "src/ocaml/preprocess/parser_raw.ml"
+# 15992 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -15954,13 +16008,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 15958 "src/ocaml/preprocess/parser_raw.ml"
+# 16012 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 15964 "src/ocaml/preprocess/parser_raw.ml"
+# 16018 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -15969,9 +16023,9 @@ module Tables = struct
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2516 "src/ocaml/preprocess/parser_raw.mly"
+# 2534 "src/ocaml/preprocess/parser_raw.mly"
( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;(merloc _endpos__2_ _3)])) )
-# 15975 "src/ocaml/preprocess/parser_raw.ml"
+# 16029 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16004,9 +16058,9 @@ module Tables = struct
let _1_inlined1 : (Parsetree.expression) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 16010 "src/ocaml/preprocess/parser_raw.ml"
+# 16064 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -16014,39 +16068,39 @@ module Tables = struct
let _v : (Parsetree.expression) = let _3 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16020 "src/ocaml/preprocess/parser_raw.ml"
+# 16074 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16025 "src/ocaml/preprocess/parser_raw.ml"
+# 16079 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _1 =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16033 "src/ocaml/preprocess/parser_raw.ml"
+# 16087 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 16041 "src/ocaml/preprocess/parser_raw.ml"
+# 16095 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2518 "src/ocaml/preprocess/parser_raw.mly"
+# 2536 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 16050 "src/ocaml/preprocess/parser_raw.ml"
+# 16104 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16100,9 +16154,9 @@ module Tables = struct
let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 16106 "src/ocaml/preprocess/parser_raw.ml"
+# 16160 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -16115,18 +16169,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 16119 "src/ocaml/preprocess/parser_raw.ml"
+# 16173 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16124 "src/ocaml/preprocess/parser_raw.ml"
+# 16178 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16130 "src/ocaml/preprocess/parser_raw.ml"
+# 16184 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -16135,22 +16189,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16141 "src/ocaml/preprocess/parser_raw.ml"
+# 16195 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 16147 "src/ocaml/preprocess/parser_raw.ml"
+# 16201 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -16163,38 +16217,38 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 16167 "src/ocaml/preprocess/parser_raw.ml"
+# 16221 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16173 "src/ocaml/preprocess/parser_raw.ml"
+# 16227 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
let _1 =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16181 "src/ocaml/preprocess/parser_raw.ml"
+# 16235 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 16189 "src/ocaml/preprocess/parser_raw.ml"
+# 16243 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2518 "src/ocaml/preprocess/parser_raw.mly"
+# 2536 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 16198 "src/ocaml/preprocess/parser_raw.ml"
+# 16252 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16247,14 +16301,14 @@ module Tables = struct
let _v : (Parsetree.expression) = let _5 =
let _1 = _1_inlined2 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16253 "src/ocaml/preprocess/parser_raw.ml"
+# 16307 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16258 "src/ocaml/preprocess/parser_raw.ml"
+# 16312 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
@@ -16264,18 +16318,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 16270 "src/ocaml/preprocess/parser_raw.ml"
+# 16324 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2520 "src/ocaml/preprocess/parser_raw.mly"
+# 2538 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 16279 "src/ocaml/preprocess/parser_raw.ml"
+# 16333 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16354,18 +16408,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 16358 "src/ocaml/preprocess/parser_raw.ml"
+# 16412 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16363 "src/ocaml/preprocess/parser_raw.ml"
+# 16417 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16369 "src/ocaml/preprocess/parser_raw.ml"
+# 16423 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -16374,22 +16428,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16380 "src/ocaml/preprocess/parser_raw.ml"
+# 16434 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 16386 "src/ocaml/preprocess/parser_raw.ml"
+# 16440 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -16402,13 +16456,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 16406 "src/ocaml/preprocess/parser_raw.ml"
+# 16460 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16412 "src/ocaml/preprocess/parser_raw.ml"
+# 16466 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos_xs_ in
@@ -16418,18 +16472,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 16424 "src/ocaml/preprocess/parser_raw.ml"
+# 16478 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2520 "src/ocaml/preprocess/parser_raw.mly"
+# 2538 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 16433 "src/ocaml/preprocess/parser_raw.ml"
+# 16487 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16498,26 +16552,26 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16504 "src/ocaml/preprocess/parser_raw.ml"
+# 16558 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16509 "src/ocaml/preprocess/parser_raw.ml"
+# 16563 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2521 "src/ocaml/preprocess/parser_raw.mly"
+# 2539 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 16515 "src/ocaml/preprocess/parser_raw.ml"
+# 16569 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 16521 "src/ocaml/preprocess/parser_raw.ml"
+# 16575 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
@@ -16525,9 +16579,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2522 "src/ocaml/preprocess/parser_raw.mly"
+# 2540 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 16531 "src/ocaml/preprocess/parser_raw.ml"
+# 16585 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16622,18 +16676,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 16626 "src/ocaml/preprocess/parser_raw.ml"
+# 16680 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16631 "src/ocaml/preprocess/parser_raw.ml"
+# 16685 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16637 "src/ocaml/preprocess/parser_raw.ml"
+# 16691 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -16642,22 +16696,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16648 "src/ocaml/preprocess/parser_raw.ml"
+# 16702 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 16654 "src/ocaml/preprocess/parser_raw.ml"
+# 16708 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -16670,25 +16724,25 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 16674 "src/ocaml/preprocess/parser_raw.ml"
+# 16728 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16680 "src/ocaml/preprocess/parser_raw.ml"
+# 16734 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2521 "src/ocaml/preprocess/parser_raw.mly"
+# 2539 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 16686 "src/ocaml/preprocess/parser_raw.ml"
+# 16740 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 16692 "src/ocaml/preprocess/parser_raw.ml"
+# 16746 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -16696,9 +16750,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2522 "src/ocaml/preprocess/parser_raw.mly"
+# 2540 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 16702 "src/ocaml/preprocess/parser_raw.ml"
+# 16756 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16767,26 +16821,26 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16773 "src/ocaml/preprocess/parser_raw.ml"
+# 16827 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16778 "src/ocaml/preprocess/parser_raw.ml"
+# 16832 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2521 "src/ocaml/preprocess/parser_raw.mly"
+# 2539 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 16784 "src/ocaml/preprocess/parser_raw.ml"
+# 16838 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 16790 "src/ocaml/preprocess/parser_raw.ml"
+# 16844 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
@@ -16794,9 +16848,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2522 "src/ocaml/preprocess/parser_raw.mly"
+# 2540 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 16800 "src/ocaml/preprocess/parser_raw.ml"
+# 16854 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -16891,18 +16945,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 16895 "src/ocaml/preprocess/parser_raw.ml"
+# 16949 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16900 "src/ocaml/preprocess/parser_raw.ml"
+# 16954 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 16906 "src/ocaml/preprocess/parser_raw.ml"
+# 16960 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -16911,22 +16965,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16917 "src/ocaml/preprocess/parser_raw.ml"
+# 16971 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 16923 "src/ocaml/preprocess/parser_raw.ml"
+# 16977 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -16939,25 +16993,25 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 16943 "src/ocaml/preprocess/parser_raw.ml"
+# 16997 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 16949 "src/ocaml/preprocess/parser_raw.ml"
+# 17003 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2521 "src/ocaml/preprocess/parser_raw.mly"
+# 2539 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 16955 "src/ocaml/preprocess/parser_raw.ml"
+# 17009 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 16961 "src/ocaml/preprocess/parser_raw.ml"
+# 17015 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -16965,9 +17019,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2522 "src/ocaml/preprocess/parser_raw.mly"
+# 2540 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 16971 "src/ocaml/preprocess/parser_raw.ml"
+# 17025 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -17036,26 +17090,26 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17042 "src/ocaml/preprocess/parser_raw.ml"
+# 17096 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17047 "src/ocaml/preprocess/parser_raw.ml"
+# 17101 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2521 "src/ocaml/preprocess/parser_raw.mly"
+# 2539 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 17053 "src/ocaml/preprocess/parser_raw.ml"
+# 17107 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 17059 "src/ocaml/preprocess/parser_raw.ml"
+# 17113 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
@@ -17063,9 +17117,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2522 "src/ocaml/preprocess/parser_raw.mly"
+# 2540 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17069 "src/ocaml/preprocess/parser_raw.ml"
+# 17123 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -17160,18 +17214,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17164 "src/ocaml/preprocess/parser_raw.ml"
+# 17218 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 17169 "src/ocaml/preprocess/parser_raw.ml"
+# 17223 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 17175 "src/ocaml/preprocess/parser_raw.ml"
+# 17229 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -17180,22 +17234,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17186 "src/ocaml/preprocess/parser_raw.ml"
+# 17240 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 17192 "src/ocaml/preprocess/parser_raw.ml"
+# 17246 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -17208,25 +17262,25 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 17212 "src/ocaml/preprocess/parser_raw.ml"
+# 17266 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17218 "src/ocaml/preprocess/parser_raw.ml"
+# 17272 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2521 "src/ocaml/preprocess/parser_raw.mly"
+# 2539 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 17224 "src/ocaml/preprocess/parser_raw.ml"
+# 17278 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 17230 "src/ocaml/preprocess/parser_raw.ml"
+# 17284 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -17234,9 +17288,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2522 "src/ocaml/preprocess/parser_raw.mly"
+# 2540 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17240 "src/ocaml/preprocess/parser_raw.ml"
+# 17294 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -17296,9 +17350,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 17302 "src/ocaml/preprocess/parser_raw.ml"
+# 17356 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -17309,43 +17363,43 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17315 "src/ocaml/preprocess/parser_raw.ml"
+# 17369 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17320 "src/ocaml/preprocess/parser_raw.ml"
+# 17374 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 17326 "src/ocaml/preprocess/parser_raw.ml"
+# 17380 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 17332 "src/ocaml/preprocess/parser_raw.ml"
+# 17386 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 17338 "src/ocaml/preprocess/parser_raw.ml"
+# 17392 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 17343 "src/ocaml/preprocess/parser_raw.ml"
+# 17397 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 17349 "src/ocaml/preprocess/parser_raw.ml"
+# 17403 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
@@ -17353,9 +17407,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 17359 "src/ocaml/preprocess/parser_raw.ml"
+# 17413 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -17436,9 +17490,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 17442 "src/ocaml/preprocess/parser_raw.ml"
+# 17496 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -17454,18 +17508,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17458 "src/ocaml/preprocess/parser_raw.ml"
+# 17512 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 17463 "src/ocaml/preprocess/parser_raw.ml"
+# 17517 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 17469 "src/ocaml/preprocess/parser_raw.ml"
+# 17523 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -17474,22 +17528,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17480 "src/ocaml/preprocess/parser_raw.ml"
+# 17534 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 17486 "src/ocaml/preprocess/parser_raw.ml"
+# 17540 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -17502,42 +17556,42 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 17506 "src/ocaml/preprocess/parser_raw.ml"
+# 17560 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17512 "src/ocaml/preprocess/parser_raw.ml"
+# 17566 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 17518 "src/ocaml/preprocess/parser_raw.ml"
+# 17572 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 17524 "src/ocaml/preprocess/parser_raw.ml"
+# 17578 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 17530 "src/ocaml/preprocess/parser_raw.ml"
+# 17584 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 17535 "src/ocaml/preprocess/parser_raw.ml"
+# 17589 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 17541 "src/ocaml/preprocess/parser_raw.ml"
+# 17595 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -17545,9 +17599,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 17551 "src/ocaml/preprocess/parser_raw.ml"
+# 17605 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -17619,9 +17673,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 17625 "src/ocaml/preprocess/parser_raw.ml"
+# 17679 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -17635,51 +17689,51 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17641 "src/ocaml/preprocess/parser_raw.ml"
+# 17695 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17646 "src/ocaml/preprocess/parser_raw.ml"
+# 17700 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 17652 "src/ocaml/preprocess/parser_raw.ml"
+# 17706 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 17658 "src/ocaml/preprocess/parser_raw.ml"
+# 17712 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 17666 "src/ocaml/preprocess/parser_raw.ml"
+# 17720 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 17671 "src/ocaml/preprocess/parser_raw.ml"
+# 17725 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 17677 "src/ocaml/preprocess/parser_raw.ml"
+# 17731 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 17683 "src/ocaml/preprocess/parser_raw.ml"
+# 17737 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
@@ -17687,9 +17741,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 17693 "src/ocaml/preprocess/parser_raw.ml"
+# 17747 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -17782,9 +17836,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 17788 "src/ocaml/preprocess/parser_raw.ml"
+# 17842 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -17803,18 +17857,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17807 "src/ocaml/preprocess/parser_raw.ml"
+# 17861 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 17812 "src/ocaml/preprocess/parser_raw.ml"
+# 17866 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 17818 "src/ocaml/preprocess/parser_raw.ml"
+# 17872 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -17823,22 +17877,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17829 "src/ocaml/preprocess/parser_raw.ml"
+# 17883 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 17835 "src/ocaml/preprocess/parser_raw.ml"
+# 17889 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -17851,50 +17905,50 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 17855 "src/ocaml/preprocess/parser_raw.ml"
+# 17909 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17861 "src/ocaml/preprocess/parser_raw.ml"
+# 17915 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 17867 "src/ocaml/preprocess/parser_raw.ml"
+# 17921 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 17873 "src/ocaml/preprocess/parser_raw.ml"
+# 17927 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 17881 "src/ocaml/preprocess/parser_raw.ml"
+# 17935 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 17886 "src/ocaml/preprocess/parser_raw.ml"
+# 17940 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 17892 "src/ocaml/preprocess/parser_raw.ml"
+# 17946 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 17898 "src/ocaml/preprocess/parser_raw.ml"
+# 17952 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -17902,9 +17956,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 17908 "src/ocaml/preprocess/parser_raw.ml"
+# 17962 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -17964,9 +18018,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 17970 "src/ocaml/preprocess/parser_raw.ml"
+# 18024 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -17977,43 +18031,43 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17983 "src/ocaml/preprocess/parser_raw.ml"
+# 18037 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 17988 "src/ocaml/preprocess/parser_raw.ml"
+# 18042 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 17994 "src/ocaml/preprocess/parser_raw.ml"
+# 18048 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 18000 "src/ocaml/preprocess/parser_raw.ml"
+# 18054 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 18006 "src/ocaml/preprocess/parser_raw.ml"
+# 18060 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18011 "src/ocaml/preprocess/parser_raw.ml"
+# 18065 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 18017 "src/ocaml/preprocess/parser_raw.ml"
+# 18071 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
@@ -18021,9 +18075,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18027 "src/ocaml/preprocess/parser_raw.ml"
+# 18081 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -18104,9 +18158,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 18110 "src/ocaml/preprocess/parser_raw.ml"
+# 18164 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -18122,18 +18176,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 18126 "src/ocaml/preprocess/parser_raw.ml"
+# 18180 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 18131 "src/ocaml/preprocess/parser_raw.ml"
+# 18185 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 18137 "src/ocaml/preprocess/parser_raw.ml"
+# 18191 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -18142,22 +18196,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18148 "src/ocaml/preprocess/parser_raw.ml"
+# 18202 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18154 "src/ocaml/preprocess/parser_raw.ml"
+# 18208 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -18170,42 +18224,42 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 18174 "src/ocaml/preprocess/parser_raw.ml"
+# 18228 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18180 "src/ocaml/preprocess/parser_raw.ml"
+# 18234 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 18186 "src/ocaml/preprocess/parser_raw.ml"
+# 18240 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 18192 "src/ocaml/preprocess/parser_raw.ml"
+# 18246 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 18198 "src/ocaml/preprocess/parser_raw.ml"
+# 18252 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18203 "src/ocaml/preprocess/parser_raw.ml"
+# 18257 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 18209 "src/ocaml/preprocess/parser_raw.ml"
+# 18263 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -18213,9 +18267,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18219 "src/ocaml/preprocess/parser_raw.ml"
+# 18273 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -18287,9 +18341,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 18293 "src/ocaml/preprocess/parser_raw.ml"
+# 18347 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -18303,51 +18357,51 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18309 "src/ocaml/preprocess/parser_raw.ml"
+# 18363 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18314 "src/ocaml/preprocess/parser_raw.ml"
+# 18368 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 18320 "src/ocaml/preprocess/parser_raw.ml"
+# 18374 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 18326 "src/ocaml/preprocess/parser_raw.ml"
+# 18380 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 18334 "src/ocaml/preprocess/parser_raw.ml"
+# 18388 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 18339 "src/ocaml/preprocess/parser_raw.ml"
+# 18393 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18345 "src/ocaml/preprocess/parser_raw.ml"
+# 18399 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 18351 "src/ocaml/preprocess/parser_raw.ml"
+# 18405 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
@@ -18355,9 +18409,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18361 "src/ocaml/preprocess/parser_raw.ml"
+# 18415 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -18450,9 +18504,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 18456 "src/ocaml/preprocess/parser_raw.ml"
+# 18510 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -18471,18 +18525,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 18475 "src/ocaml/preprocess/parser_raw.ml"
+# 18529 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 18480 "src/ocaml/preprocess/parser_raw.ml"
+# 18534 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 18486 "src/ocaml/preprocess/parser_raw.ml"
+# 18540 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -18491,22 +18545,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18497 "src/ocaml/preprocess/parser_raw.ml"
+# 18551 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18503 "src/ocaml/preprocess/parser_raw.ml"
+# 18557 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -18519,50 +18573,50 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 18523 "src/ocaml/preprocess/parser_raw.ml"
+# 18577 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18529 "src/ocaml/preprocess/parser_raw.ml"
+# 18583 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 18535 "src/ocaml/preprocess/parser_raw.ml"
+# 18589 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 18541 "src/ocaml/preprocess/parser_raw.ml"
+# 18595 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 18549 "src/ocaml/preprocess/parser_raw.ml"
+# 18603 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 18554 "src/ocaml/preprocess/parser_raw.ml"
+# 18608 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18560 "src/ocaml/preprocess/parser_raw.ml"
+# 18614 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 18566 "src/ocaml/preprocess/parser_raw.ml"
+# 18620 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -18570,9 +18624,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18576 "src/ocaml/preprocess/parser_raw.ml"
+# 18630 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -18632,9 +18686,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 18638 "src/ocaml/preprocess/parser_raw.ml"
+# 18692 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -18645,43 +18699,43 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18651 "src/ocaml/preprocess/parser_raw.ml"
+# 18705 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18656 "src/ocaml/preprocess/parser_raw.ml"
+# 18710 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 18662 "src/ocaml/preprocess/parser_raw.ml"
+# 18716 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 18668 "src/ocaml/preprocess/parser_raw.ml"
+# 18722 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 18674 "src/ocaml/preprocess/parser_raw.ml"
+# 18728 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18679 "src/ocaml/preprocess/parser_raw.ml"
+# 18733 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 18685 "src/ocaml/preprocess/parser_raw.ml"
+# 18739 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
@@ -18689,9 +18743,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18695 "src/ocaml/preprocess/parser_raw.ml"
+# 18749 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -18772,9 +18826,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 18778 "src/ocaml/preprocess/parser_raw.ml"
+# 18832 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -18790,18 +18844,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 18794 "src/ocaml/preprocess/parser_raw.ml"
+# 18848 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 18799 "src/ocaml/preprocess/parser_raw.ml"
+# 18853 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 18805 "src/ocaml/preprocess/parser_raw.ml"
+# 18859 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -18810,22 +18864,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18816 "src/ocaml/preprocess/parser_raw.ml"
+# 18870 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18822 "src/ocaml/preprocess/parser_raw.ml"
+# 18876 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -18838,42 +18892,42 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 18842 "src/ocaml/preprocess/parser_raw.ml"
+# 18896 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18848 "src/ocaml/preprocess/parser_raw.ml"
+# 18902 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 18854 "src/ocaml/preprocess/parser_raw.ml"
+# 18908 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 18860 "src/ocaml/preprocess/parser_raw.ml"
+# 18914 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 18866 "src/ocaml/preprocess/parser_raw.ml"
+# 18920 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 18871 "src/ocaml/preprocess/parser_raw.ml"
+# 18925 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 18877 "src/ocaml/preprocess/parser_raw.ml"
+# 18931 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -18881,9 +18935,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18887 "src/ocaml/preprocess/parser_raw.ml"
+# 18941 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -18955,9 +19009,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 18961 "src/ocaml/preprocess/parser_raw.ml"
+# 19015 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -18971,51 +19025,51 @@ module Tables = struct
let v =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18977 "src/ocaml/preprocess/parser_raw.ml"
+# 19031 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 18982 "src/ocaml/preprocess/parser_raw.ml"
+# 19036 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 18988 "src/ocaml/preprocess/parser_raw.ml"
+# 19042 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 18994 "src/ocaml/preprocess/parser_raw.ml"
+# 19048 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 19002 "src/ocaml/preprocess/parser_raw.ml"
+# 19056 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 19007 "src/ocaml/preprocess/parser_raw.ml"
+# 19061 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 19013 "src/ocaml/preprocess/parser_raw.ml"
+# 19067 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 19019 "src/ocaml/preprocess/parser_raw.ml"
+# 19073 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
@@ -19023,9 +19077,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 19029 "src/ocaml/preprocess/parser_raw.ml"
+# 19083 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19118,9 +19172,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 19124 "src/ocaml/preprocess/parser_raw.ml"
+# 19178 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -19139,18 +19193,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 19143 "src/ocaml/preprocess/parser_raw.ml"
+# 19197 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 19148 "src/ocaml/preprocess/parser_raw.ml"
+# 19202 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 19154 "src/ocaml/preprocess/parser_raw.ml"
+# 19208 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -19159,22 +19213,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19165 "src/ocaml/preprocess/parser_raw.ml"
+# 19219 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 19171 "src/ocaml/preprocess/parser_raw.ml"
+# 19225 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -19187,50 +19241,50 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 19191 "src/ocaml/preprocess/parser_raw.ml"
+# 19245 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19197 "src/ocaml/preprocess/parser_raw.ml"
+# 19251 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2523 "src/ocaml/preprocess/parser_raw.mly"
+# 2541 "src/ocaml/preprocess/parser_raw.mly"
(Some v)
-# 19203 "src/ocaml/preprocess/parser_raw.ml"
+# 19257 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 19209 "src/ocaml/preprocess/parser_raw.ml"
+# 19263 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 19217 "src/ocaml/preprocess/parser_raw.ml"
+# 19271 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 19222 "src/ocaml/preprocess/parser_raw.ml"
+# 19276 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 19228 "src/ocaml/preprocess/parser_raw.ml"
+# 19282 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 19234 "src/ocaml/preprocess/parser_raw.ml"
+# 19288 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
@@ -19238,9 +19292,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2524 "src/ocaml/preprocess/parser_raw.mly"
+# 2542 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 19244 "src/ocaml/preprocess/parser_raw.ml"
+# 19298 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19270,9 +19324,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2526 "src/ocaml/preprocess/parser_raw.mly"
+# 2544 "src/ocaml/preprocess/parser_raw.mly"
( Exp.attr _1 _2 )
-# 19276 "src/ocaml/preprocess/parser_raw.ml"
+# 19330 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19316,15 +19370,15 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.function_param list) = let ty_params =
-# 2774 "src/ocaml/preprocess/parser_raw.mly"
+# 2812 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 19322 "src/ocaml/preprocess/parser_raw.ml"
+# 19376 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2923 "src/ocaml/preprocess/parser_raw.mly"
+# 2961 "src/ocaml/preprocess/parser_raw.mly"
( (* We desugar (type a b c) to (type a) (type b) (type c).
If we do this desugaring, the loc for each parameter is a ghost.
*)
@@ -19338,7 +19392,7 @@ module Tables = struct
(fun x -> { pparam_loc = loc; pparam_desc = Pparam_newtype x })
ty_params
)
-# 19342 "src/ocaml/preprocess/parser_raw.ml"
+# 19396 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19364,11 +19418,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2937 "src/ocaml/preprocess/parser_raw.mly"
+# 2975 "src/ocaml/preprocess/parser_raw.mly"
( let a, b, c = _1 in
[ { pparam_loc = make_loc _sloc; pparam_desc = Pparam_val (a, b, c) } ]
)
-# 19372 "src/ocaml/preprocess/parser_raw.ml"
+# 19426 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19394,18 +19448,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 19398 "src/ocaml/preprocess/parser_raw.ml"
+# 19452 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1150 "src/ocaml/preprocess/parser_raw.mly"
+# 1170 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 19403 "src/ocaml/preprocess/parser_raw.ml"
+# 19457 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2942 "src/ocaml/preprocess/parser_raw.mly"
+# 2980 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19409 "src/ocaml/preprocess/parser_raw.ml"
+# 19463 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19428,9 +19482,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2416 "src/ocaml/preprocess/parser_raw.mly"
+# 2434 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19434 "src/ocaml/preprocess/parser_raw.ml"
+# 19488 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19460,9 +19514,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2417 "src/ocaml/preprocess/parser_raw.mly"
+# 2435 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19466 "src/ocaml/preprocess/parser_raw.ml"
+# 19520 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19500,24 +19554,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2419 "src/ocaml/preprocess/parser_raw.mly"
+# 2437 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_sequence(_1, _3) )
-# 19506 "src/ocaml/preprocess/parser_raw.ml"
+# 19560 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 19515 "src/ocaml/preprocess/parser_raw.ml"
+# 19569 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2420 "src/ocaml/preprocess/parser_raw.mly"
+# 2438 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19521 "src/ocaml/preprocess/parser_raw.ml"
+# 19575 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19571,11 +19625,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2422 "src/ocaml/preprocess/parser_raw.mly"
+# 2440 "src/ocaml/preprocess/parser_raw.mly"
( let seq = mkexp ~loc:_sloc (Pexp_sequence (_1, _5)) in
let payload = PStr [mkstrexp seq []] in
mkexp ~loc:_sloc (Pexp_extension (_4, payload)) )
-# 19579 "src/ocaml/preprocess/parser_raw.ml"
+# 19633 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19598,9 +19652,9 @@ module Tables = struct
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3647 "src/ocaml/preprocess/parser_raw.mly"
+# 3688 "src/ocaml/preprocess/parser_raw.mly"
( ty )
-# 19604 "src/ocaml/preprocess/parser_raw.ml"
+# 19658 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19646,19 +19700,19 @@ module Tables = struct
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 1025 "src/ocaml/preprocess/parser_raw.mly"
+# 1045 "src/ocaml/preprocess/parser_raw.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 19652 "src/ocaml/preprocess/parser_raw.ml"
+# 19706 "src/ocaml/preprocess/parser_raw.ml"
in
let label =
-# 3659 "src/ocaml/preprocess/parser_raw.mly"
+# 3700 "src/ocaml/preprocess/parser_raw.mly"
( Optional label )
-# 19657 "src/ocaml/preprocess/parser_raw.ml"
+# 19711 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3653 "src/ocaml/preprocess/parser_raw.mly"
+# 3694 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 19662 "src/ocaml/preprocess/parser_raw.ml"
+# 19716 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
@@ -19666,15 +19720,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 19672 "src/ocaml/preprocess/parser_raw.ml"
+# 19726 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3655 "src/ocaml/preprocess/parser_raw.mly"
+# 3696 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19678 "src/ocaml/preprocess/parser_raw.ml"
+# 19732 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19721,9 +19775,9 @@ module Tables = struct
let _1 : (Parsetree.core_type) = Obj.magic _1 in
let _2 : unit = Obj.magic _2 in
let label : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 19727 "src/ocaml/preprocess/parser_raw.ml"
+# 19781 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
@@ -19731,19 +19785,19 @@ module Tables = struct
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 1025 "src/ocaml/preprocess/parser_raw.mly"
+# 1045 "src/ocaml/preprocess/parser_raw.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 19737 "src/ocaml/preprocess/parser_raw.ml"
+# 19791 "src/ocaml/preprocess/parser_raw.ml"
in
let label =
-# 3661 "src/ocaml/preprocess/parser_raw.mly"
+# 3702 "src/ocaml/preprocess/parser_raw.mly"
( Labelled label )
-# 19742 "src/ocaml/preprocess/parser_raw.ml"
+# 19796 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3653 "src/ocaml/preprocess/parser_raw.mly"
+# 3694 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 19747 "src/ocaml/preprocess/parser_raw.ml"
+# 19801 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
@@ -19751,15 +19805,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 19757 "src/ocaml/preprocess/parser_raw.ml"
+# 19811 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3655 "src/ocaml/preprocess/parser_raw.mly"
+# 3696 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19763 "src/ocaml/preprocess/parser_raw.ml"
+# 19817 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19798,19 +19852,19 @@ module Tables = struct
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 1025 "src/ocaml/preprocess/parser_raw.mly"
+# 1045 "src/ocaml/preprocess/parser_raw.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 19804 "src/ocaml/preprocess/parser_raw.ml"
+# 19858 "src/ocaml/preprocess/parser_raw.ml"
in
let label =
-# 3663 "src/ocaml/preprocess/parser_raw.mly"
+# 3704 "src/ocaml/preprocess/parser_raw.mly"
( Nolabel )
-# 19809 "src/ocaml/preprocess/parser_raw.ml"
+# 19863 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3653 "src/ocaml/preprocess/parser_raw.mly"
+# 3694 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 19814 "src/ocaml/preprocess/parser_raw.ml"
+# 19868 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_codomain_ in
@@ -19818,15 +19872,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 19824 "src/ocaml/preprocess/parser_raw.ml"
+# 19878 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3655 "src/ocaml/preprocess/parser_raw.mly"
+# 3696 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19830 "src/ocaml/preprocess/parser_raw.ml"
+# 19884 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19857,9 +19911,9 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Lexing.position * Parsetree.functor_parameter) = let _startpos = _startpos__1_ in
-# 1437 "src/ocaml/preprocess/parser_raw.mly"
+# 1457 "src/ocaml/preprocess/parser_raw.mly"
( _startpos, Unit )
-# 19863 "src/ocaml/preprocess/parser_raw.ml"
+# 19917 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19915,16 +19969,16 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 19921 "src/ocaml/preprocess/parser_raw.ml"
+# 19975 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos = _startpos__1_ in
-# 1440 "src/ocaml/preprocess/parser_raw.mly"
+# 1460 "src/ocaml/preprocess/parser_raw.mly"
( _startpos, Named (x, mty) )
-# 19928 "src/ocaml/preprocess/parser_raw.ml"
+# 19982 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19947,9 +20001,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
-# 1429 "src/ocaml/preprocess/parser_raw.mly"
+# 1449 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 19953 "src/ocaml/preprocess/parser_raw.ml"
+# 20007 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19966,9 +20020,9 @@ module Tables = struct
let _endpos = _startpos in
let _v : (Ocaml_parsing.Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option) =
-# 3446 "src/ocaml/preprocess/parser_raw.mly"
+# 3487 "src/ocaml/preprocess/parser_raw.mly"
( ([],Pcstr_tuple [],None) )
-# 19972 "src/ocaml/preprocess/parser_raw.ml"
+# 20026 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -19999,9 +20053,9 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Ocaml_parsing.Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option) =
-# 3447 "src/ocaml/preprocess/parser_raw.mly"
+# 3488 "src/ocaml/preprocess/parser_raw.mly"
( ([],_2,None) )
-# 20005 "src/ocaml/preprocess/parser_raw.ml"
+# 20059 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20046,9 +20100,9 @@ module Tables = struct
let _endpos = _endpos__4_ in
let _v : (Ocaml_parsing.Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option) =
-# 3449 "src/ocaml/preprocess/parser_raw.mly"
+# 3490 "src/ocaml/preprocess/parser_raw.mly"
( ([],_2,Some _4) )
-# 20052 "src/ocaml/preprocess/parser_raw.ml"
+# 20106 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20111,24 +20165,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 20115 "src/ocaml/preprocess/parser_raw.ml"
+# 20169 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 20120 "src/ocaml/preprocess/parser_raw.ml"
+# 20174 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3582 "src/ocaml/preprocess/parser_raw.mly"
+# 3623 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20126 "src/ocaml/preprocess/parser_raw.ml"
+# 20180 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3452 "src/ocaml/preprocess/parser_raw.mly"
+# 3493 "src/ocaml/preprocess/parser_raw.mly"
( (_2,_4,Some _6) )
-# 20132 "src/ocaml/preprocess/parser_raw.ml"
+# 20186 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20159,9 +20213,9 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Ocaml_parsing.Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option) =
-# 3454 "src/ocaml/preprocess/parser_raw.mly"
+# 3495 "src/ocaml/preprocess/parser_raw.mly"
( ([],Pcstr_tuple [],Some _2) )
-# 20165 "src/ocaml/preprocess/parser_raw.ml"
+# 20219 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20210,24 +20264,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 20214 "src/ocaml/preprocess/parser_raw.ml"
+# 20268 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 20219 "src/ocaml/preprocess/parser_raw.ml"
+# 20273 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3582 "src/ocaml/preprocess/parser_raw.mly"
+# 3623 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20225 "src/ocaml/preprocess/parser_raw.ml"
+# 20279 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3456 "src/ocaml/preprocess/parser_raw.mly"
+# 3497 "src/ocaml/preprocess/parser_raw.mly"
( (_2,Pcstr_tuple [],Some _4) )
-# 20231 "src/ocaml/preprocess/parser_raw.ml"
+# 20285 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20276,9 +20330,9 @@ module Tables = struct
Parsetree.attributes * Location.t * Ocaml_parsing.Docstrings.info) = let attrs =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20282 "src/ocaml/preprocess/parser_raw.ml"
+# 20336 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
@@ -20288,23 +20342,23 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 20294 "src/ocaml/preprocess/parser_raw.ml"
+# 20348 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3394 "src/ocaml/preprocess/parser_raw.mly"
+# 3435 "src/ocaml/preprocess/parser_raw.mly"
(
let vars, args, res = vars_args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, vars, args, res, attrs, loc, info
)
-# 20308 "src/ocaml/preprocess/parser_raw.ml"
+# 20362 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20346,9 +20400,9 @@ module Tables = struct
Parsetree.attributes * Location.t * Ocaml_parsing.Docstrings.info) = let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20352 "src/ocaml/preprocess/parser_raw.ml"
+# 20406 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs_ = _endpos__1_inlined1_ in
@@ -20357,29 +20411,29 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 20363 "src/ocaml/preprocess/parser_raw.ml"
+# 20417 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 4048 "src/ocaml/preprocess/parser_raw.mly"
+# 4096 "src/ocaml/preprocess/parser_raw.mly"
( () )
-# 20370 "src/ocaml/preprocess/parser_raw.ml"
+# 20424 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3394 "src/ocaml/preprocess/parser_raw.mly"
+# 3435 "src/ocaml/preprocess/parser_raw.mly"
(
let vars, args, res = vars_args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, vars, args, res, attrs, loc, info
)
-# 20383 "src/ocaml/preprocess/parser_raw.ml"
+# 20437 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20450,9 +20504,9 @@ module Tables = struct
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 20456 "src/ocaml/preprocess/parser_raw.ml"
+# 20510 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -20465,9 +20519,9 @@ module Tables = struct
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20471 "src/ocaml/preprocess/parser_raw.ml"
+# 20525 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
@@ -20476,26 +20530,26 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 20480 "src/ocaml/preprocess/parser_raw.ml"
+# 20534 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1111 "src/ocaml/preprocess/parser_raw.mly"
+# 1131 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 20485 "src/ocaml/preprocess/parser_raw.ml"
+# 20539 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3297 "src/ocaml/preprocess/parser_raw.mly"
+# 3338 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20491 "src/ocaml/preprocess/parser_raw.ml"
+# 20545 "src/ocaml/preprocess/parser_raw.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 3332 "src/ocaml/preprocess/parser_raw.mly"
+# 3373 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 20499 "src/ocaml/preprocess/parser_raw.ml"
+# 20553 "src/ocaml/preprocess/parser_raw.ml"
in
let id =
@@ -20504,29 +20558,29 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 20510 "src/ocaml/preprocess/parser_raw.ml"
+# 20564 "src/ocaml/preprocess/parser_raw.ml"
in
let flag =
-# 4068 "src/ocaml/preprocess/parser_raw.mly"
+# 4116 "src/ocaml/preprocess/parser_raw.mly"
( Recursive )
-# 20516 "src/ocaml/preprocess/parser_raw.ml"
+# 20570 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20523 "src/ocaml/preprocess/parser_raw.ml"
+# 20577 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3269 "src/ocaml/preprocess/parser_raw.mly"
+# 3310 "src/ocaml/preprocess/parser_raw.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
@@ -20535,7 +20589,7 @@ module Tables = struct
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 20539 "src/ocaml/preprocess/parser_raw.ml"
+# 20593 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20612,9 +20666,9 @@ module Tables = struct
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined4 : unit = Obj.magic _1_inlined4 in
let _1_inlined3 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 20618 "src/ocaml/preprocess/parser_raw.ml"
+# 20672 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
@@ -20628,9 +20682,9 @@ module Tables = struct
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined5 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20634 "src/ocaml/preprocess/parser_raw.ml"
+# 20688 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined5_ in
@@ -20639,26 +20693,26 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 20643 "src/ocaml/preprocess/parser_raw.ml"
+# 20697 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1111 "src/ocaml/preprocess/parser_raw.mly"
+# 1131 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 20648 "src/ocaml/preprocess/parser_raw.ml"
+# 20702 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3297 "src/ocaml/preprocess/parser_raw.mly"
+# 3338 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20654 "src/ocaml/preprocess/parser_raw.ml"
+# 20708 "src/ocaml/preprocess/parser_raw.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined4 in
-# 3332 "src/ocaml/preprocess/parser_raw.mly"
+# 3373 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 20662 "src/ocaml/preprocess/parser_raw.ml"
+# 20716 "src/ocaml/preprocess/parser_raw.ml"
in
let id =
@@ -20667,9 +20721,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 20673 "src/ocaml/preprocess/parser_raw.ml"
+# 20727 "src/ocaml/preprocess/parser_raw.ml"
in
let flag =
@@ -20678,24 +20732,24 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 4070 "src/ocaml/preprocess/parser_raw.mly"
+# 4118 "src/ocaml/preprocess/parser_raw.mly"
( not_expecting _loc "nonrec flag"; Recursive )
-# 20684 "src/ocaml/preprocess/parser_raw.ml"
+# 20738 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20692 "src/ocaml/preprocess/parser_raw.ml"
+# 20746 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3269 "src/ocaml/preprocess/parser_raw.mly"
+# 3310 "src/ocaml/preprocess/parser_raw.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
@@ -20704,7 +20758,7 @@ module Tables = struct
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 20708 "src/ocaml/preprocess/parser_raw.ml"
+# 20762 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20768,9 +20822,9 @@ module Tables = struct
let xs : ((Parsetree.core_type * Parsetree.core_type * Location.t) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 20774 "src/ocaml/preprocess/parser_raw.ml"
+# 20828 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -20783,9 +20837,9 @@ module Tables = struct
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20789 "src/ocaml/preprocess/parser_raw.ml"
+# 20843 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -20794,18 +20848,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 20798 "src/ocaml/preprocess/parser_raw.ml"
+# 20852 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1111 "src/ocaml/preprocess/parser_raw.mly"
+# 1131 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 20803 "src/ocaml/preprocess/parser_raw.ml"
+# 20857 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3297 "src/ocaml/preprocess/parser_raw.mly"
+# 3338 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20809 "src/ocaml/preprocess/parser_raw.ml"
+# 20863 "src/ocaml/preprocess/parser_raw.ml"
in
let id =
@@ -20814,29 +20868,29 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 20820 "src/ocaml/preprocess/parser_raw.ml"
+# 20874 "src/ocaml/preprocess/parser_raw.ml"
in
let flag =
-# 4064 "src/ocaml/preprocess/parser_raw.mly"
+# 4112 "src/ocaml/preprocess/parser_raw.mly"
( Recursive )
-# 20826 "src/ocaml/preprocess/parser_raw.ml"
+# 20880 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20833 "src/ocaml/preprocess/parser_raw.ml"
+# 20887 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3269 "src/ocaml/preprocess/parser_raw.mly"
+# 3310 "src/ocaml/preprocess/parser_raw.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
@@ -20845,7 +20899,7 @@ module Tables = struct
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 20849 "src/ocaml/preprocess/parser_raw.ml"
+# 20903 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -20915,9 +20969,9 @@ module Tables = struct
let xs : ((Parsetree.core_type * Parsetree.core_type * Location.t) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined3 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 20921 "src/ocaml/preprocess/parser_raw.ml"
+# 20975 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
@@ -20931,9 +20985,9 @@ module Tables = struct
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20937 "src/ocaml/preprocess/parser_raw.ml"
+# 20991 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
@@ -20942,18 +20996,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 20946 "src/ocaml/preprocess/parser_raw.ml"
+# 21000 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1111 "src/ocaml/preprocess/parser_raw.mly"
+# 1131 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 20951 "src/ocaml/preprocess/parser_raw.ml"
+# 21005 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3297 "src/ocaml/preprocess/parser_raw.mly"
+# 3338 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20957 "src/ocaml/preprocess/parser_raw.ml"
+# 21011 "src/ocaml/preprocess/parser_raw.ml"
in
let id =
@@ -20962,32 +21016,32 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 20968 "src/ocaml/preprocess/parser_raw.ml"
+# 21022 "src/ocaml/preprocess/parser_raw.ml"
in
let flag =
let _1 = _1_inlined2 in
-# 4065 "src/ocaml/preprocess/parser_raw.mly"
+# 4113 "src/ocaml/preprocess/parser_raw.mly"
( Nonrecursive )
-# 20976 "src/ocaml/preprocess/parser_raw.ml"
+# 21030 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 20984 "src/ocaml/preprocess/parser_raw.ml"
+# 21038 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3269 "src/ocaml/preprocess/parser_raw.mly"
+# 3310 "src/ocaml/preprocess/parser_raw.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
@@ -20996,7 +21050,7 @@ module Tables = struct
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 21000 "src/ocaml/preprocess/parser_raw.ml"
+# 21054 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21015,17 +21069,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21021 "src/ocaml/preprocess/parser_raw.ml"
+# 21075 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3903 "src/ocaml/preprocess/parser_raw.mly"
+# 3951 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21029 "src/ocaml/preprocess/parser_raw.ml"
+# 21083 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21044,17 +21098,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21050 "src/ocaml/preprocess/parser_raw.ml"
+# 21104 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3904 "src/ocaml/preprocess/parser_raw.mly"
+# 3952 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21058 "src/ocaml/preprocess/parser_raw.ml"
+# 21112 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21084,9 +21138,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.structure) =
-# 1303 "src/ocaml/preprocess/parser_raw.mly"
+# 1323 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21090 "src/ocaml/preprocess/parser_raw.ml"
+# 21144 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21102,9 +21156,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string) =
-# 3955 "src/ocaml/preprocess/parser_raw.mly"
+# 4003 "src/ocaml/preprocess/parser_raw.mly"
( "" )
-# 21108 "src/ocaml/preprocess/parser_raw.ml"
+# 21162 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21134,9 +21188,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3956 "src/ocaml/preprocess/parser_raw.mly"
+# 4004 "src/ocaml/preprocess/parser_raw.mly"
( ";.." )
-# 21140 "src/ocaml/preprocess/parser_raw.ml"
+# 21194 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21166,9 +21220,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.signature) =
-# 1310 "src/ocaml/preprocess/parser_raw.mly"
+# 1330 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21172 "src/ocaml/preprocess/parser_raw.ml"
+# 21226 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21212,9 +21266,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 4248 "src/ocaml/preprocess/parser_raw.mly"
+# 4296 "src/ocaml/preprocess/parser_raw.mly"
( (_2, _3) )
-# 21218 "src/ocaml/preprocess/parser_raw.ml"
+# 21272 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21233,9 +21287,9 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 881 "src/ocaml/preprocess/parser_raw.mly"
+# 900 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string * Location.t * string option)
-# 21239 "src/ocaml/preprocess/parser_raw.ml"
+# 21293 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -21244,9 +21298,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4250 "src/ocaml/preprocess/parser_raw.mly"
+# 4298 "src/ocaml/preprocess/parser_raw.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 21250 "src/ocaml/preprocess/parser_raw.ml"
+# 21304 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21292,9 +21346,9 @@ module Tables = struct
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21298 "src/ocaml/preprocess/parser_raw.ml"
+# 21352 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -21303,34 +21357,34 @@ module Tables = struct
let _v : (Parsetree.label_declaration) = let _5 =
let _1 = _1_inlined3 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21309 "src/ocaml/preprocess/parser_raw.ml"
+# 21363 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3600 "src/ocaml/preprocess/parser_raw.mly"
+# 3641 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21318 "src/ocaml/preprocess/parser_raw.ml"
+# 21372 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21326 "src/ocaml/preprocess/parser_raw.ml"
+# 21380 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 21334 "src/ocaml/preprocess/parser_raw.ml"
+# 21388 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
@@ -21341,10 +21395,10 @@ module Tables = struct
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3473 "src/ocaml/preprocess/parser_raw.mly"
+# 3514 "src/ocaml/preprocess/parser_raw.mly"
( let info = symbol_info _endpos in
Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info )
-# 21348 "src/ocaml/preprocess/parser_raw.ml"
+# 21402 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21404,9 +21458,9 @@ module Tables = struct
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21410 "src/ocaml/preprocess/parser_raw.ml"
+# 21464 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -21415,43 +21469,43 @@ module Tables = struct
let _v : (Parsetree.label_declaration) = let _7 =
let _1 = _1_inlined4 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21421 "src/ocaml/preprocess/parser_raw.ml"
+# 21475 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _5 =
let _1 = _1_inlined3 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21430 "src/ocaml/preprocess/parser_raw.ml"
+# 21484 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3600 "src/ocaml/preprocess/parser_raw.mly"
+# 3641 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21439 "src/ocaml/preprocess/parser_raw.ml"
+# 21493 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21447 "src/ocaml/preprocess/parser_raw.ml"
+# 21501 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 21455 "src/ocaml/preprocess/parser_raw.ml"
+# 21509 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
@@ -21462,14 +21516,14 @@ module Tables = struct
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3478 "src/ocaml/preprocess/parser_raw.mly"
+# 3519 "src/ocaml/preprocess/parser_raw.mly"
( let info =
match rhs_info _endpos__5_ with
| Some _ as info_before_semi -> info_before_semi
| None -> symbol_info _endpos
in
Type.field _2 _4 ~mut:_1 ~attrs:(_5 @ _7) ~loc:(make_loc _sloc) ~info )
-# 21473 "src/ocaml/preprocess/parser_raw.ml"
+# 21527 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21492,9 +21546,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 3467 "src/ocaml/preprocess/parser_raw.mly"
+# 3508 "src/ocaml/preprocess/parser_raw.mly"
( [_1] )
-# 21498 "src/ocaml/preprocess/parser_raw.ml"
+# 21552 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21517,9 +21571,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 3468 "src/ocaml/preprocess/parser_raw.mly"
+# 3509 "src/ocaml/preprocess/parser_raw.mly"
( [_1] )
-# 21523 "src/ocaml/preprocess/parser_raw.ml"
+# 21577 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21549,9 +21603,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.label_declaration list) =
-# 3469 "src/ocaml/preprocess/parser_raw.mly"
+# 3510 "src/ocaml/preprocess/parser_raw.mly"
( _1 :: _2 )
-# 21555 "src/ocaml/preprocess/parser_raw.ml"
+# 21609 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21570,9 +21624,9 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21576 "src/ocaml/preprocess/parser_raw.ml"
+# 21630 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -21583,24 +21637,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 21589 "src/ocaml/preprocess/parser_raw.ml"
+# 21643 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2469 "src/ocaml/preprocess/parser_raw.mly"
+# 2487 "src/ocaml/preprocess/parser_raw.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 21598 "src/ocaml/preprocess/parser_raw.ml"
+# 21652 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2461 "src/ocaml/preprocess/parser_raw.mly"
+# 2479 "src/ocaml/preprocess/parser_raw.mly"
( x )
-# 21604 "src/ocaml/preprocess/parser_raw.ml"
+# 21658 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21633,9 +21687,9 @@ module Tables = struct
let cty : (Parsetree.core_type) = Obj.magic cty in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21639 "src/ocaml/preprocess/parser_raw.ml"
+# 21693 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -21646,18 +21700,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 21652 "src/ocaml/preprocess/parser_raw.ml"
+# 21706 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2469 "src/ocaml/preprocess/parser_raw.mly"
+# 2487 "src/ocaml/preprocess/parser_raw.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 21661 "src/ocaml/preprocess/parser_raw.ml"
+# 21715 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_x_ = _startpos__1_ in
@@ -21665,11 +21719,11 @@ module Tables = struct
let _symbolstartpos = _startpos_x_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2463 "src/ocaml/preprocess/parser_raw.mly"
+# 2481 "src/ocaml/preprocess/parser_raw.mly"
( let lab, pat = x in
lab,
mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) )
-# 21673 "src/ocaml/preprocess/parser_raw.ml"
+# 21727 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21692,9 +21746,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3987 "src/ocaml/preprocess/parser_raw.mly"
+# 4035 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21698 "src/ocaml/preprocess/parser_raw.ml"
+# 21752 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21717,9 +21771,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2757 "src/ocaml/preprocess/parser_raw.mly"
+# 2795 "src/ocaml/preprocess/parser_raw.mly"
( (Nolabel, _1) )
-# 21723 "src/ocaml/preprocess/parser_raw.ml"
+# 21777 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21745,17 +21799,17 @@ module Tables = struct
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 825 "src/ocaml/preprocess/parser_raw.mly"
+# 844 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21751 "src/ocaml/preprocess/parser_raw.ml"
+# 21805 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2759 "src/ocaml/preprocess/parser_raw.mly"
+# 2797 "src/ocaml/preprocess/parser_raw.mly"
( (Labelled _1, _2) )
-# 21759 "src/ocaml/preprocess/parser_raw.ml"
+# 21813 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21780,9 +21834,9 @@ module Tables = struct
};
} = _menhir_stack in
let label : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21786 "src/ocaml/preprocess/parser_raw.ml"
+# 21840 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -21790,10 +21844,10 @@ module Tables = struct
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2761 "src/ocaml/preprocess/parser_raw.mly"
+# 2799 "src/ocaml/preprocess/parser_raw.mly"
( let loc = _loc_label_ in
(Labelled label, mkexpvar ~loc label) )
-# 21797 "src/ocaml/preprocess/parser_raw.ml"
+# 21851 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21838,9 +21892,9 @@ module Tables = struct
let _5 : unit = Obj.magic _5 in
let ty : (Parsetree.type_constraint) = Obj.magic ty in
let label : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21844 "src/ocaml/preprocess/parser_raw.ml"
+# 21898 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic label in
let _2 : unit = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
@@ -21850,10 +21904,10 @@ module Tables = struct
let _v : (Asttypes.arg_label * Parsetree.expression) = let _endpos = _endpos__5_ in
let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2764 "src/ocaml/preprocess/parser_raw.mly"
+# 2802 "src/ocaml/preprocess/parser_raw.mly"
( (Labelled label, mkexp_constraint ~loc:(_startpos__2_, _endpos)
(mkexpvar ~loc:_loc_label_ label) ty) )
-# 21857 "src/ocaml/preprocess/parser_raw.ml"
+# 21911 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21878,9 +21932,9 @@ module Tables = struct
};
} = _menhir_stack in
let label : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21884 "src/ocaml/preprocess/parser_raw.ml"
+# 21938 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -21888,10 +21942,10 @@ module Tables = struct
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2767 "src/ocaml/preprocess/parser_raw.mly"
+# 2805 "src/ocaml/preprocess/parser_raw.mly"
( let loc = _loc_label_ in
(Optional label, mkexpvar ~loc label) )
-# 21895 "src/ocaml/preprocess/parser_raw.ml"
+# 21949 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21917,17 +21971,17 @@ module Tables = struct
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 855 "src/ocaml/preprocess/parser_raw.mly"
+# 874 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 21923 "src/ocaml/preprocess/parser_raw.ml"
+# 21977 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2770 "src/ocaml/preprocess/parser_raw.mly"
+# 2808 "src/ocaml/preprocess/parser_raw.mly"
( (Optional _1, _2) )
-# 21931 "src/ocaml/preprocess/parser_raw.ml"
+# 21985 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -21980,15 +22034,15 @@ module Tables = struct
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2457 "src/ocaml/preprocess/parser_raw.mly"
+# 2475 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 21986 "src/ocaml/preprocess/parser_raw.ml"
+# 22040 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2431 "src/ocaml/preprocess/parser_raw.mly"
+# 2449 "src/ocaml/preprocess/parser_raw.mly"
( (Optional (fst _3), _4, snd _3) )
-# 21992 "src/ocaml/preprocess/parser_raw.ml"
+# 22046 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22013,9 +22067,9 @@ module Tables = struct
};
} = _menhir_stack in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 22019 "src/ocaml/preprocess/parser_raw.ml"
+# 22073 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -22028,24 +22082,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 22034 "src/ocaml/preprocess/parser_raw.ml"
+# 22088 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2469 "src/ocaml/preprocess/parser_raw.mly"
+# 2487 "src/ocaml/preprocess/parser_raw.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 22043 "src/ocaml/preprocess/parser_raw.ml"
+# 22097 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2433 "src/ocaml/preprocess/parser_raw.mly"
+# 2451 "src/ocaml/preprocess/parser_raw.mly"
( (Optional (fst _2), None, snd _2) )
-# 22049 "src/ocaml/preprocess/parser_raw.ml"
+# 22103 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22092,9 +22146,9 @@ module Tables = struct
let _3 : (Parsetree.pattern) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 855 "src/ocaml/preprocess/parser_raw.mly"
+# 874 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 22098 "src/ocaml/preprocess/parser_raw.ml"
+# 22152 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -22102,15 +22156,15 @@ module Tables = struct
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2457 "src/ocaml/preprocess/parser_raw.mly"
+# 2475 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22108 "src/ocaml/preprocess/parser_raw.ml"
+# 22162 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2435 "src/ocaml/preprocess/parser_raw.mly"
+# 2453 "src/ocaml/preprocess/parser_raw.mly"
( (Optional _1, _4, _3) )
-# 22114 "src/ocaml/preprocess/parser_raw.ml"
+# 22168 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22136,17 +22190,17 @@ module Tables = struct
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 855 "src/ocaml/preprocess/parser_raw.mly"
+# 874 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 22142 "src/ocaml/preprocess/parser_raw.ml"
+# 22196 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2437 "src/ocaml/preprocess/parser_raw.mly"
+# 2455 "src/ocaml/preprocess/parser_raw.mly"
( (Optional _1, None, _2) )
-# 22150 "src/ocaml/preprocess/parser_raw.ml"
+# 22204 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22190,9 +22244,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2439 "src/ocaml/preprocess/parser_raw.mly"
+# 2457 "src/ocaml/preprocess/parser_raw.mly"
( (Labelled (fst _3), None, snd _3) )
-# 22196 "src/ocaml/preprocess/parser_raw.ml"
+# 22250 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22217,9 +22271,9 @@ module Tables = struct
};
} = _menhir_stack in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 22223 "src/ocaml/preprocess/parser_raw.ml"
+# 22277 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -22232,24 +22286,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 22238 "src/ocaml/preprocess/parser_raw.ml"
+# 22292 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2469 "src/ocaml/preprocess/parser_raw.mly"
+# 2487 "src/ocaml/preprocess/parser_raw.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 22247 "src/ocaml/preprocess/parser_raw.ml"
+# 22301 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2441 "src/ocaml/preprocess/parser_raw.mly"
+# 2459 "src/ocaml/preprocess/parser_raw.mly"
( (Labelled (fst _2), None, snd _2) )
-# 22253 "src/ocaml/preprocess/parser_raw.ml"
+# 22307 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22275,17 +22329,17 @@ module Tables = struct
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 825 "src/ocaml/preprocess/parser_raw.mly"
+# 844 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 22281 "src/ocaml/preprocess/parser_raw.ml"
+# 22335 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2443 "src/ocaml/preprocess/parser_raw.mly"
+# 2461 "src/ocaml/preprocess/parser_raw.mly"
( (Labelled _1, None, _2) )
-# 22289 "src/ocaml/preprocess/parser_raw.ml"
+# 22343 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22308,9 +22362,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2445 "src/ocaml/preprocess/parser_raw.mly"
+# 2463 "src/ocaml/preprocess/parser_raw.mly"
( (Nolabel, None, _1) )
-# 22314 "src/ocaml/preprocess/parser_raw.ml"
+# 22368 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22335,9 +22389,9 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern * Parsetree.expression *
Parsetree.value_constraint option * bool) =
-# 2809 "src/ocaml/preprocess/parser_raw.mly"
+# 2847 "src/ocaml/preprocess/parser_raw.mly"
( let p,e,c = _1 in (p,e,c,false) )
-# 22341 "src/ocaml/preprocess/parser_raw.ml"
+# 22395 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22364,9 +22418,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 2812 "src/ocaml/preprocess/parser_raw.mly"
+# 2850 "src/ocaml/preprocess/parser_raw.mly"
( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1, None, true) )
-# 22370 "src/ocaml/preprocess/parser_raw.ml"
+# 22424 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22401,15 +22455,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2777 "src/ocaml/preprocess/parser_raw.mly"
+# 2815 "src/ocaml/preprocess/parser_raw.mly"
( mkpatvar ~loc:_sloc _1 )
-# 22407 "src/ocaml/preprocess/parser_raw.ml"
+# 22461 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2781 "src/ocaml/preprocess/parser_raw.mly"
+# 2819 "src/ocaml/preprocess/parser_raw.mly"
( (_1, _2, None) )
-# 22413 "src/ocaml/preprocess/parser_raw.ml"
+# 22467 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22458,13 +22512,13 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2777 "src/ocaml/preprocess/parser_raw.mly"
+# 2815 "src/ocaml/preprocess/parser_raw.mly"
( mkpatvar ~loc:_sloc _1 )
-# 22464 "src/ocaml/preprocess/parser_raw.ml"
+# 22518 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2783 "src/ocaml/preprocess/parser_raw.mly"
+# 2821 "src/ocaml/preprocess/parser_raw.mly"
( let v = _1 in (* PR#7344 *)
let t =
match _2 with
@@ -22474,7 +22528,7 @@ module Tables = struct
in
(v, _4, Some t)
)
-# 22478 "src/ocaml/preprocess/parser_raw.ml"
+# 22532 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22546,24 +22600,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 22550 "src/ocaml/preprocess/parser_raw.ml"
+# 22604 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 22555 "src/ocaml/preprocess/parser_raw.ml"
+# 22609 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3582 "src/ocaml/preprocess/parser_raw.mly"
+# 3623 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22561 "src/ocaml/preprocess/parser_raw.ml"
+# 22615 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3586 "src/ocaml/preprocess/parser_raw.mly"
+# 3627 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_poly(_1, _3) )
-# 22567 "src/ocaml/preprocess/parser_raw.ml"
+# 22621 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__3_ = _startpos_xs_ in
@@ -22572,19 +22626,19 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2777 "src/ocaml/preprocess/parser_raw.mly"
+# 2815 "src/ocaml/preprocess/parser_raw.mly"
( mkpatvar ~loc:_sloc _1 )
-# 22578 "src/ocaml/preprocess/parser_raw.ml"
+# 22632 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2793 "src/ocaml/preprocess/parser_raw.mly"
+# 2831 "src/ocaml/preprocess/parser_raw.mly"
(
let t = ghtyp ~loc:(_loc__3_) _3 in
(_1, _5, Some (Pvc_constraint { locally_abstract_univars = []; typ=t }))
)
-# 22588 "src/ocaml/preprocess/parser_raw.ml"
+# 22642 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22657,27 +22711,27 @@ module Tables = struct
let _endpos = _endpos__8_ in
let _v : (Parsetree.pattern * Parsetree.expression *
Parsetree.value_constraint option) = let _4 =
-# 2774 "src/ocaml/preprocess/parser_raw.mly"
+# 2812 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 22663 "src/ocaml/preprocess/parser_raw.ml"
+# 22717 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2777 "src/ocaml/preprocess/parser_raw.mly"
+# 2815 "src/ocaml/preprocess/parser_raw.mly"
( mkpatvar ~loc:_sloc _1 )
-# 22672 "src/ocaml/preprocess/parser_raw.ml"
+# 22726 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2798 "src/ocaml/preprocess/parser_raw.mly"
+# 2836 "src/ocaml/preprocess/parser_raw.mly"
( let constraint' =
Pvc_constraint { locally_abstract_univars=_4; typ = _6}
in
(_1, _8, Some constraint') )
-# 22681 "src/ocaml/preprocess/parser_raw.ml"
+# 22735 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22715,9 +22769,9 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern * Parsetree.expression *
Parsetree.value_constraint option) =
-# 2803 "src/ocaml/preprocess/parser_raw.mly"
+# 2841 "src/ocaml/preprocess/parser_raw.mly"
( (_1, _3, None) )
-# 22721 "src/ocaml/preprocess/parser_raw.ml"
+# 22775 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22769,9 +22823,9 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern * Parsetree.expression *
Parsetree.value_constraint option) =
-# 2805 "src/ocaml/preprocess/parser_raw.mly"
+# 2843 "src/ocaml/preprocess/parser_raw.mly"
( (_1, _5, Some(Pvc_constraint { locally_abstract_univars=[]; typ=_3 })) )
-# 22775 "src/ocaml/preprocess/parser_raw.ml"
+# 22829 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22833,36 +22887,36 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22839 "src/ocaml/preprocess/parser_raw.ml"
+# 22893 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22848 "src/ocaml/preprocess/parser_raw.ml"
+# 22902 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2832 "src/ocaml/preprocess/parser_raw.mly"
+# 2870 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 22860 "src/ocaml/preprocess/parser_raw.ml"
+# 22914 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2822 "src/ocaml/preprocess/parser_raw.mly"
+# 2860 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22866 "src/ocaml/preprocess/parser_raw.ml"
+# 22920 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22892,9 +22946,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Ast_helper.let_bindings) =
-# 2823 "src/ocaml/preprocess/parser_raw.mly"
+# 2861 "src/ocaml/preprocess/parser_raw.mly"
( addlb _1 _2 )
-# 22898 "src/ocaml/preprocess/parser_raw.ml"
+# 22952 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -22949,41 +23003,41 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22955 "src/ocaml/preprocess/parser_raw.ml"
+# 23009 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22964 "src/ocaml/preprocess/parser_raw.ml"
+# 23018 "src/ocaml/preprocess/parser_raw.ml"
in
let ext =
-# 4234 "src/ocaml/preprocess/parser_raw.mly"
+# 4282 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 22970 "src/ocaml/preprocess/parser_raw.ml"
+# 23024 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2832 "src/ocaml/preprocess/parser_raw.mly"
+# 2870 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 22981 "src/ocaml/preprocess/parser_raw.ml"
+# 23035 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2822 "src/ocaml/preprocess/parser_raw.mly"
+# 2860 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 22987 "src/ocaml/preprocess/parser_raw.ml"
+# 23041 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23052,18 +23106,18 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23058 "src/ocaml/preprocess/parser_raw.ml"
+# 23112 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23067 "src/ocaml/preprocess/parser_raw.ml"
+# 23121 "src/ocaml/preprocess/parser_raw.ml"
in
let ext =
@@ -23072,27 +23126,27 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 4236 "src/ocaml/preprocess/parser_raw.mly"
+# 4284 "src/ocaml/preprocess/parser_raw.mly"
( not_expecting _loc "extension"; None )
-# 23078 "src/ocaml/preprocess/parser_raw.ml"
+# 23132 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2832 "src/ocaml/preprocess/parser_raw.mly"
+# 2870 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 23090 "src/ocaml/preprocess/parser_raw.ml"
+# 23144 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2822 "src/ocaml/preprocess/parser_raw.mly"
+# 2860 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23096 "src/ocaml/preprocess/parser_raw.ml"
+# 23150 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23122,9 +23176,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Ast_helper.let_bindings) =
-# 2823 "src/ocaml/preprocess/parser_raw.mly"
+# 2861 "src/ocaml/preprocess/parser_raw.mly"
( addlb _1 _2 )
-# 23128 "src/ocaml/preprocess/parser_raw.ml"
+# 23182 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23147,9 +23201,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2473 "src/ocaml/preprocess/parser_raw.mly"
+# 2491 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23153 "src/ocaml/preprocess/parser_raw.ml"
+# 23207 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23187,24 +23241,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2475 "src/ocaml/preprocess/parser_raw.mly"
+# 2493 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_constraint(_1, _3) )
-# 23193 "src/ocaml/preprocess/parser_raw.ml"
+# 23247 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 23202 "src/ocaml/preprocess/parser_raw.ml"
+# 23256 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2476 "src/ocaml/preprocess/parser_raw.mly"
+# 2494 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23208 "src/ocaml/preprocess/parser_raw.ml"
+# 23262 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23238,15 +23292,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2777 "src/ocaml/preprocess/parser_raw.mly"
+# 2815 "src/ocaml/preprocess/parser_raw.mly"
( mkpatvar ~loc:_sloc _1 )
-# 23244 "src/ocaml/preprocess/parser_raw.ml"
+# 23298 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2849 "src/ocaml/preprocess/parser_raw.mly"
+# 2887 "src/ocaml/preprocess/parser_raw.mly"
( (pat, exp) )
-# 23250 "src/ocaml/preprocess/parser_raw.ml"
+# 23304 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23272,9 +23326,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 2852 "src/ocaml/preprocess/parser_raw.mly"
+# 2890 "src/ocaml/preprocess/parser_raw.mly"
( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1) )
-# 23278 "src/ocaml/preprocess/parser_raw.ml"
+# 23332 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23325,10 +23379,10 @@ module Tables = struct
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2854 "src/ocaml/preprocess/parser_raw.mly"
+# 2892 "src/ocaml/preprocess/parser_raw.mly"
( let loc = (_startpos_pat_, _endpos_typ_) in
(ghpat ~loc (Ppat_constraint(pat, typ)), exp) )
-# 23332 "src/ocaml/preprocess/parser_raw.ml"
+# 23386 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23365,9 +23419,9 @@ module Tables = struct
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2857 "src/ocaml/preprocess/parser_raw.mly"
+# 2895 "src/ocaml/preprocess/parser_raw.mly"
( (pat, exp) )
-# 23371 "src/ocaml/preprocess/parser_raw.ml"
+# 23425 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23390,10 +23444,10 @@ module Tables = struct
let _startpos = _startpos_body_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) =
-# 2861 "src/ocaml/preprocess/parser_raw.mly"
+# 2899 "src/ocaml/preprocess/parser_raw.mly"
( let let_pat, let_exp = body in
let_pat, let_exp, [] )
-# 23397 "src/ocaml/preprocess/parser_raw.ml"
+# 23451 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23425,9 +23479,9 @@ module Tables = struct
} = _menhir_stack in
let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
let _1 : (
-# 821 "src/ocaml/preprocess/parser_raw.mly"
+# 840 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 23431 "src/ocaml/preprocess/parser_raw.ml"
+# 23485 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -23438,22 +23492,22 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 23444 "src/ocaml/preprocess/parser_raw.ml"
+# 23498 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_body_ in
let _symbolstartpos = _startpos_bindings_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2864 "src/ocaml/preprocess/parser_raw.mly"
+# 2902 "src/ocaml/preprocess/parser_raw.mly"
( let let_pat, let_exp, rev_ands = bindings in
let pbop_pat, pbop_exp = body in
let pbop_loc = make_loc _sloc in
let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
let_pat, let_exp, and_ :: rev_ands )
-# 23457 "src/ocaml/preprocess/parser_raw.ml"
+# 23511 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23471,7 +23525,7 @@ module Tables = struct
let _v : (Parsetree.class_expr Parsetree.class_infos list) =
# 211 "<standard.mly>"
( [] )
-# 23475 "src/ocaml/preprocess/parser_raw.ml"
+# 23529 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23535,9 +23589,9 @@ module Tables = struct
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 23541 "src/ocaml/preprocess/parser_raw.ml"
+# 23595 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -23550,9 +23604,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23556 "src/ocaml/preprocess/parser_raw.ml"
+# 23610 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -23562,24 +23616,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 23568 "src/ocaml/preprocess/parser_raw.ml"
+# 23622 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23576 "src/ocaml/preprocess/parser_raw.ml"
+# 23630 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2038 "src/ocaml/preprocess/parser_raw.mly"
+# 2056 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
@@ -23587,13 +23641,13 @@ module Tables = struct
let text = symbol_text _symbolstartpos in
Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
)
-# 23591 "src/ocaml/preprocess/parser_raw.ml"
+# 23645 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 23597 "src/ocaml/preprocess/parser_raw.ml"
+# 23651 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23611,7 +23665,7 @@ module Tables = struct
let _v : (Parsetree.class_type Parsetree.class_infos list) =
# 211 "<standard.mly>"
( [] )
-# 23615 "src/ocaml/preprocess/parser_raw.ml"
+# 23669 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23682,9 +23736,9 @@ module Tables = struct
let cty : (Parsetree.class_type) = Obj.magic cty in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 23688 "src/ocaml/preprocess/parser_raw.ml"
+# 23742 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -23697,9 +23751,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23703 "src/ocaml/preprocess/parser_raw.ml"
+# 23757 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -23709,24 +23763,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 23715 "src/ocaml/preprocess/parser_raw.ml"
+# 23769 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23723 "src/ocaml/preprocess/parser_raw.ml"
+# 23777 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2337 "src/ocaml/preprocess/parser_raw.mly"
+# 2355 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
@@ -23734,13 +23788,13 @@ module Tables = struct
let text = symbol_text _symbolstartpos in
Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
)
-# 23738 "src/ocaml/preprocess/parser_raw.ml"
+# 23792 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 23744 "src/ocaml/preprocess/parser_raw.ml"
+# 23798 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23758,7 +23812,7 @@ module Tables = struct
let _v : (Parsetree.class_type Parsetree.class_infos list) =
# 211 "<standard.mly>"
( [] )
-# 23762 "src/ocaml/preprocess/parser_raw.ml"
+# 23816 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23829,9 +23883,9 @@ module Tables = struct
let csig : (Parsetree.class_type) = Obj.magic csig in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 23835 "src/ocaml/preprocess/parser_raw.ml"
+# 23889 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -23844,9 +23898,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23850 "src/ocaml/preprocess/parser_raw.ml"
+# 23904 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -23856,24 +23910,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 23862 "src/ocaml/preprocess/parser_raw.ml"
+# 23916 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23870 "src/ocaml/preprocess/parser_raw.ml"
+# 23924 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2376 "src/ocaml/preprocess/parser_raw.mly"
+# 2394 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
@@ -23881,13 +23935,13 @@ module Tables = struct
let text = symbol_text _symbolstartpos in
Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
)
-# 23885 "src/ocaml/preprocess/parser_raw.ml"
+# 23939 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 23891 "src/ocaml/preprocess/parser_raw.ml"
+# 23945 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23905,7 +23959,7 @@ module Tables = struct
let _v : (Parsetree.module_binding list) =
# 211 "<standard.mly>"
( [] )
-# 23909 "src/ocaml/preprocess/parser_raw.ml"
+# 23963 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -23966,9 +24020,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23972 "src/ocaml/preprocess/parser_raw.ml"
+# 24026 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -23978,24 +24032,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 23984 "src/ocaml/preprocess/parser_raw.ml"
+# 24038 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 23992 "src/ocaml/preprocess/parser_raw.ml"
+# 24046 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1684 "src/ocaml/preprocess/parser_raw.mly"
+# 1704 "src/ocaml/preprocess/parser_raw.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
@@ -24003,13 +24057,13 @@ module Tables = struct
let text = symbol_text _symbolstartpos in
Mb.mk name body ~attrs ~loc ~text ~docs
)
-# 24007 "src/ocaml/preprocess/parser_raw.ml"
+# 24061 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24013 "src/ocaml/preprocess/parser_raw.ml"
+# 24067 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24027,7 +24081,7 @@ module Tables = struct
let _v : (Parsetree.module_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 24031 "src/ocaml/preprocess/parser_raw.ml"
+# 24085 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24095,9 +24149,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24101 "src/ocaml/preprocess/parser_raw.ml"
+# 24155 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -24107,24 +24161,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 24113 "src/ocaml/preprocess/parser_raw.ml"
+# 24167 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24121 "src/ocaml/preprocess/parser_raw.ml"
+# 24175 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1979 "src/ocaml/preprocess/parser_raw.mly"
+# 1997 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs _sloc in
@@ -24132,13 +24186,13 @@ module Tables = struct
let text = symbol_text _symbolstartpos in
Md.mk name mty ~attrs ~loc ~text ~docs
)
-# 24136 "src/ocaml/preprocess/parser_raw.ml"
+# 24190 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24142 "src/ocaml/preprocess/parser_raw.ml"
+# 24196 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24156,7 +24210,7 @@ module Tables = struct
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 24160 "src/ocaml/preprocess/parser_raw.ml"
+# 24214 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24188,7 +24242,7 @@ module Tables = struct
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 24192 "src/ocaml/preprocess/parser_raw.ml"
+# 24246 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24206,7 +24260,7 @@ module Tables = struct
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 24210 "src/ocaml/preprocess/parser_raw.ml"
+# 24264 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24271,9 +24325,9 @@ module Tables = struct
let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Location.t) list) = Obj.magic xs_inlined1 in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 24277 "src/ocaml/preprocess/parser_raw.ml"
+# 24331 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -24286,9 +24340,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24292 "src/ocaml/preprocess/parser_raw.ml"
+# 24346 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -24297,18 +24351,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 24301 "src/ocaml/preprocess/parser_raw.ml"
+# 24355 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1111 "src/ocaml/preprocess/parser_raw.mly"
+# 1131 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 24306 "src/ocaml/preprocess/parser_raw.ml"
+# 24360 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3297 "src/ocaml/preprocess/parser_raw.mly"
+# 3338 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24312 "src/ocaml/preprocess/parser_raw.ml"
+# 24366 "src/ocaml/preprocess/parser_raw.ml"
in
let id =
@@ -24317,24 +24371,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 24323 "src/ocaml/preprocess/parser_raw.ml"
+# 24377 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24331 "src/ocaml/preprocess/parser_raw.ml"
+# 24385 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3286 "src/ocaml/preprocess/parser_raw.mly"
+# 3327 "src/ocaml/preprocess/parser_raw.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
@@ -24343,13 +24397,13 @@ module Tables = struct
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 24347 "src/ocaml/preprocess/parser_raw.ml"
+# 24401 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24353 "src/ocaml/preprocess/parser_raw.ml"
+# 24407 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24367,7 +24421,7 @@ module Tables = struct
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 24371 "src/ocaml/preprocess/parser_raw.ml"
+# 24425 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24439,9 +24493,9 @@ module Tables = struct
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 24445 "src/ocaml/preprocess/parser_raw.ml"
+# 24499 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -24454,9 +24508,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24460 "src/ocaml/preprocess/parser_raw.ml"
+# 24514 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
@@ -24465,26 +24519,26 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 24469 "src/ocaml/preprocess/parser_raw.ml"
+# 24523 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1111 "src/ocaml/preprocess/parser_raw.mly"
+# 1131 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 24474 "src/ocaml/preprocess/parser_raw.ml"
+# 24528 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3297 "src/ocaml/preprocess/parser_raw.mly"
+# 3338 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24480 "src/ocaml/preprocess/parser_raw.ml"
+# 24534 "src/ocaml/preprocess/parser_raw.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 3332 "src/ocaml/preprocess/parser_raw.mly"
+# 3373 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 24488 "src/ocaml/preprocess/parser_raw.ml"
+# 24542 "src/ocaml/preprocess/parser_raw.ml"
in
let id =
@@ -24493,24 +24547,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 24499 "src/ocaml/preprocess/parser_raw.ml"
+# 24553 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24507 "src/ocaml/preprocess/parser_raw.ml"
+# 24561 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3286 "src/ocaml/preprocess/parser_raw.mly"
+# 3327 "src/ocaml/preprocess/parser_raw.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
@@ -24519,13 +24573,13 @@ module Tables = struct
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 24523 "src/ocaml/preprocess/parser_raw.ml"
+# 24577 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24529 "src/ocaml/preprocess/parser_raw.ml"
+# 24583 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24543,7 +24597,7 @@ module Tables = struct
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 24547 "src/ocaml/preprocess/parser_raw.ml"
+# 24601 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24575,7 +24629,7 @@ module Tables = struct
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 24579 "src/ocaml/preprocess/parser_raw.ml"
+# 24633 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24593,7 +24647,7 @@ module Tables = struct
let _v : (Parsetree.signature_item list list) =
# 211 "<standard.mly>"
( [] )
-# 24597 "src/ocaml/preprocess/parser_raw.ml"
+# 24651 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24626,21 +24680,21 @@ module Tables = struct
let _1 =
let _startpos = _startpos__1_ in
-# 1037 "src/ocaml/preprocess/parser_raw.mly"
+# 1057 "src/ocaml/preprocess/parser_raw.mly"
( text_sig _startpos )
-# 24632 "src/ocaml/preprocess/parser_raw.ml"
+# 24686 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1832 "src/ocaml/preprocess/parser_raw.mly"
+# 1850 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24638 "src/ocaml/preprocess/parser_raw.ml"
+# 24692 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24644 "src/ocaml/preprocess/parser_raw.ml"
+# 24698 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24673,21 +24727,21 @@ module Tables = struct
let _1 =
let _startpos = _startpos__1_ in
-# 1035 "src/ocaml/preprocess/parser_raw.mly"
+# 1055 "src/ocaml/preprocess/parser_raw.mly"
( text_sig _startpos @ [_1] )
-# 24679 "src/ocaml/preprocess/parser_raw.ml"
+# 24733 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1832 "src/ocaml/preprocess/parser_raw.mly"
+# 1850 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24685 "src/ocaml/preprocess/parser_raw.ml"
+# 24739 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24691 "src/ocaml/preprocess/parser_raw.ml"
+# 24745 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24705,7 +24759,7 @@ module Tables = struct
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 24709 "src/ocaml/preprocess/parser_raw.ml"
+# 24763 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24738,40 +24792,40 @@ module Tables = struct
let _1 =
let ys =
let items =
-# 1097 "src/ocaml/preprocess/parser_raw.mly"
+# 1117 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 24744 "src/ocaml/preprocess/parser_raw.ml"
+# 24798 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1563 "src/ocaml/preprocess/parser_raw.mly"
+# 1583 "src/ocaml/preprocess/parser_raw.mly"
( items )
-# 24749 "src/ocaml/preprocess/parser_raw.ml"
+# 24803 "src/ocaml/preprocess/parser_raw.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 1033 "src/ocaml/preprocess/parser_raw.mly"
+# 1053 "src/ocaml/preprocess/parser_raw.mly"
( text_str _startpos )
-# 24757 "src/ocaml/preprocess/parser_raw.ml"
+# 24811 "src/ocaml/preprocess/parser_raw.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 24763 "src/ocaml/preprocess/parser_raw.ml"
+# 24817 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1579 "src/ocaml/preprocess/parser_raw.mly"
+# 1599 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24769 "src/ocaml/preprocess/parser_raw.ml"
+# 24823 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24775 "src/ocaml/preprocess/parser_raw.ml"
+# 24829 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24823,70 +24877,70 @@ module Tables = struct
let _1 =
let _1 =
let attrs =
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24829 "src/ocaml/preprocess/parser_raw.ml"
+# 24883 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1570 "src/ocaml/preprocess/parser_raw.mly"
+# 1590 "src/ocaml/preprocess/parser_raw.mly"
( mkstrexp e attrs )
-# 24834 "src/ocaml/preprocess/parser_raw.ml"
+# 24888 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 1031 "src/ocaml/preprocess/parser_raw.mly"
+# 1051 "src/ocaml/preprocess/parser_raw.mly"
( text_str _startpos @ [_1] )
-# 24842 "src/ocaml/preprocess/parser_raw.ml"
+# 24896 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1050 "src/ocaml/preprocess/parser_raw.mly"
+# 1070 "src/ocaml/preprocess/parser_raw.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 24852 "src/ocaml/preprocess/parser_raw.ml"
+# 24906 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1099 "src/ocaml/preprocess/parser_raw.mly"
+# 1119 "src/ocaml/preprocess/parser_raw.mly"
( x )
-# 24858 "src/ocaml/preprocess/parser_raw.ml"
+# 24912 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1563 "src/ocaml/preprocess/parser_raw.mly"
+# 1583 "src/ocaml/preprocess/parser_raw.mly"
( items )
-# 24864 "src/ocaml/preprocess/parser_raw.ml"
+# 24918 "src/ocaml/preprocess/parser_raw.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 1033 "src/ocaml/preprocess/parser_raw.mly"
+# 1053 "src/ocaml/preprocess/parser_raw.mly"
( text_str _startpos )
-# 24872 "src/ocaml/preprocess/parser_raw.ml"
+# 24926 "src/ocaml/preprocess/parser_raw.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 24878 "src/ocaml/preprocess/parser_raw.ml"
+# 24932 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1579 "src/ocaml/preprocess/parser_raw.mly"
+# 1599 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24884 "src/ocaml/preprocess/parser_raw.ml"
+# 24938 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24890 "src/ocaml/preprocess/parser_raw.ml"
+# 24944 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24919,21 +24973,21 @@ module Tables = struct
let _1 =
let _startpos = _startpos__1_ in
-# 1031 "src/ocaml/preprocess/parser_raw.mly"
+# 1051 "src/ocaml/preprocess/parser_raw.mly"
( text_str _startpos @ [_1] )
-# 24925 "src/ocaml/preprocess/parser_raw.ml"
+# 24979 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1579 "src/ocaml/preprocess/parser_raw.mly"
+# 1599 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 24931 "src/ocaml/preprocess/parser_raw.ml"
+# 24985 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24937 "src/ocaml/preprocess/parser_raw.ml"
+# 24991 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24951,7 +25005,7 @@ module Tables = struct
let _v : (Parsetree.class_type_field list list) =
# 211 "<standard.mly>"
( [] )
-# 24955 "src/ocaml/preprocess/parser_raw.ml"
+# 25009 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -24983,15 +25037,15 @@ module Tables = struct
let _v : (Parsetree.class_type_field list list) = let x =
let _startpos = _startpos__1_ in
-# 1045 "src/ocaml/preprocess/parser_raw.mly"
+# 1065 "src/ocaml/preprocess/parser_raw.mly"
( text_csig _startpos @ [_1] )
-# 24989 "src/ocaml/preprocess/parser_raw.ml"
+# 25043 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 24995 "src/ocaml/preprocess/parser_raw.ml"
+# 25049 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25009,7 +25063,7 @@ module Tables = struct
let _v : (Parsetree.class_field list list) =
# 211 "<standard.mly>"
( [] )
-# 25013 "src/ocaml/preprocess/parser_raw.ml"
+# 25067 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25041,15 +25095,15 @@ module Tables = struct
let _v : (Parsetree.class_field list list) = let x =
let _startpos = _startpos__1_ in
-# 1043 "src/ocaml/preprocess/parser_raw.mly"
+# 1063 "src/ocaml/preprocess/parser_raw.mly"
( text_cstr _startpos @ [_1] )
-# 25047 "src/ocaml/preprocess/parser_raw.ml"
+# 25101 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 25053 "src/ocaml/preprocess/parser_raw.ml"
+# 25107 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25067,7 +25121,7 @@ module Tables = struct
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 25071 "src/ocaml/preprocess/parser_raw.ml"
+# 25125 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25099,15 +25153,15 @@ module Tables = struct
let _v : (Parsetree.structure_item list list) = let x =
let _startpos = _startpos__1_ in
-# 1031 "src/ocaml/preprocess/parser_raw.mly"
+# 1051 "src/ocaml/preprocess/parser_raw.mly"
( text_str _startpos @ [_1] )
-# 25105 "src/ocaml/preprocess/parser_raw.ml"
+# 25159 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 25111 "src/ocaml/preprocess/parser_raw.ml"
+# 25165 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25125,7 +25179,7 @@ module Tables = struct
let _v : (Parsetree.toplevel_phrase list list) =
# 211 "<standard.mly>"
( [] )
-# 25129 "src/ocaml/preprocess/parser_raw.ml"
+# 25183 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25158,32 +25212,32 @@ module Tables = struct
let _1 =
let x =
let _1 =
-# 1097 "src/ocaml/preprocess/parser_raw.mly"
+# 1117 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 25164 "src/ocaml/preprocess/parser_raw.ml"
+# 25218 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1350 "src/ocaml/preprocess/parser_raw.mly"
+# 1370 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25169 "src/ocaml/preprocess/parser_raw.ml"
+# 25223 "src/ocaml/preprocess/parser_raw.ml"
in
# 183 "<standard.mly>"
( x )
-# 25175 "src/ocaml/preprocess/parser_raw.ml"
+# 25229 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1362 "src/ocaml/preprocess/parser_raw.mly"
+# 1382 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25181 "src/ocaml/preprocess/parser_raw.ml"
+# 25235 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 25187 "src/ocaml/preprocess/parser_raw.ml"
+# 25241 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25235,58 +25289,58 @@ module Tables = struct
let _1 =
let _1 =
let attrs =
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25241 "src/ocaml/preprocess/parser_raw.ml"
+# 25295 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1570 "src/ocaml/preprocess/parser_raw.mly"
+# 1590 "src/ocaml/preprocess/parser_raw.mly"
( mkstrexp e attrs )
-# 25246 "src/ocaml/preprocess/parser_raw.ml"
+# 25300 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1041 "src/ocaml/preprocess/parser_raw.mly"
+# 1061 "src/ocaml/preprocess/parser_raw.mly"
( Ptop_def [_1] )
-# 25252 "src/ocaml/preprocess/parser_raw.ml"
+# 25306 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 1039 "src/ocaml/preprocess/parser_raw.mly"
+# 1059 "src/ocaml/preprocess/parser_raw.mly"
( text_def _startpos @ [_1] )
-# 25260 "src/ocaml/preprocess/parser_raw.ml"
+# 25314 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1099 "src/ocaml/preprocess/parser_raw.mly"
+# 1119 "src/ocaml/preprocess/parser_raw.mly"
( x )
-# 25266 "src/ocaml/preprocess/parser_raw.ml"
+# 25320 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1350 "src/ocaml/preprocess/parser_raw.mly"
+# 1370 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25272 "src/ocaml/preprocess/parser_raw.ml"
+# 25326 "src/ocaml/preprocess/parser_raw.ml"
in
# 183 "<standard.mly>"
( x )
-# 25278 "src/ocaml/preprocess/parser_raw.ml"
+# 25332 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1362 "src/ocaml/preprocess/parser_raw.mly"
+# 1382 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25284 "src/ocaml/preprocess/parser_raw.ml"
+# 25338 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 25290 "src/ocaml/preprocess/parser_raw.ml"
+# 25344 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25318,27 +25372,27 @@ module Tables = struct
let _v : (Parsetree.toplevel_phrase list list) = let x =
let _1 =
let _1 =
-# 1041 "src/ocaml/preprocess/parser_raw.mly"
+# 1061 "src/ocaml/preprocess/parser_raw.mly"
( Ptop_def [_1] )
-# 25324 "src/ocaml/preprocess/parser_raw.ml"
+# 25378 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos = _startpos__1_ in
-# 1039 "src/ocaml/preprocess/parser_raw.mly"
+# 1059 "src/ocaml/preprocess/parser_raw.mly"
( text_def _startpos @ [_1] )
-# 25330 "src/ocaml/preprocess/parser_raw.ml"
+# 25384 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1362 "src/ocaml/preprocess/parser_raw.mly"
+# 1382 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25336 "src/ocaml/preprocess/parser_raw.ml"
+# 25390 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 25342 "src/ocaml/preprocess/parser_raw.ml"
+# 25396 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25373,29 +25427,29 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1050 "src/ocaml/preprocess/parser_raw.mly"
+# 1070 "src/ocaml/preprocess/parser_raw.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 25380 "src/ocaml/preprocess/parser_raw.ml"
+# 25434 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos = _startpos__1_ in
-# 1039 "src/ocaml/preprocess/parser_raw.mly"
+# 1059 "src/ocaml/preprocess/parser_raw.mly"
( text_def _startpos @ [_1] )
-# 25387 "src/ocaml/preprocess/parser_raw.ml"
+# 25441 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1362 "src/ocaml/preprocess/parser_raw.mly"
+# 1382 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25393 "src/ocaml/preprocess/parser_raw.ml"
+# 25447 "src/ocaml/preprocess/parser_raw.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 25399 "src/ocaml/preprocess/parser_raw.ml"
+# 25453 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25434,7 +25488,7 @@ module Tables = struct
let _v : ((Longident.t Location.loc * Parsetree.pattern) list * unit option) = let _2 =
# 124 "<standard.mly>"
( None )
-# 25438 "src/ocaml/preprocess/parser_raw.ml"
+# 25492 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let label =
@@ -25442,9 +25496,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 25448 "src/ocaml/preprocess/parser_raw.ml"
+# 25502 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_label_ = _startpos__1_ in
@@ -25452,7 +25506,7 @@ module Tables = struct
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3172 "src/ocaml/preprocess/parser_raw.mly"
+# 3213 "src/ocaml/preprocess/parser_raw.mly"
( let constraint_loc, label, pat =
match opat with
| None ->
@@ -25466,13 +25520,13 @@ module Tables = struct
in
label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 25470 "src/ocaml/preprocess/parser_raw.ml"
+# 25524 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1287 "src/ocaml/preprocess/parser_raw.mly"
+# 1307 "src/ocaml/preprocess/parser_raw.mly"
( [x], None )
-# 25476 "src/ocaml/preprocess/parser_raw.ml"
+# 25530 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25518,7 +25572,7 @@ module Tables = struct
let _v : ((Longident.t Location.loc * Parsetree.pattern) list * unit option) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 25522 "src/ocaml/preprocess/parser_raw.ml"
+# 25576 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let label =
@@ -25526,9 +25580,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 25532 "src/ocaml/preprocess/parser_raw.ml"
+# 25586 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_label_ = _startpos__1_ in
@@ -25536,7 +25590,7 @@ module Tables = struct
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3172 "src/ocaml/preprocess/parser_raw.mly"
+# 3213 "src/ocaml/preprocess/parser_raw.mly"
( let constraint_loc, label, pat =
match opat with
| None ->
@@ -25550,13 +25604,13 @@ module Tables = struct
in
label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 25554 "src/ocaml/preprocess/parser_raw.ml"
+# 25608 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1287 "src/ocaml/preprocess/parser_raw.mly"
+# 1307 "src/ocaml/preprocess/parser_raw.mly"
( [x], None )
-# 25560 "src/ocaml/preprocess/parser_raw.ml"
+# 25614 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25619,9 +25673,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 25625 "src/ocaml/preprocess/parser_raw.ml"
+# 25679 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_label_ = _startpos__1_ in
@@ -25629,7 +25683,7 @@ module Tables = struct
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3172 "src/ocaml/preprocess/parser_raw.mly"
+# 3213 "src/ocaml/preprocess/parser_raw.mly"
( let constraint_loc, label, pat =
match opat with
| None ->
@@ -25643,13 +25697,13 @@ module Tables = struct
in
label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 25647 "src/ocaml/preprocess/parser_raw.ml"
+# 25701 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1289 "src/ocaml/preprocess/parser_raw.mly"
+# 1309 "src/ocaml/preprocess/parser_raw.mly"
( [x], Some y )
-# 25653 "src/ocaml/preprocess/parser_raw.ml"
+# 25707 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25705,9 +25759,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 25711 "src/ocaml/preprocess/parser_raw.ml"
+# 25765 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_label_ = _startpos__1_ in
@@ -25715,7 +25769,7 @@ module Tables = struct
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3172 "src/ocaml/preprocess/parser_raw.mly"
+# 3213 "src/ocaml/preprocess/parser_raw.mly"
( let constraint_loc, label, pat =
match opat with
| None ->
@@ -25729,14 +25783,14 @@ module Tables = struct
in
label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 25733 "src/ocaml/preprocess/parser_raw.ml"
+# 25787 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1293 "src/ocaml/preprocess/parser_raw.mly"
+# 1313 "src/ocaml/preprocess/parser_raw.mly"
( let xs, y = tail in
x :: xs, y )
-# 25740 "src/ocaml/preprocess/parser_raw.ml"
+# 25794 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25773,9 +25827,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) =
-# 2897 "src/ocaml/preprocess/parser_raw.mly"
+# 2935 "src/ocaml/preprocess/parser_raw.mly"
( Exp.case _1 (merloc _endpos__2_ _3) )
-# 25779 "src/ocaml/preprocess/parser_raw.ml"
+# 25833 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25826,9 +25880,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.case) =
-# 2899 "src/ocaml/preprocess/parser_raw.mly"
+# 2937 "src/ocaml/preprocess/parser_raw.mly"
( Exp.case _1 ~guard:(merloc _endpos__2_ _3) (merloc _endpos__4_ _5) )
-# 25832 "src/ocaml/preprocess/parser_raw.ml"
+# 25886 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25866,10 +25920,10 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2901 "src/ocaml/preprocess/parser_raw.mly"
+# 2939 "src/ocaml/preprocess/parser_raw.mly"
( Exp.case _1 (merloc _endpos__2_
(Exp.unreachable ~loc:(make_loc _loc__3_) ())) )
-# 25873 "src/ocaml/preprocess/parser_raw.ml"
+# 25927 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -25930,9 +25984,9 @@ module Tables = struct
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 25936 "src/ocaml/preprocess/parser_raw.ml"
+# 25990 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -25941,49 +25995,49 @@ module Tables = struct
let _6 =
let _1 = _1_inlined3 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25947 "src/ocaml/preprocess/parser_raw.ml"
+# 26001 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25956 "src/ocaml/preprocess/parser_raw.ml"
+# 26010 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3600 "src/ocaml/preprocess/parser_raw.mly"
+# 3641 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25965 "src/ocaml/preprocess/parser_raw.ml"
+# 26019 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 25972 "src/ocaml/preprocess/parser_raw.ml"
+# 26026 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 25980 "src/ocaml/preprocess/parser_raw.ml"
+# 26034 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3866 "src/ocaml/preprocess/parser_raw.mly"
+# 3907 "src/ocaml/preprocess/parser_raw.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
@@ -25991,13 +26045,13 @@ module Tables = struct
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 25995 "src/ocaml/preprocess/parser_raw.ml"
+# 26049 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3847 "src/ocaml/preprocess/parser_raw.mly"
+# 3888 "src/ocaml/preprocess/parser_raw.mly"
( let (f, c) = tail in (head :: f, c) )
-# 26001 "src/ocaml/preprocess/parser_raw.ml"
+# 26055 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26038,15 +26092,15 @@ module Tables = struct
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3877 "src/ocaml/preprocess/parser_raw.mly"
+# 3918 "src/ocaml/preprocess/parser_raw.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 26044 "src/ocaml/preprocess/parser_raw.ml"
+# 26098 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3847 "src/ocaml/preprocess/parser_raw.mly"
+# 3888 "src/ocaml/preprocess/parser_raw.mly"
( let (f, c) = tail in (head :: f, c) )
-# 26050 "src/ocaml/preprocess/parser_raw.ml"
+# 26104 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26100,9 +26154,9 @@ module Tables = struct
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26106 "src/ocaml/preprocess/parser_raw.ml"
+# 26160 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -26111,49 +26165,49 @@ module Tables = struct
let _6 =
let _1 = _1_inlined3 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26117 "src/ocaml/preprocess/parser_raw.ml"
+# 26171 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26126 "src/ocaml/preprocess/parser_raw.ml"
+# 26180 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3600 "src/ocaml/preprocess/parser_raw.mly"
+# 3641 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26135 "src/ocaml/preprocess/parser_raw.ml"
+# 26189 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26142 "src/ocaml/preprocess/parser_raw.ml"
+# 26196 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26150 "src/ocaml/preprocess/parser_raw.ml"
+# 26204 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3866 "src/ocaml/preprocess/parser_raw.mly"
+# 3907 "src/ocaml/preprocess/parser_raw.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
@@ -26161,13 +26215,13 @@ module Tables = struct
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 26165 "src/ocaml/preprocess/parser_raw.ml"
+# 26219 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3850 "src/ocaml/preprocess/parser_raw.mly"
+# 3891 "src/ocaml/preprocess/parser_raw.mly"
( [head], Closed )
-# 26171 "src/ocaml/preprocess/parser_raw.ml"
+# 26225 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26201,15 +26255,15 @@ module Tables = struct
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3877 "src/ocaml/preprocess/parser_raw.mly"
+# 3918 "src/ocaml/preprocess/parser_raw.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 26207 "src/ocaml/preprocess/parser_raw.ml"
+# 26261 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3850 "src/ocaml/preprocess/parser_raw.mly"
+# 3891 "src/ocaml/preprocess/parser_raw.mly"
( [head], Closed )
-# 26213 "src/ocaml/preprocess/parser_raw.ml"
+# 26267 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26249,9 +26303,9 @@ module Tables = struct
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26255 "src/ocaml/preprocess/parser_raw.ml"
+# 26309 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -26260,50 +26314,50 @@ module Tables = struct
let _4 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26266 "src/ocaml/preprocess/parser_raw.ml"
+# 26320 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3600 "src/ocaml/preprocess/parser_raw.mly"
+# 3641 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26275 "src/ocaml/preprocess/parser_raw.ml"
+# 26329 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26282 "src/ocaml/preprocess/parser_raw.ml"
+# 26336 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26290 "src/ocaml/preprocess/parser_raw.ml"
+# 26344 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3859 "src/ocaml/preprocess/parser_raw.mly"
+# 3900 "src/ocaml/preprocess/parser_raw.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _4 in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 26301 "src/ocaml/preprocess/parser_raw.ml"
+# 26355 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3853 "src/ocaml/preprocess/parser_raw.mly"
+# 3894 "src/ocaml/preprocess/parser_raw.mly"
( [head], Closed )
-# 26307 "src/ocaml/preprocess/parser_raw.ml"
+# 26361 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26330,15 +26384,15 @@ module Tables = struct
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3877 "src/ocaml/preprocess/parser_raw.mly"
+# 3918 "src/ocaml/preprocess/parser_raw.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 26336 "src/ocaml/preprocess/parser_raw.ml"
+# 26390 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3853 "src/ocaml/preprocess/parser_raw.mly"
+# 3894 "src/ocaml/preprocess/parser_raw.mly"
( [head], Closed )
-# 26342 "src/ocaml/preprocess/parser_raw.ml"
+# 26396 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26361,9 +26415,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.object_field list * Asttypes.closed_flag) =
-# 3855 "src/ocaml/preprocess/parser_raw.mly"
+# 3896 "src/ocaml/preprocess/parser_raw.mly"
( [], Open )
-# 26367 "src/ocaml/preprocess/parser_raw.ml"
+# 26421 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26408,9 +26462,9 @@ module Tables = struct
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26414 "src/ocaml/preprocess/parser_raw.ml"
+# 26468 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let private_ : (Asttypes.private_flag) = Obj.magic private_ in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
@@ -26421,41 +26475,41 @@ module Tables = struct
Parsetree.attributes) = let ty =
let _1 = _1_inlined2 in
-# 3596 "src/ocaml/preprocess/parser_raw.mly"
+# 3637 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26427 "src/ocaml/preprocess/parser_raw.ml"
+# 26481 "src/ocaml/preprocess/parser_raw.ml"
in
let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26435 "src/ocaml/preprocess/parser_raw.ml"
+# 26489 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26443 "src/ocaml/preprocess/parser_raw.ml"
+# 26497 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26449 "src/ocaml/preprocess/parser_raw.ml"
+# 26503 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4126 "src/ocaml/preprocess/parser_raw.mly"
+# 4174 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 26454 "src/ocaml/preprocess/parser_raw.ml"
+# 26508 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2182 "src/ocaml/preprocess/parser_raw.mly"
+# 2200 "src/ocaml/preprocess/parser_raw.mly"
( (label, private_, Cfk_virtual ty), attrs )
-# 26459 "src/ocaml/preprocess/parser_raw.ml"
+# 26513 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26493,9 +26547,9 @@ module Tables = struct
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26499 "src/ocaml/preprocess/parser_raw.ml"
+# 26553 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
@@ -26506,36 +26560,36 @@ module Tables = struct
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26512 "src/ocaml/preprocess/parser_raw.ml"
+# 26566 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26520 "src/ocaml/preprocess/parser_raw.ml"
+# 26574 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26526 "src/ocaml/preprocess/parser_raw.ml"
+# 26580 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 26531 "src/ocaml/preprocess/parser_raw.ml"
+# 26585 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2184 "src/ocaml/preprocess/parser_raw.mly"
+# 2202 "src/ocaml/preprocess/parser_raw.mly"
( let e = _5 in
let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
(_4, _3,
Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 26539 "src/ocaml/preprocess/parser_raw.ml"
+# 26593 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26579,9 +26633,9 @@ module Tables = struct
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26585 "src/ocaml/preprocess/parser_raw.ml"
+# 26639 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -26593,39 +26647,39 @@ module Tables = struct
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26599 "src/ocaml/preprocess/parser_raw.ml"
+# 26653 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26607 "src/ocaml/preprocess/parser_raw.ml"
+# 26661 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26615 "src/ocaml/preprocess/parser_raw.ml"
+# 26669 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 26621 "src/ocaml/preprocess/parser_raw.ml"
+# 26675 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2184 "src/ocaml/preprocess/parser_raw.mly"
+# 2202 "src/ocaml/preprocess/parser_raw.mly"
( let e = _5 in
let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
(_4, _3,
Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 26629 "src/ocaml/preprocess/parser_raw.ml"
+# 26683 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26684,9 +26738,9 @@ module Tables = struct
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26690 "src/ocaml/preprocess/parser_raw.ml"
+# 26744 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
@@ -26697,45 +26751,45 @@ module Tables = struct
Parsetree.attributes) = let _6 =
let _1 = _1_inlined2 in
-# 3596 "src/ocaml/preprocess/parser_raw.mly"
+# 3637 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26703 "src/ocaml/preprocess/parser_raw.ml"
+# 26757 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__6_ = _startpos__1_inlined2_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26712 "src/ocaml/preprocess/parser_raw.ml"
+# 26766 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26720 "src/ocaml/preprocess/parser_raw.ml"
+# 26774 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26726 "src/ocaml/preprocess/parser_raw.ml"
+# 26780 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 26731 "src/ocaml/preprocess/parser_raw.ml"
+# 26785 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2190 "src/ocaml/preprocess/parser_raw.mly"
+# 2208 "src/ocaml/preprocess/parser_raw.mly"
( let poly_exp =
let loc = (_startpos__6_, _endpos__8_) in
ghexp ~loc (Pexp_poly(_8, Some _6)) in
(_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 26739 "src/ocaml/preprocess/parser_raw.ml"
+# 26793 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26800,9 +26854,9 @@ module Tables = struct
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26806 "src/ocaml/preprocess/parser_raw.ml"
+# 26860 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -26814,48 +26868,48 @@ module Tables = struct
Parsetree.attributes) = let _6 =
let _1 = _1_inlined3 in
-# 3596 "src/ocaml/preprocess/parser_raw.mly"
+# 3637 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26820 "src/ocaml/preprocess/parser_raw.ml"
+# 26874 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__6_ = _startpos__1_inlined3_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26829 "src/ocaml/preprocess/parser_raw.ml"
+# 26883 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26837 "src/ocaml/preprocess/parser_raw.ml"
+# 26891 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26845 "src/ocaml/preprocess/parser_raw.ml"
+# 26899 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 26851 "src/ocaml/preprocess/parser_raw.ml"
+# 26905 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2190 "src/ocaml/preprocess/parser_raw.mly"
+# 2208 "src/ocaml/preprocess/parser_raw.mly"
( let poly_exp =
let loc = (_startpos__6_, _endpos__8_) in
ghexp ~loc (Pexp_poly(_8, Some _6)) in
(_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 26859 "src/ocaml/preprocess/parser_raw.ml"
+# 26913 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -26935,9 +26989,9 @@ module Tables = struct
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 26941 "src/ocaml/preprocess/parser_raw.ml"
+# 26995 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
@@ -26946,38 +27000,38 @@ module Tables = struct
let _endpos = _endpos__11_ in
let _v : ((string Location.loc * Asttypes.private_flag * Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2774 "src/ocaml/preprocess/parser_raw.mly"
+# 2812 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 26952 "src/ocaml/preprocess/parser_raw.ml"
+# 27006 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__7_ = _startpos_xs_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26960 "src/ocaml/preprocess/parser_raw.ml"
+# 27014 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 26968 "src/ocaml/preprocess/parser_raw.ml"
+# 27022 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 26975 "src/ocaml/preprocess/parser_raw.ml"
+# 27029 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 26981 "src/ocaml/preprocess/parser_raw.ml"
+# 27035 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__11_ in
@@ -26993,7 +27047,7 @@ module Tables = struct
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2196 "src/ocaml/preprocess/parser_raw.mly"
+# 2214 "src/ocaml/preprocess/parser_raw.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
@@ -27004,7 +27058,7 @@ module Tables = struct
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 27008 "src/ocaml/preprocess/parser_raw.ml"
+# 27062 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27090,9 +27144,9 @@ module Tables = struct
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27096 "src/ocaml/preprocess/parser_raw.ml"
+# 27150 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -27102,41 +27156,41 @@ module Tables = struct
let _endpos = _endpos__11_ in
let _v : ((string Location.loc * Asttypes.private_flag * Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2774 "src/ocaml/preprocess/parser_raw.mly"
+# 2812 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 27108 "src/ocaml/preprocess/parser_raw.ml"
+# 27162 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__7_ = _startpos_xs_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27116 "src/ocaml/preprocess/parser_raw.ml"
+# 27170 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 27124 "src/ocaml/preprocess/parser_raw.ml"
+# 27178 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27133 "src/ocaml/preprocess/parser_raw.ml"
+# 27187 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 27140 "src/ocaml/preprocess/parser_raw.ml"
+# 27194 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__11_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
@@ -27151,7 +27205,7 @@ module Tables = struct
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2196 "src/ocaml/preprocess/parser_raw.mly"
+# 2214 "src/ocaml/preprocess/parser_raw.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
@@ -27162,7 +27216,7 @@ module Tables = struct
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 27166 "src/ocaml/preprocess/parser_raw.ml"
+# 27220 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27181,17 +27235,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27187 "src/ocaml/preprocess/parser_raw.ml"
+# 27241 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27195 "src/ocaml/preprocess/parser_raw.ml"
+# 27249 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27222,9 +27276,9 @@ module Tables = struct
};
} = _menhir_stack in
let _3 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27228 "src/ocaml/preprocess/parser_raw.ml"
+# 27282 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
@@ -27232,9 +27286,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27238 "src/ocaml/preprocess/parser_raw.ml"
+# 27292 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27253,17 +27307,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27259 "src/ocaml/preprocess/parser_raw.ml"
+# 27313 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27267 "src/ocaml/preprocess/parser_raw.ml"
+# 27321 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27294,9 +27348,9 @@ module Tables = struct
};
} = _menhir_stack in
let _3 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27300 "src/ocaml/preprocess/parser_raw.ml"
+# 27354 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
@@ -27304,9 +27358,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27310 "src/ocaml/preprocess/parser_raw.ml"
+# 27364 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27329,14 +27383,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) = let _1 =
-# 4020 "src/ocaml/preprocess/parser_raw.mly"
+# 4068 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27335 "src/ocaml/preprocess/parser_raw.ml"
+# 27389 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27340 "src/ocaml/preprocess/parser_raw.ml"
+# 27394 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27374,20 +27428,20 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _1 =
let _1 =
-# 3960 "src/ocaml/preprocess/parser_raw.mly"
+# 4008 "src/ocaml/preprocess/parser_raw.mly"
( "::" )
-# 27380 "src/ocaml/preprocess/parser_raw.ml"
+# 27434 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4020 "src/ocaml/preprocess/parser_raw.mly"
+# 4068 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27385 "src/ocaml/preprocess/parser_raw.ml"
+# 27439 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27391 "src/ocaml/preprocess/parser_raw.ml"
+# 27445 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27410,14 +27464,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) = let _1 =
-# 4020 "src/ocaml/preprocess/parser_raw.mly"
+# 4068 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27416 "src/ocaml/preprocess/parser_raw.ml"
+# 27470 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27421 "src/ocaml/preprocess/parser_raw.ml"
+# 27475 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27456,15 +27510,15 @@ module Tables = struct
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 4020 "src/ocaml/preprocess/parser_raw.mly"
+# 4068 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27462 "src/ocaml/preprocess/parser_raw.ml"
+# 27516 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27468 "src/ocaml/preprocess/parser_raw.ml"
+# 27522 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27517,20 +27571,20 @@ module Tables = struct
let _v : (Longident.t) = let _3 =
let (_2, _1) = (_2_inlined1, _1_inlined1) in
let _1 =
-# 3960 "src/ocaml/preprocess/parser_raw.mly"
+# 4008 "src/ocaml/preprocess/parser_raw.mly"
( "::" )
-# 27523 "src/ocaml/preprocess/parser_raw.ml"
+# 27577 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4020 "src/ocaml/preprocess/parser_raw.mly"
+# 4068 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27528 "src/ocaml/preprocess/parser_raw.ml"
+# 27582 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27534 "src/ocaml/preprocess/parser_raw.ml"
+# 27588 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27569,15 +27623,15 @@ module Tables = struct
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 4020 "src/ocaml/preprocess/parser_raw.mly"
+# 4068 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27575 "src/ocaml/preprocess/parser_raw.ml"
+# 27629 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27581 "src/ocaml/preprocess/parser_raw.ml"
+# 27635 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27600,9 +27654,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27606 "src/ocaml/preprocess/parser_raw.ml"
+# 27660 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27639,9 +27693,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27645 "src/ocaml/preprocess/parser_raw.ml"
+# 27699 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27660,17 +27714,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27666 "src/ocaml/preprocess/parser_raw.ml"
+# 27720 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27674 "src/ocaml/preprocess/parser_raw.ml"
+# 27728 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27701,9 +27755,9 @@ module Tables = struct
};
} = _menhir_stack in
let _3 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27707 "src/ocaml/preprocess/parser_raw.ml"
+# 27761 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
@@ -27711,9 +27765,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27717 "src/ocaml/preprocess/parser_raw.ml"
+# 27771 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27732,17 +27786,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27738 "src/ocaml/preprocess/parser_raw.ml"
+# 27792 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27746 "src/ocaml/preprocess/parser_raw.ml"
+# 27800 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27773,9 +27827,9 @@ module Tables = struct
};
} = _menhir_stack in
let _3 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 27779 "src/ocaml/preprocess/parser_raw.ml"
+# 27833 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
@@ -27783,9 +27837,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27789 "src/ocaml/preprocess/parser_raw.ml"
+# 27843 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27808,9 +27862,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3980 "src/ocaml/preprocess/parser_raw.mly"
+# 4028 "src/ocaml/preprocess/parser_raw.mly"
( Lident _1 )
-# 27814 "src/ocaml/preprocess/parser_raw.ml"
+# 27868 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27847,9 +27901,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3981 "src/ocaml/preprocess/parser_raw.mly"
+# 4029 "src/ocaml/preprocess/parser_raw.mly"
( Ldot(_1,_3) )
-# 27853 "src/ocaml/preprocess/parser_raw.ml"
+# 27907 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27872,9 +27926,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3996 "src/ocaml/preprocess/parser_raw.mly"
+# 4044 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27878 "src/ocaml/preprocess/parser_raw.ml"
+# 27932 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27921,9 +27975,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3998 "src/ocaml/preprocess/parser_raw.mly"
+# 4046 "src/ocaml/preprocess/parser_raw.mly"
( lapply ~loc:_sloc _1 _3 )
-# 27927 "src/ocaml/preprocess/parser_raw.ml"
+# 27981 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27946,9 +28000,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3993 "src/ocaml/preprocess/parser_raw.mly"
+# 4041 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 27952 "src/ocaml/preprocess/parser_raw.ml"
+# 28006 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -27978,9 +28032,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1639 "src/ocaml/preprocess/parser_raw.mly"
+# 1659 "src/ocaml/preprocess/parser_raw.mly"
( me )
-# 27984 "src/ocaml/preprocess/parser_raw.ml"
+# 28038 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28025,24 +28079,24 @@ module Tables = struct
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1646 "src/ocaml/preprocess/parser_raw.mly"
+# 1666 "src/ocaml/preprocess/parser_raw.mly"
( Pmod_constraint(me, mty) )
-# 28031 "src/ocaml/preprocess/parser_raw.ml"
+# 28085 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_me_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1070 "src/ocaml/preprocess/parser_raw.mly"
+# 1090 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc _1 )
-# 28040 "src/ocaml/preprocess/parser_raw.ml"
+# 28094 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1650 "src/ocaml/preprocess/parser_raw.mly"
+# 1670 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28046 "src/ocaml/preprocess/parser_raw.ml"
+# 28100 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28073,25 +28127,25 @@ module Tables = struct
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1648 "src/ocaml/preprocess/parser_raw.mly"
+# 1668 "src/ocaml/preprocess/parser_raw.mly"
( let (_, arg) = arg_and_pos in
Pmod_functor(arg, body) )
-# 28080 "src/ocaml/preprocess/parser_raw.ml"
+# 28134 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1070 "src/ocaml/preprocess/parser_raw.mly"
+# 1090 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc _1 )
-# 28089 "src/ocaml/preprocess/parser_raw.ml"
+# 28143 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1650 "src/ocaml/preprocess/parser_raw.mly"
+# 1670 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28095 "src/ocaml/preprocess/parser_raw.ml"
+# 28149 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28121,9 +28175,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos_mty_ in
let _v : (Parsetree.module_type) =
-# 1899 "src/ocaml/preprocess/parser_raw.mly"
+# 1917 "src/ocaml/preprocess/parser_raw.mly"
( mty )
-# 28127 "src/ocaml/preprocess/parser_raw.ml"
+# 28181 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28154,25 +28208,25 @@ module Tables = struct
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1906 "src/ocaml/preprocess/parser_raw.mly"
+# 1924 "src/ocaml/preprocess/parser_raw.mly"
( let (_, arg) = arg_and_pos in
Pmty_functor(arg, body) )
-# 28161 "src/ocaml/preprocess/parser_raw.ml"
+# 28215 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1072 "src/ocaml/preprocess/parser_raw.mly"
+# 1092 "src/ocaml/preprocess/parser_raw.mly"
( mkmty ~loc:_sloc _1 )
-# 28170 "src/ocaml/preprocess/parser_raw.ml"
+# 28224 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1909 "src/ocaml/preprocess/parser_raw.mly"
+# 1927 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28176 "src/ocaml/preprocess/parser_raw.ml"
+# 28230 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28218,18 +28272,18 @@ module Tables = struct
let _v : (Parsetree.module_expr) = let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28224 "src/ocaml/preprocess/parser_raw.ml"
+# 28278 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1463 "src/ocaml/preprocess/parser_raw.mly"
+# 1483 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_structure s) )
-# 28233 "src/ocaml/preprocess/parser_raw.ml"
+# 28287 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28282,22 +28336,22 @@ module Tables = struct
let _v : (Parsetree.module_expr) = let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28288 "src/ocaml/preprocess/parser_raw.ml"
+# 28342 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_me_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1473 "src/ocaml/preprocess/parser_raw.mly"
+# 1493 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mod_attrs ~loc:_sloc attrs (
List.fold_left (fun acc (startpos, arg) ->
mkmod ~loc:(startpos, _endpos) (Pmod_functor (arg, acc))
) me args
) )
-# 28301 "src/ocaml/preprocess/parser_raw.ml"
+# 28355 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28320,9 +28374,9 @@ module Tables = struct
let _startpos = _startpos_me_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1479 "src/ocaml/preprocess/parser_raw.mly"
+# 1499 "src/ocaml/preprocess/parser_raw.mly"
( me )
-# 28326 "src/ocaml/preprocess/parser_raw.ml"
+# 28380 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28352,9 +28406,9 @@ module Tables = struct
let _startpos = _startpos_me_ in
let _endpos = _endpos_attr_ in
let _v : (Parsetree.module_expr) =
-# 1481 "src/ocaml/preprocess/parser_raw.mly"
+# 1501 "src/ocaml/preprocess/parser_raw.mly"
( Mod.attr me attr )
-# 28358 "src/ocaml/preprocess/parser_raw.ml"
+# 28412 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28383,30 +28437,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 28389 "src/ocaml/preprocess/parser_raw.ml"
+# 28443 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1485 "src/ocaml/preprocess/parser_raw.mly"
+# 1505 "src/ocaml/preprocess/parser_raw.mly"
( Pmod_ident x )
-# 28395 "src/ocaml/preprocess/parser_raw.ml"
+# 28449 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1070 "src/ocaml/preprocess/parser_raw.mly"
+# 1090 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc _1 )
-# 28404 "src/ocaml/preprocess/parser_raw.ml"
+# 28458 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1500 "src/ocaml/preprocess/parser_raw.mly"
+# 1520 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28410 "src/ocaml/preprocess/parser_raw.ml"
+# 28464 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28437,24 +28491,24 @@ module Tables = struct
let _endpos = _endpos_me2_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1488 "src/ocaml/preprocess/parser_raw.mly"
+# 1508 "src/ocaml/preprocess/parser_raw.mly"
( Pmod_apply(me1, me2) )
-# 28443 "src/ocaml/preprocess/parser_raw.ml"
+# 28497 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_me2_, _startpos_me1_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1070 "src/ocaml/preprocess/parser_raw.mly"
+# 1090 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc _1 )
-# 28452 "src/ocaml/preprocess/parser_raw.ml"
+# 28506 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1500 "src/ocaml/preprocess/parser_raw.mly"
+# 1520 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28458 "src/ocaml/preprocess/parser_raw.ml"
+# 28512 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28492,24 +28546,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1491 "src/ocaml/preprocess/parser_raw.mly"
+# 1511 "src/ocaml/preprocess/parser_raw.mly"
( Pmod_apply_unit me )
-# 28498 "src/ocaml/preprocess/parser_raw.ml"
+# 28552 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1070 "src/ocaml/preprocess/parser_raw.mly"
+# 1090 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc _1 )
-# 28507 "src/ocaml/preprocess/parser_raw.ml"
+# 28561 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1500 "src/ocaml/preprocess/parser_raw.mly"
+# 1520 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28513 "src/ocaml/preprocess/parser_raw.ml"
+# 28567 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28533,24 +28587,24 @@ module Tables = struct
let _endpos = _endpos_ex_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1494 "src/ocaml/preprocess/parser_raw.mly"
+# 1514 "src/ocaml/preprocess/parser_raw.mly"
( Pmod_extension ex )
-# 28539 "src/ocaml/preprocess/parser_raw.ml"
+# 28593 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_ex_, _startpos_ex_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1070 "src/ocaml/preprocess/parser_raw.mly"
+# 1090 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc _1 )
-# 28548 "src/ocaml/preprocess/parser_raw.ml"
+# 28602 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1500 "src/ocaml/preprocess/parser_raw.mly"
+# 1520 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28554 "src/ocaml/preprocess/parser_raw.ml"
+# 28608 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28578,25 +28632,25 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 1497 "src/ocaml/preprocess/parser_raw.mly"
+# 1517 "src/ocaml/preprocess/parser_raw.mly"
( let id = mkrhs Ast_helper.hole_txt _loc in
Pmod_extension (id, PStr []) )
-# 28585 "src/ocaml/preprocess/parser_raw.ml"
+# 28639 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1070 "src/ocaml/preprocess/parser_raw.mly"
+# 1090 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc _1 )
-# 28594 "src/ocaml/preprocess/parser_raw.ml"
+# 28648 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1500 "src/ocaml/preprocess/parser_raw.mly"
+# 1520 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28600 "src/ocaml/preprocess/parser_raw.ml"
+# 28654 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28615,17 +28669,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let x : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 28621 "src/ocaml/preprocess/parser_raw.ml"
+# 28675 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic x in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (string option) =
-# 1446 "src/ocaml/preprocess/parser_raw.mly"
+# 1466 "src/ocaml/preprocess/parser_raw.mly"
( Some x )
-# 28629 "src/ocaml/preprocess/parser_raw.ml"
+# 28683 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28648,9 +28702,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string option) =
-# 1449 "src/ocaml/preprocess/parser_raw.mly"
+# 1469 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 28654 "src/ocaml/preprocess/parser_raw.ml"
+# 28708 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28708,9 +28762,9 @@ module Tables = struct
let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 28714 "src/ocaml/preprocess/parser_raw.ml"
+# 28768 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Location.loc option) = Obj.magic ext in
@@ -28721,9 +28775,9 @@ module Tables = struct
let _v : (Parsetree.module_substitution * string Location.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28727 "src/ocaml/preprocess/parser_raw.ml"
+# 28781 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
@@ -28733,9 +28787,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 28739 "src/ocaml/preprocess/parser_raw.ml"
+# 28793 "src/ocaml/preprocess/parser_raw.ml"
in
let uid =
@@ -28744,31 +28798,31 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 28750 "src/ocaml/preprocess/parser_raw.ml"
+# 28804 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28758 "src/ocaml/preprocess/parser_raw.ml"
+# 28812 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1939 "src/ocaml/preprocess/parser_raw.mly"
+# 1957 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Ms.mk uid body ~attrs ~loc ~docs, ext
)
-# 28772 "src/ocaml/preprocess/parser_raw.ml"
+# 28826 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28814,18 +28868,18 @@ module Tables = struct
let _v : (Parsetree.module_type) = let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28820 "src/ocaml/preprocess/parser_raw.ml"
+# 28874 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1775 "src/ocaml/preprocess/parser_raw.mly"
+# 1795 "src/ocaml/preprocess/parser_raw.mly"
( mkmty ~loc:_sloc ~attrs (Pmty_signature s) )
-# 28829 "src/ocaml/preprocess/parser_raw.ml"
+# 28883 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28878,22 +28932,57 @@ module Tables = struct
let _v : (Parsetree.module_type) = let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28884 "src/ocaml/preprocess/parser_raw.ml"
+# 28938 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_mty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1787 "src/ocaml/preprocess/parser_raw.mly"
- ( wrap_mty_attrs ~loc:_sloc attrs (
- List.fold_left (fun acc (startpos, arg) ->
- mkmty ~loc:(startpos, _endpos) (Pmty_functor (arg, acc))
- ) mty args
- ) )
-# 28897 "src/ocaml/preprocess/parser_raw.ml"
+# 1807 "src/ocaml/preprocess/parser_raw.mly"
+ ( wrap_mty_attrs ~loc:_sloc attrs (mk_functor_typ args mty) )
+# 28947 "src/ocaml/preprocess/parser_raw.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = mty;
+ MenhirLib.EngineTypes.startp = _startpos_mty_;
+ MenhirLib.EngineTypes.endp = _endpos_mty_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = args;
+ MenhirLib.EngineTypes.startp = _startpos_args_;
+ MenhirLib.EngineTypes.endp = _endpos_args_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ } = _menhir_stack in
+ let mty : (Parsetree.module_type) = Obj.magic mty in
+ let _2 : unit = Obj.magic _2 in
+ let args : ((Lexing.position * Parsetree.functor_parameter) list) = Obj.magic args in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos_args_ in
+ let _endpos = _endpos_mty_ in
+ let _v : (Parsetree.module_type) =
+# 1811 "src/ocaml/preprocess/parser_raw.mly"
+ ( mk_functor_typ args mty )
+# 28986 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28946,18 +29035,18 @@ module Tables = struct
let _v : (Parsetree.module_type) = let _4 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 28952 "src/ocaml/preprocess/parser_raw.ml"
+# 29041 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1793 "src/ocaml/preprocess/parser_raw.mly"
+# 1813 "src/ocaml/preprocess/parser_raw.mly"
( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) )
-# 28961 "src/ocaml/preprocess/parser_raw.ml"
+# 29050 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -28994,9 +29083,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) =
-# 1795 "src/ocaml/preprocess/parser_raw.mly"
+# 1815 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 29000 "src/ocaml/preprocess/parser_raw.ml"
+# 29089 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29026,9 +29115,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.module_type) =
-# 1801 "src/ocaml/preprocess/parser_raw.mly"
+# 1821 "src/ocaml/preprocess/parser_raw.mly"
( Mty.attr _1 _2 )
-# 29032 "src/ocaml/preprocess/parser_raw.ml"
+# 29121 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29057,92 +29146,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 29063 "src/ocaml/preprocess/parser_raw.ml"
+# 29152 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1804 "src/ocaml/preprocess/parser_raw.mly"
+# 1824 "src/ocaml/preprocess/parser_raw.mly"
( Pmty_ident _1 )
-# 29069 "src/ocaml/preprocess/parser_raw.ml"
+# 29158 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1072 "src/ocaml/preprocess/parser_raw.mly"
+# 1092 "src/ocaml/preprocess/parser_raw.mly"
( mkmty ~loc:_sloc _1 )
-# 29078 "src/ocaml/preprocess/parser_raw.ml"
+# 29167 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1817 "src/ocaml/preprocess/parser_raw.mly"
+# 1835 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29084 "src/ocaml/preprocess/parser_raw.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- } = _menhir_stack in
- let _4 : (Parsetree.module_type) = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : unit = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__4_ in
- let _v : (Parsetree.module_type) = let _1 =
- let _1 =
-# 1806 "src/ocaml/preprocess/parser_raw.mly"
- ( Pmty_functor(Unit, _4) )
-# 29131 "src/ocaml/preprocess/parser_raw.ml"
- in
- let _endpos__1_ = _endpos__4_ in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 1072 "src/ocaml/preprocess/parser_raw.mly"
- ( mkmty ~loc:_sloc _1 )
-# 29140 "src/ocaml/preprocess/parser_raw.ml"
-
- in
-
-# 1817 "src/ocaml/preprocess/parser_raw.mly"
- ( _1 )
-# 29146 "src/ocaml/preprocess/parser_raw.ml"
+# 29173 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29180,24 +29207,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1809 "src/ocaml/preprocess/parser_raw.mly"
+# 1827 "src/ocaml/preprocess/parser_raw.mly"
( Pmty_functor(Named (mknoloc None, _1), _3) )
-# 29186 "src/ocaml/preprocess/parser_raw.ml"
+# 29213 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1072 "src/ocaml/preprocess/parser_raw.mly"
+# 1092 "src/ocaml/preprocess/parser_raw.mly"
( mkmty ~loc:_sloc _1 )
-# 29195 "src/ocaml/preprocess/parser_raw.ml"
+# 29222 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1817 "src/ocaml/preprocess/parser_raw.mly"
+# 1835 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29201 "src/ocaml/preprocess/parser_raw.ml"
+# 29228 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29239,18 +29266,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 29243 "src/ocaml/preprocess/parser_raw.ml"
+# 29270 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 29248 "src/ocaml/preprocess/parser_raw.ml"
+# 29275 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1811 "src/ocaml/preprocess/parser_raw.mly"
+# 1829 "src/ocaml/preprocess/parser_raw.mly"
( Pmty_with(_1, _3) )
-# 29254 "src/ocaml/preprocess/parser_raw.ml"
+# 29281 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_xs_ in
@@ -29258,15 +29285,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1072 "src/ocaml/preprocess/parser_raw.mly"
+# 1092 "src/ocaml/preprocess/parser_raw.mly"
( mkmty ~loc:_sloc _1 )
-# 29264 "src/ocaml/preprocess/parser_raw.ml"
+# 29291 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1817 "src/ocaml/preprocess/parser_raw.mly"
+# 1835 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29270 "src/ocaml/preprocess/parser_raw.ml"
+# 29297 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29290,23 +29317,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1815 "src/ocaml/preprocess/parser_raw.mly"
+# 1833 "src/ocaml/preprocess/parser_raw.mly"
( Pmty_extension _1 )
-# 29296 "src/ocaml/preprocess/parser_raw.ml"
+# 29323 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1072 "src/ocaml/preprocess/parser_raw.mly"
+# 1092 "src/ocaml/preprocess/parser_raw.mly"
( mkmty ~loc:_sloc _1 )
-# 29304 "src/ocaml/preprocess/parser_raw.ml"
+# 29331 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1817 "src/ocaml/preprocess/parser_raw.mly"
+# 1835 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29310 "src/ocaml/preprocess/parser_raw.ml"
+# 29337 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29373,9 +29400,9 @@ module Tables = struct
let _v : (Parsetree.module_type_declaration * string Location.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29379 "src/ocaml/preprocess/parser_raw.ml"
+# 29406 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -29385,31 +29412,31 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 29391 "src/ocaml/preprocess/parser_raw.ml"
+# 29418 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29399 "src/ocaml/preprocess/parser_raw.ml"
+# 29426 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1721 "src/ocaml/preprocess/parser_raw.mly"
+# 1741 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Mtd.mk id ?typ ~attrs ~loc ~docs, ext
)
-# 29413 "src/ocaml/preprocess/parser_raw.ml"
+# 29440 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29483,9 +29510,9 @@ module Tables = struct
let _v : (Parsetree.module_type_declaration * string Location.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29489 "src/ocaml/preprocess/parser_raw.ml"
+# 29516 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -29495,31 +29522,31 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 29501 "src/ocaml/preprocess/parser_raw.ml"
+# 29528 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29509 "src/ocaml/preprocess/parser_raw.ml"
+# 29536 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1997 "src/ocaml/preprocess/parser_raw.mly"
+# 2015 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Mtd.mk id ~typ ~attrs ~loc ~docs, ext
)
-# 29523 "src/ocaml/preprocess/parser_raw.ml"
+# 29550 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29542,9 +29569,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 4005 "src/ocaml/preprocess/parser_raw.mly"
+# 4053 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 29548 "src/ocaml/preprocess/parser_raw.ml"
+# 29575 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29560,9 +29587,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag) =
-# 4086 "src/ocaml/preprocess/parser_raw.mly"
+# 4134 "src/ocaml/preprocess/parser_raw.mly"
( Immutable )
-# 29566 "src/ocaml/preprocess/parser_raw.ml"
+# 29593 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29585,9 +29612,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 4087 "src/ocaml/preprocess/parser_raw.mly"
+# 4135 "src/ocaml/preprocess/parser_raw.mly"
( Mutable )
-# 29591 "src/ocaml/preprocess/parser_raw.ml"
+# 29618 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29603,9 +29630,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 4095 "src/ocaml/preprocess/parser_raw.mly"
+# 4143 "src/ocaml/preprocess/parser_raw.mly"
( Immutable, Concrete )
-# 29609 "src/ocaml/preprocess/parser_raw.ml"
+# 29636 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29628,9 +29655,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 4097 "src/ocaml/preprocess/parser_raw.mly"
+# 4145 "src/ocaml/preprocess/parser_raw.mly"
( Mutable, Concrete )
-# 29634 "src/ocaml/preprocess/parser_raw.ml"
+# 29661 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29653,9 +29680,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 4099 "src/ocaml/preprocess/parser_raw.mly"
+# 4147 "src/ocaml/preprocess/parser_raw.mly"
( Immutable, Virtual )
-# 29659 "src/ocaml/preprocess/parser_raw.ml"
+# 29686 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29685,9 +29712,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 4102 "src/ocaml/preprocess/parser_raw.mly"
+# 4150 "src/ocaml/preprocess/parser_raw.mly"
( Mutable, Virtual )
-# 29691 "src/ocaml/preprocess/parser_raw.ml"
+# 29718 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29717,9 +29744,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 4102 "src/ocaml/preprocess/parser_raw.mly"
+# 4150 "src/ocaml/preprocess/parser_raw.mly"
( Mutable, Virtual )
-# 29723 "src/ocaml/preprocess/parser_raw.ml"
+# 29750 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29749,9 +29776,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 4057 "src/ocaml/preprocess/parser_raw.mly"
+# 4105 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 29755 "src/ocaml/preprocess/parser_raw.ml"
+# 29782 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29770,9 +29797,9 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 29776 "src/ocaml/preprocess/parser_raw.ml"
+# 29803 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -29782,15 +29809,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 29788 "src/ocaml/preprocess/parser_raw.ml"
+# 29815 "src/ocaml/preprocess/parser_raw.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 29794 "src/ocaml/preprocess/parser_raw.ml"
+# 29821 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29816,9 +29843,9 @@ module Tables = struct
} = _menhir_stack in
let xs : (string Location.loc list) = Obj.magic xs in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 29822 "src/ocaml/preprocess/parser_raw.ml"
+# 29849 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -29828,15 +29855,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 29834 "src/ocaml/preprocess/parser_raw.ml"
+# 29861 "src/ocaml/preprocess/parser_raw.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 29840 "src/ocaml/preprocess/parser_raw.ml"
+# 29867 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29855,22 +29882,22 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let s : (
-# 876 "src/ocaml/preprocess/parser_raw.mly"
+# 895 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string option)
-# 29861 "src/ocaml/preprocess/parser_raw.ml"
+# 29888 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_s_ in
let _endpos = _endpos_s_ in
let _v : (string list) = let x =
-# 4053 "src/ocaml/preprocess/parser_raw.mly"
+# 4101 "src/ocaml/preprocess/parser_raw.mly"
( let body, _, _ = s in body )
-# 29869 "src/ocaml/preprocess/parser_raw.ml"
+# 29896 "src/ocaml/preprocess/parser_raw.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 29874 "src/ocaml/preprocess/parser_raw.ml"
+# 29901 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29896,22 +29923,22 @@ module Tables = struct
} = _menhir_stack in
let xs : (string list) = Obj.magic xs in
let s : (
-# 876 "src/ocaml/preprocess/parser_raw.mly"
+# 895 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string option)
-# 29902 "src/ocaml/preprocess/parser_raw.ml"
+# 29929 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_s_ in
let _endpos = _endpos_xs_ in
let _v : (string list) = let x =
-# 4053 "src/ocaml/preprocess/parser_raw.mly"
+# 4101 "src/ocaml/preprocess/parser_raw.mly"
( let body, _, _ = s in body )
-# 29910 "src/ocaml/preprocess/parser_raw.ml"
+# 29937 "src/ocaml/preprocess/parser_raw.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 29915 "src/ocaml/preprocess/parser_raw.ml"
+# 29942 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29934,14 +29961,14 @@ module Tables = struct
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 29940 "src/ocaml/preprocess/parser_raw.ml"
+# 29967 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3306 "src/ocaml/preprocess/parser_raw.mly"
+# 3347 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_abstract, priv, Some ty) )
-# 29945 "src/ocaml/preprocess/parser_raw.ml"
+# 29972 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -29971,14 +29998,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 29977 "src/ocaml/preprocess/parser_raw.ml"
+# 30004 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3306 "src/ocaml/preprocess/parser_raw.mly"
+# 3347 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_abstract, priv, Some ty) )
-# 29982 "src/ocaml/preprocess/parser_raw.ml"
+# 30009 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30001,26 +30028,26 @@ module Tables = struct
let _startpos = _startpos_cs_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 30007 "src/ocaml/preprocess/parser_raw.ml"
+# 30034 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 30013 "src/ocaml/preprocess/parser_raw.ml"
+# 30040 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30018 "src/ocaml/preprocess/parser_raw.ml"
+# 30045 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3310 "src/ocaml/preprocess/parser_raw.mly"
+# 3351 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_variant cs, priv, oty) )
-# 30024 "src/ocaml/preprocess/parser_raw.ml"
+# 30051 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30050,26 +30077,26 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 30056 "src/ocaml/preprocess/parser_raw.ml"
+# 30083 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 30062 "src/ocaml/preprocess/parser_raw.ml"
+# 30089 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30067 "src/ocaml/preprocess/parser_raw.ml"
+# 30094 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3310 "src/ocaml/preprocess/parser_raw.mly"
+# 3351 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_variant cs, priv, oty) )
-# 30073 "src/ocaml/preprocess/parser_raw.ml"
+# 30100 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30106,33 +30133,33 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 30112 "src/ocaml/preprocess/parser_raw.ml"
+# 30139 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 30119 "src/ocaml/preprocess/parser_raw.ml"
+# 30146 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 30124 "src/ocaml/preprocess/parser_raw.ml"
+# 30151 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30130 "src/ocaml/preprocess/parser_raw.ml"
+# 30157 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3310 "src/ocaml/preprocess/parser_raw.mly"
+# 3351 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_variant cs, priv, oty) )
-# 30136 "src/ocaml/preprocess/parser_raw.ml"
+# 30163 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30176,33 +30203,33 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 30182 "src/ocaml/preprocess/parser_raw.ml"
+# 30209 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 30189 "src/ocaml/preprocess/parser_raw.ml"
+# 30216 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 30194 "src/ocaml/preprocess/parser_raw.ml"
+# 30221 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30200 "src/ocaml/preprocess/parser_raw.ml"
+# 30227 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3310 "src/ocaml/preprocess/parser_raw.mly"
+# 3351 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_variant cs, priv, oty) )
-# 30206 "src/ocaml/preprocess/parser_raw.ml"
+# 30233 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30225,26 +30252,26 @@ module Tables = struct
let _startpos = _startpos__3_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 30231 "src/ocaml/preprocess/parser_raw.ml"
+# 30258 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 30237 "src/ocaml/preprocess/parser_raw.ml"
+# 30264 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30242 "src/ocaml/preprocess/parser_raw.ml"
+# 30269 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3314 "src/ocaml/preprocess/parser_raw.mly"
+# 3355 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_open, priv, oty) )
-# 30248 "src/ocaml/preprocess/parser_raw.ml"
+# 30275 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30274,26 +30301,26 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 30280 "src/ocaml/preprocess/parser_raw.ml"
+# 30307 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 30286 "src/ocaml/preprocess/parser_raw.ml"
+# 30313 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30291 "src/ocaml/preprocess/parser_raw.ml"
+# 30318 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3314 "src/ocaml/preprocess/parser_raw.mly"
+# 3355 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_open, priv, oty) )
-# 30297 "src/ocaml/preprocess/parser_raw.ml"
+# 30324 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30330,33 +30357,33 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 30336 "src/ocaml/preprocess/parser_raw.ml"
+# 30363 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 30343 "src/ocaml/preprocess/parser_raw.ml"
+# 30370 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 30348 "src/ocaml/preprocess/parser_raw.ml"
+# 30375 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30354 "src/ocaml/preprocess/parser_raw.ml"
+# 30381 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3314 "src/ocaml/preprocess/parser_raw.mly"
+# 3355 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_open, priv, oty) )
-# 30360 "src/ocaml/preprocess/parser_raw.ml"
+# 30387 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30400,33 +30427,33 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 30406 "src/ocaml/preprocess/parser_raw.ml"
+# 30433 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 30413 "src/ocaml/preprocess/parser_raw.ml"
+# 30440 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 30418 "src/ocaml/preprocess/parser_raw.ml"
+# 30445 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30424 "src/ocaml/preprocess/parser_raw.ml"
+# 30451 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3314 "src/ocaml/preprocess/parser_raw.mly"
+# 3355 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_open, priv, oty) )
-# 30430 "src/ocaml/preprocess/parser_raw.ml"
+# 30457 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30463,26 +30490,26 @@ module Tables = struct
let _startpos = _startpos__3_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 30469 "src/ocaml/preprocess/parser_raw.ml"
+# 30496 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 30475 "src/ocaml/preprocess/parser_raw.ml"
+# 30502 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30480 "src/ocaml/preprocess/parser_raw.ml"
+# 30507 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3318 "src/ocaml/preprocess/parser_raw.mly"
+# 3359 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_record ls, priv, oty) )
-# 30486 "src/ocaml/preprocess/parser_raw.ml"
+# 30513 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30526,26 +30553,26 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 30532 "src/ocaml/preprocess/parser_raw.ml"
+# 30559 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 30538 "src/ocaml/preprocess/parser_raw.ml"
+# 30565 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30543 "src/ocaml/preprocess/parser_raw.ml"
+# 30570 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3318 "src/ocaml/preprocess/parser_raw.mly"
+# 3359 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_record ls, priv, oty) )
-# 30549 "src/ocaml/preprocess/parser_raw.ml"
+# 30576 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30596,33 +30623,33 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 30602 "src/ocaml/preprocess/parser_raw.ml"
+# 30629 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 30609 "src/ocaml/preprocess/parser_raw.ml"
+# 30636 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 30614 "src/ocaml/preprocess/parser_raw.ml"
+# 30641 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30620 "src/ocaml/preprocess/parser_raw.ml"
+# 30647 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3318 "src/ocaml/preprocess/parser_raw.mly"
+# 3359 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_record ls, priv, oty) )
-# 30626 "src/ocaml/preprocess/parser_raw.ml"
+# 30653 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30680,33 +30707,33 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 30686 "src/ocaml/preprocess/parser_raw.ml"
+# 30713 "src/ocaml/preprocess/parser_raw.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 30693 "src/ocaml/preprocess/parser_raw.ml"
+# 30720 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 30698 "src/ocaml/preprocess/parser_raw.ml"
+# 30725 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3322 "src/ocaml/preprocess/parser_raw.mly"
+# 3363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30704 "src/ocaml/preprocess/parser_raw.ml"
+# 30731 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3318 "src/ocaml/preprocess/parser_raw.mly"
+# 3359 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_record ls, priv, oty) )
-# 30710 "src/ocaml/preprocess/parser_raw.ml"
+# 30737 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30744,24 +30771,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3742 "src/ocaml/preprocess/parser_raw.mly"
+# 3783 "src/ocaml/preprocess/parser_raw.mly"
( let (f, c) = meth_list in Ptyp_object (f, c) )
-# 30750 "src/ocaml/preprocess/parser_raw.ml"
+# 30777 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 30759 "src/ocaml/preprocess/parser_raw.ml"
+# 30786 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3746 "src/ocaml/preprocess/parser_raw.mly"
+# 3787 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30765 "src/ocaml/preprocess/parser_raw.ml"
+# 30792 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30792,24 +30819,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3744 "src/ocaml/preprocess/parser_raw.mly"
+# 3785 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_object ([], Closed) )
-# 30798 "src/ocaml/preprocess/parser_raw.ml"
+# 30825 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 30807 "src/ocaml/preprocess/parser_raw.ml"
+# 30834 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3746 "src/ocaml/preprocess/parser_raw.mly"
+# 3787 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30813 "src/ocaml/preprocess/parser_raw.ml"
+# 30840 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30862,37 +30889,37 @@ module Tables = struct
let _v : (Parsetree.module_expr Parsetree.open_infos * string Location.loc option) = let attrs2 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30868 "src/ocaml/preprocess/parser_raw.ml"
+# 30895 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30877 "src/ocaml/preprocess/parser_raw.ml"
+# 30904 "src/ocaml/preprocess/parser_raw.ml"
in
let override =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 30883 "src/ocaml/preprocess/parser_raw.ml"
+# 30910 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1740 "src/ocaml/preprocess/parser_raw.mly"
+# 1760 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk me ~override ~attrs ~loc ~docs, ext
)
-# 30896 "src/ocaml/preprocess/parser_raw.ml"
+# 30923 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -30952,40 +30979,40 @@ module Tables = struct
let _v : (Parsetree.module_expr Parsetree.open_infos * string Location.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30958 "src/ocaml/preprocess/parser_raw.ml"
+# 30985 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 30967 "src/ocaml/preprocess/parser_raw.ml"
+# 30994 "src/ocaml/preprocess/parser_raw.ml"
in
let override =
let _1 = _1_inlined1 in
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 30975 "src/ocaml/preprocess/parser_raw.ml"
+# 31002 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1740 "src/ocaml/preprocess/parser_raw.mly"
+# 1760 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk me ~override ~attrs ~loc ~docs, ext
)
-# 30989 "src/ocaml/preprocess/parser_raw.ml"
+# 31016 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31038,9 +31065,9 @@ module Tables = struct
let _v : (Longident.t Location.loc Parsetree.open_infos * string Location.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31044 "src/ocaml/preprocess/parser_raw.ml"
+# 31071 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -31050,36 +31077,36 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 31056 "src/ocaml/preprocess/parser_raw.ml"
+# 31083 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31064 "src/ocaml/preprocess/parser_raw.ml"
+# 31091 "src/ocaml/preprocess/parser_raw.ml"
in
let override =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 31070 "src/ocaml/preprocess/parser_raw.ml"
+# 31097 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1755 "src/ocaml/preprocess/parser_raw.mly"
+# 1775 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk id ~override ~attrs ~loc ~docs, ext
)
-# 31083 "src/ocaml/preprocess/parser_raw.ml"
+# 31110 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31139,9 +31166,9 @@ module Tables = struct
let _v : (Longident.t Location.loc Parsetree.open_infos * string Location.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31145 "src/ocaml/preprocess/parser_raw.ml"
+# 31172 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
@@ -31151,39 +31178,39 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 31157 "src/ocaml/preprocess/parser_raw.ml"
+# 31184 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined2 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31165 "src/ocaml/preprocess/parser_raw.ml"
+# 31192 "src/ocaml/preprocess/parser_raw.ml"
in
let override =
let _1 = _1_inlined1 in
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 31173 "src/ocaml/preprocess/parser_raw.ml"
+# 31200 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1755 "src/ocaml/preprocess/parser_raw.mly"
+# 1775 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk id ~override ~attrs ~loc ~docs, ext
)
-# 31187 "src/ocaml/preprocess/parser_raw.ml"
+# 31214 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31202,17 +31229,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 862 "src/ocaml/preprocess/parser_raw.mly"
+# 881 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31208 "src/ocaml/preprocess/parser_raw.ml"
+# 31235 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3919 "src/ocaml/preprocess/parser_raw.mly"
+# 3967 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31216 "src/ocaml/preprocess/parser_raw.ml"
+# 31243 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31231,17 +31258,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 820 "src/ocaml/preprocess/parser_raw.mly"
+# 839 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31237 "src/ocaml/preprocess/parser_raw.ml"
+# 31264 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3920 "src/ocaml/preprocess/parser_raw.mly"
+# 3968 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31245 "src/ocaml/preprocess/parser_raw.ml"
+# 31272 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31260,17 +31287,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 821 "src/ocaml/preprocess/parser_raw.mly"
+# 840 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31266 "src/ocaml/preprocess/parser_raw.ml"
+# 31293 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3921 "src/ocaml/preprocess/parser_raw.mly"
+# 3969 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31274 "src/ocaml/preprocess/parser_raw.ml"
+# 31301 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31310,17 +31337,17 @@ module Tables = struct
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31316 "src/ocaml/preprocess/parser_raw.ml"
+# 31343 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (string) =
-# 3922 "src/ocaml/preprocess/parser_raw.mly"
+# 3970 "src/ocaml/preprocess/parser_raw.mly"
( "."^ _1 ^"(" ^ _3 ^ ")" )
-# 31324 "src/ocaml/preprocess/parser_raw.ml"
+# 31351 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31367,17 +31394,17 @@ module Tables = struct
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31373 "src/ocaml/preprocess/parser_raw.ml"
+# 31400 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (string) =
-# 3923 "src/ocaml/preprocess/parser_raw.mly"
+# 3971 "src/ocaml/preprocess/parser_raw.mly"
( "."^ _1 ^ "(" ^ _3 ^ ")<-" )
-# 31381 "src/ocaml/preprocess/parser_raw.ml"
+# 31408 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31417,17 +31444,17 @@ module Tables = struct
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31423 "src/ocaml/preprocess/parser_raw.ml"
+# 31450 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (string) =
-# 3924 "src/ocaml/preprocess/parser_raw.mly"
+# 3972 "src/ocaml/preprocess/parser_raw.mly"
( "."^ _1 ^"[" ^ _3 ^ "]" )
-# 31431 "src/ocaml/preprocess/parser_raw.ml"
+# 31458 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31474,17 +31501,17 @@ module Tables = struct
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31480 "src/ocaml/preprocess/parser_raw.ml"
+# 31507 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (string) =
-# 3925 "src/ocaml/preprocess/parser_raw.mly"
+# 3973 "src/ocaml/preprocess/parser_raw.mly"
( "."^ _1 ^ "[" ^ _3 ^ "]<-" )
-# 31488 "src/ocaml/preprocess/parser_raw.ml"
+# 31515 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31524,17 +31551,17 @@ module Tables = struct
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31530 "src/ocaml/preprocess/parser_raw.ml"
+# 31557 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (string) =
-# 3926 "src/ocaml/preprocess/parser_raw.mly"
+# 3974 "src/ocaml/preprocess/parser_raw.mly"
( "."^ _1 ^"{" ^ _3 ^ "}" )
-# 31538 "src/ocaml/preprocess/parser_raw.ml"
+# 31565 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31581,17 +31608,17 @@ module Tables = struct
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31587 "src/ocaml/preprocess/parser_raw.ml"
+# 31614 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (string) =
-# 3927 "src/ocaml/preprocess/parser_raw.mly"
+# 3975 "src/ocaml/preprocess/parser_raw.mly"
( "."^ _1 ^ "{" ^ _3 ^ "}<-" )
-# 31595 "src/ocaml/preprocess/parser_raw.ml"
+# 31622 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31610,17 +31637,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 873 "src/ocaml/preprocess/parser_raw.mly"
+# 892 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31616 "src/ocaml/preprocess/parser_raw.ml"
+# 31643 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3928 "src/ocaml/preprocess/parser_raw.mly"
+# 3976 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31624 "src/ocaml/preprocess/parser_raw.ml"
+# 31651 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31643,9 +31670,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3929 "src/ocaml/preprocess/parser_raw.mly"
+# 3977 "src/ocaml/preprocess/parser_raw.mly"
( "!" )
-# 31649 "src/ocaml/preprocess/parser_raw.ml"
+# 31676 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31664,22 +31691,22 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 814 "src/ocaml/preprocess/parser_raw.mly"
+# 833 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31670 "src/ocaml/preprocess/parser_raw.ml"
+# 31697 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3933 "src/ocaml/preprocess/parser_raw.mly"
+# 3981 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 31678 "src/ocaml/preprocess/parser_raw.ml"
+# 31705 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31683 "src/ocaml/preprocess/parser_raw.ml"
+# 31710 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31698,22 +31725,22 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 815 "src/ocaml/preprocess/parser_raw.mly"
+# 834 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31704 "src/ocaml/preprocess/parser_raw.ml"
+# 31731 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3934 "src/ocaml/preprocess/parser_raw.mly"
+# 3982 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 31712 "src/ocaml/preprocess/parser_raw.ml"
+# 31739 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31717 "src/ocaml/preprocess/parser_raw.ml"
+# 31744 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31732,22 +31759,22 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 816 "src/ocaml/preprocess/parser_raw.mly"
+# 835 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31738 "src/ocaml/preprocess/parser_raw.ml"
+# 31765 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3935 "src/ocaml/preprocess/parser_raw.mly"
+# 3983 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 31746 "src/ocaml/preprocess/parser_raw.ml"
+# 31773 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31751 "src/ocaml/preprocess/parser_raw.ml"
+# 31778 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31766,22 +31793,22 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 817 "src/ocaml/preprocess/parser_raw.mly"
+# 836 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31772 "src/ocaml/preprocess/parser_raw.ml"
+# 31799 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3936 "src/ocaml/preprocess/parser_raw.mly"
+# 3984 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 31780 "src/ocaml/preprocess/parser_raw.ml"
+# 31807 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31785 "src/ocaml/preprocess/parser_raw.ml"
+# 31812 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31800,22 +31827,22 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 818 "src/ocaml/preprocess/parser_raw.mly"
+# 837 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 31806 "src/ocaml/preprocess/parser_raw.ml"
+# 31833 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3937 "src/ocaml/preprocess/parser_raw.mly"
+# 3985 "src/ocaml/preprocess/parser_raw.mly"
( op )
-# 31814 "src/ocaml/preprocess/parser_raw.ml"
+# 31841 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31819 "src/ocaml/preprocess/parser_raw.ml"
+# 31846 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31838,14 +31865,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3938 "src/ocaml/preprocess/parser_raw.mly"
+# 3986 "src/ocaml/preprocess/parser_raw.mly"
("+")
-# 31844 "src/ocaml/preprocess/parser_raw.ml"
+# 31871 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31849 "src/ocaml/preprocess/parser_raw.ml"
+# 31876 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31868,14 +31895,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3939 "src/ocaml/preprocess/parser_raw.mly"
+# 3987 "src/ocaml/preprocess/parser_raw.mly"
("+.")
-# 31874 "src/ocaml/preprocess/parser_raw.ml"
+# 31901 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31879 "src/ocaml/preprocess/parser_raw.ml"
+# 31906 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31898,14 +31925,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3940 "src/ocaml/preprocess/parser_raw.mly"
+# 3988 "src/ocaml/preprocess/parser_raw.mly"
("+=")
-# 31904 "src/ocaml/preprocess/parser_raw.ml"
+# 31931 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31909 "src/ocaml/preprocess/parser_raw.ml"
+# 31936 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31928,14 +31955,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3941 "src/ocaml/preprocess/parser_raw.mly"
+# 3989 "src/ocaml/preprocess/parser_raw.mly"
("-")
-# 31934 "src/ocaml/preprocess/parser_raw.ml"
+# 31961 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31939 "src/ocaml/preprocess/parser_raw.ml"
+# 31966 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31958,14 +31985,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3942 "src/ocaml/preprocess/parser_raw.mly"
+# 3990 "src/ocaml/preprocess/parser_raw.mly"
("-.")
-# 31964 "src/ocaml/preprocess/parser_raw.ml"
+# 31991 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31969 "src/ocaml/preprocess/parser_raw.ml"
+# 31996 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -31988,14 +32015,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3943 "src/ocaml/preprocess/parser_raw.mly"
+# 3991 "src/ocaml/preprocess/parser_raw.mly"
("*")
-# 31994 "src/ocaml/preprocess/parser_raw.ml"
+# 32021 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 31999 "src/ocaml/preprocess/parser_raw.ml"
+# 32026 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32018,14 +32045,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3944 "src/ocaml/preprocess/parser_raw.mly"
+# 3992 "src/ocaml/preprocess/parser_raw.mly"
("%")
-# 32024 "src/ocaml/preprocess/parser_raw.ml"
+# 32051 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32029 "src/ocaml/preprocess/parser_raw.ml"
+# 32056 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32048,14 +32075,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3945 "src/ocaml/preprocess/parser_raw.mly"
+# 3993 "src/ocaml/preprocess/parser_raw.mly"
("=")
-# 32054 "src/ocaml/preprocess/parser_raw.ml"
+# 32081 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32059 "src/ocaml/preprocess/parser_raw.ml"
+# 32086 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32078,14 +32105,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3946 "src/ocaml/preprocess/parser_raw.mly"
+# 3994 "src/ocaml/preprocess/parser_raw.mly"
("<")
-# 32084 "src/ocaml/preprocess/parser_raw.ml"
+# 32111 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32089 "src/ocaml/preprocess/parser_raw.ml"
+# 32116 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32108,14 +32135,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3947 "src/ocaml/preprocess/parser_raw.mly"
+# 3995 "src/ocaml/preprocess/parser_raw.mly"
(">")
-# 32114 "src/ocaml/preprocess/parser_raw.ml"
+# 32141 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32119 "src/ocaml/preprocess/parser_raw.ml"
+# 32146 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32138,14 +32165,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3948 "src/ocaml/preprocess/parser_raw.mly"
+# 3996 "src/ocaml/preprocess/parser_raw.mly"
("or")
-# 32144 "src/ocaml/preprocess/parser_raw.ml"
+# 32171 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32149 "src/ocaml/preprocess/parser_raw.ml"
+# 32176 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32168,14 +32195,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3949 "src/ocaml/preprocess/parser_raw.mly"
+# 3997 "src/ocaml/preprocess/parser_raw.mly"
("||")
-# 32174 "src/ocaml/preprocess/parser_raw.ml"
+# 32201 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32179 "src/ocaml/preprocess/parser_raw.ml"
+# 32206 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32198,14 +32225,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3950 "src/ocaml/preprocess/parser_raw.mly"
+# 3998 "src/ocaml/preprocess/parser_raw.mly"
("&")
-# 32204 "src/ocaml/preprocess/parser_raw.ml"
+# 32231 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32209 "src/ocaml/preprocess/parser_raw.ml"
+# 32236 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32228,14 +32255,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3951 "src/ocaml/preprocess/parser_raw.mly"
+# 3999 "src/ocaml/preprocess/parser_raw.mly"
("&&")
-# 32234 "src/ocaml/preprocess/parser_raw.ml"
+# 32261 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32239 "src/ocaml/preprocess/parser_raw.ml"
+# 32266 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32258,14 +32285,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3952 "src/ocaml/preprocess/parser_raw.mly"
+# 4000 "src/ocaml/preprocess/parser_raw.mly"
(":=")
-# 32264 "src/ocaml/preprocess/parser_raw.ml"
+# 32291 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3930 "src/ocaml/preprocess/parser_raw.mly"
+# 3978 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32269 "src/ocaml/preprocess/parser_raw.ml"
+# 32296 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32288,9 +32315,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (bool) =
-# 3832 "src/ocaml/preprocess/parser_raw.mly"
+# 3873 "src/ocaml/preprocess/parser_raw.mly"
( true )
-# 32294 "src/ocaml/preprocess/parser_raw.ml"
+# 32321 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32306,9 +32333,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (bool) =
-# 3833 "src/ocaml/preprocess/parser_raw.mly"
+# 3874 "src/ocaml/preprocess/parser_raw.mly"
( false )
-# 32312 "src/ocaml/preprocess/parser_raw.ml"
+# 32339 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32326,7 +32353,7 @@ module Tables = struct
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 32330 "src/ocaml/preprocess/parser_raw.ml"
+# 32357 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32351,7 +32378,7 @@ module Tables = struct
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 32355 "src/ocaml/preprocess/parser_raw.ml"
+# 32382 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32369,7 +32396,7 @@ module Tables = struct
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 32373 "src/ocaml/preprocess/parser_raw.ml"
+# 32400 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32394,7 +32421,7 @@ module Tables = struct
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 32398 "src/ocaml/preprocess/parser_raw.ml"
+# 32425 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32412,7 +32439,7 @@ module Tables = struct
let _v : (string Location.loc option) =
# 114 "<standard.mly>"
( None )
-# 32416 "src/ocaml/preprocess/parser_raw.ml"
+# 32443 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32437,9 +32464,9 @@ module Tables = struct
};
} = _menhir_stack in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 32443 "src/ocaml/preprocess/parser_raw.ml"
+# 32470 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -32452,21 +32479,21 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 32458 "src/ocaml/preprocess/parser_raw.ml"
+# 32485 "src/ocaml/preprocess/parser_raw.ml"
in
# 183 "<standard.mly>"
( x )
-# 32464 "src/ocaml/preprocess/parser_raw.ml"
+# 32491 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32470 "src/ocaml/preprocess/parser_raw.ml"
+# 32497 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32484,7 +32511,7 @@ module Tables = struct
let _v : (Parsetree.core_type option) =
# 114 "<standard.mly>"
( None )
-# 32488 "src/ocaml/preprocess/parser_raw.ml"
+# 32515 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32516,12 +32543,12 @@ module Tables = struct
let _v : (Parsetree.core_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 32520 "src/ocaml/preprocess/parser_raw.ml"
+# 32547 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32525 "src/ocaml/preprocess/parser_raw.ml"
+# 32552 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32539,7 +32566,7 @@ module Tables = struct
let _v : (Parsetree.core_type option) =
# 114 "<standard.mly>"
( None )
-# 32543 "src/ocaml/preprocess/parser_raw.ml"
+# 32570 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32571,12 +32598,12 @@ module Tables = struct
let _v : (Parsetree.core_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 32575 "src/ocaml/preprocess/parser_raw.ml"
+# 32602 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32580 "src/ocaml/preprocess/parser_raw.ml"
+# 32607 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32594,7 +32621,7 @@ module Tables = struct
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 32598 "src/ocaml/preprocess/parser_raw.ml"
+# 32625 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32627,26 +32654,26 @@ module Tables = struct
let x =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32633 "src/ocaml/preprocess/parser_raw.ml"
+# 32660 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32638 "src/ocaml/preprocess/parser_raw.ml"
+# 32665 "src/ocaml/preprocess/parser_raw.ml"
in
# 183 "<standard.mly>"
( x )
-# 32644 "src/ocaml/preprocess/parser_raw.ml"
+# 32671 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32650 "src/ocaml/preprocess/parser_raw.ml"
+# 32677 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32705,18 +32732,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 32709 "src/ocaml/preprocess/parser_raw.ml"
+# 32736 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 32714 "src/ocaml/preprocess/parser_raw.ml"
+# 32741 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 32720 "src/ocaml/preprocess/parser_raw.ml"
+# 32747 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -32725,22 +32752,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32731 "src/ocaml/preprocess/parser_raw.ml"
+# 32758 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 32737 "src/ocaml/preprocess/parser_raw.ml"
+# 32764 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -32753,25 +32780,25 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 32757 "src/ocaml/preprocess/parser_raw.ml"
+# 32784 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 32763 "src/ocaml/preprocess/parser_raw.ml"
+# 32790 "src/ocaml/preprocess/parser_raw.ml"
in
# 183 "<standard.mly>"
( x )
-# 32769 "src/ocaml/preprocess/parser_raw.ml"
+# 32796 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32775 "src/ocaml/preprocess/parser_raw.ml"
+# 32802 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32789,7 +32816,7 @@ module Tables = struct
let _v : (Parsetree.module_type option) =
# 114 "<standard.mly>"
( None )
-# 32793 "src/ocaml/preprocess/parser_raw.ml"
+# 32820 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32821,12 +32848,12 @@ module Tables = struct
let _v : (Parsetree.module_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 32825 "src/ocaml/preprocess/parser_raw.ml"
+# 32852 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32830 "src/ocaml/preprocess/parser_raw.ml"
+# 32857 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32844,7 +32871,7 @@ module Tables = struct
let _v : (Parsetree.pattern option) =
# 114 "<standard.mly>"
( None )
-# 32848 "src/ocaml/preprocess/parser_raw.ml"
+# 32875 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32876,12 +32903,12 @@ module Tables = struct
let _v : (Parsetree.pattern option) = let x =
# 183 "<standard.mly>"
( x )
-# 32880 "src/ocaml/preprocess/parser_raw.ml"
+# 32907 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32885 "src/ocaml/preprocess/parser_raw.ml"
+# 32912 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32899,7 +32926,7 @@ module Tables = struct
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 32903 "src/ocaml/preprocess/parser_raw.ml"
+# 32930 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32931,12 +32958,12 @@ module Tables = struct
let _v : (Parsetree.expression option) = let x =
# 183 "<standard.mly>"
( x )
-# 32935 "src/ocaml/preprocess/parser_raw.ml"
+# 32962 "src/ocaml/preprocess/parser_raw.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 32940 "src/ocaml/preprocess/parser_raw.ml"
+# 32967 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32954,7 +32981,7 @@ module Tables = struct
let _v : (Parsetree.type_constraint option) =
# 114 "<standard.mly>"
( None )
-# 32958 "src/ocaml/preprocess/parser_raw.ml"
+# 32985 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32979,7 +33006,7 @@ module Tables = struct
let _v : (Parsetree.type_constraint option) =
# 116 "<standard.mly>"
( Some x )
-# 32983 "src/ocaml/preprocess/parser_raw.ml"
+# 33010 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -32998,17 +33025,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 855 "src/ocaml/preprocess/parser_raw.mly"
+# 874 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 33004 "src/ocaml/preprocess/parser_raw.ml"
+# 33031 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4141 "src/ocaml/preprocess/parser_raw.mly"
+# 4189 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33012 "src/ocaml/preprocess/parser_raw.ml"
+# 33039 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33040,18 +33067,18 @@ module Tables = struct
} = _menhir_stack in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 33046 "src/ocaml/preprocess/parser_raw.ml"
+# 33073 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (string) =
-# 4142 "src/ocaml/preprocess/parser_raw.mly"
+# 4190 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 33055 "src/ocaml/preprocess/parser_raw.ml"
+# 33082 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33105,9 +33132,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1509 "src/ocaml/preprocess/parser_raw.mly"
+# 1529 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) )
-# 33111 "src/ocaml/preprocess/parser_raw.ml"
+# 33138 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33144,9 +33171,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_expr) =
-# 1516 "src/ocaml/preprocess/parser_raw.mly"
+# 1536 "src/ocaml/preprocess/parser_raw.mly"
( me (* TODO consider reloc *) )
-# 33150 "src/ocaml/preprocess/parser_raw.ml"
+# 33177 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33200,37 +33227,37 @@ module Tables = struct
let _1 = _1_inlined2 in
let e =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33206 "src/ocaml/preprocess/parser_raw.ml"
+# 33233 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33211 "src/ocaml/preprocess/parser_raw.ml"
+# 33238 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1539 "src/ocaml/preprocess/parser_raw.mly"
+# 1559 "src/ocaml/preprocess/parser_raw.mly"
( e )
-# 33217 "src/ocaml/preprocess/parser_raw.ml"
+# 33244 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33225 "src/ocaml/preprocess/parser_raw.ml"
+# 33252 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 33234 "src/ocaml/preprocess/parser_raw.ml"
+# 33261 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33310,18 +33337,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 33314 "src/ocaml/preprocess/parser_raw.ml"
+# 33341 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 33319 "src/ocaml/preprocess/parser_raw.ml"
+# 33346 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 33325 "src/ocaml/preprocess/parser_raw.ml"
+# 33352 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -33330,22 +33357,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33336 "src/ocaml/preprocess/parser_raw.ml"
+# 33363 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 33342 "src/ocaml/preprocess/parser_raw.ml"
+# 33369 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -33358,36 +33385,36 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 33362 "src/ocaml/preprocess/parser_raw.ml"
+# 33389 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33368 "src/ocaml/preprocess/parser_raw.ml"
+# 33395 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1539 "src/ocaml/preprocess/parser_raw.mly"
+# 1559 "src/ocaml/preprocess/parser_raw.mly"
( e )
-# 33374 "src/ocaml/preprocess/parser_raw.ml"
+# 33401 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33382 "src/ocaml/preprocess/parser_raw.ml"
+# 33409 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 33391 "src/ocaml/preprocess/parser_raw.ml"
+# 33418 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33459,24 +33486,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 33467 "src/ocaml/preprocess/parser_raw.ml"
+# 33494 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_ty_ = _endpos__1_inlined1_ in
let e =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33475 "src/ocaml/preprocess/parser_raw.ml"
+# 33502 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33480 "src/ocaml/preprocess/parser_raw.ml"
+# 33507 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_e_ = _startpos__1_ in
@@ -33484,26 +33511,26 @@ module Tables = struct
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1541 "src/ocaml/preprocess/parser_raw.mly"
+# 1561 "src/ocaml/preprocess/parser_raw.mly"
( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
-# 33490 "src/ocaml/preprocess/parser_raw.ml"
+# 33517 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33498 "src/ocaml/preprocess/parser_raw.ml"
+# 33525 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 33507 "src/ocaml/preprocess/parser_raw.ml"
+# 33534 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33596,11 +33623,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 33604 "src/ocaml/preprocess/parser_raw.ml"
+# 33631 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_ty_ = _endpos__1_inlined3_ in
@@ -33611,18 +33638,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 33615 "src/ocaml/preprocess/parser_raw.ml"
+# 33642 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 33620 "src/ocaml/preprocess/parser_raw.ml"
+# 33647 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 33626 "src/ocaml/preprocess/parser_raw.ml"
+# 33653 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -33631,22 +33658,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33637 "src/ocaml/preprocess/parser_raw.ml"
+# 33664 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 33643 "src/ocaml/preprocess/parser_raw.ml"
+# 33670 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -33659,13 +33686,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 33663 "src/ocaml/preprocess/parser_raw.ml"
+# 33690 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33669 "src/ocaml/preprocess/parser_raw.ml"
+# 33696 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_e_ = _startpos__1_ in
@@ -33673,26 +33700,26 @@ module Tables = struct
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1541 "src/ocaml/preprocess/parser_raw.mly"
+# 1561 "src/ocaml/preprocess/parser_raw.mly"
( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
-# 33679 "src/ocaml/preprocess/parser_raw.ml"
+# 33706 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33687 "src/ocaml/preprocess/parser_raw.ml"
+# 33714 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 33696 "src/ocaml/preprocess/parser_raw.ml"
+# 33723 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33778,11 +33805,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 33786 "src/ocaml/preprocess/parser_raw.ml"
+# 33813 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_ty2_ = _endpos__1_inlined2_ in
@@ -33792,23 +33819,23 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 33800 "src/ocaml/preprocess/parser_raw.ml"
+# 33827 "src/ocaml/preprocess/parser_raw.ml"
in
let e =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33807 "src/ocaml/preprocess/parser_raw.ml"
+# 33834 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33812 "src/ocaml/preprocess/parser_raw.ml"
+# 33839 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_e_ = _startpos__1_ in
@@ -33816,26 +33843,26 @@ module Tables = struct
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1543 "src/ocaml/preprocess/parser_raw.mly"
+# 1563 "src/ocaml/preprocess/parser_raw.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 33822 "src/ocaml/preprocess/parser_raw.ml"
+# 33849 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33830 "src/ocaml/preprocess/parser_raw.ml"
+# 33857 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 33839 "src/ocaml/preprocess/parser_raw.ml"
+# 33866 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -33942,11 +33969,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 33950 "src/ocaml/preprocess/parser_raw.ml"
+# 33977 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_ty2_ = _endpos__1_inlined4_ in
@@ -33956,11 +33983,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 33964 "src/ocaml/preprocess/parser_raw.ml"
+# 33991 "src/ocaml/preprocess/parser_raw.ml"
in
let e =
@@ -33970,18 +33997,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 33974 "src/ocaml/preprocess/parser_raw.ml"
+# 34001 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 33979 "src/ocaml/preprocess/parser_raw.ml"
+# 34006 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 33985 "src/ocaml/preprocess/parser_raw.ml"
+# 34012 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -33990,22 +34017,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 33996 "src/ocaml/preprocess/parser_raw.ml"
+# 34023 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 34002 "src/ocaml/preprocess/parser_raw.ml"
+# 34029 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -34018,13 +34045,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 34022 "src/ocaml/preprocess/parser_raw.ml"
+# 34049 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34028 "src/ocaml/preprocess/parser_raw.ml"
+# 34055 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_e_ = _startpos__1_ in
@@ -34032,26 +34059,26 @@ module Tables = struct
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1543 "src/ocaml/preprocess/parser_raw.mly"
+# 1563 "src/ocaml/preprocess/parser_raw.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 34038 "src/ocaml/preprocess/parser_raw.ml"
+# 34065 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34046 "src/ocaml/preprocess/parser_raw.ml"
+# 34073 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34055 "src/ocaml/preprocess/parser_raw.ml"
+# 34082 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34123,24 +34150,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 34131 "src/ocaml/preprocess/parser_raw.ml"
+# 34158 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_ty2_ = _endpos__1_inlined1_ in
let e =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34139 "src/ocaml/preprocess/parser_raw.ml"
+# 34166 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34144 "src/ocaml/preprocess/parser_raw.ml"
+# 34171 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_e_ = _startpos__1_ in
@@ -34148,26 +34175,26 @@ module Tables = struct
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1545 "src/ocaml/preprocess/parser_raw.mly"
+# 1565 "src/ocaml/preprocess/parser_raw.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 34154 "src/ocaml/preprocess/parser_raw.ml"
+# 34181 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34162 "src/ocaml/preprocess/parser_raw.ml"
+# 34189 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34171 "src/ocaml/preprocess/parser_raw.ml"
+# 34198 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34260,11 +34287,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 34268 "src/ocaml/preprocess/parser_raw.ml"
+# 34295 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_ty2_ = _endpos__1_inlined3_ in
@@ -34275,18 +34302,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 34279 "src/ocaml/preprocess/parser_raw.ml"
+# 34306 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 34284 "src/ocaml/preprocess/parser_raw.ml"
+# 34311 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 34290 "src/ocaml/preprocess/parser_raw.ml"
+# 34317 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -34295,22 +34322,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34301 "src/ocaml/preprocess/parser_raw.ml"
+# 34328 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 34307 "src/ocaml/preprocess/parser_raw.ml"
+# 34334 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -34323,13 +34350,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 34327 "src/ocaml/preprocess/parser_raw.ml"
+# 34354 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34333 "src/ocaml/preprocess/parser_raw.ml"
+# 34360 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_e_ = _startpos__1_ in
@@ -34337,26 +34364,26 @@ module Tables = struct
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1545 "src/ocaml/preprocess/parser_raw.mly"
+# 1565 "src/ocaml/preprocess/parser_raw.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 34343 "src/ocaml/preprocess/parser_raw.ml"
+# 34370 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34351 "src/ocaml/preprocess/parser_raw.ml"
+# 34378 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1524 "src/ocaml/preprocess/parser_raw.mly"
+# 1544 "src/ocaml/preprocess/parser_raw.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34360 "src/ocaml/preprocess/parser_raw.ml"
+# 34387 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34386,9 +34413,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1418 "src/ocaml/preprocess/parser_raw.mly"
+# 1438 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34392 "src/ocaml/preprocess/parser_raw.ml"
+# 34419 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34418,9 +34445,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1403 "src/ocaml/preprocess/parser_raw.mly"
+# 1423 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34424 "src/ocaml/preprocess/parser_raw.ml"
+# 34451 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34450,9 +34477,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) =
-# 1378 "src/ocaml/preprocess/parser_raw.mly"
+# 1398 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34456 "src/ocaml/preprocess/parser_raw.ml"
+# 34483 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34482,9 +34509,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 1383 "src/ocaml/preprocess/parser_raw.mly"
+# 1403 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34488 "src/ocaml/preprocess/parser_raw.ml"
+# 34515 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34514,9 +34541,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1408 "src/ocaml/preprocess/parser_raw.mly"
+# 1428 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34520 "src/ocaml/preprocess/parser_raw.ml"
+# 34547 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34546,9 +34573,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1413 "src/ocaml/preprocess/parser_raw.mly"
+# 1433 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34552 "src/ocaml/preprocess/parser_raw.ml"
+# 34579 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34578,9 +34605,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.module_expr) =
-# 1373 "src/ocaml/preprocess/parser_raw.mly"
+# 1393 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34584 "src/ocaml/preprocess/parser_raw.ml"
+# 34611 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34610,9 +34637,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.module_type) =
-# 1368 "src/ocaml/preprocess/parser_raw.mly"
+# 1388 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34616 "src/ocaml/preprocess/parser_raw.ml"
+# 34643 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34642,9 +34669,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1393 "src/ocaml/preprocess/parser_raw.mly"
+# 1413 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34648 "src/ocaml/preprocess/parser_raw.ml"
+# 34675 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34674,9 +34701,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) =
-# 1388 "src/ocaml/preprocess/parser_raw.mly"
+# 1408 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34680 "src/ocaml/preprocess/parser_raw.ml"
+# 34707 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34706,9 +34733,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1398 "src/ocaml/preprocess/parser_raw.mly"
+# 1418 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34712 "src/ocaml/preprocess/parser_raw.ml"
+# 34739 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34750,15 +34777,15 @@ module Tables = struct
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 3031 "src/ocaml/preprocess/parser_raw.mly"
+# 3071 "src/ocaml/preprocess/parser_raw.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 34756 "src/ocaml/preprocess/parser_raw.ml"
+# 34783 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3019 "src/ocaml/preprocess/parser_raw.mly"
+# 3057 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34762 "src/ocaml/preprocess/parser_raw.ml"
+# 34789 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34788,14 +34815,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 3033 "src/ocaml/preprocess/parser_raw.mly"
+# 3073 "src/ocaml/preprocess/parser_raw.mly"
( Pat.attr _1 _2 )
-# 34794 "src/ocaml/preprocess/parser_raw.ml"
+# 34821 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3019 "src/ocaml/preprocess/parser_raw.mly"
+# 3057 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34799 "src/ocaml/preprocess/parser_raw.ml"
+# 34826 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34818,14 +34845,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 3035 "src/ocaml/preprocess/parser_raw.mly"
+# 3075 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34824 "src/ocaml/preprocess/parser_raw.ml"
+# 34851 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3019 "src/ocaml/preprocess/parser_raw.mly"
+# 3057 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34829 "src/ocaml/preprocess/parser_raw.ml"
+# 34856 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34870,15 +34897,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 34876 "src/ocaml/preprocess/parser_raw.ml"
+# 34903 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3038 "src/ocaml/preprocess/parser_raw.mly"
+# 3078 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_alias(_1, _3) )
-# 34882 "src/ocaml/preprocess/parser_raw.ml"
+# 34909 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -34886,21 +34913,21 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 34892 "src/ocaml/preprocess/parser_raw.ml"
+# 34919 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3049 "src/ocaml/preprocess/parser_raw.mly"
+# 3089 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34898 "src/ocaml/preprocess/parser_raw.ml"
+# 34925 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3019 "src/ocaml/preprocess/parser_raw.mly"
+# 3057 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34904 "src/ocaml/preprocess/parser_raw.ml"
+# 34931 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34925,29 +34952,29 @@ module Tables = struct
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 3042 "src/ocaml/preprocess/parser_raw.mly"
+# 3082 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_tuple(List.rev _1) )
-# 34931 "src/ocaml/preprocess/parser_raw.ml"
+# 34958 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 34939 "src/ocaml/preprocess/parser_raw.ml"
+# 34966 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3049 "src/ocaml/preprocess/parser_raw.mly"
+# 3089 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34945 "src/ocaml/preprocess/parser_raw.ml"
+# 34972 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3019 "src/ocaml/preprocess/parser_raw.mly"
+# 3057 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 34951 "src/ocaml/preprocess/parser_raw.ml"
+# 34978 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -34986,30 +35013,30 @@ module Tables = struct
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 3046 "src/ocaml/preprocess/parser_raw.mly"
+# 3086 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_or(_1, _3) )
-# 34992 "src/ocaml/preprocess/parser_raw.ml"
+# 35019 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35001 "src/ocaml/preprocess/parser_raw.ml"
+# 35028 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3049 "src/ocaml/preprocess/parser_raw.mly"
+# 3089 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35007 "src/ocaml/preprocess/parser_raw.ml"
+# 35034 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3019 "src/ocaml/preprocess/parser_raw.mly"
+# 3057 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35013 "src/ocaml/preprocess/parser_raw.ml"
+# 35040 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35057,24 +35084,73 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35063 "src/ocaml/preprocess/parser_raw.ml"
+# 35090 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 35069 "src/ocaml/preprocess/parser_raw.ml"
+# 35096 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3021 "src/ocaml/preprocess/parser_raw.mly"
+# 3059 "src/ocaml/preprocess/parser_raw.mly"
( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
-# 35078 "src/ocaml/preprocess/parser_raw.ml"
+# 35105 "src/ocaml/preprocess/parser_raw.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _4 : (Parsetree.pattern) = Obj.magic _4 in
+ let _3 : unit = Obj.magic _3 in
+ let _2 : (Parsetree.pattern) = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__4_ in
+ let _v : (Parsetree.pattern) = let _endpos = _endpos__4_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3061 "src/ocaml/preprocess/parser_raw.mly"
+ ( mkpat ~loc:_sloc (Ppat_effect(_2,_4)) )
+# 35154 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35111,9 +35187,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 3152 "src/ocaml/preprocess/parser_raw.mly"
+# 3193 "src/ocaml/preprocess/parser_raw.mly"
( _3 :: _1 )
-# 35117 "src/ocaml/preprocess/parser_raw.ml"
+# 35193 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35150,9 +35226,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 3153 "src/ocaml/preprocess/parser_raw.mly"
+# 3194 "src/ocaml/preprocess/parser_raw.mly"
( [_3; _1] )
-# 35156 "src/ocaml/preprocess/parser_raw.ml"
+# 35232 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35189,9 +35265,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 3152 "src/ocaml/preprocess/parser_raw.mly"
+# 3193 "src/ocaml/preprocess/parser_raw.mly"
( _3 :: _1 )
-# 35195 "src/ocaml/preprocess/parser_raw.ml"
+# 35271 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35228,9 +35304,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 3153 "src/ocaml/preprocess/parser_raw.mly"
+# 3194 "src/ocaml/preprocess/parser_raw.mly"
( [_3; _1] )
-# 35234 "src/ocaml/preprocess/parser_raw.ml"
+# 35310 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35253,9 +35329,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 3054 "src/ocaml/preprocess/parser_raw.mly"
+# 3094 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35259 "src/ocaml/preprocess/parser_raw.ml"
+# 35335 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35291,15 +35367,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 35297 "src/ocaml/preprocess/parser_raw.ml"
+# 35373 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3057 "src/ocaml/preprocess/parser_raw.mly"
+# 3097 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_construct(_1, Some ([], _2)) )
-# 35303 "src/ocaml/preprocess/parser_raw.ml"
+# 35379 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
@@ -35307,15 +35383,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35313 "src/ocaml/preprocess/parser_raw.ml"
+# 35389 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3063 "src/ocaml/preprocess/parser_raw.mly"
+# 3103 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35319 "src/ocaml/preprocess/parser_raw.ml"
+# 35395 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35375,24 +35451,24 @@ module Tables = struct
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let newtypes =
-# 2774 "src/ocaml/preprocess/parser_raw.mly"
+# 2812 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 35381 "src/ocaml/preprocess/parser_raw.ml"
+# 35457 "src/ocaml/preprocess/parser_raw.ml"
in
let constr =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 35390 "src/ocaml/preprocess/parser_raw.ml"
+# 35466 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3060 "src/ocaml/preprocess/parser_raw.mly"
+# 3100 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_construct(constr, Some (newtypes, pat)) )
-# 35396 "src/ocaml/preprocess/parser_raw.ml"
+# 35472 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_pat_ in
@@ -35400,15 +35476,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35406 "src/ocaml/preprocess/parser_raw.ml"
+# 35482 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3063 "src/ocaml/preprocess/parser_raw.mly"
+# 3103 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35412 "src/ocaml/preprocess/parser_raw.ml"
+# 35488 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35439,24 +35515,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3062 "src/ocaml/preprocess/parser_raw.mly"
+# 3102 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_variant(_1, Some _2) )
-# 35445 "src/ocaml/preprocess/parser_raw.ml"
+# 35521 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35454 "src/ocaml/preprocess/parser_raw.ml"
+# 35530 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3063 "src/ocaml/preprocess/parser_raw.mly"
+# 3103 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35460 "src/ocaml/preprocess/parser_raw.ml"
+# 35536 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35504,24 +35580,24 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35510 "src/ocaml/preprocess/parser_raw.ml"
+# 35586 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 35516 "src/ocaml/preprocess/parser_raw.ml"
+# 35592 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3065 "src/ocaml/preprocess/parser_raw.mly"
+# 3105 "src/ocaml/preprocess/parser_raw.mly"
( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2)
-# 35525 "src/ocaml/preprocess/parser_raw.ml"
+# 35601 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35563,15 +35639,15 @@ module Tables = struct
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 3031 "src/ocaml/preprocess/parser_raw.mly"
+# 3071 "src/ocaml/preprocess/parser_raw.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 35569 "src/ocaml/preprocess/parser_raw.ml"
+# 35645 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3026 "src/ocaml/preprocess/parser_raw.mly"
+# 3066 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35575 "src/ocaml/preprocess/parser_raw.ml"
+# 35651 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35601,14 +35677,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 3033 "src/ocaml/preprocess/parser_raw.mly"
+# 3073 "src/ocaml/preprocess/parser_raw.mly"
( Pat.attr _1 _2 )
-# 35607 "src/ocaml/preprocess/parser_raw.ml"
+# 35683 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3026 "src/ocaml/preprocess/parser_raw.mly"
+# 3066 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35612 "src/ocaml/preprocess/parser_raw.ml"
+# 35688 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35631,14 +35707,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 3035 "src/ocaml/preprocess/parser_raw.mly"
+# 3075 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35637 "src/ocaml/preprocess/parser_raw.ml"
+# 35713 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3026 "src/ocaml/preprocess/parser_raw.mly"
+# 3066 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35642 "src/ocaml/preprocess/parser_raw.ml"
+# 35718 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35683,15 +35759,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 35689 "src/ocaml/preprocess/parser_raw.ml"
+# 35765 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3038 "src/ocaml/preprocess/parser_raw.mly"
+# 3078 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_alias(_1, _3) )
-# 35695 "src/ocaml/preprocess/parser_raw.ml"
+# 35771 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -35699,21 +35775,21 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35705 "src/ocaml/preprocess/parser_raw.ml"
+# 35781 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3049 "src/ocaml/preprocess/parser_raw.mly"
+# 3089 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35711 "src/ocaml/preprocess/parser_raw.ml"
+# 35787 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3026 "src/ocaml/preprocess/parser_raw.mly"
+# 3066 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35717 "src/ocaml/preprocess/parser_raw.ml"
+# 35793 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35738,29 +35814,29 @@ module Tables = struct
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 3042 "src/ocaml/preprocess/parser_raw.mly"
+# 3082 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_tuple(List.rev _1) )
-# 35744 "src/ocaml/preprocess/parser_raw.ml"
+# 35820 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35752 "src/ocaml/preprocess/parser_raw.ml"
+# 35828 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3049 "src/ocaml/preprocess/parser_raw.mly"
+# 3089 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35758 "src/ocaml/preprocess/parser_raw.ml"
+# 35834 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3026 "src/ocaml/preprocess/parser_raw.mly"
+# 3066 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35764 "src/ocaml/preprocess/parser_raw.ml"
+# 35840 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35799,30 +35875,30 @@ module Tables = struct
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 3046 "src/ocaml/preprocess/parser_raw.mly"
+# 3086 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_or(_1, _3) )
-# 35805 "src/ocaml/preprocess/parser_raw.ml"
+# 35881 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35814 "src/ocaml/preprocess/parser_raw.ml"
+# 35890 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3049 "src/ocaml/preprocess/parser_raw.mly"
+# 3089 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35820 "src/ocaml/preprocess/parser_raw.ml"
+# 35896 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3026 "src/ocaml/preprocess/parser_raw.mly"
+# 3066 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35826 "src/ocaml/preprocess/parser_raw.ml"
+# 35902 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35841,9 +35917,9 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 35847 "src/ocaml/preprocess/parser_raw.ml"
+# 35923 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -35855,30 +35931,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 35861 "src/ocaml/preprocess/parser_raw.ml"
+# 35937 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2450 "src/ocaml/preprocess/parser_raw.mly"
+# 2468 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_var _1 )
-# 35867 "src/ocaml/preprocess/parser_raw.ml"
+# 35943 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35876 "src/ocaml/preprocess/parser_raw.ml"
+# 35952 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2452 "src/ocaml/preprocess/parser_raw.mly"
+# 2470 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35882 "src/ocaml/preprocess/parser_raw.ml"
+# 35958 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35902,23 +35978,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2451 "src/ocaml/preprocess/parser_raw.mly"
+# 2469 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_any )
-# 35908 "src/ocaml/preprocess/parser_raw.ml"
+# 35984 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 35916 "src/ocaml/preprocess/parser_raw.ml"
+# 35992 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2452 "src/ocaml/preprocess/parser_raw.mly"
+# 2470 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 35922 "src/ocaml/preprocess/parser_raw.ml"
+# 35998 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35941,9 +36017,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.payload) =
-# 4253 "src/ocaml/preprocess/parser_raw.mly"
+# 4301 "src/ocaml/preprocess/parser_raw.mly"
( PStr _1 )
-# 35947 "src/ocaml/preprocess/parser_raw.ml"
+# 36023 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -35973,9 +36049,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 4254 "src/ocaml/preprocess/parser_raw.mly"
+# 4302 "src/ocaml/preprocess/parser_raw.mly"
( PSig _2 )
-# 35979 "src/ocaml/preprocess/parser_raw.ml"
+# 36055 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36005,9 +36081,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 4255 "src/ocaml/preprocess/parser_raw.mly"
+# 4303 "src/ocaml/preprocess/parser_raw.mly"
( PTyp _2 )
-# 36011 "src/ocaml/preprocess/parser_raw.ml"
+# 36087 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36037,9 +36113,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 4256 "src/ocaml/preprocess/parser_raw.mly"
+# 4304 "src/ocaml/preprocess/parser_raw.mly"
( PPat (_2, None) )
-# 36043 "src/ocaml/preprocess/parser_raw.ml"
+# 36119 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36083,9 +36159,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.payload) =
-# 4257 "src/ocaml/preprocess/parser_raw.mly"
+# 4305 "src/ocaml/preprocess/parser_raw.mly"
( PPat (_2, Some _4) )
-# 36089 "src/ocaml/preprocess/parser_raw.ml"
+# 36165 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36108,9 +36184,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3590 "src/ocaml/preprocess/parser_raw.mly"
+# 3631 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36114 "src/ocaml/preprocess/parser_raw.ml"
+# 36190 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36153,24 +36229,24 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 36157 "src/ocaml/preprocess/parser_raw.ml"
+# 36233 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 36162 "src/ocaml/preprocess/parser_raw.ml"
+# 36238 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3582 "src/ocaml/preprocess/parser_raw.mly"
+# 3623 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36168 "src/ocaml/preprocess/parser_raw.ml"
+# 36244 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3586 "src/ocaml/preprocess/parser_raw.mly"
+# 3627 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_poly(_1, _3) )
-# 36174 "src/ocaml/preprocess/parser_raw.ml"
+# 36250 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in
@@ -36178,15 +36254,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 36184 "src/ocaml/preprocess/parser_raw.ml"
+# 36260 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3592 "src/ocaml/preprocess/parser_raw.mly"
+# 3633 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36190 "src/ocaml/preprocess/parser_raw.ml"
+# 36266 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36209,14 +36285,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3621 "src/ocaml/preprocess/parser_raw.mly"
+# 3662 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36215 "src/ocaml/preprocess/parser_raw.ml"
+# 36291 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3590 "src/ocaml/preprocess/parser_raw.mly"
+# 3631 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36220 "src/ocaml/preprocess/parser_raw.ml"
+# 36296 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36255,33 +36331,33 @@ module Tables = struct
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let _3 =
-# 3621 "src/ocaml/preprocess/parser_raw.mly"
+# 3662 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36261 "src/ocaml/preprocess/parser_raw.ml"
+# 36337 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
let _1 =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 36268 "src/ocaml/preprocess/parser_raw.ml"
+# 36344 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1129 "src/ocaml/preprocess/parser_raw.mly"
+# 1149 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 36273 "src/ocaml/preprocess/parser_raw.ml"
+# 36349 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3582 "src/ocaml/preprocess/parser_raw.mly"
+# 3623 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36279 "src/ocaml/preprocess/parser_raw.ml"
+# 36355 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3586 "src/ocaml/preprocess/parser_raw.mly"
+# 3627 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_poly(_1, _3) )
-# 36285 "src/ocaml/preprocess/parser_raw.ml"
+# 36361 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_xs_ in
@@ -36289,15 +36365,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 36295 "src/ocaml/preprocess/parser_raw.ml"
+# 36371 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3592 "src/ocaml/preprocess/parser_raw.mly"
+# 3633 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36301 "src/ocaml/preprocess/parser_raw.ml"
+# 36377 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36344,9 +36420,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4214 "src/ocaml/preprocess/parser_raw.mly"
+# 4262 "src/ocaml/preprocess/parser_raw.mly"
( mk_attr ~loc:(make_loc _sloc) _2 _3 )
-# 36350 "src/ocaml/preprocess/parser_raw.ml"
+# 36426 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36427,9 +36503,9 @@ module Tables = struct
let _v : (Parsetree.value_description * string Location.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36433 "src/ocaml/preprocess/parser_raw.ml"
+# 36509 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -36439,30 +36515,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 36445 "src/ocaml/preprocess/parser_raw.ml"
+# 36521 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36453 "src/ocaml/preprocess/parser_raw.ml"
+# 36529 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3216 "src/ocaml/preprocess/parser_raw.mly"
+# 3257 "src/ocaml/preprocess/parser_raw.mly"
( let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Val.mk id ty ~prim ~attrs ~loc ~docs,
ext )
-# 36466 "src/ocaml/preprocess/parser_raw.ml"
+# 36542 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36478,14 +36554,14 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag) = let _1 =
-# 4082 "src/ocaml/preprocess/parser_raw.mly"
+# 4130 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 36484 "src/ocaml/preprocess/parser_raw.ml"
+# 36560 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4079 "src/ocaml/preprocess/parser_raw.mly"
+# 4127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36489 "src/ocaml/preprocess/parser_raw.ml"
+# 36565 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36508,14 +36584,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) = let _1 =
-# 4083 "src/ocaml/preprocess/parser_raw.mly"
+# 4131 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 36514 "src/ocaml/preprocess/parser_raw.ml"
+# 36590 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4079 "src/ocaml/preprocess/parser_raw.mly"
+# 4127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36519 "src/ocaml/preprocess/parser_raw.ml"
+# 36595 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36531,9 +36607,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 4105 "src/ocaml/preprocess/parser_raw.mly"
+# 4153 "src/ocaml/preprocess/parser_raw.mly"
( Public, Concrete )
-# 36537 "src/ocaml/preprocess/parser_raw.ml"
+# 36613 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36556,9 +36632,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 4106 "src/ocaml/preprocess/parser_raw.mly"
+# 4154 "src/ocaml/preprocess/parser_raw.mly"
( Private, Concrete )
-# 36562 "src/ocaml/preprocess/parser_raw.ml"
+# 36638 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36581,9 +36657,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 4107 "src/ocaml/preprocess/parser_raw.mly"
+# 4155 "src/ocaml/preprocess/parser_raw.mly"
( Public, Virtual )
-# 36587 "src/ocaml/preprocess/parser_raw.ml"
+# 36663 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36613,9 +36689,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 4108 "src/ocaml/preprocess/parser_raw.mly"
+# 4156 "src/ocaml/preprocess/parser_raw.mly"
( Private, Virtual )
-# 36619 "src/ocaml/preprocess/parser_raw.ml"
+# 36695 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36645,9 +36721,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 4109 "src/ocaml/preprocess/parser_raw.mly"
+# 4157 "src/ocaml/preprocess/parser_raw.mly"
( Private, Virtual )
-# 36651 "src/ocaml/preprocess/parser_raw.ml"
+# 36727 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36663,9 +36739,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.rec_flag) =
-# 4060 "src/ocaml/preprocess/parser_raw.mly"
+# 4108 "src/ocaml/preprocess/parser_raw.mly"
( Nonrecursive )
-# 36669 "src/ocaml/preprocess/parser_raw.ml"
+# 36745 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36688,9 +36764,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.rec_flag) =
-# 4061 "src/ocaml/preprocess/parser_raw.mly"
+# 4109 "src/ocaml/preprocess/parser_raw.mly"
( Recursive )
-# 36694 "src/ocaml/preprocess/parser_raw.ml"
+# 36770 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36716,12 +36792,12 @@ module Tables = struct
(Longident.t Location.loc * Parsetree.expression) list) = let eo =
# 124 "<standard.mly>"
( None )
-# 36720 "src/ocaml/preprocess/parser_raw.ml"
+# 36796 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2951 "src/ocaml/preprocess/parser_raw.mly"
+# 2989 "src/ocaml/preprocess/parser_raw.mly"
( eo, fields )
-# 36725 "src/ocaml/preprocess/parser_raw.ml"
+# 36801 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36762,18 +36838,18 @@ module Tables = struct
let x =
# 191 "<standard.mly>"
( x )
-# 36766 "src/ocaml/preprocess/parser_raw.ml"
+# 36842 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 36771 "src/ocaml/preprocess/parser_raw.ml"
+# 36847 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2951 "src/ocaml/preprocess/parser_raw.mly"
+# 2989 "src/ocaml/preprocess/parser_raw.mly"
( eo, fields )
-# 36777 "src/ocaml/preprocess/parser_raw.ml"
+# 36853 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36798,17 +36874,17 @@ module Tables = struct
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 3403 "src/ocaml/preprocess/parser_raw.mly"
+# 3444 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 36807 "src/ocaml/preprocess/parser_raw.ml"
+# 36883 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1260 "src/ocaml/preprocess/parser_raw.mly"
+# 1280 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 36812 "src/ocaml/preprocess/parser_raw.ml"
+# 36888 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36833,17 +36909,17 @@ module Tables = struct
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 3403 "src/ocaml/preprocess/parser_raw.mly"
+# 3444 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 36842 "src/ocaml/preprocess/parser_raw.ml"
+# 36918 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1263 "src/ocaml/preprocess/parser_raw.mly"
+# 1283 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 36847 "src/ocaml/preprocess/parser_raw.ml"
+# 36923 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36875,17 +36951,17 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 3403 "src/ocaml/preprocess/parser_raw.mly"
+# 3444 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 36884 "src/ocaml/preprocess/parser_raw.ml"
+# 36960 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1267 "src/ocaml/preprocess/parser_raw.mly"
+# 1287 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 36889 "src/ocaml/preprocess/parser_raw.ml"
+# 36965 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36911,23 +36987,23 @@ module Tables = struct
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3520 "src/ocaml/preprocess/parser_raw.mly"
+# 3561 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 36920 "src/ocaml/preprocess/parser_raw.ml"
+# 36996 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3514 "src/ocaml/preprocess/parser_raw.mly"
+# 3555 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36925 "src/ocaml/preprocess/parser_raw.ml"
+# 37001 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1260 "src/ocaml/preprocess/parser_raw.mly"
+# 1280 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 36931 "src/ocaml/preprocess/parser_raw.ml"
+# 37007 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36950,14 +37026,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3516 "src/ocaml/preprocess/parser_raw.mly"
+# 3557 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36956 "src/ocaml/preprocess/parser_raw.ml"
+# 37032 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1260 "src/ocaml/preprocess/parser_raw.mly"
+# 1280 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 36961 "src/ocaml/preprocess/parser_raw.ml"
+# 37037 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -36983,23 +37059,23 @@ module Tables = struct
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3520 "src/ocaml/preprocess/parser_raw.mly"
+# 3561 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 36992 "src/ocaml/preprocess/parser_raw.ml"
+# 37068 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3514 "src/ocaml/preprocess/parser_raw.mly"
+# 3555 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 36997 "src/ocaml/preprocess/parser_raw.ml"
+# 37073 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1263 "src/ocaml/preprocess/parser_raw.mly"
+# 1283 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 37003 "src/ocaml/preprocess/parser_raw.ml"
+# 37079 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37022,14 +37098,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3516 "src/ocaml/preprocess/parser_raw.mly"
+# 3557 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 37028 "src/ocaml/preprocess/parser_raw.ml"
+# 37104 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1263 "src/ocaml/preprocess/parser_raw.mly"
+# 1283 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 37033 "src/ocaml/preprocess/parser_raw.ml"
+# 37109 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37062,23 +37138,23 @@ module Tables = struct
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3520 "src/ocaml/preprocess/parser_raw.mly"
+# 3561 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 37071 "src/ocaml/preprocess/parser_raw.ml"
+# 37147 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3514 "src/ocaml/preprocess/parser_raw.mly"
+# 3555 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 37076 "src/ocaml/preprocess/parser_raw.ml"
+# 37152 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1267 "src/ocaml/preprocess/parser_raw.mly"
+# 1287 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37082 "src/ocaml/preprocess/parser_raw.ml"
+# 37158 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37108,14 +37184,14 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3516 "src/ocaml/preprocess/parser_raw.mly"
+# 3557 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 37114 "src/ocaml/preprocess/parser_raw.ml"
+# 37190 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1267 "src/ocaml/preprocess/parser_raw.mly"
+# 1287 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37119 "src/ocaml/preprocess/parser_raw.ml"
+# 37195 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37140,17 +37216,17 @@ module Tables = struct
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3520 "src/ocaml/preprocess/parser_raw.mly"
+# 3561 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 37149 "src/ocaml/preprocess/parser_raw.ml"
+# 37225 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1260 "src/ocaml/preprocess/parser_raw.mly"
+# 1280 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 37154 "src/ocaml/preprocess/parser_raw.ml"
+# 37230 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37175,17 +37251,17 @@ module Tables = struct
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3520 "src/ocaml/preprocess/parser_raw.mly"
+# 3561 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 37184 "src/ocaml/preprocess/parser_raw.ml"
+# 37260 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1263 "src/ocaml/preprocess/parser_raw.mly"
+# 1283 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 37189 "src/ocaml/preprocess/parser_raw.ml"
+# 37265 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37217,17 +37293,17 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3520 "src/ocaml/preprocess/parser_raw.mly"
+# 3561 "src/ocaml/preprocess/parser_raw.mly"
(
let cid, vars, args, res, attrs, loc, info = d in
Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 37226 "src/ocaml/preprocess/parser_raw.ml"
+# 37302 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1267 "src/ocaml/preprocess/parser_raw.mly"
+# 1287 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37231 "src/ocaml/preprocess/parser_raw.ml"
+# 37307 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37243,9 +37319,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * Parsetree.core_type * Location.t) list) =
-# 1105 "src/ocaml/preprocess/parser_raw.mly"
+# 1125 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 37249 "src/ocaml/preprocess/parser_raw.ml"
+# 37325 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37302,21 +37378,21 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2299 "src/ocaml/preprocess/parser_raw.mly"
+# 2317 "src/ocaml/preprocess/parser_raw.mly"
( _1, _3, make_loc _sloc )
-# 37308 "src/ocaml/preprocess/parser_raw.ml"
+# 37384 "src/ocaml/preprocess/parser_raw.ml"
in
# 183 "<standard.mly>"
( x )
-# 37314 "src/ocaml/preprocess/parser_raw.ml"
+# 37390 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1107 "src/ocaml/preprocess/parser_raw.mly"
+# 1127 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37320 "src/ocaml/preprocess/parser_raw.ml"
+# 37396 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37339,9 +37415,9 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.function_param list) =
-# 1138 "src/ocaml/preprocess/parser_raw.mly"
+# 1158 "src/ocaml/preprocess/parser_raw.mly"
( List.rev x )
-# 37345 "src/ocaml/preprocess/parser_raw.ml"
+# 37421 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37371,9 +37447,9 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.function_param list) =
-# 1140 "src/ocaml/preprocess/parser_raw.mly"
+# 1160 "src/ocaml/preprocess/parser_raw.mly"
( List.rev_append x xs )
-# 37377 "src/ocaml/preprocess/parser_raw.ml"
+# 37453 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37396,9 +37472,9 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
-# 1119 "src/ocaml/preprocess/parser_raw.mly"
+# 1139 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 37402 "src/ocaml/preprocess/parser_raw.ml"
+# 37478 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37428,9 +37504,9 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
-# 1121 "src/ocaml/preprocess/parser_raw.mly"
+# 1141 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37434 "src/ocaml/preprocess/parser_raw.ml"
+# 37510 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37453,9 +37529,9 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 1119 "src/ocaml/preprocess/parser_raw.mly"
+# 1139 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 37459 "src/ocaml/preprocess/parser_raw.ml"
+# 37535 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37485,9 +37561,9 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 1121 "src/ocaml/preprocess/parser_raw.mly"
+# 1141 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37491 "src/ocaml/preprocess/parser_raw.ml"
+# 37567 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37510,9 +37586,9 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (string list) =
-# 1119 "src/ocaml/preprocess/parser_raw.mly"
+# 1139 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 37516 "src/ocaml/preprocess/parser_raw.ml"
+# 37592 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37542,9 +37618,9 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (string list) =
-# 1121 "src/ocaml/preprocess/parser_raw.mly"
+# 1141 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37548 "src/ocaml/preprocess/parser_raw.ml"
+# 37624 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37578,15 +37654,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3578 "src/ocaml/preprocess/parser_raw.mly"
+# 3619 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _2 _sloc )
-# 37584 "src/ocaml/preprocess/parser_raw.ml"
+# 37660 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1119 "src/ocaml/preprocess/parser_raw.mly"
+# 1139 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 37590 "src/ocaml/preprocess/parser_raw.ml"
+# 37666 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37627,15 +37703,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3578 "src/ocaml/preprocess/parser_raw.mly"
+# 3619 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _2 _sloc )
-# 37633 "src/ocaml/preprocess/parser_raw.ml"
+# 37709 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1121 "src/ocaml/preprocess/parser_raw.mly"
+# 1141 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37639 "src/ocaml/preprocess/parser_raw.ml"
+# 37715 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37660,12 +37736,12 @@ module Tables = struct
let _v : (Parsetree.case list) = let _1 =
# 124 "<standard.mly>"
( None )
-# 37664 "src/ocaml/preprocess/parser_raw.ml"
+# 37740 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1231 "src/ocaml/preprocess/parser_raw.mly"
+# 1251 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 37669 "src/ocaml/preprocess/parser_raw.ml"
+# 37745 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37699,13 +37775,13 @@ module Tables = struct
# 126 "<standard.mly>"
( Some x )
-# 37703 "src/ocaml/preprocess/parser_raw.ml"
+# 37779 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1231 "src/ocaml/preprocess/parser_raw.mly"
+# 1251 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 37709 "src/ocaml/preprocess/parser_raw.ml"
+# 37785 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37742,9 +37818,9 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.case list) =
-# 1235 "src/ocaml/preprocess/parser_raw.mly"
+# 1255 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37748 "src/ocaml/preprocess/parser_raw.ml"
+# 37824 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37768,20 +37844,20 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3621 "src/ocaml/preprocess/parser_raw.mly"
+# 3662 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 37774 "src/ocaml/preprocess/parser_raw.ml"
+# 37850 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1166 "src/ocaml/preprocess/parser_raw.mly"
+# 1186 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 37779 "src/ocaml/preprocess/parser_raw.ml"
+# 37855 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 37785 "src/ocaml/preprocess/parser_raw.ml"
+# 37861 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37819,20 +37895,20 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3621 "src/ocaml/preprocess/parser_raw.mly"
+# 3662 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 37825 "src/ocaml/preprocess/parser_raw.ml"
+# 37901 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1170 "src/ocaml/preprocess/parser_raw.mly"
+# 1190 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37830 "src/ocaml/preprocess/parser_raw.ml"
+# 37906 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 37836 "src/ocaml/preprocess/parser_raw.ml"
+# 37912 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37855,14 +37931,14 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 1166 "src/ocaml/preprocess/parser_raw.mly"
+# 1186 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 37861 "src/ocaml/preprocess/parser_raw.ml"
+# 37937 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 37866 "src/ocaml/preprocess/parser_raw.ml"
+# 37942 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37899,14 +37975,14 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 1170 "src/ocaml/preprocess/parser_raw.mly"
+# 1190 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37905 "src/ocaml/preprocess/parser_raw.ml"
+# 37981 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 37910 "src/ocaml/preprocess/parser_raw.ml"
+# 37986 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37929,14 +38005,14 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 1166 "src/ocaml/preprocess/parser_raw.mly"
+# 1186 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 37935 "src/ocaml/preprocess/parser_raw.ml"
+# 38011 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 37940 "src/ocaml/preprocess/parser_raw.ml"
+# 38016 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -37973,14 +38049,14 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 1170 "src/ocaml/preprocess/parser_raw.mly"
+# 1190 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 37979 "src/ocaml/preprocess/parser_raw.ml"
+# 38055 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 37984 "src/ocaml/preprocess/parser_raw.ml"
+# 38060 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38003,14 +38079,14 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1166 "src/ocaml/preprocess/parser_raw.mly"
+# 1186 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 38009 "src/ocaml/preprocess/parser_raw.ml"
+# 38085 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38014 "src/ocaml/preprocess/parser_raw.ml"
+# 38090 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38047,14 +38123,14 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1170 "src/ocaml/preprocess/parser_raw.mly"
+# 1190 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 38053 "src/ocaml/preprocess/parser_raw.ml"
+# 38129 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38058 "src/ocaml/preprocess/parser_raw.ml"
+# 38134 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38077,14 +38153,14 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
-# 1166 "src/ocaml/preprocess/parser_raw.mly"
+# 1186 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 38083 "src/ocaml/preprocess/parser_raw.ml"
+# 38159 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38088 "src/ocaml/preprocess/parser_raw.ml"
+# 38164 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38121,14 +38197,14 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
-# 1170 "src/ocaml/preprocess/parser_raw.mly"
+# 1190 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 38127 "src/ocaml/preprocess/parser_raw.ml"
+# 38203 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38132 "src/ocaml/preprocess/parser_raw.ml"
+# 38208 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38151,14 +38227,14 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1166 "src/ocaml/preprocess/parser_raw.mly"
+# 1186 "src/ocaml/preprocess/parser_raw.mly"
( [ x ] )
-# 38157 "src/ocaml/preprocess/parser_raw.ml"
+# 38233 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38162 "src/ocaml/preprocess/parser_raw.ml"
+# 38238 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38195,14 +38271,14 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1170 "src/ocaml/preprocess/parser_raw.mly"
+# 1190 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 38201 "src/ocaml/preprocess/parser_raw.ml"
+# 38277 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1174 "src/ocaml/preprocess/parser_raw.mly"
+# 1194 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38206 "src/ocaml/preprocess/parser_raw.ml"
+# 38282 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38239,9 +38315,9 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 1197 "src/ocaml/preprocess/parser_raw.mly"
+# 1217 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 38245 "src/ocaml/preprocess/parser_raw.ml"
+# 38321 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38278,9 +38354,9 @@ module Tables = struct
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 1201 "src/ocaml/preprocess/parser_raw.mly"
+# 1221 "src/ocaml/preprocess/parser_raw.mly"
( [ x2; x1 ] )
-# 38284 "src/ocaml/preprocess/parser_raw.ml"
+# 38360 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38318,20 +38394,20 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression list) = let x =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38324 "src/ocaml/preprocess/parser_raw.ml"
+# 38400 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38329 "src/ocaml/preprocess/parser_raw.ml"
+# 38405 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1197 "src/ocaml/preprocess/parser_raw.mly"
+# 1217 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 38335 "src/ocaml/preprocess/parser_raw.ml"
+# 38411 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38396,18 +38472,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 38400 "src/ocaml/preprocess/parser_raw.ml"
+# 38476 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38405 "src/ocaml/preprocess/parser_raw.ml"
+# 38481 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38411 "src/ocaml/preprocess/parser_raw.ml"
+# 38487 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -38416,22 +38492,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38422 "src/ocaml/preprocess/parser_raw.ml"
+# 38498 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 38428 "src/ocaml/preprocess/parser_raw.ml"
+# 38504 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -38444,19 +38520,19 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 38448 "src/ocaml/preprocess/parser_raw.ml"
+# 38524 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38454 "src/ocaml/preprocess/parser_raw.ml"
+# 38530 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1197 "src/ocaml/preprocess/parser_raw.mly"
+# 1217 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 38460 "src/ocaml/preprocess/parser_raw.ml"
+# 38536 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38495,32 +38571,32 @@ module Tables = struct
let _v : (Parsetree.expression list) = let x2 =
let _1 = _1_inlined1 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38501 "src/ocaml/preprocess/parser_raw.ml"
+# 38577 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38506 "src/ocaml/preprocess/parser_raw.ml"
+# 38582 "src/ocaml/preprocess/parser_raw.ml"
in
let x1 =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38513 "src/ocaml/preprocess/parser_raw.ml"
+# 38589 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38518 "src/ocaml/preprocess/parser_raw.ml"
+# 38594 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1201 "src/ocaml/preprocess/parser_raw.mly"
+# 1221 "src/ocaml/preprocess/parser_raw.mly"
( [ x2; x1 ] )
-# 38524 "src/ocaml/preprocess/parser_raw.ml"
+# 38600 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38585,18 +38661,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 38589 "src/ocaml/preprocess/parser_raw.ml"
+# 38665 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38594 "src/ocaml/preprocess/parser_raw.ml"
+# 38670 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38600 "src/ocaml/preprocess/parser_raw.ml"
+# 38676 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -38605,22 +38681,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38611 "src/ocaml/preprocess/parser_raw.ml"
+# 38687 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 38617 "src/ocaml/preprocess/parser_raw.ml"
+# 38693 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -38633,31 +38709,31 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 38637 "src/ocaml/preprocess/parser_raw.ml"
+# 38713 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38643 "src/ocaml/preprocess/parser_raw.ml"
+# 38719 "src/ocaml/preprocess/parser_raw.ml"
in
let x1 =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38650 "src/ocaml/preprocess/parser_raw.ml"
+# 38726 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38655 "src/ocaml/preprocess/parser_raw.ml"
+# 38731 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1201 "src/ocaml/preprocess/parser_raw.mly"
+# 1221 "src/ocaml/preprocess/parser_raw.mly"
( [ x2; x1 ] )
-# 38661 "src/ocaml/preprocess/parser_raw.ml"
+# 38737 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38717,14 +38793,14 @@ module Tables = struct
let _v : (Parsetree.expression list) = let x2 =
let _1 = _1_inlined3 in
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38723 "src/ocaml/preprocess/parser_raw.ml"
+# 38799 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38728 "src/ocaml/preprocess/parser_raw.ml"
+# 38804 "src/ocaml/preprocess/parser_raw.ml"
in
let x1 =
@@ -38734,18 +38810,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 38738 "src/ocaml/preprocess/parser_raw.ml"
+# 38814 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38743 "src/ocaml/preprocess/parser_raw.ml"
+# 38819 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38749 "src/ocaml/preprocess/parser_raw.ml"
+# 38825 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -38754,22 +38830,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38760 "src/ocaml/preprocess/parser_raw.ml"
+# 38836 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 38766 "src/ocaml/preprocess/parser_raw.ml"
+# 38842 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -38782,19 +38858,19 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 38786 "src/ocaml/preprocess/parser_raw.ml"
+# 38862 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38792 "src/ocaml/preprocess/parser_raw.ml"
+# 38868 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1201 "src/ocaml/preprocess/parser_raw.mly"
+# 1221 "src/ocaml/preprocess/parser_raw.mly"
( [ x2; x1 ] )
-# 38798 "src/ocaml/preprocess/parser_raw.ml"
+# 38874 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -38880,18 +38956,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 38884 "src/ocaml/preprocess/parser_raw.ml"
+# 38960 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38889 "src/ocaml/preprocess/parser_raw.ml"
+# 38965 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38895 "src/ocaml/preprocess/parser_raw.ml"
+# 38971 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -38900,22 +38976,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38906 "src/ocaml/preprocess/parser_raw.ml"
+# 38982 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 38912 "src/ocaml/preprocess/parser_raw.ml"
+# 38988 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -38928,13 +39004,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 38932 "src/ocaml/preprocess/parser_raw.ml"
+# 39008 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38938 "src/ocaml/preprocess/parser_raw.ml"
+# 39014 "src/ocaml/preprocess/parser_raw.ml"
in
let x1 =
@@ -38944,18 +39020,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 38948 "src/ocaml/preprocess/parser_raw.ml"
+# 39024 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38953 "src/ocaml/preprocess/parser_raw.ml"
+# 39029 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 38959 "src/ocaml/preprocess/parser_raw.ml"
+# 39035 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -38964,22 +39040,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 38970 "src/ocaml/preprocess/parser_raw.ml"
+# 39046 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 38976 "src/ocaml/preprocess/parser_raw.ml"
+# 39052 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -38992,19 +39068,19 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 38996 "src/ocaml/preprocess/parser_raw.ml"
+# 39072 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39002 "src/ocaml/preprocess/parser_raw.ml"
+# 39078 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1201 "src/ocaml/preprocess/parser_raw.mly"
+# 1221 "src/ocaml/preprocess/parser_raw.mly"
( [ x2; x1 ] )
-# 39008 "src/ocaml/preprocess/parser_raw.ml"
+# 39084 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39041,9 +39117,9 @@ module Tables = struct
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 1197 "src/ocaml/preprocess/parser_raw.mly"
+# 1217 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 39047 "src/ocaml/preprocess/parser_raw.ml"
+# 39123 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39080,9 +39156,9 @@ module Tables = struct
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 1201 "src/ocaml/preprocess/parser_raw.mly"
+# 1221 "src/ocaml/preprocess/parser_raw.mly"
( [ x2; x1 ] )
-# 39086 "src/ocaml/preprocess/parser_raw.ml"
+# 39162 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39105,9 +39181,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.row_field) =
-# 3817 "src/ocaml/preprocess/parser_raw.mly"
+# 3858 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39111 "src/ocaml/preprocess/parser_raw.ml"
+# 39187 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39133,9 +39209,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3819 "src/ocaml/preprocess/parser_raw.mly"
+# 3860 "src/ocaml/preprocess/parser_raw.mly"
( Rf.inherit_ ~loc:(make_loc _sloc) _1 )
-# 39139 "src/ocaml/preprocess/parser_raw.ml"
+# 39215 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39160,24 +39236,24 @@ module Tables = struct
let _v : (Parsetree.expression list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 39164 "src/ocaml/preprocess/parser_raw.ml"
+# 39240 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39170 "src/ocaml/preprocess/parser_raw.ml"
+# 39246 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39175 "src/ocaml/preprocess/parser_raw.ml"
+# 39251 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39181 "src/ocaml/preprocess/parser_raw.ml"
+# 39257 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39209,24 +39285,24 @@ module Tables = struct
let _v : (Parsetree.expression list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 39213 "src/ocaml/preprocess/parser_raw.ml"
+# 39289 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39219 "src/ocaml/preprocess/parser_raw.ml"
+# 39295 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39224 "src/ocaml/preprocess/parser_raw.ml"
+# 39300 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39230 "src/ocaml/preprocess/parser_raw.ml"
+# 39306 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39272,7 +39348,7 @@ module Tables = struct
let _v : (Parsetree.expression list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 39276 "src/ocaml/preprocess/parser_raw.ml"
+# 39352 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let _1 =
@@ -39281,18 +39357,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 39285 "src/ocaml/preprocess/parser_raw.ml"
+# 39361 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 39290 "src/ocaml/preprocess/parser_raw.ml"
+# 39366 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 39296 "src/ocaml/preprocess/parser_raw.ml"
+# 39372 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -39301,22 +39377,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39307 "src/ocaml/preprocess/parser_raw.ml"
+# 39383 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 39313 "src/ocaml/preprocess/parser_raw.ml"
+# 39389 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -39329,19 +39405,19 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 39333 "src/ocaml/preprocess/parser_raw.ml"
+# 39409 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39339 "src/ocaml/preprocess/parser_raw.ml"
+# 39415 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39345 "src/ocaml/preprocess/parser_raw.ml"
+# 39421 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39394,7 +39470,7 @@ module Tables = struct
let _v : (Parsetree.expression list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 39398 "src/ocaml/preprocess/parser_raw.ml"
+# 39474 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let _1 =
@@ -39403,18 +39479,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 39407 "src/ocaml/preprocess/parser_raw.ml"
+# 39483 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 39412 "src/ocaml/preprocess/parser_raw.ml"
+# 39488 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 39418 "src/ocaml/preprocess/parser_raw.ml"
+# 39494 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -39423,22 +39499,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39429 "src/ocaml/preprocess/parser_raw.ml"
+# 39505 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 39435 "src/ocaml/preprocess/parser_raw.ml"
+# 39511 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -39451,19 +39527,19 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 39455 "src/ocaml/preprocess/parser_raw.ml"
+# 39531 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39461 "src/ocaml/preprocess/parser_raw.ml"
+# 39537 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39467 "src/ocaml/preprocess/parser_raw.ml"
+# 39543 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39501,20 +39577,20 @@ module Tables = struct
let _endpos = _endpos_xs_ in
let _v : (Parsetree.expression list) = let x =
let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39507 "src/ocaml/preprocess/parser_raw.ml"
+# 39583 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39512 "src/ocaml/preprocess/parser_raw.ml"
+# 39588 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1222 "src/ocaml/preprocess/parser_raw.mly"
+# 1242 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 39518 "src/ocaml/preprocess/parser_raw.ml"
+# 39594 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39579,18 +39655,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 39583 "src/ocaml/preprocess/parser_raw.ml"
+# 39659 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 39588 "src/ocaml/preprocess/parser_raw.ml"
+# 39664 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 39594 "src/ocaml/preprocess/parser_raw.ml"
+# 39670 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -39599,22 +39675,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39605 "src/ocaml/preprocess/parser_raw.ml"
+# 39681 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 39611 "src/ocaml/preprocess/parser_raw.ml"
+# 39687 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -39627,19 +39703,19 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 39631 "src/ocaml/preprocess/parser_raw.ml"
+# 39707 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
+# 2553 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39637 "src/ocaml/preprocess/parser_raw.ml"
+# 39713 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1222 "src/ocaml/preprocess/parser_raw.mly"
+# 1242 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 39643 "src/ocaml/preprocess/parser_raw.ml"
+# 39719 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39665,9 +39741,9 @@ module Tables = struct
} = _menhir_stack in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 39671 "src/ocaml/preprocess/parser_raw.ml"
+# 39747 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -39675,26 +39751,26 @@ module Tables = struct
let _v : ((string Location.loc * Parsetree.expression) list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 39679 "src/ocaml/preprocess/parser_raw.ml"
+# 39755 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let label =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39686 "src/ocaml/preprocess/parser_raw.ml"
+# 39762 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 39694 "src/ocaml/preprocess/parser_raw.ml"
+# 39770 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2974 "src/ocaml/preprocess/parser_raw.mly"
+# 3012 "src/ocaml/preprocess/parser_raw.mly"
( let label, e =
match oe with
| None ->
@@ -39704,13 +39780,13 @@ module Tables = struct
label, e
in
label, e )
-# 39708 "src/ocaml/preprocess/parser_raw.ml"
+# 39784 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39714 "src/ocaml/preprocess/parser_raw.ml"
+# 39790 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39743,9 +39819,9 @@ module Tables = struct
let x : unit = Obj.magic x in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 39749 "src/ocaml/preprocess/parser_raw.ml"
+# 39825 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -39753,26 +39829,26 @@ module Tables = struct
let _v : ((string Location.loc * Parsetree.expression) list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 39757 "src/ocaml/preprocess/parser_raw.ml"
+# 39833 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let label =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39764 "src/ocaml/preprocess/parser_raw.ml"
+# 39840 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 39772 "src/ocaml/preprocess/parser_raw.ml"
+# 39848 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2974 "src/ocaml/preprocess/parser_raw.mly"
+# 3012 "src/ocaml/preprocess/parser_raw.mly"
( let label, e =
match oe with
| None ->
@@ -39782,13 +39858,13 @@ module Tables = struct
label, e
in
label, e )
-# 39786 "src/ocaml/preprocess/parser_raw.ml"
+# 39862 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39792 "src/ocaml/preprocess/parser_raw.ml"
+# 39868 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39828,9 +39904,9 @@ module Tables = struct
let _2 : unit = Obj.magic _2 in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 39834 "src/ocaml/preprocess/parser_raw.ml"
+# 39910 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -39838,21 +39914,21 @@ module Tables = struct
let _v : ((string Location.loc * Parsetree.expression) list) = let x =
let label =
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 39844 "src/ocaml/preprocess/parser_raw.ml"
+# 39920 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 39852 "src/ocaml/preprocess/parser_raw.ml"
+# 39928 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2974 "src/ocaml/preprocess/parser_raw.mly"
+# 3012 "src/ocaml/preprocess/parser_raw.mly"
( let label, e =
match oe with
| None ->
@@ -39862,13 +39938,13 @@ module Tables = struct
label, e
in
label, e )
-# 39866 "src/ocaml/preprocess/parser_raw.ml"
+# 39942 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1222 "src/ocaml/preprocess/parser_raw.mly"
+# 1242 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 39872 "src/ocaml/preprocess/parser_raw.ml"
+# 39948 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39893,12 +39969,12 @@ module Tables = struct
let _v : (Parsetree.pattern list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 39897 "src/ocaml/preprocess/parser_raw.ml"
+# 39973 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39902 "src/ocaml/preprocess/parser_raw.ml"
+# 39978 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39932,13 +40008,13 @@ module Tables = struct
# 126 "<standard.mly>"
( Some x )
-# 39936 "src/ocaml/preprocess/parser_raw.ml"
+# 40012 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 39942 "src/ocaml/preprocess/parser_raw.ml"
+# 40018 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -39975,9 +40051,9 @@ module Tables = struct
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.pattern list) =
-# 1222 "src/ocaml/preprocess/parser_raw.mly"
+# 1242 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 39981 "src/ocaml/preprocess/parser_raw.ml"
+# 40057 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40016,7 +40092,7 @@ module Tables = struct
let _v : ((Longident.t Location.loc * Parsetree.expression) list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 40020 "src/ocaml/preprocess/parser_raw.ml"
+# 40096 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let label =
@@ -40024,9 +40100,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 40030 "src/ocaml/preprocess/parser_raw.ml"
+# 40106 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_label_ = _startpos__1_ in
@@ -40034,7 +40110,7 @@ module Tables = struct
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2957 "src/ocaml/preprocess/parser_raw.mly"
+# 2995 "src/ocaml/preprocess/parser_raw.mly"
( let constraint_loc, label, e =
match eo with
| None ->
@@ -40044,13 +40120,13 @@ module Tables = struct
(_startpos_c_, _endpos), label, e
in
label, mkexp_opt_constraint ~loc:constraint_loc e c )
-# 40048 "src/ocaml/preprocess/parser_raw.ml"
+# 40124 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 40054 "src/ocaml/preprocess/parser_raw.ml"
+# 40130 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40096,7 +40172,7 @@ module Tables = struct
let _v : ((Longident.t Location.loc * Parsetree.expression) list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 40100 "src/ocaml/preprocess/parser_raw.ml"
+# 40176 "src/ocaml/preprocess/parser_raw.ml"
in
let x =
let label =
@@ -40104,9 +40180,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 40110 "src/ocaml/preprocess/parser_raw.ml"
+# 40186 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_label_ = _startpos__1_ in
@@ -40114,7 +40190,7 @@ module Tables = struct
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2957 "src/ocaml/preprocess/parser_raw.mly"
+# 2995 "src/ocaml/preprocess/parser_raw.mly"
( let constraint_loc, label, e =
match eo with
| None ->
@@ -40124,13 +40200,13 @@ module Tables = struct
(_startpos_c_, _endpos), label, e
in
label, mkexp_opt_constraint ~loc:constraint_loc e c )
-# 40128 "src/ocaml/preprocess/parser_raw.ml"
+# 40204 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1218 "src/ocaml/preprocess/parser_raw.mly"
+# 1238 "src/ocaml/preprocess/parser_raw.mly"
( [x] )
-# 40134 "src/ocaml/preprocess/parser_raw.ml"
+# 40210 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40186,9 +40262,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 40192 "src/ocaml/preprocess/parser_raw.ml"
+# 40268 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_label_ = _startpos__1_ in
@@ -40196,7 +40272,7 @@ module Tables = struct
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2957 "src/ocaml/preprocess/parser_raw.mly"
+# 2995 "src/ocaml/preprocess/parser_raw.mly"
( let constraint_loc, label, e =
match eo with
| None ->
@@ -40206,13 +40282,13 @@ module Tables = struct
(_startpos_c_, _endpos), label, e
in
label, mkexp_opt_constraint ~loc:constraint_loc e c )
-# 40210 "src/ocaml/preprocess/parser_raw.ml"
+# 40286 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1222 "src/ocaml/preprocess/parser_raw.mly"
+# 1242 "src/ocaml/preprocess/parser_raw.mly"
( x :: xs )
-# 40216 "src/ocaml/preprocess/parser_raw.ml"
+# 40292 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40235,14 +40311,14 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
+# 2407 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40241 "src/ocaml/preprocess/parser_raw.ml"
+# 40317 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2427 "src/ocaml/preprocess/parser_raw.mly"
+# 2445 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40246 "src/ocaml/preprocess/parser_raw.ml"
+# 40322 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40291,18 +40367,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 40295 "src/ocaml/preprocess/parser_raw.ml"
+# 40371 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
+# 1263 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 40300 "src/ocaml/preprocess/parser_raw.ml"
+# 40376 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
+# 2931 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 40306 "src/ocaml/preprocess/parser_raw.ml"
+# 40382 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos_xs_ in
@@ -40311,22 +40387,22 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40317 "src/ocaml/preprocess/parser_raw.ml"
+# 40393 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 40323 "src/ocaml/preprocess/parser_raw.ml"
+# 40399 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
+# 2409 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let cases = _3 in
(* There are two choices of where to put attributes: on the
@@ -40339,13 +40415,13 @@ module Tables = struct
let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
mkexp_attrs ~loc:_sloc desc _2
)
-# 40343 "src/ocaml/preprocess/parser_raw.ml"
+# 40419 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2427 "src/ocaml/preprocess/parser_raw.mly"
+# 2445 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40349 "src/ocaml/preprocess/parser_raw.ml"
+# 40425 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40413,18 +40489,18 @@ module Tables = struct
let _v : (Parsetree.type_exception * string Location.loc option) = let attrs =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40419 "src/ocaml/preprocess/parser_raw.ml"
+# 40495 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs_ = _endpos__1_inlined4_ in
let attrs2 =
let _1 = _1_inlined3 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40428 "src/ocaml/preprocess/parser_raw.ml"
+# 40504 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -40434,17 +40510,17 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 40440 "src/ocaml/preprocess/parser_raw.ml"
+# 40516 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40448 "src/ocaml/preprocess/parser_raw.ml"
+# 40524 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs_ in
@@ -40452,14 +40528,14 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3433 "src/ocaml/preprocess/parser_raw.mly"
+# 3474 "src/ocaml/preprocess/parser_raw.mly"
( let vars, args, res = vars_args_res in
let loc = make_loc (_startpos, _endpos_attrs2_) in
let docs = symbol_docs _sloc in
Te.mk_exception ~attrs
(Te.decl id ~vars ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext )
-# 40463 "src/ocaml/preprocess/parser_raw.ml"
+# 40539 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40485,21 +40561,21 @@ module Tables = struct
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 40489 "src/ocaml/preprocess/parser_raw.ml"
+# 40565 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1020 "src/ocaml/preprocess/parser_raw.mly"
+# 1040 "src/ocaml/preprocess/parser_raw.mly"
( extra_sig _startpos _endpos _1 )
-# 40497 "src/ocaml/preprocess/parser_raw.ml"
+# 40573 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1823 "src/ocaml/preprocess/parser_raw.mly"
+# 1841 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40503 "src/ocaml/preprocess/parser_raw.ml"
+# 40579 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40531,9 +40607,9 @@ module Tables = struct
let _v : (Parsetree.signature_item) = let _2 =
let _1 = _1_inlined1 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40537 "src/ocaml/preprocess/parser_raw.ml"
+# 40613 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
@@ -40541,10 +40617,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1838 "src/ocaml/preprocess/parser_raw.mly"
+# 1856 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) )
-# 40548 "src/ocaml/preprocess/parser_raw.ml"
+# 40624 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40568,23 +40644,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1842 "src/ocaml/preprocess/parser_raw.mly"
+# 1860 "src/ocaml/preprocess/parser_raw.mly"
( Psig_attribute _1 )
-# 40574 "src/ocaml/preprocess/parser_raw.ml"
+# 40650 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1068 "src/ocaml/preprocess/parser_raw.mly"
+# 1088 "src/ocaml/preprocess/parser_raw.mly"
( mksig ~loc:_sloc _1 )
-# 40582 "src/ocaml/preprocess/parser_raw.ml"
+# 40658 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1844 "src/ocaml/preprocess/parser_raw.mly"
+# 1862 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40588 "src/ocaml/preprocess/parser_raw.ml"
+# 40664 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40608,23 +40684,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1847 "src/ocaml/preprocess/parser_raw.mly"
+# 1865 "src/ocaml/preprocess/parser_raw.mly"
( psig_value _1 )
-# 40614 "src/ocaml/preprocess/parser_raw.ml"
+# 40690 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 40622 "src/ocaml/preprocess/parser_raw.ml"
+# 40698 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40628 "src/ocaml/preprocess/parser_raw.ml"
+# 40704 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40648,23 +40724,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1849 "src/ocaml/preprocess/parser_raw.mly"
+# 1867 "src/ocaml/preprocess/parser_raw.mly"
( psig_value _1 )
-# 40654 "src/ocaml/preprocess/parser_raw.ml"
+# 40730 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 40662 "src/ocaml/preprocess/parser_raw.ml"
+# 40738 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40668 "src/ocaml/preprocess/parser_raw.ml"
+# 40744 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40699,26 +40775,26 @@ module Tables = struct
let _1 =
let _1 =
let _1 =
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 40705 "src/ocaml/preprocess/parser_raw.ml"
+# 40781 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3252 "src/ocaml/preprocess/parser_raw.mly"
+# 3293 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40710 "src/ocaml/preprocess/parser_raw.ml"
+# 40786 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3235 "src/ocaml/preprocess/parser_raw.mly"
+# 3276 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40716 "src/ocaml/preprocess/parser_raw.ml"
+# 40792 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1851 "src/ocaml/preprocess/parser_raw.mly"
+# 1869 "src/ocaml/preprocess/parser_raw.mly"
( psig_type _1 )
-# 40722 "src/ocaml/preprocess/parser_raw.ml"
+# 40798 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
@@ -40726,15 +40802,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 40732 "src/ocaml/preprocess/parser_raw.ml"
+# 40808 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40738 "src/ocaml/preprocess/parser_raw.ml"
+# 40814 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40769,26 +40845,26 @@ module Tables = struct
let _1 =
let _1 =
let _1 =
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 40775 "src/ocaml/preprocess/parser_raw.ml"
+# 40851 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3252 "src/ocaml/preprocess/parser_raw.mly"
+# 3293 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40780 "src/ocaml/preprocess/parser_raw.ml"
+# 40856 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3240 "src/ocaml/preprocess/parser_raw.mly"
+# 3281 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40786 "src/ocaml/preprocess/parser_raw.ml"
+# 40862 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1853 "src/ocaml/preprocess/parser_raw.mly"
+# 1871 "src/ocaml/preprocess/parser_raw.mly"
( psig_typesubst _1 )
-# 40792 "src/ocaml/preprocess/parser_raw.ml"
+# 40868 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
@@ -40796,15 +40872,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 40802 "src/ocaml/preprocess/parser_raw.ml"
+# 40878 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40808 "src/ocaml/preprocess/parser_raw.ml"
+# 40884 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -40889,16 +40965,16 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40895 "src/ocaml/preprocess/parser_raw.ml"
+# 40971 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1271 "src/ocaml/preprocess/parser_raw.mly"
+# 1291 "src/ocaml/preprocess/parser_raw.mly"
( List.rev xs )
-# 40902 "src/ocaml/preprocess/parser_raw.ml"
+# 40978 "src/ocaml/preprocess/parser_raw.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
@@ -40906,46 +40982,46 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 40912 "src/ocaml/preprocess/parser_raw.ml"
+# 40988 "src/ocaml/preprocess/parser_raw.ml"
in
let _4 =
-# 4068 "src/ocaml/preprocess/parser_raw.mly"
+# 4116 "src/ocaml/preprocess/parser_raw.mly"
( Recursive )
-# 40918 "src/ocaml/preprocess/parser_raw.ml"
+# 40994 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40925 "src/ocaml/preprocess/parser_raw.ml"
+# 41001 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3507 "src/ocaml/preprocess/parser_raw.mly"
+# 3548 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 40937 "src/ocaml/preprocess/parser_raw.ml"
+# 41013 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3494 "src/ocaml/preprocess/parser_raw.mly"
+# 3535 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40943 "src/ocaml/preprocess/parser_raw.ml"
+# 41019 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1855 "src/ocaml/preprocess/parser_raw.mly"
+# 1873 "src/ocaml/preprocess/parser_raw.mly"
( psig_typext _1 )
-# 40949 "src/ocaml/preprocess/parser_raw.ml"
+# 41025 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
@@ -40953,15 +41029,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 40959 "src/ocaml/preprocess/parser_raw.ml"
+# 41035 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 40965 "src/ocaml/preprocess/parser_raw.ml"
+# 41041 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41053,16 +41129,16 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41059 "src/ocaml/preprocess/parser_raw.ml"
+# 41135 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1271 "src/ocaml/preprocess/parser_raw.mly"
+# 1291 "src/ocaml/preprocess/parser_raw.mly"
( List.rev xs )
-# 41066 "src/ocaml/preprocess/parser_raw.ml"
+# 41142 "src/ocaml/preprocess/parser_raw.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
@@ -41070,9 +41146,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 41076 "src/ocaml/preprocess/parser_raw.ml"
+# 41152 "src/ocaml/preprocess/parser_raw.ml"
in
let _4 =
@@ -41081,41 +41157,41 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 4070 "src/ocaml/preprocess/parser_raw.mly"
+# 4118 "src/ocaml/preprocess/parser_raw.mly"
( not_expecting _loc "nonrec flag"; Recursive )
-# 41087 "src/ocaml/preprocess/parser_raw.ml"
+# 41163 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41095 "src/ocaml/preprocess/parser_raw.ml"
+# 41171 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3507 "src/ocaml/preprocess/parser_raw.mly"
+# 3548 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 41107 "src/ocaml/preprocess/parser_raw.ml"
+# 41183 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3494 "src/ocaml/preprocess/parser_raw.mly"
+# 3535 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41113 "src/ocaml/preprocess/parser_raw.ml"
+# 41189 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1855 "src/ocaml/preprocess/parser_raw.mly"
+# 1873 "src/ocaml/preprocess/parser_raw.mly"
( psig_typext _1 )
-# 41119 "src/ocaml/preprocess/parser_raw.ml"
+# 41195 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
@@ -41123,15 +41199,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41129 "src/ocaml/preprocess/parser_raw.ml"
+# 41205 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41135 "src/ocaml/preprocess/parser_raw.ml"
+# 41211 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41155,23 +41231,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1857 "src/ocaml/preprocess/parser_raw.mly"
+# 1875 "src/ocaml/preprocess/parser_raw.mly"
( psig_exception _1 )
-# 41161 "src/ocaml/preprocess/parser_raw.ml"
+# 41237 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41169 "src/ocaml/preprocess/parser_raw.ml"
+# 41245 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41175 "src/ocaml/preprocess/parser_raw.ml"
+# 41251 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41234,9 +41310,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41240 "src/ocaml/preprocess/parser_raw.ml"
+# 41316 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -41246,37 +41322,37 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 41252 "src/ocaml/preprocess/parser_raw.ml"
+# 41328 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41260 "src/ocaml/preprocess/parser_raw.ml"
+# 41336 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1888 "src/ocaml/preprocess/parser_raw.mly"
+# 1906 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Md.mk name body ~attrs ~loc ~docs, ext
)
-# 41274 "src/ocaml/preprocess/parser_raw.ml"
+# 41350 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1859 "src/ocaml/preprocess/parser_raw.mly"
+# 1877 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 41280 "src/ocaml/preprocess/parser_raw.ml"
+# 41356 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
@@ -41284,15 +41360,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41290 "src/ocaml/preprocess/parser_raw.ml"
+# 41366 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41296 "src/ocaml/preprocess/parser_raw.ml"
+# 41372 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41362,9 +41438,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41368 "src/ocaml/preprocess/parser_raw.ml"
+# 41444 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
@@ -41375,9 +41451,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 41381 "src/ocaml/preprocess/parser_raw.ml"
+# 41457 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in
@@ -41385,9 +41461,9 @@ module Tables = struct
let _symbolstartpos = _startpos_id_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1929 "src/ocaml/preprocess/parser_raw.mly"
+# 1947 "src/ocaml/preprocess/parser_raw.mly"
( Mty.alias ~loc:(make_loc _sloc) id )
-# 41391 "src/ocaml/preprocess/parser_raw.ml"
+# 41467 "src/ocaml/preprocess/parser_raw.ml"
in
let name =
@@ -41396,37 +41472,37 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 41402 "src/ocaml/preprocess/parser_raw.ml"
+# 41478 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41410 "src/ocaml/preprocess/parser_raw.ml"
+# 41486 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1920 "src/ocaml/preprocess/parser_raw.mly"
+# 1938 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Md.mk name body ~attrs ~loc ~docs, ext
)
-# 41424 "src/ocaml/preprocess/parser_raw.ml"
+# 41500 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1861 "src/ocaml/preprocess/parser_raw.mly"
+# 1879 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 41430 "src/ocaml/preprocess/parser_raw.ml"
+# 41506 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
@@ -41434,15 +41510,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41440 "src/ocaml/preprocess/parser_raw.ml"
+# 41516 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41446 "src/ocaml/preprocess/parser_raw.ml"
+# 41522 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41466,23 +41542,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1863 "src/ocaml/preprocess/parser_raw.mly"
+# 1881 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Psig_modsubst body, ext) )
-# 41472 "src/ocaml/preprocess/parser_raw.ml"
+# 41548 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41480 "src/ocaml/preprocess/parser_raw.ml"
+# 41556 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41486 "src/ocaml/preprocess/parser_raw.ml"
+# 41562 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41568,9 +41644,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41574 "src/ocaml/preprocess/parser_raw.ml"
+# 41650 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -41580,49 +41656,49 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 41586 "src/ocaml/preprocess/parser_raw.ml"
+# 41662 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41594 "src/ocaml/preprocess/parser_raw.ml"
+# 41670 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1965 "src/ocaml/preprocess/parser_raw.mly"
+# 1983 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
ext, Md.mk name mty ~attrs ~loc ~docs
)
-# 41608 "src/ocaml/preprocess/parser_raw.ml"
+# 41684 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 41614 "src/ocaml/preprocess/parser_raw.ml"
+# 41690 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1954 "src/ocaml/preprocess/parser_raw.mly"
+# 1972 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41620 "src/ocaml/preprocess/parser_raw.ml"
+# 41696 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1865 "src/ocaml/preprocess/parser_raw.mly"
+# 1883 "src/ocaml/preprocess/parser_raw.mly"
( let (ext, l) = _1 in (Psig_recmodule l, ext) )
-# 41626 "src/ocaml/preprocess/parser_raw.ml"
+# 41702 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_bs_ in
@@ -41630,15 +41706,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41636 "src/ocaml/preprocess/parser_raw.ml"
+# 41712 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41642 "src/ocaml/preprocess/parser_raw.ml"
+# 41718 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41662,23 +41738,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1867 "src/ocaml/preprocess/parser_raw.mly"
+# 1885 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Psig_modtype body, ext) )
-# 41668 "src/ocaml/preprocess/parser_raw.ml"
+# 41744 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41676 "src/ocaml/preprocess/parser_raw.ml"
+# 41752 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41682 "src/ocaml/preprocess/parser_raw.ml"
+# 41758 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41702,23 +41778,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1869 "src/ocaml/preprocess/parser_raw.mly"
+# 1887 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Psig_modtypesubst body, ext) )
-# 41708 "src/ocaml/preprocess/parser_raw.ml"
+# 41784 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41716 "src/ocaml/preprocess/parser_raw.ml"
+# 41792 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41722 "src/ocaml/preprocess/parser_raw.ml"
+# 41798 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41742,23 +41818,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1871 "src/ocaml/preprocess/parser_raw.mly"
+# 1889 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Psig_open body, ext) )
-# 41748 "src/ocaml/preprocess/parser_raw.ml"
+# 41824 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41756 "src/ocaml/preprocess/parser_raw.ml"
+# 41832 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41762 "src/ocaml/preprocess/parser_raw.ml"
+# 41838 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41814,38 +41890,38 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41820 "src/ocaml/preprocess/parser_raw.ml"
+# 41896 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41829 "src/ocaml/preprocess/parser_raw.ml"
+# 41905 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1705 "src/ocaml/preprocess/parser_raw.mly"
+# 1725 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Incl.mk thing ~attrs ~loc ~docs, ext
)
-# 41843 "src/ocaml/preprocess/parser_raw.ml"
+# 41919 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1873 "src/ocaml/preprocess/parser_raw.mly"
+# 1891 "src/ocaml/preprocess/parser_raw.mly"
( psig_include _1 )
-# 41849 "src/ocaml/preprocess/parser_raw.ml"
+# 41925 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
@@ -41853,15 +41929,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 41859 "src/ocaml/preprocess/parser_raw.ml"
+# 41935 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41865 "src/ocaml/preprocess/parser_raw.ml"
+# 41941 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -41938,9 +42014,9 @@ module Tables = struct
let cty : (Parsetree.class_type) = Obj.magic cty in
let _7 : unit = Obj.magic _7 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 41944 "src/ocaml/preprocess/parser_raw.ml"
+# 42020 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -41958,9 +42034,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41964 "src/ocaml/preprocess/parser_raw.ml"
+# 42040 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -41970,24 +42046,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 41976 "src/ocaml/preprocess/parser_raw.ml"
+# 42052 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 41984 "src/ocaml/preprocess/parser_raw.ml"
+# 42060 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2320 "src/ocaml/preprocess/parser_raw.mly"
+# 2338 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
@@ -41995,25 +42071,25 @@ module Tables = struct
ext,
Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
)
-# 41999 "src/ocaml/preprocess/parser_raw.ml"
+# 42075 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 42005 "src/ocaml/preprocess/parser_raw.ml"
+# 42081 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2308 "src/ocaml/preprocess/parser_raw.mly"
+# 2326 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42011 "src/ocaml/preprocess/parser_raw.ml"
+# 42087 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1875 "src/ocaml/preprocess/parser_raw.mly"
+# 1893 "src/ocaml/preprocess/parser_raw.mly"
( let (ext, l) = _1 in (Psig_class l, ext) )
-# 42017 "src/ocaml/preprocess/parser_raw.ml"
+# 42093 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_bs_ in
@@ -42021,15 +42097,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 42027 "src/ocaml/preprocess/parser_raw.ml"
+# 42103 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42033 "src/ocaml/preprocess/parser_raw.ml"
+# 42109 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42053,23 +42129,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1877 "src/ocaml/preprocess/parser_raw.mly"
+# 1895 "src/ocaml/preprocess/parser_raw.mly"
( let (ext, l) = _1 in (Psig_class_type l, ext) )
-# 42059 "src/ocaml/preprocess/parser_raw.ml"
+# 42135 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1085 "src/ocaml/preprocess/parser_raw.mly"
+# 1105 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 42067 "src/ocaml/preprocess/parser_raw.ml"
+# 42143 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1879 "src/ocaml/preprocess/parser_raw.mly"
+# 1897 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42073 "src/ocaml/preprocess/parser_raw.ml"
+# 42149 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42092,9 +42168,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3893 "src/ocaml/preprocess/parser_raw.mly"
+# 3937 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42098 "src/ocaml/preprocess/parser_raw.ml"
+# 42174 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42119,18 +42195,22 @@ module Tables = struct
};
} = _menhir_stack in
let _2 : (
-# 824 "src/ocaml/preprocess/parser_raw.mly"
+# 843 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 42125 "src/ocaml/preprocess/parser_raw.ml"
+# 42201 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (Parsetree.constant) =
-# 3894 "src/ocaml/preprocess/parser_raw.mly"
- ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) )
-# 42134 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3938 "src/ocaml/preprocess/parser_raw.mly"
+ ( let (n, m) = _2 in
+ mkconst ~loc:_sloc (Pconst_integer("-" ^ n, m)) )
+# 42214 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42155,18 +42235,22 @@ module Tables = struct
};
} = _menhir_stack in
let _2 : (
-# 803 "src/ocaml/preprocess/parser_raw.mly"
+# 822 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 42161 "src/ocaml/preprocess/parser_raw.ml"
+# 42241 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (Parsetree.constant) =
-# 3895 "src/ocaml/preprocess/parser_raw.mly"
- ( let (f, m) = _2 in Pconst_float("-" ^ f, m) )
-# 42170 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3940 "src/ocaml/preprocess/parser_raw.mly"
+ ( let (f, m) = _2 in
+ mkconst ~loc:_sloc (Pconst_float("-" ^ f, m)) )
+# 42254 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42191,18 +42275,22 @@ module Tables = struct
};
} = _menhir_stack in
let _2 : (
-# 824 "src/ocaml/preprocess/parser_raw.mly"
+# 843 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 42197 "src/ocaml/preprocess/parser_raw.ml"
+# 42281 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (Parsetree.constant) =
-# 3896 "src/ocaml/preprocess/parser_raw.mly"
- ( let (n, m) = _2 in Pconst_integer (n, m) )
-# 42206 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3942 "src/ocaml/preprocess/parser_raw.mly"
+ ( let (n, m) = _2 in
+ mkconst ~loc:_sloc (Pconst_integer (n, m)) )
+# 42294 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42227,18 +42315,22 @@ module Tables = struct
};
} = _menhir_stack in
let _2 : (
-# 803 "src/ocaml/preprocess/parser_raw.mly"
+# 822 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 42233 "src/ocaml/preprocess/parser_raw.ml"
+# 42321 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (Parsetree.constant) =
-# 3897 "src/ocaml/preprocess/parser_raw.mly"
- ( let (f, m) = _2 in Pconst_float(f, m) )
-# 42242 "src/ocaml/preprocess/parser_raw.ml"
+ let _v : (Parsetree.constant) = let _endpos = _endpos__2_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 3944 "src/ocaml/preprocess/parser_raw.mly"
+ ( let (f, m) = _2 in
+ mkconst ~loc:_sloc (Pconst_float(f, m)) )
+# 42334 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42279,18 +42371,18 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 3164 "src/ocaml/preprocess/parser_raw.mly"
+# 3205 "src/ocaml/preprocess/parser_raw.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 42287 "src/ocaml/preprocess/parser_raw.ml"
+# 42379 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3135 "src/ocaml/preprocess/parser_raw.mly"
+# 3176 "src/ocaml/preprocess/parser_raw.mly"
( let (fields, closed) = _2 in
Ppat_record(fields, closed) )
-# 42294 "src/ocaml/preprocess/parser_raw.ml"
+# 42386 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -42298,15 +42390,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 42304 "src/ocaml/preprocess/parser_raw.ml"
+# 42396 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3149 "src/ocaml/preprocess/parser_raw.mly"
+# 3190 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42310 "src/ocaml/preprocess/parser_raw.ml"
+# 42402 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42345,15 +42437,15 @@ module Tables = struct
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 3158 "src/ocaml/preprocess/parser_raw.mly"
+# 3199 "src/ocaml/preprocess/parser_raw.mly"
( ps )
-# 42351 "src/ocaml/preprocess/parser_raw.ml"
+# 42443 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 3140 "src/ocaml/preprocess/parser_raw.mly"
+# 3181 "src/ocaml/preprocess/parser_raw.mly"
( fst (mktailpat _loc__3_ _2) )
-# 42357 "src/ocaml/preprocess/parser_raw.ml"
+# 42449 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -42361,15 +42453,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 42367 "src/ocaml/preprocess/parser_raw.ml"
+# 42459 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3149 "src/ocaml/preprocess/parser_raw.mly"
+# 3190 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42373 "src/ocaml/preprocess/parser_raw.ml"
+# 42465 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42408,14 +42500,14 @@ module Tables = struct
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 3158 "src/ocaml/preprocess/parser_raw.mly"
+# 3199 "src/ocaml/preprocess/parser_raw.mly"
( ps )
-# 42414 "src/ocaml/preprocess/parser_raw.ml"
+# 42506 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3144 "src/ocaml/preprocess/parser_raw.mly"
+# 3185 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_array _2 )
-# 42419 "src/ocaml/preprocess/parser_raw.ml"
+# 42511 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -42423,15 +42515,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 42429 "src/ocaml/preprocess/parser_raw.ml"
+# 42521 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3149 "src/ocaml/preprocess/parser_raw.mly"
+# 3190 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42435 "src/ocaml/preprocess/parser_raw.ml"
+# 42527 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42462,239 +42554,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3146 "src/ocaml/preprocess/parser_raw.mly"
+# 3187 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_array [] )
-# 42468 "src/ocaml/preprocess/parser_raw.ml"
+# 42560 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 42477 "src/ocaml/preprocess/parser_raw.ml"
+# 42569 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3149 "src/ocaml/preprocess/parser_raw.mly"
+# 3190 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 42483 "src/ocaml/preprocess/parser_raw.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined1;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- } = _menhir_stack in
- let _3 : unit = Obj.magic _3 in
- let _1_inlined1 : (Parsetree.expression) = Obj.magic _1_inlined1 in
- let _1 : unit = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__3_ in
- let _v : (Parsetree.expression) = let _2 =
- let _1 = _1_inlined1 in
- let _1 =
-# 2389 "src/ocaml/preprocess/parser_raw.mly"
- ( _1 )
-# 42524 "src/ocaml/preprocess/parser_raw.ml"
- in
-
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
- ( _1 )
-# 42529 "src/ocaml/preprocess/parser_raw.ml"
-
- in
- let _endpos = _endpos__3_ in
- let _startpos = _startpos__1_ in
-
-# 4268 "src/ocaml/preprocess/parser_raw.mly"
- ( Fake.Meta.code _startpos _endpos _2 )
-# 42537 "src/ocaml/preprocess/parser_raw.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = xs;
- MenhirLib.EngineTypes.startp = _startpos_xs_;
- MenhirLib.EngineTypes.endp = _endpos_xs_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined3;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined2;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined1;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- };
- };
- } = _menhir_stack in
- let _3 : unit = Obj.magic _3 in
- let xs : (Parsetree.case list) = Obj.magic xs in
- let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
- let _1_inlined2 : (string Location.loc option) = Obj.magic _1_inlined2 in
- let _1_inlined1 : unit = Obj.magic _1_inlined1 in
- let _1 : unit = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__3_ in
- let _v : (Parsetree.expression) = let _2 =
- let (_startpos__1_, _1_inlined2, _1_inlined1, _1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2, _1_inlined1) in
- let _1 =
- let _3 =
- let xs =
- let xs =
-# 253 "<standard.mly>"
- ( List.rev xs )
-# 42602 "src/ocaml/preprocess/parser_raw.ml"
- in
-
-# 1243 "src/ocaml/preprocess/parser_raw.mly"
- ( xs )
-# 42607 "src/ocaml/preprocess/parser_raw.ml"
-
- in
-
-# 2893 "src/ocaml/preprocess/parser_raw.mly"
- ( xs )
-# 42613 "src/ocaml/preprocess/parser_raw.ml"
-
- in
- let _endpos__3_ = _endpos_xs_ in
- let _2 =
- let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
- let _2 =
- let _1 = _1_inlined1 in
-
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
- ( _1 )
-# 42624 "src/ocaml/preprocess/parser_raw.ml"
-
- in
-
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
- ( _1, _2 )
-# 42630 "src/ocaml/preprocess/parser_raw.ml"
-
- in
- let _endpos = _endpos__3_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 2391 "src/ocaml/preprocess/parser_raw.mly"
- ( let loc = make_loc _sloc in
- let cases = _3 in
- (* There are two choices of where to put attributes: on the
- Pexp_function node; on the Pfunction_cases body. We put them on the
- Pexp_function node here because the compiler only uses
- Pfunction_cases attributes for enabling/disabling warnings in
- typechecking. For standalone function cases, we want the compiler to
- respect, e.g., [@inline] attributes.
- *)
- let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
- mkexp_attrs ~loc:_sloc desc _2
- )
-# 42650 "src/ocaml/preprocess/parser_raw.ml"
-
- in
-
-# 2535 "src/ocaml/preprocess/parser_raw.mly"
- ( _1 )
-# 42656 "src/ocaml/preprocess/parser_raw.ml"
-
- in
- let _endpos = _endpos__3_ in
- let _startpos = _startpos__1_ in
-
-# 4268 "src/ocaml/preprocess/parser_raw.mly"
- ( Fake.Meta.code _startpos _endpos _2 )
-# 42664 "src/ocaml/preprocess/parser_raw.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- } = _menhir_stack in
- let _2 : (Parsetree.expression) = Obj.magic _2 in
- let _1 : unit = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__2_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__2_ in
- let _startpos = _startpos__1_ in
-
-# 4270 "src/ocaml/preprocess/parser_raw.mly"
- ( Fake.Meta.uncode _startpos _endpos _2 )
-# 42698 "src/ocaml/preprocess/parser_raw.ml"
+# 42575 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42734,9 +42611,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2597 "src/ocaml/preprocess/parser_raw.mly"
+# 2615 "src/ocaml/preprocess/parser_raw.mly"
( reloc_exp ~loc:_sloc _2 )
-# 42740 "src/ocaml/preprocess/parser_raw.ml"
+# 42617 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42783,9 +42660,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2603 "src/ocaml/preprocess/parser_raw.mly"
+# 2621 "src/ocaml/preprocess/parser_raw.mly"
( mkexp_constraint ~loc:_sloc _2 _3 )
-# 42789 "src/ocaml/preprocess/parser_raw.ml"
+# 42666 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42837,14 +42714,14 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2604 "src/ocaml/preprocess/parser_raw.mly"
+# 2622 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 42843 "src/ocaml/preprocess/parser_raw.ml"
+# 42720 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 42848 "src/ocaml/preprocess/parser_raw.ml"
+# 42725 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -42852,9 +42729,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2605 "src/ocaml/preprocess/parser_raw.mly"
+# 2623 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 42858 "src/ocaml/preprocess/parser_raw.ml"
+# 42735 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42906,14 +42783,14 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2604 "src/ocaml/preprocess/parser_raw.mly"
+# 2622 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 42912 "src/ocaml/preprocess/parser_raw.ml"
+# 42789 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 42917 "src/ocaml/preprocess/parser_raw.ml"
+# 42794 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -42921,9 +42798,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2605 "src/ocaml/preprocess/parser_raw.mly"
+# 2623 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 42927 "src/ocaml/preprocess/parser_raw.ml"
+# 42804 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -42975,14 +42852,14 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2604 "src/ocaml/preprocess/parser_raw.mly"
+# 2622 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 42981 "src/ocaml/preprocess/parser_raw.ml"
+# 42858 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 42986 "src/ocaml/preprocess/parser_raw.ml"
+# 42863 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -42990,9 +42867,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2605 "src/ocaml/preprocess/parser_raw.mly"
+# 2623 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 42996 "src/ocaml/preprocess/parser_raw.ml"
+# 42873 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43038,9 +42915,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 43044 "src/ocaml/preprocess/parser_raw.ml"
+# 42921 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -43048,31 +42925,31 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2606 "src/ocaml/preprocess/parser_raw.mly"
+# 2624 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 43054 "src/ocaml/preprocess/parser_raw.ml"
+# 42931 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 43059 "src/ocaml/preprocess/parser_raw.ml"
+# 42936 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 43065 "src/ocaml/preprocess/parser_raw.ml"
+# 42942 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43070 "src/ocaml/preprocess/parser_raw.ml"
+# 42947 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 43076 "src/ocaml/preprocess/parser_raw.ml"
+# 42953 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -43080,9 +42957,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2607 "src/ocaml/preprocess/parser_raw.mly"
+# 2625 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 43086 "src/ocaml/preprocess/parser_raw.ml"
+# 42963 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43140,9 +43017,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 43146 "src/ocaml/preprocess/parser_raw.ml"
+# 43023 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -43152,39 +43029,39 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2606 "src/ocaml/preprocess/parser_raw.mly"
+# 2624 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 43158 "src/ocaml/preprocess/parser_raw.ml"
+# 43035 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 43163 "src/ocaml/preprocess/parser_raw.ml"
+# 43040 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 43171 "src/ocaml/preprocess/parser_raw.ml"
+# 43048 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43176 "src/ocaml/preprocess/parser_raw.ml"
+# 43053 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43182 "src/ocaml/preprocess/parser_raw.ml"
+# 43059 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2481 "src/ocaml/preprocess/parser_raw.mly"
+# 2499 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Paren, i, r )
-# 43188 "src/ocaml/preprocess/parser_raw.ml"
+# 43065 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -43192,9 +43069,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2607 "src/ocaml/preprocess/parser_raw.mly"
+# 2625 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 43198 "src/ocaml/preprocess/parser_raw.ml"
+# 43075 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43240,9 +43117,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 43246 "src/ocaml/preprocess/parser_raw.ml"
+# 43123 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -43250,31 +43127,31 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2606 "src/ocaml/preprocess/parser_raw.mly"
+# 2624 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 43256 "src/ocaml/preprocess/parser_raw.ml"
+# 43133 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 43261 "src/ocaml/preprocess/parser_raw.ml"
+# 43138 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 43267 "src/ocaml/preprocess/parser_raw.ml"
+# 43144 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43272 "src/ocaml/preprocess/parser_raw.ml"
+# 43149 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 43278 "src/ocaml/preprocess/parser_raw.ml"
+# 43155 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -43282,9 +43159,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2607 "src/ocaml/preprocess/parser_raw.mly"
+# 2625 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 43288 "src/ocaml/preprocess/parser_raw.ml"
+# 43165 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43342,9 +43219,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 43348 "src/ocaml/preprocess/parser_raw.ml"
+# 43225 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -43354,39 +43231,39 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2606 "src/ocaml/preprocess/parser_raw.mly"
+# 2624 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 43360 "src/ocaml/preprocess/parser_raw.ml"
+# 43237 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 43365 "src/ocaml/preprocess/parser_raw.ml"
+# 43242 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 43373 "src/ocaml/preprocess/parser_raw.ml"
+# 43250 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43378 "src/ocaml/preprocess/parser_raw.ml"
+# 43255 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43384 "src/ocaml/preprocess/parser_raw.ml"
+# 43261 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2483 "src/ocaml/preprocess/parser_raw.mly"
+# 2501 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Brace, i, r )
-# 43390 "src/ocaml/preprocess/parser_raw.ml"
+# 43267 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -43394,9 +43271,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2607 "src/ocaml/preprocess/parser_raw.mly"
+# 2625 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 43400 "src/ocaml/preprocess/parser_raw.ml"
+# 43277 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43442,9 +43319,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 43448 "src/ocaml/preprocess/parser_raw.ml"
+# 43325 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -43452,31 +43329,31 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2606 "src/ocaml/preprocess/parser_raw.mly"
+# 2624 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 43458 "src/ocaml/preprocess/parser_raw.ml"
+# 43335 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 43463 "src/ocaml/preprocess/parser_raw.ml"
+# 43340 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 43469 "src/ocaml/preprocess/parser_raw.ml"
+# 43346 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43474 "src/ocaml/preprocess/parser_raw.ml"
+# 43351 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 43480 "src/ocaml/preprocess/parser_raw.ml"
+# 43357 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -43484,9 +43361,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2607 "src/ocaml/preprocess/parser_raw.mly"
+# 2625 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 43490 "src/ocaml/preprocess/parser_raw.ml"
+# 43367 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43544,9 +43421,9 @@ module Tables = struct
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 43550 "src/ocaml/preprocess/parser_raw.ml"
+# 43427 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -43556,39 +43433,39 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2606 "src/ocaml/preprocess/parser_raw.mly"
+# 2624 "src/ocaml/preprocess/parser_raw.mly"
( None )
-# 43562 "src/ocaml/preprocess/parser_raw.ml"
+# 43439 "src/ocaml/preprocess/parser_raw.ml"
in
let i =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 43567 "src/ocaml/preprocess/parser_raw.ml"
+# 43444 "src/ocaml/preprocess/parser_raw.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
(_2)
-# 43575 "src/ocaml/preprocess/parser_raw.ml"
+# 43452 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43580 "src/ocaml/preprocess/parser_raw.ml"
+# 43457 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2497 "src/ocaml/preprocess/parser_raw.mly"
+# 2515 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43586 "src/ocaml/preprocess/parser_raw.ml"
+# 43463 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2485 "src/ocaml/preprocess/parser_raw.mly"
+# 2503 "src/ocaml/preprocess/parser_raw.mly"
( array, d, Bracket, i, r )
-# 43592 "src/ocaml/preprocess/parser_raw.ml"
+# 43469 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
@@ -43596,9 +43473,102 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2607 "src/ocaml/preprocess/parser_raw.mly"
+# 2625 "src/ocaml/preprocess/parser_raw.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 43602 "src/ocaml/preprocess/parser_raw.ml"
+# 43479 "src/ocaml/preprocess/parser_raw.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = e;
+ MenhirLib.EngineTypes.startp = _startpos_e_;
+ MenhirLib.EngineTypes.endp = _endpos_e_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ } = _menhir_stack in
+ let e : (Parsetree.expression) = Obj.magic e in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos_e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _endpos = _endpos_e_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 2675 "src/ocaml/preprocess/parser_raw.mly"
+ ( wrap_exp_attrs ~loc:_sloc e
+ (Some (mknoloc "metaocaml.escape"), []) )
+# 43516 "src/ocaml/preprocess/parser_raw.ml"
+
+ in
+
+# 2630 "src/ocaml/preprocess/parser_raw.mly"
+ ( _1 )
+# 43522 "src/ocaml/preprocess/parser_raw.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = e;
+ MenhirLib.EngineTypes.startp = _startpos_e_;
+ MenhirLib.EngineTypes.endp = _endpos_e_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ } = _menhir_stack in
+ let _3 : unit = Obj.magic _3 in
+ let e : (Parsetree.expression) = Obj.magic e in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__3_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _endpos = _endpos__3_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 2678 "src/ocaml/preprocess/parser_raw.mly"
+ ( wrap_exp_attrs ~loc:_sloc e
+ (Some (mknoloc "metaocaml.bracket"),[]) )
+# 43566 "src/ocaml/preprocess/parser_raw.ml"
+
+ in
+
+# 2630 "src/ocaml/preprocess/parser_raw.mly"
+ ( _1 )
+# 43572 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43652,15 +43622,15 @@ module Tables = struct
let attrs =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 43658 "src/ocaml/preprocess/parser_raw.ml"
+# 43628 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2620 "src/ocaml/preprocess/parser_raw.mly"
+# 2639 "src/ocaml/preprocess/parser_raw.mly"
( e.pexp_desc, (ext, attrs @ e.pexp_attributes) )
-# 43664 "src/ocaml/preprocess/parser_raw.ml"
+# 43634 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -43668,10 +43638,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2613 "src/ocaml/preprocess/parser_raw.mly"
+# 2632 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 43675 "src/ocaml/preprocess/parser_raw.ml"
+# 43645 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43720,24 +43690,24 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 43726 "src/ocaml/preprocess/parser_raw.ml"
+# 43696 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43732 "src/ocaml/preprocess/parser_raw.ml"
+# 43702 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2622 "src/ocaml/preprocess/parser_raw.mly"
+# 2641 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
-# 43741 "src/ocaml/preprocess/parser_raw.ml"
+# 43711 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -43745,10 +43715,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2613 "src/ocaml/preprocess/parser_raw.mly"
+# 2632 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 43752 "src/ocaml/preprocess/parser_raw.ml"
+# 43722 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43798,9 +43768,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 43804 "src/ocaml/preprocess/parser_raw.ml"
+# 43774 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -43808,21 +43778,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 43814 "src/ocaml/preprocess/parser_raw.ml"
+# 43784 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43820 "src/ocaml/preprocess/parser_raw.ml"
+# 43790 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2628 "src/ocaml/preprocess/parser_raw.mly"
+# 2647 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_new(_3), _2 )
-# 43826 "src/ocaml/preprocess/parser_raw.ml"
+# 43796 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
@@ -43830,10 +43800,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2613 "src/ocaml/preprocess/parser_raw.mly"
+# 2632 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 43837 "src/ocaml/preprocess/parser_raw.ml"
+# 43807 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43896,21 +43866,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 43902 "src/ocaml/preprocess/parser_raw.ml"
+# 43872 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 43908 "src/ocaml/preprocess/parser_raw.ml"
+# 43878 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2630 "src/ocaml/preprocess/parser_raw.mly"
+# 2649 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_pack _4, _3 )
-# 43914 "src/ocaml/preprocess/parser_raw.ml"
+# 43884 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -43918,10 +43888,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2613 "src/ocaml/preprocess/parser_raw.mly"
+# 2632 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 43925 "src/ocaml/preprocess/parser_raw.ml"
+# 43895 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -43999,11 +43969,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 44007 "src/ocaml/preprocess/parser_raw.ml"
+# 43977 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
@@ -44011,24 +43981,24 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44017 "src/ocaml/preprocess/parser_raw.ml"
+# 43987 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 44023 "src/ocaml/preprocess/parser_raw.ml"
+# 43993 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2632 "src/ocaml/preprocess/parser_raw.mly"
+# 2651 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
-# 44032 "src/ocaml/preprocess/parser_raw.ml"
+# 44002 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__7_ in
@@ -44036,10 +44006,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2613 "src/ocaml/preprocess/parser_raw.mly"
+# 2632 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 44043 "src/ocaml/preprocess/parser_raw.ml"
+# 44013 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44104,27 +44074,27 @@ module Tables = struct
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 44108 "src/ocaml/preprocess/parser_raw.ml"
+# 44078 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2134 "src/ocaml/preprocess/parser_raw.mly"
+# 2152 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44113 "src/ocaml/preprocess/parser_raw.ml"
+# 44083 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1021 "src/ocaml/preprocess/parser_raw.mly"
+# 1041 "src/ocaml/preprocess/parser_raw.mly"
( extra_cstr _startpos _endpos _1 )
-# 44122 "src/ocaml/preprocess/parser_raw.ml"
+# 44092 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2121 "src/ocaml/preprocess/parser_raw.mly"
+# 2139 "src/ocaml/preprocess/parser_raw.mly"
( Cstr.mk _1 _2 )
-# 44128 "src/ocaml/preprocess/parser_raw.ml"
+# 44098 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -44132,21 +44102,21 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44138 "src/ocaml/preprocess/parser_raw.ml"
+# 44108 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 44144 "src/ocaml/preprocess/parser_raw.ml"
+# 44114 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2638 "src/ocaml/preprocess/parser_raw.mly"
+# 2657 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_object _3, _2 )
-# 44150 "src/ocaml/preprocess/parser_raw.ml"
+# 44120 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__4_ in
@@ -44154,10 +44124,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2613 "src/ocaml/preprocess/parser_raw.mly"
+# 2632 "src/ocaml/preprocess/parser_raw.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 44161 "src/ocaml/preprocess/parser_raw.ml"
+# 44131 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44186,30 +44156,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 44192 "src/ocaml/preprocess/parser_raw.ml"
+# 44162 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2646 "src/ocaml/preprocess/parser_raw.mly"
+# 2684 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_ident (_1) )
-# 44198 "src/ocaml/preprocess/parser_raw.ml"
+# 44168 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44207 "src/ocaml/preprocess/parser_raw.ml"
+# 44177 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44213 "src/ocaml/preprocess/parser_raw.ml"
+# 44183 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44233,23 +44203,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2648 "src/ocaml/preprocess/parser_raw.mly"
+# 2686 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_constant _1 )
-# 44239 "src/ocaml/preprocess/parser_raw.ml"
+# 44209 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44247 "src/ocaml/preprocess/parser_raw.ml"
+# 44217 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44253 "src/ocaml/preprocess/parser_raw.ml"
+# 44223 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44278,30 +44248,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 44284 "src/ocaml/preprocess/parser_raw.ml"
+# 44254 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2650 "src/ocaml/preprocess/parser_raw.mly"
+# 2688 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_construct(_1, None) )
-# 44290 "src/ocaml/preprocess/parser_raw.ml"
+# 44260 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44299 "src/ocaml/preprocess/parser_raw.ml"
+# 44269 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44305 "src/ocaml/preprocess/parser_raw.ml"
+# 44275 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44325,23 +44295,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2652 "src/ocaml/preprocess/parser_raw.mly"
+# 2690 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_variant(_1, None) )
-# 44331 "src/ocaml/preprocess/parser_raw.ml"
+# 44301 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44339 "src/ocaml/preprocess/parser_raw.ml"
+# 44309 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44345 "src/ocaml/preprocess/parser_raw.ml"
+# 44315 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44367,9 +44337,9 @@ module Tables = struct
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 862 "src/ocaml/preprocess/parser_raw.mly"
+# 881 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 44373 "src/ocaml/preprocess/parser_raw.ml"
+# 44343 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
@@ -44381,15 +44351,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 44387 "src/ocaml/preprocess/parser_raw.ml"
+# 44357 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2654 "src/ocaml/preprocess/parser_raw.mly"
+# 2692 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 44393 "src/ocaml/preprocess/parser_raw.ml"
+# 44363 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
@@ -44397,15 +44367,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44403 "src/ocaml/preprocess/parser_raw.ml"
+# 44373 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44409 "src/ocaml/preprocess/parser_raw.ml"
+# 44379 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44438,23 +44408,23 @@ module Tables = struct
let _1 =
let _1 =
let _1 =
-# 2655 "src/ocaml/preprocess/parser_raw.mly"
+# 2693 "src/ocaml/preprocess/parser_raw.mly"
("!")
-# 44444 "src/ocaml/preprocess/parser_raw.ml"
+# 44414 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 44452 "src/ocaml/preprocess/parser_raw.ml"
+# 44422 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2656 "src/ocaml/preprocess/parser_raw.mly"
+# 2694 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 44458 "src/ocaml/preprocess/parser_raw.ml"
+# 44428 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
@@ -44462,15 +44432,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44468 "src/ocaml/preprocess/parser_raw.ml"
+# 44438 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44474 "src/ocaml/preprocess/parser_raw.ml"
+# 44444 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44509,14 +44479,14 @@ module Tables = struct
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2969 "src/ocaml/preprocess/parser_raw.mly"
+# 3007 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 44515 "src/ocaml/preprocess/parser_raw.ml"
+# 44485 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2658 "src/ocaml/preprocess/parser_raw.mly"
+# 2696 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_override _2 )
-# 44520 "src/ocaml/preprocess/parser_raw.ml"
+# 44490 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -44524,15 +44494,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44530 "src/ocaml/preprocess/parser_raw.ml"
+# 44500 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44536 "src/ocaml/preprocess/parser_raw.ml"
+# 44506 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44563,24 +44533,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2664 "src/ocaml/preprocess/parser_raw.mly"
+# 2702 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_override [] )
-# 44569 "src/ocaml/preprocess/parser_raw.ml"
+# 44539 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44578 "src/ocaml/preprocess/parser_raw.ml"
+# 44548 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44584 "src/ocaml/preprocess/parser_raw.ml"
+# 44554 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44624,15 +44594,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 44630 "src/ocaml/preprocess/parser_raw.ml"
+# 44600 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2666 "src/ocaml/preprocess/parser_raw.mly"
+# 2704 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_field(_1, _3) )
-# 44636 "src/ocaml/preprocess/parser_raw.ml"
+# 44606 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -44640,15 +44610,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44646 "src/ocaml/preprocess/parser_raw.ml"
+# 44616 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44652 "src/ocaml/preprocess/parser_raw.ml"
+# 44622 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44706,24 +44676,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 44712 "src/ocaml/preprocess/parser_raw.ml"
+# 44682 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 44721 "src/ocaml/preprocess/parser_raw.ml"
+# 44691 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2668 "src/ocaml/preprocess/parser_raw.mly"
+# 2706 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_open(od, _4) )
-# 44727 "src/ocaml/preprocess/parser_raw.ml"
+# 44697 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -44731,15 +44701,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44737 "src/ocaml/preprocess/parser_raw.ml"
+# 44707 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44743 "src/ocaml/preprocess/parser_raw.ml"
+# 44713 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44792,9 +44762,9 @@ module Tables = struct
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2969 "src/ocaml/preprocess/parser_raw.mly"
+# 3007 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 44798 "src/ocaml/preprocess/parser_raw.ml"
+# 44768 "src/ocaml/preprocess/parser_raw.ml"
in
let od =
let _1 =
@@ -44802,18 +44772,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 44808 "src/ocaml/preprocess/parser_raw.ml"
+# 44778 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 44817 "src/ocaml/preprocess/parser_raw.ml"
+# 44787 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_od_ = _startpos__1_ in
@@ -44821,10 +44791,10 @@ module Tables = struct
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2670 "src/ocaml/preprocess/parser_raw.mly"
+# 2708 "src/ocaml/preprocess/parser_raw.mly"
( (* TODO: review the location of Pexp_override *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
-# 44828 "src/ocaml/preprocess/parser_raw.ml"
+# 44798 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -44832,15 +44802,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44838 "src/ocaml/preprocess/parser_raw.ml"
+# 44808 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44844 "src/ocaml/preprocess/parser_raw.ml"
+# 44814 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44871,9 +44841,9 @@ module Tables = struct
};
} = _menhir_stack in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 44877 "src/ocaml/preprocess/parser_raw.ml"
+# 44847 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
@@ -44885,23 +44855,23 @@ module Tables = struct
let _3 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44891 "src/ocaml/preprocess/parser_raw.ml"
+# 44861 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 44899 "src/ocaml/preprocess/parser_raw.ml"
+# 44869 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2677 "src/ocaml/preprocess/parser_raw.mly"
+# 2715 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_send(_1, _3) )
-# 44905 "src/ocaml/preprocess/parser_raw.ml"
+# 44875 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -44909,15 +44879,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44915 "src/ocaml/preprocess/parser_raw.ml"
+# 44885 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44921 "src/ocaml/preprocess/parser_raw.ml"
+# 44891 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -44949,9 +44919,9 @@ module Tables = struct
} = _menhir_stack in
let _3 : (Parsetree.expression) = Obj.magic _3 in
let _1_inlined1 : (
-# 873 "src/ocaml/preprocess/parser_raw.mly"
+# 892 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 44955 "src/ocaml/preprocess/parser_raw.ml"
+# 44925 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@@ -44965,15 +44935,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1054 "src/ocaml/preprocess/parser_raw.mly"
+# 1074 "src/ocaml/preprocess/parser_raw.mly"
( mkoperator ~loc:_sloc _1 )
-# 44971 "src/ocaml/preprocess/parser_raw.ml"
+# 44941 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2679 "src/ocaml/preprocess/parser_raw.mly"
+# 2717 "src/ocaml/preprocess/parser_raw.mly"
( mkinfix _1 _2 _3 )
-# 44977 "src/ocaml/preprocess/parser_raw.ml"
+# 44947 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -44981,15 +44951,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 44987 "src/ocaml/preprocess/parser_raw.ml"
+# 44957 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 44993 "src/ocaml/preprocess/parser_raw.ml"
+# 44963 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45013,23 +44983,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2681 "src/ocaml/preprocess/parser_raw.mly"
+# 2719 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_extension _1 )
-# 45019 "src/ocaml/preprocess/parser_raw.ml"
+# 44989 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45027 "src/ocaml/preprocess/parser_raw.ml"
+# 44997 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45033 "src/ocaml/preprocess/parser_raw.ml"
+# 45003 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45057,25 +45027,25 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 2683 "src/ocaml/preprocess/parser_raw.mly"
+# 2721 "src/ocaml/preprocess/parser_raw.mly"
( let id = mkrhs Ast_helper.hole_txt _loc in
Pexp_extension (id, PStr []) )
-# 45064 "src/ocaml/preprocess/parser_raw.ml"
+# 45034 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45073 "src/ocaml/preprocess/parser_raw.ml"
+# 45043 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45079 "src/ocaml/preprocess/parser_raw.ml"
+# 45049 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45123,18 +45093,18 @@ module Tables = struct
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2685 "src/ocaml/preprocess/parser_raw.mly"
+# 2723 "src/ocaml/preprocess/parser_raw.mly"
(Lident "()")
-# 45129 "src/ocaml/preprocess/parser_raw.ml"
+# 45099 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45138 "src/ocaml/preprocess/parser_raw.ml"
+# 45108 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
@@ -45144,25 +45114,25 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45150 "src/ocaml/preprocess/parser_raw.ml"
+# 45120 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 45159 "src/ocaml/preprocess/parser_raw.ml"
+# 45129 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2686 "src/ocaml/preprocess/parser_raw.mly"
+# 2724 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_open(od, mkexp ~loc:(_loc__3_) (Pexp_construct(_3, None))) )
-# 45166 "src/ocaml/preprocess/parser_raw.ml"
+# 45136 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
@@ -45170,15 +45140,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45176 "src/ocaml/preprocess/parser_raw.ml"
+# 45146 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45182 "src/ocaml/preprocess/parser_raw.ml"
+# 45152 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45217,25 +45187,25 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2692 "src/ocaml/preprocess/parser_raw.mly"
+# 2730 "src/ocaml/preprocess/parser_raw.mly"
( let (exten, fields) = _2 in
Pexp_record(fields, exten) )
-# 45224 "src/ocaml/preprocess/parser_raw.ml"
+# 45194 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45233 "src/ocaml/preprocess/parser_raw.ml"
+# 45203 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45239 "src/ocaml/preprocess/parser_raw.ml"
+# 45209 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45294,27 +45264,27 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45300 "src/ocaml/preprocess/parser_raw.ml"
+# 45270 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 45309 "src/ocaml/preprocess/parser_raw.ml"
+# 45279 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
-# 2699 "src/ocaml/preprocess/parser_raw.mly"
+# 2737 "src/ocaml/preprocess/parser_raw.mly"
( let (exten, fields) = _4 in
Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos)
(Pexp_record(fields, exten))) )
-# 45318 "src/ocaml/preprocess/parser_raw.ml"
+# 45288 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -45322,15 +45292,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45328 "src/ocaml/preprocess/parser_raw.ml"
+# 45298 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45334 "src/ocaml/preprocess/parser_raw.ml"
+# 45304 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45369,14 +45339,14 @@ module Tables = struct
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 45375 "src/ocaml/preprocess/parser_raw.ml"
+# 45345 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2707 "src/ocaml/preprocess/parser_raw.mly"
+# 2745 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_array(_2) )
-# 45380 "src/ocaml/preprocess/parser_raw.ml"
+# 45350 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -45384,15 +45354,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45390 "src/ocaml/preprocess/parser_raw.ml"
+# 45360 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45396 "src/ocaml/preprocess/parser_raw.ml"
+# 45366 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45423,24 +45393,24 @@ module Tables = struct
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2713 "src/ocaml/preprocess/parser_raw.mly"
+# 2751 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_array [] )
-# 45429 "src/ocaml/preprocess/parser_raw.ml"
+# 45399 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45438 "src/ocaml/preprocess/parser_raw.ml"
+# 45408 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45444 "src/ocaml/preprocess/parser_raw.ml"
+# 45414 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45493,9 +45463,9 @@ module Tables = struct
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 45499 "src/ocaml/preprocess/parser_raw.ml"
+# 45469 "src/ocaml/preprocess/parser_raw.ml"
in
let od =
let _1 =
@@ -45503,25 +45473,25 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45509 "src/ocaml/preprocess/parser_raw.ml"
+# 45479 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 45518 "src/ocaml/preprocess/parser_raw.ml"
+# 45488 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
-# 2715 "src/ocaml/preprocess/parser_raw.mly"
+# 2753 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array(_4))) )
-# 45525 "src/ocaml/preprocess/parser_raw.ml"
+# 45495 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -45529,15 +45499,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45535 "src/ocaml/preprocess/parser_raw.ml"
+# 45505 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45541 "src/ocaml/preprocess/parser_raw.ml"
+# 45511 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45588,26 +45558,26 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45594 "src/ocaml/preprocess/parser_raw.ml"
+# 45564 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 45603 "src/ocaml/preprocess/parser_raw.ml"
+# 45573 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__4_ in
-# 2717 "src/ocaml/preprocess/parser_raw.mly"
+# 2755 "src/ocaml/preprocess/parser_raw.mly"
( (* TODO: review the location of Pexp_array *)
Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array [])) )
-# 45611 "src/ocaml/preprocess/parser_raw.ml"
+# 45581 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__4_ in
@@ -45615,15 +45585,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45621 "src/ocaml/preprocess/parser_raw.ml"
+# 45591 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45627 "src/ocaml/preprocess/parser_raw.ml"
+# 45597 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45662,15 +45632,15 @@ module Tables = struct
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 45668 "src/ocaml/preprocess/parser_raw.ml"
+# 45638 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2725 "src/ocaml/preprocess/parser_raw.mly"
+# 2763 "src/ocaml/preprocess/parser_raw.mly"
( fst (mktailexp _loc__3_ _2) )
-# 45674 "src/ocaml/preprocess/parser_raw.ml"
+# 45644 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -45678,15 +45648,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45684 "src/ocaml/preprocess/parser_raw.ml"
+# 45654 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45690 "src/ocaml/preprocess/parser_raw.ml"
+# 45660 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45739,9 +45709,9 @@ module Tables = struct
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2986 "src/ocaml/preprocess/parser_raw.mly"
+# 3024 "src/ocaml/preprocess/parser_raw.mly"
( es )
-# 45745 "src/ocaml/preprocess/parser_raw.ml"
+# 45715 "src/ocaml/preprocess/parser_raw.ml"
in
let od =
let _1 =
@@ -45749,30 +45719,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45755 "src/ocaml/preprocess/parser_raw.ml"
+# 45725 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 45764 "src/ocaml/preprocess/parser_raw.ml"
+# 45734 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2731 "src/ocaml/preprocess/parser_raw.mly"
+# 2769 "src/ocaml/preprocess/parser_raw.mly"
( let list_exp =
(* TODO: review the location of list_exp *)
let tail_exp, _tail_loc = mktailexp _loc__5_ _4 in
mkexp ~loc:(_startpos__3_, _endpos) tail_exp in
Pexp_open(od, list_exp) )
-# 45776 "src/ocaml/preprocess/parser_raw.ml"
+# 45746 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -45780,15 +45750,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45786 "src/ocaml/preprocess/parser_raw.ml"
+# 45756 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45792 "src/ocaml/preprocess/parser_raw.ml"
+# 45762 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45836,18 +45806,18 @@ module Tables = struct
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2736 "src/ocaml/preprocess/parser_raw.mly"
+# 2774 "src/ocaml/preprocess/parser_raw.mly"
(Lident "[]")
-# 45842 "src/ocaml/preprocess/parser_raw.ml"
+# 45812 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45851 "src/ocaml/preprocess/parser_raw.ml"
+# 45821 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
@@ -45857,25 +45827,25 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 45863 "src/ocaml/preprocess/parser_raw.ml"
+# 45833 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 45872 "src/ocaml/preprocess/parser_raw.ml"
+# 45842 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2737 "src/ocaml/preprocess/parser_raw.mly"
+# 2775 "src/ocaml/preprocess/parser_raw.mly"
( Pexp_open(od, mkexp ~loc:_loc__3_ (Pexp_construct(_3, None))) )
-# 45879 "src/ocaml/preprocess/parser_raw.ml"
+# 45849 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
@@ -45883,15 +45853,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 45889 "src/ocaml/preprocess/parser_raw.ml"
+# 45859 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 45895 "src/ocaml/preprocess/parser_raw.ml"
+# 45865 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -45984,11 +45954,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 45992 "src/ocaml/preprocess/parser_raw.ml"
+# 45962 "src/ocaml/preprocess/parser_raw.ml"
in
let _5 =
@@ -45996,15 +45966,15 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46002 "src/ocaml/preprocess/parser_raw.ml"
+# 45972 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 46008 "src/ocaml/preprocess/parser_raw.ml"
+# 45978 "src/ocaml/preprocess/parser_raw.ml"
in
let od =
@@ -46013,18 +45983,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46019 "src/ocaml/preprocess/parser_raw.ml"
+# 45989 "src/ocaml/preprocess/parser_raw.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1764 "src/ocaml/preprocess/parser_raw.mly"
+# 1784 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 46028 "src/ocaml/preprocess/parser_raw.ml"
+# 45998 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos_od_ = _startpos__1_ in
@@ -46032,12 +46002,12 @@ module Tables = struct
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2745 "src/ocaml/preprocess/parser_raw.mly"
+# 2783 "src/ocaml/preprocess/parser_raw.mly"
( let modexp =
mkexp_attrs ~loc:(_startpos__3_, _endpos)
(Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in
Pexp_open(od, modexp) )
-# 46041 "src/ocaml/preprocess/parser_raw.ml"
+# 46011 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__9_ in
@@ -46045,15 +46015,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1060 "src/ocaml/preprocess/parser_raw.mly"
+# 1080 "src/ocaml/preprocess/parser_raw.mly"
( mkexp ~loc:_sloc _1 )
-# 46051 "src/ocaml/preprocess/parser_raw.ml"
+# 46021 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2616 "src/ocaml/preprocess/parser_raw.mly"
+# 2635 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46057 "src/ocaml/preprocess/parser_raw.ml"
+# 46027 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46082,30 +46052,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46088 "src/ocaml/preprocess/parser_raw.ml"
+# 46058 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3069 "src/ocaml/preprocess/parser_raw.mly"
+# 3110 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_var (_1) )
-# 46094 "src/ocaml/preprocess/parser_raw.ml"
+# 46064 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46103 "src/ocaml/preprocess/parser_raw.ml"
+# 46073 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3070 "src/ocaml/preprocess/parser_raw.mly"
+# 3111 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46109 "src/ocaml/preprocess/parser_raw.ml"
+# 46079 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46128,9 +46098,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 3071 "src/ocaml/preprocess/parser_raw.mly"
+# 3112 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46134 "src/ocaml/preprocess/parser_raw.ml"
+# 46104 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46170,9 +46140,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3076 "src/ocaml/preprocess/parser_raw.mly"
+# 3117 "src/ocaml/preprocess/parser_raw.mly"
( reloc_pat ~loc:_sloc _2 )
-# 46176 "src/ocaml/preprocess/parser_raw.ml"
+# 46146 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46195,9 +46165,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 3078 "src/ocaml/preprocess/parser_raw.mly"
+# 3119 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46201 "src/ocaml/preprocess/parser_raw.ml"
+# 46171 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46260,9 +46230,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46266 "src/ocaml/preprocess/parser_raw.ml"
+# 46236 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
@@ -46270,24 +46240,24 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46276 "src/ocaml/preprocess/parser_raw.ml"
+# 46246 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 46282 "src/ocaml/preprocess/parser_raw.ml"
+# 46252 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3080 "src/ocaml/preprocess/parser_raw.mly"
+# 3121 "src/ocaml/preprocess/parser_raw.mly"
( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 )
-# 46291 "src/ocaml/preprocess/parser_raw.ml"
+# 46261 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46364,11 +46334,11 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3807 "src/ocaml/preprocess/parser_raw.mly"
+# 3848 "src/ocaml/preprocess/parser_raw.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 46372 "src/ocaml/preprocess/parser_raw.ml"
+# 46342 "src/ocaml/preprocess/parser_raw.ml"
in
let _4 =
@@ -46377,9 +46347,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46383 "src/ocaml/preprocess/parser_raw.ml"
+# 46353 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__4_, _startpos__4_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
@@ -46388,15 +46358,15 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46394 "src/ocaml/preprocess/parser_raw.ml"
+# 46364 "src/ocaml/preprocess/parser_raw.ml"
in
-# 4240 "src/ocaml/preprocess/parser_raw.mly"
+# 4288 "src/ocaml/preprocess/parser_raw.mly"
( _1, _2 )
-# 46400 "src/ocaml/preprocess/parser_raw.ml"
+# 46370 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
@@ -46404,11 +46374,11 @@ module Tables = struct
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 3082 "src/ocaml/preprocess/parser_raw.mly"
+# 3123 "src/ocaml/preprocess/parser_raw.mly"
( mkpat_attrs ~loc:_sloc
(Ppat_constraint(mkpat ~loc:_loc__4_ (Ppat_unpack _4), _6))
_3 )
-# 46412 "src/ocaml/preprocess/parser_raw.ml"
+# 46382 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46432,23 +46402,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3090 "src/ocaml/preprocess/parser_raw.mly"
+# 3131 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_any )
-# 46438 "src/ocaml/preprocess/parser_raw.ml"
+# 46408 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46446 "src/ocaml/preprocess/parser_raw.ml"
+# 46416 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46452 "src/ocaml/preprocess/parser_raw.ml"
+# 46422 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46472,23 +46442,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3092 "src/ocaml/preprocess/parser_raw.mly"
+# 3133 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_constant _1 )
-# 46478 "src/ocaml/preprocess/parser_raw.ml"
+# 46448 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46486 "src/ocaml/preprocess/parser_raw.ml"
+# 46456 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46492 "src/ocaml/preprocess/parser_raw.ml"
+# 46462 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46526,24 +46496,24 @@ module Tables = struct
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3094 "src/ocaml/preprocess/parser_raw.mly"
+# 3135 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_interval (_1, _3) )
-# 46532 "src/ocaml/preprocess/parser_raw.ml"
+# 46502 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46541 "src/ocaml/preprocess/parser_raw.ml"
+# 46511 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46547 "src/ocaml/preprocess/parser_raw.ml"
+# 46517 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46572,30 +46542,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46578 "src/ocaml/preprocess/parser_raw.ml"
+# 46548 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3096 "src/ocaml/preprocess/parser_raw.mly"
+# 3137 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_construct(_1, None) )
-# 46584 "src/ocaml/preprocess/parser_raw.ml"
+# 46554 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46593 "src/ocaml/preprocess/parser_raw.ml"
+# 46563 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46599 "src/ocaml/preprocess/parser_raw.ml"
+# 46569 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46619,23 +46589,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3098 "src/ocaml/preprocess/parser_raw.mly"
+# 3139 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_variant(_1, None) )
-# 46625 "src/ocaml/preprocess/parser_raw.ml"
+# 46595 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46633 "src/ocaml/preprocess/parser_raw.ml"
+# 46603 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46639 "src/ocaml/preprocess/parser_raw.ml"
+# 46609 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46672,15 +46642,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46678 "src/ocaml/preprocess/parser_raw.ml"
+# 46648 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3100 "src/ocaml/preprocess/parser_raw.mly"
+# 3141 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_type (_2) )
-# 46684 "src/ocaml/preprocess/parser_raw.ml"
+# 46654 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -46688,15 +46658,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46694 "src/ocaml/preprocess/parser_raw.ml"
+# 46664 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46700 "src/ocaml/preprocess/parser_raw.ml"
+# 46670 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46739,15 +46709,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46745 "src/ocaml/preprocess/parser_raw.ml"
+# 46715 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3102 "src/ocaml/preprocess/parser_raw.mly"
+# 3143 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_open(_1, _3) )
-# 46751 "src/ocaml/preprocess/parser_raw.ml"
+# 46721 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__3_ in
@@ -46755,15 +46725,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46761 "src/ocaml/preprocess/parser_raw.ml"
+# 46731 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46767 "src/ocaml/preprocess/parser_raw.ml"
+# 46737 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46811,18 +46781,18 @@ module Tables = struct
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 3103 "src/ocaml/preprocess/parser_raw.mly"
+# 3144 "src/ocaml/preprocess/parser_raw.mly"
(Lident "[]")
-# 46817 "src/ocaml/preprocess/parser_raw.ml"
+# 46787 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46826 "src/ocaml/preprocess/parser_raw.ml"
+# 46796 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
@@ -46831,18 +46801,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46837 "src/ocaml/preprocess/parser_raw.ml"
+# 46807 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3104 "src/ocaml/preprocess/parser_raw.mly"
+# 3145 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 46846 "src/ocaml/preprocess/parser_raw.ml"
+# 46816 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
@@ -46850,15 +46820,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46856 "src/ocaml/preprocess/parser_raw.ml"
+# 46826 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46862 "src/ocaml/preprocess/parser_raw.ml"
+# 46832 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -46906,18 +46876,18 @@ module Tables = struct
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 3105 "src/ocaml/preprocess/parser_raw.mly"
+# 3146 "src/ocaml/preprocess/parser_raw.mly"
(Lident "()")
-# 46912 "src/ocaml/preprocess/parser_raw.ml"
+# 46882 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46921 "src/ocaml/preprocess/parser_raw.ml"
+# 46891 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
@@ -46926,18 +46896,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 46932 "src/ocaml/preprocess/parser_raw.ml"
+# 46902 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3106 "src/ocaml/preprocess/parser_raw.mly"
+# 3147 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 46941 "src/ocaml/preprocess/parser_raw.ml"
+# 46911 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
@@ -46945,15 +46915,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 46951 "src/ocaml/preprocess/parser_raw.ml"
+# 46921 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 46957 "src/ocaml/preprocess/parser_raw.ml"
+# 46927 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47010,15 +46980,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 47016 "src/ocaml/preprocess/parser_raw.ml"
+# 46986 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3108 "src/ocaml/preprocess/parser_raw.mly"
+# 3149 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_open (_1, _4) )
-# 47022 "src/ocaml/preprocess/parser_raw.ml"
+# 46992 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
@@ -47026,15 +46996,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 47032 "src/ocaml/preprocess/parser_raw.ml"
+# 47002 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 47038 "src/ocaml/preprocess/parser_raw.ml"
+# 47008 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47086,24 +47056,24 @@ module Tables = struct
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3118 "src/ocaml/preprocess/parser_raw.mly"
+# 3159 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_constraint(_2, _4) )
-# 47092 "src/ocaml/preprocess/parser_raw.ml"
+# 47062 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 47101 "src/ocaml/preprocess/parser_raw.ml"
+# 47071 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 47107 "src/ocaml/preprocess/parser_raw.ml"
+# 47077 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47127,23 +47097,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 3129 "src/ocaml/preprocess/parser_raw.mly"
+# 3170 "src/ocaml/preprocess/parser_raw.mly"
( Ppat_extension _1 )
-# 47133 "src/ocaml/preprocess/parser_raw.ml"
+# 47103 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1062 "src/ocaml/preprocess/parser_raw.mly"
+# 1082 "src/ocaml/preprocess/parser_raw.mly"
( mkpat ~loc:_sloc _1 )
-# 47141 "src/ocaml/preprocess/parser_raw.ml"
+# 47111 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3086 "src/ocaml/preprocess/parser_raw.mly"
+# 3127 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 47147 "src/ocaml/preprocess/parser_raw.ml"
+# 47117 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47162,17 +47132,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 47168 "src/ocaml/preprocess/parser_raw.ml"
+# 47138 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4148 "src/ocaml/preprocess/parser_raw.mly"
+# 4196 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 47176 "src/ocaml/preprocess/parser_raw.ml"
+# 47146 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47191,17 +47161,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 47197 "src/ocaml/preprocess/parser_raw.ml"
+# 47167 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4149 "src/ocaml/preprocess/parser_raw.mly"
+# 4197 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 47205 "src/ocaml/preprocess/parser_raw.ml"
+# 47175 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47224,9 +47194,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4150 "src/ocaml/preprocess/parser_raw.mly"
+# 4198 "src/ocaml/preprocess/parser_raw.mly"
( "and" )
-# 47230 "src/ocaml/preprocess/parser_raw.ml"
+# 47200 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47249,9 +47219,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4151 "src/ocaml/preprocess/parser_raw.mly"
+# 4199 "src/ocaml/preprocess/parser_raw.mly"
( "as" )
-# 47255 "src/ocaml/preprocess/parser_raw.ml"
+# 47225 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47274,9 +47244,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4152 "src/ocaml/preprocess/parser_raw.mly"
+# 4200 "src/ocaml/preprocess/parser_raw.mly"
( "assert" )
-# 47280 "src/ocaml/preprocess/parser_raw.ml"
+# 47250 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47299,9 +47269,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4153 "src/ocaml/preprocess/parser_raw.mly"
+# 4201 "src/ocaml/preprocess/parser_raw.mly"
( "begin" )
-# 47305 "src/ocaml/preprocess/parser_raw.ml"
+# 47275 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47324,9 +47294,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4154 "src/ocaml/preprocess/parser_raw.mly"
+# 4202 "src/ocaml/preprocess/parser_raw.mly"
( "class" )
-# 47330 "src/ocaml/preprocess/parser_raw.ml"
+# 47300 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47349,9 +47319,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4155 "src/ocaml/preprocess/parser_raw.mly"
+# 4203 "src/ocaml/preprocess/parser_raw.mly"
( "constraint" )
-# 47355 "src/ocaml/preprocess/parser_raw.ml"
+# 47325 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47374,9 +47344,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4156 "src/ocaml/preprocess/parser_raw.mly"
+# 4204 "src/ocaml/preprocess/parser_raw.mly"
( "do" )
-# 47380 "src/ocaml/preprocess/parser_raw.ml"
+# 47350 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47399,9 +47369,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4157 "src/ocaml/preprocess/parser_raw.mly"
+# 4205 "src/ocaml/preprocess/parser_raw.mly"
( "done" )
-# 47405 "src/ocaml/preprocess/parser_raw.ml"
+# 47375 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47424,9 +47394,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4158 "src/ocaml/preprocess/parser_raw.mly"
+# 4206 "src/ocaml/preprocess/parser_raw.mly"
( "downto" )
-# 47430 "src/ocaml/preprocess/parser_raw.ml"
+# 47400 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47449,9 +47419,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4159 "src/ocaml/preprocess/parser_raw.mly"
+# 4207 "src/ocaml/preprocess/parser_raw.mly"
( "else" )
-# 47455 "src/ocaml/preprocess/parser_raw.ml"
+# 47425 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47474,9 +47444,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4160 "src/ocaml/preprocess/parser_raw.mly"
+# 4208 "src/ocaml/preprocess/parser_raw.mly"
( "end" )
-# 47480 "src/ocaml/preprocess/parser_raw.ml"
+# 47450 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47499,9 +47469,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4161 "src/ocaml/preprocess/parser_raw.mly"
+# 4209 "src/ocaml/preprocess/parser_raw.mly"
( "exception" )
-# 47505 "src/ocaml/preprocess/parser_raw.ml"
+# 47475 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47524,9 +47494,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4162 "src/ocaml/preprocess/parser_raw.mly"
+# 4210 "src/ocaml/preprocess/parser_raw.mly"
( "external" )
-# 47530 "src/ocaml/preprocess/parser_raw.ml"
+# 47500 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47549,9 +47519,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4163 "src/ocaml/preprocess/parser_raw.mly"
+# 4211 "src/ocaml/preprocess/parser_raw.mly"
( "false" )
-# 47555 "src/ocaml/preprocess/parser_raw.ml"
+# 47525 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47574,9 +47544,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4164 "src/ocaml/preprocess/parser_raw.mly"
+# 4212 "src/ocaml/preprocess/parser_raw.mly"
( "for" )
-# 47580 "src/ocaml/preprocess/parser_raw.ml"
+# 47550 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47599,9 +47569,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4165 "src/ocaml/preprocess/parser_raw.mly"
+# 4213 "src/ocaml/preprocess/parser_raw.mly"
( "fun" )
-# 47605 "src/ocaml/preprocess/parser_raw.ml"
+# 47575 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47624,9 +47594,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4166 "src/ocaml/preprocess/parser_raw.mly"
+# 4214 "src/ocaml/preprocess/parser_raw.mly"
( "function" )
-# 47630 "src/ocaml/preprocess/parser_raw.ml"
+# 47600 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47649,9 +47619,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4167 "src/ocaml/preprocess/parser_raw.mly"
+# 4215 "src/ocaml/preprocess/parser_raw.mly"
( "functor" )
-# 47655 "src/ocaml/preprocess/parser_raw.ml"
+# 47625 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47674,9 +47644,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4168 "src/ocaml/preprocess/parser_raw.mly"
+# 4216 "src/ocaml/preprocess/parser_raw.mly"
( "if" )
-# 47680 "src/ocaml/preprocess/parser_raw.ml"
+# 47650 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47699,9 +47669,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4169 "src/ocaml/preprocess/parser_raw.mly"
+# 4217 "src/ocaml/preprocess/parser_raw.mly"
( "in" )
-# 47705 "src/ocaml/preprocess/parser_raw.ml"
+# 47675 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47724,9 +47694,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4170 "src/ocaml/preprocess/parser_raw.mly"
+# 4218 "src/ocaml/preprocess/parser_raw.mly"
( "include" )
-# 47730 "src/ocaml/preprocess/parser_raw.ml"
+# 47700 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47749,9 +47719,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4171 "src/ocaml/preprocess/parser_raw.mly"
+# 4219 "src/ocaml/preprocess/parser_raw.mly"
( "inherit" )
-# 47755 "src/ocaml/preprocess/parser_raw.ml"
+# 47725 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47774,9 +47744,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4172 "src/ocaml/preprocess/parser_raw.mly"
+# 4220 "src/ocaml/preprocess/parser_raw.mly"
( "initializer" )
-# 47780 "src/ocaml/preprocess/parser_raw.ml"
+# 47750 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47799,9 +47769,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4173 "src/ocaml/preprocess/parser_raw.mly"
+# 4221 "src/ocaml/preprocess/parser_raw.mly"
( "lazy" )
-# 47805 "src/ocaml/preprocess/parser_raw.ml"
+# 47775 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47824,9 +47794,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4174 "src/ocaml/preprocess/parser_raw.mly"
+# 4222 "src/ocaml/preprocess/parser_raw.mly"
( "let" )
-# 47830 "src/ocaml/preprocess/parser_raw.ml"
+# 47800 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47849,9 +47819,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4175 "src/ocaml/preprocess/parser_raw.mly"
+# 4223 "src/ocaml/preprocess/parser_raw.mly"
( "match" )
-# 47855 "src/ocaml/preprocess/parser_raw.ml"
+# 47825 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47874,9 +47844,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4176 "src/ocaml/preprocess/parser_raw.mly"
+# 4224 "src/ocaml/preprocess/parser_raw.mly"
( "method" )
-# 47880 "src/ocaml/preprocess/parser_raw.ml"
+# 47850 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47899,9 +47869,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4177 "src/ocaml/preprocess/parser_raw.mly"
+# 4225 "src/ocaml/preprocess/parser_raw.mly"
( "module" )
-# 47905 "src/ocaml/preprocess/parser_raw.ml"
+# 47875 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47924,9 +47894,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4178 "src/ocaml/preprocess/parser_raw.mly"
+# 4226 "src/ocaml/preprocess/parser_raw.mly"
( "mutable" )
-# 47930 "src/ocaml/preprocess/parser_raw.ml"
+# 47900 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47949,9 +47919,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4179 "src/ocaml/preprocess/parser_raw.mly"
+# 4227 "src/ocaml/preprocess/parser_raw.mly"
( "new" )
-# 47955 "src/ocaml/preprocess/parser_raw.ml"
+# 47925 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47974,9 +47944,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4180 "src/ocaml/preprocess/parser_raw.mly"
+# 4228 "src/ocaml/preprocess/parser_raw.mly"
( "nonrec" )
-# 47980 "src/ocaml/preprocess/parser_raw.ml"
+# 47950 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -47999,9 +47969,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4181 "src/ocaml/preprocess/parser_raw.mly"
+# 4229 "src/ocaml/preprocess/parser_raw.mly"
( "object" )
-# 48005 "src/ocaml/preprocess/parser_raw.ml"
+# 47975 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48024,9 +47994,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4182 "src/ocaml/preprocess/parser_raw.mly"
+# 4230 "src/ocaml/preprocess/parser_raw.mly"
( "of" )
-# 48030 "src/ocaml/preprocess/parser_raw.ml"
+# 48000 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48049,9 +48019,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4183 "src/ocaml/preprocess/parser_raw.mly"
+# 4231 "src/ocaml/preprocess/parser_raw.mly"
( "open" )
-# 48055 "src/ocaml/preprocess/parser_raw.ml"
+# 48025 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48074,9 +48044,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4184 "src/ocaml/preprocess/parser_raw.mly"
+# 4232 "src/ocaml/preprocess/parser_raw.mly"
( "or" )
-# 48080 "src/ocaml/preprocess/parser_raw.ml"
+# 48050 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48099,9 +48069,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4185 "src/ocaml/preprocess/parser_raw.mly"
+# 4233 "src/ocaml/preprocess/parser_raw.mly"
( "private" )
-# 48105 "src/ocaml/preprocess/parser_raw.ml"
+# 48075 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48124,9 +48094,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4186 "src/ocaml/preprocess/parser_raw.mly"
+# 4234 "src/ocaml/preprocess/parser_raw.mly"
( "rec" )
-# 48130 "src/ocaml/preprocess/parser_raw.ml"
+# 48100 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48149,9 +48119,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4187 "src/ocaml/preprocess/parser_raw.mly"
+# 4235 "src/ocaml/preprocess/parser_raw.mly"
( "sig" )
-# 48155 "src/ocaml/preprocess/parser_raw.ml"
+# 48125 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48174,9 +48144,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4188 "src/ocaml/preprocess/parser_raw.mly"
+# 4236 "src/ocaml/preprocess/parser_raw.mly"
( "struct" )
-# 48180 "src/ocaml/preprocess/parser_raw.ml"
+# 48150 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48199,9 +48169,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4189 "src/ocaml/preprocess/parser_raw.mly"
+# 4237 "src/ocaml/preprocess/parser_raw.mly"
( "then" )
-# 48205 "src/ocaml/preprocess/parser_raw.ml"
+# 48175 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48224,9 +48194,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4190 "src/ocaml/preprocess/parser_raw.mly"
+# 4238 "src/ocaml/preprocess/parser_raw.mly"
( "to" )
-# 48230 "src/ocaml/preprocess/parser_raw.ml"
+# 48200 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48249,9 +48219,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4191 "src/ocaml/preprocess/parser_raw.mly"
+# 4239 "src/ocaml/preprocess/parser_raw.mly"
( "true" )
-# 48255 "src/ocaml/preprocess/parser_raw.ml"
+# 48225 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48274,9 +48244,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4192 "src/ocaml/preprocess/parser_raw.mly"
+# 4240 "src/ocaml/preprocess/parser_raw.mly"
( "try" )
-# 48280 "src/ocaml/preprocess/parser_raw.ml"
+# 48250 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48299,9 +48269,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4193 "src/ocaml/preprocess/parser_raw.mly"
+# 4241 "src/ocaml/preprocess/parser_raw.mly"
( "type" )
-# 48305 "src/ocaml/preprocess/parser_raw.ml"
+# 48275 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48324,9 +48294,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4194 "src/ocaml/preprocess/parser_raw.mly"
+# 4242 "src/ocaml/preprocess/parser_raw.mly"
( "val" )
-# 48330 "src/ocaml/preprocess/parser_raw.ml"
+# 48300 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48349,9 +48319,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4195 "src/ocaml/preprocess/parser_raw.mly"
+# 4243 "src/ocaml/preprocess/parser_raw.mly"
( "virtual" )
-# 48355 "src/ocaml/preprocess/parser_raw.ml"
+# 48325 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48374,9 +48344,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4196 "src/ocaml/preprocess/parser_raw.mly"
+# 4244 "src/ocaml/preprocess/parser_raw.mly"
( "when" )
-# 48380 "src/ocaml/preprocess/parser_raw.ml"
+# 48350 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48399,9 +48369,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4197 "src/ocaml/preprocess/parser_raw.mly"
+# 4245 "src/ocaml/preprocess/parser_raw.mly"
( "while" )
-# 48405 "src/ocaml/preprocess/parser_raw.ml"
+# 48375 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48424,9 +48394,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4198 "src/ocaml/preprocess/parser_raw.mly"
+# 4246 "src/ocaml/preprocess/parser_raw.mly"
( "with" )
-# 48430 "src/ocaml/preprocess/parser_raw.ml"
+# 48400 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48449,9 +48419,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.type_exception * string Location.loc option) =
-# 3410 "src/ocaml/preprocess/parser_raw.mly"
+# 3451 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48455 "src/ocaml/preprocess/parser_raw.ml"
+# 48425 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48525,18 +48495,18 @@ module Tables = struct
let _v : (Parsetree.type_exception * string Location.loc option) = let attrs =
let _1 = _1_inlined5 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48531 "src/ocaml/preprocess/parser_raw.ml"
+# 48501 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs_ = _endpos__1_inlined5_ in
let attrs2 =
let _1 = _1_inlined4 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48540 "src/ocaml/preprocess/parser_raw.ml"
+# 48510 "src/ocaml/preprocess/parser_raw.ml"
in
let lid =
@@ -48545,9 +48515,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 48551 "src/ocaml/preprocess/parser_raw.ml"
+# 48521 "src/ocaml/preprocess/parser_raw.ml"
in
let id =
@@ -48556,30 +48526,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 48562 "src/ocaml/preprocess/parser_raw.ml"
+# 48532 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48570 "src/ocaml/preprocess/parser_raw.ml"
+# 48540 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "src/ocaml/preprocess/parser_raw.mly"
+# 3460 "src/ocaml/preprocess/parser_raw.mly"
( let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Te.mk_exception ~attrs
(Te.rebind id lid ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext )
-# 48583 "src/ocaml/preprocess/parser_raw.ml"
+# 48553 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48609,9 +48579,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2872 "src/ocaml/preprocess/parser_raw.mly"
+# 2910 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 48615 "src/ocaml/preprocess/parser_raw.ml"
+# 48585 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48658,10 +48628,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2874 "src/ocaml/preprocess/parser_raw.mly"
+# 2912 "src/ocaml/preprocess/parser_raw.mly"
( ghexp ~loc:_sloc (mkfunction _1 _2 _4)
)
-# 48665 "src/ocaml/preprocess/parser_raw.ml"
+# 48635 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48688,39 +48658,39 @@ module Tables = struct
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 48692 "src/ocaml/preprocess/parser_raw.ml"
+# 48662 "src/ocaml/preprocess/parser_raw.ml"
in
let xs =
let items =
-# 1097 "src/ocaml/preprocess/parser_raw.mly"
+# 1117 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 48698 "src/ocaml/preprocess/parser_raw.ml"
+# 48668 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1563 "src/ocaml/preprocess/parser_raw.mly"
+# 1583 "src/ocaml/preprocess/parser_raw.mly"
( items )
-# 48703 "src/ocaml/preprocess/parser_raw.ml"
+# 48673 "src/ocaml/preprocess/parser_raw.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 48709 "src/ocaml/preprocess/parser_raw.ml"
+# 48679 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1019 "src/ocaml/preprocess/parser_raw.mly"
+# 1039 "src/ocaml/preprocess/parser_raw.mly"
( extra_str _startpos _endpos _1 )
-# 48718 "src/ocaml/preprocess/parser_raw.ml"
+# 48688 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1556 "src/ocaml/preprocess/parser_raw.mly"
+# 1576 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48724 "src/ocaml/preprocess/parser_raw.ml"
+# 48694 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48761,7 +48731,7 @@ module Tables = struct
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 48765 "src/ocaml/preprocess/parser_raw.ml"
+# 48735 "src/ocaml/preprocess/parser_raw.ml"
in
let xs =
let items =
@@ -48769,65 +48739,65 @@ module Tables = struct
let _1 =
let _1 =
let attrs =
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48775 "src/ocaml/preprocess/parser_raw.ml"
+# 48745 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1570 "src/ocaml/preprocess/parser_raw.mly"
+# 1590 "src/ocaml/preprocess/parser_raw.mly"
( mkstrexp e attrs )
-# 48780 "src/ocaml/preprocess/parser_raw.ml"
+# 48750 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 1031 "src/ocaml/preprocess/parser_raw.mly"
+# 1051 "src/ocaml/preprocess/parser_raw.mly"
( text_str _startpos @ [_1] )
-# 48788 "src/ocaml/preprocess/parser_raw.ml"
+# 48758 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1050 "src/ocaml/preprocess/parser_raw.mly"
+# 1070 "src/ocaml/preprocess/parser_raw.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 48798 "src/ocaml/preprocess/parser_raw.ml"
+# 48768 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1099 "src/ocaml/preprocess/parser_raw.mly"
+# 1119 "src/ocaml/preprocess/parser_raw.mly"
( x )
-# 48804 "src/ocaml/preprocess/parser_raw.ml"
+# 48774 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1563 "src/ocaml/preprocess/parser_raw.mly"
+# 1583 "src/ocaml/preprocess/parser_raw.mly"
( items )
-# 48810 "src/ocaml/preprocess/parser_raw.ml"
+# 48780 "src/ocaml/preprocess/parser_raw.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 48816 "src/ocaml/preprocess/parser_raw.ml"
+# 48786 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1019 "src/ocaml/preprocess/parser_raw.mly"
+# 1039 "src/ocaml/preprocess/parser_raw.mly"
( extra_str _startpos _endpos _1 )
-# 48825 "src/ocaml/preprocess/parser_raw.ml"
+# 48795 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1556 "src/ocaml/preprocess/parser_raw.mly"
+# 1576 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48831 "src/ocaml/preprocess/parser_raw.ml"
+# 48801 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48853,9 +48823,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1585 "src/ocaml/preprocess/parser_raw.mly"
+# 1605 "src/ocaml/preprocess/parser_raw.mly"
( val_of_let_bindings ~loc:_sloc _1 )
-# 48859 "src/ocaml/preprocess/parser_raw.ml"
+# 48829 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48889,9 +48859,9 @@ module Tables = struct
let _2 =
let _1 = _1_inlined1 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48895 "src/ocaml/preprocess/parser_raw.ml"
+# 48865 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
@@ -48899,10 +48869,10 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1588 "src/ocaml/preprocess/parser_raw.mly"
+# 1608 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
Pstr_extension (_1, add_docs_attrs docs _2) )
-# 48906 "src/ocaml/preprocess/parser_raw.ml"
+# 48876 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
@@ -48910,15 +48880,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1066 "src/ocaml/preprocess/parser_raw.mly"
+# 1086 "src/ocaml/preprocess/parser_raw.mly"
( mkstr ~loc:_sloc _1 )
-# 48916 "src/ocaml/preprocess/parser_raw.ml"
+# 48886 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48922 "src/ocaml/preprocess/parser_raw.ml"
+# 48892 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48942,23 +48912,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1591 "src/ocaml/preprocess/parser_raw.mly"
+# 1611 "src/ocaml/preprocess/parser_raw.mly"
( Pstr_attribute _1 )
-# 48948 "src/ocaml/preprocess/parser_raw.ml"
+# 48918 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1066 "src/ocaml/preprocess/parser_raw.mly"
+# 1086 "src/ocaml/preprocess/parser_raw.mly"
( mkstr ~loc:_sloc _1 )
-# 48956 "src/ocaml/preprocess/parser_raw.ml"
+# 48926 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 48962 "src/ocaml/preprocess/parser_raw.ml"
+# 48932 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -48982,23 +48952,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1595 "src/ocaml/preprocess/parser_raw.mly"
+# 1615 "src/ocaml/preprocess/parser_raw.mly"
( pstr_primitive _1 )
-# 48988 "src/ocaml/preprocess/parser_raw.ml"
+# 48958 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 48996 "src/ocaml/preprocess/parser_raw.ml"
+# 48966 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49002 "src/ocaml/preprocess/parser_raw.ml"
+# 48972 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49022,23 +48992,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1597 "src/ocaml/preprocess/parser_raw.mly"
+# 1617 "src/ocaml/preprocess/parser_raw.mly"
( pstr_primitive _1 )
-# 49028 "src/ocaml/preprocess/parser_raw.ml"
+# 48998 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49036 "src/ocaml/preprocess/parser_raw.ml"
+# 49006 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49042 "src/ocaml/preprocess/parser_raw.ml"
+# 49012 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49073,26 +49043,26 @@ module Tables = struct
let _1 =
let _1 =
let _1 =
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 49079 "src/ocaml/preprocess/parser_raw.ml"
+# 49049 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3252 "src/ocaml/preprocess/parser_raw.mly"
+# 3293 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49084 "src/ocaml/preprocess/parser_raw.ml"
+# 49054 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3235 "src/ocaml/preprocess/parser_raw.mly"
+# 3276 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49090 "src/ocaml/preprocess/parser_raw.ml"
+# 49060 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1599 "src/ocaml/preprocess/parser_raw.mly"
+# 1619 "src/ocaml/preprocess/parser_raw.mly"
( pstr_type _1 )
-# 49096 "src/ocaml/preprocess/parser_raw.ml"
+# 49066 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
@@ -49100,15 +49070,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49106 "src/ocaml/preprocess/parser_raw.ml"
+# 49076 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49112 "src/ocaml/preprocess/parser_raw.ml"
+# 49082 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49193,16 +49163,16 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49199 "src/ocaml/preprocess/parser_raw.ml"
+# 49169 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1271 "src/ocaml/preprocess/parser_raw.mly"
+# 1291 "src/ocaml/preprocess/parser_raw.mly"
( List.rev xs )
-# 49206 "src/ocaml/preprocess/parser_raw.ml"
+# 49176 "src/ocaml/preprocess/parser_raw.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
@@ -49210,46 +49180,46 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 49216 "src/ocaml/preprocess/parser_raw.ml"
+# 49186 "src/ocaml/preprocess/parser_raw.ml"
in
let _4 =
-# 4068 "src/ocaml/preprocess/parser_raw.mly"
+# 4116 "src/ocaml/preprocess/parser_raw.mly"
( Recursive )
-# 49222 "src/ocaml/preprocess/parser_raw.ml"
+# 49192 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49229 "src/ocaml/preprocess/parser_raw.ml"
+# 49199 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3507 "src/ocaml/preprocess/parser_raw.mly"
+# 3548 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 49241 "src/ocaml/preprocess/parser_raw.ml"
+# 49211 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3490 "src/ocaml/preprocess/parser_raw.mly"
+# 3531 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49247 "src/ocaml/preprocess/parser_raw.ml"
+# 49217 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1601 "src/ocaml/preprocess/parser_raw.mly"
+# 1621 "src/ocaml/preprocess/parser_raw.mly"
( pstr_typext _1 )
-# 49253 "src/ocaml/preprocess/parser_raw.ml"
+# 49223 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
@@ -49257,15 +49227,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49263 "src/ocaml/preprocess/parser_raw.ml"
+# 49233 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49269 "src/ocaml/preprocess/parser_raw.ml"
+# 49239 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49357,16 +49327,16 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined4 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49363 "src/ocaml/preprocess/parser_raw.ml"
+# 49333 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1271 "src/ocaml/preprocess/parser_raw.mly"
+# 1291 "src/ocaml/preprocess/parser_raw.mly"
( List.rev xs )
-# 49370 "src/ocaml/preprocess/parser_raw.ml"
+# 49340 "src/ocaml/preprocess/parser_raw.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
@@ -49374,9 +49344,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 49380 "src/ocaml/preprocess/parser_raw.ml"
+# 49350 "src/ocaml/preprocess/parser_raw.ml"
in
let _4 =
@@ -49385,41 +49355,41 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 4070 "src/ocaml/preprocess/parser_raw.mly"
+# 4118 "src/ocaml/preprocess/parser_raw.mly"
( not_expecting _loc "nonrec flag"; Recursive )
-# 49391 "src/ocaml/preprocess/parser_raw.ml"
+# 49361 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49399 "src/ocaml/preprocess/parser_raw.ml"
+# 49369 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3507 "src/ocaml/preprocess/parser_raw.mly"
+# 3548 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 49411 "src/ocaml/preprocess/parser_raw.ml"
+# 49381 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3490 "src/ocaml/preprocess/parser_raw.mly"
+# 3531 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49417 "src/ocaml/preprocess/parser_raw.ml"
+# 49387 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1601 "src/ocaml/preprocess/parser_raw.mly"
+# 1621 "src/ocaml/preprocess/parser_raw.mly"
( pstr_typext _1 )
-# 49423 "src/ocaml/preprocess/parser_raw.ml"
+# 49393 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
@@ -49427,15 +49397,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49433 "src/ocaml/preprocess/parser_raw.ml"
+# 49403 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49439 "src/ocaml/preprocess/parser_raw.ml"
+# 49409 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49459,23 +49429,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1603 "src/ocaml/preprocess/parser_raw.mly"
+# 1623 "src/ocaml/preprocess/parser_raw.mly"
( pstr_exception _1 )
-# 49465 "src/ocaml/preprocess/parser_raw.ml"
+# 49435 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49473 "src/ocaml/preprocess/parser_raw.ml"
+# 49443 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49479 "src/ocaml/preprocess/parser_raw.ml"
+# 49449 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49538,9 +49508,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49544 "src/ocaml/preprocess/parser_raw.ml"
+# 49514 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -49550,36 +49520,36 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 49556 "src/ocaml/preprocess/parser_raw.ml"
+# 49526 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49564 "src/ocaml/preprocess/parser_raw.ml"
+# 49534 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1629 "src/ocaml/preprocess/parser_raw.mly"
+# 1649 "src/ocaml/preprocess/parser_raw.mly"
( let docs = symbol_docs _sloc in
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
let body = Mb.mk name body ~attrs ~loc ~docs in
Pstr_module body, ext )
-# 49577 "src/ocaml/preprocess/parser_raw.ml"
+# 49547 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1605 "src/ocaml/preprocess/parser_raw.mly"
+# 1625 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49583 "src/ocaml/preprocess/parser_raw.ml"
+# 49553 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
@@ -49587,15 +49557,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49593 "src/ocaml/preprocess/parser_raw.ml"
+# 49563 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49599 "src/ocaml/preprocess/parser_raw.ml"
+# 49569 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49674,9 +49644,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49680 "src/ocaml/preprocess/parser_raw.ml"
+# 49650 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -49686,24 +49656,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 49692 "src/ocaml/preprocess/parser_raw.ml"
+# 49662 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49700 "src/ocaml/preprocess/parser_raw.ml"
+# 49670 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1668 "src/ocaml/preprocess/parser_raw.mly"
+# 1688 "src/ocaml/preprocess/parser_raw.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
@@ -49711,25 +49681,25 @@ module Tables = struct
ext,
Mb.mk name body ~attrs ~loc ~docs
)
-# 49715 "src/ocaml/preprocess/parser_raw.ml"
+# 49685 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 49721 "src/ocaml/preprocess/parser_raw.ml"
+# 49691 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1656 "src/ocaml/preprocess/parser_raw.mly"
+# 1676 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49727 "src/ocaml/preprocess/parser_raw.ml"
+# 49697 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1607 "src/ocaml/preprocess/parser_raw.mly"
+# 1627 "src/ocaml/preprocess/parser_raw.mly"
( pstr_recmodule _1 )
-# 49733 "src/ocaml/preprocess/parser_raw.ml"
+# 49703 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_bs_ in
@@ -49737,15 +49707,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49743 "src/ocaml/preprocess/parser_raw.ml"
+# 49713 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49749 "src/ocaml/preprocess/parser_raw.ml"
+# 49719 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49769,23 +49739,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1609 "src/ocaml/preprocess/parser_raw.mly"
+# 1629 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Pstr_modtype body, ext) )
-# 49775 "src/ocaml/preprocess/parser_raw.ml"
+# 49745 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49783 "src/ocaml/preprocess/parser_raw.ml"
+# 49753 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49789 "src/ocaml/preprocess/parser_raw.ml"
+# 49759 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49809,23 +49779,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1611 "src/ocaml/preprocess/parser_raw.mly"
+# 1631 "src/ocaml/preprocess/parser_raw.mly"
( let (body, ext) = _1 in (Pstr_open body, ext) )
-# 49815 "src/ocaml/preprocess/parser_raw.ml"
+# 49785 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49823 "src/ocaml/preprocess/parser_raw.ml"
+# 49793 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49829 "src/ocaml/preprocess/parser_raw.ml"
+# 49799 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -49895,9 +49865,9 @@ module Tables = struct
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 49901 "src/ocaml/preprocess/parser_raw.ml"
+# 49871 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -49915,9 +49885,9 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49921 "src/ocaml/preprocess/parser_raw.ml"
+# 49891 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -49927,24 +49897,24 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 49933 "src/ocaml/preprocess/parser_raw.ml"
+# 49903 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49941 "src/ocaml/preprocess/parser_raw.ml"
+# 49911 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2022 "src/ocaml/preprocess/parser_raw.mly"
+# 2040 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
@@ -49952,25 +49922,25 @@ module Tables = struct
ext,
Ci.mk id body ~virt ~params ~attrs ~loc ~docs
)
-# 49956 "src/ocaml/preprocess/parser_raw.ml"
+# 49926 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1279 "src/ocaml/preprocess/parser_raw.mly"
+# 1299 "src/ocaml/preprocess/parser_raw.mly"
( let (x, b) = a in x, b :: bs )
-# 49962 "src/ocaml/preprocess/parser_raw.ml"
+# 49932 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2011 "src/ocaml/preprocess/parser_raw.mly"
+# 2029 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49968 "src/ocaml/preprocess/parser_raw.ml"
+# 49938 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1613 "src/ocaml/preprocess/parser_raw.mly"
+# 1633 "src/ocaml/preprocess/parser_raw.mly"
( let (ext, l) = _1 in (Pstr_class l, ext) )
-# 49974 "src/ocaml/preprocess/parser_raw.ml"
+# 49944 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_bs_ in
@@ -49978,15 +49948,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 49984 "src/ocaml/preprocess/parser_raw.ml"
+# 49954 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 49990 "src/ocaml/preprocess/parser_raw.ml"
+# 49960 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50010,23 +49980,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1615 "src/ocaml/preprocess/parser_raw.mly"
+# 1635 "src/ocaml/preprocess/parser_raw.mly"
( let (ext, l) = _1 in (Pstr_class_type l, ext) )
-# 50016 "src/ocaml/preprocess/parser_raw.ml"
+# 49986 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 50024 "src/ocaml/preprocess/parser_raw.ml"
+# 49994 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50030 "src/ocaml/preprocess/parser_raw.ml"
+# 50000 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50082,38 +50052,38 @@ module Tables = struct
let attrs2 =
let _1 = _1_inlined2 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50088 "src/ocaml/preprocess/parser_raw.ml"
+# 50058 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50097 "src/ocaml/preprocess/parser_raw.ml"
+# 50067 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1705 "src/ocaml/preprocess/parser_raw.mly"
+# 1725 "src/ocaml/preprocess/parser_raw.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Incl.mk thing ~attrs ~loc ~docs, ext
)
-# 50111 "src/ocaml/preprocess/parser_raw.ml"
+# 50081 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1617 "src/ocaml/preprocess/parser_raw.mly"
+# 1637 "src/ocaml/preprocess/parser_raw.mly"
( pstr_include _1 )
-# 50117 "src/ocaml/preprocess/parser_raw.ml"
+# 50087 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
@@ -50121,15 +50091,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1083 "src/ocaml/preprocess/parser_raw.mly"
+# 1103 "src/ocaml/preprocess/parser_raw.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 50127 "src/ocaml/preprocess/parser_raw.ml"
+# 50097 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1619 "src/ocaml/preprocess/parser_raw.mly"
+# 1639 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50133 "src/ocaml/preprocess/parser_raw.ml"
+# 50103 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50152,9 +50122,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4133 "src/ocaml/preprocess/parser_raw.mly"
+# 4181 "src/ocaml/preprocess/parser_raw.mly"
( "-" )
-# 50158 "src/ocaml/preprocess/parser_raw.ml"
+# 50128 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50177,9 +50147,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 4134 "src/ocaml/preprocess/parser_raw.mly"
+# 4182 "src/ocaml/preprocess/parser_raw.mly"
( "-." )
-# 50183 "src/ocaml/preprocess/parser_raw.ml"
+# 50153 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50232,9 +50202,9 @@ module Tables = struct
let _v : (Parsetree.row_field) = let _5 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50238 "src/ocaml/preprocess/parser_raw.ml"
+# 50208 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined1_ in
@@ -50243,18 +50213,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 50247 "src/ocaml/preprocess/parser_raw.ml"
+# 50217 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 50252 "src/ocaml/preprocess/parser_raw.ml"
+# 50222 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3837 "src/ocaml/preprocess/parser_raw.mly"
+# 3878 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50258 "src/ocaml/preprocess/parser_raw.ml"
+# 50228 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
@@ -50262,20 +50232,20 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50268 "src/ocaml/preprocess/parser_raw.ml"
+# 50238 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3823 "src/ocaml/preprocess/parser_raw.mly"
+# 3864 "src/ocaml/preprocess/parser_raw.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _5 in
Rf.tag ~loc:(make_loc _sloc) ~attrs _1 _3 _4 )
-# 50279 "src/ocaml/preprocess/parser_raw.ml"
+# 50249 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50307,9 +50277,9 @@ module Tables = struct
let _v : (Parsetree.row_field) = let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50313 "src/ocaml/preprocess/parser_raw.ml"
+# 50283 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
@@ -50318,20 +50288,20 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50324 "src/ocaml/preprocess/parser_raw.ml"
+# 50294 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3827 "src/ocaml/preprocess/parser_raw.mly"
+# 3868 "src/ocaml/preprocess/parser_raw.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _2 in
Rf.tag ~loc:(make_loc _sloc) ~attrs _1 true [] )
-# 50335 "src/ocaml/preprocess/parser_raw.ml"
+# 50305 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50363,7 +50333,7 @@ module Tables = struct
let _v : (Parsetree.toplevel_phrase) = let arg =
# 124 "<standard.mly>"
( None )
-# 50367 "src/ocaml/preprocess/parser_raw.ml"
+# 50337 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_arg_ = _endpos__1_inlined1_ in
let dir =
@@ -50372,18 +50342,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50378 "src/ocaml/preprocess/parser_raw.ml"
+# 50348 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4031 "src/ocaml/preprocess/parser_raw.mly"
+# 4079 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive ~loc:_sloc dir arg )
-# 50387 "src/ocaml/preprocess/parser_raw.ml"
+# 50357 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50414,9 +50384,9 @@ module Tables = struct
};
} = _menhir_stack in
let _1_inlined2 : (
-# 876 "src/ocaml/preprocess/parser_raw.mly"
+# 895 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string option)
-# 50420 "src/ocaml/preprocess/parser_raw.ml"
+# 50390 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (string) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -50427,23 +50397,23 @@ module Tables = struct
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 4035 "src/ocaml/preprocess/parser_raw.mly"
+# 4083 "src/ocaml/preprocess/parser_raw.mly"
( let (s, _, _) = _1 in Pdir_string s )
-# 50433 "src/ocaml/preprocess/parser_raw.ml"
+# 50403 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1088 "src/ocaml/preprocess/parser_raw.mly"
+# 1108 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 50441 "src/ocaml/preprocess/parser_raw.ml"
+# 50411 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 50447 "src/ocaml/preprocess/parser_raw.ml"
+# 50417 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
@@ -50453,18 +50423,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50459 "src/ocaml/preprocess/parser_raw.ml"
+# 50429 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4031 "src/ocaml/preprocess/parser_raw.mly"
+# 4079 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive ~loc:_sloc dir arg )
-# 50468 "src/ocaml/preprocess/parser_raw.ml"
+# 50438 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50495,9 +50465,9 @@ module Tables = struct
};
} = _menhir_stack in
let _1_inlined2 : (
-# 824 "src/ocaml/preprocess/parser_raw.mly"
+# 843 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 50501 "src/ocaml/preprocess/parser_raw.ml"
+# 50471 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (string) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
@@ -50508,23 +50478,23 @@ module Tables = struct
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 4036 "src/ocaml/preprocess/parser_raw.mly"
+# 4084 "src/ocaml/preprocess/parser_raw.mly"
( let (n, m) = _1 in Pdir_int (n ,m) )
-# 50514 "src/ocaml/preprocess/parser_raw.ml"
+# 50484 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1088 "src/ocaml/preprocess/parser_raw.mly"
+# 1108 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 50522 "src/ocaml/preprocess/parser_raw.ml"
+# 50492 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 50528 "src/ocaml/preprocess/parser_raw.ml"
+# 50498 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
@@ -50534,18 +50504,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50540 "src/ocaml/preprocess/parser_raw.ml"
+# 50510 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4031 "src/ocaml/preprocess/parser_raw.mly"
+# 4079 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive ~loc:_sloc dir arg )
-# 50549 "src/ocaml/preprocess/parser_raw.ml"
+# 50519 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50585,23 +50555,23 @@ module Tables = struct
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 4037 "src/ocaml/preprocess/parser_raw.mly"
+# 4085 "src/ocaml/preprocess/parser_raw.mly"
( Pdir_ident _1 )
-# 50591 "src/ocaml/preprocess/parser_raw.ml"
+# 50561 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1088 "src/ocaml/preprocess/parser_raw.mly"
+# 1108 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 50599 "src/ocaml/preprocess/parser_raw.ml"
+# 50569 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 50605 "src/ocaml/preprocess/parser_raw.ml"
+# 50575 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
@@ -50611,18 +50581,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50617 "src/ocaml/preprocess/parser_raw.ml"
+# 50587 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4031 "src/ocaml/preprocess/parser_raw.mly"
+# 4079 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive ~loc:_sloc dir arg )
-# 50626 "src/ocaml/preprocess/parser_raw.ml"
+# 50596 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50662,23 +50632,23 @@ module Tables = struct
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 4038 "src/ocaml/preprocess/parser_raw.mly"
+# 4086 "src/ocaml/preprocess/parser_raw.mly"
( Pdir_ident _1 )
-# 50668 "src/ocaml/preprocess/parser_raw.ml"
+# 50638 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1088 "src/ocaml/preprocess/parser_raw.mly"
+# 1108 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 50676 "src/ocaml/preprocess/parser_raw.ml"
+# 50646 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 50682 "src/ocaml/preprocess/parser_raw.ml"
+# 50652 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
@@ -50688,18 +50658,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50694 "src/ocaml/preprocess/parser_raw.ml"
+# 50664 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4031 "src/ocaml/preprocess/parser_raw.mly"
+# 4079 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive ~loc:_sloc dir arg )
-# 50703 "src/ocaml/preprocess/parser_raw.ml"
+# 50673 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50739,23 +50709,23 @@ module Tables = struct
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 4039 "src/ocaml/preprocess/parser_raw.mly"
+# 4087 "src/ocaml/preprocess/parser_raw.mly"
( Pdir_bool false )
-# 50745 "src/ocaml/preprocess/parser_raw.ml"
+# 50715 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1088 "src/ocaml/preprocess/parser_raw.mly"
+# 1108 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 50753 "src/ocaml/preprocess/parser_raw.ml"
+# 50723 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 50759 "src/ocaml/preprocess/parser_raw.ml"
+# 50729 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
@@ -50765,18 +50735,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50771 "src/ocaml/preprocess/parser_raw.ml"
+# 50741 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4031 "src/ocaml/preprocess/parser_raw.mly"
+# 4079 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive ~loc:_sloc dir arg )
-# 50780 "src/ocaml/preprocess/parser_raw.ml"
+# 50750 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50816,23 +50786,23 @@ module Tables = struct
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 4040 "src/ocaml/preprocess/parser_raw.mly"
+# 4088 "src/ocaml/preprocess/parser_raw.mly"
( Pdir_bool true )
-# 50822 "src/ocaml/preprocess/parser_raw.ml"
+# 50792 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1088 "src/ocaml/preprocess/parser_raw.mly"
+# 1108 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 50830 "src/ocaml/preprocess/parser_raw.ml"
+# 50800 "src/ocaml/preprocess/parser_raw.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 50836 "src/ocaml/preprocess/parser_raw.ml"
+# 50806 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
@@ -50842,18 +50812,18 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 50848 "src/ocaml/preprocess/parser_raw.ml"
+# 50818 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 4031 "src/ocaml/preprocess/parser_raw.mly"
+# 4079 "src/ocaml/preprocess/parser_raw.mly"
( mk_directive ~loc:_sloc dir arg )
-# 50857 "src/ocaml/preprocess/parser_raw.ml"
+# 50827 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50893,37 +50863,37 @@ module Tables = struct
let _1 =
let _1 =
let attrs =
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 50899 "src/ocaml/preprocess/parser_raw.ml"
+# 50869 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1570 "src/ocaml/preprocess/parser_raw.mly"
+# 1590 "src/ocaml/preprocess/parser_raw.mly"
( mkstrexp e attrs )
-# 50904 "src/ocaml/preprocess/parser_raw.ml"
+# 50874 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 1031 "src/ocaml/preprocess/parser_raw.mly"
+# 1051 "src/ocaml/preprocess/parser_raw.mly"
( text_str _startpos @ [_1] )
-# 50912 "src/ocaml/preprocess/parser_raw.ml"
+# 50882 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1019 "src/ocaml/preprocess/parser_raw.mly"
+# 1039 "src/ocaml/preprocess/parser_raw.mly"
( extra_str _startpos _endpos _1 )
-# 50921 "src/ocaml/preprocess/parser_raw.ml"
+# 50891 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1319 "src/ocaml/preprocess/parser_raw.mly"
+# 1339 "src/ocaml/preprocess/parser_raw.mly"
( Ptop_def _1 )
-# 50927 "src/ocaml/preprocess/parser_raw.ml"
+# 50897 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -50956,21 +50926,21 @@ module Tables = struct
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 50960 "src/ocaml/preprocess/parser_raw.ml"
+# 50930 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1019 "src/ocaml/preprocess/parser_raw.mly"
+# 1039 "src/ocaml/preprocess/parser_raw.mly"
( extra_str _startpos _endpos _1 )
-# 50968 "src/ocaml/preprocess/parser_raw.ml"
+# 50938 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1323 "src/ocaml/preprocess/parser_raw.mly"
+# 1343 "src/ocaml/preprocess/parser_raw.mly"
( Ptop_def _1 )
-# 50974 "src/ocaml/preprocess/parser_raw.ml"
+# 50944 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51000,9 +50970,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.toplevel_phrase) =
-# 1327 "src/ocaml/preprocess/parser_raw.mly"
+# 1347 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51006 "src/ocaml/preprocess/parser_raw.ml"
+# 50976 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51025,9 +50995,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.toplevel_phrase) =
-# 1330 "src/ocaml/preprocess/parser_raw.mly"
+# 1350 "src/ocaml/preprocess/parser_raw.mly"
( raise End_of_file )
-# 51031 "src/ocaml/preprocess/parser_raw.ml"
+# 51001 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51050,9 +51020,9 @@ module Tables = struct
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3673 "src/ocaml/preprocess/parser_raw.mly"
+# 3714 "src/ocaml/preprocess/parser_raw.mly"
( ty )
-# 51056 "src/ocaml/preprocess/parser_raw.ml"
+# 51026 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51080,18 +51050,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 51084 "src/ocaml/preprocess/parser_raw.ml"
+# 51054 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1210 "src/ocaml/preprocess/parser_raw.mly"
+# 1230 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 51089 "src/ocaml/preprocess/parser_raw.ml"
+# 51059 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3676 "src/ocaml/preprocess/parser_raw.mly"
+# 3717 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_tuple tys )
-# 51095 "src/ocaml/preprocess/parser_raw.ml"
+# 51065 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
@@ -51099,15 +51069,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 51105 "src/ocaml/preprocess/parser_raw.ml"
+# 51075 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3678 "src/ocaml/preprocess/parser_raw.mly"
+# 3719 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51111 "src/ocaml/preprocess/parser_raw.ml"
+# 51081 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51137,9 +51107,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.type_constraint) =
-# 2989 "src/ocaml/preprocess/parser_raw.mly"
+# 3027 "src/ocaml/preprocess/parser_raw.mly"
( Pconstraint _2 )
-# 51143 "src/ocaml/preprocess/parser_raw.ml"
+# 51113 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51183,9 +51153,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.type_constraint) =
-# 2990 "src/ocaml/preprocess/parser_raw.mly"
+# 3028 "src/ocaml/preprocess/parser_raw.mly"
( Pcoerce (Some _2, _4) )
-# 51189 "src/ocaml/preprocess/parser_raw.ml"
+# 51159 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51215,9 +51185,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.type_constraint) =
-# 2991 "src/ocaml/preprocess/parser_raw.mly"
+# 3029 "src/ocaml/preprocess/parser_raw.mly"
( Pcoerce (None, _2) )
-# 51221 "src/ocaml/preprocess/parser_raw.ml"
+# 51191 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51233,9 +51203,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 3326 "src/ocaml/preprocess/parser_raw.mly"
+# 3367 "src/ocaml/preprocess/parser_raw.mly"
( (Ptype_abstract, Public, None) )
-# 51239 "src/ocaml/preprocess/parser_raw.ml"
+# 51209 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51265,9 +51235,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 3328 "src/ocaml/preprocess/parser_raw.mly"
+# 3369 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 51271 "src/ocaml/preprocess/parser_raw.ml"
+# 51241 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51290,9 +51260,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3990 "src/ocaml/preprocess/parser_raw.mly"
+# 4038 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51296 "src/ocaml/preprocess/parser_raw.ml"
+# 51266 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51322,9 +51292,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) =
-# 3343 "src/ocaml/preprocess/parser_raw.mly"
+# 3384 "src/ocaml/preprocess/parser_raw.mly"
( _2, _1 )
-# 51328 "src/ocaml/preprocess/parser_raw.ml"
+# 51298 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51340,9 +51310,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
-# 3336 "src/ocaml/preprocess/parser_raw.mly"
+# 3377 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 51346 "src/ocaml/preprocess/parser_raw.ml"
+# 51316 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51365,9 +51335,9 @@ module Tables = struct
let _startpos = _startpos_p_ in
let _endpos = _endpos_p_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
-# 3338 "src/ocaml/preprocess/parser_raw.mly"
+# 3379 "src/ocaml/preprocess/parser_raw.mly"
( [p] )
-# 51371 "src/ocaml/preprocess/parser_raw.ml"
+# 51341 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51407,18 +51377,18 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 51411 "src/ocaml/preprocess/parser_raw.ml"
+# 51381 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1182 "src/ocaml/preprocess/parser_raw.mly"
+# 1202 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 51416 "src/ocaml/preprocess/parser_raw.ml"
+# 51386 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3340 "src/ocaml/preprocess/parser_raw.mly"
+# 3381 "src/ocaml/preprocess/parser_raw.mly"
( ps )
-# 51422 "src/ocaml/preprocess/parser_raw.ml"
+# 51392 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51449,24 +51419,24 @@ module Tables = struct
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3348 "src/ocaml/preprocess/parser_raw.mly"
+# 3389 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_var tyvar )
-# 51455 "src/ocaml/preprocess/parser_raw.ml"
+# 51425 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__1_ = _endpos_tyvar_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 51464 "src/ocaml/preprocess/parser_raw.ml"
+# 51434 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3351 "src/ocaml/preprocess/parser_raw.mly"
+# 3392 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51470 "src/ocaml/preprocess/parser_raw.ml"
+# 51440 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51490,23 +51460,23 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3350 "src/ocaml/preprocess/parser_raw.mly"
+# 3391 "src/ocaml/preprocess/parser_raw.mly"
( Ptyp_any )
-# 51496 "src/ocaml/preprocess/parser_raw.ml"
+# 51466 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1064 "src/ocaml/preprocess/parser_raw.mly"
+# 1084 "src/ocaml/preprocess/parser_raw.mly"
( mktyp ~loc:_sloc _1 )
-# 51504 "src/ocaml/preprocess/parser_raw.ml"
+# 51474 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3351 "src/ocaml/preprocess/parser_raw.mly"
+# 3392 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51510 "src/ocaml/preprocess/parser_raw.ml"
+# 51480 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51522,9 +51492,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3355 "src/ocaml/preprocess/parser_raw.mly"
+# 3396 "src/ocaml/preprocess/parser_raw.mly"
( NoVariance, NoInjectivity )
-# 51528 "src/ocaml/preprocess/parser_raw.ml"
+# 51498 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51547,9 +51517,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3356 "src/ocaml/preprocess/parser_raw.mly"
+# 3397 "src/ocaml/preprocess/parser_raw.mly"
( Covariant, NoInjectivity )
-# 51553 "src/ocaml/preprocess/parser_raw.ml"
+# 51523 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51572,9 +51542,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3357 "src/ocaml/preprocess/parser_raw.mly"
+# 3398 "src/ocaml/preprocess/parser_raw.mly"
( Contravariant, NoInjectivity )
-# 51578 "src/ocaml/preprocess/parser_raw.ml"
+# 51548 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51597,9 +51567,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3358 "src/ocaml/preprocess/parser_raw.mly"
+# 3399 "src/ocaml/preprocess/parser_raw.mly"
( NoVariance, Injective )
-# 51603 "src/ocaml/preprocess/parser_raw.ml"
+# 51573 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51629,9 +51599,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3359 "src/ocaml/preprocess/parser_raw.mly"
+# 3400 "src/ocaml/preprocess/parser_raw.mly"
( Covariant, Injective )
-# 51635 "src/ocaml/preprocess/parser_raw.ml"
+# 51605 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51661,9 +51631,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3359 "src/ocaml/preprocess/parser_raw.mly"
+# 3400 "src/ocaml/preprocess/parser_raw.mly"
( Covariant, Injective )
-# 51667 "src/ocaml/preprocess/parser_raw.ml"
+# 51637 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51693,9 +51663,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3360 "src/ocaml/preprocess/parser_raw.mly"
+# 3401 "src/ocaml/preprocess/parser_raw.mly"
( Contravariant, Injective )
-# 51699 "src/ocaml/preprocess/parser_raw.ml"
+# 51669 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51725,9 +51695,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3360 "src/ocaml/preprocess/parser_raw.mly"
+# 3401 "src/ocaml/preprocess/parser_raw.mly"
( Contravariant, Injective )
-# 51731 "src/ocaml/preprocess/parser_raw.ml"
+# 51701 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51746,21 +51716,21 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 816 "src/ocaml/preprocess/parser_raw.mly"
+# 835 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 51752 "src/ocaml/preprocess/parser_raw.ml"
+# 51722 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 3362 "src/ocaml/preprocess/parser_raw.mly"
+# 3403 "src/ocaml/preprocess/parser_raw.mly"
( if _1 = "+!" then Covariant, Injective else
if _1 = "-!" then Contravariant, Injective else
(expecting _loc__1_ "type_variance";
NoVariance, NoInjectivity) )
-# 51764 "src/ocaml/preprocess/parser_raw.ml"
+# 51734 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51779,21 +51749,21 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 862 "src/ocaml/preprocess/parser_raw.mly"
+# 881 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 51785 "src/ocaml/preprocess/parser_raw.ml"
+# 51755 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 3367 "src/ocaml/preprocess/parser_raw.mly"
+# 3408 "src/ocaml/preprocess/parser_raw.mly"
( if _1 = "!+" then Covariant, Injective else
if _1 = "!-" then Contravariant, Injective else
(expecting _loc__1_ "type_variance";
NoVariance, NoInjectivity) )
-# 51797 "src/ocaml/preprocess/parser_raw.ml"
+# 51767 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51827,39 +51797,39 @@ module Tables = struct
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 51831 "src/ocaml/preprocess/parser_raw.ml"
+# 51801 "src/ocaml/preprocess/parser_raw.ml"
in
let xs =
let _1 =
-# 1097 "src/ocaml/preprocess/parser_raw.mly"
+# 1117 "src/ocaml/preprocess/parser_raw.mly"
( [] )
-# 51837 "src/ocaml/preprocess/parser_raw.ml"
+# 51807 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1350 "src/ocaml/preprocess/parser_raw.mly"
+# 1370 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51842 "src/ocaml/preprocess/parser_raw.ml"
+# 51812 "src/ocaml/preprocess/parser_raw.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 51848 "src/ocaml/preprocess/parser_raw.ml"
+# 51818 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1023 "src/ocaml/preprocess/parser_raw.mly"
+# 1043 "src/ocaml/preprocess/parser_raw.mly"
( extra_def _startpos _endpos _1 )
-# 51857 "src/ocaml/preprocess/parser_raw.ml"
+# 51827 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1343 "src/ocaml/preprocess/parser_raw.mly"
+# 1363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51863 "src/ocaml/preprocess/parser_raw.ml"
+# 51833 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -51907,7 +51877,7 @@ module Tables = struct
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 51911 "src/ocaml/preprocess/parser_raw.ml"
+# 51881 "src/ocaml/preprocess/parser_raw.ml"
in
let xs =
let _1 =
@@ -51915,61 +51885,61 @@ module Tables = struct
let _1 =
let _1 =
let attrs =
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51921 "src/ocaml/preprocess/parser_raw.ml"
+# 51891 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1570 "src/ocaml/preprocess/parser_raw.mly"
+# 1590 "src/ocaml/preprocess/parser_raw.mly"
( mkstrexp e attrs )
-# 51926 "src/ocaml/preprocess/parser_raw.ml"
+# 51896 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1041 "src/ocaml/preprocess/parser_raw.mly"
+# 1061 "src/ocaml/preprocess/parser_raw.mly"
( Ptop_def [_1] )
-# 51932 "src/ocaml/preprocess/parser_raw.ml"
+# 51902 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 1039 "src/ocaml/preprocess/parser_raw.mly"
+# 1059 "src/ocaml/preprocess/parser_raw.mly"
( text_def _startpos @ [_1] )
-# 51940 "src/ocaml/preprocess/parser_raw.ml"
+# 51910 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1099 "src/ocaml/preprocess/parser_raw.mly"
+# 1119 "src/ocaml/preprocess/parser_raw.mly"
( x )
-# 51946 "src/ocaml/preprocess/parser_raw.ml"
+# 51916 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1350 "src/ocaml/preprocess/parser_raw.mly"
+# 1370 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51952 "src/ocaml/preprocess/parser_raw.ml"
+# 51922 "src/ocaml/preprocess/parser_raw.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 51958 "src/ocaml/preprocess/parser_raw.ml"
+# 51928 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 1023 "src/ocaml/preprocess/parser_raw.mly"
+# 1043 "src/ocaml/preprocess/parser_raw.mly"
( extra_def _startpos _endpos _1 )
-# 51967 "src/ocaml/preprocess/parser_raw.ml"
+# 51937 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1343 "src/ocaml/preprocess/parser_raw.mly"
+# 1363 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 51973 "src/ocaml/preprocess/parser_raw.ml"
+# 51943 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52006,9 +51976,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (string) =
-# 3907 "src/ocaml/preprocess/parser_raw.mly"
+# 3955 "src/ocaml/preprocess/parser_raw.mly"
( _2 )
-# 52012 "src/ocaml/preprocess/parser_raw.ml"
+# 51982 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52027,17 +51997,17 @@ module Tables = struct
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 52033 "src/ocaml/preprocess/parser_raw.ml"
+# 52003 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3915 "src/ocaml/preprocess/parser_raw.mly"
+# 3963 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52041 "src/ocaml/preprocess/parser_raw.ml"
+# 52011 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52060,9 +52030,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3916 "src/ocaml/preprocess/parser_raw.mly"
+# 3964 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52066 "src/ocaml/preprocess/parser_raw.ml"
+# 52036 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52085,9 +52055,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3984 "src/ocaml/preprocess/parser_raw.mly"
+# 4032 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52091 "src/ocaml/preprocess/parser_raw.ml"
+# 52061 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52132,9 +52102,9 @@ module Tables = struct
let ty : (Parsetree.core_type) = Obj.magic ty in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 52138 "src/ocaml/preprocess/parser_raw.ml"
+# 52108 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let mutable_ : (Asttypes.mutable_flag) = Obj.magic mutable_ in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
@@ -52145,33 +52115,33 @@ module Tables = struct
Parsetree.attributes) = let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52151 "src/ocaml/preprocess/parser_raw.ml"
+# 52121 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 52159 "src/ocaml/preprocess/parser_raw.ml"
+# 52129 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs =
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52165 "src/ocaml/preprocess/parser_raw.ml"
+# 52135 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4126 "src/ocaml/preprocess/parser_raw.mly"
+# 4174 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 52170 "src/ocaml/preprocess/parser_raw.ml"
+# 52140 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2168 "src/ocaml/preprocess/parser_raw.mly"
+# 2186 "src/ocaml/preprocess/parser_raw.mly"
( (label, mutable_, Cfk_virtual ty), attrs )
-# 52175 "src/ocaml/preprocess/parser_raw.ml"
+# 52145 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52216,9 +52186,9 @@ module Tables = struct
let _6 : (Parsetree.expression) = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 52222 "src/ocaml/preprocess/parser_raw.ml"
+# 52192 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
@@ -52229,33 +52199,33 @@ module Tables = struct
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52235 "src/ocaml/preprocess/parser_raw.ml"
+# 52205 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 52243 "src/ocaml/preprocess/parser_raw.ml"
+# 52213 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52249 "src/ocaml/preprocess/parser_raw.ml"
+# 52219 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 52254 "src/ocaml/preprocess/parser_raw.ml"
+# 52224 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2170 "src/ocaml/preprocess/parser_raw.mly"
+# 2188 "src/ocaml/preprocess/parser_raw.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 52259 "src/ocaml/preprocess/parser_raw.ml"
+# 52229 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52306,9 +52276,9 @@ module Tables = struct
let _6 : (Parsetree.expression) = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 52312 "src/ocaml/preprocess/parser_raw.ml"
+# 52282 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -52320,36 +52290,36 @@ module Tables = struct
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52326 "src/ocaml/preprocess/parser_raw.ml"
+# 52296 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 52334 "src/ocaml/preprocess/parser_raw.ml"
+# 52304 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52342 "src/ocaml/preprocess/parser_raw.ml"
+# 52312 "src/ocaml/preprocess/parser_raw.ml"
in
let _1 =
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 52348 "src/ocaml/preprocess/parser_raw.ml"
+# 52318 "src/ocaml/preprocess/parser_raw.ml"
in
-# 2170 "src/ocaml/preprocess/parser_raw.mly"
+# 2188 "src/ocaml/preprocess/parser_raw.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 52353 "src/ocaml/preprocess/parser_raw.ml"
+# 52323 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52401,9 +52371,9 @@ module Tables = struct
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.type_constraint) = Obj.magic _5 in
let _1_inlined1 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 52407 "src/ocaml/preprocess/parser_raw.ml"
+# 52377 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
@@ -52414,30 +52384,30 @@ module Tables = struct
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52420 "src/ocaml/preprocess/parser_raw.ml"
+# 52390 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 52428 "src/ocaml/preprocess/parser_raw.ml"
+# 52398 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52435 "src/ocaml/preprocess/parser_raw.ml"
+# 52405 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 4129 "src/ocaml/preprocess/parser_raw.mly"
+# 4177 "src/ocaml/preprocess/parser_raw.mly"
( Fresh )
-# 52441 "src/ocaml/preprocess/parser_raw.ml"
+# 52411 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__7_ in
@@ -52453,11 +52423,11 @@ module Tables = struct
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2173 "src/ocaml/preprocess/parser_raw.mly"
+# 2191 "src/ocaml/preprocess/parser_raw.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 52461 "src/ocaml/preprocess/parser_raw.ml"
+# 52431 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52515,9 +52485,9 @@ module Tables = struct
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.type_constraint) = Obj.magic _5 in
let _1_inlined2 : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 52521 "src/ocaml/preprocess/parser_raw.ml"
+# 52491 "src/ocaml/preprocess/parser_raw.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -52529,33 +52499,33 @@ module Tables = struct
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3881 "src/ocaml/preprocess/parser_raw.mly"
+# 3922 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52535 "src/ocaml/preprocess/parser_raw.ml"
+# 52505 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 52543 "src/ocaml/preprocess/parser_raw.ml"
+# 52513 "src/ocaml/preprocess/parser_raw.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52552 "src/ocaml/preprocess/parser_raw.ml"
+# 52522 "src/ocaml/preprocess/parser_raw.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 4130 "src/ocaml/preprocess/parser_raw.mly"
+# 4178 "src/ocaml/preprocess/parser_raw.mly"
( Override )
-# 52559 "src/ocaml/preprocess/parser_raw.ml"
+# 52529 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
@@ -52570,11 +52540,11 @@ module Tables = struct
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2173 "src/ocaml/preprocess/parser_raw.mly"
+# 2191 "src/ocaml/preprocess/parser_raw.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 52578 "src/ocaml/preprocess/parser_raw.ml"
+# 52548 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52641,9 +52611,9 @@ module Tables = struct
let _v : (Parsetree.value_description * string Location.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 4223 "src/ocaml/preprocess/parser_raw.mly"
+# 4271 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52647 "src/ocaml/preprocess/parser_raw.ml"
+# 52617 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
@@ -52653,30 +52623,30 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 52659 "src/ocaml/preprocess/parser_raw.ml"
+# 52629 "src/ocaml/preprocess/parser_raw.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 4227 "src/ocaml/preprocess/parser_raw.mly"
+# 4275 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52667 "src/ocaml/preprocess/parser_raw.ml"
+# 52637 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3197 "src/ocaml/preprocess/parser_raw.mly"
+# 3238 "src/ocaml/preprocess/parser_raw.mly"
( let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Val.mk id ty ~attrs ~loc ~docs,
ext )
-# 52680 "src/ocaml/preprocess/parser_raw.ml"
+# 52650 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52692,9 +52662,9 @@ module Tables = struct
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.virtual_flag) =
-# 4090 "src/ocaml/preprocess/parser_raw.mly"
+# 4138 "src/ocaml/preprocess/parser_raw.mly"
( Concrete )
-# 52698 "src/ocaml/preprocess/parser_raw.ml"
+# 52668 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52717,9 +52687,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.virtual_flag) =
-# 4091 "src/ocaml/preprocess/parser_raw.mly"
+# 4139 "src/ocaml/preprocess/parser_raw.mly"
( Virtual )
-# 52723 "src/ocaml/preprocess/parser_raw.ml"
+# 52693 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52742,9 +52712,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 4114 "src/ocaml/preprocess/parser_raw.mly"
+# 4162 "src/ocaml/preprocess/parser_raw.mly"
( Immutable )
-# 52748 "src/ocaml/preprocess/parser_raw.ml"
+# 52718 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52774,9 +52744,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 4115 "src/ocaml/preprocess/parser_raw.mly"
+# 4163 "src/ocaml/preprocess/parser_raw.mly"
( Mutable )
-# 52780 "src/ocaml/preprocess/parser_raw.ml"
+# 52750 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52806,9 +52776,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 4116 "src/ocaml/preprocess/parser_raw.mly"
+# 4164 "src/ocaml/preprocess/parser_raw.mly"
( Mutable )
-# 52812 "src/ocaml/preprocess/parser_raw.ml"
+# 52782 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52831,9 +52801,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 4121 "src/ocaml/preprocess/parser_raw.mly"
+# 4169 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 52837 "src/ocaml/preprocess/parser_raw.ml"
+# 52807 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52863,9 +52833,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 4122 "src/ocaml/preprocess/parser_raw.mly"
+# 4170 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 52869 "src/ocaml/preprocess/parser_raw.ml"
+# 52839 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52895,9 +52865,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 4123 "src/ocaml/preprocess/parser_raw.mly"
+# 4171 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 52901 "src/ocaml/preprocess/parser_raw.ml"
+# 52871 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -52959,27 +52929,27 @@ module Tables = struct
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 52963 "src/ocaml/preprocess/parser_raw.ml"
+# 52933 "src/ocaml/preprocess/parser_raw.ml"
in
-# 1111 "src/ocaml/preprocess/parser_raw.mly"
+# 1131 "src/ocaml/preprocess/parser_raw.mly"
( xs )
-# 52968 "src/ocaml/preprocess/parser_raw.ml"
+# 52938 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3297 "src/ocaml/preprocess/parser_raw.mly"
+# 3338 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52974 "src/ocaml/preprocess/parser_raw.ml"
+# 52944 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__6_ = _endpos_xs_ in
let _5 =
let _1 = _1_inlined2 in
-# 3621 "src/ocaml/preprocess/parser_raw.mly"
+# 3662 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 52983 "src/ocaml/preprocess/parser_raw.ml"
+# 52953 "src/ocaml/preprocess/parser_raw.ml"
in
let _3 =
@@ -52988,16 +52958,16 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 52994 "src/ocaml/preprocess/parser_raw.ml"
+# 52964 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3540 "src/ocaml/preprocess/parser_raw.mly"
+# 3581 "src/ocaml/preprocess/parser_raw.mly"
( let lident = loc_last _3 in
Pwith_type
(_3,
@@ -53007,7 +52977,7 @@ module Tables = struct
~manifest:_5
~priv:_4
~loc:(make_loc _sloc))) )
-# 53011 "src/ocaml/preprocess/parser_raw.ml"
+# 52981 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53060,9 +53030,9 @@ module Tables = struct
let _v : (Parsetree.with_constraint) = let _5 =
let _1 = _1_inlined2 in
-# 3621 "src/ocaml/preprocess/parser_raw.mly"
+# 3662 "src/ocaml/preprocess/parser_raw.mly"
( _1 )
-# 53066 "src/ocaml/preprocess/parser_raw.ml"
+# 53036 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
@@ -53072,16 +53042,16 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 53078 "src/ocaml/preprocess/parser_raw.ml"
+# 53048 "src/ocaml/preprocess/parser_raw.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "src/ocaml/preprocess/parser_raw.mly"
+# 3594 "src/ocaml/preprocess/parser_raw.mly"
( let lident = loc_last _3 in
Pwith_typesubst
(_3,
@@ -53089,7 +53059,7 @@ module Tables = struct
~params:_2
~manifest:_5
~loc:(make_loc _sloc))) )
-# 53093 "src/ocaml/preprocess/parser_raw.ml"
+# 53063 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53138,9 +53108,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 53144 "src/ocaml/preprocess/parser_raw.ml"
+# 53114 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -53149,15 +53119,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 53155 "src/ocaml/preprocess/parser_raw.ml"
+# 53125 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3561 "src/ocaml/preprocess/parser_raw.mly"
+# 3602 "src/ocaml/preprocess/parser_raw.mly"
( Pwith_module (_2, _4) )
-# 53161 "src/ocaml/preprocess/parser_raw.ml"
+# 53131 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53206,9 +53176,9 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 53212 "src/ocaml/preprocess/parser_raw.ml"
+# 53182 "src/ocaml/preprocess/parser_raw.ml"
in
let _2 =
@@ -53217,15 +53187,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 53223 "src/ocaml/preprocess/parser_raw.ml"
+# 53193 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3563 "src/ocaml/preprocess/parser_raw.mly"
+# 3604 "src/ocaml/preprocess/parser_raw.mly"
( Pwith_modsubst (_2, _4) )
-# 53229 "src/ocaml/preprocess/parser_raw.ml"
+# 53199 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53281,15 +53251,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 53287 "src/ocaml/preprocess/parser_raw.ml"
+# 53257 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3565 "src/ocaml/preprocess/parser_raw.mly"
+# 3606 "src/ocaml/preprocess/parser_raw.mly"
( Pwith_modtype (l, rhs) )
-# 53293 "src/ocaml/preprocess/parser_raw.ml"
+# 53263 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53345,15 +53315,15 @@ module Tables = struct
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1027 "src/ocaml/preprocess/parser_raw.mly"
+# 1047 "src/ocaml/preprocess/parser_raw.mly"
( mkrhs _1 _sloc )
-# 53351 "src/ocaml/preprocess/parser_raw.ml"
+# 53321 "src/ocaml/preprocess/parser_raw.ml"
in
-# 3567 "src/ocaml/preprocess/parser_raw.mly"
+# 3608 "src/ocaml/preprocess/parser_raw.mly"
( Pwith_modtypesubst (l, rhs) )
-# 53357 "src/ocaml/preprocess/parser_raw.ml"
+# 53327 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53376,9 +53346,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3570 "src/ocaml/preprocess/parser_raw.mly"
+# 3611 "src/ocaml/preprocess/parser_raw.mly"
( Public )
-# 53382 "src/ocaml/preprocess/parser_raw.ml"
+# 53352 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53408,9 +53378,9 @@ module Tables = struct
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3571 "src/ocaml/preprocess/parser_raw.mly"
+# 3612 "src/ocaml/preprocess/parser_raw.mly"
( Private )
-# 53414 "src/ocaml/preprocess/parser_raw.ml"
+# 53384 "src/ocaml/preprocess/parser_raw.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
@@ -53445,9 +53415,9 @@ module MenhirInterpreter = struct
| T_VAL : unit terminal
| T_UNDERSCORE : unit terminal
| T_UIDENT : (
-# 890 "src/ocaml/preprocess/parser_raw.mly"
+# 909 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53451 "src/ocaml/preprocess/parser_raw.ml"
+# 53421 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_TYPE : unit terminal
| T_TRY : unit terminal
@@ -53457,9 +53427,9 @@ module MenhirInterpreter = struct
| T_THEN : unit terminal
| T_STRUCT : unit terminal
| T_STRING : (
-# 876 "src/ocaml/preprocess/parser_raw.mly"
+# 895 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string option)
-# 53463 "src/ocaml/preprocess/parser_raw.ml"
+# 53433 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_STAR : unit terminal
| T_SIG : unit terminal
@@ -53470,22 +53440,22 @@ module MenhirInterpreter = struct
| T_RBRACKET : unit terminal
| T_RBRACE : unit terminal
| T_QUOTED_STRING_ITEM : (
-# 881 "src/ocaml/preprocess/parser_raw.mly"
+# 900 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string * Location.t * string option)
-# 53476 "src/ocaml/preprocess/parser_raw.ml"
+# 53446 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_QUOTED_STRING_EXPR : (
-# 878 "src/ocaml/preprocess/parser_raw.mly"
+# 897 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t * string * Location.t * string option)
-# 53481 "src/ocaml/preprocess/parser_raw.ml"
+# 53451 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_QUOTE : unit terminal
| T_QUESTION : unit terminal
| T_PRIVATE : unit terminal
| T_PREFIXOP : (
-# 862 "src/ocaml/preprocess/parser_raw.mly"
+# 881 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53489 "src/ocaml/preprocess/parser_raw.ml"
+# 53459 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_PLUSEQ : unit terminal
| T_PLUSDOT : unit terminal
@@ -53493,9 +53463,9 @@ module MenhirInterpreter = struct
| T_PERCENT : unit terminal
| T_OR : unit terminal
| T_OPTLABEL : (
-# 855 "src/ocaml/preprocess/parser_raw.mly"
+# 874 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53499 "src/ocaml/preprocess/parser_raw.ml"
+# 53469 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_OPEN : unit terminal
| T_OF : unit terminal
@@ -53508,17 +53478,20 @@ module MenhirInterpreter = struct
| T_MINUSDOT : unit terminal
| T_MINUS : unit terminal
| T_METHOD : unit terminal
+ | T_METAOCAML_ESCAPE : unit terminal
+ | T_METAOCAML_BRACKET_OPEN : unit terminal
+ | T_METAOCAML_BRACKET_CLOSE : unit terminal
| T_MATCH : unit terminal
| T_LPAREN : unit terminal
| T_LIDENT : (
-# 838 "src/ocaml/preprocess/parser_raw.mly"
+# 857 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53517 "src/ocaml/preprocess/parser_raw.ml"
+# 53490 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_LETOP : (
-# 820 "src/ocaml/preprocess/parser_raw.mly"
+# 839 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53522 "src/ocaml/preprocess/parser_raw.ml"
+# 53495 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_LET : unit terminal
| T_LESSMINUS : unit terminal
@@ -53536,63 +53509,62 @@ module MenhirInterpreter = struct
| T_LBRACE : unit terminal
| T_LAZY : unit terminal
| T_LABEL : (
-# 825 "src/ocaml/preprocess/parser_raw.mly"
+# 844 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53542 "src/ocaml/preprocess/parser_raw.ml"
+# 53515 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_INT : (
-# 824 "src/ocaml/preprocess/parser_raw.mly"
+# 843 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 53547 "src/ocaml/preprocess/parser_raw.ml"
+# 53520 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_INITIALIZER : unit terminal
| T_INHERIT : unit terminal
| T_INFIXOP4 : (
-# 818 "src/ocaml/preprocess/parser_raw.mly"
+# 837 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53554 "src/ocaml/preprocess/parser_raw.ml"
+# 53527 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_INFIXOP3 : (
-# 817 "src/ocaml/preprocess/parser_raw.mly"
+# 836 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53559 "src/ocaml/preprocess/parser_raw.ml"
+# 53532 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_INFIXOP2 : (
-# 816 "src/ocaml/preprocess/parser_raw.mly"
+# 835 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53564 "src/ocaml/preprocess/parser_raw.ml"
+# 53537 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_INFIXOP1 : (
-# 815 "src/ocaml/preprocess/parser_raw.mly"
+# 834 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53569 "src/ocaml/preprocess/parser_raw.ml"
+# 53542 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_INFIXOP0 : (
-# 814 "src/ocaml/preprocess/parser_raw.mly"
+# 833 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53574 "src/ocaml/preprocess/parser_raw.ml"
+# 53547 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_INCLUDE : unit terminal
| T_IN : unit terminal
| T_IF : unit terminal
| T_HASHOP : (
-# 873 "src/ocaml/preprocess/parser_raw.mly"
+# 892 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53582 "src/ocaml/preprocess/parser_raw.ml"
+# 53555 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_HASH : unit terminal
| T_GREATERRBRACKET : unit terminal
| T_GREATERRBRACE : unit terminal
- | T_GREATERDOT : unit terminal
| T_GREATER : unit terminal
| T_FUNCTOR : unit terminal
| T_FUNCTION : unit terminal
| T_FUN : unit terminal
| T_FOR : unit terminal
| T_FLOAT : (
-# 803 "src/ocaml/preprocess/parser_raw.mly"
+# 822 "src/ocaml/preprocess/parser_raw.mly"
(string * char option)
-# 53596 "src/ocaml/preprocess/parser_raw.ml"
+# 53568 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_FALSE : unit terminal
| T_EXTERNAL : unit terminal
@@ -53602,28 +53574,27 @@ module MenhirInterpreter = struct
| T_EOF : unit terminal
| T_END : unit terminal
| T_ELSE : unit terminal
+ | T_EFFECT : unit terminal
| T_DOWNTO : unit terminal
- | T_DOTTILDE : unit terminal
| T_DOTOP : (
-# 819 "src/ocaml/preprocess/parser_raw.mly"
+# 838 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53611 "src/ocaml/preprocess/parser_raw.ml"
+# 53583 "src/ocaml/preprocess/parser_raw.ml"
) terminal
- | T_DOTLESS : unit terminal
| T_DOTDOT : unit terminal
| T_DOT : unit terminal
| T_DONE : unit terminal
| T_DOCSTRING : (
-# 898 "src/ocaml/preprocess/parser_raw.mly"
+# 917 "src/ocaml/preprocess/parser_raw.mly"
(Docstrings.docstring)
-# 53620 "src/ocaml/preprocess/parser_raw.ml"
+# 53591 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_DO : unit terminal
| T_CONSTRAINT : unit terminal
| T_COMMENT : (
-# 897 "src/ocaml/preprocess/parser_raw.mly"
+# 916 "src/ocaml/preprocess/parser_raw.mly"
(string * Location.t)
-# 53627 "src/ocaml/preprocess/parser_raw.ml"
+# 53598 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_COMMA : unit terminal
| T_COLONGREATER : unit terminal
@@ -53632,9 +53603,9 @@ module MenhirInterpreter = struct
| T_COLON : unit terminal
| T_CLASS : unit terminal
| T_CHAR : (
-# 783 "src/ocaml/preprocess/parser_raw.mly"
+# 801 "src/ocaml/preprocess/parser_raw.mly"
(char)
-# 53638 "src/ocaml/preprocess/parser_raw.ml"
+# 53609 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_BEGIN : unit terminal
| T_BARRBRACKET : unit terminal
@@ -53645,9 +53616,9 @@ module MenhirInterpreter = struct
| T_ASSERT : unit terminal
| T_AS : unit terminal
| T_ANDOP : (
-# 821 "src/ocaml/preprocess/parser_raw.mly"
+# 840 "src/ocaml/preprocess/parser_raw.mly"
(string)
-# 53651 "src/ocaml/preprocess/parser_raw.ml"
+# 53622 "src/ocaml/preprocess/parser_raw.ml"
) terminal
| T_AND : unit terminal
| T_AMPERSAND : unit terminal
@@ -53995,164 +53966,166 @@ module MenhirInterpreter = struct
| 46 ->
X (T T_METHOD)
| 47 ->
- X (T T_MATCH)
+ X (T T_METAOCAML_ESCAPE)
| 48 ->
- X (T T_LPAREN)
+ X (T T_METAOCAML_BRACKET_OPEN)
| 49 ->
- X (T T_LIDENT)
+ X (T T_METAOCAML_BRACKET_CLOSE)
| 50 ->
- X (T T_LETOP)
+ X (T T_MATCH)
| 51 ->
- X (T T_LET)
+ X (T T_LPAREN)
| 52 ->
- X (T T_LESSMINUS)
+ X (T T_LIDENT)
| 53 ->
- X (T T_LESS)
+ X (T T_LETOP)
| 54 ->
- X (T T_LBRACKETPERCENTPERCENT)
+ X (T T_LET)
| 55 ->
- X (T T_LBRACKETPERCENT)
+ X (T T_LESSMINUS)
| 56 ->
- X (T T_LBRACKETLESS)
+ X (T T_LESS)
| 57 ->
- X (T T_LBRACKETGREATER)
+ X (T T_LBRACKETPERCENTPERCENT)
| 58 ->
- X (T T_LBRACKETBAR)
+ X (T T_LBRACKETPERCENT)
| 59 ->
- X (T T_LBRACKETATATAT)
+ X (T T_LBRACKETLESS)
| 60 ->
- X (T T_LBRACKETATAT)
+ X (T T_LBRACKETGREATER)
| 61 ->
- X (T T_LBRACKETAT)
+ X (T T_LBRACKETBAR)
| 62 ->
- X (T T_LBRACKET)
+ X (T T_LBRACKETATATAT)
| 63 ->
- X (T T_LBRACELESS)
+ X (T T_LBRACKETATAT)
| 64 ->
- X (T T_LBRACE)
+ X (T T_LBRACKETAT)
| 65 ->
- X (T T_LAZY)
+ X (T T_LBRACKET)
| 66 ->
- X (T T_LABEL)
+ X (T T_LBRACELESS)
| 67 ->
- X (T T_INT)
+ X (T T_LBRACE)
| 68 ->
- X (T T_INITIALIZER)
+ X (T T_LAZY)
| 69 ->
- X (T T_INHERIT)
+ X (T T_LABEL)
| 70 ->
- X (T T_INFIXOP4)
+ X (T T_INT)
| 71 ->
- X (T T_INFIXOP3)
+ X (T T_INITIALIZER)
| 72 ->
- X (T T_INFIXOP2)
+ X (T T_INHERIT)
| 73 ->
- X (T T_INFIXOP1)
+ X (T T_INFIXOP4)
| 74 ->
- X (T T_INFIXOP0)
+ X (T T_INFIXOP3)
| 75 ->
- X (T T_INCLUDE)
+ X (T T_INFIXOP2)
| 76 ->
- X (T T_IN)
+ X (T T_INFIXOP1)
| 77 ->
- X (T T_IF)
+ X (T T_INFIXOP0)
| 78 ->
- X (T T_HASHOP)
+ X (T T_INCLUDE)
| 79 ->
- X (T T_HASH)
+ X (T T_IN)
| 80 ->
- X (T T_GREATERRBRACKET)
+ X (T T_IF)
| 81 ->
- X (T T_GREATERRBRACE)
+ X (T T_HASHOP)
| 82 ->
- X (T T_GREATERDOT)
+ X (T T_HASH)
| 83 ->
- X (T T_GREATER)
+ X (T T_GREATERRBRACKET)
| 84 ->
- X (T T_FUNCTOR)
+ X (T T_GREATERRBRACE)
| 85 ->
- X (T T_FUNCTION)
+ X (T T_GREATER)
| 86 ->
- X (T T_FUN)
+ X (T T_FUNCTOR)
| 87 ->
- X (T T_FOR)
+ X (T T_FUNCTION)
| 88 ->
- X (T T_FLOAT)
+ X (T T_FUN)
| 89 ->
- X (T T_FALSE)
+ X (T T_FOR)
| 90 ->
- X (T T_EXTERNAL)
+ X (T T_FLOAT)
| 91 ->
- X (T T_EXCEPTION)
+ X (T T_FALSE)
| 92 ->
- X (T T_EQUAL)
+ X (T T_EXTERNAL)
| 93 ->
- X (T T_EOL)
+ X (T T_EXCEPTION)
| 94 ->
- X (T T_EOF)
+ X (T T_EQUAL)
| 95 ->
- X (T T_END)
+ X (T T_EOL)
| 96 ->
- X (T T_ELSE)
+ X (T T_EOF)
| 97 ->
- X (T T_DOWNTO)
+ X (T T_END)
| 98 ->
- X (T T_DOTTILDE)
+ X (T T_ELSE)
| 99 ->
- X (T T_DOTOP)
+ X (T T_EFFECT)
| 100 ->
- X (T T_DOTLESS)
+ X (T T_DOWNTO)
| 101 ->
- X (T T_DOTDOT)
+ X (T T_DOTOP)
| 102 ->
- X (T T_DOT)
+ X (T T_DOTDOT)
| 103 ->
- X (T T_DONE)
+ X (T T_DOT)
| 104 ->
- X (T T_DOCSTRING)
+ X (T T_DONE)
| 105 ->
- X (T T_DO)
+ X (T T_DOCSTRING)
| 106 ->
- X (T T_CONSTRAINT)
+ X (T T_DO)
| 107 ->
- X (T T_COMMENT)
+ X (T T_CONSTRAINT)
| 108 ->
- X (T T_COMMA)
+ X (T T_COMMENT)
| 109 ->
- X (T T_COLONGREATER)
+ X (T T_COMMA)
| 110 ->
- X (T T_COLONEQUAL)
+ X (T T_COLONGREATER)
| 111 ->
- X (T T_COLONCOLON)
+ X (T T_COLONEQUAL)
| 112 ->
- X (T T_COLON)
+ X (T T_COLONCOLON)
| 113 ->
- X (T T_CLASS)
+ X (T T_COLON)
| 114 ->
- X (T T_CHAR)
+ X (T T_CLASS)
| 115 ->
- X (T T_BEGIN)
+ X (T T_CHAR)
| 116 ->
- X (T T_BARRBRACKET)
+ X (T T_BEGIN)
| 117 ->
- X (T T_BARBAR)
+ X (T T_BARRBRACKET)
| 118 ->
- X (T T_BAR)
+ X (T T_BARBAR)
| 119 ->
- X (T T_BANG)
+ X (T T_BAR)
| 120 ->
- X (T T_BACKQUOTE)
+ X (T T_BANG)
| 121 ->
- X (T T_ASSERT)
+ X (T T_BACKQUOTE)
| 122 ->
- X (T T_AS)
+ X (T T_ASSERT)
| 123 ->
- X (T T_ANDOP)
+ X (T T_AS)
| 124 ->
- X (T T_AND)
+ X (T T_ANDOP)
| 125 ->
- X (T T_AMPERSAND)
+ X (T T_AND)
| 126 ->
+ X (T T_AMPERSAND)
+ | 127 ->
X (T T_AMPERAMPER)
| _ ->
assert false
@@ -54600,22 +54573,22 @@ module MenhirInterpreter = struct
assert false
and lr0_incoming =
- (16, "\000\000\000\006\000D\000\004\000\006\000\b\000\n\000\012\000\016\000\018\000\020\000\022\000\024\000\028\000\030\000$\000,\000:\000F\000J\000L\000N\000P\000R\000T\000V\000^\000`\000d\000h\000\132\000\138\000\140\000\152\000\154\000\156\000\170\000\172\000\174\000\176\000\180\000\182\000\184\000\192\000\194\000\196\000\208\000\212\000\214\000\228\000\232\000\244\000\246\000\250\000U\000\206\001\199\001\199\001\145\000|\001\199\000\012\001\145\0019\000b\000\"\000<\000>\000@\000B\000D\000F\000Z\000\\\000f\000l\000\142\000\144\000\146\000\148\000\150\000\158\000\168\000\186\000\200\000b\000(\000\204\001e\000*\000j\000~\001e\000.\000j\000\130\001e\0000\000j\000\222\000\236\000\240\000\248\000\252\000\254\000\231\000*\000d\000/\000\226\000\014\000\016\0004\0006\000\016\000d\001i\0008\000d\000\226\000H\000b\0006\001i\000V\001\145\0019\000\016\000$\0019\000\018\001\145\0019\000<\000B\000\240\000P\000\\\000\240\000b\000\146\000\240\000B\000\\\0005\000\014\0006\001i\0007\000;\000{\000*\000\218\000;\0009\000d\000\186\000\016\000\022\000:\000b\000*\000d\000\226\000d\000l\000d\000\226\000p\001\199\000\014\000\016\000\018\001\145\0019\000P\0009\000d\000?\000\145\000z\001\199\000\020\001\145\0019\000 \000<\000N\001\145\0019\000b\000\014\000B\000\136\000\178\000\\\000\136\000\178\000b\000B\000V\001\145\0019\000\014\000\016\001\005\000*\000\226\000V\000\018\000L\0019\000\014\000\030\0019\000&\0002\000@\000B\000J\000\240\001\145\0019\000b\000\012\0019\000R\001\145\0019\000d\001\r\000\206\000\016\000d\001\019\001\021\001\185\001\195\0019\000Z\000\\\000`\001\145\0019\000b\000<\000v\000d\000j\000f\000v\000~\000.\000\130\001\021\001%\0000\001W\000\226\000r\000\238\000\227\000t\000.\000\227\000~\000\160\001\015\000b\001\015\000*\000\206\000\016\001\027\000\206\000d\001\029\001\169\000\238\000\242\001i\000=\000C\000X\000s\000\"\000\237\001\015\000\206\000b\000\207\000C\000X\001\029\001y\001\137\001\143\001\149\001\151\001\201\000\"\001\201\000\160\001\169\000=\001y\001\153\000*\001\195\001\207\000\246\0006\001i\001\149\001\201\001y\000I\000q\000\127\000.\000\238\000q\000\245\000L\000\252\000\229\000\131\000\252\001\207\0019\001\207\0019\001\153\000I\000.\000q\000\238\000\127\000.\000\127\000.\000\127\000.\000\168\000\137\000.\000\245\000\245\001\153\000\219\000\186\000\132\001\145\0019\000\136\000\160\000=\000\178\000\180\000\230\000/\0001\000W\000Y\000]\000_\000\204\000_\001\167\000\245\001\r\000\206\000b\000*\000\184\001\145\0019\000Y\000\175\000\179\000\218\000\181\000\218\000\181\000\224\000\181\000\238\000\181\000\246\000/\001\195\000\245\000\181\001\143\001\161\000b\000\018\000d\000\243\000\243\000*\000Y\001\161\001\165\000\\\000\224\000*\000\181\000*\000\226\001\153\000*\000\181\000\181\000\224\000*\000\181\000*\000~\000.\000k\000.\000\181\000(\000k\000]\000\181\000\213\000(\000\014\000(\000\225\001%\000\234\000k\000\234\000/\000\026\000b\000d\000\226\001\153\001Y\000*\000d\0008\000b\001Y\000\186\000h\000J\000\240\001\145\0019\000\170\0019\000b\000*\001\005\000\226\000b\000*\000X\000\170\0019\000\141\001w\001u\000X\000\251\001\001\000\004\000\018\0009\001W\000\186\000:\000\222\001\207\000\031\001\207\000\145\000\214\001\153\000\186\001\153\000;\000V\000\018\000\251\000\186\001\001\000X\001\001\001\195\001\015\000\206\000\016\001i\001\023\001i\001\143\000\222\001\001\001\r\000\186\001\015\000\206\000\222\001\015\000!\000\129\000\250\000!\001w\001\001\001\001\000*\001\001\000*\001u\000X\000\205\001\007\000b\000*\001\007\000*\000\226\001\001\000*\000\205\001\195\001\r\001\143\001\007\000\154\000~\000\128\000d\000\186\000\130\000d\000\198\000\202\000\132\001\145\0019\000\232\001\145\0019\000\156\001\145\0019\000\172\001\145\0019\000\238\000\181\000\b\000\174\001\145\0019\000H\000\014\000b\000\181\000\226\001\153\001I\000\211\000*\000d\000\171\000b\000\018\000\243\000*\000\134\000Y\000Y\000\143\001S\001\127\001}\000\226\001\201\000\221\000X\000\172\001\145\0019\000\133\000\218\000\172\001\145\0019\000\133\000\238\001#\001#\000\176\001\145\0019\000\181\000\186\000\240\000-\000/\000[\000\158\000[\000\160\000d\000\200\000b\000\172\001\145\0019\000\133\000(\000\244\001\145\0019\000[\000\206\000b\000K\000\172\001\145\0019\000\133\000[\000\026\000b\000d\000\220\001\153\000\226\001\153\000\220\001\153\000A\000*\000d\0008\000d\000H\000[\000\245\001\r\000\206\000b\000*\000@\000B\000V\001\145\0019\001\007\000\226\001\001\000*\000Z\000\\\000f\000Y\000\226\001\153\000\186\000g\000u\000\218\000\172\001\145\0019\000\133\000\245\000[\001\017\001\143\001\161\001\167\001M\000\154\000g\001{\001\129\000\"\000\172\001\145\0019\000\133\001\129\000>\000\172\001\145\0019\000\133\001\129\000@\000\172\001\145\0019\000\133\001\129\000B\000\172\001\145\0019\000\133\001\129\000D\000\172\001\145\0019\000\133\001\129\000F\000\172\001\145\0019\000\133\001\129\000Z\000\172\001\145\0019\000\133\001\129\000\\\000\172\001\145\0019\000\133\001\129\000l\000\172\001\145\0019\000\133\001\129\000\142\000\172\001\145\0019\000\133\001\129\000\144\000\172\001\145\0019\000\133\001\129\000\146\000\172\001\145\0019\000\133\001\129\000\148\000\172\001\145\0019\000\133\001\129\000\150\000\172\001\145\0019\000\133\001\129\000\168\000\172\001\145\0019\000\133\001\129\000\186\000\172\001\145\0019\000\133\001\129\000\218\000\172\001\145\0019\000\133\001\129\000\222\000\172\001\145\0019\000\133\001\129\000\224\000\172\001\145\0019\000\133\001\129\000\236\000\172\001\145\0019\000\133\001\129\000\252\000\172\001\145\0019\000\133\001\129\000\254\000\172\001\145\0019\000\133\001\129\001\195\001\161\000[\001\209\000\172\001\145\0019\000\133\001\129\000(\000D\001\199\000g\000g\000\250\0019\000/\000\186\000g\000\226\000\018\000\243\000\206\001\153\000\186\000g\000\135\0006\001i\000\206\001\153\000\186\000g\000A\000\186\000g\000Q\001}\000A\000\209\000\186\001{\001\131\001\127\000W\000\226\001\153\000\186\000g\000\173\000\186\000g\000\218\000\181\000\224\000\181\000\238\000\181\000\246\000/\001\195\000\175\000\177\000\218\000\181\001O\001Q\000\163\0013\0013\001\205\001\129\000\173\000\186\000g\001E\000\154\000g\000\248\001G\001G\000\240\000g\000*\000v\000\234\000o\000\234\001\129\000(\000o\000~\000.\000o\000.\000\128\000m\000\164\000\130\000[\000\004\000i\001W\000\209\000\217\000(\000i\000i\000\153\0000\001\r\000\206\000d\000/\000\134\000[\000\200\000b\000o\000*\000j\000\172\001\145\0019\000\133\001\129\000~\000o\000.\000j\000\172\001\145\0019\000\133\001\129\000\130\000o\0000\000j\000\172\001\145\0019\000\133\001\129\000\206\000b\000g\000*\000j\000\172\001\145\0019\000\133\001\129\000~\000g\000.\000j\000\172\001\145\0019\000\133\001\129\000\130\000g\0000\000j\000\172\001\145\0019\000\133\001\129\001\r\000\200\000b\000o\000*\000j\000\172\001\145\0019\000\133\001\129\000~\000o\000.\000j\000\172\001\145\0019\000\133\001\129\000\130\000o\0000\000j\000\172\001\145\0019\000\133\001\129\001W\000j\000\172\001\145\0019\000\133\001\129\000[\000\139\001U\001U\001\129\000g\000*\000~\000g\000.\000\130\000g\0000\001\r\000\200\000b\000o\000*\000~\000o\000.\000\130\000o\0000\001W\000o\000o\000*\000~\000o\000.\000\130\000o\0000\000g\000\024\000\196\001\147\000g\000\212\000g\000\208\001\129\001\131\000g\000X\000g\000X\000\206\000g\001#\000\133\000g\000\028\000\172\001\145\0019\000\133\000\194\000\172\001\145\0019\000\133\001\129\001\129\000\194\000\172\001\145\0019\000\133\001\129\000\192\000g\000\192\000[\000\172\001\145\0019\000\133\000\166\001\129\000\166\000[\000\153\0000\000\172\001\145\0019\000\133\001\129\000\217\000(\000m\000\164\000m\000\164\000o\000.\000g\001\145\0019\001\007\000\154\000g\000V\001\145\0019\001\005\000\186\001\007\000\226\001\001\000\186\001\007\001\011\000\154\000g\001w\001\011\000\184\001\145\0019\000\016\000b\000\224\000*\000~\001\163\000L\000\130\000T\000\249\000d\000\226\000\135\000\206\001\207\000\165\0019\000(\0019\001\207\001[\0000\001]\001[\001_\000y\000\"\001\201\001\157\001\201\000\226\000\135\000\206\001\157\000X\001\201\001\201\001\157\000X\001\201\001\201\001s\0019\000\154\000g\001\165\001\145\0019\000,\000\155\001Q\0013\000g\000\211\000*\000d\000Q\000\172\001\145\0019\000\133\001\129\000\234\000o\000\234\000[\000V\001\145\0019\001\007\000*\000\226\001\001\000*\000g\000*\000A\000*\000g\000\004\000\133\000\172\001\145\0019\000\133\000*\000\220\001\001\000*\000\226\001\001\000*\000\220\001\001\000*\001\129\000*\000\220\001\001\000*\000\226\001\001\000*\000\220\001\001\000*\001\007\0013\001\145\0019\001\007\0013\000V\000\018\001\145\0019\001i\000\186\001\001\000\215\0013\001\145\0019\000,\001\005\001\011\0013\000\250\0019\001\005\001\011\0013\001=\001=\001\005\001\011\0013\000n\001\199\0008\000\181\000\b\000g\000x\001\199\000\152\001\145\0019\001\007\0013\000\182\001\145\0019\000/\000\226\000\135\000\206\001\153\000\167\000\186\000 \000\241\000\241\0013\001\153\000\184\001\145\0019\001\163\000\186\000b\001\r\000\206\000b\001\161\0019\0013\001s\0019\0013\000\226\000&\000J\000\240\001\145\0019\001\015\0013\001\145\0019\001\015\0013\000V\000\018\001\145\0019\001i\000\222\001\001\0013\001\145\0019\000\016\000\222\001\015\0013\000,\001\005\000\226\001\001\0013\000\250\0019\001\005\000\226\001\001\0013\001;\001;\001\005\000\186\001\r\0013\000\226\001\001\001\t\0013\001w\001\t\000\152\001\145\0019\001\001\0013\000\184\001\145\0019\001\163\000\228\000\018\001\145\0019\000\n\000'\000~\000{\000.\001\133\000d\000\186\000N\0019\000b\001\153\000*\001\181\000\012\0019\000\n\000T\000T\000\n\000\247\000d\000\226\001\153\0013\000^\0019\000\n\000:\000:\000\n\000\157\000d\000\226\000\167\0013\000\140\0019\000h\000J\000\240\0019\001\r\000\154\000~\000}\000.\001\169\000\218\001\153\001\153\001\143\001\169\001\177\001\195\0019\001\r\000\154\001\177\001\177\0013\000\214\0019\001\153\000\186\001\153\001\159\0013\001-\000\192\001a\0013\001\135\001\179\001-\001\177\0013\000\250\0019\000'\001\133\000d\000\186\001\177\0013\001?\001?\001\145\0019\000'\001\133\000d\000\226\000d\000\226\000C\000X\000~\001\153\000C\000X\000\207\000C\000X\001\029\001\143\001\173\001\177\001\173\001\173\001\173\0013\000\250\0019\000'\001\133\000d\000\226\001\173\0013\001A\001A\000)\000a\000e\000\161\000\233\000\253\000\255\001\003\0011\001a\0013\001k\000\250\0019\0009\000d\000?\000\145\0013\0017\0017\001m\000\250\0019\0009\000d\000\222\000~\000\130\001[\0000\000\204\000\238\001\163\001s\0019\000\151\000\238\001q\000\239\000\145\0013\0015\001o\001q\001\153\000\186\000:\000\130\001[\0000\000\204\001\155\001\163\001s\0019\000\130\001[\0000\000\204\001\155\001\155\0015\001\135\001\171\0011\000c\0011\001\153\000\228\001\145\0019\000'\001\133\000d\000\186\000N\0019\001\183\000\012\000\240\0019\000\249\000d\000\186\000g\000A\000\186\000g\000+\0013\0019\000\n\000T\000T\000\n\000%\000d\000\226\001\153\000\249\000d\000\186\000g\000A\000\186\000g\000^\000\240\0019\000:\000\159\000d\000\226\000\018\000\243\000\206\001\153\000\186\000g\000\167\000\186\000g\000Q\001\031\0013\0019\000\n\000:\000:\000\n\000#\000d\000\226\000\167\000\159\000d\000\226\000\018\000\243\000\206\001\153\000\186\000g\000\167\000\186\000g\000Q\000\138\0019\000g\0013\000\140\000\240\0019\000b\000h\000D\001\199\0019\000\155\001Q\0013\000J\000\240\0019\001\r\000\154\000~\000}\000.\001\185\000\174\0019\001S\000X\001K\000\154\001\143\001\175\000\139\001\185\001\193\001\195\001\205\001\193\001\187\001\187\001\193\0019\001\r\000\154\001\193\0019\000\155\001Q\0013\001\193\000*\000\226\001\173\000*\001\193\000\246\000d\000\223\0013\0019\001\193\000\223\0013\000\214\0019\001\159\0013\001+\000\192\001a\0013\001\135\001\191\001+\001\193\000\226\001\173\000\186\001\193\001S\001\189\001\189\0013\000\250\0019\000'\001\133\000d\001\189\0013\001C\001C\000)\000M\000h\000S\000e\000\161\000\235\000\255\001/\001M\001a\0013\001k\0017\001\135\001\171\000O\000g\0013\001/\000\169\001/\001M\001\197\000.\000\169\000.\000g\0013\001/\001/\000O\000\192\001\007\001\001\000*\000\181\000*\000\226\001\153\000*\001\183\001+\000\192\000g\000\004\000\133\001\197\000.\0013\000=\000>\000\159\000\238\001\163\000\186\001\161\0019\000\149\0013\001q\001\141\001o\001q\001\139\001\141\001\163\000\186\001\161\0019\0009\000d\000?\000\145\0013\000=\000>\000\159\000\149\0013\000\169\000.\000\165\0019\000(\0019\000\204\001!\001\201\000(\001!\000\168\001!\000\168\000C\000X\001y\000w\000*\000\160\001\169\000=\000\218\001\153\001\153\000\218\001\153\000\130\001[\0000\000\204\001\153\001\155\000\239\000\222\000\239\000\145\0013\000=\000>\000\159\000\147\0013\001q\001o\001q\0009\000d\000\222\000\239\000\145\0013\000=\000>\000\159\000\147\0013\000c\000\192\001\001\000*\000\167\0013\001\197\000.\0019\000g\000\212\000g\000\208\000O\000\190\001g\000\000\000c\000\190\001c\000\000\000b\000\224\000*\0001\000\203\001\015\000\206\000b\000\224\000*\0001\001i\001\025\001i\001\165\001\203\000\190\000\000\000\201\001\161\000\190\000\000\000\199\001\153\000\190\000\000\000g\000\190\000\197\000\000\000\195\001\015\000\190\000\000\000\193\001\r\000\190\000\000\000\191\001\007\000\190\000\000\000\189\001\001\000\190\000\000\000\187\000\251\000\190\000\000\000\181\000\190\000\185\000\000\000-\000\190\000\183\001\r\000\206\000\000\000\160\001i\000\022\000 \000\136\000\180\000-\001\r\000\190\000E\000G\000&\000M\001)\000g\0013\000&\001)\000&\000\000\000&\000G\000M\001'\001'\000g\0013\001'\001'\0003\000g\0013\001'\000\190\001'\000\190")
+ (16, "\000\000\000\006\000D\000\004\000\006\000\b\000\n\000\012\000\016\000\018\000\020\000\022\000\024\000\028\000\030\000$\000,\000:\000F\000J\000L\000N\000P\000R\000T\000V\000^\000f\000j\000n\000\138\000\144\000\146\000\158\000\160\000\162\000\174\000\176\000\178\000\180\000\184\000\186\000\188\000\196\000\198\000\202\000\210\000\214\000\216\000\230\000\234\000\246\000\248\000\252\000U\000\208\001\199\001\199\001\145\000\130\001\199\000\012\001\145\0019\000h\000\"\000<\000>\000@\000B\000D\000F\000Z\000\\\000l\000r\000\148\000\150\000\152\000\154\000\156\000\164\000\172\000\190\000\204\000h\000(\000\206\001e\000*\000p\000\132\001e\000.\000p\000\136\001e\0000\000p\000\224\000\238\000\242\000\250\000\254\001\000\000\231\000*\000j\000/\000\228\000\014\000\016\0004\0006\000\016\000j\001i\0008\000j\000\228\000H\000h\0006\001i\000V\001\145\0019\000\016\000$\0019\000\018\001\145\0019\000<\000B\000\242\000P\000\\\000\242\000h\000\152\000\242\000B\000\\\0005\000\014\0006\001i\0007\000;\000{\000*\000\220\000;\0009\000j\000\190\000\016\000\022\000:\000h\000*\000j\000\228\000j\000r\000j\000\228\000v\001\199\000\014\000\016\000\018\001\145\0019\000P\0009\000j\000?\000\145\000\128\001\199\000\020\001\145\0019\000 \000<\000N\001\145\0019\000h\000\014\000B\000\142\000\182\000\\\000\142\000\182\000h\000B\000V\001\145\0019\000\014\000\016\001\005\000*\000\228\000V\000\018\000L\0019\000\014\000\030\0019\000&\0002\000@\000B\000J\000\242\001\145\0019\000h\000\012\0019\000R\001\145\0019\000j\001\r\000\208\000\016\000j\001\019\001\021\001\185\001\195\0019\000Z\000\\\000`\000b\000f\001\145\0019\000h\000<\000|\000j\000p\000l\000|\000\132\000.\000\136\001\021\001%\0000\001W\000\228\000x\000\240\000\227\000z\000.\000\227\000\132\000\166\001\015\000h\001\015\000*\000\208\000\016\001\027\000\208\000j\001\029\001\169\000\240\000\244\001i\000=\000C\000X\000s\000\"\000\237\001\015\000\208\000h\000\207\000C\000X\001\029\001y\001\137\001\143\001\149\001\151\001\201\000\"\001\201\000\166\001\169\000=\001y\001\153\000*\001\195\001\207\000\248\0006\001i\001\149\001\201\001y\000I\000q\000\127\000.\000\240\000q\000\245\000L\000\254\000\229\000\131\000\254\001\207\0019\001\207\0019\001\153\000I\000.\000q\000\240\000\127\000.\000\127\000.\000\127\000.\000\172\000\137\000.\000\245\000\245\001\153\000\219\000\190\000\138\001\145\0019\000\142\000\166\000=\000\182\000\184\000\232\000/\0001\000W\000Y\000]\000_\000\206\000_\001\167\000\245\001\r\000\208\000h\000*\000\188\001\145\0019\000\200\000Y\000\175\000\220\000Y\001\143\001\161\001\165\000\245\000\175\000\179\000\220\000\181\000\220\000\181\000\226\000\181\000\240\000\181\000\248\000/\001\195\001\161\000h\000\018\000j\000\243\000\243\000*\000Y\000\\\000\226\000*\000\181\000*\000\228\001\153\000*\000\181\000\181\000\181\000\226\000*\000\181\000*\000\132\000.\000k\000.\000\181\000(\000k\000]\000\181\000\213\000(\000\014\000(\000\225\001%\000\236\000k\000\236\000/\000\026\000h\000j\000\228\001\153\001Y\000*\000j\0008\000h\001Y\000\190\000n\000J\000\242\001\145\0019\000\174\0019\000h\000*\001\005\000\228\000h\000\016\000\174\0019\000\141\001w\001u\000X\000\251\001\001\000\004\000\018\0009\001W\000\190\000:\000\224\001\207\000\031\001\207\000\145\000\216\001\153\000\190\001\153\000;\000V\000\018\000\251\000\190\001\001\000X\001\001\001\195\001\015\000\208\000\016\001i\001\023\001i\001u\000X\001\001\001w\001\143\000\224\001\001\001\r\000\190\001\015\000\208\000\224\001\015\000!\000\129\000\252\000!\001\001\000*\001\001\000*\001u\000X\000\205\001\007\000h\000*\001\007\000*\000\228\001\001\000*\000\205\001\195\001\r\001\143\001\007\000\160\000\132\000\134\000j\000\190\000\136\000j\000\234\001\145\0019\000\138\001\145\0019\000\242\000-\000/\000[\000\164\000[\000\166\000j\000\204\000h\000\162\001\145\0019\000\176\001\145\0019\000\240\000\181\000\b\000\178\001\145\0019\000H\000\014\000h\000\181\000\228\001\153\001I\000\211\000*\000j\000\171\000h\000\018\000\243\000*\000\140\000Y\000Y\000\143\001S\001\127\001}\000\228\001\201\000\221\000X\000\176\001\145\0019\000\133\000\220\000\176\001\145\0019\000\133\000\240\001#\001#\000\180\001\145\0019\000\181\000\190\000\246\001\145\0019\000[\000\208\000h\000K\000\176\001\145\0019\000\133\000[\000\026\000h\000j\000\222\001\153\000\228\001\153\000\222\001\153\000A\000*\000j\0008\000j\000H\000[\000\245\001\r\000\208\000h\000*\000@\000B\000V\001\145\0019\001\007\000\228\001\001\000*\000Z\000\\\000l\000Y\000\228\001\153\000\190\000g\000u\000\220\000\176\001\145\0019\000\133\000\245\000[\001\017\001\143\001\161\001\167\001M\000\160\000g\001{\001\129\000\"\000\176\001\145\0019\000\133\001\129\000>\000\176\001\145\0019\000\133\001\129\000@\000\176\001\145\0019\000\133\001\129\000B\000\176\001\145\0019\000\133\001\129\000D\000\176\001\145\0019\000\133\001\129\000F\000\176\001\145\0019\000\133\001\129\000Z\000\176\001\145\0019\000\133\001\129\000\\\000\176\001\145\0019\000\133\001\129\000r\000\176\001\145\0019\000\133\001\129\000\148\000\176\001\145\0019\000\133\001\129\000\150\000\176\001\145\0019\000\133\001\129\000\152\000\176\001\145\0019\000\133\001\129\000\154\000\176\001\145\0019\000\133\001\129\000\156\000\176\001\145\0019\000\133\001\129\000\172\000\176\001\145\0019\000\133\001\129\000\190\000\176\001\145\0019\000\133\001\129\000\220\000\176\001\145\0019\000\133\001\129\000\224\000\176\001\145\0019\000\133\001\129\000\226\000\176\001\145\0019\000\133\001\129\000\238\000\176\001\145\0019\000\133\001\129\000\254\000\176\001\145\0019\000\133\001\129\001\000\000\176\001\145\0019\000\133\001\129\001\195\001\161\000[\001\209\000\176\001\145\0019\000\133\001\129\000(\000D\001\199\000g\000g\000\252\0019\000/\000\190\000g\000\228\000\018\000\243\000\208\001\153\000\190\000g\000\135\0006\001i\000\208\001\153\000\190\000g\000A\000\190\000g\000Q\001}\000A\000\209\000\190\001{\001\131\001\127\000W\000\228\001\153\000\190\000g\000\173\000\190\000g\000\220\000\181\000\226\000\181\000\240\000\181\000\248\000/\001\195\000\175\000\177\000\220\000\181\001O\001Q\000\163\0013\0013\001\205\001\129\000\173\000\190\000g\001E\000\160\000g\000\250\001G\001G\000\242\000g\000*\000|\000\176\001\145\0019\000\133\000(\000o\001\129\000(\000o\000\236\000o\000\236\000\132\000.\000o\000.\000\134\000m\000\170\000\136\000[\000\004\000i\001W\000\209\000\217\000(\000i\000i\000\153\0000\001\r\000\208\000j\000/\000\140\000[\000\204\000h\000o\000*\000p\000\176\001\145\0019\000\133\001\129\000\132\000o\000.\000p\000\176\001\145\0019\000\133\001\129\000\136\000o\0000\000p\000\176\001\145\0019\000\133\001\129\000\208\000h\000g\000*\000p\000\176\001\145\0019\000\133\001\129\000\132\000g\000.\000p\000\176\001\145\0019\000\133\001\129\000\136\000g\0000\000p\000\176\001\145\0019\000\133\001\129\001\r\000\204\000h\000o\000*\000p\000\176\001\145\0019\000\133\001\129\000\132\000o\000.\000p\000\176\001\145\0019\000\133\001\129\000\136\000o\0000\000p\000\176\001\145\0019\000\133\001\129\001W\000p\000\176\001\145\0019\000\133\001\129\000[\000\139\001U\001U\001\129\000g\000*\000\132\000g\000.\000\136\000g\0000\001\r\000\204\000h\000o\000*\000\132\000o\000.\000\136\000o\0000\001W\000g\000\024\000\202\001\147\000g\000\214\000g\000\210\001\129\001\131\000g\000X\000g\000X\000\208\000g\001#\000\133\000g\000\028\000\176\001\145\0019\000\133\000\198\000\176\001\145\0019\000\133\001\129\001\129\000\198\000\176\001\145\0019\000\133\001\129\000o\000*\000\132\000o\000.\000\136\000o\0000\000[\000\196\000g\000\196\000\153\0000\000\176\001\145\0019\000\133\001\129\000\217\000(\000m\000\170\000m\000\170\000o\000.\000g\001\145\0019\001\007\000\160\000g\000V\001\145\0019\001\005\000\190\001\007\000\228\001\001\000\190\001\007\001\011\000\160\000g\001w\001\011\000\188\001\145\0019\000\016\000h\000\226\000*\000\132\001\163\000L\000\136\000T\000\249\000j\000\228\000\135\000\208\001\207\000\165\0019\000(\0019\001\207\001[\0000\001]\001[\001_\000y\000\"\001\201\001\157\001\201\000\228\000\135\000\208\001\157\000X\001\201\001\201\001\157\000X\001\201\001\201\001s\0019\000\160\000g\001\165\001\145\0019\000,\000\155\001Q\0013\000g\000\211\000*\000j\000Q\000\176\001\145\0019\000\133\001\129\000\236\000o\000\236\000[\000V\001\145\0019\001\007\000*\000\228\001\001\000*\000g\000*\000A\000*\000g\000\004\000\133\000g\000d\000[\000\176\001\145\0019\000\133\000*\000\222\001\001\000*\000\228\001\001\000*\000\222\001\001\000*\001\129\000*\000\222\001\001\000*\000\228\001\001\000*\000\222\001\001\000*\001\007\0013\001\145\0019\001\007\0013\000V\000\018\001\145\0019\001i\000\190\001\001\000\215\0013\001\145\0019\000,\001\005\001\011\0013\000\252\0019\001\005\001\011\0013\001=\001=\001\005\001\011\0013\000t\001\199\0008\000\181\000\b\000g\000~\001\199\000\158\001\145\0019\001\007\0013\000\186\001\145\0019\000/\000\228\000\135\000\208\001\153\000\167\000\190\000 \000\241\000\241\0013\001\153\000\188\001\145\0019\001\163\000\190\000h\001\r\000\208\000h\001\161\0019\0013\001s\0019\0013\000\228\000&\000J\000\242\001\145\0019\001\015\0013\001\145\0019\001\015\0013\000V\000\018\001\145\0019\001i\000\224\001\001\0013\001\145\0019\000\016\000\224\001\015\0013\000,\001\005\000\228\001\001\0013\000\252\0019\001\005\000\228\001\001\0013\001;\001;\001\005\000\190\001\r\0013\000\228\001\001\001\t\0013\001w\001\t\000\158\001\145\0019\001\001\0013\000\188\001\145\0019\001\163\000\230\000\018\001\145\0019\000\n\000'\000\132\000{\000.\001\133\000j\000\190\000N\0019\000h\001\153\000*\001\181\000\012\0019\000\n\000T\000T\000\n\000\247\000j\000\228\001\153\0013\000^\0019\000\n\000:\000:\000\n\000\157\000j\000\228\000\167\0013\000\146\0019\000n\000J\000\242\0019\001\r\000\160\000\132\000}\000.\001\169\000\220\001\153\001\153\001\143\001\169\001\177\001\195\0019\001\r\000\160\001\177\001\177\0013\000\216\0019\001\153\000\190\001\153\001\159\0013\001-\000\196\001a\0013\001\135\001\179\001-\001\177\0013\000\252\0019\000'\001\133\000j\000\190\001\177\0013\001?\001?\001\145\0019\000'\001\133\000j\000\228\000j\000\228\000C\000X\000\132\001\153\000C\000X\000\207\000C\000X\001\029\001\143\001\173\001\177\001\173\001\173\001\173\0013\000\252\0019\000'\001\133\000j\000\228\001\173\0013\001A\001A\000)\000a\000e\000\161\000\233\000\253\000\255\001\003\0011\001a\0013\001k\000\252\0019\0009\000j\000?\000\145\0013\0017\0017\001m\000\252\0019\0009\000j\000\224\000\132\000\136\001[\0000\000\206\000\240\001\163\001s\0019\000\151\000\240\001q\000\239\000\145\0013\0015\001o\001q\001\153\000\190\000:\000\136\001[\0000\000\206\001\155\001\163\001s\0019\000\136\001[\0000\000\206\001\155\001\155\0015\001\135\001\171\0011\000c\0011\001\153\000\230\001\145\0019\000'\001\133\000j\000\190\000N\0019\001\183\000\012\000\242\0019\000\249\000j\000\190\000g\000A\000\190\000g\000+\0013\0019\000\n\000T\000T\000\n\000%\000j\000\228\001\153\000\249\000j\000\190\000g\000A\000\190\000g\000^\000\242\0019\000:\000\159\000j\000\228\000\018\000\243\000\208\001\153\000\190\000g\000\167\000\190\000g\000Q\001\031\0013\0019\000\n\000:\000:\000\n\000#\000j\000\228\000\167\000\159\000j\000\228\000\018\000\243\000\208\001\153\000\190\000g\000\167\000\190\000g\000Q\000\144\0019\000g\0013\000\146\000\242\0019\000h\000n\000D\001\199\0019\000\155\001Q\0013\000J\000\242\0019\001\r\000\160\000\132\000}\000.\001\185\000\178\0019\001S\000X\001K\000\160\001\143\001\175\000\139\001\185\001\193\001\195\001\205\001\193\001\187\001\187\001\193\0019\001\r\000\160\001\193\0019\000\155\001Q\0013\001\193\000*\000\228\001\173\000*\001\193\000\248\000j\000\223\0013\0019\001\193\000\223\0013\000\216\0019\001\159\0013\001+\000\196\001a\0013\001\135\001\191\001+\001\193\000\228\001\173\000\190\001\193\001S\001\189\001\189\0013\000\252\0019\000'\001\133\000j\001\189\0013\001C\001C\000)\000M\000n\000S\000e\000\161\000\235\000\255\001/\001M\001a\0013\001k\0017\001\135\001\171\000O\000g\0013\001/\000\169\001/\001M\001\197\000.\000\169\000.\000g\0013\001/\001/\000O\000\196\001\007\001\001\000*\000\181\000*\000\228\001\153\000*\001\183\001+\000\196\000g\000\004\000\133\001\197\000.\0013\000=\000>\000\159\000\240\001\163\000\190\001\161\0019\000\149\0013\001q\001\141\001o\001q\001\139\001\141\001\163\000\190\001\161\0019\0009\000j\000?\000\145\0013\000=\000>\000\159\000\149\0013\000\169\000.\000\165\0019\000(\0019\000\206\001!\001\201\000(\001!\000\172\001!\000\172\000C\000X\001y\000w\000*\000\166\001\169\000=\000\220\001\153\001\153\000\220\001\153\000\136\001[\0000\000\206\001\153\001\155\000\239\000\224\000\239\000\145\0013\000=\000>\000\159\000\147\0013\001q\001o\001q\0009\000j\000\224\000\239\000\145\0013\000=\000>\000\159\000\147\0013\000c\000\196\001\001\000*\000\167\0013\001\197\000.\0019\000g\000\214\000g\000\210\000O\000\194\001g\000\000\000c\000\194\001c\000\000\000h\000\226\000*\0001\000\203\001\015\000\208\000h\000\226\000*\0001\001i\001\025\001i\001\165\001\203\000\194\000\000\000\201\001\161\000\194\000\000\000\199\001\153\000\194\000\000\000g\000\194\000\197\000\000\000\195\001\015\000\194\000\000\000\193\001\r\000\194\000\000\000\191\001\007\000\194\000\000\000\189\001\001\000\194\000\000\000\187\000\251\000\194\000\000\000\181\000\194\000\185\000\000\000-\000\194\000\183\001\r\000\208\000\000\000\166\001i\000\022\000 \000\142\000\184\000-\001\r\000\194\000E\000G\000&\000M\001)\000g\0013\000&\001)\000&\000\000\000&\000G\000M\001'\001'\000g\0013\001'\001'\0003\000g\0013\001'\000\194\001'\000\194")
and rhs =
- ((16, "\001g\001c\000\203\000\201\000\199\000\197\000\195\000\193\000\191\000\189\000\187\000\185\000\183\000E\0003\000B\000@\001y\001\207\000\246\0006\001i\000\250\0019\001Q\0013\001\025\001\165\001\151\000=\001\201\000=\000b\000w\000*\000=\000\160\001\169\001\201\000\160\001\169\000b\000w\000*\000\160\001\169\001\015\000\206\001\149\0006\001i\000\014\000U\000U\000\206\001\199\000\169\000|\001\199\001\197\000.\001\175\000\174\0019\001\187\001K\000\154\001\193\000h\000J\0019\001\r\000\154\001\193\000h\000J\000\240\0019\001\r\000\154\001\193\001\193\001\195\001\175\000\139\001\143\000\140\0019\001\193\000\223\0013\000\140\000\240\0019\001\193\000\223\0013\000\012\000+\0013\000^\001\031\0013\000\214\0019\001\159\0013\000\138\0019\000g\0013\001a\0013\001\135\000\186\001\193\000\226\001\173\000\186\001\193\001S\001\189\001S\000X\001\193\001S\001\187\001\021\000b\000\181\000*\000b\000\181\000\226\001\153\000*\000b\001\153\000*\000\140\0019\001\177\0013\000\012\0019\000\247\000d\000\226\001\153\0013\000^\0019\000\157\000d\000\226\000\167\0013\000\214\0019\001\159\0013\001a\0013\001\135\001\169\000~\000}\000.\001\169\001\143\000N\0019\001\181\001-\000\192\001\177\001\195\000h\000J\0019\001\r\000\154\001\177\000h\000J\000\240\0019\001\r\000\154\001\177\000b\001\193\000*\001\185\000~\000}\000.\001\185\000b\001\193\000\226\001\173\000*\000N\0019\001\183\001+\000\192\001\177\000\207\000C\000X\001\173\000d\000\226\000C\000X\001\173\000C\000X\001\173\000\228\000\018\001\145\0019\000'\001\133\000d\000\186\001\177\0013\001?\001\029\000\136\000\230\000 \000\178\000~\000.\000b\000*\000\180\000\022\000\016\000b\000\224\000*\001\165\001\r\001\r\000\206\000b\000\224\000*\000b\000\224\000*\001\165\001\153\000\186\001\153\001\201\000y\000\"\001\201\000\130\001[\0000\000\238\000\151\001\207\001\153\001\195\000\237\001\137\001\149\000b\001\153\000*\000b\000V\001\145\0019\001\001\000*\000~\000I\000.\000~\000\238\000\127\000.\000~\000q\000\238\000\127\000.\000t\000\227\000\127\000.\000t\000.\000r\000\227\000\127\000.\000r\000\227\000\127\000\168\000\137\000.\000\024\000\196\000D\001\199\000p\001\199\000\169\000.\0004\000\238\001\163\000\186\001\161\0019\001\163\000\186\001\161\0019\001\143\000x\001\199\001\197\000.\000~\000{\000.\000\172\001\145\0019\000\133\001{\000[\000h\000V\001\145\0019\001\005\001\011\000\154\000g\000h\000\184\001\145\0019\001\163\001s\0019\000\154\000g\000h\000J\001\145\0019\001\007\000\154\000g\000h\000J\000\240\001\145\0019\001\007\000\154\000g\000\174\001\145\0019\001}\000\221\000X\001\131\000`\001\145\0019\000g\000\004\000\133\000\020\001\145\0019\000g\000\004\000\133\000\156\001\145\0019\000g\000\028\001\129\000\194\001\129\000\156\001\145\0019\000g\000\028\001\129\000\194\000\172\001\145\0019\000\133\000\156\001\145\0019\000g\000\028\000\172\001\145\0019\000\133\000\194\001\129\000\156\001\145\0019\000g\000\028\000\172\001\145\0019\000\133\000\194\000\172\001\145\0019\000\133\000\156\001\145\0019\000g\000\028\001\129\000\156\001\145\0019\000g\000\028\000\172\001\145\0019\000\133\000\006\001\145\0019\000g\000\212\000g\000\208\000\176\001\145\0019\000\181\000\186\000g\001\147\000g\000\212\000g\000\208\000\244\001\145\0019\000[\000\132\001\145\0019\000[\000[\000\139\000u\001\161\000[\000\245\000[\001\129\000\150\001\129\001\129\000\150\000\172\001\145\0019\000\133\001\129\000\148\001\129\001\129\000\148\000\172\001\145\0019\000\133\001\129\000\146\001\129\001\129\000\146\000\172\001\145\0019\000\133\001\129\000\144\001\129\001\129\000\144\000\172\001\145\0019\000\133\001\129\000\142\001\129\001\129\000\142\000\172\001\145\0019\000\133\001\129\000B\001\129\001\129\000B\000\172\001\145\0019\000\133\001\129\000@\001\129\001\129\000@\000\172\001\145\0019\000\133\001\129\000>\001\129\001\129\000>\000\172\001\145\0019\000\133\001\129\000\\\001\129\001\129\000\\\000\172\001\145\0019\000\133\001\129\000Z\001\129\001\129\000Z\000\172\001\145\0019\000\133\001\129\000\"\001\129\001\129\000\"\000\172\001\145\0019\000\133\001\129\000D\001\129\001\129\000D\000\172\001\145\0019\000\133\001\129\000\186\001\129\001\129\000\186\000\172\001\145\0019\000\133\001\129\000l\001\129\001\129\000l\000\172\001\145\0019\000\133\001\129\000\168\001\129\001\129\000\168\000\172\001\145\0019\000\133\001\129\000F\001\129\001\129\000F\000\172\001\145\0019\000\133\001\129\000\236\001\129\001\129\000\236\000\172\001\145\0019\000\133\001\129\000\252\001\129\001\129\000\252\000\172\001\145\0019\000\133\001\129\000\254\001\129\001\129\000\254\000\172\001\145\0019\000\133\001\129\000\222\001\129\001\129\000\222\000\172\001\145\0019\000\133\000K\001\129\000K\000\172\001\145\0019\000\133\001\209\001\129\001\209\000\172\001\145\0019\000\133\001M\000\154\000g\000f\001E\000\154\000g\001\129\000\224\001\129\001\129\000\224\000\172\001\145\0019\000\133\000d\000j\001\129\000d\000j\000\172\001\145\0019\000\133\000[\000\206\001W\000j\001\129\000[\000\206\001W\000j\000\172\001\145\0019\000\133\000[\000\206\000b\000g\000*\000j\001\129\000[\000\206\000b\000g\000*\000j\000\172\001\145\0019\000\133\000[\000\206\000\130\000g\0000\000j\001\129\000[\000\206\000\130\000g\0000\000j\000\172\001\145\0019\000\133\000[\000\206\000~\000g\000.\000j\001\129\000[\000\206\000~\000g\000.\000j\000\172\001\145\0019\000\133\000[\000\200\000b\000o\000*\000j\001\129\000[\000\200\000b\000o\000*\000j\000\172\001\145\0019\000\133\000[\000\206\001\r\000\200\000b\000o\000*\000j\001\129\000[\000\206\001\r\000\200\000b\000o\000*\000j\000\172\001\145\0019\000\133\000[\000\200\000\130\000o\0000\000j\001\129\000[\000\200\000\130\000o\0000\000j\000\172\001\145\0019\000\133\000[\000\206\001\r\000\200\000\130\000o\0000\000j\001\129\000[\000\206\001\r\000\200\000\130\000o\0000\000j\000\172\001\145\0019\000\133\000[\000\200\000~\000o\000.\000j\001\129\000[\000\200\000~\000o\000.\000j\000\172\001\145\0019\000\133\000[\000\206\001\r\000\200\000~\000o\000.\000j\001\129\000[\000\206\001\r\000\200\000~\000o\000.\000j\000\172\001\145\0019\000\133\001\129\001\195\000b\000\018\000\243\000*\001S\000\143\001\129\001\129\000(\001\129\000(\000g\001\129\000(\000D\001\199\000g\000C\000\207\000C\000X\001y\000d\000\226\000C\000X\001y\000C\000X\001y\000b\000*\000b\001\005\000\226\001\001\000*\000\141\000L\001\157\000\226\001\157\000X\001\201\000\226\000\135\000\206\001\157\000X\001\201\000\226\001\201\000\226\000\135\000\206\001\201\000\238\001\163\001s\0019\001\163\001s\0019\000\018\001\145\0019\0009\000d\000\222\000\239\000\145\0013\000\018\001\145\0019\000P\0009\000d\000\222\000\239\000\145\0013\000\018\001\145\0019\0009\000d\000?\000\145\0013\000\018\001\145\0019\000P\0009\000d\000?\000\145\0013\000\016\000d\000O\000\190\000(\000\204\000c\000\190\000n\001\199\000\169\000.\0002\000\249\000d\000\226\000\165\0019\000\249\000d\000\226\000\165\0019\000(\0019\001_\001]\001]\001[\000d\000d\000\226\001\153\001\021\000[\000\134\000[\000\026\000d\000\026\000b\000d\000A\000*\0008\000d\000H\000[\0008\000b\001Y\000\211\000*\0008\000d\000H\000b\001I\000\211\000*\000H\000\171\000\026\000b\001Y\000*\000\026\000d\000\134\000Y\000Y\001O\000/\000/\000Q\000/\000A\000\186\000g\000/\000\226\000\135\000\206\001\153\000\186\000g\000/\000\226\000\018\000\243\000\206\001\153\000\186\000g\000\173\000\186\000g\000W\000\226\001\153\000\186\000g\000h\001\145\0019\000\155\001Q\0013\001M\001\205\000h\0019\000\155\001Q\0013\000h\000D\001\199\0019\000\155\001Q\0013\001K\001\205\000\181\000\181\000\226\001\153\000/\000Q\000/\000Y\000\226\001\153\000\186\000g\000\173\000\186\000g\001G\001E\000\248\001G\000\250\0019\000'\001\133\000d\001\189\0013\001C\000\250\0019\000'\001\133\000d\000\226\001\173\0013\001A\000\250\0019\000'\001\133\000d\000\186\001\177\0013\001?\000\250\0019\001\005\001\011\0013\001=\000\250\0019\001\005\000\226\001\001\0013\001;\001\195\0019\000\250\0019\0009\000d\000?\000\145\0013\0017\000\250\0019\0009\000d\000\222\000\239\000\145\0013\0015\000\163\0013\000&\0011\000a\0011\000&\001/\000&\000g\0013\001/\000M\001/\001\179\001-\001\191\001+\000M\001)\000&\001'\000&\000g\0013\001'\000M\001'\000G\001'\001W\000\219\000\213\001W\000\219\000\213\000(\001W\000\219\000\213\000(\000\014\000\225\001W\000\219\000\213\000(\001%\000\181\000X\000g\000\181\000\b\000g\000X\000g\000\181\000X\000\206\000d\000\226\000\165\0019\000(\0019\001!\001\201\000(\001!\000d\000\226\000\165\0019\000(\0019\001\201\000(\000d\000\226\000\165\0019\001\201\000\204\0019\000#\000d\000\226\000\167\0019\000\159\000d\000Q\000\240\0019\000\159\000d\000Q\0019\000\159\000d\000\226\000\167\000\186\000g\000\240\0019\000\159\000d\000\226\000\167\000\186\000g\0019\000\159\000d\000\226\000\018\000\243\000\206\001\153\000\186\000g\000\240\0019\000\159\000d\000\226\000\018\000\243\000\206\001\153\000\186\000g\000d\001\015\000\206\000d\000\016\001\015\000\206\000\016\001i\000b\000\224\000*\0001\001\015\000\206\001i\001\015\000\206\000b\000\224\000*\001\015\000\206\0001\001i\001\015\000\206\001i\000d\001\r\000\206\000d\000\016\001\r\000\206\000\016\000/\001\r\000\206\000/\001\027\001\015\000b\001\015\000*\001\019\000\186\001\007\000\226\001\001\000\186\001\007\001w\001\011\000\226\001\001\001w\001\t\000\030\0019\000O\000\192\000\170\0019\001u\000X\001\007\000\205\001\007\001\195\001\r\001\007\000\205\001\007\000b\000*\001\143\000\014\000\016\000\014\000V\001\145\0019\000\016\000\222\001\015\0013\000$\0019\000c\000\192\000\170\0019\001u\000X\001\001\000V\000\018\000L\0019\001\007\000b\001\001\000*\001\001\001\195\000\251\000b\000*\000X\001\001\001\001\000X\001\001\001\001\000\004\000\129\001\143\000V\000\018\001\145\0019\001i\000\215\0013\000V\000\018\001\145\0019\001i\000\222\001\001\0013\001\023\000T\000T\000\n\000T\000\n\000\n\000T\000\242\001i\000d\000d\000\243\000 \000 \000\241\001\153\000:\001\153\001\155\000:\001\155\001\153\000\186\001\155\001\153\000\186\000:\001\155\000\204\000:\000\204\001\153\000\186\000\204\001\153\000\186\000:\000\204\000\130\001[\0000\000:\000\130\001[\0000\001\153\000\186\000\130\001[\0000\001\153\000\186\000:\000\130\001[\0000\000l\001!\000\168\000l\000\168\000J\001\145\0019\001\007\0013\000J\000\240\001\145\0019\001\007\0013\000J\001\145\0019\001\015\0013\000J\000\240\001\145\0019\001\015\0013\000<\000f\000\248\000\200\000b\001e\000*\000\200\000b\001e\000*\000j\000\200\000~\001e\000.\000\200\000~\001e\000.\000j\000\200\000\130\001e\0000\000\200\000\130\001e\0000\000j\000\158\000\240\000\150\000\148\000\146\000\144\000\142\000B\000@\000>\000\\\000Z\000\"\000D\000\186\000l\000\168\000F\000\236\000\252\000\254\000\222\000\252\000\238\000(\000\246\000d\000\226\001\201\000\226\001\153\000\186\001\129\000\186\000\172\001\145\0019\000\133\000\186\001\001\000\186\000\181\000\186\000g\000A\000H\0008\000d\000\226\000b\001\007\000\226\001\001\000*\000b\001\007\000*\000b\000\012\0019\001\129\000*\000b\000\012\0019\000\172\001\145\0019\000\133\000*\000b\000\012\0019\001\129\000\226\001\001\000*\000b\000\012\0019\000\172\001\145\0019\000\133\000\226\001\001\000*\000b\000\012\0019\001\129\000\226\001\001\000\220\001\001\000*\000b\000\012\0019\000\172\001\145\0019\000\133\000\226\001\001\000\220\001\001\000*\000b\000\012\0019\001\129\000\220\001\001\000*\000b\000\012\0019\000\172\001\145\0019\000\133\000\220\001\001\000*\001\203\000\190\001\161\000\190\001\153\000\190\000g\000\190\001\015\000\190\001\r\000\190\001\007\000\190\001\001\000\190\000\251\000\190\000\181\000\190\000-\000\190\000\181\000\224\000\181\000\181\001\195\000\175\000\181\000\246\000/\000\179\000\181\000\238\000\181\000\184\001\145\0019\000\181\000\179\000\218\000\181\000\181\000\218\000\181\000\177\000\218\000\181\000\173\000\218\000\181\000Y\001\161\000\181\001\161\000b\000\018\000\243\000*\000Y\000\245\000\181\000\132\001\145\0019\000Y\000\173\000\224\000\181\000\173\001\195\000\175\000\173\000\246\000/\000\177\000\173\000\238\000\181\000d\000\014\000O\000\226\000c\000\226\001\153\0008\000\181\0008\000\181\000\b\000g\001\153\000\135\000\206\001\153\001\207\000\135\000\206\001\207\000z\001\199\001\197\000.\000\182\001\145\0019\000/\000\226\000\167\000\186\000\241\0013\000:\000:\000\n\000:\000\n\000\n\000:\000,\000i\000[\000\004\000i\001o\001q\000\151\001q\001o\001\139\001q\001\141\000\149\001q\000\149\001\141\001o\001q\000\147\001q\000\145\000\214\001\153\000\186\001\153\001\127\000\143\001\127\001w\000\141\001w\001U\000\139\001U\000\245\000\137\000\245\0006\001i\000\135\0006\001i\001#\000\238\001#\000\133\000\238\001#\001\207\000\131\000\252\001\207\000!\000\129\000\250\000!\000q\000\127\000\238\000q\001\153\000}\000\218\001\153\000;\000{\000\218\000;\001\201\000y\000\"\001\201\000w\000\218\001\153\001\153\000\218\001\153\000u\000\218\001\129\000u\000\218\000\172\001\145\0019\000\133\001\129\000\218\001\129\001\129\000\218\000\172\001\145\0019\000\133\000\172\001\145\0019\000\133\000\218\001\129\000\172\001\145\0019\000\133\000\218\000\172\001\145\0019\000\133\000s\000\"\001\201\001\201\000\"\001\201\000I\001\153\001\129\001\129\000(\000\172\001\145\0019\000\133\000\172\001\145\0019\000\133\000(\001\129\000(\000o\000\172\001\145\0019\000\133\000(\000o\000d\000\217\000d\000\217\000(\000d\000\217\000(\000m\000\181\000\181\000(\000\181\000(\000k\001W\000\209\000\217\001W\000\209\000\217\000(\001W\000\209\000\217\000(\000i\001{\000\172\001\145\0019\000\133\000\184\001\145\0019\001\163\001s\0019\0013\0011\001a\0013\001\135\000)\000\161\001k\0017\001m\0015\000\018\001\145\0019\0009\000=\000>\000\159\000\147\0013\000\018\001\145\0019\000P\0009\000=\000>\000\159\000\147\0013\000e\000V\001\145\0019\001\005\001\t\0013\000V\001\145\0019\001\005\000\186\001\r\0013\001\003\000V\001\145\0019\000,\001\005\000\226\001\001\0013\001;\000\255\000\253\000\233\000\152\001\145\0019\001\001\0013\000\228\001\145\0019\000'\001\133\000d\000\226\001\173\0013\001A\001\171\001\167\000\\\000\136\000\\\000\178\000B\000\136\000B\000\178\000\130\001%\0000\000~\000k\000.\000v\000k\000\234\000v\000\234\000\202\001\129\000\166\000\202\000\172\001\145\0019\000\133\000\166\000\198\000[\000b\000g\000*\000b\000g\000A\000*\000[\000\206\000b\000g\000*\000[\000\206\000\130\000g\0000\000[\000\206\000~\000g\000.\000[\000\200\000b\000o\000*\000[\000\206\001\r\000\200\000b\000o\000*\000[\000\200\000\130\000o\0000\000[\000\206\001\r\000\200\000\130\000o\0000\000[\000\200\000~\000o\000.\000[\000\206\001\r\000\200\000~\000o\000.\000\232\001\145\0019\000g\000\192\000\232\001\145\0019\000\192\000R\001\145\0019\001\185\000b\000V\001\145\0019\001\007\000*\000b\000V\001\145\0019\001\007\000\226\001\001\000*\000N\001\145\0019\001\183\001+\000\192\000-\001\167\001\161\000\245\000<\000[\000\240\000[\000\128\000m\000\164\000\128\000\164\000[\000\206\001W\001\r\000\206\000b\000g\000*\001\r\000\206\000\128\000m\000\164\000[\000\160\000d\000[\000\158\000[\001\143\000\014\001\r\000\206\000b\000*\000\130\000\153\0000\001\r\000\206\000\130\000\153\0000\000v\000o\000\234\000v\000\234\001\r\000\206\000v\000o\000\234\001\r\000\206\000v\000\234\000~\000o\000.\001\r\000\206\000~\000o\000.\001\r\000\206\000~\000.\001\r\000\206\000b\000V\001\145\0019\001\007\000\226\001\001\000*\000/\000W\000b\000\181\000*\000]\000b\000V\001\145\0019\001\005\000*\000b\000V\001\145\0019\001\005\000\226\001\001\000*\000\014\000_\000_\000\204\000_\001\161\000\245\000\160\000=\001\r\000\206\000]\001\r\000\206\000~\000.\001\r\000\206\000b\000*\001\r\000\206\000b\000\181\000*\000b\000\181\000\226\001\153\000*\001\143\000d\000\016\000\250\000\246\000\244\000\232\000\228\000\214\000\212\000\208\000\196\000\194\000\192\000\184\000\182\000\180\000\176\000\174\000\172\000\170\000\156\000\154\000\152\000\140\000\138\000\132\000h\000`\000^\000V\000T\000R\000P\000N\000L\000J\000F\000:\000,\000$\000\030\000\028\000\024\000\022\000\020\000\018\000\012\000\n\000\b\000\006\000\004\000e\000\184\001\145\0019\001\163\000\186\001\161\0019\0013\000\186\000g\001}\000\209\000\186\001\131\001/\000g\0013\001/\001M\001a\0013\001\135\000\161\000)\001k\0017\000\018\001\145\0019\0009\000=\000>\000\159\000\149\0013\000\018\001\145\0019\000P\0009\000=\000>\000\159\000\149\0013\000S\000V\001\145\0019\001\005\001\011\0013\000V\001\145\0019\000,\001\005\001\011\0013\001=\000\255\000\235\000\228\001\145\0019\000'\001\133\000d\001\189\0013\001C\001\171\000\152\001\145\0019\001\007\0013\000\\\000Z\000\245\000L\000\229\000\131\0019\000\245\0019\000\160\001i\000\160\001i\000 \000\160\001i\000\136\000\160\001i\000-\000\160\001i\001\r\000\160\001i\000\180\000\160\001i\000\022\000g\0013\000&\001)\000&\000G\000&\000\190\001\201\000s\000\226\001\153\000\226\001\153\000\220\001\153\000\220\001\153\000\186\000\239\001\029\0005\0007\000;\000b\000{\000*\0006\001i\000\014\000B\000\\\000\240\000B\000\240\000\240\000B\000\\\000\240\000\240\000\\\000\146\000<\001'\000\190\000g\0013\001'\000\190\000b\000\231\000*\000d\0001\001\017\0019\000%\000d\000\226\001\153\0019\000\249\000d\000\186\000g\000\240\0019\000\249\000d\000\186\000g\0019\000\249\000d\000A\000\186\000g\000\240\0019\000\249\000d\000A\000\186\000g\000\012\001\145\0019\000/\000\226\000\167\0013\000\n\000\n\000T\000\n\000\n\000T\000\n\000:\000\n\000\n\000:\000\018\0009\001W\000\031\001\207\000\145\000\018\0009\001W\000\222\001\207\000V\001\r\000\186\001\015\000V\001\r\000\222\001\015\000V\000\018\000\251\000\186\001\001\000V\000\018\000\251\000\222\001\001\000\186\000\186\000:"), (16, "\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b\000\t\000\n\000\011\000\012\000\r\000\014\000\015\000\016\000\017\000\018\000\022\000\026\000\027\000\028\000\029\000\030\000 \000$\000&\000)\000.\0001\0003\0004\0005\0008\0009\000=\000>\000A\000D\000J\000Q\000S\000U\000V\000[\000a\000d\000g\000k\000o\000q\000r\000t\000x\000z\000}\000\127\000\128\000\131\000\136\000\136\000\139\000\139\000\143\000\150\000\157\000\161\000\163\000\164\000\165\000\169\000\170\000\175\000\177\000\183\000\190\000\193\000\194\000\198\000\203\000\208\000\209\000\213\000\218\000\221\000\232\000\233\000\234\000\235\000\236\000\237\000\239\000\241\000\242\000\243\000\244\000\247\000\248\000\249\000\254\001\001\001\002\001\005\001\006\001\t\001\012\001\r\001\014\001\015\001\017\001\018\001\019\001\020\001\023\001\029\001 \001$\001)\001-\001/\0013\0019\001:\001;\001;\001=\001A\001B\001G\001K\001L\001P\001P\001S\001W\001X\001Y\001a\001j\001q\001y\001\128\001\134\001\140\001\148\001\159\001\170\001\184\001\190\001\199\001\206\001\217\001\221\001\225\001\227\001\228\001\230\001\232\001\235\001\241\001\244\001\250\001\253\002\003\002\006\002\012\002\015\002\021\002\024\002\030\002!\002'\002*\0020\0023\0029\002<\002B\002E\002K\002N\002T\002W\002]\002`\002f\002i\002o\002r\002x\002{\002\129\002\132\002\138\002\141\002\147\002\150\002\156\002\158\002\163\002\165\002\170\002\173\002\177\002\180\002\186\002\189\002\195\002\200\002\208\002\215\002\225\002\232\002\242\002\249\003\003\003\n\003\020\003\029\003)\0030\003:\003C\003O\003V\003`\003i\003u\003w\003{\003|\003}\003~\003\128\003\131\003\136\003\137\003\141\003\146\003\149\003\151\003\156\003\157\003\157\003\159\003\163\003\169\003\171\003\175\003\179\003\182\003\191\003\201\003\209\003\218\003\219\003\220\003\222\003\222\003\224\003\226\003\230\003\231\003\236\003\243\003\244\003\245\003\247\003\248\003\251\003\252\003\253\003\255\004\001\004\006\004\b\004\n\004\015\004\017\004\022\004\024\004\028\004\030\004 \004!\004\"\004#\004%\004)\0040\0048\004;\004@\004F\004H\004M\004T\004V\004W\004Z\004\\\004]\004b\004e\004f\004i\004i\004q\004q\004z\004z\004\131\004\131\004\137\004\137\004\144\004\144\004\146\004\146\004\154\004\154\004\163\004\163\004\165\004\165\004\167\004\169\004\169\004\171\004\175\004\177\004\177\004\179\004\179\004\181\004\181\004\183\004\183\004\185\004\189\004\191\004\193\004\196\004\200\004\206\004\211\004\214\004\219\004\222\004\229\004\232\004\238\004\240\004\244\004\245\004\246\004\251\004\255\005\004\005\011\005\019\005\029\005(\005)\005,\005-\0050\0051\0054\0055\0058\005=\005@\005A\005D\005E\005H\005I\005L\005M\005P\005Q\005U\005V\005X\005\\\005^\005`\005b\005f\005k\005l\005n\005o\005q\005t\005u\005v\005w\005x\005\127\005\131\005\136\005\141\005\144\005\146\005\147\005\151\005\154\005\157\005\158\005\165\005\173\005\174\005\174\005\175\005\175\005\176\005\177\005\179\005\181\005\183\005\184\005\186\005\187\005\189\005\190\005\192\005\193\005\195\005\198\005\202\005\203\005\205\005\208\005\212\005\215\005\219\005\224\005\230\005\233\005\235\005\240\005\246\005\251\006\001\006\002\006\003\006\004\006\b\006\r\006\017\006\022\006\026\006\031\006 \006!\006\"\006#\006$\006%\006&\006'\006(\006)\006*\006+\006,\006-\006.\006/\0060\0061\0062\0063\0064\0065\0066\0066\0066\0067\0067\0068\0068\006:\006:\006<\006<\006>\006>\006@\006E\006E\006G\006G\006I\006I\006K\006K\006L\006M\006P\006U\006X\006]\006e\006l\006v\006\127\006\139\006\146\006\156\006\158\006\160\006\162\006\164\006\166\006\168\006\170\006\172\006\174\006\176\006\178\006\181\006\183\006\184\006\187\006\188\006\191\006\195\006\198\006\201\006\204\006\207\006\208\006\210\006\216\006\218\006\222\006\225\006\227\006\228\006\231\006\232\006\235\006\236\006\237\006\238\006\240\006\242\006\244\006\248\006\249\006\252\006\253\007\000\007\004\007\r\007\r\007\014\007\014\007\015\007\016\007\018\007\020\007\020\007\021\007\022\007\025\007\026\007\027\007\029\007\030\007\031\007 \007!\007#\007%\007&\007'\007)\007)\007.\007/\0071\0072\0074\0075\0077\0078\007:\007<\007?\007@\007B\007E\007F\007I\007J\007M\007N\007Q\007R\007U\007V\007Y\007Z\007]\007`\007c\007f\007l\007o\007u\007{\007\132\007\135\007\138\007\139\007\140\007\141\007\143\007\147\007\152\007\155\007\161\007\163\007\166\007\170\007\171\007\173\007\176\007\179\007\183\007\188\007\189\007\193\007\200\007\201\007\203\007\204\007\205\007\206\007\208\007\210\007\219\007\229\007\230\007\236\007\243\007\244\007\253\007\254\007\255\b\000\b\005\b\015\b\016\b\017\b\019\b\021\b\023\b\025\b\028\b\031\b\"\b$\b'\b-\b/\b2\b6\b;\b@\bE\bJ\bQ\bV\b]\bb\bi\bn\br\bv\b|\b\132\b\138\b\139\b\140\b\141\b\142\b\144\b\146\b\149\b\151\b\154\b\159\b\164\b\167\b\170\b\171\b\172\b\176\b\179\b\184\b\187\b\189\b\194\b\198\b\201\b\206\b\210\b\220\b\221\b\222\b\225\b\226\b\232\b\240\b\241\b\242\b\245\b\246\b\247\b\249\b\252\t\000\t\004\t\t\t\014\t\015\t\016\t\017\t\018\t\019\t\020\t\021\t\022\t\023\t\024\t\025\t\026\t\027\t\028\t\029\t\030\t\031\t \t!\t\"\t#\t$\t%\t&\t'\t(\t)\t*\t+\t,\t-\t.\t/\t0\t1\t2\t3\t4\t5\t6\t7\t8\t9\t:\t;\t<\t=\t>\t?\t@\tA\tB\tC\tK\tM\tQ\tR\tU\tV\tX\tY\tZ\t[\t]\tf\tp\tq\tw\t\127\t\128\t\129\t\138\t\139\t\144\t\145\t\146\t\151\t\153\t\155\t\158\t\161\t\164\t\167\t\170\t\173\t\176\t\178\t\180\t\181\t\182\t\183\t\185\t\189\t\191\t\191\t\193\t\194\t\196\t\196\t\197\t\200\t\202\t\203\t\203\t\204\t\205\t\206\t\208\t\210\t\212\t\214\t\215\t\216\t\218\t\222\t\225\t\226\t\227\t\228\t\233\t\238\t\244\t\250\n\001\n\b\n\b\n\t\n\n\n\012\n\014\n\015\n\017\n\019\n\025\n\030\n\"\n&\n+\n0\n1\n3"))
+ ((16, "\001g\001c\000\203\000\201\000\199\000\197\000\195\000\193\000\191\000\189\000\187\000\185\000\183\000E\0003\000B\000@\001y\001\207\000\248\0006\001i\000\252\0019\001Q\0013\001\025\001\165\001\151\000=\001\201\000=\000h\000w\000*\000=\000\166\001\169\001\201\000\166\001\169\000h\000w\000*\000\166\001\169\001\015\000\208\001\149\0006\001i\000\014\000U\000U\000\208\001\199\000\169\000\130\001\199\001\197\000.\001\175\000\178\0019\001\187\001K\000\160\001\193\000n\000J\0019\001\r\000\160\001\193\000n\000J\000\242\0019\001\r\000\160\001\193\001\193\001\195\001\175\000\139\001\143\000\146\0019\001\193\000\223\0013\000\146\000\242\0019\001\193\000\223\0013\000\012\000+\0013\000^\001\031\0013\000\216\0019\001\159\0013\000\144\0019\000g\0013\001a\0013\001\135\000\190\001\193\000\228\001\173\000\190\001\193\001S\001\189\001S\000X\001\193\001S\001\187\001\021\000h\000\181\000*\000h\000\181\000\228\001\153\000*\000h\001\153\000*\000\146\0019\001\177\0013\000\012\0019\000\247\000j\000\228\001\153\0013\000^\0019\000\157\000j\000\228\000\167\0013\000\216\0019\001\159\0013\001a\0013\001\135\001\169\000\132\000}\000.\001\169\001\143\000N\0019\001\181\001-\000\196\001\177\001\195\000n\000J\0019\001\r\000\160\001\177\000n\000J\000\242\0019\001\r\000\160\001\177\000h\001\193\000*\001\185\000\132\000}\000.\001\185\000h\001\193\000\228\001\173\000*\000N\0019\001\183\001+\000\196\001\177\000\207\000C\000X\001\173\000j\000\228\000C\000X\001\173\000C\000X\001\173\000\230\000\018\001\145\0019\000'\001\133\000j\000\190\001\177\0013\001?\001\029\000\142\000\232\000 \000\182\000\132\000.\000h\000*\000\184\000\022\000\016\000h\000\226\000*\001\165\001\r\001\r\000\208\000h\000\226\000*\000h\000\226\000*\001\165\001\153\000\190\001\153\001\201\000y\000\"\001\201\000\136\001[\0000\000\240\000\151\001\207\001\153\001\195\000\237\001\137\001\149\000h\001\153\000*\000h\000V\001\145\0019\001\001\000*\000\132\000I\000.\000\132\000\240\000\127\000.\000\132\000q\000\240\000\127\000.\000z\000\227\000\127\000.\000z\000.\000x\000\227\000\127\000.\000x\000\227\000\127\000\172\000\137\000.\000\024\000\202\000D\001\199\000v\001\199\000\169\000.\0004\000\240\001\163\000\190\001\161\0019\001\163\000\190\001\161\0019\001\143\000~\001\199\001\197\000.\000\132\000{\000.\000\176\001\145\0019\000\133\001{\000[\000n\000V\001\145\0019\001\005\001\011\000\160\000g\000n\000\188\001\145\0019\001\163\001s\0019\000\160\000g\000n\000J\001\145\0019\001\007\000\160\000g\000n\000J\000\242\001\145\0019\001\007\000\160\000g\000\178\001\145\0019\001}\000\221\000X\001\131\000f\001\145\0019\000g\000\004\000\133\000\020\001\145\0019\000g\000\004\000\133\000\162\001\145\0019\000g\000\028\001\129\000\198\001\129\000\162\001\145\0019\000g\000\028\001\129\000\198\000\176\001\145\0019\000\133\000\162\001\145\0019\000g\000\028\000\176\001\145\0019\000\133\000\198\001\129\000\162\001\145\0019\000g\000\028\000\176\001\145\0019\000\133\000\198\000\176\001\145\0019\000\133\000\162\001\145\0019\000g\000\028\001\129\000\162\001\145\0019\000g\000\028\000\176\001\145\0019\000\133\000\006\001\145\0019\000g\000\214\000g\000\210\000\180\001\145\0019\000\181\000\190\000g\001\147\000g\000\214\000g\000\210\000\246\001\145\0019\000[\000\138\001\145\0019\000[\000[\000\139\000u\001\161\000[\000\245\000[\001\129\000\156\001\129\001\129\000\156\000\176\001\145\0019\000\133\001\129\000\154\001\129\001\129\000\154\000\176\001\145\0019\000\133\001\129\000\152\001\129\001\129\000\152\000\176\001\145\0019\000\133\001\129\000\150\001\129\001\129\000\150\000\176\001\145\0019\000\133\001\129\000\148\001\129\001\129\000\148\000\176\001\145\0019\000\133\001\129\000B\001\129\001\129\000B\000\176\001\145\0019\000\133\001\129\000@\001\129\001\129\000@\000\176\001\145\0019\000\133\001\129\000>\001\129\001\129\000>\000\176\001\145\0019\000\133\001\129\000\\\001\129\001\129\000\\\000\176\001\145\0019\000\133\001\129\000Z\001\129\001\129\000Z\000\176\001\145\0019\000\133\001\129\000\"\001\129\001\129\000\"\000\176\001\145\0019\000\133\001\129\000D\001\129\001\129\000D\000\176\001\145\0019\000\133\001\129\000\190\001\129\001\129\000\190\000\176\001\145\0019\000\133\001\129\000r\001\129\001\129\000r\000\176\001\145\0019\000\133\001\129\000\172\001\129\001\129\000\172\000\176\001\145\0019\000\133\001\129\000F\001\129\001\129\000F\000\176\001\145\0019\000\133\001\129\000\238\001\129\001\129\000\238\000\176\001\145\0019\000\133\001\129\000\254\001\129\001\129\000\254\000\176\001\145\0019\000\133\001\129\001\000\001\129\001\129\001\000\000\176\001\145\0019\000\133\001\129\000\224\001\129\001\129\000\224\000\176\001\145\0019\000\133\000K\001\129\000K\000\176\001\145\0019\000\133\001\209\001\129\001\209\000\176\001\145\0019\000\133\001M\000\160\000g\000l\001E\000\160\000g\001\129\000\226\001\129\001\129\000\226\000\176\001\145\0019\000\133\000j\000p\001\129\000j\000p\000\176\001\145\0019\000\133\000[\000\208\001W\000p\001\129\000[\000\208\001W\000p\000\176\001\145\0019\000\133\000[\000\208\000h\000g\000*\000p\001\129\000[\000\208\000h\000g\000*\000p\000\176\001\145\0019\000\133\000[\000\208\000\136\000g\0000\000p\001\129\000[\000\208\000\136\000g\0000\000p\000\176\001\145\0019\000\133\000[\000\208\000\132\000g\000.\000p\001\129\000[\000\208\000\132\000g\000.\000p\000\176\001\145\0019\000\133\000[\000\204\000h\000o\000*\000p\001\129\000[\000\204\000h\000o\000*\000p\000\176\001\145\0019\000\133\000[\000\208\001\r\000\204\000h\000o\000*\000p\001\129\000[\000\208\001\r\000\204\000h\000o\000*\000p\000\176\001\145\0019\000\133\000[\000\204\000\136\000o\0000\000p\001\129\000[\000\204\000\136\000o\0000\000p\000\176\001\145\0019\000\133\000[\000\208\001\r\000\204\000\136\000o\0000\000p\001\129\000[\000\208\001\r\000\204\000\136\000o\0000\000p\000\176\001\145\0019\000\133\000[\000\204\000\132\000o\000.\000p\001\129\000[\000\204\000\132\000o\000.\000p\000\176\001\145\0019\000\133\000[\000\208\001\r\000\204\000\132\000o\000.\000p\001\129\000[\000\208\001\r\000\204\000\132\000o\000.\000p\000\176\001\145\0019\000\133\001\129\001\195\000h\000\018\000\243\000*\001S\000\143\001\129\001\129\000(\001\129\000(\000g\001\129\000(\000D\001\199\000g\000C\000\207\000C\000X\001y\000j\000\228\000C\000X\001y\000C\000X\001y\000h\000*\000h\001\005\000\228\001\001\000*\000\141\000L\001\157\000\228\001\157\000X\001\201\000\228\000\135\000\208\001\157\000X\001\201\000\228\001\201\000\228\000\135\000\208\001\201\000\240\001\163\001s\0019\001\163\001s\0019\000\018\001\145\0019\0009\000j\000\224\000\239\000\145\0013\000\018\001\145\0019\000P\0009\000j\000\224\000\239\000\145\0013\000\018\001\145\0019\0009\000j\000?\000\145\0013\000\018\001\145\0019\000P\0009\000j\000?\000\145\0013\000\016\000j\000O\000\194\000(\000\206\000c\000\194\000t\001\199\000\169\000.\0002\000\249\000j\000\228\000\165\0019\000\249\000j\000\228\000\165\0019\000(\0019\001_\001]\001]\001[\000j\000j\000\228\001\153\001\021\000[\000\140\000[\000\026\000j\000\026\000h\000j\000A\000*\0008\000j\000H\000[\0008\000h\001Y\000\211\000*\0008\000j\000H\000h\001I\000\211\000*\000H\000\171\000\026\000h\001Y\000*\000\026\000j\000\140\000Y\000Y\001O\000/\000/\000Q\000/\000A\000\190\000g\000/\000\228\000\135\000\208\001\153\000\190\000g\000/\000\228\000\018\000\243\000\208\001\153\000\190\000g\000\173\000\190\000g\000W\000\228\001\153\000\190\000g\000n\001\145\0019\000\155\001Q\0013\001M\001\205\000n\0019\000\155\001Q\0013\000n\000D\001\199\0019\000\155\001Q\0013\001K\001\205\000\181\000\181\000\228\001\153\000/\000Q\000/\000Y\000\228\001\153\000\190\000g\000\173\000\190\000g\001G\001E\000\250\001G\000\252\0019\000'\001\133\000j\001\189\0013\001C\000\252\0019\000'\001\133\000j\000\228\001\173\0013\001A\000\252\0019\000'\001\133\000j\000\190\001\177\0013\001?\000\252\0019\001\005\001\011\0013\001=\000\252\0019\001\005\000\228\001\001\0013\001;\001\195\0019\000\252\0019\0009\000j\000?\000\145\0013\0017\000\252\0019\0009\000j\000\224\000\239\000\145\0013\0015\000\163\0013\000&\0011\000a\0011\000&\001/\000&\000g\0013\001/\000M\001/\001\179\001-\001\191\001+\000M\001)\000&\001'\000&\000g\0013\001'\000M\001'\000G\001'\001W\000\219\000\213\001W\000\219\000\213\000(\001W\000\219\000\213\000(\000\014\000\225\001W\000\219\000\213\000(\001%\000\181\000X\000g\000\181\000\b\000g\000X\000g\000\181\000X\000\208\000j\000\228\000\165\0019\000(\0019\001!\001\201\000(\001!\000j\000\228\000\165\0019\000(\0019\001\201\000(\000j\000\228\000\165\0019\001\201\000\206\0019\000#\000j\000\228\000\167\0019\000\159\000j\000Q\000\242\0019\000\159\000j\000Q\0019\000\159\000j\000\228\000\167\000\190\000g\000\242\0019\000\159\000j\000\228\000\167\000\190\000g\0019\000\159\000j\000\228\000\018\000\243\000\208\001\153\000\190\000g\000\242\0019\000\159\000j\000\228\000\018\000\243\000\208\001\153\000\190\000g\000j\001\015\000\208\000j\000\016\001\015\000\208\000\016\001i\000h\000\226\000*\0001\001\015\000\208\001i\001\015\000\208\000h\000\226\000*\001\015\000\208\0001\001i\001\015\000\208\001i\000j\001\r\000\208\000j\000\016\001\r\000\208\000\016\000/\001\r\000\208\000/\001\027\001\015\000h\001\015\000*\001\019\000\190\001\007\000\228\001\001\000\190\001\007\001w\001\011\000\228\001\001\001w\001\t\000\030\0019\000O\000\196\000\174\0019\001u\000X\001\007\000\205\001\007\001\195\001\r\001\007\000\205\001\007\000h\000*\001\143\000\014\000\016\000\014\000V\001\145\0019\000\016\000\224\001\015\0013\000$\0019\000c\000\196\000\174\0019\001u\000X\001\001\001u\000X\001\001\000V\000\018\000L\0019\001\007\000h\001\001\000*\001\001\001\195\000\251\001\001\000X\001\001\001\001\000\004\000\129\001\143\000V\000\018\001\145\0019\001i\000\215\0013\000V\000\018\001\145\0019\001i\000\224\001\001\0013\001\023\000T\000T\000\n\000T\000\n\000\n\000T\000\244\001i\000j\000j\000\243\000 \000 \000\241\001\153\000:\001\153\001\155\000:\001\155\001\153\000\190\001\155\001\153\000\190\000:\001\155\000\206\000:\000\206\001\153\000\190\000\206\001\153\000\190\000:\000\206\000\136\001[\0000\000:\000\136\001[\0000\001\153\000\190\000\136\001[\0000\001\153\000\190\000:\000\136\001[\0000\000r\001!\000\172\000r\000\172\000J\001\145\0019\001\007\0013\000J\000\242\001\145\0019\001\007\0013\000J\001\145\0019\001\015\0013\000J\000\242\001\145\0019\001\015\0013\000<\000l\000\250\000\204\000h\001e\000*\000\204\000h\001e\000*\000p\000\204\000\132\001e\000.\000\204\000\132\001e\000.\000p\000\204\000\136\001e\0000\000\204\000\136\001e\0000\000p\000\164\000\242\000\156\000\154\000\152\000\150\000\148\000B\000@\000>\000\\\000Z\000\"\000D\000\190\000r\000\172\000F\000\238\000\254\001\000\000\224\000\254\000\240\000(\000\248\000j\000\228\001\201\000\228\001\153\000\190\001\129\000\190\000\176\001\145\0019\000\133\000\190\001\001\000\190\000\181\000\190\000g\000A\000H\0008\000j\000\228\000h\001\007\000\228\001\001\000*\000h\001\007\000*\000h\000\012\0019\001\129\000*\000h\000\012\0019\000\176\001\145\0019\000\133\000*\000h\000\012\0019\001\129\000\228\001\001\000*\000h\000\012\0019\000\176\001\145\0019\000\133\000\228\001\001\000*\000h\000\012\0019\001\129\000\228\001\001\000\222\001\001\000*\000h\000\012\0019\000\176\001\145\0019\000\133\000\228\001\001\000\222\001\001\000*\000h\000\012\0019\001\129\000\222\001\001\000*\000h\000\012\0019\000\176\001\145\0019\000\133\000\222\001\001\000*\001\203\000\194\001\161\000\194\001\153\000\194\000g\000\194\001\015\000\194\001\r\000\194\001\007\000\194\001\001\000\194\000\251\000\194\000\181\000\194\000-\000\194\000\181\000\226\000\181\000\181\001\195\000\175\000\181\000\248\000/\000\179\000\181\000\240\000\181\000\188\001\145\0019\000\181\000\200\000\175\000\220\000Y\000\179\000\220\000\181\000\181\000\220\000\181\000\177\000\220\000\181\000\173\000\220\000\181\000Y\001\161\000\181\001\161\000h\000\018\000\243\000*\000Y\000\245\000\181\000\138\001\145\0019\000Y\000\173\000\226\000\181\000\173\001\195\000\175\000\173\000\248\000/\000\177\000\173\000\240\000\181\000j\000\014\000O\000\228\000c\000\228\001\153\0008\000\181\0008\000\181\000\b\000g\001\153\000\135\000\208\001\153\001\207\000\135\000\208\001\207\000\128\001\199\001\197\000.\000\186\001\145\0019\000/\000\228\000\167\000\190\000\241\0013\000:\000:\000\n\000:\000\n\000\n\000:\000,\000i\000[\000\004\000i\001o\001q\000\151\001q\001o\001\139\001q\001\141\000\149\001q\000\149\001\141\001o\001q\000\147\001q\000\145\000\216\001\153\000\190\001\153\001\127\000\143\001\127\001w\000\141\001w\001U\000\139\001U\000\245\000\137\000\245\0006\001i\000\135\0006\001i\001#\000\240\001#\000\133\000\240\001#\001\207\000\131\000\254\001\207\000!\000\129\000\252\000!\000q\000\127\000\240\000q\001\153\000}\000\220\001\153\000;\000{\000\220\000;\001\201\000y\000\"\001\201\000w\000\220\001\153\001\153\000\220\001\153\000u\000\220\001\129\000u\000\220\000\176\001\145\0019\000\133\001\129\000\220\001\129\001\129\000\220\000\176\001\145\0019\000\133\000\176\001\145\0019\000\133\000\220\001\129\000\176\001\145\0019\000\133\000\220\000\176\001\145\0019\000\133\000s\000\"\001\201\001\201\000\"\001\201\000I\001\153\001\129\001\129\000(\000\176\001\145\0019\000\133\000\176\001\145\0019\000\133\000(\001\129\000(\000o\000\176\001\145\0019\000\133\000(\000o\000j\000\217\000j\000\217\000(\000j\000\217\000(\000m\000\181\000\181\000(\000\181\000(\000k\001W\000\209\000\217\001W\000\209\000\217\000(\001W\000\209\000\217\000(\000i\001{\000\176\001\145\0019\000\133\000\188\001\145\0019\001\163\001s\0019\0013\0011\001a\0013\001\135\000)\000\161\001k\0017\001m\0015\000\018\001\145\0019\0009\000=\000>\000\159\000\147\0013\000\018\001\145\0019\000P\0009\000=\000>\000\159\000\147\0013\000e\000V\001\145\0019\001\005\001\t\0013\000V\001\145\0019\001\005\000\190\001\r\0013\001\003\000V\001\145\0019\000,\001\005\000\228\001\001\0013\001;\000\255\000\253\000\233\000\158\001\145\0019\001\001\0013\000\230\001\145\0019\000'\001\133\000j\000\228\001\173\0013\001A\001\171\001\167\000\\\000\142\000\\\000\182\000B\000\142\000B\000\182\000\136\001%\0000\000\132\000k\000.\000|\000k\000\236\000|\000\236\000h\000g\000*\000h\000g\000A\000*\000[\000\208\000h\000g\000*\000[\000\208\000\136\000g\0000\000[\000\208\000\132\000g\000.\000[\000\204\000h\000o\000*\000[\000\208\001\r\000\204\000h\000o\000*\000[\000\204\000\136\000o\0000\000[\000\208\001\r\000\204\000\136\000o\0000\000[\000\204\000\132\000o\000.\000[\000\208\001\r\000\204\000\132\000o\000.\000`\000[\000b\000g\000d\000\234\001\145\0019\000g\000\196\000\234\001\145\0019\000\196\000R\001\145\0019\001\185\000h\000V\001\145\0019\001\007\000*\000h\000V\001\145\0019\001\007\000\228\001\001\000*\000N\001\145\0019\001\183\001+\000\196\000-\001\167\001\161\000\245\000<\000[\000\242\000[\000\134\000m\000\170\000\134\000\170\000[\000\208\001W\001\r\000\208\000h\000g\000*\001\r\000\208\000\134\000m\000\170\000[\000\166\000j\000[\000\164\000[\001\143\000\014\001\r\000\208\000h\000*\000\136\000\153\0000\001\r\000\208\000\136\000\153\0000\000|\000o\000\236\000|\000\236\001\r\000\208\000|\000o\000\236\001\r\000\208\000|\000\236\000\132\000o\000.\001\r\000\208\000\132\000o\000.\001\r\000\208\000\132\000.\001\r\000\208\000h\000V\001\145\0019\001\007\000\228\001\001\000*\000/\000W\000h\000\181\000*\000]\000h\000V\001\145\0019\001\005\000*\000h\000V\001\145\0019\001\005\000\228\001\001\000*\000\014\000_\000_\000\206\000_\001\161\000\245\000\166\000=\001\r\000\208\000]\001\r\000\208\000\132\000.\001\r\000\208\000h\000*\001\r\000\208\000h\000\181\000*\000h\000\181\000\228\001\153\000*\001\143\000j\000\016\000\252\000\248\000\246\000\234\000\230\000\216\000\214\000\210\000\202\000\198\000\196\000\188\000\186\000\184\000\180\000\178\000\176\000\174\000\162\000\160\000\158\000\146\000\144\000\138\000n\000f\000^\000V\000T\000R\000P\000N\000L\000J\000F\000:\000,\000$\000\030\000\028\000\024\000\022\000\020\000\018\000\012\000\n\000\b\000\006\000\004\000e\000\188\001\145\0019\001\163\000\190\001\161\0019\0013\000\190\000g\001}\000\209\000\190\001\131\001/\000g\0013\001/\001M\001a\0013\001\135\000\161\000)\001k\0017\000\018\001\145\0019\0009\000=\000>\000\159\000\149\0013\000\018\001\145\0019\000P\0009\000=\000>\000\159\000\149\0013\000S\000V\001\145\0019\001\005\001\011\0013\000V\001\145\0019\000,\001\005\001\011\0013\001=\000\255\000\235\000\230\001\145\0019\000'\001\133\000j\001\189\0013\001C\001\171\000\158\001\145\0019\001\007\0013\000\\\000Z\000\245\000L\000\229\000\131\0019\000\245\0019\000\166\001i\000\166\001i\000 \000\166\001i\000\142\000\166\001i\000-\000\166\001i\001\r\000\166\001i\000\184\000\166\001i\000\022\000g\0013\000&\001)\000&\000G\000&\000\194\001\201\000s\000\228\001\153\000\228\001\153\000\222\001\153\000\222\001\153\000\190\000\239\001\029\0005\0007\000;\000h\000{\000*\0006\001i\000\014\000B\000\\\000\242\000B\000\242\000\242\000B\000\\\000\242\000\242\000\\\000\152\000<\001'\000\194\000g\0013\001'\000\194\000h\000\231\000*\000j\0001\001\017\0019\000%\000j\000\228\001\153\0019\000\249\000j\000\190\000g\000\242\0019\000\249\000j\000\190\000g\0019\000\249\000j\000A\000\190\000g\000\242\0019\000\249\000j\000A\000\190\000g\000\012\001\145\0019\000/\000\228\000\167\0013\000\n\000\n\000T\000\n\000\n\000T\000\n\000:\000\n\000\n\000:\000\018\0009\001W\000\031\001\207\000\145\000\018\0009\001W\000\224\001\207\000V\001\r\000\190\001\015\000V\001\r\000\224\001\015\000V\000\018\000\251\000\190\001\001\000V\000\018\000\251\000\224\001\001\000\190\000\190\000:"), (16, "\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b\000\t\000\n\000\011\000\012\000\r\000\014\000\015\000\016\000\017\000\018\000\022\000\026\000\027\000\028\000\029\000\030\000 \000$\000&\000)\000.\0001\0003\0004\0005\0008\0009\000=\000>\000A\000D\000J\000Q\000S\000U\000V\000[\000a\000d\000g\000k\000o\000q\000r\000t\000x\000z\000}\000\127\000\128\000\131\000\136\000\136\000\139\000\139\000\143\000\150\000\157\000\161\000\163\000\164\000\165\000\169\000\170\000\175\000\177\000\183\000\190\000\193\000\194\000\198\000\203\000\208\000\209\000\213\000\218\000\221\000\232\000\233\000\234\000\235\000\236\000\237\000\239\000\241\000\242\000\243\000\244\000\247\000\248\000\249\000\254\001\001\001\002\001\005\001\006\001\t\001\012\001\r\001\014\001\015\001\017\001\018\001\019\001\020\001\023\001\029\001 \001$\001)\001-\001/\0013\0019\001:\001;\001;\001=\001A\001B\001G\001K\001L\001P\001P\001S\001W\001X\001Y\001a\001j\001q\001y\001\128\001\134\001\140\001\148\001\159\001\170\001\184\001\190\001\199\001\206\001\217\001\221\001\225\001\227\001\228\001\230\001\232\001\235\001\241\001\244\001\250\001\253\002\003\002\006\002\012\002\015\002\021\002\024\002\030\002!\002'\002*\0020\0023\0029\002<\002B\002E\002K\002N\002T\002W\002]\002`\002f\002i\002o\002r\002x\002{\002\129\002\132\002\138\002\141\002\147\002\150\002\156\002\158\002\163\002\165\002\170\002\173\002\177\002\180\002\186\002\189\002\195\002\200\002\208\002\215\002\225\002\232\002\242\002\249\003\003\003\n\003\020\003\029\003)\0030\003:\003C\003O\003V\003`\003i\003u\003w\003{\003|\003}\003~\003\128\003\131\003\136\003\137\003\141\003\146\003\149\003\151\003\156\003\157\003\157\003\159\003\163\003\169\003\171\003\175\003\179\003\182\003\191\003\201\003\209\003\218\003\219\003\220\003\222\003\222\003\224\003\226\003\230\003\231\003\236\003\243\003\244\003\245\003\247\003\248\003\251\003\252\003\253\003\255\004\001\004\006\004\b\004\n\004\015\004\017\004\022\004\024\004\028\004\030\004 \004!\004\"\004#\004%\004)\0040\0048\004;\004@\004F\004H\004M\004T\004V\004W\004Z\004\\\004]\004b\004e\004f\004i\004i\004q\004q\004z\004z\004\131\004\131\004\137\004\137\004\144\004\144\004\146\004\146\004\154\004\154\004\163\004\163\004\165\004\165\004\167\004\169\004\169\004\171\004\175\004\177\004\177\004\179\004\179\004\181\004\181\004\183\004\183\004\185\004\189\004\191\004\193\004\196\004\200\004\206\004\211\004\214\004\219\004\222\004\229\004\232\004\238\004\240\004\244\004\245\004\246\004\251\004\255\005\004\005\011\005\019\005\029\005(\005)\005,\005-\0050\0051\0054\0055\0058\005=\005@\005A\005D\005E\005H\005I\005L\005M\005P\005Q\005U\005V\005X\005\\\005^\005`\005b\005f\005k\005l\005n\005o\005q\005t\005u\005v\005w\005x\005\127\005\131\005\136\005\139\005\144\005\147\005\149\005\150\005\153\005\156\005\157\005\164\005\172\005\173\005\173\005\174\005\174\005\175\005\176\005\178\005\180\005\182\005\183\005\185\005\186\005\188\005\189\005\191\005\192\005\194\005\197\005\201\005\202\005\204\005\207\005\211\005\214\005\218\005\223\005\229\005\232\005\234\005\239\005\245\005\250\006\000\006\001\006\002\006\003\006\007\006\012\006\016\006\021\006\025\006\030\006\031\006 \006!\006\"\006#\006$\006%\006&\006'\006(\006)\006*\006+\006,\006-\006.\006/\0060\0061\0062\0063\0064\0065\0065\0065\0066\0066\0067\0067\0069\0069\006;\006;\006=\006=\006?\006D\006D\006F\006F\006H\006H\006J\006J\006K\006L\006O\006T\006W\006\\\006d\006k\006u\006~\006\138\006\145\006\155\006\157\006\159\006\161\006\163\006\165\006\167\006\169\006\171\006\173\006\175\006\177\006\180\006\182\006\183\006\186\006\187\006\190\006\194\006\198\006\201\006\204\006\207\006\210\006\211\006\213\006\219\006\221\006\225\006\228\006\230\006\231\006\234\006\235\006\238\006\239\006\240\006\241\006\243\006\245\006\247\006\251\006\252\006\255\007\000\007\003\007\007\007\016\007\016\007\017\007\017\007\018\007\019\007\021\007\023\007\023\007\024\007\025\007\028\007\029\007\030\007 \007!\007\"\007#\007$\007&\007(\007)\007*\007,\007,\0071\0072\0074\0075\0077\0078\007:\007;\007=\007?\007B\007C\007E\007H\007I\007L\007M\007P\007Q\007T\007U\007X\007Y\007\\\007]\007`\007c\007f\007i\007o\007r\007x\007~\007\135\007\138\007\141\007\142\007\143\007\144\007\146\007\150\007\155\007\158\007\164\007\166\007\169\007\173\007\174\007\176\007\179\007\182\007\186\007\191\007\192\007\196\007\203\007\204\007\206\007\207\007\208\007\209\007\211\007\213\007\222\007\232\007\233\007\239\007\246\007\247\b\000\b\001\b\002\b\003\b\b\b\018\b\019\b\020\b\022\b\024\b\026\b\028\b\031\b\"\b%\b'\b*\b.\b3\b8\b=\bB\bI\bN\bU\bZ\ba\bc\bf\bk\bo\bs\by\b\129\b\135\b\136\b\137\b\138\b\139\b\141\b\143\b\146\b\148\b\151\b\156\b\161\b\164\b\167\b\168\b\169\b\173\b\176\b\181\b\184\b\186\b\191\b\195\b\198\b\203\b\207\b\217\b\218\b\219\b\222\b\223\b\229\b\237\b\238\b\239\b\242\b\243\b\244\b\246\b\249\b\253\t\001\t\006\t\011\t\012\t\r\t\014\t\015\t\016\t\017\t\018\t\019\t\020\t\021\t\022\t\023\t\024\t\025\t\026\t\027\t\028\t\029\t\030\t\031\t \t!\t\"\t#\t$\t%\t&\t'\t(\t)\t*\t+\t,\t-\t.\t/\t0\t1\t2\t3\t4\t5\t6\t7\t8\t9\t:\t;\t<\t=\t>\t?\t@\tH\tJ\tN\tO\tR\tS\tU\tV\tW\tX\tZ\tc\tm\tn\tt\t|\t}\t~\t\135\t\136\t\141\t\142\t\143\t\148\t\150\t\152\t\155\t\158\t\161\t\164\t\167\t\170\t\173\t\175\t\177\t\178\t\179\t\180\t\182\t\186\t\188\t\188\t\190\t\191\t\193\t\193\t\194\t\197\t\199\t\200\t\200\t\201\t\202\t\203\t\205\t\207\t\209\t\211\t\212\t\213\t\215\t\219\t\222\t\223\t\224\t\225\t\230\t\235\t\241\t\247\t\254\n\005\n\005\n\006\n\007\n\t\n\011\n\012\n\014\n\016\n\022\n\027\n\031\n#\n(\n-\n.\n0"))
and lr0_core =
- (16, "\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b\000\t\000\n\000\011\000\012\000\r\000\014\000\015\000\016\000\017\000\018\000\019\000\020\000\021\000\022\000\023\000\024\000\025\000\026\000\027\000\028\000\029\000\030\000\031\000 \000!\000\"\000#\000$\000%\000&\000'\000(\000)\000*\000+\000,\000-\000.\000/\0000\0001\0002\0003\0004\0005\0006\0007\0008\0009\000:\000;\000<\000=\000>\000?\000@\000A\000B\000C\000D\000E\000F\000G\000H\000I\000J\000K\000L\000M\000N\000O\000P\000Q\000R\000S\000T\000U\000V\000W\000X\000Y\000Z\000[\000\\\000]\000^\000_\000`\000a\000b\000c\000d\000e\000f\000g\000h\000i\000j\000k\000l\000m\000n\000o\000p\000q\000r\000s\000t\000u\000v\000w\000x\000y\000z\000{\000|\000}\000~\000\127\000\128\000\129\000\130\000\131\000\132\000\133\000\134\000\135\000\136\000\137\000\138\000\139\000\140\000\141\000\142\000\143\000\144\000\145\000\146\000\147\000\148\000\149\000\150\000\151\000\152\000\153\000\154\000\155\000\156\000\157\000\158\000\159\000\160\000\161\000\162\000\163\000\164\000\165\000\166\000\167\000\168\000\169\000\170\000\171\000\172\000\173\000\174\000\175\000\176\000\177\000\178\000\179\000\180\000\181\000\182\000\183\000\184\000\185\000\186\000\187\000\188\000\189\000\190\000\191\000\192\000\193\000\194\000\195\000\196\000\197\000\198\000\199\000\200\000\201\000\202\000\203\000\204\000\205\000\206\000\207\000\208\000\209\000\210\000\211\000\212\000\213\000\214\000\215\000\216\000\217\000\218\000\219\000\220\000\221\000\222\000\223\000\224\000\225\000\226\000\227\000\228\000\229\000\230\000\231\000\232\000\233\000\234\000\235\000\236\000\237\000\238\000\239\000\240\000\241\000\242\000\243\000\244\000\245\000\246\000\247\000\248\000\249\000\250\000\251\000\252\000\253\000\254\000\255\001\000\001\001\001\002\001\003\001\004\001\005\001\006\001\007\001\b\001\t\001\n\001\011\001\012\001\r\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\021\001\022\001\023\001\024\001\025\001\026\001\027\001\028\001\029\001\030\001\031\001 \001!\001\"\001#\001$\001%\001&\001'\001(\001)\001*\001+\001,\001-\001.\001/\0010\0011\0012\0013\0014\0015\0016\0017\0018\0019\001:\001;\001<\001=\001>\001?\001@\001A\001B\001C\001D\001E\001F\001G\001H\001I\001J\001K\001L\001M\001N\001O\001P\001Q\001R\001S\001T\001U\001V\001W\001X\001Y\001Z\001[\001\\\001]\001^\001_\001`\001a\001b\001c\001d\001e\001f\001g\001h\001i\001j\001k\001l\001m\001n\001o\001p\001q\001r\001s\001t\001u\001v\001w\001x\001y\001z\001{\001|\001}\001\128\001\129\001\134\001\135\001\136\001\137\001\138\001\139\001\140\001\141\001\142\001\143\001\144\001\145\001\146\001\147\001\148\001\149\001\150\001\151\001\152\001~\001\127\001\153\001\154\001\155\001\130\001\131\001\132\001\133\001\156\001\157\001\158\001\159\001\160\001\161\001\162\001\163\001\164\001\165\001\166\001\167\001\168\001\169\001\170\001\171\001\172\001\173\001\174\001\175\001\176\001\177\001\178\001\179\001\180\001\181\001\182\001\183\001\184\001\185\001\186\001\187\001\188\001\189\001\190\001\191\001\192\001\193\001\194\001\195\001\196\001\197\001\198\001\199\001\200\001\201\001\202\001\203\001\204\001\205\001\206\001\207\001\208\001\209\001\210\001\211\001\212\001\213\001\214\001\215\001\216\001\217\001\218\001\219\001\220\001\221\001\222\001\223\001\224\001\225\001\226\001\227\001\228\001\229\001\230\001\231\001\232\001\233\001\234\001\235\001\238\001\239\001\240\001\241\001\242\001\243\001\244\001\245\001\246\001\247\001\236\001\237\001\248\001\249\001\250\001\251\001\252\001\253\001\254\001\255\002\000\002\001\002\002\002\003\002\004\002\005\002\006\002\007\002\b\002\t\002\n\002\011\002\012\002\r\002\014\002\015\002\016\002\017\002\018\002\019\002\020\002\021\002\022\002\023\002\024\002\025\002\026\002\027\002\028\002\029\002\030\002\031\002 \002!\002\"\002#\002$\002%\002&\002'\002(\002)\002*\002+\002,\002-\002.\002/\0020\0021\0022\0023\0024\0025\0026\0027\0028\0029\002:\002;\002<\002=\002>\002?\002@\002A\002B\002C\002D\002E\002F\002G\002H\002I\002J\002K\002L\002M\002N\002O\002P\002Q\002R\002S\002T\002U\002V\002W\002X\002Y\002Z\002[\002\\\002]\002^\002_\002`\002a\002\137\002\138\002\139\002\140\002\141\002\142\002\143\002\144\002\145\002\146\002\147\002\148\002\149\002\150\002\151\002\152\002\153\002\154\002\155\002\156\002\157\002m\002n\002o\002p\002b\002c\002f\002g\002h\002i\002j\002k\002l\002s\002t\002u\002v\002w\002x\002y\002z\002{\002|\002}\002~\002\127\002\128\002\129\002\130\002\131\002\132\002\133\002\134\002\135\002\136\002d\002e\002q\002r\004\t\004\n\002\159\002\160\002\161\002\162\002\163\002\164\002\165\002\166\002\167\002\168\002\169\002\170\002\171\002\172\002\173\002\174\002\175\002\176\002\177\002\178\002\179\002\180\002\181\002\230\002\231\002\232\002\233\002\234\002\235\0034\0035\0036\0037\0038\0039\003:\003;\003<\003=\003>\003?\003@\003A\002\182\002\183\002\184\002\185\002\186\002\187\002\200\002\201\002\202\002\203\002\204\002\205\002\236\002\237\002\238\002\239\002\240\002\241\002\188\002\189\002\190\002\191\002\192\002\193\002\194\002\195\002\196\002\197\002\198\002\199\002\206\002\207\002\208\002\209\002\210\002\211\002\212\002\213\002\214\002\215\002\216\002\217\002\218\002\219\002\220\002\221\002\222\002\223\002\224\002\225\002\226\002\227\002\228\002\229\002\242\002\243\002\244\002\245\002\246\002\247\002\248\002\249\002\250\002\251\002\252\002\253\003\028\003\029\003\030\003\031\003 \003!\002\254\002\255\003\000\003\001\003\002\003\003\003\004\003\005\003\006\003\007\003\b\003\t\003\n\003\011\003\012\003\r\003\014\003\015\003\"\003#\003$\003%\003&\003'\003(\003)\003*\003+\003,\003-\003.\003/\0030\0031\0032\0033\003\016\003\017\003\018\003\019\003\020\003\021\003\022\003\023\003\024\003\025\003\026\003\027\003B\003C\003D\003E\003F\003G\003H\003I\003J\003K\003L\003M\003N\003O\003P\003Q\003R\003S\003T\003U\003V\003W\003X\003Y\003Z\003[\003\\\003]\003^\003_\003`\003a\003b\003c\003d\003e\003f\003g\003h\003i\003j\003k\003l\003m\003n\003o\003p\003q\003r\003s\003t\003u\003v\003w\003x\003y\003z\003{\004\011\004\012\004\r\004\014\004\015\004\016\004\017\004\018\004\019\004\020\004\021\003\140\003\141\003\142\004\022\004\023\004\024\004\025\004\026\004\027\004\028\003\166\003\167\003\168\003\169\003\170\003\171\003\172\003\173\003\174\003\175\003\176\003\177\003\178\003\179\003\180\003\181\003\182\003\183\003\184\003\185\003\186\003\187\003\188\003\189\003\190\003\191\003\192\003\193\003\194\003\195\003\196\003\197\003\198\003\199\003\200\003\201\003\202\003\203\003\204\003\205\003\206\003\207\003\208\003\209\003\210\003\211\003\212\003\213\003\214\003\215\003\216\003\217\003\218\003\219\003\220\003\221\003\222\003\223\003\224\003\225\003\226\003\227\003\228\003\229\003\230\003\231\003\232\003\233\003\234\003\235\003\236\003\237\003\238\003\239\003\240\003\241\003\242\003\243\003\244\003\245\003\246\003\247\003\248\003\249\003\250\003\251\003\252\003\253\003\254\003\255\004\000\004\001\004\002\004\003\004\004\004\005\004\006\004\007\004\b\004\029\004\030\004\031\004 \004!\004\"\004#\004$\004%\002\158\003|\003}\003~\003\127\003\128\003\129\003\130\003\131\003\132\003\133\003\134\003\135\003\136\003\137\003\138\003\139\003\143\003\144\003\145\003\146\003\147\003\148\003\149\003\150\003\151\003\152\003\153\003\154\003\155\003\156\003\157\003\158\003\159\003\160\003\161\003\162\003\163\003\164\003\165\004&\004'\004(\004)\004*\004+\004,\004-\004.\004/\0040\0041\0042\0043\0044\0045\0046\0047\0048\0049\004:\004;\004<\004=\004>\004?\004@\004A\004B\004C\004D\004E\004F\004G\004H\004I\004J\004K\004L\004M\004N\004O\004P\004Q\004R\004S\004T\004U\004V\004W\004X\004Y\004Z\004[\004\\\004]\004^\004_\004`\004a\004b\004c\004d\004e\004f\004g\004h\004i\004j\004k\004l\004m\004n\004o\004p\004q\004r\004s\004t\004u\004v\004w\004x\004y\004z\004{\004|\004}\004~\004\127\004\128\004\129\004\130\004\131\004\132\004\133\004\134\004\135\004\136\004\137\004\138\004\139\004\140\004\141\004\142\004\143\004\144\004\145\004\146\004\147\004\148\004\149\004\150\004\151\004\152\004\153\004\154\004\155\004\156\004\157\004\158\004\159\004\160\004\161\004\162\004\163\004\164\004\165\004\166\004\167\004\168\004\169\004\170\004\171\004\172\004\173\004\174\004\175\004\176\004\177\004\178\004\179\004\180\004\181\004\182\004\183\004\184\004\185\004\186\004\187\004\188\004\189\004\190\004\191\004\192\004\193\004\194\004\195\004\196\004\197\004\198\004\199\004\200\004\201\004\202\004\203\004\204\004\205\004\206\004\207\004\208\004\209\004\210\004\211\004\212\004\213\004\214\004\215\004\216\004\217\004\218\004\219\004\220\004\221\004\222\004\223\004\224\004\225\004\226\004\227\004\228\004\229\004\230\004\231\004\232\004\233\004\234\004\235\004\236\004\237\004\238\004\239\004\240\004\241\004\242\004\243\004\244\004\245\004\246\004\247\004\248\004\249\004\250\004\251\004\252\004\253\004\254\004\255\005\000\005\001\005\002\005\003\005\004\005\005\005\006\005\007\005\b\005\t\005\n\005\011\005\012\005\r\005\014\005\015\005\016\005\017\005\018\005\019\005\020\005\021\005\022\005\023\005\024\005\025\005\026\005\027\005\028\005\029\005\030\005\031\005 \005!\005\"\005#\005$\005%\005&\005'\005(\005)\005*\005+\005,\005-\005.\005/\0050\0051\0052\0053\0054\0055\0056\0057\0058\0059\005:\005;\005<\005=\005>\005?\005@\005A\005B\005C\005D\005E\005F\005G\005H\005I\005J\005K\005L\005M\005N\005O\005P\005Q\005R\005S\005T\005U\005V\005W\005X\005Y\005Z\005[\005\\\005]\005^\005_\005`\005a\005b\005c\005d\005e\005f\005g\005h\005i\005j\005k\005l\005m\005n\005o\005p\005q\005r\005s\005t\005u\005v\005w\005x\005y\005z\005{\005|\005}\005~\005\127\005\128\005\129\005\130\005\131\005\132\005\133\005\134\005\135\005\136\005\137\005\138\005\139\005\140\005\141\005\142\005\143\005\144\005\145\005\146\005\147\005\148\005\149\005\150\005\151\005\152\005\153\005\154\005\155\005\156\005\157\005\158\005\159\005\160\005\161\005\162\005\163\005\164\005\165\005\166\005\167\005\168\005\169\005\170\005\171\005\172\005\173\005\174\005\175\005\176\005\177\005\178\005\179\005\180\005\181\005\182\005\183\005\184\005\185\005\186\005\187\005\188\005\189\005\190\005\191\005\192\005\193\005\194\005\195\005\196\005\197\005\198\005\199\005\200\005\201\005\202\005\203\005\204\005\205\005\206\005\207\005\208\005\209\005\210\005\211\005\212\005\213\005\214\005\215\005\216\005\217\005\218\005\219\005\220\005\221\005\222\005\223\005\224\005\225\005\226\005\227\005\228\005\229\005\230\005\231\005\232\005\233\005\234\005\235\005\236\005\237\005\238\005\239\005\240\005\241\005\242\005\243\005\244\005\245\005\246\005\247\005\248\005\249\005\250\005\251\005\252\005\253\005\254\005\255\006\000\006\001\006\002\006\003\006\004\006\005\006\006\006\007\006\b\006\t\006\n\006\011\006\012\006\r\006\014\006\015\006\016\006\017\006\018\006\019\006\020\006\021\006\022\006\023\006\024\006\025\006\026\006\027\006\028\006\029\006\030\006\031\006 \006!\006\"\006#\006$\006%\006&\006'\006(\006)\006*\006+\006,\006-\006.\006/\0060\0061\0062\0063\0064\0065\0066\0067\0068\0069\006:\006;\006<\006=\006>\006?\006@\006A\006B\006C\006D\006E\006F\006G\006H\006I\006J\006K\006L\006M\006N\006O\006P\006Q\006R\006S\006T\006U\006V\006W\006X\006Y\006Z\006[\006\\\006]\006^\006_\006`\006a\006b\006c\006d\006e\006f\006g\006h\006i\006j\006k\006l\006m\006n\006o\006p\006q\006r\006s\006t\006u\006v\006w\006x\006y\006z\006{\006|\006}\006~\006\127\006\128\006\129\006\130\006\131\006\132\006\133\006\134\006\135\006\136\006\137\006\138\006\139\006\140\006\141\006\142\006\143\006\144\006\145\006\146\006\147\006\148\006\149\006\150\006\151\006\152\006\153\006\154\006\155\006\156\006\157\006\158\006\159\006\160\006\161\006\162\006\163\006\164\006\165\006\166\006\167\006\168\006\169\006\170\006\171\006\172\006\173\006\174\006\175\006\176\006\177\006\178\006\179\006\180\006\181\006\182\006\183\006\184\006\185\006\186\006\187\006\188\006\189\006\190\006\191\006\192\006\193\006\194\006\195\006\196\006\197\006\198\006\199\006\200\006\201\006\202\006\203\006\204\006\205\006\206\006\207\006\208\006\209\006\210\006\211\006\212\006\213\006\214\006\215\006\216\006\217\006\218\006\219\006\220\006\221\006\222\006\223\006\224\006\225\006\226\006\227\006\228\006\229\006\230\006\231\006\232\006\233\006\234\006\235\006\236\006\237\006\238\006\239\006\240\006\241\006\242\006\243\006\244\006\245\006\246\006\247\006\248\006\249\006\250\006\251\006\252\006\253\006\254\006\255\007\000\007\001\007\002\007\003\007\004\007\005\007\006\007\007\007\b\007\t\007\n\007\011\007\012\007\r\007\014\007\015\007\016\007\017\007\018\007\019\007\020\007\021\007\022\007\023\007\024\007\025\007\026\007\027\007\028\007\029\007\030\007\031\007 \007!\007\"\007#\007$\007%\007&\007'\007(\007)\007*\007+\007,\007-\007.\007/\0070\0071\0072\0073\0074\0075\0076\0077\0078\0079\007:\007;\007<\007=\007>\007?\007@\007A\007B\007C\007D\007E\007F\007G\007H\007I\007J\007K\007L\007M\007N\007O\007P\007Q\007R\007S\007T\007U\007V\007W\007X\007Y\007Z\007[\007\\\007]\007^\007_\007`\007a\007b\007c\007d\007e\007f\007g\007h\007i\007j\007k\007l\007m\007n\007o\007p\007q\007r\007s\007t\007u\007v\007w\007x\007y\007z\007{\007|\007}\007~\007\127\007\128\007\129\007\130\007\131\007\132\007\133\007\134\007\135\007\136\007\137\007\138\007\139\007\140\007\141\007\142\007\143\007\144\007\145\007\146\007\147\007\148\007\149\007\150\007\151\007\152\007\153\007\154\007\155\007\156\007\157\007\158\007\159\007\160\007\161\007\162\007\163\007\164\007\165\007\166\007\167\007\168\007\169\007\170\007\171\007\172\007\173\007\174\007\175\007\176\007\177\007\178\007\179\007\180\007\181\007\182\007\183\007\184\007\185\007\186\007\187\007\188\007\189\007\190\007\191\007\192\007\193\007\194\007\195\007\196\007\197\007\198\007\199\007\200\007\201\007\202\007\203\007\204\007\205\007\206\007\207\007\208\007\209\007\210\007\211\007\212\007\213\007\214\007\215")
+ (16, "\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b\000\t\000\n\000\011\000\012\000\r\000\014\000\015\000\016\000\017\000\018\000\019\000\020\000\021\000\022\000\023\000\024\000\025\000\026\000\027\000\028\000\029\000\030\000\031\000 \000!\000\"\000#\000$\000%\000&\000'\000(\000)\000*\000+\000,\000-\000.\000/\0000\0001\0002\0003\0004\0005\0006\0007\0008\0009\000:\000;\000<\000=\000>\000?\000@\000A\000B\000C\000D\000E\000F\000G\000H\000I\000J\000K\000L\000M\000N\000O\000P\000Q\000R\000S\000T\000U\000V\000W\000X\000Y\000Z\000[\000\\\000]\000^\000_\000`\000a\000b\000c\000d\000e\000f\000g\000h\000i\000j\000k\000l\000m\000n\000o\000p\000q\000r\000s\000t\000u\000v\000w\000x\000y\000z\000{\000|\000}\000~\000\127\000\128\000\129\000\130\000\131\000\132\000\133\000\134\000\135\000\136\000\137\000\138\000\139\000\140\000\141\000\142\000\143\000\144\000\145\000\146\000\147\000\148\000\149\000\150\000\151\000\152\000\153\000\154\000\155\000\156\000\157\000\158\000\159\000\160\000\161\000\162\000\163\000\164\000\165\000\166\000\167\000\168\000\169\000\170\000\171\000\172\000\173\000\174\000\175\000\176\000\177\000\178\000\179\000\180\000\181\000\182\000\183\000\184\000\185\000\186\000\187\000\188\000\189\000\190\000\191\000\192\000\193\000\194\000\195\000\196\000\197\000\198\000\199\000\200\000\201\000\202\000\203\000\204\000\205\000\206\000\207\000\208\000\209\000\210\000\211\000\212\000\213\000\214\000\215\000\216\000\217\000\218\000\219\000\220\000\221\000\222\000\223\000\224\000\225\000\226\000\227\000\228\000\229\000\230\000\231\000\232\000\233\000\234\000\235\000\236\000\237\000\238\000\239\000\240\000\241\000\242\000\243\000\244\000\245\000\246\000\247\000\248\000\249\000\250\000\251\000\252\000\253\000\254\000\255\001\000\001\001\001\002\001\003\001\004\001\005\001\006\001\007\001\b\001\t\001\n\001\011\001\012\001\r\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\021\001\022\001\023\001\024\001\025\001\026\001\027\001\028\001\029\001\030\001\031\001 \001!\001\"\001#\001$\001%\001&\001'\001(\001)\001*\001+\001,\001-\001.\001/\0010\0011\0012\0013\0014\0015\0016\0017\0018\0019\001:\001;\001<\001=\001>\001?\001@\001A\001B\001C\001D\001E\001F\001G\001H\001I\001J\001K\001L\001M\001N\001O\001P\001Q\001R\001S\001T\001U\001V\001W\001X\001Y\001Z\001[\001\\\001]\001^\001_\001`\001a\001b\001c\001d\001e\001f\001g\001h\001i\001j\001k\001l\001m\001n\001o\001p\001q\001r\001s\001t\001u\001v\001w\001x\001y\001z\001{\001|\001}\001~\001\127\001\128\001\129\001\130\001\131\001\132\001\133\001\134\001\135\001\138\001\139\001\144\001\145\001\146\001\147\001\148\001\149\001\150\001\151\001\152\001\153\001\154\001\155\001\156\001\157\001\136\001\137\001\158\001\159\001\160\001\140\001\141\001\142\001\143\001\161\001\162\001\163\001\164\001\165\001\166\001\167\001\168\001\169\001\170\001\171\001\172\001\173\001\174\001\175\001\176\001\177\001\178\001\179\001\180\001\181\001\182\001\183\001\184\001\185\001\186\001\187\001\188\001\189\001\190\001\191\001\192\001\193\001\194\001\195\001\196\001\197\001\198\001\199\001\200\001\201\001\202\001\203\001\204\001\205\001\206\001\207\001\208\001\209\001\210\001\211\001\212\001\213\001\214\001\215\001\216\001\217\001\218\001\219\001\220\001\221\001\222\001\223\001\224\001\225\001\226\001\227\001\228\001\229\001\230\001\231\001\232\001\233\001\234\001\235\001\236\001\237\001\238\001\239\001\240\001\243\001\244\001\245\001\246\001\247\001\248\001\249\001\250\001\251\001\252\001\241\001\242\001\253\001\254\001\255\002\000\002\001\002\002\002\003\002\004\002\005\002\006\002\007\002\b\002\t\002\n\002\011\002\012\002\r\002\014\002\015\002\016\002\017\002\018\002\019\002\020\002\021\002\022\002\023\002\024\002\025\002\026\002\027\002\028\002\029\002\030\002\031\002 \002!\002\"\002#\002$\002%\002&\002'\002(\002)\002*\002+\002,\002-\002.\002/\002\137\002\138\002\139\002\140\002\141\002\142\002\143\002\144\002\145\002\146\002\147\002\148\002\149\002\150\002\151\002\152\002\153\002\154\002\155\002\156\002\157\0026\0027\0028\0029\002:\002;\002<\002=\002>\002?\002@\002A\002B\002C\002D\002E\002F\002G\002H\002I\002J\002K\002L\002M\002N\002O\002P\002Q\002R\002S\002T\002U\002V\002W\002X\002Y\002Z\002[\002\\\002]\002^\002_\002`\002a\002b\002c\002d\002e\002f\002g\002h\002i\002j\002k\002l\002m\002n\002o\002p\0020\0021\0024\0025\003\137\003\138\003\139\003\140\003\141\002s\002t\002u\002v\002w\002x\002y\002z\002{\002|\002}\002~\002\127\002\128\002\129\002\130\002\131\002\132\002\133\002\134\002\135\002\136\0022\0023\002q\002r\004\015\004\016\002\159\002\160\002\161\002\162\002\163\002\164\002\165\002\166\002\167\002\168\002\169\002\170\002\171\002\172\002\173\002\174\002\175\002\176\002\177\002\178\002\179\002\180\002\181\002\230\002\231\002\232\002\233\002\234\002\235\0034\0035\0036\0037\0038\0039\003:\003;\003<\003=\003>\003?\003@\003A\002\182\002\183\002\184\002\185\002\186\002\187\002\200\002\201\002\202\002\203\002\204\002\205\002\236\002\237\002\238\002\239\002\240\002\241\002\188\002\189\002\190\002\191\002\192\002\193\002\194\002\195\002\196\002\197\002\198\002\199\002\206\002\207\002\208\002\209\002\210\002\211\002\212\002\213\002\214\002\215\002\216\002\217\002\218\002\219\002\220\002\221\002\222\002\223\002\224\002\225\002\226\002\227\002\228\002\229\002\242\002\243\002\244\002\245\002\246\002\247\002\248\002\249\002\250\002\251\002\252\002\253\003\028\003\029\003\030\003\031\003 \003!\002\254\002\255\003\000\003\001\003\002\003\003\003\004\003\005\003\006\003\007\003\b\003\t\003\n\003\011\003\012\003\r\003\014\003\015\003\"\003#\003$\003%\003&\003'\003(\003)\003*\003+\003,\003-\003.\003/\0030\0031\0032\0033\003\016\003\017\003\018\003\019\003\020\003\021\003\022\003\023\003\024\003\025\003\026\003\027\003B\003C\003D\003E\003F\003G\003H\003I\003J\003K\003L\003M\003N\003O\003P\003Q\003R\003S\003T\003U\003V\003W\003X\003Y\003Z\003[\003\\\003]\003^\003_\003`\003a\003b\003c\003d\003e\003f\003g\003h\003i\003j\003k\003l\003m\003n\003o\003p\003q\003r\003s\003t\003u\003v\003w\003x\003y\003z\003{\004\017\004\018\004\019\004\020\004\021\004\022\004\023\004\024\004\025\004\026\004\027\003\143\003\144\003\145\004\028\004\029\004\030\004\031\004 \004!\004\"\003\172\003\173\003\174\003\175\003\176\003\177\003\178\003\179\003\180\003\181\003\182\003\183\003\184\003\185\003\186\003\187\003\188\003\189\003\190\003\191\003\192\003\193\003\194\003\195\003\196\003\197\003\198\003\199\003\200\003\201\003\202\003\203\003\204\003\205\003\206\003\207\003\208\003\209\003\210\003\211\003\212\003\213\003\214\003\215\003\216\003\217\003\218\003\219\003\220\003\221\003\222\003\223\003\224\003\225\003\226\003\227\003\228\003\229\003\230\003\231\003\232\003\233\003\234\003\235\003\236\003\237\003\238\003\239\003\240\003\241\003\242\003\243\003\244\003\245\003\246\003\247\003\248\003\249\003\250\003\251\003\252\003\253\003\254\003\255\004\000\004\001\004\002\004\003\004\004\004\005\004\006\004\007\004\b\004\t\004\n\004\011\004\012\004\r\004\014\003\142\004H\004I\004J\004K\004L\004M\004N\004O\004#\004$\004%\004&\004'\004(\004)\004*\004+\004,\004-\004.\004/\0040\0041\0042\0043\0044\0045\0046\0047\0048\0049\004:\004;\004<\004=\004>\004?\004@\004A\004B\004C\004D\004E\004F\004G\002\158\003|\003}\003~\003\127\003\128\003\129\003\130\003\131\003\132\003\133\003\134\003\135\003\136\003\146\003\147\003\148\003\149\003\150\003\151\003\152\003\153\003\154\003\155\003\156\003\157\003\158\003\159\003\160\003\161\003\162\003\163\003\164\003\165\003\166\003\167\003\168\003\169\003\170\003\171\004P\004Q\004R\004S\004T\004U\004V\004W\004X\004Y\004Z\004[\004\\\004]\004^\004_\004`\004a\004b\004c\004d\004e\004f\004g\004h\004i\004j\004k\004l\004m\004n\004o\004p\004q\004r\004s\004t\004u\004v\004w\004x\004y\004z\004{\004|\004}\004~\004\127\004\128\004\129\004\130\004\131\004\132\004\133\004\134\004\135\004\136\004\137\004\138\004\139\004\140\004\141\004\142\004\143\004\144\004\145\004\146\004\147\004\148\004\149\004\150\004\151\004\152\004\153\004\154\004\155\004\156\004\157\004\158\004\159\004\160\004\161\004\162\004\163\004\164\004\165\004\166\004\167\004\168\004\169\004\170\004\171\004\172\004\173\004\174\004\175\004\176\004\177\004\178\004\179\004\180\004\181\004\182\004\183\004\184\004\185\004\186\004\187\004\188\004\189\004\190\004\191\004\192\004\193\004\194\004\195\004\196\004\197\004\198\004\199\004\200\004\201\004\202\004\203\004\204\004\205\004\206\004\207\004\208\004\209\004\210\004\211\004\212\004\213\004\214\004\215\004\216\004\217\004\218\004\219\004\220\004\221\004\222\004\223\004\224\004\225\004\226\004\227\004\228\004\229\004\230\004\231\004\232\004\233\004\234\004\235\004\236\004\237\004\238\004\239\004\240\004\241\004\242\004\243\004\244\004\245\004\246\004\247\004\248\004\249\004\250\004\251\004\252\004\253\004\254\004\255\005\000\005\001\005\002\005\003\005\004\005\005\005\006\005\007\005\b\005\t\005\n\005\011\005\012\005\r\005\014\005\015\005\016\005\017\005\018\005\019\005\020\005\021\005\022\005\023\005\024\005\025\005\026\005\027\005\028\005\029\005\030\005\031\005 \005!\005\"\005#\005$\005%\005&\005'\005(\005)\005*\005+\005,\005-\005.\005/\0050\0051\0052\0053\0054\0055\0056\0057\0058\0059\005:\005;\005<\005=\005>\005?\005@\005A\005B\005C\005D\005E\005F\005G\005H\005I\005J\005K\005L\005M\005N\005O\005P\005Q\005R\005S\005T\005U\005V\005W\005X\005Y\005Z\005[\005\\\005]\005^\005_\005`\005a\005b\005c\005d\005e\005f\005g\005h\005i\005j\005k\005l\005m\005n\005o\005p\005q\005r\005s\005t\005u\005v\005w\005x\005y\005z\005{\005|\005}\005~\005\127\005\128\005\129\005\130\005\131\005\132\005\133\005\134\005\135\005\136\005\137\005\138\005\139\005\140\005\141\005\142\005\143\005\144\005\145\005\146\005\147\005\148\005\149\005\150\005\151\005\152\005\153\005\154\005\155\005\156\005\157\005\158\005\159\005\160\005\161\005\162\005\163\005\164\005\165\005\166\005\167\005\168\005\169\005\170\005\171\005\172\005\173\005\174\005\175\005\176\005\177\005\178\005\179\005\180\005\181\005\182\005\183\005\184\005\185\005\186\005\187\005\188\005\189\005\190\005\191\005\192\005\193\005\194\005\195\005\196\005\197\005\198\005\199\005\200\005\201\005\202\005\203\005\204\005\205\005\206\005\207\005\208\005\209\005\210\005\211\005\212\005\213\005\214\005\215\005\216\005\217\005\218\005\219\005\220\005\221\005\222\005\223\005\224\005\225\005\226\005\227\005\228\005\229\005\230\005\231\005\232\005\233\005\234\005\235\005\236\005\237\005\238\005\239\005\240\005\241\005\242\005\243\005\244\005\245\005\246\005\247\005\248\005\249\005\250\005\251\005\252\005\253\005\254\005\255\006\000\006\001\006\002\006\003\006\004\006\005\006\006\006\007\006\b\006\t\006\n\006\011\006\012\006\r\006\014\006\015\006\016\006\017\006\018\006\019\006\020\006\021\006\022\006\023\006\024\006\025\006\026\006\027\006\028\006\029\006\030\006\031\006 \006!\006\"\006#\006$\006%\006&\006'\006(\006)\006*\006+\006,\006-\006.\006/\0060\0061\0062\0063\0064\0065\0066\0067\0068\0069\006:\006;\006<\006=\006>\006?\006@\006A\006B\006C\006D\006E\006F\006G\006H\006I\006J\006K\006L\006M\006N\006O\006P\006Q\006R\006S\006T\006U\006V\006W\006X\006Y\006Z\006[\006\\\006]\006^\006_\006`\006a\006b\006c\006d\006e\006f\006g\006h\006i\006j\006k\006l\006m\006n\006o\006p\006q\006r\006s\006t\006u\006v\006w\006x\006y\006z\006{\006|\006}\006~\006\127\006\128\006\129\006\130\006\131\006\132\006\133\006\134\006\135\006\136\006\137\006\138\006\139\006\140\006\141\006\142\006\143\006\144\006\145\006\146\006\147\006\148\006\149\006\150\006\151\006\152\006\153\006\154\006\155\006\156\006\157\006\158\006\159\006\160\006\161\006\162\006\163\006\164\006\165\006\166\006\167\006\168\006\169\006\170\006\171\006\172\006\173\006\174\006\175\006\176\006\177\006\178\006\179\006\180\006\181\006\182\006\183\006\184\006\185\006\186\006\187\006\188\006\189\006\190\006\191\006\192\006\193\006\194\006\195\006\196\006\197\006\198\006\199\006\200\006\201\006\202\006\203\006\204\006\205\006\206\006\207\006\208\006\209\006\210\006\211\006\212\006\213\006\214\006\215\006\216\006\217\006\218\006\219\006\220\006\221\006\222\006\223\006\224\006\225\006\226\006\227\006\228\006\229\006\230\006\231\006\232\006\233\006\234\006\235\006\236\006\237\006\238\006\239\006\240\006\241\006\242\006\243\006\244\006\245\006\246\006\247\006\248\006\249\006\250\006\251\006\252\006\253\006\254\006\255\007\000\007\001\007\002\007\003\007\004\007\005\007\006\007\007\007\b\007\t\007\n\007\011\007\012\007\r\007\014\007\015\007\016\007\017\007\018\007\019\007\020\007\021\007\022\007\023\007\024\007\025\007\026\007\027\007\028\007\029\007\030\007\031\007 \007!\007\"\007#\007$\007%\007&\007'\007(\007)\007*\007+\007,\007-\007.\007/\0070\0071\0072\0073\0074\0075\0076\0077\0078\0079\007:\007;\007<\007=\007>\007?\007@\007A\007B\007C\007D\007E\007F\007G\007H\007I\007J\007K\007L\007M\007N\007O\007P\007Q\007R\007S\007T\007U\007V\007W\007X\007Y\007Z\007[\007\\\007]\007^\007_\007`\007a\007b\007c\007d\007e\007f\007g\007h\007i\007j\007k\007l\007m\007n\007o\007p\007q\007r\007s\007t\007u\007v\007w\007x\007y\007z\007{\007|\007}\007~\007\127\007\128\007\129\007\130\007\131\007\132\007\133\007\134\007\135\007\136\007\137\007\138\007\139\007\140\007\141\007\142\007\143\007\144\007\145\007\146\007\147\007\148\007\149\007\150\007\151\007\152\007\153\007\154\007\155\007\156\007\157\007\158\007\159\007\160\007\161\007\162\007\163\007\164\007\165\007\166\007\167\007\168\007\169\007\170\007\171\007\172\007\173\007\174\007\175\007\176\007\177\007\178\007\179\007\180\007\181\007\182\007\183\007\184\007\185\007\186\007\187\007\188\007\189\007\190\007\191\007\192\007\193\007\194\007\195\007\196\007\197\007\198\007\199\007\200\007\201\007\202\007\203\007\204\007\205\007\206\007\207\007\208\007\209\007\210\007\211\007\212\007\213\007\214\007\215")
and lr0_items =
- ((32, "\000\000\000\000\000\002X\001\000\001\244\001\000\0124\001\000\0120\001\000\012,\001\000\012(\001\000\012$\001\000\011p\001\000\012 \001\000\012\028\001\000\012\024\001\000\012\020\001\000\012\016\001\000\012\012\001\000\012\b\001\000\012\004\001\000\012\000\001\000\011\252\001\000\011\248\001\000\011\244\001\000\011\240\001\000\011\236\001\000\011\232\001\000\011\228\001\000\011\224\001\000\011\220\001\000\011\216\001\000\011l\001\000\011\212\001\000\011\208\001\000\011\204\001\000\011\200\001\000\011\196\001\000\011\192\001\000\011\188\001\000\011\184\001\000\011\180\001\000\011\176\001\000\011\172\001\000\011\168\001\000\011\164\001\000\011\160\001\000\011\156\001\000\011\152\001\000\011\148\001\000\011\144\001\000\011\140\001\000\011\136\001\000\011\132\001\000\011\128\001\000\011|\001\000\011x\001\000\011t\001\000\000\132\001\000\000\128\001\000\000\132\002\000\000\132\003\000\001\244\002\000\002X\002\000\000\140\001\000\000\140\002\000\rX\001\000\rX\002\000\rX\003\000\r4\001\000\007L\001\000\006\248\001\000\007@\001\000\007<\001\000\0078\001\000\007P\001\000\007`\001\000\007H\001\000\007D\001\000\006\252\001\000\007X\001\000\0074\001\000\0070\001\000\007,\001\000\007(\001\000\007$\001\000\007\028\001\000\007\\\001\000\007T\001\000\007\024\001\000\007\020\001\000\007\016\001\000\007\012\001\000\007\b\001\000\007\004\001\000\007\b\002\000\007\004\002\000\004\012\001\000\004\012\002\000\007\b\003\000\007\004\003\000\007\b\004\000\007\004\004\000\007\b\005\000\007\016\002\000\007\012\002\000\007\016\003\000\007\012\003\000\007\016\004\000\007\012\004\000\007\016\005\000\007\024\002\000\007\020\002\000\007\024\003\000\007\020\003\000\007\024\004\000\007\020\004\000\007\024\005\000\007p\001\000\007d\001\000\007 \001\000\007\000\001\000\007h\001\000\007l\001\000\r4\002\000\r4\003\000\r8\001\000\rX\004\000\rX\005\000\000|\001\000\005\180\001\000\001\252\001\000\t<\001\000\000x\001\000\003\252\001\000\004\000\001\000\t<\002\000\000x\002\000\007\212\001\000\007\212\002\000\007\212\003\000\007\208\001\000\001\200\001\000\001\196\001\000\000p\001\000\000d\001\000\000x\001\000\000x\002\000\001\200\002\000\001\200\003\000\001\200\004\000\005\180\001\000\003\252\001\000\006D\001\000\006D\002\000\n\024\001\000\n\020\001\000\003\248\001\000\003\244\001\000\003\240\001\000\003\236\001\000\n\024\002\000\n\020\002\000\003\248\002\000\003\244\002\000\003\240\002\000\003\236\002\000\n\024\003\000\n\020\003\000\003\248\003\000\003\244\003\000\003\240\003\000\003\236\003\000\r(\001\000\r\020\001\000\r\b\001\000\r\020\002\000\n\024\004\000\003\248\004\000\003\240\004\000\r\028\001\000\r\012\001\000\r\028\002\000\012\248\001\000\r$\001\000\r \001\000\r\024\001\000\r\016\001\000\r\024\002\000\r \002\000\012\236\001\000\r\000\001\000\012\252\001\000\012\252\002\000\012\236\002\000\tp\001\000\012\248\002\000\tt\001\000\012\248\003\000\tt\002\000\tt\003\000\n\024\005\000\003\248\005\000\003\240\005\000\005\172\001\000\003\248\006\000\003\240\006\000\012\228\001\000\005\180\001\000\001|\001\000\001x\001\000\006\212\001\000\006\196\001\000\006\180\001\000\006\172\001\000\001\200\001\000\001\196\001\000\001\128\001\000\001p\001\000\000p\001\000\000d\001\000\001p\002\000\005\172\001\000\003\184\001\000\003\184\002\000\005\172\001\000\006\228\001\000\006\224\001\000\005\172\001\000\005\132\001\000\005|\001\000\005t\001\000\005\132\002\000\005|\002\000\005t\002\000\001\248\001\000\001\248\002\000\n\244\001\000\005\228\001\000\012l\001\000\012h\001\000\003\248\001\000\003\244\001\000\012l\002\000\012h\002\000\003\248\002\000\003\244\002\000\012l\003\000\012h\003\000\003\248\003\000\003\244\003\000\012l\004\000\003\248\004\000\012l\005\000\003\248\005\000\005\172\001\000\003\248\006\000\003\248\007\000\t\024\001\000\003\248\b\000\b\176\001\000\b\176\002\000\002<\001\000\002<\002\000\002<\003\000\001d\001\000\n\204\001\000\n\184\001\000\n\184\002\000\n\184\003\000\000\236\001\000\000\232\001\000\011<\001\000\nX\001\000\nT\001\000\nT\002\000\nX\002\000\nP\001\000\nL\001\000\nL\002\000\nP\002\000\r4\001\000\011d\001\000\0118\001\000\0114\001\000\011,\001\000\001\144\001\000\001p\001\000\nX\001\000\nT\001\000\0078\001\000\0118\002\000\0114\002\000\0118\003\000\0114\003\000\0118\004\000\0114\004\000\006<\001\000\0068\001\000\0118\005\000\0114\005\000\0114\006\000\0118\006\000\006L\001\000\006L\002\000\006L\003\000\006L\004\000\0064\001\000\006\020\001\000\006\020\002\000\005$\001\000\005 \001\000\004\024\001\000\000@\001\000\000<\001\000\006\236\001\000\006\232\001\000\006\236\002\000\006\236\003\000\006\236\004\000\007\252\001\000\007\248\001\000\007\244\001\000\007\240\001\000\007\236\001\000\007\232\001\000\007\228\001\000\007\224\001\000\007\220\001\000\007\216\001\000\007\252\002\000\007\248\002\000\007\244\002\000\007\240\002\000\007\236\002\000\007\232\002\000\007\228\002\000\007\224\002\000\007\252\003\000\007\248\003\000\007\244\003\000\007\240\003\000\007\236\003\000\007\232\003\000\007\228\003\000\007\224\003\000\n\172\001\000\n\172\002\000\n\172\003\000\005\220\001\000\005\232\001\000\005\224\001\000\005\232\002\000\005\224\002\000\005\232\003\000\005\224\003\000\005\252\001\000\000\228\001\000\n\172\004\000\004\244\001\000\004\244\002\000\012\148\001\000\012\144\001\000\0028\001\000\0028\002\000\0028\003\000\r4\001\000\n\180\001\000\n\176\001\000\n|\001\000\nx\001\000\001\144\001\000\001p\001\000\n\204\001\000\006\248\001\000\011\b\001\000\011\004\001\000\r8\001\000\003<\001\000\0038\001\000\003<\002\000\0038\002\000\003,\001\000\nh\001\000\nd\001\000\n`\001\000\001l\001\000\001l\002\000\n\\\001\000\0048\001\000\n\\\002\000\n\\\003\000\005d\001\000\005`\001\000\005\\\001\000\005X\001\000\007\160\001\000\001\228\001\000\001\224\001\000\007\128\001\000\001\228\002\000\001\224\002\000\001\220\001\000\001\216\001\000\001\220\002\000\001\216\002\000\001\212\001\000\001\208\001\000\001\204\001\000\000h\001\000\005\248\001\000\005\184\001\000\005\176\001\000\005\248\002\000\005\248\003\000\005\248\001\000\005\184\001\000\005\248\004\000\005\184\002\000\005\184\003\000\005\244\001\000\005\184\002\000\005\176\002\000\005\176\003\000\001X\001\000\000h\002\000\001\208\002\000\006\148\001\000\006\148\002\000\000\\\001\000\003\188\001\000\003\176\001\000\003\188\002\000\012\208\001\000\t\160\001\000\t\160\002\000\001\184\001\000\005\248\001\000\005\184\001\000\005\176\001\000\000t\001\000\005\184\002\000\005\176\002\000\000t\002\000\001\200\001\000\001\196\001\000\003\180\001\000\003\180\002\000\003\180\003\000\012\232\001\000\003\180\004\000\001\188\001\000\002\b\001\000\001\192\001\000\000X\001\000\012\204\001\000\t\164\001\000\000l\001\000\000`\001\000\t\164\002\000\t\164\003\000\000l\001\000\000`\001\000\000l\002\000\000l\003\000\000`\002\000\000D\001\000\001\196\002\000\001\180\001\000\001\196\003\000\001\180\002\000\001\176\001\000\000H\001\000\000H\002\000\000H\003\000\000H\004\000\000t\003\000\t\160\003\000\000l\001\000\000`\001\000\003\188\003\000\t\168\001\000\t`\001\000\td\001\000\001\208\003\000\001\208\004\000\td\002\000\td\003\000\012\156\001\000\012\152\001\000\012\152\002\000\007t\001\000\012\152\003\000\012\152\004\000\tT\001\000\tT\002\000\tT\003\000\000H\001\000\012\152\005\000\tP\001\000\000H\001\000\012\156\002\000\t\172\001\000\001\180\001\000\t\168\001\000\001\204\002\000\001\204\003\000\001\212\002\000\001\212\003\000\td\001\000\001\212\004\000\001\212\005\000\td\001\000\001\216\003\000\001\216\004\000\td\001\000\001\228\003\000\001\224\003\000\001\224\004\000\001\228\004\000\t8\001\000\001\228\005\000\001\228\006\000\t8\002\000\t4\001\000\007\160\002\000\001\180\001\000\005d\002\000\005`\002\000\005\\\002\000\005X\002\000\007\188\001\000\bh\001\000\bh\002\000\bh\003\000\001\\\001\000\011P\001\000\011P\002\000\001h\001\000\001t\001\000\001`\001\000\011$\001\000\r<\001\000\011(\001\000\bh\004\000\0110\001\000\011D\001\000\011@\001\000\011D\002\000\011D\003\000\nH\001\000\011L\001\000\011`\001\000\011\\\001\000\011X\001\000\011T\001\000\005\232\001\000\001\140\001\000\001\136\001\000\011`\002\000\011\\\002\000\011X\002\000\011T\002\000\005\232\002\000\001\140\002\000\011`\003\000\011\\\003\000\001\140\003\000\011\\\004\000\bD\001\000\bD\002\000\bD\003\000\bX\001\000\b4\001\000\bH\001\000\b<\001\000\bH\002\000\bL\001\000\bH\003\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bL\002\000\bL\003\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b,\002\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\003\000\b,\001\000\b@\002\000\bL\001\000\b@\003\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b8\002\000\b8\003\000\b0\002\000\011L\001\000\bd\001\000\bd\002\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\011h\001\000\011H\001\000\b`\001\000\b\\\001\000\r4\001\000\011d\001\000\0118\001\000\0114\001\000\011,\001\000\b`\002\000\001\144\001\000\001p\001\000\b`\003\000\006\156\001\000\006\152\001\000\006\156\002\000\b`\004\000\b`\005\000\b`\006\000\011H\001\000\001\148\001\000\nP\001\000\nL\001\000\007D\001\000\001\144\002\000\001\144\003\000\011d\002\000\011,\002\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\011,\003\000\011d\003\000\011d\004\000\001\180\001\000\011d\005\000\b\\\002\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bL\001\000\bD\004\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\001\140\004\000\001\140\005\000\011`\004\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\011`\005\000\011X\003\000\n`\001\000\011X\004\000\n`\002\000\n`\003\000\t\220\001\000\t\216\001\000\t\212\001\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\t\220\002\000\t\216\002\000\t\220\003\000\011T\003\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\007\188\002\000\005d\003\000\005`\003\000\005\\\003\000\005X\003\000\005d\004\000\005`\004\000\005\\\004\000\005`\005\000\007\136\001\000\005`\006\000\005d\005\000\nh\002\000\nd\002\000\nd\003\000\011$\001\000\004\180\001\000\004\176\001\000\004h\001\000\004d\001\000\004d\002\000\0044\001\000\0040\001\000\0044\002\000\0044\003\000\001\180\001\000\004d\003\000\004d\004\000\004h\002\000\004X\001\000\004T\001\000\004T\002\000\004T\003\000\007\196\001\000\004\148\001\000\0020\001\000\002,\001\000\002(\001\000\002$\001\000\0020\002\000\002,\002\000\0020\003\000\0020\004\000\0020\005\000\006\024\001\000\006\024\002\000\003\196\001\000\003\192\001\000\003\192\002\000\003\196\002\000\003\196\003\000\006\\\001\000\006P\001\000\006\\\002\000\006\\\003\000\006H\001\000\006H\002\000\t(\001\000\003\200\001\000\t(\002\000\006H\003\000\006H\004\000\006X\001\000\006d\001\000\006`\001\000\006T\001\000\006H\005\000\006d\002\000\r\128\001\000\r|\001\000\r\128\002\000\r|\002\000\r\128\003\000\r|\003\000\r\152\001\000\r\148\001\000\r\152\002\000\r\128\004\000\r\128\005\000\000H\001\000\r|\004\000\r|\005\000\000H\001\000\r|\006\000\t\024\001\000\t\024\002\000\t\024\003\000\001\180\001\000\t\024\004\000\t\024\005\000\001\180\001\000\012\244\001\000\r\144\001\000\r\140\001\000\r\136\001\000\r\132\001\000\r\144\002\000\r\140\002\000\r\144\003\000\r\140\003\000\r\140\004\000\r\140\005\000\006d\001\000\006`\001\000\006T\001\000\006`\002\000\006d\001\000\006`\003\000\006`\001\000\006T\001\000\006T\002\000\005\248\001\000\005\216\001\000\005\184\001\000\005\216\002\000\005\184\002\000\005\184\003\000\003\252\001\000\005\216\003\000\006t\001\000\005\212\001\000\006h\001\000\r\144\004\000\r\144\005\000\006d\001\000\006`\001\000\006T\001\000\r\136\002\000\r\132\002\000\005\232\001\000\r\132\003\000\r\132\004\000\005\248\001\000\005\184\001\000\005\232\002\000\r\136\003\000\r\136\004\000\005\248\001\000\005\184\001\000\tX\001\000\t\\\001\000\006d\003\000\t\\\002\000\t\\\003\000\t$\001\000\006d\001\000\006`\001\000\006\\\004\000\006T\001\000\006d\001\000\006`\001\000\006T\001\000\006P\002\000\006P\003\000\006d\001\000\006`\001\000\006T\001\000\003\196\004\000\003\196\005\000\006\024\003\000\006\024\004\000\006\028\001\000\006,\001\000\006(\001\000\006 \001\000\006\024\005\000\007\252\001\000\007\248\001\000\007\244\001\000\007\240\001\000\007\236\001\000\007\232\001\000\007\228\001\000\007\224\001\000\007\220\001\000\007\216\001\000\006,\002\000\006,\003\000\007\220\002\000\007\216\002\000\006,\001\000\006(\001\000\006 \001\000\007\220\003\000\007\216\003\000\007\216\004\000\006d\001\000\006`\001\000\006T\001\000\007\216\005\000\006(\002\000\006 \002\000\006$\001\000\005\232\001\000\0060\001\000\006,\001\000\006(\001\000\006 \001\000\0020\006\000\0020\007\000\011\020\001\000\001l\001\000\n\216\001\000\n\212\001\000\t\208\001\000\t\204\001\000\t\200\001\000\007\172\001\000\007\168\001\000\n\252\001\000\r8\001\000\005\220\001\000\nt\001\000\np\001\000\nl\001\000\002d\001\000\002d\002\000\002d\003\000\n\168\001\000\n\164\001\000\n\168\002\000\n\164\002\000\n\168\003\000\n\164\003\000\002T\001\000\002P\001\000\002L\001\000\002H\001\000\002D\001\000\002@\001\000\002T\002\000\002P\002\000\002L\002\000\002H\002\000\002D\002\000\002@\002\000\002T\003\000\002P\003\000\002L\003\000\002H\003\000\002D\003\000\002@\003\000\t\240\001\000\t\156\001\000\t\152\001\000\t\240\002\000\t\156\002\000\t\152\002\000\t\240\003\000\t\156\003\000\t\152\003\000\tH\001\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\005p\001\000\005l\001\000\005h\001\000\005l\002\000\0024\001\000\0024\002\000\0024\003\000\004`\001\000\004\\\001\000\b\136\001\000\004\\\002\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\004\172\001\000\004\168\001\000\004\172\002\000\004\172\003\000\001\180\001\000\004\\\003\000\004\\\004\000\004\\\005\000\b\132\001\000\004`\002\000\r4\001\000\011d\001\000\0118\001\000\0114\001\000\011,\001\000\003\148\001\000\001\144\001\000\001p\001\000\003\148\002\000\003\148\003\000\003\148\004\000\004l\001\000\004l\002\000\004p\001\000\t \001\000\003\156\001\000\003\152\001\000\t \002\000\0024\004\000\007\152\001\000\007\152\002\000\000l\001\000\000`\001\000\0024\005\000\0024\006\000\t\156\001\000\t\152\001\000\002\024\001\000\t\156\002\000\t\152\002\000\002\024\002\000\t\156\003\000\t\152\003\000\002\024\003\000\t\156\004\000\t\152\004\000\tL\001\000\002\024\004\000\t\156\005\000\t\152\005\000\t\156\006\000\t\156\001\000\t\152\001\000\t\156\007\000\t\156\002\000\t\152\002\000\t\156\b\000\t\156\003\000\t\152\003\000\t\156\t\000\t\156\004\000\t\152\004\000\tL\001\000\tL\002\000\tL\003\000\tD\001\000\002\\\001\000\002\\\002\000\002\\\003\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\002\\\004\000\002\\\005\000\n\208\001\000\n\188\001\000\005\236\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\208\002\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n\236\002\000\n\236\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n\232\002\000\n\232\003\000\n\156\002\000\n\148\002\000\n\140\002\000\n\140\003\000\t\196\001\000\t\188\001\000\t\184\001\000\t\156\001\000\t\152\001\000\t\196\002\000\t\188\002\000\t\184\002\000\t\156\002\000\t\152\002\000\t\196\003\000\t\188\003\000\t\184\003\000\t\156\003\000\t\152\003\000\t\196\004\000\t\188\004\000\t\184\004\000\t\156\004\000\t\152\004\000\tL\001\000\t\196\005\000\t\188\005\000\002`\001\000\002`\002\000\002`\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\002`\004\000\n\220\002\000\n\160\002\000\n\152\002\000\n\144\002\000\n\136\002\000\n\132\002\000\n\128\002\000\n\128\003\000\003\028\001\000\003\024\001\000\t\156\001\000\t\152\001\000\003\028\002\000\t\156\002\000\t\152\002\000\003\028\003\000\t\156\003\000\t\152\003\000\003\028\004\000\t\156\004\000\t\152\004\000\tL\001\000\003\028\005\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\003\140\001\000\003\136\001\000\003\132\001\000\003\128\001\000\003|\001\000\003x\001\000\003t\001\000\003p\001\000\003l\001\000\003h\001\000\003d\001\000\003`\001\000\003\\\001\000\003X\001\000\003T\001\000\003P\001\000\003L\001\000\003H\001\000\003D\001\000\003@\001\000\002h\001\000\002 \001\000\004H\001\000\004D\001\000\004H\002\000\004H\003\000\012\220\001\000\012\220\002\000\001\180\001\000\012\216\001\000\012\212\001\000\012\216\002\000\012\212\002\000\001\180\001\000\012\216\003\000\012\216\004\000\001\180\001\000\004H\004\000\004H\005\000\004D\002\000\004L\001\000\004L\002\000\004P\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\004P\002\000\n\200\001\000\011 \001\000\011\028\001\000\011\024\001\000\011\016\001\000\011\012\001\000\011\000\001\000\n\248\001\000\n\228\001\000\n\224\001\000\005\240\001\000\005\232\001\000\001\140\001\000\001\136\001\000\011 \002\000\011\028\002\000\011\024\002\000\011\016\002\000\011\012\002\000\011\000\002\000\n\248\002\000\n\228\002\000\n\224\002\000\005\240\002\000\005\232\002\000\001\140\002\000\r4\001\000\011 \003\000\n\248\003\000\n\224\003\000\001\140\003\000\n\248\004\000\007<\001\000\000@\001\000\0078\001\000\000<\001\000\011 \004\000\011 \005\000\011 \006\000\011 \007\000\006,\001\000\006(\001\000\006 \001\000\011 \b\000\011 \t\000\006d\001\000\006`\001\000\006T\001\000\011 \n\000\012\148\001\000\007H\001\000\012\144\001\000\007D\001\000\006\252\001\000\003,\001\000\bX\001\000\004\184\001\000\004\184\002\000\004\184\003\000\001\180\001\000\004\184\004\000\004\184\005\000\t\140\001\000\t\136\001\000\002l\001\000\t\140\002\000\t\136\002\000\t\156\001\000\t\152\001\000\t\140\003\000\t\156\002\000\t\152\002\000\t\140\004\000\t\156\003\000\t\152\003\000\t\140\005\000\t\156\004\000\t\152\004\000\t\140\006\000\tL\001\000\n\200\001\000\002t\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\002t\002\000\r@\001\000\n\240\001\000\n\196\001\000\n\192\001\000\004\152\001\000\003(\001\000\003(\002\000\003(\003\000\t\236\001\000\t\148\001\000\t\144\001\000\003\172\001\000\003\168\001\000\003\164\001\000\003\160\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\204\002\000\002\200\002\000\t\156\001\000\t\152\001\000\002\204\003\000\t\156\002\000\t\152\002\000\002\204\004\000\t\156\003\000\t\152\003\000\002\204\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\204\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\003\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\180\002\000\002\176\002\000\t\156\001\000\t\152\001\000\002\180\003\000\t\156\002\000\t\152\002\000\002\180\004\000\t\156\003\000\t\152\003\000\002\180\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\180\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\003\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\172\002\000\002\168\002\000\t\156\001\000\t\152\001\000\002\172\003\000\t\156\002\000\t\152\002\000\002\172\004\000\t\156\003\000\t\152\003\000\002\172\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\172\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\003\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\164\002\000\002\160\002\000\t\156\001\000\t\152\001\000\002\164\003\000\t\156\002\000\t\152\002\000\002\164\004\000\t\156\003\000\t\152\003\000\002\164\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\164\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\003\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\212\002\000\002\208\002\000\t\156\001\000\t\152\001\000\002\212\003\000\t\156\002\000\t\152\002\000\002\212\004\000\t\156\003\000\t\152\003\000\002\212\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\212\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\003\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\244\002\000\002\240\002\000\t\156\001\000\t\152\001\000\002\244\003\000\t\156\002\000\t\152\002\000\002\244\004\000\t\156\003\000\t\152\003\000\002\244\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\244\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\003\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\196\002\000\002\192\002\000\t\156\001\000\t\152\001\000\002\196\003\000\t\156\002\000\t\152\002\000\002\196\004\000\t\156\003\000\t\152\003\000\002\196\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\196\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\003\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\188\002\000\002\184\002\000\t\156\001\000\t\152\001\000\002\188\003\000\t\156\002\000\t\152\002\000\002\188\004\000\t\156\003\000\t\152\003\000\002\188\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\188\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\003\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\228\002\000\002\224\002\000\t\156\001\000\t\152\001\000\002\228\003\000\t\156\002\000\t\152\002\000\002\228\004\000\t\156\003\000\t\152\003\000\002\228\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\228\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\003\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\156\002\000\002\152\002\000\t\156\001\000\t\152\001\000\002\156\003\000\t\156\002\000\t\152\002\000\002\156\004\000\t\156\003\000\t\152\003\000\002\156\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\156\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\003\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\148\002\000\002\144\002\000\t\156\001\000\t\152\001\000\002\148\003\000\t\156\002\000\t\152\002\000\002\148\004\000\t\156\003\000\t\152\003\000\002\148\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\148\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\003\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\140\002\000\002\136\002\000\t\156\001\000\t\152\001\000\002\140\003\000\t\156\002\000\t\152\002\000\002\140\004\000\t\156\003\000\t\152\003\000\002\140\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\140\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\003\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\132\002\000\002\128\002\000\t\156\001\000\t\152\001\000\002\132\003\000\t\156\002\000\t\152\002\000\002\132\004\000\t\156\003\000\t\152\003\000\002\132\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\132\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\003\000\002\128\001\000\002|\001\000\002x\001\000\002|\002\000\002x\002\000\t\156\001\000\t\152\001\000\002|\003\000\t\156\002\000\t\152\002\000\002|\004\000\t\156\003\000\t\152\003\000\002|\005\000\t\156\004\000\t\152\004\000\tL\001\000\002|\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\003\000\002x\001\000\002\236\002\000\002\232\002\000\t\156\001\000\t\152\001\000\002\236\003\000\t\156\002\000\t\152\002\000\002\236\004\000\t\156\003\000\t\152\003\000\002\236\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\236\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\003\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\220\002\000\002\216\002\000\t\156\001\000\t\152\001\000\002\220\003\000\t\156\002\000\t\152\002\000\002\220\004\000\t\156\003\000\t\152\003\000\002\220\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\220\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\003\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\t\148\002\000\t\144\002\000\t\156\001\000\t\152\001\000\t\148\003\000\t\156\002\000\t\152\002\000\t\148\004\000\t\156\003\000\t\152\003\000\t\148\005\000\t\156\004\000\t\152\004\000\t\148\006\000\tL\001\000\t\148\001\000\t\144\003\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\020\002\000\003\016\002\000\t\156\001\000\t\152\001\000\003\020\003\000\t\156\002\000\t\152\002\000\003\020\004\000\t\156\003\000\t\152\003\000\003\020\005\000\t\156\004\000\t\152\004\000\tL\001\000\003\020\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\003\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\0034\002\000\0030\002\000\t\156\001\000\t\152\001\000\0034\003\000\t\156\002\000\t\152\002\000\0034\004\000\t\156\003\000\t\152\003\000\0034\005\000\t\156\004\000\t\152\004\000\tL\001\000\0034\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\003\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\252\002\000\002\248\002\000\t\156\001\000\t\152\001\000\002\252\003\000\t\156\002\000\t\152\002\000\002\252\004\000\t\156\003\000\t\152\003\000\002\252\005\000\t\156\004\000\t\152\004\000\tL\001\000\002\252\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\003\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\004\002\000\003\000\002\000\t\156\001\000\t\152\001\000\003\004\003\000\t\156\002\000\t\152\002\000\003\004\004\000\t\156\003\000\t\152\003\000\003\004\005\000\t\156\004\000\t\152\004\000\tL\001\000\003\004\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\003\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\012\002\000\003\b\002\000\t\156\001\000\t\152\001\000\003\012\003\000\t\156\002\000\t\152\002\000\003\012\004\000\t\156\003\000\t\152\003\000\003\012\005\000\t\156\004\000\t\152\004\000\tL\001\000\003\012\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\003\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\144\002\000\n\196\001\000\002p\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\002p\002\000\003$\001\000\003 \001\000\t\156\001\000\t\152\001\000\003$\002\000\t\156\002\000\t\152\002\000\003$\003\000\t\156\003\000\t\152\003\000\003$\004\000\t\156\004\000\t\152\004\000\tL\001\000\003$\005\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003 \002\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\172\002\000\003\168\002\000\003\164\002\000\003\172\003\000\003\172\004\000\003\172\005\000\003\168\003\000\000L\001\000\000L\002\000\011$\001\000\004\136\001\000\004\132\001\000\004\128\001\000\004|\001\000\004x\001\000\012@\001\000\012@\002\000\012\216\001\000\012\212\001\000\004\136\002\000\004\132\002\000\004\136\003\000\004\136\004\000\004\136\005\000\004\136\006\000\001\180\001\000\004\136\007\000\004\136\b\000\t@\001\000\004\132\003\000\t@\002\000\t@\003\000\004\132\004\000\004\132\005\000\001\180\001\000\004\132\006\000\004\132\007\000\004\128\002\000\004\128\003\000\004\128\004\000\004|\002\000\012D\001\000\007\204\001\000\012D\002\000\012D\003\000\002\028\001\000\012D\004\000\t\028\001\000\011(\001\000\004\144\001\000\004\144\002\000\004\144\003\000\001\180\001\000\004\144\004\000\004\144\005\000\b\128\001\000\bx\001\000\bp\001\000\bl\001\000\bT\001\000\004\140\001\000\004\140\002\000\004\140\003\000\bT\002\000\bT\003\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bl\002\000\bl\003\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b\128\002\000\b\128\003\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bx\002\000\bx\003\000\bp\002\000\bt\001\000\b|\001\000\bP\001\000\bP\002\000\bP\003\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\004t\001\000\000L\003\000\005\012\001\000\005\012\002\000\000L\004\000\004\152\002\000\t\148\001\000\t\144\001\000\t\136\003\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\b\128\001\000\bx\001\000\bp\001\000\bl\001\000\bT\001\000\004\188\001\000\004\188\002\000\004\188\003\000\004\196\001\000\003,\002\000\003,\003\000\003,\004\000\004\196\002\000\004\196\003\000\004\192\001\000\n\208\001\000\007 \001\000\n\224\004\000\n\224\005\000\011\016\003\000\011\012\003\000\011\016\004\000\011\012\004\000\011\012\005\000\t\192\001\000\t\180\001\000\t\176\001\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\t\192\002\000\t\180\002\000\t\192\003\000\011\028\003\000\011\024\003\000\011\028\004\000\011\024\004\000\011\024\005\000\n\228\003\000\n\228\004\000\n\228\005\000\011\000\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\b\224\001\000\b\224\002\000\b\224\003\000\t\232\001\000\t\228\001\000\t\224\001\000\t\232\002\000\t\228\002\000\t\224\002\000\t\232\003\000\t\228\003\000\t\224\003\000\t\232\004\000\t\228\004\000\t\232\005\000\b\220\001\000\011\000\004\000\011\000\005\000\011 \001\000\011\028\001\000\011\024\001\000\011\016\001\000\011\012\001\000\011\000\001\000\n\248\001\000\n\228\001\000\n\224\001\000\005\240\001\000\005\232\001\000\005\224\001\000\001\140\001\000\001\136\001\000\011 \002\000\011\028\002\000\011\024\002\000\011\016\002\000\011\012\002\000\011\000\002\000\n\248\002\000\n\228\002\000\n\224\002\000\005\240\002\000\005\232\002\000\005\224\002\000\001\140\002\000\r8\001\000\005\224\003\000\005\240\003\000\004@\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\004@\002\000\n\156\002\000\n\148\002\000\n\140\002\000\003\132\002\000\003\128\002\000\003t\002\000\003p\002\000\003d\002\000\003`\002\000\n\140\003\000\003d\003\000\003`\003\000\n\140\004\000\003d\004\000\003`\004\000\n\140\005\000\003d\005\000\003`\005\000\003d\006\000\003`\006\000\t\156\001\000\t\152\001\000\003d\007\000\t\156\002\000\t\152\002\000\003d\b\000\t\156\003\000\t\152\003\000\003d\t\000\t\156\004\000\t\152\004\000\tL\001\000\003d\n\000\t\148\001\000\t\144\001\000\003\144\001\000\003`\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\156\003\000\003\132\003\000\003\128\003\000\n\156\004\000\003\132\004\000\003\128\004\000\n\156\005\000\003\132\005\000\003\128\005\000\003\132\006\000\003\128\006\000\t\156\001\000\t\152\001\000\003\132\007\000\t\156\002\000\t\152\002\000\003\132\b\000\t\156\003\000\t\152\003\000\003\132\t\000\t\156\004\000\t\152\004\000\tL\001\000\003\132\n\000\t\148\001\000\t\144\001\000\003\144\001\000\003\128\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\148\003\000\003t\003\000\003p\003\000\n\148\004\000\003t\004\000\003p\004\000\n\148\005\000\003t\005\000\003p\005\000\003t\006\000\003p\006\000\t\156\001\000\t\152\001\000\003t\007\000\t\156\002\000\t\152\002\000\003t\b\000\t\156\003\000\t\152\003\000\003t\t\000\t\156\004\000\t\152\004\000\tL\001\000\003t\n\000\t\148\001\000\t\144\001\000\003\144\001\000\003p\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\220\002\000\n\160\002\000\n\152\002\000\n\144\002\000\n\136\002\000\n\132\002\000\n\128\002\000\003\140\002\000\003\136\002\000\003|\002\000\003x\002\000\003l\002\000\003h\002\000\003\\\002\000\003X\002\000\003T\002\000\003P\002\000\003L\002\000\003H\002\000\003D\002\000\003@\002\000\n\128\003\000\003L\003\000\003H\003\000\n\128\004\000\003L\004\000\003H\004\000\n\128\005\000\003L\005\000\003H\005\000\003L\006\000\003H\006\000\t\156\001\000\t\152\001\000\003L\007\000\t\156\002\000\t\152\002\000\003L\b\000\t\156\003\000\t\152\003\000\003L\t\000\t\156\004\000\t\152\004\000\tL\001\000\003L\n\000\t\148\001\000\t\144\001\000\003\144\001\000\003H\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\136\003\000\003\\\003\000\003X\003\000\n\136\004\000\003\\\004\000\003X\004\000\n\136\005\000\003\\\005\000\003X\005\000\003\\\006\000\003X\006\000\t\156\001\000\t\152\001\000\003\\\007\000\t\156\002\000\t\152\002\000\003\\\b\000\t\156\003\000\t\152\003\000\003\\\t\000\t\156\004\000\t\152\004\000\tL\001\000\003\\\n\000\t\148\001\000\t\144\001\000\003\144\001\000\003X\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\132\003\000\003T\003\000\003P\003\000\n\132\004\000\003T\004\000\003P\004\000\n\132\005\000\003T\005\000\003P\005\000\003T\006\000\003P\006\000\t\156\001\000\t\152\001\000\003T\007\000\t\156\002\000\t\152\002\000\003T\b\000\t\156\003\000\t\152\003\000\003T\t\000\t\156\004\000\t\152\004\000\tL\001\000\003T\n\000\t\148\001\000\t\144\001\000\003\144\001\000\003P\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\160\003\000\n\152\003\000\n\144\003\000\005\232\001\000\005\224\001\000\003\140\003\000\003\136\003\000\003|\003\000\003x\003\000\003l\003\000\003h\003\000\n\160\004\000\n\152\004\000\n\144\004\000\003\140\004\000\003\136\004\000\003|\004\000\003x\004\000\003l\004\000\003h\004\000\n\144\005\000\003l\005\000\003h\005\000\n\144\006\000\003l\006\000\003h\006\000\n\144\007\000\003l\007\000\003h\007\000\003l\b\000\003h\b\000\t\156\001\000\t\152\001\000\003l\t\000\t\156\002\000\t\152\002\000\003l\n\000\t\156\003\000\t\152\003\000\003l\011\000\t\156\004\000\t\152\004\000\tL\001\000\003l\012\000\t\148\001\000\t\144\001\000\003\144\001\000\003h\t\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\160\005\000\003\140\005\000\003\136\005\000\n\160\006\000\003\140\006\000\003\136\006\000\n\160\007\000\003\140\007\000\003\136\007\000\003\140\b\000\003\136\b\000\t\156\001\000\t\152\001\000\003\140\t\000\t\156\002\000\t\152\002\000\003\140\n\000\t\156\003\000\t\152\003\000\003\140\011\000\t\156\004\000\t\152\004\000\tL\001\000\003\140\012\000\t\148\001\000\t\144\001\000\003\144\001\000\003\136\t\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\152\005\000\003|\005\000\003x\005\000\n\152\006\000\003|\006\000\003x\006\000\n\152\007\000\003|\007\000\003x\007\000\003|\b\000\003x\b\000\t\156\001\000\t\152\001\000\003|\t\000\t\156\002\000\t\152\002\000\003|\n\000\t\156\003\000\t\152\003\000\003|\011\000\t\156\004\000\t\152\004\000\tL\001\000\003|\012\000\t\148\001\000\t\144\001\000\003\144\001\000\003x\t\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\220\003\000\003D\003\000\003@\003\000\003D\004\000\003@\004\000\t\156\001\000\t\152\001\000\003D\005\000\t\156\002\000\t\152\002\000\003D\006\000\t\156\003\000\t\152\003\000\003D\007\000\t\156\004\000\t\152\004\000\tL\001\000\003D\b\000\t\148\001\000\t\144\001\000\003\144\001\000\003@\005\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\004<\001\000\t0\001\000\002h\002\000\t0\002\000\t,\001\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\024\002\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\128\004\000\n\128\005\000\n\136\003\000\n\136\004\000\n\136\005\000\n\132\003\000\n\132\004\000\n\132\005\000\n\160\003\000\n\152\003\000\n\144\003\000\005\232\001\000\005\224\001\000\n\160\004\000\n\152\004\000\n\144\004\000\n\144\005\000\n\144\006\000\n\144\007\000\n\160\005\000\n\160\006\000\n\160\007\000\n\152\005\000\n\152\006\000\n\152\007\000\n\220\003\000\t\196\006\000\n\140\004\000\n\140\005\000\n\156\003\000\n\156\004\000\n\156\005\000\n\148\003\000\n\148\004\000\n\148\005\000\002\\\006\000\001\232\001\000\001\236\001\000\002\\\007\000\002\\\b\000\002\\\t\000\002\\\n\000\002\\\011\000\t\152\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\0024\007\000\005l\003\000\005l\004\000\005l\005\000\005p\002\000\005h\002\000\005p\003\000\005h\003\000\tH\002\000\t\240\004\000\t\156\004\000\t\152\004\000\tL\001\000\002T\004\000\002P\004\000\002L\004\000\002H\004\000\002D\004\000\002@\004\000\002T\005\000\002P\005\000\002L\005\000\002H\005\000\002D\005\000\002@\005\000\t\156\001\000\t\152\001\000\002T\006\000\002L\006\000\002H\006\000\t\156\002\000\t\152\002\000\002T\007\000\002L\007\000\002H\007\000\t\156\003\000\t\152\003\000\002T\b\000\002L\b\000\002H\b\000\t\156\004\000\t\152\004\000\tL\001\000\002T\t\000\002L\t\000\002H\t\000\002L\n\000\002H\n\000\t\156\001\000\t\152\001\000\002L\011\000\t\156\002\000\t\152\002\000\002L\012\000\t\156\003\000\t\152\003\000\002L\r\000\t\156\004\000\t\152\004\000\tL\001\000\002L\014\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002H\011\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002P\006\000\002D\006\000\002@\006\000\002D\007\000\002@\007\000\t\156\001\000\t\152\001\000\002D\b\000\t\156\002\000\t\152\002\000\002D\t\000\t\156\003\000\t\152\003\000\002D\n\000\t\156\004\000\t\152\004\000\tL\001\000\002D\011\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002@\b\000\n\168\004\000\n\164\004\000\n\164\005\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\002d\004\000\np\002\000\t\156\001\000\t\152\001\000\np\003\000\t\156\002\000\t\152\002\000\np\004\000\t\156\003\000\t\152\003\000\np\005\000\t\156\004\000\t\152\004\000\tL\001\000\np\006\000\nl\002\000\t\148\001\000\t\144\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\nl\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\nt\002\000\n\252\002\000\n\252\003\000\t\156\001\000\t\152\001\000\007\172\002\000\t\156\002\000\t\152\002\000\007\172\003\000\t\156\003\000\t\152\003\000\007\172\004\000\t\156\004\000\t\152\004\000\tL\001\000\007\172\005\000\t\148\001\000\t\144\001\000\007\168\002\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\t\208\002\000\t\204\002\000\t\200\002\000\t\208\003\000\t\204\003\000\t\208\004\000\n\216\002\000\n\212\002\000\n\212\003\000\011\020\002\000\011\020\003\000\0020\b\000\002,\003\000\002,\004\000\006,\001\000\006(\001\000\006 \001\000\002,\005\000\002,\006\000\002,\007\000\002$\002\000\002$\003\000\002$\004\000\002$\005\000\006\000\001\000\006,\001\000\006(\001\000\006 \001\000\006\000\002\000\006\004\001\000\006d\001\000\006`\001\000\006T\001\000\006\004\002\000\006\004\003\000\006,\001\000\006(\001\000\006 \001\000\006\004\004\000\002$\006\000\002$\007\000\002$\b\000\006\b\001\000\006\b\002\000\002(\002\000\002(\003\000\002(\004\000\001|\001\000\001\128\001\000\001p\001\000\001\128\002\000\001\128\003\000\001l\001\000\002(\005\000\003\208\001\000\001\164\001\000\006|\001\000\004 \001\000\004\028\001\000\004 \002\000\004\028\002\000\004 \003\000\004\028\003\000\t@\001\000\b\172\001\000\b\172\002\000\b\172\003\000\000H\001\000\004 \004\000\004\028\004\000\004 \005\000\004\028\005\000\004 \006\000\004 \007\000\b\168\001\000\000H\001\000\001\164\002\000\001\164\003\000\004,\001\000\004(\001\000\004,\002\000\004$\001\000\t|\001\000\001\160\001\000\t|\002\000\001\160\002\000\t|\003\000\001\160\003\000\000l\001\000\000`\001\000\003\208\002\000\tx\001\000\001\156\001\000\000l\001\000\000`\001\000\003\224\001\000\003\220\001\000\003\216\001\000\003\212\001\000\t@\001\000\003\224\002\000\003\216\002\000\003\224\003\000\003\216\003\000\003\216\004\000\003\216\005\000\003\216\006\000\000l\001\000\000`\001\000\tx\001\000\003\224\004\000\001\156\001\000\000l\001\000\000`\001\000\003\212\002\000\003\212\003\000\003\212\004\000\000l\001\000\000`\001\000\tx\001\000\003\220\002\000\001\156\001\000\000l\001\000\000`\001\000\002(\006\000\002(\007\000\002(\b\000\002(\t\000\001\132\001\000\004\148\002\000\004\148\003\000\b\216\001\000\004\148\004\000\004\148\005\000\004\148\006\000\007\196\002\000\004T\004\000\004T\005\000\004X\002\000\004\176\002\000\t\156\001\000\t\152\001\000\003<\003\000\t\156\002\000\t\152\002\000\003<\004\000\t\156\003\000\t\152\003\000\003<\005\000\t\156\004\000\t\152\004\000\tL\001\000\003<\006\000\t\148\001\000\t\144\001\000\003\144\001\000\0038\003\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\011\b\002\000\011\004\002\000\011\004\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\204\002\000\n\160\001\000\n\156\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n\180\002\000\n\176\002\000\n\180\003\000\n\176\003\000\n\180\004\000\n\176\004\000\n\180\005\000\n\176\005\000\006,\001\000\006(\001\000\006 \001\000\n\176\006\000\n\180\006\000\n\180\007\000\006d\001\000\006`\001\000\006T\001\000\n\180\b\000\n|\002\000\nx\002\000\nx\003\000\n|\003\000\n|\004\000\0028\004\000\0028\005\000\tL\001\000\0028\006\000\t\156\001\000\t\152\001\000\007\252\004\000\007\244\004\000\007\236\004\000\007\228\004\000\t\156\002\000\t\152\002\000\007\252\005\000\007\244\005\000\007\236\005\000\007\228\005\000\t\156\003\000\t\152\003\000\007\252\006\000\007\244\006\000\007\236\006\000\007\228\006\000\t\156\004\000\t\152\004\000\tL\001\000\007\252\007\000\007\244\007\000\007\236\007\000\007\228\007\000\007\228\b\000\007\252\b\000\007\252\t\000\006d\001\000\006`\001\000\006T\001\000\007\252\n\000\007\244\b\000\007\236\b\000\007\244\t\000\007\236\t\000\006d\001\000\006`\001\000\006T\001\000\007\236\n\000\007\244\n\000\007\244\011\000\006d\001\000\006`\001\000\006T\001\000\007\244\012\000\t\148\001\000\t\144\001\000\007\248\004\000\007\240\004\000\007\232\004\000\007\224\004\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\007\224\005\000\007\248\005\000\007\248\006\000\006d\001\000\006`\001\000\006T\001\000\007\248\007\000\007\240\005\000\007\232\005\000\007\240\006\000\007\232\006\000\006d\001\000\006`\001\000\006T\001\000\007\232\007\000\007\240\007\000\007\240\b\000\006d\001\000\006`\001\000\006T\001\000\007\240\t\000\006\236\005\000\006,\001\000\006(\001\000\006 \001\000\006\236\006\000\006\232\002\000\006\232\003\000\006\232\004\000\006,\001\000\006(\001\000\006 \001\000\006\232\005\000\012x\001\000\012t\001\000\006l\001\000\006l\002\000\006l\003\000\006l\004\000\006l\005\000\007\180\001\000\007\180\002\000\006d\001\000\006`\001\000\006T\001\000\006l\006\000\006l\007\000\012x\002\000\012t\002\000\012x\003\000\012t\003\000\012x\004\000\012x\005\000\012x\006\000\012x\007\000\004\228\001\000\004\228\002\000\004\228\003\000\004\228\004\000\004\228\005\000\004\228\006\000\012x\b\000\012t\004\000\012t\005\000\012t\006\000\004\020\001\000\004\020\002\000\b\156\001\000\b\152\001\000\b\156\002\000\b\152\002\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b\156\003\000\b\156\004\000\002\012\001\000\002\012\002\000\012\140\001\000\012\140\002\000\012\140\003\000\012\140\004\000\006,\001\000\006(\001\000\006 \001\000\012\140\005\000\b\180\001\000\b\180\002\000\b\180\003\000\b\180\004\000\b\180\005\000\t@\001\000\b\164\001\000\b\164\002\000\b\164\003\000\001\180\001\000\b\180\006\000\b\180\007\000\006\164\001\000\006\160\001\000\006\164\002\000\b\180\b\000\b\180\t\000\b\160\001\000\001\180\001\000\012<\001\000\t\244\001\000\012<\002\000\t\244\002\000\012<\003\000\t\244\003\000\012<\004\000\t\244\004\000\012<\005\000\001\144\001\000\001p\001\000\005\232\001\000\001\140\001\000\001\136\001\000\005\232\002\000\001\140\002\000\001\140\003\000\012<\006\000\012<\007\000\012<\b\000\t\244\005\000\t\244\006\000\t\244\007\000\b\148\001\000\b\144\001\000\005\020\001\000\006\244\001\000\006\240\001\000\006\244\002\000\006\244\003\000\006\244\004\000\006\244\005\000\005\248\001\000\005\184\001\000\006\244\006\000\006\240\002\000\006\240\003\000\006\240\004\000\005\248\001\000\005\184\001\000\006\240\005\000\n,\001\000\n$\001\000\n \001\000\006p\001\000\006l\001\000\006@\001\000\006p\002\000\006l\002\000\006p\003\000\006l\003\000\006p\004\000\006l\004\000\006p\005\000\006l\005\000\006p\006\000\006p\007\000\006d\001\000\006`\001\000\006T\001\000\006p\b\000\n,\002\000\n$\002\000\n \002\000\006@\002\000\n,\003\000\n$\003\000\n \003\000\006@\003\000\006@\004\000\0068\001\000\006@\005\000\006@\006\000\005\248\001\000\005\184\001\000\006@\007\000\n,\004\000\n,\005\000\n,\006\000\n,\007\000\006d\001\000\006`\001\000\006T\001\000\n,\b\000\004\236\001\000\004\236\002\000\004\236\003\000\004\236\004\000\006d\001\000\006`\001\000\006T\001\000\004\236\005\000\004\236\006\000\004\236\007\000\n,\t\000\n$\004\000\n \004\000\n$\005\000\n$\006\000\005\232\001\000\n$\007\000\006\012\001\000\006d\001\000\006`\001\000\006T\001\000\006\012\002\000\n \005\000\n \006\000\006\016\001\000\006\016\002\000\n<\001\000\n<\002\000\n<\003\000\n<\004\000\006d\001\000\006`\001\000\006T\001\000\n<\005\000\t\244\001\000\t\244\002\000\t\244\003\000\t\244\004\000\n@\001\000\001T\001\000\001T\002\000\001T\003\000\001T\004\000\r`\001\000\001T\005\000\002\020\001\000\tt\001\000\002\020\002\000\002\020\003\000\001T\006\000\001T\007\000\001T\b\000\001 \001\000\001 \002\000\000\244\001\000\001\180\001\000\000\244\002\000\000\244\003\000\001 \003\000\001\000\001\000\001\000\002\000\006\144\001\000\006\136\001\000\006\144\002\000\006\140\001\000\006\132\001\000\006\140\002\000\001\000\003\000\001\000\004\000\001\000\005\000\001\180\001\000\001\000\006\000\001\000\007\000\001\004\001\000\001\004\002\000\b\208\001\000\b\200\001\000\b\208\002\000\b\204\001\000\b\196\001\000\b\204\002\000\001\004\003\000\001\004\004\000\001\004\005\000\001\004\006\000\001\004\007\000\000\252\001\000\000\252\002\000\001,\001\000\001(\001\000\001,\002\000\001(\002\000\001,\003\000\001,\004\000\005\232\001\000\001,\005\000\001,\006\000\001\024\001\000\tl\001\000\001\024\002\000\001\024\003\000\001\024\004\000\tl\002\000\tl\003\000\001\180\001\000\th\001\000\001\180\001\000\001\028\001\000\001\020\001\000\001,\007\000\001$\001\000\001$\002\000\001(\003\000\005\232\001\000\001(\004\000\001(\005\000\001(\006\000\001$\001\000\001$\001\000\000\252\003\000\000\252\004\000\001\b\001\000\001\b\002\000\001\180\001\000\001\152\001\000\001\152\002\000\001\180\001\000\001\152\003\000\001\b\003\000\001\b\004\000\001 \004\000\001 \005\000\001\012\001\000\001\012\002\000\001\016\001\000\0050\001\000\0050\002\000\001T\t\000\001$\001\000\001T\n\000\004\220\001\000\004\220\002\000\004\220\003\000\004\220\004\000\004\220\005\000\004\220\006\000\004\220\007\000\001$\001\000\004\220\b\000\004\220\t\000\001T\011\000\n@\002\000\n@\003\000\n@\004\000\n@\005\000\n@\006\000\n@\007\000\005\172\001\000\001L\001\000\001L\002\000\001L\003\000\001L\004\000\001\212\001\000\001\208\001\000\001\204\001\000\001\024\001\000\t\172\001\000\th\001\000\001\180\001\000\001P\001\000\001P\002\000\001H\001\000\001H\002\000\001H\003\000\012\232\001\000\001X\001\000\002\b\001\000\001\028\001\000\001H\004\000\001D\001\000\001$\001\000\001P\003\000\001L\005\000\n@\b\000\n@\t\000\004\212\001\000\004\212\002\000\004\212\003\000\004\212\004\000\004\212\005\000\004\212\006\000\004\212\007\000\004\212\b\000\004\212\t\000\n@\n\000\n\004\001\000\005\024\001\000\n\028\001\000\n\b\001\000\n8\001\000\n4\001\000\n0\001\000\n(\001\000\005\024\002\000\t\252\001\000\t\252\002\000\n\012\001\000\004\252\001\000\004\252\002\000\004\252\003\000\004\252\004\000\004\252\005\000\t\024\001\000\004\252\006\000\004\252\007\000\004\252\b\000\n\012\002\000\n\016\001\000\005\004\001\000\005\004\002\000\005\004\003\000\005\004\004\000\005\004\005\000\001\212\001\000\001\208\001\000\001\204\001\000\001l\001\000\006\208\001\000\006\208\002\000\006\208\003\000\006\192\001\000\003\228\001\000\001\168\001\000\003\228\002\000\003\228\003\000\003\228\004\000\b\236\001\000\001\172\001\000\003\228\001\000\b\236\002\000\005\004\006\000\t\024\001\000\005\004\007\000\005\004\b\000\005\004\t\000\b\228\001\000\b\232\001\000\006\220\001\000\006\216\001\000\006\204\001\000\006\200\001\000\006\188\001\000\006\184\001\000\006\168\001\000\001\180\001\000\006\220\002\000\006\216\002\000\006\204\002\000\006\200\002\000\006\188\002\000\006\184\002\000\006\220\003\000\006\204\003\000\006\188\003\000\006\220\004\000\006\220\005\000\006\220\006\000\006\204\004\000\006\188\004\000\003\232\001\000\003\232\002\000\003\232\003\000\006\216\003\000\006\216\004\000\006\216\005\000\006\200\003\000\006\184\003\000\006\176\001\000\n\016\002\000\n\000\001\000\nD\001\000\005\020\002\000\b\144\002\000\t\248\001\000\b\148\002\000\001\180\001\000\012\132\001\000\001T\001\000\012\132\002\000\012\132\003\000\012\132\004\000\012\132\005\000\012\132\006\000\000\208\001\000\001@\001\000\001@\002\000\001@\003\000\000\184\001\000\rT\001\000\rL\001\000\rT\002\000\rL\002\000\rT\003\000\rL\003\000\rT\004\000\rL\004\000\rL\005\000\rL\006\000\rT\005\000\rT\006\000\rT\007\000\000\184\002\000\000\184\003\000\rP\001\000\rH\001\000\rD\001\000\rl\001\000\rd\001\000\rl\002\000\rh\001\000\006|\001\000\rh\002\000\rD\002\000\rD\003\000\rD\004\000\rD\005\000\001\180\001\000\rP\002\000\rH\002\000\rP\003\000\rH\003\000\rH\004\000\rH\005\000\rP\004\000\rP\005\000\rP\006\000\000\188\001\000\005\168\001\000\005\160\001\000\005\152\001\000\005\168\002\000\005\160\002\000\005\152\002\000\b\188\001\000\005\168\003\000\005\160\003\000\005\152\003\000\005\168\004\000\005\160\004\000\005\152\004\000\005\168\005\000\005\160\005\000\005\168\006\000\005\168\007\000\005\168\b\000\005\168\t\000\001\180\001\000\005\168\n\000\005\168\011\000\005\160\006\000\005\160\007\000\005\160\b\000\005\152\005\000\000\188\002\000\000\188\003\000\005\164\001\000\005\156\001\000\005\148\001\000\005\144\001\000\rx\001\000\rp\001\000\rx\002\000\rt\001\000\b\188\001\000\rt\002\000\005\144\002\000\005\144\003\000\005\144\004\000\005\144\005\000\005\164\002\000\005\156\002\000\005\148\002\000\005\164\003\000\005\156\003\000\005\148\003\000\005\164\004\000\005\156\004\000\005\164\005\000\005\164\006\000\005\164\007\000\005\164\b\000\001\180\001\000\005\164\t\000\005\164\n\000\005\156\005\000\005\156\006\000\005\156\007\000\005\148\004\000\000\196\001\000\000\196\002\000\000\196\003\000\000\196\004\000\000\180\001\000\000\176\001\000\000\180\002\000\000\180\003\000\001<\001\000\0010\001\000\004\160\001\000\004\156\001\000\000\160\001\000\000\156\001\000\004\160\002\000\004\160\003\000\004\160\004\000\004\160\005\000\004\160\006\000\004\160\007\000\000\160\002\000\000\156\002\000\000\160\003\000\000\160\004\000\005\232\001\000\000\160\005\000\000\160\006\000\0018\001\000\tl\001\000\0018\002\000\0018\003\000\0018\004\000\000\148\001\000\000\148\002\000\000\224\001\000\000\220\001\000\000\220\002\000\004\164\001\000\000\152\001\000\000\152\002\000\000\172\001\000\000\168\001\000\000\144\001\000\t0\001\000\000\168\002\000\0014\001\000\000\164\001\000\000\152\003\000\000\164\002\000\004\164\002\000\000\220\003\000\000\164\001\000\000\224\002\000\000\148\003\000\000\164\001\000\000\160\007\000\000\156\003\000\005\232\001\000\000\156\004\000\000\156\005\000\000\164\001\000\000\156\006\000\004\156\002\000\004\156\003\000\004\156\004\000\004\156\005\000\001<\002\000\0010\002\000\000\164\001\000\0010\003\000\001<\003\000\001<\004\000\001<\005\000\000\180\004\000\000\164\001\000\007\144\001\000\007\144\002\000\000\180\005\000\000\180\006\000\000\176\002\000\000\176\003\000\000\164\001\000\000\176\004\000\000\176\005\000\000\192\001\000\000\192\002\000\000\192\003\000\000\192\004\000\001@\004\000\001@\005\000\000\200\001\000\000\200\002\000\000\204\001\000\0058\001\000\0058\002\000\000\208\002\000\000\164\001\000\000\212\001\000\000\212\002\000\000\212\003\000\000\212\004\000\000\164\001\000\000\216\001\000\000\216\002\000\012\132\007\000\012\132\b\000\004\204\001\000\004\204\002\000\004\204\003\000\004\204\004\000\004\204\005\000\004\204\006\000\004\204\007\000\004\204\b\000\012\132\t\000\012`\001\000\005(\001\000\004\148\001\000\012p\001\000\0128\001\000\012\\\001\000\012\128\001\000\012|\001\000\005(\002\000\012P\001\000\004\152\001\000\012T\001\000\012T\002\000\012d\001\000\012d\002\000\012X\001\000\012\136\001\000\b\140\001\000\012L\001\000\012L\002\000\012L\003\000\000\136\001\000\012H\001\000\012P\001\000\004\152\001\000\003(\001\000\002\012\003\000\002\012\004\000\004\020\003\000\004\020\004\000\005$\002\000\005$\003\000\005$\004\000\005 \002\000\006\020\003\000\006\020\004\000\006L\005\000\006,\001\000\006(\001\000\006 \001\000\0118\007\000\006d\001\000\006`\001\000\006T\001\000\0118\b\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\000\236\002\000\000\232\002\000\000\232\003\000\000\236\003\000\001\180\001\000\000\236\004\000\000\236\005\000\n\184\004\000\n\184\005\000\n\184\006\000\002<\004\000\002<\005\000\tL\001\000\002<\006\000\b\176\003\000\b\176\004\000\003\248\t\000\012l\006\000\012l\007\000\012l\b\000\003\228\001\000\002\000\001\000\003\228\002\000\002\000\002\000\002\000\003\000\002\000\004\000\002\000\005\000\012l\t\000\t\004\001\000\t\000\001\000\012l\n\000\t\000\002\000\t\004\002\000\b\240\001\000\b\248\001\000\b\244\001\000\b\252\001\000\003\232\001\000\002\004\001\000\002\004\002\000\002\004\003\000\002\004\004\000\012h\004\000\003\244\004\000\005\172\001\000\003\244\005\000\003\244\006\000\t\024\001\000\003\244\007\000\003\244\b\000\012h\005\000\012h\006\000\012h\007\000\012h\b\000\t\004\001\000\t\000\001\000\012h\t\000\001\248\003\000\001\248\004\000\005\132\003\000\005|\003\000\005t\003\000\005\132\004\000\005|\004\000\005t\004\000\005|\005\000\005t\005\000\005|\006\000\005t\006\000\005\140\001\000\005t\007\000\005\136\001\000\005\128\001\000\005x\001\000\000l\001\000\000`\001\000\005\128\002\000\005x\002\000\005x\003\000\006\228\002\000\006\224\002\000\006\224\003\000\003\184\003\000\003\184\004\000\003\184\005\000\t\128\001\000\000p\002\000\000d\002\000\000p\003\000\000d\003\000\000p\004\000\000p\005\000\000d\004\000\t\128\002\000\t\128\003\000\001\180\001\000\t\132\001\000\001\196\002\000\001\180\001\000\t\132\002\000\t\132\003\000\001\180\001\000\006\212\002\000\006\212\003\000\006\212\004\000\006\196\002\000\006\172\002\000\001\180\001\000\006\180\002\000\012\228\002\000\003\240\007\000\003\240\b\000\t\024\001\000\003\240\t\000\003\240\n\000\n\024\006\000\n\024\007\000\n\024\b\000\n\024\t\000\t\016\001\000\n\024\n\000\t\016\002\000\t\b\001\000\t\012\001\000\n\020\004\000\003\244\004\000\003\236\004\000\005\172\001\000\003\244\005\000\003\236\005\000\003\236\006\000\003\236\007\000\t\024\001\000\003\236\b\000\003\236\t\000\n\020\005\000\n\020\006\000\n\020\007\000\n\020\b\000\t\016\001\000\n\020\t\000\006D\003\000\006D\004\000\006d\001\000\006`\001\000\006T\001\000\001\200\005\000\001\200\006\000\rX\006\000\rX\007\000\000\140\003\000\000\140\004\000\002X\003\000\002X\004\000\002X\005\000\002X\006\000\002X\007\000\004\004\001\000\004\004\002\000\000\000\001\000\000\004\000\000\004\016\001\000\004\016\002\000\000\004\001\000\000\b\000\000\r4\001\000\005\192\001\000\001p\001\000\005\192\002\000\005\192\003\000\005\196\001\000\000\b\001\000\005\248\001\000\005\208\001\000\005\204\001\000\005\200\001\000\005\184\001\000\005\208\002\000\005\204\002\000\005\200\002\000\005\184\002\000\r4\001\000\005\204\003\000\005\204\004\000\005\204\005\000\005\208\003\000\005\200\003\000\000P\001\000\005\188\001\000\000T\001\000\b\000\001\000\b\000\002\000\000\012\000\000\000\012\001\000\b\004\001\000\b\004\002\000\000\016\000\000\000\016\001\000\b\b\001\000\001\180\001\000\b\b\002\000\000\020\000\000\b\012\001\000\b\012\002\000\000\020\001\000\000\024\000\000\000\024\001\000\b\016\001\000\005\248\001\000\005\184\001\000\b\016\002\000\000\028\000\000\000\028\001\000\b\020\001\000\005\232\001\000\b\020\002\000\000 \000\000\000 \001\000\b\024\001\000\006,\001\000\006(\001\000\006 \001\000\b\024\002\000\000$\000\000\000$\001\000\b\028\001\000\006d\001\000\006`\001\000\006T\001\000\b\028\002\000\000(\000\000\000(\001\000\b \001\000\b \002\000\000,\000\000\bL\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b$\001\000\b$\002\000\000,\001\000\0000\000\000\b(\001\000\b(\002\000\0000\001\000\005\240\001\000\005\232\001\000\005\240\002\000\005\232\002\000\0004\000\000\012\184\001\000\012\180\001\000\012\176\001\000\012\172\001\000\012\168\001\000\012\164\001\000\012\160\001\000\012\184\002\000\012\180\002\000\012\176\002\000\012\172\002\000\012\168\002\000\012\164\002\000\012\160\002\000\012\184\003\000\012\164\003\000\012\168\003\000\012\180\003\000\012\172\003\000\012\176\003\000\005\240\001\000\005\232\001\000\012\200\001\000\0004\001\000\012\196\001\000\012\196\002\000\005@\001\000\005@\002\000\012\188\001\000\012\188\002\000\012\188\003\000\012\192\001\000\012\192\002\000\0008\000\000\005L\001\000\005H\001\000\005T\001\000\005P\001\000\005P\002\000\005T\002\000\005L\002\000\005L\003\000\005L\004\000\005H\002\000\0008\001\000\r0\001\000\r0\002\000\r0\003\000\r0\004\000\r,\001\000\r,\002"), (16, "\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b\000\t\000\n\000\011\000\012\000\r\000\014\000\015\000\016\000\017\000\018\000\019\000\020\000\021\000\022\000\023\000\024\000\025\000\026\000\027\000\028\000\029\000\030\000\031\000 \000!\000\"\000#\000$\000%\000&\000'\000(\000)\000*\000+\000,\000-\000.\000/\0000\0001\0002\0003\0004\0005\0006\0008\0009\000:\000;\000<\000=\000>\000?\000@\000A\000B\000C\000D\000E\000F\000G\000H\000I\000J\000K\000L\000M\000N\000O\000P\000Q\000R\000S\000T\000U\000[\000]\000^\000_\000a\000c\000d\000f\000h\000j\000k\000m\000o\000q\000r\000s\000t\000u\000v\000w\000x\000y\000z\000{\000|\000}\000~\000\127\000\128\000\130\000\131\000\132\000\134\000\135\000\136\000\137\000\138\000\142\000\143\000\144\000\145\000\146\000\147\000\149\000\150\000\151\000\157\000\163\000\169\000\170\000\172\000\173\000\176\000\178\000\179\000\180\000\181\000\184\000\185\000\186\000\187\000\188\000\189\000\190\000\191\000\192\000\194\000\195\000\196\000\197\000\200\000\203\000\204\000\206\000\207\000\211\000\217\000\218\000\220\000\221\000\222\000\224\000\228\000\231\000\232\000\233\000\234\000\235\000\239\000\243\000\247\000\249\000\251\000\253\000\254\001\000\001\001\001\002\001\003\001\004\001\005\001\006\001\007\001\b\001\t\001\n\001\012\001\r\001\015\001\016\001\017\001\019\001\020\001\021\001\028\001\031\001!\001#\001%\001&\001'\001)\001*\001+\001,\001-\001.\001/\0010\0011\0012\0014\0015\0016\0017\0019\001:\001;\001<\001F\001N\001V\001W\001X\001Y\001Z\001\\\001^\001_\001`\001a\001b\001c\001d\001e\001f\001g\001h\001i\001j\001q\001s\001u\001x\001z\001{\001}\001\127\001\128\001\129\001\130\001\131\001\132\001\136\001\137\001\139\001\140\001\142\001\144\001\145\001\146\001\149\001\150\001\153\001\154\001\157\001\158\001\159\001\160\001\161\001\163\001\164\001\165\001\166\001\167\001\168\001\169\001\170\001\172\001\173\001\175\001\176\001\177\001\181\001\184\001\186\001\187\001\188\001\189\001\190\001\191\001\192\001\193\001\194\001\195\001\199\001\200\001\203\001\204\001\205\001\206\001\207\001\209\001\210\001\211\001\213\001\214\001\215\001\216\001\217\001\220\001\221\001\222\001\223\001\225\001\226\001\227\001\228\001\230\001\231\001\232\001\233\001\235\001\236\001\238\001\239\001\241\001\242\001\244\001\246\001\247\001\248\001\249\001\251\001\252\001\254\001\255\002\002\002\003\002\004\002\006\002\007\002\b\002\t\002\011\002\015\002\016\002\017\002\018\002\019\002\020\002\021\002\022\002\023\002\024\002\025\002\026\002\027\002\028\002\029\002\030\002 \002!\002\"\002#\002$\002+\0021\0024\0025\0026\0027\0028\0029\002:\002<\002=\002C\002D\002J\002K\002Q\002R\002X\002Y\002Z\002[\002]\002c\002d\002g\002o\002p\002r\002s\002t\002u\002v\002w\002x\002{\002|\002}\002\132\002\133\002\134\002\136\002\137\002\143\002\149\002\150\002\151\002\157\002\158\002\160\002\161\002\162\002\163\002\171\002\173\002\174\002\175\002\181\002\185\002\188\002\189\002\190\002\191\002\192\002\193\002\194\002\195\002\198\002\200\002\201\002\203\002\204\002\206\002\207\002\208\002\209\002\211\002\212\002\213\002\214\002\219\002\221\002\222\002\223\002\224\002\225\002\226\002\228\002\229\002\230\002\231\002\233\002\234\002\235\002\236\002\237\002\239\002\240\002\241\002\242\002\243\002\247\002\248\002\250\002\252\002\254\003\000\003\001\003\002\003\004\003\005\003\007\003\t\003\n\003\012\003\r\003\015\003\016\003\020\003\022\003\024\003\025\003\029\003\030\003\"\003#\003&\003(\003*\003+\003,\003-\003.\003/\0033\0036\0037\003:\003;\003<\003?\003@\003B\003C\003D\003E\003I\003M\003N\003R\003S\003T\003U\003V\003Z\003e\003f\003k\003l\003m\003q\003r\003s\003t\003v\003w\003{\003|\003~\003\128\003\131\003\133\003\134\003\136\003\137\003\139\003\140\003\141\003\142\003\144\003\146\003\148\003\154\003\160\003\166\003\169\003\172\003\175\003\176\003\184\003\185\003\186\003\187\003\188\003\190\003\191\003\192\003\199\003\200\003\202\003\203\003\204\003\205\003\206\003\207\003\215\003\216\003\217\003\218\003\219\003\220\003\221\003\223\003\224\003\225\003\226\003\227\003\230\003\231\003\232\003\235\003\238\003\241\003\245\003\247\003\250\003\253\004\000\004\004\004\005\004\006\004\007\004\b\004\t\004\n\004\016\004\017\004\018\004\019\004\020\004!\004\"\004/\0040\0041\0044\0045\004:\004?\004D\004J\004L\004M\004N\004O\004\\\004c\004d\004f\004i\004l\004o\004s\004\149\004\151\004\152\004\153\004\154\004\156\004\158\004\161\004\162\004\164\004\165\004\166\004\167\004\168\004\169\004\170\004\183\004\184\004\197\004\209\004\214\004\215\004\217\004\219\004\220\004\221\004\222\004\226\004\227\004\231\004\232\004\234\004\236\004\238\004\240\004\241\004\243\004\244\004\245\004\248\004\250\004\253\005\000\005\003\005\007\005\t\005\022\005\023\005\024\005\025\005\026\005\028\005\029\005\030\005\031\005P\005R\005U\005X\005[\005_\005\141\005\143\005\146\005\149\005\152\005\156\005\202\005\204\005\207\005\210\005\213\005\217\006\007\006\t\006\012\006\015\006\018\006\022\006D\006F\006I\006L\006O\006S\006\129\006\131\006\134\006\137\006\140\006\144\006\190\006\192\006\195\006\198\006\201\006\205\006\251\006\253\007\000\007\003\007\006\007\n\0078\007:\007=\007@\007C\007G\007u\007w\007z\007}\007\128\007\132\007\178\007\180\007\183\007\186\007\189\007\193\007\239\007\241\007\244\007\247\007\250\007\254\b,\b.\b1\b4\b7\b;\bi\bk\bn\bq\bt\bx\b\166\b\168\b\171\b\174\b\177\b\181\b\227\b\229\b\232\b\235\b\238\b\242\t \t\"\t%\t(\t+\t/\t]\t_\tb\te\th\tl\t\154\t\156\t\159\t\162\t\165\t\169\t\215\t\217\t\220\t\223\t\226\t\230\n\020\n\022\n\025\n\028\n\031\n#\nQ\nS\nV\nY\n\\\n`\n\142\n\143\n\145\n\158\n\160\n\163\n\166\n\169\n\173\n\219\n\222\n\223\n\224\n\225\n\226\n\227\n\228\n\234\n\235\n\236\n\240\n\241\n\242\n\243\n\245\n\246\n\247\n\249\n\250\n\251\n\252\n\254\n\255\011\000\011\001\011\002\011\003\011\004\011\005\011\006\011\007\011\b\011\t\011\n\011\011\011\r\011\014\011\016\011\017\011\018\011\024\011\025\011\026\011\027\011!\011\"\011(\011)\011/\0110\0111\0112\0113\0115\0116\011<\011=\011>\011?\011@\011A\011B\011p\011v\011w\011x\011z\011{\011|\011}\011~\011\127\011\129\011\130\011\131\011\133\011\134\011\135\011\136\011\184\011\186\011\187\011\189\011\190\011\191\011\192\011\193\011\194\011\195\011\196\011\209\011\210\011\211\011\214\011\217\011\220\011\222\011\223\011\224\011\225\011\226\011\240\011\253\011\255\012\000\012\001\012\014\012\023\012\026\012\029\012 \012\"\012%\012(\012+\012/\012]\012`\012c\012f\012h\012k\012n\012q\012u\012\163\012\166\012\169\012\172\012\174\012\177\012\180\012\183\012\187\012\233\012\254\r\001\r\004\r\007\r\t\r\012\r\015\r\018\r\022\rD\rG\rJ\rM\rO\rR\rU\rX\r\\\r\138\r\141\r\144\r\147\r\149\r\152\r\155\r\158\r\162\r\208\r\219\r\228\r\231\r\234\r\237\r\239\r\242\r\245\r\248\r\252\014*\014-\0140\0143\0145\0148\014;\014>\014B\014p\014s\014v\014y\014{\014~\014\129\014\132\014\136\014\182\014\185\014\187\014\190\014\193\014\196\014\200\014\246\015\003\015\005\015\006\015\007\0155\0156\0157\0158\0159\015:\015;\015<\015=\015B\015E\015F\015G\015H\015I\015J\015K\015L\015M\015N\015O\015P\015Q\015R\015S\015T\015U\015V\015W\015X\015Y\015Z\015[\015\\\015]\015^\015_\015`\015\142\015\143\015\144\015\145\015\146\015\148\015\149\015\150\015\151\015\155\015\161\015\167\015\172\015\177\015\182\015\188\015\190\015\193\015\196\015\199\015\203\015\249\016)\016+\016.\0161\0164\0168\016f\016g\016h\016i\016v\016y\016|\016\127\016\131\016\132\016\178\016\179\016\192\016\193\016\194\016\197\016\200\016\203\016\207\016\253\017\000\017\002\017\003\017\004\017\005\017\006\017\007\017\b\017\t\017\n\017\011\017\015\017\016\017\017\017\018\017\019\017\020\017\021\017\022\017\026\017\027\017\031\017 \017$\017%\017&\017'\017(\017)\017*\017+\017,\017-\017/\0170\0171\0172\0173\0174\0175\0176\0178\017:\017<\017>\017?\017A\017C\017E\017F\017G\017I\017J\017K\017M\017N\017O\017Q\017S\017W\017X\017\\\017`\017c\017e\017f\017g\017j\017o\017p\017q\017t\017y\017z\017{\017|\017}\017~\017\127\017\128\017\129\017\130\017\131\017\132\017\133\017\134\017\135\017\136\017\137\017\140\017\143\017\146\017\150\017\196\017\197\017\198\017\199\017\212\017\214\017\216\017\218\017\223\017\224\017\225\017\229\017\230\017\232\017\233\017\234\017\235\017\236\017\237\017\239\017\245\017\251\018\001\018\b\018\t\018\n\018\014\018\015\018\017\018\022\018\023\018\024\018\028\018\029\018N\018O\018P\018T\018U\018W\018\\\018]\018^\018b\018c\018g\018h\018i\018j\018n\018o\018r\018s\018t\018u\018v\018w\018{\018|\018}\018\127\018\129\018\130\018\131\018\132\018\133\018\134\018\135\018\136\018\137\018\138\018\139\018\140\018\141\018\142\018\143\018\144\018\145\018\147\018\154\018\155\018\156\018\157\018\158\018\159\018\160\018\161\018\165\018\166\018\167\018\168\018\169\018\170\018\171\018\173\018\174\018\176\018\177\018\178\018\180\018\181\018\182\018\183\018\185\018\187\018\189\018\191\018\193\018\194\018\196\018\199\018\201\018\202\018\203\018\204\018\205\018\206\018\207\018\208\018\210\018\211\018\213\018\214\018\215\018\216\018\219\018\220\018\221\018\222\018\225\018\226\018\232\018\234\018\236\018\238\018\240\018\241\018\245\018\246\018\250\018\254\019\000\019\001\019\004\019\005\019\006\019\007\019\b\019\012\019\r\019\014\019\015\019\016\019\017\019\021\019\022\019\023\019\024\019\026\019\027\019\029\019\030\019\031\019#\019$\019%\019&\019'\019(\019)\019*\019.\019/\0190\0191\0192\0193\0195\0196\0197\0198\0199\019:\019;\019=\019>\019?\019@\019A\019B\019C\019D\019F\019G\019H\019I\019J\019L\019M\019O\019P\019Q\019R\019S\019U\019V\019W\019X\019Z\019[\019]\019^\019_\019`\019a\019b\019c\019d\019e\019g\019i\019j\019k\019m\019n\019o\019q\019r\019s\019t\019v\019x\019y\019z\019|\019}\019~\019\128\019\129\019\131\019\133\019\134\019\135\019\136\019\138\019\139\019\141\019\142\019\143\019\144\019\145\019\146\019\147\019\148\019\149\019\150\019\152\019\153\019\154\019\155\019\156\019\157\019\158\019\159\019\161\019\162\019\163\019\164\019\165\019\166\019\167\019\168\019\169\019\170\019\172\019\173\019\174\019\175\019\179\019\182\019\183\019\184\019\185\019\186\019\187\019\189\019\191\019\192\019\194\019\195\019\196\019\197\019\198\019\199\019\200\019\201\019\202\019\203\019\204\019\205\019\206\019\207\019\208\019\209\019\210\019\211\019\212\019\213\019\214\019\215\019\216\019\217\019\218\019\219\019\220\019\221\019\222\019\223\019\224\019\225\019\227\019\228\019\229\019\230\019\231\019\232\019\233\019\234\019\235\019\236\019\240\019\241\019\242\019\243\019\244\019\246\019\247\019\248\019\249\019\251\019\252\019\253\019\254\020\000\020\001\020\002\020\003\020\004\020\012\020\018\020\021\020\022\020\023\020\024\020\025\020\026\020\027\020\028\020\029\020\030\020\031\020 \020!\020\"\020#\020$\020%\020&\020'\020(\020)\020+\020-\020.\020/\0200\0201\0202\0203\0204\0205\0206\0207\0209\020;\020=\020?\020@\020A\020B\020C\020D\020E\020F\020I\020K\020L\020N\020O\020P\020Q\020R\020T\020V\020X\020Y\020Z\020[\020\\\020]\020^\020a\020d\020e\020h\020k\020m\020n\020o\020p\020r\020s\020t\020u\020v\020w\020x\020y\020z\020~\020\128\020\129\020\131\020\132\020\133\020\134\020\135\020\136\020\139\020\142\020\144\020\145\020\146\020\147\020\149\020\150\020\151\020\152\020\153\020\154\020\155\020\156\020\157\020\158\020\159\020\161\020\162\020\163\020\165\020\169\020\170\020\171\020\172\020\173\020\174\020\175\020\177\020\178\020\179\020\181\020\182\020\183\020\185\020\186\020\187\020\188\020\189\020\191\020\192\020\194\020\195\020\196\020\198\020\200\020\201\020\203\020\204\020\205\020\207\020\208\020\209\020\211\020\212\020\214\020\215\020\217\020\218\020\219\020\220\020\221\020\224\020\225\020\226\020\227\020\228\020\230\020\231\020\232\020\233\020\234\020\235\020\237\020\238\020\239\020\240\020\241\020\242\020\243\020\244\020\245\020\246\020\247\020\248\020\249\020\250\020\252\020\253\020\254\020\255\021\001\021\002\021\003\021\004\021\005\021\006\021\007\021\b\021\t\021\n\021\011\021\012\021\r\021\014\021\015\021\016\021\017\021\018\021\019\021\020\021\021\021\022\021\023\021\025\021\026\021\027\021\028\021\029\021\030\021\031\021 \021!\021\"\021#\021$\021%\021(\021)\021*\021+\021,\021-\021.\021/\0210\0211\0212\0216\021:\021;\021B\021C\021D\021F\021G\021H\021I\021J\021K\021L\021N\021O\021P\021Q\021R\021S\021T\021V\021X\021Y\021Z\021[\021^\021_\021`\021a\021b\021c\021d\021e\021g\021h\021i\021j\021l\021n\021o\021q\021r\021s\021t\021u\021x\021y\021z\021{\021~\021\129\021\131\021\133\021\134\021\135\021\140\021\142\021\143\021\144\021\145\021\146\021\147\021\148\021\149\021\152\021\154\021\155\021\156\021\157\021\158\021\160\021\163\021\164\021\166\021\167\021\168\021\169\021\170\021\172\021\173\021\174\021\175\021\176\021\178\021\179\021\180\021\181\021\182\021\184\021\185\021\186\021\187\021\188\021\191\021\194\021\195\021\196\021\198\021\199\021\200\021\201\021\202\021\204\021\205\021\206\021\207\021\211\021\212\021\213\021\214\021\215\021\216\021\217\021\218\021\219\021\220\021\221\021\222\021\223\021\224\021\225\021\226\021\227\021\228\021\229\021\232\021\233\021\234\021\235\021\236\021\241\021\245\021\247\021\248\021\249\021\250\021\251\021\252\021\253\021\254\021\255\022\000\022\001\022\002\022\003\022\004\022\005\022\006\022\b\022\t\022\n\022\011\022\012\022\r\022\014\022\015\022\018\022\019\022\020\022\021\022\023\022\024\022\025\022\026\022\030\022\031\022 \022!\022%\022&\022'\022(\022)\022*\022+\0221\0222\0223\0224\0225\0226\0227\0229\022;\022<\022C\022J\022K\022L\022M\022N\022O\022R\022S\022T\022U\022V\022W\022X\022Y\022Z\022[\022\\\022]\022^\022`\022a\022b\022c\022d\022e\022f\022g\022h\022i\022j\022k\022l\022m\022n\022o"))
+ ((32, "\000\000\000\000\000\002X\001\000\001\244\001\000\0124\001\000\0120\001\000\012,\001\000\012(\001\000\012$\001\000\011p\001\000\012 \001\000\012\028\001\000\012\024\001\000\012\020\001\000\012\016\001\000\012\012\001\000\012\b\001\000\012\004\001\000\012\000\001\000\011\252\001\000\011\248\001\000\011\244\001\000\011\240\001\000\011\236\001\000\011\232\001\000\011\228\001\000\011\224\001\000\011\220\001\000\011\216\001\000\011l\001\000\011\212\001\000\011\208\001\000\011\204\001\000\011\200\001\000\011\196\001\000\011\192\001\000\011\188\001\000\011\184\001\000\011\180\001\000\011\176\001\000\011\172\001\000\011\168\001\000\011\164\001\000\011\160\001\000\011\156\001\000\011\152\001\000\011\148\001\000\011\144\001\000\011\140\001\000\011\136\001\000\011\132\001\000\011\128\001\000\011|\001\000\011x\001\000\011t\001\000\000\132\001\000\000\128\001\000\000\132\002\000\000\132\003\000\001\244\002\000\002X\002\000\000\140\001\000\000\140\002\000\rX\001\000\rX\002\000\rX\003\000\r4\001\000\007L\001\000\006\248\001\000\007@\001\000\007<\001\000\0078\001\000\007P\001\000\007`\001\000\007H\001\000\007D\001\000\006\252\001\000\007X\001\000\0074\001\000\0070\001\000\007,\001\000\007(\001\000\007$\001\000\007\028\001\000\007\\\001\000\007T\001\000\007\024\001\000\007\020\001\000\007\016\001\000\007\012\001\000\007\b\001\000\007\004\001\000\007\b\002\000\007\004\002\000\004\012\001\000\004\012\002\000\007\b\003\000\007\004\003\000\007\b\004\000\007\004\004\000\007\b\005\000\007\016\002\000\007\012\002\000\007\016\003\000\007\012\003\000\007\016\004\000\007\012\004\000\007\016\005\000\007\024\002\000\007\020\002\000\007\024\003\000\007\020\003\000\007\024\004\000\007\020\004\000\007\024\005\000\007p\001\000\007d\001\000\007 \001\000\007\000\001\000\007h\001\000\007l\001\000\r4\002\000\r4\003\000\r8\001\000\rX\004\000\rX\005\000\000|\001\000\005\180\001\000\001\252\001\000\t@\001\000\000x\001\000\003\252\001\000\004\000\001\000\t@\002\000\000x\002\000\007\212\001\000\007\212\002\000\007\212\003\000\007\208\001\000\001\200\001\000\001\196\001\000\000p\001\000\000d\001\000\000x\001\000\000x\002\000\001\200\002\000\001\200\003\000\001\200\004\000\005\180\001\000\003\252\001\000\006D\001\000\006D\002\000\n\028\001\000\n\024\001\000\003\248\001\000\003\244\001\000\003\240\001\000\003\236\001\000\n\028\002\000\n\024\002\000\003\248\002\000\003\244\002\000\003\240\002\000\003\236\002\000\n\028\003\000\n\024\003\000\003\248\003\000\003\244\003\000\003\240\003\000\003\236\003\000\r(\001\000\r\020\001\000\r\b\001\000\r\020\002\000\n\028\004\000\003\248\004\000\003\240\004\000\r\028\001\000\r\012\001\000\r\028\002\000\012\248\001\000\r$\001\000\r \001\000\r\024\001\000\r\016\001\000\r\024\002\000\r \002\000\012\236\001\000\r\000\001\000\012\252\001\000\012\252\002\000\012\236\002\000\tt\001\000\012\248\002\000\tx\001\000\012\248\003\000\tx\002\000\tx\003\000\n\028\005\000\003\248\005\000\003\240\005\000\005\172\001\000\003\248\006\000\003\240\006\000\012\228\001\000\005\180\001\000\001|\001\000\001x\001\000\006\212\001\000\006\196\001\000\006\180\001\000\006\172\001\000\001\200\001\000\001\196\001\000\001\128\001\000\001p\001\000\000p\001\000\000d\001\000\001p\002\000\005\172\001\000\003\184\001\000\003\184\002\000\005\172\001\000\006\228\001\000\006\224\001\000\005\172\001\000\005\132\001\000\005|\001\000\005t\001\000\005\132\002\000\005|\002\000\005t\002\000\001\248\001\000\001\248\002\000\n\244\001\000\005\228\001\000\012l\001\000\012h\001\000\003\248\001\000\003\244\001\000\012l\002\000\012h\002\000\003\248\002\000\003\244\002\000\012l\003\000\012h\003\000\003\248\003\000\003\244\003\000\012l\004\000\003\248\004\000\012l\005\000\003\248\005\000\005\172\001\000\003\248\006\000\003\248\007\000\t\028\001\000\003\248\b\000\b\180\001\000\b\180\002\000\002<\001\000\002<\002\000\002<\003\000\001d\001\000\n\204\001\000\n\184\001\000\n\184\002\000\n\184\003\000\000\236\001\000\000\232\001\000\011<\001\000\n\\\001\000\nX\001\000\nX\002\000\n\\\002\000\nT\001\000\nP\001\000\nP\002\000\nT\002\000\r4\001\000\011d\001\000\0118\001\000\0114\001\000\011,\001\000\001\144\001\000\001p\001\000\n\\\001\000\nX\001\000\0078\001\000\0118\002\000\0114\002\000\0118\003\000\0114\003\000\0118\004\000\0114\004\000\006<\001\000\0068\001\000\0118\005\000\0114\005\000\0114\006\000\0118\006\000\006P\001\000\006P\002\000\006P\003\000\006P\004\000\0064\001\000\006\020\001\000\006\020\002\000\005$\001\000\005 \001\000\004\024\001\000\000@\001\000\000<\001\000\006\236\001\000\006\232\001\000\006\236\002\000\006\236\003\000\006\236\004\000\007\252\001\000\007\248\001\000\007\244\001\000\007\240\001\000\007\236\001\000\007\232\001\000\007\228\001\000\007\224\001\000\007\220\001\000\007\216\001\000\007\252\002\000\007\248\002\000\007\244\002\000\007\240\002\000\007\236\002\000\007\232\002\000\007\228\002\000\007\224\002\000\007\252\003\000\007\248\003\000\007\244\003\000\007\240\003\000\007\236\003\000\007\232\003\000\007\228\003\000\007\224\003\000\n\172\001\000\n\172\002\000\n\172\003\000\005\220\001\000\005\232\001\000\005\224\001\000\005\232\002\000\005\224\002\000\005\232\003\000\005\224\003\000\005\252\001\000\000\228\001\000\n\172\004\000\004\244\001\000\004\244\002\000\012\148\001\000\012\144\001\000\n\156\001\000\n\160\001\000\0028\001\000\0028\002\000\0028\003\000\r4\001\000\n\180\001\000\n\176\001\000\nt\001\000\np\001\000\001\144\001\000\001p\001\000\n\204\001\000\006\248\001\000\011\b\001\000\011\004\001\000\r8\001\000\003<\001\000\0038\001\000\003<\002\000\0038\002\000\003,\001\000\nl\001\000\nh\001\000\nd\001\000\001l\001\000\001l\002\000\n`\001\000\0048\001\000\n`\002\000\n`\003\000\005d\001\000\005`\001\000\005\\\001\000\005X\001\000\007\160\001\000\001\228\001\000\001\224\001\000\007\128\001\000\001\228\002\000\001\224\002\000\001\220\001\000\001\216\001\000\001\220\002\000\001\216\002\000\001\212\001\000\001\208\001\000\001\204\001\000\000h\001\000\005\248\001\000\005\184\001\000\005\176\001\000\005\248\002\000\005\248\003\000\005\248\001\000\005\184\001\000\005\248\004\000\005\184\002\000\005\184\003\000\005\244\001\000\005\184\002\000\005\176\002\000\005\176\003\000\001X\001\000\000h\002\000\001\208\002\000\006\148\001\000\006\148\002\000\000\\\001\000\003\188\001\000\003\176\001\000\003\188\002\000\012\208\001\000\t\164\001\000\t\164\002\000\001\184\001\000\005\248\001\000\005\184\001\000\005\176\001\000\000t\001\000\005\184\002\000\005\176\002\000\000t\002\000\001\200\001\000\001\196\001\000\003\180\001\000\003\180\002\000\003\180\003\000\012\232\001\000\003\180\004\000\001\188\001\000\002\b\001\000\001\192\001\000\000X\001\000\012\204\001\000\t\168\001\000\000l\001\000\000`\001\000\t\168\002\000\t\168\003\000\000l\001\000\000`\001\000\000l\002\000\000l\003\000\000`\002\000\000D\001\000\001\196\002\000\001\180\001\000\001\196\003\000\001\180\002\000\001\176\001\000\000H\001\000\000H\002\000\000H\003\000\000H\004\000\000t\003\000\t\164\003\000\000l\001\000\000`\001\000\003\188\003\000\t\172\001\000\td\001\000\th\001\000\001\208\003\000\001\208\004\000\th\002\000\th\003\000\012\156\001\000\012\152\001\000\012\152\002\000\007t\001\000\012\152\003\000\012\152\004\000\tX\001\000\tX\002\000\tX\003\000\000H\001\000\012\152\005\000\tT\001\000\000H\001\000\012\156\002\000\t\176\001\000\001\180\001\000\t\172\001\000\001\204\002\000\001\204\003\000\001\212\002\000\001\212\003\000\th\001\000\001\212\004\000\001\212\005\000\th\001\000\001\216\003\000\001\216\004\000\th\001\000\001\228\003\000\001\224\003\000\001\224\004\000\001\228\004\000\t<\001\000\001\228\005\000\001\228\006\000\t<\002\000\t8\001\000\007\160\002\000\001\180\001\000\005d\002\000\005`\002\000\005\\\002\000\005X\002\000\007\188\001\000\bl\001\000\bl\002\000\bl\003\000\001\\\001\000\011P\001\000\011P\002\000\001h\001\000\001t\001\000\001`\001\000\011$\001\000\r<\001\000\011(\001\000\bl\004\000\0110\001\000\011D\001\000\011@\001\000\011D\002\000\011D\003\000\nL\001\000\011L\001\000\011`\001\000\011\\\001\000\011X\001\000\011T\001\000\005\232\001\000\001\140\001\000\001\136\001\000\011`\002\000\011\\\002\000\011X\002\000\011T\002\000\005\232\002\000\001\140\002\000\011`\003\000\011\\\003\000\001\140\003\000\011\\\004\000\bD\001\000\bD\002\000\bD\003\000\bH\001\000\b\\\001\000\bH\002\000\bH\003\000\bH\004\000\011h\001\000\011H\001\000\001\148\001\000\011L\001\000\bh\001\000\b4\001\000\bL\001\000\b<\001\000\bL\002\000\bP\001\000\bL\003\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bP\002\000\bP\003\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b,\002\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\003\000\b,\001\000\b@\002\000\bP\001\000\b@\003\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b8\002\000\b8\003\000\b0\002\000\011H\001\000\bd\001\000\b`\001\000\r4\001\000\011d\001\000\0118\001\000\0114\001\000\011,\001\000\bd\002\000\001\144\001\000\001p\001\000\bd\003\000\006\156\001\000\006\152\001\000\006\156\002\000\bd\004\000\bd\005\000\bd\006\000\nT\001\000\nP\001\000\007D\001\000\001\144\002\000\001\144\003\000\011d\002\000\011,\002\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\011,\003\000\011d\003\000\011d\004\000\001\180\001\000\011d\005\000\b`\002\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bh\002\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bP\001\000\bD\004\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\001\140\004\000\001\140\005\000\011`\004\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\011`\005\000\011X\003\000\nd\001\000\011X\004\000\nd\002\000\nd\003\000\t\224\001\000\t\220\001\000\t\216\001\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\t\224\002\000\t\220\002\000\t\224\003\000\011T\003\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\007\188\002\000\005d\003\000\005`\003\000\005\\\003\000\005X\003\000\005d\004\000\005`\004\000\005\\\004\000\005`\005\000\007\136\001\000\005`\006\000\005d\005\000\nl\002\000\nh\002\000\nh\003\000\011$\001\000\004\180\001\000\004\176\001\000\004h\001\000\004d\001\000\004d\002\000\0044\001\000\0040\001\000\0044\002\000\0044\003\000\001\180\001\000\004d\003\000\004d\004\000\004h\002\000\004X\001\000\004T\001\000\004T\002\000\004T\003\000\007\196\001\000\004\148\001\000\0020\001\000\002,\001\000\002(\001\000\002$\001\000\0020\002\000\002,\002\000\0020\003\000\0020\004\000\0020\005\000\006\024\001\000\006\024\002\000\003\196\001\000\003\192\001\000\003\192\002\000\003\196\002\000\003\196\003\000\006T\001\000\003\196\001\000\003\192\001\000\0068\001\000\005\180\001\000\003\252\001\000\006H\001\000\006H\002\000\t,\001\000\003\200\001\000\t,\002\000\006H\003\000\006H\004\000\006\\\001\000\006d\001\000\006`\001\000\006X\001\000\006H\005\000\006d\002\000\r\128\001\000\r|\001\000\r\128\002\000\r|\002\000\r\128\003\000\r|\003\000\r\152\001\000\r\148\001\000\r\152\002\000\r\128\004\000\r\128\005\000\000H\001\000\r|\004\000\r|\005\000\000H\001\000\r|\006\000\t\028\001\000\t\028\002\000\t\028\003\000\001\180\001\000\t\028\004\000\t\028\005\000\001\180\001\000\012\244\001\000\r\144\001\000\r\140\001\000\r\136\001\000\r\132\001\000\r\144\002\000\r\140\002\000\r\144\003\000\r\140\003\000\r\140\004\000\r\140\005\000\006d\001\000\006`\001\000\006X\001\000\006`\002\000\006d\001\000\006`\003\000\006`\001\000\006X\001\000\006X\002\000\005\248\001\000\005\216\001\000\005\184\001\000\005\216\002\000\005\184\002\000\005\184\003\000\003\252\001\000\005\216\003\000\006t\001\000\005\212\001\000\006L\001\000\006L\002\000\006d\001\000\006`\001\000\006X\001\000\006L\003\000\t(\001\000\006h\001\000\r\144\004\000\r\144\005\000\006d\001\000\006`\001\000\006X\001\000\r\136\002\000\r\132\002\000\005\232\001\000\r\132\003\000\r\132\004\000\005\248\001\000\005\184\001\000\005\232\002\000\r\136\003\000\r\136\004\000\005\248\001\000\005\184\001\000\t\\\001\000\t`\001\000\006d\003\000\t`\002\000\t`\003\000\006d\001\000\006`\001\000\006X\001\000\006T\002\000\006T\003\000\006d\001\000\006`\001\000\006X\001\000\003\196\004\000\003\196\005\000\006\024\003\000\006\024\004\000\006\028\001\000\006,\001\000\006(\001\000\006 \001\000\006\024\005\000\007\252\001\000\007\248\001\000\007\244\001\000\007\240\001\000\007\236\001\000\007\232\001\000\007\228\001\000\007\224\001\000\007\220\001\000\007\216\001\000\006,\002\000\006,\003\000\007\220\002\000\007\216\002\000\006,\001\000\006(\001\000\006 \001\000\007\220\003\000\007\216\003\000\007\216\004\000\006d\001\000\006`\001\000\006X\001\000\007\216\005\000\006(\002\000\006 \002\000\006$\001\000\005\232\001\000\0060\001\000\006,\001\000\006(\001\000\006 \001\000\0020\006\000\0020\007\000\011\020\001\000\001l\001\000\n\216\001\000\n\212\001\000\t\212\001\000\t\208\001\000\t\204\001\000\007\172\001\000\007\168\001\000\n\252\001\000\r8\001\000\005\220\001\000\n\168\001\000\n\164\001\000\n\168\002\000\n\164\002\000\n\168\003\000\n\164\003\000\002d\001\000\002d\002\000\002d\003\000\n\208\001\000\n\188\001\000\005\236\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\208\002\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\n\236\002\000\n\236\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\n\232\002\000\n\232\003\000\n\148\002\000\n\140\002\000\n\132\002\000\n\132\003\000\002T\001\000\002P\001\000\002L\001\000\002H\001\000\002D\001\000\002@\001\000\002T\002\000\002P\002\000\002L\002\000\002H\002\000\002D\002\000\002@\002\000\002T\003\000\002P\003\000\002L\003\000\002H\003\000\002D\003\000\002@\003\000\t\244\001\000\t\160\001\000\t\156\001\000\t\244\002\000\t\160\002\000\t\156\002\000\t\244\003\000\t\160\003\000\t\156\003\000\tL\001\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\005p\001\000\005l\001\000\005h\001\000\005l\002\000\0024\001\000\0024\002\000\0024\003\000\004`\001\000\004\\\001\000\b\140\001\000\004\\\002\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\004\172\001\000\004\168\001\000\004\172\002\000\004\172\003\000\001\180\001\000\004\\\003\000\004\\\004\000\004\\\005\000\b\136\001\000\004`\002\000\r4\001\000\011d\001\000\0118\001\000\0114\001\000\011,\001\000\003\148\001\000\001\144\001\000\001p\001\000\003\148\002\000\003\148\003\000\003\148\004\000\004l\001\000\004l\002\000\004p\001\000\t$\001\000\003\156\001\000\003\152\001\000\t$\002\000\0024\004\000\007\152\001\000\007\152\002\000\000l\001\000\000`\001\000\0024\005\000\0024\006\000\t\160\001\000\t\156\001\000\002\024\001\000\t\160\002\000\t\156\002\000\002\024\002\000\t\160\003\000\t\156\003\000\002\024\003\000\t\160\004\000\t\156\004\000\tP\001\000\002\024\004\000\t\160\005\000\t\156\005\000\t\160\006\000\t\160\001\000\t\156\001\000\t\160\007\000\t\160\002\000\t\156\002\000\t\160\b\000\t\160\003\000\t\156\003\000\t\160\t\000\t\160\004\000\t\156\004\000\tP\001\000\tP\002\000\tP\003\000\tH\001\000\002\\\001\000\002\\\002\000\002\\\003\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\002\\\004\000\002\\\005\000\002`\001\000\002`\002\000\002`\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\002`\004\000\n\220\002\000\n\152\002\000\n\144\002\000\n\136\002\000\n\128\002\000\n|\002\000\nx\002\000\nx\003\000\003\028\001\000\003\024\001\000\t\160\001\000\t\156\001\000\003\028\002\000\t\160\002\000\t\156\002\000\003\028\003\000\t\160\003\000\t\156\003\000\003\028\004\000\t\160\004\000\t\156\004\000\tP\001\000\003\028\005\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\003\140\001\000\003\136\001\000\003\132\001\000\003\128\001\000\003|\001\000\003x\001\000\003t\001\000\003p\001\000\003l\001\000\003h\001\000\003d\001\000\003`\001\000\003\\\001\000\003X\001\000\003T\001\000\003P\001\000\003L\001\000\003H\001\000\003D\001\000\003@\001\000\002h\001\000\002 \001\000\004H\001\000\004D\001\000\004H\002\000\004H\003\000\012\220\001\000\012\220\002\000\001\180\001\000\012\216\001\000\012\212\001\000\012\216\002\000\012\212\002\000\001\180\001\000\012\216\003\000\012\216\004\000\001\180\001\000\004H\004\000\004H\005\000\004D\002\000\004L\001\000\004L\002\000\004P\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\004P\002\000\n\200\001\000\011 \001\000\011\028\001\000\011\024\001\000\011\016\001\000\011\012\001\000\011\000\001\000\n\248\001\000\n\228\001\000\n\224\001\000\005\240\001\000\005\232\001\000\001\140\001\000\001\136\001\000\011 \002\000\011\028\002\000\011\024\002\000\011\016\002\000\011\012\002\000\011\000\002\000\n\248\002\000\n\228\002\000\n\224\002\000\005\240\002\000\005\232\002\000\001\140\002\000\r4\001\000\011 \003\000\n\248\003\000\n\224\003\000\001\140\003\000\n\248\004\000\007<\001\000\000@\001\000\0078\001\000\000<\001\000\011 \004\000\011 \005\000\011 \006\000\011 \007\000\006,\001\000\006(\001\000\006 \001\000\011 \b\000\011 \t\000\006d\001\000\006`\001\000\006X\001\000\011 \n\000\012\148\001\000\007H\001\000\012\144\001\000\007D\001\000\006\252\001\000\003,\001\000\b\\\001\000\004\184\001\000\004\184\002\000\004\184\003\000\001\180\001\000\004\184\004\000\004\184\005\000\t\144\001\000\t\140\001\000\002l\001\000\t\144\002\000\t\140\002\000\t\160\001\000\t\156\001\000\t\144\003\000\t\160\002\000\t\156\002\000\t\144\004\000\t\160\003\000\t\156\003\000\t\144\005\000\t\160\004\000\t\156\004\000\t\144\006\000\tP\001\000\n\200\001\000\002t\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\002t\002\000\r@\001\000\n\240\001\000\n\196\001\000\n\192\001\000\004\152\001\000\003(\001\000\003(\002\000\003(\003\000\t\240\001\000\t\152\001\000\t\148\001\000\003\172\001\000\003\168\001\000\003\164\001\000\003\160\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\204\002\000\002\200\002\000\t\160\001\000\t\156\001\000\002\204\003\000\t\160\002\000\t\156\002\000\002\204\004\000\t\160\003\000\t\156\003\000\002\204\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\204\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\003\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\180\002\000\002\176\002\000\t\160\001\000\t\156\001\000\002\180\003\000\t\160\002\000\t\156\002\000\002\180\004\000\t\160\003\000\t\156\003\000\002\180\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\180\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\003\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\172\002\000\002\168\002\000\t\160\001\000\t\156\001\000\002\172\003\000\t\160\002\000\t\156\002\000\002\172\004\000\t\160\003\000\t\156\003\000\002\172\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\172\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\003\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\164\002\000\002\160\002\000\t\160\001\000\t\156\001\000\002\164\003\000\t\160\002\000\t\156\002\000\002\164\004\000\t\160\003\000\t\156\003\000\002\164\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\164\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\003\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\212\002\000\002\208\002\000\t\160\001\000\t\156\001\000\002\212\003\000\t\160\002\000\t\156\002\000\002\212\004\000\t\160\003\000\t\156\003\000\002\212\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\212\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\003\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\244\002\000\002\240\002\000\t\160\001\000\t\156\001\000\002\244\003\000\t\160\002\000\t\156\002\000\002\244\004\000\t\160\003\000\t\156\003\000\002\244\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\244\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\003\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\196\002\000\002\192\002\000\t\160\001\000\t\156\001\000\002\196\003\000\t\160\002\000\t\156\002\000\002\196\004\000\t\160\003\000\t\156\003\000\002\196\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\196\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\003\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\188\002\000\002\184\002\000\t\160\001\000\t\156\001\000\002\188\003\000\t\160\002\000\t\156\002\000\002\188\004\000\t\160\003\000\t\156\003\000\002\188\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\188\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\003\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\228\002\000\002\224\002\000\t\160\001\000\t\156\001\000\002\228\003\000\t\160\002\000\t\156\002\000\002\228\004\000\t\160\003\000\t\156\003\000\002\228\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\228\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\003\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\156\002\000\002\152\002\000\t\160\001\000\t\156\001\000\002\156\003\000\t\160\002\000\t\156\002\000\002\156\004\000\t\160\003\000\t\156\003\000\002\156\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\156\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\003\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\148\002\000\002\144\002\000\t\160\001\000\t\156\001\000\002\148\003\000\t\160\002\000\t\156\002\000\002\148\004\000\t\160\003\000\t\156\003\000\002\148\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\148\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\003\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\140\002\000\002\136\002\000\t\160\001\000\t\156\001\000\002\140\003\000\t\160\002\000\t\156\002\000\002\140\004\000\t\160\003\000\t\156\003\000\002\140\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\140\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\003\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\132\002\000\002\128\002\000\t\160\001\000\t\156\001\000\002\132\003\000\t\160\002\000\t\156\002\000\002\132\004\000\t\160\003\000\t\156\003\000\002\132\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\132\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\003\000\002\128\001\000\002|\001\000\002x\001\000\002|\002\000\002x\002\000\t\160\001\000\t\156\001\000\002|\003\000\t\160\002\000\t\156\002\000\002|\004\000\t\160\003\000\t\156\003\000\002|\005\000\t\160\004\000\t\156\004\000\tP\001\000\002|\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\003\000\002x\001\000\002\236\002\000\002\232\002\000\t\160\001\000\t\156\001\000\002\236\003\000\t\160\002\000\t\156\002\000\002\236\004\000\t\160\003\000\t\156\003\000\002\236\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\236\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\003\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\220\002\000\002\216\002\000\t\160\001\000\t\156\001\000\002\220\003\000\t\160\002\000\t\156\002\000\002\220\004\000\t\160\003\000\t\156\003\000\002\220\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\220\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\003\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\t\152\002\000\t\148\002\000\t\160\001\000\t\156\001\000\t\152\003\000\t\160\002\000\t\156\002\000\t\152\004\000\t\160\003\000\t\156\003\000\t\152\005\000\t\160\004\000\t\156\004\000\t\152\006\000\tP\001\000\t\152\001\000\t\148\003\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\020\002\000\003\016\002\000\t\160\001\000\t\156\001\000\003\020\003\000\t\160\002\000\t\156\002\000\003\020\004\000\t\160\003\000\t\156\003\000\003\020\005\000\t\160\004\000\t\156\004\000\tP\001\000\003\020\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\003\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\0034\002\000\0030\002\000\t\160\001\000\t\156\001\000\0034\003\000\t\160\002\000\t\156\002\000\0034\004\000\t\160\003\000\t\156\003\000\0034\005\000\t\160\004\000\t\156\004\000\tP\001\000\0034\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\003\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002\252\002\000\002\248\002\000\t\160\001\000\t\156\001\000\002\252\003\000\t\160\002\000\t\156\002\000\002\252\004\000\t\160\003\000\t\156\003\000\002\252\005\000\t\160\004\000\t\156\004\000\tP\001\000\002\252\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\003\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\004\002\000\003\000\002\000\t\160\001\000\t\156\001\000\003\004\003\000\t\160\002\000\t\156\002\000\003\004\004\000\t\160\003\000\t\156\003\000\003\004\005\000\t\160\004\000\t\156\004\000\tP\001\000\003\004\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\003\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\012\002\000\003\b\002\000\t\160\001\000\t\156\001\000\003\012\003\000\t\160\002\000\t\156\002\000\003\012\004\000\t\160\003\000\t\156\003\000\003\012\005\000\t\160\004\000\t\156\004\000\tP\001\000\003\012\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\003\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\144\002\000\n\196\001\000\002p\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\002p\002\000\003$\001\000\003 \001\000\t\160\001\000\t\156\001\000\003$\002\000\t\160\002\000\t\156\002\000\003$\003\000\t\160\003\000\t\156\003\000\003$\004\000\t\160\004\000\t\156\004\000\tP\001\000\003$\005\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003 \002\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\003\172\002\000\003\168\002\000\003\164\002\000\003\172\003\000\003\172\004\000\003\172\005\000\003\168\003\000\000L\001\000\000L\002\000\011$\001\000\004\136\001\000\004\132\001\000\004\128\001\000\004|\001\000\004x\001\000\012@\001\000\012@\002\000\012\216\001\000\012\212\001\000\004\136\002\000\004\132\002\000\004\136\003\000\004\136\004\000\004\136\005\000\004\136\006\000\001\180\001\000\004\136\007\000\004\136\b\000\tD\001\000\004\132\003\000\tD\002\000\tD\003\000\004\132\004\000\004\132\005\000\001\180\001\000\004\132\006\000\004\132\007\000\004\128\002\000\004\128\003\000\004\128\004\000\004|\002\000\012D\001\000\007\204\001\000\012D\002\000\012D\003\000\002\028\001\000\012D\004\000\t \001\000\011(\001\000\004\144\001\000\004\144\002\000\004\144\003\000\001\180\001\000\004\144\004\000\004\144\005\000\b\132\001\000\b|\001\000\bt\001\000\bp\001\000\bX\001\000\004\140\001\000\004\140\002\000\004\140\003\000\bX\002\000\bX\003\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\bp\002\000\bp\003\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b\132\002\000\b\132\003\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b|\002\000\b|\003\000\bt\002\000\bx\001\000\b\128\001\000\bT\001\000\bT\002\000\bT\003\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\004t\001\000\000L\003\000\005\012\001\000\005\012\002\000\000L\004\000\004\152\002\000\t\152\001\000\t\148\001\000\t\140\003\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\b\132\001\000\b|\001\000\bt\001\000\bp\001\000\bX\001\000\004\188\001\000\004\188\002\000\004\188\003\000\004\196\001\000\003,\002\000\003,\003\000\003,\004\000\004\196\002\000\004\196\003\000\004\192\001\000\n\208\001\000\007 \001\000\n\224\004\000\n\224\005\000\011\016\003\000\011\012\003\000\t\200\001\000\t\192\001\000\t\188\001\000\t\160\001\000\t\156\001\000\t\200\002\000\t\192\002\000\t\188\002\000\t\160\002\000\t\156\002\000\t\200\003\000\t\192\003\000\t\188\003\000\t\160\003\000\t\156\003\000\t\200\004\000\t\192\004\000\t\188\004\000\t\160\004\000\t\156\004\000\tP\001\000\t\200\005\000\t\192\005\000\t\200\006\000\t\196\001\000\t\184\001\000\t\180\001\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\t\196\002\000\t\184\002\000\t\196\003\000\011\016\004\000\011\012\004\000\011\012\005\000\011\028\003\000\011\024\003\000\011\028\004\000\011\024\004\000\011\024\005\000\n\228\003\000\n\228\004\000\n\228\005\000\011\000\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\b\228\001\000\b\228\002\000\b\228\003\000\t\236\001\000\t\232\001\000\t\228\001\000\t\236\002\000\t\232\002\000\t\228\002\000\t\236\003\000\t\232\003\000\t\228\003\000\t\236\004\000\t\232\004\000\t\236\005\000\b\224\001\000\011\000\004\000\011\000\005\000\011 \001\000\011\028\001\000\011\024\001\000\011\016\001\000\011\012\001\000\011\000\001\000\n\248\001\000\n\228\001\000\n\224\001\000\005\240\001\000\005\232\001\000\005\224\001\000\001\140\001\000\001\136\001\000\011 \002\000\011\028\002\000\011\024\002\000\011\016\002\000\011\012\002\000\011\000\002\000\n\248\002\000\n\228\002\000\n\224\002\000\005\240\002\000\005\232\002\000\005\224\002\000\001\140\002\000\r8\001\000\005\224\003\000\005\240\003\000\004@\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\004@\002\000\n\148\002\000\n\140\002\000\n\132\002\000\003\132\002\000\003\128\002\000\003t\002\000\003p\002\000\003d\002\000\003`\002\000\n\132\003\000\003d\003\000\003`\003\000\n\132\004\000\003d\004\000\003`\004\000\n\132\005\000\003d\005\000\003`\005\000\003d\006\000\003`\006\000\t\160\001\000\t\156\001\000\003d\007\000\t\160\002\000\t\156\002\000\003d\b\000\t\160\003\000\t\156\003\000\003d\t\000\t\160\004\000\t\156\004\000\tP\001\000\003d\n\000\t\152\001\000\t\148\001\000\003\144\001\000\003`\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\148\003\000\003\132\003\000\003\128\003\000\n\148\004\000\003\132\004\000\003\128\004\000\n\148\005\000\003\132\005\000\003\128\005\000\003\132\006\000\003\128\006\000\t\160\001\000\t\156\001\000\003\132\007\000\t\160\002\000\t\156\002\000\003\132\b\000\t\160\003\000\t\156\003\000\003\132\t\000\t\160\004\000\t\156\004\000\tP\001\000\003\132\n\000\t\152\001\000\t\148\001\000\003\144\001\000\003\128\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\140\003\000\003t\003\000\003p\003\000\n\140\004\000\003t\004\000\003p\004\000\n\140\005\000\003t\005\000\003p\005\000\003t\006\000\003p\006\000\t\160\001\000\t\156\001\000\003t\007\000\t\160\002\000\t\156\002\000\003t\b\000\t\160\003\000\t\156\003\000\003t\t\000\t\160\004\000\t\156\004\000\tP\001\000\003t\n\000\t\152\001\000\t\148\001\000\003\144\001\000\003p\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\220\002\000\n\152\002\000\n\144\002\000\n\136\002\000\n\128\002\000\n|\002\000\nx\002\000\003\140\002\000\003\136\002\000\003|\002\000\003x\002\000\003l\002\000\003h\002\000\003\\\002\000\003X\002\000\003T\002\000\003P\002\000\003L\002\000\003H\002\000\003D\002\000\003@\002\000\nx\003\000\003L\003\000\003H\003\000\nx\004\000\003L\004\000\003H\004\000\nx\005\000\003L\005\000\003H\005\000\003L\006\000\003H\006\000\t\160\001\000\t\156\001\000\003L\007\000\t\160\002\000\t\156\002\000\003L\b\000\t\160\003\000\t\156\003\000\003L\t\000\t\160\004\000\t\156\004\000\tP\001\000\003L\n\000\t\152\001\000\t\148\001\000\003\144\001\000\003H\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\128\003\000\003\\\003\000\003X\003\000\n\128\004\000\003\\\004\000\003X\004\000\n\128\005\000\003\\\005\000\003X\005\000\003\\\006\000\003X\006\000\t\160\001\000\t\156\001\000\003\\\007\000\t\160\002\000\t\156\002\000\003\\\b\000\t\160\003\000\t\156\003\000\003\\\t\000\t\160\004\000\t\156\004\000\tP\001\000\003\\\n\000\t\152\001\000\t\148\001\000\003\144\001\000\003X\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n|\003\000\003T\003\000\003P\003\000\n|\004\000\003T\004\000\003P\004\000\n|\005\000\003T\005\000\003P\005\000\003T\006\000\003P\006\000\t\160\001\000\t\156\001\000\003T\007\000\t\160\002\000\t\156\002\000\003T\b\000\t\160\003\000\t\156\003\000\003T\t\000\t\160\004\000\t\156\004\000\tP\001\000\003T\n\000\t\152\001\000\t\148\001\000\003\144\001\000\003P\007\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\152\003\000\n\144\003\000\n\136\003\000\005\232\001\000\005\224\001\000\003\140\003\000\003\136\003\000\003|\003\000\003x\003\000\003l\003\000\003h\003\000\n\152\004\000\n\144\004\000\n\136\004\000\003\140\004\000\003\136\004\000\003|\004\000\003x\004\000\003l\004\000\003h\004\000\n\136\005\000\003l\005\000\003h\005\000\n\136\006\000\003l\006\000\003h\006\000\n\136\007\000\003l\007\000\003h\007\000\003l\b\000\003h\b\000\t\160\001\000\t\156\001\000\003l\t\000\t\160\002\000\t\156\002\000\003l\n\000\t\160\003\000\t\156\003\000\003l\011\000\t\160\004\000\t\156\004\000\tP\001\000\003l\012\000\t\152\001\000\t\148\001\000\003\144\001\000\003h\t\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\152\005\000\003\140\005\000\003\136\005\000\n\152\006\000\003\140\006\000\003\136\006\000\n\152\007\000\003\140\007\000\003\136\007\000\003\140\b\000\003\136\b\000\t\160\001\000\t\156\001\000\003\140\t\000\t\160\002\000\t\156\002\000\003\140\n\000\t\160\003\000\t\156\003\000\003\140\011\000\t\160\004\000\t\156\004\000\tP\001\000\003\140\012\000\t\152\001\000\t\148\001\000\003\144\001\000\003\136\t\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\144\005\000\003|\005\000\003x\005\000\n\144\006\000\003|\006\000\003x\006\000\n\144\007\000\003|\007\000\003x\007\000\003|\b\000\003x\b\000\t\160\001\000\t\156\001\000\003|\t\000\t\160\002\000\t\156\002\000\003|\n\000\t\160\003\000\t\156\003\000\003|\011\000\t\160\004\000\t\156\004\000\tP\001\000\003|\012\000\t\152\001\000\t\148\001\000\003\144\001\000\003x\t\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\220\003\000\003D\003\000\003@\003\000\003D\004\000\003@\004\000\t\160\001\000\t\156\001\000\003D\005\000\t\160\002\000\t\156\002\000\003D\006\000\t\160\003\000\t\156\003\000\003D\007\000\t\160\004\000\t\156\004\000\tP\001\000\003D\b\000\t\152\001\000\t\148\001\000\003\144\001\000\003@\005\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\004<\001\000\t4\001\000\002h\002\000\t4\002\000\t0\001\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\024\002\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\nx\004\000\nx\005\000\n\128\003\000\n\128\004\000\n\128\005\000\n|\003\000\n|\004\000\n|\005\000\n\152\003\000\n\144\003\000\n\136\003\000\005\232\001\000\005\224\001\000\n\152\004\000\n\144\004\000\n\136\004\000\n\136\005\000\n\136\006\000\n\136\007\000\n\152\005\000\n\152\006\000\n\152\007\000\n\144\005\000\n\144\006\000\n\144\007\000\n\220\003\000\002\\\006\000\001\232\001\000\001\236\001\000\002\\\007\000\002\\\b\000\002\\\t\000\002\\\n\000\002\\\011\000\t\156\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\0024\007\000\005l\003\000\005l\004\000\005l\005\000\005p\002\000\005h\002\000\005p\003\000\005h\003\000\tL\002\000\t\244\004\000\t\160\004\000\t\156\004\000\tP\001\000\002T\004\000\002P\004\000\002L\004\000\002H\004\000\002D\004\000\002@\004\000\002T\005\000\002P\005\000\002L\005\000\002H\005\000\002D\005\000\002@\005\000\t\160\001\000\t\156\001\000\002T\006\000\002L\006\000\002H\006\000\t\160\002\000\t\156\002\000\002T\007\000\002L\007\000\002H\007\000\t\160\003\000\t\156\003\000\002T\b\000\002L\b\000\002H\b\000\t\160\004\000\t\156\004\000\tP\001\000\002T\t\000\002L\t\000\002H\t\000\002L\n\000\002H\n\000\t\160\001\000\t\156\001\000\002L\011\000\t\160\002\000\t\156\002\000\002L\012\000\t\160\003\000\t\156\003\000\002L\r\000\t\160\004\000\t\156\004\000\tP\001\000\002L\014\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002H\011\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002P\006\000\002D\006\000\002@\006\000\002D\007\000\002@\007\000\t\160\001\000\t\156\001\000\002D\b\000\t\160\002\000\t\156\002\000\002D\t\000\t\160\003\000\t\156\003\000\002D\n\000\t\160\004\000\t\156\004\000\tP\001\000\002D\011\000\t\152\001\000\t\148\001\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\002@\b\000\n\132\004\000\n\132\005\000\n\148\003\000\n\148\004\000\n\148\005\000\n\140\003\000\n\140\004\000\n\140\005\000\n\236\001\000\n\232\001\000\n\220\001\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\002d\004\000\n\168\004\000\n\164\004\000\n\164\005\000\n\252\002\000\n\252\003\000\t\160\001\000\t\156\001\000\007\172\002\000\t\160\002\000\t\156\002\000\007\172\003\000\t\160\003\000\t\156\003\000\007\172\004\000\t\160\004\000\t\156\004\000\tP\001\000\007\172\005\000\t\152\001\000\t\148\001\000\007\168\002\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\t\212\002\000\t\208\002\000\t\204\002\000\t\212\003\000\t\208\003\000\t\212\004\000\n\216\002\000\n\212\002\000\n\212\003\000\011\020\002\000\011\020\003\000\0020\b\000\002,\003\000\002,\004\000\006,\001\000\006(\001\000\006 \001\000\002,\005\000\002,\006\000\002,\007\000\002$\002\000\002$\003\000\002$\004\000\002$\005\000\006\000\001\000\006,\001\000\006(\001\000\006 \001\000\006\000\002\000\006\004\001\000\006d\001\000\006`\001\000\006X\001\000\006\004\002\000\006\004\003\000\006,\001\000\006(\001\000\006 \001\000\006\004\004\000\002$\006\000\002$\007\000\002$\b\000\006\b\001\000\006\b\002\000\002(\002\000\002(\003\000\002(\004\000\001|\001\000\001\128\001\000\001p\001\000\001\128\002\000\001\128\003\000\001l\001\000\002(\005\000\003\208\001\000\001\164\001\000\006|\001\000\004 \001\000\004\028\001\000\004 \002\000\004\028\002\000\004 \003\000\004\028\003\000\tD\001\000\b\176\001\000\b\176\002\000\b\176\003\000\000H\001\000\004 \004\000\004\028\004\000\004 \005\000\004\028\005\000\004 \006\000\004 \007\000\b\172\001\000\000H\001\000\001\164\002\000\001\164\003\000\004,\001\000\004(\001\000\004,\002\000\004$\001\000\t\128\001\000\001\160\001\000\t\128\002\000\001\160\002\000\t\128\003\000\001\160\003\000\000l\001\000\000`\001\000\003\208\002\000\t|\001\000\001\156\001\000\000l\001\000\000`\001\000\003\224\001\000\003\220\001\000\003\216\001\000\003\212\001\000\tD\001\000\003\224\002\000\003\216\002\000\003\224\003\000\003\216\003\000\003\216\004\000\003\216\005\000\003\216\006\000\000l\001\000\000`\001\000\t|\001\000\003\224\004\000\001\156\001\000\000l\001\000\000`\001\000\003\212\002\000\003\212\003\000\003\212\004\000\000l\001\000\000`\001\000\t|\001\000\003\220\002\000\001\156\001\000\000l\001\000\000`\001\000\002(\006\000\002(\007\000\002(\b\000\002(\t\000\001\132\001\000\004\148\002\000\004\148\003\000\b\220\001\000\004\148\004\000\004\148\005\000\004\148\006\000\007\196\002\000\004T\004\000\004T\005\000\004X\002\000\004\176\002\000\t\160\001\000\t\156\001\000\003<\003\000\t\160\002\000\t\156\002\000\003<\004\000\t\160\003\000\t\156\003\000\003<\005\000\t\160\004\000\t\156\004\000\tP\001\000\003<\006\000\t\152\001\000\t\148\001\000\003\144\001\000\0038\003\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\011\b\002\000\011\004\002\000\011\004\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\204\002\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\n\180\002\000\n\176\002\000\n\180\003\000\n\176\003\000\n\180\004\000\n\176\004\000\n\180\005\000\n\176\005\000\006,\001\000\006(\001\000\006 \001\000\n\176\006\000\n\180\006\000\n\180\007\000\006d\001\000\006`\001\000\006X\001\000\n\180\b\000\nt\002\000\np\002\000\np\003\000\nt\003\000\nt\004\000\0028\004\000\0028\005\000\tP\001\000\0028\006\000\n\160\002\000\n\160\003\000\n\236\001\000\n\232\001\000\n\220\001\000\n\156\002\000\n\152\001\000\n\148\001\000\n\144\001\000\n\140\001\000\n\136\001\000\n\132\001\000\n\128\001\000\n|\001\000\nx\001\000\t\160\001\000\t\156\001\000\007\252\004\000\007\244\004\000\007\236\004\000\007\228\004\000\t\160\002\000\t\156\002\000\007\252\005\000\007\244\005\000\007\236\005\000\007\228\005\000\t\160\003\000\t\156\003\000\007\252\006\000\007\244\006\000\007\236\006\000\007\228\006\000\t\160\004\000\t\156\004\000\tP\001\000\007\252\007\000\007\244\007\000\007\236\007\000\007\228\007\000\007\228\b\000\007\252\b\000\007\252\t\000\006d\001\000\006`\001\000\006X\001\000\007\252\n\000\007\244\b\000\007\236\b\000\007\244\t\000\007\236\t\000\006d\001\000\006`\001\000\006X\001\000\007\236\n\000\007\244\n\000\007\244\011\000\006d\001\000\006`\001\000\006X\001\000\007\244\012\000\t\152\001\000\t\148\001\000\007\248\004\000\007\240\004\000\007\232\004\000\007\224\004\000\003\144\001\000\0034\001\000\0030\001\000\003\020\001\000\003\016\001\000\003\012\001\000\003\b\001\000\003\004\001\000\003\000\001\000\002\252\001\000\002\248\001\000\002\244\001\000\002\240\001\000\002\236\001\000\002\232\001\000\002\228\001\000\002\224\001\000\002\220\001\000\002\216\001\000\002\212\001\000\002\208\001\000\002\204\001\000\002\200\001\000\002\196\001\000\002\192\001\000\002\188\001\000\002\184\001\000\002\180\001\000\002\176\001\000\002\172\001\000\002\168\001\000\002\164\001\000\002\160\001\000\002\156\001\000\002\152\001\000\002\148\001\000\002\144\001\000\002\140\001\000\002\136\001\000\002\132\001\000\002\128\001\000\002|\001\000\002x\001\000\007\224\005\000\007\248\005\000\007\248\006\000\006d\001\000\006`\001\000\006X\001\000\007\248\007\000\007\240\005\000\007\232\005\000\007\240\006\000\007\232\006\000\006d\001\000\006`\001\000\006X\001\000\007\232\007\000\007\240\007\000\007\240\b\000\006d\001\000\006`\001\000\006X\001\000\007\240\t\000\006\236\005\000\006,\001\000\006(\001\000\006 \001\000\006\236\006\000\006\232\002\000\006\232\003\000\006\232\004\000\006,\001\000\006(\001\000\006 \001\000\006\232\005\000\012x\001\000\012t\001\000\006l\001\000\006l\002\000\006l\003\000\006l\004\000\006l\005\000\007\180\001\000\007\180\002\000\006d\001\000\006`\001\000\006X\001\000\006l\006\000\006l\007\000\012x\002\000\012t\002\000\012x\003\000\012t\003\000\012x\004\000\012x\005\000\012x\006\000\012x\007\000\004\228\001\000\004\228\002\000\004\228\003\000\004\228\004\000\004\228\005\000\004\228\006\000\012x\b\000\012t\004\000\012t\005\000\012t\006\000\004\020\001\000\004\020\002\000\b\160\001\000\b\156\001\000\b\160\002\000\b\156\002\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b\160\003\000\b\160\004\000\002\012\001\000\002\012\002\000\012\140\001\000\012\140\002\000\012\140\003\000\012\140\004\000\006,\001\000\006(\001\000\006 \001\000\012\140\005\000\b\184\001\000\b\184\002\000\b\184\003\000\b\184\004\000\b\184\005\000\tD\001\000\b\168\001\000\b\168\002\000\b\168\003\000\001\180\001\000\b\184\006\000\b\184\007\000\006\164\001\000\006\160\001\000\006\164\002\000\b\184\b\000\b\184\t\000\b\164\001\000\001\180\001\000\012<\001\000\t\248\001\000\012<\002\000\t\248\002\000\012<\003\000\t\248\003\000\012<\004\000\t\248\004\000\012<\005\000\001\144\001\000\001p\001\000\005\232\001\000\001\140\001\000\001\136\001\000\005\232\002\000\001\140\002\000\001\140\003\000\012<\006\000\012<\007\000\012<\b\000\t\248\005\000\t\248\006\000\t\248\007\000\b\152\001\000\b\148\001\000\005\020\001\000\006\244\001\000\006\240\001\000\006\244\002\000\006\244\003\000\006\244\004\000\006\244\005\000\005\248\001\000\005\184\001\000\006\244\006\000\006\240\002\000\006\240\003\000\006\240\004\000\005\248\001\000\005\184\001\000\006\240\005\000\n0\001\000\n(\001\000\n$\001\000\006p\001\000\006l\001\000\006@\001\000\006p\002\000\006l\002\000\006p\003\000\006l\003\000\006p\004\000\006l\004\000\006p\005\000\006l\005\000\006p\006\000\006p\007\000\006d\001\000\006`\001\000\006X\001\000\006p\b\000\n0\002\000\n(\002\000\n$\002\000\006@\002\000\n0\003\000\n(\003\000\n$\003\000\006@\003\000\006@\004\000\0068\001\000\006@\005\000\006@\006\000\005\248\001\000\005\184\001\000\006@\007\000\n0\004\000\n0\005\000\n0\006\000\n0\007\000\006d\001\000\006`\001\000\006X\001\000\n0\b\000\004\236\001\000\004\236\002\000\004\236\003\000\004\236\004\000\006d\001\000\006`\001\000\006X\001\000\004\236\005\000\004\236\006\000\004\236\007\000\n0\t\000\n(\004\000\n$\004\000\n(\005\000\n(\006\000\005\232\001\000\n(\007\000\006\012\001\000\006d\001\000\006`\001\000\006X\001\000\006\012\002\000\n$\005\000\n$\006\000\006\016\001\000\006\016\002\000\n@\001\000\n@\002\000\n@\003\000\n@\004\000\006d\001\000\006`\001\000\006X\001\000\n@\005\000\t\248\001\000\t\248\002\000\t\248\003\000\t\248\004\000\nD\001\000\001T\001\000\001T\002\000\001T\003\000\001T\004\000\r`\001\000\001T\005\000\002\020\001\000\tx\001\000\002\020\002\000\002\020\003\000\001T\006\000\001T\007\000\001T\b\000\001 \001\000\001 \002\000\000\244\001\000\001\180\001\000\000\244\002\000\000\244\003\000\001 \003\000\001\000\001\000\001\000\002\000\006\144\001\000\006\136\001\000\006\144\002\000\006\140\001\000\006\132\001\000\006\140\002\000\001\000\003\000\001\000\004\000\001\000\005\000\001\180\001\000\001\000\006\000\001\000\007\000\001\004\001\000\001\004\002\000\b\212\001\000\b\204\001\000\b\212\002\000\b\208\001\000\b\200\001\000\b\208\002\000\001\004\003\000\001\004\004\000\001\004\005\000\001\004\006\000\001\004\007\000\000\252\001\000\000\252\002\000\001,\001\000\001(\001\000\001,\002\000\001(\002\000\001,\003\000\001,\004\000\005\232\001\000\001,\005\000\001,\006\000\001\024\001\000\tp\001\000\001\024\002\000\001\024\003\000\001\024\004\000\tp\002\000\tp\003\000\001\180\001\000\tl\001\000\001\180\001\000\001\028\001\000\001\020\001\000\001,\007\000\001$\001\000\001$\002\000\001(\003\000\005\232\001\000\001(\004\000\001(\005\000\001(\006\000\001$\001\000\001$\001\000\000\252\003\000\000\252\004\000\001\b\001\000\001\b\002\000\001\180\001\000\001\152\001\000\001\152\002\000\001\180\001\000\001\152\003\000\001\b\003\000\001\b\004\000\001 \004\000\001 \005\000\001\012\001\000\001\012\002\000\001\016\001\000\0050\001\000\0050\002\000\001T\t\000\001$\001\000\001T\n\000\004\220\001\000\004\220\002\000\004\220\003\000\004\220\004\000\004\220\005\000\004\220\006\000\004\220\007\000\001$\001\000\004\220\b\000\004\220\t\000\001T\011\000\nD\002\000\nD\003\000\nD\004\000\nD\005\000\nD\006\000\nD\007\000\005\172\001\000\001L\001\000\001L\002\000\001L\003\000\001L\004\000\001\212\001\000\001\208\001\000\001\204\001\000\001\024\001\000\t\176\001\000\tl\001\000\001\180\001\000\001P\001\000\001P\002\000\001H\001\000\001H\002\000\001H\003\000\012\232\001\000\001X\001\000\002\b\001\000\001\028\001\000\001H\004\000\001D\001\000\001$\001\000\001P\003\000\001L\005\000\nD\b\000\nD\t\000\004\212\001\000\004\212\002\000\004\212\003\000\004\212\004\000\004\212\005\000\004\212\006\000\004\212\007\000\004\212\b\000\004\212\t\000\nD\n\000\n\b\001\000\005\024\001\000\n \001\000\n\012\001\000\n<\001\000\n8\001\000\n4\001\000\n,\001\000\005\024\002\000\n\000\001\000\n\000\002\000\n\016\001\000\004\252\001\000\004\252\002\000\004\252\003\000\004\252\004\000\004\252\005\000\t\028\001\000\004\252\006\000\004\252\007\000\004\252\b\000\n\016\002\000\n\020\001\000\005\004\001\000\005\004\002\000\005\004\003\000\005\004\004\000\005\004\005\000\001\212\001\000\001\208\001\000\001\204\001\000\001l\001\000\006\208\001\000\006\208\002\000\006\208\003\000\006\192\001\000\003\228\001\000\001\168\001\000\003\228\002\000\003\228\003\000\003\228\004\000\b\240\001\000\001\172\001\000\003\228\001\000\b\240\002\000\005\004\006\000\t\028\001\000\005\004\007\000\005\004\b\000\005\004\t\000\b\232\001\000\b\236\001\000\006\220\001\000\006\216\001\000\006\204\001\000\006\200\001\000\006\188\001\000\006\184\001\000\006\168\001\000\001\180\001\000\006\220\002\000\006\216\002\000\006\204\002\000\006\200\002\000\006\188\002\000\006\184\002\000\006\220\003\000\006\204\003\000\006\188\003\000\006\220\004\000\006\220\005\000\006\220\006\000\006\204\004\000\006\188\004\000\003\232\001\000\003\232\002\000\003\232\003\000\006\216\003\000\006\216\004\000\006\216\005\000\006\200\003\000\006\184\003\000\006\176\001\000\n\020\002\000\n\004\001\000\nH\001\000\005\020\002\000\b\148\002\000\t\252\001\000\b\152\002\000\001\180\001\000\012\132\001\000\001T\001\000\012\132\002\000\012\132\003\000\012\132\004\000\012\132\005\000\012\132\006\000\000\208\001\000\001@\001\000\001@\002\000\001@\003\000\000\184\001\000\rT\001\000\rL\001\000\rT\002\000\rL\002\000\rT\003\000\rL\003\000\rT\004\000\rL\004\000\rL\005\000\rL\006\000\rT\005\000\rT\006\000\rT\007\000\000\184\002\000\000\184\003\000\rP\001\000\rH\001\000\rD\001\000\rl\001\000\rd\001\000\rl\002\000\rh\001\000\006|\001\000\rh\002\000\rD\002\000\rD\003\000\rD\004\000\rD\005\000\001\180\001\000\rP\002\000\rH\002\000\rP\003\000\rH\003\000\rH\004\000\rH\005\000\rP\004\000\rP\005\000\rP\006\000\000\188\001\000\005\168\001\000\005\160\001\000\005\152\001\000\005\168\002\000\005\160\002\000\005\152\002\000\b\192\001\000\005\168\003\000\005\160\003\000\005\152\003\000\005\168\004\000\005\160\004\000\005\152\004\000\005\168\005\000\005\160\005\000\005\168\006\000\005\168\007\000\005\168\b\000\005\168\t\000\001\180\001\000\005\168\n\000\005\168\011\000\005\160\006\000\005\160\007\000\005\160\b\000\005\152\005\000\000\188\002\000\000\188\003\000\005\164\001\000\005\156\001\000\005\148\001\000\005\144\001\000\rx\001\000\rp\001\000\rx\002\000\rt\001\000\b\192\001\000\rt\002\000\005\144\002\000\005\144\003\000\005\144\004\000\005\144\005\000\005\164\002\000\005\156\002\000\005\148\002\000\005\164\003\000\005\156\003\000\005\148\003\000\005\164\004\000\005\156\004\000\005\164\005\000\005\164\006\000\005\164\007\000\005\164\b\000\001\180\001\000\005\164\t\000\005\164\n\000\005\156\005\000\005\156\006\000\005\156\007\000\005\148\004\000\000\196\001\000\000\196\002\000\000\196\003\000\000\196\004\000\000\180\001\000\000\176\001\000\000\180\002\000\000\180\003\000\001<\001\000\0010\001\000\004\160\001\000\004\156\001\000\000\160\001\000\000\156\001\000\004\160\002\000\004\160\003\000\004\160\004\000\004\160\005\000\004\160\006\000\004\160\007\000\000\160\002\000\000\156\002\000\000\160\003\000\000\160\004\000\005\232\001\000\000\160\005\000\000\160\006\000\0018\001\000\tp\001\000\0018\002\000\0018\003\000\0018\004\000\000\148\001\000\000\148\002\000\000\224\001\000\000\220\001\000\000\220\002\000\004\164\001\000\000\152\001\000\000\152\002\000\000\172\001\000\000\168\001\000\000\144\001\000\t4\001\000\000\168\002\000\0014\001\000\000\164\001\000\000\152\003\000\000\164\002\000\004\164\002\000\000\220\003\000\000\164\001\000\000\224\002\000\000\148\003\000\000\164\001\000\000\160\007\000\000\156\003\000\005\232\001\000\000\156\004\000\000\156\005\000\000\164\001\000\000\156\006\000\004\156\002\000\004\156\003\000\004\156\004\000\004\156\005\000\001<\002\000\0010\002\000\000\164\001\000\0010\003\000\001<\003\000\001<\004\000\001<\005\000\000\180\004\000\000\164\001\000\007\144\001\000\007\144\002\000\000\180\005\000\000\180\006\000\000\176\002\000\000\176\003\000\000\164\001\000\000\176\004\000\000\176\005\000\000\192\001\000\000\192\002\000\000\192\003\000\000\192\004\000\001@\004\000\001@\005\000\000\200\001\000\000\200\002\000\000\204\001\000\0058\001\000\0058\002\000\000\208\002\000\000\164\001\000\000\212\001\000\000\212\002\000\000\212\003\000\000\212\004\000\000\164\001\000\000\216\001\000\000\216\002\000\012\132\007\000\012\132\b\000\004\204\001\000\004\204\002\000\004\204\003\000\004\204\004\000\004\204\005\000\004\204\006\000\004\204\007\000\004\204\b\000\012\132\t\000\012`\001\000\005(\001\000\004\148\001\000\012p\001\000\0128\001\000\012\\\001\000\012\128\001\000\012|\001\000\005(\002\000\012P\001\000\004\152\001\000\012T\001\000\012T\002\000\012d\001\000\012d\002\000\012X\001\000\012\136\001\000\b\144\001\000\012L\001\000\012L\002\000\012L\003\000\000\136\001\000\012H\001\000\012P\001\000\004\152\001\000\003(\001\000\002\012\003\000\002\012\004\000\004\020\003\000\004\020\004\000\005$\002\000\005$\003\000\005$\004\000\005 \002\000\006\020\003\000\006\020\004\000\006P\005\000\006,\001\000\006(\001\000\006 \001\000\0118\007\000\006d\001\000\006`\001\000\006X\001\000\0118\b\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\000\236\002\000\000\232\002\000\000\232\003\000\000\236\003\000\001\180\001\000\000\236\004\000\000\236\005\000\n\184\004\000\n\184\005\000\n\184\006\000\002<\004\000\002<\005\000\tP\001\000\002<\006\000\b\180\003\000\b\180\004\000\003\248\t\000\012l\006\000\012l\007\000\012l\b\000\003\228\001\000\002\000\001\000\003\228\002\000\002\000\002\000\002\000\003\000\002\000\004\000\002\000\005\000\012l\t\000\t\b\001\000\t\004\001\000\012l\n\000\t\004\002\000\t\b\002\000\b\244\001\000\b\252\001\000\b\248\001\000\t\000\001\000\003\232\001\000\002\004\001\000\002\004\002\000\002\004\003\000\002\004\004\000\012h\004\000\003\244\004\000\005\172\001\000\003\244\005\000\003\244\006\000\t\028\001\000\003\244\007\000\003\244\b\000\012h\005\000\012h\006\000\012h\007\000\012h\b\000\t\b\001\000\t\004\001\000\012h\t\000\001\248\003\000\001\248\004\000\005\132\003\000\005|\003\000\005t\003\000\005\132\004\000\005|\004\000\005t\004\000\005|\005\000\005t\005\000\005|\006\000\005t\006\000\005\140\001\000\005t\007\000\005\136\001\000\005\128\001\000\005x\001\000\000l\001\000\000`\001\000\005\128\002\000\005x\002\000\005x\003\000\006\228\002\000\006\224\002\000\006\224\003\000\003\184\003\000\003\184\004\000\003\184\005\000\t\132\001\000\000p\002\000\000d\002\000\000p\003\000\000d\003\000\000p\004\000\000p\005\000\000d\004\000\t\132\002\000\t\132\003\000\001\180\001\000\t\136\001\000\001\196\002\000\001\180\001\000\t\136\002\000\t\136\003\000\001\180\001\000\006\212\002\000\006\212\003\000\006\212\004\000\006\196\002\000\006\172\002\000\001\180\001\000\006\180\002\000\012\228\002\000\003\240\007\000\003\240\b\000\t\028\001\000\003\240\t\000\003\240\n\000\n\028\006\000\n\028\007\000\n\028\b\000\n\028\t\000\t\020\001\000\n\028\n\000\t\020\002\000\t\012\001\000\t\016\001\000\n\024\004\000\003\244\004\000\003\236\004\000\005\172\001\000\003\244\005\000\003\236\005\000\003\236\006\000\003\236\007\000\t\028\001\000\003\236\b\000\003\236\t\000\n\024\005\000\n\024\006\000\n\024\007\000\n\024\b\000\t\020\001\000\n\024\t\000\006D\003\000\006D\004\000\006d\001\000\006`\001\000\006X\001\000\001\200\005\000\001\200\006\000\rX\006\000\rX\007\000\000\140\003\000\000\140\004\000\002X\003\000\002X\004\000\002X\005\000\002X\006\000\002X\007\000\004\004\001\000\004\004\002\000\000\000\001\000\000\004\000\000\004\016\001\000\004\016\002\000\000\004\001\000\000\b\000\000\r4\001\000\005\192\001\000\001p\001\000\005\192\002\000\005\192\003\000\005\196\001\000\000\b\001\000\005\248\001\000\005\208\001\000\005\204\001\000\005\200\001\000\005\184\001\000\005\208\002\000\005\204\002\000\005\200\002\000\005\184\002\000\r4\001\000\005\204\003\000\005\204\004\000\005\204\005\000\005\208\003\000\005\200\003\000\000P\001\000\005\188\001\000\000T\001\000\b\000\001\000\b\000\002\000\000\012\000\000\000\012\001\000\b\004\001\000\b\004\002\000\000\016\000\000\000\016\001\000\b\b\001\000\001\180\001\000\b\b\002\000\000\020\000\000\b\012\001\000\b\012\002\000\000\020\001\000\000\024\000\000\000\024\001\000\b\016\001\000\005\248\001\000\005\184\001\000\b\016\002\000\000\028\000\000\000\028\001\000\b\020\001\000\005\232\001\000\b\020\002\000\000 \000\000\000 \001\000\b\024\001\000\006,\001\000\006(\001\000\006 \001\000\b\024\002\000\000$\000\000\000$\001\000\b\028\001\000\006d\001\000\006`\001\000\006X\001\000\b\028\002\000\000(\000\000\000(\001\000\b \001\000\b \002\000\000,\000\000\bP\001\000\b@\001\000\b8\001\000\b0\001\000\b,\001\000\b$\001\000\b$\002\000\000,\001\000\0000\000\000\b(\001\000\b(\002\000\0000\001\000\005\240\001\000\005\232\001\000\005\240\002\000\005\232\002\000\0004\000\000\012\184\001\000\012\180\001\000\012\176\001\000\012\172\001\000\012\168\001\000\012\164\001\000\012\160\001\000\012\184\002\000\012\180\002\000\012\176\002\000\012\172\002\000\012\168\002\000\012\164\002\000\012\160\002\000\012\184\003\000\012\164\003\000\012\168\003\000\012\180\003\000\012\172\003\000\012\176\003\000\005\240\001\000\005\232\001\000\012\200\001\000\0004\001\000\012\196\001\000\012\196\002\000\005@\001\000\005@\002\000\012\188\001\000\012\188\002\000\012\188\003\000\012\192\001\000\012\192\002\000\0008\000\000\005L\001\000\005H\001\000\005T\001\000\005P\001\000\005P\002\000\005T\002\000\005L\002\000\005L\003\000\005L\004\000\005H\002\000\0008\001\000\r0\001\000\r0\002\000\r0\003\000\r0\004\000\r,\001\000\r,\002"), (16, "\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b\000\t\000\n\000\011\000\012\000\r\000\014\000\015\000\016\000\017\000\018\000\019\000\020\000\021\000\022\000\023\000\024\000\025\000\026\000\027\000\028\000\029\000\030\000\031\000 \000!\000\"\000#\000$\000%\000&\000'\000(\000)\000*\000+\000,\000-\000.\000/\0000\0001\0002\0003\0004\0005\0006\0008\0009\000:\000;\000<\000=\000>\000?\000@\000A\000B\000C\000D\000E\000F\000G\000H\000I\000J\000K\000L\000M\000N\000O\000P\000Q\000R\000S\000T\000U\000[\000]\000^\000_\000a\000c\000d\000f\000h\000j\000k\000m\000o\000q\000r\000s\000t\000u\000v\000w\000x\000y\000z\000{\000|\000}\000~\000\127\000\128\000\130\000\131\000\132\000\134\000\135\000\136\000\137\000\138\000\142\000\143\000\144\000\145\000\146\000\147\000\149\000\150\000\151\000\157\000\163\000\169\000\170\000\172\000\173\000\176\000\178\000\179\000\180\000\181\000\184\000\185\000\186\000\187\000\188\000\189\000\190\000\191\000\192\000\194\000\195\000\196\000\197\000\200\000\203\000\204\000\206\000\207\000\211\000\217\000\218\000\220\000\221\000\222\000\224\000\228\000\231\000\232\000\233\000\234\000\235\000\239\000\243\000\247\000\249\000\251\000\253\000\254\001\000\001\001\001\002\001\003\001\004\001\005\001\006\001\007\001\b\001\t\001\n\001\012\001\r\001\015\001\016\001\017\001\019\001\020\001\021\001\028\001\031\001!\001#\001%\001&\001'\001)\001*\001+\001,\001-\001.\001/\0010\0011\0012\0014\0015\0016\0017\0019\001:\001;\001<\001F\001N\001V\001W\001X\001Y\001Z\001\\\001^\001_\001`\001a\001b\001c\001d\001e\001f\001g\001h\001i\001j\001k\001l\001s\001u\001w\001z\001|\001}\001\127\001\129\001\130\001\131\001\132\001\133\001\134\001\138\001\139\001\141\001\142\001\144\001\146\001\147\001\148\001\151\001\152\001\155\001\156\001\159\001\160\001\161\001\162\001\163\001\165\001\166\001\167\001\168\001\169\001\170\001\171\001\172\001\174\001\175\001\177\001\178\001\179\001\183\001\186\001\188\001\189\001\190\001\191\001\192\001\193\001\194\001\195\001\196\001\197\001\201\001\202\001\205\001\206\001\207\001\208\001\209\001\211\001\212\001\213\001\215\001\216\001\217\001\218\001\219\001\222\001\223\001\224\001\225\001\227\001\228\001\229\001\230\001\232\001\233\001\234\001\235\001\237\001\238\001\240\001\241\001\243\001\244\001\246\001\248\001\249\001\250\001\251\001\253\001\254\002\000\002\001\002\004\002\005\002\006\002\b\002\t\002\n\002\011\002\r\002\017\002\018\002\019\002\020\002\021\002\022\002\023\002\024\002\025\002\026\002\027\002\028\002\029\002\030\002\031\002 \002\"\002#\002$\002%\002&\002-\0023\0026\0027\0028\0029\002:\002;\002<\002=\002>\002?\002@\002A\002B\002D\002E\002G\002H\002N\002O\002U\002V\002\\\002]\002c\002d\002e\002f\002i\002q\002r\002t\002u\002v\002w\002x\002{\002|\002}\002\132\002\133\002\134\002\136\002\137\002\143\002\149\002\155\002\156\002\157\002\163\002\164\002\166\002\167\002\168\002\169\002\177\002\179\002\180\002\181\002\187\002\191\002\194\002\195\002\196\002\197\002\198\002\199\002\200\002\201\002\204\002\206\002\207\002\209\002\210\002\212\002\213\002\214\002\215\002\217\002\218\002\219\002\220\002\225\002\227\002\228\002\229\002\230\002\231\002\232\002\234\002\235\002\236\002\237\002\240\002\243\002\244\002\245\002\247\002\248\002\249\002\250\002\251\002\255\003\000\003\002\003\004\003\006\003\b\003\t\003\n\003\012\003\r\003\015\003\017\003\018\003\020\003\021\003\023\003\024\003\028\003\030\003 \003!\003%\003&\003*\003+\003.\0030\0032\0033\0034\0035\0036\0037\003;\003<\003=\003>\003B\003E\003F\003I\003J\003K\003N\003O\003Q\003R\003S\003W\003X\003\\\003]\003^\003_\003`\003d\003o\003p\003u\003v\003w\003{\003|\003}\003~\003\128\003\129\003\133\003\134\003\136\003\138\003\141\003\143\003\144\003\146\003\148\003\150\003\152\003\153\003\154\003\155\003\156\003\157\003\158\003\171\003\172\003\185\003\186\003\187\003\190\003\191\003\197\003\203\003\209\003\212\003\215\003\218\003\219\003\227\003\228\003\229\003\230\003\231\003\233\003\234\003\235\003\242\003\243\003\245\003\246\003\247\003\248\003\249\003\250\004\002\004\003\004\004\004\005\004\006\004\007\004\b\004\n\004\011\004\012\004\r\004\014\004\017\004\018\004\019\004\022\004\025\004\028\004 \004\"\004%\004(\004+\004/\0040\0041\0042\0043\0044\0045\004;\004<\004=\004>\004?\004L\004S\004T\004V\004Y\004\\\004_\004c\004\133\004\135\004\136\004\137\004\138\004\140\004\142\004\145\004\146\004\148\004\149\004\150\004\151\004\152\004\153\004\154\004\167\004\168\004\181\004\193\004\198\004\199\004\201\004\203\004\204\004\205\004\206\004\210\004\211\004\215\004\216\004\218\004\220\004\222\004\224\004\225\004\227\004\228\004\229\004\232\004\234\004\237\004\240\004\243\004\247\004\249\005\006\005\007\005\b\005\t\005\n\005\012\005\r\005\014\005\015\005@\005B\005E\005H\005K\005O\005}\005\127\005\130\005\133\005\136\005\140\005\186\005\188\005\191\005\194\005\197\005\201\005\247\005\249\005\252\005\255\006\002\006\006\0064\0066\0069\006<\006?\006C\006q\006s\006v\006y\006|\006\128\006\174\006\176\006\179\006\182\006\185\006\189\006\235\006\237\006\240\006\243\006\246\006\250\007(\007*\007-\0070\0073\0077\007e\007g\007j\007m\007p\007t\007\162\007\164\007\167\007\170\007\173\007\177\007\223\007\225\007\228\007\231\007\234\007\238\b\028\b\030\b!\b$\b'\b+\bY\b[\b^\ba\bd\bh\b\150\b\152\b\155\b\158\b\161\b\165\b\211\b\213\b\216\b\219\b\222\b\226\t\016\t\018\t\021\t\024\t\027\t\031\tM\tO\tR\tU\tX\t\\\t\138\t\140\t\143\t\146\t\149\t\153\t\199\t\201\t\204\t\207\t\210\t\214\n\004\n\006\n\t\n\012\n\015\n\019\nA\nC\nF\nI\nL\nP\n~\n\127\n\129\n\142\n\144\n\147\n\150\n\153\n\157\n\203\n\206\n\207\n\208\n\209\n\210\n\211\n\212\n\218\n\219\n\220\n\224\n\225\n\226\n\227\n\229\n\230\n\231\n\233\n\234\n\235\n\236\n\238\n\239\n\240\n\241\n\242\n\243\n\244\n\245\n\246\n\247\n\248\n\249\n\250\n\251\n\253\n\254\011\000\011\001\011\002\011\b\011\t\011\n\011\011\011\017\011\018\011\024\011\025\011\031\011 \011!\011\"\011#\011%\011&\011,\011-\011.\011/\0110\0111\0112\011`\011f\011g\011h\011j\011k\011l\011m\011n\011o\011q\011r\011s\011u\011z\011\127\011\132\011\138\011\140\011\141\011\189\011\191\011\192\011\193\011\194\011\195\011\197\011\198\011\199\011\200\011\201\011\202\011\203\011\204\011\217\011\218\011\219\011\222\011\225\011\228\011\230\011\231\011\232\011\233\011\234\011\248\012\005\012\007\012\b\012\t\012\022\012\031\012\"\012%\012(\012*\012-\0120\0123\0127\012e\012h\012k\012n\012p\012s\012v\012y\012}\012\171\012\174\012\177\012\180\012\182\012\185\012\188\012\191\012\195\012\241\r\006\r\t\r\012\r\015\r\017\r\020\r\023\r\026\r\030\rL\rO\rR\rU\rW\rZ\r]\r`\rd\r\146\r\149\r\152\r\155\r\157\r\160\r\163\r\166\r\170\r\216\r\227\r\236\r\239\r\242\r\245\r\247\r\250\r\253\014\000\014\004\0142\0145\0148\014;\014=\014@\014C\014F\014J\014x\014{\014~\014\129\014\131\014\134\014\137\014\140\014\144\014\190\014\193\014\195\014\198\014\201\014\204\014\208\014\254\015\011\015\r\015\014\015\015\015=\015>\015?\015@\015A\015B\015C\015D\015E\015J\015M\015N\015O\015P\015Q\015R\015S\015T\015U\015V\015W\015X\015Y\015Z\015[\015\\\015]\015^\015_\015\141\015\142\015\143\015\144\015\145\015\147\015\148\015\149\015\150\015\154\015\160\015\166\015\171\015\176\015\181\015\187\015\189\015\192\015\195\015\198\015\202\015\248\016(\016*\016-\0160\0163\0167\016e\016f\016g\016h\016i\016j\016k\016l\016m\016z\016{\016|\016}\016~\016\127\016\130\016\133\016\136\016\140\016\186\016\189\016\191\016\192\016\193\016\194\016\195\016\196\016\197\016\198\016\199\016\200\016\204\016\205\016\206\016\207\016\208\016\209\016\210\016\211\016\215\016\216\016\220\016\221\016\225\016\226\016\227\016\228\016\229\016\230\016\231\016\232\016\233\016\234\016\236\016\237\016\238\016\239\016\240\016\241\016\242\016\243\016\245\016\247\016\249\016\251\016\252\016\254\017\000\017\002\017\003\017\004\017\006\017\007\017\b\017\n\017\011\017\012\017\014\017\016\017\020\017\021\017\025\017\029\017 \017\"\017#\017$\017'\017,\017-\017.\0171\0176\0177\0178\0179\017:\017;\017<\017=\017>\017?\017@\017A\017B\017C\017D\017E\017F\017I\017L\017O\017S\017\129\017\130\017\131\017\132\017\145\017\147\017\149\017\151\017\156\017\157\017\158\017\162\017\163\017\165\017\166\017\167\017\168\017\169\017\170\017\172\017\173\017\174\017\187\017\193\017\199\017\205\017\212\017\213\017\214\017\218\017\219\017\221\017\226\017\227\017\228\017\232\017\233\018\026\018\027\018\028\018 \018!\018#\018(\018)\018*\018.\018/\0183\0184\0185\0186\018:\018;\018>\018?\018@\018A\018B\018C\018G\018H\018I\018K\018M\018N\018O\018P\018Q\018R\018S\018T\018U\018V\018W\018X\018Y\018Z\018[\018\\\018]\018_\018f\018g\018h\018i\018j\018k\018l\018m\018q\018r\018s\018t\018u\018v\018w\018y\018z\018|\018}\018~\018\128\018\129\018\130\018\131\018\133\018\135\018\137\018\139\018\141\018\142\018\144\018\147\018\149\018\150\018\151\018\152\018\153\018\154\018\155\018\156\018\158\018\159\018\161\018\162\018\163\018\164\018\167\018\168\018\169\018\170\018\173\018\174\018\180\018\182\018\184\018\186\018\188\018\189\018\193\018\194\018\198\018\202\018\204\018\205\018\208\018\209\018\210\018\211\018\212\018\216\018\217\018\218\018\219\018\220\018\221\018\225\018\226\018\227\018\228\018\230\018\231\018\233\018\234\018\235\018\239\018\240\018\241\018\242\018\243\018\244\018\245\018\246\018\250\018\251\018\252\018\253\018\254\018\255\019\001\019\002\019\003\019\004\019\005\019\006\019\007\019\t\019\n\019\011\019\012\019\r\019\014\019\015\019\016\019\018\019\019\019\020\019\021\019\022\019\024\019\025\019\027\019\028\019\029\019\030\019\031\019!\019\"\019#\019$\019&\019'\019)\019*\019+\019,\019-\019.\019/\0190\0191\0193\0195\0196\0197\0199\019:\019;\019=\019>\019?\019@\019B\019D\019E\019F\019H\019I\019J\019L\019M\019O\019Q\019R\019S\019T\019V\019W\019Y\019Z\019[\019\\\019]\019^\019_\019`\019a\019b\019d\019e\019f\019g\019h\019i\019j\019k\019m\019n\019o\019p\019q\019r\019s\019t\019u\019v\019x\019y\019z\019{\019\127\019\130\019\131\019\132\019\133\019\134\019\135\019\137\019\139\019\140\019\142\019\143\019\144\019\145\019\146\019\147\019\148\019\149\019\150\019\151\019\152\019\153\019\154\019\155\019\156\019\157\019\158\019\159\019\160\019\161\019\162\019\163\019\164\019\165\019\166\019\167\019\168\019\169\019\170\019\171\019\172\019\173\019\175\019\176\019\177\019\178\019\179\019\180\019\181\019\182\019\183\019\184\019\188\019\189\019\190\019\191\019\192\019\194\019\195\019\196\019\197\019\199\019\200\019\201\019\202\019\204\019\205\019\206\019\207\019\208\019\216\019\222\019\225\019\226\019\227\019\228\019\229\019\230\019\231\019\232\019\233\019\234\019\235\019\236\019\237\019\238\019\239\019\240\019\241\019\242\019\243\019\244\019\245\019\247\019\249\019\250\019\251\019\252\019\253\019\254\019\255\020\000\020\001\020\002\020\003\020\005\020\007\020\t\020\011\020\012\020\r\020\014\020\015\020\016\020\017\020\018\020\021\020\023\020\024\020\026\020\027\020\028\020\029\020\030\020 \020\"\020$\020%\020&\020'\020(\020)\020*\020-\0200\0201\0204\0207\0209\020:\020;\020<\020>\020?\020@\020A\020B\020C\020D\020E\020F\020J\020L\020M\020O\020P\020Q\020R\020S\020T\020W\020Z\020\\\020]\020^\020_\020a\020b\020c\020d\020e\020f\020g\020h\020i\020j\020k\020m\020n\020o\020q\020u\020v\020w\020x\020y\020z\020{\020}\020~\020\127\020\129\020\130\020\131\020\133\020\134\020\135\020\136\020\137\020\139\020\140\020\142\020\143\020\144\020\146\020\148\020\149\020\151\020\152\020\153\020\155\020\156\020\157\020\159\020\160\020\162\020\163\020\165\020\166\020\167\020\168\020\169\020\172\020\173\020\174\020\175\020\176\020\178\020\179\020\180\020\181\020\182\020\183\020\185\020\186\020\187\020\188\020\189\020\190\020\191\020\192\020\193\020\194\020\195\020\196\020\197\020\198\020\200\020\201\020\202\020\203\020\205\020\206\020\207\020\208\020\209\020\210\020\211\020\212\020\213\020\214\020\215\020\216\020\217\020\218\020\219\020\220\020\221\020\222\020\223\020\224\020\225\020\226\020\227\020\229\020\230\020\231\020\232\020\233\020\234\020\235\020\236\020\237\020\238\020\239\020\240\020\241\020\244\020\245\020\246\020\247\020\248\020\249\020\250\020\251\020\252\020\253\020\254\021\002\021\006\021\007\021\014\021\015\021\016\021\018\021\019\021\020\021\021\021\022\021\023\021\024\021\026\021\027\021\028\021\029\021\030\021\031\021 \021\"\021$\021%\021&\021'\021*\021+\021,\021-\021.\021/\0210\0211\0213\0214\0215\0216\0218\021:\021;\021=\021>\021?\021@\021A\021D\021E\021F\021G\021J\021M\021O\021Q\021R\021S\021X\021Z\021[\021\\\021]\021^\021_\021`\021a\021d\021f\021g\021h\021i\021j\021l\021o\021p\021r\021s\021t\021u\021v\021x\021y\021z\021{\021|\021~\021\127\021\128\021\129\021\130\021\132\021\133\021\134\021\135\021\136\021\139\021\142\021\143\021\144\021\146\021\147\021\148\021\149\021\150\021\152\021\153\021\154\021\155\021\159\021\160\021\161\021\162\021\163\021\164\021\165\021\166\021\167\021\168\021\169\021\170\021\171\021\172\021\173\021\174\021\175\021\176\021\177\021\180\021\181\021\182\021\183\021\184\021\189\021\193\021\195\021\196\021\197\021\198\021\199\021\200\021\201\021\202\021\203\021\204\021\205\021\206\021\207\021\208\021\209\021\210\021\212\021\213\021\214\021\215\021\216\021\217\021\218\021\219\021\222\021\223\021\224\021\225\021\227\021\228\021\229\021\230\021\234\021\235\021\236\021\237\021\241\021\242\021\243\021\244\021\245\021\246\021\247\021\253\021\254\021\255\022\000\022\001\022\002\022\003\022\005\022\007\022\b\022\015\022\022\022\023\022\024\022\025\022\026\022\027\022\030\022\031\022 \022!\022\"\022#\022$\022%\022&\022'\022(\022)\022*\022,\022-\022.\022/\0220\0221\0222\0223\0224\0225\0226\0227\0228\0229\022:\022;"))
and nullable =
"\000\000\016)\001\000@\000\000\135\b\000\000\255\224\024\000\000\031\255\192\000 @ \128\0000 \000"
and first =
- (127, "'\225 \197\138\173\2433\208\021\007\242(\000q\192O\194A\139\021[\230g\160*\015\228P\000\227\128\004\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\025\b\002\004\000&\t\022\128\b\006\128\000\001\004\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000 \b\b\000\004\024 \000\000\001\000\000\000\000\000\000\192\128\016\000\000 @\000\000\002\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000F\194\000\139\005\027\226G\160\b\015\128P\000c\128\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\t\000\000\000\000\004\000\016\000\000\002\000\000\000\000\000\018\000\000\000\000\012\000 \000\000\004\000\000\000\000\000\144\004\016\001\004\000B\000\002\000\006@\000\b\000\t\248H1b\171|\204\244\005\001\252\138\000\028p\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\b\b\000\128\000\000\000\000\000\000 \000@\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000O\194A\139\021[\230g\160*\015\228P\000\227\128\000\000\000\018\000\016\000\000\002\000\000\000\000\000\004\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002H\000H\000\000\b\000\000\000\000\000\016\000@\000\004\144\000\128\000\000\016\000\000\000\000\000 \000@\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\000\006\000\000\192\000\001\139\132\000\002\000\000\000\000\000\000\159\132\131\022*\183\204\207@T\031\200\160\001\199\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\128\000\000\000\000\000\000\000\000\000\001 \000 \002\b\004\132\000\004\000\012\000\000\016\000\019\240\144b\197V\249\153\232\n\003\248\020\0008\224\003)\000P\144\004\193\"\176\001\000\200\000\000 \128\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\247\217\016 \191\141@\0010p=\199\005\129A\160\025\b\002\004\000$\t\020\128\b\006\000\000\001\004\0002\016\004\b\000L\018)\000\016\012\000\000\002\b\000d \b\128P\024$r\000\000\024\005\000\0060\000\000\000\000\000\000\000\b\160\000\000\000\000\000\000\000\000\000\128\000@\002\000\000\b\000\000@\000\000\016\000\004\128\000\128\b \002\016\000\016\0000\000\000@\000\t\000A\000\016@\004 \000 \000`\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\001\027\b\002,\020o\137\030\128 >\001@\001\142\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000d \b\016\000\152$Z\000 \026\000\000\004\016\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\017\176\128\"\193F\248\145\232\002\003\224\020\000\024\224\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\128\006\000\000\192\000\001\139\132\000\002\000\000\000\000\000\000\141\132\001\022\n7\196\143@\016\031\000\160\000\199\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000@\000\004\144\000\128\000\000\016\000\000\000\000\000 \000\192\000\028\004\0001p\128\000@\000\000\000\000\000\001\128\0008\b\000b\225\000\000\128\000\000\000\000@\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\006\000\000\224 \001\139\132\000\002\000\000\000\000\000\000\012\132\001\002\000\019\004\139@\004\003@\000\000\138\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000e \n\130P\024$v\000\000\024\005\000\0060\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\001\148\128(H\002`\145X\000\128`\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\002@\000\000\000\001\000\004\000\000\000\128\000\000\004\000\004\128\000\000\000\002\000\b\000\000\001\000\000\000\b\000\t\000\000\000\000\004\000\016\000\000\002\000\000\000\016\0002\016\004@(\012\0189\000\000\012\002\128\003\024\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\012\000\001\192@\003\023\b\000\004\000\000\000\000\000\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\000\002~\018\rX\170\2233=\001@\127\002\128\015\028\000@\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\200@\016 \0010H\180\000@0\000\000\b \001\144\128 @\002`\145h\000\128`\000\000\016@\003!\000@\128\004\193\"\208\001\000\192\000\000 \128\006B\000\129\000\t\130E\160\002\001\160\000\000A\000\012\132\001\002\000\019\004\139@\004\003@\000\000\130\000\b\000\000\000\000\006\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\r\000\000\002\b\000 \000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\016\016\000\b0@\000\000\002\000\000\000\000\000\001\129\000 \000\000@\128\000\000\004\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\001\022\n7\196\143@\016\031\000\160\000\199\000\024\000\003\128\128\006.\016\000\b\000\000\000\000\000\000\018\000\000\000\000\b\000 \000\000\004\000\000\000\000\000$\000\000\000\000\024\000@\000\000\b\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\b\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\000?\000a \000\031\016\128@\128\016(\176\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\001\144\000<\b\000b\225@\000\128 \002\000\001\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000@\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\016\002\000\000\004\b\000\000\000@\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\016\000\000\000\000\001\000\000\016\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\016\000\000\000\000\000\000\000\000\000\004\000\000\004\000\000 \002\000\000\000\000\000\000\000\128\003\000\000`\000\000\197\194\000\001\000\000\004\000\000\000\006B\000\129\000\t\130E\160\002\001\160\000\000A\000\004\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000$\001\004\000A\000\144\128\000\136\001\128\000\002\000\000H\000\b\000\130\001!\000\001\000\003\000\000\004\000\000\128\000\016\000\000@B\001\128\000\000\000\004\000\000\001\000\000 \000\000\128\132\001\000\000\000\000\b\000\000\002@\016@\004\016\t\b\000\b\000\024\000\000 \000\004\128 \128\b \002\016\000\016\0000\000\000@\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\012\132\001\002\000\019\004\139@\004\003\000\000\000\130\000\025\b\002\004\000&\t\022\128\b\006\000\000\001\004\0002\016\004\b\000L\018-\000\016\r\000\000\002\b\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\001\144\128 @\002`\145h\000\128`\000\000\016@\003!\000@\128\004\193\"\208\001\000\192\000\000 \128\006R\000\161 \t\130E`\002\001\128\000\000A\000\012\164\001PJ\003\004\142\192\000\003\000\160\000\198\000\b\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\000\000\000\t\000A\000\016@\004 \000 \000d\000\000\128\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\001?\t\006,Uo\153\158\128\160?\145@\003\142\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\000\000\000@\001\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\b\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\004l \b\176Q\190$z\000\128\248\005\000\0068\000\202@\020$\0010H\172\000@0\000\000\b \001\148\128(H\002`\145X\000\128`\000\000\016@#a\000E\130\141\241#\208\004\007\192(\0001\192F\194\000\139\005\027\226G\160\b\015\128P\000c\128\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\000\000\000$\000\000\000\000\016\000@\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000 \000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\002\003\b\000\000\000\000\000\000\000\000\000\000\002\000\000\004.\016\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000$\000\000\000\000\016\000@\000\000\b\000\000\000@\000\192\000\024\000\0001p\160\000@\000\000\000\000\000\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000\001 \000\000\000\000\128\002\000\000\000@\000\000\000\000\002@\000\000\000\001\000\004\000\000\000\128\000\000\000\000\000\128\000\000\000\002\000\b\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\128\000\004\000\000\001\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\192\000\028\004\1285p\128\000@\000\000\000\000\000\000\128\000\000\001\000`\001\000\000\000\000\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\000\b\000\001\000\000\004\004 \b\000\000\000\000@\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000e \n\018\000\152$V\000 \024\000\000\004\016\000\202@\020$\0010H\172\000@2\000\000( \002\000\000@\000\001\001\b\006\000\000\000\000\016\000\000\001\000\000@\002\000\209\002\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\159\132\131V*\183\204\207@P\031\192\160\003\199\003\239\178 A\127\026\128\002`\224{\142\011\002\131@0\000\006\000\000\012\\ \000\016\000\000\000\000\000\000$\000\000\000\000\024\000@\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\001\128\0008\b\000b\225\000\000\128\000\000\000\000\000\000\000\000\001\128\000\000\000\000\000\000\000\000\000\000\000")
+ (128, "'\225 \197\138\173\190fz\002\161\252\128\0008\224'\225 \197\138\173\190fz\002\161\252\128\0008\224\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\001 \000\000\000\000\024\000@\000\000\016\000\000\000\000\004\128 \128\b \000B\000\002\000\012\128\000 \000'\225 \197\138\173\190fz\002\129\252\128\0008\224\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000@\b\000\128\000\000\000\000\000\000\128\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000'\225 \197\138\173\190fz\002\161\252\128\0008\224\000\000\000\004\128\004\000\000\000\016\000\000\000\000\000\128\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\016\000\000\016\000\000\000\000\000\128\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000'\225 \197\138\173\190fz\002\161\252\128\0008\224\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\004\128\000\128\b \002B\000\002\000\012\000\000 \000'\225 \197\138\173\190fz\002\129\252\000\0008\224\003)\000P\144\004\024$V\000 2\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000}\246D\b/\226*\000\t\131\131\220h\176(4\003!\000@\128\004\016$R\000 0\000\000\016@\003!\000@\128\004\024$R\000 0\000\000\016@\003!\000D\002\129\152$r\000\0000\000\000\024\192\000\000\000\000\000\000\000\004P\000\000\000\000\000\000\000\000\001\000\000\128\004\000\000\002\000\000 \000\000\016\000\004\128\000\128\b \000B\000\002\000\012\000\000 \000\004\128 \128\b \000B\000\002\000\012\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003\000\000p\016\000\024\184@\000 \000\000\000\000@\003\000\000`\000\000\024\184@\000 \000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\003)\000T\018\129\152$v\000\0000\000\000\024\192\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\003!\000D\002\129\152$r\000\0000\000\000\024\192\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000'\225 \213\138\173\190fz\002\129\252\000\000x\224\002\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 4\016\000\016@\003!\000@\128\004\024$Z\000 4\016\000\016@\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\001 \000\000\000\000\024\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\128\007\224\012\004\128\000|D\002\004\001\002\139\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\003 \000x\016\000\024\184P\000 \016\002\000\001\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\001\000@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\002\000@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\128\000\000\000\000\000\000\128\003\000\000`\000\000\024\184@\000 \000\002\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\128 \128\b \002B\000\002 \012\000\000 \000\004\128\000\128\b \002B\000\002\000\012\000\000 \000\004\000\000\128\000\002\000B\001\128\000\000\000\016\000\000\004\000\000\128\000\002\000B\000\128\000\000\000\016\000\000\004\128 \128\b \002B\000\002\000\012\000\000 \000\004\128 \128\b \000B\000\002\000\012\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\003)\000P\144\004\024$V\000 0\000\000\016@\003)\000T\018\129\152$v\000\0000\000\000\024\192\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000@\000\000\000\000\000\000\000\000\004\128 \128\b \000B\000\002\000\012\128\000 \000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \197\138\173\190fz\002\129\252\128\0008\224\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003)\000P\144\004\024$V\000 0\000\000\016@\003)\000P\144\004\024$V\000 0\000\000\016@#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000@\000\000\000 \000\000\000\000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000@\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\016\024@\000\000\000\000\000\000\000\000\000\000@\000\000\016\184@\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\003\000\000`\000\000\024\184P\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\002\000\000 \000\000\016\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\001\000\000\000\002\000\024\000@\000\000\000\000\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\004\000\000\128\000\002\000B\000\128\000\000\000\016\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 0\000\000\016@\003)\000P\144\004\024$V\000 2\000\000P@\004\000\000\128\000\002\000B\001\128\000\000\000\016\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000'\225 \213\138\173\190fz\002\129\252\000\000x\224}\246D\b/\226*\000\t\131\131\220h\176(4\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\001 \000\000\000\000\024\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\001\128\000\000\000\000\000\000\000\000\000\000\000")
end) (ET) (TI)
@@ -54745,12 +54718,12 @@ module Incremental = struct
end
-# 4273 "src/ocaml/preprocess/parser_raw.mly"
+# 4314 "src/ocaml/preprocess/parser_raw.mly"
-# 54752 "src/ocaml/preprocess/parser_raw.ml"
+# 54725 "src/ocaml/preprocess/parser_raw.ml"
# 269 "<standard.mly>"
-# 54757 "src/ocaml/preprocess/parser_raw.ml"
+# 54730 "src/ocaml/preprocess/parser_raw.ml"
diff --git a/src/ocaml/preprocess/parser_raw.mli b/src/ocaml/preprocess/parser_raw.mli
index 07068589e7..ef2a29bd63 100644
--- a/src/ocaml/preprocess/parser_raw.mli
+++ b/src/ocaml/preprocess/parser_raw.mli
@@ -48,6 +48,9 @@ type token =
| MINUSDOT
| MINUS
| METHOD
+ | METAOCAML_ESCAPE
+ | METAOCAML_BRACKET_OPEN
+ | METAOCAML_BRACKET_CLOSE
| MATCH
| LPAREN
| LIDENT of (string)
@@ -83,7 +86,6 @@ type token =
| HASH
| GREATERRBRACKET
| GREATERRBRACE
- | GREATERDOT
| GREATER
| FUNCTOR
| FUNCTION
@@ -98,10 +100,9 @@ type token =
| EOF
| END
| ELSE
+ | EFFECT
| DOWNTO
- | DOTTILDE
| DOTOP of (string)
- | DOTLESS
| DOTDOT
| DOT
| DONE
@@ -222,6 +223,9 @@ module MenhirInterpreter : sig
| T_MINUSDOT : unit terminal
| T_MINUS : unit terminal
| T_METHOD : unit terminal
+ | T_METAOCAML_ESCAPE : unit terminal
+ | T_METAOCAML_BRACKET_OPEN : unit terminal
+ | T_METAOCAML_BRACKET_CLOSE : unit terminal
| T_MATCH : unit terminal
| T_LPAREN : unit terminal
| T_LIDENT : (string) terminal
@@ -257,7 +261,6 @@ module MenhirInterpreter : sig
| T_HASH : unit terminal
| T_GREATERRBRACKET : unit terminal
| T_GREATERRBRACE : unit terminal
- | T_GREATERDOT : unit terminal
| T_GREATER : unit terminal
| T_FUNCTOR : unit terminal
| T_FUNCTION : unit terminal
@@ -272,10 +275,9 @@ module MenhirInterpreter : sig
| T_EOF : unit terminal
| T_END : unit terminal
| T_ELSE : unit terminal
+ | T_EFFECT : unit terminal
| T_DOWNTO : unit terminal
- | T_DOTTILDE : unit terminal
| T_DOTOP : (string) terminal
- | T_DOTLESS : unit terminal
| T_DOTDOT : unit terminal
| T_DOT : unit terminal
| T_DONE : unit terminal
diff --git a/src/ocaml/preprocess/parser_raw.mly b/src/ocaml/preprocess/parser_raw.mly
index 917ab96e82..33dac707b9 100644
--- a/src/ocaml/preprocess/parser_raw.mly
+++ b/src/ocaml/preprocess/parser_raw.mly
@@ -61,6 +61,7 @@ let mkmod ~loc ?attrs d = Mod.mk ~loc:(make_loc loc) ?attrs d
let mkstr ~loc d = Str.mk ~loc:(make_loc loc) d
let mkclass ~loc ?attrs d = Cl.mk ~loc:(make_loc loc) ?attrs d
let mkcty ~loc ?attrs d = Cty.mk ~loc:(make_loc loc) ?attrs d
+let mkconst ~loc c = Const.mk ~loc:(make_loc loc) c
let pstr_typext (te, ext) =
(Pstr_typext te, ext)
@@ -153,20 +154,31 @@ let neg_string f =
then String.sub f 1 (String.length f - 1)
else "-" ^ f
-let mkuminus ~oploc name arg =
- match name, arg.pexp_desc with
- | "-", Pexp_constant(Pconst_integer (n,m)) ->
- Pexp_constant(Pconst_integer(neg_string n,m))
- | ("-" | "-."), Pexp_constant(Pconst_float (f, m)) ->
- Pexp_constant(Pconst_float(neg_string f, m))
+(* Pre-apply the special [-], [-.], [+] and [+.] prefix operators into
+ constants if possible, otherwise turn them into the corresponding prefix
+ operators [~-], [~-.], etc.. *)
+let mkuminus ~sloc ~oploc name arg =
+ match name, arg.pexp_desc, arg.pexp_attributes with
+ | "-",
+ Pexp_constant({pconst_desc = Pconst_integer (n,m); pconst_loc=_}),
+ [] ->
+ Pexp_constant(mkconst ~loc:sloc (Pconst_integer(neg_string n, m)))
+ | ("-" | "-."),
+ Pexp_constant({pconst_desc = Pconst_float (f, m); pconst_loc=_}), [] ->
+ Pexp_constant(mkconst ~loc:sloc (Pconst_float(neg_string f, m)))
| _ ->
Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
-let mkuplus ~oploc name arg =
+let mkuplus ~sloc ~oploc name arg =
let desc = arg.pexp_desc in
- match name, desc with
- | "+", Pexp_constant(Pconst_integer _)
- | ("+" | "+."), Pexp_constant(Pconst_float _) -> desc
+ match name, desc, arg.pexp_attributes with
+ | "+",
+ Pexp_constant({pconst_desc = Pconst_integer _ as desc; pconst_loc=_}),
+ []
+ | ("+" | "+."),
+ Pexp_constant({pconst_desc = Pconst_float _ as desc; pconst_loc=_}),
+ [] ->
+ Pexp_constant(mkconst ~loc:sloc desc)
| _ ->
Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
@@ -487,7 +499,8 @@ let wrap_mksig_ext ~loc (item, ext) =
let mk_quotedext ~loc (id, idloc, str, strloc, delim) =
let exp_id = mkloc id idloc in
- let e = ghexp ~loc (Pexp_constant (Pconst_string (str, strloc, delim))) in
+ let const = Const.mk ~loc:strloc (Pconst_string (str, strloc, delim)) in
+ let e = ghexp ~loc (Pexp_constant const) in
(exp_id, PStr [mkstrexp e []])
let text_str pos = Str.text (rhs_text pos)
@@ -664,6 +677,11 @@ let mkfunction params body_constraint body =
| Some newtypes ->
mkghost_newtype_function_body newtypes body_constraint body_exp
+let mk_functor_typ args mty =
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmty ~loc:(startpos, mty.pmty_loc.loc_end) (Pmty_functor (arg, acc)))
+ mty args
+
(* Alternatively, we could keep the generic module type in the Parsetree
and extract the package type during type-checking. In that case,
the assertions below should be turned into explicit checks. *)
@@ -793,6 +811,7 @@ let merloc startpos ?endpos x =
%token DOT [@symbol "."]
%token DOTDOT [@symbol ".."]
%token DOWNTO [@symbol "downto"]
+%token EFFECT [@symbol "effect"]
%token ELSE [@symbol "else"]
%token END [@symbol "end"]
%token EOF
@@ -899,9 +918,10 @@ let merloc startpos ?endpos x =
%token EOL "\\n" (* not great, but EOL is unused *)
-%token DOTLESS [@cost 1] [@symbol ".<"]
-%token DOTTILDE [@cost 1] [@symbol ".~"]
-%token GREATERDOT [@cost 1] [@symbol ">."]
+(* see the [metaocaml_expr] comment *)
+%token METAOCAML_ESCAPE [@symbol ".~"]
+%token METAOCAML_BRACKET_OPEN [@symbol ".<"]
+%token METAOCAML_BRACKET_CLOSE [@symbol ">."]
/* Precedences and associativities.
@@ -967,7 +987,7 @@ The precedences must be listed from low to high.
LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
NEW PREFIXOP STRING TRUE UIDENT UNDERSCORE
LBRACKETPERCENT QUOTED_STRING_EXPR
- DOTLESS DOTTILDE GREATERDOT
+ METAOCAML_BRACKET_OPEN METAOCAML_ESCAPE
/* Entry points */
@@ -1784,11 +1804,11 @@ module_type [@recovery default_module_type ()]:
| FUNCTOR attrs = attributes args = functor_args
MINUSGREATER mty = module_type
%prec below_WITH
- { wrap_mty_attrs ~loc:$sloc attrs (
- List.fold_left (fun acc (startpos, arg) ->
- mkmty ~loc:(startpos, $endpos) (Pmty_functor (arg, acc))
- ) mty args
- ) }
+ { wrap_mty_attrs ~loc:$sloc attrs (mk_functor_typ args mty) }
+ | args = functor_args
+ MINUSGREATER mty = module_type
+ %prec below_WITH
+ { mk_functor_typ args mty }
| MODULE TYPE OF attributes module_expr %prec below_LBRACKETAT
{ mkmty ~loc:$sloc ~attrs:$4 (Pmty_typeof $5) }
| LPAREN module_type RPAREN
@@ -1802,8 +1822,6 @@ module_type [@recovery default_module_type ()]:
| mkmty(
mkrhs(mty_longident)
{ Pmty_ident $1 }
- | LPAREN RPAREN MINUSGREATER module_type
- { Pmty_functor(Unit, $4) }
| module_type MINUSGREATER module_type
%prec below_WITH
{ Pmty_functor(Named (mknoloc None, $1), $3) }
@@ -2587,9 +2605,9 @@ let_pattern [@recovery default_pattern ()]:
| e1 = fun_expr op = op(infix_operator) e2 = expr
{ mkinfix e1 op e2 }
| subtractive expr %prec prec_unary_minus
- { mkuminus ~oploc:$loc($1) $1 $2 }
+ { mkuminus ~sloc:$sloc ~oploc:$loc($1) $1 $2 }
| additive expr %prec prec_unary_plus
- { mkuplus ~oploc:$loc($1) $1 $2 }
+ { mkuplus ~sloc:$sloc ~oploc:$loc($1) $1 $2 }
;
%public simple_expr:
@@ -2609,6 +2627,7 @@ let_pattern [@recovery default_pattern ()]:
| indexop_error (DOT, seq_expr) { $1 }
| indexop_error (qualified_dotop, expr_semi_list) { $1 }
*)
+ | metaocaml_expr { $1 }
| simple_expr_attrs
{ let desc, attrs = $1 in
mkexp_attrs ~loc:$sloc desc attrs }
@@ -2641,6 +2660,25 @@ let_pattern [@recovery default_pattern ()]:
{ unclosed "object" $loc($1) "end" $loc($4) }
*)
;
+
+(* We include this parsing rule from the BER-MetaOCaml patchset
+ (see https://okmij.org/ftp/ML/MetaOCaml.html)
+ even though the lexer does *not* include any lexing rule
+ for the METAOCAML_* tokens, so they
+ will never be produced by the upstream compiler.
+
+ The intention of this dead parsing rule is purely to ease the
+ future maintenance work on MetaOCaml.
+*)
+%inline metaocaml_expr:
+ | METAOCAML_ESCAPE e = simple_expr
+ { wrap_exp_attrs ~loc:$sloc e
+ (Some (mknoloc "metaocaml.escape"), []) }
+ | METAOCAML_BRACKET_OPEN e = seq_expr METAOCAML_BRACKET_CLOSE
+ { wrap_exp_attrs ~loc:$sloc e
+ (Some (mknoloc "metaocaml.bracket"),[]) }
+;
+
%inline simple_expr_:
| mkrhs(val_longident)
{ Pexp_ident ($1) }
@@ -3019,6 +3057,8 @@ pattern [@recovery default_pattern ()]:
{ $1 }
| EXCEPTION ext_attributes pattern %prec prec_constr_appl
{ mkpat_attrs ~loc:$sloc (Ppat_exception $3) $2}
+ | EFFECT pattern_gen COMMA simple_pattern
+ { mkpat ~loc:$sloc (Ppat_effect($2,$4)) }
;
pattern_no_exn:
@@ -3064,6 +3104,7 @@ pattern_gen:
| LAZY ext_attributes simple_pattern
{ mkpat_attrs ~loc:$sloc (Ppat_lazy $3) $2}
;
+
simple_pattern:
mkpat(mkrhs(val_ident) %prec below_EQUAL
{ Ppat_var ($1) })
@@ -3884,17 +3925,24 @@ meth_list:
/* Constants */
constant:
- | INT { let (n, m) = $1 in Pconst_integer (n, m) }
- | CHAR { Pconst_char $1 }
- | STRING { let (s, strloc, d) = $1 in Pconst_string (s, strloc, d) }
- | FLOAT { let (f, m) = $1 in Pconst_float (f, m) }
+ | INT { let (n, m) = $1 in
+ mkconst ~loc:$sloc (Pconst_integer (n, m)) }
+ | CHAR { mkconst ~loc:$sloc (Pconst_char $1) }
+ | STRING { let (s, strloc, d) = $1 in
+ mkconst ~loc:$sloc (Pconst_string (s,strloc,d)) }
+ | FLOAT { let (f, m) = $1 in
+ mkconst ~loc:$sloc (Pconst_float (f, m)) }
;
signed_constant:
constant { $1 }
- | MINUS INT { let (n, m) = $2 in Pconst_integer("-" ^ n, m) }
- | MINUS FLOAT { let (f, m) = $2 in Pconst_float("-" ^ f, m) }
- | PLUS INT { let (n, m) = $2 in Pconst_integer (n, m) }
- | PLUS FLOAT { let (f, m) = $2 in Pconst_float(f, m) }
+ | MINUS INT { let (n, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_integer("-" ^ n, m)) }
+ | MINUS FLOAT { let (f, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_float("-" ^ f, m)) }
+ | PLUS INT { let (n, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_integer (n, m)) }
+ | PLUS FLOAT { let (f, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_float(f, m)) }
;
/* Identifiers and long identifiers */
@@ -4263,11 +4311,4 @@ attr_payload:
}
;
-%public simple_expr:
-| DOTLESS expr GREATERDOT
- { Fake.Meta.code $startpos $endpos $2 }
-| DOTTILDE simple_expr %prec prec_escape
- { Fake.Meta.uncode $startpos $endpos $2 }
-;
-
%%
diff --git a/src/ocaml/preprocess/parser_recover.ml b/src/ocaml/preprocess/parser_recover.ml
index cc51826cc9..c0e51ab58f 100644
--- a/src/ocaml/preprocess/parser_recover.ml
+++ b/src/ocaml/preprocess/parser_recover.ml
@@ -64,6 +64,9 @@ module Default = struct
| MenhirInterpreter.T MenhirInterpreter.T_MINUSDOT -> ()
| MenhirInterpreter.T MenhirInterpreter.T_MINUS -> ()
| MenhirInterpreter.T MenhirInterpreter.T_METHOD -> ()
+ | MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_ESCAPE -> ()
+ | MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_OPEN -> ()
+ | MenhirInterpreter.T MenhirInterpreter.T_METAOCAML_BRACKET_CLOSE -> ()
| MenhirInterpreter.T MenhirInterpreter.T_MATCH -> ()
| MenhirInterpreter.T MenhirInterpreter.T_LPAREN -> ()
| MenhirInterpreter.T MenhirInterpreter.T_LIDENT -> "_"
@@ -99,7 +102,6 @@ module Default = struct
| MenhirInterpreter.T MenhirInterpreter.T_HASH -> ()
| MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACKET -> ()
| MenhirInterpreter.T MenhirInterpreter.T_GREATERRBRACE -> ()
- | MenhirInterpreter.T MenhirInterpreter.T_GREATERDOT -> ()
| MenhirInterpreter.T MenhirInterpreter.T_GREATER -> ()
| MenhirInterpreter.T MenhirInterpreter.T_FUNCTOR -> ()
| MenhirInterpreter.T MenhirInterpreter.T_FUNCTION -> ()
@@ -114,10 +116,9 @@ module Default = struct
| MenhirInterpreter.T MenhirInterpreter.T_EOF -> ()
| MenhirInterpreter.T MenhirInterpreter.T_END -> ()
| MenhirInterpreter.T MenhirInterpreter.T_ELSE -> ()
+ | MenhirInterpreter.T MenhirInterpreter.T_EFFECT -> ()
| MenhirInterpreter.T MenhirInterpreter.T_DOWNTO -> ()
- | MenhirInterpreter.T MenhirInterpreter.T_DOTTILDE -> ()
| MenhirInterpreter.T MenhirInterpreter.T_DOTOP -> raise Not_found
- | MenhirInterpreter.T MenhirInterpreter.T_DOTLESS -> ()
| MenhirInterpreter.T MenhirInterpreter.T_DOTDOT -> ()
| MenhirInterpreter.T MenhirInterpreter.T_DOT -> ()
| MenhirInterpreter.T MenhirInterpreter.T_DONE -> ()
@@ -380,7 +381,7 @@ type decision =
| Select of (int -> action list)
let depth =
- [|0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;3;2;2;1;2;1;2;3;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;1;2;3;4;5;2;3;4;5;2;3;4;5;1;1;1;1;1;1;2;3;1;4;5;1;1;1;1;1;1;2;1;2;3;1;1;1;2;2;3;4;1;1;2;1;2;3;1;1;2;4;1;2;1;1;1;2;2;1;1;1;2;2;1;2;3;2;3;5;6;1;1;1;1;1;2;1;2;1;1;1;2;1;2;1;1;1;2;3;4;5;6;7;8;1;2;1;2;3;1;1;1;2;3;1;1;1;2;2;1;2;2;1;1;2;3;4;1;1;5;6;6;1;2;3;4;1;1;2;1;1;1;1;1;2;3;4;1;2;3;1;2;3;1;1;2;3;3;1;1;4;1;2;1;1;1;2;3;1;1;1;1;2;1;1;1;2;1;1;2;3;1;1;1;1;2;1;2;2;1;1;1;2;3;4;2;3;1;2;3;1;2;2;1;2;1;1;2;1;2;1;1;2;1;1;2;3;1;4;1;1;1;1;1;2;3;2;3;2;1;2;3;2;1;2;3;4;3;3;3;1;1;3;4;2;3;1;2;1;3;4;2;3;5;1;2;1;2;3;2;3;4;5;3;4;3;4;4;5;6;2;1;2;2;1;1;2;3;1;1;2;1;1;1;1;1;1;4;1;1;2;3;1;1;1;2;3;4;1;2;3;1;1;1;2;3;2;3;2;1;2;1;1;2;3;1;2;4;5;6;1;1;1;2;3;2;3;2;3;3;4;5;2;3;2;3;2;4;4;5;4;5;3;4;2;3;1;2;3;3;2;3;4;5;1;6;5;2;2;3;1;1;2;1;2;3;3;4;2;1;2;3;1;1;2;3;4;5;1;2;1;2;2;3;1;2;3;1;2;1;2;3;4;1;5;2;1;2;3;1;2;4;5;4;5;6;2;3;4;5;1;1;2;3;4;5;2;1;2;3;3;1;1;1;4;5;2;3;2;3;4;2;3;4;1;3;2;3;1;4;2;3;4;5;3;4;1;5;2;3;2;3;3;4;5;2;2;1;1;6;7;1;1;1;1;1;1;1;1;1;2;3;1;2;3;1;2;3;1;2;3;1;1;2;1;2;3;1;1;2;1;2;3;3;4;5;1;2;1;2;3;4;1;2;1;1;1;2;4;1;2;5;6;1;2;3;4;5;6;7;8;9;2;3;1;1;2;3;4;5;1;1;1;2;1;1;2;3;4;1;1;4;5;6;7;8;9;10;1;1;1;1;2;3;4;1;2;3;4;2;3;2;3;1;2;3;4;5;1;2;3;4;5;1;1;2;3;1;2;1;2;3;4;4;5;2;1;2;1;2;2;3;2;3;4;5;1;2;3;4;5;6;1;2;1;1;1;1;1;2;3;1;1;2;3;4;5;6;3;2;3;4;5;6;3;2;1;2;1;2;3;4;5;2;2;3;4;5;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;1;2;1;1;2;2;3;4;5;6;7;8;3;2;3;4;5;6;7;2;3;4;2;1;1;2;3;1;4;1;1;2;3;4;5;1;2;3;2;3;2;3;2;3;2;3;2;1;1;2;3;1;3;1;2;4;2;3;3;4;5;3;4;5;3;4;5;6;7;1;2;3;5;6;7;5;6;7;3;1;2;2;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;2;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;11;12;9;5;6;7;8;9;10;11;12;9;5;6;7;8;9;10;11;12;9;3;4;5;6;7;8;5;1;2;2;1;2;6;4;5;3;4;5;3;4;5;5;1;2;3;2;3;4;2;3;1;1;4;5;3;4;4;5;3;4;4;5;3;4;5;3;1;2;3;1;2;3;4;5;1;4;5;1;2;3;3;6;1;1;7;8;9;10;11;6;7;3;4;5;2;3;3;2;4;4;5;6;7;8;9;10;11;12;13;14;11;6;7;8;9;10;11;8;4;4;5;4;2;3;4;5;6;2;3;2;2;3;2;3;4;5;2;2;3;4;2;2;3;2;3;8;3;4;5;6;7;2;3;4;5;1;2;1;2;3;4;6;7;8;1;2;2;3;4;1;1;2;3;1;5;1;1;1;1;2;3;1;2;3;4;5;6;7;1;2;3;1;2;1;1;2;3;2;1;1;2;3;4;5;6;4;2;3;4;2;6;7;8;9;1;2;3;1;4;5;6;2;4;5;2;2;3;4;5;6;3;2;2;3;2;2;3;4;5;6;6;7;8;2;3;3;4;4;5;6;4;5;6;7;8;8;9;10;8;9;10;10;11;12;4;5;5;6;7;5;6;7;7;8;9;5;6;2;3;4;5;1;2;3;4;5;1;2;6;7;2;3;4;5;6;7;1;2;3;4;5;6;8;4;5;6;1;2;1;2;3;4;1;2;1;2;3;4;5;1;2;3;4;5;1;2;3;6;7;1;2;8;9;1;1;2;3;4;5;1;1;2;3;6;7;8;5;6;7;1;1;1;2;3;4;5;6;2;3;4;5;1;2;3;4;5;6;7;8;2;3;4;5;6;7;4;5;6;7;8;1;2;3;4;5;6;7;9;4;5;6;7;1;2;5;6;1;2;1;2;3;4;5;1;2;3;4;1;2;3;4;1;5;1;2;3;6;7;8;1;2;1;2;3;3;1;2;1;2;1;2;3;4;5;6;7;1;2;1;2;1;2;3;4;5;6;7;1;2;1;2;3;4;5;6;1;2;3;4;2;3;1;1;1;7;2;3;4;5;6;3;4;1;2;1;2;3;3;4;4;5;1;2;1;1;2;9;10;1;2;3;4;5;6;7;8;9;11;2;3;4;5;6;7;1;2;3;4;1;1;1;2;1;2;3;1;1;4;1;3;5;8;9;1;2;3;4;5;6;7;8;9;10;1;1;1;1;1;1;1;1;2;1;2;1;1;2;3;4;5;6;7;8;2;1;1;2;3;4;5;1;1;2;3;1;1;2;3;4;1;1;2;6;7;8;9;1;1;1;2;3;4;5;6;4;4;1;2;3;3;4;5;3;3;1;2;1;1;2;2;1;2;1;2;3;4;5;6;1;1;2;3;1;1;2;3;4;5;6;5;6;7;2;3;1;1;2;1;2;2;3;4;5;2;3;4;5;4;5;6;1;1;2;1;3;4;5;6;7;8;9;10;11;6;7;8;5;2;3;1;1;2;1;2;2;3;4;5;2;3;4;5;6;7;8;9;10;5;6;7;4;1;2;3;4;1;2;3;1;1;2;3;4;5;6;7;2;3;4;5;6;1;2;3;4;1;2;1;2;1;2;1;1;2;1;3;2;2;3;2;3;7;3;4;5;6;2;3;4;5;2;3;3;4;5;4;1;2;5;6;2;3;4;5;1;2;3;4;4;5;1;2;1;1;2;2;1;2;3;4;1;2;7;8;1;2;3;4;5;6;7;8;9;1;1;1;1;1;1;1;1;2;1;1;2;1;2;1;1;1;1;2;3;1;1;1;3;4;3;4;2;3;4;2;3;4;5;7;8;2;3;3;4;5;4;5;6;4;5;6;3;4;9;6;7;8;1;2;3;4;5;9;10;2;2;1;1;1;1;1;2;3;4;4;5;6;7;8;5;6;7;8;9;3;4;3;4;5;6;1;7;1;2;3;2;2;3;3;4;5;2;3;4;5;4;2;3;2;2;3;2;3;4;2;2;2;2;7;8;9;10;6;7;8;9;10;2;1;1;4;5;6;7;8;9;5;6;7;8;9;3;4;5;6;6;7;3;4;3;4;5;6;7;1;2;1;0;1;2;1;0;1;2;3;1;1;1;2;3;4;5;3;3;1;1;1;1;2;0;1;1;2;0;1;1;2;0;1;2;1;0;1;1;2;0;1;1;2;0;1;1;2;0;1;1;2;0;1;1;2;0;1;2;1;0;1;2;1;1;2;0;1;2;3;3;3;3;3;3;1;1;1;2;1;2;1;2;3;1;2;0;1;1;1;2;2;2;3;4;2;1;1;2;3;4;1;2;|]
+ [|0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;3;2;2;1;2;1;2;3;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;1;2;3;4;5;2;3;4;5;2;3;4;5;1;1;1;1;1;1;2;3;1;4;5;1;1;1;1;1;1;2;1;2;3;1;1;1;2;2;3;4;1;1;2;1;2;3;1;1;2;4;1;2;1;1;1;2;2;1;1;1;2;2;1;2;3;2;3;5;6;1;1;1;1;1;2;1;2;1;1;1;2;1;2;1;1;1;2;3;4;5;6;7;8;1;2;1;2;3;1;1;1;2;3;1;1;1;2;2;1;2;2;1;1;2;3;4;1;1;5;6;6;1;2;3;4;1;1;2;1;1;1;1;1;2;3;4;1;2;3;1;2;3;1;1;2;3;3;1;1;4;1;2;1;1;1;1;1;2;3;1;1;1;1;2;1;1;1;2;1;1;2;3;1;1;1;1;2;1;2;2;1;1;1;2;3;4;2;3;1;2;3;1;2;2;1;2;1;1;2;1;2;1;1;2;1;1;2;3;1;4;1;1;1;1;1;2;3;2;3;2;1;2;3;2;1;2;3;4;3;3;3;1;1;3;4;2;3;1;2;1;3;4;2;3;5;1;2;1;2;3;2;3;4;5;3;4;3;4;4;5;6;2;1;2;2;1;1;2;3;1;1;2;1;1;1;1;1;1;4;1;1;2;3;1;1;1;2;3;4;1;2;3;1;1;2;3;4;1;1;1;1;1;1;2;3;2;3;2;1;2;3;1;2;4;5;6;1;2;3;2;3;2;3;3;4;5;2;3;2;3;2;2;4;4;5;4;5;3;4;2;3;1;2;3;3;2;3;4;5;1;6;5;2;2;3;1;1;2;1;2;3;3;4;2;1;2;3;1;1;2;3;4;5;1;2;1;2;2;3;1;1;1;2;1;2;3;4;1;5;2;1;2;3;1;2;4;5;4;5;6;2;3;4;5;1;1;2;3;4;5;2;1;2;3;3;1;1;1;2;3;2;3;1;1;4;5;2;3;4;2;3;4;1;3;2;3;2;3;4;5;3;4;1;5;2;3;2;3;3;4;5;2;2;1;1;6;7;1;1;1;1;1;1;1;2;3;1;2;3;1;1;1;2;1;1;2;3;4;1;1;4;5;6;7;8;9;10;1;1;1;1;2;3;4;1;2;3;1;2;3;1;1;2;1;2;3;1;1;2;1;2;3;3;4;5;1;2;1;2;3;4;1;2;1;1;1;2;4;1;2;5;6;1;2;3;4;5;6;7;8;9;2;3;1;1;2;3;4;5;1;2;3;4;2;3;2;3;1;2;3;4;5;1;2;3;4;5;1;1;2;3;1;2;1;2;3;4;4;5;2;1;2;1;2;2;3;2;3;4;5;1;2;3;4;5;6;1;2;1;1;1;1;1;2;3;1;1;2;3;4;5;6;3;2;3;4;5;6;3;2;1;2;1;2;3;4;5;2;2;3;4;5;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;2;3;4;5;6;3;1;2;1;1;2;2;3;4;5;6;7;8;3;2;3;4;5;6;7;2;3;4;2;1;1;2;3;1;4;1;1;2;3;4;5;1;2;3;2;3;2;3;2;3;2;3;2;1;1;2;3;1;3;1;2;4;2;3;3;4;5;3;4;5;3;4;5;6;7;1;2;3;5;6;7;5;6;7;3;1;2;2;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;2;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;7;3;4;5;6;7;8;9;10;11;12;9;5;6;7;8;9;10;11;12;9;5;6;7;8;9;10;11;12;9;3;4;5;6;7;8;5;1;2;2;1;2;6;4;5;3;4;5;3;4;5;6;1;1;7;8;9;10;11;6;7;3;4;5;2;3;3;2;4;4;5;6;7;8;9;10;11;12;13;14;11;6;7;8;9;10;11;8;5;1;2;3;2;3;4;2;3;1;1;4;5;3;4;4;5;3;4;4;5;3;4;5;3;1;2;3;1;2;3;4;5;1;4;5;1;2;3;3;4;4;4;5;2;3;2;3;4;5;2;2;3;4;2;2;3;2;3;8;3;4;5;6;7;2;3;4;5;1;2;1;2;3;4;6;7;8;1;2;2;3;4;1;1;2;3;1;5;1;1;1;1;2;3;1;2;3;4;5;6;7;1;2;3;1;2;1;1;2;3;2;1;1;2;3;4;5;6;4;2;3;4;2;6;7;8;9;1;2;3;1;4;5;6;2;4;5;2;2;3;4;5;6;3;2;2;3;2;2;3;4;5;6;6;7;8;2;3;3;4;4;5;6;2;3;2;4;5;6;7;8;8;9;10;8;9;10;10;11;12;4;5;5;6;7;5;6;7;7;8;9;5;6;2;3;4;5;1;2;3;4;5;1;2;6;7;2;3;4;5;6;7;1;2;3;4;5;6;8;4;5;6;1;2;1;2;3;4;1;2;1;2;3;4;5;1;2;3;4;5;1;2;3;6;7;1;2;8;9;1;1;2;3;4;5;1;1;2;3;6;7;8;5;6;7;1;1;1;2;3;4;5;6;2;3;4;5;1;2;3;4;5;6;7;8;2;3;4;5;6;7;4;5;6;7;8;1;2;3;4;5;6;7;9;4;5;6;7;1;2;5;6;1;2;1;2;3;4;5;1;2;3;4;1;2;3;4;1;5;1;2;3;6;7;8;1;2;1;2;3;3;1;2;1;2;1;2;3;4;5;6;7;1;2;1;2;1;2;3;4;5;6;7;1;2;1;2;3;4;5;6;1;2;3;4;2;3;1;1;1;7;2;3;4;5;6;3;4;1;2;1;2;3;3;4;4;5;1;2;1;1;2;9;10;1;2;3;4;5;6;7;8;9;11;2;3;4;5;6;7;1;2;3;4;1;1;1;2;1;2;3;1;1;4;1;3;5;8;9;1;2;3;4;5;6;7;8;9;10;1;1;1;1;1;1;1;1;2;1;2;1;1;2;3;4;5;6;7;8;2;1;1;2;3;4;5;1;1;2;3;1;1;2;3;4;1;1;2;6;7;8;9;1;1;1;2;3;4;5;6;4;4;1;2;3;3;4;5;3;3;1;2;1;1;2;2;1;2;1;2;3;4;5;6;1;1;2;3;1;1;2;3;4;5;6;5;6;7;2;3;1;1;2;1;2;2;3;4;5;2;3;4;5;4;5;6;1;1;2;1;3;4;5;6;7;8;9;10;11;6;7;8;5;2;3;1;1;2;1;2;2;3;4;5;2;3;4;5;6;7;8;9;10;5;6;7;4;1;2;3;4;1;2;3;1;1;2;3;4;5;6;7;2;3;4;5;6;1;2;3;4;1;2;1;2;1;2;1;1;2;1;3;2;2;3;2;3;7;3;4;5;6;2;3;4;5;2;3;3;4;5;4;1;2;5;6;2;3;4;5;1;2;3;4;4;5;1;2;1;1;2;2;1;2;3;4;1;2;7;8;1;2;3;4;5;6;7;8;9;1;1;1;1;1;1;1;1;2;1;1;2;1;2;1;1;1;1;2;3;1;1;1;3;4;3;4;2;3;4;2;3;4;5;7;8;2;3;3;4;5;4;5;6;4;5;6;3;4;9;6;7;8;1;2;3;4;5;9;10;2;2;1;1;1;1;1;2;3;4;4;5;6;7;8;5;6;7;8;9;3;4;3;4;5;6;1;7;1;2;3;2;2;3;3;4;5;2;3;4;5;4;2;3;2;2;3;2;3;4;2;2;2;2;7;8;9;10;6;7;8;9;10;2;1;1;4;5;6;7;8;9;5;6;7;8;9;3;4;5;6;6;7;3;4;3;4;5;6;7;1;2;1;0;1;2;1;0;1;2;3;1;1;1;2;3;4;5;3;3;1;1;1;1;2;0;1;1;2;0;1;1;2;0;1;2;1;0;1;1;2;0;1;1;2;0;1;1;2;0;1;1;2;0;1;1;2;0;1;2;1;0;1;2;1;1;2;0;1;2;3;3;3;3;3;3;1;1;1;2;1;2;1;2;3;1;2;0;1;1;1;2;2;2;3;4;2;1;1;2;3;4;1;2;|]
let can_pop (type a) : a terminal -> bool = function
| T_WITH -> true
@@ -423,6 +424,9 @@ let can_pop (type a) : a terminal -> bool = function
| T_MINUSDOT -> true
| T_MINUS -> true
| T_METHOD -> true
+ | T_METAOCAML_ESCAPE -> true
+ | T_METAOCAML_BRACKET_OPEN -> true
+ | T_METAOCAML_BRACKET_CLOSE -> true
| T_MATCH -> true
| T_LPAREN -> true
| T_LET -> true
@@ -448,7 +452,6 @@ let can_pop (type a) : a terminal -> bool = function
| T_HASH -> true
| T_GREATERRBRACKET -> true
| T_GREATERRBRACE -> true
- | T_GREATERDOT -> true
| T_GREATER -> true
| T_FUNCTOR -> true
| T_FUNCTION -> true
@@ -461,9 +464,8 @@ let can_pop (type a) : a terminal -> bool = function
| T_EOL -> true
| T_END -> true
| T_ELSE -> true
+ | T_EFFECT -> true
| T_DOWNTO -> true
- | T_DOTTILDE -> true
- | T_DOTLESS -> true
| T_DOTDOT -> true
| T_DOT -> true
| T_DONE -> true
@@ -491,7 +493,7 @@ let can_pop (type a) : a terminal -> bool = function
let recover =
let r0 = [R 232] in
let r1 = S (N N_fun_expr) :: r0 in
- let r2 = [R 635] in
+ let r2 = [R 636] in
let r3 = Sub (r1) :: r2 in
let r4 = [R 150] in
let r5 = S (T T_DONE) :: r4 in
@@ -505,7 +507,7 @@ let recover =
let r13 = Sub (r11) :: r12 in
let r14 = [R 125] in
let r15 = [R 33] in
- let r16 = [R 547] in
+ let r16 = [R 548] in
let r17 = S (N N_structure) :: r16 in
let r18 = [R 34] in
let r19 = Sub (r17) :: r18 in
@@ -524,7 +526,7 @@ let recover =
let r32 = Sub (r30) :: r31 in
let r33 = [R 108] in
let r34 = Sub (r32) :: r33 in
- let r35 = [R 552] in
+ let r35 = [R 553] in
let r36 = Sub (r34) :: r35 in
let r37 = [R 854] in
let r38 = R 322 :: r37 in
@@ -549,7 +551,7 @@ let recover =
let r57 = [R 127] in
let r58 = [R 256] in
let r59 = S (T T_LIDENT) :: r58 in
- let r60 = [R 591] in
+ let r60 = [R 592] in
let r61 = [R 30] in
let r62 = Sub (r59) :: r61 in
let r63 = [R 501] in
@@ -559,14 +561,14 @@ let recover =
let r67 = S (N N_module_type) :: r66 in
let r68 = R 316 :: r67 in
let r69 = R 124 :: r68 in
- let r70 = [R 638] in
+ let r70 = [R 639] in
let r71 = R 324 :: r70 in
let r72 = [R 401] in
let r73 = S (T T_END) :: r72 in
let r74 = Sub (r71) :: r73 in
let r75 = [R 253] in
let r76 = R 322 :: r75 in
- let r77 = R 581 :: r76 in
+ let r77 = R 582 :: r76 in
let r78 = R 824 :: r77 in
let r79 = S (T T_LIDENT) :: r78 in
let r80 = R 828 :: r79 in
@@ -584,26 +586,26 @@ let recover =
let r92 = R 316 :: r91 in
let r93 = R 243 :: r92 in
let r94 = Sub (r90) :: r93 in
- let r95 = [R 578] in
+ let r95 = [R 579] in
let r96 = Sub (r94) :: r95 in
- let r97 = [R 645] in
+ let r97 = [R 646] in
let r98 = R 322 :: r97 in
let r99 = Sub (r96) :: r98 in
- let r100 = R 558 :: r99 in
+ let r100 = R 559 :: r99 in
let r101 = S (T T_PLUSEQ) :: r100 in
let r102 = Sub (r86) :: r101 in
let r103 = R 828 :: r102 in
let r104 = R 316 :: r103 in
let r105 = [R 254] in
let r106 = R 322 :: r105 in
- let r107 = R 581 :: r106 in
+ let r107 = R 582 :: r106 in
let r108 = R 824 :: r107 in
let r109 = S (T T_LIDENT) :: r108 in
let r110 = R 828 :: r109 in
- let r111 = [R 646] in
+ let r111 = [R 647] in
let r112 = R 322 :: r111 in
let r113 = Sub (r96) :: r112 in
- let r114 = R 558 :: r113 in
+ let r114 = R 559 :: r113 in
let r115 = S (T T_PLUSEQ) :: r114 in
let r116 = Sub (r86) :: r115 in
let r117 = [R 832] in
@@ -611,12 +613,12 @@ let recover =
let r119 = [R 827] in
let r120 = Sub (r118) :: r119 in
let r121 = R 833 :: r120 in
- let r122 = [R 604] in
+ let r122 = [R 605] in
let r123 = Sub (r121) :: r122 in
let r124 = [R 830] in
let r125 = S (T T_RPAREN) :: r124 in
let r126 = [R 831] in
- let r127 = [R 605] in
+ let r127 = [R 606] in
let r128 = [R 432] in
let r129 = S (T T_DOTDOT) :: r128 in
let r130 = [R 825] in
@@ -629,7 +631,7 @@ let recover =
let r137 = S (T T_MINUSGREATER) :: r136 in
let r138 = Sub (r28) :: r137 in
let r139 = [R 441] in
- let r140 = [R 554] in
+ let r140 = [R 555] in
let r141 = Sub (r32) :: r140 in
let r142 = [R 353] in
let r143 = R 316 :: r142 in
@@ -639,12 +641,12 @@ let recover =
let r147 = Sub (r17) :: r146 in
let r148 = [R 701] in
let r149 = [R 377] in
- let r150 = [R 572] in
+ let r150 = [R 573] in
let r151 = Sub (r94) :: r150 in
let r152 = [R 794] in
let r153 = R 322 :: r152 in
let r154 = Sub (r151) :: r153 in
- let r155 = R 558 :: r154 in
+ let r155 = R 559 :: r154 in
let r156 = S (T T_PLUSEQ) :: r155 in
let r157 = Sub (r86) :: r156 in
let r158 = R 828 :: r157 in
@@ -652,17 +654,17 @@ let recover =
let r160 = [R 795] in
let r161 = R 322 :: r160 in
let r162 = Sub (r151) :: r161 in
- let r163 = R 558 :: r162 in
+ let r163 = R 559 :: r162 in
let r164 = S (T T_PLUSEQ) :: r163 in
let r165 = Sub (r86) :: r164 in
- let r166 = [R 556] in
+ let r166 = [R 557] in
let r167 = S (T T_RBRACKET) :: r166 in
let r168 = Sub (r19) :: r167 in
let r169 = [R 346] in
let r170 = Sub (r3) :: r169 in
let r171 = S (T T_MINUSGREATER) :: r170 in
let r172 = S (N N_pattern) :: r171 in
- let r173 = [R 593] in
+ let r173 = [R 594] in
let r174 = Sub (r172) :: r173 in
let r175 = [R 143] in
let r176 = Sub (r174) :: r175 in
@@ -679,8 +681,8 @@ let recover =
let r187 = [R 58] in
let r188 = S (T T_RPAREN) :: r187 in
let r189 = [R 719] in
- let r190 = [R 661] in
- let r191 = [R 659] in
+ let r190 = [R 662] in
+ let r191 = [R 660] in
let r192 = [R 715] in
let r193 = S (T T_RPAREN) :: r192 in
let r194 = [R 399] in
@@ -691,7 +693,7 @@ let recover =
let r199 = R 316 :: r198 in
let r200 = [R 718] in
let r201 = S (T T_RPAREN) :: r200 in
- let r202 = [R 403] in
+ let r202 = [R 404] in
let r203 = S (N N_module_expr) :: r202 in
let r204 = R 316 :: r203 in
let r205 = S (T T_OF) :: r204 in
@@ -724,1079 +726,1080 @@ let recover =
let r232 = [R 378] in
let r233 = [R 383] in
let r234 = [R 317] in
- let r235 = [R 142] in
- let r236 = Sub (r174) :: r235 in
- let r237 = S (T T_WITH) :: r236 in
- let r238 = Sub (r3) :: r237 in
- let r239 = R 316 :: r238 in
- let r240 = [R 670] in
- let r241 = S (T T_RPAREN) :: r240 in
- let r242 = [R 706] in
- let r243 = [R 206] in
- let r244 = [R 301] in
- let r245 = Sub (r24) :: r244 in
- let r246 = [R 304] in
- let r247 = Sub (r245) :: r246 in
- let r248 = [R 203] in
- let r249 = Sub (r3) :: r248 in
- let r250 = S (T T_IN) :: r249 in
- let r251 = [R 666] in
- let r252 = [R 91] in
- let r253 = [R 629] in
- let r254 = S (N N_pattern) :: r253 in
- let r255 = [R 664] in
- let r256 = S (T T_RBRACKET) :: r255 in
- let r257 = [R 270] in
- let r258 = Sub (r224) :: r257 in
- let r259 = [R 342] in
- let r260 = R 494 :: r259 in
- let r261 = R 487 :: r260 in
- let r262 = Sub (r258) :: r261 in
- let r263 = [R 663] in
- let r264 = S (T T_RBRACE) :: r263 in
- let r265 = [R 488] in
- let r266 = [R 619] in
- let r267 = Sub (r34) :: r266 in
- let r268 = [R 600] in
- let r269 = Sub (r267) :: r268 in
- let r270 = [R 120] in
- let r271 = S (T T_RBRACKET) :: r270 in
- let r272 = Sub (r269) :: r271 in
- let r273 = [R 119] in
+ let r235 = [R 679] in
+ let r236 = [R 680] in
+ let r237 = S (T T_METAOCAML_BRACKET_CLOSE) :: r236 in
+ let r238 = [R 142] in
+ let r239 = Sub (r174) :: r238 in
+ let r240 = S (T T_WITH) :: r239 in
+ let r241 = Sub (r3) :: r240 in
+ let r242 = R 316 :: r241 in
+ let r243 = [R 668] in
+ let r244 = S (T T_RPAREN) :: r243 in
+ let r245 = [R 706] in
+ let r246 = [R 206] in
+ let r247 = [R 301] in
+ let r248 = Sub (r24) :: r247 in
+ let r249 = [R 304] in
+ let r250 = Sub (r248) :: r249 in
+ let r251 = [R 203] in
+ let r252 = Sub (r3) :: r251 in
+ let r253 = S (T T_IN) :: r252 in
+ let r254 = [R 667] in
+ let r255 = [R 91] in
+ let r256 = [R 630] in
+ let r257 = S (N N_pattern) :: r256 in
+ let r258 = [R 665] in
+ let r259 = S (T T_RBRACKET) :: r258 in
+ let r260 = [R 270] in
+ let r261 = Sub (r224) :: r260 in
+ let r262 = [R 342] in
+ let r263 = R 494 :: r262 in
+ let r264 = R 487 :: r263 in
+ let r265 = Sub (r261) :: r264 in
+ let r266 = [R 664] in
+ let r267 = S (T T_RBRACE) :: r266 in
+ let r268 = [R 488] in
+ let r269 = [R 620] in
+ let r270 = Sub (r34) :: r269 in
+ let r271 = [R 601] in
+ let r272 = Sub (r270) :: r271 in
+ let r273 = [R 120] in
let r274 = S (T T_RBRACKET) :: r273 in
- let r275 = [R 118] in
- let r276 = S (T T_RBRACKET) :: r275 in
- let r277 = [R 421] in
- let r278 = Sub (r59) :: r277 in
- let r279 = S (T T_BACKQUOTE) :: r278 in
- let r280 = [R 807] in
- let r281 = R 316 :: r280 in
- let r282 = Sub (r279) :: r281 in
- let r283 = [R 115] in
- let r284 = S (T T_RBRACKET) :: r283 in
- let r285 = [R 86] in
- let r286 = Sub (r84) :: r285 in
- let r287 = [R 26] in
- let r288 = [R 364] in
- let r289 = S (T T_LIDENT) :: r288 in
- let r290 = S (T T_DOT) :: r289 in
- let r291 = S (T T_UIDENT) :: r56 in
- let r292 = [R 381] in
- let r293 = Sub (r291) :: r292 in
- let r294 = [R 382] in
- let r295 = S (T T_RPAREN) :: r294 in
- let r296 = [R 366] in
- let r297 = S (T T_UIDENT) :: r296 in
- let r298 = [R 116] in
- let r299 = S (T T_RBRACKET) :: r298 in
- let r300 = [R 239] in
- let r301 = [R 616] in
- let r302 = S (T T_DOT) :: r297 in
- let r303 = S (T T_LBRACKETGREATER) :: r274 in
- let r304 = [R 29] in
- let r305 = Sub (r303) :: r304 in
- let r306 = [R 237] in
- let r307 = Sub (r30) :: r306 in
- let r308 = S (T T_MINUSGREATER) :: r307 in
- let r309 = [R 617] in
- let r310 = [R 27] in
- let r311 = [R 113] in
- let r312 = [R 18] in
- let r313 = Sub (r59) :: r312 in
- let r314 = [R 601] in
- let r315 = [R 596] in
- let r316 = Sub (r32) :: r315 in
- let r317 = [R 806] in
- let r318 = R 316 :: r317 in
- let r319 = Sub (r316) :: r318 in
- let r320 = [R 597] in
- let r321 = [R 117] in
- let r322 = S (T T_RBRACKET) :: r321 in
- let r323 = Sub (r269) :: r322 in
- let r324 = [R 589] in
- let r325 = Sub (r279) :: r324 in
- let r326 = [R 121] in
- let r327 = S (T T_RBRACKET) :: r326 in
- let r328 = [R 495] in
- let r329 = S (T T_UNDERSCORE) :: r189 in
- let r330 = [R 714] in
- let r331 = Sub (r329) :: r330 in
- let r332 = [R 538] in
- let r333 = Sub (r331) :: r332 in
- let r334 = R 316 :: r333 in
- let r335 = [R 87] in
- let r336 = [R 724] in
- let r337 = S (T T_INT) :: r335 in
- let r338 = [R 658] in
- let r339 = Sub (r337) :: r338 in
- let r340 = [R 721] in
- let r341 = [R 726] in
- let r342 = S (T T_RBRACKET) :: r341 in
- let r343 = S (T T_LBRACKET) :: r342 in
- let r344 = [R 727] in
- let r345 = [R 529] in
- let r346 = S (N N_pattern) :: r345 in
- let r347 = R 316 :: r346 in
- let r348 = [R 530] in
- let r349 = [R 523] in
- let r350 = [R 537] in
+ let r275 = Sub (r272) :: r274 in
+ let r276 = [R 119] in
+ let r277 = S (T T_RBRACKET) :: r276 in
+ let r278 = [R 118] in
+ let r279 = S (T T_RBRACKET) :: r278 in
+ let r280 = [R 421] in
+ let r281 = Sub (r59) :: r280 in
+ let r282 = S (T T_BACKQUOTE) :: r281 in
+ let r283 = [R 807] in
+ let r284 = R 316 :: r283 in
+ let r285 = Sub (r282) :: r284 in
+ let r286 = [R 115] in
+ let r287 = S (T T_RBRACKET) :: r286 in
+ let r288 = [R 86] in
+ let r289 = Sub (r84) :: r288 in
+ let r290 = [R 26] in
+ let r291 = [R 364] in
+ let r292 = S (T T_LIDENT) :: r291 in
+ let r293 = S (T T_DOT) :: r292 in
+ let r294 = S (T T_UIDENT) :: r56 in
+ let r295 = [R 381] in
+ let r296 = Sub (r294) :: r295 in
+ let r297 = [R 382] in
+ let r298 = S (T T_RPAREN) :: r297 in
+ let r299 = [R 366] in
+ let r300 = S (T T_UIDENT) :: r299 in
+ let r301 = [R 116] in
+ let r302 = S (T T_RBRACKET) :: r301 in
+ let r303 = [R 239] in
+ let r304 = [R 617] in
+ let r305 = S (T T_DOT) :: r300 in
+ let r306 = S (T T_LBRACKETGREATER) :: r277 in
+ let r307 = [R 29] in
+ let r308 = Sub (r306) :: r307 in
+ let r309 = [R 237] in
+ let r310 = Sub (r30) :: r309 in
+ let r311 = S (T T_MINUSGREATER) :: r310 in
+ let r312 = [R 618] in
+ let r313 = [R 27] in
+ let r314 = [R 113] in
+ let r315 = [R 18] in
+ let r316 = Sub (r59) :: r315 in
+ let r317 = [R 602] in
+ let r318 = [R 597] in
+ let r319 = Sub (r32) :: r318 in
+ let r320 = [R 806] in
+ let r321 = R 316 :: r320 in
+ let r322 = Sub (r319) :: r321 in
+ let r323 = [R 598] in
+ let r324 = [R 117] in
+ let r325 = S (T T_RBRACKET) :: r324 in
+ let r326 = Sub (r272) :: r325 in
+ let r327 = [R 590] in
+ let r328 = Sub (r282) :: r327 in
+ let r329 = [R 121] in
+ let r330 = S (T T_RBRACKET) :: r329 in
+ let r331 = [R 495] in
+ let r332 = S (T T_UNDERSCORE) :: r189 in
+ let r333 = [R 714] in
+ let r334 = Sub (r332) :: r333 in
+ let r335 = [R 539] in
+ let r336 = Sub (r334) :: r335 in
+ let r337 = R 316 :: r336 in
+ let r338 = [R 87] in
+ let r339 = [R 724] in
+ let r340 = S (T T_INT) :: r338 in
+ let r341 = [R 659] in
+ let r342 = Sub (r340) :: r341 in
+ let r343 = [R 721] in
+ let r344 = [R 726] in
+ let r345 = S (T T_RBRACKET) :: r344 in
+ let r346 = S (T T_LBRACKET) :: r345 in
+ let r347 = [R 727] in
+ let r348 = [R 529] in
+ let r349 = S (N N_pattern) :: r348 in
+ let r350 = R 316 :: r349 in
let r351 = [R 535] in
- let r352 = [R 422] in
- let r353 = S (T T_LIDENT) :: r352 in
- let r354 = [R 536] in
- let r355 = Sub (r331) :: r354 in
- let r356 = S (T T_RPAREN) :: r355 in
- let r357 = [R 101] in
- let r358 = [R 100] in
- let r359 = S (T T_RPAREN) :: r358 in
- let r360 = [R 531] in
- let r361 = [R 729] in
- let r362 = S (T T_RPAREN) :: r361 in
- let r363 = [R 528] in
- let r364 = [R 526] in
- let r365 = [R 99] in
- let r366 = S (T T_RPAREN) :: r365 in
- let r367 = [R 728] in
- let r368 = [R 344] in
- let r369 = [R 665] in
- let r370 = [R 282] in
- let r371 = [R 268] in
- let r372 = S (T T_LIDENT) :: r371 in
- let r373 = [R 281] in
+ let r352 = Sub (r334) :: r351 in
+ let r353 = [R 530] in
+ let r354 = Sub (r334) :: r353 in
+ let r355 = S (T T_COMMA) :: r354 in
+ let r356 = [R 101] in
+ let r357 = [R 538] in
+ let r358 = [R 531] in
+ let r359 = [R 523] in
+ let r360 = [R 536] in
+ let r361 = [R 422] in
+ let r362 = S (T T_LIDENT) :: r361 in
+ let r363 = [R 537] in
+ let r364 = Sub (r334) :: r363 in
+ let r365 = S (T T_RPAREN) :: r364 in
+ let r366 = [R 100] in
+ let r367 = S (T T_RPAREN) :: r366 in
+ let r368 = [R 532] in
+ let r369 = [R 729] in
+ let r370 = S (T T_RPAREN) :: r369 in
+ let r371 = [R 528] in
+ let r372 = [R 526] in
+ let r373 = [R 99] in
let r374 = S (T T_RPAREN) :: r373 in
- let r375 = [R 269] in
- let r376 = [R 278] in
- let r377 = [R 277] in
- let r378 = S (T T_RPAREN) :: r377 in
- let r379 = R 496 :: r378 in
- let r380 = [R 497] in
- let r381 = [R 139] in
- let r382 = Sub (r3) :: r381 in
- let r383 = S (T T_IN) :: r382 in
- let r384 = S (N N_module_expr) :: r383 in
- let r385 = R 316 :: r384 in
- let r386 = R 124 :: r385 in
- let r387 = [R 286] in
- let r388 = Sub (r24) :: r387 in
- let r389 = [R 293] in
- let r390 = R 322 :: r389 in
- let r391 = Sub (r388) :: r390 in
- let r392 = R 565 :: r391 in
+ let r375 = [R 728] in
+ let r376 = [R 344] in
+ let r377 = [R 666] in
+ let r378 = [R 282] in
+ let r379 = [R 268] in
+ let r380 = S (T T_LIDENT) :: r379 in
+ let r381 = [R 281] in
+ let r382 = S (T T_RPAREN) :: r381 in
+ let r383 = [R 269] in
+ let r384 = [R 278] in
+ let r385 = [R 277] in
+ let r386 = S (T T_RPAREN) :: r385 in
+ let r387 = R 496 :: r386 in
+ let r388 = [R 497] in
+ let r389 = [R 139] in
+ let r390 = Sub (r3) :: r389 in
+ let r391 = S (T T_IN) :: r390 in
+ let r392 = S (N N_module_expr) :: r391 in
let r393 = R 316 :: r392 in
let r394 = R 124 :: r393 in
- let r395 = [R 140] in
- let r396 = Sub (r3) :: r395 in
- let r397 = S (T T_IN) :: r396 in
- let r398 = S (N N_module_expr) :: r397 in
- let r399 = R 316 :: r398 in
- let r400 = [R 390] in
- let r401 = S (N N_module_expr) :: r400 in
- let r402 = S (T T_MINUSGREATER) :: r401 in
- let r403 = S (N N_functor_args) :: r402 in
- let r404 = [R 240] in
- let r405 = [R 241] in
- let r406 = S (T T_RPAREN) :: r405 in
- let r407 = S (N N_module_type) :: r406 in
- let r408 = [R 404] in
- let r409 = S (T T_RPAREN) :: r408 in
- let r410 = [R 407] in
- let r411 = S (N N_module_type) :: r410 in
- let r412 = [R 402] in
- let r413 = S (N N_module_type) :: r412 in
- let r414 = S (T T_MINUSGREATER) :: r413 in
- let r415 = S (N N_functor_args) :: r414 in
- let r416 = [R 373] in
- let r417 = Sub (r59) :: r416 in
- let r418 = [R 413] in
- let r419 = Sub (r417) :: r418 in
- let r420 = [R 867] in
- let r421 = S (N N_module_type) :: r420 in
- let r422 = S (T T_EQUAL) :: r421 in
- let r423 = Sub (r419) :: r422 in
- let r424 = S (T T_TYPE) :: r423 in
- let r425 = S (T T_MODULE) :: r424 in
- let r426 = [R 598] in
- let r427 = Sub (r425) :: r426 in
- let r428 = [R 409] in
- let r429 = [R 864] in
- let r430 = Sub (r32) :: r429 in
- let r431 = S (T T_COLONEQUAL) :: r430 in
- let r432 = Sub (r258) :: r431 in
- let r433 = [R 863] in
- let r434 = R 581 :: r433 in
- let r435 = [R 582] in
- let r436 = Sub (r34) :: r435 in
- let r437 = S (T T_EQUAL) :: r436 in
- let r438 = [R 374] in
- let r439 = Sub (r59) :: r438 in
- let r440 = [R 868] in
- let r441 = [R 408] in
- let r442 = [R 865] in
- let r443 = Sub (r293) :: r442 in
- let r444 = S (T T_UIDENT) :: r232 in
- let r445 = [R 866] in
- let r446 = [R 599] in
- let r447 = [R 395] in
- let r448 = [R 502] in
- let r449 = S (T T_RPAREN) :: r448 in
- let r450 = [R 620] in
- let r451 = S (N N_fun_expr) :: r450 in
- let r452 = [R 709] in
- let r453 = S (T T_RBRACKET) :: r452 in
- let r454 = [R 694] in
- let r455 = [R 626] in
- let r456 = R 489 :: r455 in
- let r457 = [R 490] in
- let r458 = [R 632] in
- let r459 = R 489 :: r458 in
- let r460 = R 498 :: r459 in
- let r461 = Sub (r258) :: r460 in
- let r462 = [R 567] in
- let r463 = Sub (r461) :: r462 in
- let r464 = [R 703] in
- let r465 = S (T T_RBRACE) :: r464 in
- let r466 = [R 669] in
- let r467 = [R 667] in
- let r468 = S (T T_GREATERDOT) :: r467 in
- let r469 = [R 153] in
- let r470 = Sub (r180) :: r469 in
- let r471 = R 316 :: r470 in
- let r472 = [R 682] in
- let r473 = S (T T_END) :: r472 in
- let r474 = R 316 :: r473 in
- let r475 = [R 148] in
- let r476 = S (N N_fun_expr) :: r475 in
- let r477 = S (T T_THEN) :: r476 in
- let r478 = Sub (r3) :: r477 in
+ let r395 = [R 286] in
+ let r396 = Sub (r24) :: r395 in
+ let r397 = [R 293] in
+ let r398 = R 322 :: r397 in
+ let r399 = Sub (r396) :: r398 in
+ let r400 = R 566 :: r399 in
+ let r401 = R 316 :: r400 in
+ let r402 = R 124 :: r401 in
+ let r403 = [R 140] in
+ let r404 = Sub (r3) :: r403 in
+ let r405 = S (T T_IN) :: r404 in
+ let r406 = S (N N_module_expr) :: r405 in
+ let r407 = R 316 :: r406 in
+ let r408 = [R 390] in
+ let r409 = S (N N_module_expr) :: r408 in
+ let r410 = S (T T_MINUSGREATER) :: r409 in
+ let r411 = S (N N_functor_args) :: r410 in
+ let r412 = [R 240] in
+ let r413 = [R 241] in
+ let r414 = S (T T_RPAREN) :: r413 in
+ let r415 = S (N N_module_type) :: r414 in
+ let r416 = [R 405] in
+ let r417 = S (T T_RPAREN) :: r416 in
+ let r418 = [R 402] in
+ let r419 = S (N N_module_type) :: r418 in
+ let r420 = S (T T_MINUSGREATER) :: r419 in
+ let r421 = S (N N_functor_args) :: r420 in
+ let r422 = [R 373] in
+ let r423 = Sub (r59) :: r422 in
+ let r424 = [R 413] in
+ let r425 = Sub (r423) :: r424 in
+ let r426 = [R 867] in
+ let r427 = S (N N_module_type) :: r426 in
+ let r428 = S (T T_EQUAL) :: r427 in
+ let r429 = Sub (r425) :: r428 in
+ let r430 = S (T T_TYPE) :: r429 in
+ let r431 = S (T T_MODULE) :: r430 in
+ let r432 = [R 599] in
+ let r433 = Sub (r431) :: r432 in
+ let r434 = [R 409] in
+ let r435 = [R 864] in
+ let r436 = Sub (r32) :: r435 in
+ let r437 = S (T T_COLONEQUAL) :: r436 in
+ let r438 = Sub (r261) :: r437 in
+ let r439 = [R 863] in
+ let r440 = R 582 :: r439 in
+ let r441 = [R 583] in
+ let r442 = Sub (r34) :: r441 in
+ let r443 = S (T T_EQUAL) :: r442 in
+ let r444 = [R 374] in
+ let r445 = Sub (r59) :: r444 in
+ let r446 = [R 403] in
+ let r447 = S (N N_module_type) :: r446 in
+ let r448 = [R 408] in
+ let r449 = [R 868] in
+ let r450 = [R 865] in
+ let r451 = Sub (r296) :: r450 in
+ let r452 = S (T T_UIDENT) :: r232 in
+ let r453 = [R 866] in
+ let r454 = [R 600] in
+ let r455 = [R 395] in
+ let r456 = [R 502] in
+ let r457 = S (T T_RPAREN) :: r456 in
+ let r458 = [R 621] in
+ let r459 = S (N N_fun_expr) :: r458 in
+ let r460 = [R 709] in
+ let r461 = S (T T_RBRACKET) :: r460 in
+ let r462 = [R 694] in
+ let r463 = [R 627] in
+ let r464 = R 489 :: r463 in
+ let r465 = [R 490] in
+ let r466 = [R 633] in
+ let r467 = R 489 :: r466 in
+ let r468 = R 498 :: r467 in
+ let r469 = Sub (r261) :: r468 in
+ let r470 = [R 568] in
+ let r471 = Sub (r469) :: r470 in
+ let r472 = [R 703] in
+ let r473 = S (T T_RBRACE) :: r472 in
+ let r474 = [R 682] in
+ let r475 = S (T T_END) :: r474 in
+ let r476 = R 316 :: r475 in
+ let r477 = [R 153] in
+ let r478 = Sub (r180) :: r477 in
let r479 = R 316 :: r478 in
- let r480 = [R 636] in
- let r481 = Sub (r174) :: r480 in
- let r482 = R 316 :: r481 in
- let r483 = [R 594] in
- let r484 = [R 347] in
- let r485 = Sub (r3) :: r484 in
- let r486 = S (T T_MINUSGREATER) :: r485 in
- let r487 = [R 284] in
- let r488 = Sub (r331) :: r487 in
- let r489 = [R 230] in
- let r490 = Sub (r488) :: r489 in
- let r491 = [R 583] in
- let r492 = Sub (r490) :: r491 in
- let r493 = [R 231] in
- let r494 = Sub (r492) :: r493 in
- let r495 = [R 135] in
- let r496 = Sub (r1) :: r495 in
- let r497 = [R 141] in
- let r498 = Sub (r496) :: r497 in
- let r499 = S (T T_MINUSGREATER) :: r498 in
- let r500 = R 485 :: r499 in
- let r501 = Sub (r494) :: r500 in
- let r502 = R 316 :: r501 in
- let r503 = [R 546] in
- let r504 = S (T T_UNDERSCORE) :: r503 in
- let r505 = [R 280] in
- let r506 = [R 279] in
- let r507 = S (T T_RPAREN) :: r506 in
- let r508 = R 496 :: r507 in
- let r509 = [R 299] in
- let r510 = [R 229] in
- let r511 = S (T T_RPAREN) :: r510 in
- let r512 = [R 283] in
- let r513 = [R 486] in
- let r514 = [R 134] in
- let r515 = Sub (r174) :: r514 in
- let r516 = R 316 :: r515 in
- let r517 = [R 614] in
- let r518 = [R 615] in
- let r519 = Sub (r174) :: r518 in
- let r520 = R 316 :: r519 in
- let r521 = [R 595] in
- let r522 = [R 123] in
- let r523 = S (T T_DOWNTO) :: r522 in
- let r524 = [R 151] in
- let r525 = S (T T_DONE) :: r524 in
- let r526 = Sub (r3) :: r525 in
- let r527 = S (T T_DO) :: r526 in
- let r528 = Sub (r3) :: r527 in
- let r529 = Sub (r523) :: r528 in
- let r530 = Sub (r3) :: r529 in
- let r531 = S (T T_EQUAL) :: r530 in
- let r532 = S (N N_pattern) :: r531 in
- let r533 = R 316 :: r532 in
- let r534 = [R 692] in
- let r535 = [R 702] in
- let r536 = S (T T_RPAREN) :: r535 in
- let r537 = S (T T_LPAREN) :: r536 in
- let r538 = S (T T_DOT) :: r537 in
- let r539 = [R 712] in
- let r540 = S (T T_RPAREN) :: r539 in
- let r541 = S (N N_module_type) :: r540 in
- let r542 = S (T T_COLON) :: r541 in
- let r543 = S (N N_module_expr) :: r542 in
- let r544 = R 316 :: r543 in
- let r545 = [R 302] in
- let r546 = Sub (r3) :: r545 in
- let r547 = S (T T_EQUAL) :: r546 in
- let r548 = [R 152] in
- let r549 = Sub (r180) :: r548 in
- let r550 = R 316 :: r549 in
- let r551 = [R 699] in
- let r552 = [R 675] in
- let r553 = S (T T_RPAREN) :: r552 in
- let r554 = Sub (r451) :: r553 in
- let r555 = S (T T_LPAREN) :: r554 in
- let r556 = [R 622] in
- let r557 = Sub (r174) :: r556 in
- let r558 = R 316 :: r557 in
- let r559 = [R 198] in
- let r560 = [R 199] in
- let r561 = Sub (r174) :: r560 in
- let r562 = R 316 :: r561 in
- let r563 = [R 273] in
- let r564 = [R 821] in
- let r565 = Sub (r34) :: r564 in
- let r566 = S (T T_COLON) :: r565 in
- let r567 = [R 274] in
- let r568 = S (T T_RPAREN) :: r567 in
- let r569 = Sub (r566) :: r568 in
- let r570 = [R 823] in
- let r571 = [R 822] in
- let r572 = [R 275] in
- let r573 = [R 276] in
- let r574 = [R 698] in
- let r575 = [R 672] in
- let r576 = S (T T_RPAREN) :: r575 in
- let r577 = Sub (r3) :: r576 in
- let r578 = S (T T_LPAREN) :: r577 in
- let r579 = [R 610] in
- let r580 = [R 611] in
- let r581 = Sub (r174) :: r580 in
- let r582 = R 316 :: r581 in
- let r583 = [R 202] in
- let r584 = Sub (r3) :: r583 in
- let r585 = [R 178] in
- let r586 = [R 179] in
- let r587 = Sub (r174) :: r586 in
- let r588 = R 316 :: r587 in
- let r589 = [R 166] in
- let r590 = [R 167] in
- let r591 = Sub (r174) :: r590 in
- let r592 = R 316 :: r591 in
- let r593 = [R 200] in
- let r594 = [R 201] in
- let r595 = Sub (r174) :: r594 in
- let r596 = R 316 :: r595 in
- let r597 = [R 235] in
- let r598 = Sub (r3) :: r597 in
- let r599 = [R 172] in
- let r600 = [R 173] in
- let r601 = Sub (r174) :: r600 in
- let r602 = R 316 :: r601 in
- let r603 = [R 180] in
- let r604 = [R 181] in
- let r605 = Sub (r174) :: r604 in
- let r606 = R 316 :: r605 in
- let r607 = [R 164] in
- let r608 = [R 165] in
- let r609 = Sub (r174) :: r608 in
- let r610 = R 316 :: r609 in
- let r611 = [R 170] in
- let r612 = [R 171] in
- let r613 = Sub (r174) :: r612 in
- let r614 = R 316 :: r613 in
- let r615 = [R 168] in
- let r616 = [R 169] in
- let r617 = Sub (r174) :: r616 in
- let r618 = R 316 :: r617 in
- let r619 = [R 188] in
- let r620 = [R 189] in
- let r621 = Sub (r174) :: r620 in
- let r622 = R 316 :: r621 in
- let r623 = [R 176] in
- let r624 = [R 177] in
- let r625 = Sub (r174) :: r624 in
- let r626 = R 316 :: r625 in
- let r627 = [R 174] in
- let r628 = [R 175] in
- let r629 = Sub (r174) :: r628 in
- let r630 = R 316 :: r629 in
- let r631 = [R 184] in
- let r632 = [R 185] in
- let r633 = Sub (r174) :: r632 in
- let r634 = R 316 :: r633 in
- let r635 = [R 162] in
- let r636 = [R 163] in
- let r637 = Sub (r174) :: r636 in
- let r638 = R 316 :: r637 in
- let r639 = [R 160] in
- let r640 = [R 161] in
- let r641 = Sub (r174) :: r640 in
- let r642 = R 316 :: r641 in
- let r643 = [R 204] in
- let r644 = [R 205] in
- let r645 = Sub (r174) :: r644 in
- let r646 = R 316 :: r645 in
- let r647 = [R 158] in
- let r648 = [R 159] in
- let r649 = Sub (r174) :: r648 in
- let r650 = R 316 :: r649 in
- let r651 = [R 186] in
- let r652 = [R 187] in
- let r653 = Sub (r174) :: r652 in
- let r654 = R 316 :: r653 in
- let r655 = [R 182] in
- let r656 = [R 183] in
- let r657 = Sub (r174) :: r656 in
- let r658 = R 316 :: r657 in
- let r659 = [R 190] in
- let r660 = [R 191] in
- let r661 = Sub (r174) :: r660 in
- let r662 = R 316 :: r661 in
- let r663 = [R 192] in
- let r664 = [R 193] in
- let r665 = Sub (r174) :: r664 in
- let r666 = R 316 :: r665 in
- let r667 = [R 194] in
- let r668 = [R 195] in
- let r669 = Sub (r174) :: r668 in
- let r670 = R 316 :: r669 in
- let r671 = [R 612] in
- let r672 = [R 613] in
- let r673 = Sub (r174) :: r672 in
- let r674 = R 316 :: r673 in
- let r675 = [R 196] in
- let r676 = [R 197] in
- let r677 = Sub (r174) :: r676 in
- let r678 = R 316 :: r677 in
- let r679 = [R 19] in
- let r680 = R 322 :: r679 in
- let r681 = Sub (r388) :: r680 in
- let r682 = [R 784] in
- let r683 = Sub (r3) :: r682 in
- let r684 = [R 290] in
- let r685 = Sub (r3) :: r684 in
- let r686 = S (T T_EQUAL) :: r685 in
- let r687 = Sub (r34) :: r686 in
- let r688 = S (T T_DOT) :: r687 in
- let r689 = [R 289] in
+ let r480 = [R 692] in
+ let r481 = [R 702] in
+ let r482 = S (T T_RPAREN) :: r481 in
+ let r483 = S (T T_LPAREN) :: r482 in
+ let r484 = S (T T_DOT) :: r483 in
+ let r485 = [R 712] in
+ let r486 = S (T T_RPAREN) :: r485 in
+ let r487 = S (N N_module_type) :: r486 in
+ let r488 = S (T T_COLON) :: r487 in
+ let r489 = S (N N_module_expr) :: r488 in
+ let r490 = R 316 :: r489 in
+ let r491 = [R 302] in
+ let r492 = Sub (r3) :: r491 in
+ let r493 = S (T T_EQUAL) :: r492 in
+ let r494 = [R 148] in
+ let r495 = S (N N_fun_expr) :: r494 in
+ let r496 = S (T T_THEN) :: r495 in
+ let r497 = Sub (r3) :: r496 in
+ let r498 = R 316 :: r497 in
+ let r499 = [R 637] in
+ let r500 = Sub (r174) :: r499 in
+ let r501 = R 316 :: r500 in
+ let r502 = [R 595] in
+ let r503 = [R 347] in
+ let r504 = Sub (r3) :: r503 in
+ let r505 = S (T T_MINUSGREATER) :: r504 in
+ let r506 = [R 284] in
+ let r507 = Sub (r334) :: r506 in
+ let r508 = [R 230] in
+ let r509 = Sub (r507) :: r508 in
+ let r510 = [R 584] in
+ let r511 = Sub (r509) :: r510 in
+ let r512 = [R 231] in
+ let r513 = Sub (r511) :: r512 in
+ let r514 = [R 135] in
+ let r515 = Sub (r1) :: r514 in
+ let r516 = [R 141] in
+ let r517 = Sub (r515) :: r516 in
+ let r518 = S (T T_MINUSGREATER) :: r517 in
+ let r519 = R 485 :: r518 in
+ let r520 = Sub (r513) :: r519 in
+ let r521 = R 316 :: r520 in
+ let r522 = [R 547] in
+ let r523 = S (T T_UNDERSCORE) :: r522 in
+ let r524 = [R 280] in
+ let r525 = [R 279] in
+ let r526 = S (T T_RPAREN) :: r525 in
+ let r527 = R 496 :: r526 in
+ let r528 = [R 299] in
+ let r529 = [R 229] in
+ let r530 = S (T T_RPAREN) :: r529 in
+ let r531 = [R 283] in
+ let r532 = [R 486] in
+ let r533 = [R 134] in
+ let r534 = Sub (r174) :: r533 in
+ let r535 = R 316 :: r534 in
+ let r536 = [R 615] in
+ let r537 = [R 616] in
+ let r538 = Sub (r174) :: r537 in
+ let r539 = R 316 :: r538 in
+ let r540 = [R 596] in
+ let r541 = [R 123] in
+ let r542 = S (T T_DOWNTO) :: r541 in
+ let r543 = [R 151] in
+ let r544 = S (T T_DONE) :: r543 in
+ let r545 = Sub (r3) :: r544 in
+ let r546 = S (T T_DO) :: r545 in
+ let r547 = Sub (r3) :: r546 in
+ let r548 = Sub (r542) :: r547 in
+ let r549 = Sub (r3) :: r548 in
+ let r550 = S (T T_EQUAL) :: r549 in
+ let r551 = S (N N_pattern) :: r550 in
+ let r552 = R 316 :: r551 in
+ let r553 = [R 152] in
+ let r554 = Sub (r180) :: r553 in
+ let r555 = R 316 :: r554 in
+ let r556 = [R 699] in
+ let r557 = [R 673] in
+ let r558 = S (T T_RPAREN) :: r557 in
+ let r559 = Sub (r459) :: r558 in
+ let r560 = S (T T_LPAREN) :: r559 in
+ let r561 = [R 623] in
+ let r562 = Sub (r174) :: r561 in
+ let r563 = R 316 :: r562 in
+ let r564 = [R 198] in
+ let r565 = [R 199] in
+ let r566 = Sub (r174) :: r565 in
+ let r567 = R 316 :: r566 in
+ let r568 = [R 273] in
+ let r569 = [R 821] in
+ let r570 = Sub (r34) :: r569 in
+ let r571 = S (T T_COLON) :: r570 in
+ let r572 = [R 274] in
+ let r573 = S (T T_RPAREN) :: r572 in
+ let r574 = Sub (r571) :: r573 in
+ let r575 = [R 823] in
+ let r576 = [R 822] in
+ let r577 = [R 275] in
+ let r578 = [R 276] in
+ let r579 = [R 698] in
+ let r580 = [R 670] in
+ let r581 = S (T T_RPAREN) :: r580 in
+ let r582 = Sub (r3) :: r581 in
+ let r583 = S (T T_LPAREN) :: r582 in
+ let r584 = [R 611] in
+ let r585 = [R 612] in
+ let r586 = Sub (r174) :: r585 in
+ let r587 = R 316 :: r586 in
+ let r588 = [R 202] in
+ let r589 = Sub (r3) :: r588 in
+ let r590 = [R 178] in
+ let r591 = [R 179] in
+ let r592 = Sub (r174) :: r591 in
+ let r593 = R 316 :: r592 in
+ let r594 = [R 166] in
+ let r595 = [R 167] in
+ let r596 = Sub (r174) :: r595 in
+ let r597 = R 316 :: r596 in
+ let r598 = [R 200] in
+ let r599 = [R 201] in
+ let r600 = Sub (r174) :: r599 in
+ let r601 = R 316 :: r600 in
+ let r602 = [R 235] in
+ let r603 = Sub (r3) :: r602 in
+ let r604 = [R 172] in
+ let r605 = [R 173] in
+ let r606 = Sub (r174) :: r605 in
+ let r607 = R 316 :: r606 in
+ let r608 = [R 180] in
+ let r609 = [R 181] in
+ let r610 = Sub (r174) :: r609 in
+ let r611 = R 316 :: r610 in
+ let r612 = [R 164] in
+ let r613 = [R 165] in
+ let r614 = Sub (r174) :: r613 in
+ let r615 = R 316 :: r614 in
+ let r616 = [R 170] in
+ let r617 = [R 171] in
+ let r618 = Sub (r174) :: r617 in
+ let r619 = R 316 :: r618 in
+ let r620 = [R 168] in
+ let r621 = [R 169] in
+ let r622 = Sub (r174) :: r621 in
+ let r623 = R 316 :: r622 in
+ let r624 = [R 188] in
+ let r625 = [R 189] in
+ let r626 = Sub (r174) :: r625 in
+ let r627 = R 316 :: r626 in
+ let r628 = [R 176] in
+ let r629 = [R 177] in
+ let r630 = Sub (r174) :: r629 in
+ let r631 = R 316 :: r630 in
+ let r632 = [R 174] in
+ let r633 = [R 175] in
+ let r634 = Sub (r174) :: r633 in
+ let r635 = R 316 :: r634 in
+ let r636 = [R 184] in
+ let r637 = [R 185] in
+ let r638 = Sub (r174) :: r637 in
+ let r639 = R 316 :: r638 in
+ let r640 = [R 162] in
+ let r641 = [R 163] in
+ let r642 = Sub (r174) :: r641 in
+ let r643 = R 316 :: r642 in
+ let r644 = [R 160] in
+ let r645 = [R 161] in
+ let r646 = Sub (r174) :: r645 in
+ let r647 = R 316 :: r646 in
+ let r648 = [R 204] in
+ let r649 = [R 205] in
+ let r650 = Sub (r174) :: r649 in
+ let r651 = R 316 :: r650 in
+ let r652 = [R 158] in
+ let r653 = [R 159] in
+ let r654 = Sub (r174) :: r653 in
+ let r655 = R 316 :: r654 in
+ let r656 = [R 186] in
+ let r657 = [R 187] in
+ let r658 = Sub (r174) :: r657 in
+ let r659 = R 316 :: r658 in
+ let r660 = [R 182] in
+ let r661 = [R 183] in
+ let r662 = Sub (r174) :: r661 in
+ let r663 = R 316 :: r662 in
+ let r664 = [R 190] in
+ let r665 = [R 191] in
+ let r666 = Sub (r174) :: r665 in
+ let r667 = R 316 :: r666 in
+ let r668 = [R 192] in
+ let r669 = [R 193] in
+ let r670 = Sub (r174) :: r669 in
+ let r671 = R 316 :: r670 in
+ let r672 = [R 194] in
+ let r673 = [R 195] in
+ let r674 = Sub (r174) :: r673 in
+ let r675 = R 316 :: r674 in
+ let r676 = [R 613] in
+ let r677 = [R 614] in
+ let r678 = Sub (r174) :: r677 in
+ let r679 = R 316 :: r678 in
+ let r680 = [R 196] in
+ let r681 = [R 197] in
+ let r682 = Sub (r174) :: r681 in
+ let r683 = R 316 :: r682 in
+ let r684 = [R 19] in
+ let r685 = R 322 :: r684 in
+ let r686 = Sub (r396) :: r685 in
+ let r687 = [R 784] in
+ let r688 = Sub (r3) :: r687 in
+ let r689 = [R 290] in
let r690 = Sub (r3) :: r689 in
let r691 = S (T T_EQUAL) :: r690 in
let r692 = Sub (r34) :: r691 in
- let r693 = [R 592] in
- let r694 = [R 288] in
+ let r693 = S (T T_DOT) :: r692 in
+ let r694 = [R 289] in
let r695 = Sub (r3) :: r694 in
- let r696 = [R 785] in
- let r697 = Sub (r496) :: r696 in
- let r698 = S (T T_EQUAL) :: r697 in
- let r699 = [R 292] in
+ let r696 = S (T T_EQUAL) :: r695 in
+ let r697 = Sub (r34) :: r696 in
+ let r698 = [R 593] in
+ let r699 = [R 288] in
let r700 = Sub (r3) :: r699 in
- let r701 = S (T T_EQUAL) :: r700 in
- let r702 = [R 291] in
- let r703 = Sub (r3) :: r702 in
- let r704 = [R 533] in
- let r705 = [R 539] in
- let r706 = [R 544] in
- let r707 = [R 542] in
- let r708 = [R 532] in
- let r709 = [R 323] in
- let r710 = [R 674] in
- let r711 = S (T T_RBRACKET) :: r710 in
- let r712 = Sub (r3) :: r711 in
- let r713 = [R 673] in
- let r714 = S (T T_RBRACE) :: r713 in
- let r715 = Sub (r3) :: r714 in
- let r716 = [R 676] in
- let r717 = S (T T_RPAREN) :: r716 in
- let r718 = Sub (r451) :: r717 in
- let r719 = S (T T_LPAREN) :: r718 in
- let r720 = [R 680] in
- let r721 = S (T T_RBRACKET) :: r720 in
- let r722 = Sub (r451) :: r721 in
- let r723 = [R 678] in
- let r724 = S (T T_RBRACE) :: r723 in
- let r725 = Sub (r451) :: r724 in
- let r726 = [R 272] in
- let r727 = [R 216] in
- let r728 = [R 217] in
- let r729 = Sub (r174) :: r728 in
- let r730 = R 316 :: r729 in
- let r731 = [R 679] in
- let r732 = S (T T_RBRACKET) :: r731 in
- let r733 = Sub (r451) :: r732 in
- let r734 = [R 224] in
- let r735 = [R 225] in
- let r736 = Sub (r174) :: r735 in
- let r737 = R 316 :: r736 in
- let r738 = [R 677] in
- let r739 = S (T T_RBRACE) :: r738 in
- let r740 = Sub (r451) :: r739 in
- let r741 = [R 220] in
- let r742 = [R 221] in
- let r743 = Sub (r174) :: r742 in
- let r744 = R 316 :: r743 in
- let r745 = [R 210] in
- let r746 = [R 211] in
- let r747 = Sub (r174) :: r746 in
- let r748 = R 316 :: r747 in
- let r749 = [R 214] in
- let r750 = [R 215] in
- let r751 = Sub (r174) :: r750 in
- let r752 = R 316 :: r751 in
- let r753 = [R 212] in
- let r754 = [R 213] in
- let r755 = Sub (r174) :: r754 in
- let r756 = R 316 :: r755 in
- let r757 = [R 218] in
- let r758 = [R 219] in
- let r759 = Sub (r174) :: r758 in
- let r760 = R 316 :: r759 in
- let r761 = [R 226] in
- let r762 = [R 227] in
- let r763 = Sub (r174) :: r762 in
- let r764 = R 316 :: r763 in
- let r765 = [R 222] in
- let r766 = [R 223] in
- let r767 = Sub (r174) :: r766 in
- let r768 = R 316 :: r767 in
- let r769 = [R 208] in
- let r770 = [R 209] in
- let r771 = Sub (r174) :: r770 in
- let r772 = R 316 :: r771 in
- let r773 = [R 303] in
- let r774 = Sub (r3) :: r773 in
- let r775 = [R 305] in
- let r776 = [R 696] in
- let r777 = [R 708] in
- let r778 = [R 707] in
- let r779 = [R 711] in
- let r780 = [R 710] in
- let r781 = S (T T_LIDENT) :: r456 in
- let r782 = [R 697] in
- let r783 = S (T T_GREATERRBRACE) :: r782 in
- let r784 = [R 704] in
- let r785 = S (T T_RBRACE) :: r784 in
- let r786 = [R 568] in
- let r787 = Sub (r461) :: r786 in
- let r788 = [R 149] in
- let r789 = Sub (r174) :: r788 in
- let r790 = R 316 :: r789 in
- let r791 = [R 146] in
- let r792 = [R 147] in
- let r793 = Sub (r174) :: r792 in
- let r794 = R 316 :: r793 in
- let r795 = [R 144] in
- let r796 = [R 145] in
- let r797 = Sub (r174) :: r796 in
- let r798 = R 316 :: r797 in
- let r799 = [R 681] in
- let r800 = [R 668] in
- let r801 = S (T T_GREATERDOT) :: r800 in
- let r802 = Sub (r174) :: r801 in
- let r803 = R 316 :: r802 in
- let r804 = [R 491] in
- let r805 = Sub (r174) :: r804 in
- let r806 = R 316 :: r805 in
- let r807 = [R 693] in
- let r808 = [R 384] in
- let r809 = S (N N_module_expr) :: r808 in
- let r810 = S (T T_EQUAL) :: r809 in
- let r811 = [R 137] in
- let r812 = Sub (r3) :: r811 in
- let r813 = S (T T_IN) :: r812 in
- let r814 = Sub (r810) :: r813 in
- let r815 = Sub (r195) :: r814 in
- let r816 = R 316 :: r815 in
- let r817 = [R 385] in
- let r818 = S (N N_module_expr) :: r817 in
- let r819 = S (T T_EQUAL) :: r818 in
- let r820 = [R 386] in
- let r821 = [R 138] in
- let r822 = Sub (r3) :: r821 in
- let r823 = S (T T_IN) :: r822 in
- let r824 = R 316 :: r823 in
- let r825 = R 243 :: r824 in
- let r826 = Sub (r90) :: r825 in
- let r827 = R 316 :: r826 in
- let r828 = [R 103] in
- let r829 = Sub (r26) :: r828 in
- let r830 = [R 244] in
- let r831 = [R 263] in
- let r832 = R 316 :: r831 in
- let r833 = Sub (r141) :: r832 in
- let r834 = S (T T_COLON) :: r833 in
- let r835 = S (T T_LIDENT) :: r834 in
- let r836 = R 414 :: r835 in
- let r837 = [R 265] in
- let r838 = Sub (r836) :: r837 in
- let r839 = [R 105] in
- let r840 = S (T T_RBRACE) :: r839 in
- let r841 = [R 264] in
- let r842 = R 316 :: r841 in
- let r843 = S (T T_SEMI) :: r842 in
- let r844 = R 316 :: r843 in
- let r845 = Sub (r141) :: r844 in
- let r846 = S (T T_COLON) :: r845 in
- let r847 = [R 555] in
- let r848 = Sub (r32) :: r847 in
- let r849 = [R 104] in
- let r850 = Sub (r26) :: r849 in
- let r851 = [R 247] in
- let r852 = [R 248] in
- let r853 = Sub (r26) :: r852 in
- let r854 = [R 246] in
- let r855 = Sub (r26) :: r854 in
- let r856 = [R 245] in
- let r857 = Sub (r26) :: r856 in
- let r858 = [R 207] in
- let r859 = Sub (r174) :: r858 in
- let r860 = R 316 :: r859 in
- let r861 = [R 705] in
- let r862 = [R 684] in
- let r863 = S (T T_RPAREN) :: r862 in
- let r864 = S (N N_module_expr) :: r863 in
- let r865 = R 316 :: r864 in
- let r866 = [R 685] in
- let r867 = S (T T_RPAREN) :: r866 in
- let r868 = [R 671] in
- let r869 = [R 505] in
- let r870 = S (T T_RPAREN) :: r869 in
- let r871 = Sub (r174) :: r870 in
- let r872 = R 316 :: r871 in
- let r873 = [R 511] in
- let r874 = S (T T_RPAREN) :: r873 in
- let r875 = [R 507] in
- let r876 = S (T T_RPAREN) :: r875 in
- let r877 = [R 509] in
- let r878 = S (T T_RPAREN) :: r877 in
- let r879 = [R 510] in
- let r880 = S (T T_RPAREN) :: r879 in
- let r881 = [R 506] in
- let r882 = S (T T_RPAREN) :: r881 in
- let r883 = [R 508] in
- let r884 = S (T T_RPAREN) :: r883 in
- let r885 = [R 797] in
- let r886 = R 322 :: r885 in
- let r887 = Sub (r810) :: r886 in
- let r888 = Sub (r195) :: r887 in
- let r889 = R 316 :: r888 in
- let r890 = [R 411] in
- let r891 = R 322 :: r890 in
- let r892 = R 492 :: r891 in
- let r893 = Sub (r59) :: r892 in
- let r894 = R 316 :: r893 in
- let r895 = R 124 :: r894 in
- let r896 = [R 493] in
- let r897 = [R 798] in
- let r898 = R 312 :: r897 in
- let r899 = R 322 :: r898 in
- let r900 = Sub (r810) :: r899 in
- let r901 = [R 313] in
- let r902 = R 312 :: r901 in
- let r903 = R 322 :: r902 in
- let r904 = Sub (r810) :: r903 in
- let r905 = Sub (r195) :: r904 in
- let r906 = [R 261] in
- let r907 = S (T T_RBRACKET) :: r906 in
- let r908 = Sub (r17) :: r907 in
- let r909 = [R 550] in
+ let r701 = [R 785] in
+ let r702 = Sub (r515) :: r701 in
+ let r703 = S (T T_EQUAL) :: r702 in
+ let r704 = [R 292] in
+ let r705 = Sub (r3) :: r704 in
+ let r706 = S (T T_EQUAL) :: r705 in
+ let r707 = [R 291] in
+ let r708 = Sub (r3) :: r707 in
+ let r709 = [R 534] in
+ let r710 = [R 540] in
+ let r711 = [R 545] in
+ let r712 = [R 543] in
+ let r713 = [R 533] in
+ let r714 = [R 323] in
+ let r715 = [R 672] in
+ let r716 = S (T T_RBRACKET) :: r715 in
+ let r717 = Sub (r3) :: r716 in
+ let r718 = [R 671] in
+ let r719 = S (T T_RBRACE) :: r718 in
+ let r720 = Sub (r3) :: r719 in
+ let r721 = [R 674] in
+ let r722 = S (T T_RPAREN) :: r721 in
+ let r723 = Sub (r459) :: r722 in
+ let r724 = S (T T_LPAREN) :: r723 in
+ let r725 = [R 678] in
+ let r726 = S (T T_RBRACKET) :: r725 in
+ let r727 = Sub (r459) :: r726 in
+ let r728 = [R 676] in
+ let r729 = S (T T_RBRACE) :: r728 in
+ let r730 = Sub (r459) :: r729 in
+ let r731 = [R 272] in
+ let r732 = [R 216] in
+ let r733 = [R 217] in
+ let r734 = Sub (r174) :: r733 in
+ let r735 = R 316 :: r734 in
+ let r736 = [R 677] in
+ let r737 = S (T T_RBRACKET) :: r736 in
+ let r738 = Sub (r459) :: r737 in
+ let r739 = [R 224] in
+ let r740 = [R 225] in
+ let r741 = Sub (r174) :: r740 in
+ let r742 = R 316 :: r741 in
+ let r743 = [R 675] in
+ let r744 = S (T T_RBRACE) :: r743 in
+ let r745 = Sub (r459) :: r744 in
+ let r746 = [R 220] in
+ let r747 = [R 221] in
+ let r748 = Sub (r174) :: r747 in
+ let r749 = R 316 :: r748 in
+ let r750 = [R 210] in
+ let r751 = [R 211] in
+ let r752 = Sub (r174) :: r751 in
+ let r753 = R 316 :: r752 in
+ let r754 = [R 214] in
+ let r755 = [R 215] in
+ let r756 = Sub (r174) :: r755 in
+ let r757 = R 316 :: r756 in
+ let r758 = [R 212] in
+ let r759 = [R 213] in
+ let r760 = Sub (r174) :: r759 in
+ let r761 = R 316 :: r760 in
+ let r762 = [R 218] in
+ let r763 = [R 219] in
+ let r764 = Sub (r174) :: r763 in
+ let r765 = R 316 :: r764 in
+ let r766 = [R 226] in
+ let r767 = [R 227] in
+ let r768 = Sub (r174) :: r767 in
+ let r769 = R 316 :: r768 in
+ let r770 = [R 222] in
+ let r771 = [R 223] in
+ let r772 = Sub (r174) :: r771 in
+ let r773 = R 316 :: r772 in
+ let r774 = [R 208] in
+ let r775 = [R 209] in
+ let r776 = Sub (r174) :: r775 in
+ let r777 = R 316 :: r776 in
+ let r778 = [R 149] in
+ let r779 = Sub (r174) :: r778 in
+ let r780 = R 316 :: r779 in
+ let r781 = [R 146] in
+ let r782 = [R 147] in
+ let r783 = Sub (r174) :: r782 in
+ let r784 = R 316 :: r783 in
+ let r785 = [R 144] in
+ let r786 = [R 145] in
+ let r787 = Sub (r174) :: r786 in
+ let r788 = R 316 :: r787 in
+ let r789 = [R 303] in
+ let r790 = Sub (r3) :: r789 in
+ let r791 = [R 305] in
+ let r792 = [R 696] in
+ let r793 = [R 708] in
+ let r794 = [R 707] in
+ let r795 = [R 711] in
+ let r796 = [R 710] in
+ let r797 = S (T T_LIDENT) :: r464 in
+ let r798 = [R 697] in
+ let r799 = S (T T_GREATERRBRACE) :: r798 in
+ let r800 = [R 704] in
+ let r801 = S (T T_RBRACE) :: r800 in
+ let r802 = [R 569] in
+ let r803 = Sub (r469) :: r802 in
+ let r804 = [R 681] in
+ let r805 = [R 491] in
+ let r806 = Sub (r174) :: r805 in
+ let r807 = R 316 :: r806 in
+ let r808 = [R 693] in
+ let r809 = [R 384] in
+ let r810 = S (N N_module_expr) :: r809 in
+ let r811 = S (T T_EQUAL) :: r810 in
+ let r812 = [R 137] in
+ let r813 = Sub (r3) :: r812 in
+ let r814 = S (T T_IN) :: r813 in
+ let r815 = Sub (r811) :: r814 in
+ let r816 = Sub (r195) :: r815 in
+ let r817 = R 316 :: r816 in
+ let r818 = [R 385] in
+ let r819 = S (N N_module_expr) :: r818 in
+ let r820 = S (T T_EQUAL) :: r819 in
+ let r821 = [R 386] in
+ let r822 = [R 138] in
+ let r823 = Sub (r3) :: r822 in
+ let r824 = S (T T_IN) :: r823 in
+ let r825 = R 316 :: r824 in
+ let r826 = R 243 :: r825 in
+ let r827 = Sub (r90) :: r826 in
+ let r828 = R 316 :: r827 in
+ let r829 = [R 103] in
+ let r830 = Sub (r26) :: r829 in
+ let r831 = [R 244] in
+ let r832 = [R 263] in
+ let r833 = R 316 :: r832 in
+ let r834 = Sub (r141) :: r833 in
+ let r835 = S (T T_COLON) :: r834 in
+ let r836 = S (T T_LIDENT) :: r835 in
+ let r837 = R 414 :: r836 in
+ let r838 = [R 265] in
+ let r839 = Sub (r837) :: r838 in
+ let r840 = [R 105] in
+ let r841 = S (T T_RBRACE) :: r840 in
+ let r842 = [R 264] in
+ let r843 = R 316 :: r842 in
+ let r844 = S (T T_SEMI) :: r843 in
+ let r845 = R 316 :: r844 in
+ let r846 = Sub (r141) :: r845 in
+ let r847 = S (T T_COLON) :: r846 in
+ let r848 = [R 556] in
+ let r849 = Sub (r32) :: r848 in
+ let r850 = [R 104] in
+ let r851 = Sub (r26) :: r850 in
+ let r852 = [R 247] in
+ let r853 = [R 248] in
+ let r854 = Sub (r26) :: r853 in
+ let r855 = [R 246] in
+ let r856 = Sub (r26) :: r855 in
+ let r857 = [R 245] in
+ let r858 = Sub (r26) :: r857 in
+ let r859 = [R 207] in
+ let r860 = Sub (r174) :: r859 in
+ let r861 = R 316 :: r860 in
+ let r862 = [R 705] in
+ let r863 = [R 684] in
+ let r864 = S (T T_RPAREN) :: r863 in
+ let r865 = S (N N_module_expr) :: r864 in
+ let r866 = R 316 :: r865 in
+ let r867 = [R 685] in
+ let r868 = S (T T_RPAREN) :: r867 in
+ let r869 = [R 669] in
+ let r870 = [R 505] in
+ let r871 = S (T T_RPAREN) :: r870 in
+ let r872 = Sub (r174) :: r871 in
+ let r873 = R 316 :: r872 in
+ let r874 = [R 511] in
+ let r875 = S (T T_RPAREN) :: r874 in
+ let r876 = [R 507] in
+ let r877 = S (T T_RPAREN) :: r876 in
+ let r878 = [R 509] in
+ let r879 = S (T T_RPAREN) :: r878 in
+ let r880 = [R 510] in
+ let r881 = S (T T_RPAREN) :: r880 in
+ let r882 = [R 506] in
+ let r883 = S (T T_RPAREN) :: r882 in
+ let r884 = [R 508] in
+ let r885 = S (T T_RPAREN) :: r884 in
+ let r886 = [R 797] in
+ let r887 = R 322 :: r886 in
+ let r888 = Sub (r811) :: r887 in
+ let r889 = Sub (r195) :: r888 in
+ let r890 = R 316 :: r889 in
+ let r891 = [R 411] in
+ let r892 = R 322 :: r891 in
+ let r893 = R 492 :: r892 in
+ let r894 = Sub (r59) :: r893 in
+ let r895 = R 316 :: r894 in
+ let r896 = R 124 :: r895 in
+ let r897 = [R 493] in
+ let r898 = [R 798] in
+ let r899 = R 312 :: r898 in
+ let r900 = R 322 :: r899 in
+ let r901 = Sub (r811) :: r900 in
+ let r902 = [R 313] in
+ let r903 = R 312 :: r902 in
+ let r904 = R 322 :: r903 in
+ let r905 = Sub (r811) :: r904 in
+ let r906 = Sub (r195) :: r905 in
+ let r907 = [R 261] in
+ let r908 = S (T T_RBRACKET) :: r907 in
+ let r909 = Sub (r17) :: r908 in
let r910 = [R 551] in
- let r911 = [R 131] in
- let r912 = S (T T_RBRACKET) :: r911 in
- let r913 = Sub (r19) :: r912 in
- let r914 = [R 803] in
- let r915 = R 322 :: r914 in
- let r916 = S (N N_module_expr) :: r915 in
- let r917 = R 316 :: r916 in
- let r918 = [R 424] in
- let r919 = S (T T_STRING) :: r918 in
- let r920 = [R 557] in
- let r921 = R 322 :: r920 in
- let r922 = Sub (r919) :: r921 in
- let r923 = S (T T_EQUAL) :: r922 in
- let r924 = Sub (r36) :: r923 in
- let r925 = S (T T_COLON) :: r924 in
- let r926 = Sub (r24) :: r925 in
- let r927 = R 316 :: r926 in
- let r928 = [R 553] in
- let r929 = Sub (r34) :: r928 in
- let r930 = Sub (r88) :: r357 in
- let r931 = [R 783] in
- let r932 = R 322 :: r931 in
- let r933 = R 316 :: r932 in
- let r934 = Sub (r930) :: r933 in
- let r935 = S (T T_EQUAL) :: r934 in
- let r936 = Sub (r90) :: r935 in
- let r937 = R 316 :: r936 in
- let r938 = [R 637] in
- let r939 = R 322 :: r938 in
- let r940 = R 316 :: r939 in
- let r941 = R 243 :: r940 in
- let r942 = Sub (r90) :: r941 in
- let r943 = R 316 :: r942 in
- let r944 = R 124 :: r943 in
- let r945 = S (T T_COLONCOLON) :: r366 in
- let r946 = [R 548] in
- let r947 = [R 325] in
- let r948 = [R 444] in
- let r949 = R 322 :: r948 in
- let r950 = Sub (r293) :: r949 in
- let r951 = R 316 :: r950 in
- let r952 = [R 445] in
- let r953 = R 322 :: r952 in
- let r954 = Sub (r293) :: r953 in
- let r955 = R 316 :: r954 in
- let r956 = [R 387] in
- let r957 = S (N N_module_type) :: r956 in
- let r958 = S (T T_COLON) :: r957 in
- let r959 = [R 648] in
- let r960 = R 322 :: r959 in
- let r961 = Sub (r958) :: r960 in
- let r962 = Sub (r195) :: r961 in
- let r963 = R 316 :: r962 in
- let r964 = [R 412] in
- let r965 = R 322 :: r964 in
- let r966 = S (N N_module_type) :: r965 in
- let r967 = S (T T_COLONEQUAL) :: r966 in
- let r968 = Sub (r59) :: r967 in
- let r969 = R 316 :: r968 in
- let r970 = [R 400] in
- let r971 = R 322 :: r970 in
- let r972 = [R 651] in
- let r973 = R 314 :: r972 in
- let r974 = R 322 :: r973 in
- let r975 = S (N N_module_type) :: r974 in
- let r976 = S (T T_COLON) :: r975 in
- let r977 = [R 315] in
- let r978 = R 314 :: r977 in
- let r979 = R 322 :: r978 in
- let r980 = S (N N_module_type) :: r979 in
- let r981 = S (T T_COLON) :: r980 in
- let r982 = Sub (r195) :: r981 in
- let r983 = S (T T_UIDENT) :: r149 in
- let r984 = Sub (r983) :: r233 in
- let r985 = [R 649] in
- let r986 = R 322 :: r985 in
- let r987 = [R 388] in
- let r988 = [R 655] in
- let r989 = R 322 :: r988 in
- let r990 = S (N N_module_type) :: r989 in
- let r991 = R 316 :: r990 in
- let r992 = S (T T_QUOTED_STRING_EXPR) :: r57 in
- let r993 = [R 71] in
- let r994 = Sub (r992) :: r993 in
- let r995 = [R 81] in
- let r996 = Sub (r994) :: r995 in
- let r997 = [R 656] in
- let r998 = R 308 :: r997 in
- let r999 = R 322 :: r998 in
- let r1000 = Sub (r996) :: r999 in
- let r1001 = S (T T_COLON) :: r1000 in
- let r1002 = S (T T_LIDENT) :: r1001 in
- let r1003 = R 132 :: r1002 in
- let r1004 = R 855 :: r1003 in
- let r1005 = R 316 :: r1004 in
- let r1006 = [R 85] in
- let r1007 = R 310 :: r1006 in
- let r1008 = R 322 :: r1007 in
- let r1009 = Sub (r994) :: r1008 in
- let r1010 = S (T T_EQUAL) :: r1009 in
- let r1011 = S (T T_LIDENT) :: r1010 in
- let r1012 = R 132 :: r1011 in
- let r1013 = R 855 :: r1012 in
- let r1014 = R 316 :: r1013 in
- let r1015 = [R 133] in
- let r1016 = S (T T_RBRACKET) :: r1015 in
- let r1017 = [R 72] in
- let r1018 = S (T T_END) :: r1017 in
- let r1019 = R 331 :: r1018 in
- let r1020 = R 62 :: r1019 in
- let r1021 = [R 61] in
- let r1022 = S (T T_RPAREN) :: r1021 in
- let r1023 = [R 64] in
- let r1024 = R 322 :: r1023 in
- let r1025 = Sub (r34) :: r1024 in
- let r1026 = S (T T_COLON) :: r1025 in
- let r1027 = S (T T_LIDENT) :: r1026 in
- let r1028 = R 416 :: r1027 in
- let r1029 = [R 65] in
- let r1030 = R 322 :: r1029 in
- let r1031 = Sub (r36) :: r1030 in
- let r1032 = S (T T_COLON) :: r1031 in
- let r1033 = S (T T_LIDENT) :: r1032 in
- let r1034 = R 560 :: r1033 in
- let r1035 = [R 63] in
- let r1036 = R 322 :: r1035 in
- let r1037 = Sub (r994) :: r1036 in
- let r1038 = [R 74] in
- let r1039 = Sub (r994) :: r1038 in
- let r1040 = S (T T_IN) :: r1039 in
- let r1041 = Sub (r984) :: r1040 in
- let r1042 = R 316 :: r1041 in
- let r1043 = [R 75] in
- let r1044 = Sub (r994) :: r1043 in
- let r1045 = S (T T_IN) :: r1044 in
- let r1046 = Sub (r984) :: r1045 in
- let r1047 = [R 602] in
- let r1048 = Sub (r34) :: r1047 in
- let r1049 = [R 70] in
- let r1050 = Sub (r286) :: r1049 in
- let r1051 = S (T T_RBRACKET) :: r1050 in
- let r1052 = Sub (r1048) :: r1051 in
- let r1053 = [R 603] in
- let r1054 = [R 102] in
- let r1055 = Sub (r34) :: r1054 in
- let r1056 = S (T T_EQUAL) :: r1055 in
- let r1057 = Sub (r34) :: r1056 in
- let r1058 = [R 66] in
- let r1059 = R 322 :: r1058 in
- let r1060 = Sub (r1057) :: r1059 in
- let r1061 = [R 67] in
- let r1062 = [R 332] in
- let r1063 = [R 311] in
- let r1064 = R 310 :: r1063 in
- let r1065 = R 322 :: r1064 in
- let r1066 = Sub (r994) :: r1065 in
- let r1067 = S (T T_EQUAL) :: r1066 in
- let r1068 = S (T T_LIDENT) :: r1067 in
- let r1069 = R 132 :: r1068 in
- let r1070 = R 855 :: r1069 in
- let r1071 = [R 83] in
- let r1072 = Sub (r996) :: r1071 in
- let r1073 = S (T T_MINUSGREATER) :: r1072 in
- let r1074 = Sub (r28) :: r1073 in
- let r1075 = [R 84] in
- let r1076 = Sub (r996) :: r1075 in
- let r1077 = [R 82] in
- let r1078 = Sub (r996) :: r1077 in
- let r1079 = S (T T_MINUSGREATER) :: r1078 in
- let r1080 = [R 309] in
- let r1081 = R 308 :: r1080 in
- let r1082 = R 322 :: r1081 in
- let r1083 = Sub (r996) :: r1082 in
- let r1084 = S (T T_COLON) :: r1083 in
- let r1085 = S (T T_LIDENT) :: r1084 in
- let r1086 = R 132 :: r1085 in
- let r1087 = R 855 :: r1086 in
- let r1088 = [R 326] in
- let r1089 = [R 639] in
- let r1090 = [R 643] in
- let r1091 = [R 319] in
- let r1092 = R 318 :: r1091 in
- let r1093 = R 322 :: r1092 in
- let r1094 = R 581 :: r1093 in
- let r1095 = R 824 :: r1094 in
- let r1096 = S (T T_LIDENT) :: r1095 in
- let r1097 = R 828 :: r1096 in
- let r1098 = [R 644] in
- let r1099 = [R 321] in
- let r1100 = R 320 :: r1099 in
- let r1101 = R 322 :: r1100 in
- let r1102 = R 581 :: r1101 in
- let r1103 = Sub (r129) :: r1102 in
- let r1104 = S (T T_COLONEQUAL) :: r1103 in
- let r1105 = S (T T_LIDENT) :: r1104 in
- let r1106 = R 828 :: r1105 in
- let r1107 = [R 436] in
- let r1108 = S (T T_RBRACE) :: r1107 in
- let r1109 = [R 249] in
- let r1110 = R 316 :: r1109 in
- let r1111 = R 243 :: r1110 in
- let r1112 = Sub (r90) :: r1111 in
- let r1113 = [R 434] in
- let r1114 = [R 435] in
- let r1115 = [R 439] in
- let r1116 = S (T T_RBRACE) :: r1115 in
- let r1117 = [R 438] in
- let r1118 = S (T T_RBRACE) :: r1117 in
- let r1119 = [R 43] in
- let r1120 = Sub (r992) :: r1119 in
- let r1121 = [R 52] in
- let r1122 = Sub (r1120) :: r1121 in
- let r1123 = S (T T_EQUAL) :: r1122 in
- let r1124 = [R 801] in
- let r1125 = R 306 :: r1124 in
- let r1126 = R 322 :: r1125 in
- let r1127 = Sub (r1123) :: r1126 in
- let r1128 = S (T T_LIDENT) :: r1127 in
- let r1129 = R 132 :: r1128 in
- let r1130 = R 855 :: r1129 in
- let r1131 = R 316 :: r1130 in
- let r1132 = [R 80] in
- let r1133 = S (T T_END) :: r1132 in
- let r1134 = R 333 :: r1133 in
- let r1135 = R 60 :: r1134 in
- let r1136 = [R 850] in
- let r1137 = Sub (r3) :: r1136 in
- let r1138 = S (T T_EQUAL) :: r1137 in
- let r1139 = S (T T_LIDENT) :: r1138 in
- let r1140 = R 414 :: r1139 in
- let r1141 = R 316 :: r1140 in
- let r1142 = [R 46] in
- let r1143 = R 322 :: r1142 in
- let r1144 = [R 851] in
- let r1145 = Sub (r3) :: r1144 in
- let r1146 = S (T T_EQUAL) :: r1145 in
- let r1147 = S (T T_LIDENT) :: r1146 in
- let r1148 = R 414 :: r1147 in
- let r1149 = [R 853] in
- let r1150 = Sub (r3) :: r1149 in
- let r1151 = [R 849] in
- let r1152 = Sub (r34) :: r1151 in
- let r1153 = S (T T_COLON) :: r1152 in
- let r1154 = [R 852] in
- let r1155 = Sub (r3) :: r1154 in
- let r1156 = S (T T_EQUAL) :: r683 in
- let r1157 = [R 357] in
- let r1158 = Sub (r1156) :: r1157 in
- let r1159 = S (T T_LIDENT) :: r1158 in
- let r1160 = R 558 :: r1159 in
- let r1161 = R 316 :: r1160 in
- let r1162 = [R 47] in
- let r1163 = R 322 :: r1162 in
- let r1164 = [R 358] in
- let r1165 = Sub (r1156) :: r1164 in
- let r1166 = S (T T_LIDENT) :: r1165 in
- let r1167 = R 558 :: r1166 in
- let r1168 = [R 360] in
- let r1169 = Sub (r3) :: r1168 in
- let r1170 = S (T T_EQUAL) :: r1169 in
- let r1171 = [R 362] in
- let r1172 = Sub (r3) :: r1171 in
- let r1173 = S (T T_EQUAL) :: r1172 in
- let r1174 = Sub (r34) :: r1173 in
- let r1175 = S (T T_DOT) :: r1174 in
- let r1176 = [R 356] in
- let r1177 = Sub (r36) :: r1176 in
- let r1178 = S (T T_COLON) :: r1177 in
- let r1179 = [R 359] in
- let r1180 = Sub (r3) :: r1179 in
- let r1181 = S (T T_EQUAL) :: r1180 in
- let r1182 = [R 361] in
- let r1183 = Sub (r3) :: r1182 in
- let r1184 = S (T T_EQUAL) :: r1183 in
- let r1185 = Sub (r34) :: r1184 in
- let r1186 = S (T T_DOT) :: r1185 in
- let r1187 = [R 49] in
- let r1188 = R 322 :: r1187 in
- let r1189 = Sub (r3) :: r1188 in
- let r1190 = [R 44] in
- let r1191 = R 322 :: r1190 in
- let r1192 = R 483 :: r1191 in
- let r1193 = Sub (r1120) :: r1192 in
- let r1194 = [R 45] in
- let r1195 = R 322 :: r1194 in
- let r1196 = R 483 :: r1195 in
- let r1197 = Sub (r1120) :: r1196 in
- let r1198 = [R 76] in
- let r1199 = S (T T_RPAREN) :: r1198 in
- let r1200 = [R 39] in
- let r1201 = Sub (r1120) :: r1200 in
- let r1202 = S (T T_IN) :: r1201 in
- let r1203 = Sub (r984) :: r1202 in
- let r1204 = R 316 :: r1203 in
- let r1205 = [R 296] in
- let r1206 = R 322 :: r1205 in
- let r1207 = Sub (r388) :: r1206 in
- let r1208 = R 565 :: r1207 in
- let r1209 = R 316 :: r1208 in
- let r1210 = [R 40] in
- let r1211 = Sub (r1120) :: r1210 in
- let r1212 = S (T T_IN) :: r1211 in
- let r1213 = Sub (r984) :: r1212 in
- let r1214 = [R 78] in
- let r1215 = Sub (r226) :: r1214 in
- let r1216 = S (T T_RBRACKET) :: r1215 in
- let r1217 = [R 55] in
- let r1218 = Sub (r1120) :: r1217 in
- let r1219 = S (T T_MINUSGREATER) :: r1218 in
- let r1220 = Sub (r488) :: r1219 in
- let r1221 = [R 37] in
- let r1222 = Sub (r1220) :: r1221 in
- let r1223 = [R 38] in
- let r1224 = Sub (r1120) :: r1223 in
- let r1225 = [R 295] in
- let r1226 = R 322 :: r1225 in
- let r1227 = Sub (r388) :: r1226 in
- let r1228 = [R 79] in
- let r1229 = S (T T_RPAREN) :: r1228 in
- let r1230 = [R 484] in
- let r1231 = [R 48] in
- let r1232 = R 322 :: r1231 in
- let r1233 = Sub (r1057) :: r1232 in
- let r1234 = [R 50] in
- let r1235 = [R 334] in
- let r1236 = [R 53] in
- let r1237 = Sub (r1120) :: r1236 in
- let r1238 = S (T T_EQUAL) :: r1237 in
- let r1239 = [R 54] in
- let r1240 = [R 307] in
- let r1241 = R 306 :: r1240 in
- let r1242 = R 322 :: r1241 in
- let r1243 = Sub (r1123) :: r1242 in
- let r1244 = S (T T_LIDENT) :: r1243 in
- let r1245 = R 132 :: r1244 in
- let r1246 = R 855 :: r1245 in
- let r1247 = [R 330] in
- let r1248 = [R 789] in
- let r1249 = [R 793] in
- let r1250 = [R 787] in
- let r1251 = R 327 :: r1250 in
- let r1252 = [R 329] in
- let r1253 = R 327 :: r1252 in
- let r1254 = [R 59] in
- let r1255 = S (T T_RPAREN) :: r1254 in
- let r1256 = [R 128] in
- let r1257 = R 316 :: r1256 in
- let r1258 = [R 129] in
- let r1259 = R 316 :: r1258 in
- let r1260 = [R 351] in
- let r1261 = [R 440] in
- let r1262 = [R 25] in
- let r1263 = Sub (r86) :: r1262 in
- let r1264 = [R 28] in
- let r1265 = [R 608] in
+ let r911 = [R 552] in
+ let r912 = [R 131] in
+ let r913 = S (T T_RBRACKET) :: r912 in
+ let r914 = Sub (r19) :: r913 in
+ let r915 = [R 803] in
+ let r916 = R 322 :: r915 in
+ let r917 = S (N N_module_expr) :: r916 in
+ let r918 = R 316 :: r917 in
+ let r919 = [R 424] in
+ let r920 = S (T T_STRING) :: r919 in
+ let r921 = [R 558] in
+ let r922 = R 322 :: r921 in
+ let r923 = Sub (r920) :: r922 in
+ let r924 = S (T T_EQUAL) :: r923 in
+ let r925 = Sub (r36) :: r924 in
+ let r926 = S (T T_COLON) :: r925 in
+ let r927 = Sub (r24) :: r926 in
+ let r928 = R 316 :: r927 in
+ let r929 = [R 554] in
+ let r930 = Sub (r34) :: r929 in
+ let r931 = Sub (r88) :: r356 in
+ let r932 = [R 783] in
+ let r933 = R 322 :: r932 in
+ let r934 = R 316 :: r933 in
+ let r935 = Sub (r931) :: r934 in
+ let r936 = S (T T_EQUAL) :: r935 in
+ let r937 = Sub (r90) :: r936 in
+ let r938 = R 316 :: r937 in
+ let r939 = [R 638] in
+ let r940 = R 322 :: r939 in
+ let r941 = R 316 :: r940 in
+ let r942 = R 243 :: r941 in
+ let r943 = Sub (r90) :: r942 in
+ let r944 = R 316 :: r943 in
+ let r945 = R 124 :: r944 in
+ let r946 = S (T T_COLONCOLON) :: r374 in
+ let r947 = [R 549] in
+ let r948 = [R 325] in
+ let r949 = [R 444] in
+ let r950 = R 322 :: r949 in
+ let r951 = Sub (r296) :: r950 in
+ let r952 = R 316 :: r951 in
+ let r953 = [R 445] in
+ let r954 = R 322 :: r953 in
+ let r955 = Sub (r296) :: r954 in
+ let r956 = R 316 :: r955 in
+ let r957 = [R 387] in
+ let r958 = S (N N_module_type) :: r957 in
+ let r959 = S (T T_COLON) :: r958 in
+ let r960 = [R 649] in
+ let r961 = R 322 :: r960 in
+ let r962 = Sub (r959) :: r961 in
+ let r963 = Sub (r195) :: r962 in
+ let r964 = R 316 :: r963 in
+ let r965 = [R 412] in
+ let r966 = R 322 :: r965 in
+ let r967 = S (N N_module_type) :: r966 in
+ let r968 = S (T T_COLONEQUAL) :: r967 in
+ let r969 = Sub (r59) :: r968 in
+ let r970 = R 316 :: r969 in
+ let r971 = [R 400] in
+ let r972 = R 322 :: r971 in
+ let r973 = [R 652] in
+ let r974 = R 314 :: r973 in
+ let r975 = R 322 :: r974 in
+ let r976 = S (N N_module_type) :: r975 in
+ let r977 = S (T T_COLON) :: r976 in
+ let r978 = [R 315] in
+ let r979 = R 314 :: r978 in
+ let r980 = R 322 :: r979 in
+ let r981 = S (N N_module_type) :: r980 in
+ let r982 = S (T T_COLON) :: r981 in
+ let r983 = Sub (r195) :: r982 in
+ let r984 = S (T T_UIDENT) :: r149 in
+ let r985 = Sub (r984) :: r233 in
+ let r986 = [R 650] in
+ let r987 = R 322 :: r986 in
+ let r988 = [R 388] in
+ let r989 = [R 656] in
+ let r990 = R 322 :: r989 in
+ let r991 = S (N N_module_type) :: r990 in
+ let r992 = R 316 :: r991 in
+ let r993 = S (T T_QUOTED_STRING_EXPR) :: r57 in
+ let r994 = [R 71] in
+ let r995 = Sub (r993) :: r994 in
+ let r996 = [R 81] in
+ let r997 = Sub (r995) :: r996 in
+ let r998 = [R 657] in
+ let r999 = R 308 :: r998 in
+ let r1000 = R 322 :: r999 in
+ let r1001 = Sub (r997) :: r1000 in
+ let r1002 = S (T T_COLON) :: r1001 in
+ let r1003 = S (T T_LIDENT) :: r1002 in
+ let r1004 = R 132 :: r1003 in
+ let r1005 = R 855 :: r1004 in
+ let r1006 = R 316 :: r1005 in
+ let r1007 = [R 85] in
+ let r1008 = R 310 :: r1007 in
+ let r1009 = R 322 :: r1008 in
+ let r1010 = Sub (r995) :: r1009 in
+ let r1011 = S (T T_EQUAL) :: r1010 in
+ let r1012 = S (T T_LIDENT) :: r1011 in
+ let r1013 = R 132 :: r1012 in
+ let r1014 = R 855 :: r1013 in
+ let r1015 = R 316 :: r1014 in
+ let r1016 = [R 133] in
+ let r1017 = S (T T_RBRACKET) :: r1016 in
+ let r1018 = [R 72] in
+ let r1019 = S (T T_END) :: r1018 in
+ let r1020 = R 331 :: r1019 in
+ let r1021 = R 62 :: r1020 in
+ let r1022 = [R 61] in
+ let r1023 = S (T T_RPAREN) :: r1022 in
+ let r1024 = [R 64] in
+ let r1025 = R 322 :: r1024 in
+ let r1026 = Sub (r34) :: r1025 in
+ let r1027 = S (T T_COLON) :: r1026 in
+ let r1028 = S (T T_LIDENT) :: r1027 in
+ let r1029 = R 416 :: r1028 in
+ let r1030 = [R 65] in
+ let r1031 = R 322 :: r1030 in
+ let r1032 = Sub (r36) :: r1031 in
+ let r1033 = S (T T_COLON) :: r1032 in
+ let r1034 = S (T T_LIDENT) :: r1033 in
+ let r1035 = R 561 :: r1034 in
+ let r1036 = [R 63] in
+ let r1037 = R 322 :: r1036 in
+ let r1038 = Sub (r995) :: r1037 in
+ let r1039 = [R 74] in
+ let r1040 = Sub (r995) :: r1039 in
+ let r1041 = S (T T_IN) :: r1040 in
+ let r1042 = Sub (r985) :: r1041 in
+ let r1043 = R 316 :: r1042 in
+ let r1044 = [R 75] in
+ let r1045 = Sub (r995) :: r1044 in
+ let r1046 = S (T T_IN) :: r1045 in
+ let r1047 = Sub (r985) :: r1046 in
+ let r1048 = [R 603] in
+ let r1049 = Sub (r34) :: r1048 in
+ let r1050 = [R 70] in
+ let r1051 = Sub (r289) :: r1050 in
+ let r1052 = S (T T_RBRACKET) :: r1051 in
+ let r1053 = Sub (r1049) :: r1052 in
+ let r1054 = [R 604] in
+ let r1055 = [R 102] in
+ let r1056 = Sub (r34) :: r1055 in
+ let r1057 = S (T T_EQUAL) :: r1056 in
+ let r1058 = Sub (r34) :: r1057 in
+ let r1059 = [R 66] in
+ let r1060 = R 322 :: r1059 in
+ let r1061 = Sub (r1058) :: r1060 in
+ let r1062 = [R 67] in
+ let r1063 = [R 332] in
+ let r1064 = [R 311] in
+ let r1065 = R 310 :: r1064 in
+ let r1066 = R 322 :: r1065 in
+ let r1067 = Sub (r995) :: r1066 in
+ let r1068 = S (T T_EQUAL) :: r1067 in
+ let r1069 = S (T T_LIDENT) :: r1068 in
+ let r1070 = R 132 :: r1069 in
+ let r1071 = R 855 :: r1070 in
+ let r1072 = [R 83] in
+ let r1073 = Sub (r997) :: r1072 in
+ let r1074 = S (T T_MINUSGREATER) :: r1073 in
+ let r1075 = Sub (r28) :: r1074 in
+ let r1076 = [R 84] in
+ let r1077 = Sub (r997) :: r1076 in
+ let r1078 = [R 82] in
+ let r1079 = Sub (r997) :: r1078 in
+ let r1080 = S (T T_MINUSGREATER) :: r1079 in
+ let r1081 = [R 309] in
+ let r1082 = R 308 :: r1081 in
+ let r1083 = R 322 :: r1082 in
+ let r1084 = Sub (r997) :: r1083 in
+ let r1085 = S (T T_COLON) :: r1084 in
+ let r1086 = S (T T_LIDENT) :: r1085 in
+ let r1087 = R 132 :: r1086 in
+ let r1088 = R 855 :: r1087 in
+ let r1089 = [R 326] in
+ let r1090 = [R 640] in
+ let r1091 = [R 644] in
+ let r1092 = [R 319] in
+ let r1093 = R 318 :: r1092 in
+ let r1094 = R 322 :: r1093 in
+ let r1095 = R 582 :: r1094 in
+ let r1096 = R 824 :: r1095 in
+ let r1097 = S (T T_LIDENT) :: r1096 in
+ let r1098 = R 828 :: r1097 in
+ let r1099 = [R 645] in
+ let r1100 = [R 321] in
+ let r1101 = R 320 :: r1100 in
+ let r1102 = R 322 :: r1101 in
+ let r1103 = R 582 :: r1102 in
+ let r1104 = Sub (r129) :: r1103 in
+ let r1105 = S (T T_COLONEQUAL) :: r1104 in
+ let r1106 = S (T T_LIDENT) :: r1105 in
+ let r1107 = R 828 :: r1106 in
+ let r1108 = [R 436] in
+ let r1109 = S (T T_RBRACE) :: r1108 in
+ let r1110 = [R 249] in
+ let r1111 = R 316 :: r1110 in
+ let r1112 = R 243 :: r1111 in
+ let r1113 = Sub (r90) :: r1112 in
+ let r1114 = [R 434] in
+ let r1115 = [R 435] in
+ let r1116 = [R 439] in
+ let r1117 = S (T T_RBRACE) :: r1116 in
+ let r1118 = [R 438] in
+ let r1119 = S (T T_RBRACE) :: r1118 in
+ let r1120 = [R 43] in
+ let r1121 = Sub (r993) :: r1120 in
+ let r1122 = [R 52] in
+ let r1123 = Sub (r1121) :: r1122 in
+ let r1124 = S (T T_EQUAL) :: r1123 in
+ let r1125 = [R 801] in
+ let r1126 = R 306 :: r1125 in
+ let r1127 = R 322 :: r1126 in
+ let r1128 = Sub (r1124) :: r1127 in
+ let r1129 = S (T T_LIDENT) :: r1128 in
+ let r1130 = R 132 :: r1129 in
+ let r1131 = R 855 :: r1130 in
+ let r1132 = R 316 :: r1131 in
+ let r1133 = [R 80] in
+ let r1134 = S (T T_END) :: r1133 in
+ let r1135 = R 333 :: r1134 in
+ let r1136 = R 60 :: r1135 in
+ let r1137 = [R 850] in
+ let r1138 = Sub (r3) :: r1137 in
+ let r1139 = S (T T_EQUAL) :: r1138 in
+ let r1140 = S (T T_LIDENT) :: r1139 in
+ let r1141 = R 414 :: r1140 in
+ let r1142 = R 316 :: r1141 in
+ let r1143 = [R 46] in
+ let r1144 = R 322 :: r1143 in
+ let r1145 = [R 851] in
+ let r1146 = Sub (r3) :: r1145 in
+ let r1147 = S (T T_EQUAL) :: r1146 in
+ let r1148 = S (T T_LIDENT) :: r1147 in
+ let r1149 = R 414 :: r1148 in
+ let r1150 = [R 853] in
+ let r1151 = Sub (r3) :: r1150 in
+ let r1152 = [R 849] in
+ let r1153 = Sub (r34) :: r1152 in
+ let r1154 = S (T T_COLON) :: r1153 in
+ let r1155 = [R 852] in
+ let r1156 = Sub (r3) :: r1155 in
+ let r1157 = S (T T_EQUAL) :: r688 in
+ let r1158 = [R 357] in
+ let r1159 = Sub (r1157) :: r1158 in
+ let r1160 = S (T T_LIDENT) :: r1159 in
+ let r1161 = R 559 :: r1160 in
+ let r1162 = R 316 :: r1161 in
+ let r1163 = [R 47] in
+ let r1164 = R 322 :: r1163 in
+ let r1165 = [R 358] in
+ let r1166 = Sub (r1157) :: r1165 in
+ let r1167 = S (T T_LIDENT) :: r1166 in
+ let r1168 = R 559 :: r1167 in
+ let r1169 = [R 360] in
+ let r1170 = Sub (r3) :: r1169 in
+ let r1171 = S (T T_EQUAL) :: r1170 in
+ let r1172 = [R 362] in
+ let r1173 = Sub (r3) :: r1172 in
+ let r1174 = S (T T_EQUAL) :: r1173 in
+ let r1175 = Sub (r34) :: r1174 in
+ let r1176 = S (T T_DOT) :: r1175 in
+ let r1177 = [R 356] in
+ let r1178 = Sub (r36) :: r1177 in
+ let r1179 = S (T T_COLON) :: r1178 in
+ let r1180 = [R 359] in
+ let r1181 = Sub (r3) :: r1180 in
+ let r1182 = S (T T_EQUAL) :: r1181 in
+ let r1183 = [R 361] in
+ let r1184 = Sub (r3) :: r1183 in
+ let r1185 = S (T T_EQUAL) :: r1184 in
+ let r1186 = Sub (r34) :: r1185 in
+ let r1187 = S (T T_DOT) :: r1186 in
+ let r1188 = [R 49] in
+ let r1189 = R 322 :: r1188 in
+ let r1190 = Sub (r3) :: r1189 in
+ let r1191 = [R 44] in
+ let r1192 = R 322 :: r1191 in
+ let r1193 = R 483 :: r1192 in
+ let r1194 = Sub (r1121) :: r1193 in
+ let r1195 = [R 45] in
+ let r1196 = R 322 :: r1195 in
+ let r1197 = R 483 :: r1196 in
+ let r1198 = Sub (r1121) :: r1197 in
+ let r1199 = [R 76] in
+ let r1200 = S (T T_RPAREN) :: r1199 in
+ let r1201 = [R 39] in
+ let r1202 = Sub (r1121) :: r1201 in
+ let r1203 = S (T T_IN) :: r1202 in
+ let r1204 = Sub (r985) :: r1203 in
+ let r1205 = R 316 :: r1204 in
+ let r1206 = [R 296] in
+ let r1207 = R 322 :: r1206 in
+ let r1208 = Sub (r396) :: r1207 in
+ let r1209 = R 566 :: r1208 in
+ let r1210 = R 316 :: r1209 in
+ let r1211 = [R 40] in
+ let r1212 = Sub (r1121) :: r1211 in
+ let r1213 = S (T T_IN) :: r1212 in
+ let r1214 = Sub (r985) :: r1213 in
+ let r1215 = [R 78] in
+ let r1216 = Sub (r226) :: r1215 in
+ let r1217 = S (T T_RBRACKET) :: r1216 in
+ let r1218 = [R 55] in
+ let r1219 = Sub (r1121) :: r1218 in
+ let r1220 = S (T T_MINUSGREATER) :: r1219 in
+ let r1221 = Sub (r507) :: r1220 in
+ let r1222 = [R 37] in
+ let r1223 = Sub (r1221) :: r1222 in
+ let r1224 = [R 38] in
+ let r1225 = Sub (r1121) :: r1224 in
+ let r1226 = [R 295] in
+ let r1227 = R 322 :: r1226 in
+ let r1228 = Sub (r396) :: r1227 in
+ let r1229 = [R 79] in
+ let r1230 = S (T T_RPAREN) :: r1229 in
+ let r1231 = [R 484] in
+ let r1232 = [R 48] in
+ let r1233 = R 322 :: r1232 in
+ let r1234 = Sub (r1058) :: r1233 in
+ let r1235 = [R 50] in
+ let r1236 = [R 334] in
+ let r1237 = [R 53] in
+ let r1238 = Sub (r1121) :: r1237 in
+ let r1239 = S (T T_EQUAL) :: r1238 in
+ let r1240 = [R 54] in
+ let r1241 = [R 307] in
+ let r1242 = R 306 :: r1241 in
+ let r1243 = R 322 :: r1242 in
+ let r1244 = Sub (r1124) :: r1243 in
+ let r1245 = S (T T_LIDENT) :: r1244 in
+ let r1246 = R 132 :: r1245 in
+ let r1247 = R 855 :: r1246 in
+ let r1248 = [R 330] in
+ let r1249 = [R 789] in
+ let r1250 = [R 793] in
+ let r1251 = [R 787] in
+ let r1252 = R 327 :: r1251 in
+ let r1253 = [R 329] in
+ let r1254 = R 327 :: r1253 in
+ let r1255 = [R 59] in
+ let r1256 = S (T T_RPAREN) :: r1255 in
+ let r1257 = [R 128] in
+ let r1258 = R 316 :: r1257 in
+ let r1259 = [R 129] in
+ let r1260 = R 316 :: r1259 in
+ let r1261 = [R 351] in
+ let r1262 = [R 440] in
+ let r1263 = [R 25] in
+ let r1264 = Sub (r86) :: r1263 in
+ let r1265 = [R 28] in
let r1266 = [R 609] in
- let r1267 = [R 437] in
- let r1268 = S (T T_RBRACE) :: r1267 in
- let r1269 = [R 252] in
- let r1270 = R 322 :: r1269 in
- let r1271 = R 581 :: r1270 in
- let r1272 = [R 251] in
- let r1273 = R 322 :: r1272 in
- let r1274 = R 581 :: r1273 in
- let r1275 = [R 257] in
- let r1276 = [R 260] in
- let r1277 = [R 368] in
- let r1278 = [R 371] in
- let r1279 = S (T T_RPAREN) :: r1278 in
- let r1280 = S (T T_COLONCOLON) :: r1279 in
- let r1281 = S (T T_LPAREN) :: r1280 in
- let r1282 = [R 512] in
- let r1283 = [R 513] in
- let r1284 = [R 514] in
- let r1285 = [R 515] in
- let r1286 = [R 516] in
- let r1287 = [R 517] in
- let r1288 = [R 518] in
- let r1289 = [R 519] in
- let r1290 = [R 520] in
- let r1291 = [R 521] in
- let r1292 = [R 522] in
- let r1293 = [R 808] in
- let r1294 = [R 817] in
- let r1295 = [R 336] in
- let r1296 = [R 815] in
- let r1297 = S (T T_SEMISEMI) :: r1296 in
- let r1298 = [R 816] in
- let r1299 = [R 338] in
- let r1300 = [R 341] in
- let r1301 = [R 340] in
- let r1302 = [R 339] in
- let r1303 = R 337 :: r1302 in
- let r1304 = [R 844] in
- let r1305 = S (T T_EOF) :: r1304 in
- let r1306 = R 337 :: r1305 in
- let r1307 = [R 843] in
+ let r1267 = [R 610] in
+ let r1268 = [R 437] in
+ let r1269 = S (T T_RBRACE) :: r1268 in
+ let r1270 = [R 252] in
+ let r1271 = R 322 :: r1270 in
+ let r1272 = R 582 :: r1271 in
+ let r1273 = [R 251] in
+ let r1274 = R 322 :: r1273 in
+ let r1275 = R 582 :: r1274 in
+ let r1276 = [R 257] in
+ let r1277 = [R 260] in
+ let r1278 = [R 368] in
+ let r1279 = [R 371] in
+ let r1280 = S (T T_RPAREN) :: r1279 in
+ let r1281 = S (T T_COLONCOLON) :: r1280 in
+ let r1282 = S (T T_LPAREN) :: r1281 in
+ let r1283 = [R 512] in
+ let r1284 = [R 513] in
+ let r1285 = [R 514] in
+ let r1286 = [R 515] in
+ let r1287 = [R 516] in
+ let r1288 = [R 517] in
+ let r1289 = [R 518] in
+ let r1290 = [R 519] in
+ let r1291 = [R 520] in
+ let r1292 = [R 521] in
+ let r1293 = [R 522] in
+ let r1294 = [R 808] in
+ let r1295 = [R 817] in
+ let r1296 = [R 336] in
+ let r1297 = [R 815] in
+ let r1298 = S (T T_SEMISEMI) :: r1297 in
+ let r1299 = [R 816] in
+ let r1300 = [R 338] in
+ let r1301 = [R 341] in
+ let r1302 = [R 340] in
+ let r1303 = [R 339] in
+ let r1304 = R 337 :: r1303 in
+ let r1305 = [R 844] in
+ let r1306 = S (T T_EOF) :: r1305 in
+ let r1307 = R 337 :: r1306 in
+ let r1308 = [R 843] in
function
| 0 | 1907 | 1911 | 1929 | 1933 | 1937 | 1941 | 1945 | 1949 | 1953 | 1957 | 1961 | 1965 | 1971 | 1991 -> Nothing
| 1906 -> One ([R 0])
@@ -1818,9 +1821,9 @@ let recover =
| 217 -> One ([R 16])
| 1924 -> One ([R 20])
| 1926 -> One ([R 21])
- | 298 -> One ([R 22])
- | 281 -> One ([R 23])
- | 304 -> One ([R 24])
+ | 300 -> One ([R 22])
+ | 283 -> One ([R 23])
+ | 306 -> One ([R 24])
| 1693 -> One ([R 36])
| 1697 -> One ([R 41])
| 1694 -> One ([R 42])
@@ -1830,19 +1833,19 @@ let recover =
| 1444 -> One ([R 69])
| 1446 -> One ([R 73])
| 1695 -> One ([R 77])
- | 359 -> One ([R 88])
+ | 361 -> One ([R 88])
| 185 -> One ([R 89])
- | 357 -> One ([R 90])
+ | 359 -> One ([R 90])
| 158 -> One ([R 94])
- | 157 | 1150 -> One ([R 95])
+ | 157 | 1147 -> One ([R 95])
| 1321 -> One ([R 98])
| 1546 -> One ([R 106])
| 1550 -> One ([R 107])
- | 308 -> One ([R 109])
- | 286 -> One ([R 110])
- | 295 -> One ([R 111])
- | 297 -> One ([R 112])
- | 1063 -> One ([R 122])
+ | 310 -> One ([R 109])
+ | 288 -> One ([R 110])
+ | 297 -> One ([R 111])
+ | 299 -> One ([R 112])
+ | 1028 -> One ([R 122])
| 1 -> One (R 124 :: r9)
| 61 -> One (R 124 :: r42)
| 182 -> One (R 124 :: r179)
@@ -1851,155 +1854,154 @@ let recover =
| 219 -> One (R 124 :: r213)
| 220 -> One (R 124 :: r217)
| 226 -> One (R 124 :: r229)
- | 241 -> One (R 124 :: r239)
- | 351 -> One (R 124 :: r334)
- | 374 -> One (R 124 :: r347)
- | 451 -> One (R 124 :: r399)
- | 545 -> One (R 124 :: r471)
- | 548 -> One (R 124 :: r474)
- | 551 -> One (R 124 :: r479)
- | 554 -> One (R 124 :: r482)
- | 560 -> One (R 124 :: r502)
- | 589 -> One (R 124 :: r516)
- | 594 -> One (R 124 :: r520)
- | 601 -> One (R 124 :: r533)
- | 617 -> One (R 124 :: r544)
- | 631 -> One (R 124 :: r550)
- | 639 -> One (R 124 :: r558)
- | 645 -> One (R 124 :: r562)
- | 674 -> One (R 124 :: r582)
- | 690 -> One (R 124 :: r588)
- | 696 -> One (R 124 :: r592)
- | 705 -> One (R 124 :: r596)
- | 716 -> One (R 124 :: r602)
- | 722 -> One (R 124 :: r606)
- | 728 -> One (R 124 :: r610)
- | 734 -> One (R 124 :: r614)
- | 740 -> One (R 124 :: r618)
- | 746 -> One (R 124 :: r622)
- | 752 -> One (R 124 :: r626)
- | 758 -> One (R 124 :: r630)
- | 764 -> One (R 124 :: r634)
- | 770 -> One (R 124 :: r638)
- | 776 -> One (R 124 :: r642)
- | 782 -> One (R 124 :: r646)
- | 788 -> One (R 124 :: r650)
- | 794 -> One (R 124 :: r654)
- | 800 -> One (R 124 :: r658)
- | 806 -> One (R 124 :: r662)
- | 812 -> One (R 124 :: r666)
- | 818 -> One (R 124 :: r670)
- | 824 -> One (R 124 :: r674)
- | 830 -> One (R 124 :: r678)
- | 921 -> One (R 124 :: r730)
- | 930 -> One (R 124 :: r737)
- | 939 -> One (R 124 :: r744)
- | 949 -> One (R 124 :: r748)
- | 958 -> One (R 124 :: r752)
- | 967 -> One (R 124 :: r756)
- | 978 -> One (R 124 :: r760)
- | 987 -> One (R 124 :: r764)
- | 996 -> One (R 124 :: r768)
- | 1003 -> One (R 124 :: r772)
- | 1082 -> One (R 124 :: r790)
- | 1087 -> One (R 124 :: r794)
- | 1094 -> One (R 124 :: r798)
- | 1103 -> One (R 124 :: r803)
- | 1113 -> One (R 124 :: r806)
- | 1132 -> One (R 124 :: r816)
- | 1147 -> One (R 124 :: r827)
- | 1207 -> One (R 124 :: r860)
- | 1216 -> One (R 124 :: r865)
- | 1231 -> One (R 124 :: r872)
- | 1262 -> One (R 124 :: r889)
- | 1295 -> One (R 124 :: r917)
- | 1300 -> One (R 124 :: r927)
- | 1332 -> One (R 124 :: r951)
- | 1333 -> One (R 124 :: r955)
- | 1342 -> One (R 124 :: r963)
- | 1379 -> One (R 124 :: r991)
- | 1388 -> One (R 124 :: r1005)
- | 1389 -> One (R 124 :: r1014)
- | 1583 -> One (R 124 :: r1131)
- | 296 -> One ([R 130])
- | 649 -> One ([R 136])
- | 1009 -> One ([R 154])
- | 672 -> One ([R 155])
- | 703 -> One ([R 156])
- | 679 -> One ([R 157])
- | 701 -> One ([R 228])
- | 710 -> One ([R 233])
- | 714 -> One ([R 234])
- | 465 -> One ([R 242])
+ | 243 -> One (R 124 :: r242)
+ | 353 -> One (R 124 :: r337)
+ | 376 -> One (R 124 :: r350)
+ | 457 -> One (R 124 :: r407)
+ | 550 -> One (R 124 :: r476)
+ | 553 -> One (R 124 :: r479)
+ | 567 -> One (R 124 :: r490)
+ | 581 -> One (R 124 :: r498)
+ | 584 -> One (R 124 :: r501)
+ | 590 -> One (R 124 :: r521)
+ | 619 -> One (R 124 :: r535)
+ | 624 -> One (R 124 :: r539)
+ | 631 -> One (R 124 :: r552)
+ | 636 -> One (R 124 :: r555)
+ | 644 -> One (R 124 :: r563)
+ | 650 -> One (R 124 :: r567)
+ | 679 -> One (R 124 :: r587)
+ | 695 -> One (R 124 :: r593)
+ | 701 -> One (R 124 :: r597)
+ | 710 -> One (R 124 :: r601)
+ | 721 -> One (R 124 :: r607)
+ | 727 -> One (R 124 :: r611)
+ | 733 -> One (R 124 :: r615)
+ | 739 -> One (R 124 :: r619)
+ | 745 -> One (R 124 :: r623)
+ | 751 -> One (R 124 :: r627)
+ | 757 -> One (R 124 :: r631)
+ | 763 -> One (R 124 :: r635)
+ | 769 -> One (R 124 :: r639)
+ | 775 -> One (R 124 :: r643)
+ | 781 -> One (R 124 :: r647)
+ | 787 -> One (R 124 :: r651)
+ | 793 -> One (R 124 :: r655)
+ | 799 -> One (R 124 :: r659)
+ | 805 -> One (R 124 :: r663)
+ | 811 -> One (R 124 :: r667)
+ | 817 -> One (R 124 :: r671)
+ | 823 -> One (R 124 :: r675)
+ | 829 -> One (R 124 :: r679)
+ | 835 -> One (R 124 :: r683)
+ | 926 -> One (R 124 :: r735)
+ | 935 -> One (R 124 :: r742)
+ | 944 -> One (R 124 :: r749)
+ | 954 -> One (R 124 :: r753)
+ | 963 -> One (R 124 :: r757)
+ | 972 -> One (R 124 :: r761)
+ | 983 -> One (R 124 :: r765)
+ | 992 -> One (R 124 :: r769)
+ | 1001 -> One (R 124 :: r773)
+ | 1008 -> One (R 124 :: r777)
+ | 1047 -> One (R 124 :: r780)
+ | 1052 -> One (R 124 :: r784)
+ | 1059 -> One (R 124 :: r788)
+ | 1110 -> One (R 124 :: r807)
+ | 1129 -> One (R 124 :: r817)
+ | 1144 -> One (R 124 :: r828)
+ | 1204 -> One (R 124 :: r861)
+ | 1213 -> One (R 124 :: r866)
+ | 1231 -> One (R 124 :: r873)
+ | 1262 -> One (R 124 :: r890)
+ | 1295 -> One (R 124 :: r918)
+ | 1300 -> One (R 124 :: r928)
+ | 1332 -> One (R 124 :: r952)
+ | 1333 -> One (R 124 :: r956)
+ | 1342 -> One (R 124 :: r964)
+ | 1379 -> One (R 124 :: r992)
+ | 1388 -> One (R 124 :: r1006)
+ | 1389 -> One (R 124 :: r1015)
+ | 1583 -> One (R 124 :: r1132)
+ | 298 -> One ([R 130])
+ | 654 -> One ([R 136])
+ | 1014 -> One ([R 154])
+ | 677 -> One ([R 155])
+ | 708 -> One ([R 156])
+ | 684 -> One ([R 157])
+ | 706 -> One ([R 228])
+ | 715 -> One ([R 233])
+ | 719 -> One ([R 234])
+ | 470 -> One ([R 242])
| 114 -> One ([R 255])
| 91 -> One (R 258 :: r53)
| 95 -> One (R 258 :: r55)
| 216 -> One ([R 262])
- | 1172 -> One ([R 266])
- | 1173 -> One ([R 267])
- | 1008 -> One ([R 271])
- | 886 -> One ([R 285])
- | 857 -> One ([R 287])
- | 891 -> One ([R 294])
+ | 1169 -> One ([R 266])
+ | 1170 -> One ([R 267])
+ | 1013 -> One ([R 271])
+ | 891 -> One ([R 285])
+ | 862 -> One ([R 287])
+ | 896 -> One ([R 294])
| 1698 -> One ([R 297])
- | 566 -> One ([R 298])
- | 1206 -> One ([R 300])
+ | 596 -> One ([R 298])
+ | 1203 -> One ([R 300])
| 128 -> One (R 316 :: r74)
| 213 -> One (R 316 :: r208)
| 224 -> One (R 316 :: r222)
| 237 -> One (R 316 :: r234)
- | 454 -> One (R 316 :: r403)
- | 463 -> One (R 316 :: r415)
- | 835 -> One (R 316 :: r681)
- | 1277 -> One (R 316 :: r905)
- | 1361 -> One (R 316 :: r982)
- | 1400 -> One (R 316 :: r1020)
- | 1406 -> One (R 316 :: r1028)
- | 1417 -> One (R 316 :: r1034)
- | 1428 -> One (R 316 :: r1037)
- | 1432 -> One (R 316 :: r1046)
- | 1453 -> One (R 316 :: r1060)
- | 1469 -> One (R 316 :: r1070)
- | 1504 -> One (R 316 :: r1087)
- | 1526 -> One (R 316 :: r1097)
- | 1536 -> One (R 316 :: r1106)
- | 1590 -> One (R 316 :: r1135)
- | 1594 -> One (R 316 :: r1148)
- | 1622 -> One (R 316 :: r1167)
- | 1662 -> One (R 316 :: r1189)
- | 1666 -> One (R 316 :: r1193)
- | 1667 -> One (R 316 :: r1197)
- | 1678 -> One (R 316 :: r1213)
- | 1686 -> One (R 316 :: r1222)
- | 1725 -> One (R 316 :: r1233)
- | 1745 -> One (R 316 :: r1246)
- | 1838 -> One (R 316 :: r1260)
- | 1525 -> One (R 318 :: r1090)
- | 1766 -> One (R 318 :: r1249)
- | 1535 -> One (R 320 :: r1098)
- | 888 -> One (R 322 :: r709)
- | 1462 -> One (R 322 :: r1061)
- | 1523 -> One (R 322 :: r1089)
- | 1731 -> One (R 322 :: r1234)
- | 1764 -> One (R 322 :: r1248)
- | 1771 -> One (R 322 :: r1251)
- | 1781 -> One (R 322 :: r1253)
- | 1986 -> One (R 322 :: r1297)
- | 1997 -> One (R 322 :: r1303)
- | 2002 -> One (R 322 :: r1306)
- | 1331 -> One (R 324 :: r947)
- | 1515 -> One (R 324 :: r1088)
+ | 460 -> One (R 316 :: r411)
+ | 468 -> One (R 316 :: r421)
+ | 840 -> One (R 316 :: r686)
+ | 1277 -> One (R 316 :: r906)
+ | 1361 -> One (R 316 :: r983)
+ | 1400 -> One (R 316 :: r1021)
+ | 1406 -> One (R 316 :: r1029)
+ | 1417 -> One (R 316 :: r1035)
+ | 1428 -> One (R 316 :: r1038)
+ | 1432 -> One (R 316 :: r1047)
+ | 1453 -> One (R 316 :: r1061)
+ | 1469 -> One (R 316 :: r1071)
+ | 1504 -> One (R 316 :: r1088)
+ | 1526 -> One (R 316 :: r1098)
+ | 1536 -> One (R 316 :: r1107)
+ | 1590 -> One (R 316 :: r1136)
+ | 1594 -> One (R 316 :: r1149)
+ | 1622 -> One (R 316 :: r1168)
+ | 1662 -> One (R 316 :: r1190)
+ | 1666 -> One (R 316 :: r1194)
+ | 1667 -> One (R 316 :: r1198)
+ | 1678 -> One (R 316 :: r1214)
+ | 1686 -> One (R 316 :: r1223)
+ | 1725 -> One (R 316 :: r1234)
+ | 1745 -> One (R 316 :: r1247)
+ | 1838 -> One (R 316 :: r1261)
+ | 1525 -> One (R 318 :: r1091)
+ | 1766 -> One (R 318 :: r1250)
+ | 1535 -> One (R 320 :: r1099)
+ | 893 -> One (R 322 :: r714)
+ | 1462 -> One (R 322 :: r1062)
+ | 1523 -> One (R 322 :: r1090)
+ | 1731 -> One (R 322 :: r1235)
+ | 1764 -> One (R 322 :: r1249)
+ | 1771 -> One (R 322 :: r1252)
+ | 1781 -> One (R 322 :: r1254)
+ | 1986 -> One (R 322 :: r1298)
+ | 1997 -> One (R 322 :: r1304)
+ | 2002 -> One (R 322 :: r1307)
+ | 1331 -> One (R 324 :: r948)
+ | 1515 -> One (R 324 :: r1089)
| 215 -> One (R 327 :: r209)
- | 1755 -> One (R 327 :: r1247)
- | 1465 -> One (R 331 :: r1062)
- | 1734 -> One (R 333 :: r1235)
- | 1984 -> One (R 335 :: r1295)
- | 1992 -> One (R 337 :: r1299)
- | 1993 -> One (R 337 :: r1300)
- | 1994 -> One (R 337 :: r1301)
- | 428 -> One ([R 343])
- | 432 -> One ([R 345])
- | 1076 -> One ([R 348])
+ | 1755 -> One (R 327 :: r1248)
+ | 1465 -> One (R 331 :: r1063)
+ | 1734 -> One (R 333 :: r1236)
+ | 1984 -> One (R 335 :: r1296)
+ | 1992 -> One (R 337 :: r1300)
+ | 1993 -> One (R 337 :: r1301)
+ | 1994 -> One (R 337 :: r1302)
+ | 434 -> One ([R 343])
+ | 438 -> One ([R 345])
+ | 1041 -> One ([R 348])
| 1841 -> One ([R 349])
| 1844 -> One ([R 350])
| 1843 -> One ([R 352])
@@ -2009,24 +2011,24 @@ let recover =
| 1915 -> One ([R 369])
| 1923 -> One ([R 370])
| 1922 -> One ([R 372])
- | 608 -> One ([R 379])
- | 1061 -> One ([R 380])
- | 522 -> One ([R 391])
- | 532 -> One ([R 392])
- | 533 -> One ([R 393])
- | 531 -> One ([R 394])
- | 534 -> One ([R 396])
+ | 558 -> One ([R 379])
+ | 1103 -> One ([R 380])
+ | 529 -> One ([R 391])
+ | 539 -> One ([R 392])
+ | 540 -> One ([R 393])
+ | 538 -> One ([R 394])
+ | 541 -> One ([R 396])
| 212 -> One ([R 397])
- | 204 | 1352 -> One ([R 398])
- | 492 -> One ([R 405])
- | 469 -> One ([R 406])
- | 499 -> One ([R 410])
- | 1158 | 1608 -> One ([R 415])
+ | 204 | 467 | 1352 -> One ([R 398])
+ | 497 -> One ([R 406])
+ | 474 -> One ([R 407])
+ | 510 -> One ([R 410])
+ | 1155 | 1608 -> One ([R 415])
| 1410 -> One ([R 417])
| 1408 -> One ([R 418])
| 1411 -> One ([R 419])
| 1409 -> One ([R 420])
- | 392 -> One ([R 423])
+ | 399 -> One ([R 423])
| 1311 -> One ([R 425])
| 1559 -> One ([R 426])
| 1865 -> One ([R 427])
@@ -2034,24 +2036,24 @@ let recover =
| 1866 -> One ([R 429])
| 1574 -> One ([R 430])
| 1566 -> One ([R 431])
- | 66 | 245 -> One ([R 446])
- | 74 | 626 -> One ([R 447])
+ | 66 | 247 -> One ([R 446])
+ | 74 | 576 -> One ([R 447])
| 102 -> One ([R 448])
| 90 -> One ([R 450])
| 94 -> One ([R 452])
| 98 -> One ([R 454])
| 81 -> One ([R 455])
- | 101 | 1032 -> One ([R 456])
+ | 101 | 1074 -> One ([R 456])
| 80 -> One ([R 457])
| 79 -> One ([R 458])
| 78 -> One ([R 459])
| 77 -> One ([R 460])
| 76 -> One ([R 461])
- | 69 | 199 | 616 -> One ([R 462])
- | 68 | 615 -> One ([R 463])
+ | 69 | 199 | 566 -> One ([R 462])
+ | 68 | 565 -> One ([R 463])
| 67 -> One ([R 464])
- | 73 | 398 | 625 -> One ([R 465])
- | 72 | 624 -> One ([R 466])
+ | 73 | 403 | 575 -> One ([R 465])
+ | 72 | 574 -> One ([R 466])
| 65 -> One ([R 467])
| 70 -> One ([R 468])
| 83 -> One ([R 469])
@@ -2061,82 +2063,81 @@ let recover =
| 100 -> One ([R 473])
| 103 -> One ([R 474])
| 99 -> One ([R 476])
- | 324 -> One ([R 477])
- | 323 -> One (R 478 :: r319)
- | 259 -> One (R 479 :: r272)
- | 260 -> One ([R 480])
- | 429 -> One (R 481 :: r368)
- | 430 -> One ([R 482])
- | 858 -> One (R 498 :: r698)
- | 859 -> One ([R 499])
+ | 326 -> One ([R 477])
+ | 325 -> One (R 478 :: r322)
+ | 261 -> One (R 479 :: r275)
+ | 262 -> One ([R 480])
+ | 435 -> One (R 481 :: r376)
+ | 436 -> One ([R 482])
+ | 863 -> One (R 498 :: r703)
+ | 864 -> One ([R 499])
| 120 -> One ([R 500])
- | 384 -> One ([R 524])
- | 378 -> One ([R 525])
- | 379 -> One ([R 527])
- | 377 | 627 -> One ([R 534])
- | 881 -> One ([R 540])
- | 882 -> One ([R 541])
- | 883 -> One ([R 543])
- | 572 -> One ([R 545])
- | 1582 -> One ([R 549])
- | 1624 | 1643 -> One ([R 559])
- | 1421 -> One ([R 561])
- | 1419 -> One ([R 562])
- | 1422 -> One ([R 563])
- | 1420 -> One ([R 564])
- | 1707 -> One (R 565 :: r1227)
- | 1198 -> One ([R 566])
- | 1557 -> One ([R 569])
- | 1558 -> One ([R 570])
- | 1552 -> One ([R 571])
- | 1818 -> One ([R 573])
- | 1817 -> One ([R 574])
- | 1819 -> One ([R 575])
- | 1814 -> One ([R 576])
- | 1815 -> One ([R 577])
- | 1879 -> One ([R 579])
- | 1877 -> One ([R 580])
- | 583 -> One ([R 584])
- | 514 -> One ([R 585])
- | 466 -> One ([R 586])
- | 1011 -> One ([R 587])
- | 1010 -> One ([R 588])
- | 346 -> One ([R 590])
- | 316 -> One ([R 618])
- | 905 -> One ([R 621])
- | 643 -> One ([R 623])
- | 906 -> One ([R 624])
- | 1013 -> One ([R 625])
- | 1119 -> One ([R 627])
- | 1120 -> One ([R 628])
- | 423 -> One ([R 630])
- | 424 -> One ([R 631])
- | 1053 -> One ([R 633])
- | 1054 -> One ([R 634])
- | 1577 -> One ([R 640])
- | 1514 -> One ([R 641])
- | 1517 -> One ([R 642])
- | 1516 -> One ([R 647])
- | 1521 -> One ([R 650])
- | 1520 -> One ([R 652])
- | 1519 -> One ([R 653])
- | 1518 -> One ([R 654])
- | 1578 -> One ([R 657])
- | 197 -> One ([R 660])
- | 194 -> One ([R 662])
- | 607 -> One ([R 687])
- | 683 -> One ([R 688])
- | 682 | 702 -> One ([R 689])
- | 610 | 678 -> One ([R 690])
- | 913 | 1001 -> One ([R 695])
- | 681 -> One ([R 700])
- | 360 -> One ([R 713])
- | 364 -> One ([R 716])
- | 365 -> One ([R 720])
- | 396 -> One ([R 722])
- | 369 -> One ([R 723])
- | 425 -> One ([R 725])
- | 387 -> One ([R 730])
+ | 394 -> One ([R 524])
+ | 388 -> One ([R 525])
+ | 389 -> One ([R 527])
+ | 886 -> One ([R 541])
+ | 887 -> One ([R 542])
+ | 888 -> One ([R 544])
+ | 602 -> One ([R 546])
+ | 1582 -> One ([R 550])
+ | 1624 | 1643 -> One ([R 560])
+ | 1421 -> One ([R 562])
+ | 1419 -> One ([R 563])
+ | 1422 -> One ([R 564])
+ | 1420 -> One ([R 565])
+ | 1707 -> One (R 566 :: r1228)
+ | 1195 -> One ([R 567])
+ | 1557 -> One ([R 570])
+ | 1558 -> One ([R 571])
+ | 1552 -> One ([R 572])
+ | 1818 -> One ([R 574])
+ | 1817 -> One ([R 575])
+ | 1819 -> One ([R 576])
+ | 1814 -> One ([R 577])
+ | 1815 -> One ([R 578])
+ | 1879 -> One ([R 580])
+ | 1877 -> One ([R 581])
+ | 613 -> One ([R 585])
+ | 509 -> One ([R 586])
+ | 471 -> One ([R 587])
+ | 1016 -> One ([R 588])
+ | 1015 -> One ([R 589])
+ | 348 -> One ([R 591])
+ | 318 -> One ([R 619])
+ | 910 -> One ([R 622])
+ | 648 -> One ([R 624])
+ | 911 -> One ([R 625])
+ | 1018 -> One ([R 626])
+ | 1116 -> One ([R 628])
+ | 1117 -> One ([R 629])
+ | 429 -> One ([R 631])
+ | 430 -> One ([R 632])
+ | 1095 -> One ([R 634])
+ | 1096 -> One ([R 635])
+ | 1577 -> One ([R 641])
+ | 1514 -> One ([R 642])
+ | 1517 -> One ([R 643])
+ | 1516 -> One ([R 648])
+ | 1521 -> One ([R 651])
+ | 1520 -> One ([R 653])
+ | 1519 -> One ([R 654])
+ | 1518 -> One ([R 655])
+ | 1578 -> One ([R 658])
+ | 197 -> One ([R 661])
+ | 194 -> One ([R 663])
+ | 557 -> One ([R 687])
+ | 688 -> One ([R 688])
+ | 687 | 707 -> One ([R 689])
+ | 560 | 683 -> One ([R 690])
+ | 918 | 1006 -> One ([R 695])
+ | 686 -> One ([R 700])
+ | 362 -> One ([R 713])
+ | 366 -> One ([R 716])
+ | 367 -> One ([R 720])
+ | 385 -> One ([R 722])
+ | 371 -> One ([R 723])
+ | 431 -> One ([R 725])
+ | 384 -> One ([R 730])
| 28 -> One ([R 731])
| 8 -> One ([R 732])
| 52 -> One ([R 734])
@@ -2206,9 +2207,9 @@ let recover =
| 1977 -> One ([R 813])
| 1974 -> One ([R 814])
| 1980 -> One ([R 818])
- | 284 -> One ([R 820])
- | 472 -> One (R 828 :: r432)
- | 486 -> One ([R 829])
+ | 286 -> One ([R 820])
+ | 477 -> One (R 828 :: r438)
+ | 491 -> One ([R 829])
| 134 -> One ([R 834])
| 137 -> One ([R 835])
| 141 -> One ([R 836])
@@ -2218,8 +2219,8 @@ let recover =
| 143 -> One ([R 840])
| 140 -> One ([R 841])
| 133 -> One ([R 842])
- | 361 -> One ([R 847])
- | 680 -> One ([R 848])
+ | 363 -> One ([R 847])
+ | 685 -> One ([R 848])
| 1392 -> One ([R 856])
| 1606 -> One ([R 857])
| 1609 -> One ([R 858])
@@ -2227,275 +2228,275 @@ let recover =
| 1641 -> One ([R 860])
| 1644 -> One ([R 861])
| 1642 -> One ([R 862])
- | 475 -> One ([R 869])
- | 476 -> One ([R 870])
- | 1047 -> One (S (T T_WITH) :: r787)
+ | 480 -> One ([R 869])
+ | 481 -> One ([R 870])
+ | 1089 -> One (S (T T_WITH) :: r803)
| 208 -> One (S (T T_TYPE) :: r205)
- | 1175 -> One (S (T T_STAR) :: r850)
- | 1982 -> One (S (T T_SEMISEMI) :: r1294)
- | 1989 -> One (S (T T_SEMISEMI) :: r1298)
+ | 1172 -> One (S (T T_STAR) :: r851)
+ | 1982 -> One (S (T T_SEMISEMI) :: r1295)
+ | 1989 -> One (S (T T_SEMISEMI) :: r1299)
| 1912 -> One (S (T T_RPAREN) :: r134)
- | 306 | 1858 -> One (S (T T_RPAREN) :: r311)
- | 372 -> One (S (T T_RPAREN) :: r344)
- | 416 -> One (S (T T_RPAREN) :: r367)
- | 456 -> One (S (T T_RPAREN) :: r404)
- | 524 -> One (S (T T_RPAREN) :: r447)
- | 1033 -> One (S (T T_RPAREN) :: r776)
- | 1226 -> One (S (T T_RPAREN) :: r868)
- | 1851 -> One (S (T T_RPAREN) :: r1263)
- | 1913 -> One (S (T T_RPAREN) :: r1277)
- | 1154 | 1541 -> One (S (T T_RBRACKET) :: r252)
- | 1039 -> One (S (T T_RBRACKET) :: r779)
- | 1041 -> One (S (T T_RBRACKET) :: r780)
- | 310 -> One (S (T T_QUOTE) :: r313)
- | 1430 -> One (S (T T_OPEN) :: r1042)
- | 1670 -> One (S (T T_OPEN) :: r1204)
- | 121 | 289 -> One (S (T T_MODULE) :: r69)
- | 461 -> One (S (T T_MINUSGREATER) :: r411)
- | 1183 -> One (S (T T_MINUSGREATER) :: r855)
- | 1187 -> One (S (T T_MINUSGREATER) :: r857)
- | 1491 -> One (S (T T_MINUSGREATER) :: r1076)
+ | 308 | 1858 -> One (S (T T_RPAREN) :: r314)
+ | 374 -> One (S (T T_RPAREN) :: r347)
+ | 422 -> One (S (T T_RPAREN) :: r375)
+ | 462 -> One (S (T T_RPAREN) :: r412)
+ | 531 -> One (S (T T_RPAREN) :: r455)
+ | 1075 -> One (S (T T_RPAREN) :: r792)
+ | 1223 -> One (S (T T_RPAREN) :: r869)
+ | 1851 -> One (S (T T_RPAREN) :: r1264)
+ | 1913 -> One (S (T T_RPAREN) :: r1278)
+ | 1151 | 1541 -> One (S (T T_RBRACKET) :: r255)
+ | 1081 -> One (S (T T_RBRACKET) :: r795)
+ | 1083 -> One (S (T T_RBRACKET) :: r796)
+ | 312 -> One (S (T T_QUOTE) :: r316)
+ | 1430 -> One (S (T T_OPEN) :: r1043)
+ | 1670 -> One (S (T T_OPEN) :: r1205)
+ | 121 | 291 -> One (S (T T_MODULE) :: r69)
+ | 504 -> One (S (T T_MINUSGREATER) :: r447)
+ | 1180 -> One (S (T T_MINUSGREATER) :: r856)
+ | 1184 -> One (S (T T_MINUSGREATER) :: r858)
+ | 1491 -> One (S (T T_MINUSGREATER) :: r1077)
| 84 -> One (S (T T_LPAREN) :: r50)
| 117 -> One (S (T T_LIDENT) :: r64)
- | 437 -> One (S (T T_LIDENT) :: r370)
- | 445 -> One (S (T T_LIDENT) :: r376)
- | 650 -> One (S (T T_LIDENT) :: r563)
- | 651 -> One (S (T T_LIDENT) :: r569)
- | 662 -> One (S (T T_LIDENT) :: r572)
- | 666 -> One (S (T T_LIDENT) :: r574)
- | 1159 -> One (S (T T_LIDENT) :: r846)
- | 1610 -> One (S (T T_LIDENT) :: r1153)
- | 1645 -> One (S (T T_LIDENT) :: r1178)
- | 1717 -> One (S (T T_LIDENT) :: r1230)
+ | 443 -> One (S (T T_LIDENT) :: r378)
+ | 451 -> One (S (T T_LIDENT) :: r384)
+ | 655 -> One (S (T T_LIDENT) :: r568)
+ | 656 -> One (S (T T_LIDENT) :: r574)
+ | 667 -> One (S (T T_LIDENT) :: r577)
+ | 671 -> One (S (T T_LIDENT) :: r579)
+ | 1156 -> One (S (T T_LIDENT) :: r847)
+ | 1610 -> One (S (T T_LIDENT) :: r1154)
+ | 1645 -> One (S (T T_LIDENT) :: r1179)
+ | 1717 -> One (S (T T_LIDENT) :: r1231)
| 192 -> One (S (T T_INT) :: r190)
| 195 -> One (S (T T_INT) :: r191)
- | 684 -> One (S (T T_IN) :: r584)
- | 1690 -> One (S (T T_IN) :: r1224)
- | 538 -> One (S (T T_GREATERRBRACE) :: r454)
- | 1122 -> One (S (T T_GREATERRBRACE) :: r807)
+ | 689 -> One (S (T T_IN) :: r589)
+ | 1690 -> One (S (T T_IN) :: r1225)
+ | 545 -> One (S (T T_GREATERRBRACE) :: r462)
+ | 1119 -> One (S (T T_GREATERRBRACE) :: r808)
| 165 -> One (S (T T_GREATER) :: r139)
- | 1846 -> One (S (T T_GREATER) :: r1261)
- | 504 -> One (S (T T_EQUAL) :: r443)
- | 854 -> One (S (T T_EQUAL) :: r695)
- | 870 -> One (S (T T_EQUAL) :: r703)
- | 1023 -> One (S (T T_EQUAL) :: r774)
- | 1600 -> One (S (T T_EQUAL) :: r1150)
- | 1618 -> One (S (T T_EQUAL) :: r1155)
- | 1904 -> One (S (T T_EOF) :: r1275)
- | 1908 -> One (S (T T_EOF) :: r1276)
- | 1927 -> One (S (T T_EOF) :: r1282)
- | 1931 -> One (S (T T_EOF) :: r1283)
- | 1935 -> One (S (T T_EOF) :: r1284)
- | 1938 -> One (S (T T_EOF) :: r1285)
- | 1943 -> One (S (T T_EOF) :: r1286)
- | 1947 -> One (S (T T_EOF) :: r1287)
- | 1951 -> One (S (T T_EOF) :: r1288)
- | 1955 -> One (S (T T_EOF) :: r1289)
- | 1959 -> One (S (T T_EOF) :: r1290)
- | 1962 -> One (S (T T_EOF) :: r1291)
- | 1966 -> One (S (T T_EOF) :: r1292)
- | 2006 -> One (S (T T_EOF) :: r1307)
- | 1100 -> One (S (T T_END) :: r799)
+ | 1846 -> One (S (T T_GREATER) :: r1262)
+ | 513 -> One (S (T T_EQUAL) :: r451)
+ | 859 -> One (S (T T_EQUAL) :: r700)
+ | 875 -> One (S (T T_EQUAL) :: r708)
+ | 1065 -> One (S (T T_EQUAL) :: r790)
+ | 1600 -> One (S (T T_EQUAL) :: r1151)
+ | 1618 -> One (S (T T_EQUAL) :: r1156)
+ | 1904 -> One (S (T T_EOF) :: r1276)
+ | 1908 -> One (S (T T_EOF) :: r1277)
+ | 1927 -> One (S (T T_EOF) :: r1283)
+ | 1931 -> One (S (T T_EOF) :: r1284)
+ | 1935 -> One (S (T T_EOF) :: r1285)
+ | 1938 -> One (S (T T_EOF) :: r1286)
+ | 1943 -> One (S (T T_EOF) :: r1287)
+ | 1947 -> One (S (T T_EOF) :: r1288)
+ | 1951 -> One (S (T T_EOF) :: r1289)
+ | 1955 -> One (S (T T_EOF) :: r1290)
+ | 1959 -> One (S (T T_EOF) :: r1291)
+ | 1962 -> One (S (T T_EOF) :: r1292)
+ | 1966 -> One (S (T T_EOF) :: r1293)
+ | 2006 -> One (S (T T_EOF) :: r1308)
+ | 1106 -> One (S (T T_END) :: r804)
| 86 -> One (S (T T_DOTDOT) :: r51)
| 159 -> One (S (T T_DOTDOT) :: r131)
- | 1560 -> One (S (T T_DOTDOT) :: r1113)
- | 1561 -> One (S (T T_DOTDOT) :: r1114)
- | 230 | 899 | 972 -> One (S (T T_DOT) :: r231)
- | 1969 -> One (S (T T_DOT) :: r444)
- | 847 -> One (S (T T_DOT) :: r692)
- | 1162 -> One (S (T T_DOT) :: r848)
- | 1181 -> One (S (T T_DOT) :: r853)
- | 1305 -> One (S (T T_DOT) :: r929)
- | 1917 -> One (S (T T_DOT) :: r1281)
- | 160 | 1151 -> One (S (T T_COLONCOLON) :: r133)
+ | 1560 -> One (S (T T_DOTDOT) :: r1114)
+ | 1561 -> One (S (T T_DOTDOT) :: r1115)
+ | 230 | 904 | 977 -> One (S (T T_DOT) :: r231)
+ | 1969 -> One (S (T T_DOT) :: r452)
+ | 852 -> One (S (T T_DOT) :: r697)
+ | 1159 -> One (S (T T_DOT) :: r849)
+ | 1178 -> One (S (T T_DOT) :: r854)
+ | 1305 -> One (S (T T_DOT) :: r930)
+ | 1917 -> One (S (T T_DOT) :: r1282)
+ | 160 | 1148 -> One (S (T T_COLONCOLON) :: r133)
| 166 -> One (S (T T_COLON) :: r144)
- | 458 -> One (S (T T_COLON) :: r407)
- | 1485 -> One (S (T T_COLON) :: r1074)
- | 246 -> One (S (T T_BARRBRACKET) :: r242)
- | 250 -> One (S (T T_BARRBRACKET) :: r251)
- | 434 -> One (S (T T_BARRBRACKET) :: r369)
- | 1035 -> One (S (T T_BARRBRACKET) :: r777)
- | 1037 -> One (S (T T_BARRBRACKET) :: r778)
- | 1213 -> One (S (T T_BARRBRACKET) :: r861)
- | 335 -> One (S (T T_BAR) :: r323)
+ | 464 -> One (S (T T_COLON) :: r415)
+ | 1485 -> One (S (T T_COLON) :: r1075)
+ | 248 -> One (S (T T_BARRBRACKET) :: r245)
+ | 252 -> One (S (T T_BARRBRACKET) :: r254)
+ | 440 -> One (S (T T_BARRBRACKET) :: r377)
+ | 1077 -> One (S (T T_BARRBRACKET) :: r793)
+ | 1079 -> One (S (T T_BARRBRACKET) :: r794)
+ | 1210 -> One (S (T T_BARRBRACKET) :: r862)
+ | 337 -> One (S (T T_BAR) :: r326)
| 190 -> One (S (N N_pattern) :: r188)
- | 389 | 574 -> One (S (N N_pattern) :: r193)
- | 350 -> One (S (N N_pattern) :: r328)
- | 380 -> One (S (N N_pattern) :: r348)
- | 382 -> One (S (N N_pattern) :: r349)
- | 403 -> One (S (N N_pattern) :: r360)
- | 408 -> One (S (N N_pattern) :: r363)
- | 873 -> One (S (N N_pattern) :: r704)
- | 875 -> One (S (N N_pattern) :: r705)
- | 877 -> One (S (N N_pattern) :: r706)
- | 884 -> One (S (N N_pattern) :: r708)
- | 1289 -> One (S (N N_pattern) :: r909)
+ | 396 | 604 -> One (S (N N_pattern) :: r193)
+ | 352 -> One (S (N N_pattern) :: r331)
+ | 390 -> One (S (N N_pattern) :: r358)
+ | 392 -> One (S (N N_pattern) :: r359)
+ | 408 -> One (S (N N_pattern) :: r368)
+ | 413 -> One (S (N N_pattern) :: r371)
+ | 878 -> One (S (N N_pattern) :: r709)
+ | 880 -> One (S (N N_pattern) :: r710)
+ | 882 -> One (S (N N_pattern) :: r711)
+ | 889 -> One (S (N N_pattern) :: r713)
+ | 1289 -> One (S (N N_pattern) :: r910)
| 207 -> One (S (N N_module_type) :: r201)
- | 460 -> One (S (N N_module_type) :: r409)
- | 500 -> One (S (N N_module_type) :: r440)
- | 502 -> One (S (N N_module_type) :: r441)
- | 528 -> One (S (N N_module_type) :: r449)
- | 1138 -> One (S (N N_module_type) :: r819)
- | 1221 -> One (S (N N_module_type) :: r867)
- | 1236 -> One (S (N N_module_type) :: r874)
- | 1239 -> One (S (N N_module_type) :: r876)
- | 1242 -> One (S (N N_module_type) :: r878)
- | 1247 -> One (S (N N_module_type) :: r880)
- | 1250 -> One (S (N N_module_type) :: r882)
- | 1253 -> One (S (N N_module_type) :: r884)
- | 1267 -> One (S (N N_module_type) :: r896)
+ | 507 -> One (S (N N_module_type) :: r448)
+ | 511 -> One (S (N N_module_type) :: r449)
+ | 535 -> One (S (N N_module_type) :: r457)
+ | 1135 -> One (S (N N_module_type) :: r820)
+ | 1218 -> One (S (N N_module_type) :: r868)
+ | 1236 -> One (S (N N_module_type) :: r875)
+ | 1239 -> One (S (N N_module_type) :: r877)
+ | 1242 -> One (S (N N_module_type) :: r879)
+ | 1247 -> One (S (N N_module_type) :: r881)
+ | 1250 -> One (S (N N_module_type) :: r883)
+ | 1253 -> One (S (N N_module_type) :: r885)
+ | 1267 -> One (S (N N_module_type) :: r897)
| 223 -> One (S (N N_module_expr) :: r219)
- | 565 -> One (S (N N_let_pattern) :: r508)
- | 248 -> One (S (N N_fun_expr) :: r243)
- | 540 -> One (S (N N_fun_expr) :: r457)
- | 544 -> One (S (N N_fun_expr) :: r468)
- | 593 -> One (S (N N_fun_expr) :: r517)
- | 644 -> One (S (N N_fun_expr) :: r559)
- | 673 -> One (S (N N_fun_expr) :: r579)
- | 689 -> One (S (N N_fun_expr) :: r585)
- | 695 -> One (S (N N_fun_expr) :: r589)
- | 704 -> One (S (N N_fun_expr) :: r593)
- | 715 -> One (S (N N_fun_expr) :: r599)
- | 721 -> One (S (N N_fun_expr) :: r603)
- | 727 -> One (S (N N_fun_expr) :: r607)
- | 733 -> One (S (N N_fun_expr) :: r611)
- | 739 -> One (S (N N_fun_expr) :: r615)
- | 745 -> One (S (N N_fun_expr) :: r619)
- | 751 -> One (S (N N_fun_expr) :: r623)
- | 757 -> One (S (N N_fun_expr) :: r627)
- | 763 -> One (S (N N_fun_expr) :: r631)
- | 769 -> One (S (N N_fun_expr) :: r635)
- | 775 -> One (S (N N_fun_expr) :: r639)
- | 781 -> One (S (N N_fun_expr) :: r643)
- | 787 -> One (S (N N_fun_expr) :: r647)
- | 793 -> One (S (N N_fun_expr) :: r651)
- | 799 -> One (S (N N_fun_expr) :: r655)
- | 805 -> One (S (N N_fun_expr) :: r659)
- | 811 -> One (S (N N_fun_expr) :: r663)
- | 817 -> One (S (N N_fun_expr) :: r667)
- | 823 -> One (S (N N_fun_expr) :: r671)
- | 829 -> One (S (N N_fun_expr) :: r675)
- | 920 -> One (S (N N_fun_expr) :: r727)
- | 929 -> One (S (N N_fun_expr) :: r734)
- | 938 -> One (S (N N_fun_expr) :: r741)
- | 948 -> One (S (N N_fun_expr) :: r745)
- | 957 -> One (S (N N_fun_expr) :: r749)
- | 966 -> One (S (N N_fun_expr) :: r753)
- | 977 -> One (S (N N_fun_expr) :: r757)
- | 986 -> One (S (N N_fun_expr) :: r761)
- | 995 -> One (S (N N_fun_expr) :: r765)
- | 1002 -> One (S (N N_fun_expr) :: r769)
- | 1086 -> One (S (N N_fun_expr) :: r791)
- | 1093 -> One (S (N N_fun_expr) :: r795)
- | 448 -> One (Sub (r3) :: r380)
- | 559 -> One (Sub (r3) :: r486)
- | 1291 -> One (Sub (r3) :: r910)
+ | 595 -> One (S (N N_let_pattern) :: r527)
+ | 250 -> One (S (N N_fun_expr) :: r246)
+ | 547 -> One (S (N N_fun_expr) :: r465)
+ | 623 -> One (S (N N_fun_expr) :: r536)
+ | 649 -> One (S (N N_fun_expr) :: r564)
+ | 678 -> One (S (N N_fun_expr) :: r584)
+ | 694 -> One (S (N N_fun_expr) :: r590)
+ | 700 -> One (S (N N_fun_expr) :: r594)
+ | 709 -> One (S (N N_fun_expr) :: r598)
+ | 720 -> One (S (N N_fun_expr) :: r604)
+ | 726 -> One (S (N N_fun_expr) :: r608)
+ | 732 -> One (S (N N_fun_expr) :: r612)
+ | 738 -> One (S (N N_fun_expr) :: r616)
+ | 744 -> One (S (N N_fun_expr) :: r620)
+ | 750 -> One (S (N N_fun_expr) :: r624)
+ | 756 -> One (S (N N_fun_expr) :: r628)
+ | 762 -> One (S (N N_fun_expr) :: r632)
+ | 768 -> One (S (N N_fun_expr) :: r636)
+ | 774 -> One (S (N N_fun_expr) :: r640)
+ | 780 -> One (S (N N_fun_expr) :: r644)
+ | 786 -> One (S (N N_fun_expr) :: r648)
+ | 792 -> One (S (N N_fun_expr) :: r652)
+ | 798 -> One (S (N N_fun_expr) :: r656)
+ | 804 -> One (S (N N_fun_expr) :: r660)
+ | 810 -> One (S (N N_fun_expr) :: r664)
+ | 816 -> One (S (N N_fun_expr) :: r668)
+ | 822 -> One (S (N N_fun_expr) :: r672)
+ | 828 -> One (S (N N_fun_expr) :: r676)
+ | 834 -> One (S (N N_fun_expr) :: r680)
+ | 925 -> One (S (N N_fun_expr) :: r732)
+ | 934 -> One (S (N N_fun_expr) :: r739)
+ | 943 -> One (S (N N_fun_expr) :: r746)
+ | 953 -> One (S (N N_fun_expr) :: r750)
+ | 962 -> One (S (N N_fun_expr) :: r754)
+ | 971 -> One (S (N N_fun_expr) :: r758)
+ | 982 -> One (S (N N_fun_expr) :: r762)
+ | 991 -> One (S (N N_fun_expr) :: r766)
+ | 1000 -> One (S (N N_fun_expr) :: r770)
+ | 1007 -> One (S (N N_fun_expr) :: r774)
+ | 1051 -> One (S (N N_fun_expr) :: r781)
+ | 1058 -> One (S (N N_fun_expr) :: r785)
+ | 242 -> One (Sub (r3) :: r237)
+ | 454 -> One (Sub (r3) :: r388)
+ | 589 -> One (Sub (r3) :: r505)
+ | 1291 -> One (Sub (r3) :: r911)
| 2 -> One (Sub (r13) :: r14)
| 55 -> One (Sub (r13) :: r15)
| 59 -> One (Sub (r13) :: r22)
| 168 -> One (Sub (r13) :: r147)
| 180 -> One (Sub (r13) :: r168)
- | 711 -> One (Sub (r13) :: r598)
- | 1287 -> One (Sub (r13) :: r908)
- | 1293 -> One (Sub (r13) :: r913)
- | 1671 -> One (Sub (r13) :: r1209)
- | 410 -> One (Sub (r24) :: r364)
- | 879 -> One (Sub (r24) :: r707)
- | 285 -> One (Sub (r26) :: r301)
- | 300 -> One (Sub (r26) :: r309)
- | 585 -> One (Sub (r26) :: r513)
- | 1180 -> One (Sub (r26) :: r851)
- | 290 -> One (Sub (r28) :: r308)
- | 1493 -> One (Sub (r28) :: r1079)
- | 283 -> One (Sub (r30) :: r300)
- | 327 -> One (Sub (r32) :: r320)
- | 479 -> One (Sub (r32) :: r434)
- | 258 -> One (Sub (r34) :: r265)
- | 405 -> One (Sub (r34) :: r362)
- | 440 -> One (Sub (r34) :: r375)
- | 482 -> One (Sub (r34) :: r437)
- | 567 -> One (Sub (r34) :: r509)
- | 628 -> One (Sub (r34) :: r547)
- | 653 -> One (Sub (r34) :: r570)
- | 657 -> One (Sub (r34) :: r571)
- | 866 -> One (Sub (r34) :: r701)
- | 1402 -> One (Sub (r34) :: r1022)
- | 1440 -> One (Sub (r34) :: r1053)
- | 1792 -> One (Sub (r34) :: r1255)
- | 1856 -> One (Sub (r34) :: r1265)
- | 1859 -> One (Sub (r34) :: r1266)
- | 1627 -> One (Sub (r36) :: r1170)
- | 1651 -> One (Sub (r36) :: r1181)
+ | 716 -> One (Sub (r13) :: r603)
+ | 1287 -> One (Sub (r13) :: r909)
+ | 1293 -> One (Sub (r13) :: r914)
+ | 1671 -> One (Sub (r13) :: r1210)
+ | 415 -> One (Sub (r24) :: r372)
+ | 884 -> One (Sub (r24) :: r712)
+ | 287 -> One (Sub (r26) :: r304)
+ | 302 -> One (Sub (r26) :: r312)
+ | 615 -> One (Sub (r26) :: r532)
+ | 1177 -> One (Sub (r26) :: r852)
+ | 292 -> One (Sub (r28) :: r311)
+ | 1493 -> One (Sub (r28) :: r1080)
+ | 285 -> One (Sub (r30) :: r303)
+ | 329 -> One (Sub (r32) :: r323)
+ | 484 -> One (Sub (r32) :: r440)
+ | 260 -> One (Sub (r34) :: r268)
+ | 410 -> One (Sub (r34) :: r370)
+ | 446 -> One (Sub (r34) :: r383)
+ | 487 -> One (Sub (r34) :: r443)
+ | 578 -> One (Sub (r34) :: r493)
+ | 597 -> One (Sub (r34) :: r528)
+ | 658 -> One (Sub (r34) :: r575)
+ | 662 -> One (Sub (r34) :: r576)
+ | 871 -> One (Sub (r34) :: r706)
+ | 1402 -> One (Sub (r34) :: r1023)
+ | 1440 -> One (Sub (r34) :: r1054)
+ | 1792 -> One (Sub (r34) :: r1256)
+ | 1856 -> One (Sub (r34) :: r1266)
+ | 1859 -> One (Sub (r34) :: r1267)
+ | 1627 -> One (Sub (r36) :: r1171)
+ | 1651 -> One (Sub (r36) :: r1182)
| 146 -> One (Sub (r59) :: r126)
- | 848 -> One (Sub (r59) :: r693)
- | 1972 -> One (Sub (r59) :: r1293)
- | 1330 -> One (Sub (r71) :: r946)
- | 355 -> One (Sub (r86) :: r336)
+ | 853 -> One (Sub (r59) :: r698)
+ | 1972 -> One (Sub (r59) :: r1294)
+ | 1330 -> One (Sub (r71) :: r947)
+ | 357 -> One (Sub (r86) :: r339)
| 152 -> One (Sub (r121) :: r127)
| 139 -> One (Sub (r123) :: r125)
- | 1394 -> One (Sub (r123) :: r1016)
+ | 1394 -> One (Sub (r123) :: r1017)
| 156 -> One (Sub (r129) :: r130)
- | 1868 -> One (Sub (r129) :: r1271)
- | 1882 -> One (Sub (r129) :: r1274)
- | 557 -> One (Sub (r172) :: r483)
- | 598 -> One (Sub (r172) :: r521)
+ | 1868 -> One (Sub (r129) :: r1272)
+ | 1882 -> One (Sub (r129) :: r1275)
+ | 587 -> One (Sub (r172) :: r502)
+ | 628 -> One (Sub (r172) :: r540)
| 186 -> One (Sub (r180) :: r181)
- | 543 -> One (Sub (r180) :: r466)
- | 606 -> One (Sub (r180) :: r534)
- | 635 -> One (Sub (r180) :: r551)
- | 664 -> One (Sub (r180) :: r573)
- | 914 -> One (Sub (r180) :: r726)
- | 1273 -> One (Sub (r195) :: r900)
- | 1356 -> One (Sub (r195) :: r976)
- | 1029 -> One (Sub (r245) :: r775)
- | 249 -> One (Sub (r247) :: r250)
- | 253 -> One (Sub (r262) :: r264)
- | 320 -> One (Sub (r267) :: r314)
- | 264 -> One (Sub (r269) :: r276)
- | 278 -> One (Sub (r269) :: r299)
- | 265 -> One (Sub (r282) :: r284)
- | 266 -> One (Sub (r286) :: r287)
- | 302 -> One (Sub (r286) :: r310)
- | 1853 -> One (Sub (r286) :: r1264)
- | 268 -> One (Sub (r293) :: r295)
- | 508 -> One (Sub (r293) :: r445)
- | 1353 -> One (Sub (r293) :: r971)
- | 343 -> One (Sub (r325) :: r327)
- | 578 -> One (Sub (r331) :: r512)
- | 366 -> One (Sub (r339) :: r340)
- | 390 -> One (Sub (r353) :: r356)
- | 575 -> One (Sub (r353) :: r511)
- | 841 -> One (Sub (r353) :: r688)
- | 1628 -> One (Sub (r353) :: r1175)
- | 1652 -> One (Sub (r353) :: r1186)
- | 438 -> One (Sub (r372) :: r374)
- | 446 -> One (Sub (r372) :: r379)
- | 512 -> One (Sub (r425) :: r446)
- | 471 -> One (Sub (r427) :: r428)
- | 541 -> One (Sub (r463) :: r465)
- | 1046 -> One (Sub (r463) :: r785)
- | 563 -> One (Sub (r504) :: r505)
- | 1043 -> One (Sub (r781) :: r783)
- | 1145 -> One (Sub (r810) :: r820)
- | 1156 -> One (Sub (r829) :: r830)
- | 1157 -> One (Sub (r838) :: r840)
- | 1542 -> One (Sub (r838) :: r1108)
- | 1562 -> One (Sub (r838) :: r1116)
- | 1570 -> One (Sub (r838) :: r1118)
- | 1861 -> One (Sub (r838) :: r1268)
- | 1809 -> One (Sub (r930) :: r1257)
- | 1821 -> One (Sub (r930) :: r1259)
- | 1377 -> One (Sub (r958) :: r987)
- | 1370 -> One (Sub (r984) :: r986)
- | 1713 -> One (Sub (r996) :: r1229)
- | 1737 -> One (Sub (r996) :: r1238)
- | 1682 -> One (Sub (r1048) :: r1216)
- | 1669 -> One (Sub (r1120) :: r1199)
- | 1741 -> One (Sub (r1123) :: r1239)
- | 1593 -> One (Sub (r1141) :: r1143)
- | 1621 -> One (Sub (r1161) :: r1163)
- | 688 -> One (r0)
- | 687 -> One (r2)
+ | 241 -> One (Sub (r180) :: r235)
+ | 556 -> One (Sub (r180) :: r480)
+ | 640 -> One (Sub (r180) :: r556)
+ | 669 -> One (Sub (r180) :: r578)
+ | 919 -> One (Sub (r180) :: r731)
+ | 1273 -> One (Sub (r195) :: r901)
+ | 1356 -> One (Sub (r195) :: r977)
+ | 1071 -> One (Sub (r248) :: r791)
+ | 251 -> One (Sub (r250) :: r253)
+ | 255 -> One (Sub (r265) :: r267)
+ | 322 -> One (Sub (r270) :: r317)
+ | 266 -> One (Sub (r272) :: r279)
+ | 280 -> One (Sub (r272) :: r302)
+ | 267 -> One (Sub (r285) :: r287)
+ | 268 -> One (Sub (r289) :: r290)
+ | 304 -> One (Sub (r289) :: r313)
+ | 1853 -> One (Sub (r289) :: r1265)
+ | 270 -> One (Sub (r296) :: r298)
+ | 517 -> One (Sub (r296) :: r453)
+ | 1353 -> One (Sub (r296) :: r972)
+ | 345 -> One (Sub (r328) :: r330)
+ | 608 -> One (Sub (r334) :: r531)
+ | 368 -> One (Sub (r342) :: r343)
+ | 379 -> One (Sub (r352) :: r355)
+ | 397 -> One (Sub (r362) :: r365)
+ | 605 -> One (Sub (r362) :: r530)
+ | 846 -> One (Sub (r362) :: r693)
+ | 1628 -> One (Sub (r362) :: r1176)
+ | 1652 -> One (Sub (r362) :: r1187)
+ | 444 -> One (Sub (r380) :: r382)
+ | 452 -> One (Sub (r380) :: r387)
+ | 521 -> One (Sub (r431) :: r454)
+ | 476 -> One (Sub (r433) :: r434)
+ | 548 -> One (Sub (r471) :: r473)
+ | 1088 -> One (Sub (r471) :: r801)
+ | 593 -> One (Sub (r523) :: r524)
+ | 1085 -> One (Sub (r797) :: r799)
+ | 1142 -> One (Sub (r811) :: r821)
+ | 1153 -> One (Sub (r830) :: r831)
+ | 1154 -> One (Sub (r839) :: r841)
+ | 1542 -> One (Sub (r839) :: r1109)
+ | 1562 -> One (Sub (r839) :: r1117)
+ | 1570 -> One (Sub (r839) :: r1119)
+ | 1861 -> One (Sub (r839) :: r1269)
+ | 1809 -> One (Sub (r931) :: r1258)
+ | 1821 -> One (Sub (r931) :: r1260)
+ | 1377 -> One (Sub (r959) :: r988)
+ | 1370 -> One (Sub (r985) :: r987)
+ | 1713 -> One (Sub (r997) :: r1230)
+ | 1737 -> One (Sub (r997) :: r1239)
+ | 1682 -> One (Sub (r1049) :: r1217)
+ | 1669 -> One (Sub (r1121) :: r1200)
+ | 1741 -> One (Sub (r1124) :: r1240)
+ | 1593 -> One (Sub (r1142) :: r1144)
+ | 1621 -> One (Sub (r1162) :: r1164)
+ | 693 -> One (r0)
+ | 692 -> One (r2)
| 1903 -> One (r4)
| 1902 -> One (r5)
| 1901 -> One (r6)
@@ -2511,12 +2512,12 @@ let recover =
| 1898 -> One (r20)
| 1897 -> One (r21)
| 60 -> One (r22)
- | 107 | 247 | 542 | 1060 -> One (r23)
+ | 107 | 249 | 549 | 1102 -> One (r23)
| 110 -> One (r25)
- | 299 -> One (r27)
- | 282 -> One (r29)
- | 305 -> One (r31)
- | 309 -> One (r33)
+ | 301 -> One (r27)
+ | 284 -> One (r29)
+ | 307 -> One (r31)
+ | 311 -> One (r33)
| 1314 -> One (r35)
| 1896 -> One (r37)
| 1895 -> One (r38)
@@ -2556,9 +2557,9 @@ let recover =
| 1827 -> One (r76)
| 1826 -> One (r77)
| 164 -> One (r83)
- | 293 -> One (r85)
- | 358 -> One (r87)
- | 1195 -> One (r89)
+ | 295 -> One (r85)
+ | 360 -> One (r87)
+ | 1192 -> One (r89)
| 1569 -> One (r91)
| 1568 -> One (r92)
| 1567 | 1820 -> One (r93)
@@ -2587,15 +2588,15 @@ let recover =
| 1545 -> One (r128)
| 1867 -> One (r130)
| 1864 -> One (r131)
- | 1153 -> One (r132)
- | 1152 -> One (r133)
+ | 1150 -> One (r132)
+ | 1149 -> One (r133)
| 161 -> One (r134)
| 1850 -> One (r135)
| 1849 -> One (r136)
| 1848 -> One (r137)
| 163 -> One (r138)
| 1845 -> One (r139)
- | 1169 -> One (r140)
+ | 1166 -> One (r140)
| 1837 -> One (r142)
| 1836 -> One (r143)
| 167 -> One (r144)
@@ -2618,16 +2619,16 @@ let recover =
| 1802 -> One (r166)
| 1801 -> One (r167)
| 181 -> One (r168)
- | 1077 -> One (r169)
- | 1075 -> One (r170)
- | 558 -> One (r171)
- | 600 -> One (r173)
+ | 1042 -> One (r169)
+ | 1040 -> One (r170)
+ | 588 -> One (r171)
+ | 630 -> One (r173)
| 1800 -> One (r175)
| 1799 -> One (r176)
| 1798 -> One (r177)
| 184 -> One (r178)
| 183 -> One (r179)
- | 1215 -> One (r181)
+ | 1212 -> One (r181)
| 1797 -> One (r182)
| 1796 -> One (r183)
| 1795 -> One (r184)
@@ -2638,8 +2639,8 @@ let recover =
| 191 -> One (r189)
| 193 -> One (r190)
| 196 -> One (r191)
- | 402 -> One (r192)
- | 401 -> One (r193)
+ | 407 -> One (r192)
+ | 406 -> One (r193)
| 203 -> One (r194)
| 206 -> One (r196)
| 205 -> One (r197)
@@ -2663,8 +2664,8 @@ let recover =
| 1256 -> One (r215)
| 222 -> One (r216)
| 221 -> One (r217)
- | 527 -> One (r218)
- | 526 -> One (r219)
+ | 534 -> One (r218)
+ | 533 -> One (r219)
| 1246 -> One (r220)
| 1245 -> One (r221)
| 225 -> One (r222)
@@ -2681,1010 +2682,1010 @@ let recover =
| 1230 -> One (r235)
| 1229 -> One (r236)
| 1228 -> One (r237)
- | 243 -> One (r238)
- | 242 -> One (r239)
+ | 1227 -> One (r238)
+ | 1226 -> One (r239)
| 1225 -> One (r240)
- | 1224 -> One (r241)
- | 1212 -> One (r242)
- | 1211 -> One (r243)
- | 436 -> One (r244)
- | 1031 -> One (r246)
- | 1028 -> One (r248)
- | 1027 -> One (r249)
- | 1026 -> One (r250)
- | 433 -> One (r251)
- | 252 -> One (r252)
- | 422 -> One (r253)
- | 421 -> One (r255)
- | 420 -> One (r256)
- | 254 -> One (r257)
- | 427 -> One (r259)
- | 349 -> One (r260)
- | 257 -> One (r261)
- | 256 -> One (r263)
- | 255 -> One (r264)
- | 348 -> One (r265)
- | 332 -> One (r266)
- | 317 -> One (r268)
- | 342 -> One (r270)
- | 341 -> One (r271)
- | 261 -> One (r272)
- | 263 -> One (r273)
- | 262 -> One (r274)
- | 340 -> One (r275)
- | 339 -> One (r276)
- | 280 -> One (r277)
- | 279 -> One (r278)
- | 331 -> One (r280)
- | 322 -> One (r281)
- | 334 -> One (r283)
- | 333 -> One (r284)
- | 276 | 1496 -> One (r285)
- | 277 -> One (r287)
- | 275 -> One (r288)
- | 274 -> One (r289)
- | 267 -> One (r290)
- | 273 -> One (r292)
- | 270 -> One (r294)
- | 269 -> One (r295)
- | 272 -> One (r296)
- | 271 -> One (r297)
- | 319 -> One (r298)
- | 318 -> One (r299)
- | 315 -> One (r300)
- | 314 -> One (r301)
- | 313 -> One (r304)
- | 294 -> One (r306)
- | 292 -> One (r307)
- | 291 -> One (r308)
- | 301 -> One (r309)
- | 303 -> One (r310)
- | 307 -> One (r311)
- | 312 -> One (r312)
- | 311 -> One (r313)
- | 321 -> One (r314)
- | 330 -> One (r315)
- | 329 -> One (r317)
- | 326 -> One (r318)
- | 325 -> One (r319)
- | 328 -> One (r320)
- | 338 -> One (r321)
- | 337 -> One (r322)
- | 336 -> One (r323)
- | 347 -> One (r324)
- | 345 -> One (r326)
- | 344 -> One (r327)
- | 426 -> One (r328)
- | 362 | 865 -> One (r330)
- | 363 -> One (r332)
- | 353 -> One (r333)
- | 352 -> One (r334)
- | 354 -> One (r335)
- | 356 -> One (r336)
- | 368 -> One (r338)
- | 367 -> One (r340)
- | 419 -> One (r341)
- | 418 -> One (r342)
- | 371 -> One (r343)
- | 373 -> One (r344)
- | 413 -> One (r345)
- | 376 -> One (r346)
+ | 245 -> One (r241)
+ | 244 -> One (r242)
+ | 1222 -> One (r243)
+ | 1221 -> One (r244)
+ | 1209 -> One (r245)
+ | 1208 -> One (r246)
+ | 442 -> One (r247)
+ | 1073 -> One (r249)
+ | 1070 -> One (r251)
+ | 1069 -> One (r252)
+ | 1068 -> One (r253)
+ | 439 -> One (r254)
+ | 254 -> One (r255)
+ | 428 -> One (r256)
+ | 427 -> One (r258)
+ | 426 -> One (r259)
+ | 256 -> One (r260)
+ | 433 -> One (r262)
+ | 351 -> One (r263)
+ | 259 -> One (r264)
+ | 258 -> One (r266)
+ | 257 -> One (r267)
+ | 350 -> One (r268)
+ | 334 -> One (r269)
+ | 319 -> One (r271)
+ | 344 -> One (r273)
+ | 343 -> One (r274)
+ | 263 -> One (r275)
+ | 265 -> One (r276)
+ | 264 -> One (r277)
+ | 342 -> One (r278)
+ | 341 -> One (r279)
+ | 282 -> One (r280)
+ | 281 -> One (r281)
+ | 333 -> One (r283)
+ | 324 -> One (r284)
+ | 336 -> One (r286)
+ | 335 -> One (r287)
+ | 278 | 1496 -> One (r288)
+ | 279 -> One (r290)
+ | 277 -> One (r291)
+ | 276 -> One (r292)
+ | 269 -> One (r293)
+ | 275 -> One (r295)
+ | 272 -> One (r297)
+ | 271 -> One (r298)
+ | 274 -> One (r299)
+ | 273 -> One (r300)
+ | 321 -> One (r301)
+ | 320 -> One (r302)
+ | 317 -> One (r303)
+ | 316 -> One (r304)
+ | 315 -> One (r307)
+ | 296 -> One (r309)
+ | 294 -> One (r310)
+ | 293 -> One (r311)
+ | 303 -> One (r312)
+ | 305 -> One (r313)
+ | 309 -> One (r314)
+ | 314 -> One (r315)
+ | 313 -> One (r316)
+ | 323 -> One (r317)
+ | 332 -> One (r318)
+ | 331 -> One (r320)
+ | 328 -> One (r321)
+ | 327 -> One (r322)
+ | 330 -> One (r323)
+ | 340 -> One (r324)
+ | 339 -> One (r325)
+ | 338 -> One (r326)
+ | 349 -> One (r327)
+ | 347 -> One (r329)
+ | 346 -> One (r330)
+ | 432 -> One (r331)
+ | 364 | 870 -> One (r333)
+ | 365 -> One (r335)
+ | 355 -> One (r336)
+ | 354 -> One (r337)
+ | 356 -> One (r338)
+ | 358 -> One (r339)
+ | 370 -> One (r341)
+ | 369 -> One (r343)
+ | 425 -> One (r344)
+ | 424 -> One (r345)
+ | 373 -> One (r346)
| 375 -> One (r347)
- | 381 -> One (r348)
- | 383 -> One (r349)
- | 386 -> One (r350)
- | 412 -> One (r351)
- | 391 -> One (r352)
- | 395 -> One (r354)
- | 394 -> One (r355)
- | 393 -> One (r356)
- | 397 -> One (r357)
- | 400 -> One (r358)
- | 399 -> One (r359)
- | 404 -> One (r360)
- | 407 -> One (r361)
- | 406 -> One (r362)
- | 409 -> One (r363)
- | 411 -> One (r364)
- | 415 -> One (r365)
- | 414 -> One (r366)
- | 417 -> One (r367)
- | 431 -> One (r368)
- | 435 -> One (r369)
- | 444 -> One (r370)
- | 439 -> One (r371)
- | 443 -> One (r373)
- | 442 -> One (r374)
- | 441 -> One (r375)
- | 1205 -> One (r376)
- | 1204 -> One (r377)
- | 1203 -> One (r378)
- | 447 -> One (r379)
- | 1202 -> One (r380)
- | 1131 -> One (r381)
- | 1130 -> One (r382)
- | 1129 -> One (r383)
- | 1128 -> One (r384)
- | 1127 -> One (r385)
- | 450 -> One (r386)
- | 837 -> One (r387)
- | 1201 -> One (r389)
- | 1200 -> One (r390)
- | 1199 -> One (r391)
- | 1197 -> One (r392)
- | 1196 -> One (r393)
- | 1756 -> One (r394)
- | 1126 -> One (r395)
- | 536 -> One (r396)
- | 535 -> One (r397)
- | 453 -> One (r398)
- | 452 -> One (r399)
- | 523 -> One (r400)
- | 521 -> One (r401)
- | 520 -> One (r402)
- | 455 -> One (r403)
- | 457 -> One (r404)
- | 519 -> One (r405)
- | 518 -> One (r406)
- | 459 -> One (r407)
- | 517 -> One (r408)
- | 516 -> One (r409)
- | 515 -> One (r410)
- | 462 -> One (r411)
- | 470 -> One (r412)
- | 468 -> One (r413)
- | 467 -> One (r414)
- | 464 -> One (r415)
- | 498 -> One (r416)
- | 497 -> One (r418)
- | 491 -> One (r420)
- | 490 -> One (r421)
- | 489 -> One (r422)
- | 488 -> One (r423)
- | 487 -> One (r424)
- | 510 -> One (r426)
- | 511 -> One (r428)
- | 478 -> One (r429)
- | 477 -> One (r430)
- | 474 -> One (r431)
- | 473 -> One (r432)
- | 481 -> One (r433)
- | 480 -> One (r434)
- | 485 -> One (r435)
- | 484 -> One (r436)
- | 483 -> One (r437)
- | 496 -> One (r438)
- | 501 -> One (r440)
- | 503 -> One (r441)
- | 506 -> One (r442)
- | 505 -> One (r443)
- | 507 | 1970 -> One (r444)
- | 509 -> One (r445)
- | 513 -> One (r446)
- | 525 -> One (r447)
- | 530 -> One (r448)
- | 529 -> One (r449)
- | 904 -> One (r450)
- | 1125 -> One (r452)
- | 1124 -> One (r453)
- | 1121 -> One (r454)
- | 1118 -> One (r455)
- | 539 -> One (r456)
- | 1117 -> One (r457)
- | 1052 -> One (r458)
- | 1051 -> One (r459)
- | 1050 -> One (r460)
- | 1055 -> One (r462)
- | 1112 -> One (r464)
- | 1111 -> One (r465)
- | 1110 -> One (r466)
- | 1109 -> One (r467)
- | 1108 -> One (r468)
- | 1102 -> One (r469)
- | 547 -> One (r470)
- | 546 -> One (r471)
- | 1099 -> One (r472)
- | 550 -> One (r473)
- | 549 -> One (r474)
- | 1092 -> One (r475)
- | 1081 -> One (r476)
- | 1080 -> One (r477)
- | 553 -> One (r478)
- | 552 -> One (r479)
- | 1079 -> One (r480)
- | 556 -> One (r481)
- | 555 -> One (r482)
- | 1078 -> One (r483)
- | 1074 -> One (r484)
- | 1073 -> One (r485)
- | 1072 -> One (r486)
- | 580 -> One (r487)
- | 582 -> One (r489)
- | 864 -> One (r491)
- | 581 -> One (r493)
- | 862 -> One (r495)
- | 1071 -> One (r497)
- | 588 -> One (r498)
- | 587 -> One (r499)
- | 584 -> One (r500)
- | 562 -> One (r501)
- | 561 -> One (r502)
- | 564 -> One (r503)
- | 573 -> One (r505)
- | 571 -> One (r506)
- | 570 -> One (r507)
- | 569 -> One (r508)
- | 568 -> One (r509)
- | 577 -> One (r510)
- | 576 -> One (r511)
- | 579 -> One (r512)
- | 586 -> One (r513)
- | 592 -> One (r514)
- | 591 -> One (r515)
- | 590 -> One (r516)
- | 1070 -> One (r517)
- | 597 -> One (r518)
- | 596 -> One (r519)
- | 595 -> One (r520)
- | 599 -> One (r521)
- | 1064 -> One (r522)
- | 1069 -> One (r524)
- | 1068 -> One (r525)
- | 1067 -> One (r526)
- | 1066 -> One (r527)
- | 1065 -> One (r528)
- | 1062 -> One (r529)
- | 605 -> One (r530)
- | 604 -> One (r531)
- | 603 -> One (r532)
- | 602 -> One (r533)
- | 609 -> One (r534)
- | 614 -> One (r535)
- | 613 -> One (r536)
- | 612 | 1059 -> One (r537)
- | 1058 -> One (r538)
- | 623 -> One (r539)
- | 622 -> One (r540)
- | 621 -> One (r541)
- | 620 -> One (r542)
- | 619 -> One (r543)
- | 618 -> One (r544)
- | 1022 -> One (r545)
- | 630 -> One (r546)
- | 629 -> One (r547)
- | 634 -> One (r548)
- | 633 -> One (r549)
- | 632 -> One (r550)
- | 636 -> One (r551)
- | 919 | 1015 -> One (r552)
- | 918 | 1014 -> One (r553)
- | 638 | 917 -> One (r554)
- | 637 | 916 -> One (r555)
- | 642 -> One (r556)
- | 641 -> One (r557)
- | 640 -> One (r558)
- | 1012 -> One (r559)
- | 648 -> One (r560)
+ | 419 -> One (r348)
+ | 378 -> One (r349)
+ | 377 -> One (r350)
+ | 380 | 577 -> One (r351)
+ | 383 -> One (r353)
+ | 382 -> One (r354)
+ | 381 -> One (r355)
+ | 386 -> One (r356)
+ | 418 -> One (r357)
+ | 391 -> One (r358)
+ | 393 -> One (r359)
+ | 417 -> One (r360)
+ | 398 -> One (r361)
+ | 402 -> One (r363)
+ | 401 -> One (r364)
+ | 400 -> One (r365)
+ | 405 -> One (r366)
+ | 404 -> One (r367)
+ | 409 -> One (r368)
+ | 412 -> One (r369)
+ | 411 -> One (r370)
+ | 414 -> One (r371)
+ | 416 -> One (r372)
+ | 421 -> One (r373)
+ | 420 -> One (r374)
+ | 423 -> One (r375)
+ | 437 -> One (r376)
+ | 441 -> One (r377)
+ | 450 -> One (r378)
+ | 445 -> One (r379)
+ | 449 -> One (r381)
+ | 448 -> One (r382)
+ | 447 -> One (r383)
+ | 1202 -> One (r384)
+ | 1201 -> One (r385)
+ | 1200 -> One (r386)
+ | 453 -> One (r387)
+ | 1199 -> One (r388)
+ | 1128 -> One (r389)
+ | 1127 -> One (r390)
+ | 1126 -> One (r391)
+ | 1125 -> One (r392)
+ | 1124 -> One (r393)
+ | 456 -> One (r394)
+ | 842 -> One (r395)
+ | 1198 -> One (r397)
+ | 1197 -> One (r398)
+ | 1196 -> One (r399)
+ | 1194 -> One (r400)
+ | 1193 -> One (r401)
+ | 1756 -> One (r402)
+ | 1123 -> One (r403)
+ | 543 -> One (r404)
+ | 542 -> One (r405)
+ | 459 -> One (r406)
+ | 458 -> One (r407)
+ | 530 -> One (r408)
+ | 528 -> One (r409)
+ | 527 -> One (r410)
+ | 461 -> One (r411)
+ | 463 -> One (r412)
+ | 526 -> One (r413)
+ | 525 -> One (r414)
+ | 465 -> One (r415)
+ | 524 -> One (r416)
+ | 523 -> One (r417)
+ | 475 -> One (r418)
+ | 473 -> One (r419)
+ | 472 -> One (r420)
+ | 469 -> One (r421)
+ | 503 -> One (r422)
+ | 502 -> One (r424)
+ | 496 -> One (r426)
+ | 495 -> One (r427)
+ | 494 -> One (r428)
+ | 493 -> One (r429)
+ | 492 -> One (r430)
+ | 519 -> One (r432)
+ | 520 -> One (r434)
+ | 483 -> One (r435)
+ | 482 -> One (r436)
+ | 479 -> One (r437)
+ | 478 -> One (r438)
+ | 486 -> One (r439)
+ | 485 -> One (r440)
+ | 490 -> One (r441)
+ | 489 -> One (r442)
+ | 488 -> One (r443)
+ | 501 -> One (r444)
+ | 506 -> One (r446)
+ | 505 -> One (r447)
+ | 508 -> One (r448)
+ | 512 -> One (r449)
+ | 515 -> One (r450)
+ | 514 -> One (r451)
+ | 516 | 1970 -> One (r452)
+ | 518 -> One (r453)
+ | 522 -> One (r454)
+ | 532 -> One (r455)
+ | 537 -> One (r456)
+ | 536 -> One (r457)
+ | 909 -> One (r458)
+ | 1122 -> One (r460)
+ | 1121 -> One (r461)
+ | 1118 -> One (r462)
+ | 1115 -> One (r463)
+ | 546 -> One (r464)
+ | 1114 -> One (r465)
+ | 1094 -> One (r466)
+ | 1093 -> One (r467)
+ | 1092 -> One (r468)
+ | 1097 -> One (r470)
+ | 1109 -> One (r472)
+ | 1108 -> One (r473)
+ | 1105 -> One (r474)
+ | 552 -> One (r475)
+ | 551 -> One (r476)
+ | 1104 -> One (r477)
+ | 555 -> One (r478)
+ | 554 -> One (r479)
+ | 559 -> One (r480)
+ | 564 -> One (r481)
+ | 563 -> One (r482)
+ | 562 | 1101 -> One (r483)
+ | 1100 -> One (r484)
+ | 573 -> One (r485)
+ | 572 -> One (r486)
+ | 571 -> One (r487)
+ | 570 -> One (r488)
+ | 569 -> One (r489)
+ | 568 -> One (r490)
+ | 1064 -> One (r491)
+ | 580 -> One (r492)
+ | 579 -> One (r493)
+ | 1057 -> One (r494)
+ | 1046 -> One (r495)
+ | 1045 -> One (r496)
+ | 583 -> One (r497)
+ | 582 -> One (r498)
+ | 1044 -> One (r499)
+ | 586 -> One (r500)
+ | 585 -> One (r501)
+ | 1043 -> One (r502)
+ | 1039 -> One (r503)
+ | 1038 -> One (r504)
+ | 1037 -> One (r505)
+ | 610 -> One (r506)
+ | 612 -> One (r508)
+ | 869 -> One (r510)
+ | 611 -> One (r512)
+ | 867 -> One (r514)
+ | 1036 -> One (r516)
+ | 618 -> One (r517)
+ | 617 -> One (r518)
+ | 614 -> One (r519)
+ | 592 -> One (r520)
+ | 591 -> One (r521)
+ | 594 -> One (r522)
+ | 603 -> One (r524)
+ | 601 -> One (r525)
+ | 600 -> One (r526)
+ | 599 -> One (r527)
+ | 598 -> One (r528)
+ | 607 -> One (r529)
+ | 606 -> One (r530)
+ | 609 -> One (r531)
+ | 616 -> One (r532)
+ | 622 -> One (r533)
+ | 621 -> One (r534)
+ | 620 -> One (r535)
+ | 1035 -> One (r536)
+ | 627 -> One (r537)
+ | 626 -> One (r538)
+ | 625 -> One (r539)
+ | 629 -> One (r540)
+ | 1029 -> One (r541)
+ | 1034 -> One (r543)
+ | 1033 -> One (r544)
+ | 1032 -> One (r545)
+ | 1031 -> One (r546)
+ | 1030 -> One (r547)
+ | 1027 -> One (r548)
+ | 635 -> One (r549)
+ | 634 -> One (r550)
+ | 633 -> One (r551)
+ | 632 -> One (r552)
+ | 639 -> One (r553)
+ | 638 -> One (r554)
+ | 637 -> One (r555)
+ | 641 -> One (r556)
+ | 924 | 1020 -> One (r557)
+ | 923 | 1019 -> One (r558)
+ | 643 | 922 -> One (r559)
+ | 642 | 921 -> One (r560)
| 647 -> One (r561)
| 646 -> One (r562)
- | 661 -> One (r563)
- | 656 -> One (r564)
- | 655 | 840 -> One (r565)
- | 660 -> One (r567)
- | 659 -> One (r568)
- | 652 -> One (r569)
- | 654 -> One (r570)
- | 658 -> One (r571)
- | 663 -> One (r572)
- | 665 -> One (r573)
- | 667 -> One (r574)
- | 671 | 947 -> One (r575)
- | 670 | 946 -> One (r576)
- | 669 | 945 -> One (r577)
- | 668 | 944 -> One (r578)
- | 892 -> One (r579)
- | 677 -> One (r580)
- | 676 -> One (r581)
- | 675 -> One (r582)
- | 686 -> One (r583)
- | 685 -> One (r584)
- | 694 -> One (r585)
- | 693 -> One (r586)
- | 692 -> One (r587)
+ | 645 -> One (r563)
+ | 1017 -> One (r564)
+ | 653 -> One (r565)
+ | 652 -> One (r566)
+ | 651 -> One (r567)
+ | 666 -> One (r568)
+ | 661 -> One (r569)
+ | 660 | 845 -> One (r570)
+ | 665 -> One (r572)
+ | 664 -> One (r573)
+ | 657 -> One (r574)
+ | 659 -> One (r575)
+ | 663 -> One (r576)
+ | 668 -> One (r577)
+ | 670 -> One (r578)
+ | 672 -> One (r579)
+ | 676 | 952 -> One (r580)
+ | 675 | 951 -> One (r581)
+ | 674 | 950 -> One (r582)
+ | 673 | 949 -> One (r583)
+ | 897 -> One (r584)
+ | 682 -> One (r585)
+ | 681 -> One (r586)
+ | 680 -> One (r587)
| 691 -> One (r588)
- | 700 -> One (r589)
+ | 690 -> One (r589)
| 699 -> One (r590)
| 698 -> One (r591)
| 697 -> One (r592)
- | 709 -> One (r593)
- | 708 -> One (r594)
- | 707 -> One (r595)
- | 706 -> One (r596)
- | 713 -> One (r597)
- | 712 -> One (r598)
- | 720 -> One (r599)
- | 719 -> One (r600)
- | 718 -> One (r601)
- | 717 -> One (r602)
- | 726 -> One (r603)
+ | 696 -> One (r593)
+ | 705 -> One (r594)
+ | 704 -> One (r595)
+ | 703 -> One (r596)
+ | 702 -> One (r597)
+ | 714 -> One (r598)
+ | 713 -> One (r599)
+ | 712 -> One (r600)
+ | 711 -> One (r601)
+ | 718 -> One (r602)
+ | 717 -> One (r603)
| 725 -> One (r604)
| 724 -> One (r605)
| 723 -> One (r606)
- | 732 -> One (r607)
+ | 722 -> One (r607)
| 731 -> One (r608)
| 730 -> One (r609)
| 729 -> One (r610)
- | 738 -> One (r611)
+ | 728 -> One (r611)
| 737 -> One (r612)
| 736 -> One (r613)
| 735 -> One (r614)
- | 744 -> One (r615)
+ | 734 -> One (r615)
| 743 -> One (r616)
| 742 -> One (r617)
| 741 -> One (r618)
- | 750 -> One (r619)
+ | 740 -> One (r619)
| 749 -> One (r620)
| 748 -> One (r621)
| 747 -> One (r622)
- | 756 -> One (r623)
+ | 746 -> One (r623)
| 755 -> One (r624)
| 754 -> One (r625)
| 753 -> One (r626)
- | 762 -> One (r627)
+ | 752 -> One (r627)
| 761 -> One (r628)
| 760 -> One (r629)
| 759 -> One (r630)
- | 768 -> One (r631)
+ | 758 -> One (r631)
| 767 -> One (r632)
| 766 -> One (r633)
| 765 -> One (r634)
- | 774 -> One (r635)
+ | 764 -> One (r635)
| 773 -> One (r636)
| 772 -> One (r637)
| 771 -> One (r638)
- | 780 -> One (r639)
+ | 770 -> One (r639)
| 779 -> One (r640)
| 778 -> One (r641)
| 777 -> One (r642)
- | 786 -> One (r643)
+ | 776 -> One (r643)
| 785 -> One (r644)
| 784 -> One (r645)
| 783 -> One (r646)
- | 792 -> One (r647)
+ | 782 -> One (r647)
| 791 -> One (r648)
| 790 -> One (r649)
| 789 -> One (r650)
- | 798 -> One (r651)
+ | 788 -> One (r651)
| 797 -> One (r652)
| 796 -> One (r653)
| 795 -> One (r654)
- | 804 -> One (r655)
+ | 794 -> One (r655)
| 803 -> One (r656)
| 802 -> One (r657)
| 801 -> One (r658)
- | 810 -> One (r659)
+ | 800 -> One (r659)
| 809 -> One (r660)
| 808 -> One (r661)
| 807 -> One (r662)
- | 816 -> One (r663)
+ | 806 -> One (r663)
| 815 -> One (r664)
| 814 -> One (r665)
| 813 -> One (r666)
- | 822 -> One (r667)
+ | 812 -> One (r667)
| 821 -> One (r668)
| 820 -> One (r669)
| 819 -> One (r670)
- | 828 -> One (r671)
+ | 818 -> One (r671)
| 827 -> One (r672)
| 826 -> One (r673)
| 825 -> One (r674)
- | 834 -> One (r675)
+ | 824 -> One (r675)
| 833 -> One (r676)
| 832 -> One (r677)
| 831 -> One (r678)
- | 890 -> One (r679)
- | 887 -> One (r680)
- | 836 -> One (r681)
- | 839 -> One (r682)
- | 838 -> One (r683)
- | 846 -> One (r684)
- | 845 -> One (r685)
- | 844 -> One (r686)
- | 843 -> One (r687)
- | 842 -> One (r688)
- | 853 -> One (r689)
- | 852 -> One (r690)
- | 851 -> One (r691)
- | 850 -> One (r692)
- | 849 -> One (r693)
- | 856 -> One (r694)
- | 855 -> One (r695)
- | 863 -> One (r696)
- | 861 -> One (r697)
- | 860 -> One (r698)
- | 869 -> One (r699)
- | 868 -> One (r700)
- | 867 -> One (r701)
- | 872 -> One (r702)
- | 871 -> One (r703)
+ | 830 -> One (r679)
+ | 839 -> One (r680)
+ | 838 -> One (r681)
+ | 837 -> One (r682)
+ | 836 -> One (r683)
+ | 895 -> One (r684)
+ | 892 -> One (r685)
+ | 841 -> One (r686)
+ | 844 -> One (r687)
+ | 843 -> One (r688)
+ | 851 -> One (r689)
+ | 850 -> One (r690)
+ | 849 -> One (r691)
+ | 848 -> One (r692)
+ | 847 -> One (r693)
+ | 858 -> One (r694)
+ | 857 -> One (r695)
+ | 856 -> One (r696)
+ | 855 -> One (r697)
+ | 854 -> One (r698)
+ | 861 -> One (r699)
+ | 860 -> One (r700)
+ | 868 -> One (r701)
+ | 866 -> One (r702)
+ | 865 -> One (r703)
| 874 -> One (r704)
- | 876 -> One (r705)
- | 878 -> One (r706)
- | 880 -> One (r707)
- | 885 -> One (r708)
- | 889 -> One (r709)
- | 895 | 956 -> One (r710)
- | 894 | 955 -> One (r711)
- | 893 | 954 -> One (r712)
- | 898 | 965 -> One (r713)
- | 897 | 964 -> One (r714)
- | 896 | 963 -> One (r715)
- | 903 | 976 -> One (r716)
- | 902 | 975 -> One (r717)
- | 901 | 974 -> One (r718)
- | 900 | 973 -> One (r719)
- | 909 | 985 -> One (r720)
- | 908 | 984 -> One (r721)
- | 907 | 983 -> One (r722)
- | 912 | 994 -> One (r723)
- | 911 | 993 -> One (r724)
- | 910 | 992 -> One (r725)
- | 915 -> One (r726)
- | 925 -> One (r727)
- | 924 -> One (r728)
- | 923 -> One (r729)
- | 922 -> One (r730)
- | 928 | 1018 -> One (r731)
- | 927 | 1017 -> One (r732)
- | 926 | 1016 -> One (r733)
- | 934 -> One (r734)
- | 933 -> One (r735)
- | 932 -> One (r736)
- | 931 -> One (r737)
- | 937 | 1021 -> One (r738)
- | 936 | 1020 -> One (r739)
- | 935 | 1019 -> One (r740)
- | 943 -> One (r741)
- | 942 -> One (r742)
- | 941 -> One (r743)
- | 940 -> One (r744)
- | 953 -> One (r745)
- | 952 -> One (r746)
- | 951 -> One (r747)
- | 950 -> One (r748)
- | 962 -> One (r749)
- | 961 -> One (r750)
- | 960 -> One (r751)
- | 959 -> One (r752)
- | 971 -> One (r753)
- | 970 -> One (r754)
- | 969 -> One (r755)
- | 968 -> One (r756)
- | 982 -> One (r757)
- | 981 -> One (r758)
- | 980 -> One (r759)
- | 979 -> One (r760)
- | 991 -> One (r761)
- | 990 -> One (r762)
- | 989 -> One (r763)
- | 988 -> One (r764)
- | 1000 -> One (r765)
- | 999 -> One (r766)
- | 998 -> One (r767)
- | 997 -> One (r768)
- | 1007 -> One (r769)
- | 1006 -> One (r770)
- | 1005 -> One (r771)
- | 1004 -> One (r772)
- | 1025 -> One (r773)
- | 1024 -> One (r774)
- | 1030 -> One (r775)
- | 1034 -> One (r776)
- | 1036 -> One (r777)
- | 1038 -> One (r778)
- | 1040 -> One (r779)
- | 1042 -> One (r780)
- | 1045 -> One (r782)
- | 1044 -> One (r783)
- | 1057 -> One (r784)
- | 1056 -> One (r785)
- | 1049 -> One (r786)
- | 1048 -> One (r787)
- | 1085 -> One (r788)
- | 1084 -> One (r789)
- | 1083 -> One (r790)
- | 1091 -> One (r791)
- | 1090 -> One (r792)
- | 1089 -> One (r793)
- | 1088 -> One (r794)
- | 1098 -> One (r795)
- | 1097 -> One (r796)
- | 1096 -> One (r797)
- | 1095 -> One (r798)
- | 1101 -> One (r799)
- | 1107 -> One (r800)
- | 1106 -> One (r801)
- | 1105 -> One (r802)
- | 1104 -> One (r803)
- | 1116 -> One (r804)
- | 1115 -> One (r805)
- | 1114 -> One (r806)
- | 1123 -> One (r807)
- | 1137 -> One (r808)
- | 1136 -> One (r809)
- | 1144 -> One (r811)
- | 1143 -> One (r812)
- | 1142 -> One (r813)
- | 1135 -> One (r814)
- | 1134 -> One (r815)
- | 1133 -> One (r816)
- | 1141 -> One (r817)
- | 1140 -> One (r818)
- | 1139 -> One (r819)
- | 1146 -> One (r820)
- | 1194 -> One (r821)
- | 1193 -> One (r822)
- | 1192 -> One (r823)
- | 1191 -> One (r824)
- | 1155 -> One (r825)
- | 1149 -> One (r826)
- | 1148 -> One (r827)
- | 1179 -> One (r828)
- | 1178 -> One (r830)
- | 1174 -> One (r837)
- | 1171 -> One (r839)
- | 1170 -> One (r840)
- | 1168 -> One (r841)
- | 1167 -> One (r842)
- | 1166 -> One (r843)
- | 1165 -> One (r844)
- | 1161 -> One (r845)
- | 1160 -> One (r846)
- | 1164 -> One (r847)
- | 1163 -> One (r848)
- | 1177 -> One (r849)
- | 1176 -> One (r850)
- | 1190 -> One (r851)
- | 1186 -> One (r852)
- | 1182 -> One (r853)
- | 1185 -> One (r854)
- | 1184 -> One (r855)
- | 1189 -> One (r856)
- | 1188 -> One (r857)
- | 1210 -> One (r858)
- | 1209 -> One (r859)
- | 1208 -> One (r860)
- | 1214 -> One (r861)
- | 1220 -> One (r862)
- | 1219 -> One (r863)
- | 1218 -> One (r864)
- | 1217 -> One (r865)
- | 1223 -> One (r866)
- | 1222 -> One (r867)
- | 1227 -> One (r868)
- | 1235 -> One (r869)
- | 1234 -> One (r870)
- | 1233 -> One (r871)
- | 1232 -> One (r872)
- | 1238 -> One (r873)
- | 1237 -> One (r874)
- | 1241 -> One (r875)
- | 1240 -> One (r876)
- | 1244 -> One (r877)
- | 1243 -> One (r878)
- | 1249 -> One (r879)
- | 1248 -> One (r880)
- | 1252 -> One (r881)
- | 1251 -> One (r882)
- | 1255 -> One (r883)
- | 1254 -> One (r884)
- | 1286 -> One (r885)
- | 1285 -> One (r886)
- | 1284 -> One (r887)
- | 1272 -> One (r888)
- | 1271 -> One (r889)
- | 1270 -> One (r890)
- | 1269 -> One (r891)
- | 1266 -> One (r892)
- | 1265 -> One (r893)
- | 1264 -> One (r894)
- | 1263 -> One (r895)
- | 1268 -> One (r896)
- | 1283 -> One (r897)
- | 1276 -> One (r898)
- | 1275 -> One (r899)
- | 1274 -> One (r900)
- | 1282 -> One (r901)
- | 1281 -> One (r902)
- | 1280 -> One (r903)
- | 1279 -> One (r904)
- | 1278 -> One (r905)
- | 1780 -> One (r906)
- | 1779 -> One (r907)
- | 1288 -> One (r908)
- | 1290 -> One (r909)
- | 1292 -> One (r910)
- | 1778 -> One (r911)
- | 1777 -> One (r912)
- | 1294 -> One (r913)
- | 1299 -> One (r914)
- | 1298 -> One (r915)
- | 1297 -> One (r916)
- | 1296 -> One (r917)
- | 1310 -> One (r918)
- | 1313 -> One (r920)
- | 1312 -> One (r921)
- | 1309 -> One (r922)
- | 1308 -> One (r923)
- | 1304 -> One (r924)
- | 1303 -> One (r925)
- | 1302 -> One (r926)
- | 1301 -> One (r927)
- | 1307 -> One (r928)
- | 1306 -> One (r929)
- | 1326 -> One (r931)
- | 1325 -> One (r932)
- | 1324 -> One (r933)
- | 1319 -> One (r934)
- | 1329 -> One (r938)
- | 1328 -> One (r939)
- | 1327 -> One (r940)
- | 1387 -> One (r941)
- | 1386 -> One (r942)
- | 1385 -> One (r943)
- | 1384 -> One (r944)
- | 1323 -> One (r945)
- | 1580 -> One (r946)
- | 1579 -> One (r947)
- | 1341 -> One (r948)
- | 1340 -> One (r949)
- | 1339 -> One (r950)
- | 1338 -> One (r951)
- | 1337 -> One (r952)
- | 1336 -> One (r953)
- | 1335 -> One (r954)
- | 1334 -> One (r955)
- | 1374 -> One (r956)
- | 1373 -> One (r957)
- | 1376 -> One (r959)
- | 1375 -> One (r960)
- | 1369 -> One (r961)
- | 1351 -> One (r962)
- | 1350 -> One (r963)
- | 1349 -> One (r964)
- | 1348 -> One (r965)
- | 1347 -> One (r966)
- | 1355 -> One (r970)
- | 1354 -> One (r971)
- | 1368 -> One (r972)
- | 1360 -> One (r973)
- | 1359 -> One (r974)
- | 1358 -> One (r975)
- | 1357 -> One (r976)
- | 1367 -> One (r977)
- | 1366 -> One (r978)
- | 1365 -> One (r979)
- | 1364 -> One (r980)
- | 1363 -> One (r981)
- | 1362 -> One (r982)
- | 1372 -> One (r985)
- | 1371 -> One (r986)
- | 1378 -> One (r987)
- | 1383 -> One (r988)
- | 1382 -> One (r989)
- | 1381 -> One (r990)
- | 1380 -> One (r991)
- | 1443 | 1497 -> One (r993)
- | 1499 -> One (r995)
- | 1513 -> One (r997)
- | 1503 -> One (r998)
- | 1502 -> One (r999)
- | 1484 -> One (r1000)
- | 1483 -> One (r1001)
- | 1482 -> One (r1002)
- | 1481 -> One (r1003)
- | 1480 -> One (r1004)
- | 1479 -> One (r1005)
- | 1478 -> One (r1006)
- | 1468 -> One (r1007)
- | 1467 -> One (r1008)
- | 1399 -> One (r1009)
- | 1398 -> One (r1010)
- | 1397 -> One (r1011)
- | 1393 -> One (r1012)
- | 1391 -> One (r1013)
- | 1390 -> One (r1014)
- | 1396 -> One (r1015)
- | 1395 -> One (r1016)
- | 1461 -> One (r1017)
- | 1460 -> One (r1018)
- | 1405 -> One (r1019)
- | 1401 -> One (r1020)
- | 1404 -> One (r1021)
- | 1403 -> One (r1022)
- | 1416 -> One (r1023)
- | 1415 -> One (r1024)
- | 1414 -> One (r1025)
- | 1413 -> One (r1026)
- | 1412 -> One (r1027)
- | 1407 -> One (r1028)
- | 1427 -> One (r1029)
- | 1426 -> One (r1030)
- | 1425 -> One (r1031)
- | 1424 -> One (r1032)
- | 1423 -> One (r1033)
- | 1418 -> One (r1034)
- | 1452 -> One (r1035)
- | 1451 -> One (r1036)
- | 1429 -> One (r1037)
- | 1450 -> One (r1038)
- | 1449 -> One (r1039)
- | 1448 -> One (r1040)
- | 1447 -> One (r1041)
- | 1431 -> One (r1042)
- | 1445 -> One (r1043)
- | 1435 -> One (r1044)
- | 1434 -> One (r1045)
- | 1433 -> One (r1046)
- | 1442 | 1490 -> One (r1047)
- | 1439 -> One (r1049)
- | 1438 -> One (r1050)
- | 1437 -> One (r1051)
- | 1436 | 1489 -> One (r1052)
- | 1441 -> One (r1053)
- | 1457 -> One (r1054)
- | 1456 -> One (r1055)
- | 1455 -> One (r1056)
- | 1459 -> One (r1058)
- | 1458 -> One (r1059)
- | 1454 -> One (r1060)
- | 1463 -> One (r1061)
- | 1466 -> One (r1062)
- | 1477 -> One (r1063)
- | 1476 -> One (r1064)
- | 1475 -> One (r1065)
- | 1474 -> One (r1066)
- | 1473 -> One (r1067)
- | 1472 -> One (r1068)
- | 1471 -> One (r1069)
- | 1470 -> One (r1070)
- | 1501 -> One (r1071)
- | 1488 -> One (r1072)
- | 1487 -> One (r1073)
- | 1486 -> One (r1074)
- | 1500 -> One (r1075)
- | 1492 -> One (r1076)
- | 1498 -> One (r1077)
- | 1495 -> One (r1078)
- | 1494 -> One (r1079)
- | 1512 -> One (r1080)
- | 1511 -> One (r1081)
- | 1510 -> One (r1082)
- | 1509 -> One (r1083)
- | 1508 -> One (r1084)
- | 1507 -> One (r1085)
- | 1506 -> One (r1086)
- | 1505 -> One (r1087)
- | 1522 -> One (r1088)
- | 1524 -> One (r1089)
- | 1534 -> One (r1090)
- | 1533 -> One (r1091)
- | 1532 -> One (r1092)
- | 1531 -> One (r1093)
- | 1530 -> One (r1094)
- | 1529 -> One (r1095)
- | 1528 -> One (r1096)
- | 1527 -> One (r1097)
- | 1576 -> One (r1098)
- | 1556 -> One (r1099)
- | 1555 -> One (r1100)
- | 1554 -> One (r1101)
- | 1553 -> One (r1102)
- | 1540 -> One (r1103)
- | 1539 -> One (r1104)
- | 1538 -> One (r1105)
- | 1537 -> One (r1106)
- | 1544 -> One (r1107)
- | 1543 -> One (r1108)
- | 1549 -> One (r1109)
- | 1548 -> One (r1110)
- | 1547 | 1808 -> One (r1111)
- | 1551 | 1807 -> One (r1112)
- | 1573 -> One (r1113)
- | 1565 -> One (r1114)
- | 1564 -> One (r1115)
- | 1563 -> One (r1116)
- | 1572 -> One (r1117)
- | 1571 -> One (r1118)
- | 1692 -> One (r1119)
- | 1736 -> One (r1121)
- | 1589 -> One (r1122)
- | 1753 -> One (r1124)
- | 1744 -> One (r1125)
- | 1743 -> One (r1126)
- | 1588 -> One (r1127)
- | 1587 -> One (r1128)
- | 1586 -> One (r1129)
- | 1585 -> One (r1130)
- | 1584 -> One (r1131)
- | 1730 -> One (r1132)
- | 1729 -> One (r1133)
- | 1592 -> One (r1134)
- | 1591 -> One (r1135)
- | 1617 -> One (r1136)
- | 1616 -> One (r1137)
- | 1615 -> One (r1138)
- | 1614 -> One (r1139)
- | 1605 -> One (r1140)
- | 1604 -> One (r1142)
- | 1603 -> One (r1143)
- | 1599 -> One (r1144)
- | 1598 -> One (r1145)
- | 1597 -> One (r1146)
- | 1596 -> One (r1147)
- | 1595 -> One (r1148)
- | 1602 -> One (r1149)
- | 1601 -> One (r1150)
- | 1613 -> One (r1151)
- | 1612 -> One (r1152)
- | 1611 -> One (r1153)
- | 1620 -> One (r1154)
- | 1619 -> One (r1155)
- | 1661 -> One (r1157)
- | 1650 -> One (r1158)
- | 1649 -> One (r1159)
- | 1640 -> One (r1160)
- | 1639 -> One (r1162)
- | 1638 -> One (r1163)
- | 1637 -> One (r1164)
- | 1626 -> One (r1165)
- | 1625 -> One (r1166)
- | 1623 -> One (r1167)
- | 1636 -> One (r1168)
- | 1635 -> One (r1169)
- | 1634 -> One (r1170)
- | 1633 -> One (r1171)
- | 1632 -> One (r1172)
- | 1631 -> One (r1173)
- | 1630 -> One (r1174)
- | 1629 -> One (r1175)
- | 1648 -> One (r1176)
- | 1647 -> One (r1177)
- | 1646 -> One (r1178)
- | 1660 -> One (r1179)
- | 1659 -> One (r1180)
- | 1658 -> One (r1181)
- | 1657 -> One (r1182)
- | 1656 -> One (r1183)
- | 1655 -> One (r1184)
- | 1654 -> One (r1185)
- | 1653 -> One (r1186)
- | 1665 -> One (r1187)
- | 1664 -> One (r1188)
- | 1663 -> One (r1189)
- | 1724 -> One (r1190)
- | 1723 -> One (r1191)
- | 1722 -> One (r1192)
- | 1721 -> One (r1193)
- | 1720 -> One (r1194)
- | 1719 -> One (r1195)
- | 1716 -> One (r1196)
- | 1668 -> One (r1197)
- | 1712 -> One (r1198)
- | 1711 -> One (r1199)
- | 1706 -> One (r1200)
- | 1705 -> One (r1201)
- | 1704 -> One (r1202)
- | 1703 -> One (r1203)
- | 1677 -> One (r1204)
- | 1676 -> One (r1205)
- | 1675 -> One (r1206)
- | 1674 -> One (r1207)
- | 1673 -> One (r1208)
- | 1672 -> One (r1209)
- | 1702 -> One (r1210)
- | 1681 -> One (r1211)
- | 1680 -> One (r1212)
- | 1679 -> One (r1213)
- | 1685 -> One (r1214)
- | 1684 -> One (r1215)
- | 1683 -> One (r1216)
- | 1699 -> One (r1217)
- | 1689 -> One (r1218)
- | 1688 -> One (r1219)
- | 1701 -> One (r1221)
- | 1687 -> One (r1222)
- | 1696 -> One (r1223)
- | 1691 -> One (r1224)
- | 1710 -> One (r1225)
- | 1709 -> One (r1226)
- | 1708 -> One (r1227)
- | 1715 -> One (r1228)
- | 1714 -> One (r1229)
- | 1718 -> One (r1230)
- | 1728 -> One (r1231)
- | 1727 -> One (r1232)
- | 1726 -> One (r1233)
- | 1732 -> One (r1234)
- | 1735 -> One (r1235)
- | 1740 -> One (r1236)
- | 1739 -> One (r1237)
- | 1738 -> One (r1238)
- | 1742 -> One (r1239)
- | 1752 -> One (r1240)
- | 1751 -> One (r1241)
- | 1750 -> One (r1242)
- | 1749 -> One (r1243)
- | 1748 -> One (r1244)
- | 1747 -> One (r1245)
- | 1746 -> One (r1246)
- | 1762 -> One (r1247)
- | 1765 -> One (r1248)
- | 1767 -> One (r1249)
- | 1773 -> One (r1250)
- | 1772 -> One (r1251)
- | 1783 -> One (r1252)
- | 1782 -> One (r1253)
- | 1794 -> One (r1254)
- | 1793 -> One (r1255)
- | 1811 -> One (r1256)
- | 1810 -> One (r1257)
- | 1823 -> One (r1258)
- | 1822 -> One (r1259)
- | 1839 -> One (r1260)
- | 1847 -> One (r1261)
- | 1855 -> One (r1262)
- | 1852 -> One (r1263)
- | 1854 -> One (r1264)
- | 1857 -> One (r1265)
- | 1860 -> One (r1266)
- | 1863 -> One (r1267)
- | 1862 -> One (r1268)
- | 1871 -> One (r1269)
- | 1870 -> One (r1270)
- | 1869 -> One (r1271)
- | 1885 -> One (r1272)
- | 1884 -> One (r1273)
- | 1883 -> One (r1274)
- | 1905 -> One (r1275)
- | 1909 -> One (r1276)
- | 1914 -> One (r1277)
- | 1921 -> One (r1278)
- | 1920 -> One (r1279)
- | 1919 -> One (r1280)
- | 1918 -> One (r1281)
- | 1928 -> One (r1282)
- | 1932 -> One (r1283)
- | 1936 -> One (r1284)
- | 1939 -> One (r1285)
- | 1944 -> One (r1286)
- | 1948 -> One (r1287)
- | 1952 -> One (r1288)
- | 1956 -> One (r1289)
- | 1960 -> One (r1290)
- | 1963 -> One (r1291)
- | 1967 -> One (r1292)
- | 1973 -> One (r1293)
- | 1983 -> One (r1294)
- | 1985 -> One (r1295)
- | 1988 -> One (r1296)
- | 1987 -> One (r1297)
- | 1990 -> One (r1298)
- | 2000 -> One (r1299)
- | 1996 -> One (r1300)
- | 1995 -> One (r1301)
- | 1999 -> One (r1302)
- | 1998 -> One (r1303)
- | 2005 -> One (r1304)
- | 2004 -> One (r1305)
- | 2003 -> One (r1306)
- | 2007 -> One (r1307)
- | 370 -> Select (function
+ | 873 -> One (r705)
+ | 872 -> One (r706)
+ | 877 -> One (r707)
+ | 876 -> One (r708)
+ | 879 -> One (r709)
+ | 881 -> One (r710)
+ | 883 -> One (r711)
+ | 885 -> One (r712)
+ | 890 -> One (r713)
+ | 894 -> One (r714)
+ | 900 | 961 -> One (r715)
+ | 899 | 960 -> One (r716)
+ | 898 | 959 -> One (r717)
+ | 903 | 970 -> One (r718)
+ | 902 | 969 -> One (r719)
+ | 901 | 968 -> One (r720)
+ | 908 | 981 -> One (r721)
+ | 907 | 980 -> One (r722)
+ | 906 | 979 -> One (r723)
+ | 905 | 978 -> One (r724)
+ | 914 | 990 -> One (r725)
+ | 913 | 989 -> One (r726)
+ | 912 | 988 -> One (r727)
+ | 917 | 999 -> One (r728)
+ | 916 | 998 -> One (r729)
+ | 915 | 997 -> One (r730)
+ | 920 -> One (r731)
+ | 930 -> One (r732)
+ | 929 -> One (r733)
+ | 928 -> One (r734)
+ | 927 -> One (r735)
+ | 933 | 1023 -> One (r736)
+ | 932 | 1022 -> One (r737)
+ | 931 | 1021 -> One (r738)
+ | 939 -> One (r739)
+ | 938 -> One (r740)
+ | 937 -> One (r741)
+ | 936 -> One (r742)
+ | 942 | 1026 -> One (r743)
+ | 941 | 1025 -> One (r744)
+ | 940 | 1024 -> One (r745)
+ | 948 -> One (r746)
+ | 947 -> One (r747)
+ | 946 -> One (r748)
+ | 945 -> One (r749)
+ | 958 -> One (r750)
+ | 957 -> One (r751)
+ | 956 -> One (r752)
+ | 955 -> One (r753)
+ | 967 -> One (r754)
+ | 966 -> One (r755)
+ | 965 -> One (r756)
+ | 964 -> One (r757)
+ | 976 -> One (r758)
+ | 975 -> One (r759)
+ | 974 -> One (r760)
+ | 973 -> One (r761)
+ | 987 -> One (r762)
+ | 986 -> One (r763)
+ | 985 -> One (r764)
+ | 984 -> One (r765)
+ | 996 -> One (r766)
+ | 995 -> One (r767)
+ | 994 -> One (r768)
+ | 993 -> One (r769)
+ | 1005 -> One (r770)
+ | 1004 -> One (r771)
+ | 1003 -> One (r772)
+ | 1002 -> One (r773)
+ | 1012 -> One (r774)
+ | 1011 -> One (r775)
+ | 1010 -> One (r776)
+ | 1009 -> One (r777)
+ | 1050 -> One (r778)
+ | 1049 -> One (r779)
+ | 1048 -> One (r780)
+ | 1056 -> One (r781)
+ | 1055 -> One (r782)
+ | 1054 -> One (r783)
+ | 1053 -> One (r784)
+ | 1063 -> One (r785)
+ | 1062 -> One (r786)
+ | 1061 -> One (r787)
+ | 1060 -> One (r788)
+ | 1067 -> One (r789)
+ | 1066 -> One (r790)
+ | 1072 -> One (r791)
+ | 1076 -> One (r792)
+ | 1078 -> One (r793)
+ | 1080 -> One (r794)
+ | 1082 -> One (r795)
+ | 1084 -> One (r796)
+ | 1087 -> One (r798)
+ | 1086 -> One (r799)
+ | 1099 -> One (r800)
+ | 1098 -> One (r801)
+ | 1091 -> One (r802)
+ | 1090 -> One (r803)
+ | 1107 -> One (r804)
+ | 1113 -> One (r805)
+ | 1112 -> One (r806)
+ | 1111 -> One (r807)
+ | 1120 -> One (r808)
+ | 1134 -> One (r809)
+ | 1133 -> One (r810)
+ | 1141 -> One (r812)
+ | 1140 -> One (r813)
+ | 1139 -> One (r814)
+ | 1132 -> One (r815)
+ | 1131 -> One (r816)
+ | 1130 -> One (r817)
+ | 1138 -> One (r818)
+ | 1137 -> One (r819)
+ | 1136 -> One (r820)
+ | 1143 -> One (r821)
+ | 1191 -> One (r822)
+ | 1190 -> One (r823)
+ | 1189 -> One (r824)
+ | 1188 -> One (r825)
+ | 1152 -> One (r826)
+ | 1146 -> One (r827)
+ | 1145 -> One (r828)
+ | 1176 -> One (r829)
+ | 1175 -> One (r831)
+ | 1171 -> One (r838)
+ | 1168 -> One (r840)
+ | 1167 -> One (r841)
+ | 1165 -> One (r842)
+ | 1164 -> One (r843)
+ | 1163 -> One (r844)
+ | 1162 -> One (r845)
+ | 1158 -> One (r846)
+ | 1157 -> One (r847)
+ | 1161 -> One (r848)
+ | 1160 -> One (r849)
+ | 1174 -> One (r850)
+ | 1173 -> One (r851)
+ | 1187 -> One (r852)
+ | 1183 -> One (r853)
+ | 1179 -> One (r854)
+ | 1182 -> One (r855)
+ | 1181 -> One (r856)
+ | 1186 -> One (r857)
+ | 1185 -> One (r858)
+ | 1207 -> One (r859)
+ | 1206 -> One (r860)
+ | 1205 -> One (r861)
+ | 1211 -> One (r862)
+ | 1217 -> One (r863)
+ | 1216 -> One (r864)
+ | 1215 -> One (r865)
+ | 1214 -> One (r866)
+ | 1220 -> One (r867)
+ | 1219 -> One (r868)
+ | 1224 -> One (r869)
+ | 1235 -> One (r870)
+ | 1234 -> One (r871)
+ | 1233 -> One (r872)
+ | 1232 -> One (r873)
+ | 1238 -> One (r874)
+ | 1237 -> One (r875)
+ | 1241 -> One (r876)
+ | 1240 -> One (r877)
+ | 1244 -> One (r878)
+ | 1243 -> One (r879)
+ | 1249 -> One (r880)
+ | 1248 -> One (r881)
+ | 1252 -> One (r882)
+ | 1251 -> One (r883)
+ | 1255 -> One (r884)
+ | 1254 -> One (r885)
+ | 1286 -> One (r886)
+ | 1285 -> One (r887)
+ | 1284 -> One (r888)
+ | 1272 -> One (r889)
+ | 1271 -> One (r890)
+ | 1270 -> One (r891)
+ | 1269 -> One (r892)
+ | 1266 -> One (r893)
+ | 1265 -> One (r894)
+ | 1264 -> One (r895)
+ | 1263 -> One (r896)
+ | 1268 -> One (r897)
+ | 1283 -> One (r898)
+ | 1276 -> One (r899)
+ | 1275 -> One (r900)
+ | 1274 -> One (r901)
+ | 1282 -> One (r902)
+ | 1281 -> One (r903)
+ | 1280 -> One (r904)
+ | 1279 -> One (r905)
+ | 1278 -> One (r906)
+ | 1780 -> One (r907)
+ | 1779 -> One (r908)
+ | 1288 -> One (r909)
+ | 1290 -> One (r910)
+ | 1292 -> One (r911)
+ | 1778 -> One (r912)
+ | 1777 -> One (r913)
+ | 1294 -> One (r914)
+ | 1299 -> One (r915)
+ | 1298 -> One (r916)
+ | 1297 -> One (r917)
+ | 1296 -> One (r918)
+ | 1310 -> One (r919)
+ | 1313 -> One (r921)
+ | 1312 -> One (r922)
+ | 1309 -> One (r923)
+ | 1308 -> One (r924)
+ | 1304 -> One (r925)
+ | 1303 -> One (r926)
+ | 1302 -> One (r927)
+ | 1301 -> One (r928)
+ | 1307 -> One (r929)
+ | 1306 -> One (r930)
+ | 1326 -> One (r932)
+ | 1325 -> One (r933)
+ | 1324 -> One (r934)
+ | 1319 -> One (r935)
+ | 1329 -> One (r939)
+ | 1328 -> One (r940)
+ | 1327 -> One (r941)
+ | 1387 -> One (r942)
+ | 1386 -> One (r943)
+ | 1385 -> One (r944)
+ | 1384 -> One (r945)
+ | 1323 -> One (r946)
+ | 1580 -> One (r947)
+ | 1579 -> One (r948)
+ | 1341 -> One (r949)
+ | 1340 -> One (r950)
+ | 1339 -> One (r951)
+ | 1338 -> One (r952)
+ | 1337 -> One (r953)
+ | 1336 -> One (r954)
+ | 1335 -> One (r955)
+ | 1334 -> One (r956)
+ | 1374 -> One (r957)
+ | 1373 -> One (r958)
+ | 1376 -> One (r960)
+ | 1375 -> One (r961)
+ | 1369 -> One (r962)
+ | 1351 -> One (r963)
+ | 1350 -> One (r964)
+ | 1349 -> One (r965)
+ | 1348 -> One (r966)
+ | 1347 -> One (r967)
+ | 1355 -> One (r971)
+ | 1354 -> One (r972)
+ | 1368 -> One (r973)
+ | 1360 -> One (r974)
+ | 1359 -> One (r975)
+ | 1358 -> One (r976)
+ | 1357 -> One (r977)
+ | 1367 -> One (r978)
+ | 1366 -> One (r979)
+ | 1365 -> One (r980)
+ | 1364 -> One (r981)
+ | 1363 -> One (r982)
+ | 1362 -> One (r983)
+ | 1372 -> One (r986)
+ | 1371 -> One (r987)
+ | 1378 -> One (r988)
+ | 1383 -> One (r989)
+ | 1382 -> One (r990)
+ | 1381 -> One (r991)
+ | 1380 -> One (r992)
+ | 1443 | 1497 -> One (r994)
+ | 1499 -> One (r996)
+ | 1513 -> One (r998)
+ | 1503 -> One (r999)
+ | 1502 -> One (r1000)
+ | 1484 -> One (r1001)
+ | 1483 -> One (r1002)
+ | 1482 -> One (r1003)
+ | 1481 -> One (r1004)
+ | 1480 -> One (r1005)
+ | 1479 -> One (r1006)
+ | 1478 -> One (r1007)
+ | 1468 -> One (r1008)
+ | 1467 -> One (r1009)
+ | 1399 -> One (r1010)
+ | 1398 -> One (r1011)
+ | 1397 -> One (r1012)
+ | 1393 -> One (r1013)
+ | 1391 -> One (r1014)
+ | 1390 -> One (r1015)
+ | 1396 -> One (r1016)
+ | 1395 -> One (r1017)
+ | 1461 -> One (r1018)
+ | 1460 -> One (r1019)
+ | 1405 -> One (r1020)
+ | 1401 -> One (r1021)
+ | 1404 -> One (r1022)
+ | 1403 -> One (r1023)
+ | 1416 -> One (r1024)
+ | 1415 -> One (r1025)
+ | 1414 -> One (r1026)
+ | 1413 -> One (r1027)
+ | 1412 -> One (r1028)
+ | 1407 -> One (r1029)
+ | 1427 -> One (r1030)
+ | 1426 -> One (r1031)
+ | 1425 -> One (r1032)
+ | 1424 -> One (r1033)
+ | 1423 -> One (r1034)
+ | 1418 -> One (r1035)
+ | 1452 -> One (r1036)
+ | 1451 -> One (r1037)
+ | 1429 -> One (r1038)
+ | 1450 -> One (r1039)
+ | 1449 -> One (r1040)
+ | 1448 -> One (r1041)
+ | 1447 -> One (r1042)
+ | 1431 -> One (r1043)
+ | 1445 -> One (r1044)
+ | 1435 -> One (r1045)
+ | 1434 -> One (r1046)
+ | 1433 -> One (r1047)
+ | 1442 | 1490 -> One (r1048)
+ | 1439 -> One (r1050)
+ | 1438 -> One (r1051)
+ | 1437 -> One (r1052)
+ | 1436 | 1489 -> One (r1053)
+ | 1441 -> One (r1054)
+ | 1457 -> One (r1055)
+ | 1456 -> One (r1056)
+ | 1455 -> One (r1057)
+ | 1459 -> One (r1059)
+ | 1458 -> One (r1060)
+ | 1454 -> One (r1061)
+ | 1463 -> One (r1062)
+ | 1466 -> One (r1063)
+ | 1477 -> One (r1064)
+ | 1476 -> One (r1065)
+ | 1475 -> One (r1066)
+ | 1474 -> One (r1067)
+ | 1473 -> One (r1068)
+ | 1472 -> One (r1069)
+ | 1471 -> One (r1070)
+ | 1470 -> One (r1071)
+ | 1501 -> One (r1072)
+ | 1488 -> One (r1073)
+ | 1487 -> One (r1074)
+ | 1486 -> One (r1075)
+ | 1500 -> One (r1076)
+ | 1492 -> One (r1077)
+ | 1498 -> One (r1078)
+ | 1495 -> One (r1079)
+ | 1494 -> One (r1080)
+ | 1512 -> One (r1081)
+ | 1511 -> One (r1082)
+ | 1510 -> One (r1083)
+ | 1509 -> One (r1084)
+ | 1508 -> One (r1085)
+ | 1507 -> One (r1086)
+ | 1506 -> One (r1087)
+ | 1505 -> One (r1088)
+ | 1522 -> One (r1089)
+ | 1524 -> One (r1090)
+ | 1534 -> One (r1091)
+ | 1533 -> One (r1092)
+ | 1532 -> One (r1093)
+ | 1531 -> One (r1094)
+ | 1530 -> One (r1095)
+ | 1529 -> One (r1096)
+ | 1528 -> One (r1097)
+ | 1527 -> One (r1098)
+ | 1576 -> One (r1099)
+ | 1556 -> One (r1100)
+ | 1555 -> One (r1101)
+ | 1554 -> One (r1102)
+ | 1553 -> One (r1103)
+ | 1540 -> One (r1104)
+ | 1539 -> One (r1105)
+ | 1538 -> One (r1106)
+ | 1537 -> One (r1107)
+ | 1544 -> One (r1108)
+ | 1543 -> One (r1109)
+ | 1549 -> One (r1110)
+ | 1548 -> One (r1111)
+ | 1547 | 1808 -> One (r1112)
+ | 1551 | 1807 -> One (r1113)
+ | 1573 -> One (r1114)
+ | 1565 -> One (r1115)
+ | 1564 -> One (r1116)
+ | 1563 -> One (r1117)
+ | 1572 -> One (r1118)
+ | 1571 -> One (r1119)
+ | 1692 -> One (r1120)
+ | 1736 -> One (r1122)
+ | 1589 -> One (r1123)
+ | 1753 -> One (r1125)
+ | 1744 -> One (r1126)
+ | 1743 -> One (r1127)
+ | 1588 -> One (r1128)
+ | 1587 -> One (r1129)
+ | 1586 -> One (r1130)
+ | 1585 -> One (r1131)
+ | 1584 -> One (r1132)
+ | 1730 -> One (r1133)
+ | 1729 -> One (r1134)
+ | 1592 -> One (r1135)
+ | 1591 -> One (r1136)
+ | 1617 -> One (r1137)
+ | 1616 -> One (r1138)
+ | 1615 -> One (r1139)
+ | 1614 -> One (r1140)
+ | 1605 -> One (r1141)
+ | 1604 -> One (r1143)
+ | 1603 -> One (r1144)
+ | 1599 -> One (r1145)
+ | 1598 -> One (r1146)
+ | 1597 -> One (r1147)
+ | 1596 -> One (r1148)
+ | 1595 -> One (r1149)
+ | 1602 -> One (r1150)
+ | 1601 -> One (r1151)
+ | 1613 -> One (r1152)
+ | 1612 -> One (r1153)
+ | 1611 -> One (r1154)
+ | 1620 -> One (r1155)
+ | 1619 -> One (r1156)
+ | 1661 -> One (r1158)
+ | 1650 -> One (r1159)
+ | 1649 -> One (r1160)
+ | 1640 -> One (r1161)
+ | 1639 -> One (r1163)
+ | 1638 -> One (r1164)
+ | 1637 -> One (r1165)
+ | 1626 -> One (r1166)
+ | 1625 -> One (r1167)
+ | 1623 -> One (r1168)
+ | 1636 -> One (r1169)
+ | 1635 -> One (r1170)
+ | 1634 -> One (r1171)
+ | 1633 -> One (r1172)
+ | 1632 -> One (r1173)
+ | 1631 -> One (r1174)
+ | 1630 -> One (r1175)
+ | 1629 -> One (r1176)
+ | 1648 -> One (r1177)
+ | 1647 -> One (r1178)
+ | 1646 -> One (r1179)
+ | 1660 -> One (r1180)
+ | 1659 -> One (r1181)
+ | 1658 -> One (r1182)
+ | 1657 -> One (r1183)
+ | 1656 -> One (r1184)
+ | 1655 -> One (r1185)
+ | 1654 -> One (r1186)
+ | 1653 -> One (r1187)
+ | 1665 -> One (r1188)
+ | 1664 -> One (r1189)
+ | 1663 -> One (r1190)
+ | 1724 -> One (r1191)
+ | 1723 -> One (r1192)
+ | 1722 -> One (r1193)
+ | 1721 -> One (r1194)
+ | 1720 -> One (r1195)
+ | 1719 -> One (r1196)
+ | 1716 -> One (r1197)
+ | 1668 -> One (r1198)
+ | 1712 -> One (r1199)
+ | 1711 -> One (r1200)
+ | 1706 -> One (r1201)
+ | 1705 -> One (r1202)
+ | 1704 -> One (r1203)
+ | 1703 -> One (r1204)
+ | 1677 -> One (r1205)
+ | 1676 -> One (r1206)
+ | 1675 -> One (r1207)
+ | 1674 -> One (r1208)
+ | 1673 -> One (r1209)
+ | 1672 -> One (r1210)
+ | 1702 -> One (r1211)
+ | 1681 -> One (r1212)
+ | 1680 -> One (r1213)
+ | 1679 -> One (r1214)
+ | 1685 -> One (r1215)
+ | 1684 -> One (r1216)
+ | 1683 -> One (r1217)
+ | 1699 -> One (r1218)
+ | 1689 -> One (r1219)
+ | 1688 -> One (r1220)
+ | 1701 -> One (r1222)
+ | 1687 -> One (r1223)
+ | 1696 -> One (r1224)
+ | 1691 -> One (r1225)
+ | 1710 -> One (r1226)
+ | 1709 -> One (r1227)
+ | 1708 -> One (r1228)
+ | 1715 -> One (r1229)
+ | 1714 -> One (r1230)
+ | 1718 -> One (r1231)
+ | 1728 -> One (r1232)
+ | 1727 -> One (r1233)
+ | 1726 -> One (r1234)
+ | 1732 -> One (r1235)
+ | 1735 -> One (r1236)
+ | 1740 -> One (r1237)
+ | 1739 -> One (r1238)
+ | 1738 -> One (r1239)
+ | 1742 -> One (r1240)
+ | 1752 -> One (r1241)
+ | 1751 -> One (r1242)
+ | 1750 -> One (r1243)
+ | 1749 -> One (r1244)
+ | 1748 -> One (r1245)
+ | 1747 -> One (r1246)
+ | 1746 -> One (r1247)
+ | 1762 -> One (r1248)
+ | 1765 -> One (r1249)
+ | 1767 -> One (r1250)
+ | 1773 -> One (r1251)
+ | 1772 -> One (r1252)
+ | 1783 -> One (r1253)
+ | 1782 -> One (r1254)
+ | 1794 -> One (r1255)
+ | 1793 -> One (r1256)
+ | 1811 -> One (r1257)
+ | 1810 -> One (r1258)
+ | 1823 -> One (r1259)
+ | 1822 -> One (r1260)
+ | 1839 -> One (r1261)
+ | 1847 -> One (r1262)
+ | 1855 -> One (r1263)
+ | 1852 -> One (r1264)
+ | 1854 -> One (r1265)
+ | 1857 -> One (r1266)
+ | 1860 -> One (r1267)
+ | 1863 -> One (r1268)
+ | 1862 -> One (r1269)
+ | 1871 -> One (r1270)
+ | 1870 -> One (r1271)
+ | 1869 -> One (r1272)
+ | 1885 -> One (r1273)
+ | 1884 -> One (r1274)
+ | 1883 -> One (r1275)
+ | 1905 -> One (r1276)
+ | 1909 -> One (r1277)
+ | 1914 -> One (r1278)
+ | 1921 -> One (r1279)
+ | 1920 -> One (r1280)
+ | 1919 -> One (r1281)
+ | 1918 -> One (r1282)
+ | 1928 -> One (r1283)
+ | 1932 -> One (r1284)
+ | 1936 -> One (r1285)
+ | 1939 -> One (r1286)
+ | 1944 -> One (r1287)
+ | 1948 -> One (r1288)
+ | 1952 -> One (r1289)
+ | 1956 -> One (r1290)
+ | 1960 -> One (r1291)
+ | 1963 -> One (r1292)
+ | 1967 -> One (r1293)
+ | 1973 -> One (r1294)
+ | 1983 -> One (r1295)
+ | 1985 -> One (r1296)
+ | 1988 -> One (r1297)
+ | 1987 -> One (r1298)
+ | 1990 -> One (r1299)
+ | 2000 -> One (r1300)
+ | 1996 -> One (r1301)
+ | 1995 -> One (r1302)
+ | 1999 -> One (r1303)
+ | 1998 -> One (r1304)
+ | 2005 -> One (r1305)
+ | 2004 -> One (r1306)
+ | 2003 -> One (r1307)
+ | 2007 -> One (r1308)
+ | 372 -> Select (function
| -1 -> [R 98]
- | _ -> S (T T_DOT) :: r343)
- | 611 -> Select (function
+ | _ -> S (T T_DOT) :: r346)
+ | 561 -> Select (function
| -1 -> [R 98]
- | _ -> r538)
+ | _ -> r484)
| 130 -> Select (function
| -1 -> r82
| _ -> R 124 :: r104)
@@ -3692,20 +3693,20 @@ let recover =
| -1 -> r82
| _ -> R 124 :: r159)
| 1315 -> Select (function
- | -1 -> r944
- | _ -> R 124 :: r937)
+ | -1 -> r945
+ | _ -> R 124 :: r938)
| 1343 -> Select (function
- | -1 -> r895
- | _ -> R 124 :: r969)
- | 495 -> Select (function
- | -1 -> r296
+ | -1 -> r896
+ | _ -> R 124 :: r970)
+ | 500 -> Select (function
+ | -1 -> r299
| _ -> [R 255])
- | 388 -> Select (function
+ | 395 -> Select (function
| -1 -> [R 722]
- | _ -> S (N N_pattern) :: r351)
- | 385 -> Select (function
+ | _ -> S (N N_pattern) :: r360)
+ | 387 -> Select (function
| -1 -> [R 723]
- | _ -> S (N N_pattern) :: r350)
+ | _ -> S (N N_pattern) :: r357)
| 136 -> Select (function
| -1 -> r110
| _ -> R 828 :: r116)
@@ -3714,41 +3715,44 @@ let recover =
| _ -> R 828 :: r165)
| 1320 -> Select (function
| -1 -> S (T T_RPAREN) :: r134
- | _ -> S (T T_COLONCOLON) :: r359)
+ | _ -> S (T T_COLONCOLON) :: r367)
| 198 -> Select (function
- | 249 | 626 | 836 | 1029 | 1199 | 1674 | 1708 -> r47
+ | 251 | 576 | 841 | 1071 | 1196 | 1674 | 1708 -> r47
| -1 -> S (T T_RPAREN) :: r134
| _ -> S (N N_pattern) :: r193)
- | 244 -> Select (function
+ | 246 -> Select (function
| -1 -> S (T T_RPAREN) :: r134
- | _ -> Sub (r3) :: r241)
- | 251 -> Select (function
- | -1 -> S (T T_RBRACKET) :: r252
- | _ -> Sub (r254) :: r256)
- | 537 -> Select (function
- | -1 -> S (T T_RBRACKET) :: r252
- | _ -> Sub (r451) :: r453)
- | 449 -> Select (function
- | 60 | 169 | 181 | 214 | 1288 | 1294 -> r394
- | _ -> S (T T_OPEN) :: r386)
+ | _ -> Sub (r3) :: r244)
+ | 466 -> Select (function
+ | -1 -> S (T T_RPAREN) :: r412
+ | _ -> S (N N_module_type) :: r417)
+ | 253 -> Select (function
+ | -1 -> S (T T_RBRACKET) :: r255
+ | _ -> Sub (r257) :: r259)
+ | 544 -> Select (function
+ | -1 -> S (T T_RBRACKET) :: r255
+ | _ -> Sub (r459) :: r461)
+ | 455 -> Select (function
+ | 60 | 169 | 181 | 214 | 1288 | 1294 -> r402
+ | _ -> S (T T_OPEN) :: r394)
| 1322 -> Select (function
- | -1 -> r444
- | _ -> S (T T_LPAREN) :: r945)
- | 287 -> Select (function
- | 1484 | 1488 | 1492 | 1495 | 1509 | 1713 | 1737 -> r290
- | -1 -> r302
- | _ -> S (T T_DOT) :: r305)
- | 493 -> Select (function
- | -1 -> r302
- | _ -> S (T T_DOT) :: r439)
+ | -1 -> r452
+ | _ -> S (T T_LPAREN) :: r946)
+ | 289 -> Select (function
+ | 1484 | 1488 | 1492 | 1495 | 1509 | 1713 | 1737 -> r293
+ | -1 -> r305
+ | _ -> S (T T_DOT) :: r308)
+ | 498 -> Select (function
+ | -1 -> r305
+ | _ -> S (T T_DOT) :: r445)
| 162 -> Select (function
| -1 -> r83
| _ -> S (T T_COLON) :: r138)
| 113 -> Select (function
- | 840 | 1180 -> r62
+ | 845 | 1177 -> r62
| _ -> Sub (r59) :: r60)
| 116 -> Select (function
- | 840 | 1180 -> r61
+ | 845 | 1177 -> r61
| _ -> r60)
| 1825 -> Select (function
| -1 -> r78
@@ -3786,29 +3790,29 @@ let recover =
| 176 -> Select (function
| -1 -> r109
| _ -> r165)
- | 288 -> Select (function
- | 1484 | 1488 | 1492 | 1495 | 1509 | 1713 | 1737 -> r289
- | -1 -> r297
- | _ -> r305)
- | 494 -> Select (function
- | -1 -> r297
- | _ -> r439)
+ | 290 -> Select (function
+ | 1484 | 1488 | 1492 | 1495 | 1509 | 1713 | 1737 -> r292
+ | -1 -> r300
+ | _ -> r308)
+ | 499 -> Select (function
+ | -1 -> r300
+ | _ -> r445)
| 1346 -> Select (function
- | -1 -> r892
- | _ -> r967)
- | 1345 -> Select (function
| -1 -> r893
| _ -> r968)
- | 1344 -> Select (function
+ | 1345 -> Select (function
| -1 -> r894
| _ -> r969)
+ | 1344 -> Select (function
+ | -1 -> r895
+ | _ -> r970)
| 1318 -> Select (function
- | -1 -> r941
- | _ -> r935)
- | 1317 -> Select (function
| -1 -> r942
| _ -> r936)
- | 1316 -> Select (function
+ | 1317 -> Select (function
| -1 -> r943
| _ -> r937)
+ | 1316 -> Select (function
+ | -1 -> r944
+ | _ -> r938)
| _ -> raise Not_found
diff --git a/src/ocaml/typing/btype.ml b/src/ocaml/typing/btype.ml
index 5ce396ecd2..84a8f910a2 100644
--- a/src/ocaml/typing/btype.ml
+++ b/src/ocaml/typing/btype.ml
@@ -43,7 +43,6 @@ module TypeMap = struct
let singleton ty = wrap_repr singleton ty
let fold f = TransientTypeMap.fold (wrap_type_expr f)
end
-module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
module TypeHash = struct
include TransientTypeHash
let mem hash = wrap_repr (mem hash)
@@ -94,45 +93,85 @@ module TypePairs = struct
f (type_expr t1, type_expr t2))
end
-(**** Forward declarations ****)
-
-let print_raw =
- ref (fun _ -> assert false : Format.formatter -> type_expr -> unit)
-
(**** Type level management ****)
let generic_level = Ident.highest_scope
-
-(* Used to mark a type during a traversal. *)
let lowest_level = Ident.lowest_scope
-let pivot_level = 2 * lowest_level - 1
- (* pivot_level - lowest_level < lowest_level *)
+
+(**** leveled type pool ****)
+(* This defines a stack of pools of type nodes indexed by the level
+ we will try to generalize them in [Ctype.with_local_level_gen].
+ [pool_of_level] returns the pool in which types at level [level]
+ should be kept, which is the topmost pool whose level is lower or
+ equal to [level].
+ [Ctype.with_local_level_gen] shall call [with_new_pool] to create
+ a new pool at a given level. On return it shall process all nodes
+ that were added to the pool.
+ Remark: the only function adding to a pool is [add_to_pool], and
+ the only function returning the contents of a pool is [with_new_pool],
+ so that the initial pool can be added to, but never read from. *)
+
+type pool = {level: int; mutable pool: transient_expr list; next: pool}
+(* To avoid an indirection we choose to add a dummy level at the end of
+ the list. It will never be accessed, as [pool_of_level] is always called
+ with [level >= 0]. *)
+let rec dummy = {level = max_int; pool = []; next = dummy}
+let pool_stack = s_table (fun () -> {level = 0; pool = []; next = dummy}) ()
+
+(* Lookup in the stack is linear, but the depth is the number of nested
+ generalization points (e.g. lhs of let-definitions), which in ML is known
+ to be generally low. In most cases we are allocating in the topmost pool.
+ In [Ctype.with_local_gen], we move non-generalizable type nodes from the
+ topmost pool to one deeper in the stack, so that for each type node the
+ accumulated depth of lookups over its life is bounded by the depth of
+ the stack when it was allocated.
+ In case this linear search turns out to be costly, we could switch to
+ binary search, exploiting the fact that the levels of pools in the stack
+ are expected to grow. *)
+let rec pool_of_level level pool =
+ if level >= pool.level then pool else pool_of_level level pool.next
+
+(* Create a new pool at given level, and use it locally. *)
+let with_new_pool ~level f =
+ let pool = {level; pool = []; next = !pool_stack} in
+ let r =
+ Misc.protect_refs [ R(pool_stack, pool) ] f
+ in
+ (r, pool.pool)
+
+let add_to_pool ~level ty =
+ if level >= generic_level || level <= lowest_level then () else
+ let pool = pool_of_level level !pool_stack in
+ pool.pool <- ty :: pool.pool
(**** Some type creators ****)
+let newty3 ~level ~scope desc =
+ let ty = proto_newty3 ~level ~scope desc in
+ add_to_pool ~level ty;
+ Transient_expr.type_expr ty
+
+let newty2 ~level desc =
+ newty3 ~level ~scope:Ident.lowest_scope desc
+
let newgenty desc = newty2 ~level:generic_level desc
let newgenvar ?name () = newgenty (Tvar name)
let newgenstub ~scope = newty3 ~level:generic_level ~scope (Tvar None)
-(*
-let newmarkedvar level =
- incr new_id; { desc = Tvar; level = pivot_level - level; id = !new_id }
-let newmarkedgenvar () =
- incr new_id;
- { desc = Tvar; level = pivot_level - generic_level; id = !new_id }
-*)
-
(**** Check some types ****)
let is_Tvar ty = match get_desc ty with Tvar _ -> true | _ -> false
let is_Tunivar ty = match get_desc ty with Tunivar _ -> true | _ -> false
let is_Tconstr ty = match get_desc ty with Tconstr _ -> true | _ -> false
+let is_poly_Tpoly ty =
+ match get_desc ty with Tpoly (_, _ :: _) -> true | _ -> false
let type_kind_is_abstract decl =
match decl.type_kind with Type_abstract _ -> true | _ -> false
let type_origin decl =
match decl.type_kind with
| Type_abstract origin -> origin
| Type_variant _ | Type_record _ | Type_open -> Definition
+let label_is_poly lbl = is_poly_Tpoly lbl.lbl_arg
let dummy_method = "*dummy method*"
@@ -238,7 +277,6 @@ let set_static_row_name decl path =
set_type_desc ty (Tvariant row)
| _ -> ()
-
(**********************************)
(* Utilities for type traversal *)
(**********************************)
@@ -303,24 +341,6 @@ let rec iter_abbrev f = function
| Mcons(_, _, ty, ty', rem) -> f ty; f ty'; iter_abbrev f rem
| Mlink rem -> iter_abbrev f !rem
-type type_iterators =
- { it_signature: type_iterators -> signature -> unit;
- it_signature_item: type_iterators -> signature_item -> unit;
- it_value_description: type_iterators -> value_description -> unit;
- it_type_declaration: type_iterators -> type_declaration -> unit;
- it_extension_constructor: type_iterators -> extension_constructor -> unit;
- it_module_declaration: type_iterators -> module_declaration -> unit;
- it_modtype_declaration: type_iterators -> modtype_declaration -> unit;
- it_class_declaration: type_iterators -> class_declaration -> unit;
- it_class_type_declaration: type_iterators -> class_type_declaration -> unit;
- it_functor_param: type_iterators -> functor_parameter -> unit;
- it_module_type: type_iterators -> module_type -> unit;
- it_class_type: type_iterators -> class_type -> unit;
- it_type_kind: type_iterators -> type_decl_kind -> unit;
- it_do_type_expr: type_iterators -> type_expr -> unit;
- it_type_expr: type_iterators -> type_expr -> unit;
- it_path: Path.t -> unit; }
-
let iter_type_expr_cstr_args f = function
| Cstr_tuple tl -> List.iter f tl
| Cstr_record lbls -> List.iter (fun d -> f d.ld_type) lbls
@@ -344,8 +364,44 @@ let iter_type_expr_kind f = function
| Type_open ->
()
+ (**********************************)
+ (* Utilities for marking *)
+ (**********************************)
+
+let rec mark_type mark ty =
+ if try_mark_node mark ty then iter_type_expr (mark_type mark) ty
+
+let mark_type_params mark ty =
+ iter_type_expr (mark_type mark) ty
+
+ (**********************************)
+ (* (Object-oriented) iterator *)
+ (**********************************)
+
+type 'a type_iterators =
+ { it_signature: 'a type_iterators -> signature -> unit;
+ it_signature_item: 'a type_iterators -> signature_item -> unit;
+ it_value_description: 'a type_iterators -> value_description -> unit;
+ it_type_declaration: 'a type_iterators -> type_declaration -> unit;
+ it_extension_constructor:
+ 'a type_iterators -> extension_constructor -> unit;
+ it_module_declaration: 'a type_iterators -> module_declaration -> unit;
+ it_modtype_declaration: 'a type_iterators -> modtype_declaration -> unit;
+ it_class_declaration: 'a type_iterators -> class_declaration -> unit;
+ it_class_type_declaration:
+ 'a type_iterators -> class_type_declaration -> unit;
+ it_functor_param: 'a type_iterators -> functor_parameter -> unit;
+ it_module_type: 'a type_iterators -> module_type -> unit;
+ it_class_type: 'a type_iterators -> class_type -> unit;
+ it_type_kind: 'a type_iterators -> type_decl_kind -> unit;
+ it_do_type_expr: 'a type_iterators -> 'a;
+ it_type_expr: 'a type_iterators -> type_expr -> unit;
+ it_path: Path.t -> unit; }
+
+type type_iterators_full = (type_expr -> unit) type_iterators
+type type_iterators_without_type_expr = (unit -> unit) type_iterators
-let type_iterators =
+let type_iterators_without_type_expr =
let it_signature it =
List.iter (it.it_signature_item it)
and it_signature_item it = function
@@ -406,6 +462,17 @@ let type_iterators =
it.it_class_type it cty
and it_type_kind it kind =
iter_type_expr_kind (it.it_type_expr it) kind
+ and it_path _p = ()
+ in
+ { it_path; it_type_expr = (fun _ _ -> ()); it_do_type_expr = (fun _ _ -> ());
+ it_type_kind; it_class_type; it_functor_param; it_module_type;
+ it_signature; it_class_type_declaration; it_class_declaration;
+ it_modtype_declaration; it_module_declaration; it_extension_constructor;
+ it_type_declaration; it_value_description; it_signature_item; }
+
+let type_iterators mark =
+ let it_type_expr it ty =
+ if try_mark_node mark ty then it.it_do_type_expr it ty
and it_do_type_expr it ty =
iter_type_expr (it.it_type_expr it) ty;
match get_desc ty with
@@ -416,13 +483,12 @@ let type_iterators =
| Tvariant row ->
Option.iter (fun (p,_) -> it.it_path p) (row_name row)
| _ -> ()
- and it_path _p = ()
in
- { it_path; it_type_expr = it_do_type_expr; it_do_type_expr;
- it_type_kind; it_class_type; it_functor_param; it_module_type;
- it_signature; it_class_type_declaration; it_class_declaration;
- it_modtype_declaration; it_module_declaration; it_extension_constructor;
- it_type_declaration; it_value_description; it_signature_item; }
+ {type_iterators_without_type_expr with it_type_expr; it_do_type_expr}
+
+ (**********************************)
+ (* Utilities for copying *)
+ (**********************************)
let copy_row f fixed row keep more =
let Row {fields = orig_fields; fixed = orig_fixed; closed; name = orig_name} =
@@ -468,8 +534,7 @@ let rec copy_type_desc ?(keep_names=false) f = function
Tpoly (f ty, tyl)
| Tpackage (p, fl) -> Tpackage (p, List.map (fun (n, ty) -> (n, f ty)) fl)
-(* Utilities for copying *)
-
+(* TODO: rename to [module Copy_scope] *)
module For_copy : sig
type copy_scope
@@ -493,9 +558,8 @@ end = struct
let with_scope f =
let scope = { saved_desc = [] } in
- let res = f scope in
- cleanup scope;
- res
+ Fun.protect ~finally:(fun () -> cleanup scope) (fun () -> f scope)
+
end
(*******************************************)
@@ -712,65 +776,10 @@ let instance_variable_type label sign =
| (_, _, ty) -> ty
| exception Not_found -> assert false
- (**********************************)
- (* Utilities for level-marking *)
- (**********************************)
-
-let not_marked_node ty = get_level ty >= lowest_level
- (* type nodes with negative levels are "marked" *)
-let flip_mark_node ty =
- let ty = Transient_expr.repr ty in
- Transient_expr.set_level ty (pivot_level - ty.level)
-let logged_mark_node ty =
- set_level ty (pivot_level - get_level ty)
-
-let try_mark_node ty = not_marked_node ty && (flip_mark_node ty; true)
-let try_logged_mark_node ty = not_marked_node ty && (logged_mark_node ty; true)
-
-let rec mark_type ty =
- if not_marked_node ty then begin
- flip_mark_node ty;
- iter_type_expr mark_type ty
- end
-
-let mark_type_params ty =
- iter_type_expr mark_type ty
-
-let type_iterators =
- let it_type_expr it ty =
- if try_mark_node ty then it.it_do_type_expr it ty
- in
- {type_iterators with it_type_expr}
-
-
-(* Remove marks from a type. *)
-let rec unmark_type ty =
- if get_level ty < lowest_level then begin
- (* flip back the marked level *)
- flip_mark_node ty;
- iter_type_expr unmark_type ty
- end
-
-let unmark_iterators =
- let it_type_expr _it ty = unmark_type ty in
- {type_iterators with it_type_expr}
-
-let unmark_type_decl decl =
- unmark_iterators.it_type_declaration unmark_iterators decl
-
-let unmark_extension_constructor ext =
- List.iter unmark_type ext.ext_type_params;
- iter_type_expr_cstr_args unmark_type ext.ext_args;
- Option.iter unmark_type ext.ext_ret_type
-
-let unmark_class_signature sign =
- unmark_type sign.csig_self;
- unmark_type sign.csig_self_row;
- Vars.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_vars;
- Meths.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_meths
-let unmark_class_type cty =
- unmark_iterators.it_class_type unmark_iterators cty
+ (**********)
+ (* Misc *)
+ (**********)
(**** Type information getter ****)
diff --git a/src/ocaml/typing/btype.mli b/src/ocaml/typing/btype.mli
index 71dd67b74a..f8fd3ad3e8 100644
--- a/src/ocaml/typing/btype.mli
+++ b/src/ocaml/typing/btype.mli
@@ -58,6 +58,22 @@ end
(**** Levels ****)
val generic_level: int
+ (* level of polymorphic variables; = Ident.highest_scope *)
+val lowest_level: int
+ (* lowest level for type nodes; = Ident.lowest_scope *)
+
+val with_new_pool: level:int -> (unit -> 'a) -> 'a * transient_expr list
+ (* [with_new_pool ~level f] executes [f] and returns the nodes
+ that were created at level [level] and above *)
+val add_to_pool: level:int -> transient_expr -> unit
+ (* Add a type node to the pool associated to the level (which should
+ be the level of the type node).
+ Do nothing if [level = generic_level] or [level = lowest_level]. *)
+
+val newty3: level:int -> scope:int -> type_desc -> type_expr
+ (* Create a type with a fresh id *)
+val newty2: level:int -> type_desc -> type_expr
+ (* Create a type with a fresh id and no scope *)
val newgenty: type_desc -> type_expr
(* Create a generic type *)
@@ -67,21 +83,16 @@ val newgenstub: scope:int -> type_expr
(* Return a fresh generic node, to be instantiated
by [Transient_expr.set_stub_desc] *)
-(* Use Tsubst instead
-val newmarkedvar: int -> type_expr
- (* Return a fresh marked variable *)
-val newmarkedgenvar: unit -> type_expr
- (* Return a fresh marked generic variable *)
-*)
-
(**** Types ****)
val is_Tvar: type_expr -> bool
val is_Tunivar: type_expr -> bool
val is_Tconstr: type_expr -> bool
+val is_poly_Tpoly: type_expr -> bool
val dummy_method: label
val type_kind_is_abstract: type_declaration -> bool
-val type_origin : type_declaration -> type_origin
+val type_origin: type_declaration -> type_origin
+val label_is_poly: label_description -> bool
(**** polymorphic variants ****)
@@ -136,29 +147,47 @@ val iter_type_expr_cstr_args: (type_expr -> unit) ->
val map_type_expr_cstr_args: (type_expr -> type_expr) ->
(constructor_arguments -> constructor_arguments)
+(**** Utilities for type marking ****)
-type type_iterators =
- { it_signature: type_iterators -> signature -> unit;
- it_signature_item: type_iterators -> signature_item -> unit;
- it_value_description: type_iterators -> value_description -> unit;
- it_type_declaration: type_iterators -> type_declaration -> unit;
- it_extension_constructor: type_iterators -> extension_constructor -> unit;
- it_module_declaration: type_iterators -> module_declaration -> unit;
- it_modtype_declaration: type_iterators -> modtype_declaration -> unit;
- it_class_declaration: type_iterators -> class_declaration -> unit;
- it_class_type_declaration: type_iterators -> class_type_declaration -> unit;
- it_functor_param: type_iterators -> functor_parameter -> unit;
- it_module_type: type_iterators -> module_type -> unit;
- it_class_type: type_iterators -> class_type -> unit;
- it_type_kind: type_iterators -> type_decl_kind -> unit;
- it_do_type_expr: type_iterators -> type_expr -> unit;
- it_type_expr: type_iterators -> type_expr -> unit;
+val mark_type: type_mark -> type_expr -> unit
+ (* Mark a type recursively *)
+val mark_type_params: type_mark -> type_expr -> unit
+ (* Mark the sons of a type node recursively *)
+
+(**** (Object-oriented) iterator ****)
+
+type 'a type_iterators =
+ { it_signature: 'a type_iterators -> signature -> unit;
+ it_signature_item: 'a type_iterators -> signature_item -> unit;
+ it_value_description: 'a type_iterators -> value_description -> unit;
+ it_type_declaration: 'a type_iterators -> type_declaration -> unit;
+ it_extension_constructor:
+ 'a type_iterators -> extension_constructor -> unit;
+ it_module_declaration: 'a type_iterators -> module_declaration -> unit;
+ it_modtype_declaration: 'a type_iterators -> modtype_declaration -> unit;
+ it_class_declaration: 'a type_iterators -> class_declaration -> unit;
+ it_class_type_declaration:
+ 'a type_iterators -> class_type_declaration -> unit;
+ it_functor_param: 'a type_iterators -> functor_parameter -> unit;
+ it_module_type: 'a type_iterators -> module_type -> unit;
+ it_class_type: 'a type_iterators -> class_type -> unit;
+ it_type_kind: 'a type_iterators -> type_decl_kind -> unit;
+ it_do_type_expr: 'a type_iterators -> 'a;
+ it_type_expr: 'a type_iterators -> type_expr -> unit;
it_path: Path.t -> unit; }
-val type_iterators: type_iterators
- (* Iteration on arbitrary type information.
+
+type type_iterators_full = (type_expr -> unit) type_iterators
+type type_iterators_without_type_expr = (unit -> unit) type_iterators
+
+val type_iterators: type_mark -> type_iterators_full
+ (* Iteration on arbitrary type information, including [type_expr].
[it_type_expr] calls [mark_node] to avoid loops. *)
-val unmark_iterators: type_iterators
- (* Unmark any structure containing types. See [unmark_type] below. *)
+
+val type_iterators_without_type_expr: type_iterators_without_type_expr
+ (* Iteration on arbitrary type information.
+ Cannot recurse on [type_expr]. *)
+
+(**** Utilities for copying ****)
val copy_type_desc:
?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc
@@ -184,41 +213,6 @@ module For_copy : sig
before returning its result. *)
end
-val lowest_level: int
- (* Marked type: ty.level < lowest_level *)
-
-val not_marked_node: type_expr -> bool
- (* Return true if a type node is not yet marked *)
-
-val logged_mark_node: type_expr -> unit
- (* Mark a type node, logging the marking so it can be backtracked *)
-val try_logged_mark_node: type_expr -> bool
- (* Mark a type node if it is not yet marked, logging the marking so it
- can be backtracked.
- Return false if it was already marked *)
-
-val flip_mark_node: type_expr -> unit
- (* Mark a type node.
- The marking is not logged and will have to be manually undone using
- one of the various [unmark]'ing functions below. *)
-val try_mark_node: type_expr -> bool
- (* Mark a type node if it is not yet marked.
- The marking is not logged and will have to be manually undone using
- one of the various [unmark]'ing functions below.
-
- Return false if it was already marked *)
-val mark_type: type_expr -> unit
- (* Mark a type recursively *)
-val mark_type_params: type_expr -> unit
- (* Mark the sons of a type node recursively *)
-
-val unmark_type: type_expr -> unit
-val unmark_type_decl: type_declaration -> unit
-val unmark_extension_constructor: extension_constructor -> unit
-val unmark_class_type: class_type -> unit
-val unmark_class_signature: class_signature -> unit
- (* Remove marks from a type *)
-
(**** Memorization of abbreviation expansion ****)
val find_expans: private_flag -> Path.t -> abbrev_memo -> type_expr option
@@ -266,6 +260,7 @@ val signature_of_class_type : class_type -> class_signature
(* Get the body of a class type (i.e. without parameters) *)
val class_body : class_type -> class_type
+
(* Fully expand the head of a class type *)
val scrape_class_type : class_type -> class_type
@@ -311,9 +306,6 @@ val method_type : label -> class_signature -> type_expr
@raises [Assert_failure] if the class has no such method. *)
val instance_variable_type : label -> class_signature -> type_expr
-(**** Forward declarations ****)
-val print_raw: (Format.formatter -> type_expr -> unit) ref
-
(**** Type information getter ****)
val cstr_type_path : constructor_description -> Path.t
diff --git a/src/ocaml/typing/cmt_format.ml b/src/ocaml/typing/cmt_format.ml
index 418a9d676e..4a5d2362ef 100644
--- a/src/ocaml/typing/cmt_format.ml
+++ b/src/ocaml/typing/cmt_format.ml
@@ -61,11 +61,11 @@ and binary_part =
| Partial_signature_item of signature_item
| Partial_module_type of module_type
+type dependency_kind = Definition_to_declaration | Declaration_to_declaration
type cmt_infos = {
cmt_modname : string;
cmt_annots : binary_annots;
- cmt_value_dependencies :
- (Types.value_description * Types.value_description) list;
+ cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
cmt_comments : (string * Location.t) list;
cmt_args : string array;
cmt_sourcefile : string option;
@@ -444,21 +444,19 @@ let read_cmi filename =
| Some cmi, _ -> cmi
let saved_types = ref []
-let value_deps = ref []
+let uids_deps : (dependency_kind * Uid.t * Uid.t) list ref = ref []
let clear () =
saved_types := [];
- value_deps := []
+ uids_deps := []
let add_saved_type b = saved_types := b :: !saved_types
let get_saved_types () = !saved_types
let set_saved_types l = saved_types := l
-(*let record_value_dependency vd1 vd2 =
- if vd1.Types.val_loc <> vd2.Types.val_loc then
- value_deps := (vd1, vd2) :: !value_deps*)
-
-let record_value_dependency _vd1 _vd2 = ()
+let record_declaration_dependency (rk, uid1, uid2) =
+ if not (Uid.equal uid1 uid2) then
+ uids_deps := (rk, uid1, uid2) :: !uids_deps
let save_cmt target binary_annots initial_env cmi shape =
if !Clflags.binary_annotations && not !Clflags.print_types then begin
@@ -483,7 +481,7 @@ let save_cmt target binary_annots initial_env cmi shape =
let cmt = {
cmt_modname = Unit_info.Artifact.modname target;
cmt_annots;
- cmt_value_dependencies = !value_deps;
+ cmt_declaration_dependencies = !uids_deps;
cmt_comments = [];
cmt_args = Sys.argv;
cmt_sourcefile = sourcefile;
diff --git a/src/ocaml/typing/cmt_format.mli b/src/ocaml/typing/cmt_format.mli
index c316ccc70c..9b87374a81 100644
--- a/src/ocaml/typing/cmt_format.mli
+++ b/src/ocaml/typing/cmt_format.mli
@@ -50,11 +50,11 @@ and binary_part =
| Partial_signature_item of signature_item
| Partial_module_type of module_type
+type dependency_kind = Definition_to_declaration | Declaration_to_declaration
type cmt_infos = {
cmt_modname : modname;
cmt_annots : binary_annots;
- cmt_value_dependencies :
- (Types.value_description * Types.value_description) list;
+ cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
cmt_comments : (string * Location.t) list;
cmt_args : string array;
cmt_sourcefile : string option;
@@ -109,8 +109,7 @@ val add_saved_type : binary_part -> unit
val get_saved_types : unit -> binary_part list
val set_saved_types : binary_part list -> unit
-val record_value_dependency:
- Types.value_description -> Types.value_description -> unit
+val record_declaration_dependency: dependency_kind * Uid.t * Uid.t -> unit
(*
diff --git a/src/ocaml/typing/ctype.ml b/src/ocaml/typing/ctype.ml
index 970c637a94..cdfa58f48e 100644
--- a/src/ocaml/typing/ctype.ml
+++ b/src/ocaml/typing/ctype.ml
@@ -23,16 +23,6 @@ open Errortrace
open Local_store
-(*
- Type manipulation after type inference
- ======================================
- If one wants to manipulate a type after type inference (for
- instance, during code generation or in the debugger), one must
- first make sure that the type levels are correct, using the
- function [correct_levels]. Then, this type can be correctly
- manipulated by [apply], [expand_head] and [moregeneral].
-*)
-
(*
General notes
=============
@@ -119,10 +109,11 @@ let raise_scope_escape_exn ty = raise (scope_escape_exn ty)
exception Tags of label * label
let () =
+ let open Format_doc in
Location.register_error_of_exn
(function
| Tags (l, l') ->
- let pp_tag ppf s = Format.fprintf ppf "`%s" s in
+ let pp_tag ppf s = fprintf ppf "`%s" s in
let inline_tag = Misc.Style.as_inline_code pp_tag in
Some
Location.
@@ -142,10 +133,37 @@ exception Cannot_subst
exception Cannot_unify_universal_variables
+exception Out_of_scope_universal_variable
+
exception Matches_failure of Env.t * unification_error
exception Incompatible
+(**** Control tracing of GADT instances *)
+
+let trace_gadt_instances = ref false
+let check_trace_gadt_instances ?(force=false) env =
+ not !trace_gadt_instances && (force || Env.has_local_constraints env) &&
+ (trace_gadt_instances := true; cleanup_abbrev (); true)
+
+let reset_trace_gadt_instances b =
+ if b then trace_gadt_instances := false
+
+let wrap_trace_gadt_instances ?force env f x =
+ let b = check_trace_gadt_instances ?force env in
+ Misc.try_finally (fun () -> f x)
+ ~always:(fun () -> reset_trace_gadt_instances b)
+
+(**** Abbreviations without parameters ****)
+(* Shall reset after generalizing *)
+
+let simple_abbrevs = ref Mnil
+
+let proper_abbrevs tl abbrev =
+ if tl <> [] || !trace_gadt_instances || !Clflags.principal
+ then abbrev
+ else simple_abbrevs
+
(**** Type level management ****)
let current_level = s_ref 0
@@ -186,10 +204,77 @@ let end_def () =
saved_level := List.tl !saved_level;
current_level := cl; nongen_level := nl
let create_scope () =
- init_def (!current_level + 1);
- !current_level
+ let level = !current_level + 1 in
+ init_def level;
+ level
let wrap_end_def f = Misc.try_finally f ~always:end_def
+let wrap_end_def_new_pool f =
+ wrap_end_def (fun _ -> with_new_pool ~level:!current_level f)
+
+(* [with_local_level_gen] handles both the scoping structure of levels
+ and automatic generalization through pools (cf. btype.ml) *)
+let with_local_level_gen ~begin_def ~structure ?before_generalize f =
+ begin_def ();
+ let level = !current_level in
+ let result, pool = wrap_end_def_new_pool f in
+ Option.iter (fun g -> g result) before_generalize;
+ simple_abbrevs := Mnil;
+ (* Nodes in [pool] were either created by the above call to [f],
+ or they were created before, generalized, and then added to
+ the pool by [update_level].
+ In the latter case, their level was already kept for backtracking
+ by a call to [set_level] inside [update_level].
+ Since backtracking can only go back to a snapshot taken before [f] was
+ called, this means that either they did not exists in that snapshot,
+ or that they original level is already stored, so that there is no need
+ to register levels for backtracking when we change them with
+ [Transient_expr.set_level] here *)
+ List.iter begin fun ty ->
+ (* Already generic nodes are not tracked *)
+ if ty.level = generic_level then () else
+ match ty.desc with
+ | Tvar _ when structure ->
+ (* In structure mode, we do do not generalize type variables,
+ so we need to lower their level, and move them to an outer pool.
+ The goal of this mode is to allow unsharing inner nodes
+ without introducing polymorphism *)
+ if ty.level >= level then Transient_expr.set_level ty !current_level;
+ add_to_pool ~level:ty.level ty
+ | Tlink _ -> ()
+ (* If a node is no longer used as representative, no need
+ to track it anymore *)
+ | _ ->
+ if ty.level < level then
+ (* If a node was introduced locally, but its level was lowered
+ through unification, keeping that node as representative,
+ then we need to move it to an outer pool. *)
+ add_to_pool ~level:ty.level ty
+ else begin
+ (* Generalize all remaining nodes *)
+ Transient_expr.set_level ty generic_level;
+ if structure then match ty.desc with
+ Tconstr (_, _, abbrev) ->
+ (* In structure mode, we drop abbreviations, as the goal of
+ this mode is to reduce sharing *)
+ abbrev := Mnil
+ | _ -> ()
+ end
+ end pool;
+ result
+
+let with_local_level_generalize_structure f =
+ with_local_level_gen ~begin_def ~structure:true f
+let with_local_level_generalize ?before_generalize f =
+ with_local_level_gen ~begin_def ~structure:false ?before_generalize f
+let with_local_level_generalize_if cond ?before_generalize f =
+ if cond then with_local_level_generalize ?before_generalize f else f ()
+let with_local_level_generalize_structure_if cond f =
+ if cond then with_local_level_generalize_structure f else f ()
+let with_local_level_generalize_structure_if_principal f =
+ if !Clflags.principal then with_local_level_generalize_structure f else f ()
+let with_local_level_generalize_for_class f =
+ with_local_level_gen ~begin_def:begin_class_def ~structure:false f
let with_local_level ?post f =
begin_def ();
@@ -200,7 +285,7 @@ let with_local_level_if cond f ~post =
if cond then with_local_level f ~post else f ()
let with_local_level_iter f ~post =
begin_def ();
- let result, l = wrap_end_def f in
+ let (result, l) = wrap_end_def f in
List.iter post l;
result
let with_local_level_iter_if cond f ~post =
@@ -211,8 +296,7 @@ let with_local_level_iter_if_principal f ~post =
with_local_level_iter_if !Clflags.principal f ~post
let with_level ~level f =
begin_def (); init_def level;
- let result = wrap_end_def f in
- result
+ wrap_end_def f
let with_level_if cond ~level f =
if cond then with_level ~level f else f ()
@@ -236,32 +320,6 @@ let increase_global_level () =
let restore_global_level gl =
global_level := gl
-(**** Control tracing of GADT instances *)
-
-let trace_gadt_instances = ref false
-let check_trace_gadt_instances env =
- not !trace_gadt_instances && Env.has_local_constraints env &&
- (trace_gadt_instances := true; cleanup_abbrev (); true)
-
-let reset_trace_gadt_instances b =
- if b then trace_gadt_instances := false
-
-let wrap_trace_gadt_instances env f x =
- let b = check_trace_gadt_instances env in
- let y = f x in
- reset_trace_gadt_instances b;
- y
-
-(**** Abbreviations without parameters ****)
-(* Shall reset after generalizing *)
-
-let simple_abbrevs = ref Mnil
-
-let proper_abbrevs tl abbrev =
- if tl <> [] || !trace_gadt_instances || !Clflags.principal
- then abbrev
- else simple_abbrevs
-
(**** Some type creators ****)
(* Re-export generic type creators *)
@@ -308,10 +366,6 @@ end
(**** unification mode ****)
-type equations_generation =
- | Forbidden
- | Allowed of { equated_types : TypePairs.t }
-
type unification_environment =
| Expression of
{ env : Env.t;
@@ -319,7 +373,7 @@ type unification_environment =
(* normal unification mode *)
| Pattern of
{ penv : Pattern_env.t;
- equations_generation : equations_generation;
+ equated_types : TypePairs.t;
assume_injective : bool;
unify_eq_set : TypePairs.t; }
(* GADT constraint unification mode:
@@ -366,16 +420,12 @@ let in_subst_mode = function
| Expression {in_subst} -> in_subst
| Pattern _ -> false
-let can_generate_equations = function
- | Expression _ | Pattern { equations_generation = Forbidden } -> false
- | Pattern { equations_generation = Allowed _ } -> true
-
(* Can only be called when generate_equations is true *)
let record_equation uenv t1 t2 =
match uenv with
- | Expression _ | Pattern { equations_generation = Forbidden } ->
+ | Expression _ ->
invalid_arg "Ctype.record_equation"
- | Pattern { equations_generation = Allowed { equated_types } } ->
+ | Pattern { equated_types } ->
TypePairs.add equated_types (t1, t2)
let can_assume_injective = function
@@ -397,11 +447,6 @@ let without_assume_injective uenv f =
| Expression _ as uenv -> f uenv
| Pattern r -> f (Pattern { r with assume_injective = false })
-let without_generating_equations uenv f =
- match uenv with
- | Expression _ as uenv -> f uenv
- | Pattern r -> f (Pattern { r with equations_generation = Forbidden })
-
(*** Checks for type definitions ***)
let rec in_current_module = function
@@ -551,35 +596,34 @@ let rec filter_row_fields erase = function
type variable_kind = Row_variable | Type_variable
exception Non_closed of type_expr * variable_kind
-(* [free_vars] collects the variables of the input type expression. It
+(* [free_vars] walks over the variables of the input type expression. It
is used for several different things in the type-checker, with the
following bells and whistles:
- If [env] is Some typing environment, types in the environment
are expanded to check whether the apparently-free variable would vanish
during expansion.
- - We collect both type variables and row variables, paired with
- a [variable_kind] to distinguish them.
- We do not count "virtual" free variables -- free variables stored in
the abbreviation of an object type that has been expanded (we store
the abbreviations for use when displaying the type).
- [free_vars] returns a [(variable * bool) list], while
- [free_variables] below drops the type/row information
- and only returns a [variable list].
+ [free_vars] accumulates its answer in a monoid-like structure, with
+ an initial element [zero] and a combining function [add_one], passing
+ [add_one] information about whether the variable is a normal type variable
+ or a row variable.
*)
-let free_vars ?env ty =
+let free_vars ~init ~add_one ?env mark ty =
let rec fv ~kind acc ty =
- if not (try_mark_node ty) then acc
+ if not (try_mark_node mark ty) then acc
else match get_desc ty, env with
| Tvar _, _ ->
- (ty, kind) :: acc
+ add_one ty kind acc
| Tconstr (path, tl, _), Some env ->
let acc =
match Env.find_type_expansion path env with
| exception Not_found -> acc
| (_, body, _) ->
if get_level body = generic_level then acc
- else (ty, kind) :: acc
+ else add_one ty kind acc
in
List.fold_left (fv ~kind:Type_variable) acc tl
| Tobject (ty, _), _ ->
@@ -595,29 +639,30 @@ let free_vars ?env ty =
else fv ~kind:Row_variable acc (row_more row)
| _ ->
fold_type_expr (fv ~kind) acc ty
- in fv ~kind:Type_variable [] ty
+ in fv ~kind:Type_variable init ty
let free_variables ?env ty =
- let tl = List.map fst (free_vars ?env ty) in
- unmark_type ty;
- tl
+ let add_one ty _kind acc = ty :: acc in
+ with_type_mark (fun mark -> free_vars ~init:[] ~add_one ?env mark ty)
+
+let closed_type ?env mark ty =
+ let add_one ty kind _acc = raise (Non_closed (ty, kind)) in
+ free_vars ~init:() ~add_one ?env mark ty
-let closed_type ty =
- match free_vars ty with
- [] -> ()
- | (v, real) :: _ -> raise (Non_closed (v, real))
+let closed_type_expr ?env ty =
+ with_type_mark (fun mark ->
+ try closed_type ?env mark ty; true
+ with Non_closed _ -> false)
let closed_parameterized_type params ty =
- List.iter mark_type params;
- let ok =
- try closed_type ty; true with Non_closed _ -> false in
- List.iter unmark_type params;
- unmark_type ty;
- ok
+ with_type_mark begin fun mark ->
+ List.iter (mark_type mark) params;
+ try closed_type mark ty; true with Non_closed _ -> false
+ end
let closed_type_decl decl =
- try
- List.iter mark_type decl.type_params;
+ with_type_mark begin fun mark -> try
+ List.iter (mark_type mark) decl.type_params;
begin match decl.type_kind with
Type_abstract _ ->
()
@@ -628,36 +673,35 @@ let closed_type_decl decl =
| Some _ -> ()
| None ->
match cd_args with
- | Cstr_tuple l -> List.iter closed_type l
- | Cstr_record l -> List.iter (fun l -> closed_type l.ld_type) l
+ | Cstr_tuple l -> List.iter (closed_type mark) l
+ | Cstr_record l ->
+ List.iter (fun l -> closed_type mark l.ld_type) l
)
v
| Type_record(r, _rep) ->
- List.iter (fun l -> closed_type l.ld_type) r
+ List.iter (fun l -> closed_type mark l.ld_type) r
| Type_open -> ()
end;
begin match decl.type_manifest with
None -> ()
- | Some ty -> closed_type ty
+ | Some ty -> closed_type mark ty
end;
- unmark_type_decl decl;
None
with Non_closed (ty, _) ->
- unmark_type_decl decl;
Some ty
+ end
let closed_extension_constructor ext =
- try
- List.iter mark_type ext.ext_type_params;
+ with_type_mark begin fun mark -> try
+ List.iter (mark_type mark) ext.ext_type_params;
begin match ext.ext_ret_type with
| Some _ -> ()
- | None -> iter_type_expr_cstr_args closed_type ext.ext_args
+ | None -> iter_type_expr_cstr_args (closed_type mark) ext.ext_args
end;
- unmark_extension_constructor ext;
None
with Non_closed (ty, _) ->
- unmark_extension_constructor ext;
Some ty
+ end
type closed_class_failure = {
free_variable: type_expr * variable_kind;
@@ -667,13 +711,14 @@ type closed_class_failure = {
exception CCFailure of closed_class_failure
let closed_class params sign =
- List.iter mark_type params;
- ignore (try_mark_node sign.csig_self_row);
+ with_type_mark begin fun mark ->
+ List.iter (mark_type mark) params;
+ ignore (try_mark_node mark sign.csig_self_row);
try
Meths.iter
(fun lab (priv, _, ty) ->
if priv = Mpublic then begin
- try closed_type ty with Non_closed (ty0, variable_kind) ->
+ try closed_type mark ty with Non_closed (ty0, variable_kind) ->
raise (CCFailure {
free_variable = (ty0, variable_kind);
meth = lab;
@@ -681,14 +726,10 @@ let closed_class params sign =
})
end)
sign.csig_meths;
- List.iter unmark_type params;
- unmark_class_signature sign;
None
with CCFailure reason ->
- List.iter unmark_type params;
- unmark_class_signature sign;
Some reason
-
+ end
(**********************)
(* Type duplication *)
@@ -708,76 +749,53 @@ let duplicate_class_type ty =
(* Type level manipulation *)
(*****************************)
-(*
- It would be a bit more efficient to remove abbreviation expansions
- rather than generalizing them: these expansions will usually not be
- used anymore. However, this is not possible in the general case, as
- [expand_abbrev] (via [subst]) requires these expansions to be
- preserved. Does it worth duplicating this code ?
-*)
-let rec generalize ty =
- let level = get_level ty in
- if (level > !current_level) && (level <> generic_level) then begin
- set_level ty generic_level;
- (* recur into abbrev for the speed *)
- begin match get_desc ty with
- Tconstr (_, _, abbrev) ->
- iter_abbrev generalize !abbrev
- | _ -> ()
- end;
- iter_type_expr generalize ty
- end
-let generalize ty =
- simple_abbrevs := Mnil;
- generalize ty
-
-(* Generalize the structure and lower the variables *)
-
-let rec generalize_structure ty =
- let level = get_level ty in
- if level <> generic_level then begin
- if is_Tvar ty && level > !current_level then
- set_level ty !current_level
- else if level > !current_level then begin
- begin match get_desc ty with
- Tconstr (_, _, abbrev) ->
- abbrev := Mnil
- | _ -> ()
- end;
- set_level ty generic_level;
- iter_type_expr generalize_structure ty
- end
- end
-
-let generalize_structure ty =
- simple_abbrevs := Mnil;
- generalize_structure ty
-
-(* Generalize the spine of a function, if the level >= !current_level *)
+(*
+ Build a copy of a type in which nodes reachable through a path composed
+ only of Tarrow, Tpoly, Ttuple, Tpackage and Tconstr, and whose level
+ was no lower than [!current_level], are at [generic_level].
+ This is different from [with_local_level_gen], which generalizes in place,
+ and only nodes with a level higher than [!current_level].
+ This is used for typing classes, to indicate which types have been
+ inferred in the first pass, and can be considered as "known" during the
+ second pass.
+ *)
-let rec generalize_spine ty =
- let level = get_level ty in
- if level < !current_level || level = generic_level then () else
+let rec copy_spine copy_scope ty =
match get_desc ty with
- Tarrow (_, ty1, ty2, _) ->
- set_level ty generic_level;
- generalize_spine ty1;
- generalize_spine ty2;
- | Tpoly (ty', _) ->
- set_level ty generic_level;
- generalize_spine ty'
- | Ttuple tyl ->
- set_level ty generic_level;
- List.iter generalize_spine tyl
- | Tpackage (_, fl) ->
- set_level ty generic_level;
- List.iter (fun (_n, ty) -> generalize_spine ty) fl
- | Tconstr (_, tyl, memo) ->
- set_level ty generic_level;
- memo := Mnil;
- List.iter generalize_spine tyl
- | _ -> ()
+ | Tsubst (ty, _) -> ty
+ | Tvar _
+ | Tfield _
+ | Tnil
+ | Tvariant _
+ | Tobject _
+ | Tlink _
+ | Tunivar _ -> ty
+ | (Tarrow _ | Tpoly _ | Ttuple _ | Tpackage _ | Tconstr _) as desc ->
+ let level = get_level ty in
+ if level < !current_level || level = generic_level then ty else
+ let t = newgenstub ~scope:(get_scope ty) in
+ For_copy.redirect_desc copy_scope ty (Tsubst (t, None));
+ let copy_rec = copy_spine copy_scope in
+ let desc' = match desc with
+ | Tarrow (lbl, ty1, ty2, _) ->
+ Tarrow (lbl, copy_rec ty1, copy_rec ty2, commu_ok)
+ | Tpoly (ty', tvl) ->
+ Tpoly (copy_rec ty', tvl)
+ | Ttuple tyl ->
+ Ttuple (List.map copy_rec tyl)
+ | Tpackage (path, fl) ->
+ let fl = List.map (fun (n, ty) -> n, copy_rec ty) fl in
+ Tpackage (path, fl)
+ | Tconstr (path, tyl, _) ->
+ Tconstr (path, List.map copy_rec tyl, ref Mnil)
+ | _ -> assert false
+ in
+ Transient_expr.set_stub_desc t desc';
+ t
+
+let copy_spine ty =
+ For_copy.with_scope (fun copy_scope -> copy_spine copy_scope ty)
let forward_try_expand_safe = (* Forward declaration *)
ref (fun _env _ty -> assert false)
@@ -804,35 +822,35 @@ let rec normalize_package_path env p =
normalize_package_path env (Path.Pdot (p1', s))
| _ -> p
-let rec check_scope_escape env level ty =
+let rec check_scope_escape mark env level ty =
let orig_level = get_level ty in
- if try_logged_mark_node ty then begin
+ if try_mark_node mark ty then begin
if level < get_scope ty then
raise_scope_escape_exn ty;
begin match get_desc ty with
| Tconstr (p, _, _) when level < Path.scope p ->
begin match !forward_try_expand_safe env ty with
| ty' ->
- check_scope_escape env level ty'
+ check_scope_escape mark env level ty'
| exception Cannot_expand ->
raise_escape_exn (Constructor p)
end
| Tpackage (p, fl) when level < Path.scope p ->
let p' = normalize_package_path env p in
if Path.same p p' then raise_escape_exn (Module_type p);
- check_scope_escape env level
+ check_scope_escape mark env level
(newty2 ~level:orig_level (Tpackage (p', fl)))
| _ ->
- iter_type_expr (check_scope_escape env level) ty
+ iter_type_expr (check_scope_escape mark env level) ty
end;
end
let check_scope_escape env level ty =
- let snap = snapshot () in
- try check_scope_escape env level ty; backtrack snap
+ with_type_mark begin fun mark -> try
+ check_scope_escape mark env level ty
with Escape e ->
- backtrack snap;
raise (Escape { e with context = Some ty })
+ end
let rec update_scope scope ty =
if get_scope ty < scope then begin
@@ -856,8 +874,14 @@ let update_scope_for tr_exn scope ty =
*)
let rec update_level env level expand ty =
- if get_level ty > level then begin
+ let ty_level = get_level ty in
+ if ty_level > level then begin
if level < get_scope ty then raise_scope_escape_exn ty;
+ let set_level () =
+ set_level ty level;
+ if ty_level = generic_level then
+ add_to_pool ~level (Transient_expr.repr ty)
+ in
match get_desc ty with
Tconstr(p, _tl, _abbrev) when level < Path.scope p ->
(* Try first to replace an abbreviation by its expansion. *)
@@ -884,7 +908,7 @@ let rec update_level env level expand ty =
link_type ty ty';
update_level env level expand ty'
with Cannot_expand ->
- set_level ty level;
+ set_level ();
iter_type_expr (update_level env level expand) ty
end
| Tpackage (p, fl) when level < Path.scope p ->
@@ -902,13 +926,13 @@ let rec update_level env level expand ty =
set_type_desc ty (Tvariant (set_row_name row None))
| _ -> ()
end;
- set_level ty level;
+ set_level ();
iter_type_expr (update_level env level expand) ty
| Tfield(lab, _, ty1, _)
when lab = dummy_method && level < get_scope ty1 ->
raise_escape_exn Self
| _ ->
- set_level ty level;
+ set_level ();
(* XXX what about abbreviations in Tconstr ? *)
iter_type_expr (update_level env level expand) ty
end
@@ -987,11 +1011,11 @@ let lower_contravariant env ty =
simple_abbrevs := Mnil;
lower_contravariant env !nongen_level (Hashtbl.create 7) false ty
-let rec generalize_class_type' gen =
+let rec generalize_class_type gen =
function
Cty_constr (_, params, cty) ->
List.iter gen params;
- generalize_class_type' gen cty
+ generalize_class_type gen cty
| Cty_signature csig ->
gen csig.csig_self;
gen csig.csig_self_row;
@@ -999,20 +1023,10 @@ let rec generalize_class_type' gen =
Meths.iter (fun _ (_, _, ty) -> gen ty) csig.csig_meths
| Cty_arrow (_, ty, cty) ->
gen ty;
- generalize_class_type' gen cty
-
-let generalize_class_type cty =
- generalize_class_type' generalize cty
-
-let generalize_class_type_structure cty =
- generalize_class_type' generalize_structure cty
-
-(* Correct the levels of type [ty]. *)
-let correct_levels ty =
- duplicate_type ty
+ generalize_class_type gen cty
(* Only generalize the type ty0 in ty *)
-let limited_generalize ty0 ty =
+let limited_generalize ty0 ~inside:ty =
let graph = TypeHash.create 17 in
let roots = ref [] in
@@ -1052,8 +1066,8 @@ let limited_generalize ty0 ty =
if get_level ty <> generic_level then set_level ty !current_level)
graph
-let limited_generalize_class_type rv cty =
- generalize_class_type' (limited_generalize rv) cty
+let limited_generalize_class_type rv ~inside:cty =
+ generalize_class_type (fun inside -> limited_generalize rv ~inside) cty
(* Compute statically the free univars of all nodes in a type *)
(* This avoids doing it repeatedly during instantiation *)
@@ -1096,15 +1110,14 @@ let compute_univars ty =
let fully_generic ty =
- let rec aux ty =
- if not_marked_node ty then
- if get_level ty = generic_level then
- (flip_mark_node ty; iter_type_expr aux ty)
- else raise Exit
- in
- let res = try aux ty; true with Exit -> false in
- unmark_type ty;
- res
+ with_type_mark begin fun mark ->
+ let rec aux ty =
+ if try_mark_node mark ty then
+ if get_level ty = generic_level then iter_type_expr aux ty
+ else raise Exit
+ in
+ try aux ty; true with Exit -> false
+ end
(*******************)
@@ -1261,11 +1274,7 @@ let instance ?partial sch =
copy ?partial copy_scope sch)
let generic_instance sch =
- let old = !current_level in
- current_level := generic_level;
- let ty = instance sch in
- current_level := old;
- ty
+ with_level ~level:generic_level (fun () -> instance sch)
let instance_list schl =
For_copy.with_scope (fun copy_scope ->
@@ -1306,7 +1315,7 @@ let new_local_type ?(loc = Location.none) ?manifest_and_scope origin =
type_attributes = [];
type_immediate = Unknown;
type_unboxed_default = false;
- type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
let existential_name name_counter ty =
@@ -1388,11 +1397,7 @@ let instance_declaration decl =
)
let generic_instance_declaration decl =
- let old = !current_level in
- current_level := generic_level;
- let decl = instance_declaration decl in
- current_level := old;
- decl
+ with_level ~level:generic_level (fun () -> instance_declaration decl)
let instance_class params cty =
let rec copy_class_type copy_scope = function
@@ -1533,33 +1538,31 @@ let unify_var' = (* Forward declaration *)
let subst env level priv abbrev oty params args body =
if List.length params <> List.length args then raise Cannot_subst;
- let old_level = !current_level in
- current_level := level;
- let body0 = newvar () in (* Stub *)
- let undo_abbrev =
- match oty with
- | None -> fun () -> () (* No abbreviation added *)
- | Some ty ->
- match get_desc ty with
- Tconstr (path, tl, _) ->
- let abbrev = proper_abbrevs tl abbrev in
- memorize_abbrev abbrev priv path ty body0;
- fun () -> forget_abbrev abbrev path
- | _ -> assert false
- in
- abbreviations := abbrev;
- let (params', body') = instance_parameterized_type params body in
- abbreviations := ref Mnil;
- let uenv = Expression {env; in_subst = true} in
- try
- !unify_var' uenv body0 body';
- List.iter2 (!unify_var' uenv) params' args;
- current_level := old_level;
- body'
- with Unify _ ->
- current_level := old_level;
- undo_abbrev ();
- raise Cannot_subst
+ with_level ~level begin fun () ->
+ let body0 = newvar () in (* Stub *)
+ let undo_abbrev =
+ match oty with
+ | None -> fun () -> () (* No abbreviation added *)
+ | Some ty ->
+ match get_desc ty with
+ Tconstr (path, tl, _) ->
+ let abbrev = proper_abbrevs tl abbrev in
+ memorize_abbrev abbrev priv path ty body0;
+ fun () -> forget_abbrev abbrev path
+ | _ -> assert false
+ in
+ abbreviations := abbrev;
+ let (params', body') = instance_parameterized_type params body in
+ abbreviations := ref Mnil;
+ let uenv = Expression {env; in_subst = true} in
+ try
+ !unify_var' uenv body0 body';
+ List.iter2 (!unify_var' uenv) params' args;
+ body'
+ with Unify _ ->
+ undo_abbrev ();
+ raise Cannot_subst
+ end
(*
Default to generic level. Usually, only the shape of the type matters, not
@@ -1591,6 +1594,7 @@ let check_abbrev_env env =
if not (Env.same_type_declarations env !previous_env) then begin
(* prerr_endline "cleanup expansion cache"; *)
cleanup_abbrev ();
+ simple_abbrevs := Mnil;
previous_env := env
end
@@ -1705,6 +1709,8 @@ let try_expand_safe env ty =
let rec try_expand_head
(try_once : Env.t -> type_expr -> type_expr) env ty =
let ty' = try_once env ty in
+ (* let () = Format.eprintf "BEFORE TRY_EXPAND_HEAD REC\n" in *)
+ if ty == ty' then ty' else
try try_expand_head try_once env ty'
with Cannot_expand -> ty'
@@ -1800,8 +1806,8 @@ let full_expand ~may_forget_scope env ty =
(* #10277: forget scopes when printing trace *)
with_level ~level:(get_level ty) begin fun () ->
(* The same as [expand_head], except in the failing case we return the
- *original* type, not [correct_levels ty].*)
- try try_expand_head try_expand_safe env (correct_levels ty) with
+ *original* type, not [duplicate_type ty].*)
+ try try_expand_head try_expand_safe env (duplicate_type ty) with
| Cannot_expand -> ty
end
else expand_head env ty
@@ -1953,6 +1959,17 @@ let local_non_recursive_abbrev uenv p ty =
(* Polymorphic Unification *)
(*****************************)
+(* Polymorphic unification is hard in the presence of recursive types. A
+ correctness argument for the approach below can be made by reference to
+ "Numbering matters: first-order canonical forms for second-order recursive
+ types" (ICFP'04) by Gauthier & Pottier. That work describes putting numbers
+ on nodes; we do not do that here, but instead make a decision about whether
+ to abort or continue based on the comparison of the numbers if we calculated
+ them. A different approach would actually store the relevant numbers in the
+ [Tpoly] nodes. (The algorithm here actually pre-dates that paper, which was
+ developed independently. But reading and understanding the paper will help
+ guide intuition for reading this algorithm nonetheless.) *)
+
(* Since we cannot duplicate universal variables, unification must
be done at meta-level, using bindings in univar_pairs *)
let rec unify_univar t1 t2 = function
@@ -1972,23 +1989,32 @@ let rec unify_univar t1 t2 = function
| _ ->
raise Cannot_unify_universal_variables
end
- | [] -> raise Cannot_unify_universal_variables
+ | [] ->
+ raise Out_of_scope_universal_variable
(* The same as [unify_univar], but raises the appropriate exception instead of
[Cannot_unify_universal_variables] *)
-let unify_univar_for tr_exn t1 t2 univar_pairs =
- try unify_univar t1 t2 univar_pairs
- with Cannot_unify_universal_variables -> raise_unexplained_for tr_exn
+let unify_univar_for (type a) (tr_exn : a trace_exn) t1 t2 univar_pairs =
+ try unify_univar t1 t2 univar_pairs with
+ | Cannot_unify_universal_variables -> raise_unexplained_for tr_exn
+ | Out_of_scope_universal_variable ->
+ (* Allow unscoped univars when checking for equality, since one
+ might want to compare arbitrary subparts of types, ignoring scopes;
+ see Typedecl_variance (#13514) for instance *)
+ match tr_exn with
+ | Equality -> raise_unexplained_for tr_exn
+ | _ -> fatal_error "Ctype.unify_univar_for: univar not in scope"
(* Test the occurrence of free univars in a type *)
(* That's way too expensive. Must do some kind of caching *)
(* If [inj_only=true], only check injective positions *)
let occur_univar ?(inj_only=false) env ty =
let visited = ref TypeMap.empty in
+ with_type_mark begin fun mark ->
let rec occur_rec bound ty =
- if not_marked_node ty then
+ if not_marked_node mark ty then
if TypeSet.is_empty bound then
- (flip_mark_node ty; occur_desc bound ty)
+ (ignore (try_mark_node mark ty); occur_desc bound ty)
else try
let bound' = TypeMap.find ty !visited in
if not (TypeSet.subset bound' bound) then begin
@@ -2027,10 +2053,8 @@ let occur_univar ?(inj_only=false) env ty =
end
| _ -> iter_type_expr (occur_rec bound) ty
in
- Misc.try_finally (fun () ->
- occur_rec TypeSet.empty ty
- )
- ~always:(fun () -> unmark_type ty)
+ occur_rec TypeSet.empty ty
+ end
let has_free_univars env ty =
try occur_univar ~inj_only:false env ty; false with Escape _ -> true
@@ -2061,10 +2085,9 @@ let get_univar_family univar_pairs univars =
(* Whether a family of univars escapes from a type *)
let univars_escape env univar_pairs vl ty =
let family = get_univar_family univar_pairs vl in
- let visited = ref TypeSet.empty in
+ with_type_mark begin fun mark ->
let rec occur t =
- if TypeSet.mem t !visited then () else begin
- visited := TypeSet.add t !visited;
+ if try_mark_node mark t then begin
match get_desc t with
Tpoly (t, tl) ->
if List.exists (fun t -> TypeSet.mem t family) tl then ()
@@ -2086,9 +2109,18 @@ let univars_escape env univar_pairs vl ty =
end
in
occur ty
+ end
+
+let univar_pairs = ref []
+
+let with_univar_pairs pairs f =
+ let old = !univar_pairs in
+ univar_pairs := pairs;
+ Misc.try_finally f
+ ~always:(fun () -> univar_pairs := old)
(* Wrapper checking that no variable escapes and updating univar_pairs *)
-let enter_poly env univar_pairs t1 tl1 t2 tl2 f =
+let enter_poly env t1 tl1 t2 tl2 f =
let old_univars = !univar_pairs in
let known_univars =
List.fold_left (fun s (cl,_) -> add_univars s cl)
@@ -2100,17 +2132,15 @@ let enter_poly env univar_pairs t1 tl1 t2 tl2 f =
univars_escape env old_univars tl2 (newty(Tpoly(t1,tl1)));
let cl1 = List.map (fun t -> t, ref None) tl1
and cl2 = List.map (fun t -> t, ref None) tl2 in
- univar_pairs := (cl1,cl2) :: (cl2,cl1) :: old_univars;
- Misc.try_finally (fun () -> f t1 t2)
- ~always:(fun () -> univar_pairs := old_univars)
+ with_univar_pairs
+ ((cl1,cl2) :: (cl2,cl1) :: old_univars)
+ (fun () -> f t1 t2)
-let enter_poly_for tr_exn env univar_pairs t1 tl1 t2 tl2 f =
+let enter_poly_for tr_exn env t1 tl1 t2 tl2 f =
try
- enter_poly env univar_pairs t1 tl1 t2 tl2 f
+ enter_poly env t1 tl1 t2 tl2 f
with Escape e -> raise_for tr_exn (Escape e)
-let univar_pairs = ref []
-
(**** Instantiate a generic type into a poly type ***)
let polyfy env ty vars =
@@ -2197,16 +2227,18 @@ let unexpanded_diff ~got ~expected =
(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
let deep_occur t0 ty =
+ with_type_mark begin fun mark ->
let rec occur_rec ty =
- if get_level ty >= get_level t0 && try_mark_node ty then begin
+ if get_level ty >= get_level t0 && try_mark_node mark ty then begin
if eq_type ty t0 then raise Occur;
iter_type_expr occur_rec ty
end
in
try
- occur_rec ty; unmark_type ty; false
+ occur_rec ty; false
with Occur ->
- unmark_type ty; true
+ true
+ end
(* A local constraint can be added only if the rhs
@@ -2291,6 +2323,21 @@ let compatible_paths p1 p2 =
Path.same p1 path_bytes && Path.same p2 path_string ||
Path.same p1 path_string && Path.same p2 path_bytes
+(* Two labels are considered compatible under certain conditions.
+ - they are the same
+ - in classic mode, only optional labels are relavant
+ - in pattern mode, we act as if we were in classic mode. If not, interactions
+ with GADTs from files compiled in classic mode would be unsound.
+*)
+let compatible_labels ~in_pattern_mode l1 l2 =
+ l1 = l2
+ || (!Clflags.classic || in_pattern_mode)
+ && not (is_optional l1 || is_optional l2)
+
+let eq_labels error_mode ~in_pattern_mode l1 l2 =
+ if not (compatible_labels ~in_pattern_mode l1 l2) then
+ raise_for error_mode (Function_label_mismatch {got=l1; expected=l2})
+
(* Check for datatypes carefully; see PR#6348 *)
let rec expands_to_datatype env ty =
match get_desc ty with
@@ -2302,12 +2349,21 @@ let rec expands_to_datatype env ty =
end
| _ -> false
-(* [mcomp] tests if two types are "compatible" -- i.e., if they could ever
- unify. (This is distinct from [eqtype], which checks if two types *are*
- exactly the same.) This is used to decide whether GADT cases are
- unreachable. It is broadly part of unification. *)
+(* [mcomp] tests if two types are "compatible" -- i.e., if there could
+ exist a witness of their equality. This is distinct from [eqtype],
+ which checks if two types *are* exactly the same.
+ [mcomp] is used to decide whether GADT cases are unreachable.
+ The existence of a witness is necessarily an incomplete property,
+ i.e. there exists types for which we cannot tell if an equality
+ witness could exist or not. Typically, this is the case for
+ abstract types, which could be equal to anything, depending on
+ their actual definition. As a result [mcomp] overapproximates
+ compatibilty, i.e. when it says that two types are incompatible, we
+ are sure that there exists no equality witness, but if it does not
+ say so, there is no guarantee that such a witness could exist.
+ *)
-(* mcomp type_pairs subst env t1 t2 does not raise an
+(* [mcomp type_pairs subst env t1 t2] should not raise an
exception if it is possible that t1 and t2 are actually
equal, assuming the types in type_pairs are equal and
that the mapping subst holds.
@@ -2335,7 +2391,7 @@ let rec mcomp type_pairs env t1 t2 =
| (_, Tvar _) ->
()
| (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _))
- when l1 = l2 || not (is_optional l1 || is_optional l2) ->
+ when compatible_labels ~in_pattern_mode:true l1 l2 ->
mcomp type_pairs env t1 t2;
mcomp type_pairs env u1 u2;
| (Ttuple tl1, Ttuple tl2) ->
@@ -2370,12 +2426,14 @@ let rec mcomp type_pairs env t1 t2 =
mcomp type_pairs env t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
(try
- enter_poly env univar_pairs
+ enter_poly env
t1 tl1 t2 tl2 (mcomp type_pairs env)
with Escape _ -> raise Incompatible)
| (Tunivar _, Tunivar _) ->
- (try unify_univar t1' t2' !univar_pairs
- with Cannot_unify_universal_variables -> raise Incompatible)
+ begin try unify_univar t1' t2' !univar_pairs with
+ | Cannot_unify_universal_variables -> raise Incompatible
+ | Out_of_scope_universal_variable -> ()
+ end
| (_, _) ->
raise Incompatible
end
@@ -2517,14 +2575,16 @@ let mcomp_for tr_exn env t1 t2 =
let find_lowest_level ty =
let lowest = ref generic_level in
- let rec find ty =
- if not_marked_node ty then begin
- let level = get_level ty in
- if level < !lowest then lowest := level;
- flip_mark_node ty;
- iter_type_expr find ty
- end
- in find ty; unmark_type ty; !lowest
+ with_type_mark begin fun mark ->
+ let rec find ty =
+ if try_mark_node mark ty then begin
+ let level = get_level ty in
+ if level < !lowest then lowest := level;
+ iter_type_expr find ty
+ end
+ in find ty
+ end;
+ !lowest
(* This function can be called only in [Pattern] mode. *)
let add_gadt_equation uenv source destination =
@@ -2571,11 +2631,7 @@ let rec concat_longident lid1 =
let nondep_instance env level id ty =
let ty = !nondep_type' env [id] ty in
if level = generic_level then duplicate_type ty else
- let old = !current_level in
- current_level := level;
- let ty = instance ty in
- current_level := old;
- ty
+ with_level ~level (fun () -> instance ty)
(* Find the type paths nl1 in the module type mty2, and add them to the
list (nl2, tl2). raise Not_found if impossible *)
@@ -2627,10 +2683,10 @@ let unify_package env unify_list lv1 p1 fl1 lv2 p2 fl2 =
let ntl2 = complete_type_list env fl1 lv2 (Mty_ident p2) fl2
and ntl1 = complete_type_list env fl2 lv1 (Mty_ident p1) fl1 in
unify_list (List.map snd ntl1) (List.map snd ntl2);
- if eq_package_path env p1 p2
- || !package_subtype env p1 fl1 p2 fl2
- && !package_subtype env p2 fl2 p1 fl1 then () else raise Not_found
-
+ if eq_package_path env p1 p2 then Ok ()
+ else Result.bind
+ (!package_subtype env p1 fl1 p2 fl2)
+ (fun () -> !package_subtype env p2 fl2 p1 fl1)
(* force unification in Reither when one side has a non-conjunctive type *)
(* Code smell: this could also be put in unification_environment.
@@ -2664,10 +2720,8 @@ let unify3_var uenv t1' t2 t2' =
| exception Unify_trace _ when in_pattern_mode uenv ->
reify uenv t1';
reify uenv t2';
- if can_generate_equations uenv then begin
- occur_univar ~inj_only:true (get_env uenv) t2';
- record_equation uenv t1' t2';
- end
+ occur_univar ~inj_only:true (get_env uenv) t2';
+ record_equation uenv t1' t2'
(*
1. When unifying two non-abbreviated types, one type is made a link
@@ -2814,9 +2868,8 @@ and unify3 uenv t1 t1' t2 t2' =
end;
try
begin match (d1, d2) with
- (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) when l1 = l2 ||
- (!Clflags.classic || in_pattern_mode uenv) &&
- not (is_optional l1 || is_optional l2) ->
+ (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) ->
+ eq_labels Unify ~in_pattern_mode:(in_pattern_mode uenv) l1 l2;
unify uenv t1 t2; unify uenv u1 u2;
begin match is_commu_ok c1, is_commu_ok c2 with
| false, true -> set_commu_ok c1
@@ -2827,7 +2880,7 @@ and unify3 uenv t1 t1' t2 t2' =
| (Ttuple tl1, Ttuple tl2) ->
unify_list uenv tl1 tl2
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
- if not (can_generate_equations uenv) then
+ if not (in_pattern_mode uenv) then
unify_list uenv tl1 tl2
else if can_assume_injective uenv then
without_assume_injective uenv (fun uenv -> unify_list uenv tl1 tl2)
@@ -2843,21 +2896,16 @@ and unify3 uenv t1 t1' t2 t2' =
in
List.iter2
(fun i (t1, t2) ->
- if i then unify uenv t1 t2 else
- without_generating_equations uenv
- begin fun uenv ->
- let snap = snapshot () in
- try unify uenv t1 t2 with Unify_trace _ ->
- backtrack snap;
- reify uenv t1;
- reify uenv t2
- end)
+ if i then unify uenv t1 t2 else begin
+ reify uenv t1;
+ reify uenv t2
+ end)
inj (List.combine tl1 tl2)
| (Tconstr (path,[],_),
Tconstr (path',[],_))
- when let env = get_env uenv in
- is_instantiable env path && is_instantiable env path'
- && can_generate_equations uenv ->
+ when in_pattern_mode uenv &&
+ let env = get_env uenv in
+ is_instantiable env path && is_instantiable env path' ->
let source, destination =
if Path.scope path > Path.scope path'
then path , t2'
@@ -2866,24 +2914,20 @@ and unify3 uenv t1 t1' t2 t2' =
record_equation uenv t1' t2';
add_gadt_equation uenv source destination
| (Tconstr (path,[],_), _)
- when is_instantiable (get_env uenv) path
- && can_generate_equations uenv ->
+ when in_pattern_mode uenv && is_instantiable (get_env uenv) path ->
reify uenv t2';
record_equation uenv t1' t2';
add_gadt_equation uenv path t2'
| (_, Tconstr (path,[],_))
- when is_instantiable (get_env uenv) path
- && can_generate_equations uenv ->
+ when in_pattern_mode uenv && is_instantiable (get_env uenv) path ->
reify uenv t1';
record_equation uenv t1' t2';
add_gadt_equation uenv path t1'
| (Tconstr (_,_,_), _) | (_, Tconstr (_,_,_)) when in_pattern_mode uenv ->
reify uenv t1';
reify uenv t2';
- if can_generate_equations uenv then (
- mcomp_for Unify (get_env uenv) t1' t2';
- record_equation uenv t1' t2'
- )
+ mcomp_for Unify (get_env uenv) t1' t2';
+ record_equation uenv t1' t2'
| (Tobject (fi1, nm1), Tobject (fi2, _)) ->
unify_fields uenv fi1 fi2;
(* Type [t2'] may have been instantiated by [unify_fields] *)
@@ -2905,10 +2949,8 @@ and unify3 uenv t1 t1' t2 t2' =
backtrack snap;
reify uenv t1';
reify uenv t2';
- if can_generate_equations uenv then (
- mcomp_for Unify (get_env uenv) t1' t2';
- record_equation uenv t1' t2'
- )
+ mcomp_for Unify (get_env uenv) t1' t2';
+ record_equation uenv t1' t2'
end
| (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
begin match field_kind_repr kind with
@@ -2929,13 +2971,19 @@ and unify3 uenv t1 t1' t2 t2' =
| (Tpoly (t1, []), Tpoly (t2, [])) ->
unify uenv t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
- enter_poly_for Unify (get_env uenv) univar_pairs t1 tl1 t2 tl2
+ enter_poly_for Unify (get_env uenv) t1 tl1 t2 tl2
(unify uenv)
| (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
- begin try
+ begin match
unify_package (get_env uenv) (unify_list uenv)
(get_level t1) p1 fl1 (get_level t2) p2 fl2
- with Not_found ->
+ with
+ | Ok () -> ()
+ | Error fm_err ->
+ if not (in_pattern_mode uenv) then
+ raise_for Unify (Errortrace.First_class_module fm_err);
+ List.iter (fun (_n, ty) -> reify uenv ty) (fl1 @ fl2);
+ | exception Not_found ->
if not (in_pattern_mode uenv) then raise_unexplained_for Unify;
List.iter (fun (_n, ty) -> reify uenv ty) (fl1 @ fl2);
(* if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 *)
@@ -3249,17 +3297,29 @@ let unify uenv ty1 ty2 =
raise (Unify (expand_to_unification_error (get_env uenv) trace))
let unify_gadt (penv : Pattern_env.t) ty1 ty2 =
- univar_pairs := [];
let equated_types = TypePairs.create 0 in
- let equations_generation = Allowed { equated_types } in
- let uenv = Pattern
- { penv;
- equations_generation;
- assume_injective = true;
- unify_eq_set = TypePairs.create 11; }
+ let do_unify_gadt () =
+ let uenv = Pattern
+ { penv;
+ equated_types;
+ assume_injective = true;
+ unify_eq_set = TypePairs.create 11; }
+ in
+ unify uenv ty1 ty2;
+ equated_types
in
- unify uenv ty1 ty2;
- equated_types
+ let no_leak = penv.allow_recursive_equations || closed_type_expr ty2 in
+ if no_leak then with_univar_pairs [] do_unify_gadt else
+ let snap = Btype.snapshot () in
+ try
+ (* If there are free variables, first try normal unification *)
+ let uenv = Expression {env = penv.env; in_subst = false} in
+ with_univar_pairs [] (fun () -> unify uenv ty1 ty2);
+ equated_types
+ with Unify _ ->
+ (* If it fails, retry in pattern mode *)
+ Btype.backtrack snap;
+ with_univar_pairs [] do_unify_gadt
let unify_var uenv t1 t2 =
if eq_type t1 t2 then () else
@@ -3291,8 +3351,8 @@ let unify_var env ty1 ty2 =
unify_var (Expression {env; in_subst = false}) ty1 ty2
let unify_pairs env ty1 ty2 pairs =
- univar_pairs := pairs;
- unify (Expression {env; in_subst = false}) ty1 ty2
+ with_univar_pairs pairs (fun () ->
+ unify (Expression {env; in_subst = false}) ty1 ty2)
let unify env ty1 ty2 =
unify_pairs env ty1 ty2 []
@@ -3704,40 +3764,35 @@ let close_class_signature env sign =
let self = expand_head env sign.csig_self in
close env (object_fields self)
-let generalize_class_signature_spine env sign =
+let generalize_class_signature_spine sign =
(* Generalize the spine of methods *)
- let meths = sign.csig_meths in
- Meths.iter (fun _ (_, _, ty) -> generalize_spine ty) meths;
- let new_meths =
- Meths.map
- (fun (priv, virt, ty) -> (priv, virt, generic_instance ty))
- meths
- in
- (* But keep levels correct on the type of self *)
- Meths.iter
- (fun _ (_, _, ty) -> unify_var env (newvar ()) ty)
- meths;
- sign.csig_meths <- new_meths
+ sign.csig_meths <-
+ Meths.map (fun (priv, virt, ty) -> priv, virt, copy_spine ty)
+ sign.csig_meths
(***********************************)
(* Matching between type schemes *)
(***********************************)
+(* Level of the subject, should be just below generic_level *)
+let subject_level = generic_level - 1
+
(*
Update the level of [ty]. First check that the levels of generic
variables from the subject are not lowered.
*)
let moregen_occur env level ty =
- let rec occur ty =
- let lv = get_level ty in
- if lv <= level then () else
- if is_Tvar ty && lv >= generic_level - 1 then raise Occur else
- if try_mark_node ty then iter_type_expr occur ty
- in
- begin try
- occur ty; unmark_type ty
- with Occur ->
- unmark_type ty; raise_unexplained_for Moregen
+ with_type_mark begin fun mark ->
+ let rec occur ty =
+ let lv = get_level ty in
+ if lv <= level then () else
+ if is_Tvar ty && lv >= subject_level then raise Occur else
+ if try_mark_node mark ty then iter_type_expr occur ty
+ in
+ try
+ occur ty
+ with Occur ->
+ raise_unexplained_for Moregen
end;
(* also check for free univars *)
occur_univar_for Moregen env ty;
@@ -3745,7 +3800,7 @@ let moregen_occur env level ty =
let may_instantiate inst_nongen t1 =
let level = get_level t1 in
- if inst_nongen then level <> generic_level - 1
+ if inst_nongen then level <> subject_level
else level = generic_level
let rec moregen inst_nongen type_pairs env t1 t2 =
@@ -3772,8 +3827,8 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
moregen_occur env (get_level t1') t2;
update_scope_for Moregen (get_scope t1') t2;
link_type t1' t2
- | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
- || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+ | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) ->
+ eq_labels Moregen ~in_pattern_mode:false l1 l2;
moregen inst_nongen type_pairs env t1 t2;
moregen inst_nongen type_pairs env u1 u2
| (Ttuple tl1, Ttuple tl2) ->
@@ -3782,10 +3837,13 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
when Path.same p1 p2 ->
moregen_list inst_nongen type_pairs env tl1 tl2
| (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
- begin try
+ begin match
unify_package env (moregen_list inst_nongen type_pairs env)
(get_level t1') p1 fl1 (get_level t2') p2 fl2
- with Not_found -> raise_unexplained_for Moregen
+ with
+ | Ok () -> ()
+ | Error fme -> raise_for Moregen (First_class_module fme)
+ | exception Not_found -> raise_unexplained_for Moregen
end
| (Tnil, Tconstr _ ) -> raise_for Moregen (Obj (Abstract_row Second))
| (Tconstr _, Tnil ) -> raise_for Moregen (Obj (Abstract_row First))
@@ -3801,7 +3859,7 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
| (Tpoly (t1, []), Tpoly (t2, [])) ->
moregen inst_nongen type_pairs env t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
- enter_poly_for Moregen env univar_pairs t1 tl1 t2 tl2
+ enter_poly_for Moregen env t1 tl1 t2 tl2
(moregen inst_nongen type_pairs env)
| (Tunivar _, Tunivar _) ->
unify_univar_for Moregen t1' t2' !univar_pairs
@@ -3964,8 +4022,8 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
(* Must empty univar_pairs first *)
let moregen inst_nongen type_pairs env patt subj =
- univar_pairs := [];
- moregen inst_nongen type_pairs env patt subj
+ with_univar_pairs [] (fun () ->
+ moregen inst_nongen type_pairs env patt subj)
(*
Non-generic variable can be instantiated only if [inst_nongen] is
@@ -3976,37 +4034,37 @@ let moregen inst_nongen type_pairs env patt subj =
is unimportant. So, no need to propagate abbreviations.
*)
let moregeneral env inst_nongen pat_sch subj_sch =
- let old_level = !current_level in
- current_level := generic_level - 1;
- (*
- Generic variables are first duplicated with [instance]. So,
- their levels are lowered to [generic_level - 1]. The subject is
- then copied with [duplicate_type]. That way, its levels won't be
- changed.
- *)
- let subj_inst = instance subj_sch in
- let subj = duplicate_type subj_inst in
- current_level := generic_level;
- (* Duplicate generic variables *)
- let patt = instance pat_sch in
-
- Misc.try_finally
- (fun () ->
- try
- moregen inst_nongen (TypePairs.create 13) env patt subj
- with Moregen_trace trace ->
- (* Moregen splits the generic level into two finer levels:
- [generic_level] and [generic_level - 1]. In order to properly
- detect and print weak variables when printing this error, we need to
- merge them back together, by regeneralizing the levels of the types
- after they were instantiated at [generic_level - 1] above. Because
- [moregen] does some unification that we need to preserve for more
- legible error messages, we have to manually perform the
- regeneralization rather than backtracking. *)
- current_level := generic_level - 2;
- generalize subj_inst;
- raise (Moregen (expand_to_moregen_error env trace)))
- ~always:(fun () -> current_level := old_level)
+ (* Moregen splits the generic level into two finer levels:
+ [generic_level] and [subject_level = generic_level - 1].
+ In order to properly detect and print weak variables when
+ printing errors, we need to merge those levels back together.
+ We do that by starting at level [subject_level - 1], using
+ [with_local_level_generalize] to first set the current level
+ to [subject_level], and then generalize nodes at [subject_level]
+ on exit.
+ Strictly speaking, we could avoid generalizing when there is no error,
+ as nodes at level [subject_level] are never unified with nodes of
+ the original types, but that would be rather ad hoc.
+ *)
+ with_level ~level:(subject_level - 1) begin fun () ->
+ match with_local_level_generalize begin fun () ->
+ assert (!current_level = subject_level);
+ (*
+ Generic variables are first duplicated with [instance]. So,
+ their levels are lowered to [subject_level]. The subject is
+ then copied with [duplicate_type]. That way, its levels won't be
+ changed.
+ *)
+ let subj_inst = instance subj_sch in
+ let subj = duplicate_type subj_inst in
+ (* Duplicate generic variables *)
+ let patt = generic_instance pat_sch in
+ try Ok (moregen inst_nongen (TypePairs.create 13) env patt subj)
+ with Moregen_trace trace -> Error trace
+ end with
+ | Ok () -> ()
+ | Error trace -> raise (Moregen (expand_to_moregen_error env trace))
+ end
let is_moregeneral env inst_nongen pat_sch subj_sch =
match moregeneral env inst_nongen pat_sch subj_sch with
@@ -4017,8 +4075,8 @@ let is_moregeneral env inst_nongen pat_sch subj_sch =
and check validity after unification *)
(* Simpler, no? *)
-let rec rigidify_rec vars ty =
- if try_mark_node ty then
+let rec rigidify_rec mark vars ty =
+ if try_mark_node mark ty then
begin match get_desc ty with
| Tvar _ ->
if not (TypeSet.mem ty !vars) then vars := TypeSet.add ty !vars
@@ -4031,18 +4089,17 @@ let rec rigidify_rec vars ty =
~name ~closed
in link_type more (newty2 ~level:(get_level ty) (Tvariant row'))
end;
- iter_row (rigidify_rec vars) row;
+ iter_row (rigidify_rec mark vars) row;
(* only consider the row variable if the variant is not static *)
if not (static_row row) then
- rigidify_rec vars (row_more row)
+ rigidify_rec mark vars (row_more row)
| _ ->
- iter_type_expr (rigidify_rec vars) ty
+ iter_type_expr (rigidify_rec mark vars) ty
end
let rigidify ty =
let vars = ref TypeSet.empty in
- rigidify_rec vars ty;
- unmark_type ty;
+ with_type_mark (fun mark -> rigidify_rec mark vars ty);
TypeSet.elements !vars
let all_distinct_vars env vars =
@@ -4104,8 +4161,18 @@ let eqtype_subst type_pairs subst t1 t2 =
end
let rec eqtype rename type_pairs subst env t1 t2 =
- if eq_type t1 t2 then () else
+ let check_phys_eq t1 t2 =
+ not rename && eq_type t1 t2
+ in
+ (* Checking for physical equality of type representatives when [rename] is
+ true would be incorrect: imagine comparing ['a * 'a] with ['b * 'a]. The
+ first ['a] and ['b] would be identified in [eqtype_subst], and then the
+ second ['a] and ['a] would be [eq_type]. So we do not call [eq_type] here.
+ On the other hand, when [rename] is false we need to check for physical
+ equality, as that's the only way variables can be identified.
+ *)
+ if check_phys_eq t1 t2 then () else
try
match (get_desc t1, get_desc t2) with
(Tvar _, Tvar _) when rename ->
@@ -4116,26 +4183,29 @@ let rec eqtype rename type_pairs subst env t1 t2 =
let t1' = expand_head_rigid env t1 in
let t2' = expand_head_rigid env t2 in
(* Expansion may have changed the representative of the types... *)
- if eq_type t1' t2' then () else
+ if check_phys_eq t1' t2' then () else
if not (TypePairs.mem type_pairs (t1', t2')) then begin
TypePairs.add type_pairs (t1', t2');
match (get_desc t1', get_desc t2') with
(Tvar _, Tvar _) when rename ->
eqtype_subst type_pairs subst t1' t2'
- | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
- || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+ | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) ->
+ eq_labels Equality ~in_pattern_mode:false l1 l2;
eqtype rename type_pairs subst env t1 t2;
- eqtype rename type_pairs subst env u1 u2;
+ eqtype rename type_pairs subst env u1 u2
| (Ttuple tl1, Ttuple tl2) ->
eqtype_list rename type_pairs subst env tl1 tl2
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
when Path.same p1 p2 ->
- eqtype_list rename type_pairs subst env tl1 tl2
+ eqtype_list_same_length rename type_pairs subst env tl1 tl2
| (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
- begin try
+ begin match
unify_package env (eqtype_list rename type_pairs subst env)
(get_level t1') p1 fl1 (get_level t2') p2 fl2
- with Not_found -> raise_unexplained_for Equality
+ with
+ | Ok () -> ()
+ | Error fme -> raise_for Equality (First_class_module fme)
+ | exception Not_found -> raise_unexplained_for Equality
end
| (Tnil, Tconstr _ ) ->
raise_for Equality (Obj (Abstract_row Second))
@@ -4153,7 +4223,7 @@ let rec eqtype rename type_pairs subst env t1 t2 =
| (Tpoly (t1, []), Tpoly (t2, [])) ->
eqtype rename type_pairs subst env t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
- enter_poly_for Equality env univar_pairs t1 tl1 t2 tl2
+ enter_poly_for Equality env t1 tl1 t2 tl2
(eqtype rename type_pairs subst env)
| (Tunivar _, Tunivar _) ->
unify_univar_for Equality t1' t2' !univar_pairs
@@ -4163,17 +4233,22 @@ let rec eqtype rename type_pairs subst env t1 t2 =
with Equality_trace trace ->
raise_trace_for Equality (Diff {got = t1; expected = t2} :: trace)
+and eqtype_list_same_length rename type_pairs subst env tl1 tl2 =
+ List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+
and eqtype_list rename type_pairs subst env tl1 tl2 =
if List.length tl1 <> List.length tl2 then
raise_unexplained_for Equality;
- List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+ eqtype_list_same_length rename type_pairs subst env tl1 tl2
and eqtype_fields rename type_pairs subst env ty1 ty2 =
let (fields1, rest1) = flatten_fields ty1 in
let (fields2, rest2) = flatten_fields ty2 in
(* First check if same row => already equal *)
let same_row =
- eq_type rest1 rest2 || TypePairs.mem type_pairs (rest1,rest2)
+ (* [not rename]: see comment at top of [eqtype] *)
+ (not rename && eq_type rest1 rest2) ||
+ TypePairs.mem type_pairs (rest1,rest2)
in
if same_row then () else
(* Try expansion, needed when called from Includecore.type_manifest *)
@@ -4288,20 +4363,23 @@ and eqtype_row rename type_pairs subst env row1 row2 =
pairs
(* Must empty univar_pairs first *)
-let eqtype_list rename type_pairs subst env tl1 tl2 =
- univar_pairs := [];
- let snap = Btype.snapshot () in
- Misc.try_finally
- ~always:(fun () -> backtrack snap)
- (fun () -> eqtype_list rename type_pairs subst env tl1 tl2)
+let eqtype_list_same_length rename type_pairs subst env tl1 tl2 =
+ with_univar_pairs [] (fun () ->
+ let snap = Btype.snapshot () in
+ Misc.try_finally
+ ~always:(fun () -> backtrack snap)
+ (fun () -> eqtype_list_same_length rename type_pairs subst env tl1 tl2))
let eqtype rename type_pairs subst env t1 t2 =
- eqtype_list rename type_pairs subst env [t1] [t2]
+ eqtype_list_same_length rename type_pairs subst env [t1] [t2]
(* Two modes: with or without renaming of variables *)
let equal env rename tyl1 tyl2 =
+ if List.length tyl1 <> List.length tyl2 then
+ raise_unexplained_for Equality;
+ if List.for_all2 eq_type tyl1 tyl2 then () else
let subst = ref [] in
- try eqtype_list rename (TypePairs.create 11) subst env tyl1 tyl2
+ try eqtype_list_same_length rename (TypePairs.create 11) subst env tyl1 tyl2
with Equality_trace trace ->
raise (Equality (expand_to_equality_error env trace !subst))
@@ -4465,48 +4543,48 @@ let match_class_types ?(trace=true) env pat_sch subj_sch =
let errors = match_class_sig_shape ~strict:false sign1 sign2 in
match errors with
| [] ->
- let old_level = !current_level in
- current_level := generic_level - 1;
- (*
- Generic variables are first duplicated with [instance]. So,
- their levels are lowered to [generic_level - 1]. The subject is
- then copied with [duplicate_type]. That way, its levels won't be
- changed.
- *)
- let (_, subj_inst) = instance_class [] subj_sch in
- let subj = duplicate_class_type subj_inst in
- current_level := generic_level;
- (* Duplicate generic variables *)
- let (_, patt) = instance_class [] pat_sch in
- let type_pairs = TypePairs.create 53 in
- let sign1 = signature_of_class_type patt in
- let sign2 = signature_of_class_type subj in
- let self1 = sign1.csig_self in
- let self2 = sign2.csig_self in
- let row1 = sign1.csig_self_row in
- let row2 = sign2.csig_self_row in
- TypePairs.add type_pairs (self1, self2);
- (* Always succeeds *)
- moregen true type_pairs env row1 row2;
- let res =
- match moregen_clty trace type_pairs env patt subj with
- | () -> []
- | exception Failure res ->
- (* We've found an error. Moregen splits the generic level into two
- finer levels: [generic_level] and [generic_level - 1]. In order
- to properly detect and print weak variables when printing this
- error, we need to merge them back together, by regeneralizing the
- levels of the types after they were instantiated at
- [generic_level - 1] above. Because [moregen] does some
- unification that we need to preserve for more legible error
- messages, we have to manually perform the regeneralization rather
- than backtracking. *)
- current_level := generic_level - 2;
- generalize_class_type subj_inst;
- res
- in
- current_level := old_level;
- res
+ (* Moregen splits the generic level into two finer levels:
+ [generic_level] and [subject_level = generic_level - 1].
+ In order to properly detect and print weak variables when
+ printing errors, we need to merge those levels back together.
+ We do that by starting at level [subject_level - 1], using
+ [with_local_level_generalize] to first set the current level
+ to [subject_level], and then generalize nodes at [subject_level]
+ on exit.
+ Strictly speaking, we could avoid generalizing when there is no error,
+ as nodes at level [subject_level] are never unified with nodes of
+ the original types, but that would be rather ad hoc.
+ *)
+ with_level ~level:(subject_level - 1) begin fun () ->
+ with_local_level_generalize begin fun () ->
+ assert (!current_level = subject_level);
+ (*
+ Generic variables are first duplicated with [instance]. So,
+ their levels are lowered to [subject_level]. The subject is
+ then copied with [duplicate_type]. That way, its levels won't be
+ changed.
+ *)
+ let (_, subj_inst) = instance_class [] subj_sch in
+ let subj = duplicate_class_type subj_inst in
+ (* Duplicate generic variables *)
+ let (_, patt) =
+ with_level ~level:generic_level
+ (fun () -> instance_class [] pat_sch) in
+ let type_pairs = TypePairs.create 53 in
+ let sign1 = signature_of_class_type patt in
+ let sign2 = signature_of_class_type subj in
+ let self1 = sign1.csig_self in
+ let self2 = sign2.csig_self in
+ let row1 = sign1.csig_self_row in
+ let row2 = sign2.csig_self_row in
+ TypePairs.add type_pairs (self1, self2);
+ (* Always succeeds *)
+ moregen true type_pairs env row1 row2;
+ (* May fail *)
+ try moregen_clty trace type_pairs env patt subj; []
+ with Failure res -> res
+ end
+ end
| errors ->
CM_Class_type_mismatch (env, pat_sch, subj_sch) :: errors
@@ -4850,8 +4928,8 @@ let rec subtype_rec env trace t1 t2 cstrs =
match (get_desc t1, get_desc t2) with
(Tvar _, _) | (_, Tvar _) ->
(trace, t1, t2, !univar_pairs)::cstrs
- | (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _)) when l1 = l2
- || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+ | (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _))
+ when compatible_labels ~in_pattern_mode:false l1 l2 ->
let cstrs =
subtype_rec
env
@@ -4928,7 +5006,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
subtype_rec env trace u1' u2 cstrs
| (Tpoly (u1, tl1), Tpoly (u2,tl2)) ->
begin try
- enter_poly env univar_pairs u1 tl1 u2 tl2
+ enter_poly env u1 tl1 u2 tl2
(fun t1 t2 -> subtype_rec env trace t1 t2 cstrs)
with Escape _ ->
(trace, t1, t2, !univar_pairs)::cstrs
@@ -4950,7 +5028,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
(* need to check module subtyping *)
let snap = Btype.snapshot () in
match List.iter (fun (_, t1, t2, _) -> unify env t1 t2) cstrs' with
- | () when !package_subtype env p1 fl1 p2 fl2 ->
+ | () when Result.is_ok (!package_subtype env p1 fl1 p2 fl2) ->
Btype.backtrack snap; cstrs' @ cstrs
| () | exception Unify _ ->
Btype.backtrack snap; raise Not_found
@@ -5074,19 +5152,22 @@ and subtype_row env trace row1 row2 cstrs =
let subtype env ty1 ty2 =
TypePairs.clear subtypes;
- univar_pairs := [];
- (* Build constraint set. *)
- let cstrs =
- subtype_rec env [Subtype.Diff {got = ty1; expected = ty2}] ty1 ty2 []
- in
- TypePairs.clear subtypes;
- (* Enforce constraints. *)
- function () ->
- List.iter
- (function (trace0, t1, t2, pairs) ->
- try unify_pairs env t1 t2 pairs with Unify {trace} ->
- subtype_error ~env ~trace:trace0 ~unification_trace:(List.tl trace))
- (List.rev cstrs)
+ with_univar_pairs [] (fun () ->
+ (* Build constraint set. *)
+ let cstrs =
+ subtype_rec env [Subtype.Diff {got = ty1; expected = ty2}] ty1 ty2 []
+ in
+ TypePairs.clear subtypes;
+ (* Enforce constraints. *)
+ function () ->
+ List.iter
+ (function (trace0, t1, t2, pairs) ->
+ try unify_pairs env t1 t2 pairs with Unify {trace} ->
+ subtype_error
+ ~env
+ ~trace:trace0
+ ~unification_trace:(List.tl trace))
+ (List.rev cstrs))
(*******************)
(* Miscellaneous *)
@@ -5235,9 +5316,8 @@ let nongen_vars_in_class_declaration cty =
(* Normalize a type before printing, saving... *)
(* Cannot use mark_type because deep_occur uses it too *)
-let rec normalize_type_rec visited ty =
- if not (TypeSet.mem ty !visited) then begin
- visited := TypeSet.add ty !visited;
+let rec normalize_type_rec mark ty =
+ if try_mark_node mark ty then begin
let tm = row_of_type ty in
begin if not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm then
match get_desc tm with (* PR#7348 *)
@@ -5296,11 +5376,11 @@ let rec normalize_type_rec visited ty =
set_type_desc fi (get_desc fi')
| _ -> ()
end;
- iter_type_expr (normalize_type_rec visited) ty;
+ iter_type_expr (normalize_type_rec mark) ty;
end
let normalize_type ty =
- normalize_type_rec (ref TypeSet.empty) ty
+ with_type_mark (fun mark -> normalize_type_rec mark ty)
(*************************)
diff --git a/src/ocaml/typing/ctype.mli b/src/ocaml/typing/ctype.mli
index c6759b06c4..a58eaf565f 100644
--- a/src/ocaml/typing/ctype.mli
+++ b/src/ocaml/typing/ctype.mli
@@ -35,6 +35,15 @@ exception Incompatible
(* All the following wrapper functions revert to the original level,
even in case of exception. *)
+val with_local_level_generalize:
+ ?before_generalize:('a -> unit) -> (unit -> 'a) -> 'a
+val with_local_level_generalize_if:
+ bool -> ?before_generalize:('a -> unit) -> (unit -> 'a) -> 'a
+val with_local_level_generalize_structure: (unit -> 'a) -> 'a
+val with_local_level_generalize_structure_if: bool -> (unit -> 'a) -> 'a
+val with_local_level_generalize_structure_if_principal: (unit -> 'a) -> 'a
+val with_local_level_generalize_for_class: (unit -> 'a) -> 'a
+
val with_local_level: ?post:('a -> unit) -> (unit -> 'a) -> 'a
(* [with_local_level (fun () -> cmd) ~post] evaluates [cmd] at a
raised level.
@@ -134,8 +143,6 @@ val merge_row_fields:
val filter_row_fields:
bool -> (label * row_field) list -> (label * row_field) list
-val generalize: type_expr -> unit
- (* Generalize in-place the given type *)
val lower_contravariant: Env.t -> type_expr -> unit
(* Lower level of type variables inside contravariant branches;
to be used before generalize for expansive expressions *)
@@ -143,23 +150,16 @@ val lower_variables_only: Env.t -> int -> type_expr -> unit
(* Lower all variables to the given level *)
val enforce_current_level: Env.t -> type_expr -> unit
(* Lower whole type to !current_level *)
-val generalize_structure: type_expr -> unit
- (* Generalize the structure of a type, lowering variables
- to !current_level *)
-val generalize_class_type : class_type -> unit
- (* Generalize the components of a class type *)
-val generalize_class_type_structure : class_type -> unit
- (* Generalize the structure of the components of a class type *)
-val generalize_class_signature_spine : Env.t -> class_signature -> unit
+val generalize_class_signature_spine: class_signature -> unit
(* Special function to generalize methods during inference *)
-val correct_levels: type_expr -> type_expr
- (* Returns a copy with decreasing levels *)
-val limited_generalize: type_expr -> type_expr -> unit
+val limited_generalize: type_expr -> inside:type_expr -> unit
(* Only generalize some part of the type
Make the remaining of the type non-generalizable *)
-val limited_generalize_class_type: type_expr -> class_type -> unit
+val limited_generalize_class_type: type_expr -> inside:class_type -> unit
(* Same, but for class types *)
+val duplicate_type: type_expr -> type_expr
+ (* Returns a copy with non-variable nodes at generic level *)
val fully_generic: type_expr -> bool
val check_scope_escape : Env.t -> int -> type_expr -> unit
@@ -266,13 +266,19 @@ type typedecl_extraction_result =
val extract_concrete_typedecl:
Env.t -> type_expr -> typedecl_extraction_result
+val get_new_abstract_name : Env.t -> string -> string
+
val unify: Env.t -> type_expr -> type_expr -> unit
(* Unify the two types given. Raise [Unify] if not possible. *)
val unify_gadt:
Pattern_env.t -> type_expr -> type_expr -> Btype.TypePairs.t
- (* Unify the two types given and update the environment with the
- local constraints. Raise [Unify] if not possible.
- Returns the pairs of types that have been equated. *)
+ (* [unify_gadt penv ty1 ty2] unifies [ty1] and [ty2] in
+ [Pattern] mode, possible adding local constraints to the
+ environment in [penv]. Raises [Unify] if not possible.
+ Returns the pairs of types that have been equated.
+ Type variables in [ty1] are assumed to be non-leaking (safely
+ reifiable), moreover if [penv.allow_recursive_equations = true]
+ the same assumption is made for [ty2]. *)
val unify_var: Env.t -> type_expr -> type_expr -> unit
(* Same as [unify], but allow free univars when first type
is a variable. *)
@@ -448,6 +454,7 @@ type closed_class_failure = {
val free_variables: ?env:Env.t -> type_expr -> type_expr list
(* If env present, then check for incomplete definitions too *)
+val closed_type_expr: ?env:Env.t -> type_expr -> bool
val closed_type_decl: type_declaration -> type_expr option
val closed_extension_constructor: extension_constructor -> type_expr option
val closed_class:
@@ -464,14 +471,15 @@ val collapse_conj_params: Env.t -> type_expr list -> unit
(* Collapse conjunctive types in class parameters *)
val get_current_level: unit -> int
-val wrap_trace_gadt_instances: Env.t -> ('a -> 'b) -> 'a -> 'b
+val wrap_trace_gadt_instances: ?force:bool -> Env.t -> ('a -> 'b) -> 'a -> 'b
val immediacy : Env.t -> type_expr -> Type_immediacy.t
(* Stubs *)
val package_subtype :
(Env.t -> Path.t -> (Longident.t * type_expr) list ->
- Path.t -> (Longident.t * type_expr) list -> bool) ref
+ Path.t -> (Longident.t * type_expr) list ->
+ (unit,Errortrace.first_class_module) Result.t) ref
(* Raises [Incompatible] *)
val mcomp : Env.t -> type_expr -> type_expr -> unit
diff --git a/src/ocaml/typing/datarepr.ml b/src/ocaml/typing/datarepr.ml
index 9213fe8337..5228031155 100644
--- a/src/ocaml/typing/datarepr.ml
+++ b/src/ocaml/typing/datarepr.ml
@@ -23,24 +23,25 @@ open Btype
(* Simplified version of Ctype.free_vars *)
let free_vars ?(param=false) ty =
let ret = ref TypeSet.empty in
- let rec loop ty =
- if try_mark_node ty then
- match get_desc ty with
- | Tvar _ ->
- ret := TypeSet.add ty !ret
- | Tvariant row ->
- iter_row loop row;
- if not (static_row row) then begin
- match get_desc (row_more row) with
- | Tvar _ when param -> ret := TypeSet.add ty !ret
- | _ -> loop (row_more row)
- end
- (* XXX: What about Tobject ? *)
- | _ ->
- iter_type_expr loop ty
- in
- loop ty;
- unmark_type ty;
+ with_type_mark begin fun mark ->
+ let rec loop ty =
+ if try_mark_node mark ty then
+ match get_desc ty with
+ | Tvar _ ->
+ ret := TypeSet.add ty !ret
+ | Tvariant row ->
+ iter_row loop row;
+ if not (static_row row) then begin
+ match get_desc (row_more row) with
+ | Tvar _ when param -> ret := TypeSet.add ty !ret
+ | _ -> loop (row_more row)
+ end
+ (* XXX: What about Tobject ? *)
+ | _ ->
+ iter_type_expr loop ty
+ in
+ loop ty
+ end;
!ret
let newgenconstr path tyl = newgenty (Tconstr (path, tyl, ref Mnil))
diff --git a/src/ocaml/typing/datarepr.mli b/src/ocaml/typing/datarepr.mli
index 38f05f74f0..1ccb918e59 100644
--- a/src/ocaml/typing/datarepr.mli
+++ b/src/ocaml/typing/datarepr.mli
@@ -19,14 +19,14 @@
open Types
val extension_descr:
- current_unit:string -> Path.t -> extension_constructor ->
+ current_unit:(Unit_info.t option) -> Path.t -> extension_constructor ->
constructor_description
val labels_of_type:
Path.t -> type_declaration ->
(Ident.t * label_description) list
val constructors_of_type:
- current_unit:string -> Path.t -> type_declaration ->
+ current_unit:(Unit_info.t option) -> Path.t -> type_declaration ->
(Ident.t * constructor_description) list
diff --git a/src/ocaml/typing/env.ml b/src/ocaml/typing/env.ml
index 1e52f6dd33..fb25f29dd5 100644
--- a/src/ocaml/typing/env.ml
+++ b/src/ocaml/typing/env.ml
@@ -849,42 +849,57 @@ let rec print_address ppf = function
(* The name of the compilation unit currently compiled.
"" if outside a compilation unit. *)
-module Current_unit_name : sig
- val get : unit -> modname
- val set : modname -> unit
- val is : modname -> bool
- val is_ident : Ident.t -> bool
- val is_path : Path.t -> bool
+module Current_unit : sig
+ val get : unit -> Unit_info.t option
+ val set : Unit_info.t -> unit
+ val unset : unit -> unit
+
+ module Name : sig
+ val get : unit -> modname
+ val is : modname -> bool
+ val is_ident : Ident.t -> bool
+ val is_path : Path.t -> bool
+ end
end = struct
- let current_unit =
- ref ""
+ let current_unit : Unit_info.t option ref =
+ ref None
let get () =
!current_unit
- let set name =
- current_unit := name
- let is name =
- !current_unit = name
- let is_ident id =
- Ident.persistent id && is (Ident.name id)
- let is_path = function
- | Pident id -> is_ident id
- | Pdot _ | Papply _ | Pextra_ty _ -> false
+ let set cu =
+ current_unit := Some cu
+ let unset () =
+ current_unit := None
+
+ module Name = struct
+ let get () =
+ match !current_unit with
+ | None -> ""
+ | Some cu -> Unit_info.modname cu
+ let is name =
+ get () = name
+ let is_ident id =
+ Ident.persistent id && is (Ident.name id)
+ let is_path = function
+ | Pident id -> is_ident id
+ | Pdot _ | Papply _ | Pextra_ty _ -> false
+ end
end
-let set_unit_name = Current_unit_name.set
-let get_unit_name = Current_unit_name.get
+let set_current_unit = Current_unit.set
+let get_current_unit = Current_unit.get
+let get_current_unit_name = Current_unit.Name.get
let find_same_module id tbl =
match IdTbl.find_same id tbl with
| x -> x
| exception Not_found
- when Ident.persistent id && not (Current_unit_name.is_ident id) ->
+ when Ident.persistent id && not (Current_unit.Name.is_ident id) ->
Mod_persistent
let find_name_module ~mark name tbl =
match IdTbl.find_name wrap_module ~mark name tbl with
| x -> x
- | exception Not_found when not (Current_unit_name.is name) ->
+ | exception Not_found when not (Current_unit.Name.is name) ->
let path = Pident(Ident.create_persistent name) in
path, Mod_persistent
@@ -898,7 +913,7 @@ let short_paths_components name pm =
let add_persistent_structure id env =
if not (Ident.persistent id) then invalid_arg "Env.add_persistent_structure";
- if Current_unit_name.is_ident id then env
+ if Current_unit.Name.is_ident id then env
else begin
let material =
(* This addition only observably changes the environment if it shadows a
@@ -1030,7 +1045,7 @@ let reset_declaration_caches () =
()
let reset_cache () =
- Current_unit_name.set "";
+ Current_unit.unset ();
Persistent_env.clear !persistent_env;
reset_declaration_caches ();
()
@@ -1355,7 +1370,7 @@ let find_shape env (ns : Shape.Sig_component_kind.t) id =
properly populated. *)
assert false
| exception Not_found
- when Ident.persistent id && not (Current_unit_name.is_ident id) ->
+ when Ident.persistent id && not (Current_unit.Name.is_ident id) ->
Shape.for_persistent_unit (Ident.name id)
end
| Module_type ->
@@ -1703,7 +1718,7 @@ let prefix_idents root prefixing_sub sg =
let p = Pdot(root, Ident.name id) in
prefix_idents root
((SigL_modtype(id, mtd, vis), p) :: items_and_paths)
- (Subst.add_modtype id (Mty_ident p) prefixing_sub)
+ (Subst.add_modtype id p prefixing_sub)
rem
| SigL_class(id, cd, rs, vis) :: rem ->
(* pretend this is a type, cf. PR#6650 *)
@@ -1796,16 +1811,6 @@ let module_declaration_address env id presence md =
| Mp_present ->
Lazy_backtrack.create_forced (Aident id)
-let is_identchar c =
- (* This should be kept in sync with the [identchar_latin1] character class
- in [lexer.mll] *)
- match c with
- | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214'
- | '\216'..'\246' | '\248'..'\255' | '\'' | '0'..'9' ->
- true
- | _ ->
- false
-
let rec components_of_module_maker
{cm_env; cm_prefixing_subst;
cm_path; cm_addr; cm_mty; cm_shape} : _ result =
@@ -1853,7 +1858,7 @@ let rec components_of_module_maker
| Type_variant (_,repr) ->
let cstrs = List.map snd
(Datarepr.constructors_of_type path final_decl
- ~current_unit:(get_unit_name ()))
+ ~current_unit:(get_current_unit ()))
in
List.iter
(fun descr ->
@@ -1891,7 +1896,7 @@ let rec components_of_module_maker
| SigL_typext(id, ext, _, _) ->
let ext' = Subst.extension_constructor sub ext in
let descr =
- Datarepr.extension_descr ~current_unit:(get_unit_name ()) path
+ Datarepr.extension_descr ~current_unit:(get_current_unit ()) path
ext'
in
let addr = next_address () in
@@ -2012,7 +2017,8 @@ and check_value_name name loc =
(* Note: we could also check here general validity of the
identifier, to protect against bad identifiers forged by -pp or
-ppx preprocessors. *)
- if String.length name > 0 && not (is_identchar name.[0]) then
+ if String.length name > 0 && not
+ (Utf8_lexeme.starts_like_a_valid_identifier name) then
for i = 1 to String.length name - 1 do
if name.[i] = '#' then
error (Illegal_value_name(loc, name))
@@ -2111,7 +2117,7 @@ and store_type ~check ~long_path ~predef id info shape env =
match info.type_kind with
| Type_variant (_,repr) ->
let constructors = Datarepr.constructors_of_type path info
- ~current_unit:(get_unit_name ())
+ ~current_unit:(get_current_unit ())
in
Type_variant (List.map snd constructors, repr),
List.fold_left
@@ -2162,7 +2168,8 @@ and store_type_infos ~tda_shape id info env =
and store_extension ~check ~rebind id addr ext shape env =
let loc = ext.ext_loc in
let cstr =
- Datarepr.extension_descr ~current_unit:(get_unit_name ()) (Pident id) ext
+ Datarepr.extension_descr
+ ~current_unit:(get_current_unit ()) (Pident id) ext
in
let cda =
{ cda_description = cstr;
@@ -2684,7 +2691,7 @@ let read_signature u =
let unit_name_of_filename fn =
match Filename.extension fn with
| ".cmi" ->
- let modname = Unit_info.modname_from_source fn in
+ let modname = Unit_info.strict_modname_from_source fn in
if Unit_info.is_unit_name modname then Some modname
else None
| _ -> None
@@ -3441,7 +3448,7 @@ let bound_module name env =
match IdTbl.find_name wrap_module ~mark:false name env.modules with
| _ -> true
| exception Not_found ->
- if Current_unit_name.is name then false
+ if Current_unit.Name.is name then false
else begin
match find_pers_mod ~allow_hidden:false name with
| _ -> true
@@ -3670,15 +3677,14 @@ let env_of_only_summary env_from_summary env =
(* Error report *)
-open Format
+open Format_doc
(* Forward declarations *)
-let print_longident =
- ref ((fun _ _ -> assert false) : formatter -> Longident.t -> unit)
+let print_longident : Longident.t printer ref = ref (fun _ _ -> assert false)
-let print_path =
- ref ((fun _ _ -> assert false) : formatter -> Path.t -> unit)
+let print_path: Path.t printer ref = ref (fun _ _ -> assert false)
+let pp_path ppf l = !print_path ppf l
let spellcheck ppf extract env lid =
let choices ~path name = Misc.spellcheck (extract path env) name in
@@ -3718,10 +3724,12 @@ let extract_instance_variables env =
module Style = Misc.Style
-let report_lookup_error _loc env ppf = function
+let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
+let report_lookup_error_doc _loc env ppf = function
| Unbound_value(lid, hint) -> begin
- fprintf ppf "Unbound value %a"
- (Style.as_inline_code !print_longident) lid;
+ fprintf ppf "Unbound value %a" quoted_longident lid;
spellcheck ppf extract_values env lid;
match hint with
| No_hint -> ()
@@ -3737,52 +3745,52 @@ let report_lookup_error _loc env ppf = function
end
| Unbound_type lid ->
fprintf ppf "Unbound type constructor %a"
- (Style.as_inline_code !print_longident) lid;
+ quoted_longident lid;
spellcheck ppf extract_types env lid;
| Unbound_module lid -> begin
fprintf ppf "Unbound module %a"
- (Style.as_inline_code !print_longident) lid;
+ quoted_longident lid;
match find_modtype_by_name lid env with
| exception Not_found -> spellcheck ppf extract_modules env lid;
| _ ->
fprintf ppf
"@.@[@{<hint>Hint@}: There is a module type named %a, %s@]"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
"but module types are not modules"
end
| Unbound_constructor lid ->
fprintf ppf "Unbound constructor %a"
- (Style.as_inline_code !print_longident) lid;
+ quoted_constr lid;
spellcheck ppf extract_constructors env lid;
| Unbound_label lid ->
fprintf ppf "Unbound record field %a"
- (Style.as_inline_code !print_longident) lid;
+ quoted_longident lid;
spellcheck ppf extract_labels env lid;
| Unbound_class lid -> begin
fprintf ppf "Unbound class %a"
- (Style.as_inline_code !print_longident) lid;
+ quoted_longident lid;
match find_cltype_by_name lid env with
| exception Not_found -> spellcheck ppf extract_classes env lid;
| _ ->
fprintf ppf
"@.@[@{<hint>Hint@}: There is a class type named %a, %s@]"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
"but classes are not class types"
end
| Unbound_modtype lid -> begin
fprintf ppf "Unbound module type %a"
- (Style.as_inline_code !print_longident) lid;
+ quoted_longident lid;
match find_module_by_name lid env with
| exception Not_found -> spellcheck ppf extract_modtypes env lid;
| _ ->
fprintf ppf
"@.@[@{<hint>Hint@}: There is a module named %a, %s@]"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
"but modules are not module types"
end
| Unbound_cltype lid ->
fprintf ppf "Unbound class type %a"
- (Style.as_inline_code !print_longident) lid;
+ quoted_longident lid;
spellcheck ppf extract_cltypes env lid;
| Unbound_instance_variable s ->
fprintf ppf "Unbound instance variable %a" Style.inline_code s;
@@ -3795,47 +3803,47 @@ let report_lookup_error _loc env ppf = function
fprintf ppf
"The instance variable %a@ \
cannot be accessed from the definition of another instance variable"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
| Masked_self_variable lid ->
fprintf ppf
"The self variable %a@ \
cannot be accessed from the definition of an instance variable"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
| Masked_ancestor_variable lid ->
fprintf ppf
"The ancestor variable %a@ \
cannot be accessed from the definition of an instance variable"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
| Illegal_reference_to_recursive_module ->
fprintf ppf "Illegal recursive module reference"
| Structure_used_as_functor lid ->
fprintf ppf "@[The module %a is a structure, it cannot be applied@]"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
| Abstract_used_as_functor lid ->
fprintf ppf "@[The module %a is abstract, it cannot be applied@]"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
| Functor_used_as_structure lid ->
fprintf ppf "@[The module %a is a functor, \
- it cannot have any components@]" !print_longident lid
+ it cannot have any components@]" quoted_longident lid
| Abstract_used_as_structure lid ->
fprintf ppf "@[The module %a is abstract, \
it cannot have any components@]"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
| Generative_used_as_applicative lid ->
fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \
applied@ in@ type@ expressions@]"
- (Style.as_inline_code !print_longident) lid
+ quoted_longident lid
| Cannot_scrape_alias(lid, p) ->
let cause =
- if Current_unit_name.is_path p then "is the current compilation unit"
+ if Current_unit.Name.is_path p then "is the current compilation unit"
else "is missing"
in
fprintf ppf
"The module %a is an alias for module %a, which %s"
- (Style.as_inline_code !print_longident) lid
- (Style.as_inline_code !print_path) p cause
+ quoted_longident lid
+ (Style.as_inline_code pp_path) p cause
-let report_error ppf = function
+let report_error_doc ppf = function
| Missing_module(_, path1, path2) ->
fprintf ppf "@[@[<hov>";
if Path.same path1 path2 then
@@ -3852,7 +3860,7 @@ let report_error ppf = function
| Illegal_value_name(_loc, name) ->
fprintf ppf "%a is not a valid value identifier."
Style.inline_code name
- | Lookup_error(loc, t, err) -> report_lookup_error loc t ppf err
+ | Lookup_error(loc, t, err) -> report_lookup_error_doc loc t ppf err
let () =
Location.register_error_of_exn
@@ -3867,9 +3875,9 @@ let () =
let error_of_printer =
if loc = Location.none
then Location.error_of_printer_file
- else Location.error_of_printer ~loc ?sub:None
+ else Location.error_of_printer ~loc ?sub:None ?footnote:None
in
- Some (error_of_printer report_error err)
+ Some (error_of_printer report_error_doc err)
| _ ->
None
)
@@ -4179,3 +4187,26 @@ let cleanup_usage_tables ~stamp =
Stamped_hashtable.backtrack module_declarations_changelog ~stamp;
Stamped_hashtable.backtrack used_constructors_changelog ~stamp;
Stamped_hashtable.backtrack used_labels_changelog ~stamp
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err ->
+ let loc =
+ match err with
+ | Missing_module (loc, _, _)
+ | Illegal_value_name (loc, _)
+ | Lookup_error(loc, _, _) -> loc
+ in
+ let error_of_printer =
+ if loc = Location.none
+ then Location.error_of_printer_file
+ else Location.error_of_printer ~loc ?sub:None ?footnote:None
+ in
+ Some (error_of_printer report_error_doc err)
+ | _ ->
+ None
+ )
+
+let report_lookup_error = Format_doc.compat2 report_lookup_error_doc
+let report_error = Format_doc.compat report_error_doc
diff --git a/src/ocaml/typing/env.mli b/src/ocaml/typing/env.mli
index aa005a4b82..f20139ce12 100644
--- a/src/ocaml/typing/env.mli
+++ b/src/ocaml/typing/env.mli
@@ -396,9 +396,10 @@ val reset_cache: unit -> unit
(* To be called before each toplevel phrase. *)
val reset_cache_toplevel: unit -> unit
-(* Remember the name of the current compilation unit. *)
-val set_unit_name: string -> unit
-val get_unit_name: unit -> string
+(* Remember the current compilation unit. *)
+val set_current_unit: Unit_info.t -> unit
+val get_current_unit : unit -> Unit_info.t option
+val get_current_unit_name: unit -> string
(* Read, save a signature to/from a file *)
val read_signature: Unit_info.Artifact.t -> signature
@@ -455,12 +456,14 @@ type error =
exception Error of error
-open Format
-val report_error: formatter -> error -> unit
-
-val report_lookup_error: Location.t -> t -> formatter -> lookup_error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
+val report_lookup_error:
+ Location.t -> t -> lookup_error Format_doc.format_printer
+val report_lookup_error_doc:
+ Location.t -> t -> lookup_error Format_doc.printer
val in_signature: bool -> t -> t
val is_in_signature: t -> bool
@@ -490,9 +493,9 @@ val strengthen:
(* Forward declaration to break mutual recursion with Ctype. *)
val same_constr: (t -> type_expr -> type_expr -> bool) ref
(* Forward declaration to break mutual recursion with Printtyp. *)
-val print_longident: (Format.formatter -> Longident.t -> unit) ref
+val print_longident: Longident.t Format_doc.printer ref
(* Forward declaration to break mutual recursion with Printtyp. *)
-val print_path: (Format.formatter -> Path.t -> unit) ref
+val print_path: Path.t Format_doc.printer ref
(* Forward declaration to break mutual recursion with Printtyp *)
diff --git a/src/ocaml/typing/envaux.ml b/src/ocaml/typing/envaux.ml
index 90e0da92c4..df75c5d5b6 100644
--- a/src/ocaml/typing/envaux.ml
+++ b/src/ocaml/typing/envaux.ml
@@ -101,17 +101,19 @@ let env_of_only_summary env =
(* Error report *)
-open Format
+open Format_doc
module Style = Misc.Style
-let report_error ppf = function
+let report_error_doc ppf = function
| Module_not_found p ->
fprintf ppf "@[Cannot find module %a@].@."
- (Style.as_inline_code Printtyp.path) p
+ (Style.as_inline_code Printtyp.Doc.path) p
let () =
Location.register_error_of_exn
(function
- | Error err -> Some (Location.error_of_printer_file report_error err)
+ | Error err -> Some (Location.error_of_printer_file report_error_doc err)
| _ -> None
)
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/src/ocaml/typing/envaux.mli b/src/ocaml/typing/envaux.mli
index 2869890a14..5fbb8410bd 100644
--- a/src/ocaml/typing/envaux.mli
+++ b/src/ocaml/typing/envaux.mli
@@ -14,8 +14,6 @@
(* *)
(**************************************************************************)
-open Format
-
(* Convert environment summaries to environments *)
val env_from_summary : Env.summary -> Subst.t -> Env.t
@@ -33,4 +31,5 @@ type error =
exception Error of error
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
diff --git a/src/ocaml/typing/errortrace.ml b/src/ocaml/typing/errortrace.ml
index 407b3438e5..f0a7147301 100644
--- a/src/ocaml/typing/errortrace.ml
+++ b/src/ocaml/typing/errortrace.ml
@@ -16,7 +16,7 @@
(**************************************************************************)
open Types
-open Format
+open Format_doc
type position = First | Second
@@ -98,14 +98,21 @@ type 'variety obj =
(* Unification *)
| Self_cannot_be_closed : unification obj
+type first_class_module =
+ | Package_cannot_scrape of Path.t
+ | Package_inclusion of Format_doc.doc
+ | Package_coercion of Format_doc.doc
+
type ('a, 'variety) elt =
(* Common *)
| Diff : 'a diff -> ('a, _) elt
| Variant : 'variety variant -> ('a, 'variety) elt
| Obj : 'variety obj -> ('a, 'variety) elt
| Escape : 'a escape -> ('a, _) elt
+ | Function_label_mismatch of Asttypes.arg_label diff
| Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
(* Could move [Incompatible_fields] into [obj] *)
+ | First_class_module: first_class_module -> ('a,_) elt
(* Unification & Moregen; included in Equality for simplicity *)
| Rec_occur : type_expr * type_expr -> ('a, _) elt
@@ -125,7 +132,8 @@ let map_elt (type variety) f : ('a, variety) elt -> ('b, variety) elt = function
Escape { kind = Equation (f x); context }
| Escape {kind = (Univ _ | Self | Constructor _ | Module_type _ | Constraint);
_}
- | Variant _ | Obj _ | Incompatible_fields _ | Rec_occur (_, _) as x -> x
+ | Variant _ | Obj _ | Function_label_mismatch _ | Incompatible_fields _
+ | Rec_occur (_, _) | First_class_module _ as x -> x
let map f t = List.map (map_elt f) t
diff --git a/src/ocaml/typing/errortrace.mli b/src/ocaml/typing/errortrace.mli
index f3cfe48557..2377748a46 100644
--- a/src/ocaml/typing/errortrace.mli
+++ b/src/ocaml/typing/errortrace.mli
@@ -20,7 +20,7 @@ open Types
type position = First | Second
val swap_position : position -> position
-val print_pos : Format.formatter -> position -> unit
+val print_pos : position Format_doc.printer
type expanded_type = { ty: type_expr; expanded: type_expr }
@@ -84,13 +84,20 @@ type 'variety obj =
(* Unification *)
| Self_cannot_be_closed : unification obj
+type first_class_module =
+ | Package_cannot_scrape of Path.t
+ | Package_inclusion of Format_doc.doc
+ | Package_coercion of Format_doc.doc
+
type ('a, 'variety) elt =
(* Common *)
| Diff : 'a diff -> ('a, _) elt
| Variant : 'variety variant -> ('a, 'variety) elt
| Obj : 'variety obj -> ('a, 'variety) elt
| Escape : 'a escape -> ('a, _) elt
+ | Function_label_mismatch of Asttypes.arg_label diff
| Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
+ | First_class_module: first_class_module -> ('a,_) elt
(* Unification & Moregen; included in Equality for simplicity *)
| Rec_occur : type_expr * type_expr -> ('a, _) elt
diff --git a/src/ocaml/typing/errortrace_report.ml b/src/ocaml/typing/errortrace_report.ml
new file mode 100644
index 0000000000..03012f7d82
--- /dev/null
+++ b/src/ocaml/typing/errortrace_report.ml
@@ -0,0 +1,590 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+(* Trace-specific printing *)
+
+(* A configuration type that controls which trace we print. This could be
+ exposed, but we instead expose three separate
+ [{unification,equality,moregen}] functions. This also lets us
+ give the unification case an extra optional argument without adding it to the
+ equality and moregen cases. *)
+type 'variety trace_format =
+ | Unification : Errortrace.unification trace_format
+ | Equality : Errortrace.comparison trace_format
+ | Moregen : Errortrace.comparison trace_format
+
+let incompatibility_phrase (type variety) : variety trace_format -> string =
+ function
+ | Unification -> "is not compatible with type"
+ | Equality -> "is not equal to type"
+ | Moregen -> "is not compatible with type"
+
+(* Print a unification error *)
+open Out_type
+open Format_doc
+module Fmt = Format_doc
+module Style = Misc.Style
+
+type 'a diff = 'a Out_type.diff = Same of 'a | Diff of 'a * 'a
+
+let trees_of_trace mode =
+ List.map (Errortrace.map_diff (trees_of_type_expansion mode))
+
+let rec trace fst txt ppf = function
+ | {Errortrace.got; expected} :: rem ->
+ if not fst then fprintf ppf "@,";
+ fprintf ppf "@[Type@;<1 2>%a@ %s@;<1 2>%a@]%a"
+ pp_type_expansion got txt pp_type_expansion expected
+ (trace false txt) rem
+ | _ -> ()
+
+type printing_status =
+ | Discard
+ | Keep
+ | Optional_refinement
+ (** An [Optional_refinement] printing status is attributed to trace
+ elements that are focusing on a new subpart of a structural type.
+ Since the whole type should have been printed earlier in the trace,
+ we only print those elements if they are the last printed element
+ of a trace, and there is no explicit explanation for the
+ type error.
+ *)
+
+let diff_printing_status Errortrace.{ got = {ty = t1; expanded = t1'};
+ expected = {ty = t2; expanded = t2'} } =
+ if Btype.is_constr_row ~allow_ident:true t1'
+ || Btype.is_constr_row ~allow_ident:true t2'
+ then Discard
+ else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
+ else Keep
+
+let printing_status = function
+ | Errortrace.Diff d -> diff_printing_status d
+ | Errortrace.Escape {kind = Constraint} -> Keep
+ | _ -> Keep
+
+(** Flatten the trace and remove elements that are always discarded
+ during printing *)
+
+(* Takes [printing_status] to change behavior for [Subtype] *)
+let prepare_any_trace printing_status tr =
+ let clean_trace x l = match printing_status x with
+ | Keep -> x :: l
+ | Optional_refinement when l = [] -> [x]
+ | Optional_refinement | Discard -> l
+ in
+ match tr with
+ | [] -> []
+ | elt :: rem -> elt :: List.fold_right clean_trace rem []
+
+let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.map f tr)
+
+(** Keep elements that are [Diff _ ] and split the the last element if it is
+ optionally elidable, require a prepared trace *)
+let rec filter_trace = function
+ | [] -> [], None
+ | [Errortrace.Diff d as elt]
+ when printing_status elt = Optional_refinement -> [], Some d
+ | Errortrace.Diff d :: rem ->
+ let filtered, last = filter_trace rem in
+ d :: filtered, last
+ | _ :: rem -> filter_trace rem
+
+let may_prepare_expansion compact (Errortrace.{ty; expanded} as ty_exp) =
+ match Types.get_desc expanded with
+ Tvariant _ | Tobject _ when compact ->
+ Variable_names.reserve ty; Errortrace.{ty; expanded = ty}
+ | _ -> prepare_expansion ty_exp
+
+let print_path p =
+ Fmt.dprintf "%a" !Oprint.out_ident (namespaced_tree_of_path Type p)
+
+let print_tag ppf s = Style.inline_code ppf ("`" ^ s)
+
+let print_tags ppf tags =
+ Fmt.(pp_print_list ~pp_sep:comma) print_tag ppf tags
+
+let is_unit env ty =
+ match Types.get_desc (Ctype.expand_head env ty) with
+ | Tconstr (p, _, _) -> Path.same p Predef.path_unit
+ | _ -> false
+
+let unifiable env ty1 ty2 =
+ let snap = Btype.snapshot () in
+ let res =
+ try Ctype.unify env ty1 ty2; true
+ with Ctype.Unify _ -> false
+ in
+ Btype.backtrack snap;
+ res
+
+let explanation_diff env t3 t4 =
+ match Types.get_desc t3, Types.get_desc t4 with
+ | Tarrow (_, ty1, ty2, _), _
+ when is_unit env ty1 && unifiable env ty2 t4 ->
+ Some (doc_printf
+ "@,@[@{<hint>Hint@}: Did you forget to provide %a as argument?@]"
+ Style.inline_code "()"
+ )
+ | _, Tarrow (_, ty1, ty2, _)
+ when is_unit env ty1 && unifiable env t3 ty2 ->
+ Some (doc_printf
+ "@,@[@{<hint>Hint@}: Did you forget to wrap the expression using \
+ %a?@]"
+ Style.inline_code "fun () ->"
+ )
+ | _ ->
+ None
+
+let explain_fixed_row_case = function
+ | Errortrace.Cannot_be_closed -> doc_printf "it cannot be closed"
+ | Errortrace.Cannot_add_tags tags ->
+ doc_printf "it may not allow the tag(s) %a"
+ print_tags tags
+
+let pp_path ppf p =
+ Style.as_inline_code Printtyp.Doc.path ppf p
+
+let explain_fixed_row pos expl = match expl with
+ | Types.Fixed_private ->
+ doc_printf "The %a variant type is private" Errortrace.print_pos pos
+ | Types.Univar x ->
+ Variable_names.reserve x;
+ doc_printf "The %a variant type is bound to the universal type variable %a"
+ Errortrace.print_pos pos
+ (Style.as_inline_code type_expr_with_reserved_names) x
+ | Types.Reified p ->
+ doc_printf "The %a variant type is bound to %a"
+ Errortrace.print_pos pos
+ (Style.as_inline_code
+ (fun ppf p ->
+ Internal_names.add p;
+ print_path p ppf))
+ p
+ | Types.Rigid -> Format_doc.Doc.empty
+
+let explain_variant (type variety) : variety Errortrace.variant -> _ = function
+ (* Common *)
+ | Errortrace.Incompatible_types_for s ->
+ Some(doc_printf "@,Types for tag %a are incompatible"
+ print_tag s
+ )
+ (* Unification *)
+ | Errortrace.No_intersection ->
+ Some(doc_printf "@,These two variant types have no intersection")
+ | Errortrace.No_tags(pos,fields) -> Some(
+ doc_printf
+ "@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
+ Errortrace.print_pos pos
+ print_tags (List.map fst fields)
+ )
+ | Errortrace.Fixed_row (pos,
+ k,
+ (Univar _ | Reified _ | Fixed_private as e)) ->
+ Some (
+ doc_printf "@,@[%a,@ %a@]" pp_doc (explain_fixed_row pos e)
+ pp_doc (explain_fixed_row_case k)
+ )
+ | Errortrace.Fixed_row (_,_, Rigid) ->
+ (* this case never happens *)
+ None
+ (* Equality & Moregen *)
+ | Errortrace.Presence_not_guaranteed_for (pos, s) -> Some(
+ doc_printf
+ "@,@[The tag %a is guaranteed to be present in the %a variant type,\
+ @ but not in the %a@]"
+ print_tag s
+ Errortrace.print_pos (Errortrace.swap_position pos)
+ Errortrace.print_pos pos
+ )
+ | Errortrace.Openness pos ->
+ Some(doc_printf "@,The %a variant type is open and the %a is not"
+ Errortrace.print_pos pos
+ Errortrace.print_pos (Errortrace.swap_position pos))
+
+let explain_escape pre = function
+ | Errortrace.Univ u ->
+ Variable_names.reserve u;
+ Some(
+ doc_printf "%a@,The universal variable %a would escape its scope"
+ pp_doc pre
+ (Style.as_inline_code type_expr_with_reserved_names) u
+ )
+ | Errortrace.Constructor p -> Some(
+ doc_printf
+ "%a@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
+ pp_doc pre pp_path p
+ )
+ | Errortrace.Module_type p -> Some(
+ doc_printf
+ "%a@,@[The module type@;<1 2>%a@ would escape its scope@]"
+ pp_doc pre pp_path p
+ )
+ | Errortrace.Equation Errortrace.{ty = _; expanded = t} ->
+ Variable_names.reserve t;
+ Some(
+ doc_printf "%a@ @[<hov>This instance of %a is ambiguous:@ %s@]"
+ pp_doc pre
+ (Style.as_inline_code type_expr_with_reserved_names) t
+ "it would escape the scope of its equation"
+ )
+ | Errortrace.Self ->
+ Some (doc_printf "%a@,Self type cannot escape its class" pp_doc pre)
+ | Errortrace.Constraint ->
+ None
+
+let explain_object (type variety) : variety Errortrace.obj -> _ = function
+ | Errortrace.Missing_field (pos,f) -> Some(
+ doc_printf "@,@[The %a object type has no method %a@]"
+ Errortrace.print_pos pos Style.inline_code f
+ )
+ | Errortrace.Abstract_row pos -> Some(
+ doc_printf
+ "@,@[The %a object type has an abstract row, it cannot be closed@]"
+ Errortrace.print_pos pos
+ )
+ | Errortrace.Self_cannot_be_closed ->
+ Some (doc_printf
+ "@,Self type cannot be unified with a closed object type"
+ )
+
+let explain_incompatible_fields name (diff: Types.type_expr Errortrace.diff) =
+ Variable_names.reserve diff.got;
+ Variable_names.reserve diff.expected;
+ doc_printf "@,@[The method %a has type@ %a,@ \
+ but the expected method type was@ %a@]"
+ Style.inline_code name
+ (Style.as_inline_code type_expr_with_reserved_names) diff.got
+ (Style.as_inline_code type_expr_with_reserved_names) diff.expected
+
+
+let explain_label_mismatch ~got ~expected =
+ let quoted_label ppf l = Style.inline_code ppf (Asttypes.string_of_label l) in
+ match got, expected with
+ | Asttypes.Nolabel, Asttypes.(Labelled _ | Optional _ ) ->
+ doc_printf "@,@[A label@ %a@ was expected@]"
+ quoted_label expected
+ | Asttypes.(Labelled _|Optional _), Asttypes.Nolabel ->
+ doc_printf
+ "@,@[The first argument is labeled@ %a,@ \
+ but an unlabeled argument was expected@]"
+ quoted_label got
+ | Asttypes.Labelled g, Asttypes.Optional e when g = e ->
+ doc_printf
+ "@,@[The label@ %a@ was expected to be optional@]"
+ quoted_label got
+ | Asttypes.Optional g, Asttypes.Labelled e when g = e ->
+ doc_printf
+ "@,@[The label@ %a@ was expected to not be optional@]"
+ quoted_label got
+ | Asttypes.(Labelled _ | Optional _), Asttypes.(Labelled _ | Optional _) ->
+ doc_printf "@,@[Labels %a@ and@ %a do not match@]"
+ quoted_label got
+ quoted_label expected
+ | Asttypes.Nolabel, Asttypes.Nolabel ->
+ (* Two empty labels cannot be mismatched*)
+ assert false
+
+
+let explain_first_class_module = function
+ | Errortrace.Package_cannot_scrape p -> Some(
+ doc_printf "@,@[The module alias %a could not be expanded@]"
+ pp_path p
+ )
+ | Errortrace.Package_inclusion pr ->
+ Some(doc_printf "@,@[%a@]" Fmt.pp_doc pr)
+ | Errortrace.Package_coercion pr ->
+ Some(doc_printf "@,@[%a@]" Fmt.pp_doc pr)
+
+let explanation (type variety) intro prev env
+ : (Errortrace.expanded_type, variety) Errortrace.elt -> _ = function
+ | Errortrace.Diff {got; expected} ->
+ explanation_diff env got.expanded expected.expanded
+ | Errortrace.Escape {kind; context} ->
+ let pre =
+ match context, kind, prev with
+ | Some ctx, _, _ ->
+ Variable_names.reserve ctx;
+ doc_printf "@[%a@;<1 2>%a@]" pp_doc intro
+ (Style.as_inline_code type_expr_with_reserved_names) ctx
+ | None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
+ explain_incompatible_fields name diff
+ | _ -> Format_doc.Doc.empty
+ in
+ explain_escape pre kind
+ | Errortrace.Incompatible_fields { name; diff} ->
+ Some(explain_incompatible_fields name diff)
+ | Errortrace.Function_label_mismatch diff ->
+ Some(explain_label_mismatch ~got:diff.got ~expected:diff.expected)
+ | Errortrace.Variant v ->
+ explain_variant v
+ | Errortrace.Obj o ->
+ explain_object o
+ | Errortrace.First_class_module fm ->
+ explain_first_class_module fm
+ | Errortrace.Rec_occur(x,y) ->
+ add_type_to_preparation x;
+ add_type_to_preparation y;
+ begin match Types.get_desc x with
+ | Tvar _ | Tunivar _ ->
+ Some(
+ doc_printf "@,@[<hov>The type variable %a occurs inside@ %a@]"
+ (Style.as_inline_code prepared_type_expr) x
+ (Style.as_inline_code prepared_type_expr) y
+ )
+ | _ ->
+ (* We had a delayed unification of the type variable with
+ a non-variable after the occur check. *)
+ Some Format_doc.Doc.empty
+ (* There is no need to search further for an explanation, but
+ we don't want to print a message of the form:
+ {[ The type int occurs inside int list -> 'a |}
+ *)
+ end
+
+let mismatch intro env trace =
+ Errortrace.explain trace (fun ~prev h -> explanation intro prev env h)
+
+let warn_on_missing_def env ppf t =
+ match Types.get_desc t with
+ | Tconstr (p,_,_) ->
+ begin match Env.find_type p env with
+ | exception Not_found ->
+ fprintf ppf
+ "@,@[<hov>Type %a is abstract because@ no corresponding\
+ @ cmi file@ was found@ in path.@]" pp_path p
+ | { type_manifest = Some _; _ } -> ()
+ | { type_manifest = None; _ } as decl ->
+ match Btype.type_origin decl with
+ | Rec_check_regularity ->
+ fprintf ppf
+ "@,@[<hov>Type %a was considered abstract@ when checking\
+ @ constraints@ in this@ recursive type definition.@]"
+ pp_path p
+ | Definition | Existential _ -> ()
+ end
+ | _ -> ()
+
+let prepare_expansion_head empty_tr = function
+ | Errortrace.Diff d ->
+ Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
+ | _ -> None
+
+let head_error_printer mode txt_got txt_but = function
+ | None -> Format_doc.Doc.empty
+ | Some d ->
+ let d = Errortrace.map_diff (trees_of_type_expansion mode) d in
+ doc_printf "%a@;<1 2>%a@ %a@;<1 2>%a"
+ pp_doc txt_got pp_type_expansion d.Errortrace.got
+ pp_doc txt_but pp_type_expansion d.Errortrace.expected
+
+let warn_on_missing_defs env ppf = function
+ | None -> ()
+ | Some Errortrace.{got = {ty=te1; expanded=_};
+ expected = {ty=te2; expanded=_} } ->
+ warn_on_missing_def env ppf te1;
+ warn_on_missing_def env ppf te2
+
+(* [subst] comes out of equality, and is [[]] otherwise *)
+let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation =
+ reset ();
+ (* We want to substitute in the opposite order from [Eqtype] *)
+ Variable_names.add_subst (List.map (fun (ty1,ty2) -> ty2,ty1) subst);
+ let tr =
+ prepare_trace
+ (fun ty_exp ->
+ Errortrace.{ty_exp with expanded = hide_variant_name ty_exp.expanded})
+ tr
+ in
+ match tr with
+ | [] -> assert false
+ | (elt :: tr) as full_trace ->
+ with_labels (not !Clflags.classic) (fun () ->
+ let tr, last = filter_trace tr in
+ let head = prepare_expansion_head (tr=[] && last=None) elt in
+ let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
+ let last = Option.map (Errortrace.map_diff prepare_expansion) last in
+ let head_error = head_error_printer mode txt1 txt2 head in
+ let tr = trees_of_trace mode tr in
+ let last =
+ Option.map (Errortrace.map_diff (trees_of_type_expansion mode)) last in
+ let mis = mismatch txt1 env full_trace in
+ let tr = match mis, last with
+ | None, Some elt -> tr @ [elt]
+ | Some _, _ | _, None -> tr
+ in
+ fprintf ppf
+ "@[<v>\
+ @[%a%a@]%a%a\
+ @]"
+ pp_doc head_error
+ pp_doc ty_expect_explanation
+ (trace false (incompatibility_phrase trace_format)) tr
+ (pp_print_option pp_doc) mis;
+ if env <> Env.empty
+ then warn_on_missing_defs env ppf head;
+ Internal_names.print_explanations env ppf;
+ Ident_conflicts.err_print ppf
+ )
+
+let report_error trace_format ppf mode env tr
+ ?(subst = [])
+ ?(type_expected_explanation = Fmt.Doc.empty)
+ txt1 txt2 =
+ wrap_printing_env ~error:true env (fun () ->
+ error trace_format mode subst env tr txt1 ppf txt2
+ type_expected_explanation)
+
+let unification
+ ppf env ({trace} : Errortrace.unification_error) =
+ report_error Unification ppf Type env
+ ?subst:None trace
+
+let equality
+ ppf mode env ({subst; trace} : Errortrace.equality_error) =
+ report_error Equality ppf mode env
+ ~subst ?type_expected_explanation:None trace
+
+let moregen
+ ppf mode env ({trace} : Errortrace.moregen_error) =
+ report_error Moregen ppf mode env
+ ?subst:None ?type_expected_explanation:None trace
+
+let comparison ppf mode env = function
+ | Errortrace.Equality_error error -> equality ppf mode env error
+ | Errortrace.Moregen_error error -> moregen ppf mode env error
+
+module Subtype = struct
+ (* There's a frustrating amount of code duplication between this module and
+ the outside code, particularly in [prepare_trace] and [filter_trace].
+ Unfortunately, [Subtype] is *just* similar enough to have code duplication,
+ while being *just* different enough (it's only [Diff]) for the abstraction
+ to be nonobvious. Someday, perhaps... *)
+
+ let printing_status = function
+ | Errortrace.Subtype.Diff d -> diff_printing_status d
+
+ let prepare_unification_trace = prepare_trace
+
+ let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.Subtype.map f tr)
+
+ let trace filter_trace get_diff fst keep_last txt ppf tr =
+ with_labels (not !Clflags.classic) (fun () ->
+ match tr with
+ | elt :: tr' ->
+ let diffed_elt = get_diff elt in
+ let tr, last = filter_trace tr' in
+ let tr = match keep_last, last with
+ | true, Some last -> tr @ [last]
+ | _ -> tr
+ in
+ let tr =
+ trees_of_trace Type
+ @@ List.map (Errortrace.map_diff prepare_expansion) tr in
+ let tr =
+ match fst, diffed_elt with
+ | true, Some elt -> elt :: tr
+ | _, _ -> tr
+ in
+ trace fst txt ppf tr
+ | _ -> ()
+ )
+
+ let rec filter_subtype_trace = function
+ | [] -> [], None
+ | [Errortrace.Subtype.Diff d as elt]
+ when printing_status elt = Optional_refinement ->
+ [], Some d
+ | Errortrace.Subtype.Diff d :: rem ->
+ let ftr, last = filter_subtype_trace rem in
+ d :: ftr, last
+
+ let unification_get_diff = function
+ | Errortrace.Diff diff ->
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+ | _ -> None
+
+ let subtype_get_diff = function
+ | Errortrace.Subtype.Diff diff ->
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+
+ let error
+ ppf
+ env
+ (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif})
+ txt1 =
+ wrap_printing_env ~error:true env (fun () ->
+ reset ();
+ let tr_sub = prepare_trace prepare_expansion tr_sub in
+ let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
+ let keep_first = match tr_unif with
+ | [Obj _ | Variant _ | Escape _ ] | [] -> true
+ | _ -> false in
+ fprintf ppf "@[<v>%a"
+ (trace filter_subtype_trace subtype_get_diff true keep_first txt1)
+ tr_sub;
+ if tr_unif = [] then fprintf ppf "@]" else
+ let mis = mismatch (doc_printf "Within this type") env tr_unif in
+ fprintf ppf "%a%a%t@]"
+ (trace filter_trace unification_get_diff false
+ (mis = None) "is not compatible with type") tr_unif
+ (pp_print_option pp_doc) mis
+ Ident_conflicts.err_print
+ )
+end
+
+let subtype = Subtype.error
+
+let quoted_ident ppf t =
+ Style.as_inline_code !Oprint.out_ident ppf t
+
+let type_path_expansion ppf = function
+ | Same p -> quoted_ident ppf p
+ | Diff(p,p') ->
+ fprintf ppf "@[<2>%a@ =@ %a@]"
+ quoted_ident p
+ quoted_ident p'
+
+let trees_of_type_path_expansion (tp,tp') =
+ let path_tree = namespaced_tree_of_path Type in
+ if Path.same tp tp' then Same(path_tree tp) else
+ Diff(path_tree tp, path_tree tp)
+
+let type_path_list ppf l =
+ Fmt.pp_print_list ~pp_sep:(fun ppf () -> Fmt.pp_print_break ppf 2 0)
+ type_path_expansion ppf l
+
+let ambiguous_type ppf env tp0 tpl txt1 txt2 txt3 =
+ wrap_printing_env ~error:true env (fun () ->
+ reset ();
+ let tp0 = trees_of_type_path_expansion tp0 in
+ match tpl with
+ [] -> assert false
+ | [tp] ->
+ fprintf ppf
+ "@[%a@;<1 2>%a@ \
+ %a@;<1 2>%a\
+ @]"
+ pp_doc txt1 type_path_expansion (trees_of_type_path_expansion tp)
+ pp_doc txt3 type_path_expansion tp0
+ | _ ->
+ fprintf ppf
+ "@[%a@;<1 2>@[<hv>%a@]\
+ @ %a@;<1 2>%a\
+ @]"
+ pp_doc txt2 type_path_list (List.map trees_of_type_path_expansion tpl)
+ pp_doc txt3 type_path_expansion tp0)
diff --git a/src/ocaml/typing/errortrace_report.mli b/src/ocaml/typing/errortrace_report.mli
new file mode 100644
index 0000000000..bb6f0ea9e1
--- /dev/null
+++ b/src/ocaml/typing/errortrace_report.mli
@@ -0,0 +1,56 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+(** Functions for reporting core level type errors. *)
+
+open Format_doc
+
+val ambiguous_type:
+ formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
+ Format_doc.t -> Format_doc.t -> Format_doc.t -> unit
+
+val unification :
+ formatter ->
+ Env.t -> Errortrace.unification_error ->
+ ?type_expected_explanation:Format_doc.t -> Format_doc.t -> Format_doc.t ->
+ unit
+
+val equality :
+ formatter ->
+ Out_type.type_or_scheme ->
+ Env.t -> Errortrace.equality_error ->
+ Format_doc.t -> Format_doc.t ->
+ unit
+
+val moregen :
+ formatter ->
+ Out_type.type_or_scheme ->
+ Env.t -> Errortrace.moregen_error ->
+ Format_doc.t -> Format_doc.t ->
+ unit
+
+val comparison :
+ formatter ->
+ Out_type.type_or_scheme ->
+ Env.t -> Errortrace.comparison_error ->
+ Format_doc.t -> Format_doc.t ->
+ unit
+
+val subtype :
+ formatter ->
+ Env.t ->
+ Errortrace.Subtype.error ->
+ string ->
+ unit
diff --git a/src/ocaml/typing/ident.ml b/src/ocaml/typing/ident.ml
index 149feff921..cc9d4e1f60 100644
--- a/src/ocaml/typing/ident.ml
+++ b/src/ocaml/typing/ident.ml
@@ -16,7 +16,8 @@
open Local_store
let lowest_scope = 0
-let highest_scope = 100000000
+let highest_scope = 100_000_000
+ (* assumed to fit in 27 bits, see Types.scope_field *)
type t =
| Local of { name: string; stamp: int }
@@ -111,6 +112,9 @@ let stamp = function
| Scoped { stamp; _ } -> stamp
| _ -> 0
+let compare_stamp id1 id2 =
+ compare (stamp id1) (stamp id2)
+
let scope = function
| Scoped { scope; _ } -> scope
| Local _ -> highest_scope
@@ -134,7 +138,7 @@ let is_predef = function
| _ -> false
let print ~with_scope ppf =
- let open Format in
+ let open Format_doc in
function
| Global name -> fprintf ppf "%s!" name
| Predef { name; stamp = n } ->
@@ -143,12 +147,12 @@ let print ~with_scope ppf =
fprintf ppf "%s/%i" name n
| Scoped { name; stamp = n; scope } ->
fprintf ppf "%s/%i%s" name n
- (if with_scope then sprintf "[%i]" scope else "")
+ (if with_scope then asprintf "[%i]" scope else "")
let print_with_scope ppf id = print ~with_scope:true ppf id
-let print ppf id = print ~with_scope:false ppf id
-
+let doc_print ppf id = print ~with_scope:false ppf id
+let print ppf id = Format_doc.compat doc_print ppf id
(* For the documentation of ['a Ident.tbl], see ident.mli.
The implementation is a copy-paste specialization of
diff --git a/src/ocaml/typing/ident.mli b/src/ocaml/typing/ident.mli
index cfc4ca10b7..e878c1bea5 100644
--- a/src/ocaml/typing/ident.mli
+++ b/src/ocaml/typing/ident.mli
@@ -24,7 +24,8 @@ include Identifiable.S with type t := t
- [compare] compares identifiers by binding location
*)
-val print_with_scope : Format.formatter -> t -> unit
+val doc_print: t Format_doc.printer
+val print_with_scope : t Format_doc.printer
(** Same as {!print} except that it will also add a "[n]" suffix
if the scope of the argument is [n]. *)
@@ -50,7 +51,11 @@ val same: t -> t -> bool
[create_*], or if they are both persistent and have the same
name. *)
+val compare_stamp: t -> t -> int
+ (** Compare only the internal stamps, 0 if absent *)
+
val compare: t -> t -> int
+ (** Compare identifiers structurally, including the name *)
val global: t -> bool
val is_predef: t -> bool
diff --git a/src/ocaml/typing/includeclass.ml b/src/ocaml/typing/includeclass.ml
index 39f00f9cf5..ff171e3272 100644
--- a/src/ocaml/typing/includeclass.ml
+++ b/src/ocaml/typing/includeclass.ml
@@ -40,7 +40,7 @@ let class_declarations env cty1 cty2 =
cty1.cty_params cty1.cty_type
cty2.cty_params cty2.cty_type
-open Format
+open Format_doc
open Ctype
(*
@@ -50,6 +50,7 @@ let rec hide_params = function
*)
let include_err mode ppf =
+ let msg fmt = Format_doc.Doc.msg fmt in
function
| CM_Virtual_class ->
fprintf ppf "A class cannot be changed from virtual to concrete"
@@ -57,38 +58,30 @@ let include_err mode ppf =
fprintf ppf
"The classes do not have the same number of type parameters"
| CM_Type_parameter_mismatch (n, env, err) ->
- Printtyp.report_equality_error ppf mode env err
- (function ppf ->
- fprintf ppf "The %d%s type parameter has type"
+ Errortrace_report.equality ppf mode env err
+ (msg "The %d%s type parameter has type"
n (Misc.ordinal_suffix n))
- (function ppf ->
- fprintf ppf "but is expected to have type")
+ (msg "but is expected to have type")
| CM_Class_type_mismatch (env, cty1, cty2) ->
Printtyp.wrap_printing_env ~error:true env (fun () ->
fprintf ppf
"@[The class type@;<1 2>%a@ %s@;<1 2>%a@]"
- Printtyp.class_type cty1
+ Printtyp.Doc.class_type cty1
"is not matched by the class type"
- Printtyp.class_type cty2)
+ Printtyp.Doc.class_type cty2)
| CM_Parameter_mismatch (n, env, err) ->
- Printtyp.report_moregen_error ppf mode env err
- (function ppf ->
- fprintf ppf "The %d%s parameter has type"
+ Errortrace_report.moregen ppf mode env err
+ (msg "The %d%s parameter has type"
n (Misc.ordinal_suffix n))
- (function ppf ->
- fprintf ppf "but is expected to have type")
+ (msg "but is expected to have type")
| CM_Val_type_mismatch (lab, env, err) ->
- Printtyp.report_comparison_error ppf mode env err
- (function ppf ->
- fprintf ppf "The instance variable %s@ has type" lab)
- (function ppf ->
- fprintf ppf "but is expected to have type")
+ Errortrace_report.comparison ppf mode env err
+ (msg "The instance variable %s@ has type" lab)
+ (msg "but is expected to have type")
| CM_Meth_type_mismatch (lab, env, err) ->
- Printtyp.report_comparison_error ppf mode env err
- (function ppf ->
- fprintf ppf "The method %s@ has type" lab)
- (function ppf ->
- fprintf ppf "but is expected to have type")
+ Errortrace_report.comparison ppf mode env err
+ (msg "The method %s@ has type" lab)
+ (msg "but is expected to have type")
| CM_Non_mutable_value lab ->
fprintf ppf
"@[The non-mutable instance variable %s cannot become mutable@]" lab
@@ -110,9 +103,11 @@ let include_err mode ppf =
| CM_Private_method lab ->
fprintf ppf "@[The private method %s cannot become public@]" lab
-let report_error mode ppf = function
+let report_error_doc mode ppf = function
| [] -> ()
| err :: errs ->
let print_errs ppf errs =
List.iter (fun err -> fprintf ppf "@ %a" (include_err mode) err) errs in
fprintf ppf "@[<v>%a%a@]" (include_err mode) err print_errs errs
+
+let report_error = Format_doc.compat1 report_error_doc
diff --git a/src/ocaml/typing/includeclass.mli b/src/ocaml/typing/includeclass.mli
index 84de6212c4..a4d4d85882 100644
--- a/src/ocaml/typing/includeclass.mli
+++ b/src/ocaml/typing/includeclass.mli
@@ -17,7 +17,6 @@
open Types
open Ctype
-open Format
val class_types:
Env.t -> class_type -> class_type -> class_match_failure list
@@ -30,4 +29,6 @@ val class_declarations:
class_match_failure list
val report_error :
- Printtyp.type_or_scheme -> formatter -> class_match_failure list -> unit
+ Out_type.type_or_scheme -> class_match_failure list Format_doc.format_printer
+val report_error_doc :
+ Out_type.type_or_scheme -> class_match_failure list Format_doc.printer
diff --git a/src/ocaml/typing/includecore.ml b/src/ocaml/typing/includecore.ml
index 595c07e935..b6db2a57bf 100644
--- a/src/ocaml/typing/includecore.ml
+++ b/src/ocaml/typing/includecore.ml
@@ -70,6 +70,26 @@ type value_mismatch =
exception Dont_match of value_mismatch
+(* A value description [vd1] is consistent with the value description [vd2] if
+ there is a context E such that [E |- vd1 <: vd2] for the ordinary subtyping.
+ For values, this is the case as soon as the kind of [vd1] is a subkind of the
+ [vd2] kind. *)
+let value_descriptions_consistency env vd1 vd2 =
+ match (vd1.val_kind, vd2.val_kind) with
+ | (Val_prim p1, Val_prim p2) -> begin
+ match primitive_descriptions p1 p2 with
+ | None -> Tcoerce_none
+ | Some err -> raise (Dont_match (Primitive_mismatch err))
+ end
+ | (Val_prim p, _) ->
+ let pc =
+ { pc_desc = p; pc_type = vd2.Types.val_type;
+ pc_env = env; pc_loc = vd1.Types.val_loc; }
+ in
+ Tcoerce_primitive pc
+ | (_, Val_prim _) -> raise (Dont_match Not_a_primitive)
+ | (_, _) -> Tcoerce_none
+
let value_descriptions ~loc env name
(vd1 : Types.value_description)
(vd2 : Types.value_description) =
@@ -81,22 +101,7 @@ let value_descriptions ~loc env name
name;
match Ctype.moregeneral env true vd1.val_type vd2.val_type with
| exception Ctype.Moregen err -> raise (Dont_match (Type err))
- | () -> begin
- match (vd1.val_kind, vd2.val_kind) with
- | (Val_prim p1, Val_prim p2) -> begin
- match primitive_descriptions p1 p2 with
- | None -> Tcoerce_none
- | Some err -> raise (Dont_match (Primitive_mismatch err))
- end
- | (Val_prim p, _) ->
- let pc =
- { pc_desc = p; pc_type = vd2.Types.val_type;
- pc_env = env; pc_loc = vd1.Types.val_loc; }
- in
- Tcoerce_primitive pc
- | (_, Val_prim _) -> raise (Dont_match Not_a_primitive)
- | (_, _) -> Tcoerce_none
- end
+ | () -> value_descriptions_consistency env vd1 vd2
(* Inclusion between manifest types (particularly for private row types) *)
@@ -203,9 +208,10 @@ type type_mismatch =
| Immediate of Type_immediacy.Violation.t
module Style = Misc.Style
+module Fmt = Format_doc
let report_primitive_mismatch first second ppf err =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
match (err : primitive_mismatch) with
| Name ->
pr "The names of the primitives are not the same"
@@ -226,7 +232,7 @@ let report_primitive_mismatch first second ppf err =
n (Misc.ordinal_suffix n)
let report_value_mismatch first second env ppf err =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
pr "@ ";
match (err : value_mismatch) with
| Primitive_mismatch pm ->
@@ -234,14 +240,16 @@ let report_value_mismatch first second env ppf err =
| Not_a_primitive ->
pr "The implementation is not a primitive."
| Type trace ->
- Printtyp.report_moregen_error ppf Type_scheme env trace
- (fun ppf -> Format.fprintf ppf "The type")
- (fun ppf -> Format.fprintf ppf "is not compatible with the type")
+ let msg = Fmt.Doc.msg in
+ Errortrace_report.moregen ppf Type_scheme env trace
+ (msg "The type")
+ (msg "is not compatible with the type")
let report_type_inequality env ppf err =
- Printtyp.report_equality_error ppf Type_scheme env err
- (fun ppf -> Format.fprintf ppf "The type")
- (fun ppf -> Format.fprintf ppf "is not equal to the type")
+ let msg = Fmt.Doc.msg in
+ Errortrace_report.equality ppf Type_scheme env err
+ (msg "The type")
+ (msg "is not equal to the type")
let report_privacy_mismatch ppf err =
let singular, item =
@@ -251,7 +259,7 @@ let report_privacy_mismatch ppf err =
| Private_record_type -> true, "record constructor"
| Private_extensible_variant -> true, "extensible variant"
| Private_row_type -> true, "row type"
- in Format.fprintf ppf "%s %s would be revealed."
+ in Format_doc.fprintf ppf "%s %s would be revealed."
(if singular then "A private" else "Private")
item
@@ -260,56 +268,56 @@ let report_label_mismatch first second env ppf err =
| Type err ->
report_type_inequality env ppf err
| Mutability ord ->
- Format.fprintf ppf "%s is mutable and %s is not."
+ Format_doc.fprintf ppf "%s is mutable and %s is not."
(String.capitalize_ascii (choose ord first second))
(choose_other ord first second)
let pp_record_diff first second prefix decl env ppf (x : record_change) =
match x with
| Delete cd ->
- Format.fprintf ppf "%aAn extra field, %a, is provided in %s %s."
+ Fmt.fprintf ppf "%aAn extra field, %a, is provided in %s %s."
prefix x Style.inline_code (Ident.name cd.delete.ld_id) first decl
| Insert cd ->
- Format.fprintf ppf "%aA field, %a, is missing in %s %s."
+ Fmt.fprintf ppf "%aA field, %a, is missing in %s %s."
prefix x Style.inline_code (Ident.name cd.insert.ld_id) first decl
| Change Type {got=lbl1; expected=lbl2; reason} ->
- Format.fprintf ppf
+ Fmt.fprintf ppf
"@[<hv>%aFields do not match:@;<1 2>\
%a@ is not the same as:\
@;<1 2>%a@ %a@]"
prefix x
- (Style.as_inline_code Printtyp.label) lbl1
- (Style.as_inline_code Printtyp.label) lbl2
+ (Style.as_inline_code Printtyp.Doc.label) lbl1
+ (Style.as_inline_code Printtyp.Doc.label) lbl2
(report_label_mismatch first second env) reason
| Change Name n ->
- Format.fprintf ppf "%aFields have different names, %a and %a."
+ Fmt.fprintf ppf "%aFields have different names, %a and %a."
prefix x
Style.inline_code n.got
Style.inline_code n.expected
| Swap sw ->
- Format.fprintf ppf "%aFields %a and %a have been swapped."
+ Fmt.fprintf ppf "%aFields %a and %a have been swapped."
prefix x
Style.inline_code sw.first
Style.inline_code sw.last
| Move {name; got; expected } ->
- Format.fprintf ppf
+ Fmt.fprintf ppf
"@[<2>%aField %a has been moved@ from@ position %d@ to %d.@]"
prefix x Style.inline_code name expected got
let report_patch pr_diff first second decl env ppf patch =
- let nl ppf () = Format.fprintf ppf "@," in
+ let nl ppf () = Fmt.fprintf ppf "@," in
let no_prefix _ppf _ = () in
match patch with
| [ elt ] ->
- Format.fprintf ppf "@[<hv>%a@]"
+ Fmt.fprintf ppf "@[<hv>%a@]"
(pr_diff first second no_prefix decl env) elt
| _ ->
let pp_diff = pr_diff first second Diffing_with_keys.prefix decl env in
- Format.fprintf ppf "@[<hv>%a@]"
- (Format.pp_print_list ~pp_sep:nl pp_diff) patch
+ Fmt.fprintf ppf "@[<hv>%a@]"
+ (Fmt.pp_print_list ~pp_sep:nl pp_diff) patch
let report_record_mismatch first second decl env ppf err =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
match err with
| Label_mismatch patch ->
report_patch pp_record_diff first second decl env ppf patch
@@ -319,7 +327,7 @@ let report_record_mismatch first second decl env ppf err =
"uses unboxed float representation"
let report_constructor_mismatch first second decl env ppf err =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
match (err : constructor_mismatch) with
| Type err -> report_type_inequality env ppf err
| Arity -> pr "They have different arities."
@@ -337,45 +345,45 @@ let report_constructor_mismatch first second decl env ppf err =
let pp_variant_diff first second prefix decl env ppf (x : variant_change) =
match x with
| Delete cd ->
- Format.fprintf ppf "%aAn extra constructor, %a, is provided in %s %s."
+ Fmt.fprintf ppf "%aAn extra constructor, %a, is provided in %s %s."
prefix x Style.inline_code (Ident.name cd.delete.cd_id) first decl
| Insert cd ->
- Format.fprintf ppf "%aA constructor, %a, is missing in %s %s."
+ Fmt.fprintf ppf "%aA constructor, %a, is missing in %s %s."
prefix x Style.inline_code (Ident.name cd.insert.cd_id) first decl
| Change Type {got; expected; reason} ->
- Format.fprintf ppf
+ Fmt.fprintf ppf
"@[<hv>%aConstructors do not match:@;<1 2>\
%a@ is not the same as:\
@;<1 2>%a@ %a@]"
prefix x
- (Style.as_inline_code Printtyp.constructor) got
- (Style.as_inline_code Printtyp.constructor) expected
+ (Style.as_inline_code Printtyp.Doc.constructor) got
+ (Style.as_inline_code Printtyp.Doc.constructor) expected
(report_constructor_mismatch first second decl env) reason
| Change Name n ->
- Format.fprintf ppf
+ Fmt.fprintf ppf
"%aConstructors have different names, %a and %a."
prefix x
Style.inline_code n.got
Style.inline_code n.expected
| Swap sw ->
- Format.fprintf ppf
+ Fmt.fprintf ppf
"%aConstructors %a and %a have been swapped."
prefix x
Style.inline_code sw.first
Style.inline_code sw.last
| Move {name; got; expected} ->
- Format.fprintf ppf
+ Fmt.fprintf ppf
"@[<2>%aConstructor %a has been moved@ from@ position %d@ to %d.@]"
prefix x Style.inline_code name expected got
let report_extension_constructor_mismatch first second decl env ppf err =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
match (err : extension_constructor_mismatch) with
| Constructor_privacy ->
pr "Private extension constructor(s) would be revealed."
| Constructor_mismatch (id, ext1, ext2, err) ->
let constructor =
- Style.as_inline_code (Printtyp.extension_only_constructor id)
+ Style.as_inline_code (Printtyp.Doc.extension_only_constructor id)
in
pr "@[<hv>Constructors do not match:@;<1 2>%a@ is not the same as:\
@;<1 2>%a@ %a@]"
@@ -385,8 +393,8 @@ let report_extension_constructor_mismatch first second decl env ppf err =
let report_private_variant_mismatch first second decl env ppf err =
- let pr fmt = Format.fprintf ppf fmt in
- let pp_tag ppf x = Format.fprintf ppf "`%s" x in
+ let pr fmt = Fmt.fprintf ppf fmt in
+ let pp_tag ppf x = Fmt.fprintf ppf "`%s" x in
match (err : private_variant_mismatch) with
| Only_outer_closed ->
(* It's only dangerous in one direction, so we don't have a position *)
@@ -403,14 +411,14 @@ let report_private_variant_mismatch first second decl env ppf err =
report_type_inequality env ppf err
let report_private_object_mismatch env ppf err =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
match (err : private_object_mismatch) with
| Missing s ->
pr "The implementation is missing the method %a" Style.inline_code s
| Types err -> report_type_inequality env ppf err
let report_kind_mismatch first second ppf (kind1, kind2) =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
let kind_to_string = function
| Kind_abstract -> "abstract"
| Kind_record -> "a record"
@@ -423,7 +431,7 @@ let report_kind_mismatch first second ppf (kind1, kind2) =
(kind_to_string kind2)
let report_type_mismatch first second decl env ppf err =
- let pr fmt = Format.fprintf ppf fmt in
+ let pr fmt = Fmt.fprintf ppf fmt in
pr "@ ";
match err with
| Arity ->
@@ -543,14 +551,37 @@ module Record_diffing = struct
| None -> Ok ()
let weight: Diff.change -> _ = function
- | Insert _ -> 10
- | Delete _ -> 10
+ | Insert _ | Delete _ ->
+ (* Insertion and deletion are symmetrical for definitions *)
+ 100
| Keep _ -> 0
- | Change (_,_,Diffing_with_keys.Name t ) ->
- if t.types_match then 10 else 15
- | Change _ -> 10
-
-
+ (* [Keep] must have the smallest weight. *)
+ | Change (_,_,c) ->
+ (* Constraints:
+ - [ Change < Insert + Delete ], otherwise [Change] are never optimal
+
+ - [ Swap < Move ] => [ 2 Change < Insert + Delete ] =>
+ [ Change < Delete ], in order to favour consecutive [Swap]s
+ over [Move]s.
+
+ - For some D and a large enough R,
+ [Delete^D Keep^R Insert^D < Change^(D+R)]
+ => [ Change > (2 D)/(D+R) Delete ].
+ Note that the case [D=1,R=1] is incompatible with the inequation
+ above. If we choose [R = D + 1] for [D<5], we can specialize the
+ inequation to [ Change > 10 / 11 Delete ]. *)
+ match c with
+ (* With [Type<Name with type<Name], we pick constructor with the right
+ name over the one with the right type. *)
+ | Diffing_with_keys.Name t ->
+ if t.types_match then 98 else 99
+ | Diffing_with_keys.Type _ -> 50
+ (* With the uniqueness constraint on keys, the only relevant constraint
+ is [Type-only change < Name change]. Indeed, names can only match at
+ one position. In other words, if a [ Type ] patch is admissible, the
+ only admissible patches at this position are of the form [Delete^D
+ Name_change]. And with the constranit [Type_change < Name_change],
+ we have [Type_change Delete^D < Delete^D Name_change]. *)
let key (x: Defs.left) = Ident.name x.ld_id
let diffing loc env params1 params2 cstrs_1 cstrs_2 =
@@ -662,13 +693,12 @@ module Variant_diffing = struct
let update _ st = st
let weight: D.change -> _ = function
- | Insert _ -> 10
- | Delete _ -> 10
+ | Insert _ | Delete _ -> 100
| Keep _ -> 0
- | Change (_,_,Diffing_with_keys.Name t) ->
- if t.types_match then 10 else 15
- | Change _ -> 10
-
+ | Change (_,_,Diffing_with_keys.Name c) ->
+ if c.types_match then 98 else 99
+ | Change (_,_,Diffing_with_keys.Type _) -> 50
+ (** See {!Variant_diffing.weight} for an explanation *)
let test loc env (params1,params2)
({pos; data=cd1}: D.left)
@@ -890,6 +920,17 @@ let type_manifest env ty1 params1 ty2 params2 priv2 kind2 =
| () -> None
end
+(* A type declarations [td1] is consistent with the type declaration [td2] if
+ there is a context E such E |- td1 <: td2 for the ordinary subtyping. For
+ types, this is the case as soon as the two type declarations share the same
+ arity and the privacy of [td1] is less than the privacy of [td2] (consider a
+ context E where all type constructors are equal). *)
+let type_declarations_consistency env decl1 decl2 =
+ if decl1.type_arity <> decl2.type_arity then Some Arity
+ else match privacy_mismatch env decl1 decl2 with
+ | Some err -> Some (Privacy err)
+ | None -> None
+
let type_declarations ?(equality = false) ~loc env ~mark name
decl1 path decl2 =
Builtin_attributes.check_alerts_inclusion
@@ -898,12 +939,7 @@ let type_declarations ?(equality = false) ~loc env ~mark name
loc
decl1.type_attributes decl2.type_attributes
name;
- if decl1.type_arity <> decl2.type_arity then Some Arity else
- let err =
- match privacy_mismatch env decl1 decl2 with
- | Some err -> Some (Privacy err)
- | None -> None
- in
+ let err = type_declarations_consistency env decl1 decl2 in
if err <> None then err else
let err = match (decl1.type_manifest, decl2.type_manifest) with
(_, None) ->
diff --git a/src/ocaml/typing/includecore.mli b/src/ocaml/typing/includecore.mli
index 50825976ce..bed53fb036 100644
--- a/src/ocaml/typing/includecore.mli
+++ b/src/ocaml/typing/includecore.mli
@@ -118,6 +118,21 @@ val extension_constructors:
loc:Location.t -> Env.t -> mark:bool -> Ident.t ->
extension_constructor -> extension_constructor ->
extension_constructor_mismatch option
+
+(** The functions [value_descriptions_consistency] and
+ [type_declarations_consistency] check if two declaration are consistent.
+ Declarations are consistent when there exists an environment such that the
+ first declaration is a subtype of the second one.
+
+ Notably, if a type declaration [td1] is consistent with [td2] then a type
+ expression [te] which is well-formed with the [td2] declaration in scope
+ is still well-formed with the [td1] declaration: [E, td2 |- te] => [E, td1
+ |- te]. *)
+val value_descriptions_consistency:
+ Env.t -> value_description -> value_description -> module_coercion
+val type_declarations_consistency:
+ Env.t -> type_declaration -> type_declaration -> type_mismatch option
+
(*
val class_types:
Env.t -> class_type -> class_type -> bool
@@ -126,14 +141,14 @@ val class_types:
val report_value_mismatch :
string -> string ->
Env.t ->
- Format.formatter -> value_mismatch -> unit
+ value_mismatch Format_doc.printer
val report_type_mismatch :
string -> string -> string ->
Env.t ->
- Format.formatter -> type_mismatch -> unit
+ type_mismatch Format_doc.printer
val report_extension_constructor_mismatch :
string -> string -> string ->
Env.t ->
- Format.formatter -> extension_constructor_mismatch -> unit
+ extension_constructor_mismatch Format_doc.printer
diff --git a/src/ocaml/typing/includemod.ml b/src/ocaml/typing/includemod.ml
index b43602c51c..0cb220cf32 100644
--- a/src/ocaml/typing/includemod.ml
+++ b/src/ocaml/typing/includemod.ml
@@ -134,78 +134,145 @@ module Error = struct
end
-type mark =
+module Directionality = struct
+
+ type mark =
| Mark_both
| Mark_positive
- | Mark_negative
| Mark_neither
-let negate_mark = function
- | Mark_both -> Mark_both
- | Mark_positive -> Mark_negative
- | Mark_negative -> Mark_positive
- | Mark_neither -> Mark_neither
-
-let mark_positive = function
- | Mark_both | Mark_positive -> true
- | Mark_negative | Mark_neither -> false
-
-(* All functions "blah env x1 x2" check that x1 is included in x2,
- i.e. that x1 is the type of an implementation that fulfills the
- specification x2. If not, Error is raised with a backtrace of the error. *)
-
-(* Inclusion between value descriptions *)
-
-let value_descriptions ~loc env ~mark subst id vd1 vd2 =
- Cmt_format.record_value_dependency vd1 vd2;
- if mark_positive mark then
- Env.mark_value_used vd1.val_uid;
- let vd2 = Subst.value_description subst vd2 in
- try
- Ok (Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2)
- with Includecore.Dont_match err ->
- Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
-
-(* Inclusion between type declarations *)
-
-let type_declarations ~loc env ~mark ?old_env:_ subst id decl1 decl2 =
- let mark = mark_positive mark in
- if mark then
- Env.mark_type_used decl1.type_uid;
- let decl2 = Subst.type_declaration subst decl2 in
- match
- Includecore.type_declarations ~loc env ~mark
- (Ident.name id) decl1 (Path.Pident id) decl2
- with
- | None -> Ok Tcoerce_none
- | Some err ->
- Error Error.(Core(Type_declarations (diff decl1 decl2 err)))
-
-(* Inclusion between extension constructors *)
-
-let extension_constructors ~loc env ~mark subst id ext1 ext2 =
- let mark = mark_positive mark in
- let ext2 = Subst.extension_constructor subst ext2 in
- match Includecore.extension_constructors ~loc env ~mark id ext1 ext2 with
- | None -> Ok Tcoerce_none
- | Some err ->
- Error Error.(Core(Extension_constructors(diff ext1 ext2 err)))
-
-(* Inclusion between class declarations *)
-
-let class_type_declarations ~loc ~old_env:_ env subst decl1 decl2 =
- let decl2 = Subst.cltype_declaration subst decl2 in
- match Includeclass.class_type_declarations ~loc env decl1 decl2 with
- [] -> Ok Tcoerce_none
- | reason ->
- Error Error.(Core(Class_type_declarations(diff decl1 decl2 reason)))
-
-let class_declarations ~old_env:_ env subst decl1 decl2 =
- let decl2 = Subst.class_declaration subst decl2 in
- match Includeclass.class_declarations env decl1 decl2 with
- [] -> Ok Tcoerce_none
- | reason ->
- Error Error.(Core(Class_declarations(diff decl1 decl2 reason)))
+ type pos =
+ | Strictly_positive
+ (** Strictly positive positions are notable for tools since they are the
+ the case where we match a implementation definition with an interface
+ declaration. Oherwise in the positive case we are matching
+ declatations inside functor arguments at even level of nesting.*)
+ | Positive
+ | Negative
+
+
+(**
+ When checking inclusion, the [Directionality.t] type tracks the
+ subtyping direction at the syntactic level.
+
+ The [posivity] field is used in the [cmt_declaration_dependencies] to
+ distinguish between directed and undirected edges, and to avoid recording
+ matched declarations twice.
+
+ The [mark_as_used] field describes if we should record only positive use,
+ any use (because there is no clear implementation side), or none (because we
+ are inside an auxiliary check function.)
+
+ The [in_eq] field is [true] when we are checking both directions inside of
+ module types which allows optimizing module type equality checks. The module
+ subtyping relation [A <: B] checks that [A.T = B.T] when [A] and [B] define a
+ module type [T]. The relation [A.T = B.T] is equivalent to [(A.T <: B.T) and
+ (B.T <: A.T)], but checking both recursively would lead to an exponential
+ slowdown (see #10598 and #10616). To avoid this issue, when [in_eq] is
+ [true], we compute a coarser relation [A << B] which is the same as [A <: B]
+ except that module types [T] are checked only for [A.T << B.T] and not the
+ reverse. Thus, we can implement a cheap module type equality check [A.T =
+ B.T] by computing [(A.T << B.T) and (B.T << A.T)], avoiding the exponential
+ slowdown described above.
+*)
+ type t = {
+ in_eq:bool;
+ mark_as_used:mark;
+ pos:pos;
+ }
+
+ let strictly_positive ~mark =
+ let mark_as_used = if mark then Mark_positive else Mark_neither in
+ { in_eq=false; pos=Strictly_positive; mark_as_used }
+
+ let unknown ~mark =
+ let mark_as_used = if mark then Mark_both else Mark_neither in
+ { in_eq=false; pos=Positive; mark_as_used }
+
+ let negate_pos = function
+ | Positive | Strictly_positive -> Negative
+ | Negative -> Positive
+
+ let negate d = { d with pos = negate_pos d.pos }
+
+ let at_most_positive = function
+ | Strictly_positive -> Positive
+ | Positive | Negative as non_strict -> non_strict
+
+ let enter_eq d =
+ {
+ in_eq = true;
+ pos = at_most_positive d.pos;
+ mark_as_used = d.mark_as_used
+ }
+
+ let mark_as_used d = match d.mark_as_used with
+ | Mark_neither -> false
+ | Mark_both -> true
+ | Mark_positive ->
+ match d.pos with
+ | Positive | Strictly_positive -> true
+ | Negative -> false
+
+end
+
+module Core_inclusion = struct
+ (* All functions "blah env x1 x2" check that x1 is included in x2,
+ i.e. that x1 is the type of an implementation that fulfills the
+ specification x2. If not, Error is raised with a backtrace of the error. *)
+
+ (* Inclusion between value descriptions *)
+
+ let value_descriptions ~loc env ~direction subst id vd1 vd2 =
+ if Directionality.mark_as_used direction then
+ Env.mark_value_used vd1.val_uid;
+ let vd2 = Subst.value_description subst vd2 in
+ try
+ Ok (Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2)
+ with Includecore.Dont_match err ->
+ Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
+
+ (* Inclusion between type declarations *)
+
+ let type_declarations ~loc env ~direction subst id decl1 decl2 =
+ let mark = Directionality.mark_as_used direction in
+ if mark then
+ Env.mark_type_used decl1.type_uid;
+ let decl2 = Subst.type_declaration subst decl2 in
+ match
+ Includecore.type_declarations ~loc env ~mark
+ (Ident.name id) decl1 (Path.Pident id) decl2
+ with
+ | None -> Ok Tcoerce_none
+ | Some err ->
+ Error Error.(Core(Type_declarations (diff decl1 decl2 err)))
+
+ (* Inclusion between extension constructors *)
+
+ let extension_constructors ~loc env ~direction subst id ext1 ext2 =
+ let mark = Directionality.mark_as_used direction in
+ let ext2 = Subst.extension_constructor subst ext2 in
+ match Includecore.extension_constructors ~loc env ~mark id ext1 ext2 with
+ | None -> Ok Tcoerce_none
+ | Some err ->
+ Error Error.(Core(Extension_constructors(diff ext1 ext2 err)))
+
+ (* Inclusion between class declarations *)
+
+ let class_type_declarations ~loc env ~direction:_ subst _id decl1 decl2 =
+ let decl2 = Subst.cltype_declaration subst decl2 in
+ match Includeclass.class_type_declarations ~loc env decl1 decl2 with
+ [] -> Ok Tcoerce_none
+ | reason ->
+ Error Error.(Core(Class_type_declarations(diff decl1 decl2 reason)))
+
+ let class_declarations ~loc:_ env ~direction:_ subst _id decl1 decl2 =
+ let decl2 = Subst.class_declaration subst decl2 in
+ match Includeclass.class_declarations env decl1 decl2 with
+ [] -> Ok Tcoerce_none
+ | reason ->
+ Error Error.(Core(Class_declarations(diff decl1 decl2 reason)))
+end
(* Expand a module type identifier when possible *)
@@ -308,10 +375,10 @@ let rec print_coercion ppf c =
print_coercion out
| Tcoerce_primitive {pc_desc; pc_env = _; pc_type} ->
pr "prim %s@ (%a)" pc_desc.Primitive.prim_name
- Printtyp.raw_type_expr pc_type
+ Rawprinttyp.type_expr pc_type
| Tcoerce_alias (_, p, c) ->
pr "@[<2>alias %a@ (%a)@]"
- Printtyp.path p
+ (Format_doc.compat Printtyp.Doc.path) p
print_coercion c
and print_coercion2 ppf (n, c) =
Format.fprintf ppf "@[%d,@ %a@]" n print_coercion c
@@ -407,30 +474,33 @@ module Sign_diff = struct
}
end
-(**
- In the group of mutual functions below, the [~in_eq] argument is [true] when
- we are in fact checking equality of module types.
-
- The module subtyping relation [A <: B] checks that [A.T = B.T] when [A]
- and [B] define a module type [T]. The relation [A.T = B.T] is equivalent
- to [(A.T <: B.T) and (B.T <: A.T)], but checking both recursively would lead
- to an exponential slowdown (see #10598 and #10616).
- To avoid this issue, when [~in_eq] is [true], we compute a coarser relation
- [A << B] which is the same as [A <: B] except that module types [T] are
- checked only for [A.T << B.T] and not the reverse.
- Thus, we can implement a cheap module type equality check [A.T = B.T] by
- computing [(A.T << B.T) and (B.T << A.T)], avoiding the exponential slowdown
- described above.
-*)
+(** Core type system subtyping-like relation that we want to lift at the module
+ level. We have two relations that we want to lift:
+
+ - the normal subtyping relation [<:].
+ - the coarse-grain consistency relation [C], which is defined by
+ [d1 C d2] if there is an environment [E] such that [E |- d1 <: d2]. *)
+type 'a core_incl =
+ loc:Location.t -> Env.t -> direction:Directionality.t -> Subst.t -> Ident.t ->
+ 'a -> 'a -> (module_coercion, Error.sigitem_symptom) result
-let rec modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape =
- match try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape with
+type core_relation = {
+ value_descriptions: Types.value_description core_incl;
+ type_declarations: Types.type_declaration core_incl;
+ extension_constructors: Types.extension_constructor core_incl;
+ class_declarations: Types.class_declaration core_incl;
+ class_type_declarations: Types.class_type_declaration core_incl;
+}
+
+
+let rec modtypes ~core ~direction ~loc env subst mty1 mty2 shape =
+ match try_modtypes ~core ~direction ~loc env subst mty1 mty2 shape with
| Ok _ as ok -> ok
| Error reason ->
let mty2 = Subst.modtype Make_local subst mty2 in
Error Error.(diff mty1 mty2 reason)
-and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
+and try_modtypes ~core ~direction ~loc env subst mty1 mty2 orig_shape =
match mty1, mty2 with
| (Mty_alias p1, Mty_alias p2) ->
if Env.is_functor_arg p2 env then
@@ -448,8 +518,8 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
begin match expand_module_alias ~strengthen:false env p1 with
| Error e -> Error (Error.Mt_core e)
| Ok mty1 ->
- match strengthened_modtypes ~in_eq ~loc ~aliasable:true env ~mark
- subst mty1 p1 mty2 orig_shape
+ match strengthened_modtypes ~core ~direction ~loc ~aliasable:true
+ env subst mty1 p1 mty2 orig_shape
with
| Ok _ as x -> x
| Error reason -> Error (Error.After_alias_expansion reason)
@@ -462,20 +532,21 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
else
begin match expand_modtype_path env p1, expand_modtype_path env p2 with
| Some mty1, Some mty2 ->
- try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape
+ try_modtypes ~core ~direction ~loc env subst mty1 mty2 orig_shape
| None, _ | _, None -> Error (Error.Mt_core Abstract_module_type)
end
| (Mty_ident p1, _) ->
let p1 = Env.normalize_modtype_path env p1 in
begin match expand_modtype_path env p1 with
| Some p1 ->
- try_modtypes ~in_eq ~loc env ~mark subst p1 mty2 orig_shape
+ try_modtypes ~core ~direction ~loc env subst p1 mty2 orig_shape
| None -> Error (Error.Mt_core Abstract_module_type)
end
| (_, Mty_ident p2) ->
let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
begin match expand_modtype_path env p2 with
- | Some p2 -> try_modtypes ~in_eq ~loc env ~mark subst mty1 p2 orig_shape
+ | Some p2 ->
+ try_modtypes ~core ~direction ~loc env subst mty1 p2 orig_shape
| None ->
begin match mty1 with
| Mty_functor _ ->
@@ -487,14 +558,15 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
end
| (Mty_signature sig1, Mty_signature sig2) ->
begin match
- signatures ~in_eq ~loc env ~mark subst sig1 sig2 orig_shape
+ signatures ~core ~direction ~loc env subst sig1 sig2 orig_shape
with
| Ok _ as ok -> ok
| Error e -> Error (Error.Signature e)
end
| Mty_functor (param1, res1), Mty_functor (param2, res2) ->
let cc_arg, env, subst =
- functor_param ~in_eq ~loc env ~mark:(negate_mark mark)
+ let direction = Directionality.negate direction in
+ functor_param ~core ~direction ~loc env
subst param1 param2
in
let var, res_shape =
@@ -502,16 +574,18 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
| Some (var, res_shape) -> var, res_shape
| None ->
(* Using a fresh variable with a placeholder uid here is fine: users
- will never try to jump to the definition of that variable.
- If they try to jump to the parameter from inside the functor,
- they will use the variable shape that is stored in the local
- environment. *)
+ will never try to jump to the definition of that variable. If
+ they try to jump to the parameter from inside the functor, they
+ will use the variable shape that is stored in the local
+ environment. *)
let var, shape_var =
Shape.fresh_var Uid.internal_not_actually_unique
in
var, Shape.app orig_shape ~arg:shape_var
in
- let cc_res = modtypes ~in_eq ~loc env ~mark subst res1 res2 res_shape in
+ let cc_res =
+ modtypes ~core ~direction ~loc env subst res1 res2 res_shape
+ in
begin match cc_arg, cc_res with
| Ok Tcoerce_none, Ok (Tcoerce_none, final_res_shape) ->
let final_shape =
@@ -555,7 +629,7 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
(* Functor parameters *)
-and functor_param ~in_eq ~loc env ~mark subst param1 param2 =
+and functor_param ~core ~direction ~loc env subst param1 param2 =
match param1, param2 with
| Unit, Unit ->
Ok Tcoerce_none, env, subst
@@ -563,7 +637,7 @@ and functor_param ~in_eq ~loc env ~mark subst param1 param2 =
let arg2' = Subst.modtype Keep subst arg2 in
let cc_arg =
match
- modtypes ~in_eq ~loc env ~mark Subst.identity arg2' arg1
+ modtypes ~core ~direction ~loc env Subst.identity arg2' arg1
Shape.dummy_mod
with
| Ok (cc, _) -> Ok cc
@@ -591,27 +665,28 @@ and equate_one_functor_param subst env arg2' name1 name2 =
| None, None ->
env, subst
-and strengthened_modtypes ~in_eq ~loc ~aliasable env ~mark
+and strengthened_modtypes ~core ~direction ~loc ~aliasable env
subst mty1 path1 mty2 shape =
match mty1, mty2 with
| Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
Ok (Tcoerce_none, shape)
| _, _ ->
let mty1 = Mtype.strengthen ~aliasable env mty1 path1 in
- modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape
+ modtypes ~core ~direction ~loc env subst mty1 mty2 shape
-and strengthened_module_decl ~loc ~aliasable env ~mark
+and strengthened_module_decl ~core ~loc ~aliasable ~direction env
subst md1 path1 md2 shape =
match md1.md_type, md2.md_type with
| Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
Ok (Tcoerce_none, shape)
| _, _ ->
let md1 = Mtype.strengthen_decl ~aliasable env md1 path1 in
- modtypes ~in_eq:false ~loc env ~mark subst md1.md_type md2.md_type shape
+ modtypes ~core ~direction ~loc env subst md1.md_type md2.md_type shape
+
(* Inclusion between signatures *)
-and signatures ~in_eq ~loc env ~mark subst sig1 sig2 mod_shape =
+and signatures ~core ~direction ~loc env subst sig1 sig2 mod_shape =
(* Environment used to check inclusion of components *)
let new_env =
Env.add_signature sig1 (Env.in_signature true env) in
@@ -656,12 +731,12 @@ and signatures ~in_eq ~loc env ~mark subst sig1 sig2 mod_shape =
Return a coercion list indicating, for all run-time components
of sig2, the position of the matching run-time components of sig1
and the coercion to be applied to it. *)
- let rec pair_components subst paired unpaired = function
+ let rec pair_components ~core subst paired unpaired = function
[] ->
let open Sign_diff in
let d =
- signature_components ~in_eq ~loc env ~mark new_env subst mod_shape
- Shape.Map.empty
+ signature_components ~core ~direction ~loc env new_env subst
+ mod_shape Shape.Map.empty
(List.rev paired)
in
begin match unpaired, d.errors, d.runtime_coercions, d.leftovers with
@@ -705,36 +780,37 @@ and signatures ~in_eq ~loc env ~mark subst sig1 sig2 mod_shape =
| Sig_module _ ->
Subst.add_module id2 (Path.Pident id1) subst
| Sig_modtype _ ->
- Subst.add_modtype id2 (Mty_ident (Path.Pident id1)) subst
+ Subst.add_modtype id2 (Path.Pident id1) subst
| Sig_value _ | Sig_typext _
| Sig_class _ | Sig_class_type _ ->
subst
in
- pair_components new_subst
+ pair_components ~core new_subst
((item1, item2, pos1) :: paired) unpaired rem
| exception Not_found ->
let unpaired =
if report then
item2 :: unpaired
else unpaired in
- pair_components subst paired unpaired rem
+ pair_components ~core subst paired unpaired rem
end in
(* Do the pairing and checking, and return the final coercion *)
- pair_components subst [] [] sig2
+ pair_components ~core subst [] [] sig2
(* Inclusion between signature components *)
-and signature_components ~in_eq ~loc old_env ~mark env subst
+and signature_components ~core ~direction ~loc old_env env subst
orig_shape shape_map paired =
match paired with
| [] -> Sign_diff.{ empty with shape_map }
| (sigi1, sigi2, pos) :: rem ->
let shape_modified = ref false in
- let id, item, shape_map, present_at_runtime =
+ let id, item, paired_uids, shape_map, present_at_runtime =
match sigi1, sigi2 with
| Sig_value(id1, valdecl1, _) ,Sig_value(_id2, valdecl2, _) ->
let item =
- value_descriptions ~loc env ~mark subst id1 valdecl1 valdecl2
+ core.value_descriptions ~loc ~direction env subst id1
+ valdecl1 valdecl2
in
let item = mark_error_as_recoverable item in
let present_at_runtime = match valdecl2.val_kind with
@@ -742,33 +818,35 @@ and signature_components ~in_eq ~loc old_env ~mark env subst
| _ -> true
in
let shape_map = Shape.Map.add_value_proj shape_map id1 orig_shape in
- id1, item, shape_map, present_at_runtime
+ let paired_uids = (valdecl1.val_uid, valdecl2.val_uid) in
+ id1, item, paired_uids, shape_map, present_at_runtime
| Sig_type(id1, tydec1, _, _), Sig_type(_id2, tydec2, _, _) ->
let item =
- type_declarations ~loc ~old_env env ~mark subst id1 tydec1 tydec2
+ core.type_declarations ~loc ~direction env subst id1 tydec1 tydec2
in
let item = mark_error_as_unrecoverable item in
(* Right now we don't filter hidden constructors / labels from the
shape. *)
let shape_map = Shape.Map.add_type_proj shape_map id1 orig_shape in
- id1, item, shape_map, false
+ id1, item, (tydec1.type_uid, tydec2.type_uid), shape_map, false
| Sig_typext(id1, ext1, _, _), Sig_typext(_id2, ext2, _, _) ->
let item =
- extension_constructors ~loc env ~mark subst id1 ext1 ext2
+ core.extension_constructors ~loc ~direction env subst id1
+ ext1 ext2
in
let item = mark_error_as_unrecoverable item in
let shape_map =
Shape.Map.add_extcons_proj shape_map id1 orig_shape
in
- id1, item, shape_map, true
+ id1, item, (ext1.ext_uid, ext2.ext_uid), shape_map, true
| Sig_module(id1, pres1, mty1, _, _), Sig_module(_, pres2, mty2, _, _)
-> begin
let orig_shape =
Shape.(proj orig_shape (Item.module_ id1))
in
let item =
- module_declarations ~in_eq ~loc env ~mark subst id1 mty1 mty2
- orig_shape
+ module_declarations ~core ~direction ~loc env subst id1
+ mty1 mty2 orig_shape
in
let item, shape_map =
match item with
@@ -792,35 +870,37 @@ and signature_components ~in_eq ~loc old_env ~mark env subst
| Mp_absent, Mp_present, _ -> assert false
in
let item = mark_error_as_unrecoverable item in
- id1, item, shape_map, present_at_runtime
+ let paired_uids = (mty1.md_uid, mty2.md_uid) in
+ id1, item, paired_uids, shape_map, present_at_runtime
end
| Sig_modtype(id1, info1, _), Sig_modtype(_id2, info2, _) ->
let item =
- modtype_infos ~in_eq ~loc env ~mark subst id1 info1 info2
+ modtype_infos ~core ~direction ~loc env subst id1 info1 info2
in
let shape_map =
Shape.Map.add_module_type_proj shape_map id1 orig_shape
in
let item = mark_error_as_unrecoverable item in
- id1, item, shape_map, false
+ id1, item, (info1.mtd_uid, info2.mtd_uid), shape_map, false
| Sig_class(id1, decl1, _, _), Sig_class(_id2, decl2, _, _) ->
let item =
- class_declarations ~old_env env subst decl1 decl2
+ core.class_declarations ~loc ~direction env subst id1 decl1 decl2
in
let shape_map =
Shape.Map.add_class_proj shape_map id1 orig_shape
in
let item = mark_error_as_unrecoverable item in
- id1, item, shape_map, true
+ id1, item, (decl1.cty_uid, decl2.cty_uid), shape_map, true
| Sig_class_type(id1, info1, _, _), Sig_class_type(_id2, info2, _, _) ->
let item =
- class_type_declarations ~loc ~old_env env subst info1 info2
+ core.class_type_declarations ~loc ~direction env subst id1
+ info1 info2
in
let item = mark_error_as_unrecoverable item in
let shape_map =
Shape.Map.add_class_type_proj shape_map id1 orig_shape
in
- id1, item, shape_map, false
+ id1, item, (info1.clty_uid, info2.clty_uid), shape_map, false
| _ ->
assert false
in
@@ -828,6 +908,25 @@ and signature_components ~in_eq ~loc old_env ~mark env subst
let first =
match item with
| Ok x ->
+ begin match direction with
+ | { Directionality.in_eq = true; pos = Negative }
+ | { Directionality.mark_as_used = Mark_neither; _ } ->
+ (* We do not store paired uids when checking for reverse
+ module-type inclusion as it would introduce duplicates. *)
+ ()
+ | { Directionality.pos; _} ->
+ let paired_uids =
+ let elt1, elt2 = paired_uids in
+ match pos with
+ | Negative ->
+ (Cmt_format.Declaration_to_declaration, elt2, elt1)
+ | Positive ->
+ (Cmt_format.Declaration_to_declaration, elt1, elt2)
+ | Strictly_positive ->
+ (Cmt_format. Definition_to_declaration, elt1, elt2)
+ in
+ Cmt_format.record_declaration_dependency paired_uids
+ end;
let runtime_coercions =
if present_at_runtime then [pos,x] else []
in
@@ -841,13 +940,13 @@ and signature_components ~in_eq ~loc old_env ~mark env subst
in
let rest =
if continue then
- signature_components ~in_eq ~loc old_env ~mark env subst
+ signature_components ~core ~direction ~loc old_env env subst
orig_shape shape_map rem
else Sign_diff.{ empty with leftovers=rem }
in
Sign_diff.merge first rest
-and module_declarations ~in_eq ~loc env ~mark subst id1 md1 md2 orig_shape =
+and module_declarations ~direction ~loc env subst id1 md1 md2 orig_shape =
Builtin_attributes.check_alerts_inclusion
~def:md1.md_loc
~use:md2.md_loc
@@ -855,14 +954,14 @@ and module_declarations ~in_eq ~loc env ~mark subst id1 md1 md2 orig_shape =
md1.md_attributes md2.md_attributes
(Ident.name id1);
let p1 = Path.Pident id1 in
- if mark_positive mark then
+ if Directionality.mark_as_used direction then
Env.mark_module_used md1.md_uid;
- strengthened_modtypes ~in_eq ~loc ~aliasable:true env ~mark subst
+ strengthened_modtypes ~direction ~loc ~aliasable:true env subst
md1.md_type p1 md2.md_type orig_shape
(* Inclusion between module type specifications *)
-and modtype_infos ~in_eq ~loc env ~mark subst id info1 info2 =
+and modtype_infos ~core ~direction ~loc env subst id info1 info2 =
Builtin_attributes.check_alerts_inclusion
~def:info1.mtd_loc
~use:info2.mtd_loc
@@ -875,28 +974,30 @@ and modtype_infos ~in_eq ~loc env ~mark subst id info1 info2 =
(None, None) -> Ok Tcoerce_none
| (Some _, None) -> Ok Tcoerce_none
| (Some mty1, Some mty2) ->
- check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2
+ check_modtype_equiv ~core ~direction ~loc env mty1 mty2
| (None, Some mty2) ->
let mty1 = Mty_ident(Path.Pident id) in
- check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2 in
+ check_modtype_equiv ~core ~direction ~loc env mty1 mty2 in
match r with
| Ok _ as ok -> ok
| Error e -> Error Error.(Module_type_declaration (diff info1 info2 e))
-and check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2 =
+and check_modtype_equiv ~core ~direction ~loc env mty1 mty2 =
+ let nested_eq = direction.Directionality.in_eq in
+ let direction = Directionality.enter_eq direction in
let c1 =
- modtypes ~in_eq:true ~loc env ~mark Subst.identity mty1 mty2 Shape.dummy_mod
+ modtypes ~core ~direction ~loc env Subst.identity mty1 mty2 Shape.dummy_mod
in
let c2 =
(* For nested module type paths, we check only one side of the equivalence:
the outer module type is the one responsible for checking the other side
of the equivalence.
*)
- if in_eq then None
+ if nested_eq then None
else
- let mark = negate_mark mark in
+ let direction = Directionality.negate direction in
Some (
- modtypes ~in_eq:true ~loc env ~mark Subst.identity
+ modtypes ~core ~direction ~loc env Subst.identity
mty2 mty1 Shape.dummy_mod
)
in
@@ -922,7 +1023,34 @@ let can_alias env path =
in
no_apply path && not (Env.is_functor_arg path env)
-
+let core_inclusion = Core_inclusion.{
+ type_declarations;
+ value_descriptions;
+ extension_constructors;
+ class_type_declarations;
+ class_declarations;
+}
+
+let core_consistency =
+ let type_declarations ~loc:_ env ~direction:_ _ _ d1 d2 =
+ match Includecore.type_declarations_consistency env d1 d2 with
+ | None -> Ok Tcoerce_none
+ | Some err -> Error Error.(Core(Type_declarations (diff d1 d2 err)))
+ in
+ let value_descriptions ~loc:_ env ~direction:_ _ _ vd1 vd2 =
+ match Includecore.value_descriptions_consistency env vd1 vd2 with
+ | x -> Ok x
+ | exception Includecore.Dont_match err ->
+ Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
+ in
+ let accept ~loc:_ _env ~direction:_ _subst _id _d1 _d2 = Ok Tcoerce_none in
+ {
+ type_declarations;
+ value_descriptions;
+ class_declarations=accept;
+ class_type_declarations=accept;
+ extension_constructors=accept;
+ }
type explanation = Env.t * Error.all
exception Error of explanation
@@ -941,7 +1069,8 @@ exception Apply_error of {
let check_modtype_inclusion_raw ~loc env mty1 path1 mty2 =
let aliasable = can_alias env path1 in
- strengthened_modtypes ~in_eq:false ~loc ~aliasable env ~mark:Mark_both
+ let direction = Directionality.unknown ~mark:true in
+ strengthened_modtypes ~core:core_inclusion ~direction ~loc ~aliasable env
Subst.identity mty1 path1 mty2 Shape.dummy_mod
|> Result.map fst
@@ -977,9 +1106,11 @@ let () =
interface. *)
let compunit env ~mark impl_name impl_sig intf_name intf_sig unit_shape =
+ let loc = Location.in_file impl_name in
+ let direction = Directionality.strictly_positive ~mark in
match
- signatures ~in_eq:false ~loc:(Location.in_file impl_name) env ~mark
- Subst.identity impl_sig intf_sig unit_shape
+ signatures ~core:core_inclusion ~direction ~loc env Subst.identity
+ impl_sig intf_sig unit_shape
with Result.Error reasons ->
let cdiff =
Error.In_Compilation_unit(Error.diff impl_name intf_name reasons) in
@@ -1082,7 +1213,8 @@ module Functor_inclusion_diff = struct
let test st mty1 mty2 =
let loc = Location.none in
let res, _, _ =
- functor_param ~in_eq:false ~loc st.env ~mark:Mark_neither
+ let direction=Directionality.unknown ~mark:false in
+ functor_param ~core:core_inclusion ~direction ~loc st.env
st.subst mty1 mty2
in
res
@@ -1176,9 +1308,12 @@ module Functor_app_diff = struct
| Unit, Named _ | (Anonymous | Named _), Unit ->
Result.Error (Error.Incompatible_params(arg,param))
| ( Anonymous | Named _ | Empty_struct ), Named (_, param) ->
+ let direction=Directionality.unknown ~mark:false in
match
- modtypes ~in_eq:false ~loc state.env ~mark:Mark_neither
- state.subst arg_mty param Shape.dummy_mod
+ modtypes
+ ~core:core_inclusion ~direction ~loc
+ state.env state.subst arg_mty param
+ Shape.dummy_mod
with
| Error mty -> Result.Error (Error.Mismatch mty)
| Ok (cc, _) -> Ok cc
@@ -1199,36 +1334,64 @@ end
(* Hide the context and substitution parameters to the outside world *)
let modtypes_with_shape ~shape ~loc env ~mark mty1 mty2 =
- match modtypes ~in_eq:false ~loc env ~mark
- Subst.identity mty1 mty2 shape
+ (* modtypes with shape is used when typing module expressions in [Typemod] *)
+ let direction = Directionality.strictly_positive ~mark in
+ match
+ modtypes ~core:core_inclusion ~direction ~loc env Subst.identity
+ mty1 mty2 shape
with
| Ok (cc, shape) -> cc, shape
| Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+let modtypes_consistency ~loc env mty1 mty2 =
+ let direction = Directionality.unknown ~mark:false in
+ match
+ modtypes ~core:core_consistency ~direction ~loc env Subst.identity
+ mty1 mty2 Shape.dummy_mod
+ with
+ | Ok _ -> ()
+ | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+
let modtypes ~loc env ~mark mty1 mty2 =
- match modtypes ~in_eq:false ~loc env ~mark
- Subst.identity mty1 mty2 Shape.dummy_mod
+ let direction = Directionality.unknown ~mark in
+ match
+ modtypes ~core:core_inclusion ~direction ~loc env Subst.identity
+ mty1 mty2 Shape.dummy_mod
with
| Ok (cc, _) -> cc
| Error reason -> raise (Error (env, Error.(In_Module_type reason)))
-let signatures env ~mark sig1 sig2 =
- match signatures ~in_eq:false ~loc:Location.none env ~mark
- Subst.identity sig1 sig2 Shape.dummy_mod
+let gen_signatures env ~direction sig1 sig2 =
+ match
+ signatures
+ ~core:core_inclusion ~direction ~loc:Location.none env
+ Subst.identity sig1 sig2 Shape.dummy_mod
with
| Ok (cc, _) -> cc
| Error reason -> raise (Error(env,Error.(In_Signature reason)))
+let signatures env ~mark sig1 sig2 =
+ let direction = Directionality.unknown ~mark in
+ gen_signatures env ~direction sig1 sig2
+
+let check_implementation env impl intf =
+ let direction = Directionality.strictly_positive ~mark:true in
+ ignore (gen_signatures env ~direction impl intf)
+
let type_declarations ~loc env ~mark id decl1 decl2 =
- match type_declarations ~loc env ~mark Subst.identity id decl1 decl2 with
+ let direction = Directionality.unknown ~mark in
+ match Core_inclusion.type_declarations ~loc env ~direction
+ Subst.identity id decl1 decl2
+ with
| Ok _ -> ()
| Error (Error.Core reason) ->
raise (Error(env,Error.(In_Type_declaration(id,reason))))
| Error _ -> assert false
let strengthened_module_decl ~loc ~aliasable env ~mark md1 path1 md2 =
- match strengthened_module_decl ~loc ~aliasable env ~mark Subst.identity
- md1 path1 md2 Shape.dummy_mod with
+ let direction = Directionality.unknown ~mark in
+ match strengthened_module_decl ~core:core_inclusion ~loc ~aliasable ~direction
+ env Subst.identity md1 path1 md2 Shape.dummy_mod with
| Ok (x, _shape) -> x
| Error mdiff ->
raise (Error(env,Error.(In_Module_type mdiff)))
@@ -1240,7 +1403,10 @@ let expand_module_alias ~strengthen env path =
raise (Error(env,In_Expansion(Error.Unbound_module_path path)))
let check_modtype_equiv ~loc env id mty1 mty2 =
- match check_modtype_equiv ~in_eq:false ~loc env ~mark:Mark_both mty1 mty2 with
+ let direction = Directionality.unknown ~mark:true in
+ match
+ check_modtype_equiv ~core:core_inclusion ~loc ~direction env mty1 mty2
+ with
| Ok _ -> ()
| Error e ->
raise (Error(env,
diff --git a/src/ocaml/typing/includemod.mli b/src/ocaml/typing/includemod.mli
index a57d51b67c..fa749601ff 100644
--- a/src/ocaml/typing/includemod.mli
+++ b/src/ocaml/typing/includemod.mli
@@ -18,18 +18,6 @@
open Typedtree
open Types
-(** Type describing which arguments of an inclusion to consider as used
- for the usage warnings. [Mark_both] is the default. *)
-type mark =
- | Mark_both
- (** Mark definitions used from both arguments *)
- | Mark_positive
- (** Mark definitions used from the positive (first) argument *)
- | Mark_negative
- (** Mark definitions used from the negative (second) argument *)
- | Mark_neither
- (** Do not mark definitions used from either argument *)
-
module Error: sig
type ('elt,'explanation) diff = {
@@ -152,15 +140,18 @@ val is_runtime_component: Types.signature_item -> bool
(* Typechecking *)
val modtypes:
- loc:Location.t -> Env.t -> mark:mark ->
+ loc:Location.t -> Env.t -> mark:bool ->
module_type -> module_type -> module_coercion
+val modtypes_consistency:
+ loc:Location.t -> Env.t -> module_type -> module_type -> unit
+
val modtypes_with_shape:
- shape:Shape.t -> loc:Location.t -> Env.t -> mark:mark ->
+ shape:Shape.t -> loc:Location.t -> Env.t -> mark:bool ->
module_type -> module_type -> module_coercion * Shape.t
val strengthened_module_decl:
- loc:Location.t -> aliasable:bool -> Env.t -> mark:mark ->
+ loc:Location.t -> aliasable:bool -> Env.t -> mark:bool ->
module_declaration -> Path.t -> module_declaration -> module_coercion
val check_modtype_inclusion :
@@ -173,15 +164,17 @@ val check_modtype_inclusion :
val check_modtype_equiv:
loc:Location.t -> Env.t -> Ident.t -> module_type -> module_type -> unit
-val signatures: Env.t -> mark:mark ->
- signature -> signature -> module_coercion
+val signatures: Env.t -> mark:bool -> signature -> signature -> module_coercion
+
+(** Check an implementation against an interface *)
+val check_implementation: Env.t -> signature -> signature -> unit
val compunit:
- Env.t -> mark:mark -> string -> signature ->
+ Env.t -> mark:bool -> string -> signature ->
string -> signature -> Shape.t -> module_coercion * Shape.t
val type_declarations:
- loc:Location.t -> Env.t -> mark:mark ->
+ loc:Location.t -> Env.t -> mark:bool ->
Ident.t -> type_declaration -> type_declaration -> unit
val print_coercion: Format.formatter -> module_coercion -> unit
diff --git a/src/ocaml/typing/includemod_errorprinter.ml b/src/ocaml/typing/includemod_errorprinter.ml
index 0ffd000bba..38e2f0e375 100644
--- a/src/ocaml/typing/includemod_errorprinter.ml
+++ b/src/ocaml/typing/includemod_errorprinter.ml
@@ -14,6 +14,7 @@
(**************************************************************************)
module Style = Misc.Style
+module Fmt = Format_doc
module Context = struct
type pos =
@@ -34,28 +35,28 @@ module Context = struct
let rec context ppf = function
Module id :: rem ->
- Format.fprintf ppf "@[<2>module %a%a@]" Printtyp.ident id args rem
+ Fmt.fprintf ppf "@[<2>module %a%a@]" Printtyp.Doc.ident id args rem
| Modtype id :: rem ->
- Format.fprintf ppf "@[<2>module type %a =@ %a@]"
- Printtyp.ident id context_mty rem
+ Fmt.fprintf ppf "@[<2>module type %a =@ %a@]"
+ Printtyp.Doc.ident id context_mty rem
| Body x :: rem ->
- Format.fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem
+ Fmt.fprintf ppf "(%s) ->@ %a" (argname x) context_mty rem
| Arg x :: rem ->
- Format.fprintf ppf "functor (%s : %a) -> ..."
+ Fmt.fprintf ppf "(%s : %a) -> ..."
(argname x) context_mty rem
| [] ->
- Format.fprintf ppf "<here>"
+ Fmt.fprintf ppf "<here>"
and context_mty ppf = function
(Module _ | Modtype _) :: _ as rem ->
- Format.fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+ Fmt.fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
| cxt -> context ppf cxt
and args ppf = function
Body x :: rem ->
- Format.fprintf ppf "(%s)%a" (argname x) args rem
+ Fmt.fprintf ppf "(%s)%a" (argname x) args rem
| Arg x :: rem ->
- Format.fprintf ppf "(%s :@ %a) : ..." (argname x) context_mty rem
+ Fmt.fprintf ppf "(%s :@ %a) : ..." (argname x) context_mty rem
| cxt ->
- Format.fprintf ppf " :@ %a" context_mty cxt
+ Fmt.fprintf ppf " :@ %a" context_mty cxt
and argname = function
| Types.Unit -> ""
| Types.Named (None, _) -> "_"
@@ -64,25 +65,24 @@ module Context = struct
let alt_pp ppf cxt =
if cxt = [] then () else
if List.for_all (function Module _ -> true | _ -> false) cxt then
- Format.fprintf ppf "in module %a,"
- (Style.as_inline_code Printtyp.path) (path_of_context cxt)
+ Fmt.fprintf ppf ",@ in module %a"
+ (Style.as_inline_code Printtyp.Doc.path) (path_of_context cxt)
else
- Format.fprintf ppf "@[<hv 2>at position@ %a,@]"
+ Fmt.fprintf ppf ",@ @[<hv 2>at position@ %a@]"
(Style.as_inline_code context) cxt
let pp ppf cxt =
if cxt = [] then () else
if List.for_all (function Module _ -> true | _ -> false) cxt then
- Format.fprintf ppf "In module %a:@ "
- (Style.as_inline_code Printtyp.path) (path_of_context cxt)
+ Fmt.fprintf ppf "In module %a:@ "
+ (Style.as_inline_code Printtyp.Doc.path) (path_of_context cxt)
else
- Format.fprintf ppf "@[<hv 2>At position@ %a@]@ "
+ Fmt.fprintf ppf "@[<hv 2>At position@ %a@]@ "
(Style.as_inline_code context) cxt
end
-module Illegal_permutation = struct
- (** Extraction of information in case of illegal permutation
- in a module type *)
+module Runtime_coercion = struct
+ (** Extraction of a small change from a non-identity runtime coercion *)
(** When examining coercions, we only have runtime component indices,
we use thus a limited version of {!pos}. *)
@@ -95,43 +95,50 @@ module Illegal_permutation = struct
| None -> g y
| Some _ as v -> v
- (** We extract a lone transposition from a full tree of permutations. *)
- let rec transposition_under path (coerc:Typedtree.module_coercion) =
+ type change =
+ | Transposition of int * int
+ | Primitive_coercion of string
+ | Alias_coercion of Path.t
+
+ (** We extract a small change from a full coercion. *)
+ let rec first_change_under path (coerc:Typedtree.module_coercion) =
match coerc with
| Tcoerce_structure(c,_) ->
either
- (not_fixpoint path 0) c
+ (first_item_transposition path 0) c
(first_non_id path 0) c
| Tcoerce_functor(arg,res) ->
either
- (transposition_under (InArg::path)) arg
- (transposition_under (InBody::path)) res
+ (first_change_under (InArg::path)) arg
+ (first_change_under (InBody::path)) res
| Tcoerce_none -> None
- | Tcoerce_alias _ | Tcoerce_primitive _ ->
- (* these coercions are not inversible, and raise an error earlier when
- checking for module type equivalence *)
- assert false
+ | Tcoerce_alias _ | Tcoerce_primitive _ -> None
+
(* we search the first point which is not invariant at the current level *)
- and not_fixpoint path pos = function
+ and first_item_transposition path pos = function
| [] -> None
| (n, _) :: q ->
- if n = pos then
- not_fixpoint path (pos+1) q
+ if n < 0 || n = pos then
+ (* when n < 0, this is not a transposition but a kind coercion,
+ which will be covered in the first_non_id case *)
+ first_item_transposition path (pos+1) q
else
- Some(List.rev path, pos, n)
+ Some(List.rev path, Transposition (pos, n))
(* we search the first item with a non-identity inner coercion *)
and first_non_id path pos = function
| [] -> None
| (_, Typedtree.Tcoerce_none) :: q -> first_non_id path (pos + 1) q
+ | (_, Typedtree.Tcoerce_alias (_,p,_)) :: _ ->
+ Some (List.rev path, Alias_coercion p)
+ | (_, Typedtree.Tcoerce_primitive p) :: _ ->
+ let name = Primitive.byte_name p.pc_desc in
+ Some (List.rev path, Primitive_coercion name)
| (_,c) :: q ->
either
- (transposition_under (Item pos :: path)) c
+ (first_change_under (Item pos :: path)) c
(first_non_id path (pos + 1)) q
- let transposition c =
- match transposition_under [] c with
- | None -> raise Not_found
- | Some x -> x
+ let first_change c = first_change_under [] c
let rec runtime_item k = function
| [] -> raise Not_found
@@ -168,23 +175,64 @@ module Illegal_permutation = struct
let item mt k = Includemod.item_ident_name (runtime_item k mt)
let pp_item ppf (id,_,kind) =
- Format.fprintf ppf "%s %a"
+ Fmt.fprintf ppf "%s %a"
(Includemod.kind_of_field_desc kind)
Style.inline_code (Ident.name id)
- let pp ctx_printer env ppf (mty,c) =
+ let illegal_permutation ctx_printer env ppf (mty,c) =
+ match first_change c with
+ | None | Some (_, (Primitive_coercion _ | Alias_coercion _)) ->
+ (* those kind coercions are not inversible, and raise an error earlier
+ when checking for module type equivalence *)
+ assert false
+ | Some (path, Transposition (k,l)) ->
try
- let p, k, l = transposition c in
- let ctx, mt = find env p mty in
- Format.fprintf ppf
+ let ctx, mt = find env path mty in
+ Fmt.fprintf ppf
"@[<hv 2>Illegal permutation of runtime components in a module type.@ \
- @[For example,@ %a@]@ @[the %a@ and the %a are not in the same order@ \
+ @[For example%a,@]@ @[the %a@ and the %a are not in the same order@ \
in the expected and actual module types.@]@]"
ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
with Not_found -> (* this should not happen *)
- Format.fprintf ppf
+ Fmt.fprintf ppf
"Illegal permutation of runtime components in a module type."
+ let in_package_subtype ctx_printer env mty c ppf =
+ match first_change c with
+ | None ->
+ (* The coercion looks like the identity but was not simplified to
+ [Tcoerce_none], this only happens when the two first-class module
+ types differ by runtime size *)
+ Fmt.fprintf ppf
+ "The two first-class module types differ by their runtime size."
+ | Some (path, c) ->
+ try
+ let ctx, mt = find env path mty in
+ match c with
+ | Primitive_coercion prim_name ->
+ Fmt.fprintf ppf
+ "@[The two first-class module types differ by a coercion of@ \
+ the primitive %a@ to a value%a.@]"
+ Style.inline_code prim_name
+ ctx_printer ctx
+ | Alias_coercion path ->
+ Fmt.fprintf ppf
+ "@[The two first-class module types differ by a coercion of@ \
+ a module alias %a@ to a module%a.@]"
+ (Style.as_inline_code Printtyp.Doc.path) path
+ ctx_printer ctx
+ | Transposition (k,l) ->
+ Fmt.fprintf ppf
+ "@[@[The two first-class module types do not share@ \
+ the same positions for runtime components.@]@ \
+ @[For example,%a@ the %a@ occurs at the expected position of@ \
+ the %a.@]@]"
+ ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
+ with Not_found ->
+ Fmt.fprintf ppf
+ "@[The two packages types do not share@ \
+ the@ same@ positions@ for@ runtime@ components.@]"
+
end
@@ -204,7 +252,7 @@ let is_big obj =
let show_loc msg ppf loc =
let pos = loc.Location.loc_start in
if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
- else Format.fprintf ppf "@\n@[<2>%a:@ %s@]" Location.print_loc loc msg
+ else Fmt.fprintf ppf "@\n@[<2>%a:@ %s@]" Location.Doc.loc loc msg
let show_locs ppf (loc1, loc2) =
show_loc "Expected declaration" ppf loc2;
@@ -212,10 +260,10 @@ let show_locs ppf (loc1, loc2) =
let dmodtype mty =
- let tmty = Printtyp.tree_of_modtype mty in
- Format.dprintf "%a" !Oprint.out_module_type tmty
+ let tmty = Out_type.tree_of_modtype mty in
+ Fmt.dprintf "%a" !Oprint.out_module_type tmty
-let space ppf () = Format.fprintf ppf "@ "
+let space ppf () = Fmt.fprintf ppf "@ "
(**
In order to display a list of functor arguments in a compact format,
@@ -264,8 +312,8 @@ module With_shorthand = struct
let make side pos =
match side with
- | Got -> Format.sprintf "$S%d" pos
- | Expected -> Format.sprintf "$T%d" pos
+ | Got -> Fmt.asprintf "$S%d" pos
+ | Expected -> Fmt.asprintf "$T%d" pos
| Unneeded -> "..."
(** Add shorthands to a patch *)
@@ -311,60 +359,60 @@ module With_shorthand = struct
(** Printing of arguments with shorthands *)
let pp ppx = function
| Original x -> ppx x
- | Synthetic s -> Format.dprintf "%s" s.name
+ | Synthetic s -> Fmt.dprintf "%s" s.name
let pp_orig ppx = function
| Original x | Synthetic { item=x; _ } -> ppx x
let definition x = match functor_param x with
- | Unit -> Format.dprintf "()"
+ | Unit -> Fmt.dprintf "()"
| Named(_,short_mty) ->
match short_mty with
| Original mty -> dmodtype mty
| Synthetic {name; item = mty} ->
- Format.dprintf
+ Fmt.dprintf
"%s@ =@ %t" name (dmodtype mty)
let param x = match functor_param x with
- | Unit -> Format.dprintf "()"
+ | Unit -> Fmt.dprintf "()"
| Named (_, short_mty) ->
pp dmodtype short_mty
let qualified_param x = match functor_param x with
- | Unit -> Format.dprintf "()"
+ | Unit -> Fmt.dprintf "()"
| Named (None, Original (Mty_signature []) ) ->
- Format.dprintf "(sig end)"
+ Fmt.dprintf "(sig end)"
| Named (None, short_mty) ->
pp dmodtype short_mty
| Named (Some p, short_mty) ->
- Format.dprintf "(%s : %t)"
+ Fmt.dprintf "(%s : %t)"
(Ident.name p) (pp dmodtype short_mty)
let definition_of_argument ua =
let arg, mty = ua.item in
match (arg: Err.functor_arg_descr) with
- | Unit -> Format.dprintf "()"
- | Empty_struct -> Format.dprintf "(struct end)"
+ | Unit -> Fmt.dprintf "()"
+ | Empty_struct -> Fmt.dprintf "(struct end)"
| Named p ->
let mty = modtype { ua with item = mty } in
- Format.dprintf
+ Fmt.dprintf
"%a@ :@ %t"
- Printtyp.path p
+ Printtyp.Doc.path p
(pp_orig dmodtype mty)
| Anonymous ->
let short_mty = modtype { ua with item = mty } in
begin match short_mty with
| Original mty -> dmodtype mty
| Synthetic {name; item=mty} ->
- Format.dprintf "%s@ :@ %t" name (dmodtype mty)
+ Fmt.dprintf "%s@ :@ %t" name (dmodtype mty)
end
let arg ua =
let arg, mty = ua.item in
match (arg: Err.functor_arg_descr) with
- | Unit -> Format.dprintf "()"
- | Empty_struct -> Format.dprintf "(struct end)"
- | Named p -> fun ppf -> Printtyp.path ppf p
+ | Unit -> Fmt.dprintf "()"
+ | Empty_struct -> Fmt.dprintf "(struct end)"
+ | Named p -> fun ppf -> Printtyp.Doc.path ppf p
| Anonymous ->
let short_mty = modtype { ua with item=mty } in
pp dmodtype short_mty
@@ -379,17 +427,38 @@ module Functor_suberror = struct
| Types.Named (Some _ as x,_) -> x
| Types.(Unit | Named(None,_)) -> None
- (** Print the list of params with style *)
+
+(** Print a list of functor parameters with style while adjusting the printing
+ environment for each functor argument.
+
+ Currently, we are disabling disambiguation for functor argument name to
+ avoid the need to track the moving association between identifiers and
+ syntactic names in situation like:
+
+ got: (X: sig module type T end) (Y:X.T) (X:sig module type T end) (Z:X.T)
+ expect: (_: sig end) (Y:X.T) (_:sig end) (Z:X.T)
+*)
let pretty_params sep proj printer patch =
- let elt (x,param) =
+ let pp_param (x,param) =
let sty = Diffing.(style @@ classify x) in
- Format.dprintf "%a%t%a"
- Format.pp_open_stag (Style.Style sty)
+ Fmt.dprintf "%a%t%a"
+ Fmt.pp_open_stag (Style.Style sty)
(printer param)
- Format.pp_close_stag ()
+ Fmt.pp_close_stag ()
+ in
+ let rec pp_params = function
+ | [] -> ignore
+ | [_,param] -> pp_param param
+ | (id,param) :: q ->
+ Fmt.dprintf "%t%a%t"
+ (pp_param param) sep () (hide_id id q)
+ and hide_id id q =
+ match id with
+ | None -> pp_params q
+ | Some id -> Out_type.Ident_names.with_fuzzy id (fun () -> pp_params q)
in
let params = List.filter_map proj @@ List.map snd patch in
- Printtyp.functor_parameters ~sep elt params
+ pp_params params
let expected d =
let extract: _ Diffing.change -> _ = function
@@ -425,17 +494,17 @@ module Functor_suberror = struct
pretty_params space extract With_shorthand.qualified_param d
let insert mty =
- Format.dprintf
+ Fmt.dprintf
"An argument appears to be missing with module type@;<1 2>@[%t@]"
(With_shorthand.definition mty)
let delete mty =
- Format.dprintf
+ Fmt.dprintf
"An extra argument is provided of module type@;<1 2>@[%t@]"
(With_shorthand.definition mty)
let ok x y =
- Format.dprintf
+ Fmt.dprintf
"Module types %t and %t match"
(With_shorthand.param x)
(With_shorthand.param y)
@@ -443,17 +512,17 @@ module Functor_suberror = struct
let diff g e more =
let g = With_shorthand.definition g in
let e = With_shorthand.definition e in
- Format.dprintf
+ Fmt.dprintf
"Module types do not match:@ @[%t@]@;<1 -2>does not include@ \
@[%t@]%t"
g e (more ())
let incompatible = function
| Types.Unit ->
- Format.dprintf
+ Fmt.dprintf
"The functor was expected to be applicative at this position"
| Types.Named _ ->
- Format.dprintf
+ Fmt.dprintf
"The functor was expected to be generative at this position"
let patch env got expected =
@@ -479,7 +548,7 @@ module Functor_suberror = struct
pretty_params space extract With_shorthand.arg d
let delete mty =
- Format.dprintf
+ Fmt.dprintf
"The following extra argument is provided@;<1 2>@[%t@]"
(With_shorthand.definition_of_argument mty)
@@ -488,10 +557,10 @@ module Functor_suberror = struct
let ok x y =
let pp_orig_name = match With_shorthand.functor_param y with
| With_shorthand.Named (_, Original mty) ->
- Format.dprintf " %t" (dmodtype mty)
+ Fmt.dprintf " %t" (dmodtype mty)
| _ -> ignore
in
- Format.dprintf
+ Fmt.dprintf
"Module %t matches the expected module type%t"
(With_shorthand.arg x)
pp_orig_name
@@ -499,7 +568,7 @@ module Functor_suberror = struct
let diff g e more =
let g = With_shorthand.definition_of_argument g in
let e = With_shorthand.definition e in
- Format.dprintf
+ Fmt.dprintf
"Modules do not match:@ @[%t@]@;<1 -2>\
is not included in@ @[%t@]%t"
g e (more ())
@@ -510,10 +579,10 @@ module Functor_suberror = struct
let single_diff g e more =
let _arg, mty = g.With_shorthand.item in
let e = match e.With_shorthand.item with
- | Types.Unit -> Format.dprintf "()"
+ | Types.Unit -> Fmt.dprintf "()"
| Types.Named(_, mty) -> dmodtype mty
in
- Format.dprintf
+ Fmt.dprintf
"Modules do not match:@ @[%t@]@;<1 -2>\
is not included in@ @[%t@]%t"
(dmodtype mty) e (more ())
@@ -521,10 +590,10 @@ module Functor_suberror = struct
let incompatible = function
| Unit ->
- Format.dprintf
+ Fmt.dprintf
"The functor was expected to be applicative at this position"
| Named _ | Anonymous ->
- Format.dprintf
+ Fmt.dprintf
"The functor was expected to be generative at this position"
| Empty_struct ->
(* an empty structure can be used in both applicative and generative
@@ -534,18 +603,18 @@ module Functor_suberror = struct
let subcase sub ~expansion_token env (pos, diff) =
Location.msg "%a%a%a%a@[<hv 2>%t@]%a"
- Format.pp_print_tab ()
- Format.pp_open_tbox ()
+ Fmt.pp_print_tab ()
+ Fmt.pp_open_tbox ()
Diffing.prefix (pos, Diffing.classify diff)
- Format.pp_set_tab ()
+ Fmt.pp_set_tab ()
(Printtyp.wrap_printing_env env ~error:true
(fun () -> sub ~expansion_token env diff)
)
- Format.pp_close_tbox ()
+ Fmt.pp_close_tbox ()
let onlycase sub ~expansion_token env (_, diff) =
Location.msg "%a@[<hv 2>%t@]"
- Format.pp_print_tab ()
+ Fmt.pp_print_tab ()
(Printtyp.wrap_printing_env env ~error:true
(fun () -> sub ~expansion_token env diff)
)
@@ -592,123 +661,114 @@ let coalesce msgs =
| [] -> ignore
| before ->
let ctx ppf =
- Format.pp_print_list ~pp_sep:space
- (fun ppf x -> x.Location.txt ppf)
+ Fmt.pp_print_list ~pp_sep:space
+ (fun ppf x -> Fmt.pp_doc ppf x.Location.txt)
ppf before in
ctx
let subcase_list l ppf = match l with
| [] -> ()
| _ :: _ ->
- Format.fprintf ppf "@;<1 -2>@[%a@]"
- (Format.pp_print_list ~pp_sep:space
- (fun ppf f -> f.Location.txt ppf)
- )
+ let pp_msg ppf lmsg = Fmt.pp_doc ppf lmsg.Location.txt in
+ Fmt.fprintf ppf "@;<1 -2>@[%a@]"
+ (Fmt.pp_print_list ~pp_sep:space pp_msg)
(List.rev l)
(* Printers for leaves *)
let core env id x =
match x with
| Err.Value_descriptions diff ->
- Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a%t@]"
+ Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
"Values do not match"
!Oprint.out_sig_item
- (Printtyp.tree_of_value_description id diff.got)
+ (Out_type.tree_of_value_description id diff.got)
"is not included in"
!Oprint.out_sig_item
- (Printtyp.tree_of_value_description id diff.expected)
+ (Out_type.tree_of_value_description id diff.expected)
(Includecore.report_value_mismatch
"the first" "the second" env) diff.symptom
show_locs (diff.got.val_loc, diff.expected.val_loc)
- Printtyp.Conflicts.print_explanations
| Err.Type_declarations diff ->
- Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a%t@]"
+ Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
"Type declarations do not match"
!Oprint.out_sig_item
- (Printtyp.tree_of_type_declaration id diff.got Trec_first)
+ (Out_type.tree_of_type_declaration id diff.got Trec_first)
"is not included in"
!Oprint.out_sig_item
- (Printtyp.tree_of_type_declaration id diff.expected Trec_first)
+ (Out_type.tree_of_type_declaration id diff.expected Trec_first)
(Includecore.report_type_mismatch
"the first" "the second" "declaration" env) diff.symptom
show_locs (diff.got.type_loc, diff.expected.type_loc)
- Printtyp.Conflicts.print_explanations
| Err.Extension_constructors diff ->
- Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a%t@]"
+ Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a@]"
"Extension declarations do not match"
!Oprint.out_sig_item
- (Printtyp.tree_of_extension_constructor id diff.got Text_first)
+ (Out_type.tree_of_extension_constructor id diff.got Text_first)
"is not included in"
!Oprint.out_sig_item
- (Printtyp.tree_of_extension_constructor id diff.expected Text_first)
+ (Out_type.tree_of_extension_constructor id diff.expected Text_first)
(Includecore.report_extension_constructor_mismatch
"the first" "the second" "declaration" env) diff.symptom
show_locs (diff.got.ext_loc, diff.expected.ext_loc)
- Printtyp.Conflicts.print_explanations
| Err.Class_type_declarations diff ->
- Format.dprintf
+ Fmt.dprintf
"@[<hv 2>Class type declarations do not match:@ \
- %a@;<1 -2>does not match@ %a@]@ %a%t"
+ %a@;<1 -2>does not match@ %a@]@ %a"
!Oprint.out_sig_item
- (Printtyp.tree_of_cltype_declaration id diff.got Trec_first)
+ (Out_type.tree_of_cltype_declaration id diff.got Trec_first)
!Oprint.out_sig_item
- (Printtyp.tree_of_cltype_declaration id diff.expected Trec_first)
- (Includeclass.report_error Type_scheme) diff.symptom
- Printtyp.Conflicts.print_explanations
+ (Out_type.tree_of_cltype_declaration id diff.expected Trec_first)
+ (Includeclass.report_error_doc Type_scheme) diff.symptom
| Err.Class_declarations {got;expected;symptom} ->
- let t1 = Printtyp.tree_of_class_declaration id got Trec_first in
- let t2 = Printtyp.tree_of_class_declaration id expected Trec_first in
- Format.dprintf
+ let t1 = Out_type.tree_of_class_declaration id got Trec_first in
+ let t2 = Out_type.tree_of_class_declaration id expected Trec_first in
+ Fmt.dprintf
"@[<hv 2>Class declarations do not match:@ \
- %a@;<1 -2>does not match@ %a@]@ %a%t"
+ %a@;<1 -2>does not match@ %a@]@ %a"
!Oprint.out_sig_item t1
!Oprint.out_sig_item t2
- (Includeclass.report_error Type_scheme) symptom
- Printtyp.Conflicts.print_explanations
+ (Includeclass.report_error_doc Type_scheme) symptom
let missing_field ppf item =
let id, loc, kind = Includemod.item_ident_name item in
- Format.fprintf ppf "The %s %a is required but not provided%a"
+ Fmt.fprintf ppf "The %s %a is required but not provided%a"
(Includemod.kind_of_field_desc kind)
- (Style.as_inline_code Printtyp.ident) id
+ (Style.as_inline_code Printtyp.Doc.ident) id
(show_loc "Expected declaration") loc
let module_types {Err.got=mty1; expected=mty2} =
- Format.dprintf
+ Fmt.dprintf
"@[<hv 2>Modules do not match:@ \
%a@;<1 -2>is not included in@ %a@]"
- !Oprint.out_module_type (Printtyp.tree_of_modtype mty1)
- !Oprint.out_module_type (Printtyp.tree_of_modtype mty2)
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty1)
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty2)
let eq_module_types {Err.got=mty1; expected=mty2} =
- Format.dprintf
+ Fmt.dprintf
"@[<hv 2>Module types do not match:@ \
%a@;<1 -2>is not equal to@ %a@]"
- !Oprint.out_module_type (Printtyp.tree_of_modtype mty1)
- !Oprint.out_module_type (Printtyp.tree_of_modtype mty2)
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty1)
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty2)
let module_type_declarations id {Err.got=d1 ; expected=d2} =
- Format.dprintf
+ Fmt.dprintf
"@[<hv 2>Module type declarations do not match:@ \
%a@;<1 -2>does not match@ %a@]"
- !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d1)
- !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d2)
+ !Oprint.out_sig_item (Out_type.tree_of_modtype_declaration id d1)
+ !Oprint.out_sig_item (Out_type.tree_of_modtype_declaration id d2)
let interface_mismatch ppf (diff: _ Err.diff) =
- Format.fprintf ppf
+ Fmt.fprintf ppf
"The implementation %a@ does not match the interface %a:@ "
Style.inline_code diff.got Style.inline_code diff.expected
let core_module_type_symptom (x:Err.core_module_type_symptom) =
match x with
| Not_an_alias | Not_an_identifier | Abstract_module_type
- | Incompatible_aliases ->
- if Printtyp.Conflicts.exists () then
- Some Printtyp.Conflicts.print_explanations
- else None
+ | Incompatible_aliases -> None
| Unbound_module_path path ->
- Some(Format.dprintf "Unbound module %a"
- (Style.as_inline_code Printtyp.path) path
+ Some(Fmt.dprintf "Unbound module %a"
+ (Style.as_inline_code Printtyp.Doc.path) path
)
(* Construct a linearized error message from the error tree *)
@@ -749,8 +809,8 @@ and module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx = function
module_type ~eqmode ~expansion_token ~env ~before ~ctx diff
| Invalid_module_alias path ->
let printer =
- Format.dprintf "Module %a cannot be aliased"
- (Style.as_inline_code Printtyp.path) path
+ Fmt.dprintf "Module %a cannot be aliased"
+ (Style.as_inline_code Printtyp.Doc.path) path
in
dwith_context ctx printer :: before
@@ -759,10 +819,10 @@ and functor_params ~expansion_token ~env ~before ~ctx {got;expected;_} =
let actual = Functor_suberror.Inclusion.got d in
let expected = Functor_suberror.expected d in
let main =
- Format.dprintf
+ Fmt.dprintf
"@[<hv 2>Modules do not match:@ \
- @[functor@ %t@ -> ...@]@;<1 -2>is not included in@ \
- @[functor@ %t@ -> ...@]@]"
+ @[%t@ -> ...@]@;<1 -2>is not included in@ \
+ @[%t@ -> ...@]@]"
actual expected
in
let msgs = dwith_context ctx main :: before in
@@ -785,8 +845,8 @@ and signature ~expansion_token ~env:_ ~before ~ctx sgs =
if expansion_token then
let init_missings, last_missing = Misc.split_last missings in
List.map (Location.msg "%a" missing_field) init_missings
- @ [ with_context ctx missing_field last_missing ]
- @ before
+ @ with_context ctx missing_field last_missing
+ :: before
else
before
| [], a :: _ -> sigitem ~expansion_token ~env:sgs.env ~before ~ctx a
@@ -826,7 +886,7 @@ and module_type_decl ~expansion_token ~env ~before ~ctx id diff =
| None -> assert false
| Some mty ->
with_context (Modtype id::ctx)
- (Illegal_permutation.pp Context.alt_pp env) (mty,c)
+ (Runtime_coercion.illegal_permutation Context.alt_pp env) (mty,c)
:: before
end
@@ -875,7 +935,7 @@ let module_type_subst ~env id diff =
let mty = diff.got in
let main =
with_context [Modtype id]
- (Illegal_permutation.pp Context.alt_pp env) (mty,c) in
+ (Runtime_coercion.illegal_permutation Context.alt_pp env) (mty,c) in
[main]
let all env = function
@@ -898,29 +958,32 @@ let all env = function
(* General error reporting *)
-let err_msgs (env, err) =
- Printtyp.Conflicts.reset();
+let err_msgs ppf (env, err) =
Printtyp.wrap_printing_env ~error:true env
- (fun () -> coalesce @@ all env err)
+ (fun () -> (coalesce @@ all env err) ppf)
-let report_error err =
- let main = err_msgs err in
- Location.errorf ~loc:Location.(in_file !input_name) "%t" main
+let report_error_doc err =
+ Location.errorf
+ ~loc:Location.(in_file !input_name)
+ ~footnote:Out_type.Ident_conflicts.err_msg
+ "%a" err_msgs err
-let report_apply_error ~loc env (app_name, mty_f, args) =
+let report_apply_error_doc ~loc env (app_name, mty_f, args) =
+ let footnote = Out_type.Ident_conflicts.err_msg in
let d = Functor_suberror.App.patch env ~f:mty_f ~args in
match d with
(* We specialize the one change and one argument case to remove the
presentation of the functor arguments *)
| [ _, Change (_, _, Err.Incompatible_params (i,_)) ] ->
- Location.errorf ~loc "%t" (Functor_suberror.App.incompatible i)
+ Location.errorf ~loc ~footnote "%t" (Functor_suberror.App.incompatible i)
| [ _, Change (g, e, Err.Mismatch mty_diff) ] ->
let more () =
subcase_list @@
module_type_symptom ~eqmode:false ~expansion_token:true ~env ~before:[]
~ctx:[] mty_diff.symptom
in
- Location.errorf ~loc "%t" (Functor_suberror.App.single_diff g e more)
+ Location.errorf ~loc ~footnote "%t"
+ (Functor_suberror.App.single_diff g e more)
| _ ->
let not_functor =
List.for_all (function _, Diffing.Delete _ -> true | _ -> false) d
@@ -930,7 +993,7 @@ let report_apply_error ~loc env (app_name, mty_f, args) =
| Includemod.Named_leftmost_functor lid ->
Location.errorf ~loc
"@[The module %a is not a functor, it cannot be applied.@]"
- (Style.as_inline_code Printtyp.longident) lid
+ (Style.as_inline_code Printtyp.Doc.longident) lid
| Includemod.Anonymous_functor
| Includemod.Full_application_path _
(* The "non-functor application in term" case is directly handled in
@@ -944,14 +1007,14 @@ let report_apply_error ~loc env (app_name, mty_f, args) =
let intro ppf =
match app_name with
| Includemod.Anonymous_functor ->
- Format.fprintf ppf "This functor application is ill-typed."
+ Fmt.fprintf ppf "This functor application is ill-typed."
| Includemod.Full_application_path lid ->
- Format.fprintf ppf "The functor application %a is ill-typed."
- (Style.as_inline_code Printtyp.longident) lid
+ Fmt.fprintf ppf "The functor application %a is ill-typed."
+ (Style.as_inline_code Printtyp.Doc.longident) lid
| Includemod.Named_leftmost_functor lid ->
- Format.fprintf ppf
+ Fmt.fprintf ppf
"This application of the functor %a is ill-typed."
- (Style.as_inline_code Printtyp.longident) lid
+ (Style.as_inline_code Printtyp.Doc.longident) lid
in
let actual = Functor_suberror.App.got d in
let expected = Functor_suberror.expected d in
@@ -959,20 +1022,24 @@ let report_apply_error ~loc env (app_name, mty_f, args) =
List.rev @@
Functor_suberror.params functor_app_diff env ~expansion_token:true d
in
- Location.errorf ~loc ~sub
+ Location.errorf ~loc ~sub ~footnote
"@[<hv>%t@ \
These arguments:@;<1 2>@[%t@]@ \
- do not match these parameters:@;<1 2>@[functor@ %t@ -> ...@]@]"
+ do not match these parameters:@;<1 2>@[%t@ -> ...@]@]"
intro
actual expected
+let coercion_in_package_subtype env mty c =
+ Format_doc.doc_printf "%t" @@
+ Runtime_coercion.in_package_subtype Context.alt_pp env mty c
+
let register () =
Location.register_error_of_exn
(function
- | Includemod.Error err -> Some (report_error err)
+ | Includemod.Error err -> Some (report_error_doc err)
| Includemod.Apply_error {loc; env; app_name; mty_f; args} ->
Some (Printtyp.wrap_printing_env env ~error:true (fun () ->
- report_apply_error ~loc env (app_name, mty_f, args))
+ report_apply_error_doc ~loc env (app_name, mty_f, args))
)
| _ -> None
)
diff --git a/src/ocaml/typing/includemod_errorprinter.mli b/src/ocaml/typing/includemod_errorprinter.mli
index 12ea2169b0..0c7dda4e56 100644
--- a/src/ocaml/typing/includemod_errorprinter.mli
+++ b/src/ocaml/typing/includemod_errorprinter.mli
@@ -13,5 +13,7 @@
(* *)
(**************************************************************************)
-val err_msgs: Includemod.explanation -> Format.formatter -> unit
+val err_msgs: Includemod.explanation Format_doc.printer
+val coercion_in_package_subtype:
+ Env.t -> Types.module_type -> Typedtree.module_coercion -> Format_doc.doc
val register: unit -> unit
diff --git a/src/ocaml/typing/magic_numbers.ml b/src/ocaml/typing/magic_numbers.ml
index f5503f0000..56a4d953d9 100644
--- a/src/ocaml/typing/magic_numbers.ml
+++ b/src/ocaml/typing/magic_numbers.ml
@@ -25,17 +25,18 @@ module Cmi = struct
| "Caml1999I032" -> Some "5.0"
| "Caml1999I033" -> Some "5.1"
| "Caml1999I034" -> Some "5.2"
+ | "Caml1999I035" -> Some "5.3"
| _ -> None
let () = assert (to_version_opt Config.cmi_magic_number <> None)
- open Format
+ open Format_doc
module Style = Misc.Style
let report_error ppf = function
| Not_an_interface filename ->
fprintf ppf "%a@ is not a compiled interface"
- (Style.as_inline_code Location.print_filename) filename
+ (Style.as_inline_code Location.Doc.filename) filename
| Wrong_version_interface (filename, compiler_magic) ->
let program_name = Lib_config.program_name () in
begin match to_version_opt compiler_magic with
@@ -51,7 +52,7 @@ module Cmi = struct
compiler. \n\
This diagnostic is based on the compiled interface file: %a"
program_name program_name program_name
- Location.print_filename filename
+ Location.Doc.filename filename
| Some version ->
fprintf ppf
"Compiler version mismatch: this project seems to be compiled with \
@@ -63,11 +64,11 @@ module Cmi = struct
This diagnostic is based on the compiled interface file: %a"
version program_name
(Option.get @@ to_version_opt Config.cmi_magic_number)
- program_name Location.print_filename filename
+ program_name Location.Doc.filename filename
end
| Corrupted_interface filename ->
fprintf ppf "Corrupted compiled interface@ %a"
- (Style.as_inline_code Location.print_filename) filename
+ (Style.as_inline_code Location.Doc.filename) filename
let () =
Location.register_error_of_exn
diff --git a/src/ocaml/typing/msupport.ml b/src/ocaml/typing/msupport.ml
index 4623a4f667..2491259ffb 100644
--- a/src/ocaml/typing/msupport.ml
+++ b/src/ocaml/typing/msupport.ml
@@ -129,7 +129,8 @@ let flush_saved_types () =
| parts ->
Cmt_format.set_saved_types [];
let open Ast_helper in
- let pexp = Exp.constant (Saved_parts.store parts) in
+ let pconst_desc = Saved_parts.store parts in
+ let pexp = Exp.constant { pconst_desc; pconst_loc = !default_loc } in
let pstr = Str.eval pexp in
[ Attr.mk Saved_parts.attribute (Parsetree.PStr [ pstr ]) ]
@@ -142,7 +143,9 @@ let rec get_saved_types_from_attributes = function
begin
match str with
| PStr
- ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant key; _ }, _);
+ ({ pstr_desc =
+ Pstr_eval
+ ({ pexp_desc = Pexp_constant { pconst_desc = key; _ }; _ }, _);
_
}
:: _) -> Saved_parts.find key
diff --git a/src/ocaml/typing/mtype.ml b/src/ocaml/typing/mtype.ml
index b12dfde8c4..e563d26714 100644
--- a/src/ocaml/typing/mtype.ml
+++ b/src/ocaml/typing/mtype.ml
@@ -460,9 +460,11 @@ let collect_arg_paths mty =
and bindings = ref Ident.empty in
(* let rt = Ident.create "Root" in
and prefix = ref (Path.Pident rt) in *)
+ with_type_mark begin fun mark ->
+ let super = type_iterators mark in
let it_path p = paths := Path.Set.union (get_arg_paths p) !paths
and it_signature_item it si =
- type_iterators.it_signature_item it si;
+ super.it_signature_item it si;
match si with
| Sig_module (id, _, {md_type=Mty_alias p}, _, _) ->
bindings := Ident.add id p !bindings
@@ -475,11 +477,11 @@ let collect_arg_paths mty =
sg
| _ -> ()
in
- let it = {type_iterators with it_path; it_signature_item} in
+ let it = {super with it_path; it_signature_item} in
it.it_module_type it mty;
- it.it_module_type unmark_iterators mty;
Path.Set.fold (fun p -> Ident.Set.union (collect_ids !subst !bindings p))
!paths Ident.Set.empty
+ end
type remove_alias_args =
{ mutable modified: bool;
@@ -556,14 +558,16 @@ let scrape_for_type_of ~remove_aliases env mty =
let lower_nongen nglev mty =
let open Btype in
- let it_type_expr it ty =
+ with_type_mark begin fun mark ->
+ let super = type_iterators mark in
+ let it_do_type_expr it ty =
match get_desc ty with
Tvar _ ->
let level = get_level ty in
if level < generic_level && level > nglev then set_level ty nglev
| _ ->
- type_iterators.it_type_expr it ty
+ super.it_do_type_expr it ty
in
- let it = {type_iterators with it_type_expr} in
- it.it_module_type it mty;
- it.it_module_type unmark_iterators mty
+ let it = {super with it_do_type_expr} in
+ it.it_module_type it mty
+ end
diff --git a/src/ocaml/typing/oprint.ml b/src/ocaml/typing/oprint.ml
index 57897a19fd..8b2d7c4e8c 100644
--- a/src/ocaml/typing/oprint.ml
+++ b/src/ocaml/typing/oprint.ml
@@ -13,7 +13,7 @@
(* *)
(**************************************************************************)
-open Format
+open Format_doc
open Outcometree
exception Ellipsis
@@ -37,28 +37,9 @@ let rec print_ident ppf =
let out_ident = ref print_ident
-(* Check a character matches the [identchar_latin1] class from the lexer *)
-let is_ident_char c =
- match c with
- | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246'
- | '\248'..'\255' | '\'' | '0'..'9' -> true
- | _ -> false
-
-let all_ident_chars s =
- let rec loop s len i =
- if i < len then begin
- if is_ident_char s.[i] then loop s len (i+1)
- else false
- end else begin
- true
- end
- in
- let len = String.length s in
- loop s len 0
-
let parenthesized_ident name =
(List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
- || not (all_ident_chars name)
+ || not (Misc.Utf8_lexeme.is_valid_identifier name)
let value_ident ppf name =
if parenthesized_ident name then
@@ -162,6 +143,9 @@ let print_constr ppf name =
(* despite being keywords, these are constructor names
and should not be escaped *)
fprintf ppf "%s" c
+ | Oide_dot (id, ("true"|"false" as s)) ->
+ (* Similarly, M.true is invalid *)
+ fprintf ppf "%a.(%s)" print_ident id s
| _ -> print_ident ppf name
let print_out_value ppf tree =
@@ -249,7 +233,7 @@ let print_out_value ppf tree =
in
cautious print_tree_1 ppf tree
-let out_value = ref print_out_value
+let out_value = ref (compat print_out_value)
(* Types *)
@@ -267,7 +251,7 @@ let rec print_list pr sep ppf =
let pr_present =
print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
-let pr_var = Pprintast.tyvar
+let pr_var = Pprintast.Doc.tyvar
let ty_var ~non_gen ppf s =
pr_var ppf (if non_gen then "_" ^ s else s)
@@ -404,10 +388,13 @@ and print_typargs ppf =
pp_print_char ppf ')';
pp_close_box ppf ();
pp_print_space ppf ()
-and print_out_label ppf (name, mut, arg) =
- fprintf ppf "@[<2>%s%a :@ %a@];" (if mut then "mutable " else "")
- print_lident name
- print_out_type arg
+and print_out_label ppf {olab_name; olab_mut; olab_type} =
+ fprintf ppf "@[<2>%s%a :@ %a@];"
+ (match olab_mut with
+ | Mutable -> "mutable "
+ | Immutable -> "")
+ print_lident olab_name
+ print_out_type olab_type
let out_label = ref print_out_label
@@ -555,7 +542,7 @@ and print_out_functor_parameters ppf l =
print_args l
| _ :: _ as non_anonymous_functor ->
let args, anons = split_anon_functor_arguments non_anonymous_functor in
- fprintf ppf "@[<2>functor@ %a@]@ ->@ %a"
+ fprintf ppf "@[%a@]@ ->@ %a"
(pp_print_list ~pp_sep:pp_print_space print_nonanon_arg) args
print_args anons
in
@@ -814,6 +801,8 @@ let _ = out_functor_parameters := print_out_functor_parameters
(* Phrases *)
+open Format
+
let print_out_exception ppf exn outv =
match exn with
Sys.Break -> fprintf ppf "Interrupted.@."
@@ -848,23 +837,26 @@ let rec print_items ppf =
otyext_constructors = exts;
otyext_private = ext.oext_private }
in
- fprintf ppf "@[%a@]" !out_type_extension te;
+ fprintf ppf "@[%a@]" (Format_doc.compat !out_type_extension) te;
if items <> [] then fprintf ppf "@ %a" print_items items
| (tree, valopt) :: items ->
begin match valopt with
Some v ->
- fprintf ppf "@[<2>%a =@ %a@]" !out_sig_item tree
+ fprintf ppf "@[<2>%a =@ %a@]" (Format_doc.compat !out_sig_item) tree
!out_value v
- | None -> fprintf ppf "@[%a@]" !out_sig_item tree
+ | None -> fprintf ppf "@[%a@]" (Format_doc.compat !out_sig_item) tree
end;
if items <> [] then fprintf ppf "@ %a" print_items items
let print_out_phrase ppf =
function
Ophr_eval (outv, ty) ->
- fprintf ppf "@[- : %a@ =@ %a@]@." !out_type ty !out_value outv
+ fprintf ppf "@[- : %a@ =@ %a@]@." (compat !out_type) ty !out_value outv
| Ophr_signature [] -> ()
| Ophr_signature items -> fprintf ppf "@[<v>%a@]@." print_items items
| Ophr_exception (exn, outv) -> print_out_exception ppf exn outv
let out_phrase = ref print_out_phrase
+
+type 'a printer = 'a Format_doc.printer ref
+type 'a toplevel_printer = (Format.formatter -> 'a -> unit) ref
diff --git a/src/ocaml/typing/oprint.mli b/src/ocaml/typing/oprint.mli
index 31dad9a906..8ce44f37ee 100644
--- a/src/ocaml/typing/oprint.mli
+++ b/src/ocaml/typing/oprint.mli
@@ -13,24 +13,24 @@
(* *)
(**************************************************************************)
-open Format
open Outcometree
-val out_ident : (formatter -> out_ident -> unit) ref
-val out_value : (formatter -> out_value -> unit) ref
-val out_label : (formatter -> string * bool * out_type -> unit) ref
-val out_type : (formatter -> out_type -> unit) ref
-val out_type_args : (formatter -> out_type list -> unit) ref
-val out_constr : (formatter -> out_constructor -> unit) ref
-val out_class_type : (formatter -> out_class_type -> unit) ref
-val out_module_type : (formatter -> out_module_type -> unit) ref
-val out_sig_item : (formatter -> out_sig_item -> unit) ref
-val out_signature : (formatter -> out_sig_item list -> unit) ref
+type 'a printer = 'a Format_doc.printer ref
+type 'a toplevel_printer = (Format.formatter -> 'a -> unit) ref
+
+val out_ident: out_ident printer
+val out_value : out_value toplevel_printer
+val out_label : out_label printer
+val out_type : out_type printer
+val out_type_args : out_type list printer
+val out_constr : out_constructor printer
+val out_class_type : out_class_type printer
+val out_module_type : out_module_type printer
+val out_sig_item : out_sig_item printer
+val out_signature :out_sig_item list printer
val out_functor_parameters :
- (formatter ->
- (string option * Outcometree.out_module_type) option list -> unit)
- ref
-val out_type_extension : (formatter -> out_type_extension -> unit) ref
-val out_phrase : (formatter -> out_phrase -> unit) ref
+ (string option * Outcometree.out_module_type) option list printer
+val out_type_extension : out_type_extension printer
+val out_phrase : out_phrase toplevel_printer
val parenthesized_ident : string -> bool
diff --git a/src/ocaml/typing/out_type.ml b/src/ocaml/typing/out_type.ml
new file mode 100644
index 0000000000..356f8fc8a7
--- /dev/null
+++ b/src/ocaml/typing/out_type.ml
@@ -0,0 +1,1969 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy and Jerome Vouillon, 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. *)
+(* *)
+(**************************************************************************)
+
+(* Compute a spanning tree representation of types *)
+
+open Misc
+open Ctype
+open Longident
+open Path
+open Asttypes
+open Types
+open Btype
+open Outcometree
+
+module Sig_component_kind = Shape.Sig_component_kind
+module Style = Misc.Style
+
+(* Print a long identifier *)
+
+module Fmt = Format_doc
+open Format_doc
+
+(* Print an identifier avoiding name collisions *)
+
+module Out_name = struct
+ let create x = { printed_name = x }
+ let print x = x.printed_name
+end
+
+(** Some identifiers may require hiding when printing *)
+type bound_ident = { hide:bool; ident:Ident.t }
+
+(* printing environment for path shortening and naming *)
+let printing_env = ref Env.empty
+
+(* When printing, it is important to only observe the
+ current printing environment, without reading any new
+ cmi present on the file system *)
+let in_printing_env f = Env.without_cmis f !printing_env
+
+ type namespace = Sig_component_kind.t =
+ | Value
+ | Type
+ | Constructor
+ | Label
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+
+module Namespace = struct
+
+ let id = function
+ | Type -> 0
+ | Module -> 1
+ | Module_type -> 2
+ | Class -> 3
+ | Class_type -> 4
+ | Extension_constructor | Value | Constructor | Label -> 5
+ (* we do not handle those component *)
+
+ let size = 1 + id Value
+
+
+ let pp ppf x =
+ Fmt.pp_print_string ppf (Shape.Sig_component_kind.to_string x)
+
+ (** The two functions below should never access the filesystem,
+ and thus use {!in_printing_env} rather than directly
+ accessing the printing environment *)
+ let lookup =
+ let to_lookup f lid = fst @@ in_printing_env (f (Lident lid)) in
+ function
+ | Some Type -> to_lookup Env.find_type_by_name
+ | Some Module -> to_lookup Env.find_module_by_name
+ | Some Module_type -> to_lookup Env.find_modtype_by_name
+ | Some Class -> to_lookup Env.find_class_by_name
+ | Some Class_type -> to_lookup Env.find_cltype_by_name
+ | None | Some(Value|Extension_constructor|Constructor|Label) ->
+ fun _ -> raise Not_found
+
+ let location namespace id =
+ let path = Path.Pident id in
+ try Some (
+ match namespace with
+ | Some Type -> (in_printing_env @@ Env.find_type path).type_loc
+ | Some Module -> (in_printing_env @@ Env.find_module path).md_loc
+ | Some Module_type -> (in_printing_env @@ Env.find_modtype path).mtd_loc
+ | Some Class -> (in_printing_env @@ Env.find_class path).cty_loc
+ | Some Class_type -> (in_printing_env @@ Env.find_cltype path).clty_loc
+ | Some (Extension_constructor|Value|Constructor|Label) | None ->
+ Location.none
+ ) with Not_found -> None
+
+ let best_class_namespace = function
+ | Papply _ | Pdot _ -> Some Module
+ | Pextra_ty _ -> assert false (* Only in type path *)
+ | Pident c ->
+ match location (Some Class) c with
+ | Some _ -> Some Class
+ | None -> Some Class_type
+
+end
+
+(** {2 Ident conflicts printing}
+
+ Ident conflicts arise when multiple {!Ident.t}s are attributed the same name.
+ The following module stores the global conflict references and provides the
+ printing functions for explaining the source of the conflicts.
+*)
+module Ident_conflicts = struct
+ module M = String.Map
+ type explanation =
+ { kind: namespace; name:string; root_name:string; location:Location.t}
+ let explanations = ref M.empty
+
+ let add namespace name id =
+ match Namespace.location (Some namespace) id with
+ | None -> ()
+ | Some location ->
+ let explanation =
+ { kind = namespace; location; name; root_name=Ident.name id}
+ in
+ explanations := M.add name explanation !explanations
+
+ let collect_explanation namespace id ~name =
+ let root_name = Ident.name id in
+ (* if [name] is of the form "root_name/%d", we register both
+ [id] and the identifier in scope for [root_name].
+ *)
+ if root_name <> name && not (M.mem name !explanations) then
+ begin
+ add namespace name id;
+ if not (M.mem root_name !explanations) then
+ (* lookup the identifier in scope with name [root_name] and
+ add it too
+ *)
+ match Namespace.lookup (Some namespace) root_name with
+ | Pident root_id -> add namespace root_name root_id
+ | exception Not_found | _ -> ()
+ end
+
+ let pp_explanation ppf r=
+ Fmt.fprintf ppf "@[<v 2>%a:@,Definition of %s %a@]"
+ Location.Doc.loc r.location (Sig_component_kind.to_string r.kind)
+ Style.inline_code r.name
+
+ let print_located_explanations ppf l =
+ Fmt.fprintf ppf "@[<v>%a@]"
+ (Fmt.pp_print_list pp_explanation) l
+
+ let reset () = explanations := M.empty
+ let list_explanations () =
+ let c = !explanations in
+ reset ();
+ c |> M.bindings |> List.map snd |> List.sort Stdlib.compare
+
+
+ let print_toplevel_hint ppf l =
+ let conj ppf () = Fmt.fprintf ppf " and@ " in
+ let pp_namespace_plural ppf n = Fmt.fprintf ppf "%as" Namespace.pp n in
+ let root_names = List.map (fun r -> r.kind, r.root_name) l in
+ let unique_root_names = List.sort_uniq Stdlib.compare root_names in
+ let submsgs = Array.make Namespace.size [] in
+ let () = List.iter (fun (n,_ as x) ->
+ submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
+ ) unique_root_names in
+ let pp_submsg ppf names =
+ match names with
+ | [] -> ()
+ | [namespace, a] ->
+ Fmt.fprintf ppf
+ "@,\
+ @[<2>@{<hint>Hint@}: The %a %a has been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
+ @ Did you try to redefine them?@]"
+ Namespace.pp namespace
+ Style.inline_code a Namespace.pp namespace
+ | (namespace, _) :: _ :: _ ->
+ Fmt.fprintf ppf
+ "@,\
+ @[<2>@{<hint>Hint@}: The %a %a have been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
+ @ Did you try to redefine them?@]"
+ pp_namespace_plural namespace
+ Fmt.(pp_print_list ~pp_sep:conj Style.inline_code)
+ (List.map snd names)
+ pp_namespace_plural namespace in
+ Array.iter (pp_submsg ppf) submsgs
+
+ let err_msg () =
+ let ltop, l =
+ (* isolate toplevel locations, since they are too imprecise *)
+ let from_toplevel a =
+ a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
+ List.partition from_toplevel (list_explanations ())
+ in
+ match l, ltop with
+ | [], [] -> None
+ | _ ->
+ Some
+ (Fmt.doc_printf "%a%a"
+ print_located_explanations l
+ print_toplevel_hint ltop
+ )
+ let err_print ppf = Option.iter Fmt.(fprintf ppf "@,%a" pp_doc) (err_msg ())
+
+ let exists () = M.cardinal !explanations >0
+end
+
+module Ident_names = struct
+
+module M = String.Map
+module S = String.Set
+
+let enabled = ref true
+let enable b = enabled := b
+
+(* Names bound in recursive definitions should be considered as bound
+ in the environment when printing identifiers but not when trying
+ to find shortest path.
+ For instance, if we define
+ [{
+ module Avoid__me = struct
+ type t = A
+ end
+ type t = X
+ type u = [` A of t * t ]
+ module M = struct
+ type t = A of [ u | `B ]
+ type r = Avoid__me.t
+ end
+ }]
+ It is is important that in the definition of [t] that the outer type [t] is
+ printed as [t/2] reserving the name [t] to the type being defined in the
+ current recursive definition.
+ Contrarily, in the definition of [r], one should not shorten the
+ path [Avoid__me.t] to [r] until the end of the definition of [r].
+ The [bound_in_recursion] bridges the gap between those two slightly different
+ notions of printing environment.
+*)
+let bound_in_recursion = ref M.empty
+
+(* When dealing with functor arguments, identity becomes fuzzy because the same
+ syntactic argument may be represented by different identifiers during the
+ error processing, we are thus disabling disambiguation on the argument name
+*)
+let fuzzy = ref S.empty
+let with_fuzzy id f =
+ protect_refs [ R(fuzzy, S.add (Ident.name id) !fuzzy) ] f
+let fuzzy_id namespace id = namespace = Module && S.mem (Ident.name id) !fuzzy
+
+let with_hidden ids f =
+ let update m id = M.add (Ident.name id.ident) id.ident m in
+ let updated = List.fold_left update !bound_in_recursion ids in
+ protect_refs [ R(bound_in_recursion, updated )] f
+
+let human_id id index =
+ (* The identifier with index [k] is the (k+1)-th most recent identifier in
+ the printing environment. We print them as [name/(k+1)] except for [k=0]
+ which is printed as [name] rather than [name/1].
+ *)
+ if index = 0 then
+ Ident.name id
+ else
+ let ordinal = index + 1 in
+ String.concat "/" [Ident.name id; string_of_int ordinal]
+
+let indexed_name namespace id =
+ let find namespace id env = match namespace with
+ | Type -> Env.find_type_index id env
+ | Module -> Env.find_module_index id env
+ | Module_type -> Env.find_modtype_index id env
+ | Class -> Env.find_class_index id env
+ | Class_type-> Env.find_cltype_index id env
+ | Value | Extension_constructor | Constructor | Label -> None
+ in
+ let index =
+ match M.find_opt (Ident.name id) !bound_in_recursion with
+ | Some rec_bound_id ->
+ (* the identifier name appears in the current group of recursive
+ definition *)
+ if Ident.same rec_bound_id id then
+ Some 0
+ else
+ (* the current recursive definition shadows one more time the
+ previously existing identifier with the same name *)
+ Option.map succ (in_printing_env (find namespace id))
+ | None ->
+ in_printing_env (find namespace id)
+ in
+ let index =
+ (* If [index] is [None] at this point, it might indicate that
+ the identifier id is not defined in the environment, while there
+ are other identifiers in scope that share the same name.
+ Currently, this kind of partially incoherent environment happens
+ within functor error messages where the left and right hand side
+ have a different views of the environment at the source level.
+ Printing the source-level by using a default index of `0`
+ seems like a reasonable compromise in this situation however.*)
+ Option.value index ~default:0
+ in
+ human_id id index
+
+let ident_name namespace id =
+ match namespace, !enabled with
+ | None, _ | _, false -> Out_name.create (Ident.name id)
+ | Some namespace, true ->
+ if fuzzy_id namespace id then Out_name.create (Ident.name id)
+ else
+ let name = indexed_name namespace id in
+ Ident_conflicts.collect_explanation namespace id ~name;
+ Out_name.create name
+end
+let ident_name = Ident_names.ident_name
+
+(* Print a path *)
+
+let ident_stdlib = Ident.create_persistent "Stdlib"
+
+let non_shadowed_stdlib namespace = function
+ | Pdot(Pident id, s) as path ->
+ Ident.same id ident_stdlib &&
+ (match Namespace.lookup namespace s with
+ | path' -> Path.same path path'
+ | exception Not_found -> true)
+ | _ -> false
+
+let find_double_underscore s =
+ let len = String.length s in
+ let rec loop i =
+ if i + 1 >= len then
+ None
+ else if s.[i] = '_' && s.[i + 1] = '_' then
+ Some i
+ else
+ loop (i + 1)
+ in
+ loop 0
+
+let rec module_path_is_an_alias_of env path ~alias_of =
+ match Env.find_module path env with
+ | { md_type = Mty_alias path'; _ } ->
+ Path.same path' alias_of ||
+ module_path_is_an_alias_of env path' ~alias_of
+ | _ -> false
+ | exception Not_found -> false
+
+(* Simple heuristic to print Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+ for Foo__bar. This pattern is used by the stdlib. *)
+let rec rewrite_double_underscore_paths env p =
+ match p with
+ | Pdot (p, s) ->
+ Pdot (rewrite_double_underscore_paths env p, s)
+ | Papply (a, b) ->
+ Papply (rewrite_double_underscore_paths env a,
+ rewrite_double_underscore_paths env b)
+ | Pextra_ty (p, extra) ->
+ Pextra_ty (rewrite_double_underscore_paths env p, extra)
+ | Pident id ->
+ let name = Ident.name id in
+ match find_double_underscore name with
+ | None -> p
+ | Some i ->
+ let better_lid =
+ Ldot
+ (Lident (String.sub name 0 i),
+ Unit_info.modulize
+ (String.sub name (i + 2) (String.length name - i - 2)))
+ in
+ match Env.find_module_by_name better_lid env with
+ | exception Not_found -> p
+ | p', _ ->
+ if module_path_is_an_alias_of env p' ~alias_of:p then
+ p'
+ else
+ p
+
+let rewrite_double_underscore_paths env p =
+ if env == Env.empty then
+ p
+ else
+ rewrite_double_underscore_paths env p
+
+let rec tree_of_path ?(disambiguation=true) namespace p =
+ let tree_of_path namespace p = tree_of_path ~disambiguation namespace p in
+ let namespace = if disambiguation then namespace else None in
+ match p with
+ | Pident id ->
+ Oide_ident (ident_name namespace id)
+ | Pdot(_, s) as path when non_shadowed_stdlib namespace path ->
+ Oide_ident (Out_name.create s)
+ | Pdot(p, s) ->
+ Oide_dot (tree_of_path (Some Module) p, s)
+ | Papply(p1, p2) ->
+ let t1 = tree_of_path (Some Module) p1 in
+ let t2 = tree_of_path (Some Module) p2 in
+ Oide_apply (t1, t2)
+ | Pextra_ty (p, extra) -> begin
+ (* inline record types are syntactically prevented from escaping their
+ binding scope, and are never shown to users. *)
+ match extra with
+ Pcstr_ty s ->
+ Oide_dot (tree_of_path (Some Type) p, s)
+ | Pext_ty ->
+ tree_of_path None p
+ end
+
+let tree_of_path ?disambiguation namespace p =
+ tree_of_path ?disambiguation namespace
+ (rewrite_double_underscore_paths !printing_env p)
+
+
+(* Print a recursive annotation *)
+
+let tree_of_rec = function
+ | Trec_not -> Orec_not
+ | Trec_first -> Orec_first
+ | Trec_next -> Orec_next
+
+(* Normalize paths *)
+
+type param_subst = Id | Nth of int | Map of int list
+
+let is_nth = function
+ Nth _ -> true
+ | _ -> false
+
+let compose l1 = function
+ | Id -> Map l1
+ | Map l2 -> Map (List.map (List.nth l1) l2)
+ | Nth n -> Nth (List.nth l1 n)
+
+let apply_subst s1 tyl =
+ if tyl = [] then []
+ (* cf. PR#7543: Typemod.type_package doesn't respect type constructor arity *)
+ else
+ match s1 with
+ Nth n1 -> [List.nth tyl n1]
+ | Map l1 -> List.map (List.nth tyl) l1
+ | Id -> tyl
+
+type best_path = Paths of Path.t list | Best of Path.t
+
+(** Short-paths cache: the five mutable variables below implement a one-slot
+ cache for short-paths
+ *)
+let printing_old = ref Env.empty
+let printing_pers = ref String.Set.empty
+(** {!printing_old} and {!printing_pers} are the keys of the one-slot cache *)
+
+let printing_depth = ref 0
+let printing_cont = ref ([] : Env.iter_cont list)
+let printing_map = ref Path.Map.empty
+(**
+ - {!printing_map} is the main value stored in the cache.
+ Note that it is evaluated lazily and its value is updated during printing.
+ - {!printing_dep} is the current exploration depth of the environment,
+ it is used to determine whenever the {!printing_map} should be evaluated
+ further before completing a request.
+ - {!printing_cont} is the list of continuations needed to evaluate
+ the {!printing_map} one level further (see also {!Env.run_iter_cont})
+*)
+
+let rec index l x =
+ match l with
+ [] -> raise Not_found
+ | a :: l -> if eq_type x a then 0 else 1 + index l x
+
+let rec uniq = function
+ [] -> true
+ | a :: l -> not (List.memq (a : int) l) && uniq l
+
+let rec normalize_type_path ?(cache=false) env p =
+ try
+ let (params, ty, _) = Env.find_type_expansion p env in
+ match get_desc ty with
+ Tconstr (p1, tyl, _) ->
+ if List.length params = List.length tyl
+ && List.for_all2 eq_type params tyl
+ then normalize_type_path ~cache env p1
+ else if cache || List.length params <= List.length tyl
+ || not (uniq (List.map get_id tyl)) then (p, Id)
+ else
+ let l1 = List.map (index params) tyl in
+ let (p2, s2) = normalize_type_path ~cache env p1 in
+ (p2, compose l1 s2)
+ | _ ->
+ (p, Nth (index params ty))
+ with
+ Not_found ->
+ (Env.normalize_type_path None env p, Id)
+
+let penalty s =
+ if s <> "" && s.[0] = '_' then
+ 10
+ else
+ match find_double_underscore s with
+ | None -> 1
+ | Some _ -> 10
+
+let rec path_size = function
+ Pident id ->
+ penalty (Ident.name id), -Ident.scope id
+ | Pdot (p, _) | Pextra_ty (p, Pcstr_ty _) ->
+ let (l, b) = path_size p in (1+l, b)
+ | Papply (p1, p2) ->
+ let (l, b) = path_size p1 in
+ (l + fst (path_size p2), b)
+ | Pextra_ty (p, _) -> path_size p
+
+let same_printing_env env =
+ let used_pers = Env.used_persistent () in
+ Env.same_types !printing_old env && String.Set.equal !printing_pers used_pers
+
+let set_printing_env env =
+ printing_env := env;
+ if !Clflags.real_paths ||
+ !printing_env == Env.empty ||
+ same_printing_env env then
+ ()
+ else begin
+ (* printf "Reset printing_map@."; *)
+ printing_old := env;
+ printing_pers := Env.used_persistent ();
+ printing_map := Path.Map.empty;
+ printing_depth := 0;
+ (* printf "Recompute printing_map.@."; *)
+ let cont =
+ Env.iter_types
+ (fun p (p', _decl) ->
+ let (p1, s1) = normalize_type_path env p' ~cache:true in
+ (* Format.eprintf "%a -> %a = %a@." path p path p' path p1 *)
+ if s1 = Id then
+ try
+ let r = Path.Map.find p1 !printing_map in
+ match !r with
+ Paths l -> r := Paths (p :: l)
+ | Best p' -> r := Paths [p; p'] (* assert false *)
+ with Not_found ->
+ printing_map := Path.Map.add p1 (ref (Paths [p])) !printing_map)
+ env in
+ printing_cont := [cont];
+ end
+
+let wrap_printing_env env f =
+ set_printing_env env;
+ try_finally f ~always:(fun () -> set_printing_env Env.empty)
+
+let wrap_printing_env ~error env f =
+ if error then Env.without_cmis (wrap_printing_env env) f
+ else wrap_printing_env env f
+
+let rec lid_of_path = function
+ Path.Pident id ->
+ Longident.Lident (Ident.name id)
+ | Path.Pdot (p1, s) | Path.Pextra_ty (p1, Pcstr_ty s) ->
+ Longident.Ldot (lid_of_path p1, s)
+ | Path.Papply (p1, p2) ->
+ Longident.Lapply (lid_of_path p1, lid_of_path p2)
+ | Path.Pextra_ty (p, Pext_ty) -> lid_of_path p
+
+let is_unambiguous path env =
+ let l = Env.find_shadowed_types path env in
+ List.exists (Path.same path) l || (* concrete paths are ok *)
+ match l with
+ [] -> true
+ | p :: rem ->
+ (* allow also coherent paths: *)
+ let normalize p = fst (normalize_type_path ~cache:true env p) in
+ let p' = normalize p in
+ List.for_all (fun p -> Path.same (normalize p) p') rem ||
+ (* also allow repeatedly defining and opening (for toplevel) *)
+ let id = lid_of_path p in
+ List.for_all (fun p -> lid_of_path p = id) rem &&
+ Path.same p (fst (Env.find_type_by_name id env))
+
+let rec get_best_path r =
+ match !r with
+ Best p' -> p'
+ | Paths [] -> raise Not_found
+ | Paths l ->
+ r := Paths [];
+ List.iter
+ (fun p ->
+ (* Format.eprintf "evaluating %a@." path p; *)
+ match !r with
+ Best p' when path_size p >= path_size p' -> ()
+ | _ -> if is_unambiguous p !printing_env then r := Best p)
+ (* else Format.eprintf "%a ignored as ambiguous@." path p *)
+ l;
+ get_best_path r
+
+let best_type_path p =
+ if !printing_env == Env.empty
+ then (p, Id)
+ else if !Clflags.real_paths
+ then (p, Id)
+ else
+ let (p', s) = normalize_type_path !printing_env p in
+ let get_path () = get_best_path (Path.Map.find p' !printing_map) in
+ while !printing_cont <> [] &&
+ try fst (path_size (get_path ())) > !printing_depth with Not_found -> true
+ do
+ printing_cont := List.map snd (Env.run_iter_cont !printing_cont);
+ incr printing_depth;
+ done;
+ let p'' = try get_path () with Not_found -> p' in
+ (* Format.eprintf "%a = %a -> %a@." path p path p' path p''; *)
+ (p'', s)
+
+(* When building a tree for a best type path, we should not disambiguate
+ identifiers whenever the short-path algorithm detected a better path than
+ the original one.*)
+let tree_of_best_type_path p p' =
+ if Path.same p p' then tree_of_path (Some Type) p'
+ else tree_of_path ~disambiguation:false None p'
+
+(* Print a type expression *)
+
+let proxy ty = Transient_expr.repr (proxy ty)
+
+(* When printing a type scheme, we print weak names. When printing a plain
+ type, we do not. This type controls that behavior *)
+type type_or_scheme = Type | Type_scheme
+
+let is_non_gen mode ty =
+ match mode with
+ | Type_scheme -> is_Tvar ty && get_level ty <> generic_level
+ | Type -> false
+
+let nameable_row row =
+ row_name row <> None &&
+ List.for_all
+ (fun (_, f) ->
+ match row_field_repr f with
+ | Reither(c, l, _) ->
+ row_closed row && if c then l = [] else List.length l = 1
+ | _ -> true)
+ (row_fields row)
+
+(* This specialized version of [Btype.iter_type_expr] normalizes and
+ short-circuits the traversal of the [type_expr], so that it covers only the
+ subterms that would be printed by the type printer. *)
+let printer_iter_type_expr f ty =
+ match get_desc ty with
+ | Tconstr(p, tyl, _) ->
+ let (_p', s) = best_type_path p in
+ List.iter f (apply_subst s tyl)
+ | Tvariant row -> begin
+ match row_name row with
+ | Some(_p, tyl) when nameable_row row ->
+ List.iter f tyl
+ | _ ->
+ iter_row f row
+ end
+ | Tobject (fi, nm) -> begin
+ match !nm with
+ | None ->
+ let fields, _ = flatten_fields fi in
+ List.iter
+ (fun (_, kind, ty) ->
+ if field_kind_repr kind = Fpublic then
+ f ty)
+ fields
+ | Some (_, l) ->
+ List.iter f (List.tl l)
+ end
+ | Tfield(_, kind, ty1, ty2) ->
+ if field_kind_repr kind = Fpublic then
+ f ty1;
+ f ty2
+ | _ ->
+ Btype.iter_type_expr f ty
+
+let quoted_ident ppf x =
+ Style.as_inline_code !Oprint.out_ident ppf x
+
+module Internal_names : sig
+
+ val reset : unit -> unit
+
+ val add : Path.t -> unit
+
+ val print_explanations : Env.t -> Fmt.formatter -> unit
+
+end = struct
+
+ let names = ref Ident.Set.empty
+
+ let reset () =
+ names := Ident.Set.empty
+
+ let add p =
+ match p with
+ | Pident id ->
+ let name = Ident.name id in
+ if String.length name > 0 && name.[0] = '$' then begin
+ names := Ident.Set.add id !names
+ end
+ | Pdot _ | Papply _ | Pextra_ty _ -> ()
+
+ let print_explanations env ppf =
+ let constrs =
+ Ident.Set.fold
+ (fun id acc ->
+ let p = Pident id in
+ match Env.find_type p env with
+ | exception Not_found -> acc
+ | decl ->
+ match type_origin decl with
+ | Existential constr ->
+ let prev = String.Map.find_opt constr acc in
+ let prev = Option.value ~default:[] prev in
+ String.Map.add constr (tree_of_path None p :: prev) acc
+ | Definition | Rec_check_regularity -> acc)
+ !names String.Map.empty
+ in
+ String.Map.iter
+ (fun constr out_idents ->
+ match out_idents with
+ | [] -> ()
+ | [out_ident] ->
+ fprintf ppf
+ "@ @[<2>@{<hint>Hint@}:@ %a@ is an existential type@ \
+ bound by the constructor@ %a.@]"
+ quoted_ident out_ident
+ Style.inline_code constr
+ | out_ident :: out_idents ->
+ fprintf ppf
+ "@ @[<2>@{<hint>Hint@}:@ %a@ and %a@ are existential types@ \
+ bound by the constructor@ %a.@]"
+ (Fmt.pp_print_list
+ ~pp_sep:(fun ppf () -> fprintf ppf ",@ ")
+ quoted_ident)
+ (List.rev out_idents)
+ quoted_ident out_ident
+ Style.inline_code constr)
+ constrs
+
+end
+
+module Variable_names : sig
+ val reset_names : unit -> unit
+
+ val add_subst : (type_expr * type_expr) list -> unit
+
+ val new_name : unit -> string
+ val new_var_name : non_gen:bool -> type_expr -> unit -> string
+
+ val name_of_type : (unit -> string) -> transient_expr -> string
+ val check_name_of_type : non_gen:bool -> transient_expr -> unit
+
+
+ val reserve: type_expr -> unit
+
+ val remove_names : transient_expr list -> unit
+
+ val with_local_names : (unit -> 'a) -> 'a
+
+ (* Refresh the weak variable map in the toplevel; for [print_items], which is
+ itself for the toplevel *)
+ val refresh_weak : unit -> unit
+end = struct
+ (* We map from types to names, but not directly; we also store a substitution,
+ which maps from types to types. The lookup process is
+ "type -> apply substitution -> find name". The substitution is presumed to
+ be one-shot. *)
+ let names = ref ([] : (transient_expr * string) list)
+ let name_subst = ref ([] : (transient_expr * transient_expr) list)
+ let name_counter = ref 0
+ let named_vars = ref ([] : string list)
+ let visited_for_named_vars = ref ([] : transient_expr list)
+
+ let weak_counter = ref 1
+ let weak_var_map = ref TypeMap.empty
+ let named_weak_vars = ref String.Set.empty
+
+ let reset_names () =
+ names := [];
+ name_subst := [];
+ name_counter := 0;
+ named_vars := [];
+ visited_for_named_vars := []
+
+ let add_named_var tty =
+ match tty.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ if List.mem name !named_vars then () else
+ named_vars := name :: !named_vars
+ | _ -> ()
+
+ let rec add_named_vars ty =
+ let tty = Transient_expr.repr ty in
+ let px = proxy ty in
+ if not (List.memq px !visited_for_named_vars) then begin
+ visited_for_named_vars := px :: !visited_for_named_vars;
+ match tty.desc with
+ | Tvar _ | Tunivar _ ->
+ add_named_var tty
+ | _ ->
+ printer_iter_type_expr add_named_vars ty
+ end
+
+ let substitute ty =
+ match List.assq ty !name_subst with
+ | ty' -> ty'
+ | exception Not_found -> ty
+
+ let add_subst subst =
+ name_subst :=
+ List.map (fun (t1,t2) -> Transient_expr.repr t1, Transient_expr.repr t2)
+ subst
+ @ !name_subst
+
+ let name_is_already_used name =
+ List.mem name !named_vars
+ || List.exists (fun (_, name') -> name = name') !names
+ || String.Set.mem name !named_weak_vars
+
+ let rec new_name () =
+ let name = Misc.letter_of_int !name_counter in
+ incr name_counter;
+ if name_is_already_used name then new_name () else name
+
+ let rec new_weak_name ty () =
+ let name = "weak" ^ Int.to_string !weak_counter in
+ incr weak_counter;
+ if name_is_already_used name then new_weak_name ty ()
+ else begin
+ named_weak_vars := String.Set.add name !named_weak_vars;
+ weak_var_map := TypeMap.add ty name !weak_var_map;
+ name
+ end
+
+ let new_var_name ~non_gen ty () =
+ if non_gen then new_weak_name ty ()
+ else new_name ()
+
+ let name_of_type name_generator t =
+ (* We've already been through repr at this stage, so t is our representative
+ of the union-find class. *)
+ let t = substitute t in
+ try List.assq t !names with Not_found ->
+ try TransientTypeMap.find t !weak_var_map with Not_found ->
+ let name =
+ match t.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ (* Some part of the type we've already printed has assigned another
+ * unification variable to that name. We want to keep the name, so
+ * try adding a number until we find a name that's not taken. *)
+ let available name =
+ List.for_all
+ (fun (_, name') -> name <> name')
+ !names
+ in
+ if available name then name
+ else
+ let suffixed i = name ^ Int.to_string i in
+ let i = Misc.find_first_mono (fun i -> available (suffixed i)) in
+ suffixed i
+ | _ ->
+ (* No name available, create a new one *)
+ name_generator ()
+ in
+ (* Exception for type declarations *)
+ if name <> "_" then names := (t, name) :: !names;
+ name
+
+ let check_name_of_type ~non_gen px =
+ let name_gen = new_var_name ~non_gen (Transient_expr.type_expr px) in
+ ignore(name_of_type name_gen px)
+
+ let remove_names tyl =
+ let tyl = List.map substitute tyl in
+ names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+
+ let with_local_names f =
+ let old_names = !names in
+ let old_subst = !name_subst in
+ names := [];
+ name_subst := [];
+ try_finally
+ ~always:(fun () ->
+ names := old_names;
+ name_subst := old_subst)
+ f
+
+ let refresh_weak () =
+ let refresh t name (m,s) =
+ if is_non_gen Type_scheme t then
+ begin
+ TypeMap.add t name m,
+ String.Set.add name s
+ end
+ else m, s in
+ let m, s =
+ TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
+ named_weak_vars := s;
+ weak_var_map := m
+
+ let reserve ty =
+ normalize_type ty;
+ add_named_vars ty
+end
+
+module Aliases = struct
+ let visited_objects = ref ([] : transient_expr list)
+ let aliased = ref ([] : transient_expr list)
+ let delayed = ref ([] : transient_expr list)
+ let printed_aliases = ref ([] : transient_expr list)
+
+(* [printed_aliases] is a subset of [aliased] that records only those aliased
+ types that have actually been printed; this allows us to avoid naming loops
+ that the user will never see. *)
+
+ let is_delayed t = List.memq t !delayed
+
+ let remove_delay t =
+ if is_delayed t then
+ delayed := List.filter ((!=) t) !delayed
+
+ let add_delayed t =
+ if not (is_delayed t) then delayed := t :: !delayed
+
+ let is_aliased_proxy px = List.memq px !aliased
+ let is_printed_proxy px = List.memq px !printed_aliases
+
+ let add_proxy px =
+ if not (is_aliased_proxy px) then
+ aliased := px :: !aliased
+
+ let add ty = add_proxy (proxy ty)
+
+ let add_printed_proxy ~non_gen px =
+ Variable_names.check_name_of_type ~non_gen px;
+ printed_aliases := px :: !printed_aliases
+
+ let mark_as_printed px =
+ if is_aliased_proxy px then (add_printed_proxy ~non_gen:false) px
+
+ let add_printed ty = add_printed_proxy (proxy ty)
+
+ let aliasable ty =
+ match get_desc ty with
+ Tvar _ | Tunivar _ | Tpoly _ -> false
+ | Tconstr (p, _, _) ->
+ not (is_nth (snd (best_type_path p)))
+ | _ -> true
+
+ let should_visit_object ty =
+ match get_desc ty with
+ | Tvariant row -> not (static_row row)
+ | Tobject _ -> opened_object ty
+ | _ -> false
+
+ let rec mark_loops_rec visited ty =
+ let px = proxy ty in
+ if List.memq px visited && aliasable ty then add_proxy px else
+ let tty = Transient_expr.repr ty in
+ let visited = px :: visited in
+ match tty.desc with
+ | Tvariant _ | Tobject _ ->
+ if List.memq px !visited_objects then add_proxy px else begin
+ if should_visit_object ty then
+ visited_objects := px :: !visited_objects;
+ printer_iter_type_expr (mark_loops_rec visited) ty
+ end
+ | Tpoly(ty, tyl) ->
+ List.iter add tyl;
+ mark_loops_rec visited ty
+ | _ ->
+ printer_iter_type_expr (mark_loops_rec visited) ty
+
+ let mark_loops ty =
+ mark_loops_rec [] ty
+
+ let reset () =
+ visited_objects := []; aliased := []; delayed := []; printed_aliases := []
+
+end
+
+let prepare_type ty =
+ Variable_names.reserve ty;
+ Aliases.mark_loops ty
+
+
+let reset_except_conflicts () =
+ Variable_names.reset_names (); Aliases.reset (); Internal_names.reset ()
+
+let reset () =
+ Ident_conflicts.reset ();
+ reset_except_conflicts ()
+
+let prepare_for_printing tyl =
+ reset_except_conflicts ();
+ List.iter prepare_type tyl
+
+let add_type_to_preparation = prepare_type
+
+(* Disabled in classic mode when printing an unification error *)
+let print_labels = ref true
+let with_labels b f = Misc.protect_refs [R (print_labels,b)] f
+
+let alias_nongen_row mode px ty =
+ match get_desc ty with
+ | Tvariant _ | Tobject _ ->
+ if is_non_gen mode (Transient_expr.type_expr px) then
+ Aliases.add_proxy px
+ | _ -> ()
+
+let rec tree_of_typexp mode ty =
+ let px = proxy ty in
+ if Aliases.is_printed_proxy px && not (Aliases.is_delayed px) then
+ let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+ let name = Variable_names.(name_of_type (new_var_name ~non_gen ty)) px in
+ Otyp_var (non_gen, name) else
+
+ let pr_typ () =
+ let tty = Transient_expr.repr ty in
+ match tty.desc with
+ | Tvar _ ->
+ let non_gen = is_non_gen mode ty in
+ let name_gen = Variable_names.new_var_name ~non_gen ty in
+ Otyp_var (non_gen, Variable_names.name_of_type name_gen tty)
+ | Tarrow(l, ty1, ty2, _) ->
+ let lab =
+ if !print_labels || is_optional l then l else Nolabel
+ in
+ let t1 =
+ if is_optional l then
+ match get_desc ty1 with
+ | Tconstr(path, [ty], _)
+ when Path.same path Predef.path_option ->
+ tree_of_typexp mode ty
+ | _ -> Otyp_stuff "<hidden>"
+ else tree_of_typexp mode ty1 in
+ Otyp_arrow (lab, t1, tree_of_typexp mode ty2)
+ | Ttuple tyl ->
+ Otyp_tuple (tree_of_typlist mode tyl)
+ | Tconstr(p, tyl, _abbrev) ->
+ let p', s = best_type_path p in
+ let tyl' = apply_subst s tyl in
+ if is_nth s && not (tyl'=[])
+ then tree_of_typexp mode (List.hd tyl')
+ else begin
+ Internal_names.add p';
+ Otyp_constr (tree_of_best_type_path p p', tree_of_typlist mode tyl')
+ end
+ | Tvariant row ->
+ let Row {fields; name; closed; _} = row_repr row in
+ let fields =
+ if closed then
+ List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
+ fields
+ else fields in
+ let present =
+ List.filter
+ (fun (_, f) ->
+ match row_field_repr f with
+ | Rpresent _ -> true
+ | _ -> false)
+ fields in
+ let all_present = List.length present = List.length fields in
+ begin match name with
+ | Some(p, tyl) when nameable_row row ->
+ let (p', s) = best_type_path p in
+ let id = tree_of_best_type_path p p' in
+ let args = tree_of_typlist mode (apply_subst s tyl) in
+ let out_variant =
+ if is_nth s then List.hd args else Otyp_constr (id, args) in
+ if closed && all_present then
+ out_variant
+ else
+ let tags =
+ if all_present then None else Some (List.map fst present) in
+ Otyp_variant (Ovar_typ out_variant, closed, tags)
+ | _ ->
+ let fields = List.map (tree_of_row_field mode) fields in
+ let tags =
+ if all_present then None else Some (List.map fst present) in
+ Otyp_variant (Ovar_fields fields, closed, tags)
+ end
+ | Tobject (fi, nm) ->
+ tree_of_typobject mode fi !nm
+ | Tnil | Tfield _ ->
+ tree_of_typobject mode ty None
+ | Tsubst _ ->
+ (* This case should only happen when debugging the compiler *)
+ Otyp_stuff "<Tsubst>"
+ | Tlink _ ->
+ fatal_error "Out_type.tree_of_typexp"
+ | Tpoly (ty, []) ->
+ tree_of_typexp mode ty
+ | Tpoly (ty, tyl) ->
+ (*let print_names () =
+ List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
+ prerr_string "; " in *)
+ if tyl = [] then tree_of_typexp mode ty else begin
+ let tyl = List.map Transient_expr.repr tyl in
+ let old_delayed = !Aliases.delayed in
+ (* Make the names delayed, so that the real type is
+ printed once when used as proxy *)
+ List.iter Aliases.add_delayed tyl;
+ let tl = List.map Variable_names.(name_of_type new_name) tyl in
+ let tr = Otyp_poly (tl, tree_of_typexp mode ty) in
+ (* Forget names when we leave scope *)
+ Variable_names.remove_names tyl;
+ Aliases.delayed := old_delayed; tr
+ end
+ | Tunivar _ ->
+ Otyp_var (false, Variable_names.(name_of_type new_name) tty)
+ | Tpackage (p, fl) ->
+ let fl =
+ List.map
+ (fun (li, ty) -> (
+ String.concat "." (Longident.flatten li),
+ tree_of_typexp mode ty
+ )) fl in
+ Otyp_module (tree_of_path (Some Module_type) p, fl)
+ in
+ Aliases.remove_delay px;
+ alias_nongen_row mode px ty;
+ if Aliases.(is_aliased_proxy px && aliasable ty) then begin
+ let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+ Aliases.add_printed_proxy ~non_gen px;
+ (* add_printed_alias chose a name, thus the name generator
+ doesn't matter.*)
+ let alias = Variable_names.(name_of_type (new_var_name ~non_gen ty)) px in
+ Otyp_alias {non_gen; aliased = pr_typ (); alias } end
+ else pr_typ ()
+
+and tree_of_row_field mode (l, f) =
+ match row_field_repr f with
+ | Rpresent None | Reither(true, [], _) -> (l, false, [])
+ | Rpresent(Some ty) -> (l, false, [tree_of_typexp mode ty])
+ | Reither(c, tyl, _) ->
+ if c (* contradiction: constant constructor with an argument *)
+ then (l, true, tree_of_typlist mode tyl)
+ else (l, false, tree_of_typlist mode tyl)
+ | Rabsent -> (l, false, [] (* actually, an error *))
+
+and tree_of_typlist mode tyl =
+ List.map (tree_of_typexp mode) tyl
+
+and tree_of_typobject mode fi nm =
+ begin match nm with
+ | None ->
+ let pr_fields fi =
+ let (fields, rest) = flatten_fields fi in
+ let present_fields =
+ List.fold_right
+ (fun (n, k, t) l ->
+ match field_kind_repr k with
+ | Fpublic -> (n, t) :: l
+ | _ -> l)
+ fields [] in
+ let sorted_fields =
+ List.sort
+ (fun (n, _) (n', _) -> String.compare n n') present_fields in
+ tree_of_typfields mode rest sorted_fields in
+ let (fields, open_row) = pr_fields fi in
+ Otyp_object {fields; open_row}
+ | Some (p, _ty :: tyl) ->
+ let args = tree_of_typlist mode tyl in
+ let (p', s) = best_type_path p in
+ assert (s = Id);
+ Otyp_class (tree_of_best_type_path p p', args)
+ | _ ->
+ fatal_error "Out_type.tree_of_typobject"
+ end
+
+and tree_of_typfields mode rest = function
+ | [] ->
+ let open_row =
+ match get_desc rest with
+ | Tvar _ | Tunivar _ | Tconstr _-> true
+ | Tnil -> false
+ | _ -> fatal_error "typfields (1)"
+ in
+ ([], open_row)
+ | (s, t) :: l ->
+ let field = (s, tree_of_typexp mode t) in
+ let (fields, rest) = tree_of_typfields mode rest l in
+ (field :: fields, rest)
+
+let typexp mode ppf ty =
+ !Oprint.out_type ppf (tree_of_typexp mode ty)
+
+let prepared_type_expr ppf ty = typexp Type ppf ty
+
+(* "Half-prepared" type expression: [ty] should have had its names reserved, but
+ should not have had its loops marked. *)
+let type_expr_with_reserved_names ppf ty =
+ Aliases.reset ();
+ Aliases.mark_loops ty;
+ prepared_type_expr ppf ty
+
+
+let prepared_type_scheme ppf ty = typexp Type_scheme ppf ty
+
+(* Print one type declaration *)
+
+let tree_of_constraints params =
+ List.fold_right
+ (fun ty list ->
+ let ty' = unalias ty in
+ if proxy ty != proxy ty' then
+ let tr = tree_of_typexp Type_scheme ty in
+ (tr, tree_of_typexp Type_scheme ty') :: list
+ else list)
+ params []
+
+let filter_params tyl =
+ let params =
+ List.fold_left
+ (fun tyl ty ->
+ if List.exists (eq_type ty) tyl
+ then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
+ else ty :: tyl)
+ (* Two parameters might be identical due to a constraint but we need to
+ print them differently in order to make the output syntactically valid.
+ We use [Ttuple [ty]] because it is printed as [ty]. *)
+ (* Replacing fold_left by fold_right does not work! *)
+ [] tyl
+ in List.rev params
+
+let prepare_type_constructor_arguments = function
+ | Cstr_tuple l -> List.iter prepare_type l
+ | Cstr_record l -> List.iter (fun l -> prepare_type l.ld_type) l
+
+let tree_of_label l =
+ {
+ olab_name = Ident.name l.ld_id;
+ olab_mut = l.ld_mutable;
+ olab_type = tree_of_typexp Type l.ld_type;
+ }
+
+let tree_of_constructor_arguments = function
+ | Cstr_tuple l -> tree_of_typlist Type l
+ | Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
+
+let tree_of_single_constructor cd =
+ let name = Ident.name cd.cd_id in
+ let ret = Option.map (tree_of_typexp Type) cd.cd_res in
+ let args = tree_of_constructor_arguments cd.cd_args in
+ {
+ ocstr_name = name;
+ ocstr_args = args;
+ ocstr_return_type = ret;
+ }
+
+(* When printing GADT constructor, we need to forget the naming decision we took
+ for the type parameters and constraints. Indeed, in
+ {[
+ type 'a t = X: 'a -> 'b t
+ ]}
+ It is fine to print both the type parameter ['a] and the existentially
+ quantified ['a] in the definition of the constructor X as ['a]
+ *)
+let tree_of_constructor_in_decl cd =
+ match cd.cd_res with
+ | None -> tree_of_single_constructor cd
+ | Some _ ->
+ Variable_names.with_local_names (fun () -> tree_of_single_constructor cd)
+
+let prepare_decl id decl =
+ let params = filter_params decl.type_params in
+ begin match decl.type_manifest with
+ | Some ty ->
+ let vars = free_variables ty in
+ List.iter
+ (fun ty ->
+ if get_desc ty = Tvar (Some "_") && List.exists (eq_type ty) vars
+ then set_type_desc ty (Tvar None))
+ params
+ | None -> ()
+ end;
+ List.iter Aliases.add params;
+ List.iter prepare_type params;
+ List.iter (Aliases.add_printed ~non_gen:false) params;
+ let ty_manifest =
+ match decl.type_manifest with
+ | None -> None
+ | Some ty ->
+ let ty =
+ (* Special hack to hide variant name *)
+ match get_desc ty with
+ Tvariant row ->
+ begin match row_name row with
+ Some (Pident id', _) when Ident.same id id' ->
+ newgenty (Tvariant (set_row_name row None))
+ | _ -> ty
+ end
+ | _ -> ty
+ in
+ prepare_type ty;
+ Some ty
+ in
+ begin match decl.type_kind with
+ | Type_abstract _ -> ()
+ | Type_variant (cstrs, _rep) ->
+ List.iter
+ (fun c ->
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res)
+ cstrs
+ | Type_record(l, _rep) ->
+ List.iter (fun l -> prepare_type l.ld_type) l
+ | Type_open -> ()
+ end;
+ ty_manifest, params
+
+let tree_of_type_decl id decl =
+ let ty_manifest, params = prepare_decl id decl in
+ let type_param ot_variance =
+ function
+ | Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+ | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+ in
+ let type_defined decl =
+ let abstr =
+ match decl.type_kind with
+ Type_abstract _ ->
+ decl.type_manifest = None || decl.type_private = Private
+ | Type_record _ ->
+ decl.type_private = Private
+ | Type_variant (tll, _rep) ->
+ decl.type_private = Private ||
+ List.exists (fun cd -> cd.cd_res <> None) tll
+ | Type_open ->
+ decl.type_manifest = None
+ in
+ let vari =
+ List.map2
+ (fun ty v ->
+ let is_var = is_Tvar ty in
+ if abstr || not is_var then
+ let inj =
+ type_kind_is_abstract decl && Variance.mem Inj v &&
+ match decl.type_manifest with
+ | None -> true
+ | Some ty -> (* only abstract or private row types *)
+ decl.type_private = Private &&
+ Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
+ and (co, cn) = Variance.get_upper v in
+ (if not cn then Covariant else
+ if not co then Contravariant else NoVariance),
+ (if inj then Injective else NoInjectivity)
+ else (NoVariance, NoInjectivity))
+ decl.type_params decl.type_variance
+ in
+ (Ident.name id,
+ List.map2 (fun ty cocn -> type_param cocn (tree_of_typexp Type ty))
+ params vari)
+ in
+ let tree_of_manifest ty1 =
+ match ty_manifest with
+ | None -> ty1
+ | Some ty -> Otyp_manifest (tree_of_typexp Type ty, ty1)
+ in
+ let (name, args) = type_defined decl in
+ let constraints = tree_of_constraints params in
+ let ty, priv, unboxed =
+ match decl.type_kind with
+ | Type_abstract _ ->
+ begin match ty_manifest with
+ | None -> (Otyp_abstract, Public, false)
+ | Some ty ->
+ tree_of_typexp Type ty, decl.type_private, false
+ end
+ | Type_variant (cstrs, rep) ->
+ tree_of_manifest
+ (Otyp_sum (List.map tree_of_constructor_in_decl cstrs)),
+ decl.type_private,
+ (rep = Variant_unboxed)
+ | Type_record(lbls, rep) ->
+ tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
+ decl.type_private,
+ (match rep with Record_unboxed _ -> true | _ -> false)
+ | Type_open ->
+ tree_of_manifest Otyp_open,
+ decl.type_private,
+ false
+ in
+ { otype_name = name;
+ otype_params = args;
+ otype_type = ty;
+ otype_private = priv;
+ otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
+ otype_unboxed = unboxed;
+ otype_cstrs = constraints }
+
+let add_type_decl_to_preparation id decl =
+ ignore @@ prepare_decl id decl
+
+let tree_of_prepared_type_decl id decl =
+ tree_of_type_decl id decl
+
+let tree_of_type_decl id decl =
+ reset_except_conflicts();
+ tree_of_type_decl id decl
+
+let add_constructor_to_preparation c =
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res
+
+let prepared_constructor ppf c =
+ !Oprint.out_constr ppf (tree_of_single_constructor c)
+
+
+let tree_of_type_declaration id decl rs =
+ Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
+
+let tree_of_prepared_type_declaration id decl rs =
+ Osig_type (tree_of_prepared_type_decl id decl, tree_of_rec rs)
+
+let add_type_declaration_to_preparation id decl =
+ add_type_decl_to_preparation id decl
+
+let prepared_type_declaration id ppf decl =
+ !Oprint.out_sig_item ppf
+ (tree_of_prepared_type_declaration id decl Trec_first)
+
+
+(* When printing extension constructor, it is important to ensure that
+after printing the constructor, we are still in the scope of the constructor.
+For GADT constructor, this can be done by printing the type parameters inside
+their own isolated scope. This ensures that in
+{[
+ type 'b t += A: 'b -> 'b any t
+]}
+the type parameter `'b` is not bound when printing the type variable `'b` from
+the constructor definition from the type parameter.
+
+Contrarily, for non-gadt constructor, we must keep the same scope for
+the type parameters and the constructor because a type constraint may
+have changed the name of the type parameter:
+{[
+type -'a t = .. constraint <x:'a. 'a t -> 'a> = 'a
+(* the universal 'a is here to steal the name 'a from the type parameter *)
+type 'a t = X of 'a
+]} *)
+let add_extension_constructor_to_preparation ext =
+ let ty_params = filter_params ext.ext_type_params in
+ List.iter Aliases.add ty_params;
+ List.iter prepare_type ty_params;
+ prepare_type_constructor_arguments ext.ext_args;
+ Option.iter prepare_type ext.ext_ret_type
+
+let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
+ let ret = Option.map (tree_of_typexp Type) ext_ret_type in
+ let args = tree_of_constructor_arguments ext_args in
+ (args, ret)
+
+let prepared_tree_of_extension_constructor
+ id ext es
+ =
+ let ty_name = Path.name ext.ext_type_path in
+ let ty_params = filter_params ext.ext_type_params in
+ let type_param =
+ function
+ | Otyp_var (_, id) -> id
+ | _ -> "?"
+ in
+ let param_scope f =
+ match ext.ext_ret_type with
+ | None ->
+ (* normal constructor: same scope for parameters and the constructor *)
+ f ()
+ | Some _ ->
+ (* gadt constructor: isolated scope for the type parameters *)
+ Variable_names.with_local_names f
+ in
+ let ty_params =
+ param_scope
+ (fun () ->
+ List.iter (Aliases.add_printed ~non_gen:false) ty_params;
+ List.map (fun ty -> type_param (tree_of_typexp Type ty)) ty_params
+ )
+ in
+ let name = Ident.name id in
+ let args, ret =
+ extension_constructor_args_and_ret_type_subtree
+ ext.ext_args
+ ext.ext_ret_type
+ in
+ let ext =
+ { oext_name = name;
+ oext_type_name = ty_name;
+ oext_type_params = ty_params;
+ oext_args = args;
+ oext_ret_type = ret;
+ oext_private = ext.ext_private }
+ in
+ let es =
+ match es with
+ Text_first -> Oext_first
+ | Text_next -> Oext_next
+ | Text_exception -> Oext_exception
+ in
+ Osig_typext (ext, es)
+
+let tree_of_extension_constructor id ext es =
+ reset_except_conflicts ();
+ add_extension_constructor_to_preparation ext;
+ prepared_tree_of_extension_constructor id ext es
+
+let prepared_extension_constructor id ppf ext =
+ !Oprint.out_sig_item ppf
+ (prepared_tree_of_extension_constructor id ext Text_first)
+
+(* Print a value declaration *)
+
+let tree_of_value_description id decl =
+ (* Format.eprintf "@[%a@]@." raw_type_expr decl.val_type; *)
+ let id = Ident.name id in
+ let () = prepare_for_printing [decl.val_type] in
+ let ty = tree_of_typexp Type_scheme decl.val_type in
+ let vd =
+ { oval_name = id;
+ oval_type = ty;
+ oval_prims = [];
+ oval_attributes = [] }
+ in
+ let vd =
+ match decl.val_kind with
+ | Val_prim p -> Primitive.print p vd
+ | _ -> vd
+ in
+ Osig_value vd
+
+(* Print a class type *)
+
+let method_type priv ty =
+ match priv, get_desc ty with
+ | Mpublic, Tpoly(ty, tyl) -> (ty, tyl)
+ | _ , _ -> (ty, [])
+
+let prepare_method _lab (priv, _virt, ty) =
+ let ty, _ = method_type priv ty in
+ prepare_type ty
+
+let tree_of_method mode (lab, priv, virt, ty) =
+ let (ty, tyl) = method_type priv ty in
+ let tty = tree_of_typexp mode ty in
+ Variable_names.remove_names (List.map Transient_expr.repr tyl);
+ let priv = priv <> Mpublic in
+ let virt = virt = Virtual in
+ Ocsg_method (lab, priv, virt, tty)
+
+let rec prepare_class_type params = function
+ | Cty_constr (_p, tyl, cty) ->
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !Aliases.visited_objects
+ || not (List.for_all is_Tvar params)
+ || List.exists (deep_occur row) tyl
+ then prepare_class_type params cty
+ else List.iter prepare_type tyl
+ | Cty_signature sign ->
+ (* Self may have a name *)
+ let px = proxy sign.csig_self_row in
+ if List.memq px !Aliases.visited_objects then Aliases.add_proxy px
+ else Aliases.(visited_objects := px :: !visited_objects);
+ Vars.iter (fun _ (_, _, ty) -> prepare_type ty) sign.csig_vars;
+ Meths.iter prepare_method sign.csig_meths
+ | Cty_arrow (_, ty, cty) ->
+ prepare_type ty;
+ prepare_class_type params cty
+
+let rec tree_of_class_type mode params =
+ function
+ | Cty_constr (p', tyl, cty) ->
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !Aliases.visited_objects
+ || not (List.for_all is_Tvar params)
+ then
+ tree_of_class_type mode params cty
+ else
+ let namespace = Namespace.best_class_namespace p' in
+ Octy_constr (tree_of_path namespace p', tree_of_typlist Type_scheme tyl)
+ | Cty_signature sign ->
+ let px = proxy sign.csig_self_row in
+ let self_ty =
+ if Aliases.is_aliased_proxy px then
+ Some
+ (Otyp_var (false, Variable_names.(name_of_type new_name) px))
+ else None
+ in
+ let csil = [] in
+ let csil =
+ List.fold_left
+ (fun csil (ty1, ty2) -> Ocsg_constraint (ty1, ty2) :: csil)
+ csil (tree_of_constraints params)
+ in
+ let all_vars =
+ Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.csig_vars []
+ in
+ (* Consequence of PR#3607: order of Map.fold has changed! *)
+ let all_vars = List.rev all_vars in
+ let csil =
+ List.fold_left
+ (fun csil (l, m, v, t) ->
+ Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp mode t)
+ :: csil)
+ csil all_vars
+ in
+ let all_meths =
+ Meths.fold
+ (fun l (p, v, t) all -> (l, p, v, t) :: all)
+ sign.csig_meths []
+ in
+ let all_meths = List.rev all_meths in
+ let csil =
+ List.fold_left
+ (fun csil meth -> tree_of_method mode meth :: csil)
+ csil all_meths
+ in
+ Octy_signature (self_ty, List.rev csil)
+ | Cty_arrow (l, ty, cty) ->
+ let lab =
+ if !print_labels || is_optional l then l else Nolabel
+ in
+ let tr =
+ if is_optional l then
+ match get_desc ty with
+ | Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
+ tree_of_typexp mode ty
+ | _ -> Otyp_stuff "<hidden>"
+ else tree_of_typexp mode ty in
+ Octy_arrow (lab, tr, tree_of_class_type mode params cty)
+
+
+let tree_of_class_param param variance =
+ let ot_variance =
+ if is_Tvar param then Asttypes.(NoVariance, NoInjectivity) else variance in
+ match tree_of_typexp Type_scheme param with
+ Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+ | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+
+let class_variance =
+ let open Variance in let open Asttypes in
+ List.map (fun v ->
+ (if not (mem May_pos v) then Contravariant else
+ if not (mem May_neg v) then Covariant else NoVariance),
+ NoInjectivity)
+
+let tree_of_class_declaration id cl rs =
+ let params = filter_params cl.cty_params in
+
+ reset_except_conflicts ();
+ List.iter Aliases.add params;
+ prepare_class_type params cl.cty_type;
+ let px = proxy (Btype.self_type_row cl.cty_type) in
+ List.iter prepare_type params;
+
+ List.iter (Aliases.add_printed ~non_gen:false) params;
+ if Aliases.is_aliased_proxy px then
+ Aliases.add_printed_proxy ~non_gen:false px;
+
+ let vir_flag = cl.cty_new = None in
+ Osig_class
+ (vir_flag, Ident.name id,
+ List.map2 tree_of_class_param params (class_variance cl.cty_variance),
+ tree_of_class_type Type_scheme params cl.cty_type,
+ tree_of_rec rs)
+
+let tree_of_cltype_declaration id cl rs =
+ let params = cl.clty_params in
+
+ reset_except_conflicts ();
+ List.iter Aliases.add params;
+ prepare_class_type params cl.clty_type;
+ let px = proxy (Btype.self_type_row cl.clty_type) in
+ List.iter prepare_type params;
+
+ List.iter (Aliases.add_printed ~non_gen:false) params;
+ Aliases.mark_as_printed px;
+
+ let sign = Btype.signature_of_class_type cl.clty_type in
+ let has_virtual_vars =
+ Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_vars false
+ in
+ let has_virtual_meths =
+ Meths.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_meths false
+ in
+ Osig_class_type
+ (has_virtual_vars || has_virtual_meths, Ident.name id,
+ List.map2 tree_of_class_param params (class_variance cl.clty_variance),
+ tree_of_class_type Type_scheme params cl.clty_type,
+ tree_of_rec rs)
+
+(* Print a module type *)
+
+let wrap_env fenv ftree arg =
+ (* We save the current value of the short-path cache *)
+ (* From keys *)
+ let env = !printing_env in
+ let old_pers = !printing_pers in
+ (* to data *)
+ let old_map = !printing_map in
+ let old_depth = !printing_depth in
+ let old_cont = !printing_cont in
+ set_printing_env (fenv env);
+ let tree = ftree arg in
+ if !Clflags.real_paths
+ || same_printing_env env then ()
+ (* our cached key is still live in the cache, and we want to keep all
+ progress made on the computation of the [printing_map] *)
+ else begin
+ (* we restore the snapshotted cache before calling set_printing_env *)
+ printing_old := env;
+ printing_pers := old_pers;
+ printing_depth := old_depth;
+ printing_cont := old_cont;
+ printing_map := old_map
+ end;
+ set_printing_env env;
+ tree
+
+let dummy =
+ {
+ type_params = [];
+ type_arity = 0;
+ type_kind = Type_abstract Definition;
+ type_private = Public;
+ type_manifest = None;
+ type_variance = [];
+ type_separability = [];
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = Location.none;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.internal_not_actually_unique;
+ }
+
+(** we hide items being defined from short-path to avoid shortening
+ [type t = Path.To.t] into [type t = t].
+*)
+
+let ident_sigitem = function
+ | Types.Sig_type(ident,_,_,_) -> {hide=true;ident}
+ | Types.Sig_class(ident,_,_,_)
+ | Types.Sig_class_type (ident,_,_,_)
+ | Types.Sig_module(ident,_, _,_,_)
+ | Types.Sig_value (ident,_,_)
+ | Types.Sig_modtype (ident,_,_)
+ | Types.Sig_typext (ident,_,_,_) -> {hide=false; ident }
+
+let hide ids env =
+ let hide_id id env =
+ (* Global idents cannot be renamed *)
+ if id.hide && not (Ident.global id.ident) then
+ Env.add_type ~check:false (Ident.rename id.ident) dummy env
+ else env
+ in
+ List.fold_right hide_id ids env
+
+let with_hidden_items ids f =
+ let with_hidden_in_printing_env ids f =
+ wrap_env (hide ids) (Ident_names.with_hidden ids) f
+ in
+ if not !Clflags.real_paths then
+ with_hidden_in_printing_env ids f
+ else
+ Ident_names.with_hidden ids f
+
+
+let add_sigitem env x =
+ Env.add_signature (Signature_group.flatten x) env
+
+let rec tree_of_modtype ?(ellipsis=false) = function
+ | Mty_ident p ->
+ Omty_ident (tree_of_path (Some Module_type) p)
+ | Mty_signature sg ->
+ Omty_signature (if ellipsis then [Osig_ellipsis]
+ else tree_of_signature sg)
+ | Mty_functor(param, ty_res) ->
+ let param, env =
+ tree_of_functor_parameter param
+ in
+ let res = wrap_env env (tree_of_modtype ~ellipsis) ty_res in
+ Omty_functor (param, res)
+ | Mty_alias p ->
+ Omty_alias (tree_of_path (Some Module) p)
+ | Mty_for_hole -> Omty_hole
+
+and tree_of_functor_parameter = function
+ | Unit ->
+ None, fun k -> k
+ | Named (param, ty_arg) ->
+ let name, env =
+ match param with
+ | None -> None, fun env -> env
+ | Some id ->
+ Some (Ident.name id),
+ Env.add_module ~arg:true id Mp_present ty_arg
+ in
+ Some (name, tree_of_modtype ~ellipsis:false ty_arg), env
+
+and tree_of_signature sg =
+ wrap_env (fun env -> env)(fun sg ->
+ let tree_groups = tree_of_signature_rec !printing_env sg in
+ List.concat_map (fun (_env,l) -> List.map snd l) tree_groups
+ ) sg
+
+and tree_of_signature_rec env' sg =
+ let structured = List.of_seq (Signature_group.seq sg) in
+ let collect_trees_of_rec_group group =
+ let env = !printing_env in
+ let env', group_trees =
+ trees_of_recursive_sigitem_group env group
+ in
+ set_printing_env env';
+ (env, group_trees) in
+ set_printing_env env';
+ List.map collect_trees_of_rec_group structured
+
+and trees_of_recursive_sigitem_group env
+ (syntactic_group: Signature_group.rec_group) =
+ let display (x:Signature_group.sig_item) = x.src, tree_of_sigitem x.src in
+ let env = Env.add_signature syntactic_group.pre_ghosts env in
+ match syntactic_group.group with
+ | Not_rec x -> add_sigitem env x, [display x]
+ | Rec_group items ->
+ let ids = List.map (fun x -> ident_sigitem x.Signature_group.src) items in
+ List.fold_left add_sigitem env items,
+ with_hidden_items ids (fun () -> List.map display items)
+
+and tree_of_sigitem = function
+ | Sig_value(id, decl, _) ->
+ tree_of_value_description id decl
+ | Sig_type(id, decl, rs, _) ->
+ tree_of_type_declaration id decl rs
+ | Sig_typext(id, ext, es, _) ->
+ tree_of_extension_constructor id ext es
+ | Sig_module(id, _, md, rs, _) ->
+ let ellipsis =
+ List.exists (function
+ | Parsetree.{attr_name = {txt="..."}; attr_payload = PStr []} -> true
+ | _ -> false)
+ md.md_attributes in
+ tree_of_module id md.md_type rs ~ellipsis
+ | Sig_modtype(id, decl, _) ->
+ tree_of_modtype_declaration id decl
+ | Sig_class(id, decl, rs, _) ->
+ tree_of_class_declaration id decl rs
+ | Sig_class_type(id, decl, rs, _) ->
+ tree_of_cltype_declaration id decl rs
+
+and tree_of_modtype_declaration id decl =
+ let mty =
+ match decl.mtd_type with
+ | None -> Omty_abstract
+ | Some mty -> tree_of_modtype mty
+ in
+ Osig_modtype (Ident.name id, mty)
+
+and tree_of_module id ?ellipsis mty rs =
+ Osig_module (Ident.name id, tree_of_modtype ?ellipsis mty, tree_of_rec rs)
+
+(* For the toplevel: merge with tree_of_signature? *)
+let print_items showval env x =
+ Variable_names.refresh_weak();
+ Ident_conflicts.reset ();
+ let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
+ let post_process (env,l) = List.map (extend_val env) l in
+ List.concat_map post_process @@ tree_of_signature_rec env x
+
+let same_path t t' =
+ let open Types in
+ eq_type t t' ||
+ match get_desc t, get_desc t' with
+ Tconstr(p,tl,_), Tconstr(p',tl',_) ->
+ let (p1, s1) = best_type_path p and (p2, s2) = best_type_path p' in
+ begin match s1, s2 with
+ Nth n1, Nth n2 when n1 = n2 -> true
+ | (Id | Map _), (Id | Map _) when Path.same p1 p2 ->
+ let tl = apply_subst s1 tl and tl' = apply_subst s2 tl' in
+ List.length tl = List.length tl' &&
+ List.for_all2 eq_type tl tl'
+ | _ -> false
+ end
+ | _ ->
+ false
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+
+let trees_of_type_expansion mode Errortrace.{ty = t; expanded = t'} =
+ Aliases.reset ();
+ Aliases.mark_loops t;
+ if same_path t t'
+ then begin Aliases.add_delayed (proxy t); Same (tree_of_typexp mode t) end
+ else begin
+ Aliases.mark_loops t';
+ let t' = if proxy t == proxy t' then unalias t' else t' in
+ (* beware order matter due to side effect,
+ e.g. when printing object types *)
+ let first = tree_of_typexp mode t in
+ let second = tree_of_typexp mode t' in
+ if first = second then Same first
+ else Diff(first,second)
+ end
+
+let pp_type ppf t =
+ Style.as_inline_code !Oprint.out_type ppf t
+
+let pp_type_expansion ppf = function
+ | Same t -> pp_type ppf t
+ | Diff(t,t') ->
+ fprintf ppf "@[<2>%a@ =@ %a@]"
+ pp_type t
+ pp_type t'
+
+(* Hide variant name and var, to force printing the expanded type *)
+let hide_variant_name t =
+ let open Types in
+ match get_desc t with
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ if name = None then t else
+ Btype.newty2 ~level:(get_level t)
+ (Tvariant
+ (create_row ~fields ~fixed ~closed ~name:None
+ ~more:(Ctype.newvar2 (get_level more))))
+ | _ -> t
+
+let prepare_expansion Errortrace.{ty; expanded} =
+ let expanded = hide_variant_name expanded in
+ Variable_names.reserve ty;
+ if not (same_path ty expanded) then Variable_names.reserve expanded;
+ Errortrace.{ty; expanded}
+
+
+(* Adapt functions to exposed interface *)
+let namespaced_tree_of_path n = tree_of_path (Some n)
+let tree_of_path ?disambiguation p = tree_of_path ?disambiguation None p
+let tree_of_modtype = tree_of_modtype ~ellipsis:false
+let tree_of_type_declaration ident td rs =
+ with_hidden_items [{hide=true; ident}]
+ (fun () -> tree_of_type_declaration ident td rs)
+
+let tree_of_class_type kind cty = tree_of_class_type kind [] cty
+let prepare_class_type cty = prepare_class_type [] cty
+
+let tree_of_type_path p =
+ let (p', s) = best_type_path p in
+ let p'' = if (s = Id) then p' else p in
+ tree_of_best_type_path p p''
diff --git a/src/ocaml/typing/out_type.mli b/src/ocaml/typing/out_type.mli
new file mode 100644
index 0000000000..b134fa1196
--- /dev/null
+++ b/src/ocaml/typing/out_type.mli
@@ -0,0 +1,259 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Functions for representing type expressions and module types as outcometree
+ (with [as 'a] aliases for cycles) and printing them. All functions below
+ depends on global contexts that keep track of
+
+- If labels are disabled
+- Current printing environment
+- Shortest equivalent paths
+
+- Conflicts for identifier names
+- Names chosen for type variables
+- Aliases used for representing cycles or row variables
+- Uses of internal names
+
+Whenever possible, it is advised to use the simpler functions available in
+{!Printtyp} which take care of setting up this naming context. The functions
+below are needed when one needs to share a common naming context (or part of it)
+between different calls to printing functions (or in order to implement
+{!Printtyp}).
+*)
+
+open Format_doc
+open Types
+open Outcometree
+
+(** {1 Wrapping functions}*)
+
+val wrap_printing_env: error:bool -> Env.t -> (unit -> 'a) -> 'a
+(** Call the function using the environment for type path shortening
+ This affects all the printing and tree cration functions functions below
+ Also, if [~error:true], then disable the loading of cmis *)
+
+
+(** [with_labels false] disable labels in function types *)
+val with_labels: bool -> (unit -> 'a) -> 'a
+
+(** {1 Printing idents and paths } *)
+
+val ident_name: Shape.Sig_component_kind.t option -> Ident.t -> out_name
+val tree_of_path: ?disambiguation:bool -> Path.t -> out_ident
+val namespaced_tree_of_path: Shape.Sig_component_kind.t -> Path.t -> out_ident
+val tree_of_type_path: Path.t -> out_ident
+(** Specialized functions for printing types with [short-paths] *)
+
+(** [same_path ty ty2] is true when there is an equation [ty]=[ty2] in the
+ short-path scope*)
+val same_path: type_expr -> type_expr -> bool
+
+(** Simple heuristic to rewrite Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+ for Foo__bar. This pattern is used by the stdlib. *)
+val rewrite_double_underscore_paths: Env.t -> Path.t -> Path.t
+
+(** {1 Printing type expressions} *)
+
+(** Printing type expressions requires to translate the internal graph based
+ representation into to an {!Outcometree} closer to the source syntax. In
+ order to do so, the printing is generally split in three phase:
+ - A preparation phase which in particular
+ - marks cycles
+ - chooses user-facing names for type variables
+ - An outcometree generation phase, where we emit an outcometree as a
+ ready-for-printing representation of trees (represented by the various
+ [tree_of_*] functions)
+ - Printing proper
+*)
+
+(** [prepare_for_printing] resets the global naming environment, a la
+ {!reset_except_conflicts}, and prepares the types for printing by reserving
+ variable names and marking cycles. Any type variables that are shared
+ between multiple types in the input list will be given the same name when
+ printed with {!prepared_type_expr}. *)
+val prepare_for_printing: type_expr list -> unit
+
+(** [add_type_to_preparation ty] extend a previous type expression preparation
+ to the type expression [ty]
+*)
+val add_type_to_preparation: type_expr -> unit
+
+(** In [Type_scheme] mode, non-generic types variables are printed as weakly
+ polymorphic type variables. *)
+type type_or_scheme = Type | Type_scheme
+val tree_of_typexp: type_or_scheme -> type_expr -> out_type
+(** [tree_of_typexp] generate the [outcometree] for a prepared type
+ expression.*)
+
+val prepared_type_scheme: type_expr printer
+val prepared_type_expr: type_expr printer
+(** The printers [prepared_type_expr] and [prepared_type_scheme] should only be
+ used on prepared types. Types can be prepared by initially calling
+ {!prepare_for_printing} or adding them later to the preparation with
+ {!add_type_to_preparation}.
+
+ Calling this function on non-prepared types may cause a stack overflow (see
+ #8860) due to cycles in the printed types.
+
+ See {!Printtyp.type_expr} for a safer but less flexible printer. *)
+
+(** [type_expr_with_reserved_names] can print "half-prepared" type expression. A
+ "half-prepared" type expression should have had its names reserved (with
+ {!Variable_names.reserve}), but should not have had its cycles marked. *)
+val type_expr_with_reserved_names: type_expr printer
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+val trees_of_type_expansion:
+ type_or_scheme -> Errortrace.expanded_type -> out_type diff
+val prepare_expansion: Errortrace.expanded_type -> Errortrace.expanded_type
+val pp_type_expansion: out_type diff printer
+val hide_variant_name: Types.type_expr -> Types.type_expr
+
+
+(** {1: Label and constructors }*)
+val prepare_type_constructor_arguments: constructor_arguments -> unit
+val tree_of_constructor_arguments: constructor_arguments -> out_type list
+
+val tree_of_label: label_declaration -> out_label
+
+val add_constructor_to_preparation : constructor_declaration -> unit
+val prepared_constructor : constructor_declaration printer
+
+val tree_of_extension_constructor:
+ Ident.t -> extension_constructor -> ext_status -> out_sig_item
+val extension_constructor_args_and_ret_type_subtree:
+ constructor_arguments -> type_expr option -> out_type list * out_type option
+val add_extension_constructor_to_preparation :
+ extension_constructor -> unit
+val prepared_extension_constructor:
+ Ident.t -> extension_constructor printer
+
+
+(** {1 Declarations }*)
+
+val tree_of_type_declaration:
+ Ident.t -> type_declaration -> rec_status -> out_sig_item
+val add_type_declaration_to_preparation :
+ Ident.t -> type_declaration -> unit
+val prepared_type_declaration: Ident.t -> type_declaration printer
+
+val tree_of_value_description: Ident.t -> value_description -> out_sig_item
+val tree_of_modtype_declaration:
+ Ident.t -> modtype_declaration -> out_sig_item
+val tree_of_class_declaration:
+ Ident.t -> class_declaration -> rec_status -> out_sig_item
+val tree_of_cltype_declaration:
+ Ident.t -> class_type_declaration -> rec_status -> out_sig_item
+
+(** {1 Module types }*)
+
+val tree_of_module:
+ Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item
+val tree_of_modtype: module_type -> out_module_type
+val tree_of_signature: Types.signature -> out_sig_item list
+
+val tree_of_class_type: type_or_scheme -> class_type -> out_class_type
+val prepare_class_type: class_type -> unit
+
+(** {1 Toplevel printing} *)
+val print_items: (Env.t -> signature_item -> 'a option) ->
+ Env.t -> signature_item list -> (out_sig_item * 'a option) list
+
+(** {1 Naming contexts }*)
+
+(** Path name, which were mutable at some point *)
+module Out_name: sig
+ val create: string -> out_name
+ val print: out_name -> string
+end
+
+(** Disambiguation for identifiers, e.g. the two type constructors named [t]
+in the type of [f] in
+{[
+ type t = A
+ module M = struct
+ type t = B
+ let f A = B
+ end
+]}
+should be disambiguated to [t/2->t] *)
+module Ident_names: sig
+ val enable: bool -> unit
+ (** When contextual names are enabled, the mapping between identifiers
+ and names is ensured to be one-to-one. *)
+
+ (** [with_fuzzy id f] locally disable ident disambiguation for [id] within
+ [f] *)
+ val with_fuzzy: Ident.t -> (unit -> 'a) -> 'a
+end
+
+(** The [Ident_conflicts] module keeps track of conflicts arising when
+ attributing names to identifiers and provides functions that can print
+ explanations for these conflict in error messages *)
+module Ident_conflicts: sig
+ val exists: unit -> bool
+ (** [exists()] returns true if the current naming context renamed
+ an identifier to avoid a name collision *)
+
+ type explanation =
+ { kind: Shape.Sig_component_kind.t;
+ name:string;
+ root_name:string;
+ location:Location.t
+ }
+
+ val list_explanations: unit -> explanation list
+(** [list_explanations()] return the list of conflict explanations
+ collected up to this point, and reset the list of collected
+ explanations *)
+
+ val print_located_explanations: explanation list printer
+
+ val err_print: formatter -> unit
+ val err_msg: unit -> doc option
+ (** [err_msg ()] return an error message if there are pending conflict
+ explanations at this point. It is often important to check for conflicts
+ after all printing is done, thus the delayed nature of [err_msg]*)
+
+ val reset: unit -> unit
+end
+
+(** Naming choice for type variable names (['a], ['b], ...), for instance the
+ two classes of distinct type variables in
+ {[let repeat x y = x, y, y, x]}
+ should be printed printed as ['a -> 'b -> 'a * 'b * 'b * 'a].
+*)
+module Variable_names: sig
+
+ (** Add external type equalities*)
+ val add_subst: (type_expr * type_expr) list -> unit
+
+ (** [reserve ty] registers the variable names appearing in [ty] *)
+ val reserve: type_expr -> unit
+end
+
+(** Register internal typechecker names ([$0],[$a]) appearing in the
+ [outcometree] *)
+module Internal_names: sig
+ val add: Path.t -> unit
+ val reset: unit -> unit
+ val print_explanations: Env.t -> formatter -> unit
+end
+
+(** Reset all contexts *)
+val reset: unit -> unit
+
+(** Reset all contexts except for conflicts *)
+val reset_except_conflicts: unit -> unit
diff --git a/src/ocaml/typing/outcometree.mli b/src/ocaml/typing/outcometree.mli
index ed2b61599c..da508b0d2c 100644
--- a/src/ocaml/typing/outcometree.mli
+++ b/src/ocaml/typing/outcometree.mli
@@ -49,7 +49,7 @@ type out_value =
| Oval_int64 of int64
| Oval_nativeint of nativeint
| Oval_list of out_value list
- | Oval_printer of (Format.formatter -> unit)
+ | Oval_printer of (Format_doc.formatter -> unit)
| Oval_record of (out_ident * out_value) list
| Oval_string of string * int * out_string (* string, size-to-print, kind *)
| Oval_stuff of string
@@ -72,7 +72,7 @@ type out_type =
| Otyp_constr of out_ident * out_type list
| Otyp_manifest of out_type * out_type
| Otyp_object of { fields: (string * out_type) list; open_row:bool}
- | Otyp_record of (string * bool * out_type) list
+ | Otyp_record of out_label list
| Otyp_stuff of string
| Otyp_sum of out_constructor list
| Otyp_tuple of out_type list
@@ -82,6 +82,12 @@ type out_type =
| Otyp_module of out_ident * (string * out_type) list
| Otyp_attribute of out_type * out_attribute
+and out_label = {
+ olab_name: string;
+ olab_mut: Asttypes.mutable_flag;
+ olab_type: out_type;
+}
+
and out_constructor = {
ocstr_name: string;
ocstr_args: out_type list;
diff --git a/src/ocaml/typing/parmatch.ml b/src/ocaml/typing/parmatch.ml
index e10ec777b8..44f0dfef2f 100644
--- a/src/ocaml/typing/parmatch.ml
+++ b/src/ocaml/typing/parmatch.ml
@@ -504,26 +504,15 @@ let rec read_args xs r = match xs,r with
| _,_ ->
fatal_error "Parmatch.read_args"
-let do_set_args ~erase_mutable q r = match q with
+let set_args q r = match q with
| {pat_desc = Tpat_tuple omegas} ->
let args,rest = read_args omegas r in
make_pat (Tpat_tuple args) q.pat_type q.pat_env::rest
| {pat_desc = Tpat_record (omegas,closed)} ->
let args,rest = read_args omegas r in
- make_pat
- (Tpat_record
- (List.map2 (fun (lid, lbl,_) arg ->
- if
- erase_mutable &&
- (match lbl.lbl_mut with
- | Mutable -> true | Immutable -> false)
- then
- lid, lbl, omega
- else
- lid, lbl, arg)
- omegas args, closed))
- q.pat_type q.pat_env::
- rest
+ let args =
+ List.map2 (fun (lid, lbl, _) arg -> (lid, lbl, arg)) omegas args in
+ make_pat (Tpat_record (args, closed)) q.pat_type q.pat_env :: rest
| {pat_desc = Tpat_construct (lid, c, omegas, _)} ->
let args,rest = read_args omegas r in
make_pat
@@ -548,7 +537,6 @@ let do_set_args ~erase_mutable q r = match q with
end
| {pat_desc = Tpat_array omegas} ->
let args,rest = read_args omegas r in
- let args = if erase_mutable then omegas else args in
make_pat
(Tpat_array args) q.pat_type q.pat_env::
rest
@@ -557,9 +545,6 @@ let do_set_args ~erase_mutable q r = match q with
| {pat_desc = (Tpat_var _ | Tpat_alias _ | Tpat_or _); _} ->
fatal_error "Parmatch.set_args"
-let set_args q r = do_set_args ~erase_mutable:false q r
-and set_args_erase_mutable q r = do_set_args ~erase_mutable:true q r
-
(* Given a matrix of non-empty rows
p1 :: r1...
p2 :: r2...
@@ -1899,22 +1884,20 @@ let do_check_partial ~pred loc casel pss = match pss with
| Seq.Cons (v, _rest) ->
if Warnings.is_active (Warnings.Partial_match "") then begin
let errmsg =
- try
- let buf = Buffer.create 16 in
- let fmt = Format.formatter_of_buffer buf in
- Format.fprintf fmt "%a@?" Printpat.pretty_pat v;
- if do_match (initial_only_guarded casel) [v] then
- Buffer.add_string buf
- "\n(However, some guarded clause may match this value.)";
- if contains_extension v then
- Buffer.add_string buf
- "\nMatching over values of extensible variant types \
- (the *extension* above)\n\
- must include a wild card pattern in order to be exhaustive."
- ;
- Buffer.contents buf
- with _ ->
- ""
+ let doc = ref Format_doc.Doc.empty in
+ let fmt = Format_doc.formatter doc in
+ Format_doc.fprintf fmt "@[<v>%a" Printpat.top_pretty v;
+ if do_match (initial_only_guarded casel) [v] then
+ Format_doc.fprintf fmt
+ "@,(However, some guarded clause may match this value.)";
+ if contains_extension v then
+ Format_doc.fprintf fmt
+ "@,@[Matching over values of extensible variant types \
+ (the *extension* above)@,\
+ must include a wild card pattern@ in order to be exhaustive.@]"
+ ;
+ Format_doc.fprintf fmt "@]";
+ Format_doc.(asprintf "%a" pp_doc) !doc
in
Location.prerr_warning loc (Warnings.Partial_match errmsg)
end;
diff --git a/src/ocaml/typing/parmatch.mli b/src/ocaml/typing/parmatch.mli
index 246ca209ea..de7a4ad193 100644
--- a/src/ocaml/typing/parmatch.mli
+++ b/src/ocaml/typing/parmatch.mli
@@ -75,13 +75,11 @@ val lubs : pattern list -> pattern list -> pattern list
val get_mins : ('a -> 'a -> bool) -> 'a list -> 'a list
-(** Those two functions recombine one pattern and its arguments:
+(** This function recombines one pattern and its arguments:
For instance:
(_,_)::p1::p2::rem -> (p1, p2)::rem
- The second one will replace mutable arguments by '_'
*)
val set_args : pattern -> pattern list -> pattern list
-val set_args_erase_mutable : pattern -> pattern list -> pattern list
val pat_of_constr : pattern -> constructor_description -> pattern
val complete_constrs :
diff --git a/src/ocaml/typing/path.ml b/src/ocaml/typing/path.ml
index 4b44b0b2f0..038ae48f88 100644
--- a/src/ocaml/typing/path.ml
+++ b/src/ocaml/typing/path.ml
@@ -104,8 +104,8 @@ let rec name ?(paren=kfalse) = function
let rec print ppf = function
| Pident id -> Ident.print_with_scope ppf id
| Pdot(p, s) | Pextra_ty (p, Pcstr_ty s) ->
- Format.fprintf ppf "%a.%s" print p s
- | Papply(p1, p2) -> Format.fprintf ppf "%a(%a)" print p1 print p2
+ Format_doc.fprintf ppf "%a.%s" print p s
+ | Papply(p1, p2) -> Format_doc.fprintf ppf "%a(%a)" print p1 print p2
| Pextra_ty (p, Pext_ty) -> print ppf p
let rec head = function
diff --git a/src/ocaml/typing/path.mli b/src/ocaml/typing/path.mli
index 39e76a3727..034be0042e 100644
--- a/src/ocaml/typing/path.mli
+++ b/src/ocaml/typing/path.mli
@@ -68,7 +68,7 @@ val name: ?paren:(string -> bool) -> t -> string
(* [paren] tells whether a path suffix needs parentheses *)
val head: t -> Ident.t
-val print: Format.formatter -> t -> unit
+val print: t Format_doc.printer
val heads: t -> Ident.t list
diff --git a/src/ocaml/typing/persistent_env.ml b/src/ocaml/typing/persistent_env.ml
index a75b4f3e11..9a20ed6eb4 100644
--- a/src/ocaml/typing/persistent_env.ml
+++ b/src/ocaml/typing/persistent_env.ml
@@ -280,25 +280,26 @@ let check_pers_struct ~allow_hidden penv f1 f2 ~loc name =
let warn = Warnings.No_cmi_file(name, None) in
Location.prerr_warning loc warn
| Magic_numbers.Cmi.Error err ->
- let msg = Format.asprintf "%a" Magic_numbers.Cmi.report_error err in
+ let msg = Format_doc.asprintf "%a" Magic_numbers.Cmi.report_error err in
let warn = Warnings.No_cmi_file(name, Some msg) in
Location.prerr_warning loc warn
| Error err ->
let msg =
match err with
| Illegal_renaming(name, ps_name, filename) ->
- Format.asprintf
+ Format_doc.doc_printf
" %a@ contains the compiled interface for @ \
%a when %a was expected"
- (Style.as_inline_code Location.print_filename) filename
+ Location.Doc.quoted_filename filename
Style.inline_code ps_name
Style.inline_code name
| Inconsistent_import _ -> assert false
| Need_recursive_types name ->
- Format.asprintf
+ Format_doc.doc_printf
"%a uses recursive types"
Style.inline_code name
in
+ let msg = Format_doc.(asprintf "%a" pp_doc) msg in
let warn = Warnings.No_cmi_file(name, Some msg) in
Location.prerr_warning loc warn
@@ -386,20 +387,20 @@ let save_cmi penv psig pm =
)
~exceptionally:(fun () -> remove_file filename)
-let report_error ppf =
- let open Format in
+let report_error_doc ppf =
+ let open Format_doc in
function
| Illegal_renaming(modname, ps_name, filename) -> fprintf ppf
"Wrong file naming: %a@ contains the compiled interface for@ \
%a when %a was expected"
- (Style.as_inline_code Location.print_filename) filename
+ Location.Doc.quoted_filename filename
Style.inline_code ps_name
Style.inline_code modname
| Inconsistent_import(name, source1, source2) -> fprintf ppf
"@[<hov>The files %a@ and %a@ \
make inconsistent assumptions@ over interface %a@]"
- (Style.as_inline_code Location.print_filename) source1
- (Style.as_inline_code Location.print_filename) source2
+ Location.Doc.quoted_filename source1
+ Location.Doc.quoted_filename source2
Style.inline_code name
| Need_recursive_types(import) ->
fprintf ppf
@@ -408,13 +409,6 @@ let report_error ppf =
Style.inline_code import
Style.inline_code "-rectypes"
-let () =
- Location.register_error_of_exn
- (function
- | Error err ->
- Some (Location.error_of_printer_file report_error err)
- | _ -> None
- )
(* helper for merlin *)
@@ -429,3 +423,13 @@ let forall ~found ~missing t =
| Found (pers_struct, a) ->
found name pers_struct.ps_filename pers_struct.ps_name a
)
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err ->
+ Some (Location.error_of_printer_file report_error_doc err)
+ | _ -> None
+ )
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/src/ocaml/typing/persistent_env.mli b/src/ocaml/typing/persistent_env.mli
index 1acb5b3d65..a622cd02e7 100644
--- a/src/ocaml/typing/persistent_env.mli
+++ b/src/ocaml/typing/persistent_env.mli
@@ -27,7 +27,8 @@ type error =
exception Error of error
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
module Persistent_signature : sig
type t =
diff --git a/src/ocaml/typing/predef.ml b/src/ocaml/typing/predef.ml
index 7344be15fc..e7b24bd8fe 100644
--- a/src/ocaml/typing/predef.ml
+++ b/src/ocaml/typing/predef.ml
@@ -35,6 +35,8 @@ and ident_float = ident_create "float"
and ident_bool = ident_create "bool"
and ident_unit = ident_create "unit"
and ident_exn = ident_create "exn"
+and ident_eff = ident_create "eff"
+and ident_continuation = ident_create "continuation"
and ident_array = ident_create "array"
and ident_list = ident_create "list"
and ident_option = ident_create "option"
@@ -53,6 +55,8 @@ and path_float = Pident ident_float
and path_bool = Pident ident_bool
and path_unit = Pident ident_unit
and path_exn = Pident ident_exn
+and path_eff = Pident ident_eff
+and path_continuation = Pident ident_continuation
and path_array = Pident ident_array
and path_list = Pident ident_list
and path_option = Pident ident_option
@@ -71,6 +75,9 @@ and type_float = newgenty (Tconstr(path_float, [], ref Mnil))
and type_bool = newgenty (Tconstr(path_bool, [], ref Mnil))
and type_unit = newgenty (Tconstr(path_unit, [], ref Mnil))
and type_exn = newgenty (Tconstr(path_exn, [], ref Mnil))
+and type_eff t = newgenty (Tconstr(path_eff, [t], ref Mnil))
+and type_continuation t1 t2 =
+ newgenty (Tconstr(path_continuation, [t1; t2], ref Mnil))
and type_array t = newgenty (Tconstr(path_array, [t], ref Mnil))
and type_list t = newgenty (Tconstr(path_list, [t], ref Mnil))
and type_option t = newgenty (Tconstr(path_option, [t], ref Mnil))
@@ -96,6 +103,8 @@ and ident_sys_blocked_io = ident_create "Sys_blocked_io"
and ident_assert_failure = ident_create "Assert_failure"
and ident_undefined_recursive_module =
ident_create "Undefined_recursive_module"
+and ident_continuation_already_taken = ident_create "Continuation_already_taken"
+
let all_predef_exns = [
ident_match_failure;
@@ -110,6 +119,7 @@ let all_predef_exns = [
ident_sys_blocked_io;
ident_assert_failure;
ident_undefined_recursive_module;
+ ident_continuation_already_taken;
]
let path_match_failure = Pident ident_match_failure
@@ -178,6 +188,28 @@ let build_initial_env add_type add_extension empty_env =
}
in
add_type type_ident decl env
+ and add_continuation type_ident env =
+ let tvar1 = newgenvar() in
+ let tvar2 = newgenvar() in
+ let arity = 2 in
+ let decl =
+ {type_params = [tvar1; tvar2];
+ type_arity = arity;
+ type_kind = Type_abstract Definition;
+ type_loc = Location.none;
+ type_private = Asttypes.Public;
+ type_manifest = None;
+ type_variance = [Variance.contravariant; Variance.covariant];
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = lowest_level;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.of_predef_id type_ident;
+ }
+ in
+ add_type type_ident decl env
in
let add_extension id l =
add_extension id
@@ -204,6 +236,11 @@ let build_initial_env add_type add_extension empty_env =
~kind:(variant [cstr ident_false []; cstr ident_true []])
|> add_type ident_char ~immediate:Always
|> add_type ident_exn ~kind:Type_open
+ |> add_type1 ident_eff
+ ~variance:Variance.full
+ ~separability:Separability.Ind
+ ~kind:(fun _ -> Type_open)
+ |> add_continuation ident_continuation
|> add_type ident_extension_constructor
|> add_type ident_float
|> add_type ident_floatarray
@@ -245,6 +282,7 @@ let build_initial_env add_type add_extension empty_env =
|> add_extension ident_sys_error [type_string]
|> add_extension ident_undefined_recursive_module
[newgenty (Ttuple[type_string; type_int; type_int])]
+ |> add_extension ident_continuation_already_taken []
let builtin_values =
List.map (fun id -> (Ident.name id, id)) all_predef_exns
diff --git a/src/ocaml/typing/predef.mli b/src/ocaml/typing/predef.mli
index ff67206f62..f2c75be0dc 100644
--- a/src/ocaml/typing/predef.mli
+++ b/src/ocaml/typing/predef.mli
@@ -27,6 +27,8 @@ val type_float: type_expr
val type_bool: type_expr
val type_unit: type_expr
val type_exn: type_expr
+val type_eff: type_expr -> type_expr
+val type_continuation: type_expr -> type_expr -> type_expr
val type_array: type_expr -> type_expr
val type_list: type_expr -> type_expr
val type_option: type_expr -> type_expr
@@ -45,6 +47,7 @@ val path_float: Path.t
val path_bool: Path.t
val path_unit: Path.t
val path_exn: Path.t
+val path_eff: Path.t
val path_array: Path.t
val path_list: Path.t
val path_option: Path.t
@@ -54,6 +57,7 @@ val path_int64: Path.t
val path_lazy_t: Path.t
val path_extension_constructor: Path.t
val path_floatarray: Path.t
+val path_continuation: Path.t
val path_match_failure: Path.t
val path_assert_failure : Path.t
diff --git a/src/ocaml/typing/primitive.ml b/src/ocaml/typing/primitive.ml
index f8e964cce1..a0cb5d712b 100644
--- a/src/ocaml/typing/primitive.ml
+++ b/src/ocaml/typing/primitive.ml
@@ -232,16 +232,16 @@ module Style = Misc.Style
let report_error ppf err =
match err with
| Old_style_float_with_native_repr_attribute ->
- Format.fprintf ppf "Cannot use %a in conjunction with %a/%a."
+ Format_doc.fprintf ppf "Cannot use %a in conjunction with %a/%a."
Style.inline_code "float"
Style.inline_code "[@unboxed]"
Style.inline_code "[@untagged]"
| Old_style_noalloc_with_noalloc_attribute ->
- Format.fprintf ppf "Cannot use %a in conjunction with %a."
+ Format_doc.fprintf ppf "Cannot use %a in conjunction with %a."
Style.inline_code "noalloc"
Style.inline_code "[@@noalloc]"
| No_native_primitive_with_repr_attribute ->
- Format.fprintf ppf
+ Format_doc.fprintf ppf
"@[The native code version of the primitive is mandatory@ \
when attributes %a or %a are present.@]"
Style.inline_code "[@untagged]"
diff --git a/src/ocaml/typing/printpat.ml b/src/ocaml/typing/printpat.ml
index bc3578ce41..d4897294d0 100644
--- a/src/ocaml/typing/printpat.ml
+++ b/src/ocaml/typing/printpat.ml
@@ -18,7 +18,7 @@
open Asttypes
open Typedtree
open Types
-open Format
+open Format_doc
let is_cons = function
| {cstr_name = "::"} -> true
@@ -99,7 +99,7 @@ let rec pretty_val : type k . _ -> k general_pattern -> _ = fun ppf v ->
| Tpat_lazy v ->
fprintf ppf "@[<2>lazy@ %a@]" pretty_arg v
| Tpat_alias (v, x,_,_) ->
- fprintf ppf "@[(%a@ as %a)@]" pretty_val v Ident.print x
+ fprintf ppf "@[(%a@ as %a)@]" pretty_val v Ident.doc_print x
| Tpat_value v ->
fprintf ppf "%a" pretty_val (v :> pattern)
| Tpat_exception v ->
@@ -144,20 +144,30 @@ and pretty_lvals ppf = function
fprintf ppf "%s=%a;@ %a"
lbl.lbl_name pretty_val v pretty_lvals rest
+let top_pretty ppf v =
+ fprintf ppf "@[%a@]" pretty_val v
+
let pretty_pat ppf p =
- fprintf ppf "@[%a@]" pretty_val p
+ top_pretty ppf p ;
+ pp_print_flush ppf ()
type 'k matrix = 'k general_pattern list list
let pretty_line ppf line =
- Format.fprintf ppf "@[";
+ fprintf ppf "@[";
List.iter (fun p ->
- Format.fprintf ppf "<%a>@ "
- pretty_val p
- ) line;
- Format.fprintf ppf "@]"
+ fprintf ppf "<%a>@ "
+ pretty_val p
+ ) line;
+ fprintf ppf "@]"
let pretty_matrix ppf (pss : 'k matrix) =
- Format.fprintf ppf "@[<v 2> %a@]"
- (Format.pp_print_list ~pp_sep:Format.pp_print_cut pretty_line)
+ fprintf ppf "@[<v 2> %a@]"
+ (pp_print_list ~pp_sep:pp_print_cut pretty_line)
pss
+
+module Compat = struct
+ let pretty_pat ppf x = compat pretty_pat ppf x
+ let pretty_line ppf x = compat pretty_line ppf x
+ let pretty_matrix ppf x = compat pretty_matrix ppf x
+end
diff --git a/src/ocaml/typing/printpat.mli b/src/ocaml/typing/printpat.mli
index 1f03508c2d..2d9a93ce6d 100644
--- a/src/ocaml/typing/printpat.mli
+++ b/src/ocaml/typing/printpat.mli
@@ -17,11 +17,12 @@
val pretty_const
: Asttypes.constant -> string
-val pretty_val : Format.formatter -> 'k Typedtree.general_pattern -> unit
-val pretty_pat
- : Format.formatter -> 'k Typedtree.general_pattern -> unit
-val pretty_line
- : Format.formatter -> 'k Typedtree.general_pattern list -> unit
-val pretty_matrix
- : Format.formatter -> 'k Typedtree.general_pattern list list -> unit
+val top_pretty: 'k Typedtree.general_pattern Format_doc.printer
+
+module Compat: sig
+ val pretty_pat: Format.formatter -> 'k Typedtree.general_pattern -> unit
+ val pretty_line: Format.formatter -> 'k Typedtree.general_pattern list -> unit
+ val pretty_matrix:
+ Format.formatter -> 'k Typedtree.general_pattern list list -> unit
+end
diff --git a/src/ocaml/typing/printtyp.ml b/src/ocaml/typing/printtyp.ml
index 833db2360a..85eed321f1 100644
--- a/src/ocaml/typing/printtyp.ml
+++ b/src/ocaml/typing/printtyp.ml
@@ -15,2664 +15,65 @@
(* Printing functions *)
-module M = Misc.String.Map
-module S = Misc.String.Set
+module Fmt = Format_doc
+module Doc = Printtyp_doc
-open Misc
-open Ctype
-open Format
-open Longident
-open Path
-open Asttypes
-open Types
-open Btype
-open Outcometree
-
-module Sig_component_kind = Shape.Sig_component_kind
-module Style = Misc.Style
+include Doc
(* Print a long identifier *)
let longident = Pprintast.longident
-
-let () = Env.print_longident := longident
-
-(* Print an identifier avoiding name collisions *)
-
-module Out_name = struct
- let create x = { printed_name = x }
- let print x = x.printed_name
-end
-
-(** Some identifiers may require hiding when printing *)
-type bound_ident = { hide:bool; ident:Ident.t }
-
-(* printing environment for path shortening and naming *)
-let printing_env = ref Env.empty
-
-(* When printing, it is important to only observe the
- current printing environment, without reading any new
- cmi present on the file system *)
-let in_printing_env f = Env.without_cmis f !printing_env
-
- type namespace = Shape.Sig_component_kind.t =
- | Value
- | Type
- | Constructor
- | Label
- | Module
- | Module_type
- | Extension_constructor
- | Class
- | Class_type
-
-
-module Namespace = struct
-
- let id = function
- | Type -> 0
- | Module -> 1
- | Module_type -> 2
- | Class -> 3
- | Class_type -> 4
- | Extension_constructor | Value | Constructor | Label -> 5
- (* we do not handle those component *)
-
- let size = 1 + id Value
-
-
- let pp ppf x =
- Format.pp_print_string ppf (Shape.Sig_component_kind.to_string x)
-
- let lookup =
- let to_lookup f lid = fst @@ in_printing_env (f (Lident lid)) in
- function
- | Some Type -> to_lookup Env.find_type_by_name
- | Some Module -> to_lookup Env.find_module_by_name
- | Some Module_type -> to_lookup Env.find_modtype_by_name
- | Some Class -> to_lookup Env.find_class_by_name
- | Some Class_type -> to_lookup Env.find_cltype_by_name
- | None | Some(Value|Extension_constructor|Constructor|Label) ->
- fun _ -> raise Not_found
-
- let location namespace id =
- let path = Path.Pident id in
- try Some (
- match namespace with
- | Some Type -> (in_printing_env @@ Env.find_type path).type_loc
- | Some Module -> (in_printing_env @@ Env.find_module path).md_loc
- | Some Module_type -> (in_printing_env @@ Env.find_modtype path).mtd_loc
- | Some Class -> (in_printing_env @@ Env.find_class path).cty_loc
- | Some Class_type -> (in_printing_env @@ Env.find_cltype path).clty_loc
- | Some (Extension_constructor|Value|Constructor|Label) | None ->
- Location.none
- ) with Not_found -> None
-
- let best_class_namespace = function
- | Papply _ | Pdot _ -> Some Module
- | Pextra_ty _ -> assert false (* Only in type path *)
- | Pident c ->
- match location (Some Class) c with
- | Some _ -> Some Class
- | None -> Some Class_type
-
-end
-
-(** {2 Conflicts printing}
- Conflicts arise when multiple items are attributed the same name,
- the following module stores the global conflict references and
- provides the printing functions for explaining the source of
- the conflicts.
-*)
-module Conflicts = struct
- type explanation =
- { kind: namespace; name:string; root_name:string; location:Location.t}
- let explanations = ref M.empty
-
- let add namespace name id =
- match Namespace.location (Some namespace) id with
- | None -> ()
- | Some location ->
- let explanation =
- { kind = namespace; location; name; root_name=Ident.name id}
- in
- explanations := M.add name explanation !explanations
-
- let collect_explanation namespace id ~name =
- let root_name = Ident.name id in
- (* if [name] is of the form "root_name/%d", we register both
- [id] and the identifier in scope for [root_name].
- *)
- if root_name <> name && not (M.mem name !explanations) then
- begin
- add namespace name id;
- if not (M.mem root_name !explanations) then
- (* lookup the identifier in scope with name [root_name] and
- add it too
- *)
- match Namespace.lookup (Some namespace) root_name with
- | Pident root_id -> add namespace root_name root_id
- | exception Not_found | _ -> ()
- end
-
- let pp_explanation ppf r=
- Format.fprintf ppf "@[<v 2>%a:@,Definition of %s %a@]"
- Location.print_loc r.location (Sig_component_kind.to_string r.kind)
- Style.inline_code r.name
-
- let print_located_explanations ppf l =
- Format.fprintf ppf "@[<v>%a@]" (Format.pp_print_list pp_explanation) l
-
- let reset () = explanations := M.empty
- let list_explanations () =
- let c = !explanations in
- reset ();
- c |> M.bindings |> List.map snd |> List.sort Stdlib.compare
-
-
- let print_toplevel_hint ppf l =
- let conj ppf () = Format.fprintf ppf " and@ " in
- let pp_namespace_plural ppf n = Format.fprintf ppf "%as" Namespace.pp n in
- let root_names = List.map (fun r -> r.kind, r.root_name) l in
- let unique_root_names = List.sort_uniq Stdlib.compare root_names in
- let submsgs = Array.make Namespace.size [] in
- let () = List.iter (fun (n,_ as x) ->
- submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
- ) unique_root_names in
- let pp_submsg ppf names =
- match names with
- | [] -> ()
- | [namespace, a] ->
- Format.fprintf ppf
- "@ \
- @[<2>@{<hint>Hint@}: The %a %a has been defined multiple times@ \
- in@ this@ toplevel@ session.@ \
- Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
- @ Did you try to redefine them?@]"
- Namespace.pp namespace
- Style.inline_code a Namespace.pp namespace
- | (namespace, _) :: _ :: _ ->
- Format.fprintf ppf
- "@ \
- @[<2>@{<hint>Hint@}: The %a %a have been defined multiple times@ \
- in@ this@ toplevel@ session.@ \
- Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
- @ Did you try to redefine them?@]"
- pp_namespace_plural namespace
- Format.(pp_print_list ~pp_sep:conj Style.inline_code)
- (List.map snd names)
- pp_namespace_plural namespace in
- Array.iter (pp_submsg ppf) submsgs
-
- let print_explanations ppf =
- let ltop, l =
- (* isolate toplevel locations, since they are too imprecise *)
- let from_toplevel a =
- a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
- List.partition from_toplevel (list_explanations ())
- in
- begin match l with
- | [] -> ()
- | l -> Format.fprintf ppf "@,%a" print_located_explanations l
- end;
- (* if there are name collisions in a toplevel session,
- display at least one generic hint by namespace *)
- print_toplevel_hint ppf ltop
-
- let exists () = M.cardinal !explanations >0
-end
-
-module Naming_context = struct
-
-let enabled = ref true
-let enable b = enabled := b
-
-(* Names bound in recursive definitions should be considered as bound
- in the environment when printing identifiers but not when trying
- to find shortest path.
- For instance, if we define
- [{
- module Avoid__me = struct
- type t = A
- end
- type t = X
- type u = [` A of t * t ]
- module M = struct
- type t = A of [ u | `B ]
- type r = Avoid__me.t
- end
- }]
- It is is important that in the definition of [t] that the outer type [t] is
- printed as [t/2] reserving the name [t] to the type being defined in the
- current recursive definition.
- Contrarily, in the definition of [r], one should not shorten the
- path [Avoid__me.t] to [r] until the end of the definition of [r].
- The [bound_in_recursion] bridges the gap between those two slightly different
- notions of printing environment.
-*)
-let bound_in_recursion = ref M.empty
-
-(* When dealing with functor arguments, identity becomes fuzzy because the same
- syntactic argument may be represented by different identifiers during the
- error processing, we are thus disabling disambiguation on the argument name
-*)
-let fuzzy = ref S.empty
-let with_arg id f =
- protect_refs [ R(fuzzy, S.add (Ident.name id) !fuzzy) ] f
-let fuzzy_id namespace id = namespace = Module && S.mem (Ident.name id) !fuzzy
-
-let with_hidden ids f =
- let update m id = M.add (Ident.name id.ident) id.ident m in
- let updated = List.fold_left update !bound_in_recursion ids in
- protect_refs [ R(bound_in_recursion, updated )] f
-
-let human_id id index =
- (* The identifier with index [k] is the (k+1)-th most recent identifier in
- the printing environment. We print them as [name/(k+1)] except for [k=0]
- which is printed as [name] rather than [name/1].
- *)
- if index = 0 then
- Ident.name id
- else
- let ordinal = index + 1 in
- String.concat "/" [Ident.name id; string_of_int ordinal]
-
-let indexed_name namespace id =
- let find namespace id env = match namespace with
- | Type -> Env.find_type_index id env
- | Module -> Env.find_module_index id env
- | Module_type -> Env.find_modtype_index id env
- | Class -> Env.find_class_index id env
- | Class_type-> Env.find_cltype_index id env
- | Value | Extension_constructor | Constructor | Label -> None
- in
- let index =
- match M.find_opt (Ident.name id) !bound_in_recursion with
- | Some rec_bound_id ->
- (* the identifier name appears in the current group of recursive
- definition *)
- if Ident.same rec_bound_id id then
- Some 0
- else
- (* the current recursive definition shadows one more time the
- previously existing identifier with the same name *)
- Option.map succ (in_printing_env (find namespace id))
- | None ->
- in_printing_env (find namespace id)
- in
- let index =
- (* If [index] is [None] at this point, it might indicate that
- the identifier id is not defined in the environment, while there
- are other identifiers in scope that share the same name.
- Currently, this kind of partially incoherent environment happens
- within functor error messages where the left and right hand side
- have a different views of the environment at the source level.
- Printing the source-level by using a default index of `0`
- seems like a reasonable compromise in this situation however.*)
- Option.value index ~default:0
- in
- human_id id index
-
-let ident_name namespace id =
- match namespace, !enabled with
- | None, _ | _, false -> Out_name.create (Ident.name id)
- | Some namespace, true ->
- if fuzzy_id namespace id then Out_name.create (Ident.name id)
- else
- let name = indexed_name namespace id in
- Conflicts.collect_explanation namespace id ~name;
- Out_name.create name
-end
-let ident_name = Naming_context.ident_name
-
-let ident ppf id = pp_print_string ppf
- (Out_name.print (Naming_context.ident_name None id))
-
-let namespaced_ident namespace id =
- Out_name.print (Naming_context.ident_name (Some namespace) id)
-
-
-(* Print a path *)
-
-let ident_stdlib = Ident.create_persistent "Stdlib"
-
-let non_shadowed_stdlib namespace = function
- | Pdot(Pident id, s) as path ->
- Ident.same id ident_stdlib &&
- (match Namespace.lookup namespace s with
- | path' -> Path.same path path'
- | exception Not_found -> true)
- | _ -> false
-
-let find_double_underscore s =
- let len = String.length s in
- let rec loop i =
- if i + 1 >= len then
- None
- else if s.[i] = '_' && s.[i + 1] = '_' then
- Some i
- else
- loop (i + 1)
- in
- loop 0
-
-let rec module_path_is_an_alias_of env path ~alias_of =
- match Env.find_module path env with
- | { md_type = Mty_alias path'; _ } ->
- Path.same path' alias_of ||
- module_path_is_an_alias_of env path' ~alias_of
- | _ -> false
- | exception Not_found -> false
-
-(* Simple heuristic to print Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
- for Foo__bar. This pattern is used by the stdlib. *)
-let rec rewrite_double_underscore_paths env p =
- match p with
- | Pdot (p, s) ->
- Pdot (rewrite_double_underscore_paths env p, s)
- | Papply (a, b) ->
- Papply (rewrite_double_underscore_paths env a,
- rewrite_double_underscore_paths env b)
- | Pextra_ty (p, extra) ->
- Pextra_ty (rewrite_double_underscore_paths env p, extra)
- | Pident id ->
- let name = Ident.name id in
- match find_double_underscore name with
- | None -> p
- | Some i ->
- let better_lid =
- Ldot
- (Lident (String.sub name 0 i),
- Unit_info.modulize
- (String.sub name (i + 2) (String.length name - i - 2)))
- in
- match Env.find_module_by_name better_lid env with
- | exception Not_found -> p
- | p', _ ->
- if module_path_is_an_alias_of env p' ~alias_of:p then
- p'
- else
- p
-
-let rewrite_double_underscore_paths env p =
- if env == Env.empty then
- p
- else
- rewrite_double_underscore_paths env p
-
-let rec tree_of_path ?(disambiguation=true) namespace p =
- let tree_of_path namespace p = tree_of_path ~disambiguation namespace p in
- let namespace = if disambiguation then namespace else None in
- match p with
- | Pident id ->
- Oide_ident (ident_name namespace id)
- | Pdot(_, s) as path when non_shadowed_stdlib namespace path ->
- Oide_ident (Out_name.create s)
- | Pdot(p, s) ->
- Oide_dot (tree_of_path (Some Module) p, s)
- | Papply(p1, p2) ->
- let t1 = tree_of_path (Some Module) p1 in
- let t2 = tree_of_path (Some Module) p2 in
- Oide_apply (t1, t2)
- | Pextra_ty (p, extra) -> begin
- (* inline record types are syntactically prevented from escaping their
- binding scope, and are never shown to users. *)
- match extra with
- Pcstr_ty s ->
- Oide_dot (tree_of_path (Some Type) p, s)
- | Pext_ty ->
- tree_of_path None p
- end
-
-let tree_of_path ?disambiguation namespace p =
- tree_of_path ?disambiguation namespace
- (rewrite_double_underscore_paths !printing_env p)
-
-let path ppf p =
- !Oprint.out_ident ppf (tree_of_path None p)
-
-let string_of_path p =
- Format.asprintf "%a" path p
-
-let strings_of_paths namespace p =
- let trees = List.map (tree_of_path namespace) p in
- List.map (Format.asprintf "%a" !Oprint.out_ident) trees
-
-let () = Env.print_path := path
-
-(* Print a recursive annotation *)
-
-let tree_of_rec = function
- | Trec_not -> Orec_not
- | Trec_first -> Orec_first
- | Trec_next -> Orec_next
-
-(* Print a raw type expression, with sharing *)
-
-let raw_list pr ppf = function
- [] -> fprintf ppf "[]"
- | a :: l ->
- fprintf ppf "@[<1>[%a%t]@]" pr a
- (fun ppf -> List.iter (fun x -> fprintf ppf ";@,%a" pr x) l)
-
-let kind_vars = ref []
-let kind_count = ref 0
-
-let string_of_field_kind v =
- match field_kind_repr v with
- | Fpublic -> "Fpublic"
- | Fabsent -> "Fabsent"
- | Fprivate -> "Fprivate"
-
-let rec safe_repr v t =
- match Transient_expr.coerce t with
- {desc = Tlink t} when not (List.memq t v) ->
- safe_repr (t::v) t
- | t' -> t'
-
-let rec list_of_memo = function
- Mnil -> []
- | Mcons (_priv, p, _t1, _t2, rem) -> p :: list_of_memo rem
- | Mlink rem -> list_of_memo !rem
-
-let print_name ppf = function
- None -> fprintf ppf "None"
- | Some name -> fprintf ppf "\"%s\"" name
-
-let string_of_label = function
- Nolabel -> ""
- | Labelled s -> s
- | Optional s -> "?"^s
-
-let visited = ref []
-let rec raw_type ppf ty =
- let ty = safe_repr [] ty in
- if List.memq ty !visited then fprintf ppf "{id=%d}" ty.id else begin
- visited := ty :: !visited;
- fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;desc=@,%a}@]" ty.id ty.level
- ty.scope raw_type_desc ty.desc
- end
-and raw_type_list tl = raw_list raw_type tl
-and raw_lid_type_list tl =
- raw_list (fun ppf (lid, typ) ->
- fprintf ppf "(@,%a,@,%a)" longident lid raw_type typ)
- tl
-and raw_type_desc ppf = function
- Tvar name -> fprintf ppf "Tvar %a" print_name name
- | Tarrow(l,t1,t2,c) ->
- fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
- (string_of_label l) raw_type t1 raw_type t2
- (if is_commu_ok c then "Cok" else "Cunknown")
- | Ttuple tl ->
- fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
- | Tconstr (p, tl, abbrev) ->
- fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p
- raw_type_list tl
- (raw_list path) (list_of_memo !abbrev)
- | Tobject (t, nm) ->
- fprintf ppf "@[<hov1>Tobject(@,%a,@,@[<1>ref%t@])@]" raw_type t
- (fun ppf ->
- match !nm with None -> fprintf ppf " None"
- | Some(p,tl) ->
- fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
- | Tfield (f, k, t1, t2) ->
- fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
- (string_of_field_kind k)
- raw_type t1 raw_type t2
- | Tnil -> fprintf ppf "Tnil"
- | Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
- | Tsubst (t, None) -> fprintf ppf "@[<1>Tsubst@,(%a,None)@]" raw_type t
- | Tsubst (t, Some t') ->
- fprintf ppf "@[<1>Tsubst@,(%a,@ Some%a)@]" raw_type t raw_type t'
- | Tunivar name -> fprintf ppf "Tunivar %a" print_name name
- | Tpoly (t, tl) ->
- fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
- raw_type t
- raw_type_list tl
- | Tvariant row ->
- let Row {fields; more; name; fixed; closed} = row_repr row in
- fprintf ppf
- "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
- "row_fields="
- (raw_list (fun ppf (l, f) ->
- fprintf ppf "@[%s,@ %a@]" l raw_field f))
- fields
- "row_more=" raw_type more
- "row_closed=" closed
- "row_fixed=" raw_row_fixed fixed
- "row_name="
- (fun ppf ->
- match name with None -> fprintf ppf "None"
- | Some(p,tl) ->
- fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
- | Tpackage (p, fl) ->
- fprintf ppf "@[<hov1>Tpackage(@,%a,@,%a)@]" path p raw_lid_type_list fl
-
-and raw_row_fixed ppf = function
-| None -> fprintf ppf "None"
-| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private"
-| Some Types.Rigid -> fprintf ppf "Some Rigid"
-| Some Types.Univar t -> fprintf ppf "Some(Univar(%a))" raw_type t
-| Some Types.Reified p -> fprintf ppf "Some(Reified(%a))" path p
-
-and raw_field ppf rf =
- match_row_field
- ~absent:(fun _ -> fprintf ppf "RFabsent")
- ~present:(function
- | None ->
- fprintf ppf "RFpresent None"
- | Some t ->
- fprintf ppf "@[<1>RFpresent(Some@,%a)@]" raw_type t)
- ~either:(fun c tl m e ->
- fprintf ppf "@[<hov1>RFeither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
- raw_type_list tl m
- (fun ppf ->
- match e with None -> fprintf ppf " RFnone"
- | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f))
- rf
-
-let raw_type_expr ppf t =
- visited := []; kind_vars := []; kind_count := 0;
- raw_type ppf t;
- visited := []; kind_vars := []
-
-let () = Btype.print_raw := raw_type_expr
-
-(* Normalize paths *)
-
-let set_printing_env env =
- printing_env :=
- if !Clflags.real_paths then Env.empty
- else env
-
-let wrap_printing_env env f =
- set_printing_env (Env.update_short_paths env);
- try_finally f ~always:(fun () -> set_printing_env Env.empty)
-
-let wrap_printing_env ?error:_ env f =
- Env.without_cmis (wrap_printing_env env) f
-
-type type_result = Short_paths.type_result =
- | Nth of int
- | Path of int list option * Path.t
-
-type type_resolution = Short_paths.type_resolution =
- | Nth of int
- | Subst of int list
- | Id
-
-let apply_subst ns args =
- List.map (List.nth args) ns
-
-let apply_subst_opt nso args =
- match nso with
- | None -> args
- | Some ns -> apply_subst ns args
-
-let apply_nth n args =
- List.nth args n
-
-let best_type_path p =
- if !Clflags.real_paths || !printing_env == Env.empty
- then Path(None, p)
- else Short_paths.find_type (Env.short_paths !printing_env) p
-
-let best_type_path_resolution p =
- if !Clflags.real_paths || !printing_env == Env.empty
- then Id
- else Short_paths.find_type_resolution (Env.short_paths !printing_env) p
-
-let best_type_path_simple p =
- if !Clflags.real_paths || !printing_env == Env.empty
- then p
- else Short_paths.find_type_simple (Env.short_paths !printing_env) p
-
-let best_module_type_path p =
- if !Clflags.real_paths || !printing_env == Env.empty
- then p
- else Short_paths.find_module_type (Env.short_paths !printing_env) p
-
-let best_module_path p =
- if !Clflags.real_paths || !printing_env == Env.empty
- then p
- else Short_paths.find_module (Env.short_paths !printing_env) p
-
-let best_class_type_path p =
- if !Clflags.real_paths || !printing_env == Env.empty
- then None, p
- else Short_paths.find_class_type (Env.short_paths !printing_env) p
-
-let best_class_type_path_simple p =
- if !Clflags.real_paths || !printing_env == Env.empty
- then p
- else Short_paths.find_class_type_simple (Env.short_paths !printing_env) p
-
-(* When building a tree for a best type path, we should not disambiguate
- identifiers whenever the short-path algorithm detected a better path than
- the original one.*)
-let tree_of_best_type_path p p' =
- if Path.same p p' then tree_of_path (Some Type) p'
- else tree_of_path ~disambiguation:false None p'
-
-(* Print a type expression *)
-
-let proxy ty = Transient_expr.repr (proxy ty)
-
-(* When printing a type scheme, we print weak names. When printing a plain
- type, we do not. This type controls that behavior *)
-type type_or_scheme = Type | Type_scheme
-
-let is_non_gen mode ty =
- match mode with
- | Type_scheme -> is_Tvar ty && get_level ty <> generic_level
- | Type -> false
-
-let nameable_row row =
- row_name row <> None &&
- List.for_all
- (fun (_, f) ->
- match row_field_repr f with
- | Reither(c, l, _) ->
- row_closed row && if c then l = [] else List.length l = 1
- | _ -> true)
- (row_fields row)
-
-(* This specialized version of [Btype.iter_type_expr] normalizes and
- short-circuits the traversal of the [type_expr], so that it covers only the
- subterms that would be printed by the type printer. *)
-let printer_iter_type_expr f ty =
- match get_desc ty with
- | Tconstr(p, tyl, _) -> begin
- match best_type_path_resolution p with
- | Nth n ->
- f (apply_nth n tyl)
- | Subst ns ->
- List.iter f (apply_subst ns tyl)
- | Id ->
- List.iter f tyl
- end
- | Tvariant row -> begin
- match row_name row with
- | Some(_p, tyl) when nameable_row row ->
- List.iter f tyl
- | _ ->
- iter_row f row
- end
- | Tobject (fi, nm) -> begin
- match !nm with
- | None ->
- let fields, _ = flatten_fields fi in
- List.iter
- (fun (_, kind, ty) ->
- if field_kind_repr kind = Fpublic then
- f ty)
- fields
- | Some (_, l) ->
- List.iter f (List.tl l)
- end
- | Tfield(_, kind, ty1, ty2) ->
- if field_kind_repr kind = Fpublic then
- f ty1;
- f ty2
- | _ ->
- Btype.iter_type_expr f ty
-
-module Internal_names : sig
-
- val reset : unit -> unit
-
- val add : Path.t -> unit
-
- val print_explanations : Env.t -> Format.formatter -> unit
-
-end = struct
-
- let names = ref Ident.Set.empty
-
- let reset () =
- names := Ident.Set.empty
-
- let add p =
- match p with
- | Pident id ->
- let name = Ident.name id in
- if String.length name > 0 && name.[0] = '$' then begin
- names := Ident.Set.add id !names
- end
- | Pdot _ | Papply _ | Pextra_ty _ -> ()
-
- let print_explanations env ppf =
- let constrs =
- Ident.Set.fold
- (fun id acc ->
- let p = Pident id in
- match Env.find_type p env with
- | exception Not_found -> acc
- | decl ->
- match type_origin decl with
- | Existential constr ->
- let prev = String.Map.find_opt constr acc in
- let prev = Option.value ~default:[] prev in
- String.Map.add constr (tree_of_path None p :: prev) acc
- | Definition | Rec_check_regularity -> acc)
- !names String.Map.empty
- in
- String.Map.iter
- (fun constr out_idents ->
- match out_idents with
- | [] -> ()
- | [out_ident] ->
- fprintf ppf
- "@ @[<2>@{<hint>Hint@}:@ %a@ is an existential type@ \
- bound by the constructor@ %a.@]"
- (Style.as_inline_code !Oprint.out_ident) out_ident
- Style.inline_code constr
- | out_ident :: out_idents ->
- fprintf ppf
- "@ @[<2>@{<hint>Hint@}:@ %a@ and %a@ are existential types@ \
- bound by the constructor@ %a.@]"
- (Format.pp_print_list
- ~pp_sep:(fun ppf () -> fprintf ppf ",@ ")
- (Style.as_inline_code !Oprint.out_ident))
- (List.rev out_idents)
- (Style.as_inline_code !Oprint.out_ident) out_ident
- Style.inline_code constr)
- constrs
-
-end
-
-module Names : sig
- val reset_names : unit -> unit
-
- val add_named_vars : type_expr -> unit
- val add_subst : (type_expr * type_expr) list -> unit
-
- val new_name : unit -> string
- val new_var_name : non_gen:bool -> type_expr -> unit -> string
-
- val name_of_type : (unit -> string) -> transient_expr -> string
- val check_name_of_type : non_gen:bool -> transient_expr -> unit
-
- val remove_names : transient_expr list -> unit
-
- val with_local_names : (unit -> 'a) -> 'a
-
- (* Refresh the weak variable map in the toplevel; for [print_items], which is
- itself for the toplevel *)
- val refresh_weak : unit -> unit
-end = struct
- (* We map from types to names, but not directly; we also store a substitution,
- which maps from types to types. The lookup process is
- "type -> apply substitution -> find name". The substitution is presumed to
- be acyclic. *)
- let names = ref ([] : (transient_expr * string) list)
- let name_subst = ref ([] : (transient_expr * transient_expr) list)
- let name_counter = ref 0
- let named_vars = ref ([] : string list)
- let visited_for_named_vars = ref ([] : transient_expr list)
-
- let weak_counter = ref 1
- let weak_var_map = ref TypeMap.empty
- let named_weak_vars = ref String.Set.empty
-
- let reset_names () =
- names := [];
- name_subst := [];
- name_counter := 0;
- named_vars := [];
- visited_for_named_vars := []
-
- let add_named_var tty =
- match tty.desc with
- Tvar (Some name) | Tunivar (Some name) ->
- if List.mem name !named_vars then () else
- named_vars := name :: !named_vars
- | _ -> ()
-
- let rec add_named_vars ty =
- let tty = Transient_expr.repr ty in
- let px = proxy ty in
- if not (List.memq px !visited_for_named_vars) then begin
- visited_for_named_vars := px :: !visited_for_named_vars;
- match tty.desc with
- | Tvar _ | Tunivar _ ->
- add_named_var tty
- | _ ->
- printer_iter_type_expr add_named_vars ty
- end
-
- let rec substitute ty =
- match List.assq ty !name_subst with
- | ty' -> substitute ty'
- | exception Not_found -> ty
-
- let add_subst subst =
- name_subst :=
- List.map (fun (t1,t2) -> Transient_expr.repr t1, Transient_expr.repr t2)
- subst
- @ !name_subst
-
- let name_is_already_used name =
- List.mem name !named_vars
- || List.exists (fun (_, name') -> name = name') !names
- || String.Set.mem name !named_weak_vars
-
- let rec new_name () =
- let name = Misc.letter_of_int !name_counter in
- incr name_counter;
- if name_is_already_used name then new_name () else name
-
- let rec new_weak_name ty () =
- let name = "weak" ^ Int.to_string !weak_counter in
- incr weak_counter;
- if name_is_already_used name then new_weak_name ty ()
- else begin
- named_weak_vars := String.Set.add name !named_weak_vars;
- weak_var_map := TypeMap.add ty name !weak_var_map;
- name
- end
-
- let new_var_name ~non_gen ty () =
- if non_gen then new_weak_name ty ()
- else new_name ()
-
- let name_of_type name_generator t =
- (* We've already been through repr at this stage, so t is our representative
- of the union-find class. *)
- let t = substitute t in
- try List.assq t !names with Not_found ->
- try TransientTypeMap.find t !weak_var_map with Not_found ->
- let name =
- match t.desc with
- Tvar (Some name) | Tunivar (Some name) ->
- (* Some part of the type we've already printed has assigned another
- * unification variable to that name. We want to keep the name, so
- * try adding a number until we find a name that's not taken. *)
- let available name =
- List.for_all
- (fun (_, name') -> name <> name')
- !names
- in
- if available name then name
- else
- let suffixed i = name ^ Int.to_string i in
- let i = Misc.find_first_mono (fun i -> available (suffixed i)) in
- suffixed i
- | _ ->
- (* No name available, create a new one *)
- name_generator ()
- in
- (* Exception for type declarations *)
- if name <> "_" then names := (t, name) :: !names;
- name
-
- let check_name_of_type ~non_gen px =
- let name_gen = new_var_name ~non_gen (Transient_expr.type_expr px) in
- ignore(name_of_type name_gen px)
-
- let remove_names tyl =
- let tyl = List.map substitute tyl in
- names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
-
- let with_local_names f =
- let old_names = !names in
- let old_subst = !name_subst in
- names := [];
- name_subst := [];
- try_finally
- ~always:(fun () ->
- names := old_names;
- name_subst := old_subst)
- f
-
- let refresh_weak () =
- let refresh t name (m,s) =
- if is_non_gen Type_scheme t then
- begin
- TypeMap.add t name m,
- String.Set.add name s
- end
- else m, s in
- let m, s =
- TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
- named_weak_vars := s;
- weak_var_map := m
-end
-
-let reserve_names ty =
- normalize_type ty;
- Names.add_named_vars ty
-
-let visited_objects = ref ([] : transient_expr list)
-let aliased = ref ([] : transient_expr list)
-let delayed = ref ([] : transient_expr list)
-let printed_aliases = ref ([] : transient_expr list)
-
-(* [printed_aliases] is a subset of [aliased] that records only those aliased
- types that have actually been printed; this allows us to avoid naming loops
- that the user will never see. *)
-
-let add_delayed t =
- if not (List.memq t !delayed) then delayed := t :: !delayed
-
-let is_aliased_proxy px = List.memq px !aliased
-
-let add_alias_proxy px =
- if not (is_aliased_proxy px) then
- aliased := px :: !aliased
-
-let add_alias ty = add_alias_proxy (proxy ty)
-
-let add_printed_alias_proxy ~non_gen px =
- Names.check_name_of_type ~non_gen px;
- printed_aliases := px :: !printed_aliases
-
-let add_printed_alias ty = add_printed_alias_proxy (proxy ty)
-
-let aliasable ty =
- match get_desc ty with
- Tvar _ | Tunivar _ | Tpoly _ -> false
- | Tconstr (p, _, _) -> begin
- match best_type_path_resolution p with
- | Nth _ -> false
- | Subst _ | Id -> true
- end
- | _ -> true
-
-(* let namable_row row =
- row.row_name <> None &&
- List.for_all
- (fun (_, f) ->
- match row_field_repr f with
- | Reither(c, l, _, _) ->
- row.row_closed && if c then l = [] else List.length l = 1
- | _ -> true)
- row.row_fields *)
-let should_visit_object ty =
- match get_desc ty with
- | Tvariant row -> not (static_row row)
- | Tobject _ -> opened_object ty
- | _ -> false
-
-(*let rec mark_loops_rec visited ty =
- let ty = repr ty in
- let px = proxy ty in
- if List.memq px visited && aliasable ty then add_alias px else
- let visited = px :: visited in
- match ty.desc with
- | Tvar _ -> add_named_var ty
- | Tarrow(_, ty1, ty2, _) ->
- mark_loops_rec visited ty1; mark_loops_rec visited ty2
- | Ttuple tyl -> List.iter (mark_loops_rec visited) tyl
- | Tconstr(p, tyl, _) -> begin
- match best_type_path_resolution p with
- | Nth n ->
- mark_loops_rec visited (apply_nth n tyl)
- | Subst ns ->
- List.iter (mark_loops_rec visited) (apply_subst ns tyl)
- | Id ->
- List.iter (mark_loops_rec visited) tyl
- end
- | Tpackage (_, fl) ->
- List.iter (fun (_n, ty) -> mark_loops_rec visited ty) fl
- | Tvariant row ->
- if List.memq px !visited_objects then add_alias px else
- begin
- let row = row_repr row in
- if not (static_row row) then
- visited_objects := px :: !visited_objects;
- match row.row_name with
- | Some(_p, tyl) when namable_row row ->
- List.iter (mark_loops_rec visited) tyl
- | _ ->
- iter_row (mark_loops_rec visited) row
- end
- | Tobject (fi, nm) ->
- if List.memq px !visited_objects then add_alias px else
- begin
- if opened_object ty then
- visited_objects := px :: !visited_objects;
- begin match !nm with
- | None ->
- let fields, _ = flatten_fields fi in
- List.iter
- (fun (_, kind, ty) ->
- if field_kind_repr kind = Fpresent then
- mark_loops_rec visited ty)
- fields
- | Some (_, l) ->
- List.iter (mark_loops_rec visited) (List.tl l)
- end
- end
- | Tfield(_, kind, ty1, ty2) when field_kind_repr kind = Fpresent ->
- mark_loops_rec visited ty1; mark_loops_rec visited ty2
- | Tfield(_, _, _, ty2) ->
- mark_loops_rec visited ty2
- | Tnil -> ()
- | Tsubst _ -> () (* we do not print arguments *)
- | Tlink _ -> fatal_error "Printtyp.mark_loops_rec (2)"
- | Tpoly (ty, tyl) ->
- List.iter (fun t -> add_alias t) tyl;
- mark_loops_rec visited ty
- | Tunivar _ -> add_named_var ty *)
-let rec mark_loops_rec visited ty =
- let px = proxy ty in
- if List.memq px visited && aliasable ty then add_alias_proxy px else
- let tty = Transient_expr.repr ty in
- let visited = px :: visited in
- match tty.desc with
- | Tvariant _ | Tobject _ ->
- if List.memq px !visited_objects then add_alias_proxy px else begin
- if should_visit_object ty then
- visited_objects := px :: !visited_objects;
- printer_iter_type_expr (mark_loops_rec visited) ty
- end
- | Tpoly(ty, tyl) ->
- List.iter add_alias tyl;
- mark_loops_rec visited ty
- | _ ->
- printer_iter_type_expr (mark_loops_rec visited) ty
-let mark_loops ty =
- mark_loops_rec [] ty;;
-
-let prepare_type ty =
- reserve_names ty;
- mark_loops ty;;
-
-let reset_loop_marks () =
- visited_objects := []; aliased := []; delayed := []; printed_aliases := []
-
-let reset_except_context () =
- Names.reset_names (); reset_loop_marks (); Internal_names.reset ()
-
-let reset () =
- Conflicts.reset ();
- reset_except_context ()
-
-let prepare_for_printing tyl =
- reset_except_context ();
- List.iter prepare_type tyl
-
-let add_type_to_preparation = prepare_type
-
-(* Disabled in classic mode when printing an unification error *)
-let print_labels = ref true
-
-let alias_nongen_row mode px ty =
- match get_desc ty with
- | Tvariant _ | Tobject _ ->
- if is_non_gen mode (Transient_expr.type_expr px) then
- add_alias_proxy px
- | _ -> ()
-
-let rec tree_of_typexp mode ty =
- let px = proxy ty in
- if List.memq px !printed_aliases && not (List.memq px !delayed) then
- let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
- let name = Names.name_of_type (Names.new_var_name ~non_gen ty) px in
- Otyp_var (non_gen, name) else
-
- let pr_typ () =
- let tty = Transient_expr.repr ty in
- match tty.desc with
- | Tvar _ ->
- let non_gen = is_non_gen mode ty in
- let name_gen = Names.new_var_name ~non_gen ty in
- Otyp_var (non_gen, Names.name_of_type name_gen tty)
- | Tarrow(l, ty1, ty2, _) ->
- let lab =
- if !print_labels || is_optional l then l else Nolabel
- in
- let t1 =
- if is_optional l then
- match get_desc ty1 with
- | Tconstr(path, [ty], _)
- when Path.same path Predef.path_option ->
- tree_of_typexp mode ty
- | _ -> Otyp_stuff "<hidden>"
- else tree_of_typexp mode ty1 in
- Otyp_arrow (lab, t1, tree_of_typexp mode ty2)
- | Ttuple tyl ->
- Otyp_tuple (tree_of_typlist mode tyl)
- | Tconstr(p, tyl, _abbrev) -> begin
- match best_type_path p with
- | Nth n -> tree_of_typexp mode (apply_nth n tyl)
- | Path(nso, p') ->
- Internal_names.add p';
- let tyl' = apply_subst_opt nso tyl in
- Otyp_constr (tree_of_path (Some Type) p', tree_of_typlist mode tyl')
- end
- | Tvariant row ->
- let Row {fields; name; closed; _} = row_repr row in
- let fields =
- if closed then
- List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
- fields
- else fields in
- let present =
- List.filter
- (fun (_, f) ->
- match row_field_repr f with
- | Rpresent _ -> true
- | _ -> false)
- fields in
- let all_present = List.length present = List.length fields in
- begin match name with
- | Some(p, tyl) when nameable_row row ->
- let out_variant =
- match best_type_path p with
- | Nth n -> tree_of_typexp mode (apply_nth n tyl)
- | Path(s, p) ->
- let id = tree_of_path (Some Type) p in
- let args = tree_of_typlist mode (apply_subst_opt s tyl) in
- Otyp_constr (id, args)
- in
- if closed && all_present then
- out_variant
- else
- let tags =
- if all_present then None else Some (List.map fst present) in
- Otyp_variant (Ovar_typ out_variant, closed, tags)
- | _ ->
- let fields = List.map (tree_of_row_field mode) fields in
- let tags =
- if all_present then None else Some (List.map fst present) in
- Otyp_variant (Ovar_fields fields, closed, tags)
- end
- | Tobject (fi, nm) ->
- tree_of_typobject mode fi !nm
- | Tnil | Tfield _ ->
- tree_of_typobject mode ty None
- | Tsubst _ ->
- (* This case should only happen when debugging the compiler *)
- Otyp_stuff "<Tsubst>"
- | Tlink _ ->
- fatal_error "Printtyp.tree_of_typexp"
- | Tpoly (ty, []) ->
- tree_of_typexp mode ty
- | Tpoly (ty, tyl) ->
- (*let print_names () =
- List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
- prerr_string "; " in *)
- if tyl = [] then tree_of_typexp mode ty else begin
- let tyl = List.map Transient_expr.repr tyl in
- let old_delayed = !delayed in
- (* Make the names delayed, so that the real type is
- printed once when used as proxy *)
- List.iter add_delayed tyl;
- let tl = List.map (Names.name_of_type Names.new_name) tyl in
- let tr = Otyp_poly (tl, tree_of_typexp mode ty) in
- (* Forget names when we leave scope *)
- Names.remove_names tyl;
- delayed := old_delayed; tr
- end
- | Tunivar _ ->
- Otyp_var (false, Names.name_of_type Names.new_name tty)
- | Tpackage (p, fl) ->
- let p = best_module_type_path p in
- let fl =
- List.map
- (fun (li, ty) -> (
- String.concat "." (Longident.flatten li),
- tree_of_typexp mode ty
- )) fl in
- Otyp_module (tree_of_path (Some Module_type) p, fl)
- in
- if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
- alias_nongen_row mode px ty;
- if is_aliased_proxy px && aliasable ty then begin
- let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
- add_printed_alias_proxy ~non_gen px;
- (* add_printed_alias chose a name, thus the name generator
- doesn't matter.*)
- let alias = Names.name_of_type (Names.new_var_name ~non_gen ty) px in
- Otyp_alias {non_gen; aliased = pr_typ (); alias } end
- else pr_typ ()
-
-and tree_of_row_field mode (l, f) =
- match row_field_repr f with
- | Rpresent None | Reither(true, [], _) -> (l, false, [])
- | Rpresent(Some ty) -> (l, false, [tree_of_typexp mode ty])
- | Reither(c, tyl, _) ->
- if c (* contradiction: constant constructor with an argument *)
- then (l, true, tree_of_typlist mode tyl)
- else (l, false, tree_of_typlist mode tyl)
- | Rabsent -> (l, false, [] (* actually, an error *))
-
-and tree_of_typlist mode tyl =
- List.map (tree_of_typexp mode) tyl
-
-and tree_of_typobject mode fi nm =
- begin match nm with
- | None ->
- let pr_fields fi =
- let (fields, rest) = flatten_fields fi in
- let present_fields =
- List.fold_right
- (fun (n, k, t) l ->
- match field_kind_repr k with
- | Fpublic -> (n, t) :: l
- | _ -> l)
- fields [] in
- let sorted_fields =
- List.sort
- (fun (n, _) (n', _) -> String.compare n n') present_fields in
- tree_of_typfields mode rest sorted_fields in
- let (fields, open_row) = pr_fields fi in
- Otyp_object {fields; open_row}
- | Some (p, _ty :: tyl) ->
- let args = tree_of_typlist mode tyl in
- let p' = best_type_path_simple p in
- Otyp_class (tree_of_best_type_path p p', args)
- | _ ->
- fatal_error "Printtyp.tree_of_typobject"
- end
-
-and tree_of_typfields mode rest = function
- | [] ->
- let open_row =
- match get_desc rest with
- | Tvar _ | Tunivar _ | Tconstr _-> true
- | Tnil -> false
- | _ -> fatal_error "typfields (1)"
- in
- ([], open_row)
- | (s, t) :: l ->
- let field = (s, tree_of_typexp mode t) in
- let (fields, rest) = tree_of_typfields mode rest l in
- (field :: fields, rest)
-
-let typexp mode ppf ty =
- !Oprint.out_type ppf (tree_of_typexp mode ty)
-
-let prepared_type_expr ppf ty = typexp Type ppf ty
-let prepared_type_scheme ppf ty = typexp Type_scheme ppf ty
-
-let type_expr ppf ty =
- (* [type_expr] is used directly by error message printers,
- we mark eventual loops ourself to avoid any misuse and stack overflow *)
- prepare_for_printing [ty];
- prepared_type_expr ppf ty
-
-(* "Half-prepared" type expression: [ty] should have had its names reserved, but
- should not have had its loops marked. *)
-let type_expr_with_reserved_names ppf ty =
- reset_loop_marks ();
- mark_loops ty;
- prepared_type_expr ppf ty
-
-let shared_type_scheme ppf ty =
- prepare_type ty;
- typexp Type_scheme ppf ty
-
-let type_scheme ppf ty =
- prepare_for_printing [ty];
- prepared_type_scheme ppf ty
-
-let type_path ppf p =
- let p = best_class_type_path_simple p in
- let t = tree_of_path (Some Type) p in
- !Oprint.out_ident ppf t
-
-let tree_of_type_scheme ty =
- prepare_for_printing [ty];
- tree_of_typexp Type_scheme ty
-
-(* Print one type declaration *)
-
-let tree_of_constraints params =
- List.fold_right
- (fun ty list ->
- let ty' = unalias ty in
- if proxy ty != proxy ty' then
- let tr = tree_of_typexp Type_scheme ty in
- (tr, tree_of_typexp Type_scheme ty') :: list
- else list)
- params []
-
-let filter_params tyl =
- let params =
- List.fold_left
- (fun tyl ty ->
- if List.exists (eq_type ty) tyl
- then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
- else ty :: tyl)
- (* Two parameters might be identical due to a constraint but we need to
- print them differently in order to make the output syntactically valid.
- We use [Ttuple [ty]] because it is printed as [ty]. *)
- (* Replacing fold_left by fold_right does not work! *)
- [] tyl
- in List.rev params
-
-let prepare_type_constructor_arguments = function
- | Cstr_tuple l -> List.iter prepare_type l
- | Cstr_record l -> List.iter (fun l -> prepare_type l.ld_type) l
-
-let tree_of_label l =
- (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp Type l.ld_type)
-
-let tree_of_constructor_arguments = function
- | Cstr_tuple l -> tree_of_typlist Type l
- | Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
-
-let tree_of_single_constructor cd =
- let name = Ident.name cd.cd_id in
- let ret = Option.map (tree_of_typexp Type) cd.cd_res in
- let args = tree_of_constructor_arguments cd.cd_args in
- {
- ocstr_name = name;
- ocstr_args = args;
- ocstr_return_type = ret;
- }
-
-(* When printing GADT constructor, we need to forget the naming decision we took
- for the type parameters and constraints. Indeed, in
- {[
- type 'a t = X: 'a -> 'b t
- ]}
- It is fine to print both the type parameter ['a] and the existentially
- quantified ['a] in the definition of the constructor X as ['a]
- *)
-let tree_of_constructor_in_decl cd =
- match cd.cd_res with
- | None -> tree_of_single_constructor cd
- | Some _ -> Names.with_local_names (fun () -> tree_of_single_constructor cd)
-
-let prepare_decl id decl =
- let params = filter_params decl.type_params in
- begin match decl.type_manifest with
- | Some ty ->
- let vars = free_variables ty in
- List.iter
- (fun ty ->
- if get_desc ty = Tvar (Some "_") && List.exists (eq_type ty) vars
- then set_type_desc ty (Tvar None))
- params
- | None -> ()
- end;
- List.iter add_alias params;
- List.iter prepare_type params;
- List.iter (add_printed_alias ~non_gen:false) params;
- let ty_manifest =
- match decl.type_manifest with
- | None -> None
- | Some ty ->
- let ty =
- (* Special hack to hide variant name *)
- match get_desc ty with
- Tvariant row ->
- begin match row_name row with
- Some (Pident id', _) when Ident.same id id' ->
- newgenty (Tvariant (set_row_name row None))
- | _ -> ty
- end
- | _ -> ty
- in
- prepare_type ty;
- Some ty
- in
- begin match decl.type_kind with
- | Type_abstract _ -> ()
- | Type_variant (cstrs, _rep) ->
- List.iter
- (fun c ->
- prepare_type_constructor_arguments c.cd_args;
- Option.iter prepare_type c.cd_res)
- cstrs
- | Type_record(l, _rep) ->
- List.iter (fun l -> prepare_type l.ld_type) l
- | Type_open -> ()
- end;
- ty_manifest, params
-
-let tree_of_type_decl id decl =
- let ty_manifest, params = prepare_decl id decl in
- let type_param ot_variance =
- function
- | Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
- | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
- in
- let type_defined decl =
- let abstr =
- match decl.type_kind with
- Type_abstract _ ->
- decl.type_manifest = None || decl.type_private = Private
- | Type_record _ ->
- decl.type_private = Private
- | Type_variant (tll, _rep) ->
- decl.type_private = Private ||
- List.exists (fun cd -> cd.cd_res <> None) tll
- | Type_open ->
- decl.type_manifest = None
- in
- let vari =
- List.map2
- (fun ty v ->
- let is_var = is_Tvar ty in
- if abstr || not is_var then
- let inj =
- type_kind_is_abstract decl && Variance.mem Inj v &&
- match decl.type_manifest with
- | None -> true
- | Some ty -> (* only abstract or private row types *)
- decl.type_private = Private &&
- Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
- and (co, cn) = Variance.get_upper v in
- (if not cn then Covariant else
- if not co then Contravariant else NoVariance),
- (if inj then Injective else NoInjectivity)
- else (NoVariance, NoInjectivity))
- decl.type_params decl.type_variance
- in
- (Ident.name id,
- List.map2 (fun ty cocn -> type_param cocn (tree_of_typexp Type ty))
- params vari)
- in
- let tree_of_manifest ty1 =
- match ty_manifest with
- | None -> ty1
- | Some ty -> Otyp_manifest (tree_of_typexp Type ty, ty1)
- in
- let (name, args) = type_defined decl in
- let constraints = tree_of_constraints params in
- let ty, priv, unboxed =
- match decl.type_kind with
- | Type_abstract _ ->
- begin match ty_manifest with
- | None -> (Otyp_abstract, Public, false)
- | Some ty ->
- tree_of_typexp Type ty, decl.type_private, false
- end
- | Type_variant (cstrs, rep) ->
- tree_of_manifest
- (Otyp_sum (List.map tree_of_constructor_in_decl cstrs)),
- decl.type_private,
- (rep = Variant_unboxed)
- | Type_record(lbls, rep) ->
- tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
- decl.type_private,
- (match rep with Record_unboxed _ -> true | _ -> false)
- | Type_open ->
- tree_of_manifest Otyp_open,
- decl.type_private,
- false
- in
- { otype_name = name;
- otype_params = args;
- otype_type = ty;
- otype_private = priv;
- otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
- otype_unboxed = unboxed;
- otype_cstrs = constraints }
-
-let add_type_decl_to_preparation id decl =
- ignore @@ prepare_decl id decl
-
-let tree_of_prepared_type_decl id decl =
- tree_of_type_decl id decl
-
-let tree_of_type_decl id decl =
- reset_except_context();
- tree_of_type_decl id decl
-
-let add_constructor_to_preparation c =
- prepare_type_constructor_arguments c.cd_args;
- Option.iter prepare_type c.cd_res
-
-let prepared_constructor ppf c =
- !Oprint.out_constr ppf (tree_of_single_constructor c)
-
-let constructor ppf c =
- reset_except_context ();
- add_constructor_to_preparation c;
- prepared_constructor ppf c
-
-let label ppf l =
- reset_except_context ();
- prepare_type l.ld_type;
- !Oprint.out_label ppf (tree_of_label l)
-
-let tree_of_type_declaration id decl rs =
- Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
-
-let tree_of_prepared_type_declaration id decl rs =
- Osig_type (tree_of_prepared_type_decl id decl, tree_of_rec rs)
-
-let type_declaration id ppf decl =
- !Oprint.out_sig_item ppf (tree_of_type_declaration id decl Trec_first)
-
-let add_type_declaration_to_preparation id decl =
- add_type_decl_to_preparation id decl
-
-let prepared_type_declaration id ppf decl =
- !Oprint.out_sig_item ppf
- (tree_of_prepared_type_declaration id decl Trec_first)
-
-let constructor_arguments ppf a =
- let tys = tree_of_constructor_arguments a in
- !Oprint.out_type ppf (Otyp_tuple tys)
-
-(* Print an extension declaration *)
-
-let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
- let ret = Option.map (tree_of_typexp Type) ext_ret_type in
- let args = tree_of_constructor_arguments ext_args in
- (args, ret)
-
-(* When printing extension constructor, it is important to ensure that
-after printing the constructor, we are still in the scope of the constructor.
-For GADT constructor, this can be done by printing the type parameters inside
-their own isolated scope. This ensures that in
-{[
- type 'b t += A: 'b -> 'b any t
-]}
-the type parameter `'b` is not bound when printing the type variable `'b` from
-the constructor definition from the type parameter.
-
-Contrarily, for non-gadt constructor, we must keep the same scope for
-the type parameters and the constructor because a type constraint may
-have changed the name of the type parameter:
-{[
-type -'a t = .. constraint <x:'a. 'a t -> 'a> = 'a
-(* the universal 'a is here to steal the name 'a from the type parameter *)
-type 'a t = X of 'a
-]} *)
-
-let add_extension_constructor_to_preparation ext =
- let ty_params = filter_params ext.ext_type_params in
- List.iter add_alias ty_params;
- List.iter prepare_type ty_params;
- prepare_type_constructor_arguments ext.ext_args;
- Option.iter prepare_type ext.ext_ret_type
-
-let prepared_tree_of_extension_constructor
- id ext es
- =
- let type_path = best_type_path_simple ext.ext_type_path in
- let ty_name = Path.name type_path in
- let ty_params = filter_params ext.ext_type_params in
- let type_param =
- function
- | Otyp_var (_, id) -> id
- | _ -> "?"
- in
- let param_scope f =
- match ext.ext_ret_type with
- | None ->
- (* normal constructor: same scope for parameters and the constructor *)
- f ()
- | Some _ ->
- (* gadt constructor: isolated scope for the type parameters *)
- Names.with_local_names f
- in
- let ty_params =
- param_scope
- (fun () ->
- List.iter (add_printed_alias ~non_gen:false) ty_params;
- List.map (fun ty -> type_param (tree_of_typexp Type ty)) ty_params
- )
- in
- let name = Ident.name id in
- let args, ret =
- extension_constructor_args_and_ret_type_subtree
- ext.ext_args
- ext.ext_ret_type
- in
- let ext =
- { oext_name = name;
- oext_type_name = ty_name;
- oext_type_params = ty_params;
- oext_args = args;
- oext_ret_type = ret;
- oext_private = ext.ext_private }
- in
- let es =
- match es with
- Text_first -> Oext_first
- | Text_next -> Oext_next
- | Text_exception -> Oext_exception
- in
- Osig_typext (ext, es)
-
-let tree_of_extension_constructor id ext es =
- reset_except_context ();
- add_extension_constructor_to_preparation ext;
- prepared_tree_of_extension_constructor id ext es
-
-let extension_constructor id ppf ext =
- !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
-
-let prepared_extension_constructor id ppf ext =
- !Oprint.out_sig_item ppf
- (prepared_tree_of_extension_constructor id ext Text_first)
-
-let extension_only_constructor id ppf ext =
- reset_except_context ();
- prepare_type_constructor_arguments ext.ext_args;
- Option.iter prepare_type ext.ext_ret_type;
- let name = Ident.name id in
- let args, ret =
- extension_constructor_args_and_ret_type_subtree
- ext.ext_args
- ext.ext_ret_type
- in
- Format.fprintf ppf "@[<hv>%a@]"
- !Oprint.out_constr {
- ocstr_name = name;
- ocstr_args = args;
- ocstr_return_type = ret;
- }
-
-(* Print a value declaration *)
-
-let tree_of_value_description id decl =
- (* Format.eprintf "@[%a@]@." raw_type_expr decl.val_type; *)
- let id = Ident.name id in
- let ty = tree_of_type_scheme decl.val_type in
- let vd =
- { oval_name = id;
- oval_type = ty;
- oval_prims = [];
- oval_attributes = [] }
- in
- let vd =
- match decl.val_kind with
- | Val_prim p -> Primitive.print p vd
- | _ -> vd
- in
- Osig_value vd
-
-let value_description id ppf decl =
- !Oprint.out_sig_item ppf (tree_of_value_description id decl)
-
-(* Print a class type *)
-
-let method_type priv ty =
- match priv, get_desc ty with
- | Mpublic, Tpoly(ty, tyl) -> (ty, tyl)
- | _ , _ -> (ty, [])
-
-let prepare_method _lab (priv, _virt, ty) =
- let ty, _ = method_type priv ty in
- prepare_type ty
-
-let tree_of_method mode (lab, priv, virt, ty) =
- let (ty, tyl) = method_type priv ty in
- let tty = tree_of_typexp mode ty in
- Names.remove_names (List.map Transient_expr.repr tyl);
- let priv = priv <> Mpublic in
- let virt = virt = Virtual in
- Ocsg_method (lab, priv, virt, tty)
-
-let rec prepare_class_type params = function
- | Cty_constr (_p, tyl, cty) ->
- let row = Btype.self_type_row cty in
- if List.memq (proxy row) !visited_objects
- || not (List.for_all is_Tvar params)
- || List.exists (deep_occur row) tyl
- then prepare_class_type params cty
- else List.iter prepare_type tyl
- | Cty_signature sign ->
- (* Self may have a name *)
- let px = proxy sign.csig_self_row in
- if List.memq px !visited_objects then add_alias_proxy px
- else visited_objects := px :: !visited_objects;
- Vars.iter (fun _ (_, _, ty) -> prepare_type ty) sign.csig_vars;
- Meths.iter prepare_method sign.csig_meths
- | Cty_arrow (_, ty, cty) ->
- prepare_type ty;
- prepare_class_type params cty
-
-let rec tree_of_class_type mode params =
- function
- | Cty_constr (p, tyl, cty) ->
- let row = Btype.self_type_row cty in
- if List.memq (proxy row) !visited_objects
- || not (List.for_all is_Tvar params)
- then
- tree_of_class_type mode params cty
- else begin
- let nso, p = best_class_type_path p in
- let tyl = apply_subst_opt nso tyl in
- let namespace = Namespace.best_class_namespace p in
- Octy_constr (tree_of_path namespace p, tree_of_typlist Type_scheme tyl)
- end
- | Cty_signature sign ->
- let px = proxy sign.csig_self_row in
- let self_ty =
- if is_aliased_proxy px then
- Some
- (Otyp_var (false, Names.name_of_type Names.new_name px))
- else None
- in
- let csil = [] in
- let csil =
- List.fold_left
- (fun csil (ty1, ty2) -> Ocsg_constraint (ty1, ty2) :: csil)
- csil (tree_of_constraints params)
- in
- let all_vars =
- Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.csig_vars []
- in
- (* Consequence of PR#3607: order of Map.fold has changed! *)
- let all_vars = List.rev all_vars in
- let csil =
- List.fold_left
- (fun csil (l, m, v, t) ->
- Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp mode t)
- :: csil)
- csil all_vars
- in
- let all_meths =
- Meths.fold
- (fun l (p, v, t) all -> (l, p, v, t) :: all)
- sign.csig_meths []
- in
- let all_meths = List.rev all_meths in
- let csil =
- List.fold_left
- (fun csil meth -> tree_of_method mode meth :: csil)
- csil all_meths
- in
- Octy_signature (self_ty, List.rev csil)
- | Cty_arrow (l, ty, cty) ->
- let lab =
- if !print_labels || is_optional l then l else Nolabel
- in
- let tr =
- if is_optional l then
- match get_desc ty with
- | Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
- tree_of_typexp mode ty
- | _ -> Otyp_stuff "<hidden>"
- else tree_of_typexp mode ty in
- Octy_arrow (lab, tr, tree_of_class_type mode params cty)
-
-let class_type ppf cty =
- reset ();
- prepare_class_type [] cty;
- !Oprint.out_class_type ppf (tree_of_class_type Type [] cty)
-
-let tree_of_class_param param variance =
- let ot_variance =
- if is_Tvar param then Asttypes.(NoVariance, NoInjectivity) else variance in
- match tree_of_typexp Type_scheme param with
- Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
- | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
-
-let class_variance =
- let open Variance in let open Asttypes in
- List.map (fun v ->
- (if not (mem May_pos v) then Contravariant else
- if not (mem May_neg v) then Covariant else NoVariance),
- NoInjectivity)
-
-let tree_of_class_declaration id cl rs =
- let params = filter_params cl.cty_params in
-
- reset_except_context ();
- List.iter add_alias params;
- prepare_class_type params cl.cty_type;
- let px = proxy (Btype.self_type_row cl.cty_type) in
- List.iter prepare_type params;
-
- List.iter (add_printed_alias ~non_gen:false) params;
- if is_aliased_proxy px then add_printed_alias_proxy ~non_gen:false px;
-
- let vir_flag = cl.cty_new = None in
- Osig_class
- (vir_flag, Ident.name id,
- List.map2 tree_of_class_param params (class_variance cl.cty_variance),
- tree_of_class_type Type_scheme params cl.cty_type,
- tree_of_rec rs)
-
-let class_declaration id ppf cl =
- !Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
-
-let tree_of_cltype_declaration id cl rs =
- let params = cl.clty_params in
-
- reset_except_context ();
- List.iter add_alias params;
- prepare_class_type params cl.clty_type;
- let px = proxy (Btype.self_type_row cl.clty_type) in
- List.iter prepare_type params;
-
- List.iter (add_printed_alias ~non_gen:false) params;
- if is_aliased_proxy px then (add_printed_alias_proxy ~non_gen:false) px;
-
- let sign = Btype.signature_of_class_type cl.clty_type in
- let has_virtual_vars =
- Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
- sign.csig_vars false
- in
- let has_virtual_meths =
- Meths.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
- sign.csig_meths false
- in
- Osig_class_type
- (has_virtual_vars || has_virtual_meths, Ident.name id,
- List.map2 tree_of_class_param params (class_variance cl.clty_variance),
- tree_of_class_type Type_scheme params cl.clty_type,
- tree_of_rec rs)
-
-let cltype_declaration id ppf cl =
- !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl Trec_first)
-
-(* Print a module type *)
-
-let wrap_env fenv ftree arg =
- let env = !printing_env in
- let env' = Env.update_short_paths (fenv env) in
- set_printing_env env';
- let tree = ftree arg in
- set_printing_env env;
- tree
-
-let dummy =
- {
- type_params = [];
- type_arity = 0;
- type_kind = Type_abstract Definition;
- type_private = Public;
- type_manifest = None;
- type_variance = [];
- type_separability = [];
- type_is_newtype = false;
- type_expansion_scope = Btype.lowest_level;
- type_loc = Location.none;
- type_attributes = [];
- type_immediate = Unknown;
- type_unboxed_default = false;
- type_uid = Uid.internal_not_actually_unique;
- }
-
-(** we hide items being defined from short-path to avoid shortening
- [type t = Path.To.t] into [type t = t].
-*)
-
-let ident_sigitem = function
- | Types.Sig_type(ident,_,_,_) -> {hide=true;ident}
- | Types.Sig_class(ident,_,_,_)
- | Types.Sig_class_type (ident,_,_,_)
- | Types.Sig_module(ident,_, _,_,_)
- | Types.Sig_value (ident,_,_)
- | Types.Sig_modtype (ident,_,_)
- | Types.Sig_typext (ident,_,_,_) -> {hide=false; ident }
-
-let hide ids env =
- let hide_id id env =
- (* Global idents cannot be renamed *)
- if id.hide && not (Ident.global id.ident) then
- Env.add_type ~check:false (Ident.rename_no_exn id.ident) dummy env
- else env
- in
- List.fold_right hide_id ids env
-
-let with_hidden_items ids f =
- let with_hidden_in_printing_env ids f =
- wrap_env (hide ids) (Naming_context.with_hidden ids) f
- in
- if not !Clflags.real_paths then
- with_hidden_in_printing_env ids f
- else
- Naming_context.with_hidden ids f
-
-let add_sigitem env x =
- Env.add_signature (Signature_group.flatten x) env
-
-let rec tree_of_modtype ?(ellipsis=false) = function
- | Mty_ident p ->
- let p = best_module_type_path p in
- Omty_ident (tree_of_path (Some Module_type) p)
- | Mty_signature sg ->
- Omty_signature (if ellipsis then [Osig_ellipsis]
- else tree_of_signature sg)
- | Mty_functor(param, ty_res) ->
- let param, env =
- tree_of_functor_parameter param
- in
- let res = wrap_env env (tree_of_modtype ~ellipsis) ty_res in
- Omty_functor (param, res)
- | Mty_alias p ->
- let p = best_module_path p in
- Omty_alias (tree_of_path (Some Module) p)
- | Mty_for_hole -> Omty_hole
-
-and tree_of_functor_parameter = function
- | Unit ->
- None, fun k -> k
- | Named (param, ty_arg) ->
- let name, env =
- match param with
- | None -> None, fun env -> env
- | Some id ->
- Some (Ident.name id),
- Env.add_module ~arg:true id Mp_present ty_arg
- in
- Some (name, tree_of_modtype ~ellipsis:false ty_arg), env
-
-and tree_of_signature sg =
- wrap_env (fun env -> env)(fun sg ->
- let tree_groups = tree_of_signature_rec !printing_env sg in
- List.concat_map (fun (_env,l) -> List.map snd l) tree_groups
- ) sg
-
-and tree_of_signature_rec env' sg =
- let structured = List.of_seq (Signature_group.seq sg) in
- let collect_trees_of_rec_group group =
- let env = !printing_env in
- let env', group_trees =
- trees_of_recursive_sigitem_group env group
- in
- set_printing_env env';
- (env, group_trees) in
- set_printing_env env';
- List.map collect_trees_of_rec_group structured
-
-and trees_of_recursive_sigitem_group env
- (syntactic_group: Signature_group.rec_group) =
- let display (x:Signature_group.sig_item) = x.src, tree_of_sigitem x.src in
- let env = Env.add_signature syntactic_group.pre_ghosts env in
- match syntactic_group.group with
- | Not_rec x -> add_sigitem env x, [display x]
- | Rec_group items ->
- let ids = List.map (fun x -> ident_sigitem x.Signature_group.src) items in
- List.fold_left add_sigitem env items,
- with_hidden_items ids (fun () -> List.map display items)
-
-and tree_of_sigitem = function
- | Sig_value(id, decl, _) ->
- tree_of_value_description id decl
- | Sig_type(id, decl, rs, _) ->
- tree_of_type_declaration id decl rs
- | Sig_typext(id, ext, es, _) ->
- tree_of_extension_constructor id ext es
- | Sig_module(id, _, md, rs, _) ->
- let ellipsis =
- List.exists (function
- | Parsetree.{attr_name = {txt="..."}; attr_payload = PStr []} -> true
- | _ -> false)
- md.md_attributes in
- tree_of_module id md.md_type rs ~ellipsis
- | Sig_modtype(id, decl, _) ->
- tree_of_modtype_declaration id decl
- | Sig_class(id, decl, rs, _) ->
- tree_of_class_declaration id decl rs
- | Sig_class_type(id, decl, rs, _) ->
- tree_of_cltype_declaration id decl rs
-
-and tree_of_modtype_declaration id decl =
- let mty =
- match decl.mtd_type with
- | None -> Omty_abstract
- | Some mty -> tree_of_modtype mty
- in
- Osig_modtype (Ident.name id, mty)
-
-and tree_of_module id ?ellipsis mty rs =
- Osig_module (Ident.name id, tree_of_modtype ?ellipsis mty, tree_of_rec rs)
+let ident = Fmt.compat Doc.ident
+let path = Fmt.compat Doc.path
+let type_path = Fmt.compat Doc.type_path
+let raw_type_expr = Fmt.compat Doc.raw_type_expr
+let wrap_printing_env = Doc.wrap_printing_env
+let type_expr = Fmt.compat Doc.type_expr
+let prepared_type_expr = Fmt.compat Doc.prepared_type_expr
+let constructor_arguments = Fmt.compat Doc.constructor_arguments
+let type_scheme = Fmt.compat Doc.type_scheme
+let prepared_type_scheme = Fmt.compat Doc.prepared_type_scheme
+let shared_type_scheme = Fmt.compat Doc.shared_type_scheme
+let value_description = Fmt.compat1 Doc.value_description
+let label = Fmt.compat Doc.label
+let prepared_constructor = Fmt.compat Doc.prepared_constructor
+let constructor = Fmt.compat Doc.constructor
+let prepared_type_declaration = Fmt.compat1 Doc.prepared_type_declaration
+let type_declaration = Fmt.compat1 Doc.type_declaration
+
+let prepared_extension_constructor =
+ Fmt.compat1 Doc.prepared_extension_constructor
+
+let extension_constructor = Fmt.compat1 Doc.extension_constructor
+let extension_only_constructor = Fmt.compat1 Doc.extension_only_constructor
+let modtype = Fmt.compat Doc.modtype
+let signature = Fmt.compat Doc.signature
let rec functor_parameters ~sep custom_printer = function
| [] -> ignore
| [id,param] ->
- Format.dprintf "%t%t"
- (custom_printer param)
- (functor_param ~sep ~custom_printer id [])
+ Format.dprintf "%t%t"
+ (custom_printer param)
+ (functor_param ~sep ~custom_printer id [])
| (id,param) :: q ->
- Format.dprintf "%t%a%t"
- (custom_printer param)
- sep ()
- (functor_param ~sep ~custom_printer id q)
+ Format.dprintf "%t%a%t"
+ (custom_printer param)
+ sep ()
+ (functor_param ~sep ~custom_printer id q)
and functor_param ~sep ~custom_printer id q =
match id with
| None -> functor_parameters ~sep custom_printer q
| Some id ->
- Naming_context.with_arg id
- (fun () -> functor_parameters ~sep custom_printer q)
-
-
-
-let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
-let modtype_declaration id ppf decl =
- !Oprint.out_sig_item ppf (tree_of_modtype_declaration id decl)
-
-(* For the toplevel: merge with tree_of_signature? *)
-
-let print_items showval env x =
- Names.refresh_weak();
- Conflicts.reset ();
- let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
- let post_process (env,l) = List.map (extend_val env) l in
- List.concat_map post_process @@ tree_of_signature_rec env x
-
-(* Print a signature body (used by -i when compiling a .ml) *)
-
-let print_signature ppf tree =
- fprintf ppf "@[<v>%a@]" !Oprint.out_signature tree
-
-let signature ppf sg =
- fprintf ppf "%a" print_signature (tree_of_signature sg)
-
-(* Print a signature body (used by -i when compiling a .ml) *)
-let printed_signature sourcefile ppf sg =
- (* we are tracking any collision event for warning 63 *)
- Conflicts.reset ();
- let t = tree_of_signature sg in
- if Warnings.(is_active @@ Erroneous_printed_signature "")
- && Conflicts.exists ()
- then begin
- let conflicts = Format.asprintf "%t" Conflicts.print_explanations in
- Location.prerr_warning (Location.in_file sourcefile)
- (Warnings.Erroneous_printed_signature conflicts);
- Warnings.check_fatal ()
- end;
- fprintf ppf "%a" print_signature t
-
-(* Trace-specific printing *)
-
-(* A configuration type that controls which trace we print. This could be
- exposed, but we instead expose three separate
- [report_{unification,equality,moregen}_error] functions. This also lets us
- give the unification case an extra optional argument without adding it to the
- equality and moregen cases. *)
-type 'variety trace_format =
- | Unification : Errortrace.unification trace_format
- | Equality : Errortrace.comparison trace_format
- | Moregen : Errortrace.comparison trace_format
-
-let incompatibility_phrase (type variety) : variety trace_format -> string =
- function
- | Unification -> "is not compatible with type"
- | Equality -> "is not equal to type"
- | Moregen -> "is not compatible with type"
-
-(* Print a unification error *)
-
-let same_path t t' =
- eq_type t t' ||
- match get_desc t, get_desc t' with
- | Tconstr(p,tl,_), Tconstr(p',tl',_) -> begin
- match best_type_path p, best_type_path p' with
- | Nth n, Nth n' when n = n' -> true
- | Path(nso, p), Path(nso', p') when Path.same p p' ->
- let tl = apply_subst_opt nso tl in
- let tl' = apply_subst_opt nso' tl' in
- List.length tl = List.length tl' &&
- List.for_all2 eq_type tl tl'
- | _ -> false
- end
- | _ ->
- false
-
-type 'a diff = Same of 'a | Diff of 'a * 'a
-
-let trees_of_type_expansion mode Errortrace.{ty = t; expanded = t'} =
- reset_loop_marks ();
- mark_loops t;
- if same_path t t'
- then begin add_delayed (proxy t); Same (tree_of_typexp mode t) end
- else begin
- mark_loops t';
- let t' = if proxy t == proxy t' then unalias t' else t' in
- (* beware order matter due to side effect,
- e.g. when printing object types *)
- let first = tree_of_typexp mode t in
- let second = tree_of_typexp mode t' in
- if first = second then Same first
- else Diff(first,second)
- end
-
-let type_expansion ppf = function
- | Same t -> Style.as_inline_code !Oprint.out_type ppf t
- | Diff(t,t') ->
- fprintf ppf "@[<2>%a@ =@ %a@]"
- (Style.as_inline_code !Oprint.out_type) t
- (Style.as_inline_code !Oprint.out_type) t'
-
-let trees_of_trace mode =
- List.map (Errortrace.map_diff (trees_of_type_expansion mode))
-
-let trees_of_type_path_expansion (tp,tp') =
- if Path.same tp tp' then Same(tree_of_path (Some Type) tp) else
- Diff(tree_of_path (Some Type) tp, tree_of_path (Some Type) tp')
-
-let type_path_expansion ppf = function
- | Same p -> Style.as_inline_code !Oprint.out_ident ppf p
- | Diff(p,p') ->
- fprintf ppf "@[<2>%a@ =@ %a@]"
- (Style.as_inline_code !Oprint.out_ident) p
- (Style.as_inline_code !Oprint.out_ident) p'
-
-let rec trace fst txt ppf = function
- | {Errortrace.got; expected} :: rem ->
- if not fst then fprintf ppf "@,";
- fprintf ppf "@[Type@;<1 2>%a@ %s@;<1 2>%a@]%a"
- type_expansion got txt type_expansion expected
- (trace false txt) rem
- | _ -> ()
-
-type printing_status =
- | Discard
- | Keep
- | Optional_refinement
- (** An [Optional_refinement] printing status is attributed to trace
- elements that are focusing on a new subpart of a structural type.
- Since the whole type should have been printed earlier in the trace,
- we only print those elements if they are the last printed element
- of a trace, and there is no explicit explanation for the
- type error.
- *)
-
-let diff_printing_status Errortrace.{ got = {ty = t1; expanded = t1'};
- expected = {ty = t2; expanded = t2'} } =
- if is_constr_row ~allow_ident:true t1'
- || is_constr_row ~allow_ident:true t2'
- then Discard
- else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
- else Keep
-
-let printing_status = function
- | Errortrace.Diff d -> diff_printing_status d
- | Errortrace.Escape {kind = Constraint} -> Keep
- | _ -> Keep
-
-(** Flatten the trace and remove elements that are always discarded
- during printing *)
-
-(* Takes [printing_status] to change behavior for [Subtype] *)
-let prepare_any_trace printing_status tr =
- let clean_trace x l = match printing_status x with
- | Keep -> x :: l
- | Optional_refinement when l = [] -> [x]
- | Optional_refinement | Discard -> l
- in
- match tr with
- | [] -> []
- | elt :: rem -> elt :: List.fold_right clean_trace rem []
-
-let prepare_trace f tr =
- prepare_any_trace printing_status (Errortrace.map f tr)
-
-(** Keep elements that are [Diff _ ] and take the decision
- for the last element, require a prepared trace *)
-let rec filter_trace keep_last = function
- | [] -> []
- | [Errortrace.Diff d as elt]
- when printing_status elt = Optional_refinement ->
- if keep_last then [d] else []
- | Errortrace.Diff d :: rem -> d :: filter_trace keep_last rem
- | _ :: rem -> filter_trace keep_last rem
-
-let type_path_list =
- Format.pp_print_list ~pp_sep:(fun ppf () -> Format.pp_print_break ppf 2 0)
- type_path_expansion
-
-(* Hide variant name and var, to force printing the expanded type *)
-let hide_variant_name t =
- match get_desc t with
- | Tvariant row ->
- let Row {fields; more; name; fixed; closed} = row_repr row in
- if name = None then t else
- newty2 ~level:(get_level t)
- (Tvariant
- (create_row ~fields ~fixed ~closed ~name:None
- ~more:(newvar2 (get_level more))))
- | _ -> t
-
-let prepare_expansion Errortrace.{ty; expanded} =
- let expanded = hide_variant_name expanded in
- reserve_names ty;
- if not (same_path ty expanded) then reserve_names expanded;
- Errortrace.{ty; expanded}
-
-let may_prepare_expansion compact (Errortrace.{ty; expanded} as ty_exp) =
- match get_desc expanded with
- Tvariant _ | Tobject _ when compact ->
- reserve_names ty; Errortrace.{ty; expanded = ty}
- | _ -> prepare_expansion ty_exp
-
-let print_path p =
- Format.dprintf "%a" !Oprint.out_ident (tree_of_path (Some Type) p)
-
-let print_tag ppf s = Style.inline_code ppf ("`" ^ s)
-
-let print_tags =
- let comma ppf () = Format.fprintf ppf ",@ " in
- Format.pp_print_list ~pp_sep:comma print_tag
-
-let is_unit env ty =
- match get_desc (Ctype.expand_head env ty) with
- | Tconstr (p, _, _) -> Path.same p Predef.path_unit
- | _ -> false
-
-let unifiable env ty1 ty2 =
- let snap = Btype.snapshot () in
- let res =
- try Ctype.unify env ty1 ty2; true
- with Unify _ -> false
- in
- Btype.backtrack snap;
- res
-
-let explanation_diff env t3 t4 : (Format.formatter -> unit) option =
- match get_desc t3, get_desc t4 with
- | Tarrow (_, ty1, ty2, _), _
- when is_unit env ty1 && unifiable env ty2 t4 ->
- Some (fun ppf ->
- fprintf ppf
- "@,@[@{<hint>Hint@}: Did you forget to provide %a as argument?@]"
- Style.inline_code "()"
- )
- | _, Tarrow (_, ty1, ty2, _)
- when is_unit env ty1 && unifiable env t3 ty2 ->
- Some (fun ppf ->
- fprintf ppf
- "@,@[@{<hint>Hint@}: Did you forget to wrap the expression using \
- %a?@]"
- Style.inline_code "fun () ->"
- )
- | _ ->
- None
-
-let explain_fixed_row_case ppf = function
- | Errortrace.Cannot_be_closed ->
- fprintf ppf "it cannot be closed"
- | Errortrace.Cannot_add_tags tags ->
- fprintf ppf "it may not allow the tag(s) %a"
- print_tags tags
-
-let explain_fixed_row pos expl = match expl with
- | Fixed_private ->
- dprintf "The %a variant type is private" Errortrace.print_pos pos
- | Univar x ->
- reserve_names x;
- dprintf "The %a variant type is bound to the universal type variable %a"
- Errortrace.print_pos pos
- (Style.as_inline_code type_expr_with_reserved_names) x
- | Reified p ->
- dprintf "The %a variant type is bound to %a"
- Errortrace.print_pos pos
- (Style.as_inline_code
- (fun ppf p ->
- Internal_names.add p;
- print_path p ppf))
- p
- | Rigid -> ignore
-
-let explain_variant (type variety) : variety Errortrace.variant -> _ = function
- (* Common *)
- | Errortrace.Incompatible_types_for s ->
- Some(dprintf "@,Types for tag %a are incompatible"
- print_tag s
- )
- (* Unification *)
- | Errortrace.No_intersection ->
- Some(dprintf "@,These two variant types have no intersection")
- | Errortrace.No_tags(pos,fields) -> Some(
- dprintf
- "@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
- Errortrace.print_pos pos
- print_tags (List.map fst fields)
- )
- | Errortrace.Fixed_row (pos,
- k,
- (Univar _ | Reified _ | Fixed_private as e)) ->
- Some (
- dprintf "@,@[%t,@ %a@]" (explain_fixed_row pos e)
- explain_fixed_row_case k
- )
- | Errortrace.Fixed_row (_,_, Rigid) ->
- (* this case never happens *)
- None
- (* Equality & Moregen *)
- | Errortrace.Presence_not_guaranteed_for (pos, s) -> Some(
- dprintf
- "@,@[The tag %a is guaranteed to be present in the %a variant type,\
- @ but not in the %a@]"
- print_tag s
- Errortrace.print_pos (Errortrace.swap_position pos)
- Errortrace.print_pos pos
- )
- | Errortrace.Openness pos ->
- Some(dprintf "@,The %a variant type is open and the %a is not"
- Errortrace.print_pos pos
- Errortrace.print_pos (Errortrace.swap_position pos))
-
-let explain_escape pre = function
- | Errortrace.Univ u ->
- reserve_names u;
- Some(
- dprintf "%t@,The universal variable %a would escape its scope"
- pre
- (Style.as_inline_code type_expr_with_reserved_names) u
- )
- | Errortrace.Constructor p -> Some(
- dprintf
- "%t@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
- pre (Style.as_inline_code path) p
- )
- | Errortrace.Module_type p -> Some(
- dprintf
- "%t@,@[The module type@;<1 2>%a@ would escape its scope@]"
- pre (Style.as_inline_code path) p
- )
- | Errortrace.Equation Errortrace.{ty = _; expanded = t} ->
- reserve_names t;
- Some(
- dprintf "%t @,@[<hov>This instance of %a is ambiguous:@ %s@]"
- pre
- (Style.as_inline_code type_expr_with_reserved_names) t
- "it would escape the scope of its equation"
- )
- | Errortrace.Self ->
- Some (dprintf "%t@,Self type cannot escape its class" pre)
- | Errortrace.Constraint ->
- None
-
-let explain_object (type variety) : variety Errortrace.obj -> _ = function
- | Errortrace.Missing_field (pos,f) -> Some(
- dprintf "@,@[The %a object type has no method %a@]"
- Errortrace.print_pos pos Style.inline_code f
- )
- | Errortrace.Abstract_row pos -> Some(
- dprintf
- "@,@[The %a object type has an abstract row, it cannot be closed@]"
- Errortrace.print_pos pos
- )
- | Errortrace.Self_cannot_be_closed ->
- Some (dprintf "@,Self type cannot be unified with a closed object type")
-
-let explain_incompatible_fields name (diff: Types.type_expr Errortrace.diff) =
- reserve_names diff.got;
- reserve_names diff.expected;
- dprintf "@,@[The method %a has type@ %a,@ \
- but the expected method type was@ %a@]"
- Style.inline_code name
- (Style.as_inline_code type_expr_with_reserved_names) diff.got
- (Style.as_inline_code type_expr_with_reserved_names) diff.expected
-
-let explanation (type variety) intro prev env
- : (Errortrace.expanded_type, variety) Errortrace.elt -> _ = function
- | Errortrace.Diff {got; expected} ->
- explanation_diff env got.expanded expected.expanded
- | Errortrace.Escape {kind; context} ->
- let pre =
- match context, kind, prev with
- | Some ctx, _, _ ->
- reserve_names ctx;
- dprintf "@[%t@;<1 2>%a@]" intro
- (Style.as_inline_code type_expr_with_reserved_names) ctx
- | None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
- explain_incompatible_fields name diff
- | _ -> ignore
- in
- explain_escape pre kind
- | Errortrace.Incompatible_fields { name; diff} ->
- Some(explain_incompatible_fields name diff)
- | Errortrace.Variant v ->
- explain_variant v
- | Errortrace.Obj o ->
- explain_object o
- | Errortrace.Rec_occur(x,y) ->
- reserve_names x;
- reserve_names y;
- begin match get_desc x with
- | Tvar _ | Tunivar _ ->
- Some(fun ppf ->
- reset_loop_marks ();
- mark_loops x;
- mark_loops y;
- dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
- (Style.as_inline_code prepared_type_expr) x
- (Style.as_inline_code prepared_type_expr) y
- ppf)
- | _ ->
- (* We had a delayed unification of the type variable with
- a non-variable after the occur check. *)
- Some ignore
- (* There is no need to search further for an explanation, but
- we don't want to print a message of the form:
- {[ The type int occurs inside int list -> 'a |}
- *)
- end
-
-let mismatch intro env trace =
- Errortrace.explain trace (fun ~prev h -> explanation intro prev env h)
-
-let explain mis ppf =
- match mis with
- | None -> ()
- | Some explain -> explain ppf
-
-let warn_on_missing_def env ppf t =
- match get_desc t with
- | Tconstr (p,_,_) ->
- begin match Env.find_type p env with
- | exception Not_found ->
- fprintf ppf
- "@,@[<hov>Type %a is abstract because@ no corresponding\
- @ cmi file@ was found@ in path.@]" (Style.as_inline_code path) p
- | { type_manifest = Some _; _ } -> ()
- | { type_manifest = None; _ } as decl ->
- match type_origin decl with
- | Rec_check_regularity ->
- fprintf ppf
- "@,@[<hov>Type %a was considered abstract@ when checking\
- @ constraints@ in this@ recursive type definition.@]"
- (Style.as_inline_code path) p
- | Definition | Existential _ -> ()
- end
- | _ -> ()
-
-let prepare_expansion_head empty_tr = function
- | Errortrace.Diff d ->
- Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
- | _ -> None
-
-let head_error_printer mode txt_got txt_but = function
- | None -> ignore
- | Some d ->
- let d = Errortrace.map_diff (trees_of_type_expansion mode) d in
- dprintf "%t@;<1 2>%a@ %t@;<1 2>%a"
- txt_got type_expansion d.Errortrace.got
- txt_but type_expansion d.Errortrace.expected
-
-let warn_on_missing_defs env ppf = function
- | None -> ()
- | Some Errortrace.{got = {ty=te1; expanded=_};
- expected = {ty=te2; expanded=_} } ->
- warn_on_missing_def env ppf te1;
- warn_on_missing_def env ppf te2
-
-(* [subst] comes out of equality, and is [[]] otherwise *)
-let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation =
- reset ();
- (* We want to substitute in the opposite order from [Eqtype] *)
- Names.add_subst (List.map (fun (ty1,ty2) -> ty2,ty1) subst);
- let tr =
- prepare_trace
- (fun ty_exp ->
- Errortrace.{ty_exp with expanded = hide_variant_name ty_exp.expanded})
- tr
- in
- let mis = mismatch txt1 env tr in
- match tr with
- | [] -> assert false
- | elt :: tr ->
- try
- print_labels := not !Clflags.classic;
- let tr = filter_trace (mis = None) tr in
- let head = prepare_expansion_head (tr=[]) elt in
- let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
- let head_error = head_error_printer mode txt1 txt2 head in
- let tr = trees_of_trace mode tr in
- fprintf ppf
- "@[<v>\
- @[%t%t@]%a%t\
- @]"
- head_error
- ty_expect_explanation
- (trace false (incompatibility_phrase trace_format)) tr
- (explain mis);
- if env <> Env.empty
- then warn_on_missing_defs env ppf head;
- Internal_names.print_explanations env ppf;
- Conflicts.print_explanations ppf;
- print_labels := true
- with exn ->
- print_labels := true;
- raise exn
-
-let report_error trace_format ppf mode env tr
- ?(subst = [])
- ?(type_expected_explanation = fun _ -> ())
- txt1 txt2 =
- wrap_printing_env ~error:true env (fun () ->
- error trace_format mode subst env tr txt1 ppf txt2
- type_expected_explanation)
-
-let report_unification_error
- ppf env ({trace} : Errortrace.unification_error) =
- report_error Unification ppf Type env
- ?subst:None trace
-
-let report_equality_error
- ppf mode env ({subst; trace} : Errortrace.equality_error) =
- report_error Equality ppf mode env
- ~subst ?type_expected_explanation:None trace
-
-let report_moregen_error
- ppf mode env ({trace} : Errortrace.moregen_error) =
- report_error Moregen ppf mode env
- ?subst:None ?type_expected_explanation:None trace
-
-let report_comparison_error ppf mode env = function
- | Errortrace.Equality_error error -> report_equality_error ppf mode env error
- | Errortrace.Moregen_error error -> report_moregen_error ppf mode env error
-
-module Subtype = struct
- (* There's a frustrating amount of code duplication between this module and
- the outside code, particularly in [prepare_trace] and [filter_trace].
- Unfortunately, [Subtype] is *just* similar enough to have code duplication,
- while being *just* different enough (it's only [Diff]) for the abstraction
- to be nonobvious. Someday, perhaps... *)
-
- let printing_status = function
- | Errortrace.Subtype.Diff d -> diff_printing_status d
-
- let prepare_unification_trace = prepare_trace
-
- let prepare_trace f tr =
- prepare_any_trace printing_status (Errortrace.Subtype.map f tr)
-
- let trace filter_trace get_diff fst keep_last txt ppf tr =
- print_labels := not !Clflags.classic;
- try match tr with
- | elt :: tr' ->
- let diffed_elt = get_diff elt in
- let tr =
- trees_of_trace Type
- @@ List.map (Errortrace.map_diff prepare_expansion)
- @@ filter_trace keep_last tr' in
- let tr =
- match fst, diffed_elt with
- | true, Some elt -> elt :: tr
- | _, _ -> tr
- in
- trace fst txt ppf tr;
- print_labels := true
- | _ -> ()
- with exn ->
- print_labels := true;
- raise exn
-
- let rec filter_subtype_trace keep_last = function
- | [] -> []
- | [Errortrace.Subtype.Diff d as elt]
- when printing_status elt = Optional_refinement ->
- if keep_last then [d] else []
- | Errortrace.Subtype.Diff d :: rem ->
- d :: filter_subtype_trace keep_last rem
-
- let unification_get_diff = function
- | Errortrace.Diff diff ->
- Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
- | _ -> None
-
- let subtype_get_diff = function
- | Errortrace.Subtype.Diff diff ->
- Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
-
- let report_error
- ppf
- env
- (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif})
- txt1 =
- wrap_printing_env ~error:true env (fun () ->
- reset ();
- let tr_sub = prepare_trace prepare_expansion tr_sub in
- let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
- let keep_first = match tr_unif with
- | [Obj _ | Variant _ | Escape _ ] | [] -> true
- | _ -> false in
- fprintf ppf "@[<v>%a"
- (trace filter_subtype_trace subtype_get_diff true keep_first txt1)
- tr_sub;
- if tr_unif = [] then fprintf ppf "@]" else
- let mis = mismatch (dprintf "Within this type") env tr_unif in
- fprintf ppf "%a%t%t@]"
- (trace filter_trace unification_get_diff false
- (mis = None) "is not compatible with type") tr_unif
- (explain mis)
- Conflicts.print_explanations
- )
-end
-
-let report_ambiguous_type_error ppf env tp0 tpl txt1 txt2 txt3 =
- wrap_printing_env ~error:true env (fun () ->
- reset ();
- let tp0 = trees_of_type_path_expansion tp0 in
- match tpl with
- [] -> assert false
- | [tp] ->
- fprintf ppf
- "@[%t@;<1 2>%a@ \
- %t@;<1 2>%a\
- @]"
- txt1 type_path_expansion (trees_of_type_path_expansion tp)
- txt3 type_path_expansion tp0
- | _ ->
- fprintf ppf
- "@[%t@;<1 2>@[<hv>%a@]\
- @ %t@;<1 2>%a\
- @]"
- txt2 type_path_list (List.map trees_of_type_path_expansion tpl)
- txt3 type_path_expansion tp0)
-
-(* Adapt functions to exposed interface *)
-let tree_of_path = tree_of_path None
-let tree_of_modtype = tree_of_modtype ~ellipsis:false
-let type_expansion mode ppf ty_exp =
- type_expansion ppf (trees_of_type_expansion mode ty_exp)
-let tree_of_type_declaration ident td rs =
- with_hidden_items [{hide=true; ident}]
- (fun () -> tree_of_type_declaration ident td rs)
-
-let shorten_type_path env p =
- wrap_printing_env env
- (fun () -> best_type_path_simple p)
-
-let shorten_module_type_path env p =
- wrap_printing_env env
- (fun () -> best_module_type_path p)
+ Doc.Naming_context.with_arg id
+ (fun () -> functor_parameters ~sep custom_printer q)
-let shorten_module_path env p =
- wrap_printing_env env
- (fun () -> best_module_path p)
+let modtype_declaration = Fmt.compat1 Doc.modtype_declaration
+let class_type = Fmt.compat Doc.class_type
+let class_declaration = Fmt.compat1 Doc.class_declaration
+let cltype_declaration = Fmt.compat1 Doc.cltype_declaration
+let type_expansion = Fmt.compat1 Doc.type_expansion
+let printed_signature = Fmt.compat1 Doc.printed_signature
-let shorten_class_type_path env p =
- wrap_printing_env env
- (fun () -> best_class_type_path_simple p)
-let () =
- Env.shorten_module_path := shorten_module_path
+let () = Env.print_longident := Doc.longident
+let () = Env.print_path := Doc.path
+let () = Env.shorten_module_path := shorten_module_path
diff --git a/src/ocaml/typing/printtyp.mli b/src/ocaml/typing/printtyp.mli
index 2769fe0322..0df51e40f9 100644
--- a/src/ocaml/typing/printtyp.mli
+++ b/src/ocaml/typing/printtyp.mli
@@ -19,6 +19,8 @@ open Format
open Types
open Outcometree
+module Doc : sig include module type of Printtyp_doc end
+
val longident: formatter -> Longident.t -> unit
val ident: formatter -> Ident.t -> unit
val namespaced_ident: Shape.Sig_component_kind.t -> Ident.t -> string
@@ -30,11 +32,6 @@ val type_path: formatter -> Path.t -> unit
(** Print a type path taking account of [-short-paths].
Calls should be within [wrap_printing_env]. *)
-module Out_name: sig
- val create: string -> out_name
- val print: out_name -> string
-end
-
type namespace := Shape.Sig_component_kind.t option
val strings_of_paths: namespace -> Path.t list -> string list
@@ -53,41 +50,6 @@ val shorten_module_type_path: Env.t -> Path.t -> Path.t
val shorten_module_path: Env.t -> Path.t -> Path.t
val shorten_class_type_path: Env.t -> Path.t -> Path.t
-module Naming_context: sig
- val enable: bool -> unit
- (** When contextual names are enabled, the mapping between identifiers
- and names is ensured to be one-to-one. *)
-end
-
-(** The [Conflicts] module keeps track of conflicts arising when attributing
- names to identifiers and provides functions that can print explanations
- for these conflict in error messages *)
-module Conflicts: sig
- val exists: unit -> bool
- (** [exists()] returns true if the current naming context renamed
- an identifier to avoid a name collision *)
-
- type explanation =
- { kind: Shape.Sig_component_kind.t;
- name:string;
- root_name:string;
- location:Location.t
- }
-
- val list_explanations: unit -> explanation list
-(** [list_explanations()] return the list of conflict explanations
- collected up to this point, and reset the list of collected
- explanations *)
-
- val print_located_explanations:
- Format.formatter -> explanation list -> unit
-
- val print_explanations: Format.formatter -> unit
- (** Print all conflict explanations collected up to this point *)
-
- val reset: unit -> unit
-end
-
val reset: unit -> unit
@@ -232,14 +194,6 @@ val report_comparison_error :
(formatter -> unit) -> (formatter -> unit) ->
unit
-module Subtype : sig
- val report_error :
- formatter ->
- Env.t ->
- Errortrace.Subtype.error ->
- string ->
- unit
-end
(* for toploop *)
val print_items: (Env.t -> signature_item -> 'a option) ->
diff --git a/src/ocaml/typing/printtyp_doc.ml b/src/ocaml/typing/printtyp_doc.ml
new file mode 100644
index 0000000000..a83b9ff3aa
--- /dev/null
+++ b/src/ocaml/typing/printtyp_doc.ml
@@ -0,0 +1,2714 @@
+open Misc
+open Longident
+open Path
+open Asttypes
+open Types
+open Btype
+open Ctype
+open Outcometree
+
+module M = Misc.String.Map
+module S = Misc.String.Set
+module Sig_component_kind = Shape.Sig_component_kind
+module Style = Misc.Style
+module Fmt = Format_doc
+
+module Out_name = struct
+ let create x = { printed_name = x }
+ let print x = x.printed_name
+end
+
+(** Some identifiers may require hiding when printing *)
+type bound_ident = { hide:bool; ident:Ident.t }
+
+let longident = Pprintast.Doc.longident
+
+(* printing environment for path shortening and naming *)
+let printing_env = ref Env.empty
+
+(* When printing, it is important to only observe the
+ current printing environment, without reading any new
+ cmi present on the file system *)
+let in_printing_env f = Env.without_cmis f !printing_env
+
+type namespace = Shape.Sig_component_kind.t =
+ | Value
+ | Type
+ | Constructor
+ | Label
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+
+module Namespace = struct
+
+ let id = function
+ | Type -> 0
+ | Module -> 1
+ | Module_type -> 2
+ | Class -> 3
+ | Class_type -> 4
+ | Extension_constructor | Value | Constructor | Label -> 5
+ (* we do not handle those component *)
+
+ let size = 1 + id Value
+
+
+ let pp ppf x =
+ Fmt.pp_print_string ppf (Shape.Sig_component_kind.to_string x)
+
+ let lookup =
+ let to_lookup f lid = fst @@ in_printing_env (f (Lident lid)) in
+ function
+ | Some Type -> to_lookup Env.find_type_by_name
+ | Some Module -> to_lookup Env.find_module_by_name
+ | Some Module_type -> to_lookup Env.find_modtype_by_name
+ | Some Class -> to_lookup Env.find_class_by_name
+ | Some Class_type -> to_lookup Env.find_cltype_by_name
+ | None | Some(Value|Extension_constructor|Constructor|Label) ->
+ fun _ -> raise Not_found
+
+ let location namespace id =
+ let path = Path.Pident id in
+ try Some (
+ match namespace with
+ | Some Type -> (in_printing_env @@ Env.find_type path).type_loc
+ | Some Module -> (in_printing_env @@ Env.find_module path).md_loc
+ | Some Module_type -> (in_printing_env @@ Env.find_modtype path).mtd_loc
+ | Some Class -> (in_printing_env @@ Env.find_class path).cty_loc
+ | Some Class_type -> (in_printing_env @@ Env.find_cltype path).clty_loc
+ | Some (Extension_constructor|Value|Constructor|Label) | None ->
+ Location.none
+ ) with Not_found -> None
+
+ let best_class_namespace = function
+ | Papply _ | Pdot _ -> Some Module
+ | Pextra_ty _ -> assert false (* Only in type path *)
+ | Pident c ->
+ match location (Some Class) c with
+ | Some _ -> Some Class
+ | None -> Some Class_type
+
+end
+
+
+module Conflicts = struct
+ type explanation =
+ { kind: namespace; name:string; root_name:string; location:Location.t}
+ let explanations = ref M.empty
+
+ let add namespace name id =
+ match Namespace.location (Some namespace) id with
+ | None -> ()
+ | Some location ->
+ let explanation =
+ { kind = namespace; location; name; root_name=Ident.name id}
+ in
+ explanations := M.add name explanation !explanations
+
+ let collect_explanation namespace id ~name =
+ let root_name = Ident.name id in
+ (* if [name] is of the form "root_name/%d", we register both
+ [id] and the identifier in scope for [root_name].
+ *)
+ if root_name <> name && not (M.mem name !explanations) then
+ begin
+ add namespace name id;
+ if not (M.mem root_name !explanations) then
+ (* lookup the identifier in scope with name [root_name] and
+ add it too
+ *)
+ match Namespace.lookup (Some namespace) root_name with
+ | Pident root_id -> add namespace root_name root_id
+ | exception Not_found | _ -> ()
+ end
+
+ let pp_explanation ppf r=
+ Format.fprintf ppf "@[<v 2>%a:@,Definition of %s %a@]"
+ Location.print_loc r.location (Sig_component_kind.to_string r.kind)
+ (Fmt.compat Style.inline_code) r.name
+
+ let print_located_explanations ppf l =
+ Format.fprintf ppf "@[<v>%a@]" (Format.pp_print_list pp_explanation) l
+
+ let pp_explanation_as_doc ppf r=
+ Fmt.fprintf ppf "@[<v 2>%a:@,Definition of %s %a@]"
+ Location.Doc.loc r.location (Sig_component_kind.to_string r.kind)
+ Style.inline_code r.name
+
+ let print_located_explanations_as_doc ppf l =
+ Fmt.fprintf ppf "@[<v>%a@]" (Fmt.pp_print_list pp_explanation_as_doc) l
+
+ let reset () = explanations := M.empty
+ let list_explanations () =
+ let c = !explanations in
+ reset ();
+ c |> M.bindings |> List.map snd |> List.sort Stdlib.compare
+
+ let compat_inline = Fmt.compat Style.inline_code
+ let compat_ns = Fmt.compat Namespace.pp
+
+ let print_toplevel_hint_as_doc ppf l =
+ let conj ppf () = Fmt.fprintf ppf " and@ " in
+ let pp_namespace_plural ppf n = Fmt.fprintf ppf "%as" Namespace.pp n in
+ let root_names = List.map (fun r -> r.kind, r.root_name) l in
+ let unique_root_names = List.sort_uniq Stdlib.compare root_names in
+ let submsgs = Array.make Namespace.size [] in
+ let () = List.iter (fun (n,_ as x) ->
+ submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
+ ) unique_root_names in
+ let pp_submsg ppf names =
+ match names with
+ | [] -> ()
+ | [namespace, a] ->
+ Fmt.fprintf ppf
+ "@ \
+ @[<2>@{<hint>Hint@}: The %a %a has been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
+ @ Did you try to redefine them?@]"
+ Namespace.pp namespace
+ Style.inline_code a Namespace.pp namespace
+ | (namespace, _) :: _ :: _ ->
+ Fmt.fprintf ppf
+ "@ \
+ @[<2>@{<hint>Hint@}: The %a %a have been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
+ @ Did you try to redefine them?@]"
+ pp_namespace_plural namespace
+ (Fmt.pp_print_list ~pp_sep:conj Style.inline_code)
+ (List.map snd names)
+ pp_namespace_plural namespace in
+ Array.iter (pp_submsg ppf) submsgs
+
+
+ let print_toplevel_hint ppf l =
+ let conj ppf () = Format.fprintf ppf " and@ " in
+ let pp_namespace_plural ppf n = Format.fprintf ppf "%as" compat_ns n in
+ let root_names = List.map (fun r -> r.kind, r.root_name) l in
+ let unique_root_names = List.sort_uniq Stdlib.compare root_names in
+ let submsgs = Array.make Namespace.size [] in
+ let () = List.iter (fun (n,_ as x) ->
+ submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
+ ) unique_root_names in
+ let pp_submsg ppf names =
+ match names with
+ | [] -> ()
+ | [namespace, a] ->
+ Format.fprintf ppf
+ "@ \
+ @[<2>@{<hint>Hint@}: The %a %a has been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
+ @ Did you try to redefine them?@]"
+ compat_ns namespace
+ compat_inline a compat_ns namespace
+ | (namespace, _) :: _ :: _ ->
+ Format.fprintf ppf
+ "@ \
+ @[<2>@{<hint>Hint@}: The %a %a have been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
+ @ Did you try to redefine them?@]"
+ pp_namespace_plural namespace
+ (Format.pp_print_list ~pp_sep:conj compat_inline)
+ (List.map snd names)
+ pp_namespace_plural namespace in
+ Array.iter (pp_submsg ppf) submsgs
+
+
+ let print_explanations ppf =
+ let ltop, l =
+ (* isolate toplevel locations, since they are too imprecise *)
+ let from_toplevel a =
+ a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
+ List.partition from_toplevel (list_explanations ())
+ in
+ begin match l with
+ | [] -> ()
+ | l -> Format.fprintf ppf "@,%a" print_located_explanations l
+ end;
+ (* if there are name collisions in a toplevel session,
+ display at least one generic hint by namespace *)
+ print_toplevel_hint ppf ltop
+
+ let print_explanations_as_doc ppf =
+ let ltop, l =
+ (* isolate toplevel locations, since they are too imprecise *)
+ let from_toplevel a =
+ a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
+ List.partition from_toplevel (list_explanations ())
+ in
+ begin match l with
+ | [] -> ()
+ | l -> Fmt.fprintf ppf "@,%a" print_located_explanations_as_doc l
+ end;
+ (* if there are name collisions in a toplevel session,
+ display at least one generic hint by namespace *)
+ print_toplevel_hint_as_doc ppf ltop
+
+ let exists () = M.cardinal !explanations >0
+end
+
+module Naming_context = struct
+
+ let enabled = ref true
+ let enable b = enabled := b
+
+ (* Names bound in recursive definitions should be considered as bound
+ in the environment when printing identifiers but not when trying
+ to find shortest path.
+ For instance, if we define
+ [{
+ module Avoid__me = struct
+ type t = A
+ end
+ type t = X
+ type u = [` A of t * t ]
+ module M = struct
+ type t = A of [ u | `B ]
+ type r = Avoid__me.t
+ end
+ }]
+ It is is important that in the definition of [t] that the outer type [t] is
+ printed as [t/2] reserving the name [t] to the type being defined in the
+ current recursive definition.
+ Contrarily, in the definition of [r], one should not shorten the
+ path [Avoid__me.t] to [r] until the end of the definition of [r].
+ The [bound_in_recursion] bridges the gap between those two slightly different
+ notions of printing environment.
+ *)
+ let bound_in_recursion = ref M.empty
+
+ (* When dealing with functor arguments, identity becomes fuzzy because the same
+ syntactic argument may be represented by different identifiers during the
+ error processing, we are thus disabling disambiguation on the argument name
+ *)
+ let fuzzy = ref S.empty
+ let with_arg id f =
+ protect_refs [ R(fuzzy, S.add (Ident.name id) !fuzzy) ] f
+ let fuzzy_id namespace id = namespace = Module && S.mem (Ident.name id) !fuzzy
+
+ let with_hidden ids f =
+ let update m id = M.add (Ident.name id.ident) id.ident m in
+ let updated = List.fold_left update !bound_in_recursion ids in
+ protect_refs [ R(bound_in_recursion, updated )] f
+
+ let human_id id index =
+ (* The identifier with index [k] is the (k+1)-th most recent identifier in
+ the printing environment. We print them as [name/(k+1)] except for [k=0]
+ which is printed as [name] rather than [name/1].
+ *)
+ if index = 0 then
+ Ident.name id
+ else
+ let ordinal = index + 1 in
+ String.concat "/" [Ident.name id; string_of_int ordinal]
+
+ let indexed_name namespace id =
+ let find namespace id env = match namespace with
+ | Type -> Env.find_type_index id env
+ | Module -> Env.find_module_index id env
+ | Module_type -> Env.find_modtype_index id env
+ | Class -> Env.find_class_index id env
+ | Class_type-> Env.find_cltype_index id env
+ | Value | Extension_constructor | Constructor | Label -> None
+ in
+ let index =
+ match M.find_opt (Ident.name id) !bound_in_recursion with
+ | Some rec_bound_id ->
+ (* the identifier name appears in the current group of recursive
+ definition *)
+ if Ident.same rec_bound_id id then
+ Some 0
+ else
+ (* the current recursive definition shadows one more time the
+ previously existing identifier with the same name *)
+ Option.map succ (in_printing_env (find namespace id))
+ | None ->
+ in_printing_env (find namespace id)
+ in
+ let index =
+ (* If [index] is [None] at this point, it might indicate that
+ the identifier id is not defined in the environment, while there
+ are other identifiers in scope that share the same name.
+ Currently, this kind of partially incoherent environment happens
+ within functor error messages where the left and right hand side
+ have a different views of the environment at the source level.
+ Printing the source-level by using a default index of `0`
+ seems like a reasonable compromise in this situation however.*)
+ Option.value index ~default:0
+ in
+ human_id id index
+
+ let ident_name namespace id =
+ match namespace, !enabled with
+ | None, _ | _, false -> Out_name.create (Ident.name id)
+ | Some namespace, true ->
+ if fuzzy_id namespace id then Out_name.create (Ident.name id)
+ else
+ let name = indexed_name namespace id in
+ Conflicts.collect_explanation namespace id ~name;
+ Out_name.create name
+
+end
+
+let ident_name = Naming_context.ident_name
+
+let ident ppf id =
+ Fmt.pp_print_string ppf
+ (Out_name.print (Naming_context.ident_name None id))
+
+let namespaced_ident namespace id =
+ Out_name.print (Naming_context.ident_name (Some namespace) id)
+
+(* Print a Path *)
+
+let ident_stdlib = Ident.create_persistent "Stdlib"
+
+let non_shadowed_stdlib namespace = function
+ | Pdot(Pident id, s) as path ->
+ Ident.same id ident_stdlib &&
+ (match Namespace.lookup namespace s with
+ | path' -> Path.same path path'
+ | exception Not_found -> true)
+ | _ -> false
+
+let find_double_underscore s =
+ let len = String.length s in
+ let rec loop i =
+ if i + 1 >= len then
+ None
+ else if s.[i] = '_' && s.[i + 1] = '_' then
+ Some i
+ else
+ loop (i + 1)
+ in
+ loop 0
+
+let rec module_path_is_an_alias_of env path ~alias_of =
+ match Env.find_module path env with
+ | { md_type = Mty_alias path'; _ } ->
+ Path.same path' alias_of ||
+ module_path_is_an_alias_of env path' ~alias_of
+ | _ -> false
+ | exception Not_found -> false
+
+(* Simple heuristic to print Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+ for Foo__bar. This pattern is used by the stdlib. *)
+let rec rewrite_double_underscore_paths env p =
+ match p with
+ | Pdot (p, s) ->
+ Pdot (rewrite_double_underscore_paths env p, s)
+ | Papply (a, b) ->
+ Papply (rewrite_double_underscore_paths env a,
+ rewrite_double_underscore_paths env b)
+ | Pextra_ty (p, extra) ->
+ Pextra_ty (rewrite_double_underscore_paths env p, extra)
+ | Pident id ->
+ let name = Ident.name id in
+ match find_double_underscore name with
+ | None -> p
+ | Some i ->
+ let better_lid =
+ Ldot
+ (Lident (String.sub name 0 i),
+ Unit_info.modulize
+ (String.sub name (i + 2) (String.length name - i - 2)))
+ in
+ match Env.find_module_by_name better_lid env with
+ | exception Not_found -> p
+ | p', _ ->
+ if module_path_is_an_alias_of env p' ~alias_of:p then
+ p'
+ else
+ p
+
+let rewrite_double_underscore_paths env p =
+ if env == Env.empty then
+ p
+ else
+ rewrite_double_underscore_paths env p
+
+let rec tree_of_path ?(disambiguation=true) namespace p =
+ let tree_of_path namespace p = tree_of_path ~disambiguation namespace p in
+ let namespace = if disambiguation then namespace else None in
+ match p with
+ | Pident id ->
+ Oide_ident (ident_name namespace id)
+ | Pdot(_, s) as path when non_shadowed_stdlib namespace path ->
+ Oide_ident (Out_name.create s)
+ | Pdot(p, s) ->
+ Oide_dot (tree_of_path (Some Module) p, s)
+ | Papply(p1, p2) ->
+ let t1 = tree_of_path (Some Module) p1 in
+ let t2 = tree_of_path (Some Module) p2 in
+ Oide_apply (t1, t2)
+ | Pextra_ty (p, extra) -> begin
+ (* inline record types are syntactically prevented from escaping their
+ binding scope, and are never shown to users. *)
+ match extra with
+ Pcstr_ty s ->
+ Oide_dot (tree_of_path (Some Type) p, s)
+ | Pext_ty ->
+ tree_of_path None p
+ end
+
+let tree_of_path ?disambiguation namespace p =
+ tree_of_path ?disambiguation namespace
+ (rewrite_double_underscore_paths !printing_env p)
+
+let path ppf p =
+ !Oprint.out_ident ppf (tree_of_path None p)
+
+let string_of_path p =
+ Fmt.asprintf "%a" path p
+
+let strings_of_paths namespace p =
+ let trees = List.map (tree_of_path namespace) p in
+ List.map (Fmt.asprintf "%a" !Oprint.out_ident) trees
+
+let () = Env.print_path := path
+
+(* Print a recursive annotation *)
+
+let tree_of_rec = function
+ | Trec_not -> Orec_not
+ | Trec_first -> Orec_first
+ | Trec_next -> Orec_next
+
+(* Print a raw type expression, with sharing *)
+
+let raw_list pr ppf = function
+ [] -> Fmt.fprintf ppf "[]"
+ | a :: l ->
+ Fmt.fprintf ppf "@[<1>[%a%t]@]" pr a
+ (fun ppf -> List.iter (fun x -> Fmt.fprintf ppf ";@,%a" pr x) l)
+
+let kind_vars = ref []
+let kind_count = ref 0
+
+
+let string_of_field_kind v =
+ match field_kind_repr v with
+ | Fpublic -> "Fpublic"
+ | Fabsent -> "Fabsent"
+ | Fprivate -> "Fprivate"
+
+let rec safe_repr v t =
+ match Transient_expr.coerce t with
+ {desc = Tlink t} when not (List.memq t v) ->
+ safe_repr (t::v) t
+ | t' -> t'
+
+let rec list_of_memo = function
+ Mnil -> []
+ | Mcons (_priv, p, _t1, _t2, rem) -> p :: list_of_memo rem
+ | Mlink rem -> list_of_memo !rem
+
+let print_name ppf = function
+ None -> Fmt.fprintf ppf "None"
+ | Some name -> Fmt.fprintf ppf "\"%s\"" name
+
+let string_of_label = function
+ Nolabel -> ""
+ | Labelled s -> s
+ | Optional s -> "?"^s
+
+let visited = ref []
+
+let rec raw_type ppf ty =
+ let ty = safe_repr [] ty in
+ if List.memq ty !visited then Fmt.fprintf ppf "{id=%d}" ty.id else begin
+ let scope = Transient_expr.get_scope ty in
+ visited := ty :: !visited;
+ Fmt.fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;desc=@,%a}@]" ty.id ty.level
+ scope raw_type_desc ty.desc
+ end
+and raw_type_list tl = raw_list raw_type tl
+and raw_lid_type_list tl =
+ raw_list (fun ppf (lid, typ) ->
+ Fmt.fprintf ppf "(@,%a,@,%a)" longident lid raw_type typ)
+ tl
+and raw_type_desc ppf = function
+ Tvar name -> Fmt.fprintf ppf "Tvar %a" print_name name
+ | Tarrow(l,t1,t2,c) ->
+ Fmt.fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
+ (string_of_label l) raw_type t1 raw_type t2
+ (if is_commu_ok c then "Cok" else "Cunknown")
+ | Ttuple tl ->
+ Fmt.fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
+ | Tconstr (p, tl, abbrev) ->
+ Fmt.fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p
+ raw_type_list tl
+ (raw_list path) (list_of_memo !abbrev)
+ | Tobject (t, nm) ->
+ Fmt.fprintf ppf "@[<hov1>Tobject(@,%a,@,@[<1>ref%t@])@]" raw_type t
+ (fun ppf ->
+ match !nm with None -> Fmt.fprintf ppf " None"
+ | Some(p,tl) ->
+ Fmt.fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
+ | Tfield (f, k, t1, t2) ->
+ Fmt.fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
+ (string_of_field_kind k)
+ raw_type t1 raw_type t2
+ | Tnil -> Fmt.fprintf ppf "Tnil"
+ | Tlink t -> Fmt.fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
+ | Tsubst (t, None) -> Fmt.fprintf ppf "@[<1>Tsubst@,(%a,None)@]" raw_type t
+ | Tsubst (t, Some t') ->
+ Fmt.fprintf ppf "@[<1>Tsubst@,(%a,@ Some%a)@]" raw_type t raw_type t'
+ | Tunivar name -> Fmt.fprintf ppf "Tunivar %a" print_name name
+ | Tpoly (t, tl) ->
+ Fmt.fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
+ raw_type t
+ raw_type_list tl
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ Fmt.fprintf ppf
+ "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
+ "row_fields="
+ (raw_list (fun ppf (l, f) ->
+ Fmt.fprintf ppf "@[%s,@ %a@]" l raw_field f))
+ fields
+ "row_more=" raw_type more
+ "row_closed=" closed
+ "row_fixed=" raw_row_fixed fixed
+ "row_name="
+ (fun ppf ->
+ match name with None -> Fmt.fprintf ppf "None"
+ | Some(p,tl) ->
+ Fmt.fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
+ | Tpackage (p, fl) ->
+ Fmt.fprintf ppf "@[<hov1>Tpackage(@,%a,@,%a)@]" path p raw_lid_type_list fl
+
+and raw_row_fixed ppf = function
+ | None -> Fmt.fprintf ppf "None"
+ | Some Types.Fixed_private -> Fmt.fprintf ppf "Some Fixed_private"
+ | Some Types.Rigid -> Fmt.fprintf ppf "Some Rigid"
+ | Some Types.Univar t -> Fmt.fprintf ppf "Some(Univar(%a))" raw_type t
+ | Some Types.Reified p -> Fmt.fprintf ppf "Some(Reified(%a))" path p
+
+and raw_field ppf rf =
+ match_row_field
+ ~absent:(fun _ -> Fmt.fprintf ppf "RFabsent")
+ ~present:(function
+ | None ->
+ Fmt.fprintf ppf "RFpresent None"
+ | Some t ->
+ Fmt.fprintf ppf "@[<1>RFpresent(Some@,%a)@]" raw_type t)
+ ~either:(fun c tl m e ->
+ Fmt.fprintf ppf "@[<hov1>RFeither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
+ raw_type_list tl m
+ (fun ppf ->
+ match e with _, None -> Fmt.fprintf ppf " RFnone"
+ | _, Some f -> Fmt.fprintf ppf "@,@[<1>(%a)@]" raw_field f))
+ rf
+
+let raw_type_expr ppf t =
+ visited := []; kind_vars := []; kind_count := 0;
+ raw_type ppf t;
+ visited := []; kind_vars := []
+
+
+(* Normalize paths *)
+
+let set_printing_env env =
+ printing_env :=
+ if !Clflags.real_paths then Env.empty
+ else env
+
+let wrap_printing_env env f =
+ set_printing_env (Env.update_short_paths env);
+ try_finally f ~always:(fun () -> set_printing_env Env.empty)
+
+
+let wrap_printing_env ?error:_ env f =
+ Env.without_cmis (wrap_printing_env env) f
+
+type type_result = Short_paths.type_result =
+ | Nth of int
+ | Path of int list option * Path.t
+
+type type_resolution = Short_paths.type_resolution =
+ | Nth of int
+ | Subst of int list
+ | Id
+
+let apply_subst ns args =
+ List.map (List.nth args) ns
+
+let apply_subst_opt nso args =
+ match nso with
+ | None -> args
+ | Some ns -> apply_subst ns args
+
+
+let apply_nth n args =
+ List.nth args n
+
+let best_type_path p =
+ if !Clflags.real_paths || !printing_env == Env.empty
+ then Path(None, p)
+ else Short_paths.find_type (Env.short_paths !printing_env) p
+
+let best_type_path_resolution p =
+ if !Clflags.real_paths || !printing_env == Env.empty
+ then Id
+ else Short_paths.find_type_resolution (Env.short_paths !printing_env) p
+
+let best_type_path_simple p =
+ if !Clflags.real_paths || !printing_env == Env.empty
+ then p
+ else Short_paths.find_type_simple (Env.short_paths !printing_env) p
+
+let best_module_type_path p =
+ if !Clflags.real_paths || !printing_env == Env.empty
+ then p
+ else Short_paths.find_module_type (Env.short_paths !printing_env) p
+
+let best_module_path p =
+ if !Clflags.real_paths || !printing_env == Env.empty
+ then p
+ else Short_paths.find_module (Env.short_paths !printing_env) p
+
+let best_class_type_path p =
+ if !Clflags.real_paths || !printing_env == Env.empty
+ then None, p
+ else Short_paths.find_class_type (Env.short_paths !printing_env) p
+
+let best_class_type_path_simple p =
+ if !Clflags.real_paths || !printing_env == Env.empty
+ then p
+ else Short_paths.find_class_type_simple (Env.short_paths !printing_env) p
+
+(* When building a tree for a best type path, we should not disambiguate
+ identifiers whenever the short-path algorithm detected a better path than
+ the original one.*)
+let tree_of_best_type_path p p' =
+ if Path.same p p' then tree_of_path (Some Type) p'
+ else tree_of_path ~disambiguation:false None p'
+
+(* Print a type expression *)
+
+let proxy ty = Transient_expr.repr (Btype.proxy ty)
+
+(* When printing a type scheme, we print weak names. When printing a plain
+ type, we do not. This type controls that behavior *)
+type type_or_scheme = Type | Type_scheme
+
+
+
+let is_non_gen mode ty =
+ match mode with
+ | Type_scheme -> is_Tvar ty && get_level ty <> generic_level
+ | Type -> false
+
+let nameable_row row =
+ row_name row <> None &&
+ List.for_all
+ (fun (_, f) ->
+ match row_field_repr f with
+ | Reither(c, l, _) ->
+ row_closed row && if c then l = [] else List.length l = 1
+ | _ -> true)
+ (row_fields row)
+
+(* This specialized version of [Btype.iter_type_expr] normalizes and
+ short-circuits the traversal of the [type_expr], so that it covers only the
+ subterms that would be printed by the type printer. *)
+let printer_iter_type_expr f ty =
+ match get_desc ty with
+ | Tconstr(p, tyl, _) -> begin
+ match best_type_path_resolution p with
+ | Nth n ->
+ f (apply_nth n tyl)
+ | Subst ns ->
+ List.iter f (apply_subst ns tyl)
+ | Id ->
+ List.iter f tyl
+ end
+ | Tvariant row -> begin
+ match row_name row with
+ | Some(_p, tyl) when nameable_row row ->
+ List.iter f tyl
+ | _ ->
+ iter_row f row
+ end
+ | Tobject (fi, nm) -> begin
+ match !nm with
+ | None ->
+ let fields, _ = flatten_fields fi in
+ List.iter
+ (fun (_, kind, ty) ->
+ if field_kind_repr kind = Fpublic then
+ f ty)
+ fields
+ | Some (_, l) ->
+ List.iter f (List.tl l)
+ end
+ | Tfield(_, kind, ty1, ty2) ->
+ if field_kind_repr kind = Fpublic then
+ f ty1;
+ f ty2
+ | _ ->
+ Btype.iter_type_expr f ty
+
+
+module Internal_names : sig
+ val reset : unit -> unit
+ val add : Path.t -> unit
+ val print_explanations : Env.t -> Format.formatter -> unit
+end = struct
+
+ let names = ref Ident.Set.empty
+
+ let reset () =
+ names := Ident.Set.empty
+
+ let add p =
+ match p with
+ | Pident id ->
+ let name = Ident.name id in
+ if String.length name > 0 && name.[0] = '$' then begin
+ names := Ident.Set.add id !names
+ end
+ | Pdot _ | Papply _ | Pextra_ty _ -> ()
+
+ let print_explanations env ppf =
+ let constrs =
+ Ident.Set.fold
+ (fun id acc ->
+ let p = Pident id in
+ match Env.find_type p env with
+ | exception Not_found -> acc
+ | decl ->
+ match type_origin decl with
+ | Existential constr ->
+ let prev = String.Map.find_opt constr acc in
+ let prev = Option.value ~default:[] prev in
+ String.Map.add constr (tree_of_path None p :: prev) acc
+ | Definition | Rec_check_regularity -> acc)
+ !names String.Map.empty
+ in
+ String.Map.iter
+ (fun constr out_idents ->
+ match out_idents with
+ | [] -> ()
+ | [out_ident] ->
+ Format.fprintf ppf
+ "@ @[<2>@{<hint>Hint@}:@ %a@ is an existential type@ \
+ bound by the constructor@ %a.@]"
+ (Fmt.compat1 Style.as_inline_code !Oprint.out_ident) out_ident
+ (Fmt.compat Style.inline_code) constr
+ | out_ident :: out_idents ->
+ Format.fprintf ppf
+ "@ @[<2>@{<hint>Hint@}:@ %a@ and %a@ are existential types@ \
+ bound by the constructor@ %a.@]"
+ (Format.pp_print_list
+ ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
+ (Fmt.compat1 Style.as_inline_code !Oprint.out_ident))
+ (List.rev out_idents)
+ (Fmt.compat1 Style.as_inline_code !Oprint.out_ident) out_ident
+ (Fmt.compat Style.inline_code) constr)
+ constrs
+
+end
+
+module Names : sig
+ val reset_names : unit -> unit
+
+ val add_named_vars : type_expr -> unit
+ val add_subst : (type_expr * type_expr) list -> unit
+
+ val new_name : unit -> string
+ val new_var_name : non_gen:bool -> type_expr -> unit -> string
+
+ val name_of_type : (unit -> string) -> transient_expr -> string
+ val check_name_of_type : non_gen:bool -> transient_expr -> unit
+
+ val remove_names : transient_expr list -> unit
+
+ val with_local_names : (unit -> 'a) -> 'a
+
+ (* Refresh the weak variable map in the toplevel; for [print_items], which is
+ itself for the toplevel *)
+ val refresh_weak : unit -> unit
+end = struct
+ (* We map from types to names, but not directly; we also store a substitution,
+ which maps from types to types. The lookup process is
+ "type -> apply substitution -> find name". The substitution is presumed to
+ be acyclic. *)
+ let names = ref ([] : (transient_expr * string) list)
+ let name_subst = ref ([] : (transient_expr * transient_expr) list)
+ let name_counter = ref 0
+ let named_vars = ref ([] : string list)
+ let visited_for_named_vars = ref ([] : transient_expr list)
+
+ let weak_counter = ref 1
+ let weak_var_map = ref TypeMap.empty
+ let named_weak_vars = ref String.Set.empty
+
+ let reset_names () =
+ names := [];
+ name_subst := [];
+ name_counter := 0;
+ named_vars := [];
+ visited_for_named_vars := []
+
+ let add_named_var tty =
+ match tty.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ if List.mem name !named_vars then () else
+ named_vars := name :: !named_vars
+ | _ -> ()
+
+ let rec add_named_vars ty =
+ let tty = Transient_expr.repr ty in
+ let px = proxy ty in
+ if not (List.memq px !visited_for_named_vars) then begin
+ visited_for_named_vars := px :: !visited_for_named_vars;
+ match tty.desc with
+ | Tvar _ | Tunivar _ ->
+ add_named_var tty
+ | _ ->
+ printer_iter_type_expr add_named_vars ty
+ end
+
+ let rec substitute ty =
+ match List.assq ty !name_subst with
+ | ty' -> substitute ty'
+ | exception Not_found -> ty
+
+ let add_subst subst =
+ name_subst :=
+ List.map (fun (t1,t2) -> Transient_expr.repr t1, Transient_expr.repr t2)
+ subst
+ @ !name_subst
+
+ let name_is_already_used name =
+ List.mem name !named_vars
+ || List.exists (fun (_, name') -> name = name') !names
+ || String.Set.mem name !named_weak_vars
+
+ let rec new_name () =
+ let name = Misc.letter_of_int !name_counter in
+ incr name_counter;
+ if name_is_already_used name then new_name () else name
+
+ let rec new_weak_name ty () =
+ let name = "weak" ^ Int.to_string !weak_counter in
+ incr weak_counter;
+ if name_is_already_used name then new_weak_name ty ()
+ else begin
+ named_weak_vars := String.Set.add name !named_weak_vars;
+ weak_var_map := TypeMap.add ty name !weak_var_map;
+ name
+ end
+
+ let new_var_name ~non_gen ty () =
+ if non_gen then new_weak_name ty ()
+ else new_name ()
+
+ let name_of_type name_generator t =
+ (* We've already been through repr at this stage, so t is our representative
+ of the union-find class. *)
+ let t = substitute t in
+ try List.assq t !names with Not_found ->
+ try TransientTypeMap.find t !weak_var_map with Not_found ->
+ let name =
+ match t.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ (* Some part of the type we've already printed has assigned another
+ * unification variable to that name. We want to keep the name, so
+ * try adding a number until we find a name that's not taken. *)
+ let available name =
+ List.for_all
+ (fun (_, name') -> name <> name')
+ !names
+ in
+ if available name then name
+ else
+ let suffixed i = name ^ Int.to_string i in
+ let i = Misc.find_first_mono (fun i -> available (suffixed i)) in
+ suffixed i
+ | _ ->
+ (* No name available, create a new one *)
+ name_generator ()
+ in
+ (* Exception for type declarations *)
+ if name <> "_" then names := (t, name) :: !names;
+ name
+
+ let check_name_of_type ~non_gen px =
+ let name_gen = new_var_name ~non_gen (Transient_expr.type_expr px) in
+ ignore(name_of_type name_gen px)
+
+ let remove_names tyl =
+ let tyl = List.map substitute tyl in
+ names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+
+ let with_local_names f =
+ let old_names = !names in
+ let old_subst = !name_subst in
+ names := [];
+ name_subst := [];
+ try_finally
+ ~always:(fun () ->
+ names := old_names;
+ name_subst := old_subst)
+ f
+
+ let refresh_weak () =
+ let refresh t name (m,s) =
+ if is_non_gen Type_scheme t then
+ begin
+ TypeMap.add t name m,
+ String.Set.add name s
+ end
+ else m, s in
+ let m, s =
+ TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
+ named_weak_vars := s;
+ weak_var_map := m
+end
+
+let reserve_names ty =
+ normalize_type ty;
+ Names.add_named_vars ty
+
+let visited_objects = ref ([] : transient_expr list)
+let aliased = ref ([] : transient_expr list)
+let delayed = ref ([] : transient_expr list)
+let printed_aliases = ref ([] : transient_expr list)
+
+(* [printed_aliases] is a subset of [aliased] that records only those aliased
+ types that have actually been printed; this allows us to avoid naming loops
+ that the user will never see. *)
+
+
+let add_delayed t =
+ if not (List.memq t !delayed) then delayed := t :: !delayed
+
+let is_aliased_proxy px = List.memq px !aliased
+
+let add_alias_proxy px =
+ if not (is_aliased_proxy px) then
+ aliased := px :: !aliased
+
+let add_alias ty = add_alias_proxy (proxy ty)
+
+let add_printed_alias_proxy ~non_gen px =
+ Names.check_name_of_type ~non_gen px;
+ printed_aliases := px :: !printed_aliases
+
+let add_printed_alias ty = add_printed_alias_proxy (proxy ty)
+
+let aliasable ty =
+ match get_desc ty with
+ Tvar _ | Tunivar _ | Tpoly _ -> false
+ | Tconstr (p, _, _) -> begin
+ match best_type_path_resolution p with
+ | Nth _ -> false
+ | Subst _ | Id -> true
+ end
+ | _ -> true
+
+let should_visit_object ty =
+ match get_desc ty with
+ | Tvariant row -> not (static_row row)
+ | Tobject _ -> opened_object ty
+ | _ -> false
+
+let rec mark_loops_rec visited ty =
+ let px = proxy ty in
+ if List.memq px visited && aliasable ty then add_alias_proxy px else
+ let tty = Transient_expr.repr ty in
+ let visited = px :: visited in
+ match tty.desc with
+ | Tvariant _ | Tobject _ ->
+ if List.memq px !visited_objects then add_alias_proxy px else begin
+ if should_visit_object ty then
+ visited_objects := px :: !visited_objects;
+ printer_iter_type_expr (mark_loops_rec visited) ty
+ end
+ | Tpoly(ty, tyl) ->
+ List.iter add_alias tyl;
+ mark_loops_rec visited ty
+ | _ ->
+ printer_iter_type_expr (mark_loops_rec visited) ty
+
+
+let mark_loops ty =
+ mark_loops_rec [] ty
+
+let prepare_type ty =
+ reserve_names ty;
+ mark_loops ty
+
+let reset_loop_marks () =
+ visited_objects := [];
+ aliased := [];
+ delayed := [];
+ printed_aliases := []
+
+let reset_except_context () =
+ Names.reset_names ();
+ reset_loop_marks ();
+ Internal_names.reset ()
+
+let reset () =
+ Conflicts.reset ();
+ reset_except_context ()
+
+let prepare_for_printing tyl =
+ reset_except_context ();
+ List.iter prepare_type tyl
+
+let add_type_to_preparation = prepare_type
+
+(* Disabled in classic mode when printing an unification error *)
+let print_labels = ref true
+
+
+let alias_nongen_row mode px ty =
+ match get_desc ty with
+ | Tvariant _ | Tobject _ ->
+ if is_non_gen mode (Transient_expr.type_expr px) then
+ add_alias_proxy px
+ | _ -> ()
+
+let rec tree_of_typexp mode ty =
+ let px = proxy ty in
+ if List.memq px !printed_aliases && not (List.memq px !delayed) then
+ let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+ let name = Names.name_of_type (Names.new_var_name ~non_gen ty) px in
+ Otyp_var (non_gen, name) else
+
+ let pr_typ () =
+ let tty = Transient_expr.repr ty in
+ match tty.desc with
+ | Tvar _ ->
+ let non_gen = is_non_gen mode ty in
+ let name_gen = Names.new_var_name ~non_gen ty in
+ Otyp_var (non_gen, Names.name_of_type name_gen tty)
+ | Tarrow(l, ty1, ty2, _) ->
+ let lab =
+ if !print_labels || is_optional l then l else Nolabel
+ in
+ let t1 =
+ if is_optional l then
+ match get_desc ty1 with
+ | Tconstr(path, [ty], _)
+ when Path.same path Predef.path_option ->
+ tree_of_typexp mode ty
+ | _ -> Otyp_stuff "<hidden>"
+ else tree_of_typexp mode ty1 in
+ Otyp_arrow (lab, t1, tree_of_typexp mode ty2)
+ | Ttuple tyl ->
+ Otyp_tuple (tree_of_typlist mode tyl)
+ | Tconstr(p, tyl, _abbrev) -> begin
+ match best_type_path p with
+ | Nth n -> tree_of_typexp mode (apply_nth n tyl)
+ | Path(nso, p') ->
+ Internal_names.add p';
+ let tyl' = apply_subst_opt nso tyl in
+ Otyp_constr (tree_of_path (Some Type) p', tree_of_typlist mode tyl')
+ end
+ | Tvariant row ->
+ let Row {fields; name; closed; _} = row_repr row in
+ let fields =
+ if closed then
+ List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
+ fields
+ else fields in
+ let present =
+ List.filter
+ (fun (_, f) ->
+ match row_field_repr f with
+ | Rpresent _ -> true
+ | _ -> false)
+ fields in
+ let all_present = List.length present = List.length fields in
+ begin match name with
+ | Some(p, tyl) when nameable_row row ->
+ let out_variant =
+ match best_type_path p with
+ | Nth n -> tree_of_typexp mode (apply_nth n tyl)
+ | Path(s, p) ->
+ let id = tree_of_path (Some Type) p in
+ let args = tree_of_typlist mode (apply_subst_opt s tyl) in
+ Otyp_constr (id, args)
+ in
+ if closed && all_present then
+ out_variant
+ else
+ let tags =
+ if all_present then None else Some (List.map fst present) in
+ Otyp_variant (Ovar_typ out_variant, closed, tags)
+ | _ ->
+ let fields = List.map (tree_of_row_field mode) fields in
+ let tags =
+ if all_present then None else Some (List.map fst present) in
+ Otyp_variant (Ovar_fields fields, closed, tags)
+ end
+ | Tobject (fi, nm) ->
+ tree_of_typobject mode fi !nm
+ | Tnil | Tfield _ ->
+ tree_of_typobject mode ty None
+ | Tsubst _ ->
+ (* This case should only happen when debugging the compiler *)
+ Otyp_stuff "<Tsubst>"
+ | Tlink _ ->
+ fatal_error "Printtyp.tree_of_typexp"
+ | Tpoly (ty, []) ->
+ tree_of_typexp mode ty
+ | Tpoly (ty, tyl) ->
+ (*let print_names () =
+ List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
+ prerr_string "; " in *)
+ if tyl = [] then tree_of_typexp mode ty else begin
+ let tyl = List.map Transient_expr.repr tyl in
+ let old_delayed = !delayed in
+ (* Make the names delayed, so that the real type is
+ printed once when used as proxy *)
+ List.iter add_delayed tyl;
+ let tl = List.map (Names.name_of_type Names.new_name) tyl in
+ let tr = Otyp_poly (tl, tree_of_typexp mode ty) in
+ (* Forget names when we leave scope *)
+ Names.remove_names tyl;
+ delayed := old_delayed; tr
+ end
+ | Tunivar _ ->
+ Otyp_var (false, Names.name_of_type Names.new_name tty)
+ | Tpackage (p, fl) ->
+ let p = best_module_type_path p in
+ let fl =
+ List.map
+ (fun (li, ty) -> (
+ String.concat "." (Longident.flatten li),
+ tree_of_typexp mode ty
+ )) fl in
+ Otyp_module (tree_of_path (Some Module_type) p, fl)
+ in
+ if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
+ alias_nongen_row mode px ty;
+ if is_aliased_proxy px && aliasable ty then begin
+ let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+ add_printed_alias_proxy ~non_gen px;
+ (* add_printed_alias chose a name, thus the name generator
+ doesn't matter.*)
+ let alias = Names.name_of_type (Names.new_var_name ~non_gen ty) px in
+ Otyp_alias {non_gen; aliased = pr_typ (); alias } end
+ else pr_typ ()
+
+and tree_of_row_field mode (l, f) =
+ match row_field_repr f with
+ | Rpresent None | Reither(true, [], _) -> (l, false, [])
+ | Rpresent(Some ty) -> (l, false, [tree_of_typexp mode ty])
+ | Reither(c, tyl, _) ->
+ if c (* contradiction: constant constructor with an argument *)
+ then (l, true, tree_of_typlist mode tyl)
+ else (l, false, tree_of_typlist mode tyl)
+ | Rabsent -> (l, false, [] (* actually, an error *))
+
+and tree_of_typlist mode tyl =
+ List.map (tree_of_typexp mode) tyl
+
+and tree_of_typobject mode fi nm =
+ begin match nm with
+ | None ->
+ let pr_fields fi =
+ let (fields, rest) = flatten_fields fi in
+ let present_fields =
+ List.fold_right
+ (fun (n, k, t) l ->
+ match field_kind_repr k with
+ | Fpublic -> (n, t) :: l
+ | _ -> l)
+ fields [] in
+ let sorted_fields =
+ List.sort
+ (fun (n, _) (n', _) -> String.compare n n') present_fields in
+ tree_of_typfields mode rest sorted_fields in
+ let (fields, open_row) = pr_fields fi in
+ Otyp_object {fields; open_row}
+ | Some (p, _ty :: tyl) ->
+ let args = tree_of_typlist mode tyl in
+ let p' = best_type_path_simple p in
+ Otyp_class (tree_of_best_type_path p p', args)
+ | _ ->
+ fatal_error "Printtyp.tree_of_typobject"
+ end
+
+and tree_of_typfields mode rest = function
+ | [] ->
+ let open_row =
+ match get_desc rest with
+ | Tvar _ | Tunivar _ | Tconstr _-> true
+ | Tnil -> false
+ | _ -> fatal_error "typfields (1)"
+ in
+ ([], open_row)
+ | (s, t) :: l ->
+ let field = (s, tree_of_typexp mode t) in
+ let (fields, rest) = tree_of_typfields mode rest l in
+ (field :: fields, rest)
+
+let typexp mode ppf ty =
+ !Oprint.out_type ppf (tree_of_typexp mode ty)
+
+let prepared_type_expr ppf ty = typexp Type ppf ty
+let prepared_type_scheme ppf ty = typexp Type_scheme ppf ty
+
+let type_expr ppf ty =
+ (* [type_expr] is used directly by error message printers,
+ we mark eventual loops ourself to avoid any misuse and stack overflow *)
+ prepare_for_printing [ty];
+ prepared_type_expr ppf ty
+
+(* "Half-prepared" type expression: [ty] should have had its names reserved, but
+ should not have had its loops marked. *)
+let type_expr_with_reserved_names ppf ty =
+ reset_loop_marks ();
+ mark_loops ty;
+ prepared_type_expr ppf ty
+
+let shared_type_scheme ppf ty =
+ prepare_type ty;
+ typexp Type_scheme ppf ty
+
+let type_scheme ppf ty =
+ prepare_for_printing [ty];
+ prepared_type_scheme ppf ty
+
+let type_path ppf p =
+ let p = best_class_type_path_simple p in
+ let t = tree_of_path (Some Type) p in
+ !Oprint.out_ident ppf t
+
+let tree_of_type_scheme ty =
+ prepare_for_printing [ty];
+ tree_of_typexp Type_scheme ty
+
+(* Print one type declaration *)
+
+let tree_of_constraints params =
+ List.fold_right
+ (fun ty list ->
+ let ty' = unalias ty in
+ if proxy ty != proxy ty' then
+ let tr = tree_of_typexp Type_scheme ty in
+ (tr, tree_of_typexp Type_scheme ty') :: list
+ else list)
+ params []
+
+let filter_params tyl =
+ let params =
+ List.fold_left
+ (fun tyl ty ->
+ if List.exists (eq_type ty) tyl
+ then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
+ else ty :: tyl)
+ (* Two parameters might be identical due to a constraint but we need to
+ print them differently in order to make the output syntactically valid.
+ We use [Ttuple [ty]] because it is printed as [ty]. *)
+ (* Replacing fold_left by fold_right does not work! *)
+ [] tyl
+ in List.rev params
+
+let prepare_type_constructor_arguments = function
+ | Cstr_tuple l -> List.iter prepare_type l
+ | Cstr_record l -> List.iter (fun l -> prepare_type l.ld_type) l
+
+let tree_of_label l = {
+ olab_name = Ident.name l.ld_id;
+ olab_mut = l.ld_mutable;
+ olab_type = tree_of_typexp Type l.ld_type;
+}
+
+let tree_of_constructor_arguments = function
+ | Cstr_tuple l -> tree_of_typlist Type l
+ | Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
+
+let tree_of_single_constructor cd =
+ let name = Ident.name cd.cd_id in
+ let ret = Option.map (tree_of_typexp Type) cd.cd_res in
+ let args = tree_of_constructor_arguments cd.cd_args in
+ { ocstr_name = name;
+ ocstr_args = args;
+ ocstr_return_type = ret;
+ }
+
+
+(* When printing GADT constructor, we need to forget the naming decision we took
+ for the type parameters and constraints. Indeed, in
+ {[
+ type 'a t = X: 'a -> 'b t
+ ]}
+ It is fine to print both the type parameter ['a] and the existentially
+ quantified ['a] in the definition of the constructor X as ['a]
+*)
+let tree_of_constructor_in_decl cd =
+ match cd.cd_res with
+ | None -> tree_of_single_constructor cd
+ | Some _ -> Names.with_local_names (fun () -> tree_of_single_constructor cd)
+
+let prepare_decl id decl =
+ let params = filter_params decl.type_params in
+ begin match decl.type_manifest with
+ | Some ty ->
+ let vars = free_variables ty in
+ List.iter
+ (fun ty ->
+ if get_desc ty = Tvar (Some "_") && List.exists (eq_type ty) vars
+ then set_type_desc ty (Tvar None))
+ params
+ | None -> ()
+ end;
+ List.iter add_alias params;
+ List.iter prepare_type params;
+ List.iter (add_printed_alias ~non_gen:false) params;
+ let ty_manifest =
+ match decl.type_manifest with
+ | None -> None
+ | Some ty ->
+ let ty =
+ (* Special hack to hide variant name *)
+ match get_desc ty with
+ Tvariant row ->
+ begin match row_name row with
+ Some (Pident id', _) when Ident.same id id' ->
+ newgenty (Tvariant (set_row_name row None))
+ | _ -> ty
+ end
+ | _ -> ty
+ in
+ prepare_type ty;
+ Some ty
+ in
+ begin match decl.type_kind with
+ | Type_abstract _ -> ()
+ | Type_variant (cstrs, _rep) ->
+ List.iter
+ (fun c ->
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res)
+ cstrs
+ | Type_record(l, _rep) ->
+ List.iter (fun l -> prepare_type l.ld_type) l
+ | Type_open -> ()
+ end;
+ ty_manifest, params
+
+let tree_of_type_decl id decl =
+ let ty_manifest, params = prepare_decl id decl in
+ let type_param ot_variance =
+ function
+ | Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+ | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+ in
+ let type_defined decl =
+ let abstr =
+ match decl.type_kind with
+ Type_abstract _ ->
+ decl.type_manifest = None || decl.type_private = Private
+ | Type_record _ ->
+ decl.type_private = Private
+ | Type_variant (tll, _rep) ->
+ decl.type_private = Private ||
+ List.exists (fun cd -> cd.cd_res <> None) tll
+ | Type_open ->
+ decl.type_manifest = None
+ in
+ let vari =
+ List.map2
+ (fun ty v ->
+ let is_var = is_Tvar ty in
+ if abstr || not is_var then
+ let inj =
+ type_kind_is_abstract decl && Variance.mem Inj v &&
+ match decl.type_manifest with
+ | None -> true
+ | Some ty -> (* only abstract or private row types *)
+ decl.type_private = Private &&
+ Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
+ and (co, cn) = Variance.get_upper v in
+ (if not cn then Covariant else
+ if not co then Contravariant else NoVariance),
+ (if inj then Injective else NoInjectivity)
+ else (NoVariance, NoInjectivity))
+ decl.type_params decl.type_variance
+ in
+ (Ident.name id,
+ List.map2 (fun ty cocn -> type_param cocn (tree_of_typexp Type ty))
+ params vari)
+ in
+ let tree_of_manifest ty1 =
+ match ty_manifest with
+ | None -> ty1
+ | Some ty -> Otyp_manifest (tree_of_typexp Type ty, ty1)
+ in
+ let (name, args) = type_defined decl in
+ let constraints = tree_of_constraints params in
+ let ty, priv, unboxed =
+ match decl.type_kind with
+ | Type_abstract _ ->
+ begin match ty_manifest with
+ | None -> (Otyp_abstract, Public, false)
+ | Some ty ->
+ tree_of_typexp Type ty, decl.type_private, false
+ end
+ | Type_variant (cstrs, rep) ->
+ tree_of_manifest
+ (Otyp_sum (List.map tree_of_constructor_in_decl cstrs)),
+ decl.type_private,
+ (rep = Variant_unboxed)
+ | Type_record(lbls, rep) ->
+ tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
+ decl.type_private,
+ (match rep with Record_unboxed _ -> true | _ -> false)
+ | Type_open ->
+ tree_of_manifest Otyp_open,
+ decl.type_private,
+ false
+ in
+ { otype_name = name;
+ otype_params = args;
+ otype_type = ty;
+ otype_private = priv;
+ otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
+ otype_unboxed = unboxed;
+ otype_cstrs = constraints }
+
+let add_type_decl_to_preparation id decl =
+ ignore @@ prepare_decl id decl
+
+let tree_of_prepared_type_decl id decl =
+ tree_of_type_decl id decl
+
+let tree_of_type_decl id decl =
+ reset_except_context();
+ tree_of_type_decl id decl
+
+let add_constructor_to_preparation c =
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res
+
+let prepared_constructor ppf c =
+ !Oprint.out_constr ppf (tree_of_single_constructor c)
+
+let constructor ppf c =
+ reset_except_context ();
+ add_constructor_to_preparation c;
+ prepared_constructor ppf c
+
+let label ppf l =
+ reset_except_context ();
+ prepare_type l.ld_type;
+ !Oprint.out_label ppf (tree_of_label l)
+
+let tree_of_type_declaration id decl rs =
+ Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
+
+let tree_of_prepared_type_declaration id decl rs =
+ Osig_type (tree_of_prepared_type_decl id decl, tree_of_rec rs)
+
+let type_declaration id ppf decl =
+ !Oprint.out_sig_item ppf (tree_of_type_declaration id decl Trec_first)
+
+let add_type_declaration_to_preparation id decl =
+ add_type_decl_to_preparation id decl
+
+let prepared_type_declaration id ppf decl =
+ !Oprint.out_sig_item ppf
+ (tree_of_prepared_type_declaration id decl Trec_first)
+
+let constructor_arguments ppf a =
+ let tys = tree_of_constructor_arguments a in
+ !Oprint.out_type ppf (Otyp_tuple tys)
+
+(* Print an extension declaration *)
+
+let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
+ let ret = Option.map (tree_of_typexp Type) ext_ret_type in
+ let args = tree_of_constructor_arguments ext_args in
+ (args, ret)
+
+(* When printing extension constructor, it is important to ensure that
+ after printing the constructor, we are still in the scope of the constructor.
+ For GADT constructor, this can be done by printing the type parameters inside
+ their own isolated scope. This ensures that in
+ {[
+ type 'b t += A: 'b -> 'b any t
+ ]}
+ the type parameter `'b` is not bound when printing the type variable `'b` from
+ the constructor definition from the type parameter.
+
+ Contrarily, for non-gadt constructor, we must keep the same scope for
+ the type parameters and the constructor because a type constraint may
+ have changed the name of the type parameter:
+ {[
+ type -'a t = .. constraint <x:'a. 'a t -> 'a> = 'a
+ (* the universal 'a is here to steal the name 'a from the type parameter *)
+ type 'a t = X of 'a
+ ]} *)
+
+let add_extension_constructor_to_preparation ext =
+ let ty_params = filter_params ext.ext_type_params in
+ List.iter add_alias ty_params;
+ List.iter prepare_type ty_params;
+ prepare_type_constructor_arguments ext.ext_args;
+ Option.iter prepare_type ext.ext_ret_type
+
+let prepared_tree_of_extension_constructor
+ id ext es
+ =
+ let type_path = best_type_path_simple ext.ext_type_path in
+ let ty_name = Path.name type_path in
+ let ty_params = filter_params ext.ext_type_params in
+ let type_param =
+ function
+ | Otyp_var (_, id) -> id
+ | _ -> "?"
+ in
+ let param_scope f =
+ match ext.ext_ret_type with
+ | None ->
+ (* normal constructor: same scope for parameters and the constructor *)
+ f ()
+ | Some _ ->
+ (* gadt constructor: isolated scope for the type parameters *)
+ Names.with_local_names f
+ in
+ let ty_params =
+ param_scope
+ (fun () ->
+ List.iter (add_printed_alias ~non_gen:false) ty_params;
+ List.map (fun ty -> type_param (tree_of_typexp Type ty)) ty_params
+ )
+ in
+ let name = Ident.name id in
+ let args, ret =
+ extension_constructor_args_and_ret_type_subtree
+ ext.ext_args
+ ext.ext_ret_type
+ in
+ let ext =
+ { oext_name = name;
+ oext_type_name = ty_name;
+ oext_type_params = ty_params;
+ oext_args = args;
+ oext_ret_type = ret;
+ oext_private = ext.ext_private }
+ in
+ let es =
+ match es with
+ Text_first -> Oext_first
+ | Text_next -> Oext_next
+ | Text_exception -> Oext_exception
+ in
+ Osig_typext (ext, es)
+
+let tree_of_extension_constructor id ext es =
+ reset_except_context ();
+ add_extension_constructor_to_preparation ext;
+ prepared_tree_of_extension_constructor id ext es
+
+let extension_constructor id ppf ext =
+ !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
+
+let prepared_extension_constructor id ppf ext =
+ !Oprint.out_sig_item ppf
+ (prepared_tree_of_extension_constructor id ext Text_first)
+
+let extension_only_constructor id ppf ext =
+ reset_except_context ();
+ prepare_type_constructor_arguments ext.ext_args;
+ Option.iter prepare_type ext.ext_ret_type;
+ let name = Ident.name id in
+ let args, ret =
+ extension_constructor_args_and_ret_type_subtree
+ ext.ext_args
+ ext.ext_ret_type
+ in
+ Fmt.fprintf ppf "@[<hv>%a@]"
+ !Oprint.out_constr {
+ ocstr_name = name;
+ ocstr_args = args;
+ ocstr_return_type = ret;
+ }
+
+(* Print a value declaration *)
+
+let tree_of_value_description id decl =
+ (* Format.eprintf "@[%a@]@." raw_type_expr decl.val_type; *)
+ let id = Ident.name id in
+ let ty = tree_of_type_scheme decl.val_type in
+ let vd =
+ { oval_name = id;
+ oval_type = ty;
+ oval_prims = [];
+ oval_attributes = [] }
+ in
+ let vd =
+ match decl.val_kind with
+ | Val_prim p -> Primitive.print p vd
+ | _ -> vd
+ in
+ Osig_value vd
+
+let value_description id ppf decl =
+ !Oprint.out_sig_item ppf (tree_of_value_description id decl)
+
+(* Print a class type *)
+
+
+let method_type priv ty =
+ match priv, get_desc ty with
+ | Mpublic, Tpoly(ty, tyl) -> (ty, tyl)
+ | _ , _ -> (ty, [])
+
+let prepare_method _lab (priv, _virt, ty) =
+ let ty, _ = method_type priv ty in
+ prepare_type ty
+
+let tree_of_method mode (lab, priv, virt, ty) =
+ let (ty, tyl) = method_type priv ty in
+ let tty = tree_of_typexp mode ty in
+ Names.remove_names (List.map Transient_expr.repr tyl);
+ let priv = priv <> Mpublic in
+ let virt = virt = Virtual in
+ Ocsg_method (lab, priv, virt, tty)
+
+let rec prepare_class_type params = function
+ | Cty_constr (_p, tyl, cty) ->
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !visited_objects
+ || not (List.for_all is_Tvar params)
+ || List.exists (deep_occur row) tyl
+ then prepare_class_type params cty
+ else List.iter prepare_type tyl
+ | Cty_signature sign ->
+ (* Self may have a name *)
+ let px = proxy sign.csig_self_row in
+ if List.memq px !visited_objects then add_alias_proxy px
+ else visited_objects := px :: !visited_objects;
+ Vars.iter (fun _ (_, _, ty) -> prepare_type ty) sign.csig_vars;
+ Meths.iter prepare_method sign.csig_meths
+ | Cty_arrow (_, ty, cty) ->
+ prepare_type ty;
+ prepare_class_type params cty
+
+let rec tree_of_class_type mode params =
+ function
+ | Cty_constr (p, tyl, cty) ->
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !visited_objects
+ || not (List.for_all is_Tvar params)
+ then
+ tree_of_class_type mode params cty
+ else begin
+ let nso, p = best_class_type_path p in
+ let tyl = apply_subst_opt nso tyl in
+ let namespace = Namespace.best_class_namespace p in
+ Octy_constr (tree_of_path namespace p, tree_of_typlist Type_scheme tyl)
+ end
+ | Cty_signature sign ->
+ let px = proxy sign.csig_self_row in
+ let self_ty =
+ if is_aliased_proxy px then
+ Some
+ (Otyp_var (false, Names.name_of_type Names.new_name px))
+ else None
+ in
+ let csil = [] in
+ let csil =
+ List.fold_left
+ (fun csil (ty1, ty2) -> Ocsg_constraint (ty1, ty2) :: csil)
+ csil (tree_of_constraints params)
+ in
+ let all_vars =
+ Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.csig_vars []
+ in
+ (* Consequence of PR#3607: order of Map.fold has changed! *)
+ let all_vars = List.rev all_vars in
+ let csil =
+ List.fold_left
+ (fun csil (l, m, v, t) ->
+ Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp mode t)
+ :: csil)
+ csil all_vars
+ in
+ let all_meths =
+ Meths.fold
+ (fun l (p, v, t) all -> (l, p, v, t) :: all)
+ sign.csig_meths []
+ in
+ let all_meths = List.rev all_meths in
+ let csil =
+ List.fold_left
+ (fun csil meth -> tree_of_method mode meth :: csil)
+ csil all_meths
+ in
+ Octy_signature (self_ty, List.rev csil)
+ | Cty_arrow (l, ty, cty) ->
+ let lab =
+ if !print_labels || is_optional l then l else Nolabel
+ in
+ let tr =
+ if is_optional l then
+ match get_desc ty with
+ | Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
+ tree_of_typexp mode ty
+ | _ -> Otyp_stuff "<hidden>"
+ else tree_of_typexp mode ty in
+ Octy_arrow (lab, tr, tree_of_class_type mode params cty)
+
+let class_type ppf cty =
+ reset ();
+ prepare_class_type [] cty;
+ !Oprint.out_class_type ppf (tree_of_class_type Type [] cty)
+
+let tree_of_class_param param variance =
+ let ot_variance =
+ if is_Tvar param then Asttypes.(NoVariance, NoInjectivity) else variance in
+ match tree_of_typexp Type_scheme param with
+ Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+ | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+
+let class_variance =
+ let open Variance in let open Asttypes in
+ List.map (fun v ->
+ (if not (mem May_pos v) then Contravariant else
+ if not (mem May_neg v) then Covariant else NoVariance),
+ NoInjectivity)
+
+let tree_of_class_declaration id cl rs =
+ let params = filter_params cl.cty_params in
+
+ reset_except_context ();
+ List.iter add_alias params;
+ prepare_class_type params cl.cty_type;
+ let px = proxy (Btype.self_type_row cl.cty_type) in
+ List.iter prepare_type params;
+
+ List.iter (add_printed_alias ~non_gen:false) params;
+ if is_aliased_proxy px then add_printed_alias_proxy ~non_gen:false px;
+
+ let vir_flag = cl.cty_new = None in
+ Osig_class
+ (vir_flag, Ident.name id,
+ List.map2 tree_of_class_param params (class_variance cl.cty_variance),
+ tree_of_class_type Type_scheme params cl.cty_type,
+ tree_of_rec rs)
+
+let class_declaration id ppf cl =
+ !Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
+
+let tree_of_cltype_declaration id cl rs =
+ let params = cl.clty_params in
+
+ reset_except_context ();
+ List.iter add_alias params;
+ prepare_class_type params cl.clty_type;
+ let px = proxy (Btype.self_type_row cl.clty_type) in
+ List.iter prepare_type params;
+
+ List.iter (add_printed_alias ~non_gen:false) params;
+ if is_aliased_proxy px then (add_printed_alias_proxy ~non_gen:false) px;
+
+ let sign = Btype.signature_of_class_type cl.clty_type in
+ let has_virtual_vars =
+ Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_vars false
+ in
+ let has_virtual_meths =
+ Meths.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_meths false
+ in
+ Osig_class_type
+ (has_virtual_vars || has_virtual_meths, Ident.name id,
+ List.map2 tree_of_class_param params (class_variance cl.clty_variance),
+ tree_of_class_type Type_scheme params cl.clty_type,
+ tree_of_rec rs)
+
+let cltype_declaration id ppf cl =
+ !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl Trec_first)
+
+(* Print a module type *)
+
+let wrap_env fenv ftree arg =
+ let env = !printing_env in
+ let env' = Env.update_short_paths (fenv env) in
+ set_printing_env env';
+ let tree = ftree arg in
+ set_printing_env env;
+ tree
+
+let dummy =
+ {
+ type_params = [];
+ type_arity = 0;
+ type_kind = Type_abstract Definition;
+ type_private = Public;
+ type_manifest = None;
+ type_variance = [];
+ type_separability = [];
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = Location.none;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.internal_not_actually_unique;
+ }
+
+(** we hide items being defined from short-path to avoid shortening
+ [type t = Path.To.t] into [type t = t].
+*)
+
+let ident_sigitem = function
+ | Types.Sig_type(ident,_,_,_) -> {hide=true; ident}
+ | Types.Sig_class(ident,_,_,_)
+ | Types.Sig_class_type (ident,_,_,_)
+ | Types.Sig_module(ident,_, _,_,_)
+ | Types.Sig_value (ident,_,_)
+ | Types.Sig_modtype (ident,_,_)
+ | Types.Sig_typext (ident,_,_,_) -> {hide=false; ident }
+
+
+let hide ids env =
+ let hide_id id env =
+ (* Global idents cannot be renamed *)
+ if id.hide && not (Ident.global id.ident) then
+ Env.add_type ~check:false (Ident.rename_no_exn id.ident) dummy env
+ else env
+ in
+ List.fold_right hide_id ids env
+
+let with_hidden_items ids f =
+ let with_hidden_in_printing_env ids f =
+ wrap_env (hide ids) (Naming_context.with_hidden ids) f
+ in
+ if not !Clflags.real_paths then
+ with_hidden_in_printing_env ids f
+ else
+ Naming_context.with_hidden ids f
+
+let add_sigitem env x =
+ Env.add_signature (Signature_group.flatten x) env
+
+let rec tree_of_modtype ?(ellipsis=false) = function
+ | Mty_ident p ->
+ let p = best_module_type_path p in
+ Omty_ident (tree_of_path (Some Module_type) p)
+ | Mty_signature sg ->
+ Omty_signature (if ellipsis then [Osig_ellipsis]
+ else tree_of_signature sg)
+ | Mty_functor(param, ty_res) ->
+ let param, env =
+ tree_of_functor_parameter param
+ in
+ let res = wrap_env env (tree_of_modtype ~ellipsis) ty_res in
+ Omty_functor (param, res)
+ | Mty_alias p ->
+ let p = best_module_path p in
+ Omty_alias (tree_of_path (Some Module) p)
+ | Mty_for_hole -> Omty_hole
+
+and tree_of_functor_parameter = function
+ | Unit ->
+ None, fun k -> k
+ | Named (param, ty_arg) ->
+ let name, env =
+ match param with
+ | None -> None, fun env -> env
+ | Some id ->
+ Some (Ident.name id),
+ Env.add_module ~arg:true id Mp_present ty_arg
+ in
+ Some (name, tree_of_modtype ~ellipsis:false ty_arg), env
+
+and tree_of_signature sg =
+ wrap_env (fun env -> env)(fun sg ->
+ let tree_groups = tree_of_signature_rec !printing_env sg in
+ List.concat_map (fun (_env,l) -> List.map snd l) tree_groups
+ ) sg
+
+and tree_of_signature_rec env' sg =
+ let structured = List.of_seq (Signature_group.seq sg) in
+ let collect_trees_of_rec_group group =
+ let env = !printing_env in
+ let env', group_trees =
+ trees_of_recursive_sigitem_group env group
+ in
+ set_printing_env env';
+ (env, group_trees) in
+ set_printing_env env';
+ List.map collect_trees_of_rec_group structured
+
+and trees_of_recursive_sigitem_group env
+ (syntactic_group: Signature_group.rec_group) =
+ let display (x:Signature_group.sig_item) = x.src, tree_of_sigitem x.src in
+ let env = Env.add_signature syntactic_group.pre_ghosts env in
+ match syntactic_group.group with
+ | Not_rec x -> add_sigitem env x, [display x]
+ | Rec_group items ->
+ let ids = List.map (fun x -> ident_sigitem x.Signature_group.src) items in
+ List.fold_left add_sigitem env items,
+ with_hidden_items ids (fun () -> List.map display items)
+
+and tree_of_sigitem = function
+ | Sig_value(id, decl, _) ->
+ tree_of_value_description id decl
+ | Sig_type(id, decl, rs, _) ->
+ tree_of_type_declaration id decl rs
+ | Sig_typext(id, ext, es, _) ->
+ tree_of_extension_constructor id ext es
+ | Sig_module(id, _, md, rs, _) ->
+ let ellipsis =
+ List.exists (function
+ | Parsetree.{attr_name = {txt="..."}; attr_payload = PStr []} -> true
+ | _ -> false)
+ md.md_attributes in
+ tree_of_module id md.md_type rs ~ellipsis
+ | Sig_modtype(id, decl, _) ->
+ tree_of_modtype_declaration id decl
+ | Sig_class(id, decl, rs, _) ->
+ tree_of_class_declaration id decl rs
+ | Sig_class_type(id, decl, rs, _) ->
+ tree_of_cltype_declaration id decl rs
+
+and tree_of_modtype_declaration id decl =
+ let mty =
+ match decl.mtd_type with
+ | None -> Omty_abstract
+ | Some mty -> tree_of_modtype mty
+ in
+ Osig_modtype (Ident.name id, mty)
+
+and tree_of_module id ?ellipsis mty rs =
+ Osig_module (Ident.name id, tree_of_modtype ?ellipsis mty, tree_of_rec rs)
+
+let rec functor_parameters ~sep custom_printer = function
+ | [] -> ignore
+ | [id,param] ->
+ Fmt.dprintf "%t%t"
+ (custom_printer param)
+ (functor_param ~sep ~custom_printer id [])
+ | (id,param) :: q ->
+ Fmt.dprintf "%t%a%t"
+ (custom_printer param)
+ sep ()
+ (functor_param ~sep ~custom_printer id q)
+and functor_param ~sep ~custom_printer id q =
+ match id with
+ | None -> functor_parameters ~sep custom_printer q
+ | Some id ->
+ Naming_context.with_arg id
+ (fun () -> functor_parameters ~sep custom_printer q)
+
+let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
+let modtype_declaration id ppf decl =
+ !Oprint.out_sig_item ppf (tree_of_modtype_declaration id decl)
+
+
+(* For the toplevel: merge with tree_of_signature? *)
+
+let print_items showval env x =
+ Names.refresh_weak();
+ Conflicts.reset ();
+ let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
+ let post_process (env,l) = List.map (extend_val env) l in
+ List.concat_map post_process @@ tree_of_signature_rec env x
+
+(* Print a signature body (used by -i when compiling a .ml) *)
+
+let print_signature ppf tree =
+ Fmt.fprintf ppf "@[<v>%a@]" !Oprint.out_signature tree
+
+let signature ppf sg =
+ Fmt.fprintf ppf "%a" print_signature (tree_of_signature sg)
+
+(* Print a signature body (used by -i when compiling a .ml) *)
+let printed_signature sourcefile ppf sg =
+ (* we are tracking any collision event for warning 63 *)
+ Conflicts.reset ();
+ let t = tree_of_signature sg in
+ if Warnings.(is_active @@ Erroneous_printed_signature "")
+ && Conflicts.exists ()
+ then begin
+ let conflicts = Fmt.asprintf "%t" Conflicts.print_explanations_as_doc in
+ Location.prerr_warning (Location.in_file sourcefile)
+ (Warnings.Erroneous_printed_signature conflicts);
+ Warnings.check_fatal ()
+ end;
+ Fmt.fprintf ppf "%a" print_signature t
+
+
+(* Trace-specific printing *)
+
+(* A configuration type that controls which trace we print. This could be
+ exposed, but we instead expose three separate
+ [report_{unification,equality,moregen}_error] functions. This also lets us
+ give the unification case an extra optional argument without adding it to the
+ equality and moregen cases. *)
+type 'variety trace_format =
+ | Unification : Errortrace.unification trace_format
+ | Equality : Errortrace.comparison trace_format
+ | Moregen : Errortrace.comparison trace_format
+
+let incompatibility_phrase (type variety) : variety trace_format -> string =
+ function
+ | Unification -> "is not compatible with type"
+ | Equality -> "is not equal to type"
+ | Moregen -> "is not compatible with type"
+
+(* Print a unification error *)
+
+let same_path t t' =
+ eq_type t t' ||
+ match get_desc t, get_desc t' with
+ | Tconstr(p,tl,_), Tconstr(p',tl',_) -> begin
+ match best_type_path p, best_type_path p' with
+ | Nth n, Nth n' when n = n' -> true
+ | Path(nso, p), Path(nso', p') when Path.same p p' ->
+ let tl = apply_subst_opt nso tl in
+ let tl' = apply_subst_opt nso' tl' in
+ List.length tl = List.length tl' &&
+ List.for_all2 eq_type tl tl'
+ | _ -> false
+ end
+ | _ ->
+ false
+
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+
+
+let trees_of_type_expansion mode Errortrace.{ty = t; expanded = t'} =
+ reset_loop_marks ();
+ mark_loops t;
+ if same_path t t'
+ then begin add_delayed (proxy t); Same (tree_of_typexp mode t) end
+ else begin
+ mark_loops t';
+ let t' = if proxy t == proxy t' then unalias t' else t' in
+ (* beware order matter due to side effect,
+ e.g. when printing object types *)
+ let first = tree_of_typexp mode t in
+ let second = tree_of_typexp mode t' in
+ if first = second then Same first
+ else Diff(first,second)
+ end
+
+let type_expansion ppf = function
+ | Same t -> Style.as_inline_code !Oprint.out_type ppf t
+ | Diff(t,t') ->
+ Fmt.fprintf ppf "@[<2>%a@ =@ %a@]"
+ (Style.as_inline_code !Oprint.out_type) t
+ (Style.as_inline_code !Oprint.out_type) t'
+
+
+let trees_of_trace mode =
+ List.map (Errortrace.map_diff (trees_of_type_expansion mode))
+
+let trees_of_type_path_expansion (tp,tp') =
+ if Path.same tp tp' then Same(tree_of_path (Some Type) tp) else
+ Diff(tree_of_path (Some Type) tp, tree_of_path (Some Type) tp')
+
+let type_path_expansion ppf = function
+ | Same p -> Style.as_inline_code !Oprint.out_ident ppf p
+ | Diff(p,p') ->
+ Fmt.fprintf ppf "@[<2>%a@ =@ %a@]"
+ (Style.as_inline_code !Oprint.out_ident) p
+ (Style.as_inline_code !Oprint.out_ident) p'
+
+let rec trace fst txt ppf = function
+ | {Errortrace.got; expected} :: rem ->
+ if not fst then Fmt.fprintf ppf "@,";
+ Fmt.fprintf ppf "@[Type@;<1 2>%a@ %s@;<1 2>%a@]%a"
+ type_expansion got txt type_expansion expected
+ (trace false txt) rem
+ | _ -> ()
+
+
+type printing_status =
+ | Discard
+ | Keep
+ | Optional_refinement
+ (** An [Optional_refinement] printing status is attributed to trace
+ elements that are focusing on a new subpart of a structural type.
+ Since the whole type should have been printed earlier in the trace,
+ we only print those elements if they are the last printed element
+ of a trace, and there is no explicit explanation for the
+ type error.
+ *)
+
+let diff_printing_status Errortrace.{ got = {ty = t1; expanded = t1'};
+ expected = {ty = t2; expanded = t2'} } =
+ if is_constr_row ~allow_ident:true t1'
+ || is_constr_row ~allow_ident:true t2'
+ then Discard
+ else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
+ else Keep
+
+let printing_status = function
+ | Errortrace.Diff d -> diff_printing_status d
+ | Errortrace.Escape {kind = Constraint} -> Keep
+ | _ -> Keep
+
+(** Flatten the trace and remove elements that are always discarded
+ during printing *)
+
+(* Takes [printing_status] to change behavior for [Subtype] *)
+let prepare_any_trace printing_status tr =
+ let clean_trace x l = match printing_status x with
+ | Keep -> x :: l
+ | Optional_refinement when l = [] -> [x]
+ | Optional_refinement | Discard -> l
+ in
+ match tr with
+ | [] -> []
+ | elt :: rem -> elt :: List.fold_right clean_trace rem []
+
+let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.map f tr)
+
+(** Keep elements that are [Diff _ ] and take the decision
+ for the last element, require a prepared trace *)
+let rec filter_trace keep_last = function
+ | [] -> []
+ | [Errortrace.Diff d as elt]
+ when printing_status elt = Optional_refinement ->
+ if keep_last then [d] else []
+ | Errortrace.Diff d :: rem -> d :: filter_trace keep_last rem
+ | _ :: rem -> filter_trace keep_last rem
+
+let type_path_list =
+ Fmt.pp_print_list ~pp_sep:(fun ppf () -> Fmt.pp_print_break ppf 2 0)
+ type_path_expansion
+
+(* Hide variant name and var, to force printing the expanded type *)
+let hide_variant_name t =
+ match get_desc t with
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ if name = None then t else
+ newty2 ~level:(get_level t)
+ (Tvariant
+ (create_row ~fields ~fixed ~closed ~name:None
+ ~more:(newvar2 (get_level more))))
+ | _ -> t
+
+
+
+let prepare_expansion Errortrace.{ty; expanded} =
+ let expanded = hide_variant_name expanded in
+ reserve_names ty;
+ if not (same_path ty expanded) then reserve_names expanded;
+ Errortrace.{ty; expanded}
+
+let may_prepare_expansion compact (Errortrace.{ty; expanded} as ty_exp) =
+ match get_desc expanded with
+ Tvariant _ | Tobject _ when compact ->
+ reserve_names ty; Errortrace.{ty; expanded = ty}
+ | _ -> prepare_expansion ty_exp
+
+let print_path p =
+ Fmt.dprintf "%a" !Oprint.out_ident (tree_of_path (Some Type) p)
+
+let print_tag ppf s = Style.inline_code ppf ("`" ^ s)
+
+let print_tags =
+ let comma ppf () = Fmt.fprintf ppf ",@ " in
+ Fmt.pp_print_list ~pp_sep:comma print_tag
+
+let is_unit env ty =
+ match get_desc (Ctype.expand_head env ty) with
+ | Tconstr (p, _, _) -> Path.same p Predef.path_unit
+ | _ -> false
+
+let unifiable env ty1 ty2 =
+ let snap = Btype.snapshot () in
+ let res =
+ try Ctype.unify env ty1 ty2; true
+ with Unify _ -> false
+ in
+ Btype.backtrack snap;
+ res
+
+
+let explanation_diff env t3 t4 : (Format.formatter -> unit) option =
+ match get_desc t3, get_desc t4 with
+ | Tarrow (_, ty1, ty2, _), _
+ when is_unit env ty1 && unifiable env ty2 t4 ->
+ Some (fun ppf ->
+ Format.fprintf ppf
+ "@,@[@{<hint>Hint@}: Did you forget to provide %a as argument?@]"
+ (Fmt.compat Style.inline_code) "()"
+ )
+ | _, Tarrow (_, ty1, ty2, _)
+ when is_unit env ty1 && unifiable env t3 ty2 ->
+ Some (fun ppf ->
+ Format.fprintf ppf
+ "@,@[@{<hint>Hint@}: Did you forget to wrap the expression using \
+ %a?@]"
+ (Fmt.compat Style.inline_code) "fun () ->"
+ )
+ | _ ->
+ None
+
+let explain_fixed_row_case ppf = function
+ | Errortrace.Cannot_be_closed ->
+ Format.fprintf ppf "it cannot be closed"
+ | Errortrace.Cannot_add_tags tags ->
+ Format.fprintf ppf "it may not allow the tag(s) %a"
+ (Fmt.compat print_tags) tags
+
+
+let explain_fixed_row pos expl = match expl with
+ | Fixed_private ->
+ Format.dprintf "The %a variant type is private"
+ (Fmt.compat Errortrace.print_pos) pos
+ | Univar x ->
+ reserve_names x;
+ Format.dprintf "The %a variant type is bound to the universal type variable %a"
+ (Fmt.compat Errortrace.print_pos) pos
+ (Fmt.compat1 Style.as_inline_code type_expr_with_reserved_names) x
+ | Reified p ->
+ Format.dprintf "The %a variant type is bound to %a"
+ (Fmt.compat Errortrace.print_pos) pos
+ (Fmt.compat1 Style.as_inline_code
+ (fun ppf p ->
+ Internal_names.add p;
+ print_path p ppf))
+ p
+ | Rigid -> ignore
+
+
+let explain_variant (type variety) : variety Errortrace.variant -> _ = function
+ (* Common *)
+ | Errortrace.Incompatible_types_for s ->
+ Some(
+ Format.dprintf "@,Types for tag %a are incompatible" (Fmt.compat print_tag) s)
+ (* Unification *)
+ | Errortrace.No_intersection ->
+ Some(Format.dprintf "@,These two variant types have no intersection")
+ | Errortrace.No_tags(pos,fields) -> Some (
+ Format.dprintf
+ "@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
+ (Fmt.compat Errortrace.print_pos) pos
+ (Fmt.compat print_tags) (List.map fst fields))
+ | Errortrace.Fixed_row (pos, k, (Univar _ | Reified _ | Fixed_private as e)) ->
+ Some (
+ Format.dprintf "@,@[%t,@ %a@]" (explain_fixed_row pos e)
+ explain_fixed_row_case k)
+ | Errortrace.Fixed_row (_,_, Rigid) ->
+ (* this case never happens *)
+ None
+ (* Equality & Moregen *)
+ | Errortrace.Presence_not_guaranteed_for (pos, s) -> Some(
+ Format.dprintf
+ "@,@[The tag %a is guaranteed to be present in the %a variant type,\
+ @ but not in the %a@]"
+ (Fmt.compat print_tag) s
+ (Fmt.compat Errortrace.print_pos) (Errortrace.swap_position pos)
+ (Fmt.compat Errortrace.print_pos) pos
+ )
+ | Errortrace.Openness pos ->
+ Some(Format.dprintf "@,The %a variant type is open and the %a is not"
+ (Fmt.compat Errortrace.print_pos) pos
+ (Fmt.compat Errortrace.print_pos) (Errortrace.swap_position pos))
+
+let explain_escape pre = function
+ | Errortrace.Univ u ->
+ reserve_names u;
+ Some(
+ Format.dprintf "%t@,The universal variable %a would escape its scope"
+ pre
+ (Fmt.compat1 Style.as_inline_code type_expr_with_reserved_names) u
+ )
+ | Errortrace.Constructor p -> Some(
+ Format.dprintf
+ "%t@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
+ pre (Fmt.compat1 Style.as_inline_code path) p
+ )
+ | Errortrace.Module_type p -> Some(
+ Format.dprintf
+ "%t@,@[The module type@;<1 2>%a@ would escape its scope@]"
+ pre (Fmt.compat1 Style.as_inline_code path) p
+ )
+ | Errortrace.Equation Errortrace.{ty = _; expanded = t} ->
+ reserve_names t;
+ Some(
+ Format.dprintf "%t @,@[<hov>This instance of %a is ambiguous:@ %s@]"
+ pre
+ (Fmt.compat1 Style.as_inline_code type_expr_with_reserved_names) t
+ "it would escape the scope of its equation"
+ )
+ | Errortrace.Self ->
+ Some (Format.dprintf "%t@,Self type cannot escape its class" pre)
+ | Errortrace.Constraint ->
+ None
+
+
+let explain_object (type variety) : variety Errortrace.obj -> _ = function
+ | Errortrace.Missing_field (pos,f) -> Some(
+ Format.dprintf "@,@[The %a object type has no method %a@]"
+ (Fmt.compat Errortrace.print_pos) pos (Fmt.compat Style.inline_code) f
+ )
+ | Errortrace.Abstract_row pos -> Some(
+ Format.dprintf
+ "@,@[The %a object type has an abstract row, it cannot be closed@]"
+ (Fmt.compat Errortrace.print_pos) pos
+ )
+ | Errortrace.Self_cannot_be_closed ->
+ Some (Format.dprintf "@,Self type cannot be unified with a closed object type")
+
+let explain_incompatible_fields name (diff: Types.type_expr Errortrace.diff) =
+ reserve_names diff.got;
+ reserve_names diff.expected;
+ Format.dprintf "@,@[The method %a has type@ %a,@ \
+ but the expected method type was@ %a@]"
+ (Fmt.compat Style.inline_code) name
+ (Fmt.compat1 Style.as_inline_code type_expr_with_reserved_names) diff.got
+ (Fmt.compat1 Style.as_inline_code type_expr_with_reserved_names) diff.expected
+
+let explain_label_mismatch ~got ~expected =
+ let quoted_label ppf l = Style.inline_code ppf (string_of_label l) in
+ let quoted_label = Fmt.compat quoted_label in
+ match got, expected with
+ | Asttypes.Nolabel, Asttypes.(Labelled _ | Optional _ ) ->
+ Format.dprintf "@,@[A label@ %a@ was expected@]"
+ quoted_label expected
+ | Asttypes.(Labelled _|Optional _), Asttypes.Nolabel ->
+ Format.dprintf
+ "@,@[The first argument is labeled@ %a,@ \
+ but an unlabeled argument was expected@]"
+ quoted_label got
+ | Asttypes.Labelled g, Asttypes.Optional e when g = e ->
+ Format.dprintf
+ "@,@[The label@ %a@ was expected to be optional@]"
+ quoted_label got
+ | Asttypes.Optional g, Asttypes.Labelled e when g = e ->
+ Format.dprintf
+ "@,@[The label@ %a@ was expected to not be optional@]"
+ quoted_label got
+ | Asttypes.(Labelled _ | Optional _), Asttypes.(Labelled _ | Optional _) ->
+ Format.dprintf "@,@[Labels %a@ and@ %a do not match@]"
+ quoted_label got
+ quoted_label expected
+ | Asttypes.Nolabel, Asttypes.Nolabel ->
+ (* Two empty labels cannot be mismatched*)
+ assert false
+
+let explain_first_class_module = function
+ | Errortrace.Package_cannot_scrape p -> Some(
+ Format.dprintf "@,@[The module alias %a could not be expanded@]"
+ (Fmt.compat path) p
+ )
+ | Errortrace.Package_inclusion pr ->
+ Some(Format.dprintf "@,@[%a@]" Fmt.Doc.format pr)
+ | Errortrace.Package_coercion pr ->
+ Some(Format.dprintf "@,@[%a@]" Fmt.Doc.format pr)
+
+let explanation (type variety) intro prev env
+ : (Errortrace.expanded_type, variety) Errortrace.elt -> _ = function
+ | Errortrace.Diff {got; expected} ->
+ explanation_diff env got.expanded expected.expanded
+ | Errortrace.Escape {kind; context} ->
+ let pre =
+ match context, kind, prev with
+ | Some ctx, _, _ ->
+ reserve_names ctx;
+ Format.dprintf "@[%t@;<1 2>%a@]" intro
+ (Fmt.compat1 Style.as_inline_code type_expr_with_reserved_names) ctx
+ | None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
+ explain_incompatible_fields name diff
+ | _ -> ignore
+ in
+ explain_escape pre kind
+ | Errortrace.Incompatible_fields { name; diff} ->
+ Some(explain_incompatible_fields name diff)
+ | Errortrace.Variant v ->
+ explain_variant v
+ | Errortrace.Obj o ->
+ explain_object o
+ | Errortrace.Function_label_mismatch diff ->
+ Some (explain_label_mismatch ~got:diff.got ~expected:diff.expected)
+ | Errortrace.First_class_module fm ->
+ explain_first_class_module fm
+ | Errortrace.Rec_occur(x,y) ->
+ reserve_names x;
+ reserve_names y;
+ begin match get_desc x with
+ | Tvar _ | Tunivar _ ->
+ Some(fun ppf ->
+ reset_loop_marks ();
+ mark_loops x;
+ mark_loops y;
+ Format.dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
+ (Fmt.compat1 Style.as_inline_code prepared_type_expr) x
+ (Fmt.compat1 Style.as_inline_code prepared_type_expr) y
+ ppf)
+ | _ ->
+ (* We had a delayed unification of the type variable with
+ a non-variable after the occur check. *)
+ Some ignore
+ (* There is no need to search further for an explanation, but
+ we don't want to print a message of the form:
+ {[ The type int occurs inside int list -> 'a |}
+ *)
+ end
+
+
+let mismatch intro env trace =
+ Errortrace.explain trace (fun ~prev h -> explanation intro prev env h)
+
+
+let explain mis ppf =
+ match mis with
+ | None -> ()
+ | Some explain -> explain ppf
+
+
+let warn_on_missing_def env ppf t =
+ match get_desc t with
+ | Tconstr (p,_,_) ->
+ begin match Env.find_type p env with
+ | exception Not_found ->
+ Fmt.fprintf ppf
+ "@,@[<hov>Type %a is abstract because@ no corresponding\
+ @ cmi file@ was found@ in path.@]" (Style.as_inline_code path) p
+ | { type_manifest = Some _; _ } -> ()
+ | { type_manifest = None; _ } as decl ->
+ match type_origin decl with
+ | Rec_check_regularity ->
+ Fmt.fprintf ppf
+ "@,@[<hov>Type %a was considered abstract@ when checking\
+ @ constraints@ in this@ recursive type definition.@]"
+ (Style.as_inline_code path) p
+ | Definition | Existential _ -> ()
+ end
+ | _ -> ()
+
+
+
+let prepare_expansion_head empty_tr = function
+ | Errortrace.Diff d ->
+ Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
+ | _ -> None
+
+let head_error_printer mode txt_got txt_but = function
+ | None -> ignore
+ | Some d ->
+ let d = Errortrace.map_diff (trees_of_type_expansion mode) d in
+ Format.dprintf "%t@;<1 2>%a@ %t@;<1 2>%a"
+ txt_got (Fmt.compat type_expansion) d.Errortrace.got
+ txt_but (Fmt.compat type_expansion) d.Errortrace.expected
+
+let warn_on_missing_defs env ppf = function
+ | None -> ()
+ | Some Errortrace.{got = {ty=te1; expanded=_};
+ expected = {ty=te2; expanded=_} } ->
+ warn_on_missing_def env ppf te1;
+ warn_on_missing_def env ppf te2
+
+(* [subst] comes out of equality, and is [[]] otherwise *)
+let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation =
+ reset ();
+ (* We want to substitute in the opposite order from [Eqtype] *)
+ Names.add_subst (List.map (fun (ty1,ty2) -> ty2,ty1) subst);
+ let tr =
+ prepare_trace
+ (fun ty_exp ->
+ Errortrace.{ty_exp with expanded = hide_variant_name ty_exp.expanded})
+ tr
+ in
+ let mis = mismatch txt1 env tr in
+ match tr with
+ | [] -> assert false
+ | elt :: tr ->
+ try
+ print_labels := not !Clflags.classic;
+ let tr = filter_trace (mis = None) tr in
+ let head = prepare_expansion_head (tr=[]) elt in
+ let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
+ let head_error = head_error_printer mode txt1 txt2 head in
+ let tr = trees_of_trace mode tr in
+ Format.fprintf ppf
+ "@[<v>\
+ @[%t%t@]%a%t\
+ @]"
+ head_error
+ ty_expect_explanation
+ (Fmt.compat2 trace false (incompatibility_phrase trace_format)) tr
+ (explain mis);
+ if env <> Env.empty
+ then (Fmt.compat1 warn_on_missing_defs env) ppf head;
+ Internal_names.print_explanations env ppf;
+ Conflicts.print_explanations ppf;
+ print_labels := true
+ with exn ->
+ print_labels := true;
+ raise exn
+
+let report_error trace_format ppf mode env tr
+ ?(subst = [])
+ ?(type_expected_explanation = fun _ -> ())
+ txt1 txt2 =
+ wrap_printing_env ~error:true env (fun () ->
+ error trace_format mode subst env tr txt1 ppf txt2
+ type_expected_explanation)
+
+let report_unification_error
+ ppf env ({trace} : Errortrace.unification_error) =
+ report_error Unification ppf Type env
+ ?subst:None trace
+
+let report_equality_error
+ ppf mode env ({subst; trace} : Errortrace.equality_error) =
+ report_error Equality ppf mode env
+ ~subst ?type_expected_explanation:None trace
+
+let report_moregen_error
+ ppf mode env ({trace} : Errortrace.moregen_error) =
+ report_error Moregen ppf mode env
+ ?subst:None ?type_expected_explanation:None trace
+
+let report_comparison_error ppf mode env = function
+ | Errortrace.Equality_error error -> report_equality_error ppf mode env error
+ | Errortrace.Moregen_error error -> report_moregen_error ppf mode env error
+
+
+module Subtype = struct
+ (* There's a frustrating amount of code duplication between this module and
+ the outside code, particularly in [prepare_trace] and [filter_trace].
+ Unfortunately, [Subtype] is *just* similar enough to have code duplication,
+ while being *just* different enough (it's only [Diff]) for the abstraction
+ to be nonobvious. Someday, perhaps... *)
+
+ let printing_status = function
+ | Errortrace.Subtype.Diff d -> diff_printing_status d
+
+ let prepare_unification_trace = prepare_trace
+
+ let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.Subtype.map f tr)
+
+ let trace filter_trace get_diff fst keep_last txt ppf tr =
+ print_labels := not !Clflags.classic;
+ try match tr with
+ | elt :: tr' ->
+ let diffed_elt = get_diff elt in
+ let tr =
+ trees_of_trace Type
+ @@ List.map (Errortrace.map_diff prepare_expansion)
+ @@ filter_trace keep_last tr' in
+ let tr =
+ match fst, diffed_elt with
+ | true, Some elt -> elt :: tr
+ | _, _ -> tr
+ in
+ trace fst txt ppf tr;
+ print_labels := true
+ | _ -> ()
+ with exn ->
+ print_labels := true;
+ raise exn
+
+ let rec filter_subtype_trace keep_last = function
+ | [] -> []
+ | [Errortrace.Subtype.Diff d as elt]
+ when printing_status elt = Optional_refinement ->
+ if keep_last then [d] else []
+ | Errortrace.Subtype.Diff d :: rem ->
+ d :: filter_subtype_trace keep_last rem
+
+ let unification_get_diff = function
+ | Errortrace.Diff diff ->
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+ | _ -> None
+
+ let subtype_get_diff = function
+ | Errortrace.Subtype.Diff diff ->
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+
+ let report_error
+ ppf
+ env
+ (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif})
+ txt1 =
+ wrap_printing_env ~error:true env (fun () ->
+ reset ();
+ let tr_sub = prepare_trace prepare_expansion tr_sub in
+ let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
+ let keep_first = match tr_unif with
+ | [Obj _ | Variant _ | Escape _ ] | [] -> true
+ | _ -> false in
+ Format.fprintf ppf "@[<v>%a"
+ (Fmt.compat (trace filter_subtype_trace subtype_get_diff true keep_first txt1))
+ tr_sub;
+ if tr_unif = [] then Format.fprintf ppf "@]" else
+ let mis = mismatch (Format.dprintf "Within this type") env tr_unif in
+ Format.fprintf ppf "%a%t%t@]"
+ (Fmt.compat (trace filter_trace unification_get_diff false
+ (mis = None) "is not compatible with type")) tr_unif
+ (explain mis)
+ Conflicts.print_explanations
+ )
+end
+
+
+
+let report_ambiguous_type_error ppf env tp0 tpl txt1 txt2 txt3 =
+ wrap_printing_env ~error:true env (fun () ->
+ reset ();
+ let tp0 = trees_of_type_path_expansion tp0 in
+ match tpl with
+ [] -> assert false
+ | [tp] ->
+ Format.fprintf ppf
+ "@[%t@;<1 2>%a@ \
+ %t@;<1 2>%a\
+ @]"
+ txt1 (Fmt.compat type_path_expansion) (trees_of_type_path_expansion tp)
+ txt3 (Fmt.compat type_path_expansion) tp0
+ | _ ->
+ Format.fprintf ppf
+ "@[%t@;<1 2>@[<hv>%a@]\
+ @ %t@;<1 2>%a\
+ @]"
+ txt2 (Fmt.compat type_path_list)
+ (List.map trees_of_type_path_expansion tpl)
+ txt3 (Fmt.compat type_path_expansion) tp0)
+
+(* Adapt functions to exposed interface *)
+let tree_of_path = tree_of_path None
+let tree_of_modtype = tree_of_modtype ~ellipsis:false
+let type_expansion mode ppf ty_exp =
+ type_expansion ppf (trees_of_type_expansion mode ty_exp)
+let tree_of_type_declaration ident td rs =
+ with_hidden_items [{hide=true; ident}]
+ (fun () -> tree_of_type_declaration ident td rs)
+
+let shorten_type_path env p =
+ wrap_printing_env env
+ (fun () -> best_type_path_simple p)
+
+let shorten_module_type_path env p =
+ wrap_printing_env env
+ (fun () -> best_module_type_path p)
+
+let shorten_module_path env p =
+ wrap_printing_env env
+ (fun () -> best_module_path p)
+
+let shorten_class_type_path env p =
+ wrap_printing_env env
+ (fun () -> best_class_type_path_simple p)
diff --git a/src/ocaml/typing/printtyp_doc.mli b/src/ocaml/typing/printtyp_doc.mli
new file mode 100644
index 0000000000..916dd769c0
--- /dev/null
+++ b/src/ocaml/typing/printtyp_doc.mli
@@ -0,0 +1,243 @@
+
+(* Printing functions *)
+
+open Format_doc
+open Types
+open Outcometree
+
+val longident: formatter -> Longident.t -> unit
+val ident: formatter -> Ident.t -> unit
+val namespaced_ident: Shape.Sig_component_kind.t -> Ident.t -> string
+val tree_of_path: Path.t -> out_ident
+val path: formatter -> Path.t -> unit
+val string_of_path: Path.t -> string
+
+val type_path: formatter -> Path.t -> unit
+(** Print a type path taking account of [-short-paths].
+ Calls should be within [wrap_printing_env]. *)
+
+module Out_name: sig
+ val create: string -> out_name
+ val print: out_name -> string
+end
+
+type namespace := Shape.Sig_component_kind.t option
+
+val strings_of_paths: namespace -> Path.t list -> string list
+ (** Print a list of paths, using the same naming context to
+ avoid name collisions *)
+
+val raw_type_expr: formatter -> type_expr -> unit
+val string_of_label: Asttypes.arg_label -> string
+
+val wrap_printing_env: ?error:bool -> Env.t -> (unit -> 'a) -> 'a
+ (* Call the function using the environment for type path shortening *)
+ (* This affects all the printing functions below *)
+ (* Also, if [~error:true], then disable the loading of cmis *)
+val shorten_type_path: Env.t -> Path.t -> Path.t
+val shorten_module_type_path: Env.t -> Path.t -> Path.t
+val shorten_module_path: Env.t -> Path.t -> Path.t
+val shorten_class_type_path: Env.t -> Path.t -> Path.t
+
+module Naming_context: sig
+ val enable: bool -> unit
+ (** When contextual names are enabled, the mapping between identifiers
+ and names is ensured to be one-to-one. *)
+
+ val with_arg : Ident.t -> (unit -> 'a) -> 'a
+end
+
+(** The [Conflicts] module keeps track of conflicts arising when attributing
+ names to identifiers and provides functions that can print explanations
+ for these conflict in error messages *)
+module Conflicts: sig
+ val exists: unit -> bool
+ (** [exists()] returns true if the current naming context renamed
+ an identifier to avoid a name collision *)
+
+ type explanation =
+ { kind: Shape.Sig_component_kind.t;
+ name:string;
+ root_name:string;
+ location:Location.t
+ }
+
+ val list_explanations: unit -> explanation list
+(** [list_explanations()] return the list of conflict explanations
+ collected up to this point, and reset the list of collected
+ explanations *)
+
+ val print_located_explanations:
+ Format.formatter -> explanation list -> unit
+
+ val print_explanations: Format.formatter -> unit
+ (** Print all conflict explanations collected up to this point *)
+
+ val reset: unit -> unit
+end
+
+
+val reset: unit -> unit
+
+(** Print out a type. This will pick names for type variables, and will not
+ reuse names for common type variables shared across multiple type
+ expressions. (It will also reset the printing state, which matters for
+ other type formatters such as [prepared_type_expr].) If you want multiple
+ types to use common names for type variables, see [prepare_for_printing] and
+ [prepared_type_expr]. *)
+val type_expr: formatter -> type_expr -> unit
+
+(** [prepare_for_printing] resets the global printing environment, a la [reset],
+ and prepares the types for printing by reserving names and marking loops.
+ Any type variables that are shared between multiple types in the input list
+ will be given the same name when printed with [prepared_type_expr]. *)
+val prepare_for_printing: type_expr list -> unit
+
+(** [add_type_to_preparation ty] extend a previous type expression preparation
+ to the type expression [ty]
+*)
+val add_type_to_preparation: type_expr -> unit
+
+val prepared_type_expr: formatter -> type_expr -> unit
+(** The function [prepared_type_expr] is a less-safe but more-flexible version
+ of [type_expr] that should only be called on [type_expr]s that have been
+ passed to [prepare_for_printing]. Unlike [type_expr], this function does no
+ extra work before printing a type; in particular, this means that any loops
+ in the type expression may cause a stack overflow (see #8860) since this
+ function does not mark any loops. The benefit of this is that if multiple
+ type expressions are prepared simultaneously and then printed with
+ [prepared_type_expr], they will use the same names for the same type
+ variables. *)
+
+val constructor_arguments: formatter -> constructor_arguments -> unit
+val tree_of_type_scheme: type_expr -> out_type
+val type_scheme: formatter -> type_expr -> unit
+val prepared_type_scheme: formatter -> type_expr -> unit
+val shared_type_scheme: formatter -> type_expr -> unit
+(** [shared_type_scheme] is very similar to [type_scheme], but does not reset
+ the printing context first. This is intended to be used in cases where the
+ printing should have a particularly wide context, such as documentation
+ generators; most use cases, such as error messages, have narrower contexts
+ for which [type_scheme] is better suited. *)
+
+val tree_of_value_description: Ident.t -> value_description -> out_sig_item
+val value_description: Ident.t -> formatter -> value_description -> unit
+val label : formatter -> label_declaration -> unit
+val add_constructor_to_preparation : constructor_declaration -> unit
+val prepared_constructor : formatter -> constructor_declaration -> unit
+val constructor : formatter -> constructor_declaration -> unit
+val tree_of_type_declaration:
+ Ident.t -> type_declaration -> rec_status -> out_sig_item
+val add_type_declaration_to_preparation :
+ Ident.t -> type_declaration -> unit
+val prepared_type_declaration: Ident.t -> formatter -> type_declaration -> unit
+val type_declaration: Ident.t -> formatter -> type_declaration -> unit
+val tree_of_extension_constructor:
+ Ident.t -> extension_constructor -> ext_status -> out_sig_item
+val add_extension_constructor_to_preparation :
+ extension_constructor -> unit
+val prepared_extension_constructor:
+ Ident.t -> formatter -> extension_constructor -> unit
+val extension_constructor:
+ Ident.t -> formatter -> extension_constructor -> unit
+(* Prints extension constructor with the type signature:
+ type ('a, 'b) bar += A of float
+*)
+
+val extension_only_constructor:
+ Ident.t -> formatter -> extension_constructor -> unit
+(* Prints only extension constructor without type signature:
+ A of float
+*)
+
+val tree_of_module:
+ Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item
+val modtype: formatter -> module_type -> unit
+val signature: formatter -> signature -> unit
+val tree_of_modtype: module_type -> out_module_type
+val tree_of_modtype_declaration:
+ Ident.t -> modtype_declaration -> out_sig_item
+
+(** Print a list of functor parameters while adjusting the printing environment
+ for each functor argument.
+
+ Currently, we are disabling disambiguation for functor argument name to
+ avoid the need to track the moving association between identifiers and
+ syntactic names in situation like:
+
+ got: (X: sig module type T end) (Y:X.T) (X:sig module type T end) (Z:X.T)
+ expect: (_: sig end) (Y:X.T) (_:sig end) (Z:X.T)
+*)
+val functor_parameters:
+ sep:(formatter -> unit -> unit) ->
+ ('b -> formatter -> unit) ->
+ (Ident.t option * 'b) list -> formatter -> unit
+
+type type_or_scheme = Type | Type_scheme
+
+val tree_of_signature: Types.signature -> out_sig_item list
+val tree_of_typexp: type_or_scheme -> type_expr -> out_type
+val modtype_declaration: Ident.t -> formatter -> modtype_declaration -> unit
+val class_type: formatter -> class_type -> unit
+val tree_of_class_declaration:
+ Ident.t -> class_declaration -> rec_status -> out_sig_item
+val class_declaration: Ident.t -> formatter -> class_declaration -> unit
+val tree_of_cltype_declaration:
+ Ident.t -> class_type_declaration -> rec_status -> out_sig_item
+val cltype_declaration: Ident.t -> formatter -> class_type_declaration -> unit
+val type_expansion :
+ type_or_scheme -> formatter -> Errortrace.expanded_type -> unit
+val prepare_expansion: Errortrace.expanded_type -> Errortrace.expanded_type
+val report_ambiguous_type_error:
+ Format.formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
+ (Format.formatter -> unit) -> (Format.formatter -> unit) ->
+ (Format.formatter -> unit) -> unit
+
+val report_unification_error :
+ Format.formatter ->
+ Env.t -> Errortrace.unification_error ->
+ ?type_expected_explanation:(Format.formatter -> unit) ->
+ (Format.formatter -> unit) -> (Format.formatter -> unit) ->
+ unit
+
+val report_equality_error :
+ Format.formatter ->
+ type_or_scheme ->
+ Env.t -> Errortrace.equality_error ->
+ (Format.formatter -> unit) -> (Format.formatter -> unit) ->
+ unit
+
+val report_moregen_error :
+ Format.formatter ->
+ type_or_scheme ->
+ Env.t -> Errortrace.moregen_error ->
+ (Format.formatter -> unit) -> (Format.formatter -> unit) ->
+ unit
+
+val report_comparison_error :
+ Format.formatter ->
+ type_or_scheme ->
+ Env.t -> Errortrace.comparison_error ->
+ (Format.formatter -> unit) -> (Format.formatter -> unit) ->
+ unit
+
+module Subtype : sig
+ val report_error :
+ Format.formatter ->
+ Env.t ->
+ Errortrace.Subtype.error ->
+ string ->
+ unit
+end
+
+(* for toploop *)
+val print_items: (Env.t -> signature_item -> 'a option) ->
+ Env.t -> signature_item list -> (out_sig_item * 'a option) list
+
+(* Simple heuristic to rewrite Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+ for Foo__bar. This pattern is used by the stdlib. *)
+val rewrite_double_underscore_paths: Env.t -> Path.t -> Path.t
+
+(** [printed_signature sourcefile ppf sg] print the signature [sg] of
+ [sourcefile] with potential warnings for name collisions *)
+val printed_signature: string -> formatter -> signature -> unit
diff --git a/src/ocaml/typing/printtyped.ml b/src/ocaml/typing/printtyped.ml
index 28b973942e..b60920e970 100644
--- a/src/ocaml/typing/printtyped.ml
+++ b/src/ocaml/typing/printtyped.ml
@@ -358,15 +358,16 @@ and expression i ppf x =
line i ppf "Texp_apply\n";
expression i ppf e;
list i label_x_expression ppf l;
- | Texp_match (e, l, partial) ->
- line i ppf "Texp_match%a\n"
- fmt_partiality partial;
+ | Texp_match (e, l1, l2, partial) ->
+ line i ppf "Texp_match%a\n" fmt_partiality partial;
expression i ppf e;
- list i case ppf l;
- | Texp_try (e, l) ->
+ list i case ppf l1;
+ list i case ppf l2;
+ | Texp_try (e, l1, l2) ->
line i ppf "Texp_try\n";
expression i ppf e;
- list i case ppf l;
+ list i case ppf l1;
+ list i case ppf l2;
| Texp_tuple (l) ->
line i ppf "Texp_tuple\n";
list i expression ppf l;
diff --git a/src/ocaml/typing/rawprinttyp.ml b/src/ocaml/typing/rawprinttyp.ml
new file mode 100644
index 0000000000..6528be2714
--- /dev/null
+++ b/src/ocaml/typing/rawprinttyp.ml
@@ -0,0 +1,146 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jacques Garrigue, Graduate School of Mathematics, Nagoya University *)
+(* *)
+(* Copyright 2003 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. *)
+(* *)
+(**************************************************************************)
+
+
+(* Print a raw type expression, with sharing *)
+
+open Format
+open Types
+let longident = Pprintast.longident
+
+let raw_list pr ppf = function
+ [] -> fprintf ppf "[]"
+ | a :: l ->
+ fprintf ppf "@[<1>[%a%t]@]" pr a
+ (fun ppf -> List.iter (fun x -> fprintf ppf ";@,%a" pr x) l)
+
+let kind_vars = ref []
+let kind_count = ref 0
+
+let string_of_field_kind v =
+ match field_kind_repr v with
+ | Fpublic -> "Fpublic"
+ | Fabsent -> "Fabsent"
+ | Fprivate -> "Fprivate"
+
+let rec safe_repr v t =
+ match Transient_expr.coerce t with
+ {desc = Tlink t} when not (List.memq t v) ->
+ safe_repr (t::v) t
+ | t' -> t'
+
+let rec list_of_memo = function
+ Mnil -> []
+ | Mcons (_priv, p, _t1, _t2, rem) -> p :: list_of_memo rem
+ | Mlink rem -> list_of_memo !rem
+
+let print_name ppf = function
+ None -> fprintf ppf "None"
+ | Some name -> fprintf ppf "\"%s\"" name
+
+let path = Format_doc.compat Path.print
+
+let visited = ref []
+let rec raw_type ppf ty =
+ let ty = safe_repr [] ty in
+ if List.memq ty !visited then fprintf ppf "{id=%d}" ty.id else begin
+ visited := ty :: !visited;
+ fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;marks=%x;desc=@,%a}@]"
+ ty.id ty.level
+ (Transient_expr.get_scope ty) (Transient_expr.get_marks ty)
+ raw_type_desc ty.desc
+ end
+and raw_type_list tl = raw_list raw_type tl
+and raw_lid_type_list tl =
+ raw_list (fun ppf (lid, typ) ->
+ fprintf ppf "(@,%a,@,%a)" longident lid raw_type typ)
+ tl
+and raw_type_desc ppf = function
+ Tvar name -> fprintf ppf "Tvar %a" print_name name
+ | Tarrow(l,t1,t2,c) ->
+ fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
+ (Asttypes.string_of_label l) raw_type t1 raw_type t2
+ (if is_commu_ok c then "Cok" else "Cunknown")
+ | Ttuple tl ->
+ fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
+ | Tconstr (p, tl, abbrev) ->
+ fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p
+ raw_type_list tl
+ (raw_list path) (list_of_memo !abbrev)
+ | Tobject (t, nm) ->
+ fprintf ppf "@[<hov1>Tobject(@,%a,@,@[<1>ref%t@])@]" raw_type t
+ (fun ppf ->
+ match !nm with None -> fprintf ppf " None"
+ | Some(p,tl) ->
+ fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
+ | Tfield (f, k, t1, t2) ->
+ fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
+ (string_of_field_kind k)
+ raw_type t1 raw_type t2
+ | Tnil -> fprintf ppf "Tnil"
+ | Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
+ | Tsubst (t, None) -> fprintf ppf "@[<1>Tsubst@,(%a,None)@]" raw_type t
+ | Tsubst (t, Some t') ->
+ fprintf ppf "@[<1>Tsubst@,(%a,@ Some%a)@]" raw_type t raw_type t'
+ | Tunivar name -> fprintf ppf "Tunivar %a" print_name name
+ | Tpoly (t, tl) ->
+ fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
+ raw_type t
+ raw_type_list tl
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ fprintf ppf
+ "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
+ "row_fields="
+ (raw_list (fun ppf (l, f) ->
+ fprintf ppf "@[%s,@ %a@]" l raw_field f))
+ fields
+ "row_more=" raw_type more
+ "row_closed=" closed
+ "row_fixed=" raw_row_fixed fixed
+ "row_name="
+ (fun ppf ->
+ match name with None -> fprintf ppf "None"
+ | Some(p,tl) ->
+ fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
+ | Tpackage (p, fl) ->
+ fprintf ppf "@[<hov1>Tpackage(@,%a,@,%a)@]" path p raw_lid_type_list fl
+and raw_row_fixed ppf = function
+| None -> fprintf ppf "None"
+| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private"
+| Some Types.Rigid -> fprintf ppf "Some Rigid"
+| Some Types.Univar t -> fprintf ppf "Some(Univar(%a))" raw_type t
+| Some Types.Reified p -> fprintf ppf "Some(Reified(%a))" path p
+
+and raw_field ppf rf =
+ match_row_field
+ ~absent:(fun _ -> fprintf ppf "RFabsent")
+ ~present:(function
+ | None ->
+ fprintf ppf "RFpresent None"
+ | Some t ->
+ fprintf ppf "@[<1>RFpresent(Some@,%a)@]" raw_type t)
+ ~either:(fun c tl m (_,e) ->
+ fprintf ppf "@[<hov1>RFeither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
+ raw_type_list tl m
+ (fun ppf ->
+ match e with None -> fprintf ppf " RFnone"
+ | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f))
+ rf
+
+let type_expr ppf t =
+ visited := []; kind_vars := []; kind_count := 0;
+ raw_type ppf t;
+ visited := []; kind_vars := []
diff --git a/src/ocaml/typing/rawprinttyp.mli b/src/ocaml/typing/rawprinttyp.mli
new file mode 100644
index 0000000000..205bf299e5
--- /dev/null
+++ b/src/ocaml/typing/rawprinttyp.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jacques Garrigue, Graduate School of Mathematics, Nagoya University *)
+(* *)
+(* Copyright 2003 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. *)
+(* *)
+(**************************************************************************)
+
+(** This module provides function(s) for printing the internal representation of
+ type expressions. It is targetted at internal use when debbuging the
+ compiler itself. *)
+
+val type_expr: Format.formatter -> Types.type_expr -> unit
diff --git a/src/ocaml/typing/saved_parts.mli b/src/ocaml/typing/saved_parts.mli
index be1a20693f..23569e3780 100644
--- a/src/ocaml/typing/saved_parts.mli
+++ b/src/ocaml/typing/saved_parts.mli
@@ -1,3 +1,3 @@
val attribute : string Location.loc
-val store : Cmt_format.binary_part list -> Parsetree.constant
-val find : Parsetree.constant -> Cmt_format.binary_part list
+val store : Cmt_format.binary_part list -> Parsetree.constant_desc
+val find : Parsetree.constant_desc -> Cmt_format.binary_part list
diff --git a/src/ocaml/typing/shape.ml b/src/ocaml/typing/shape.ml
index 1d588c647d..41c2b65a41 100644
--- a/src/ocaml/typing/shape.ml
+++ b/src/ocaml/typing/shape.ml
@@ -16,7 +16,7 @@
module Uid = struct
type t =
| Compilation_unit of string
- | Item of { comp_unit: string; id: int }
+ | Item of { comp_unit: string; id: int; from: Unit_info.intf_or_impl }
| Internal
| Predef of string
@@ -27,11 +27,16 @@ module Uid = struct
let compare (x : t) y = compare x y
let hash (x : t) = Hashtbl.hash x
+ let pp_intf_or_impl fmt = function
+ | Unit_info.Intf -> Format.pp_print_string fmt "[intf]"
+ | Unit_info.Impl -> ()
+
let print fmt = function
| Internal -> Format.pp_print_string fmt "<internal>"
| Predef name -> Format.fprintf fmt "<predef:%s>" name
| Compilation_unit s -> Format.pp_print_string fmt s
- | Item { comp_unit; id } -> Format.fprintf fmt "%s.%d" comp_unit id
+ | Item { comp_unit; id; from } ->
+ Format.fprintf fmt "%a%s.%d" pp_intf_or_impl from comp_unit id
let output oc t =
let fmt = Format.formatter_of_out_channel oc in
@@ -50,8 +55,14 @@ module Uid = struct
| _ -> None
let mk ~current_unit =
+ let comp_unit, from =
+ let open Unit_info in
+ match current_unit with
+ | None -> "", Impl
+ | Some ui -> modname ui, kind ui
+ in
incr id;
- Item { comp_unit = current_unit; id = !id }
+ Item { comp_unit; id = !id; from }
let of_compilation_unit_id id =
if not (Ident.persistent id) then
diff --git a/src/ocaml/typing/shape.mli b/src/ocaml/typing/shape.mli
index 115cce4596..83300d8ef5 100644
--- a/src/ocaml/typing/shape.mli
+++ b/src/ocaml/typing/shape.mli
@@ -43,9 +43,9 @@
[cmt_format.cmt_uid_to_decl] table of the corresponding compilation unit.
See:
- - {{: https://icfp22.sigplan.org/details/mlfamilyworkshop-2022-papers/10/Module-Shapes-for-Modern-Tooling }
+ - {{:https://icfp22.sigplan.org/details/mlfamilyworkshop-2022-papers/10/Module-Shapes-for-Modern-Tooling}
the design document}
- - {{: https://www.lix.polytechnique.fr/Labo/Gabriel.Scherer/research/shapes/2022-ml-workshop-shapes-talk.pdf }
+ - {{:https://www.lix.polytechnique.fr/Labo/Gabriel.Scherer/research/shapes/2022-ml-workshop-shapes-talk.pdf}
a talk about the reduction strategy
*)
@@ -57,7 +57,7 @@
module Uid : sig
type t = private
| Compilation_unit of string
- | Item of { comp_unit: string; id: int }
+ | Item of { comp_unit: string; id: int; from: Unit_info.intf_or_impl }
| Internal
| Predef of string
@@ -66,7 +66,7 @@ module Uid : sig
val restore_stamp : int -> unit
val stamp_of_uid : t -> int option
- val mk : current_unit:string -> t
+ val mk : current_unit:(Unit_info.t option) -> t
val of_compilation_unit_id : Ident.t -> t
val of_predef_id : Ident.t -> t
val internal_not_actually_unique : t
diff --git a/src/ocaml/typing/stypes.ml b/src/ocaml/typing/stypes.ml
index 9d4a2ff70f..035b488811 100644
--- a/src/ocaml/typing/stypes.ml
+++ b/src/ocaml/typing/stypes.ml
@@ -103,7 +103,7 @@ let sort_filter_phrases () =
let rec printtyp_reset_maybe loc =
match !phrases with
| cur :: t when cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum ->
- Printtyp.reset ();
+ Out_type.reset ();
phrases := t;
printtyp_reset_maybe loc;
| _ -> ()
@@ -148,7 +148,9 @@ let print_info pp prev_loc ti =
printtyp_reset_maybe loc;
Format.pp_print_string Format.str_formatter " ";
Printtyp.wrap_printing_env ~error:false env
- (fun () -> Printtyp.shared_type_scheme Format.str_formatter typ);
+ (fun () ->
+ Printtyp.shared_type_scheme
+ Format.str_formatter typ);
(* (fun () -> Printtyp.shared_type_scheme Format.str_formatter typ); *)
Format.pp_print_newline Format.str_formatter ();
let s = Format.flush_str_formatter () in
diff --git a/src/ocaml/typing/subst.ml b/src/ocaml/typing/subst.ml
index de9bf07144..616652b534 100644
--- a/src/ocaml/typing/subst.ml
+++ b/src/ocaml/typing/subst.ml
@@ -26,7 +26,7 @@ type type_replacement =
| Path of Path.t
| Type_function of { params : type_expr list; body : type_expr }
-type t =
+type s =
{ types: type_replacement Path.Map.t;
modules: Path.t Path.Map.t;
modtypes: module_type Path.Map.t;
@@ -35,6 +35,12 @@ type t =
make_loc_ghost: bool;
}
+type 'a subst = s
+type safe = [`Safe]
+type unsafe = [`Unsafe]
+type t = safe subst
+exception Module_type_path_substituted_away of Path.t * Types.module_type
+
let identity =
{ types = Path.Map.empty;
modules = Path.Map.empty;
@@ -44,17 +50,17 @@ let identity =
make_loc_ghost = false;
}
-let add_type_path id p s = { s with types = Path.Map.add id (Path p) s.types }
-let add_type id p s = add_type_path (Pident id) p s
+let unsafe x = x
-let add_type_function id ~params ~body s =
- { s with types = Path.Map.add id (Type_function { params; body }) s.types }
+let add_type id p s =
+ { s with types = Path.Map.add (Pident id) (Path p) s.types }
-let add_module_path id p s = { s with modules = Path.Map.add id p s.modules }
-let add_module id p s = add_module_path (Pident id) p s
+let add_module id p s =
+ { s with modules = Path.Map.add (Pident id) p s.modules }
-let add_modtype_path p ty s = { s with modtypes = Path.Map.add p ty s.modtypes }
-let add_modtype id ty s = add_modtype_path (Pident id) ty s
+let add_modtype_gen p ty s = { s with modtypes = Path.Map.add p ty s.modtypes }
+let add_modtype_path p p' s = add_modtype_gen p (Mty_ident p') s
+let add_modtype id p s = add_modtype_path (Pident id) p s
let for_saving s = { s with for_saving = true }
let change_locs s loc = { s with loc = Some loc }
@@ -104,8 +110,8 @@ let rec module_path s path =
let modtype_path s path =
match Path.Map.find path s.modtypes with
| Mty_ident p -> p
- | Mty_alias _ | Mty_signature _ | Mty_functor _ | Mty_for_hole ->
- fatal_error "Subst.modtype_path"
+ | Mty_alias _ | Mty_signature _ | Mty_functor _ | Mty_for_hole as mty ->
+ raise (Module_type_path_substituted_away (path,mty))
| exception Not_found ->
match path with
| Pdot(p, n) ->
@@ -589,7 +595,7 @@ let rename_bound_idents scoping s sg =
| SigL_modtype(id, mtd, vis) :: rest ->
let id' = rename id in
rename_bound_idents
- (add_modtype id (Mty_ident(Pident id')) s)
+ (add_modtype id (Pident id') s)
(SigL_modtype(id', mtd, vis) :: sg)
rest
| SigL_class(id, cd, rs, vis) :: rest ->
@@ -841,3 +847,27 @@ let modtype_declaration sc s decl =
let module_declaration scoping s decl =
Lazy.(decl |> of_module_decl |> module_decl scoping s |> force_module_decl)
+
+module Unsafe = struct
+
+ type t = unsafe subst
+ type error = Fcm_type_substituted_away of Path.t * Types.module_type
+
+ let add_modtype_path = add_modtype_gen
+ let add_modtype id mty s = add_modtype_path (Pident id) mty s
+ let add_type_path id p s = { s with types = Path.Map.add id (Path p) s.types }
+ let add_type_function id ~params ~body s =
+ { s with types = Path.Map.add id (Type_function { params; body }) s.types }
+ let add_module_path id p s = { s with modules = Path.Map.add id p s.modules }
+
+ let wrap f = match f () with
+ | x -> Ok x
+ | exception Module_type_path_substituted_away (p,mty) ->
+ Error (Fcm_type_substituted_away (p,mty))
+
+ let signature_item sc s comp = wrap (fun () -> signature_item sc s comp)
+ let signature sc s comp = wrap (fun () -> signature sc s comp )
+ let compose s1 s2 = wrap (fun () -> compose s1 s2)
+ let type_declaration s t = wrap (fun () -> type_declaration s t)
+
+end
diff --git a/src/ocaml/typing/subst.mli b/src/ocaml/typing/subst.mli
index d278d01c24..075d5ae074 100644
--- a/src/ocaml/typing/subst.mli
+++ b/src/ocaml/typing/subst.mli
@@ -13,13 +13,12 @@
(* *)
(**************************************************************************)
-(* Substitutions *)
+(** Substitutions *)
open Types
-type t
-(*
+(**
Substitutions are used to translate a type from one context to
another. This requires substituting paths for identifiers, and
possibly also lowering the level of non-generic variables so that
@@ -29,23 +28,33 @@ type t
Indeed, non-variable node of a type are duplicated, with their
levels set to generic level. That way, the resulting type is
well-formed (decreasing levels), even if the original one was not.
-*)
-val identity: t
+ In the presence of local substitutions for module types, a substitution for a
+ type expression may fail to produce a well-formed type. In order to confine
+ this issue to local substitutions, the type of substitutions is split into a
+ safe and unsafe variant. Only unsafe substitutions may expand a module type
+ path into a generic module type. *)
+
+(** Type familly for substitutions *)
+type +'k subst
+
+type safe = [`Safe]
+type unsafe = [`Unsafe]
+
+type t = safe subst
+(** Standard substitution*)
-val add_type: Ident.t -> Path.t -> t -> t
-val add_type_path: Path.t -> Path.t -> t -> t
-val add_type_function:
- Path.t -> params:type_expr list -> body:type_expr -> t -> t
-val add_module: Ident.t -> Path.t -> t -> t
-val add_module_path: Path.t -> Path.t -> t -> t
-val add_modtype: Ident.t -> module_type -> t -> t
-val add_modtype_path: Path.t -> module_type -> t -> t
+val identity: 'a subst
+val unsafe: t -> unsafe subst
+
+val add_type: Ident.t -> Path.t -> 'k subst -> 'k subst
+val add_module: Ident.t -> Path.t -> 'k subst -> 'k subst
+val add_modtype: Ident.t -> Path.t -> 'k subst -> 'k subst
val for_saving: t -> t
val make_loc_ghost: t -> t
val reset_for_saving: unit -> unit
-val change_locs: t -> Location.t -> t
+val change_locs: 'k subst -> Location.t -> 'k subst
val module_path: t -> Path.t -> Path.t
val type_path: t -> Path.t -> Path.t
@@ -60,7 +69,7 @@ val extension_constructor:
val class_declaration: t -> class_declaration -> class_declaration
val cltype_declaration: t -> class_type_declaration -> class_type_declaration
-(*
+(**
When applied to a signature item, a substitution not only modifies the types
present in its declaration, but also refreshes the identifier of the item.
Effectively this creates new declarations, and so one should decide what the
@@ -81,10 +90,44 @@ val modtype_declaration:
scoping -> t -> modtype_declaration -> modtype_declaration
val module_declaration: scoping -> t -> module_declaration -> module_declaration
-(* Composition of substitutions:
- apply (compose s1 s2) x = apply s2 (apply s1 x) *)
+(** Composition of substitutions:
+ apply (compose s1 s2) x = apply s2 (apply s1 x) **)
val compose: t -> t -> t
+module Unsafe: sig
+
+ type t = unsafe subst
+ (** Unsafe substitutions introduced by [with] constraints, local substitutions
+ ([type t := int * int]) or recursive module check. *)
+
+(** Replacing a module type name S by a non-path signature is unsafe as the
+ packed module type [(module S)] becomes ill-formed. *)
+ val add_modtype: Ident.t -> module_type -> 'any subst -> t
+ val add_modtype_path: Path.t -> module_type -> 'any subst -> t
+
+ (** Deep editing inside a module type require to retypecheck the module, for
+ applicative functors in path and module aliases. *)
+ val add_type_path: Path.t -> Path.t -> t -> t
+ val add_type_function:
+ Path.t -> params:type_expr list -> body:type_expr -> t -> t
+ val add_module_path: Path.t -> Path.t -> t -> t
+
+ type error =
+ | Fcm_type_substituted_away of Path.t * Types.module_type
+
+ type 'a res := ('a, error) result
+
+ val type_declaration: t -> type_declaration -> type_declaration res
+ val signature_item: scoping -> t -> signature_item -> signature_item res
+ val signature: scoping -> t -> signature -> signature res
+
+ val compose: t -> t -> t res
+ (** Composition of substitutions is eager and fails when the two substitution
+ are incompatible, for example [ module type t := sig end] is not
+ compatible with [module type s := sig type t=(module t) end]*)
+
+end
+
module Lazy : sig
type module_decl =
{
diff --git a/src/ocaml/typing/tast_iterator.ml b/src/ocaml/typing/tast_iterator.ml
index 408454ad37..a77402de0e 100644
--- a/src/ocaml/typing/tast_iterator.ml
+++ b/src/ocaml/typing/tast_iterator.ml
@@ -317,12 +317,14 @@ let expr sub {exp_loc; exp_extra; exp_desc; exp_env; exp_attributes; _} =
| Texp_apply (exp, list) ->
sub.expr sub exp;
List.iter (fun (_, o) -> Option.iter (sub.expr sub) o) list
- | Texp_match (exp, cases, _) ->
+ | Texp_match (exp, cases, effs, _) ->
sub.expr sub exp;
- List.iter (sub.case sub) cases
- | Texp_try (exp, cases) ->
+ List.iter (sub.case sub) cases;
+ List.iter (sub.case sub) effs
+ | Texp_try (exp, cases, effs) ->
sub.expr sub exp;
- List.iter (sub.case sub) cases
+ List.iter (sub.case sub) cases;
+ List.iter (sub.case sub) effs
| Texp_tuple list -> List.iter (sub.expr sub) list
| Texp_construct (lid, _, args) ->
iter_loc sub lid;
diff --git a/src/ocaml/typing/tast_mapper.ml b/src/ocaml/typing/tast_mapper.ml
index bcb0461741..ea8af17a53 100644
--- a/src/ocaml/typing/tast_mapper.ml
+++ b/src/ocaml/typing/tast_mapper.ml
@@ -362,16 +362,18 @@ let expr sub x =
sub.expr sub exp,
List.map (tuple2 id (Option.map (sub.expr sub))) list
)
- | Texp_match (exp, cases, p) ->
+ | Texp_match (exp, cases, eff_cases, p) ->
Texp_match (
sub.expr sub exp,
List.map (sub.case sub) cases,
+ List.map (sub.case sub) eff_cases,
p
)
- | Texp_try (exp, cases) ->
+ | Texp_try (exp, exn_cases, eff_cases) ->
Texp_try (
sub.expr sub exp,
- List.map (sub.case sub) cases
+ List.map (sub.case sub) exn_cases,
+ List.map (sub.case sub) eff_cases
)
| Texp_tuple list ->
Texp_tuple (List.map (sub.expr sub) list)
@@ -846,11 +848,12 @@ let value_bindings sub (rec_flag, list) =
let case
: type k . mapper -> k case -> k case
- = fun sub {c_lhs; c_guard; c_rhs} ->
+ = fun sub {c_lhs; c_guard; c_rhs; c_cont} ->
{
c_lhs = sub.pat sub c_lhs;
c_guard = Option.map (sub.expr sub) c_guard;
c_rhs = sub.expr sub c_rhs;
+ c_cont
}
let value_binding sub x =
diff --git a/src/ocaml/typing/typeclass.ml b/src/ocaml/typing/typeclass.ml
index 0c14185f47..755b77e9f4 100644
--- a/src/ocaml/typing/typeclass.ml
+++ b/src/ocaml/typing/typeclass.ml
@@ -19,7 +19,6 @@ open Path
open Types
open Typecore
open Typetexp
-open Format
type 'a class_info = {
@@ -48,7 +47,7 @@ type class_type_info = {
type 'a full_class = {
id : Ident.t;
- id_loc : tag loc;
+ id_loc : string loc;
clty: class_declaration;
ty_id: Ident.t;
cltydef: class_type_declaration;
@@ -94,7 +93,7 @@ type error =
| Bad_class_type_parameters of Ident.t * type_expr list * type_expr list
| Class_match_failure of Ctype.class_match_failure list
| Unbound_val of string
- | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+ | Unbound_type_var of Format_doc.t * Ctype.closed_class_failure
| Non_generalizable_class of
{ id : Ident.t
; clty : Types.class_declaration
@@ -465,7 +464,7 @@ let enter_ancestor_met ~loc name ~sign ~meths ~cl_num ~ty ~attrs met_env =
{ val_type = ty; val_kind = kind;
val_attributes = attrs;
Types.val_loc = loc;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
in
Env.enter_value ~check name desc met_env
@@ -480,7 +479,7 @@ let add_self_met loc id sign self_var_kind vars cl_num
{ val_type = ty; val_kind = kind;
val_attributes = attrs;
Types.val_loc = loc;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
in
Env.add_value ~check id desc met_env
@@ -495,7 +494,7 @@ let add_instance_var_met loc label id sign cl_num attrs met_env =
{ val_type = ty; val_kind = kind;
val_attributes = attrs;
Types.val_loc = loc;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
in
Env.add_value id desc met_env
@@ -654,10 +653,9 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
with_attrs
(fun () ->
let cty =
- Ctype.with_local_level_if_principal
+ Ctype.with_local_level_generalize_structure_if_principal
(fun () -> Typetexp.transl_simple_type val_env
~closed:false styp)
- ~post:(fun cty -> Ctype.generalize_structure cty.ctyp_type)
in
add_instance_variable ~strict:true loc val_env
label.txt mut Virtual cty.ctyp_type sign;
@@ -694,8 +692,7 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
No_overriding ("instance variable", label.txt)))
end;
let definition =
- Ctype.with_local_level_if_principal
- ~post:Typecore.generalize_structure_exp
+ Ctype.with_local_level_generalize_structure_if_principal
(fun () -> type_exp val_env sdefinition)
in
add_instance_variable ~strict:true loc val_env
@@ -1028,7 +1025,7 @@ and class_structure cl_num virt self_scope final val_env met_env loc
raise(Error(loc, val_env, Closing_self_type sign));
end;
(* Typing of method bodies *)
- Ctype.generalize_class_signature_spine val_env sign;
+ Ctype.generalize_class_signature_spine sign;
let self_var_kind =
match virt with
| Virtual -> Self_virtual(ref meths)
@@ -1036,9 +1033,9 @@ and class_structure cl_num virt self_scope final val_env met_env loc
in
let met_env =
List.fold_right
- (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} met_env ->
+ (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes} met_env ->
add_self_met pv_loc pv_id sign self_var_kind vars
- cl_num pv_as_var pv_type pv_attributes met_env)
+ cl_num (pv_kind=As_var) pv_type pv_attributes met_env)
self_pat_vars met_env
in
let fields =
@@ -1151,13 +1148,9 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
class_expr cl_num val_env met_env virt self_scope sfun
| Pcl_fun (l, None, spat, scl') ->
let (pat, pv, val_env', met_env) =
- Ctype.with_local_level_if_principal
+ Ctype.with_local_level_generalize_structure_if_principal
(fun () ->
Typecore.type_class_arg_pattern cl_num val_env met_env l spat)
- ~post: begin fun (pat, _, _, _) ->
- let gen {pat_type = ty} = Ctype.generalize_structure ty in
- iter_pattern gen pat
- end
in
let pv =
List.map
@@ -1183,7 +1176,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
let partial =
let dummy = type_exp val_env (Ast_helper.Exp.unreachable ()) in
Typecore.check_partial val_env pat.pat_type pat.pat_loc
- [{c_lhs = pat; c_guard = None; c_rhs = dummy}]
+ [{c_lhs = pat; c_cont = None; c_guard = None; c_rhs = dummy}]
in
let cl =
Ctype.with_raised_nongen_level
@@ -1201,9 +1194,8 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
| Pcl_apply (scl', sargs) ->
assert (sargs <> []);
let cl =
- Ctype.with_local_level_if_principal
+ Ctype.with_local_level_generalize_structure_if_principal
(fun () -> class_expr cl_num val_env met_env virt self_scope scl')
- ~post:(fun cl -> Ctype.generalize_class_type_structure cl.cl_type)
in
let rec nonopt_labels ls ty_fun =
match ty_fun with
@@ -1222,7 +1214,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
Location.prerr_warning
cl.cl_loc
(Warnings.Labels_omitted
- (List.map Printtyp.string_of_label
+ (List.map Asttypes.string_of_label
(List.filter ((<>) Nolabel) labels)));
true
end
@@ -1270,7 +1262,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
if not optional && Btype.is_optional l' then
Location.prerr_warning sarg.pexp_loc
(Warnings.Nonoptional_label
- (Printtyp.string_of_label l));
+ (Asttypes.string_of_label l));
remaining_sargs, use_arg sarg l'
| None ->
sargs,
@@ -1314,7 +1306,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
(* do not mark the value as used *)
let vd = Env.find_value path val_env in
let ty =
- Ctype.with_local_level ~post:Ctype.generalize
+ Ctype.with_local_level_generalize
(fun () -> Ctype.instance vd.val_type)
in
let expr =
@@ -1372,8 +1364,10 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
cl, clty
end
~post: begin fun ({cl_type=cl}, {cltyp_type=clty}) ->
- Ctype.limited_generalize_class_type (Btype.self_type_row cl) cl;
- Ctype.limited_generalize_class_type (Btype.self_type_row clty) clty;
+ Ctype.limited_generalize_class_type
+ (Btype.self_type_row cl) ~inside:cl;
+ Ctype.limited_generalize_class_type
+ (Btype.self_type_row clty) ~inside:clty;
end
in
begin match
@@ -1474,8 +1468,8 @@ let initial_env define_class approx
(* Temporary type for the class constructor *)
let constr_type =
- Ctype.with_local_level_if_principal (fun () -> approx cl.pci_expr)
- ~post:Ctype.generalize_structure
+ Ctype.with_local_level_generalize_structure_if_principal
+ (fun () -> approx cl.pci_expr)
in
let dummy_cty = Cty_signature (Ctype.new_class_signature ()) in
let dummy_class =
@@ -1560,8 +1554,10 @@ let class_infos define_class kind
end
~post: begin fun (_, params, _, _, typ, sign) ->
(* Generalize the row variable *)
- List.iter (Ctype.limited_generalize sign.csig_self_row) params;
- Ctype.limited_generalize_class_type sign.csig_self_row typ;
+ List.iter
+ (fun inside -> Ctype.limited_generalize sign.csig_self_row ~inside)
+ params;
+ Ctype.limited_generalize_class_type sign.csig_self_row ~inside:typ;
end
in
(* Check the abbreviation for the object type *)
@@ -1710,31 +1706,20 @@ let class_infos define_class kind
arity, pub_meths, List.rev !coercion_locs, expr) :: res,
env)
-let final_decl env define_class
- (cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, ci_params,
- arity, pub_meths, coe, expr) =
- let cl_abbr = cltydef.clty_hash_type in
-
- begin try Ctype.collapse_conj_params env clty.cty_params
+let collapse_conj_class_params env (cl, id, clty, _, _, _, _, _, _, _, _, _) =
+ try Ctype.collapse_conj_params env clty.cty_params
with Ctype.Unify err ->
raise(Error(cl.pci_loc, env, Non_collapsable_conjunction (id, clty, err)))
- end;
-
- List.iter Ctype.generalize clty.cty_params;
- Ctype.generalize_class_type clty.cty_type;
- Option.iter Ctype.generalize clty.cty_new;
- List.iter Ctype.generalize obj_abbr.type_params;
- Option.iter Ctype.generalize obj_abbr.type_manifest;
- List.iter Ctype.generalize cl_abbr.type_params;
- Option.iter Ctype.generalize cl_abbr.type_manifest;
+let final_decl env define_class
+ (cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, ci_params,
+ arity, pub_meths, coe, expr) =
Ctype.nongen_vars_in_class_declaration clty
|> Option.iter (fun vars ->
let nongen_vars = Btype.TypeSet.elements vars in
raise(Error(cl.pci_loc, env
, Non_generalizable_class { id; clty; nongen_vars }));
);
-
begin match
Ctype.closed_class clty.cty_params
(Btype.signature_of_class_type clty.cty_type)
@@ -1743,8 +1728,11 @@ let final_decl env define_class
| Some reason ->
let printer =
if define_class
- then function ppf -> Printtyp.class_declaration id ppf clty
- else function ppf -> Printtyp.cltype_declaration id ppf cltydef
+ then
+ Format_doc.doc_printf "%a" (Printtyp.Doc.class_declaration id) clty
+ else
+ Format_doc.doc_printf "%a"
+ (Printtyp.Doc.cltype_declaration id) cltydef
in
raise(Error(cl.pci_loc, env, Unbound_type_var(printer, reason)))
end;
@@ -1848,25 +1836,26 @@ let type_classes define_class approx kind env cls =
Ident.create_scoped ~scope cl.pci_name.txt,
Ident.create_scoped ~scope cl.pci_name.txt,
Ident.create_scoped ~scope cl.pci_name.txt,
- Uid.mk ~current_unit:(Env.get_unit_name ())
+ Uid.mk ~current_unit:(Env.get_current_unit ())
))
cls
in
- let res, newenv =
- Ctype.with_local_level_for_class begin fun () ->
+ let res, env =
+ Ctype.with_local_level_generalize_for_class begin fun () ->
let (res, env) =
List.fold_left (initial_env define_class approx) ([], env) cls
in
let (res, env) =
List.fold_right (class_infos define_class kind) res ([], env)
in
+ List.iter (collapse_conj_class_params env) res;
res, env
end
in
- let res = List.rev_map (final_decl newenv define_class) res in
+ let res = List.rev_map (final_decl env define_class) res in
let decls = List.fold_right extract_type_decls res [] in
let decls =
- try Typedecl_variance.update_class_decls newenv decls
+ try Typedecl_variance.update_class_decls env decls
with Typedecl_variance.Error(loc, err) ->
raise (Typedecl.Error(loc, Typedecl.Variance err))
in
@@ -1980,7 +1969,7 @@ let approx_class_declarations env sdecls =
(* Error report *)
-open Format
+open Format_doc
let non_virtual_string_of_kind : kind -> string = function
| Object -> "object"
@@ -1988,32 +1977,36 @@ let non_virtual_string_of_kind : kind -> string = function
| Class_type -> "non-virtual class type"
module Style=Misc.Style
+module Printtyp = Printtyp.Doc
-let report_error env ppf =
+let out_type ppf t = Style.as_inline_code !Oprint.out_type ppf t
+let quoted_type ppf t = Style.as_inline_code Printtyp.type_expr ppf t
+
+let report_error_doc env ppf =
let pp_args ppf args =
- let args = List.map (Printtyp.tree_of_typexp Type) args in
+ let args = List.map (Out_type.tree_of_typexp Type) args in
Style.as_inline_code !Oprint.out_type_args ppf args
in
function
| Repeated_parameter ->
fprintf ppf "A type parameter occurs several times"
| Unconsistent_constraint err ->
+ let msg = Format_doc.Doc.msg in
fprintf ppf "@[<v>The class constraints are not consistent.@ ";
- Printtyp.report_unification_error ppf env err
- (fun ppf -> fprintf ppf "Type")
- (fun ppf -> fprintf ppf "is not compatible with type");
+ Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "is not compatible with type");
fprintf ppf "@]"
| Field_type_mismatch (k, m, err) ->
- Printtyp.report_unification_error ppf env err
- (function ppf ->
- fprintf ppf "The %s %a@ has type" k Style.inline_code m)
- (function ppf ->
- fprintf ppf "but is expected to have type")
+ let msg = Format_doc.doc_printf in
+ Errortrace_report.unification ppf env err
+ (msg "The %s %a@ has type" k Style.inline_code m)
+ (msg "but is expected to have type")
| Unexpected_field (ty, lab) ->
fprintf ppf
"@[@[<2>This object is expected to have type :@ %a@]\
@ This type does not have a method %a."
- (Style.as_inline_code Printtyp.type_expr) ty
+ quoted_type ty
Style.inline_code lab
| Structure_expected clty ->
fprintf ppf
@@ -2034,7 +2027,7 @@ let report_error env ppf =
(* XXX Revoir message d'erreur | Improve error message *)
fprintf ppf "@[%s@ %a@]"
"This pattern cannot match self: it only matches values of type"
- (Style.as_inline_code Printtyp.type_expr) ty
+ quoted_type ty
| Unbound_class_2 cl ->
fprintf ppf "@[The class@ %a@ is not yet completely defined@]"
(Style.as_inline_code Printtyp.longident) cl
@@ -2043,23 +2036,19 @@ let report_error env ppf =
(Style.as_inline_code Printtyp.longident) cl
| Abbrev_type_clash (abbrev, actual, expected) ->
(* XXX Afficher une trace ? | Print a trace? *)
- Printtyp.prepare_for_printing [abbrev; actual; expected];
+ Out_type.prepare_for_printing [abbrev; actual; expected];
fprintf ppf "@[The abbreviation@ %a@ expands to type@ %a@ \
but is used with type@ %a@]"
- (Style.as_inline_code !Oprint.out_type)
- (Printtyp.tree_of_typexp Type abbrev)
- (Style.as_inline_code !Oprint.out_type)
- (Printtyp.tree_of_typexp Type actual)
- (Style.as_inline_code !Oprint.out_type)
- (Printtyp.tree_of_typexp Type expected)
+ out_type (Out_type.tree_of_typexp Type abbrev)
+ out_type (Out_type.tree_of_typexp Type actual)
+ out_type (Out_type.tree_of_typexp Type expected)
| Constructor_type_mismatch (c, err) ->
- Printtyp.report_unification_error ppf env err
- (function ppf ->
- fprintf ppf "The expression %a has type"
+ let msg = Format_doc.doc_printf in
+ Errortrace_report.unification ppf env err
+ (msg "The expression %a has type"
Style.inline_code ("new " ^ c)
)
- (function ppf ->
- fprintf ppf "but is used with type")
+ (msg "but is used with type")
| Virtual_class (kind, mets, vals) ->
let kind = non_virtual_string_of_kind kind in
let missings =
@@ -2085,13 +2074,12 @@ let report_error env ppf =
but is here applied to %i type argument(s)@]"
(Style.as_inline_code Printtyp.longident) lid expected provided
| Parameter_mismatch err ->
- Printtyp.report_unification_error ppf env err
- (function ppf ->
- fprintf ppf "The type parameter")
- (function ppf ->
- fprintf ppf "does not meet its constraint: it should be")
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf env err
+ (msg "The type parameter")
+ (msg "does not meet its constraint: it should be")
| Bad_parameters (id, params, cstrs) ->
- Printtyp.prepare_for_printing (params @ cstrs);
+ Out_type.prepare_for_printing (params @ cstrs);
fprintf ppf
"@[The abbreviation %a@ is used with parameter(s)@ %a@ \
which are incompatible with constraint(s)@ %a@]"
@@ -2100,7 +2088,7 @@ let report_error env ppf =
pp_args cstrs
| Bad_class_type_parameters (id, params, cstrs) ->
let pp_hash ppf id = fprintf ppf "#%a" Printtyp.ident id in
- Printtyp.prepare_for_printing (params @ cstrs);
+ Out_type.prepare_for_printing (params @ cstrs);
fprintf ppf
"@[The class type %a@ is used with parameter(s)@ %a,@ \
whereas the class type definition@ constrains@ \
@@ -2109,10 +2097,10 @@ let report_error env ppf =
pp_args params
pp_args cstrs
| Class_match_failure error ->
- Includeclass.report_error Type ppf error
+ Includeclass.report_error_doc Type ppf error
| Unbound_val lab ->
fprintf ppf "Unbound instance variable %a" Style.inline_code lab
- | Unbound_type_var (printer, reason) ->
+ | Unbound_type_var (msg, reason) ->
let print_reason ppf { Ctype.free_variable; meth; meth_ty; } =
let (ty0, kind) = free_variable in
let ty1 =
@@ -2120,28 +2108,27 @@ let report_error env ppf =
| Type_variable -> ty0
| Row_variable -> Btype.newgenty(Tobject(ty0, ref None))
in
- Printtyp.add_type_to_preparation meth_ty;
- Printtyp.add_type_to_preparation ty1;
- let pp_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty in
+ Out_type.add_type_to_preparation meth_ty;
+ Out_type.add_type_to_preparation ty1;
fprintf ppf
"The method %a@ has type@;<1 2>%a@ where@ %a@ is unbound"
Style.inline_code meth
- pp_type (Printtyp.tree_of_typexp Type meth_ty)
- pp_type (Printtyp.tree_of_typexp Type ty0)
+ out_type (Out_type.tree_of_typexp Type meth_ty)
+ out_type (Out_type.tree_of_typexp Type ty0)
in
fprintf ppf
- "@[<v>@[Some type variables are unbound in this type:@;<1 2>%t@]@ \
+ "@[<v>@[Some type variables are unbound in this type:@;<1 2>%a@]@ \
@[%a@]@]"
- printer print_reason reason
+ pp_doc msg print_reason reason
| Non_generalizable_class {id; clty; nongen_vars } ->
let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2] in
- Printtyp.prepare_for_printing nongen_vars;
+ Out_type.prepare_for_printing nongen_vars;
fprintf ppf
"@[The type of this class,@ %a,@ \
contains the non-generalizable type variable(s): %a.@ %a@]"
(Style.as_inline_code @@ Printtyp.class_declaration id) clty
(pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
- (Style.as_inline_code Printtyp.prepared_type_scheme)
+ (Style.as_inline_code Out_type.prepared_type_scheme)
) nongen_vars
Misc.print_see_manual manual_ref
@@ -2152,20 +2139,20 @@ let report_error env ppf =
Some occurrences are contravariant@]"
(Style.as_inline_code Printtyp.type_scheme) ty
| Non_collapsable_conjunction (id, clty, err) ->
+ let msg = Format_doc.Doc.msg in
fprintf ppf
"@[The type of this class,@ %a,@ \
contains non-collapsible conjunctive types in constraints.@ %t@]"
(Style.as_inline_code @@ Printtyp.class_declaration id) clty
- (fun ppf -> Printtyp.report_unification_error ppf env err
- (fun ppf -> fprintf ppf "Type")
- (fun ppf -> fprintf ppf "is not compatible with type")
+ (fun ppf -> Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "is not compatible with type")
)
| Self_clash err ->
- Printtyp.report_unification_error ppf env err
- (function ppf ->
- fprintf ppf "This object is expected to have type")
- (function ppf ->
- fprintf ppf "but actually has type")
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf env err
+ (msg "This object is expected to have type")
+ (msg "but actually has type")
| Mutability_mismatch (_lab, mut) ->
let mut1, mut2 =
if mut = Immutable then "mutable", "immutable"
@@ -2192,17 +2179,19 @@ let report_error env ppf =
completely defined.@]"
(Style.as_inline_code Printtyp.type_scheme) sign.csig_self
-let report_error env ppf err =
+let report_error_doc env ppf err =
Printtyp.wrap_printing_env ~error:true
- env (fun () -> report_error env ppf err)
+ env (fun () -> report_error_doc env ppf err)
let () =
Location.register_error_of_exn
(function
| Error (loc, env, err) ->
- Some (Location.error_of_printer ~loc (report_error env) err)
+ Some (Location.error_of_printer ~loc (report_error_doc env) err)
| Error_forward err ->
Some err
| _ ->
None
)
+
+let report_error = Format_doc.compat1 report_error_doc
diff --git a/src/ocaml/typing/typeclass.mli b/src/ocaml/typing/typeclass.mli
index cdecc8dfb7..89e230d14d 100644
--- a/src/ocaml/typing/typeclass.mli
+++ b/src/ocaml/typing/typeclass.mli
@@ -15,8 +15,6 @@
open Asttypes
open Types
-open Format
-
type 'a class_info = {
cls_id : Ident.t;
cls_id_loc : string loc;
@@ -111,7 +109,7 @@ type error =
| Bad_class_type_parameters of Ident.t * type_expr list * type_expr list
| Class_match_failure of Ctype.class_match_failure list
| Unbound_val of string
- | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+ | Unbound_type_var of Format_doc.t * Ctype.closed_class_failure
| Non_generalizable_class of
{ id : Ident.t
; clty : Types.class_declaration
@@ -129,7 +127,8 @@ type error =
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
-val report_error : Env.t -> formatter -> error -> unit
+val report_error : Env.t -> Format.formatter -> error -> unit
+val report_error_doc : Env.t -> error Format_doc.printer
(* Forward decl filled in by Typemod.type_open_descr *)
val type_open_descr :
diff --git a/src/ocaml/typing/typecore.ml b/src/ocaml/typing/typecore.ml
index 605b6823bf..ad0c54dbee 100644
--- a/src/ocaml/typing/typecore.ml
+++ b/src/ocaml/typing/typecore.ml
@@ -98,6 +98,11 @@ type existential_restriction =
| In_class_def (** or in [class c = let ... in ...] *)
| In_self_pattern (** or in self pattern *)
+type existential_binding =
+ | Bind_already_bound
+ | Bind_not_in_scope
+ | Bind_non_locally_abstract
+
type error =
| Constructor_arity_mismatch of Longident.t * int * int
| Label_mismatch of Longident.t * Errortrace.unification_error
@@ -108,7 +113,7 @@ type error =
| Orpat_vars of Ident.t * Ident.t list
| Expr_type_clash of
Errortrace.unification_error * type_forcing_context option
- * Parsetree.expression_desc option
+ * Parsetree.expression option
| Function_arity_type_clash of
{ syntactic_arity : int;
type_constraint : type_expr;
@@ -177,6 +182,8 @@ type error =
| No_value_clauses
| Exception_pattern_disallowed
| Mixed_value_and_exception_patterns_under_guard
+ | Effect_pattern_below_toplevel
+ | Invalid_continuation_pattern
| Inlined_record_escape
| Inlined_record_expected
| Unrefuted_pattern of pattern
@@ -191,10 +198,15 @@ type error =
| Andop_type_clash of string * Errortrace.unification_error
| Bindings_type_clash of Errortrace.unification_error
| Unbound_existential of Ident.t list * type_expr
+ | Bind_existential of existential_binding * Ident.t * type_expr
| Missing_type_constraint
| Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
| Expr_not_a_record_type of type_expr
+
+let not_principal fmt =
+ Format_doc.Doc.kmsg (fun x -> Warnings.Not_principal x) fmt
+
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
@@ -206,7 +218,8 @@ let deep_copy () =
try TypeHash.find table ty
with Not_found ->
let ty' =
- let {Types. level; id; desc; scope} = Transient_expr.repr ty in
+ let ({Types. level; id; desc; _} as texp) = Transient_expr.repr ty in
+ let scope = Transient_expr.get_scope texp in
create_expr ~level ~id ~scope desc
in
TypeHash.add table ty ty';
@@ -357,7 +370,7 @@ type recarg =
let mk_expected ?explanation ty = { ty; explanation; }
let case lhs rhs =
- {c_lhs = lhs; c_guard = None; c_rhs = rhs}
+ {c_lhs = lhs; c_cont = None; c_guard = None; c_rhs = rhs}
(* Typing of constants *)
@@ -370,7 +383,8 @@ let type_constant = function
| Const_int64 _ -> instance Predef.type_int64
| Const_nativeint _ -> instance Predef.type_nativeint
-let constant : Parsetree.constant -> (Asttypes.constant, error) result =
+let constant_desc
+ : Parsetree.constant_desc -> (Asttypes.constant, error) result =
function
| Pconst_integer (i,None) ->
begin
@@ -398,6 +412,8 @@ let constant : Parsetree.constant -> (Asttypes.constant, error) result =
| Pconst_float (f,None)-> Ok (Const_float f)
| Pconst_float (f,Some c) -> Error (Unknown_literal (f, c))
+let constant const = constant_desc const.pconst_desc
+
let constant_or_raise env loc cst =
match constant cst with
| Ok c -> c
@@ -469,6 +485,23 @@ let is_principal ty =
(* Typing of patterns *)
+(* Simplified patterns for effect continuations *)
+let type_continuation_pat env expected_ty sp =
+ let loc = sp.ppat_loc in
+ match sp.ppat_desc with
+ | Ppat_any -> None
+ | Ppat_var name ->
+ let id = Ident.create_local name.txt in
+ let desc =
+ { val_type = expected_ty; val_kind = Val_reg;
+ Types.val_loc = loc; val_attributes = [];
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()); }
+ in
+ Some (id, desc)
+ | Ppat_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+ | _ -> raise (Error (loc, env, Invalid_continuation_pattern))
+
(* unification inside type_exp and type_expect *)
let unify_exp_types loc env ty expected_ty =
(* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type
@@ -505,6 +538,8 @@ let unify_pat_types_return_equated_pairs ~refine loc penv ty ty' =
raise(Typetexp.Error(loc, !!penv, Typetexp.Variant_tags (l1, l2)))
let unify_pat_types_refine ~refine loc penv ty ty' =
+ (* [refine=true] only in calls originating from [check_counter_example_pat],
+ which in turn may contain only non-leaking type variables *)
ignore (unify_pat_types_return_equated_pairs ~refine loc penv ty ty')
(** [sdesc_for_hint] is used by error messages to report literals in their
@@ -564,12 +599,17 @@ let finalize_variants p =
(* [type_pat_state] and related types for pattern environment;
these should not be confused with Pattern_env.t, which is a part of the
interface to unification functions in [Ctype] *)
+type pattern_variable_kind =
+ | Std_var
+ | As_var
+ | Continuation_var
+
type pattern_variable =
{
pv_id: Ident.t;
pv_type: type_expr;
pv_loc: Location.t;
- pv_as_var: bool;
+ pv_kind: pattern_variable_kind;
pv_attributes: attributes;
pv_uid : Uid.t;
}
@@ -619,7 +659,17 @@ type type_pat_state =
*)
}
-let create_type_pat_state allow_modules =
+let continuation_variable = function
+ | None -> []
+ | Some (id, (desc:Types.value_description)) ->
+ [{pv_id = id;
+ pv_type = desc.val_type;
+ pv_loc = desc.val_loc;
+ pv_kind = Continuation_var;
+ pv_attributes = desc.val_attributes;
+ pv_uid= desc.val_uid}]
+
+let create_type_pat_state ?cont allow_modules =
let tps_module_variables =
match allow_modules with
| Modules_allowed { scope } ->
@@ -627,7 +677,7 @@ let create_type_pat_state allow_modules =
| Modules_ignored -> Modvars_ignored
| Modules_rejected -> Modvars_rejected
in
- { tps_pattern_variables = [];
+ { tps_pattern_variables = continuation_variable cont;
tps_module_variables;
tps_pattern_force = [];
}
@@ -682,7 +732,7 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) tps loc name ty
{ mv_id = id;
mv_name = name;
mv_loc = loc;
- mv_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ mv_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
} :: module_variables
in
tps.tps_module_variables <-
@@ -691,12 +741,12 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) tps loc name ty
end else
Ident.create_local name.txt
in
- let pv_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+ let pv_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
tps.tps_pattern_variables <-
{pv_id = id;
pv_type = ty;
pv_loc = loc;
- pv_as_var = is_as_variable;
+ pv_kind = if is_as_variable then As_var else Std_var;
pv_attributes = attrs;
pv_uid} :: tps.tps_pattern_variables;
id, pv_uid
@@ -751,7 +801,7 @@ and build_as_type_extra env p = function
| (Tpat_constraint {ctyp_type = ty; _}, _, _) :: rest ->
(* If the type constraint is ground, then this is the best type
we can return, so just return an instance (cf. #12313) *)
- if free_variables ty = [] then instance ty else
+ if closed_type_expr ty then instance ty else
(* Otherwise we combine the inferred type for the pattern with
then non-ground constraint in a non-ambivalent way *)
let as_ty = build_as_type_extra env p rest in
@@ -761,7 +811,7 @@ and build_as_type_extra env p = function
If we used [generic_instance] we would lose the sharing between
[instance ty] and [ty]. *)
let ty =
- with_local_level ~post:generalize_structure (fun () -> instance ty)
+ with_local_level_generalize_structure (fun () -> instance ty)
in
(* This call to unify may only fail due to missing GADT equations *)
unify_pat_types p.pat_loc env (instance as_ty) (instance ty);
@@ -841,7 +891,7 @@ let solve_Ppat_poly_constraint tps env loc sty expected_ty =
| _ -> assert false
let solve_Ppat_alias env pat =
- with_local_level ~post:generalize (fun () -> build_as_type env pat)
+ with_local_level_generalize (fun () -> build_as_type env pat)
let solve_Ppat_tuple (type a) ~refine loc env (args : a list) expected_ty =
let vars = List.map (fun _ -> newgenvar ()) args in
@@ -851,23 +901,31 @@ let solve_Ppat_tuple (type a) ~refine loc env (args : a list) expected_ty =
vars
let solve_constructor_annotation
- tps (penv : Pattern_env.t) name_list sty ty_args ty_ex =
+ tps (penv : Pattern_env.t) name_list sty ty_args ty_ex unify_res =
let expansion_scope = penv.equations_scope in
- let ids =
+ (* Introduce fresh type names that expand to type variables.
+ They should eventually be bound to ground types. *)
+ let ids_decls =
List.map
(fun name ->
- let decl = new_local_type ~loc:name.loc Definition in
+ let tv = newvar () in
+ let decl =
+ new_local_type ~loc:name.loc Definition
+ ~manifest_and_scope:(tv, Ident.lowest_scope) in
let (id, new_env) =
Env.enter_type ~scope:expansion_scope name.txt decl !!penv in
Pattern_env.set_env penv new_env;
- {name with txt = id})
+ ({name with txt = id}, (decl, tv)))
name_list
in
+ (* Translate the type annotation using these type names. *)
let cty, ty, force =
- with_local_level ~post:(fun (_,ty,_) -> generalize_structure ty)
+ with_local_level_generalize_structure
(fun () -> Typetexp.transl_simple_type_delayed !!penv sty)
in
tps.tps_pattern_force <- force :: tps.tps_pattern_force;
+ (* Only unify the return type after generating the ids *)
+ unify_res ();
let ty_args =
let ty1 = instance ty and ty2 = instance ty in
match ty_args with
@@ -881,24 +939,62 @@ let solve_constructor_annotation
Ttuple tyl -> tyl
| _ -> assert false
in
- if ids <> [] then ignore begin
- let ids = List.map (fun x -> x.txt) ids in
+ if ids_decls <> [] then begin
+ let ids_decls = List.map (fun (x,dm) -> (x.txt,dm)) ids_decls in
+ let ids = List.map fst ids_decls in
let rem =
+ (* First process the existentials introduced by this constructor.
+ Just need to make their definitions abstract. *)
List.fold_left
(fun rem tv ->
match get_desc tv with
- Tconstr(Path.Pident id, [], _) when List.mem id rem ->
- list_remove id rem
+ Tconstr(Path.Pident id, [], _) when List.mem_assoc id rem ->
+ let decl, tv' = List.assoc id ids_decls in
+ let env =
+ Env.add_type ~check:false id
+ {decl with type_manifest = None} !!penv
+ in
+ Pattern_env.set_env penv env;
+ (* We have changed the definition, so clean up *)
+ Btype.cleanup_abbrev ();
+ (* Since id is now abstract, this does not create a cycle *)
+ unify_pat_types cty.ctyp_loc env tv tv';
+ List.remove_assoc id rem
| _ ->
- raise (Error (cty.ctyp_loc, !!penv,
+ raise (error (cty.ctyp_loc, !!penv,
Unbound_existential (ids, ty))))
- ids ty_ex
+ ids_decls ty_ex
in
- if rem <> [] then
- raise (Error (cty.ctyp_loc, !!penv,
- Unbound_existential (ids, ty)))
+ (* The other type names should be bound to newly introduced existentials. *)
+ let bound_ids = ref ids in
+ List.iter
+ (fun (id, (decl, tv')) ->
+ let tv' = expand_head !!penv tv' in
+ begin match get_desc tv' with
+ | Tconstr (Path.Pident id', [], _) ->
+ if List.exists (Ident.same id') !bound_ids then
+ raise (error (cty.ctyp_loc, !!penv,
+ Bind_existential (Bind_already_bound, id, tv')));
+ (* Both id and id' are Scoped identifiers, so their stamps grow *)
+ if Ident.scope id' <> penv.equations_scope
+ || Ident.compare_stamp id id' > 0 then
+ raise (error (cty.ctyp_loc, !!penv,
+ Bind_existential (Bind_not_in_scope, id, tv')));
+ bound_ids := id' :: !bound_ids
+ | _ ->
+ raise (error (cty.ctyp_loc, !!penv,
+ Bind_existential
+ (Bind_non_locally_abstract, id, tv')));
+ end;
+ let env =
+ Env.add_type ~check:false id
+ {decl with type_manifest = Some (duplicate_type tv')} !!penv
+ in
+ Pattern_env.set_env penv env)
+ rem;
+ if rem <> [] then Btype.cleanup_abbrev ();
end;
- ty_args, Some (ids, cty)
+ ty_args, Some (List.map fst ids_decls, cty)
let solve_Ppat_construct ~refine tps penv loc constr no_existentials
existential_styp expected_ty =
@@ -911,11 +1007,13 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
let unify_res ty_res expected_ty =
let refine =
refine || constr.cstr_generalized && no_existentials = None in
+ (* Here [ty_res] contains only fresh (non-leaking) type variables,
+ so the requirement of [unify_gadt] is fulfilled. *)
unify_pat_types_return_equated_pairs ~refine loc penv ty_res expected_ty
in
let ty_args, equated_types, existential_ctyp =
- with_local_level_iter ~post: generalize_structure begin fun () ->
+ with_local_level_generalize_structure begin fun () ->
let expected_ty = instance expected_ty in
let ty_args, ty_res, equated_types, existential_ctyp =
match existential_styp with
@@ -936,16 +1034,16 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
let ty_args, ty_res, ty_ex =
instance_constructor existential_treatment constr
in
- let equated_types = unify_res ty_res expected_ty in
+ let equated_types = lazy (unify_res ty_res expected_ty) in
let ty_args, existential_ctyp =
solve_constructor_annotation tps penv name_list sty ty_args ty_ex
+ (fun () -> ignore (Lazy.force equated_types))
in
- ty_args, ty_res, equated_types, existential_ctyp
+ ty_args, ty_res, Lazy.force equated_types, existential_ctyp
in
if constr.cstr_existentials <> [] then
lower_variables_only !!penv penv.Pattern_env.equations_scope ty_res;
- ((ty_args, equated_types, existential_ctyp),
- expected_ty :: ty_res :: ty_args)
+ (ty_args, equated_types, existential_ctyp)
end
in
if !Clflags.principal && not refine then begin
@@ -954,16 +1052,14 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
try
TypePairs.iter
(fun (t1, t2) ->
- generalize_structure t1;
- generalize_structure t2;
if not (fully_generic t1 && fully_generic t2) then
let msg =
- Format.asprintf
+ Format_doc.doc_printf
"typing this pattern requires considering@ %a@ and@ %a@ as \
equal.@,\
But the knowledge of these types"
- Printtyp.type_expr t1
- Printtyp.type_expr t2
+ Printtyp.Doc.type_expr t1
+ Printtyp.Doc.type_expr t2
in
Location.prerr_warning loc (Warnings.Not_principal msg);
raise Warn_only_once)
@@ -973,7 +1069,7 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
(ty_args, existential_ctyp)
let solve_Ppat_record_field ~refine loc penv label label_lid record_ty =
- with_local_level_iter ~post:generalize_structure begin fun () ->
+ with_local_level_generalize_structure begin fun () ->
let (_, ty_arg, ty_res) = instance_label ~fixed:false label in
begin try
unify_pat_types_refine ~refine loc penv ty_res (instance record_ty)
@@ -981,7 +1077,7 @@ let solve_Ppat_record_field ~refine loc penv label label_lid record_ty =
raise(error(label_lid.loc, !!penv,
Label_mismatch(label_lid.txt, err)))
end;
- (ty_arg, [ty_res; ty_arg])
+ ty_arg
end
let solve_Ppat_array ~refine loc env expected_ty =
@@ -999,7 +1095,7 @@ let solve_Ppat_lazy ~refine loc env expected_ty =
let solve_Ppat_constraint tps loc env sty expected_ty =
let cty, ty, force =
- with_local_level ~post:(fun (_, ty, _) -> generalize_structure ty)
+ with_local_level_generalize_structure
(fun () -> Typetexp.transl_simple_type_delayed env sty)
in
tps.tps_pattern_force <- force :: tps.tps_pattern_force;
@@ -1156,7 +1252,7 @@ end) = struct
[_] -> []
| _ -> let open Printtyp in
wrap_printing_env ~error:true env (fun () ->
- reset(); strings_of_paths (Some Type) tpaths)
+ Out_type.reset(); strings_of_paths (Some Type) tpaths)
let disambiguate_by_type env tpath lbls =
match lbls with
@@ -1171,10 +1267,12 @@ end) = struct
(* warn if there are several distinct candidates in scope *)
let warn_if_ambiguous warn lid env lbl rest =
if Warnings.is_active (Ambiguous_name ([],[],false,"")) then begin
- Printtyp.Conflicts.reset ();
+ Out_type.Ident_conflicts.reset ();
let paths = ambiguous_types env lbl rest in
- let expansion =
- Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
+ let expansion = match Out_type.Ident_conflicts.err_msg () with
+ | None -> ""
+ | Some msg -> Format_doc.(asprintf "%a" pp_doc) msg
+ in
if paths <> [] then
warn lid.loc
(Warnings.Ambiguous_name ([Longident.last lid.txt],
@@ -1185,15 +1283,15 @@ end) = struct
let warn_non_principal warn lid =
let name = Datatype_kind.label_name kind in
warn lid.loc
- (Warnings.Not_principal
- ("this type-based " ^ name ^ " disambiguation"))
+ (not_principal "this type-based %s disambiguation" name)
(* we selected a name out of the lexical scope *)
let warn_out_of_scope warn lid env tpath =
if Warnings.is_active (Name_out_of_scope ("",[],false)) then begin
let path_s =
Printtyp.wrap_printing_env ~error:true env
- (fun () -> Printtyp.string_of_path tpath) in
+ (fun () -> Format_doc.asprintf "%a" Printtyp.Doc.type_path tpath)
+ in
warn lid.loc
(Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
end
@@ -1433,7 +1531,7 @@ let disambiguate_lid_a_list loc closed env usage expected_type lid_a_list =
in
if !w_pr then
Location.prerr_warning loc
- (Warnings.Not_principal "this type-based record disambiguation")
+ (not_principal "this type-based record disambiguation")
else begin
match List.rev !w_amb with
(_,types,ex)::_ as amb ->
@@ -1586,6 +1684,7 @@ let rec has_literal_pattern p = match p.ppat_desc with
List.exists has_literal_pattern ps
| Ppat_record (ps, _) ->
List.exists (fun (_,p) -> has_literal_pattern p) ps
+ | Ppat_effect (p, q)
| Ppat_or (p, q) ->
has_literal_pattern p || has_literal_pattern q
@@ -1782,22 +1881,27 @@ and type_pat_aux
pat_type = type_constant cst;
pat_attributes = sp.ppat_attributes;
pat_env = !!penv }
- | Ppat_interval (Pconst_char c1, Pconst_char c2) ->
- let open Ast_helper.Pat in
+ | Ppat_interval (c1, c2) ->
+ let open Ast_helper in
+ let get_bound = function
+ | {pconst_desc = Pconst_char c; _} -> c
+ | {pconst_loc = loc; _} ->
+ raise (error (loc, !!penv, Invalid_interval))
+ in
+ let c1 = get_bound c1 in
+ let c2 = get_bound c2 in
let gloc = {loc with Location.loc_ghost=true} in
let rec loop c1 c2 =
- if c1 = c2 then constant ~loc:gloc (Pconst_char c1)
+ if c1 = c2 then Pat.constant ~loc:gloc (Const.char ~loc:gloc c1)
else
- or_ ~loc:gloc
- (constant ~loc:gloc (Pconst_char c1))
+ Pat.or_ ~loc:gloc
+ (Pat.constant ~loc:gloc (Const.char ~loc:gloc c1))
(loop (Char.chr(Char.code c1 + 1)) c2)
in
let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
let p = {p with ppat_loc=loc} in
type_pat tps category p expected_ty
(* TODO: record 'extra' to remember about interval *)
- | Ppat_interval _ ->
- raise (error (loc, !!penv, Invalid_interval))
| Ppat_tuple spl ->
assert (List.length spl >= 2);
let expected_tys =
@@ -1967,6 +2071,8 @@ and type_pat_aux
forces. *)
let tps1 = copy_type_pat_state tps in
let tps2 = {(copy_type_pat_state tps) with tps_pattern_force = []} in
+ (* Introduce a new level to avoid keeping nodes at intermediate levels *)
+ let pat_desc = with_local_level_generalize begin fun () ->
(* Introduce a new scope using with_local_level without generalizations *)
let env1, p1, env2, p2 =
with_local_level begin fun () ->
@@ -2009,7 +2115,10 @@ and type_pat_aux
}
~dst:tps;
let p2 = alpha_pat alpha_env p2 in
- rp { pat_desc = Tpat_or (p1, p2, None);
+ Tpat_or (p1, p2, None)
+ end
+ in
+ rp { pat_desc = pat_desc;
pat_loc = loc; pat_extra = [];
pat_type = instance expected_ty;
pat_attributes = sp.ppat_attributes;
@@ -2072,6 +2181,8 @@ and type_pat_aux
pat_env = !!penv;
pat_attributes = sp.ppat_attributes;
}
+ | Ppat_effect _ ->
+ raise (error (loc, !!penv, Effect_pattern_below_toplevel))
| Ppat_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
@@ -2080,8 +2191,8 @@ let iter_pattern_variables_type f : pattern_variable list -> unit =
let add_pattern_variables ?check ?check_as env pv =
List.fold_right
- (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes; pv_uid} env ->
- let check = if pv_as_var then check_as else check in
+ (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes; pv_uid} env ->
+ let check = if pv_kind=As_var then check_as else check in
Env.add_value ?check pv_id
{val_type = pv_type; val_kind = Val_reg; Types.val_loc = pv_loc;
val_attributes = pv_attributes;
@@ -2130,8 +2241,8 @@ let add_module_variables env module_variables =
let type_pat tps category ?no_existentials penv =
type_pat tps category ~no_existentials ~penv
-let type_pattern category ~lev env spat expected_ty allow_modules =
- let tps = create_type_pat_state allow_modules in
+let type_pattern category ~lev env spat expected_ty ?cont allow_modules =
+ let tps = create_type_pat_state ?cont allow_modules in
let new_penv = Pattern_env.make env
~equations_scope:lev ~allow_recursive_equations:false in
let pat = type_pat tps category new_penv spat expected_ty in
@@ -2177,13 +2288,13 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
if is_optional l then unify_pat val_env pat (type_option (newvar ()));
let (pv, val_env, met_env) =
List.fold_right
- (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes}
+ (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes}
(pv, val_env, met_env) ->
let check s =
- if pv_as_var then Warnings.Unused_var s
+ if pv_kind = As_var then Warnings.Unused_var s
else Warnings.Unused_var_strict s in
let id' = Ident.rename pv_id in
- let val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+ let val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
let val_env =
Env.add_value pv_id
{ val_type = pv_type
@@ -2518,8 +2629,10 @@ let check_counter_example_pat ~counter_example_args penv tp expected_ty =
way -- one of the functions it calls writes an entry into
[tps_pattern_forces] -- so we can just ignore module patterns. *)
let type_pat_state = create_type_pat_state Modules_ignored in
- check_counter_example_pat
- ~info:counter_example_args ~penv type_pat_state tp expected_ty (fun x -> x)
+ wrap_trace_gadt_instances ~force:true !!penv
+ (check_counter_example_pat ~info:counter_example_args ~penv
+ type_pat_state tp expected_ty)
+ (fun x -> x)
(* this function is passed to Partial.parmatch
to type check gadt nonexhaustiveness *)
@@ -2590,9 +2703,9 @@ let rec final_subexpression exp =
match exp.exp_desc with
Texp_let (_, _, e)
| Texp_sequence (_, e)
- | Texp_try (e, _)
+ | Texp_try (e, _, _)
| Texp_ifthenelse (_, e, _)
- | Texp_match (_, {c_rhs=e} :: _, _)
+ | Texp_match (_, {c_rhs=e} :: _, _, _)
| Texp_letmodule (_, _, _, _, e)
| Texp_letexception (_, e)
| Texp_open (_, e)
@@ -2614,7 +2727,7 @@ let rec is_nonexpansive exp =
is_nonexpansive body
| Texp_apply(e, (_,None)::el) ->
is_nonexpansive e && List.for_all is_nonexpansive_opt (List.map snd el)
- | Texp_match(e, cases, _) ->
+ | Texp_match(e, cases, _, _) ->
(* Not sure this is necessary, if [e] is nonexpansive then we shouldn't
care if there are exception patterns. But the previous version enforced
that there be none, so... *)
@@ -2880,14 +2993,19 @@ let rec list_labels_aux env visited ls ty_fun =
List.rev ls, is_Tvar ty
let list_labels env ty =
- wrap_trace_gadt_instances env (list_labels_aux env TypeSet.empty []) ty
+ let snap = Btype.snapshot () in
+ let result =
+ wrap_trace_gadt_instances env (list_labels_aux env TypeSet.empty []) ty
+ in
+ Btype.backtrack snap;
+ result
(* Check that all univars are safe in a type. Both exp.exp_type and
ty_expected should already be generalized. *)
let check_univars env kind exp ty_expected vars =
let pty = instance ty_expected in
let exp_ty, vars =
- with_local_level_iter ~post:generalize begin fun () ->
+ with_local_level_generalize begin fun () ->
match get_desc pty with
Tpoly (body, tl) ->
(* Enforce scoping for type_let:
@@ -2896,7 +3014,7 @@ let check_univars env kind exp ty_expected vars =
let _, ty' = instance_poly ~fixed:true tl body in
let vars, exp_ty = instance_parameterized_type vars exp.exp_type in
unify_exp_types exp.exp_loc env exp_ty ty';
- ((exp_ty, vars), exp_ty::vars)
+ (exp_ty, vars)
| _ -> assert false
end
in
@@ -2910,12 +3028,6 @@ let check_univars env kind exp ty_expected vars =
~trace:[Ctype.expanded_diff env
~got:ty ~expected:ty_expected])))
-let generalize_and_check_univars env kind exp ty_expected vars =
- generalize exp.exp_type;
- generalize ty_expected;
- List.iter generalize vars;
- check_univars env kind exp ty_expected vars
-
(* [check_statement] implements the [non-unit-statement] check.
This check is called in contexts where the value of the expression is known
@@ -2990,10 +3102,13 @@ let check_partial_application ~statement exp =
| Texp_extension_constructor _ | Texp_ifthenelse (_, _, None)
| Texp_function _ ->
check_statement ()
- | Texp_match (_, cases, _) ->
- List.iter (fun {c_rhs; _} -> check c_rhs) cases
- | Texp_try (e, cases) ->
- check e; List.iter (fun {c_rhs; _} -> check c_rhs) cases
+ | Texp_match (_, cases, eff_cases, _) ->
+ List.iter (fun {c_rhs; _} -> check c_rhs) cases;
+ List.iter (fun {c_rhs; _} -> check c_rhs) eff_cases
+ | Texp_try (e, cases, eff_cases) ->
+ check e;
+ List.iter (fun {c_rhs; _} -> check c_rhs) cases;
+ List.iter (fun {c_rhs; _} -> check c_rhs) eff_cases
| Texp_ifthenelse (_, e1, Some e2) ->
check e1; check e2
| Texp_let (_, _, e) | Texp_sequence (_, e) | Texp_open (_, e)
@@ -3034,13 +3149,13 @@ let pattern_needs_partial_application_check p =
(* Check that a type is generalizable at some level *)
let generalizable level ty =
- let rec check ty =
- if not_marked_node ty then
- if get_level ty <= level then raise Exit else
- (flip_mark_node ty; iter_type_expr check ty)
- in
- try check ty; unmark_type ty; true
- with Exit -> unmark_type ty; false
+ with_type_mark begin fun mark ->
+ let rec check ty =
+ if try_mark_node mark ty then
+ if get_level ty <= level then raise Exit else iter_type_expr check ty
+ in
+ try check ty; true with Exit -> false
+ end
(* Hack to allow coercion of self. Will clean-up later. *)
let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
@@ -3048,8 +3163,9 @@ let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
(* Helpers for type_cases *)
let contains_variant_either ty =
+ with_type_mark begin fun mark ->
let rec loop ty =
- if try_mark_node ty then
+ if try_mark_node mark ty then
begin match get_desc ty with
Tvariant row ->
if not (is_fixed row) then
@@ -3062,8 +3178,8 @@ let contains_variant_either ty =
iter_type_expr loop ty
end
in
- try loop ty; unmark_type ty; false
- with Exit -> unmark_type ty; true
+ try loop ty; false with Exit -> true
+ end
let shallow_iter_ppat f p =
match p.ppat_desc with
@@ -3072,7 +3188,8 @@ let shallow_iter_ppat f p =
| Ppat_extension _
| Ppat_type _ | Ppat_unpack _ -> ()
| Ppat_array pats -> List.iter f pats
- | Ppat_or (p1,p2) -> f p1; f p2
+ | Ppat_or (p1,p2)
+ | Ppat_effect(p1, p2) -> f p1; f p2
| Ppat_variant (_, arg) -> Option.iter f arg
| Ppat_tuple lst -> List.iter f lst
| Ppat_construct (_, Some (_, p))
@@ -3141,14 +3258,14 @@ let check_absent_variant env =
|| not (is_fixed row) && not (static_row row) (* same as Ctype.poly *)
then () else
let ty_arg =
- match arg with None -> [] | Some p -> [correct_levels p.pat_type] in
+ match arg with None -> [] | Some p -> [duplicate_type p.pat_type] in
let fields = [s, rf_either ty_arg ~no_arg:(arg=None) ~matched:true] in
let row' =
create_row ~fields
~more:(newvar ()) ~closed:false ~fixed:None ~name:None in
(* Should fail *)
unify_pat env {pat with pat_type = newty (Tvariant row')}
- (correct_levels pat.pat_type)
+ (duplicate_type pat.pat_type)
| _ -> () }
(* Getting proper location of already typed expressions.
@@ -3187,14 +3304,14 @@ let name_cases default lst =
(* Typing of expressions *)
-(** [sdesc_for_hint] is used by error messages to report literals in their
+(** [sexp_for_hint] is used by error messages to report literals in their
original formatting *)
-let unify_exp ?sdesc_for_hint env exp expected_ty =
+let unify_exp ~sexp env exp expected_ty =
let loc = proper_exp_loc exp in
try
unify_exp_types loc env exp.exp_type expected_ty
with Error(loc, env, Expr_type_clash(err, tfc, None)) ->
- raise (error(loc, env, Expr_type_clash(err, tfc, sdesc_for_hint)))
+ raise (Error(loc, env, Expr_type_clash(err, tfc, Some sexp)))
(* If [is_inferred e] is true, [e] will be typechecked without using
the "expected type" provided by the context. *)
@@ -3246,10 +3363,8 @@ let with_explanation explanation f =
raise (error (loc', env', err))
(* Generalize expressions *)
-let generalize_structure_exp exp = generalize_structure exp.exp_type
-let may_lower_contravariant_then_generalize env exp =
- if maybe_expansive exp then lower_contravariant env exp.exp_type;
- generalize exp.exp_type
+let may_lower_contravariant env exp =
+ if maybe_expansive exp then lower_contravariant env exp.exp_type
(* value binding elaboration *)
@@ -3359,16 +3474,15 @@ and type_expect_
env sexp ty_expected_explained =
let { ty = ty_expected; explanation } = ty_expected_explained in
let loc = sexp.pexp_loc in
- let desc = sexp.pexp_desc in
(* Record the expression type before unifying it with the expected type *)
let with_explanation = with_explanation explanation in
(* Unify the result with [ty_expected], enforcing the current level *)
let rue exp =
with_explanation (fun () ->
- unify_exp ~sdesc_for_hint:desc env (re exp) (instance ty_expected));
+ unify_exp ~sexp env (re exp) (instance ty_expected));
exp
in
- match desc with
+ match sexp.pexp_desc with
| Pexp_ident lid ->
let path, desc = type_ident env ~recarg lid in
let exp_desc =
@@ -3395,7 +3509,7 @@ and type_expect_
exp_type = instance desc.val_type;
exp_attributes = sexp.pexp_attributes;
exp_env = env }
- | Pexp_constant(Pconst_string (str, _, _) as cst) -> (
+ | Pexp_constant({pconst_desc = Pconst_string (str, _, _); _} as cst) -> (
let cst = constant_or_raise env loc cst in
(* Terrible hack for format strings *)
let ty_exp = expand_head env (protect_expansion env ty_expected) in
@@ -3407,7 +3521,7 @@ and type_expect_
| Tconstr(path, _, _) when Path.same path fmt6_path ->
if !Clflags.principal && get_level ty_exp <> generic_level then
Location.prerr_warning loc
- (Warnings.Not_principal "this coercion to format6");
+ (not_principal "this coercion to format6");
true
| _ -> false
in
@@ -3455,7 +3569,7 @@ and type_expect_
introduced by those unpacks. The below code checks for scope escape
via both of these pathways (body, bound expressions).
*)
- with_local_level_if may_contain_modules begin fun () ->
+ with_local_level_generalize_if may_contain_modules begin fun () ->
let allow_modules =
if may_contain_modules
then
@@ -3486,7 +3600,6 @@ and type_expect_
types added to [new_env].
*)
let bound_exp = vb.vb_expr in
- generalize_structure_exp bound_exp;
let bound_exp_type = Ctype.instance bound_exp.exp_type in
let loc = proper_exp_loc bound_exp in
let outer_var = newvar2 outer_level in
@@ -3500,9 +3613,9 @@ and type_expect_
end;
(pat_exp_list, body, new_env)
end
- ~post:(fun (_pat_exp_list, body, new_env) ->
+ ~before_generalize:(fun (_pat_exp_list, body, new_env) ->
(* The "body" component of the scope escape check. *)
- unify_exp new_env body (newvar ()))
+ unify_exp ~sexp new_env body (newvar ()))
in
re {
exp_desc = Texp_let(rec_flag, pat_exp_list, body);
@@ -3566,28 +3679,27 @@ and type_expect_
}
| Pexp_apply(sfunct, sargs) ->
assert (sargs <> []);
+ let outer_level = get_current_level () in
let rec lower_args seen ty_fun =
let ty = expand_head env ty_fun in
if TypeSet.mem ty seen then () else
match get_desc ty with
Tarrow (_l, ty_arg, ty_fun, _com) ->
- (try enforce_current_level env ty_arg
+ (try Ctype.unify_var env (newvar2 outer_level) ty_arg
with Unify _ -> assert false);
lower_args (TypeSet.add ty seen) ty_fun
| _ -> ()
in
+ (* one more level for warning on non-returning functions *)
+ with_local_level_generalize begin fun () ->
let type_sfunct sfunct =
- (* one more level for warning on non-returning functions *)
- with_local_level_iter
- begin fun () ->
- let funct =
- with_local_level_if_principal (fun () -> type_exp env sfunct)
- ~post: generalize_structure_exp
- in
- let ty = instance funct.exp_type in
- (funct, [ty])
- end
- ~post:(wrap_trace_gadt_instances env (lower_args TypeSet.empty))
+ let funct =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> type_exp env sfunct)
+ in
+ let ty = instance funct.exp_type in
+ wrap_trace_gadt_instances env (lower_args TypeSet.empty) ty;
+ funct
in
let funct, sargs =
let funct = type_sfunct sfunct in
@@ -3613,33 +3725,72 @@ and type_expect_
exp_type = ty_res;
exp_attributes = sexp.pexp_attributes;
exp_env = env }
+ end
| Pexp_match(sarg, caselist) ->
let arg =
- with_local_level (fun () -> type_exp env sarg)
- ~post:(may_lower_contravariant_then_generalize env)
+ with_local_level_generalize (fun () -> type_exp env sarg)
+ ~before_generalize:(may_lower_contravariant env)
+ in
+ let rec split_cases valc effc conts = function
+ | [] -> List.rev valc, List.rev effc, List.rev conts
+ | {pc_lhs = {ppat_desc=Ppat_effect(p1, p2)}} as c :: rest ->
+ split_cases valc
+ (({c with pc_lhs = p1}) :: effc) (p2 :: conts) rest
+ | c :: rest ->
+ split_cases (c :: valc) effc conts rest
+ in
+ let val_caselist, eff_caselist, eff_conts =
+ split_cases [] [] [] caselist
+ in
+ if val_caselist = [] && eff_caselist <> [] then
+ raise (Error (loc, env, No_value_clauses));
+ let val_cases, partial =
+ type_cases Computation env arg.exp_type ty_expected_explained
+ ~check_if_total:true loc val_caselist
+ in
+ let eff_cases =
+ match eff_caselist with
+ | [] -> []
+ | eff_caselist ->
+ type_effect_cases Value env ty_expected_explained loc eff_caselist
+ eff_conts
in
- let cases, partial =
- type_cases Computation env
- arg.exp_type ty_expected_explained
- ~check_if_total:true loc caselist in
if
List.for_all (fun c -> pattern_needs_partial_application_check c.c_lhs)
- cases
+ val_cases
then check_partial_application ~statement:false arg;
re {
- exp_desc = Texp_match(arg, cases, partial);
+ exp_desc = Texp_match(arg, val_cases, eff_cases, partial);
exp_loc = loc; exp_extra = [];
exp_type = instance ty_expected;
exp_attributes = sexp.pexp_attributes;
exp_env = env }
| Pexp_try(sbody, caselist) ->
let body = type_expect env sbody ty_expected_explained in
- let cases, _ =
- type_cases Value env
- Predef.type_exn ty_expected_explained
- ~check_if_total:false loc caselist in
+ let rec split_cases exnc effc conts = function
+ | [] -> List.rev exnc, List.rev effc, List.rev conts
+ | {pc_lhs = {ppat_desc=Ppat_effect(p1, p2)}} as c :: rest ->
+ split_cases exnc
+ (({c with pc_lhs = p1}) :: effc) (p2 :: conts) rest
+ | c :: rest ->
+ split_cases (c :: exnc) effc conts rest
+ in
+ let exn_caselist, eff_caselist, eff_conts =
+ split_cases [] [] [] caselist
+ in
+ let exn_cases, _ =
+ type_cases Value env Predef.type_exn ty_expected_explained
+ ~check_if_total:false loc exn_caselist
+ in
+ let eff_cases =
+ match eff_caselist with
+ | [] -> []
+ | eff_caselist ->
+ type_effect_cases Value env ty_expected_explained loc eff_caselist
+ eff_conts
+ in
re {
- exp_desc = Texp_try(body, cases);
+ exp_desc = Texp_try(body, exn_cases, eff_cases);
exp_loc = loc; exp_extra = [];
exp_type = body.exp_type;
exp_attributes = sexp.pexp_attributes;
@@ -3662,7 +3813,7 @@ and type_expect_
exp_attributes = sexp.pexp_attributes;
exp_env = env }
| Pexp_construct(lid, sarg) ->
- type_construct env loc lid sarg ty_expected_explained sexp.pexp_attributes
+ type_construct env ~sexp lid sarg ty_expected_explained
| Pexp_variant(l, sarg) ->
(* Keep sharing *)
let ty_expected1 = protect_expansion env ty_expected in
@@ -3713,9 +3864,8 @@ and type_expect_
None -> None
| Some sexp ->
let exp =
- with_local_level_if_principal
+ with_local_level_generalize_structure_if_principal
(fun () -> type_exp ~recarg env sexp)
- ~post: generalize_structure_exp
in
Some exp
in
@@ -3748,7 +3898,7 @@ and type_expect_
| (None | Some (_, _, false)), Some (_, p', _) ->
let decl = Env.find_type p' env in
let ty =
- with_local_level ~post:generalize_structure
+ with_local_level_generalize_structure
(fun () -> newconstr p' (instance_list decl.type_params))
in
ty, opt_exp_opath
@@ -3867,7 +4017,7 @@ and type_expect_
type_label_access env srecord Env.Projection lid
in
let (_, ty_arg, ty_res) = instance_label ~fixed:false label in
- unify_exp env record ty_res;
+ unify_exp ~sexp env record ty_res;
rue {
exp_desc = Texp_field(record, lid, label);
exp_loc = loc; exp_extra = [];
@@ -3881,7 +4031,7 @@ and type_expect_
if expected_type = None then newvar () else record.exp_type in
let (label_loc, label, newval) =
type_label_exp false env loc ty_record (lid, label, snewval) in
- unify_exp env record ty_record;
+ unify_exp ~sexp env record ty_record;
if label.lbl_mut = Immutable then
raise(error(loc, env, Label_not_mutable lid.txt));
rue {
@@ -3920,7 +4070,7 @@ and type_expect_
let ifso = type_expect env sifso ty_expected_explained in
let ifnot = type_expect env sifnot ty_expected_explained in
(* Keep sharing *)
- unify_exp env ifnot ifso.exp_type;
+ unify_exp ~sexp env ifnot ifso.exp_type;
re {
exp_desc = Texp_ifthenelse(cond, ifso, Some ifnot);
exp_loc = loc; exp_extra = [];
@@ -3967,7 +4117,7 @@ and type_expect_
val_attributes = [];
val_kind = Val_reg;
val_loc = loc;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
} env
~check:(fun s -> Warnings.Unused_for_index s)
| _ ->
@@ -4008,27 +4158,26 @@ and type_expect_
let obj = type_exp env e in
begin try
let (obj,meth,typ) =
- with_local_level_if_principal
+ with_local_level_generalize_structure_if_principal
(fun () -> type_send env loc explanation e met)
- ~post:(fun (_,_,typ) -> generalize_structure typ)
- in
- let typ =
- match get_desc typ with
- | Tpoly (ty, []) ->
- instance ty
- | Tpoly (ty, tl) ->
- if !Clflags.principal && get_level typ <> generic_level then
- Location.prerr_warning loc
- (Warnings.Not_principal "this use of a polymorphic method");
- snd (instance_poly ~fixed:false tl ty)
- | Tvar _ ->
- let ty' = newvar () in
- unify env (instance typ) (newty(Tpoly(ty',[])));
- (* if not !Clflags.nolabels then
- Location.prerr_warning loc (Warnings.Unknown_method met); *)
- ty'
- | _ ->
- assert false
+ in
+ let typ =
+ match get_desc typ with
+ | Tpoly (ty, []) ->
+ instance ty
+ | Tpoly (ty, tl) ->
+ if !Clflags.principal && get_level typ <> generic_level then
+ Location.prerr_warning loc
+ (not_principal "this use of a polymorphic method");
+ snd (instance_poly ~fixed:false tl ty)
+ | Tvar _ ->
+ let ty' = newvar () in
+ unify env (instance typ) (newty(Tpoly(ty',[])));
+ (* if not !Clflags.nolabels then
+ Location.prerr_warning loc (Warnings.Unknown_method met); *)
+ ty'
+ | _ ->
+ assert false
in
rue {
exp_desc = Texp_send(obj, meth);
@@ -4150,7 +4299,7 @@ and type_expect_
| _ -> Mp_present
in
let scope = create_scope () in
- let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
let md_shape = Shape.set_uid_if_none md_shape md_uid in
let md =
{ md_type = modl.mod_type; md_attributes = [];
@@ -4247,8 +4396,7 @@ and type_expect_
}
| Pexp_poly(sbody, sty) ->
let ty, cty =
- with_local_level_if_principal
- ~post:(fun (ty,_) -> generalize_structure ty)
+ with_local_level_generalize_structure_if_principal
begin fun () ->
match sty with None -> protect_expansion env ty_expected, None
| Some sty ->
@@ -4267,32 +4415,29 @@ and type_expect_
{ exp with exp_type = instance ty }
| Tpoly (ty', tl) ->
(* One more level to generalize locally *)
- let (exp,_) =
+ let (exp, vars) =
with_local_level begin fun () ->
let vars, ty'' =
- with_local_level_if_principal
+ with_local_level_generalize_structure_if_principal
(fun () -> instance_poly ~fixed:true tl ty')
- ~post:(fun (_,ty'') -> generalize_structure ty'')
in
let exp = type_expect env sbody (mk_expected ty'') in
(exp, vars)
end
- ~post: begin fun (exp,vars) ->
- generalize_and_check_univars env "method" exp ty_expected vars
- end
in
+ check_univars env "method" exp ty_expected vars;
{ exp with exp_type = instance ty }
| Tvar _ ->
let exp = type_exp env sbody in
let exp = {exp with exp_type = newty (Tpoly (exp.exp_type, []))} in
- unify_exp env exp ty;
+ unify_exp ~sexp env exp ty;
exp
| _ -> assert false
in
re { exp with exp_extra =
(Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra }
- | Pexp_newtype({txt=name} as label_loc, sbody) ->
- let body, ety, id, uid = type_newtype loc env name (fun env ->
+ | Pexp_newtype(name, sbody) ->
+ let body, ety, id, uid = type_newtype env name (fun env ->
let expr = type_exp env sbody in
expr, expr.exp_type)
in
@@ -4300,7 +4445,8 @@ and type_expect_
any new extra node in the typed AST. *)
rue { body with exp_loc = loc; exp_type = ety;
exp_extra =
- (Texp_newtype' (id, label_loc, uid), loc, sexp.pexp_attributes) :: body.exp_extra }
+ (Texp_newtype' (id, name, uid), loc, sexp.pexp_attributes) :: body.exp_extra
+ }
| Pexp_pack m ->
let (p, fl) =
match get_desc (Ctype.expand_head env (instance ty_expected)) with
@@ -4311,7 +4457,7 @@ and type_expect_
< Btype.generic_level
then
Location.prerr_warning loc
- (Warnings.Not_principal "this module packing");
+ (not_principal "this module packing");
(p, fl)
| Tvar _ ->
raise (error (loc, env, Cannot_infer_signature))
@@ -4362,8 +4508,7 @@ and type_expect_
in
let op_path, op_desc, op_type, spat_params, ty_params,
ty_func_result, ty_result, ty_andops =
- with_local_level_iter_if_principal
- ~post:generalize_structure begin fun () ->
+ with_local_level_generalize_structure_if_principal begin fun () ->
let let_loc = slet.pbop_op.loc in
let op_path, op_desc = type_binding_op_ident env slet.pbop_op in
let op_type = instance op_desc.val_type in
@@ -4382,9 +4527,8 @@ and type_expect_
with Unify err ->
raise(error(let_loc, env, Letop_type_clash(slet.pbop_op.txt, err)))
end;
- ((op_path, op_desc, op_type, spat_params, ty_params,
- ty_func_result, ty_result, ty_andops),
- [ty_andops; ty_params; ty_func_result; ty_result])
+ (op_path, op_desc, op_type, spat_params, ty_params,
+ ty_func_result, ty_result, ty_andops)
end
in
let exp, ands = type_andops env slet.pbop_exp sands ty_andops in
@@ -4495,11 +4639,12 @@ and type_coerce
in
let arg, arg_type, gen =
let lv = get_current_level () in
- with_local_level begin fun () ->
+ with_local_level_generalize begin fun () ->
let arg, arg_type = type_without_constraint env in
arg, arg_type, generalizable lv arg_type
end
- ~post:(fun (_, arg_type, _) -> enforce_current_level env arg_type)
+ ~before_generalize:
+ (fun (_, arg_type, _) -> enforce_current_level env arg_type)
in
begin match !self_coercion, get_desc ty' with
| ((path, r) :: _, Tconstr (path', _, _))
@@ -4507,8 +4652,8 @@ and type_coerce
(* prerr_endline "self coercion"; *)
r := loc :: !r;
force ()
- | _ when free_variables ~env arg_type = []
- && free_variables ~env ty' = [] ->
+ | _ when closed_type_expr ~env arg_type
+ && closed_type_expr ~env ty' ->
if not gen && (* first try a single coercion *)
let snap = snapshot () in
let ty, _b = enlarge_type env ty' in
@@ -4522,7 +4667,7 @@ and type_coerce
force (); force' ();
if not gen && !Clflags.principal then
Location.prerr_warning loc
- (Warnings.Not_principal "this ground coercion");
+ (not_principal "this ground coercion");
with Subtype err ->
(* prerr_endline "coercion failed"; *)
raise (Error (loc, env, Not_subtype err))
@@ -4539,14 +4684,13 @@ and type_coerce
(arg, ty', Texp_coerce (None, cty'))
| Some sty ->
let cty, ty, force, cty', ty', force' =
- with_local_level_iter ~post:generalize_structure begin fun () ->
+ with_local_level_generalize_structure begin fun () ->
let (cty, ty, force) =
Typetexp.transl_simple_type_delayed env sty
and (cty', ty', force') =
Typetexp.transl_simple_type_delayed env sty'
in
- ((cty, ty, force, cty', ty', force'),
- [ ty; ty' ])
+ (cty, ty, force, cty', ty', force')
end
in
begin try
@@ -4561,10 +4705,9 @@ and type_coerce
and type_constraint env sty =
(* Pretend separate = true, 1% slowdown for lablgtk *)
let cty =
- with_local_level begin fun () ->
+ with_local_level_generalize_structure begin fun () ->
Typetexp.transl_simple_type env ~closed:false sty
end
- ~post:(fun cty -> generalize_structure cty.ctyp_type)
in
cty.ctyp_type, Texp_constraint cty
@@ -4599,18 +4742,18 @@ and type_constraint_expect
nodes for the newtype properly linked.
*)
and type_newtype
- : type a. _ -> _ -> _ -> (Env.t -> a * type_expr) -> a * type_expr * Ident.t * Uid.t =
- fun loc env name type_body ->
+ : type a. _ -> _ -> (Env.t -> a * type_expr) -> a * type_expr * Ident.t * Uid.t =
+ fun env { txt = name; loc = name_loc } type_body ->
let ty =
if Typetexp.valid_tyvar_name name then
newvar ~name ()
else
newvar ()
in
- (* Use [with_local_level] just for scoping *)
- with_local_level begin fun () ->
+ (* Use [with_local_level_generalize] just for scoping *)
+ with_local_level_generalize begin fun () ->
(* Create a fake abstract type declaration for [name]. *)
- let decl = new_local_type ~loc Definition in
+ let decl = new_local_type ~loc:name_loc Definition in
let scope = create_scope () in
let (id, new_env) = Env.enter_type ~scope name decl env in
@@ -4629,9 +4772,9 @@ and type_newtype
in
let ety = Subst.type_expr Subst.identity exp_type in
replace ety;
- let uid = decl.type_uid in
- (result, ety, id, uid)
+ (result, ety, id, decl.type_uid)
end
+ ~before_generalize:(fun (_,ety,_id,_uid) -> enforce_current_level env ety)
and type_ident env ?(recarg=Rejected) lid =
let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in
@@ -4680,7 +4823,7 @@ and type_binding_op_ident env s =
and split_function_ty env ty_expected ~arg_label ~first ~in_function =
let { ty = ty_fun; explanation }, loc = in_function in
let separate = !Clflags.principal || Env.has_local_constraints env in
- with_local_level_iter_if separate ~post:generalize_structure begin fun () ->
+ with_local_level_generalize_structure_if separate begin fun () ->
let ty_arg, ty_res =
try filter_arrow env (instance ty_expected) arg_label
with Filter_arrow_failed err ->
@@ -4709,7 +4852,7 @@ and split_function_ty env ty_expected ~arg_label ~first ~in_function =
type_option tv
else ty_arg
in
- (ty_arg, ty_res), [ ty_arg; ty_res ]
+ (ty_arg, ty_res)
end
(* Typecheck parameters one at a time followed by the body. Later parameters
@@ -4752,7 +4895,7 @@ and type_function
| { pparam_desc = Pparam_newtype newtype; pparam_loc = _ } :: rest ->
(* Check everything else in the scope of (type a). *)
let (params, body, newtypes, contains_gadt), exp_type, nt_id, nt_uid =
- type_newtype loc env newtype.txt (fun env ->
+ type_newtype env newtype (fun env ->
let exp_type, params, body, newtypes, contains_gadt =
(* mimic the typing of Pexp_newtype by minting a new type var,
like [type_exp].
@@ -4808,7 +4951,7 @@ and type_function
(* We don't make use of [case_data] here so we pass unit. *)
[ { pattern = pat; has_guard = false; needs_refute = false }, () ]
~type_body:begin
- fun () pat ~ext_env ~ty_expected ~ty_infer:_
+ fun () pat ~when_env:_ ~ext_env ~cont:_ ~ty_expected ~ty_infer:_
~contains_gadt:param_contains_gadt ->
let _, params, body, newtypes, suffix_contains_gadt =
type_function ext_env rest body_constraint body
@@ -4905,7 +5048,7 @@ and type_function
[type_argument] on the cases, and discard the cases'
inferred type in favor of the constrained type. (Function
cases aren't inferred, so [type_argument] would just call
- [type_expect] straightaway, so we do the same here.)
+ [type_expect] straight away, so we do the same here.)
- [type_without_constraint]: If there is just a coercion and
no constraint, call [type_exp] on the cases and surface the
cases' inferred type to [type_constraint_expect]. *)
@@ -4944,7 +5087,7 @@ and type_function
and type_label_access env srecord usage lid =
let record =
- with_local_level_if_principal ~post:generalize_structure_exp
+ with_local_level_generalize_structure_if_principal
(fun () -> type_exp ~recarg:Allowed env srecord)
in
let ty_exp = record.exp_type in
@@ -5004,7 +5147,9 @@ and type_format loc str env =
| [ e ] -> Some e
| _ :: _ :: _ -> Some (mk_exp_loc (Pexp_tuple args)) in
mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg)) in
- let mk_cst cst = mk_exp_loc (Pexp_constant cst) in
+ let mk_cst cst =
+ mk_exp_loc (Pexp_constant {pconst_desc = cst; pconst_loc = loc})
+ in
let mk_int n = mk_cst (Pconst_integer (Int.to_string n, None))
and mk_string str = mk_cst (Pconst_string (str, loc, None))
and mk_char chr = mk_cst (Pconst_char chr) in
@@ -5230,22 +5375,15 @@ and type_label_exp create env loc ty_expected
(lid, label, sarg) =
(* Here also ty_expected may be at generic_level *)
let separate = !Clflags.principal || Env.has_local_constraints env in
- (* #4682: we try two type-checking approaches for [arg] using backtracking:
- - first try: we try with [ty_arg] as expected type;
- - second try; if that fails, we backtrack and try without
- *)
- let (vars, ty_arg, snap, arg) =
- (* try the first approach *)
- with_local_level begin fun () ->
+ let is_poly = label_is_poly label in (* HUH ? *)
+ let (vars, arg) =
+ (* raise level to check univars *)
+ with_local_level_generalize_if is_poly begin fun () ->
let (vars, ty_arg) =
- with_local_level_iter_if separate begin fun () ->
+ with_local_level_generalize_structure_if separate begin fun () ->
let (vars, ty_arg, ty_res) =
- with_local_level_iter_if separate ~post:generalize_structure
- begin fun () ->
- let ((_, ty_arg, ty_res) as r) =
- instance_label ~fixed:true label in
- (r, [ty_arg; ty_res])
- end
+ with_local_level_generalize_structure_if separate
+ (fun () -> instance_label ~fixed:true label)
in
begin try
unify env (instance ty_res) (instance ty_expected)
@@ -5254,9 +5392,8 @@ and type_label_exp create env loc ty_expected
end;
(* Instantiate so that we can generalize internal nodes *)
let ty_arg = instance ty_arg in
- ((vars, ty_arg), [ty_arg])
+ (vars, ty_arg)
end
- ~post:generalize_structure
in
if label.lbl_private = Private then
@@ -5264,45 +5401,12 @@ and type_label_exp create env loc ty_expected
raise (error(loc, env, Private_type ty_expected))
else
raise (error(lid.loc, env, Private_label(lid.txt, ty_expected)));
- let snap = if vars = [] then None else Some (Btype.snapshot ()) in
- let arg = type_argument env sarg ty_arg (instance ty_arg) in
- (vars, ty_arg, snap, arg)
+ (vars, type_argument env sarg ty_arg (instance ty_arg))
end
- (* Note: there is no generalization logic here as could be expected,
- because it is part of the backtracking logic below. *)
- in
- let arg =
- try
- if (vars = []) then arg
- else begin
- (* We detect if the first try failed here,
- during generalization. *)
- if maybe_expansive arg then
- lower_contravariant env arg.exp_type;
- generalize_and_check_univars env "field value" arg label.lbl_arg vars;
- {arg with exp_type = instance arg.exp_type}
- end
- with first_try_exn when maybe_expansive arg -> try
- (* backtrack and try the second approach *)
- Option.iter Btype.backtrack snap;
- let arg = with_local_level (fun () -> type_exp env sarg)
- ~post:(fun arg -> lower_contravariant env arg.exp_type)
- in
- let arg =
- with_local_level begin fun () ->
- let arg = {arg with exp_type = instance arg.exp_type} in
- unify_exp env arg (instance ty_arg);
- arg
- end
- ~post: begin fun arg ->
- generalize_and_check_univars env "field value" arg label.lbl_arg vars
- end
- in
- {arg with exp_type = instance arg.exp_type}
- with Error (_, _, Less_general _) as e -> raise e
- | _ -> raise first_try_exn
+ ~before_generalize:(fun (_,arg) -> may_lower_contravariant env arg)
in
- (lid, label, arg)
+ if is_poly then check_univars env "field value" arg label.lbl_arg vars;
+ (lid, label, {arg with exp_type = instance arg.exp_type})
and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
(* ty_expected' may be generic *)
@@ -5330,7 +5434,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
(* apply optional arguments when expected type is "" *)
(* we must be very careful about not breaking the semantics *)
let texp =
- with_local_level_if_principal ~post:generalize_structure_exp
+ with_local_level_generalize_structure_if_principal
(fun () -> type_exp env sarg)
in
let rec make_args args ty_fun =
@@ -5346,7 +5450,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
let args, ty_fun', simple_res = make_args [] texp.exp_type
and texp = {texp with exp_type = instance texp.exp_type} in
if not (simple_res || safe_expect) then begin
- unify_exp env texp ty_expected;
+ unify_exp ~sexp:sarg env texp ty_expected;
texp
end else begin
let warn = !Clflags.principal &&
@@ -5357,7 +5461,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
Tarrow(Nolabel,ty_arg,ty_res,_) -> ty_arg, ty_res
| _ -> assert false
in
- unify_exp env {texp with exp_type = ty_fun} ty_expected;
+ unify_exp ~sexp:sarg env {texp with exp_type = ty_fun} ty_expected;
if args = [] then texp else
(* eta-expand to avoid side effects *)
let var_pair name ty =
@@ -5366,7 +5470,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
{ val_type = ty; val_kind = Val_reg;
val_attributes = [];
val_loc = Location.none;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
let exp_env = Env.add_value id desc env in
@@ -5402,7 +5506,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
in
Location.prerr_warning texp.exp_loc
(Warnings.Eliminated_optional_arguments
- (List.map (fun (l, _) -> Printtyp.string_of_label l) args));
+ (List.map (fun (l, _) -> Asttypes.string_of_label l) args));
if warn then Location.prerr_warning texp.exp_loc
(Warnings.Non_principal_labels "eliminated optional argument");
(* let-expand to have side effects *)
@@ -5417,7 +5521,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
| None ->
let texp = type_expect ?recarg env sarg
(mk_expected ?explanation ty_expected') in
- unify_exp env texp ty_expected;
+ unify_exp ~sexp:sarg env texp ty_expected;
texp
and type_application env funct sargs =
@@ -5489,7 +5593,7 @@ and type_application env funct sargs =
let arg () =
let arg = type_expect env sarg (mk_expected ty_arg) in
if is_optional lbl then
- unify_exp env arg (type_option(newvar()));
+ unify_exp ~sexp:sarg env arg (type_option(newvar()));
arg
in
(ty_res, (lbl, Some (arg, Some sarg.pexp_loc)) :: typed_args)
@@ -5506,7 +5610,7 @@ and type_application env funct sargs =
(Location.prerr_warning
funct.exp_loc
(Warnings.Labels_omitted
- (List.map Printtyp.string_of_label
+ (List.map Asttypes.string_of_label
(List.filter ((<>) Nolabel) labels)));
true)
end
@@ -5553,7 +5657,7 @@ and type_application env funct sargs =
(fun () -> type_argument env sarg ty ty0)
else begin
may_warn sarg.pexp_loc
- (Warnings.Not_principal "using an optional argument here");
+ (not_principal "using an optional argument here");
(fun () -> option_some env (type_argument env sarg
(extract_option_type env ty)
(extract_option_type env ty0)))
@@ -5592,11 +5696,11 @@ and type_application env funct sargs =
| Some (l', sarg, commuted, remaining_sargs) ->
if commuted then begin
may_warn sarg.pexp_loc
- (Warnings.Not_principal "commuting this argument")
+ (not_principal "commuting this argument")
end;
if not optional && is_optional l' then
Location.prerr_warning sarg.pexp_loc
- (Warnings.Nonoptional_label (Printtyp.string_of_label l));
+ (Warnings.Nonoptional_label (Asttypes.string_of_label l));
remaining_sargs, Some (use_arg sarg l', Some sarg.pexp_loc)
| None ->
sargs,
@@ -5620,22 +5724,19 @@ and type_application env funct sargs =
(try ignore (filter_arrow env (instance funct.exp_type) Nolabel); true
with Filter_arrow_failed _ -> false)
in
- (* Extra scope to check for non-returning functions *)
- with_local_level begin fun () ->
- match sargs with
- | (* Special case for ignore: avoid discarding warning *)
- [Nolabel, sarg] when is_ignore funct ->
- let ty_arg, ty_res =
- filter_arrow env (instance funct.exp_type) Nolabel in
- let exp = type_expect env sarg (mk_expected ty_arg) in
- check_partial_application ~statement:false exp;
- ([Nolabel, Some exp], ty_res)
- | _ ->
- let ty = funct.exp_type in
- type_args [] ty (instance ty) sargs
- end
+ match sargs with
+ | (* Special case for ignore: avoid discarding warning *)
+ [Nolabel, sarg] when is_ignore funct ->
+ let ty_arg, ty_res =
+ filter_arrow env (instance funct.exp_type) Nolabel in
+ let exp = type_expect env sarg (mk_expected ty_arg) in
+ check_partial_application ~statement:false exp;
+ ([Nolabel, Some exp], ty_res)
+ | _ ->
+ let ty = funct.exp_type in
+ type_args [] ty (instance ty) sargs
-and type_construct env loc lid sarg ty_expected_explained attrs =
+and type_construct env ~sexp lid sarg ty_expected_explained =
let { ty = ty_expected; explanation } = ty_expected_explained in
let expected_type =
match extract_concrete_variant env ty_expected with
@@ -5646,7 +5747,7 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
let srt = wrong_kind_sort_of_constructor lid.txt in
let ctx = Expression explanation in
let err = Wrong_expected_kind(srt, ctx, ty_expected) in
- raise (error (loc, env, err))
+ raise (error (sexp.pexp_loc, env, err))
in
let constrs =
Env.lookup_all_constructors ~loc:lid.loc Env.Positive lid.txt env
@@ -5660,37 +5761,36 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
match sarg with
None -> []
| Some {pexp_desc = Pexp_tuple sel} when
- constr.cstr_arity > 1 || Builtin_attributes.explicit_arity attrs
+ constr.cstr_arity > 1
+ || Builtin_attributes.explicit_arity sexp.pexp_attributes
-> sel
| Some se -> [se] in
if List.length sargs <> constr.cstr_arity then
- raise(error(loc, env, Constructor_arity_mismatch
- (lid.txt, constr.cstr_arity, List.length sargs)));
+ raise(Error(sexp.pexp_loc, env,
+ Constructor_arity_mismatch
+ (lid.txt, constr.cstr_arity, List.length sargs)));
let separate = !Clflags.principal || Env.has_local_constraints env in
let ty_args, ty_res, texp =
- with_local_level_iter_if separate ~post:generalize_structure begin fun () ->
+ with_local_level_generalize_structure_if separate begin fun () ->
let ty_args, ty_res, texp =
- with_local_level_if separate begin fun () ->
+ with_local_level_generalize_structure_if separate begin fun () ->
let (ty_args, ty_res, _) =
instance_constructor Keep_existentials_flexible constr
in
let texp =
re {
exp_desc = Texp_construct(lid, constr, []);
- exp_loc = loc; exp_extra = [];
+ exp_loc = sexp.pexp_loc; exp_extra = [];
exp_type = ty_res;
- exp_attributes = attrs;
+ exp_attributes = sexp.pexp_attributes;
exp_env = env } in
(ty_args, ty_res, texp)
end
- ~post: begin fun (_, ty_res, texp) ->
- generalize_structure ty_res;
- with_explanation explanation (fun () ->
- unify_exp env {texp with exp_type = instance ty_res}
- (instance ty_expected));
- end
in
- ((ty_args, ty_res, texp), ty_res::ty_args)
+ with_explanation explanation (fun () ->
+ unify_exp ~sexp env {texp with exp_type = instance ty_res}
+ (instance ty_expected));
+ (ty_args, ty_res, texp)
end
in
let ty_args0, ty_res =
@@ -5699,20 +5799,20 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
| _ -> assert false
in
let texp = {texp with exp_type = ty_res} in
- if not separate then unify_exp env texp (instance ty_expected);
+ if not separate then unify_exp ~sexp env texp (instance ty_expected);
let recarg =
match constr.cstr_inlined with
| None -> Rejected
| Some _ ->
begin match sargs with
- | [{pexp_desc = Pexp_extension ({ txt; _ }, _); _ }]
- when txt = Ast_helper.hole_txt -> Required
+ | [{pexp_desc = Pexp_extension ({ txt; _ }, _)}]
+ when txt = Ast_helper.hole_txt -> Required
| [{pexp_desc =
Pexp_ident _ |
Pexp_record (_, (Some {pexp_desc = Pexp_ident _}| None))}] ->
Required
| _ ->
- raise (error(loc, env, Inlined_record_expected))
+ raise (Error(sexp.pexp_loc, env, Inlined_record_expected))
end
in
let args =
@@ -5721,9 +5821,9 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
if constr.cstr_private = Private then
begin match constr.cstr_tag with
| Cstr_extension _ ->
- raise_error (error(loc, env, Private_constructor (constr, ty_res)))
+ raise(Error(sexp.pexp_loc, env, Private_constructor (constr, ty_res)))
| Cstr_constant _ | Cstr_block _ | Cstr_unboxed ->
- raise_error (error(loc, env, Private_type ty_res));
+ raise (Error(sexp.pexp_loc, env, Private_type ty_res));
end;
(* NOTE: shouldn't we call "re" on this final expression? -- AF *)
{ texp with
@@ -5748,24 +5848,25 @@ and type_statement ?explanation env sexp =
| _ -> false
in
(* Raise the current level to detect non-returning functions *)
- let exp = with_local_level (fun () -> type_exp env sexp) in
- let subexp = final_subexpression exp in
- let ty = expand_head env exp.exp_type in
- if is_Tvar ty && not !has_errors
- && get_level ty > get_current_level ()
- && not (allow_polymorphic subexp) then
- Location.prerr_warning
- subexp.exp_loc
- Warnings.Nonreturning_statement;
- if !Clflags.strict_sequence then
- let expected_ty = instance Predef.type_unit in
- with_explanation explanation (fun () ->
- unify_exp env exp expected_ty);
- exp
- else begin
- if not !has_errors then check_partial_application ~statement:true exp;
- enforce_current_level env ty;
- exp
+ with_local_level_generalize (fun () -> type_exp env sexp)
+ ~before_generalize: begin fun exp ->
+ let subexp = final_subexpression exp in
+ let ty = expand_head env exp.exp_type in
+ if is_Tvar ty && not !has_errors
+ && get_level ty > get_current_level ()
+ && not (allow_polymorphic subexp) then
+ Location.prerr_warning
+ subexp.exp_loc
+ Warnings.Nonreturning_statement;
+ if !Clflags.strict_sequence then
+ let expected_ty = instance Predef.type_unit in
+ with_explanation explanation (fun () ->
+ unify_exp ~sexp env exp expected_ty)
+ else begin
+ if not !has_errors then
+ check_partial_application ~statement:true exp;
+ enforce_current_level env ty
+ end
end
(* Most of the arguments are the same as [type_cases].
@@ -5782,20 +5883,22 @@ and type_statement ?explanation env sexp =
*)
and map_half_typed_cases
: type k ret case_data.
- ?additional_checks_for_split_cases:((_ * ret) list -> unit)
+ ?additional_checks_for_split_cases:((_ * ret) list -> unit) -> ?conts:_
-> k pattern_category -> _ -> _ -> _ -> _
-> (untyped_case * case_data) list
-> type_body:(
case_data
-> k general_pattern (* the typed pattern *)
- -> ext_env:_ (* environment with module variables / pattern variables *)
+ -> when_env:_ (* environment with module/pattern variables *)
+ -> ext_env:_ (* when_env + continuation var*)
+ -> cont:_
-> ty_expected:_ (* type to check body in scope of *)
-> ty_infer:_ (* type to infer for body *)
-> contains_gadt:_ (* whether the pattern contains a GADT *)
-> ret)
-> check_if_total:bool (* if false, assume Partial right away *)
-> ret list * partial
- = fun ?additional_checks_for_split_cases
+ = fun ?additional_checks_for_split_cases ?conts
category env ty_arg ty_res loc caselist ~type_body ~check_if_total ->
let has_errors = Msupport.monitor_errors () in
(* ty_arg is _fully_ generalized *)
@@ -5807,7 +5910,7 @@ and map_half_typed_cases
let create_inner_level = may_contain_gadts || may_contain_modules in
let ty_arg =
if (may_contain_gadts || erase_either) && not !Clflags.principal
- then correct_levels ty_arg else ty_arg
+ then duplicate_type ty_arg else ty_arg
in
let rec is_var spat =
match spat.ppat_desc with
@@ -5837,24 +5940,29 @@ and map_half_typed_cases
if erase_either
then Some false else None
in
+ let map_conts f conts caselist = match conts with
+ | None -> List.map (fun c -> f c None) caselist
+ | Some conts -> List.map2 f caselist conts
+ in
let half_typed_cases, ty_res, do_copy_types, ty_arg' =
(* propagation of the argument *)
- with_local_level begin fun () ->
+ with_local_level_generalize begin fun () ->
let pattern_force = ref [] in
(* Format.printf "@[%i %i@ %a@]@." lev (get_current_level())
Printtyp.raw_type_expr ty_arg; *)
let half_typed_cases =
- List.map
- (fun ({ Parmatch.pattern; _ } as untyped_case, case_data) ->
+ map_conts
+ (fun ({ Parmatch.pattern; _ } as untyped_case, case_data) cont ->
let htc =
- with_local_level_if_principal begin fun () ->
+ with_local_level_generalize_structure_if_principal begin fun () ->
let ty_arg =
(* propagation of pattern *)
- with_local_level ~post:generalize_structure
+ with_local_level_generalize_structure
(fun () -> instance ?partial:take_partial_instance ty_arg)
in
let (pat, ext_env, force, pvs, mvs) =
- type_pattern category ~lev env pattern ty_arg allow_modules
+ type_pattern ?cont category ~lev env pattern ty_arg
+ allow_modules
in
pattern_force := force @ !pattern_force;
{ typed_pat = pat;
@@ -5867,9 +5975,6 @@ and map_half_typed_cases
contains_gadt = contains_gadt (as_comp_pattern category pat);
}
end
- ~post: begin fun htc ->
- iter_pattern_variables_type generalize_structure htc.pat_vars;
- end
in
(* Ensure that no ambivalent pattern type escapes its branch *)
check_scope_escape htc.typed_pat.pat_loc env outer_level
@@ -5877,7 +5982,7 @@ and map_half_typed_cases
let pat = htc.typed_pat in
{htc with typed_pat = { pat with pat_type = instance pat.pat_type }}
)
- caselist in
+ conts caselist in
let patl =
List.map (fun { typed_pat; _ } -> typed_pat) half_typed_cases in
let does_contain_gadt =
@@ -5885,7 +5990,7 @@ and map_half_typed_cases
in
let ty_res, do_copy_types =
if does_contain_gadt && not !Clflags.principal then
- correct_levels ty_res, Env.make_copy_of_types env
+ duplicate_type ty_res, Env.make_copy_of_types env
else ty_res, (fun env -> env)
in
(* Unify all cases (delayed to keep it order-free) *)
@@ -5911,20 +6016,15 @@ and map_half_typed_cases
) half_typed_cases;
(half_typed_cases, ty_res, do_copy_types, ty_arg')
end
- ~post: begin fun (half_typed_cases, _, _, ty_arg') ->
- generalize ty_arg';
- List.iter (fun { pat_vars; _ } ->
- iter_pattern_variables_type generalize pat_vars
- ) half_typed_cases
- end
in
(* type bodies *)
let ty_res' = instance ty_res in
+ (* Why is it needed to keep the level of result raised ? *)
let result = with_local_level_if_principal ~post:ignore begin fun () ->
- List.map
+ map_conts
(fun { typed_pat = pat; branch_env = ext_env;
- pat_vars = pvs; module_vars = mvs;
- case_data; contains_gadt; _ }
+ pat_vars = pvs; module_vars = mvs;
+ case_data; contains_gadt; _ } cont
->
let ext_env =
if contains_gadt then
@@ -5936,21 +6036,24 @@ and map_half_typed_cases
branch environments by adding the variables (and module variables)
from the patterns.
*)
- let ext_env =
- add_pattern_variables ext_env pvs
+ let cont_vars, pvs =
+ List.partition (fun pv -> pv.pv_kind = Continuation_var) pvs in
+ let add_pattern_vars = add_pattern_variables
~check:(fun s -> Warnings.Unused_var_strict s)
~check_as:(fun s -> Warnings.Unused_var s)
in
- let ext_env = add_module_variables ext_env mvs in
+ let when_env = add_pattern_vars ext_env pvs in
+ let when_env = add_module_variables when_env mvs in
+ let ext_env = add_pattern_vars when_env cont_vars in
let ty_expected =
if contains_gadt && not !Clflags.principal then
(* Take a generic copy of [ty_res] again to allow propagation of
type information from preceding branches *)
- correct_levels ty_res
+ duplicate_type ty_res
else ty_res in
- type_body case_data pat ~ext_env ~ty_expected ~ty_infer:ty_res'
- ~contains_gadt)
- half_typed_cases
+ type_body case_data pat ~when_env ~ext_env ~cont ~ty_expected
+ ~ty_infer:ty_res' ~contains_gadt)
+ conts half_typed_cases
end in
let do_init = may_contain_gadts || needs_exhaust_check in
let ty_arg_check =
@@ -6023,11 +6126,11 @@ and map_half_typed_cases
(* Typing of match cases *)
and type_cases
- : type k . k pattern_category ->
- _ -> _ -> _ -> check_if_total:bool -> _ -> Parsetree.case list ->
- k case list * partial
+ : type k . k pattern_category -> _ -> _ -> _ -> ?conts:_ ->
+ check_if_total:bool -> _ -> Parsetree.case list ->
+ k case list * partial
= fun category env
- ty_arg ty_res_explained ~check_if_total loc caselist ->
+ ty_arg ty_res_explained ?conts ~check_if_total loc caselist ->
let { ty = ty_res; explanation } = ty_res_explained in
let caselist =
List.map (fun case -> Parmatch.untyped_case case, case) caselist
@@ -6036,16 +6139,24 @@ and type_cases
is to typecheck the guards and the cases, and then to check for some
warnings that can fire in the presence of guards.
*)
- map_half_typed_cases category env ty_arg ty_res loc caselist ~check_if_total
+ map_half_typed_cases ?conts category env ty_arg ty_res loc caselist
+ ~check_if_total
~type_body:begin
- fun { pc_guard; pc_rhs } pat ~ext_env ~ty_expected ~ty_infer
- ~contains_gadt:_ ->
+ fun { pc_guard; pc_rhs } pat ~when_env ~ext_env ~cont ~ty_expected
+ ~ty_infer ~contains_gadt:_ ->
+ let cont = Option.map (fun (id,_) -> id) cont in
let guard =
match pc_guard with
| None -> None
| Some scond ->
+ (* It is crucial that the continuation is not used in the
+ `when' expression as the extent of the continuation is
+ yet to be determined. We make the continuation
+ inaccessible by typing the `when' expression using the
+ environment `ext_env' which does not bind the
+ continuation variable. *)
Some
- (type_expect ext_env scond
+ (type_expect when_env scond
(mk_expected ~explanation:When_guard Predef.type_bool))
in
let exp =
@@ -6053,6 +6164,7 @@ and type_cases
in
{
c_lhs = pat;
+ c_cont = cont;
c_guard = guard;
c_rhs = {exp with exp_type = ty_infer}
}
@@ -6091,6 +6203,33 @@ and type_function_cases_expect
cases, partial, ty_fun
end
+and type_effect_cases
+ : type k . k pattern_category -> _ -> _ -> _ -> Parsetree.case list -> _
+ -> k case list
+ = fun category env ty_res_explained loc caselist conts ->
+ let { ty = ty_res; explanation = _ } = ty_res_explained in
+ let _ = newvar () in
+ (* remember original level *)
+ with_local_level begin fun () ->
+ (* Create a locally type abstract type for effect type. *)
+ let new_env, ty_arg, ty_cont =
+ let decl = Ctype.new_local_type ~loc Definition in
+ let scope = create_scope () in
+ let name = Ctype.get_new_abstract_name env "%eff" in
+ let id = Ident.create_scoped ~scope name in
+ let new_env = Env.add_type ~check:false id decl env in
+ let ty_eff = newgenty (Tconstr (Path.Pident id,[],ref Mnil)) in
+ new_env,
+ Predef.type_eff ty_eff,
+ Predef.type_continuation ty_eff ty_res
+ in
+ let conts = List.map (type_continuation_pat env ty_cont) conts in
+ let cases, _ = type_cases category new_env ty_arg
+ ty_res_explained ~conts ~check_if_total:false loc caselist
+ in
+ cases
+ end
+
(* Typing of let bindings *)
and type_let ?check ?check_strict
@@ -6099,11 +6238,11 @@ and type_let ?check ?check_strict
let attrs_list = List.map fst spatl in
let is_recursive = (rec_flag = Recursive) in
- let (pat_list, exp_list, new_env, mvs, _pvs) =
- with_local_level begin fun () ->
+ let (pat_list, exp_list, new_env, mvs) =
+ with_local_level_generalize begin fun () ->
if existential_context = At_toplevel then Typetexp.TyVarEnv.reset ();
let (pat_list, new_env, force, pvs, mvs) =
- with_local_level_if_principal begin fun () ->
+ with_local_level_generalize_structure_if_principal begin fun () ->
let nvs = List.map (fun _ -> newvar ()) spatl in
let (pat_list, _new_env, _force, _pvs, _mvs as res) =
type_pattern_list
@@ -6133,11 +6272,6 @@ and type_let ?check ?check_strict
pat_list;
res
end
- ~post: begin fun (pat_list, _, _, pvs, _) ->
- (* Generalize the structure *)
- iter_pattern_variables_type generalize_structure pvs;
- List.iter (fun pat -> generalize_structure pat.pat_type) pat_list
- end
in
(* Note [add_module_variables after checking expressions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -6174,8 +6308,7 @@ and type_let ?check ?check_strict
match get_desc pat.pat_type with
| Tpoly (ty, tl) ->
let vars, ty' =
- with_local_level_if_principal
- ~post:(fun (_,ty') -> generalize_structure ty')
+ with_local_level_generalize_structure_if_principal
(fun () -> instance_poly ~keep_names:true ~fixed:true tl ty)
in
let exp =
@@ -6201,37 +6334,21 @@ and type_let ?check ?check_strict
)
pat_list
(List.map2 (fun (attrs, _) (e, _) -> attrs, e) spatl exp_list);
- (pat_list, exp_list, new_env, mvs,
- List.map (fun pv -> { pv with pv_type = instance pv.pv_type}) pvs)
+ (pat_list, exp_list, new_env, mvs)
end
- ~post: begin fun (pat_list, exp_list, _, _, pvs) ->
- List.iter2
- (fun pat (exp, _) ->
- if maybe_expansive exp then lower_contravariant env pat.pat_type)
- pat_list exp_list;
- iter_pattern_variables_type generalize pvs;
- List.iter2
- (fun pat (exp, vars) ->
- match vars with
- | None ->
- (* We generalize expressions even if they are not bound to a variable
- and do not have an expliclit polymorphic type annotation. This is
- not needed in general, however those types may be shown by the
- interactive toplevel, for example:
- {[
- let _ = Array.get;;
- - : 'a array -> int -> 'a = <fun>
- ]}
- so we do it anyway. *)
- generalize exp.exp_type
- | Some vars ->
- if maybe_expansive exp then
- lower_contravariant env exp.exp_type;
- generalize_and_check_univars env "definition"
- exp pat.pat_type vars)
+ ~before_generalize: begin fun (pat_list, exp_list, _, _) ->
+ List.iter2 (fun pat (exp, vars) ->
+ if maybe_expansive exp then begin
+ lower_contravariant env pat.pat_type;
+ if vars <> None then lower_contravariant env exp.exp_type
+ end)
pat_list exp_list
end
in
+ List.iter2
+ (fun pat (exp, vars) ->
+ Option.iter (check_univars env "definition" exp pat.pat_type) vars)
+ pat_list exp_list;
let l = List.combine pat_list exp_list in
let l =
List.map2
@@ -6386,7 +6503,7 @@ and type_andops env sarg sands expected_ty =
| [] -> type_expect env let_sarg (mk_expected expected_ty), []
| { pbop_op = sop; pbop_exp = sexp; pbop_loc = loc; _ } :: rest ->
let op_path, op_desc, op_type, ty_arg, ty_rest, ty_result =
- with_local_level_iter_if_principal begin fun () ->
+ with_local_level_generalize_structure_if_principal begin fun () ->
let op_path, op_desc = type_binding_op_ident env sop in
let op_type = instance op_desc.val_type in
let ty_arg = newvar () in
@@ -6401,10 +6518,8 @@ and type_andops env sarg sands expected_ty =
with Unify err ->
raise(error(sop.loc, env, Andop_type_clash(sop.txt, err)))
end;
- ((op_path, op_desc, op_type, ty_arg, ty_rest, ty_result),
- [ty_rest; ty_arg; ty_result])
+ (op_path, op_desc, op_type, ty_arg, ty_rest, ty_result)
end
- ~post:generalize_structure
in
let let_arg, rest = loop env let_sarg rest ty_rest in
let exp = type_expect env sexp (mk_expected ty_arg) in
@@ -6530,11 +6645,11 @@ let type_let existential_ctx env rec_flag spat_sexp_list =
let type_expression env sexp =
let exp =
- with_local_level begin fun () ->
+ with_local_level_generalize begin fun () ->
Typetexp.TyVarEnv.reset();
type_exp env sexp
end
- ~post:(may_lower_contravariant_then_generalize env)
+ ~before_generalize:(may_lower_contravariant env)
in
match sexp.pexp_desc with
Pexp_ident lid ->
@@ -6554,9 +6669,12 @@ let spellcheck ppf unbound_name valid_names =
let spellcheck_idents ppf unbound valid_idents =
spellcheck ppf (Ident.name unbound) (List.map Ident.name valid_idents)
-open Format
+open Format_doc
+module Fmt = Format_doc
+module Printtyp = Printtyp.Doc
-let longident = Printtyp.longident
+let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
(* Returns the first diff of the trace *)
let type_clash_of_trace trace =
@@ -6565,11 +6683,49 @@ let type_clash_of_trace trace =
| _ -> None
))
+(** More precise denomination for type errors. Used by messages:
+
+ - [This <denom> ...]
+ - [The <denom> "foo" ...] *)
+let pp_exp_denom ppf pexp =
+ let d = pp_print_string ppf in
+ let d_expression = fprintf ppf "%a expression" Style.inline_code in
+ match pexp.pexp_desc with
+ | Pexp_constant _ -> d "constant"
+ | Pexp_ident _ -> d "value"
+ | Pexp_construct _ | Pexp_variant _ -> d "constructor"
+ | Pexp_field _ -> d "field access"
+ | Pexp_send _ -> d "method call"
+ | Pexp_while _ -> d_expression "while"
+ | Pexp_for _ -> d_expression "for"
+ | Pexp_ifthenelse _ -> d_expression "if-then-else"
+ | Pexp_match _ -> d_expression "match"
+ | Pexp_try _ -> d_expression "try-with"
+ | _ -> d "expression"
+
+(** Implements the "This expression" message, printing the expression if it
+ should be according to {!Parsetree.Doc.nominal_exp}. *)
+let report_this_pexp_has_type denom ppf exp =
+ let denom ppf =
+ match denom, exp with
+ | Some d, _ -> fprintf ppf "%s" d
+ | None, Some exp -> pp_exp_denom ppf exp
+ | None, None -> fprintf ppf "expression"
+ in
+ let nexp = Option.bind exp Pprintast.Doc.nominal_exp in
+ match nexp with
+ | Some nexp ->
+ fprintf ppf "The %t %a has type" denom (Style.as_inline_code pp_doc) nexp
+ | _ -> fprintf ppf "This %t has type" denom
+
+let report_this_texp_has_type denom ppf texp =
+ report_this_pexp_has_type denom ppf (Some (Untypeast.untype_expression texp))
+
(* Hint on type error on integer literals
To avoid confusion, it is disabled on float literals
and when the expected type is `int` *)
let report_literal_type_constraint expected_type const =
- let const_str = match const with
+ let const_str = match const.pconst_desc with
| Pconst_integer (s, _) -> Some s
| _ -> None
in
@@ -6584,7 +6740,7 @@ let report_literal_type_constraint expected_type const =
Some '.'
else None
in
- let pp_const ppf (c,s) = Format.fprintf ppf "%s%c" c s in
+ let pp_const ppf (c,s) = Fmt.fprintf ppf "%s%c" c s in
match const_str, suffix with
| Some c, Some s -> [
Location.msg
@@ -6615,17 +6771,21 @@ let report_partial_application = function
let report_expr_type_clash_hints exp diff =
match exp with
- | Some (Pexp_constant const) -> report_literal_type_constraint const diff
- | Some (Pexp_apply _) -> report_partial_application diff
- | _ -> []
+ | Some exp -> begin
+ match exp.pexp_desc with
+ | Pexp_constant const -> report_literal_type_constraint const diff
+ | Pexp_apply _ -> report_partial_application diff
+ | _ -> []
+ end
+ | None -> []
let report_pattern_type_clash_hints pat diff =
match pat with
| Some (Ppat_constant const) -> report_literal_type_constraint const diff
| _ -> []
-let report_type_expected_explanation expl ppf =
- let because expl_str = fprintf ppf "@ because it is in %s" expl_str in
+let report_type_expected_explanation expl =
+ let because expl_str = doc_printf "@ because it is in %s" expl_str in
match expl with
| If_conditional ->
because "the condition of an if-statement"
@@ -6648,25 +6808,18 @@ let report_type_expected_explanation expl ppf =
| When_guard ->
because "a when-guard"
-let report_type_expected_explanation_opt expl ppf =
+let report_type_expected_explanation_opt expl =
match expl with
- | None -> ()
- | Some expl -> report_type_expected_explanation expl ppf
+ | None -> Format_doc.Doc.empty
+ | Some expl -> report_type_expected_explanation expl
let report_unification_error ~loc ?sub env err
?type_expected_explanation txt1 txt2 =
Location.error_of_printer ~loc ?sub (fun ppf () ->
- Printtyp.report_unification_error ppf env err
+ Errortrace_report.unification ppf env err
?type_expected_explanation txt1 txt2
) ()
-let report_this_function ppf funct =
- if Typedtree.exp_is_nominal funct then
- let pexp = Untypeast.untype_expression funct in
- Format.fprintf ppf "The function %a"
- (Style.as_inline_code Pprintast.expression) pexp
- else Format.fprintf ppf "This function"
-
let report_too_many_arg_error ~funct ~func_ty ~previous_arg_loc
~extra_arg_loc ~returns_unit loc =
let open Location in
@@ -6693,39 +6846,34 @@ let report_too_many_arg_error ~funct ~func_ty ~previous_arg_loc
msg ~loc:extra_arg_loc "This extra argument is not expected.";
] in
errorf ~loc:app_loc ~sub
- "@[<v>@[<2>%a has type@ %a@]\
+ "@[<v>@[<2>%a@ %a@]\
@ It is applied to too many arguments@]"
- report_this_function funct Printtyp.type_expr func_ty
+ (report_this_texp_has_type (Some "function")) funct
+ Printtyp.type_expr func_ty
+
+let msg = Fmt.doc_printf
let report_error ~loc env = function
| Constructor_arity_mismatch(lid, expected, provided) ->
Location.errorf ~loc
"@[The constructor %a@ expects %i argument(s),@ \
but is applied here to %i argument(s)@]"
- (Style.as_inline_code longident) lid expected provided
+ quoted_constr lid expected provided
| Label_mismatch(lid, err) ->
report_unification_error ~loc env err
- (function ppf ->
- fprintf ppf "The record field %a@ belongs to the type"
- (Style.as_inline_code longident) lid)
- (function ppf ->
- fprintf ppf "but is mixed here with fields of type")
+ (msg "The record field %a@ belongs to the type" quoted_longident lid)
+ (msg "but is mixed here with fields of type")
| Pattern_type_clash (err, pat) ->
let diff = type_clash_of_trace err.trace in
let sub = report_pattern_type_clash_hints pat diff in
report_unification_error ~loc ~sub env err
- (function ppf ->
- fprintf ppf "This pattern matches values of type")
- (function ppf ->
- fprintf ppf "but a pattern was expected which matches values of \
- type");
+ (msg "This pattern matches values of type")
+ (msg "but a pattern was expected which matches values of type");
| Or_pattern_type_clash (id, err) ->
report_unification_error ~loc env err
- (function ppf ->
- fprintf ppf "The variable %a on the left-hand side of this \
+ (msg "The variable %a on the left-hand side of this \
or-pattern has type" Style.inline_code (Ident.name id))
- (function ppf ->
- fprintf ppf "but on the right-hand side it has type")
+ (msg "but on the right-hand side it has type")
| Multiply_bound_variable name ->
Location.errorf ~loc
"Variable %a is bound several times in this matching"
@@ -6745,10 +6893,8 @@ let report_error ~loc env = function
report_unification_error ~loc ~sub env err
~type_expected_explanation:
(report_type_expected_explanation_opt explanation)
- (function ppf ->
- fprintf ppf "This expression has type")
- (function ppf ->
- fprintf ppf "but an expression was expected of type");
+ (msg "%a" (report_this_pexp_has_type None) exp)
+ (msg "but an expression was expected of type");
| Function_arity_type_clash {
syntactic_arity; type_constraint; trace = { trace };
} ->
@@ -6834,7 +6980,7 @@ let report_error ~loc env = function
print_labels labels
| Label_not_mutable lid ->
Location.errorf ~loc "The record field %a is not mutable"
- (Style.as_inline_code longident) lid
+ quoted_longident lid
| Wrong_name (eorp, ty_expected, { type_path; kind; name; valid_names; }) ->
Location.error_of_printer ~loc (fun ppf () ->
Printtyp.wrap_printing_env ~error:true env (fun () ->
@@ -6847,10 +6993,10 @@ let report_error ~loc env = function
(Style.as_inline_code Printtyp.type_path) type_path;
end else begin
fprintf ppf
- "@[@[<2>%s type@ %a%t@]@ \
+ "@[@[<2>%s type@ %a%a@]@ \
There is no %s %a within type %a@]"
eorp (Style.as_inline_code Printtyp.type_expr) ty
- (report_type_expected_explanation_opt explanation)
+ pp_doc (report_type_expected_explanation_opt explanation)
(Datatype_kind.label_name kind)
Style.inline_code name.txt
(Style.as_inline_code Printtyp.type_path) type_path;
@@ -6860,19 +7006,19 @@ let report_error ~loc env = function
| Name_type_mismatch (kind, lid, tp, tpl) ->
let type_name = Datatype_kind.type_name kind in
let name = Datatype_kind.label_name kind in
+ let pr = match kind with
+ | Datatype_kind.Record -> quoted_longident
+ | Datatype_kind.Variant -> quoted_constr
+ in
Location.error_of_printer ~loc (fun ppf () ->
- Printtyp.report_ambiguous_type_error ppf env tp tpl
- (function ppf ->
- fprintf ppf "The %s %a@ belongs to the %s type"
- name (Style.as_inline_code longident) lid
- type_name)
- (function ppf ->
- fprintf ppf "The %s %a@ belongs to one of the following %s types:"
- name (Style.as_inline_code longident) lid type_name)
- (function ppf ->
- fprintf ppf "but a %s was expected belonging to the %s type"
+ Errortrace_report.ambiguous_type ppf env tp tpl
+ (msg "The %s %a@ belongs to the %s type"
+ name pr lid type_name)
+ (msg "The %s %a@ belongs to one of the following %s types:"
+ name pr lid type_name)
+ (msg "but a %s was expected belonging to the %s type"
name type_name)
- ) ()
+ ) ()
| Invalid_format msg ->
Location.errorf ~loc "%s" msg
| Not_an_object (ty, explanation) ->
@@ -6880,7 +7026,7 @@ let report_error ~loc env = function
fprintf ppf "This expression is not an object;@ \
it has type %a"
(Style.as_inline_code Printtyp.type_expr) ty;
- report_type_expected_explanation_opt explanation ppf
+ pp_doc ppf @@ report_type_expected_explanation_opt explanation
) ()
| Undefined_method (ty, me, valid_methods) ->
Location.error_of_printer ~loc (fun ppf () ->
@@ -6902,7 +7048,7 @@ let report_error ~loc env = function
) ()
| Virtual_class cl ->
Location.errorf ~loc "Cannot instantiate the virtual class %a"
- (Style.as_inline_code longident) cl
+ quoted_longident cl
| Unbound_instance_variable (var, valid_vars) ->
Location.error_of_printer ~loc (fun ppf () ->
fprintf ppf "Unbound instance variable %a" Style.inline_code var;
@@ -6913,7 +7059,7 @@ let report_error ~loc env = function
Style.inline_code v
| Not_subtype err ->
Location.error_of_printer ~loc (fun ppf () ->
- Printtyp.Subtype.report_error ppf env err "is not a subtype of"
+ Errortrace_report.subtype ppf env err "is not a subtype of"
) ()
| Outside_class ->
Location.errorf ~loc
@@ -6924,14 +7070,15 @@ let report_error ~loc env = function
Style.inline_code v
| Coercion_failure (ty_exp, err, b) ->
Location.error_of_printer ~loc (fun ppf () ->
- Printtyp.report_unification_error ppf env err
- (function ppf ->
- let ty_exp = Printtyp.prepare_expansion ty_exp in
- fprintf ppf "This expression cannot be coerced to type@;<1 2>%a;@ \
- it has type"
- (Style.as_inline_code @@ Printtyp.type_expansion Type) ty_exp)
- (function ppf ->
- fprintf ppf "but is here used with type");
+ let intro =
+ let ty_exp = Out_type.prepare_expansion ty_exp in
+ doc_printf "This expression cannot be coerced to type@;<1 2>%a;@ \
+ it has type"
+ (Style.as_inline_code @@ Printtyp.type_expansion Type) ty_exp
+ in
+ Errortrace_report.unification ppf env err
+ intro
+ (Fmt.doc_printf "but is here used with type");
if b then
fprintf ppf
".@.@[<hov>This simple coercion was not fully general.@ \
@@ -6942,15 +7089,15 @@ let report_error ~loc env = function
| Not_a_function (ty, explanation) ->
Location.errorf ~loc
"This expression should not be a function,@ \
- the expected type is@ %a%t"
+ the expected type is@ %a%a"
(Style.as_inline_code Printtyp.type_expr) ty
- (report_type_expected_explanation_opt explanation)
+ pp_doc (report_type_expected_explanation_opt explanation)
| Too_many_arguments (ty, explanation) ->
Location.errorf ~loc
"This function expects too many arguments,@ \
- it should have type@ %a%t"
+ it should have type@ %a%a"
(Style.as_inline_code Printtyp.type_expr) ty
- (report_type_expected_explanation_opt explanation)
+ pp_doc (report_type_expected_explanation_opt explanation)
| Abstract_wrong_label {got; expected; expected_type; explanation} ->
let label ~long ppf = function
| Nolabel -> fprintf ppf "unlabeled"
@@ -6965,10 +7112,10 @@ let report_error ~loc env = function
| _ -> false
in
Location.errorf ~loc
- "@[<v>@[<2>This function should have type@ %a%t@]@,\
+ "@[<v>@[<2>This function should have type@ %a%a@]@,\
@[but its first argument is %a@ instead of %s%a@]@]"
(Style.as_inline_code Printtyp.type_expr) expected_type
- (report_type_expected_explanation_opt explanation)
+ pp_doc (report_type_expected_explanation_opt explanation)
(label ~long:true) got
(if second_long then "being " else "")
(label ~long:second_long) expected
@@ -6984,7 +7131,7 @@ let report_error ~loc env = function
(Style.as_inline_code Printtyp.type_expr) ty
| Private_label (lid, ty) ->
Location.errorf ~loc "Cannot assign field %a of the private type %a"
- (Style.as_inline_code longident) lid
+ quoted_longident lid
(Style.as_inline_code Printtyp.type_expr) ty
| Private_constructor (constr, ty) ->
Location.errorf ~loc
@@ -6993,7 +7140,7 @@ let report_error ~loc env = function
(Style.as_inline_code Printtyp.type_expr) ty
| Not_a_polymorphic_variant_type lid ->
Location.errorf ~loc "The type %a@ is not a variant type"
- (Style.as_inline_code longident) lid
+ quoted_longident lid
| Incoherent_label_order ->
Location.errorf ~loc
"This function is applied to arguments@ \
@@ -7001,8 +7148,8 @@ let report_error ~loc env = function
This is only allowed when the real type is known."
| Less_general (kind, err) ->
report_unification_error ~loc env err
- (fun ppf -> fprintf ppf "This %s has type" kind)
- (fun ppf -> fprintf ppf "which is less general than")
+ (Fmt.doc_printf "This %s has type" kind)
+ (Fmt.doc_printf "which is less general than")
| Modules_not_allowed ->
Location.errorf ~loc "Modules are not allowed in this pattern."
| Cannot_infer_signature ->
@@ -7054,6 +7201,12 @@ let report_error ~loc env = function
Location.errorf ~loc
"@[Mixing value and exception patterns under when-guards is not \
supported.@]"
+ | Effect_pattern_below_toplevel ->
+ Location.errorf ~loc
+ "@[Effect patterns must be at the top level of a match case.@]"
+ | Invalid_continuation_pattern ->
+ Location.errorf ~loc
+ "@[Invalid continuation pattern: only variables and _ are allowed .@]"
| Inlined_record_escape ->
Location.errorf ~loc
"@[This form is not allowed as the type of the inlined record could \
@@ -7066,7 +7219,7 @@ let report_error ~loc env = function
"@[%s@ %s@ @[%a@]@]"
"This match case could not be refuted."
"Here is an example of a value that would reach it:"
- (Style.as_inline_code Printpat.pretty_val) pat
+ (Style.as_inline_code Printpat.top_pretty) pat
| Invalid_extension_constructor_payload ->
Location.errorf ~loc
"Invalid %a payload, a constructor is expected."
@@ -7096,22 +7249,16 @@ let report_error ~loc env = function
"This kind of recursive class expression is not allowed"
| Letop_type_clash(name, err) ->
report_unification_error ~loc env err
- (function ppf ->
- fprintf ppf "The operator %a has type" Style.inline_code name)
- (function ppf ->
- fprintf ppf "but it was expected to have type")
+ (msg "The operator %a has type" Style.inline_code name)
+ (msg "but it was expected to have type")
| Andop_type_clash(name, err) ->
report_unification_error ~loc env err
- (function ppf ->
- fprintf ppf "The operator %a has type" Style.inline_code name)
- (function ppf ->
- fprintf ppf "but it was expected to have type")
+ (msg "The operator %a has type" Style.inline_code name)
+ (msg "but it was expected to have type")
| Bindings_type_clash(err) ->
report_unification_error ~loc env err
- (function ppf ->
- fprintf ppf "These bindings have type")
- (function ppf ->
- fprintf ppf "but bindings were expected of type")
+ (Fmt.doc_printf "These bindings have type")
+ (Fmt.doc_printf "but bindings were expected of type")
| Unbound_existential (ids, ty) ->
let pp_ident ppf id = pp_print_string ppf (Ident.name id) in
let pp_type ppf (ids,ty)=
@@ -7123,6 +7270,20 @@ let report_error ~loc env = function
"@[<2>%s:@ %a@]"
"This type does not bind all existentials in the constructor"
(Style.as_inline_code pp_type) (ids, ty)
+ | Bind_existential (reason, id, ty) ->
+ let reason1, reason2 = match reason with
+ | Bind_already_bound -> "the name", "that is already bound"
+ | Bind_not_in_scope -> "the name", "that was defined before"
+ | Bind_non_locally_abstract -> "the type",
+ "that is not a locally abstract type"
+ in
+ Location.errorf ~loc
+ "@[<hov0>The local name@ %a@ %s@ %s.@ %s@ %s@ %a@ %s.@]"
+ (Style.as_inline_code Printtyp.ident) id
+ "can only be given to an existential variable"
+ "introduced by this GADT constructor"
+ "The type annotation tries to bind it to"
+ reason1 (Style.as_inline_code Printtyp.type_expr) ty reason2
| Missing_type_constraint ->
Location.errorf ~loc
"@[%s@ %s@]"
@@ -7144,9 +7305,9 @@ let report_error ~loc env = function
in
Location.errorf ~loc
"This %s should not be a %s,@ \
- the expected type is@ %a%t"
+ the expected type is@ %a%a"
ctx sort (Style.as_inline_code Printtyp.type_expr) ty
- (report_type_expected_explanation_opt explanation)
+ pp_doc (report_type_expected_explanation_opt explanation)
| Expr_not_a_record_type ty ->
Location.errorf ~loc
"This expression has type %a@ \
diff --git a/src/ocaml/typing/typecore.mli b/src/ocaml/typing/typecore.mli
index ae47ac4a89..6211689305 100644
--- a/src/ocaml/typing/typecore.mli
+++ b/src/ocaml/typing/typecore.mli
@@ -49,12 +49,17 @@ type type_expected = private {
}
(* Variables in patterns *)
+type pattern_variable_kind =
+ | Std_var
+ | As_var
+ | Continuation_var
+
type pattern_variable =
{
pv_id: Ident.t;
pv_type: type_expr;
pv_loc: Location.t;
- pv_as_var: bool;
+ pv_kind: pattern_variable_kind;
pv_attributes: Typedtree.attributes;
pv_uid : Uid.t;
}
@@ -134,7 +139,6 @@ val option_some: Env.t -> Typedtree.expression -> Typedtree.expression
val option_none: Env.t -> type_expr -> Location.t -> Typedtree.expression
val extract_option_type: Env.t -> type_expr -> type_expr
val generalizable: int -> type_expr -> bool
-val generalize_structure_exp: Typedtree.expression -> unit
type delayed_check
val delayed_checks: delayed_check list ref
val reset_delayed_checks: unit -> unit
@@ -145,6 +149,11 @@ val name_cases : string -> Typedtree.value Typedtree.case list -> Ident.t
val self_coercion : (Path.t * Location.t list ref) list ref
+type existential_binding =
+ | Bind_already_bound
+ | Bind_not_in_scope
+ | Bind_non_locally_abstract
+
type error =
| Constructor_arity_mismatch of Longident.t * int * int
| Label_mismatch of Longident.t * Errortrace.unification_error
@@ -156,7 +165,7 @@ type error =
| Orpat_vars of Ident.t * Ident.t list
| Expr_type_clash of
Errortrace.unification_error * type_forcing_context option
- * Parsetree.expression_desc option
+ * Parsetree.expression option
| Function_arity_type_clash of
{ syntactic_arity : int;
type_constraint : type_expr;
@@ -212,6 +221,8 @@ type error =
| No_value_clauses
| Exception_pattern_disallowed
| Mixed_value_and_exception_patterns_under_guard
+ | Effect_pattern_below_toplevel
+ | Invalid_continuation_pattern
| Inlined_record_escape
| Inlined_record_expected
| Unrefuted_pattern of Typedtree.pattern
@@ -226,6 +237,7 @@ type error =
| Andop_type_clash of string * Errortrace.unification_error
| Bindings_type_clash of Errortrace.unification_error
| Unbound_existential of Ident.t list * type_expr
+ | Bind_existential of existential_binding * Ident.t * type_expr
| Missing_type_constraint
| Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
| Expr_not_a_record_type of type_expr
diff --git a/src/ocaml/typing/typedecl.ml b/src/ocaml/typing/typedecl.ml
index 626cd35fb5..0610c65076 100644
--- a/src/ocaml/typing/typedecl.ml
+++ b/src/ocaml/typing/typedecl.ml
@@ -122,7 +122,7 @@ let enter_type ?abstract_abbrevs rec_flag env sdecl (id, uid) =
let abstract_source, type_manifest =
match sdecl.ptype_manifest, abstract_abbrevs with
| None, _ -> Definition, None
- | Some _, None -> Definition, Some (Btype.newgenvar ())
+ | Some _, None -> Definition, Some (Ctype.newvar ())
| Some _, Some reason -> reason, None
in
let decl =
@@ -234,7 +234,7 @@ let transl_labels env univars closed lbls =
let cty = transl_simple_type env ?univars ~closed arg in
{ld_id = Ident.create_local name.txt;
ld_name = name;
- ld_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ ld_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
ld_mutable = mut;
ld_type = cty; ld_loc = loc; ld_attributes = attrs}
)
@@ -279,8 +279,8 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
(* narrow and widen are now invoked through wrap_type_variable_scope *)
TyVarEnv.with_local_scope begin fun () ->
let closed = svars <> [] in
- let targs, tret_type, args, ret_type, _univars =
- Ctype.with_local_level_if closed begin fun () ->
+ let targs, tret_type, args, ret_type, univars =
+ Ctype.with_local_level_generalize_if closed begin fun () ->
TyVarEnv.reset ();
let univar_list =
TyVarEnv.make_poly_univars (List.map (fun v -> v.txt) svars) in
@@ -309,15 +309,13 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
end;
(targs, tret_type, args, ret_type, univar_list)
end
- ~post: begin fun (_, _, args, ret_type, univars) ->
- Btype.iter_type_expr_cstr_args Ctype.generalize args;
- Ctype.generalize ret_type;
- let _vars = TyVarEnv.instance_poly_univars env loc univars in
- let set_level t = Ctype.enforce_current_level env t in
- Btype.iter_type_expr_cstr_args set_level args;
- set_level ret_type;
- end
in
+ if closed then begin
+ ignore (TyVarEnv.instance_poly_univars env loc univars);
+ let set_level t = Ctype.enforce_current_level env t in
+ Btype.iter_type_expr_cstr_args set_level args;
+ set_level ret_type
+ end;
targs, Some tret_type, args, Some ret_type
end
@@ -344,7 +342,6 @@ let shape_map_cstrs =
let transl_declaration env sdecl (id, uid) =
(* Bind type parameters *)
- Ctype.with_local_level begin fun () ->
TyVarEnv.reset();
let tparams = make_params env sdecl.ptype_params in
let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
@@ -428,7 +425,7 @@ let transl_declaration env sdecl (id, uid) =
let tcstr =
{ cd_id = name;
cd_name = scstr.pcd_name;
- cd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ cd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
cd_vars = scstr.pcd_vars;
cd_args = targs;
cd_res = tret_type;
@@ -463,6 +460,7 @@ let transl_declaration env sdecl (id, uid) =
Ttype_record lbls, Type_record(lbls', rep)
| Ptype_open -> Ttype_open, Type_open
in
+ begin
let (tman, man) = match sdecl.ptype_manifest with
None -> None, None
| Some sty ->
@@ -529,16 +527,6 @@ let transl_declaration env sdecl (id, uid) =
decl, typ_shape
end
-(* Generalize a type declaration *)
-
-let generalize_decl decl =
- List.iter Ctype.generalize decl.type_params;
- Btype.iter_type_expr_kind Ctype.generalize decl.type_kind;
- begin match decl.type_manifest with
- | None -> ()
- | Some ty -> Ctype.generalize ty
- end
-
(* Check that all constraints are enforced *)
module TypeSet = Btype.TypeSet
@@ -662,13 +650,21 @@ let check_coherence env loc dpath decl =
| exception Ctype.Equality err ->
Some (Includecore.Constraint err)
| () ->
+ let subst =
+ Subst.Unsafe.add_type_path dpath path Subst.identity in
+ let decl =
+ match Subst.Unsafe.type_declaration subst decl with
+ | Ok decl -> decl
+ | Error (Fcm_type_substituted_away _) ->
+ (* no module type substitution in [subst] *)
+ assert false
+ in
Includecore.type_declarations ~loc ~equality:true env
~mark:true
(Path.last path)
decl'
dpath
- (Subst.type_declaration
- (Subst.add_type_path dpath path Subst.identity) decl)
+ decl
end
in
if err <> None then
@@ -906,11 +902,8 @@ let check_well_founded_decl ~abs_env env loc path decl to_check =
let open Btype in
(* We iterate on all subexpressions of the declaration to check
"in depth" that no ill-founded type exists. *)
- let it =
- let checked =
- (* [checked] remembers the types that the iterator already
- checked, to avoid looping on cyclic types. *)
- ref TypeSet.empty in
+ with_type_mark begin fun mark ->
+ let super = type_iterators mark in
let visited =
(* [visited] remembers the inner visits performed by
[check_well_founded] on each type expression reachable from
@@ -918,14 +911,14 @@ let check_well_founded_decl ~abs_env env loc path decl to_check =
[check_well_founded] work when invoked on two parts of the
type declaration that have common subexpressions. *)
ref TypeMap.empty in
- {type_iterators with it_type_expr =
- (fun self ty ->
- if TypeSet.mem ty !checked then () else begin
- check_well_founded ~abs_env env loc path to_check visited ty;
- checked := TypeSet.add ty !checked;
- self.it_do_type_expr self ty
- end)} in
- it.it_type_declaration it (Ctype.generic_instance_declaration decl)
+ let it =
+ {super with it_do_type_expr =
+ (fun self ty ->
+ check_well_founded ~abs_env env loc path to_check visited ty;
+ super.it_do_type_expr self ty
+ )} in
+ it.it_type_declaration it (Ctype.generic_instance_declaration decl)
+ end
(* Check for non-regular abbreviations; an abbreviation
[type 'a t = ...] is non-regular if the expansion of [...]
@@ -1046,10 +1039,10 @@ let name_recursion sdecl id decl =
| { type_kind = Type_abstract _;
type_manifest = Some ty;
type_private = Private; } when is_fixed_type sdecl ->
- let ty' = newty2 ~level:(get_level ty) (get_desc ty) in
+ let ty' = Btype.newty2 ~level:(get_level ty) (get_desc ty) in
if Ctype.deep_occur ty ty' then
let td = Tconstr(Path.Pident id, decl.type_params, ref Mnil) in
- link_type ty (newty2 ~level:(get_level ty) td);
+ link_type ty (Btype.newty2 ~level:(get_level ty) td);
{decl with type_manifest = Some ty'}
else decl
| _ -> decl
@@ -1072,6 +1065,23 @@ let check_redefined_unit (td: Parsetree.type_declaration) =
| _ ->
()
+(* Update a temporary definition to share recursion *)
+let update_type temp_env env id loc =
+ let path = Path.Pident id in
+ let decl = Env.find_type path temp_env in
+ match decl.type_manifest with None -> ()
+ | Some ty ->
+ (* Since this function is called after generalizing declarations,
+ ty is at the generic level. Since we need to keep possible
+ sharings in recursive type definitions, unify without instantiating,
+ but generalize again after unification. *)
+ Ctype.with_local_level_generalize begin fun () ->
+ let params = List.map (fun _ -> Ctype.newvar ()) decl.type_params in
+ try Ctype.unify env (Ctype.newconstr path params) ty
+ with Ctype.Unify err ->
+ raise (Error(loc, Type_clash (env, err)))
+ end
+
let add_types_to_env decls shapes env =
List.fold_right2
(fun (id, decl) shape env ->
@@ -1104,14 +1114,14 @@ let transl_type_decl env rec_flag sdecl_list =
let ids_list =
List.map (fun sdecl ->
Ident.create_scoped ~scope sdecl.ptype_name.txt,
- Uid.mk ~current_unit:(Env.get_unit_name ())
+ Uid.mk ~current_unit:(Env.get_current_unit ())
) sdecl_list
in
(* Translate declarations, using a temporary environment where abbreviations
expand to a generic type variable. After that, we check the coherence of
the translated declarations in the resulting new environment. *)
- let tdecls, decls, shapes, new_env =
- Ctype.with_local_level_iter ~post:generalize_decl begin fun () ->
+ let tdecls, decls, shapes, temp_env, new_env =
+ Ctype.with_local_level_generalize begin fun () ->
(* Enter types. *)
let temp_env =
List.fold_left2 (enter_type rec_flag) env sdecl_list ids_list in
@@ -1157,7 +1167,7 @@ let transl_type_decl env rec_flag sdecl_list =
check_duplicates sdecl_list;
(* Build the final env. *)
let new_env = add_types_to_env decls shapes env in
- ((tdecls, decls, shapes, new_env), List.map snd decls)
+ (tdecls, decls, shapes, temp_env, new_env)
end
in
(* Check for ill-formed abbrevs *)
@@ -1187,6 +1197,15 @@ let transl_type_decl env rec_flag sdecl_list =
List.iter (fun (tdecl, _shape) ->
check_abbrev_regularity ~abs_env new_env id_loc_list to_check tdecl)
tdecls;
+ (* Update temporary definitions (for well-founded recursive types) *)
+ begin match rec_flag with
+ | Asttypes.Nonrecursive -> ()
+ | Asttypes.Recursive ->
+ List.iter2
+ (fun (id, _) sdecl ->
+ update_type temp_env new_env id sdecl.ptype_loc)
+ ids_list sdecl_list
+ end;
(* Check that all type variables are closed *)
List.iter2
(fun sdecl (tdecl, _shape) ->
@@ -1335,7 +1354,7 @@ let transl_extension_constructor ~scope env type_path type_params
ext_private = priv;
Types.ext_loc = sext.pext_loc;
Types.ext_attributes = sext.pext_attributes;
- ext_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ ext_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
let ext_cstrs =
@@ -1415,7 +1434,7 @@ let transl_type_extension extend env loc styext =
(* Note: it would be incorrect to call [create_scope] *after*
[TyVarEnv.reset] or after [with_local_level] (see #10010). *)
let scope = Ctype.create_scope () in
- Ctype.with_local_level begin fun () ->
+ Ctype.with_local_level_generalize begin fun () ->
TyVarEnv.reset();
let ttype_params = make_params env styext.ptyext_params in
let type_params = List.map (fun (cty, _) -> cty.ctyp_type) ttype_params in
@@ -1429,15 +1448,6 @@ let transl_type_extension extend env loc styext =
in
(ttype_params, type_params, constructors)
end
- ~post: begin fun (_, type_params, constructors) ->
- (* Generalize types *)
- List.iter Ctype.generalize type_params;
- List.iter
- (fun (ext, _shape) ->
- Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
- Option.iter Ctype.generalize ext.ext_type.ext_ret_type)
- constructors;
- end
in
(* Check that all type variables are closed *)
List.iter
@@ -1487,15 +1497,11 @@ let transl_type_extension extend env loc styext =
let transl_exception env sext =
let ext, shape =
let scope = Ctype.create_scope () in
- Ctype.with_local_level
+ Ctype.with_local_level_generalize
(fun () ->
TyVarEnv.reset();
transl_extension_constructor ~scope env
Predef.path_exn [] [] Asttypes.Public sext)
- ~post: begin fun (ext, _shape) ->
- Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
- Option.iter Ctype.generalize ext.ext_type.ext_ret_type;
- end
in
(* Check that all type variables are closed *)
begin match Ctype.closed_extension_constructor ext.ext_type with
@@ -1635,7 +1641,7 @@ let transl_value_decl env loc valdecl =
[] when Env.is_in_signature env ->
{ val_type = ty; val_kind = Val_reg; Types.val_loc = loc;
val_attributes = valdecl.pval_attributes;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
| [] ->
raise (Error(valdecl.pval_loc, Val_in_structure))
@@ -1667,7 +1673,7 @@ let transl_value_decl env loc valdecl =
check_unboxable env loc ty;
{ val_type = ty; val_kind = Val_prim prim; Types.val_loc = loc;
val_attributes = valdecl.pval_attributes;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
let (id, newenv) =
@@ -1705,7 +1711,7 @@ let transl_value_decl env loc valdecl =
let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
sdecl =
Env.mark_type_used sig_decl.type_uid;
- Ctype.with_local_level begin fun () ->
+ Ctype.with_local_level_generalize begin fun () ->
TyVarEnv.reset();
(* In the first part of this function, we typecheck the syntactic
declaration [sdecl] in the outer environment [outer_env]. *)
@@ -1783,7 +1789,7 @@ let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
type_attributes = sdecl.ptype_attributes;
type_immediate = Unknown;
type_unboxed_default;
- type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
Option.iter (fun p -> set_private_row env sdecl.ptype_loc p new_sig_decl)
@@ -1840,7 +1846,6 @@ let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
typ_attributes = sdecl.ptype_attributes;
}
end
- ~post:(fun ttyp -> generalize_decl ttyp.typ_type)
(* A simplified version of [transl_with_constraint], for the case of packages.
Package constraints are much simpler than normal with type constraints (e.g.,
@@ -1860,7 +1865,7 @@ let transl_package_constraint ~loc env ty =
type_attributes = [];
type_immediate = Unknown;
type_unboxed_default = false;
- type_uid = Uid.mk ~current_unit:(Env.get_unit_name ())
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ())
}
in
let new_type_immediate =
@@ -1874,7 +1879,7 @@ let transl_package_constraint ~loc env ty =
let abstract_type_decl ~injective arity =
let rec make_params n =
if n <= 0 then [] else Ctype.newvar() :: make_params (n-1) in
- Ctype.with_local_level ~post:generalize_decl begin fun () ->
+ Ctype.with_local_level_generalize begin fun () ->
{ type_params = make_params arity;
type_arity = arity;
type_kind = Type_abstract Definition;
@@ -1917,7 +1922,7 @@ let check_recmod_typedecl env loc recmod_ids path decl =
(**** Error report ****)
-open Format
+open Format_doc
module Style = Misc.Style
let explain_unbound_gen ppf tv tl typ kwd pr =
@@ -1925,18 +1930,17 @@ let explain_unbound_gen ppf tv tl typ kwd pr =
let ti = List.find (fun ti -> Ctype.deep_occur tv (typ ti)) tl in
let ty0 = (* Hack to force aliasing when needed *)
Btype.newgenty (Tobject(tv, ref None)) in
- Printtyp.prepare_for_printing [typ ti; ty0];
+ Out_type.prepare_for_printing [typ ti; ty0];
fprintf ppf
".@ @[<hov2>In %s@ %a@;<1 -2>the variable %a is unbound@]"
kwd (Style.as_inline_code pr) ti
- (Style.as_inline_code Printtyp.prepared_type_expr) tv
- (* kwd pr ti Printtyp.prepared_type_expr tv *)
+ (Style.as_inline_code Out_type.prepared_type_expr) tv
with Not_found -> ()
let explain_unbound ppf tv tl typ kwd lab =
explain_unbound_gen ppf tv tl typ kwd
(fun ppf ti ->
- fprintf ppf "%s%a" (lab ti) Printtyp.prepared_type_expr (typ ti)
+ fprintf ppf "%s%a" (lab ti) Out_type.prepared_type_expr (typ ti)
)
let explain_unbound_single ppf tv ty =
@@ -1978,7 +1982,7 @@ module Reaching_path = struct
| [] -> []
in simplify path
- (* See Printtyp.add_type_to_preparation.
+ (* See Out_type.add_type_to_preparation.
Note: it is better to call this after [simplify], otherwise some
type variable names may be used for types that are removed
@@ -1987,29 +1991,33 @@ module Reaching_path = struct
let add_to_preparation path =
List.iter (function
| Contains (ty1, ty2) | Expands_to (ty1, ty2) ->
- List.iter Printtyp.add_type_to_preparation [ty1; ty2]
+ List.iter Out_type.add_type_to_preparation [ty1; ty2]
) path
+ module Fmt = Format_doc
+
let pp ppf reaching_path =
let pp_step ppf = function
| Expands_to (ty, body) ->
- Format.fprintf ppf "%a = %a"
- (Style.as_inline_code Printtyp.prepared_type_expr) ty
- (Style.as_inline_code Printtyp.prepared_type_expr) body
+ Fmt.fprintf ppf "%a = %a"
+ (Style.as_inline_code Out_type.prepared_type_expr) ty
+ (Style.as_inline_code Out_type.prepared_type_expr) body
| Contains (outer, inner) ->
- Format.fprintf ppf "%a contains %a"
- (Style.as_inline_code Printtyp.prepared_type_expr) outer
- (Style.as_inline_code Printtyp.prepared_type_expr) inner
+ Fmt.fprintf ppf "%a contains %a"
+ (Style.as_inline_code Out_type.prepared_type_expr) outer
+ (Style.as_inline_code Out_type.prepared_type_expr) inner
in
- let comma ppf () = Format.fprintf ppf ",@ " in
- Format.(pp_print_list ~pp_sep:comma pp_step) ppf reaching_path
+ Fmt.(pp_print_list ~pp_sep:comma) pp_step ppf reaching_path
let pp_colon ppf path =
- Format.fprintf ppf ":@;<1 2>@[<v>%a@]"
- pp path
+ Fmt.fprintf ppf ":@;<1 2>@[<v>%a@]" pp path
end
-let report_error ppf = function
+let quoted_out_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
+let quoted_type ppf ty = Style.as_inline_code Printtyp.Doc.type_expr ppf ty
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
+let report_error_doc ppf = function
| Repeated_parameter ->
fprintf ppf "A type parameter occurs several times"
| Duplicate_constructor s ->
@@ -2023,7 +2031,7 @@ let report_error ppf = function
| Recursive_abbrev (s, env, reaching_path) ->
let reaching_path = Reaching_path.simplify reaching_path in
Printtyp.wrap_printing_env ~error:true env @@ fun () ->
- Printtyp.reset ();
+ Out_type.reset ();
Reaching_path.add_to_preparation reaching_path;
fprintf ppf "@[<v>The type abbreviation %a is cyclic%a@]"
Style.inline_code s
@@ -2031,7 +2039,7 @@ let report_error ppf = function
| Cycle_in_def (s, env, reaching_path) ->
let reaching_path = Reaching_path.simplify reaching_path in
Printtyp.wrap_printing_env ~error:true env @@ fun () ->
- Printtyp.reset ();
+ Out_type.reset ();
Reaching_path.add_to_preparation reaching_path;
fprintf ppf "@[<v>The definition of %a contains a cycle%a@]"
Style.inline_code s
@@ -2039,24 +2047,24 @@ let report_error ppf = function
| Definition_mismatch (ty, _env, None) ->
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]@]"
"This variant or record definition" "does not match that of type"
- (Style.as_inline_code Printtyp.type_expr) ty
+ quoted_type ty
| Definition_mismatch (ty, env, Some err) ->
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]%a@]"
"This variant or record definition" "does not match that of type"
- (Style.as_inline_code Printtyp.type_expr) ty
+ quoted_type ty
(Includecore.report_type_mismatch
"the original" "this" "definition" env)
err
| Constraint_failed (env, err) ->
+ let msg = Format_doc.Doc.msg in
fprintf ppf "@[<v>Constraints are not satisfied in this type.@ ";
- Printtyp.report_unification_error ppf env err
- (fun ppf -> fprintf ppf "Type")
- (fun ppf -> fprintf ppf "should be an instance of");
+ Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "should be an instance of");
fprintf ppf "@]"
| Non_regular { definition; used_as; defined_as; reaching_path } ->
let reaching_path = Reaching_path.simplify reaching_path in
- let pp_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty in
- Printtyp.prepare_for_printing [used_as; defined_as];
+ Out_type.prepare_for_printing [used_as; defined_as];
Reaching_path.add_to_preparation reaching_path;
fprintf ppf
"@[<hv>This recursive type is not regular.@ \
@@ -2065,8 +2073,8 @@ let report_error ppf = function
All uses need to match the definition for the recursive type \
to be regular.@]"
Style.inline_code (Path.name definition)
- pp_type (Printtyp.tree_of_typexp Type defined_as)
- pp_type (Printtyp.tree_of_typexp Type used_as)
+ quoted_out_type (Out_type.tree_of_typexp Type defined_as)
+ quoted_out_type (Out_type.tree_of_typexp Type used_as)
(fun pp ->
let is_expansion = function Expands_to _ -> true | _ -> false in
if List.exists is_expansion reaching_path then
@@ -2074,17 +2082,17 @@ let report_error ppf = function
Reaching_path.pp_colon reaching_path
else fprintf pp ".@ ")
| Inconsistent_constraint (env, err) ->
+ let msg = Format_doc.Doc.msg in
fprintf ppf "@[<v>The type constraints are not consistent.@ ";
- Printtyp.report_unification_error ppf env err
- (fun ppf -> fprintf ppf "Type")
- (fun ppf -> fprintf ppf "is not compatible with type");
+ Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "is not compatible with type");
fprintf ppf "@]"
| Type_clash (env, err) ->
- Printtyp.report_unification_error ppf env err
- (function ppf ->
- fprintf ppf "This type constructor expands to type")
- (function ppf ->
- fprintf ppf "but is used here with type")
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf env err
+ (msg "This type constructor expands to type")
+ (msg "but is used here with type")
| Null_arity_external ->
fprintf ppf "External identifiers must be functions"
| Missing_native_external ->
@@ -2101,8 +2109,8 @@ let report_error ppf = function
)
"case" (fun ppf c ->
fprintf ppf
- "%a of %a" Printtyp.ident c.Types.cd_id
- Printtyp.constructor_arguments c.Types.cd_args)
+ "%a of %a" Printtyp.Doc.ident c.Types.cd_id
+ Printtyp.Doc.constructor_arguments c.Types.cd_args)
| Type_record (tl, _), _ ->
explain_unbound ppf ty tl (fun l -> l.Types.ld_type)
"field" (fun l -> Ident.name l.Types.ld_id ^ ": ")
@@ -2119,11 +2127,11 @@ let report_error ppf = function
| Cannot_extend_private_type path ->
fprintf ppf "@[%s@ %a@]"
"Cannot extend private type definition"
- Printtyp.path path
+ Printtyp.Doc.path path
| Not_extensible_type path ->
fprintf ppf "@[%s@ %a@ %s@]"
"Type definition"
- (Style.as_inline_code Printtyp.path) path
+ (Style.as_inline_code Printtyp.Doc.path) path
"is not extensible"
| Extension_mismatch (path, env, err) ->
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]%a@]"
@@ -2133,24 +2141,23 @@ let report_error ppf = function
"the type" "this extension" "definition" env)
err
| Rebind_wrong_type (lid, env, err) ->
- Printtyp.report_unification_error ppf env err
- (function ppf ->
- fprintf ppf "The constructor %a@ has type"
- (Style.as_inline_code Printtyp.longident) lid)
- (function ppf ->
- fprintf ppf "but was expected to be of type")
+ let msg = Format_doc.doc_printf in
+ Errortrace_report.unification ppf env err
+ (msg "The constructor %a@ has type"
+ quoted_constr lid)
+ (msg "but was expected to be of type")
| Rebind_mismatch (lid, p, p') ->
fprintf ppf
"@[%s@ %a@ %s@ %a@ %s@ %s@ %a@]"
"The constructor"
- (Style.as_inline_code Printtyp.longident) lid
+ quoted_constr lid
"extends type" Style.inline_code (Path.name p)
"whose declaration does not match"
"the declaration of type" Style.inline_code (Path.name p')
| Rebind_private lid ->
fprintf ppf "@[%s@ %a@ %s@]"
"The constructor"
- (Style.as_inline_code Printtyp.longident) lid
+ quoted_constr lid
"is private"
| Variance (Typedecl_variance.Bad_variance (n, v1, v2)) ->
let variance (p,n,i) =
@@ -2163,44 +2170,44 @@ let report_error ppf = function
in
(match n with
| Variance_variable_error { error; variable; context } ->
- Printtyp.prepare_for_printing [ variable ];
+ Out_type.prepare_for_printing [ variable ];
begin match context with
| Type_declaration (id, decl) ->
- Printtyp.add_type_declaration_to_preparation id decl;
+ Out_type.add_type_declaration_to_preparation id decl;
fprintf ppf "@[<v>%s@;<1 2>%a@;"
"In the definition"
- (Style.as_inline_code @@ Printtyp.prepared_type_declaration id)
+ (Style.as_inline_code @@ Out_type.prepared_type_declaration id)
decl
| Gadt_constructor c ->
- Printtyp.add_constructor_to_preparation c;
+ Out_type.add_constructor_to_preparation c;
fprintf ppf "@[<v>%s@;<1 2>%a@;"
"In the GADT constructor"
- (Style.as_inline_code Printtyp.prepared_constructor)
+ (Style.as_inline_code Out_type.prepared_constructor)
c
| Extension_constructor (id, e) ->
- Printtyp.add_extension_constructor_to_preparation e;
+ Out_type.add_extension_constructor_to_preparation e;
fprintf ppf "@[<v>%s@;<1 2>%a@;"
"In the extension constructor"
- (Printtyp.prepared_extension_constructor id)
+ (Out_type.prepared_extension_constructor id)
e
end;
begin match error with
| Variance_not_reflected ->
fprintf ppf "@[%s@ %a@ %s@ %s@ It"
"the type variable"
- (Style.as_inline_code Printtyp.prepared_type_expr) variable
+ (Style.as_inline_code Out_type.prepared_type_expr) variable
"has a variance that"
"is not reflected by its occurrence in type parameters."
| No_variable ->
fprintf ppf "@[%s@ %a@ %s@ %s@]@]"
"the type variable"
- (Style.as_inline_code Printtyp.prepared_type_expr) variable
+ (Style.as_inline_code Out_type.prepared_type_expr) variable
"cannot be deduced"
"from the type parameters."
| Variance_not_deducible ->
fprintf ppf "@[%s@ %a@ %s@ %s@ It"
"the type variable"
- (Style.as_inline_code Printtyp.prepared_type_expr) variable
+ (Style.as_inline_code Out_type.prepared_type_expr) variable
"has a variance that"
"cannot be deduced from the type parameters."
end
@@ -2216,7 +2223,7 @@ let report_error ppf = function
(variance v2) (variance v1))
| Unavailable_type_constructor p ->
fprintf ppf "The definition of type %a@ is unavailable"
- (Style.as_inline_code Printtyp.path) p
+ (Style.as_inline_code Printtyp.Doc.path) p
| Variance Typedecl_variance.Varying_anonymous ->
fprintf ppf "@[%s@ %s@ %s@]"
"In this GADT definition," "the variance of some parameter"
@@ -2268,7 +2275,7 @@ let report_error ppf = function
fprintf ppf "an unnamed existential variable"
| Some str ->
fprintf ppf "the existential variable %a"
- (Style.as_inline_code Pprintast.tyvar) str in
+ (Style.as_inline_code Pprintast.Doc.tyvar) str in
fprintf ppf "@[This type cannot be unboxed because@ \
it might contain both float and non-float values,@ \
depending on the instantiation of %a.@ \
@@ -2282,22 +2289,24 @@ let report_error ppf = function
"@[GADT case syntax cannot be used in a %a block.@]"
Style.inline_code "nonrec"
| Invalid_private_row_declaration ty ->
- let pp_private ppf ty = fprintf ppf "private %a" Printtyp.type_expr ty in
- Format.fprintf ppf
+ let pp_private ppf ty = fprintf ppf "private %a" Printtyp.Doc.type_expr ty in
+ fprintf ppf
"@[<hv>This private row type declaration is invalid.@ \
The type expression on the right-hand side reduces to@;<1 2>%a@ \
which does not have a free row type variable.@]@,\
@[<hv>@[@{<hint>Hint@}: If you intended to define a private \
type abbreviation,@ \
write explicitly@]@;<1 2>%a@]"
- (Style.as_inline_code Printtyp.type_expr) ty
+ (Style.as_inline_code Printtyp.Doc.type_expr) ty
(Style.as_inline_code pp_private) ty
let () =
Location.register_error_of_exn
(function
| Error (loc, err) ->
- Some (Location.error_of_printer ~loc report_error err)
+ Some (Location.error_of_printer ~loc report_error_doc err)
| _ ->
None
)
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/src/ocaml/typing/typedecl.mli b/src/ocaml/typing/typedecl.mli
index 52a3197f74..38c00487ed 100644
--- a/src/ocaml/typing/typedecl.mli
+++ b/src/ocaml/typing/typedecl.mli
@@ -16,8 +16,6 @@
(* Typing of type definitions and primitive definitions *)
open Types
-open Format
-
val transl_type_decl:
Env.t -> Asttypes.rec_flag -> Parsetree.type_declaration list ->
Typedtree.type_declaration list * Env.t * Shape.t list
@@ -111,4 +109,5 @@ type error =
exception Error of Location.t * error
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
diff --git a/src/ocaml/typing/typedecl_separability.ml b/src/ocaml/typing/typedecl_separability.ml
index c8f2f3b171..d1417effaf 100644
--- a/src/ocaml/typing/typedecl_separability.ml
+++ b/src/ocaml/typing/typedecl_separability.ml
@@ -53,7 +53,9 @@ let structure : type_definition -> type_structure = fun def ->
| Type_abstract _ ->
begin match def.type_manifest with
| None -> Abstract
- | Some type_expr -> Synonym type_expr
+ | Some type_expr ->
+ if Msupport.erroneous_type_check type_expr then Abstract else
+ Synonym type_expr
end
| ( Type_record ([{ld_type = ty; _}], Record_unboxed _)
diff --git a/src/ocaml/typing/typedtree.ml b/src/ocaml/typing/typedtree.ml
index 4080b14606..792b04cd54 100644
--- a/src/ocaml/typing/typedtree.ml
+++ b/src/ocaml/typing/typedtree.ml
@@ -105,8 +105,8 @@ and expression_desc =
| Texp_let of rec_flag * value_binding list * expression
| Texp_function of function_param list * function_body
| Texp_apply of expression * (arg_label * expression option) list
- | Texp_match of expression * computation case list * partial
- | Texp_try of expression * value case list
+ | Texp_match of expression * computation case list * value case list * partial
+ | Texp_try of expression * value case list * value case list
| Texp_tuple of expression list
| Texp_construct of
Longident.t loc * constructor_description * expression list
@@ -159,6 +159,7 @@ and meth =
and 'k case =
{
c_lhs: 'k general_pattern;
+ c_cont: Ident.t option;
c_guard: expression option;
c_rhs: expression;
}
diff --git a/src/ocaml/typing/typedtree.mli b/src/ocaml/typing/typedtree.mli
index be0732c8ca..26d39471c8 100644
--- a/src/ocaml/typing/typedtree.mli
+++ b/src/ocaml/typing/typedtree.mli
@@ -217,17 +217,22 @@ and expression_desc =
(Labelled "y", Some (Texp_constant Const_int 3))
])
*)
- | Texp_match of expression * computation case list * partial
+ | Texp_match of expression * computation case list * value case list * partial
(** match E0 with
| P1 -> E1
| P2 | exception P3 -> E2
| exception P4 -> E3
+ | effect P4 k -> E4
[Texp_match (E0, [(P1, E1); (P2 | exception P3, E2);
- (exception P4, E3)], _)]
+ (exception P4, E3)], [(P4, E4)], _)]
*)
- | Texp_try of expression * value case list
- (** try E with P1 -> E1 | ... | PN -> EN *)
+ | Texp_try of expression * value case list * value case list
+ (** try E with
+ | P1 -> E1
+ | effect P2 k -> E2
+ [Texp_try (E, [(P1, E1)], [(P2, E2)])]
+ *)
| Texp_tuple of expression list
(** (E1, ..., EN) *)
| Texp_construct of
@@ -297,6 +302,7 @@ and meth =
and 'k case =
{
c_lhs: 'k general_pattern;
+ c_cont: Ident.t option;
c_guard: expression option;
c_rhs: expression;
}
diff --git a/src/ocaml/typing/typemod.ml b/src/ocaml/typing/typemod.ml
index a5fea9214b..d072a10b58 100644
--- a/src/ocaml/typing/typemod.ml
+++ b/src/ocaml/typing/typemod.ml
@@ -19,7 +19,7 @@ open Path
open Asttypes
open Parsetree
open Types
-open Format
+open Format_doc
module Style = Misc.Style
@@ -76,8 +76,9 @@ type error =
| Badly_formed_signature of string * Typedecl.error
| Cannot_hide_id of hiding_error
| Invalid_type_subst_rhs
- | Unpackable_local_modtype_subst of Path.t
+ | Non_packable_local_modtype_subst of Path.t
| With_cannot_remove_packed_modtype of Path.t * module_type
+ | Cannot_alias of Path.t
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
@@ -240,7 +241,7 @@ let check_type_decl env sg loc id row_id newdecl decl =
| Some fresh_row_id -> Env.add_type ~check:false fresh_row_id newdecl env
in
let env = Env.add_signature sg env in
- Includemod.type_declarations ~mark:Mark_both ~loc env fresh_id newdecl decl;
+ Includemod.type_declarations ~mark:true ~loc env fresh_id newdecl decl;
Typedecl.check_coherence env loc path newdecl
let make_variance p n i =
@@ -273,9 +274,8 @@ let path_is_strict_prefix =
Ident.same ident1 ident2
&& list_is_strict_prefix l1 ~prefix:l2
-let iterator_with_env env =
+let iterator_with_env super env =
let env = ref (lazy env) in
- let super = Btype.type_iterators in
env, { super with
Btype.it_signature = (fun self sg ->
(* add all items to the env before recursing down, to handle recursive
@@ -353,22 +353,9 @@ let check_usage_of_path_of_substituted_item paths ~loc ~lid env super =
);
}
-(* When doing a module type destructive substitution [with module type T = RHS]
- where RHS is not a module type path, we need to check that the module type
- T was not used as a path for a packed module
-*)
-let check_usage_of_module_types ~error ~paths ~loc env super =
- let it_do_type_expr it ty = match get_desc ty with
- | Tpackage (p, _) ->
- begin match List.find_opt (Path.same p) paths with
- | Some p -> raise (Error(loc,Lazy.force !env,error p))
- | _ -> super.Btype.it_do_type_expr it ty
- end
- | _ -> super.Btype.it_do_type_expr it ty in
- { super with Btype.it_do_type_expr }
-
-let do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg =
- let env, iterator = iterator_with_env env in
+let do_check_after_substitution env ~loc ~lid paths sg =
+ with_type_mark begin fun mark ->
+ let env, iterator = iterator_with_env (Btype.type_iterators mark) env in
let last, rest = match List.rev paths with
| [] -> assert false
| last :: rest -> last, rest
@@ -381,19 +368,13 @@ let do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg =
| _ :: _ ->
check_usage_of_path_of_substituted_item rest ~loc ~lid env iterator
in
- let iterator = match unpackable_modtype with
- | None -> iterator
- | Some mty ->
- let error p = With_cannot_remove_packed_modtype(p,mty) in
- check_usage_of_module_types ~error ~paths ~loc env iterator
- in
- iterator.Btype.it_signature iterator sg;
- Btype.(unmark_iterators.it_signature unmark_iterators) sg
+ iterator.Btype.it_signature iterator sg
+ end
-let check_usage_after_substitution env ~loc ~lid paths unpackable_modtype sg =
- match paths, unpackable_modtype with
- | [_], None -> ()
- | _ -> do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg
+let check_usage_after_substitution env ~loc ~lid paths sg =
+ match paths with
+ | [_] -> ()
+ | _ -> do_check_after_substitution env ~loc ~lid paths sg
(* After substitution one also needs to re-check the well-foundedness
of type declarations in recursive modules *)
@@ -422,9 +403,9 @@ let check_well_formed_module env loc context mty =
| _ :: rem ->
check_signature env rem
in
- let env, super = iterator_with_env env in
+ let env, super =
+ iterator_with_env Btype.type_iterators_without_type_expr env in
{ super with
- it_type_expr = (fun _self _ty -> ());
it_signature = (fun self sg ->
let env_before = !env in
let env = lazy (Env.add_signature sg (Lazy.force env_before)) in
@@ -488,7 +469,6 @@ let merge_constraint initial_env loc sg lid constr =
| With_typesubst _ | With_modsubst _ | With_modtypesubst _ -> true
in
let real_ids = ref [] in
- let unpackable_modtype = ref None in
let split_row_id s ghosts =
let srow = s ^ "#row" in
let rec split before = function
@@ -499,6 +479,17 @@ let merge_constraint initial_env loc sg lid constr =
in
split [] ghosts
in
+ let unsafe_signature_subst sub sg =
+ (* This signature will not be used directly, it will always be freshened
+ by the caller. So what we do with the scope doesn't really matter. But
+ making it local makes it unlikely that we will ever use the result of
+ this function unfreshened without issue. *)
+ match Subst.Unsafe.signature Make_local sub sg with
+ | Ok x -> x
+ | Error (Fcm_type_substituted_away (p,mty)) ->
+ let error = With_cannot_remove_packed_modtype(p,mty) in
+ raise (Error(loc,initial_env,error))
+ in
let rec patch_item constr namelist outer_sig_env sg_for_env ~ghosts item =
let return ?(ghosts=ghosts) ~replace_by info =
Some (info, {Signature_group.ghosts; replace_by})
@@ -536,7 +527,7 @@ let merge_constraint initial_env loc sg lid constr =
type_attributes = [];
type_immediate = Unknown;
type_unboxed_default = false;
- type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
and id_row = Ident.create_local (s^"#row") in
let initial_env =
@@ -608,7 +599,7 @@ let merge_constraint initial_env loc sg lid constr =
if not destructive_substitution then
let mtd': modtype_declaration =
{
- mtd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ mtd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
mtd_type = Some mty.mty_type;
mtd_attributes = [];
mtd_loc = loc;
@@ -620,10 +611,6 @@ let merge_constraint initial_env loc sg lid constr =
else begin
let path = Pident id in
real_ids := [path];
- begin match mty.mty_type with
- | Mty_ident _ -> ()
- | mty -> unpackable_modtype := Some mty
- end;
return ~replace_by:None
(Pident id, lid, Some (Twith_modtypesubst mty))
end
@@ -635,7 +622,7 @@ let merge_constraint initial_env loc sg lid constr =
let mty = Mtype.scrape_for_type_of ~remove_aliases sig_env mty in
let md'' = { md' with md_type = mty } in
let newmd = Mtype.strengthen_decl ~aliasable:false sig_env md'' path in
- ignore(Includemod.modtypes ~mark:Mark_both ~loc sig_env
+ ignore(Includemod.modtypes ~mark:true ~loc sig_env
newmd.md_type md.md_type);
return
~replace_by:(Some(Sig_module(id, pres, newmd, rs, priv)))
@@ -645,7 +632,7 @@ let merge_constraint initial_env loc sg lid constr =
let sig_env = Env.add_signature sg_for_env outer_sig_env in
let aliasable = not (Env.is_functor_arg path sig_env) in
ignore
- (Includemod.strengthened_module_decl ~loc ~mark:Mark_both
+ (Includemod.strengthened_module_decl ~loc ~mark:true
~aliasable sig_env md' path md);
real_ids := [Pident id];
return ~replace_by:None
@@ -680,8 +667,7 @@ let merge_constraint initial_env loc sg lid constr =
let names = Longident.flatten lid.txt in
let (tcstr, sg) = merge_signature initial_env sg names in
if destructive_substitution then
- check_usage_after_substitution ~loc ~lid initial_env !real_ids
- !unpackable_modtype sg;
+ check_usage_after_substitution ~loc ~lid initial_env !real_ids sg;
let sg =
match tcstr with
| (_, _, Some (Twith_typesubst tdecl)) ->
@@ -697,37 +683,32 @@ let merge_constraint initial_env loc sg lid constr =
try Env.find_type_by_name lid.txt initial_env
with Not_found -> assert false
in
- fun s path -> Subst.add_type_path path replacement s
+ fun s path -> Subst.Unsafe.add_type_path path replacement s
| None ->
let body = Option.get tdecl.typ_type.type_manifest in
let params = tdecl.typ_type.type_params in
if params_are_constrained params
then raise(Error(loc, initial_env,
With_cannot_remove_constrained_type));
- fun s path -> Subst.add_type_function path ~params ~body s
+ fun s path -> Subst.Unsafe.add_type_function path ~params ~body s
in
let sub = Subst.change_locs Subst.identity loc in
let sub = List.fold_left how_to_extend_subst sub !real_ids in
- (* This signature will not be used directly, it will always be freshened
- by the caller. So what we do with the scope doesn't really matter. But
- making it local makes it unlikely that we will ever use the result of
- this function unfreshened without issue. *)
- Subst.signature Make_local sub sg
+ unsafe_signature_subst sub sg
| (_, _, Some (Twith_modsubst (real_path, _))) ->
let sub = Subst.change_locs Subst.identity loc in
let sub =
List.fold_left
- (fun s path -> Subst.add_module_path path real_path s)
+ (fun s path -> Subst.Unsafe.add_module_path path real_path s)
sub
!real_ids
in
- (* See explanation in the [Twith_typesubst] case above. *)
- Subst.signature Make_local sub sg
+ unsafe_signature_subst sub sg
| (_, _, Some (Twith_modtypesubst tmty)) ->
- let add s p = Subst.add_modtype_path p tmty.mty_type s in
+ let add s p = Subst.Unsafe.add_modtype_path p tmty.mty_type s in
let sub = Subst.change_locs Subst.identity loc in
let sub = List.fold_left add sub !real_ids in
- Subst.signature Make_local sub sg
+ unsafe_signature_subst sub sg
| _ ->
sg
in
@@ -996,8 +977,7 @@ module Signature_names : sig
| `Exported
| `From_open
| `Shadowable of shadowable
- | `Substituted_away of Subst.t
- | `Unpackable_modtype_substituted_away of Ident.t * Subst.t
+ | `Substituted_away of Subst.Unsafe.t
]
val create : unit -> t
@@ -1033,8 +1013,7 @@ end = struct
type info = [
| `From_open
- | `Substituted_away of Subst.t
- | `Unpackable_modtype_substituted_away of Ident.t * Subst.t
+ | `Substituted_away of Subst.Unsafe.t
| bound_info
]
@@ -1043,9 +1022,8 @@ end = struct
| Shadowed_by of Ident.t * Location.t
type to_be_removed = {
- mutable subst: Subst.t;
+ mutable subst: Subst.Unsafe.t;
mutable hide: (Sig_component_kind.t * Location.t * hide_reason) Ident.Map.t;
- mutable unpackable_modtypes: Ident.Set.t;
}
type names_infos = (string, bound_info) Hashtbl.t
@@ -1080,7 +1058,6 @@ end = struct
to_be_removed = {
subst = Subst.identity;
hide = Ident.Map.empty;
- unpackable_modtypes = Ident.Set.empty;
};
}
@@ -1095,15 +1072,20 @@ end = struct
| Class -> names.classes
| Class_type -> names.class_types
+ let check_unsafe_subst loc env: _ result -> _ = function
+ | Ok x -> x
+ | Error (Subst.Unsafe.Fcm_type_substituted_away (p,_)) ->
+ raise (Error (loc, env, Non_packable_local_modtype_subst p))
+
let check cl t loc id (info : info) =
let to_be_removed = t.to_be_removed in
match info with
| `Substituted_away s ->
- to_be_removed.subst <- Subst.compose s to_be_removed.subst;
- | `Unpackable_modtype_substituted_away (id,s) ->
- to_be_removed.subst <- Subst.compose s to_be_removed.subst;
- to_be_removed.unpackable_modtypes <-
- Ident.Set.add id to_be_removed.unpackable_modtypes
+ let subst =
+ check_unsafe_subst loc Env.empty @@
+ Subst.Unsafe.compose s to_be_removed.subst
+ in
+ to_be_removed.subst <- subst;
| `From_open ->
to_be_removed.hide <-
Ident.Map.add id (cl, loc, From_open) to_be_removed.hide
@@ -1173,31 +1155,6 @@ end = struct
thus never appear in includes *)
List.iter (check ?info names loc) (Signature_group.rec_items item.group)
- (*
- Before applying local module type substitutions where the
- right-hand side is not a path, we need to check that those module types
- where never used to pack modules. For instance
- {[
- module type T := sig end
- val x: (module T)
- ]}
- should raise an error.
- *)
- let check_unpackable_modtypes ~loc ~env to_remove component =
- if not (Ident.Set.is_empty to_remove.unpackable_modtypes) then begin
- let iterator =
- let error p = Unpackable_local_modtype_subst p in
- let paths =
- List.map (fun id -> Pident id)
- (Ident.Set.elements to_remove.unpackable_modtypes)
- in
- check_usage_of_module_types ~loc ~error ~paths
- (ref (lazy env)) Btype.type_iterators
- in
- iterator.Btype.it_signature_item iterator component;
- Btype.(unmark_iterators.it_signature_item unmark_iterators) component
- end
-
(* We usually require name uniqueness of signature components (e.g. types,
modules, etc), however in some situation reusing the name is allowed: if
the component is a value or an extension, or if the name is introduced by
@@ -1208,7 +1165,6 @@ end = struct
If some reference cannot be removed, then we error out with
[Cannot_hide_id].
*)
-
let simplify env t sg =
let to_remove = t.to_be_removed in
let ids_to_remove =
@@ -1238,10 +1194,8 @@ end = struct
if to_remove.subst == Subst.identity then
component
else
- begin
- check_unpackable_modtypes ~loc:user_loc ~env to_remove component;
- Subst.signature_item Keep to_remove.subst component
- end
+ check_unsafe_subst user_loc env @@
+ Subst.Unsafe.signature_item Keep to_remove.subst component
in
let component =
match ids_to_remove with
@@ -1356,7 +1310,7 @@ and transl_modtype_aux env smty =
{ md_type = arg.mty_type;
md_attributes = [];
md_loc = param.loc;
- md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
Env.enter_module_declaration ~scope ~arg:true name Mp_present
@@ -1411,8 +1365,7 @@ and transl_with ~loc env remove_aliases (rev_tcstrs,sg) constr =
((path, lid, tcstr) :: rev_tcstrs, sg)
-
-and transl_signature ?(keep_warnings = false) ?(toplevel = false) env sg =
+and transl_signature ?(keep_warnings = false) env sg =
let names = Signature_names.create () in
let rec transl_sig env sg =
match sg with
@@ -1481,7 +1434,7 @@ and transl_signature ?(keep_warnings = false) ?(toplevel = false) env sg =
then raise(Error(loc, env, With_cannot_remove_constrained_type));
let info =
let subst =
- Subst.add_type_function (Pident td.typ_id)
+ Subst.Unsafe.add_type_function (Pident td.typ_id)
~params
~body:(Option.get td.typ_type.type_manifest)
Subst.identity
@@ -1554,14 +1507,17 @@ and transl_signature ?(keep_warnings = false) ?(toplevel = false) env sg =
in
let pres =
match tmty.mty_type with
- | Mty_alias _ -> Mp_absent
+ | Mty_alias p ->
+ if Env.is_functor_arg p env then
+ Msupport.raise_error (Error (pmd.pmd_loc, env, Cannot_alias p));
+ Mp_absent
| _ -> Mp_present
in
let md = {
md_type=tmty.mty_type;
md_attributes=pmd.pmd_attributes;
md_loc=pmd.pmd_loc;
- md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
match pmd.pmd_name.txt with
@@ -1603,7 +1559,7 @@ and transl_signature ?(keep_warnings = false) ?(toplevel = false) env sg =
{ md_type = Mty_alias path;
md_attributes = pms.pms_attributes;
md_loc = pms.pms_loc;
- md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
let pres =
@@ -1685,10 +1641,9 @@ and transl_signature ?(keep_warnings = false) ?(toplevel = false) env sg =
(* parsetree invariant, see Ast_invariants *)
assert false
in
- let subst = Subst.add_modtype mtd.mtd_id mty Subst.identity in
- match mty with
- | Mty_ident _ -> `Substituted_away subst
- | _ -> `Unpackable_modtype_substituted_away (mtd.mtd_id,subst)
+ let subst =
+ Subst.Unsafe.add_modtype mtd.mtd_id mty Subst.identity in
+ `Substituted_away subst
in
Signature_names.check_modtype ~info names pmtd.pmtd_loc mtd.mtd_id;
let (trem, rem, final_env) = transl_sig newenv srem in
@@ -1813,8 +1768,6 @@ and transl_signature ?(keep_warnings = false) ?(toplevel = false) env sg =
end
| Psig_attribute x ->
Builtin_attributes.warning_attribute x;
- if toplevel || not (Warnings.is_active (Misplaced_attribute ""))
- then Builtin_attributes.mark_alert_used x;
let (trem,rem, final_env) = transl_sig env srem in
mksig (Tsig_attribute x) env loc :: trem, rem, final_env
| Psig_extension (ext, _attrs) ->
@@ -1844,7 +1797,7 @@ and transl_modtype_decl_aux env
Types.mtd_type=Option.map (fun t -> t.mty_type) tmty;
mtd_attributes=pmtd_attributes;
mtd_loc=pmtd_loc;
- mtd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ mtd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
let scope = Ctype.create_scope () in
@@ -1903,7 +1856,7 @@ and transl_recmodule_modtypes env sdecls =
let init =
List.map2
(fun id pmd ->
- let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
let md =
{ md_type = approx_modtype approx_env pmd.pmd_type;
md_loc = pmd.pmd_loc;
@@ -2131,7 +2084,7 @@ let check_recmodule_inclusion env bindings =
let coercion, shape =
try
Includemod.modtypes_with_shape ~shape
- ~loc:modl.mod_loc ~mark:Mark_both
+ ~loc:modl.mod_loc ~mark:true
env mty_actual' mty_decl'
with Includemod.Error msg ->
Msupport.raise_error(Error(modl.mod_loc, env, Not_included msg));
@@ -2202,32 +2155,39 @@ and package_constraints env loc mty constrs =
end
let modtype_of_package env loc p fl =
- (* We call Ctype.correct_levels to ensure that the types being added to the
+ (* We call Ctype.duplicate_type to ensure that the types being added to the
module type are at generic_level. *)
let mty =
package_constraints env loc (Mty_ident p)
- (List.map (fun (n, t) -> Longident.flatten n, Ctype.correct_levels t) fl)
+ (List.map (fun (n, t) -> Longident.flatten n, Ctype.duplicate_type t) fl)
in
Subst.modtype Keep Subst.identity mty
let package_subtype env p1 fl1 p2 fl2 =
let mkmty p fl =
let fl =
- List.filter (fun (_n,t) -> Ctype.free_variables t = []) fl in
+ List.filter (fun (_n,t) -> Ctype.closed_type_expr t) fl in
modtype_of_package env Location.none p fl
in
match mkmty p1 fl1, mkmty p2 fl2 with
- | exception Error(_, _, Cannot_scrape_package_type _) -> false
+ | exception Error(_, _, Cannot_scrape_package_type r) ->
+ Result.Error (Errortrace.Package_cannot_scrape r)
| mty1, mty2 ->
let loc = Location.none in
- match Includemod.modtypes ~loc ~mark:Mark_both env mty1 mty2 with
- | Tcoerce_none -> true
- | _ | exception Includemod.Error _ -> false
+ match Includemod.modtypes ~loc ~mark:true env mty1 mty2 with
+ | Tcoerce_none -> Ok ()
+ | c ->
+ let msg =
+ Includemod_errorprinter.coercion_in_package_subtype env mty1 c
+ in
+ Result.Error (Errortrace.Package_coercion msg)
+ | exception Includemod.Error e ->
+ let msg = doc_printf "%a" Includemod_errorprinter.err_msgs e in
+ Result.Error (Errortrace.Package_inclusion msg)
let () = Ctype.package_subtype := package_subtype
let wrap_constraint_package env mark arg mty explicit =
- let mark = if mark then Includemod.Mark_both else Includemod.Mark_neither in
let mty1 = Subst.modtype Keep Subst.identity arg.mod_type in
let mty2 = Subst.modtype Keep Subst.identity mty in
let coercion =
@@ -2245,7 +2205,6 @@ let wrap_constraint_package env mark arg mty explicit =
let wrap_constraint_with_shape env mark arg mty
shape explicit =
- let mark = if mark then Includemod.Mark_both else Includemod.Mark_neither in
let coercion, shape =
try
Includemod.modtypes_with_shape ~shape ~loc:arg.mod_loc env ~mark
@@ -2286,6 +2245,8 @@ let simplify_app_summary app_view = match app_view.arg with
| false, Some p -> Includemod.Error.Named p, mty
| false, None -> Includemod.Error.Anonymous, mty
+let not_principal msg = Warnings.Not_principal (Format_doc.Doc.msg msg)
+
let rec type_module ?(alias=false) sttn funct_body anchor env smod =
(* Merlin: when we start typing a module we don't want to include potential
saved_items from its parent. We backup them before starting and restore them
@@ -2374,7 +2335,7 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
match param.txt with
| None -> None, env, Shape.for_unnamed_functor_param
| Some name ->
- let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
let arg_md =
{ md_type = mty.mty_type;
md_attributes = [];
@@ -2432,21 +2393,21 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
end
| Pmod_unpack sexp ->
let exp =
- Ctype.with_local_level_if_principal
+ Ctype.with_local_level_generalize_structure_if_principal
(fun () -> Typecore.type_exp env sexp)
- ~post:Typecore.generalize_structure_exp
in
let mty =
match get_desc (Ctype.expand_head env exp.exp_type) with
Tpackage (p, fl) ->
- if List.exists (fun (_n, t) -> Ctype.free_variables t <> []) fl then
+ if List.exists (fun (_n, t) -> not (Ctype.closed_type_expr t)) fl
+ then
raise (Error (smod.pmod_loc, env,
Incomplete_packed_module exp.exp_type));
if !Clflags.principal &&
not (Typecore.generalizable (Btype.generic_level-1) exp.exp_type)
then
Location.prerr_warning smod.pmod_loc
- (Warnings.Not_principal "this module unpacking");
+ (not_principal "this module unpacking");
modtype_of_package env smod.pmod_loc p fl
| Tvar _ ->
raise (Typecore.Error
@@ -2561,8 +2522,8 @@ and type_one_application ~ctx:(apply_loc,sfunct,md_f,args)
| { loc = app_loc; attributes = app_attributes;
arg = Some { shape = arg_shape; path = arg_path; arg } } ->
let coercion =
- try Includemod.modtypes
- ~loc:arg.mod_loc ~mark:Mark_both env arg.mod_type mty_param
+ try Includemod.modtypes ~loc:arg.mod_loc ~mark:true env
+ arg.mod_type mty_param
with Includemod.Error _ ->
Msupport.raise_error (apply_error ());
Tcoerce_none
@@ -2597,8 +2558,8 @@ and type_one_application ~ctx:(apply_loc,sfunct,md_f,args)
not sure it's worth the effort. *)
(*
begin match
- Includemod.modtypes
- ~loc:app_loc ~mark:Mark_neither env mty_res nondep_mty
+ Includemod.modtypes ~loc:app_loc ~mark:false env
+ mty_res nondep_mty
with
| Tcoerce_none -> ()
| _ ->
@@ -2808,7 +2769,7 @@ and type_structure ?(toplevel = false) ?(keep_warnings = false) funct_body ancho
| Mty_alias _ -> Mp_absent
| _ -> Mp_present
in
- let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
let md =
{ md_type = enrich_module_type anchor name.txt modl.mod_type env;
md_attributes = attrs;
@@ -2887,6 +2848,8 @@ and type_structure ?(toplevel = false) ?(keep_warnings = false) funct_body ancho
let mty' =
enrich_module_type anchor name.txt modl.mod_type newenv
in
+ Includemod.modtypes_consistency ~loc:modl.mod_loc newenv
+ mty' mty.mty_type;
(id, name, mty, modl, mty', attrs, loc, shape, uid))
decls sbind in
let newenv = (* allow aliasing recursive modules from outside *)
@@ -3033,8 +2996,6 @@ and type_structure ?(toplevel = false) ?(keep_warnings = false) funct_body ancho
raise (Error_forward (Builtin_attributes.error_of_extension ext))
| Pstr_attribute x ->
Builtin_attributes.warning_attribute x;
- if toplevel || not (Warnings.is_active (Misplaced_attribute "")) then
- Builtin_attributes.mark_alert_used x;
Tstr_attribute x, [], shape_map, env
in
let rec type_struct env shape_map sstr =
@@ -3082,7 +3043,7 @@ let merlin_type_structure env str =
str, sg, env
let type_structure = type_structure false None
let merlin_transl_signature env sg = transl_signature ~keep_warnings:true env sg
-let transl_signature ~toplevel env sg = transl_signature ~toplevel env sg
+let transl_signature env sg = transl_signature env sg
(* Normalize types in a signature *)
@@ -3280,8 +3241,8 @@ let type_implementation target initial_env ast =
Typecore.force_delayed_checks ();
let shape = Shape_reduce.local_reduce Env.empty shape in
Printtyp.wrap_printing_env ~error:false initial_env
- (fun () -> fprintf std_formatter "%a@."
- (Printtyp.printed_signature @@ Unit_info.source_file target)
+ Format.(fun () -> fprintf std_formatter "%a@."
+ (Printtyp.printed_signature @@ Unit_info.source_file target)
simple_sg
);
(* gen_annot target (Cmt_format.Implementation str); *)
@@ -3304,7 +3265,7 @@ let type_implementation target initial_env ast =
in
let dclsig = Env.read_signature compiled_intf_file in
let coercion, shape =
- Includemod.compunit initial_env ~mark:Mark_positive
+ Includemod.compunit initial_env ~mark:true
sourcefile sg source_intf
dclsig shape
in
@@ -3325,7 +3286,7 @@ let type_implementation target initial_env ast =
(Location.in_file (Unit_info.source_file target))
Warnings.Missing_mli;
let coercion, shape =
- Includemod.compunit initial_env ~mark:Mark_positive
+ Includemod.compunit initial_env ~mark:true
sourcefile sg "(inferred signature)" simple_sg shape
in
check_nongen_signature finalenv simple_sg;
@@ -3336,8 +3297,8 @@ let type_implementation target initial_env ast =
declarations like "let x = true;; let x = 1;;", because in this
case, the inferred signature contains only the last declaration. *)
let shape = Shape_reduce.local_reduce Env.empty shape in
+ let alerts = Builtin_attributes.alerts_of_str ~mark:true ast in
if not !Clflags.dont_write_files then begin
- let alerts = Builtin_attributes.alerts_of_str ast in
let cmi =
Env.save_signature ~alerts simple_sg (Unit_info.cmi target)
in
@@ -3365,10 +3326,7 @@ let save_signature target tsg initial_env cmi =
(Cmt_format.Interface tsg) initial_env (Some cmi) None
let type_interface env ast =
- transl_signature ~toplevel:true env ast
-
-let transl_signature env ast =
- transl_signature ~toplevel:false env ast
+ transl_signature env ast
(* "Packaging" of several compilation units into one unit
having them as sub-modules. *)
@@ -3397,7 +3355,7 @@ let package_signatures units =
{ md_type=Mty_signature sg;
md_attributes=[];
md_loc=Location.none;
- md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
}
in
Sig_module(newid, Mp_present, md, Trec_not, Exported))
@@ -3439,7 +3397,7 @@ let package_units initial_env objfiles target_cmi =
end;
let dclsig = Env.read_signature target_cmi in
let cc, _shape =
- Includemod.compunit initial_env ~mark:Mark_both
+ Includemod.compunit initial_env ~mark:true
"(obtained by packing)" sg mli dclsig shape
in
Cmt_format.save_cmt (Unit_info.companion_cmt target_cmi)
@@ -3467,9 +3425,7 @@ let package_units initial_env objfiles target_cmi =
(* Error report *)
-
-
-open Printtyp
+open Printtyp.Doc
let report_error ~loc _env = function
Cannot_apply mty ->
@@ -3477,8 +3433,9 @@ let report_error ~loc _env = function
"@[This module is not a functor; it has type@ %a@]"
(Style.as_inline_code modtype) mty
| Not_included errs ->
- let main = Includemod_errorprinter.err_msgs errs in
- Location.errorf ~loc "@[<v>Signature mismatch:@ %t@]" main
+ Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
+ "@[<v>Signature mismatch:@ %a@]"
+ Includemod_errorprinter.err_msgs errs
| Cannot_eliminate_dependency mty ->
Location.errorf ~loc
"@[This functor has type@ %a@ \
@@ -3497,26 +3454,25 @@ let report_error ~loc _env = function
Style.inline_code "with"
(Style.as_inline_code longident) lid
| With_mismatch(lid, explanation) ->
- let main = Includemod_errorprinter.err_msgs explanation in
- Location.errorf ~loc
+ Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
"@[<v>\
@[In this %a constraint, the new definition of %a@ \
does not match its original definition@ \
in the constrained signature:@]@ \
- %t@]"
+ %a@]"
Style.inline_code "with"
- (Style.as_inline_code longident) lid main
+ (Style.as_inline_code longident) lid
+ Includemod_errorprinter.err_msgs explanation
| With_makes_applicative_functor_ill_typed(lid, path, explanation) ->
- let main = Includemod_errorprinter.err_msgs explanation in
- Location.errorf ~loc
+ Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
"@[<v>\
@[This %a constraint on %a makes the applicative functor @ \
type %a ill-typed in the constrained signature:@]@ \
- %t@]"
+ %a@]"
Style.inline_code "with"
(Style.as_inline_code longident) lid
Style.inline_code (Path.name path)
- main
+ Includemod_errorprinter.err_msgs explanation
| With_changes_module_alias(lid, id, path) ->
Location.errorf ~loc
"@[<v>\
@@ -3535,21 +3491,20 @@ let report_error ~loc _env = function
let[@manual.ref "ss:module-type-substitution"] manual_ref =
[ 12; 7; 3 ]
in
- let pp_constraint ppf () =
- Format.fprintf ppf "%s := %a"
- (Path.name p) Printtyp.modtype mty
+ let pp_constraint ppf (p,mty) =
+ fprintf ppf "%s := %a" (Path.name p) modtype mty
in
Location.errorf ~loc
"This %a constraint@ %a@ makes a packed module ill-formed.@ %a"
Style.inline_code "with"
- (Style.as_inline_code pp_constraint) ()
+ (Style.as_inline_code pp_constraint) (p,mty)
Misc.print_see_manual manual_ref
| With_package_manifest (lid, ty) ->
Location.errorf ~loc
"In the constrained signature, type %a is defined to be %a.@ \
Package %a constraints may only be used on abstract types."
(Style.as_inline_code longident) lid
- (Style.as_inline_code Printtyp.type_expr) ty
+ (Style.as_inline_code type_expr) ty
Style.inline_code "with"
| Repeated_name(kind, name) ->
Location.errorf ~loc
@@ -3558,27 +3513,27 @@ let report_error ~loc _env = function
(Sig_component_kind.to_string kind) Style.inline_code name
| Non_generalizable { vars; expression } ->
let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2 ] in
- prepare_for_printing vars;
- add_type_to_preparation expression;
+ Out_type.prepare_for_printing vars;
+ Out_type.add_type_to_preparation expression;
Location.errorf ~loc
"@[The type of this expression,@ %a,@ \
contains the non-generalizable type variable(s): %a.@ %a@]"
- (Style.as_inline_code prepared_type_scheme) expression
+ (Style.as_inline_code Out_type.prepared_type_scheme) expression
(pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
- (Style.as_inline_code prepared_type_scheme)) vars
+ (Style.as_inline_code Out_type.prepared_type_scheme)) vars
Misc.print_see_manual manual_ref
| Non_generalizable_module { vars; mty; item } ->
let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2 ] in
- prepare_for_printing vars;
- add_type_to_preparation item.val_type;
+ Out_type.prepare_for_printing vars;
+ Out_type.add_type_to_preparation item.val_type;
let sub =
[ Location.msg ~loc:item.val_loc
"The type of this value,@ %a,@ \
contains the non-generalizable type variable(s) %a."
- (Style.as_inline_code prepared_type_scheme)
+ (Style.as_inline_code Out_type.prepared_type_scheme)
item.val_type
(pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
- @@ Style.as_inline_code prepared_type_scheme) vars
+ @@ Style.as_inline_code Out_type.prepared_type_scheme) vars
]
in
Location.errorf ~loc ~sub
@@ -3590,11 +3545,11 @@ let report_error ~loc _env = function
Location.errorf ~loc
"@[The interface %a@ declares values, not just types.@ \
An implementation must be provided.@]"
- Location.print_filename intf_name
+ Location.Doc.quoted_filename intf_name
| Interface_not_compiled intf_name ->
Location.errorf ~loc
"@[Could not find the .cmi file for interface@ %a.@]"
- Location.print_filename intf_name
+ Location.Doc.quoted_filename intf_name
| Not_allowed_in_functor_body ->
Location.errorf ~loc
"@[This expression creates fresh types.@ %s@]"
@@ -3623,12 +3578,18 @@ let report_error ~loc _env = function
Location.errorf ~loc
"This is an alias for module %a, which is missing"
(Style.as_inline_code path) p
+ | Cannot_alias p ->
+ Location.errorf ~loc
+ "Functor arguments, such as %a, cannot be aliased"
+ (Style.as_inline_code path) p
| Cannot_scrape_package_type p ->
Location.errorf ~loc
"The type of this packed module refers to %a, which is missing"
(Style.as_inline_code path) p
| Badly_formed_signature (context, err) ->
- Location.errorf ~loc "@[In %s:@ %a@]" context Typedecl.report_error err
+ Location.errorf ~loc "@[In %s:@ %a@]"
+ context
+ Typedecl.report_error_doc err
| Cannot_hide_id Illegal_shadowing
{ shadowed_item_kind; shadowed_item_id; shadowed_item_loc;
shadower_id; user_id; user_kind; user_loc } ->
@@ -3675,7 +3636,7 @@ let report_error ~loc _env = function
| Invalid_type_subst_rhs ->
Location.errorf ~loc "Only type synonyms are allowed on the right of %a"
Style.inline_code ":="
- | Unpackable_local_modtype_subst p ->
+ | Non_packable_local_modtype_subst p ->
let[@manual.ref "ss:module-type-substitution"] manual_ref =
[ 12; 7; 3 ]
in
diff --git a/src/ocaml/typing/typemod.mli b/src/ocaml/typing/typemod.mli
index d88d5b247f..3f0ca86dcd 100644
--- a/src/ocaml/typing/typemod.mli
+++ b/src/ocaml/typing/typemod.mli
@@ -43,8 +43,6 @@ val type_implementation:
Typedtree.implementation
val type_interface:
Env.t -> Parsetree.signature -> Typedtree.signature
-val transl_signature:
- Env.t -> Parsetree.signature -> Typedtree.signature
val check_nongen_signature:
Env.t -> Types.signature -> unit
(*
@@ -135,8 +133,9 @@ type error =
| Badly_formed_signature of string * Typedecl.error
| Cannot_hide_id of hiding_error
| Invalid_type_subst_rhs
- | Unpackable_local_modtype_subst of Path.t
+ | Non_packable_local_modtype_subst of Path.t
| With_cannot_remove_packed_modtype of Path.t * module_type
+ | Cannot_alias of Path.t
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
diff --git a/src/ocaml/typing/typeopt.ml b/src/ocaml/typing/typeopt.ml
index f983c499c7..c154d3b231 100644
--- a/src/ocaml/typing/typeopt.ml
+++ b/src/ocaml/typing/typeopt.ml
@@ -23,7 +23,7 @@ open Lambda
let scrape_ty env ty =
match get_desc ty with
| Tconstr _ ->
- let ty = Ctype.expand_head_opt env (Ctype.correct_levels ty) in
+ let ty = Ctype.expand_head_opt env ty in
begin match get_desc ty with
| Tconstr (p, _, _) ->
begin match Env.find_type p env with
diff --git a/src/ocaml/typing/types.ml b/src/ocaml/typing/types.ml
index bdc2a9e549..a9c8c59d1f 100644
--- a/src/ocaml/typing/types.ml
+++ b/src/ocaml/typing/types.ml
@@ -22,9 +22,13 @@ open Asttypes
type transient_expr =
{ mutable desc: type_desc;
mutable level: int;
- mutable scope: int;
+ mutable scope: scope_field;
id: int }
+and scope_field = int
+ (* bit field: 27 bits for scope (Ident.highest_scope = 100_000_000)
+ and at least 4 marks *)
+
and type_expr = transient_expr
and type_desc =
@@ -51,13 +55,14 @@ and row_desc =
and fixed_explanation =
| Univar of type_expr | Fixed_private | Reified of Path.t | Rigid
and row_field = [`some] row_field_gen
+and row_field_cell = [`some | `none] row_field_gen ref
and _ row_field_gen =
RFpresent : type_expr option -> [> `some] row_field_gen
| RFeither :
{ no_arg: bool;
arg_type: type_expr list;
matched: bool;
- ext: [`some | `none] row_field_gen ref} -> [> `some] row_field_gen
+ ext: row_field_cell} -> [> `some] row_field_gen
| RFabsent : [> `some] row_field_gen
| RFnone : [> `none] row_field_gen
@@ -87,6 +92,8 @@ module TransientTypeOps = struct
let equal t1 t2 = t1 == t2
end
+module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
+
(* *)
module Uid = Shape.Uid
@@ -175,6 +182,7 @@ module Variance = struct
let unknown = 7
let full = single Inv
let covariant = single Pos
+ let contravariant = single Neg
let swap f1 f2 v v' =
set_if (mem f2 v) f1 (set_if (mem f1 v) f2 v')
let conjugate v =
@@ -579,12 +587,48 @@ let repr t =
| _ -> t
+(* scope_field and marks *)
+
+let scope_mask = (1 lsl 27) - 1
+let marks_mask = (-1) lxor scope_mask
+let () = assert (Ident.highest_scope land marks_mask = 0)
+
+type type_mark =
+ | Mark of {mark: int; mutable marked: type_expr list}
+ | Hash of {visited: unit TransientTypeHash.t}
+let type_marks =
+ (* All the bits in marks_mask *)
+ List.init (Sys.int_size - 27) (fun x -> 1 lsl (x + 27))
+let available_marks = Local_store.s_ref type_marks
+let with_type_mark f =
+ match !available_marks with
+ | mark :: rem as old ->
+ available_marks := rem;
+ let mk = Mark {mark; marked = []} in
+ Misc.try_finally (fun () -> f mk) ~always: begin fun () ->
+ available_marks := old;
+ match mk with
+ | Mark {marked} ->
+ (* unmark marked type nodes *)
+ List.iter
+ (fun ty -> ty.scope <- ty.scope land ((-1) lxor mark))
+ marked
+ | Hash _ -> ()
+ end
+ | [] ->
+ (* When marks are exhausted, fall back to using a hash table *)
+ f (Hash {visited = TransientTypeHash.create 1})
+
(* getters for type_expr *)
let get_desc t = (repr t).desc
let get_level t = (repr t).level
-let get_scope t = (repr t).scope
+let get_scope t = (repr t).scope land scope_mask
let get_id t = (repr t).id
+let not_marked_node mark t =
+ match mark with
+ | Mark {mark} -> (repr t).scope land mark = 0
+ | Hash {visited} -> not (TransientTypeHash.mem visited (repr t))
(* transient type_expr *)
@@ -593,12 +637,28 @@ module Transient_expr = struct
let set_desc ty d = ty.desc <- d
let set_stub_desc ty d = assert (ty.desc = Tvar None); ty.desc <- d
let set_level ty lv = ty.level <- lv
- let set_scope ty sc = ty.scope <- sc
+ let get_scope ty = ty.scope land scope_mask
+ let get_marks ty = ty.scope lsr 27
+ let set_scope ty sc =
+ if (sc land marks_mask <> 0) then
+ invalid_arg "Types.Transient_expr.set_scope";
+ ty.scope <- (ty.scope land marks_mask) lor sc
+ let try_mark_node mark ty =
+ match mark with
+ | Mark ({mark} as mk) ->
+ (ty.scope land mark = 0) && (* mark type node when not marked *)
+ (ty.scope <- ty.scope lor mark; mk.marked <- ty :: mk.marked; true)
+ | Hash {visited} ->
+ not (TransientTypeHash.mem visited ty) &&
+ (TransientTypeHash.add visited ty (); true)
let coerce ty = ty
let repr = repr
let type_expr ty = ty
end
+(* setting marks *)
+let try_mark_node mark t = Transient_expr.try_mark_node mark (repr t)
+
(* Comparison for [type_expr]; cannot be used for functors *)
let eq_type t1 t2 = t1 == t2 || repr t1 == repr t2
@@ -725,8 +785,7 @@ let match_row_field ~present ~absent ~either (f : row_field) =
| RFnone -> None
| RFeither _ | RFpresent _ | RFabsent as e -> Some e
in
- either no_arg arg_type matched e
-
+ either no_arg arg_type matched (ext,e)
(**** Some type creators ****)
@@ -734,13 +793,10 @@ let new_id = Local_store.s_ref (-1)
let create_expr = Transient_expr.create
-let newty3 ~level ~scope desc =
+let proto_newty3 ~level ~scope desc =
incr new_id;
create_expr desc ~level ~scope ~id:!new_id
-let newty2 ~level desc =
- newty3 ~level ~scope:Ident.lowest_scope desc
-
(**********************************)
(* Utilities for backtracking *)
(**********************************)
@@ -804,13 +860,16 @@ let set_level ty level =
if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
Transient_expr.set_level ty level
end
+
(* TODO: introduce a guard and rename it to set_higher_scope? *)
let set_scope ty scope =
let ty = repr ty in
- if scope <> ty.scope then begin
- if ty.id <= !last_snapshot then log_change (Cscope (ty, ty.scope));
+ let prev_scope = ty.scope land marks_mask in
+ if scope <> prev_scope then begin
+ if ty.id <= !last_snapshot then log_change (Cscope (ty, prev_scope));
Transient_expr.set_scope ty scope
end
+
let set_univar rty ty =
log_change (Cuniv (rty, !rty)); rty := Some ty
let set_name nm v =
diff --git a/src/ocaml/typing/types.mli b/src/ocaml/typing/types.mli
index d7a782da3e..60a093862b 100644
--- a/src/ocaml/typing/types.mli
+++ b/src/ocaml/typing/types.mli
@@ -221,18 +221,36 @@ val get_level: type_expr -> int
val get_scope: type_expr -> int
val get_id: type_expr -> int
+(** Access to marks. They are stored in the scope field. *)
+type type_mark
+val with_type_mark: (type_mark -> 'a) -> 'a
+ (* run a computation using exclusively an available type mark *)
+
+val not_marked_node: type_mark -> type_expr -> bool
+ (* Return true if a type node is not yet marked *)
+
+val try_mark_node: type_mark -> type_expr -> bool
+ (* Mark a type node if it is not yet marked.
+ Marks will be automatically removed when leaving the
+ scope of [with_type_mark].
+
+ Return false if it was already marked *)
+
(** Transient [type_expr].
Should only be used immediately after [Transient_expr.repr] *)
type transient_expr = private
{ mutable desc: type_desc;
mutable level: int;
- mutable scope: int;
+ mutable scope: scope_field;
id: int }
+and scope_field (* abstract *)
module Transient_expr : sig
(** Operations on [transient_expr] *)
val create: type_desc -> level: int -> scope: int -> id: int -> transient_expr
+ val get_scope: transient_expr -> int
+ val get_marks: transient_expr -> int
val set_desc: transient_expr -> type_desc -> unit
val set_level: transient_expr -> int -> unit
val set_scope: transient_expr -> int -> unit
@@ -244,18 +262,17 @@ module Transient_expr : sig
val set_stub_desc: type_expr -> type_desc -> unit
(** Instantiate a not yet instantiated stub.
Fail if already instantiated. *)
+
+ val try_mark_node: type_mark -> transient_expr -> bool
end
val create_expr: type_desc -> level: int -> scope: int -> id: int -> type_expr
(** Functions and definitions moved from Btype *)
-val newty3: level:int -> scope:int -> type_desc -> type_expr
+val proto_newty3: level:int -> scope:int -> type_desc -> transient_expr
(** Create a type with a fresh id *)
-val newty2: level:int -> type_desc -> type_expr
- (** Create a type with a fresh id and no scope *)
-
module TransientTypeOps : sig
(** Comparisons for functors *)
@@ -265,6 +282,8 @@ module TransientTypeOps : sig
val hash : t -> int
end
+module TransientTypeHash : Hashtbl.S with type key = transient_expr
+
(** Comparisons for [type_expr]; cannot be used for functors *)
val eq_type: type_expr -> type_expr -> bool
@@ -346,12 +365,15 @@ val rf_either_of: type_expr option -> row_field
val eq_row_field_ext: row_field -> row_field -> bool
val changed_row_field_exts: row_field list -> (unit -> unit) -> bool
+type row_field_cell
val match_row_field:
present:(type_expr option -> 'a) ->
absent:(unit -> 'a) ->
- either:(bool -> type_expr list -> bool -> row_field option ->'a) ->
+ either:(bool -> type_expr list -> bool ->
+ row_field_cell * row_field option ->'a) ->
row_field -> 'a
+
(* *)
module Uid = Shape.Uid
@@ -413,6 +435,7 @@ module Variance : sig
val null : t (* no occurrence *)
val full : t (* strictly invariant (all flags) *)
val covariant : t (* strictly covariant (May_pos, Pos and Inj) *)
+ val contravariant : t (* strictly contravariant *)
val unknown : t (* allow everything, guarantee nothing *)
val union : t -> t -> t
val inter : t -> t -> t
diff --git a/src/ocaml/typing/typetexp.ml b/src/ocaml/typing/typetexp.ml
index 78d4fa883d..9d701b529f 100644
--- a/src/ocaml/typing/typetexp.ml
+++ b/src/ocaml/typing/typetexp.ml
@@ -218,7 +218,6 @@ end = struct
promoted vars
let check_poly_univars env loc vars =
- vars |> List.iter (fun (_, p) -> generalize p.univar);
let univars =
vars |> List.map (fun (name, {univar=ty1; _ }) ->
let v = Btype.proxy ty1 in
@@ -350,8 +349,6 @@ let sort_constraints_no_duplicates loc env l =
(* Translation of type expressions *)
-let generalize_ctyp typ = generalize typ.ctyp_type
-
let strict_ident c = (c = '_' || c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z')
let validate_name = function
@@ -533,7 +530,7 @@ and transl_type_aux env ~row_context ~aliased ~policy styp =
ty
with Not_found ->
let t, ty =
- with_local_level_if_principal begin fun () ->
+ with_local_level_generalize_structure_if_principal begin fun () ->
let t = newvar () in
(* Use the whole location, which is used by [Type_mismatch]. *)
TyVarEnv.remember_used alias.txt t styp.ptyp_loc;
@@ -544,7 +541,6 @@ and transl_type_aux env ~row_context ~aliased ~policy styp =
end;
(t, ty)
end
- ~post: (fun (t, _) -> generalize_structure t)
in
let t = instance t in
let px = Btype.proxy t in
@@ -659,14 +655,13 @@ and transl_type_aux env ~row_context ~aliased ~policy styp =
| Ptyp_poly(vars, st) ->
let vars = List.map (fun v -> v.txt) vars in
let new_univars, cty =
- with_local_level begin fun () ->
+ with_local_level_generalize begin fun () ->
let new_univars = TyVarEnv.make_poly_univars vars in
let cty = TyVarEnv.with_univars new_univars begin fun () ->
transl_type env ~policy ~row_context st
end in
(new_univars, cty)
end
- ~post:(fun (_,cty) -> generalize_ctyp cty)
in
let ty = cty.ctyp_type in
let ty_list = TyVarEnv.check_poly_univars env styp.ptyp_loc new_univars in
@@ -776,8 +771,8 @@ let transl_type env policy styp =
transl_type env ~policy ~row_context:[] styp
(* Make the rows "fixed" in this type, to make universal check easier *)
-let rec make_fixed_univars ty =
- if Btype.try_mark_node ty then
+let rec make_fixed_univars mark ty =
+ if try_mark_node mark ty then
begin match get_desc ty with
| Tvariant row ->
let Row {fields; more; name; closed} = row_repr row in
@@ -794,14 +789,13 @@ let rec make_fixed_univars ty =
(Tvariant
(create_row ~fields ~more ~name ~closed
~fixed:(Some (Univar more))));
- Btype.iter_row make_fixed_univars row
+ Btype.iter_row (make_fixed_univars mark) row
| _ ->
- Btype.iter_type_expr make_fixed_univars ty
+ Btype.iter_type_expr (make_fixed_univars mark) ty
end
let make_fixed_univars ty =
- make_fixed_univars ty;
- Btype.unmark_type ty
+ with_type_mark (fun mark -> make_fixed_univars mark ty)
let transl_simple_type env ?univars ~closed styp =
TyVarEnv.reset_locals ?univars ();
@@ -815,7 +809,7 @@ let transl_simple_type_univars env styp =
TyVarEnv.reset_locals ();
let typ, univs =
TyVarEnv.collect_univars begin fun () ->
- with_local_level ~post:generalize_ctyp begin fun () ->
+ with_local_level_generalize begin fun () ->
let policy = TyVarEnv.univars_policy in
let typ = transl_type env policy styp in
TyVarEnv.globalize_used_variables policy env ();
@@ -829,7 +823,7 @@ let transl_simple_type_univars env styp =
let transl_simple_type_delayed env styp =
TyVarEnv.reset_locals ();
let typ, force =
- with_local_level begin fun () ->
+ with_local_level_generalize begin fun () ->
let policy = TyVarEnv.extensible_policy in
let typ = transl_type env policy styp in
make_fixed_univars typ.ctyp_type;
@@ -839,8 +833,6 @@ let transl_simple_type_delayed env styp =
let force = TyVarEnv.globalize_used_variables policy env in
(typ, force)
end
- (* Generalize everything except the variables that were just globalized. *)
- ~post:(fun (typ,_) -> generalize_ctyp typ)
in
(typ, instance typ.ctyp_type, force)
@@ -849,13 +841,12 @@ let transl_type_scheme env styp =
| Ptyp_poly (vars, st) ->
let vars = List.map (fun v -> v.txt) vars in
let univars, typ =
- with_local_level begin fun () ->
+ with_local_level_generalize begin fun () ->
TyVarEnv.reset ();
let univars = TyVarEnv.make_poly_univars vars in
let typ = transl_simple_type env ~univars ~closed:true st in
(univars, typ)
end
- ~post:(fun (_,typ) -> generalize_ctyp typ)
in
let _ = TyVarEnv.instance_poly_univars env styp.ptyp_loc univars in
{ ctyp_desc = Ttyp_poly (vars, typ);
@@ -864,20 +855,20 @@ let transl_type_scheme env styp =
ctyp_loc = styp.ptyp_loc;
ctyp_attributes = styp.ptyp_attributes }
| _ ->
- with_local_level
+ with_local_level_generalize
(fun () -> TyVarEnv.reset (); transl_simple_type env ~closed:false styp)
- ~post:generalize_ctyp
(* Error report *)
-open Format
-open Printtyp
+open Format_doc
+open Printtyp.Doc
module Style = Misc.Style
-let pp_tag ppf t = Format.fprintf ppf "`%s" t
-
+let pp_tag ppf t = fprintf ppf "`%s" t
+let pp_out_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
+let pp_type ppf ty = Style.as_inline_code Printtyp.Doc.type_expr ppf ty
-let report_error env ppf = function
+let report_error_doc env ppf = function
| Unbound_type_variable (name, in_scope_names) ->
fprintf ppf "The type variable %a is unbound in this type declaration.@ %a"
Style.inline_code name
@@ -895,21 +886,19 @@ let report_error env ppf = function
(Style.as_inline_code longident) lid expected provided
| Bound_type_variable name ->
fprintf ppf "Already bound type parameter %a"
- (Style.as_inline_code Pprintast.tyvar) name
+ (Style.as_inline_code Pprintast.Doc.tyvar) name
| Recursive_type ->
fprintf ppf "This type is recursive"
| Type_mismatch trace ->
- Printtyp.report_unification_error ppf Env.empty trace
- (function ppf ->
- fprintf ppf "This type")
- (function ppf ->
- fprintf ppf "should be an instance of type")
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf Env.empty trace
+ (msg "This type")
+ (msg "should be an instance of type")
| Alias_type_mismatch trace ->
- Printtyp.report_unification_error ppf Env.empty trace
- (function ppf ->
- fprintf ppf "This alias is bound to type")
- (function ppf ->
- fprintf ppf "but is used as an instance of type")
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf Env.empty trace
+ (msg "This alias is bound to type")
+ (msg "but is used as an instance of type")
| Present_has_conjunction l ->
fprintf ppf "The present constructor %a has a conjunctive type"
Style.inline_code l
@@ -926,18 +915,17 @@ let report_error env ppf = function
Style.inline_code ">"
(Style.as_inline_code pp_tag) l
| Constructor_mismatch (ty, ty') ->
- let pp_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty in
wrap_printing_env ~error:true env (fun () ->
- Printtyp.prepare_for_printing [ty; ty'];
+ Out_type.prepare_for_printing [ty; ty'];
fprintf ppf "@[<hov>%s %a@ %s@ %a@]"
"This variant type contains a constructor"
- pp_type (tree_of_typexp Type ty)
+ pp_out_type (Out_type.tree_of_typexp Type ty)
"which should be"
- pp_type (tree_of_typexp Type ty'))
+ pp_out_type (Out_type.tree_of_typexp Type ty'))
| Not_a_variant ty ->
fprintf ppf
"@[The type %a@ does not expand to a polymorphic variant type@]"
- (Style.as_inline_code Printtyp.type_expr) ty;
+ pp_type ty;
begin match get_desc ty with
| Tvar (Some s) ->
(* PR#7012: help the user that wrote 'Foo instead of `Foo *)
@@ -956,14 +944,13 @@ let report_error env ppf = function
| Cannot_quantify (name, v) ->
fprintf ppf
"@[<hov>The universal type variable %a cannot be generalized:@ "
- (Style.as_inline_code Pprintast.tyvar) name;
+ (Style.as_inline_code Pprintast.Doc.tyvar) name;
if Btype.is_Tvar v then
fprintf ppf "it escapes its scope"
else if Btype.is_Tunivar v then
fprintf ppf "it is already bound to another variable"
else
- fprintf ppf "it is bound to@ %a"
- (Style.as_inline_code Printtyp.type_expr) v;
+ fprintf ppf "it is bound to@ %a" pp_type v;
fprintf ppf ".@]";
| Multiple_constraints_on_type s ->
fprintf ppf "Multiple constraints for type %a"
@@ -972,8 +959,8 @@ let report_error env ppf = function
wrap_printing_env ~error:true env (fun () ->
fprintf ppf "@[<hov>Method %a has type %a,@ which should be %a@]"
Style.inline_code l
- (Style.as_inline_code Printtyp.type_expr) ty
- (Style.as_inline_code Printtyp.type_expr) ty')
+ pp_type ty
+ pp_type ty')
| Opened_object nm ->
fprintf ppf
"Illegal open object type%a"
@@ -982,15 +969,17 @@ let report_error env ppf = function
| None -> fprintf ppf "") nm
| Not_an_object ty ->
fprintf ppf "@[The type %a@ is not an object type@]"
- (Style.as_inline_code Printtyp.type_expr) ty
+ pp_type ty
let () =
Location.register_error_of_exn
(function
| Error (loc, env, err) ->
- Some (Location.error_of_printer ~loc (report_error env) err)
+ Some (Location.error_of_printer ~loc (report_error_doc env) err)
| Error_forward err ->
Some err
| _ ->
None
)
+
+let report_error = Format_doc.compat1 report_error_doc
diff --git a/src/ocaml/typing/typetexp.mli b/src/ocaml/typing/typetexp.mli
index 34243b1d42..bd03489f32 100644
--- a/src/ocaml/typing/typetexp.mli
+++ b/src/ocaml/typing/typetexp.mli
@@ -95,7 +95,8 @@ type error =
exception Error of Location.t * Env.t * error
-val report_error: Env.t -> Format.formatter -> error -> unit
+val report_error: Env.t -> error Format_doc.format_printer
+val report_error_doc: Env.t -> error Format_doc.printer
(* Support for first-class modules. *)
val transl_modtype_longident: (* from Typemod *)
diff --git a/src/ocaml/typing/untypeast.ml b/src/ocaml/typing/untypeast.ml
index 00a8ab1428..a5e0741ac6 100644
--- a/src/ocaml/typing/untypeast.ml
+++ b/src/ocaml/typing/untypeast.ml
@@ -121,13 +121,13 @@ let rec extract_letop_patterns n pat =
(** Mapping functions. *)
let constant = function
- | Const_char c -> Pconst_char c
- | Const_string (s,loc,d) -> Pconst_string (s,loc,d)
- | Const_int i -> Pconst_integer (Int.to_string i, None)
- | Const_int32 i -> Pconst_integer (Int32.to_string i, Some 'l')
- | Const_int64 i -> Pconst_integer (Int64.to_string i, Some 'L')
- | Const_nativeint i -> Pconst_integer (Nativeint.to_string i, Some 'n')
- | Const_float f -> Pconst_float (f,None)
+ | Const_char c -> Const.char c
+ | Const_string (s,loc,d) -> Const.string ?quotation_delimiter:d ~loc s
+ | Const_int i -> Const.integer (Int.to_string i)
+ | Const_int32 i -> Const.integer ~suffix:'l' (Int32.to_string i)
+ | Const_int64 i -> Const.integer ~suffix:'L' (Int64.to_string i)
+ | Const_nativeint i -> Const.integer ~suffix:'n' (Nativeint.to_string i)
+ | Const_float f -> Const.float f
let attribute sub a = {
attr_name = map_loc sub a.attr_name;
@@ -452,10 +452,32 @@ let expression sub exp =
None -> list
| Some exp -> (label, sub.expr sub exp) :: list
) list [])
- | Texp_match (exp, cases, _) ->
- Pexp_match (sub.expr sub exp, List.map (sub.case sub) cases)
- | Texp_try (exp, cases) ->
- Pexp_try (sub.expr sub exp, List.map (sub.case sub) cases)
+ | Texp_match (exp, cases, eff_cases, _) ->
+ let merged_cases = List.map (sub.case sub) cases
+ @ List.map
+ (fun c ->
+ let uc = sub.case sub c in
+ let pat = { uc.pc_lhs
+ (* XXX KC: The 2nd argument of Ppat_effect is wrong *)
+ with ppat_desc = Ppat_effect (uc.pc_lhs, uc.pc_lhs) }
+ in
+ { uc with pc_lhs = pat })
+ eff_cases
+ in
+ Pexp_match (sub.expr sub exp, merged_cases)
+ | Texp_try (exp, exn_cases, eff_cases) ->
+ let merged_cases = List.map (sub.case sub) exn_cases
+ @ List.map
+ (fun c ->
+ let uc = sub.case sub c in
+ let pat = { uc.pc_lhs
+ (* XXX KC: The 2nd argument of Ppat_effect is wrong *)
+ with ppat_desc = Ppat_effect (uc.pc_lhs, uc.pc_lhs) }
+ in
+ { uc with pc_lhs = pat })
+ eff_cases
+ in
+ Pexp_try (sub.expr sub exp, merged_cases)
| Texp_tuple list ->
Pexp_tuple (List.map (sub.expr sub) list)
| Texp_construct (lid, _, args) ->
diff --git a/src/ocaml/typing/value_rec_check.ml b/src/ocaml/typing/value_rec_check.ml
index eb741e744a..985e42a639 100644
--- a/src/ocaml/typing/value_rec_check.ml
+++ b/src/ocaml/typing/value_rec_check.ml
@@ -154,7 +154,7 @@ let classify_expression : Typedtree.expression -> sd =
(* Note on module presence:
For absent modules (i.e. module aliases), the module being bound
does not have a physical representation, but its size can still be
- derived from the alias itself, so we can re-use the same code as
+ derived from the alias itself, so we can reuse the same code as
for modules that are present. *)
let size = classify_module_expression env mexp in
let env = Ident.add mid size env in
@@ -596,8 +596,8 @@ let rec expression : Typedtree.expression -> term_judg =
value_bindings rec_flag bindings >> expression body
| Texp_letmodule (x, _, _, mexp, e) ->
module_binding (x, mexp) >> expression e
- | Texp_match (e, cases, _) ->
- (*
+ | Texp_match (e, cases, eff_cases, _) ->
+ (* TODO: update comment below for eff_cases
(Gi; mi |- pi -> ei : m)^i
G |- e : sum(mi)^i
----------------------------------------------
@@ -607,7 +607,11 @@ let rec expression : Typedtree.expression -> term_judg =
let pat_envs, pat_modes =
List.split (List.map (fun c -> case c mode) cases) in
let env_e = expression e (List.fold_left Mode.join Ignore pat_modes) in
- Env.join_list (env_e :: pat_envs))
+ let eff_envs, eff_modes =
+ List.split (List.map (fun c -> case c mode) eff_cases) in
+ let eff_e = expression e (List.fold_left Mode.join Ignore eff_modes) in
+ Env.join_list
+ ((Env.join_list (env_e :: pat_envs)) :: (eff_e :: eff_envs)))
| Texp_for (_, _, low, high, _, body) ->
(*
G1 |- low: m[Dereference]
@@ -829,7 +833,7 @@ let rec expression : Typedtree.expression -> term_judg =
modexp mexp
| Texp_object (clsstrct, _) ->
class_structure clsstrct
- | Texp_try (e, cases) ->
+ | Texp_try (e, cases, eff_cases) ->
(*
G |- e: m (Gi; _ |- pi -> ei : m)^i
--------------------------------------------
@@ -843,6 +847,7 @@ let rec expression : Typedtree.expression -> term_judg =
join [
expression e;
list case_env cases;
+ list case_env eff_cases;
]
| Texp_override (pth, fields) ->
(*
diff --git a/src/ocaml/utils/clflags.ml b/src/ocaml/utils/clflags.ml
index f507f58362..f42ff9101a 100644
--- a/src/ocaml/utils/clflags.ml
+++ b/src/ocaml/utils/clflags.ml
@@ -27,7 +27,142 @@ let keep_docs = ref false
let transparent_modules = ref true
let for_package = ref None
let debug = ref false
+let unsafe = ref false
let opaque = ref false
let unboxed_types = ref false
let locations = ref true
+
+let keyword_edition: string option ref = ref None
+
+
+(* This is used by the -save-ir-after option. *)
+module Compiler_ir = struct
+ type t = Linear
+
+ let all = [
+ Linear;
+ ]
+
+ let extension t =
+ let ext =
+ match t with
+ | Linear -> "linear"
+ in
+ ".cmir-" ^ ext
+
+ (** [extract_extension_with_pass filename] returns the IR whose extension
+ is a prefix of the extension of [filename], and the suffix,
+ which can be used to distinguish different passes on the same IR.
+ For example, [extract_extension_with_pass "foo.cmir-linear123"]
+ returns [Some (Linear, "123")]. *)
+ let extract_extension_with_pass filename =
+ let ext = Filename.extension filename in
+ let ext_len = String.length ext in
+ if ext_len <= 0 then None
+ else begin
+ let is_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ s_len <= ext_len && s = String.sub ext 0 s_len
+ in
+ let drop_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ String.sub ext s_len (ext_len - s_len)
+ in
+ let ir = List.find_opt is_prefix all in
+ match ir with
+ | None -> None
+ | Some ir -> Some (ir, drop_prefix ir)
+ end
+end
+
+
+(* This is used by the -stop-after option. *)
+module Compiler_pass = struct
+ (* If you add a new pass, the following must be updated:
+ - the variable `passes` below
+ - the manpages in man/ocaml{c,opt}.m
+ - the manual manual/src/cmds/unified-options.etex
+ *)
+ type t = Parsing | Typing | Lambda | Scheduling | Emit
+
+ let to_string = function
+ | Parsing -> "parsing"
+ | Typing -> "typing"
+ | Lambda -> "lambda"
+ | Scheduling -> "scheduling"
+ | Emit -> "emit"
+
+ let of_string = function
+ | "parsing" -> Some Parsing
+ | "typing" -> Some Typing
+ | "lambda" -> Some Lambda
+ | "scheduling" -> Some Scheduling
+ | "emit" -> Some Emit
+ | _ -> None
+
+ let rank = function
+ | Parsing -> 0
+ | Typing -> 1
+ | Lambda -> 2
+ | Scheduling -> 50
+ | Emit -> 60
+
+ let passes = [
+ Parsing;
+ Typing;
+ Lambda;
+ Scheduling;
+ Emit;
+ ]
+ let is_compilation_pass _ = true
+ let is_native_only = function
+ | Scheduling -> true
+ | Emit -> true
+ | _ -> false
+
+ let enabled is_native t = not (is_native_only t) || is_native
+ let can_save_ir_after = function
+ | Scheduling -> true
+ | _ -> false
+
+ let available_pass_names ~filter ~native =
+ passes
+ |> List.filter (enabled native)
+ |> List.filter filter
+ |> List.map to_string
+
+ let compare a b =
+ compare (rank a) (rank b)
+
+ let to_output_filename t ~prefix =
+ match t with
+ | Scheduling -> prefix ^ Compiler_ir.(extension Linear)
+ | _ -> Misc.fatal_error "Not supported"
+
+ let of_input_filename name =
+ match Compiler_ir.extract_extension_with_pass name with
+ | Some (Linear, _) -> Some Emit
+ | None -> None
+end
+
+let parse_keyword_edition s =
+ let parse_version s =
+ let bad_version () =
+ raise (Arg.Bad "Ill-formed version in keywords flag,\n\
+ the supported format is <major>.<minor>, for example 5.2 .")
+ in
+ if s = "" then None else match String.split_on_char '.' s with
+ | [] | [_] | _ :: _ :: _ :: _ -> bad_version ()
+ | [major;minor] -> match int_of_string_opt major, int_of_string_opt minor with
+ | Some major, Some minor -> Some (major,minor)
+ | _ -> bad_version ()
+ in
+ match String.split_on_char '+' s with
+ | [] -> None, []
+ | [s] -> parse_version s, []
+ | v :: rest -> parse_version v, rest
+
+let stop_after = ref None
diff --git a/src/ocaml/utils/clflags.mli b/src/ocaml/utils/clflags.mli
index 4948f58901..8799cbebc1 100644
--- a/src/ocaml/utils/clflags.mli
+++ b/src/ocaml/utils/clflags.mli
@@ -35,7 +35,27 @@ val keep_docs : bool ref
val transparent_modules : bool ref
val for_package : string option ref
val debug : bool ref
+val unsafe : bool ref
val opaque : bool ref
val unboxed_types : bool ref
val locations : bool ref
+
+val keyword_edition : string option ref
+
+
+module Compiler_pass : sig
+ type t = Parsing | Typing | Lambda | Scheduling | Emit
+ val of_string : string -> t option
+ val to_string : t -> string
+ val is_compilation_pass : t -> bool
+ val available_pass_names : filter:(t -> bool) -> native:bool -> string list
+ val can_save_ir_after : t -> bool
+ val compare : t -> t -> int
+ val to_output_filename: t -> prefix:string -> string
+ val of_input_filename: string -> t option
+end
+
+val parse_keyword_edition: string -> (int*int) option * string list
+
+val stop_after : Compiler_pass.t option ref
diff --git a/src/ocaml/utils/compression.ml b/src/ocaml/utils/compression.ml
new file mode 100644
index 0000000000..384afb3b40
--- /dev/null
+++ b/src/ocaml/utils/compression.ml
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, Collège de France and Inria project Cambium *)
+(* *)
+(* Copyright 2023 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. *)
+(* *)
+(**************************************************************************)
+
+external zstd_initialize: unit -> bool = "caml_zstd_initialize"
+
+let compression_supported = zstd_initialize ()
+
+type [@warning "-unused-constructor"] extern_flags =
+ No_sharing (** Don't preserve sharing *)
+ | Closures (** Send function closures *)
+ | Compat_32 (** Ensure 32-bit compatibility *)
+ | Compression (** Optional compression *)
+
+external to_channel: out_channel -> 'a -> extern_flags list -> unit
+ = "caml_output_value"
+
+let output_value ch v = to_channel ch v [Compression]
+
+let input_value = Stdlib.input_value
diff --git a/src/ocaml/utils/compression.mli b/src/ocaml/utils/compression.mli
new file mode 100644
index 0000000000..bdfb63da77
--- /dev/null
+++ b/src/ocaml/utils/compression.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, Collège de France and Inria project Cambium *)
+(* *)
+(* Copyright 2023 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. *)
+(* *)
+(**************************************************************************)
+
+val output_value : out_channel -> 'a -> unit
+(** [Compression.output_value chan v] writes the representation
+ of [v] on channel [chan].
+ If compression is supported, the marshaled data
+ representing value [v] is compressed before being written to
+ channel [chan].
+ If compression is not supported, this function behaves like
+ {!Stdlib.output_value}. *)
+
+val input_value : in_channel -> 'a
+(** [Compression.input_value chan] reads from channel [chan] the
+ byte representation of a structured value, as produced by
+ [Compression.output_value], and reconstructs and
+ returns the corresponding value.
+ If compression is not supported, this function behaves like
+ {!Stdlib.input_value}. *)
+
+val compression_supported : bool
+(** Reports whether compression is supported. *)
diff --git a/src/ocaml/utils/config.common.ml.in b/src/ocaml/utils/config.common.ml.in
new file mode 100644
index 0000000000..3603fe6c60
--- /dev/null
+++ b/src/ocaml/utils/config.common.ml.in
@@ -0,0 +1,163 @@
+(* @configure_input@ *)
+#3 "utils/config.common.ml.in"
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Portions of the Config module common to both the boot and main compiler. *)
+
+(* The main OCaml version string has moved to ../build-aux/ocaml_version.m4 *)
+let version = Sys.ocaml_version
+
+let standard_library =
+ try
+ Sys.getenv "OCAMLLIB"
+ with Not_found ->
+ try
+ Sys.getenv "CAMLLIB"
+ with Not_found ->
+ standard_library_default
+
+let exec_magic_number = {magic|@EXEC_MAGIC_NUMBER@|magic}
+ (* exec_magic_number is duplicated in runtime/caml/exec.h *)
+and cmi_magic_number = {magic|@CMI_MAGIC_NUMBER@|magic}
+and cmo_magic_number = {magic|@CMO_MAGIC_NUMBER@|magic}
+and cma_magic_number = {magic|@CMA_MAGIC_NUMBER@|magic}
+and cmx_magic_number = {magic|@CMX_MAGIC_NUMBER@|magic}
+and cmxa_magic_number = {magic|@CMXA_MAGIC_NUMBER@|magic}
+and ast_impl_magic_number = {magic|@AST_IMPL_MAGIC_NUMBER@|magic}
+and ast_intf_magic_number = {magic|@AST_INTF_MAGIC_NUMBER@|magic}
+and cmxs_magic_number = {magic|@CMXS_MAGIC_NUMBER@|magic}
+and cmt_magic_number = {magic|@CMT_MAGIC_NUMBER@|magic}
+and linear_magic_number = {magic|@LINEAR_MAGIC_NUMBER@|magic}
+
+let safe_string = true
+let default_safe_string = true
+let naked_pointers = false
+
+let interface_suffix = ref ".mli"
+
+let max_tag = 243
+(* This is normally the same as in obj.ml, but we have to define it
+ separately because it can differ when we're in the middle of a
+ bootstrapping phase. *)
+let lazy_tag = 246
+
+let max_young_wosize = 256
+let stack_threshold = 32 (* see runtime/caml/config.h *)
+let stack_safety_margin = 6
+let default_executable_name =
+ match Sys.os_type with
+ "Unix" -> "a.out"
+ | "Win32" | "Cygwin" -> "camlprog.exe"
+ | _ -> "camlprog"
+type configuration_value =
+ | String of string
+ | Int of int
+ | Bool of bool
+
+let configuration_variables () =
+ let p x v = (x, String v) in
+ let p_int x v = (x, Int v) in
+ let p_bool x v = (x, Bool v) in
+[
+ p "version" version;
+ p "standard_library_default" standard_library_default;
+ p "standard_library" standard_library;
+ p "ccomp_type" ccomp_type;
+ p "c_compiler" c_compiler;
+ p "bytecode_cflags" bytecode_cflags;
+ p "ocamlc_cflags" bytecode_cflags;
+ p "bytecode_cppflags" bytecode_cppflags;
+ p "ocamlc_cppflags" bytecode_cppflags;
+ p "native_cflags" native_cflags;
+ p "ocamlopt_cflags" native_cflags;
+ p "native_cppflags" native_cppflags;
+ p "ocamlopt_cppflags" native_cppflags;
+ p "bytecomp_c_compiler" bytecomp_c_compiler;
+ p "native_c_compiler" native_c_compiler;
+ p "bytecomp_c_libraries" bytecomp_c_libraries;
+ p "native_c_libraries" native_c_libraries;
+ p "native_ldflags" native_ldflags;
+ p "native_pack_linker" native_pack_linker;
+ p_bool "native_compiler" native_compiler;
+ p "architecture" architecture;
+ p "model" model;
+ p_int "int_size" Sys.int_size;
+ p_int "word_size" Sys.word_size;
+ p "system" system;
+ p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
+ p_bool "with_frame_pointers" with_frame_pointers;
+ p "ext_exe" ext_exe;
+ p "ext_obj" ext_obj;
+ p "ext_asm" ext_asm;
+ p "ext_lib" ext_lib;
+ p "ext_dll" ext_dll;
+ p "os_type" Sys.os_type;
+ p "default_executable_name" default_executable_name;
+ p_bool "systhread_supported" systhread_supported;
+ p "host" host;
+ p "target" target;
+ p_bool "flambda" flambda;
+ p_bool "safe_string" safe_string;
+ p_bool "default_safe_string" default_safe_string;
+ p_bool "flat_float_array" flat_float_array;
+ p_bool "function_sections" function_sections;
+ p_bool "afl_instrument" afl_instrument;
+ p_bool "tsan" tsan;
+ p_bool "windows_unicode" windows_unicode;
+ p_bool "supports_shared_libraries" supports_shared_libraries;
+ p_bool "native_dynlink" native_dynlink;
+ p_bool "naked_pointers" naked_pointers;
+
+ p "exec_magic_number" exec_magic_number;
+ p "cmi_magic_number" cmi_magic_number;
+ p "cmo_magic_number" cmo_magic_number;
+ p "cma_magic_number" cma_magic_number;
+ p "cmx_magic_number" cmx_magic_number;
+ p "cmxa_magic_number" cmxa_magic_number;
+ p "ast_impl_magic_number" ast_impl_magic_number;
+ p "ast_intf_magic_number" ast_intf_magic_number;
+ p "cmxs_magic_number" cmxs_magic_number;
+ p "cmt_magic_number" cmt_magic_number;
+ p "linear_magic_number" linear_magic_number;
+]
+
+let print_config_value oc = function
+ | String s ->
+ Printf.fprintf oc "%s" s
+ | Int n ->
+ Printf.fprintf oc "%d" n
+ | Bool p ->
+ Printf.fprintf oc "%B" p
+
+let print_config oc =
+ let print (x, v) =
+ Printf.fprintf oc "%s: %a\n" x print_config_value v in
+ List.iter print (configuration_variables ());
+ flush oc
+
+let config_var x =
+ match List.assoc_opt x (configuration_variables()) with
+ | None -> None
+ | Some v ->
+ let s = match v with
+ | String s -> s
+ | Int n -> Int.to_string n
+ | Bool b -> string_of_bool b
+ in
+ Some s
+
+let merlin = false
diff --git a/src/ocaml/utils/config.fixed.ml b/src/ocaml/utils/config.fixed.ml
new file mode 100644
index 0000000000..25f09e3806
--- /dev/null
+++ b/src/ocaml/utils/config.fixed.ml
@@ -0,0 +1,13 @@
+<<<<<<<
+=======
+let c_output_obj = ""
+let c_has_debug_prefix_map = false
+let as_has_debug_prefix_map = false
+let bytecode_cflags = ""
+let bytecode_cppflags = ""
+let native_cflags = ""
+let native_cppflags = ""
+let bytecomp_c_libraries = ""
+let bytecomp_c_compiler = ""
+let native_c_compiler = c_compiler
+>>>>>>>
diff --git a/src/ocaml/utils/config.generated.ml.in b/src/ocaml/utils/config.generated.ml.in
new file mode 100644
index 0000000000..aa03455409
--- /dev/null
+++ b/src/ocaml/utils/config.generated.ml.in
@@ -0,0 +1,94 @@
+(* @configure_input@ *)
+#2 "utils/config.generated.ml.in"
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* This file is included in config_main.ml during the build rather
+ than compiled on its own *)
+
+let bindir = {@QS@|@ocaml_bindir@|@QS@}
+
+let standard_library_default = {@QS@|@ocaml_libdir@|@QS@}
+
+let ccomp_type = {@QS@|@ccomptype@|@QS@}
+let c_compiler = {@QS@|@CC@|@QS@}
+let c_output_obj = {@QS@|@outputobj@|@QS@}
+let c_has_debug_prefix_map = @cc_has_debug_prefix_map@
+let as_has_debug_prefix_map = @as_has_debug_prefix_map@
+let bytecode_cflags = {@QS@|@bytecode_cflags@|@QS@}
+let bytecode_cppflags = {@QS@|@bytecode_cppflags@|@QS@}
+let native_cflags = {@QS@|@native_cflags@|@QS@}
+let native_cppflags = {@QS@|@native_cppflags@|@QS@}
+
+let bytecomp_c_libraries = {@QS@|@zstd_libs@ @cclibs@|@QS@}
+(* bytecomp_c_compiler and native_c_compiler have been supported for a
+ long time and are retained for backwards compatibility.
+ For programs that don't need compatibility with older OCaml releases
+ the recommended approach is to use the constituent variables
+ c_compiler, {bytecode,native}_c[pp]flags etc. directly.
+*)
+let bytecomp_c_compiler =
+ c_compiler ^ " " ^ bytecode_cflags ^ " " ^ bytecode_cppflags
+let native_c_compiler =
+ c_compiler ^ " " ^ native_cflags ^ " " ^ native_cppflags
+let native_c_libraries = {@QS@|@cclibs@|@QS@}
+let native_ldflags = {@QS@|@native_ldflags@|@QS@}
+let native_pack_linker = {@QS@|@PACKLD@|@QS@}
+let default_rpath = {@QS@|@rpath@|@QS@}
+let mksharedlibrpath = {@QS@|@mksharedlibrpath@|@QS@}
+let ar = {@QS@|@AR@|@QS@}
+let supports_shared_libraries = @supports_shared_libraries@
+let native_dynlink = @natdynlink@
+let mkdll = {@QS@|@mkdll_exp@|@QS@}
+let mkexe = {@QS@|@mkexe_exp@|@QS@}
+let mkmaindll = {@QS@|@mkmaindll_exp@|@QS@}
+
+let flambda = @flambda@
+let with_flambda_invariants = @flambda_invariants@
+let with_cmm_invariants = @cmm_invariants@
+let windows_unicode = @windows_unicode@ != 0
+
+let flat_float_array = @flat_float_array@
+
+let function_sections = @function_sections@
+let afl_instrument = @afl@
+
+let native_compiler = @native_compiler@
+
+let architecture = {@QS@|@arch@|@QS@}
+let model = {@QS@|@model@|@QS@}
+let system = {@QS@|@system@|@QS@}
+
+let asm = {@QS@|@AS@|@QS@}
+let asm_cfi_supported = @asm_cfi_supported@
+let with_frame_pointers = @frame_pointers@
+let reserved_header_bits = @reserved_header_bits@
+
+let ext_exe = {@QS@|@exeext@|@QS@}
+let ext_obj = "." ^ {@QS@|@OBJEXT@|@QS@}
+let ext_asm = "." ^ {@QS@|@S@|@QS@}
+let ext_lib = "." ^ {@QS@|@libext@|@QS@}
+let ext_dll = "." ^ {@QS@|@SO@|@QS@}
+
+let host = {@QS@|@host@|@QS@}
+let target = {@QS@|@target@|@QS@}
+
+let systhread_supported = @systhread_support@
+
+let flexdll_dirs = [@flexdll_dir@]
+
+let ar_supports_response_files = @ar_supports_response_files@
+
+let tsan = @tsan@
diff --git a/src/ocaml/utils/config.ml b/src/ocaml/utils/config.ml
index 0a2c82eec5..0b8242ee1a 100644
--- a/src/ocaml/utils/config.ml
+++ b/src/ocaml/utils/config.ml
@@ -30,30 +30,30 @@ let flambda = false
let ext_obj = ".o_The boot compiler cannot process C objects"
-let exec_magic_number = "Caml1999X034"
+let exec_magic_number = "Caml1999X035"
(* exec_magic_number is duplicated in runtime/caml/exec.h *)
-and cmi_magic_number = "Caml1999I034"
-and cmo_magic_number = "Caml1999O034"
-and cma_magic_number = "Caml1999A034"
+and cmi_magic_number = "Caml1999I035"
+and cmo_magic_number = "Caml1999O035"
+and cma_magic_number = "Caml1999A035"
and cmx_magic_number =
if flambda then
- "Caml1999y034"
+ "Caml1999y035"
else
- "Caml1999Y034"
+ "Caml1999Y035"
and cmxa_magic_number =
if flambda then
- "Caml1999z034"
+ "Caml1999z035"
else
- "Caml1999Z034"
-and ast_impl_magic_number = "Caml1999M034"
-and ast_intf_magic_number = "Caml1999N034"
-and cmxs_magic_number = "Caml1999D034"
-and cmt_magic_number = "Caml1999T034"
-and index_magic_number = "Merl2023I001"
+ "Caml1999Z035"
+and ast_impl_magic_number = "Caml1999M035"
+and ast_intf_magic_number = "Caml1999N035"
+and cmxs_magic_number = "Caml1999D035"
+and cmt_magic_number = "Caml1999T035"
+and index_magic_number = "Merl2023I002"
let interface_suffix = ref ".mli"
+let flat_float_array = true
let max_tag = 245
-let flat_float_array = false
let merlin = true
diff --git a/src/ocaml/utils/config.mli b/src/ocaml/utils/config.mli
index df34aee281..6fab0816bc 100644
--- a/src/ocaml/utils/config.mli
+++ b/src/ocaml/utils/config.mli
@@ -46,13 +46,16 @@ val cmt_magic_number: string
val index_magic_number: string
(* Magic number for index files *)
+
val max_tag: int
(* Biggest tag that can be stored in the header of a regular block. *)
-val flat_float_array: bool
+val flat_float_array : bool
+ (* Whether the compiler and runtime automagically flatten float arrays *)
(**/**)
val merlin : bool
+
(**/**)
diff --git a/src/ocaml/utils/diffing.ml b/src/ocaml/utils/diffing.ml
index 94391803ae..f2c336d9c4 100644
--- a/src/ocaml/utils/diffing.ml
+++ b/src/ocaml/utils/diffing.ml
@@ -42,10 +42,11 @@ let style = function
| Modification -> Misc.Style.[ FG Magenta; Bold]
let prefix ppf (pos, p) =
+ let open Format_doc in
let sty = style p in
- Format.pp_open_stag ppf (Misc.Style.Style sty);
- Format.fprintf ppf "%i. " pos;
- Format.pp_close_stag ppf ()
+ pp_open_stag ppf (Misc.Style.Style sty);
+ fprintf ppf "%i. " pos;
+ pp_close_stag ppf ()
let (let*) = Option.bind
@@ -346,7 +347,22 @@ let compute_inner_cell tbl i j =
compute_proposition (i-1) (j-1) diff
in
let*! newweight, (diff, localstate) =
- select_best_proposition [diag;del;insert]
+ (* The order of propositions is important here:
+ the call [select_best_proposition [P_0, ...; P_n]] keeps the first
+ proposition with minimal weight as the representative path for this
+ weight class at the current matrix position.
+
+ By induction, the representative path for the minimal weight class will
+ be the smallest path according to the reverse lexical order induced by
+ the element order [[P_0;...; P_n]].
+
+ This is why we choose to start with the [Del] case since path ending with
+ [Del+] suffix are likely to correspond to parital application in the
+ functor application case.
+ Similarly, large block of deletions or insertions at the end of the
+ definitions might point toward incomplete definitions.
+ Thus this seems a good overall setting. *)
+ select_best_proposition [del;insert;diag]
in
let state = update diff localstate in
Matrix.set tbl i j ~weight:newweight ~state ~diff:(Some diff)
diff --git a/src/ocaml/utils/diffing.mli b/src/ocaml/utils/diffing.mli
index 7f4d7ced1b..79c51fbbae 100644
--- a/src/ocaml/utils/diffing.mli
+++ b/src/ocaml/utils/diffing.mli
@@ -79,7 +79,7 @@ type change_kind =
| Insertion
| Modification
| Preservation
-val prefix: Format.formatter -> (int * change_kind) -> unit
+val prefix: (int * change_kind) Format_doc.printer
val style: change_kind -> Misc.Style.style list
diff --git a/src/ocaml/utils/diffing_with_keys.ml b/src/ocaml/utils/diffing_with_keys.ml
index 33a03b4da5..c319b03783 100644
--- a/src/ocaml/utils/diffing_with_keys.ml
+++ b/src/ocaml/utils/diffing_with_keys.ml
@@ -37,8 +37,8 @@ let prefix ppf x =
in
let style k ppf inner =
let sty = Diffing.style k in
- Format.pp_open_stag ppf (Misc.Style.Style sty);
- Format.kfprintf (fun ppf -> Format.pp_close_stag ppf () ) ppf inner
+ Format_doc.pp_open_stag ppf (Misc.Style.Style sty);
+ Format_doc.kfprintf (fun ppf -> Format_doc.pp_close_stag ppf () ) ppf inner
in
match x with
| Change (Name {pos; _ } | Type {pos; _})
@@ -53,7 +53,7 @@ let prefix ppf x =
(** To detect [move] and [swaps], we are using the fact that
there are 2-cycles in the graph of name renaming.
- - [Change (x,y,_) is then an edge from
+ - [Change (x,y,_)] is then an edge from
[key_left x] to [key_right y].
- [Insert x] is an edge between the special node epsilon and
[key_left x]
diff --git a/src/ocaml/utils/diffing_with_keys.mli b/src/ocaml/utils/diffing_with_keys.mli
index 2da8268767..94e56fb72e 100644
--- a/src/ocaml/utils/diffing_with_keys.mli
+++ b/src/ocaml/utils/diffing_with_keys.mli
@@ -46,7 +46,7 @@ type ('l,'r,'diff) change =
| Insert of {pos:int; insert:'r}
| Delete of {pos:int; delete:'l}
-val prefix: Format.formatter -> ('l,'r,'diff) change -> unit
+val prefix: ('l,'r,'diff) change Format_doc.printer
module Define(D:Diffing.Defs with type eq := unit): sig
diff --git a/src/ocaml/utils/domainstate.ml.c b/src/ocaml/utils/domainstate.ml.c
new file mode 100644
index 0000000000..6dbae1d07a
--- /dev/null
+++ b/src/ocaml/utils/domainstate.ml.c
@@ -0,0 +1,38 @@
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* 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. */
+/* */
+/**************************************************************************/
+
+#define CAML_CONFIG_H_NO_TYPEDEFS
+#include "config.h"
+let stack_ctx_words = Stack_ctx_words
+
+type t =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+let idx_of_field =
+ let curr = 0 in
+#define DOMAIN_STATE(type, name) \
+ let idx__##name = curr in \
+ let curr = curr + 1 in
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+ let _ = curr in
+ function
+#define DOMAIN_STATE(type, name) \
+ | Domain_##name -> idx__##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
diff --git a/src/ocaml/utils/domainstate.mli.c b/src/ocaml/utils/domainstate.mli.c
new file mode 100644
index 0000000000..66a4750d4c
--- /dev/null
+++ b/src/ocaml/utils/domainstate.mli.c
@@ -0,0 +1,24 @@
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* 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. */
+/* */
+/**************************************************************************/
+
+val stack_ctx_words : int
+
+type t =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+val idx_of_field : t -> int
diff --git a/src/ocaml/utils/linkdeps.ml b/src/ocaml/utils/linkdeps.ml
new file mode 100644
index 0000000000..824c898e0b
--- /dev/null
+++ b/src/ocaml/utils/linkdeps.ml
@@ -0,0 +1,142 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Hugo Heuzard *)
+(* *)
+(* Copyright 2020 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. *)
+(* *)
+(**************************************************************************)
+
+module Style = Misc.Style
+
+type compunit = string
+
+type filename = string
+
+type compunit_and_source = {
+ compunit : compunit;
+ filename : filename;
+}
+
+module Compunit_and_source = struct
+ type t = compunit_and_source
+ module Set = Set.Make(struct type nonrec t = t let compare = compare end)
+end
+
+type refs = Compunit_and_source.Set.t
+
+type t = {
+ complete : bool;
+ missing_compunits : (compunit, refs) Hashtbl.t;
+ provided_compunits : (compunit, filename list) Hashtbl.t;
+ badly_ordered_deps : (Compunit_and_source.t, refs) Hashtbl.t;
+}
+
+type error =
+ | Missing_implementations of (compunit * compunit_and_source list) list
+ | Wrong_link_order of (compunit_and_source * compunit_and_source list) list
+ | Multiple_definitions of (compunit * filename list) list
+
+let create ~complete = {
+ complete;
+ missing_compunits = Hashtbl.create 17;
+ provided_compunits = Hashtbl.create 17;
+ badly_ordered_deps = Hashtbl.create 17;
+}
+
+let required t compunit = Hashtbl.mem t.missing_compunits compunit
+
+let update t k f =
+ let v = Hashtbl.find_opt t k in
+ Hashtbl.replace t k (f v)
+
+let add_required t by (name : string) =
+ let add s =
+ Compunit_and_source.Set.add by
+ (Option.value s ~default:Compunit_and_source.Set.empty) in
+ (try
+ let filename = List.hd (Hashtbl.find t.provided_compunits name) in
+ update t.badly_ordered_deps {compunit = name; filename } add
+ with Not_found -> ());
+ update t.missing_compunits name add
+
+let add t ~filename ~compunit ~provides ~requires =
+ List.iter (add_required t {compunit; filename}) requires;
+ List.iter (fun p ->
+ Hashtbl.remove t.missing_compunits p;
+ let l = Option.value ~default:[]
+ (Hashtbl.find_opt t.provided_compunits p) in
+ Hashtbl.replace t.provided_compunits p (filename :: l)) provides
+
+let check t =
+ let of_seq s =
+ Seq.map (fun (k,v) -> k, Compunit_and_source.Set.elements v) s
+ |> List.of_seq
+ in
+ let missing = of_seq (Hashtbl.to_seq t.missing_compunits) in
+ let badly_ordered_deps = of_seq (Hashtbl.to_seq t.badly_ordered_deps) in
+ let duplicated =
+ Hashtbl.to_seq t.provided_compunits
+ |> Seq.filter (fun (_, files) -> List.compare_length_with files 1 > 0)
+ |> List.of_seq
+ in
+ match duplicated, badly_ordered_deps, missing with
+ | [], [], [] -> None
+ | [], [], l ->
+ if t.complete
+ then Some (Missing_implementations l)
+ else None
+ | [], l, _ ->
+ Some (Wrong_link_order l)
+ | l, _, _ ->
+ Some (Multiple_definitions l)
+
+(* Error report *)
+
+open Format_doc
+
+let print_reference print_fname ppf {compunit; filename} =
+ fprintf ppf "%a (%a)" Style.inline_code compunit print_fname filename
+
+let pp_list_comma f =
+ pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") f
+
+let report_error_doc ~print_filename ppf = function
+ | Missing_implementations l ->
+ let print_modules ppf =
+ List.iter
+ (fun (md, rq) ->
+ fprintf ppf "@ @[<hov 2>%a referenced from %a@]"
+ Style.inline_code md
+ (pp_list_comma (print_reference print_filename)) rq)
+ in
+ fprintf ppf
+ "@[<v 2>No implementation provided for the following modules:%a@]"
+ print_modules l
+ | Wrong_link_order l ->
+ let depends_on ppf (dep, depending) =
+ fprintf ppf "@ @[<hov 2>%a depends on %a@]"
+ (pp_list_comma (print_reference print_filename)) depending
+ (print_reference print_filename) dep
+ in
+ fprintf ppf "@[<hov 2>Wrong link order:%a@]"
+ (pp_list_comma depends_on) l
+ | Multiple_definitions l ->
+ let print ppf (compunit, files) =
+ fprintf ppf
+ "@ @[<hov>Multiple definitions of module %a in files %a@]"
+ Style.inline_code compunit
+ (pp_list_comma (Style.as_inline_code print_filename)) files
+
+ in
+ fprintf ppf "@[<hov 2> Duplicated implementations:%a@]"
+ (pp_list_comma print) l
+
+let report_error ~print_filename =
+ Format_doc.compat (report_error_doc ~print_filename)
diff --git a/src/ocaml/utils/linkdeps.mli b/src/ocaml/utils/linkdeps.mli
new file mode 100644
index 0000000000..070b0e5387
--- /dev/null
+++ b/src/ocaml/utils/linkdeps.mli
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Hugo Heuzard *)
+(* *)
+(* Copyright 2020 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. *)
+(* *)
+(**************************************************************************)
+
+type t
+(** The state of the linking check.
+ It keeps track of compilation units provided and required so far. *)
+
+type compunit = string
+
+type filename = string
+
+val create : complete:bool -> t
+(** [create ~complete] returns an empty state. If [complete] is
+ [true], missing compilation units will be treated as errors. *)
+
+val add : t
+ -> filename:filename -> compunit:compunit
+ -> provides:compunit list -> requires:compunit list -> unit
+(** [add t ~filename ~compunit ~provides ~requires] registers the
+ compilation unit [compunit] found in [filename] to [t].
+ - [provides] are units and sub-units provided by [compunit]
+ - [requires] are units required by [compunit]
+
+ [add] should be called in reverse topological order. *)
+
+val required : t -> compunit -> bool
+(** [required t compunit] returns [true] if [compunit] is a dependency of
+ previously added compilation units. *)
+
+type compunit_and_source = {
+ compunit : compunit;
+ filename : filename;
+}
+
+type error =
+ | Missing_implementations of (compunit * compunit_and_source list) list
+ | Wrong_link_order of (compunit_and_source * compunit_and_source list) list
+ | Multiple_definitions of (compunit * filename list) list
+
+val check : t -> error option
+(** [check t] should be called once all the compilation units to be linked
+ have been added. It returns some error if:
+ - There are some missing implementations
+ and [complete] is [true]
+ - Some implementation appear
+ before their dependencies *)
+
+
+val report_error :
+ print_filename:string Format_doc.printer -> error Format_doc.format_printer
+val report_error_doc :
+ print_filename:string Format_doc.printer -> error Format_doc.printer
diff --git a/src/ocaml/utils/local_store.mli b/src/ocaml/utils/local_store.mli
index 3ea05d5889..545cf71e02 100644
--- a/src/ocaml/utils/local_store.mli
+++ b/src/ocaml/utils/local_store.mli
@@ -14,7 +14,8 @@
(**************************************************************************)
(** This module provides some facilities for creating references (and hash
- tables) which can easily be snapshoted and restored to an arbitrary version.
+ tables) which can easily be snapshotted and restored to an arbitrary
+ version.
It is used throughout the frontend (read: typechecker), to register all
(well, hopefully) the global state. Thus making it easy for tools like
diff --git a/src/ocaml/utils/warnings.ml b/src/ocaml/utils/warnings.ml
index 4eb85d8a9e..d4d3323f94 100644
--- a/src/ocaml/utils/warnings.ml
+++ b/src/ocaml/utils/warnings.ml
@@ -52,7 +52,7 @@ type t =
| Implicit_public_methods of string list (* 15 *)
| Unerasable_optional_argument (* 16 *)
| Undeclared_virtual_method of string (* 17 *)
- | Not_principal of string (* 18 *)
+ | Not_principal of Format_doc.t (* 18 *)
| Non_principal_labels of string (* 19 *)
| Ignored_extra_argument (* 20 *)
| Nonreturning_statement (* 21 *)
@@ -109,6 +109,7 @@ type t =
| Unused_tmc_attribute (* 71 *)
| Tmc_breaks_tailcall (* 72 *)
| Generative_application_expects_unit (* 73 *)
+ | Degraded_to_partial_match (* 74 *)
(* If you remove a warning, leave a hole in the numbering. NEVER change
the numbers of existing warnings.
@@ -190,12 +191,13 @@ let number = function
| Unused_tmc_attribute -> 71
| Tmc_breaks_tailcall -> 72
| Generative_application_expects_unit -> 73
+ | Degraded_to_partial_match -> 74
;;
(* DO NOT REMOVE the ;; above: it is used by
the testsuite/ests/warnings/mnemonics.mll test to determine where
the definition of the number function above ends *)
-let last_warning_number = 73
+let last_warning_number = 74
type description =
{ number : int;
@@ -534,6 +536,11 @@ let descriptions = [
description = "A generative functor is applied to an empty structure \
(struct end) rather than to ().";
since = since 5 1 };
+ { number = 74;
+ names = ["degraded-to-partial-match"];
+ description = "A pattern-matching is compiled as partial \
+ even if it appears to be total.";
+ since = since 5 3 };
]
let name_to_number =
@@ -870,7 +877,7 @@ let parse_options errflag s =
alerts
(* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70"
+let defaults_w = "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70-74"
let defaults_warn_error = "-a"
let default_disabled_alerts = [ "unstable"; "unsynchronized_access" ]
@@ -934,7 +941,9 @@ let message = function
^ String.concat " " l ^ "."
| Unerasable_optional_argument -> "this optional argument cannot be erased."
| Undeclared_virtual_method m -> "the virtual method "^m^" is not declared."
- | Not_principal s -> s^" is not principal."
+ | Not_principal msg ->
+ Format_doc.asprintf "%a is not principal."
+ Format_doc.pp_doc msg
| Non_principal_labels s -> s^" without principality."
| Ignored_extra_argument -> "this argument will not be used by the function."
| Nonreturning_statement ->
@@ -1047,7 +1056,7 @@ let message = function
"Code should not depend on the actual values of\n\
this constructor's arguments. They are only for information\n\
and may change in future versions. %a"
- Misc.print_see_manual ref_manual
+ (Format_doc.compat Misc.print_see_manual) ref_manual
| Unreachable_case ->
"this match case is unreachable.\n\
Consider replacing it with a refutation case '<pat> -> .'"
@@ -1078,7 +1087,7 @@ let message = function
%s.\n\
Only the first match will be used to evaluate the guard expression.\n\
%a"
- vars_explanation Misc.print_see_manual ref_manual
+ vars_explanation (Format_doc.compat Misc.print_see_manual) ref_manual
| No_cmx_file name ->
Printf.sprintf
"no cmx file was found in path for module %s, \
@@ -1103,7 +1112,7 @@ let message = function
| Erroneous_printed_signature s ->
"The printed interface differs from the inferred interface.\n\
The inferred interface contained items which could not be printed\n\
- properly due to name collisions between identifiers."
+ properly due to name collisions between identifiers.\n"
^ s
^ "\nBeware that this warning is purely informational and will not catch\n\
all instances of erroneous printed interface."
@@ -1143,6 +1152,16 @@ let message = function
| Generative_application_expects_unit ->
"A generative functor\n\
should be applied to '()'; using '(struct end)' is deprecated."
+ | Degraded_to_partial_match ->
+ let[@manual.ref "ss:warn74"] ref_manual = [ 13; 5; 5 ] in
+ Format.asprintf
+ "This pattern-matching is compiled \n\
+ as partial, even if it appears to be total. \
+ It may generate a Match_failure\n\
+ exception. This typically occurs due to \
+ complex matches on mutable fields.\n\
+ %a"
+ (Format_doc.compat Misc.print_see_manual) ref_manual
;;
let nerrors = ref 0
diff --git a/src/ocaml/utils/warnings.mli b/src/ocaml/utils/warnings.mli
index bb42eec6ef..b1b3a12f78 100644
--- a/src/ocaml/utils/warnings.mli
+++ b/src/ocaml/utils/warnings.mli
@@ -57,7 +57,7 @@ type t =
| Implicit_public_methods of string list (* 15 *)
| Unerasable_optional_argument (* 16 *)
| Undeclared_virtual_method of string (* 17 *)
- | Not_principal of string (* 18 *)
+ | Not_principal of Format_doc.t (* 18 *)
| Non_principal_labels of string (* 19 *)
| Ignored_extra_argument (* 20 *)
| Nonreturning_statement (* 21 *)
@@ -116,6 +116,7 @@ type t =
| Unused_tmc_attribute (* 71 *)
| Tmc_breaks_tailcall (* 72 *)
| Generative_application_expects_unit (* 73 *)
+ | Degraded_to_partial_match (* 74 *)
type alert = {kind:string; message:string; def:loc; use:loc}
diff --git a/src/utils/.ocamlformat-ignore b/src/utils/.ocamlformat-ignore
index 430454161f..d3ad6b935a 100644
--- a/src/utils/.ocamlformat-ignore
+++ b/src/utils/.ocamlformat-ignore
@@ -1,3 +1,5 @@
+format_doc.ml
+format_doc.mli
misc.ml
misc.mli
stamped_hashtable.ml
diff --git a/src/utils/format_doc.ml b/src/utils/format_doc.ml
new file mode 100644
index 0000000000..97014afd3a
--- /dev/null
+++ b/src/utils/format_doc.ml
@@ -0,0 +1,485 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+module Doc = struct
+
+ type box_type =
+ | H
+ | V
+ | HV
+ | HoV
+ | B
+
+ type stag = Format.stag
+
+ type element =
+ | Text of string
+ | With_size of int
+ | Open_box of { kind: box_type ; indent:int }
+ | Close_box
+ | Open_tag of Format.stag
+ | Close_tag
+ | Open_tbox
+ | Tab_break of { width : int; offset : int }
+ | Set_tab
+ | Close_tbox
+ | Simple_break of { spaces : int; indent: int }
+ | Break of { fits : string * int * string as 'a; breaks : 'a }
+ | Flush of { newline:bool }
+ | Newline
+ | If_newline
+
+ | Deprecated of (Format.formatter -> unit)
+
+ type t = { rev:element list } [@@unboxed]
+
+ let empty = { rev = [] }
+
+ let to_list doc = List.rev doc.rev
+ let add doc x = { rev = x :: doc.rev }
+ let fold f acc doc = List.fold_left f acc (to_list doc)
+ let append left right = { rev = right.rev @ left.rev }
+
+ let format_open_box_gen ppf kind indent =
+ match kind with
+ | H-> Format.pp_open_hbox ppf ()
+ | V -> Format.pp_open_vbox ppf indent
+ | HV -> Format.pp_open_hvbox ppf indent
+ | HoV -> Format.pp_open_hovbox ppf indent
+ | B -> Format.pp_open_box ppf indent
+
+ let interpret_elt ppf = function
+ | Text x -> Format.pp_print_string ppf x
+ | Open_box { kind; indent } -> format_open_box_gen ppf kind indent
+ | Close_box -> Format.pp_close_box ppf ()
+ | Open_tag tag -> Format.pp_open_stag ppf tag
+ | Close_tag -> Format.pp_close_stag ppf ()
+ | Open_tbox -> Format.pp_open_tbox ppf ()
+ | Tab_break {width;offset} -> Format.pp_print_tbreak ppf width offset
+ | Set_tab -> Format.pp_set_tab ppf ()
+ | Close_tbox -> Format.pp_close_tbox ppf ()
+ | Simple_break {spaces;indent} -> Format.pp_print_break ppf spaces indent
+ | Break {fits;breaks} -> Format.pp_print_custom_break ppf ~fits ~breaks
+ | Flush {newline=true} -> Format.pp_print_newline ppf ()
+ | Flush {newline=false} -> Format.pp_print_flush ppf ()
+ | Newline -> Format.pp_force_newline ppf ()
+ | If_newline -> Format.pp_print_if_newline ppf ()
+ | With_size _ -> ()
+ | Deprecated pr -> pr ppf
+
+ let rec interpret ppf = function
+ | [] -> ()
+ | With_size size :: Text text :: l ->
+ Format.pp_print_as ppf size text;
+ interpret ppf l
+ | x :: l ->
+ interpret_elt ppf x;
+ interpret ppf l
+
+ let format ppf doc = interpret ppf (to_list doc)
+
+
+
+ let open_box kind indent doc = add doc (Open_box {kind;indent})
+ let close_box doc = add doc Close_box
+
+ let string s doc = add doc (Text s)
+ let bytes b doc = add doc (Text (Bytes.to_string b))
+ let with_size size doc = add doc (With_size size)
+
+ let int n doc = add doc (Text (string_of_int n))
+ let float f doc = add doc (Text (string_of_float f))
+ let char c doc = add doc (Text (String.make 1 c))
+ let bool c doc = add doc (Text (Bool.to_string c))
+
+ let break ~spaces ~indent doc = add doc (Simple_break {spaces; indent})
+ let space doc = break ~spaces:1 ~indent:0 doc
+ let cut = break ~spaces:0 ~indent:0
+
+ let custom_break ~fits ~breaks doc = add doc (Break {fits;breaks})
+
+ let force_newline doc = add doc Newline
+ let if_newline doc = add doc If_newline
+
+ let flush doc = add doc (Flush {newline=false})
+ let force_stop doc = add doc (Flush {newline=true})
+
+ let open_tbox doc = add doc Open_tbox
+ let set_tab doc = add doc Set_tab
+ let tab_break ~width ~offset doc = add doc (Tab_break {width;offset})
+ let tab doc = tab_break ~width:0 ~offset:0 doc
+ let close_tbox doc = add doc Close_tbox
+
+ let open_tag stag doc = add doc (Open_tag stag)
+ let close_tag doc = add doc Close_tag
+
+ let iter ?(sep=Fun.id) ~iter:iterator elt l doc =
+ let first = ref true in
+ let rdoc = ref doc in
+ let print x =
+ if !first then (first := false; rdoc := elt x !rdoc)
+ else rdoc := !rdoc |> sep |> elt x
+ in
+ iterator print l;
+ !rdoc
+
+ let rec list ?(sep=Fun.id) elt l doc = match l with
+ | [] -> doc
+ | [a] -> elt a doc
+ | a :: ((_ :: _) as q) ->
+ doc |> elt a |> sep |> list ~sep elt q
+
+ let array ?sep elt a doc = iter ?sep ~iter:Array.iter elt a doc
+ let seq ?sep elt s doc = iter ?sep ~iter:Seq.iter elt s doc
+
+ let option ?(none=Fun.id) elt o doc = match o with
+ | None -> none doc
+ | Some x -> elt x doc
+
+ let either ~left ~right x doc = match x with
+ | Either.Left x -> left x doc
+ | Either.Right x -> right x doc
+
+ let result ~ok ~error x doc = match x with
+ | Ok x -> ok x doc
+ | Error x -> error x doc
+
+ (* To format free-flowing text *)
+ let rec subtext len left right s doc =
+ let flush doc =
+ doc |> string (String.sub s left (right - left))
+ in
+ let after_flush doc = subtext len (right+1) (right+1) s doc in
+ if right = len then
+ if left <> len then flush doc else doc
+ else
+ match s.[right] with
+ | '\n' ->
+ doc |> flush |> force_newline |> after_flush
+ | ' ' ->
+ doc |> flush |> space |> after_flush
+ (* there is no specific support for '\t'
+ as it is unclear what a right semantics would be *)
+ | _ -> subtext len left (right + 1) s doc
+
+ let text s doc =
+ subtext (String.length s) 0 0 s doc
+
+ type ('a,'b) fmt = ('a, t, t, 'b) format4
+ type printer0 = t -> t
+ type 'a printer = 'a -> printer0
+
+ let output_formatting_lit fmting_lit doc =
+ let open CamlinternalFormatBasics in
+ match fmting_lit with
+ | Close_box -> close_box doc
+ | Close_tag -> close_tag doc
+ | Break (_, width, offset) -> break ~spaces:width ~indent:offset doc
+ | FFlush -> flush doc
+ | Force_newline -> force_newline doc
+ | Flush_newline -> force_stop doc
+ | Magic_size (_, n) -> with_size n doc
+ | Escaped_at -> char '@' doc
+ | Escaped_percent -> char '%' doc
+ | Scan_indic c -> doc |> char '@' |> char c
+
+ let to_string doc =
+ let b = Buffer.create 20 in
+ let convert = function
+ | Text s -> Buffer.add_string b s
+ | _ -> ()
+ in
+ fold (fun () x -> convert x) () doc;
+ Buffer.contents b
+
+ let box_type =
+ let open CamlinternalFormatBasics in
+ function
+ | Pp_fits -> H
+ | Pp_hbox -> H
+ | Pp_vbox -> V
+ | Pp_hovbox -> HoV
+ | Pp_hvbox -> HV
+ | Pp_box -> B
+
+ let rec compose_acc acc doc =
+ let open CamlinternalFormat in
+ match acc with
+ | CamlinternalFormat.Acc_formatting_lit (p, f) ->
+ doc |> compose_acc p |> output_formatting_lit f
+ | Acc_formatting_gen (p, Acc_open_tag acc') ->
+ let tag = to_string (compose_acc acc' empty) in
+ let doc = compose_acc p doc in
+ doc |> open_tag (Format.String_tag tag)
+ | Acc_formatting_gen (p, Acc_open_box acc') ->
+ let doc = compose_acc p doc in
+ let box = to_string (compose_acc acc' empty) in
+ let (indent, bty) = CamlinternalFormat.open_box_of_string box in
+ doc |> open_box (box_type bty) indent
+ | Acc_string_literal (p, s)
+ | Acc_data_string (p, s) ->
+ doc |> compose_acc p |> string s
+ | Acc_char_literal (p, c)
+ | Acc_data_char (p, c) -> doc |> compose_acc p |> char c
+ | Acc_delay (p, f) -> doc |> compose_acc p |> f
+ | Acc_flush p -> doc |> compose_acc p |> flush
+ | Acc_invalid_arg (_p, msg) -> invalid_arg msg;
+ | End_of_acc -> doc
+
+ let kprintf k (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc doc -> doc |> compose_acc acc |> k )
+ End_of_acc fmt
+
+ let printf doc = kprintf Fun.id doc
+ let kmsg k (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc -> k (compose_acc acc empty))
+ End_of_acc fmt
+
+ let msg fmt = kmsg Fun.id fmt
+
+end
+
+(** Compatibility interface *)
+
+type doc = Doc.t
+type t = doc
+type formatter = doc ref
+type 'a printer = formatter -> 'a -> unit
+
+let formatter d = d
+
+(** {1 Primitive functions }*)
+
+let pp_print_string ppf s = ppf := Doc.string s !ppf
+
+let pp_print_as ppf size s =
+ ppf := !ppf |> Doc.with_size size |> Doc.string s
+
+let pp_print_substring ~pos ~len ppf s =
+ ppf := Doc.string (String.sub s pos len) !ppf
+
+let pp_print_substring_as ~pos ~len ppf size s =
+ ppf :=
+ !ppf
+ |> Doc.with_size size
+ |> Doc.string (String.sub s pos len)
+
+let pp_print_bytes ppf s = ppf := Doc.string (Bytes.to_string s) !ppf
+let pp_print_text ppf s = ppf := Doc.text s !ppf
+let pp_print_char ppf c = ppf := Doc.char c !ppf
+let pp_print_int ppf c = ppf := Doc.int c !ppf
+let pp_print_float ppf f = ppf := Doc.float f !ppf
+let pp_print_bool ppf b = ppf := Doc.bool b !ppf
+let pp_print_nothing _ _ = ()
+
+let pp_close_box ppf () = ppf := Doc.close_box !ppf
+let pp_close_stag ppf () = ppf := Doc.close_tag !ppf
+
+let pp_print_break ppf spaces indent = ppf := Doc.break ~spaces ~indent !ppf
+
+let pp_print_custom_break ppf ~fits ~breaks =
+ ppf := Doc.custom_break ~fits ~breaks !ppf
+
+let pp_print_space ppf () = pp_print_break ppf 1 0
+let pp_print_cut ppf () = pp_print_break ppf 0 0
+
+let pp_print_flush ppf () = ppf := Doc.flush !ppf
+let pp_force_newline ppf () = ppf := Doc.force_newline !ppf
+let pp_print_newline ppf () = ppf := Doc.force_stop !ppf
+let pp_print_if_newline ppf () =ppf := Doc.if_newline !ppf
+
+let pp_open_stag ppf stag = ppf := !ppf |> Doc.open_tag stag
+
+let pp_open_box_gen ppf indent bxty =
+ let box_type = Doc.box_type bxty in
+ ppf := !ppf |> Doc.open_box box_type indent
+
+let pp_open_box ppf indent = pp_open_box_gen ppf indent Pp_box
+
+
+let pp_open_tbox ppf () = ppf := !ppf |> Doc.open_tbox
+
+let pp_close_tbox ppf () = ppf := !ppf |> Doc.close_tbox
+
+let pp_set_tab ppf () = ppf := !ppf |> Doc.set_tab
+
+let pp_print_tab ppf () = ppf := !ppf |> Doc.tab
+
+let pp_print_tbreak ppf width offset =
+ ppf := !ppf |> Doc.tab_break ~width ~offset
+
+let pp_doc ppf doc = ppf := Doc.append !ppf doc
+
+module Driver = struct
+ (* Interpret a formatting entity on a formatter. *)
+ let output_formatting_lit ppf
+ (fmting_lit:CamlinternalFormatBasics.formatting_lit)
+ = match fmting_lit with
+ | Close_box -> pp_close_box ppf ()
+ | Close_tag -> pp_close_stag ppf ()
+ | Break (_, width, offset) -> pp_print_break ppf width offset
+ | FFlush -> pp_print_flush ppf ()
+ | Force_newline -> pp_force_newline ppf ()
+ | Flush_newline -> pp_print_newline ppf ()
+ | Magic_size (_, _) -> ()
+ | Escaped_at -> pp_print_char ppf '@'
+ | Escaped_percent -> pp_print_char ppf '%'
+ | Scan_indic c -> pp_print_char ppf '@'; pp_print_char ppf c
+
+
+
+ let compute_tag output tag_acc =
+ let buf = Buffer.create 16 in
+ let buf_fmt = Format.formatter_of_buffer buf in
+ let ppf = ref Doc.empty in
+ output ppf tag_acc;
+ pp_print_flush ppf ();
+ Doc.format buf_fmt !ppf;
+ let len = Buffer.length buf in
+ if len < 2 then Buffer.contents buf
+ else Buffer.sub buf 1 (len - 2)
+
+ (* Recursively output an "accumulator" containing a reversed list of
+ printing entities (string, char, flus, ...) in an output_stream. *)
+ (* Differ from Printf.output_acc by the interpretation of formatting. *)
+ (* Used as a continuation of CamlinternalFormat.make_printf. *)
+ let rec output_acc ppf (acc: _ CamlinternalFormat.acc) =
+ match acc with
+ | Acc_string_literal (Acc_formatting_lit (p, Magic_size (_, size)), s)
+ | Acc_data_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
+ output_acc ppf p;
+ pp_print_as ppf size s;
+ | Acc_char_literal (Acc_formatting_lit (p, Magic_size (_, size)), c)
+ | Acc_data_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
+ output_acc ppf p;
+ pp_print_as ppf size (String.make 1 c);
+ | Acc_formatting_lit (p, f) ->
+ output_acc ppf p;
+ output_formatting_lit ppf f;
+ | Acc_formatting_gen (p, Acc_open_tag acc') ->
+ output_acc ppf p;
+ pp_open_stag ppf (Format.String_tag (compute_tag output_acc acc'))
+ | Acc_formatting_gen (p, Acc_open_box acc') ->
+ output_acc ppf p;
+ let (indent, bty) =
+ let box_info = compute_tag output_acc acc' in
+ CamlinternalFormat.open_box_of_string box_info
+ in
+ pp_open_box_gen ppf indent bty
+ | Acc_string_literal (p, s)
+ | Acc_data_string (p, s) -> output_acc ppf p; pp_print_string ppf s;
+ | Acc_char_literal (p, c)
+ | Acc_data_char (p, c) -> output_acc ppf p; pp_print_char ppf c;
+ | Acc_delay (p, f) -> output_acc ppf p; f ppf;
+ | Acc_flush p -> output_acc ppf p; pp_print_flush ppf ();
+ | Acc_invalid_arg (p, msg) -> output_acc ppf p; invalid_arg msg;
+ | End_of_acc -> ()
+end
+
+let kfprintf k ppf (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc -> Driver.output_acc ppf acc; k ppf)
+ End_of_acc fmt
+let fprintf doc fmt = kfprintf ignore doc fmt
+
+
+let kdprintf k (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc -> k (fun ppf -> Driver.output_acc ppf acc))
+ End_of_acc fmt
+
+let dprintf fmt = kdprintf (fun i -> i) fmt
+
+let doc_printf fmt =
+ let ppf = ref Doc.empty in
+ kfprintf (fun _ -> let doc = !ppf in ppf := Doc.empty; doc) ppf fmt
+
+let kdoc_printf k fmt =
+ let ppf = ref Doc.empty in
+ kfprintf (fun ppf ->
+ let doc = !ppf in
+ ppf := Doc.empty;
+ k doc
+ )
+ ppf fmt
+
+let doc_printer f x doc =
+ let r = ref doc in
+ f r x;
+ !r
+
+type 'a format_printer = Format.formatter -> 'a -> unit
+
+let format_printer f ppf x =
+ let doc = doc_printer f x Doc.empty in
+ Doc.format ppf doc
+let compat = format_printer
+let compat1 f p1 = compat (f p1)
+let compat2 f p1 p2 = compat (f p1 p2)
+
+let kasprintf k fmt =
+ kdoc_printf (fun doc -> k (Format.asprintf "%a" Doc.format doc)) fmt
+let asprintf fmt = kasprintf Fun.id fmt
+
+let pp_print_iter ?(pp_sep=pp_print_cut) iter elt ppf c =
+ let sep = doc_printer pp_sep () in
+ ppf:= Doc.iter ~sep ~iter (doc_printer elt) c !ppf
+
+let pp_print_list ?(pp_sep=pp_print_cut) elt ppf l =
+ ppf := Doc.list ~sep:(doc_printer pp_sep ()) (doc_printer elt) l !ppf
+
+let pp_print_array ?pp_sep elt ppf a =
+ pp_print_iter ?pp_sep Array.iter elt ppf a
+let pp_print_seq ?pp_sep elt ppf s = pp_print_iter ?pp_sep Seq.iter elt ppf s
+
+let pp_print_option ?(none=fun _ () -> ()) elt ppf o =
+ ppf := Doc.option ~none:(doc_printer none ()) (doc_printer elt) o !ppf
+
+let pp_print_result ~ok ~error ppf r =
+ ppf := Doc.result ~ok:(doc_printer ok) ~error:(doc_printer error) r !ppf
+
+let pp_print_either ~left ~right ppf e =
+ ppf := Doc.either ~left:(doc_printer left) ~right:(doc_printer right) e !ppf
+
+let comma ppf () = fprintf ppf ",@ "
+
+let pp_two_columns ?(sep = "|") ?max_lines ppf (lines: (string * string) list) =
+ let left_column_size =
+ List.fold_left (fun acc (s, _) -> Int.max acc (String.length s)) 0 lines in
+ let lines_nb = List.length lines in
+ let ellipsed_first, ellipsed_last =
+ match max_lines with
+ | Some max_lines when lines_nb > max_lines ->
+ let printed_lines = max_lines - 1 in (* the ellipsis uses one line *)
+ let lines_before = printed_lines / 2 + printed_lines mod 2 in
+ let lines_after = printed_lines / 2 in
+ (lines_before, lines_nb - lines_after - 1)
+ | _ -> (-1, -1)
+ in
+ fprintf ppf "@[<v>";
+ List.iteri (fun k (line_l, line_r) ->
+ if k = ellipsed_first then fprintf ppf "...@,";
+ if ellipsed_first <= k && k <= ellipsed_last then ()
+ else fprintf ppf "%*s %s %s@," left_column_size line_l sep line_r
+ ) lines;
+ fprintf ppf "@]"
+
+let deprecated_printer pr ppf = ppf := Doc.add !ppf (Doc.Deprecated pr)
+let deprecated pr ppf x =
+ ppf := Doc.add !ppf (Doc.Deprecated (fun ppf -> pr ppf x))
+let deprecated1 pr p1 ppf x =
+ ppf := Doc.add !ppf (Doc.Deprecated (fun ppf -> pr p1 ppf x))
diff --git a/src/utils/format_doc.mli b/src/utils/format_doc.mli
new file mode 100644
index 0000000000..bf36829add
--- /dev/null
+++ b/src/utils/format_doc.mli
@@ -0,0 +1,299 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+(** Composable document for the {!Format} formatting engine. *)
+
+(** This module introduces a pure and immutable document type which represents a
+ sequence of formatting instructions to be printed by a formatting engine at
+ later point. At the same time, it also provides format string interpreter
+ which produces this document type from format string and their associated
+ printers.
+
+ The module is designed to be source compatible with code defining format
+ printers: replacing `Format` by `Format_doc` in your code will convert
+ `Format` printers to `Format_doc` printers.
+*)
+
+(** Definitions and immutable API for composing documents *)
+module Doc: sig
+
+ (** {2 Type definitions and core functions }*)
+
+ (** Format box types *)
+ type box_type =
+ | H
+ | V
+ | HV
+ | HoV
+ | B
+
+ type stag = Format.stag
+
+ (** Base formatting instruction recognized by {!Format} *)
+ type element =
+ | Text of string
+ | With_size of int
+ | Open_box of { kind: box_type ; indent:int }
+ | Close_box
+ | Open_tag of Format.stag
+ | Close_tag
+ | Open_tbox
+ | Tab_break of { width : int; offset : int }
+ | Set_tab
+ | Close_tbox
+ | Simple_break of { spaces : int; indent : int }
+ | Break of { fits : string * int * string as 'a; breaks : 'a }
+ | Flush of { newline:bool }
+ | Newline
+ | If_newline
+
+ | Deprecated of (Format.formatter -> unit)
+ (** Escape hatch: a {!Format} printer used to provide backward-compatibility
+ for user-defined printer (from the [#install_printer] toplevel directive
+ for instance). *)
+
+ (** Immutable document type*)
+ type t
+
+ type ('a,'b) fmt = ('a, t, t,'b) format4
+
+ type printer0 = t -> t
+ type 'a printer = 'a -> printer0
+
+
+ (** Empty document *)
+ val empty: t
+
+ (** [format ppf doc] sends the format instruction of [doc] to the Format's
+ formatter [doc]. *)
+ val format: Format.formatter -> t -> unit
+
+ (** Fold over a document as a sequence of instructions *)
+ val fold: ('acc -> element -> 'acc) -> 'acc -> t -> 'acc
+
+ (** {!msg} and {!kmsg} produce a document from a format string and its
+ argument *)
+ val msg: ('a,t) fmt -> 'a
+ val kmsg: (t -> 'b) -> ('a,'b) fmt -> 'a
+
+ (** {!printf} and {!kprintf} produce a printer from a format string and its
+ argument*)
+ val printf: ('a, printer0) fmt -> 'a
+ val kprintf: (t -> 'b) -> ('a, t -> 'b) fmt -> 'a
+
+ (** The functions below mirror {!Format} printers, without the [pp_print_]
+ prefix naming convention *)
+ val open_box: box_type -> int -> printer0
+ val close_box: printer0
+
+ val text: string printer
+ val string: string printer
+ val bytes: bytes printer
+ val with_size: int printer
+
+ val int: int printer
+ val float: float printer
+ val char: char printer
+ val bool: bool printer
+
+ val space: printer0
+ val cut: printer0
+ val break: spaces:int -> indent:int -> printer0
+
+ val custom_break:
+ fits:(string * int * string as 'a) -> breaks:'a -> printer0
+ val force_newline: printer0
+ val if_newline: printer0
+
+ val flush: printer0
+ val force_stop: printer0
+
+ val open_tbox: printer0
+ val set_tab: printer0
+ val tab: printer0
+ val tab_break: width:int -> offset:int -> printer0
+ val close_tbox: printer0
+
+ val open_tag: stag printer
+ val close_tag: printer0
+
+ val list: ?sep:printer0 -> 'a printer -> 'a list printer
+ val iter:
+ ?sep:printer0 -> iter:(('a -> unit) -> 'b -> unit) -> 'a printer
+ ->'b printer
+ val array: ?sep:printer0 -> 'a printer -> 'a array printer
+ val seq: ?sep:printer0 -> 'a printer -> 'a Seq.t printer
+
+ val option: ?none:printer0 -> 'a printer -> 'a option printer
+ val result: ok:'a printer -> error:'e printer -> ('a,'e) result printer
+ val either: left:'a printer -> right:'b printer -> ('a,'b) Either.t printer
+
+end
+
+(** {1 Compatibility API} *)
+
+(** The functions and types below provides source compatibility with format
+printers and conversion function from {!Format_doc} printers to {!Format}
+printers. The reverse direction is implemented using an escape hatch in the
+formatting instruction and should only be used to preserve backward
+compatibility. *)
+
+type doc = Doc.t
+type t = doc
+type formatter
+type 'a printer = formatter -> 'a -> unit
+
+val formatter: doc ref -> formatter
+(** [formatter rdoc] creates a {!formatter} that updates the [rdoc] reference *)
+
+(** Translate a {!Format_doc} printer to a {!Format} one. *)
+type 'a format_printer = Format.formatter -> 'a -> unit
+val compat: 'a printer -> 'a format_printer
+val compat1: ('p1 -> 'a printer) -> ('p1 -> 'a format_printer)
+val compat2: ('p1 -> 'p2 -> 'a printer) -> ('p1 -> 'p2 -> 'a format_printer)
+
+(** If necessary, embbed a {!Format} printer inside a formatting instruction
+ stream. This breaks every guarantees provided by {!Format_doc}. *)
+val deprecated_printer: (Format.formatter -> unit) -> formatter -> unit
+val deprecated: 'a format_printer -> 'a printer
+val deprecated1: ('p1 -> 'a format_printer) -> ('p1 -> 'a printer)
+
+
+(** {2 Format string interpreters }*)
+
+val fprintf : formatter -> ('a, formatter,unit) format -> 'a
+val kfprintf:
+ (formatter -> 'a) -> formatter ->
+ ('b, formatter, unit, 'a) format4 -> 'b
+
+val asprintf : ('a, formatter, unit, string) format4 -> 'a
+val kasprintf : (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b
+
+
+val dprintf : ('a, formatter, unit, formatter -> unit) format4 -> 'a
+val kdprintf:
+ ((formatter -> unit) -> 'a) ->
+ ('b, formatter, unit, 'a) format4 -> 'b
+
+(** {!doc_printf} and {!kdoc_printf} creates a document directly *)
+val doc_printf: ('a, formatter, unit, doc) format4 -> 'a
+val kdoc_printf: (doc -> 'r) -> ('a, formatter, unit, 'r) format4 -> 'a
+
+(** {2 Compatibility with {!Doc} }*)
+
+val doc_printer: 'a printer -> 'a Doc.printer
+val pp_doc: doc printer
+
+(** {2 Source compatibility with Format}*)
+
+(** {3 String printers } *)
+
+val pp_print_string: string printer
+val pp_print_substring: pos:int -> len:int -> string printer
+val pp_print_text: string printer
+val pp_print_bytes: bytes printer
+
+val pp_print_as: formatter -> int -> string -> unit
+val pp_print_substring_as:
+ pos:int -> len:int -> formatter -> int -> string -> unit
+
+(** {3 Primitive type printers }*)
+
+val pp_print_char: char printer
+val pp_print_int: int printer
+val pp_print_float: float printer
+val pp_print_bool: bool printer
+val pp_print_nothing: unit printer
+
+(** {3 Printer combinators }*)
+
+val pp_print_iter:
+ ?pp_sep:unit printer -> (('a -> unit) -> 'b -> unit) ->
+ 'a printer -> 'b printer
+
+val pp_print_list: ?pp_sep:unit printer -> 'a printer -> 'a list printer
+val pp_print_array: ?pp_sep:unit printer -> 'a printer -> 'a array printer
+val pp_print_seq: ?pp_sep:unit printer -> 'a printer -> 'a Seq.t printer
+
+val pp_print_option: ?none:unit printer -> 'a printer -> 'a option printer
+val pp_print_result: ok:'a printer -> error:'e printer -> ('a,'e) result printer
+val pp_print_either:
+ left:'a printer -> right:'b printer -> ('a,'b) Either.t printer
+
+
+(** {3 Boxes and tags }*)
+
+val pp_open_stag: Format.stag printer
+val pp_close_stag: unit printer
+
+val pp_open_box: int printer
+val pp_close_box: unit printer
+
+(** {3 Break hints} *)
+
+val pp_print_space: unit printer
+val pp_print_cut: unit printer
+val pp_print_break: formatter -> int -> int -> unit
+val pp_print_custom_break:
+ formatter -> fits:(string * int * string as 'c) -> breaks:'c -> unit
+
+(** {3 Tabulations }*)
+
+val pp_open_tbox: unit printer
+val pp_close_tbox: unit printer
+val pp_set_tab: unit printer
+val pp_print_tab: unit printer
+val pp_print_tbreak: formatter -> int -> int -> unit
+
+(** {3 Newlines and flushing }*)
+
+val pp_print_if_newline: unit printer
+val pp_force_newline: unit printer
+val pp_print_flush: unit printer
+val pp_print_newline: unit printer
+
+(** {1 Compiler specific functions }*)
+
+(** {2 Separators }*)
+
+val comma: unit printer
+
+(** {2 Compiler output} *)
+
+val pp_two_columns :
+ ?sep:string -> ?max_lines:int ->
+ formatter -> (string * string) list -> unit
+(** [pp_two_columns ?sep ?max_lines ppf l] prints the lines in [l] as two
+ columns separated by [sep] ("|" by default). [max_lines] can be used to
+ indicate a maximum number of lines to print -- an ellipsis gets inserted at
+ the middle if the input has too many lines.
+
+ Example:
+
+ {v pp_two_columns ~max_lines:3 Format.std_formatter [
+ "abc", "hello";
+ "def", "zzz";
+ "a" , "bllbl";
+ "bb" , "dddddd";
+ ] v}
+
+ prints
+
+ {v
+ abc | hello
+ ...
+ bb | dddddd
+ v}
+*)
diff --git a/src/utils/misc.ml b/src/utils/misc.ml
index 063539e2b7..fd7b3b27a8 100644
--- a/src/utils/misc.ml
+++ b/src/utils/misc.ml
@@ -83,6 +83,238 @@ let protect_refs =
| x -> set_refs backup; x
| exception e -> set_refs backup; raise e
+
+(** {1 Minimal support for Unicode characters in identifiers} *)
+
+module Utf8_lexeme = struct
+
+ type t = string
+
+ (* Non-ASCII letters that are allowed in identifiers (currently: Latin-9) *)
+
+ type case = Upper of Uchar.t | Lower of Uchar.t
+ let known_chars : (Uchar.t, case) Hashtbl.t = Hashtbl.create 32
+
+ let _ =
+ List.iter
+ ~f:(fun (upper, lower) ->
+ let upper = Uchar.of_int upper and lower = Uchar.of_int lower in
+ Hashtbl.add known_chars upper (Upper lower);
+ Hashtbl.add known_chars lower (Lower upper))
+ [
+ (0xc0, 0xe0); (* À, à *) (0xc1, 0xe1); (* Á, á *)
+ (0xc2, 0xe2); (* Â, â *) (0xc3, 0xe3); (* Ã, ã *)
+ (0xc4, 0xe4); (* Ä, ä *) (0xc5, 0xe5); (* Å, å *)
+ (0xc6, 0xe6); (* Æ, æ *) (0xc7, 0xe7); (* Ç, ç *)
+ (0xc8, 0xe8); (* È, è *) (0xc9, 0xe9); (* É, é *)
+ (0xca, 0xea); (* Ê, ê *) (0xcb, 0xeb); (* Ë, ë *)
+ (0xcc, 0xec); (* Ì, ì *) (0xcd, 0xed); (* Í, í *)
+ (0xce, 0xee); (* Î, î *) (0xcf, 0xef); (* Ï, ï *)
+ (0xd0, 0xf0); (* Ð, ð *) (0xd1, 0xf1); (* Ñ, ñ *)
+ (0xd2, 0xf2); (* Ò, ò *) (0xd3, 0xf3); (* Ó, ó *)
+ (0xd4, 0xf4); (* Ô, ô *) (0xd5, 0xf5); (* Õ, õ *)
+ (0xd6, 0xf6); (* Ö, ö *) (0xd8, 0xf8); (* Ø, ø *)
+ (0xd9, 0xf9); (* Ù, ù *) (0xda, 0xfa); (* Ú, ú *)
+ (0xdb, 0xfb); (* Û, û *) (0xdc, 0xfc); (* Ü, ü *)
+ (0xdd, 0xfd); (* Ý, ý *) (0xde, 0xfe); (* Þ, þ *)
+ (0x160, 0x161); (* Š, š *) (0x17d, 0x17e); (* Ž, ž *)
+ (0x152, 0x153); (* Œ, œ *) (0x178, 0xff); (* Ÿ, ÿ *)
+ (0x1e9e, 0xdf); (* ẞ, ß *)
+ ]
+
+ (* NFD to NFC conversion table for the letters above *)
+
+ let known_pairs : (Uchar.t * Uchar.t, Uchar.t) Hashtbl.t = Hashtbl.create 32
+
+ let _ =
+ List.iter
+ ~f:(fun (c1, n2, n) ->
+ Hashtbl.add known_pairs
+ (Uchar.of_char c1, Uchar.of_int n2) (Uchar.of_int n))
+ [
+ ('A', 0x300, 0xc0); (* À *) ('A', 0x301, 0xc1); (* Á *)
+ ('A', 0x302, 0xc2); (* Â *) ('A', 0x303, 0xc3); (* Ã *)
+ ('A', 0x308, 0xc4); (* Ä *) ('A', 0x30a, 0xc5); (* Å *)
+ ('C', 0x327, 0xc7); (* Ç *) ('E', 0x300, 0xc8); (* È *)
+ ('E', 0x301, 0xc9); (* É *) ('E', 0x302, 0xca); (* Ê *)
+ ('E', 0x308, 0xcb); (* Ë *) ('I', 0x300, 0xcc); (* Ì *)
+ ('I', 0x301, 0xcd); (* Í *) ('I', 0x302, 0xce); (* Î *)
+ ('I', 0x308, 0xcf); (* Ï *) ('N', 0x303, 0xd1); (* Ñ *)
+ ('O', 0x300, 0xd2); (* Ò *) ('O', 0x301, 0xd3); (* Ó *)
+ ('O', 0x302, 0xd4); (* Ô *) ('O', 0x303, 0xd5); (* Õ *)
+ ('O', 0x308, 0xd6); (* Ö *)
+ ('U', 0x300, 0xd9); (* Ù *) ('U', 0x301, 0xda); (* Ú *)
+ ('U', 0x302, 0xdb); (* Û *) ('U', 0x308, 0xdc); (* Ü *)
+ ('Y', 0x301, 0xdd); (* Ý *) ('Y', 0x308, 0x178); (* Ÿ *)
+ ('S', 0x30c, 0x160); (* Š *) ('Z', 0x30c, 0x17d); (* Ž *)
+ ('a', 0x300, 0xe0); (* à *) ('a', 0x301, 0xe1); (* á *)
+ ('a', 0x302, 0xe2); (* â *) ('a', 0x303, 0xe3); (* ã *)
+ ('a', 0x308, 0xe4); (* ä *) ('a', 0x30a, 0xe5); (* å *)
+ ('c', 0x327, 0xe7); (* ç *) ('e', 0x300, 0xe8); (* è *)
+ ('e', 0x301, 0xe9); (* é *) ('e', 0x302, 0xea); (* ê *)
+ ('e', 0x308, 0xeb); (* ë *) ('i', 0x300, 0xec); (* ì *)
+ ('i', 0x301, 0xed); (* í *) ('i', 0x302, 0xee); (* î *)
+ ('i', 0x308, 0xef); (* ï *) ('n', 0x303, 0xf1); (* ñ *)
+ ('o', 0x300, 0xf2); (* ò *) ('o', 0x301, 0xf3); (* ó *)
+ ('o', 0x302, 0xf4); (* ô *) ('o', 0x303, 0xf5); (* õ *)
+ ('o', 0x308, 0xf6); (* ö *)
+ ('u', 0x300, 0xf9); (* ù *) ('u', 0x301, 0xfa); (* ú *)
+ ('u', 0x302, 0xfb); (* û *) ('u', 0x308, 0xfc); (* ü *)
+ ('y', 0x301, 0xfd); (* ý *) ('y', 0x308, 0xff); (* ÿ *)
+ ('s', 0x30c, 0x161); (* š *) ('z', 0x30c, 0x17e); (* ž *)
+ ]
+
+ let normalize_generic ~keep_ascii transform s =
+ let rec norm check buf prev i =
+ if i >= String.length s then begin
+ Buffer.add_utf_8_uchar buf (transform prev)
+ end else begin
+ let d = String.get_utf_8_uchar s i in
+ let u = Uchar.utf_decode_uchar d in
+ check d u;
+ let i' = i + Uchar.utf_decode_length d in
+ match Hashtbl.find_opt known_pairs (prev, u) with
+ | Some u' ->
+ norm check buf u' i'
+ | None ->
+ Buffer.add_utf_8_uchar buf (transform prev);
+ norm check buf u i'
+ end in
+ let ascii_limit = 128 in
+ if s = ""
+ || keep_ascii && String.for_all (fun x -> Char.code x < ascii_limit) s
+ then Ok s
+ else
+ let buf = Buffer.create (String.length s) in
+ let valid = ref true in
+ let check d u =
+ valid := !valid && Uchar.utf_decode_is_valid d && u <> Uchar.rep
+ in
+ let d = String.get_utf_8_uchar s 0 in
+ let u = Uchar.utf_decode_uchar d in
+ check d u;
+ norm check buf u (Uchar.utf_decode_length d);
+ let contents = Buffer.contents buf in
+ if !valid then
+ Ok contents
+ else
+ Error contents
+
+ let normalize s =
+ normalize_generic ~keep_ascii:true (fun u -> u) s
+
+ (* Capitalization *)
+
+ let uchar_is_uppercase u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then c >= 65 && c <= 90 else
+ match Hashtbl.find_opt known_chars u with
+ | Some(Upper _) -> true
+ | _ -> false
+
+ let uchar_lowercase u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then
+ if c >= 65 && c <= 90 then Uchar.of_int (c + 32) else u
+ else
+ match Hashtbl.find_opt known_chars u with
+ | Some(Upper u') -> u'
+ | _ -> u
+
+ let uchar_uppercase u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then
+ if c >= 97 && c <= 122 then Uchar.of_int (c - 32) else u
+ else
+ match Hashtbl.find_opt known_chars u with
+ | Some(Lower u') -> u'
+ | _ -> u
+
+ let capitalize s =
+ let first = ref true in
+ normalize_generic ~keep_ascii:false
+ (fun u -> if !first then (first := false; uchar_uppercase u) else u)
+ s
+
+ let uncapitalize s =
+ let first = ref true in
+ normalize_generic ~keep_ascii:false
+ (fun u -> if !first then (first := false; uchar_lowercase u) else u)
+ s
+
+ let is_capitalized s =
+ s <> "" &&
+ uchar_is_uppercase (Uchar.utf_decode_uchar (String.get_utf_8_uchar s 0))
+
+ (* Characters allowed in identifiers after normalization is applied.
+ Currently:
+ - ASCII letters, underscore
+ - Latin-9 letters, represented in NFC
+ - ASCII digits, single quote (but not as first character)
+ - dot if [with_dot] = true
+ *)
+ let uchar_valid_in_identifier ~with_dot u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then
+ c >= 97 (* a *) && c <= 122 (* z *)
+ || c >= 65 (* A *) && c <= 90 (* Z *)
+ || c >= 48 (* 0 *) && c <= 57 (* 9 *)
+ || c = 95 (* underscore *)
+ || c = 39 (* single quote *)
+ || (with_dot && c = 46) (* dot *)
+ else
+ Hashtbl.mem known_chars u
+
+ let uchar_not_identifier_start u =
+ let c = Uchar.to_int u in
+ c >= 48 (* 0 *) && c <= 57 (* 9 *)
+ || c = 39 (* single quote *)
+
+ (* Check whether a normalized string is a valid OCaml identifier. *)
+
+ type validation_result =
+ | Valid
+ | Invalid_character of Uchar.t (** Character not allowed *)
+ | Invalid_beginning of Uchar.t (** Character not allowed as first char *)
+
+ let validate_identifier ?(with_dot=false) s =
+ let rec check i =
+ if i >= String.length s then Valid else begin
+ let d = String.get_utf_8_uchar s i in
+ let u = Uchar.utf_decode_uchar d in
+ let i' = i + Uchar.utf_decode_length d in
+ if not (uchar_valid_in_identifier ~with_dot u) then
+ Invalid_character u
+ else if i = 0 && uchar_not_identifier_start u then
+ Invalid_beginning u
+ else
+ check i'
+ end
+ in check 0
+
+ let is_valid_identifier s =
+ validate_identifier s = Valid
+
+ let starts_like_a_valid_identifier s =
+ s <> "" &&
+ (let u = Uchar.utf_decode_uchar (String.get_utf_8_uchar s 0) in
+ uchar_valid_in_identifier ~with_dot:false u
+ && not (uchar_not_identifier_start u))
+
+ let is_lowercase s =
+ let rec is_lowercase_at len s n =
+ if n >= len then true
+ else
+ let d = String.get_utf_8_uchar s n in
+ let u = Uchar.utf_decode_uchar d in
+ (uchar_valid_in_identifier ~with_dot:false u)
+ && not (uchar_is_uppercase u)
+ && is_lowercase_at len s (n+Uchar.utf_decode_length d)
+ in
+ is_lowercase_at (String.length s) s 0
+end
+
+
(* List functions *)
let map_end f l1 l2 = List.map_end ~f l1 l2
@@ -643,11 +875,12 @@ module Style = struct
| _ -> raise Not_found
let as_inline_code printer ppf x =
- Format.pp_open_stag ppf (Format.String_tag "inline_code");
+ let open Format_doc in
+ pp_open_stag ppf (Format.String_tag "inline_code");
printer ppf x;
- Format.pp_close_stag ppf ()
+ pp_close_stag ppf ()
- let inline_code ppf s = as_inline_code Format.pp_print_string ppf s
+ let inline_code ppf s = as_inline_code Format_doc.pp_print_string ppf s
(* either prints the tag of [s] or delegates to [or_else] *)
let mark_open_tag ~or_else s =
@@ -761,24 +994,25 @@ let spellcheck env name =
let env = List.sort_uniq ~cmp:(fun s1 s2 -> String.compare s2 s1) env in
fst (List.fold_left ~f:(compare name) ~init:([], max_int) env)
+
let did_you_mean ppf get_choices =
+ let open Format_doc in
(* flush now to get the error report early, in the (unheard of) case
where the search in the get_choices function would take a bit of
time; in the worst case, the user has seen the error, she can
interrupt the process before the spell-checking terminates. *)
- Format.fprintf ppf "@?";
+ fprintf ppf "@?";
match get_choices () with
| [] -> ()
| choices ->
let rest, last = split_last choices in
- let comma ppf () = Format.fprintf ppf ", " in
- Format.fprintf ppf "@\n@{<hint>Hint@}: Did you mean %a%s%a?@?"
- (Format.pp_print_list ~pp_sep:comma Style.inline_code) rest
+ fprintf ppf "@\n@[@{<hint>Hint@}: Did you mean %a%s%a?@]"
+ (pp_print_list ~pp_sep:comma Style.inline_code) rest
(if rest = [] then "" else " or ")
Style.inline_code last
let print_see_manual ppf manual_section =
- let open Format in
+ let open Format_doc in
fprintf ppf "(see manual section %a)"
(pp_print_list ~pp_sep:(fun f () -> pp_print_char f '.') pp_print_int)
manual_section
diff --git a/src/utils/misc.mli b/src/utils/misc.mli
index 249f8b668b..9c560d2dc9 100644
--- a/src/utils/misc.mli
+++ b/src/utils/misc.mli
@@ -295,7 +295,8 @@ val spellcheck : string list -> string -> string list
list of suggestions taken from [env], that are close enough to
[name] that it may be a typo for one of them. *)
-val did_you_mean : Format.formatter -> (unit -> string list) -> unit
+val did_you_mean :
+ Format_doc.formatter -> (unit -> string list) -> unit
(** [did_you_mean ppf get_choices] hints that the user may have meant
one of the option returned by calling [get_choices]. It does nothing
if the returned list is empty.
@@ -400,8 +401,8 @@ module Style : sig
inline_code: tag_style;
}
- val as_inline_code: (Format.formatter -> 'a -> unit as 'printer) -> 'printer
- val inline_code: Format.formatter -> string -> unit
+ val as_inline_code: 'a Format_doc.printer -> 'a Format_doc.printer
+ val inline_code: string Format_doc.printer
val default_styles: styles
val get_styles: unit -> styles
@@ -416,5 +417,58 @@ module Style : sig
(* adds functions to support color tags to the given formatter. *)
end
-val print_see_manual : Format.formatter -> int list -> unit
+val print_see_manual : int list Format_doc.printer
(** See manual section *)
+
+
+module Utf8_lexeme: sig
+ type t = string
+
+ val normalize: string -> (t,t) Result.t
+ (** Normalize the given UTF-8 encoded string.
+ Invalid UTF-8 sequences results in a error and are replaced
+ by U+FFFD.
+ Identifier characters are put in NFC normalized form.
+ Other Unicode characters are left unchanged. *)
+
+ val capitalize: string -> (t,t) Result.t
+ (** Like [normalize], but if the string starts with a lowercase identifier
+ character, it is replaced by the corresponding uppercase character.
+ Subsequent characters are not changed. *)
+
+ val uncapitalize: string -> (t,t) Result.t
+ (** Like [normalize], but if the string starts with an uppercase identifier
+ character, it is replaced by the corresponding lowercase character.
+ Subsequent characters are not changed. *)
+
+ val is_capitalized: t -> bool
+ (** Returns [true] if the given normalized string starts with an
+ uppercase identifier character, [false] otherwise. May return
+ wrong results if the string is not normalized. *)
+
+ val is_valid_identifier: t -> bool
+ (** Check whether the given normalized string is a valid OCaml identifier:
+ - all characters are identifier characters
+ - it does not start with a digit or a single quote
+ *)
+
+ val is_lowercase: t -> bool
+ (** Returns [true] if the given normalized string only contains lowercase
+ identifier character, [false] otherwise. May return wrong results if the
+ string is not normalized. *)
+
+ type validation_result =
+ | Valid
+ | Invalid_character of Uchar.t (** Character not allowed *)
+ | Invalid_beginning of Uchar.t (** Character not allowed as first char *)
+
+ val validate_identifier: ?with_dot:bool -> t -> validation_result
+ (** Like [is_valid_identifier], but returns a more detailed error code. Dots
+ can be allowed to extend support to path-like identifiers. *)
+
+ val starts_like_a_valid_identifier: t -> bool
+ (** Checks whether the given normalized string starts with an identifier
+ character other than a digit or a single quote. Subsequent characters
+ are not checked. *)
+end
+
diff --git a/tests/test-dirs/completion/application_context.t/run.t b/tests/test-dirs/completion/application_context.t/run.t
index b0f41cc763..ec9fd7f409 100644
--- a/tests/test-dirs/completion/application_context.t/run.t
+++ b/tests/test-dirs/completion/application_context.t/run.t
@@ -4,7 +4,7 @@
[
"application",
{
- "argument_type": "'_weak1",
+ "argument_type": "'a",
"labels": [
{
"name": "~j",
diff --git a/tests/test-dirs/completion/issue1575.t b/tests/test-dirs/completion/issue1575.t
index 8d0d755204..da568763b2 100644
--- a/tests/test-dirs/completion/issue1575.t
+++ b/tests/test-dirs/completion/issue1575.t
@@ -47,7 +47,7 @@ After a # we complete methods names
{
"name": "bazs",
"kind": "#",
- "desc": "'_weak1 -> string",
+ "desc": "'a -> string",
"info": "",
"deprecated": false
}
@@ -71,7 +71,7 @@ And filtering works with methods names
{
"name": "bazs",
"kind": "#",
- "desc": "'_weak1 -> string",
+ "desc": "'a -> string",
"info": "",
"deprecated": false
}
@@ -103,7 +103,7 @@ It also works when inside modules
{
"name": "bazs",
"kind": "#",
- "desc": "'_weak1 -> string",
+ "desc": "'a -> string",
"info": "",
"deprecated": false
}
diff --git a/tests/test-dirs/errors/reg503.t b/tests/test-dirs/errors/reg503.t
new file mode 100644
index 0000000000..a239bbef80
--- /dev/null
+++ b/tests/test-dirs/errors/reg503.t
@@ -0,0 +1,31 @@
+ $ cat >test.ml <<'EOF'
+ > class test _a =
+ > object
+ > method b x = x
+ > end
+ > EOF
+
+FIXME: Type variable are not shared between the two parts of the error message:
+ $ $MERLIN single errors -filename test.ml < test.ml
+ {
+ "class": "return",
+ "value": [
+ {
+ "start": {
+ "line": 1,
+ "col": 0
+ },
+ "end": {
+ "line": 4,
+ "col": 3
+ },
+ "type": "typer",
+ "sub": [],
+ "valid": true,
+ "message": "Some type variables are unbound in this type:
+ class test : 'a -> object method b : 'b -> 'b end
+ The method b has type 'a -> 'a where 'a is unbound"
+ }
+ ],
+ "notifications": []
+ }
diff --git a/tests/test-dirs/errors/typing-after-parsing.t/run.t b/tests/test-dirs/errors/typing-after-parsing.t/run.t
index e3a8622a10..20650889ba 100644
--- a/tests/test-dirs/errors/typing-after-parsing.t/run.t
+++ b/tests/test-dirs/errors/typing-after-parsing.t/run.t
@@ -16,7 +16,7 @@ First ask for all the errors:
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type int but an expression was expected of type unit"
+ "message": "The constant 3 has type int but an expression was expected of type unit"
},
{
"start": {
@@ -57,7 +57,7 @@ Now let's just ask for typing errors:
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type int but an expression was expected of type unit"
+ "message": "The constant 3 has type int but an expression was expected of type unit"
}
],
"notifications": []
diff --git a/tests/test-dirs/function-recovery.t b/tests/test-dirs/function-recovery.t
index e9fbacb55e..ea6587d7cf 100644
--- a/tests/test-dirs/function-recovery.t
+++ b/tests/test-dirs/function-recovery.t
@@ -51,7 +51,9 @@
structure_item (_none_[0,0+-1]..[0,0+-1]) ghost
Pstr_eval
expression (_none_[0,0+-1]..[0,0+-1]) ghost
- Pexp_constant PConst_int (1,None)
+ Pexp_constant
+ constant (_none_[0,0+-1]..[0,0+-1]) ghost
+ PConst_int (1,None)
]
Texp_ident \"*type-error*/277\"
]
@@ -86,7 +88,7 @@
extra
Tpat_extra_constraint
core_type (type.ml[1,0+28]..type.ml[1,0+34])
- Ttyp_constr \"list/9!\"
+ Ttyp_constr \"list/11!\"
[
core_type (type.ml[1,0+28]..type.ml[1,0+29])
Ttyp_constr \"t/278\"
@@ -118,7 +120,9 @@
structure_item (_none_[0,0+-1]..[0,0+-1]) ghost
Pstr_eval
expression (_none_[0,0+-1]..[0,0+-1]) ghost
- Pexp_constant PConst_int (1,None)
+ Pexp_constant
+ constant (_none_[0,0+-1]..[0,0+-1]) ghost
+ PConst_int (1,None)
]
Texp_ident \"*type-error*/280\"
]
diff --git a/tests/test-dirs/hidden-deps/dash-h.t b/tests/test-dirs/hidden-deps/dash-h.t
index df93542a53..441b0a7dd0 100644
--- a/tests/test-dirs/hidden-deps/dash-h.t
+++ b/tests/test-dirs/hidden-deps/dash-h.t
@@ -214,8 +214,7 @@ reference. With no liba, we also can't see Libb.t is int.
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type t = Liba.t but an expression was expected of type
- int"
+ "message": "The value x has type t = Liba.t but an expression was expected of type int"
},
{
"start": {
diff --git a/tests/test-dirs/inconsistent-assumptions.t b/tests/test-dirs/inconsistent-assumptions.t
index 4c50abbe06..499ba8ffc8 100644
--- a/tests/test-dirs/inconsistent-assumptions.t
+++ b/tests/test-dirs/inconsistent-assumptions.t
@@ -90,7 +90,7 @@ Go to the file, and ask merlin to move you to the error:
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type char but an expression was expected of type int"
+ "message": "The value x has type char but an expression was expected of type int"
}
],
"notifications": []
diff --git a/tests/test-dirs/issue1322.t/run.t b/tests/test-dirs/issue1322.t/run.t
index 5a128d7e15..3a78027189 100644
--- a/tests/test-dirs/issue1322.t/run.t
+++ b/tests/test-dirs/issue1322.t/run.t
@@ -17,13 +17,13 @@
"message": "In this with constraint, the new definition of t
does not match its original definition in the constrained signature:
Type declarations do not match:
- type 'a t = 'a t constraint 'a = int
+ type 'a t = 'a option constraint 'a = int
is not included in
type 'a t
Their parameters differ
The type int is not equal to the type 'a
File \"foo.ml\", line 2, characters 2-11: Expected declaration
- File \"foo.ml\", line 6, characters 9-54: Actual declaration"
+ File \"foo.ml\", lines 6-7, characters 9-23: Actual declaration"
}
],
"notifications": []
diff --git a/tests/test-dirs/locate/ill-typed/locate-non-fun.t b/tests/test-dirs/locate/ill-typed/locate-non-fun.t
index ac7b677225..cfebf714db 100644
--- a/tests/test-dirs/locate/ill-typed/locate-non-fun.t
+++ b/tests/test-dirs/locate/ill-typed/locate-non-fun.t
@@ -36,7 +36,7 @@ When some typing error happens
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type int -> int -> bool but an expression was expected of type Float.t -> Float.t -> bool Type int is not compatible with type Float.t = float"
+ "message": "The value Int.equal has type int -> int -> bool but an expression was expected of type Float.t -> Float.t -> bool Type int is not compatible with type Float.t = float"
}
Merlin is still able to inspect part of the ill-typed tree
diff --git a/tests/test-dirs/locate/in-implicit-trans-dep.t/run.t b/tests/test-dirs/locate/in-implicit-trans-dep.t/run.t
index 0301d8ed39..a7a3b79686 100644
--- a/tests/test-dirs/locate/in-implicit-trans-dep.t/run.t
+++ b/tests/test-dirs/locate/in-implicit-trans-dep.t/run.t
@@ -1,8 +1,8 @@
- $ dune build @check
+ $ dune build @check
-When the deifinition is in one of the implicit transitive dependencies
-Merlin does not found the file in the source path provided by Dune. One possible
-fix would be for Dune to provide additional source path for "externatl" deps.
+When the definition is in one of the implicit transitive dependencies
+Merlin does not found the file in the source path provided by Dune.
+This works as expected since Dune lang 3.17 and OCaml >= 5.2
$ $MERLIN single locate -look-for ml -position 1:15 \
> -filename bin/main.ml <bin/main.ml
{
diff --git a/tests/test-dirs/no-escape.t/run.t b/tests/test-dirs/no-escape.t/run.t
index a974233a46..5925e4fa9d 100644
--- a/tests/test-dirs/no-escape.t/run.t
+++ b/tests/test-dirs/no-escape.t/run.t
@@ -243,7 +243,7 @@ Syntax errors also shouldn't escape:
"type": "parser",
"sub": [],
"valid": true,
- "message": "invalid package type: parametrized types are not supported"
+ "message": "Syntax error: invalid package type: parametrized types are not supported"
}
],
"notifications": []
diff --git a/tests/test-dirs/pp/simple-pp.t b/tests/test-dirs/pp/simple-pp.t
index edc96a28dc..12768ef88d 100644
--- a/tests/test-dirs/pp/simple-pp.t
+++ b/tests/test-dirs/pp/simple-pp.t
@@ -16,7 +16,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type string but an expression was expected of type int"
+ "message": "This constant has type string but an expression was expected of type int"
}
],
"notifications": []
@@ -43,7 +43,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type string but an expression was expected of type int"
+ "message": "This constant has type string but an expression was expected of type int"
}
],
"notifications": []
diff --git a/tests/test-dirs/search/search-by-type.t/run.t b/tests/test-dirs/search/search-by-type.t/run.t
index 06b4a4da4d..8bfee4acfa 100644
--- a/tests/test-dirs/search/search-by-type.t/run.t
+++ b/tests/test-dirs/search/search-by-type.t/run.t
@@ -136,11 +136,11 @@
{
"file": "hashtbl.mli",
"start": {
- "line": 116,
+ "line": 117,
"col": 0
},
"end": {
- "line": 116,
+ "line": 117,
"col": 40
},
"name": "Hashtbl.add",
@@ -152,11 +152,11 @@
{
"file": "hashtbl.mli",
"start": {
- "line": 151,
+ "line": 152,
"col": 0
},
"end": {
- "line": 151,
+ "line": 152,
"col": 44
},
"name": "Hashtbl.replace",
@@ -168,11 +168,11 @@
{
"file": "hashtbl.mli",
"start": {
- "line": 301,
+ "line": 302,
"col": 0
},
"end": {
- "line": 301,
+ "line": 302,
"col": 50
},
"name": "Hashtbl.add_seq",
@@ -184,11 +184,11 @@
{
"file": "hashtbl.mli",
"start": {
- "line": 305,
+ "line": 306,
"col": 0
},
"end": {
- "line": 305,
+ "line": 306,
"col": 54
},
"name": "Hashtbl.replace_seq",
@@ -218,11 +218,11 @@
{
"file": "moreLabels.mli",
"start": {
- "line": 133,
+ "line": 134,
"col": 2
},
"end": {
- "line": 133,
+ "line": 134,
"col": 51
},
"name": "MoreLabels.Hashtbl.add",
@@ -234,11 +234,11 @@
{
"file": "moreLabels.mli",
"start": {
- "line": 318,
+ "line": 319,
"col": 2
},
"end": {
- "line": 318,
+ "line": 319,
"col": 52
},
"name": "MoreLabels.Hashtbl.add_seq",
@@ -250,11 +250,11 @@
{
"file": "moreLabels.mli",
"start": {
- "line": 168,
+ "line": 169,
"col": 2
},
"end": {
- "line": 168,
+ "line": 169,
"col": 55
},
"name": "MoreLabels.Hashtbl.replace",
@@ -266,11 +266,11 @@
{
"file": "moreLabels.mli",
"start": {
- "line": 322,
+ "line": 323,
"col": 2
},
"end": {
- "line": 322,
+ "line": 323,
"col": 56
},
"name": "MoreLabels.Hashtbl.replace_seq",
diff --git a/tests/test-dirs/short-paths.t/run.t b/tests/test-dirs/short-paths.t/run.t
index 7082820c92..17e5853287 100644
--- a/tests/test-dirs/short-paths.t/run.t
+++ b/tests/test-dirs/short-paths.t/run.t
@@ -17,7 +17,7 @@
"sub": [],
"valid": true,
"message": "Some type variables are unbound in this type: class b : 'a -> a
- The method x has type 'a where 'a is unbound"
+ The method x has type 'c where 'c is unbound"
},
{
"start": {
@@ -91,7 +91,7 @@
"valid": true,
"message": "Some type variables are unbound in this type:
class test : 'a -> object method b : 'b end
- The method b has type 'b where 'b is unbound"
+ The method b has type 'a where 'a is unbound"
},
{
"start": {
@@ -133,7 +133,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type t = M.t but an expression was expected of type unit"
+ "message": "The value x has type t = M.t but an expression was expected of type unit"
},
{
"start": {
@@ -170,7 +170,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type int but an expression was expected of type Dep.M.t"
+ "message": "The constant 5 has type int but an expression was expected of type Dep.M.t"
}
],
"notifications": []
@@ -193,7 +193,7 @@
"sub": [],
"valid": true,
"message": "Some type variables are unbound in this type: class b : 'a -> a
- The method x has type 'a where 'a is unbound"
+ The method x has type 'c where 'c is unbound"
},
{
"start": {
@@ -267,7 +267,7 @@
"valid": true,
"message": "Some type variables are unbound in this type:
class test : 'a -> object method b : 'b end
- The method b has type 'b where 'b is unbound"
+ The method b has type 'a where 'a is unbound"
},
{
"start": {
@@ -309,7 +309,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type N.O.t but an expression was expected of type unit"
+ "message": "The value x has type t but an expression was expected of type unit"
},
{
"start": {
@@ -325,7 +325,10 @@
"valid": true,
"message": "Modules do not match: sig type t = int val foo : 'a -> string end
is not included in S
- Values do not match: val foo : 'a -> string is not included in val foo : t -> t
+ Values do not match:
+ val foo : 'a -> string
+ is not included in
+ val foo : int -> t
The type t -> string is not compatible with the type t -> t
Type string is not compatible with type t
File \"test.ml\", line 72, characters 2-20: Expected declaration
@@ -343,7 +346,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type int but an expression was expected of type Dep.t"
+ "message": "The constant 5 has type int but an expression was expected of type Dep.M.t"
}
],
"notifications": []
diff --git a/tests/test-dirs/string-loc.t b/tests/test-dirs/string-loc.t
index 3fa3a69bdd..ae774de8b6 100644
--- a/tests/test-dirs/string-loc.t
+++ b/tests/test-dirs/string-loc.t
@@ -7,7 +7,9 @@ Ensure the Pexp_constant and Pconst_string nodes have different locations.
structure_item (test.ml[1,0+4]..[1,0+10])
Pstr_eval
expression (test.ml[1,0+4]..[1,0+10])
- Pexp_constant PConst_string(\"test\",(test.ml[1,0+5]..[1,0+9]),None)
+ Pexp_constant
+ constant (test.ml[1,0+4]..[1,0+10])
+ PConst_string(\"test\",(test.ml[1,0+5]..[1,0+9]),None)
]
diff --git a/tests/test-dirs/type-enclosing/inside-tydecl.t b/tests/test-dirs/type-enclosing/inside-tydecl.t
index af594fb4a8..2fda8883cc 100644
--- a/tests/test-dirs/type-enclosing/inside-tydecl.t
+++ b/tests/test-dirs/type-enclosing/inside-tydecl.t
@@ -29,7 +29,7 @@ test
"line": 1,
"col": 20
},
- "type": "type t1 = 'a",
+ "type": "type t1 = t1",
"tail": "no"
},
{
diff --git a/tests/test-dirs/type-enclosing/issue1335.t b/tests/test-dirs/type-enclosing/issue1335.t
index 2738acdffe..99cafcb8ea 100644
--- a/tests/test-dirs/type-enclosing/issue1335.t
+++ b/tests/test-dirs/type-enclosing/issue1335.t
@@ -24,7 +24,7 @@ provide better result.
"line": 4,
"col": 15
},
- "type": "type 'a t = 'b",
+ "type": "type 'a t = 'b t",
"tail": "no"
},
{
@@ -36,7 +36,7 @@ provide better result.
"line": 4,
"col": 15
},
- "type": "'a",
+ "type": "'k t",
"tail": "no"
},
{
@@ -77,7 +77,7 @@ provide better result.
"line": 1,
"col": 25
},
- "type": "[ `A of 'a | `B ]",
+ "type": "[ `A of t1 | `B ]",
"tail": "no"
},
{
diff --git a/tests/test-dirs/type-enclosing/issue1755.t b/tests/test-dirs/type-enclosing/issue1755.t
index 2a22de8324..a8a3262781 100644
--- a/tests/test-dirs/type-enclosing/issue1755.t
+++ b/tests/test-dirs/type-enclosing/issue1755.t
@@ -21,7 +21,7 @@ provide better result.
"line": 1,
"col": 25
},
- "type": "type b = 'a",
+ "type": "type b = b",
"tail": "no"
},
{
@@ -33,7 +33,7 @@ provide better result.
"line": 1,
"col": 25
},
- "type": "'a",
+ "type": "b",
"tail": "no"
},
{
diff --git a/tests/test-dirs/type-enclosing/te-modules.t b/tests/test-dirs/type-enclosing/te-modules.t
index 5490630818..ea84666871 100644
--- a/tests/test-dirs/type-enclosing/te-modules.t
+++ b/tests/test-dirs/type-enclosing/te-modules.t
@@ -186,6 +186,10 @@ With index 0 only the first type is shown:
val filter : ('a -> bool) -> 'a list -> 'a list
val find_all : ('a -> bool) -> 'a list -> 'a list
val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
+ val take : int -> 'a list -> 'a list
+ val drop : int -> 'a list -> 'a list
+ val take_while : ('a -> bool) -> 'a list -> 'a list
+ val drop_while : ('a -> bool) -> 'a list -> 'a list
val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
val partition_map :
('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list
diff --git a/tests/test-dirs/type-expr.t/run.t b/tests/test-dirs/type-expr.t/run.t
index 4be6e42ec6..6c3ca54af4 100644
--- a/tests/test-dirs/type-expr.t/run.t
+++ b/tests/test-dirs/type-expr.t/run.t
@@ -124,6 +124,10 @@
val filter : ('a -> bool) -> 'a list -> 'a list
val find_all : ('a -> bool) -> 'a list -> 'a list
val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
+ val take : int -> 'a list -> 'a list
+ val drop : int -> 'a list -> 'a list
+ val take_while : ('a -> bool) -> 'a list -> 'a list
+ val drop_while : ('a -> bool) -> 'a list -> 'a list
val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
val partition_map :
('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list
diff --git a/tests/test-dirs/typing-recovery.t b/tests/test-dirs/typing-recovery.t
index 7b8a99ad3c..b806200933 100644
--- a/tests/test-dirs/typing-recovery.t
+++ b/tests/test-dirs/typing-recovery.t
@@ -25,7 +25,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type int but an expression was expected of type unit"
+ "message": "This constant has type int but an expression was expected of type unit"
},
{
"start": {
@@ -54,7 +54,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type char but an expression was expected of type unit"
+ "message": "This constant has type char but an expression was expected of type unit"
}
],
"notifications": []
@@ -144,7 +144,9 @@
structure_item (_none_[0,0+-1]..[0,0+-1]) ghost
Pstr_eval
expression (_none_[0,0+-1]..[0,0+-1]) ghost
- Pexp_constant PConst_int (1,None)
+ Pexp_constant
+ constant (_none_[0,0+-1]..[0,0+-1]) ghost
+ PConst_int (1,None)
]
attribute \"merlin.loc\"
[]
@@ -164,12 +166,15 @@
structure_item (_none_[0,0+-1]..[0,0+-1]) ghost
Pstr_eval
expression (_none_[0,0+-1]..[0,0+-1]) ghost
- Pexp_constant PConst_int (2,None)
+ Pexp_constant
+ constant (_none_[0,0+-1]..[0,0+-1]) ghost
+ PConst_int (2,None)
]
attribute \"merlin.loc\"
[]
Texp_ident \"*type-error*/283\"
]
+ []
]
]
@@ -214,7 +219,7 @@
"type": "typer",
"sub": [],
"valid": true,
- "message": "This expression has type unit but an expression was expected of type int"
+ "message": "The constructor () has type unit but an expression was expected of type int"
}
],
"notifications": []
@@ -278,7 +283,9 @@
structure_item (_none_[0,0+-1]..[0,0+-1]) ghost
Pstr_eval
expression (_none_[0,0+-1]..[0,0+-1]) ghost
- Pexp_constant PConst_int (1,None)
+ Pexp_constant
+ constant (_none_[0,0+-1]..[0,0+-1]) ghost
+ PConst_int (1,None)
]
extra
Texp_constraint
diff --git a/tests/test-dirs/expand_node/ppx-tests.t/c_ppx/c_ppx.ml b/tests/test-dirs/with-ppx/expand_node.t/c_ppx/c_ppx.ml
similarity index 100%
rename from tests/test-dirs/expand_node/ppx-tests.t/c_ppx/c_ppx.ml
rename to tests/test-dirs/with-ppx/expand_node.t/c_ppx/c_ppx.ml
diff --git a/tests/test-dirs/expand_node/ppx-tests.t/c_ppx/dune b/tests/test-dirs/with-ppx/expand_node.t/c_ppx/dune
similarity index 100%
rename from tests/test-dirs/expand_node/ppx-tests.t/c_ppx/dune
rename to tests/test-dirs/with-ppx/expand_node.t/c_ppx/dune
diff --git a/tests/test-dirs/expand_node/ppx-tests.t/rewriter/dune b/tests/test-dirs/with-ppx/expand_node.t/rewriter/dune
similarity index 100%
rename from tests/test-dirs/expand_node/ppx-tests.t/rewriter/dune
rename to tests/test-dirs/with-ppx/expand_node.t/rewriter/dune
diff --git a/tests/test-dirs/expand_node/ppx-tests.t/rewriter/my_ppx.ml b/tests/test-dirs/with-ppx/expand_node.t/rewriter/my_ppx.ml
similarity index 100%
rename from tests/test-dirs/expand_node/ppx-tests.t/rewriter/my_ppx.ml
rename to tests/test-dirs/with-ppx/expand_node.t/rewriter/my_ppx.ml
diff --git a/tests/test-dirs/expand_node/ppx-tests.t/run.t b/tests/test-dirs/with-ppx/expand_node.t/run.t
similarity index 100%
rename from tests/test-dirs/expand_node/ppx-tests.t/run.t
rename to tests/test-dirs/with-ppx/expand_node.t/run.t
diff --git a/upstream/gen_patch.sh b/upstream/gen_patch.sh
index 3fa724dfd9..96535b4dbf 100644
--- a/upstream/gen_patch.sh
+++ b/upstream/gen_patch.sh
@@ -2,12 +2,12 @@
D_MERLIN=../src/ocaml
-FROM=501
-TO=502
+FROM=503
+TO=503
D_FROM=ocaml_${FROM}
D_TO=ocaml_${TO}
-D_PATCH=patches_${TO}
+D_PATCH=patches__${TO}
mkdir "${D_PATCH}"
@@ -18,10 +18,14 @@ for file in "${D_TO}"/*/*.ml*; do
F_PATCH=$(echo "${F_TO}" | sed "s/${D_TO}/${D_PATCH}/g")
mkdir "$(dirname "${F_PATCH}")" 2>/dev/null | true
# Make diff
- diff -u -N "${F_FROM}" "${F_TO}" >"${F_PATCH}.patch"
+ if [ "$F_FROM" = "$F_TO" ]; then
+ git diff "${F_FROM}" >"${F_PATCH}.patch"
+ else
+ diff -u -N "${F_FROM}" "${F_TO}" >"${F_PATCH}.patch"
+ fi
if [ -s "${F_PATCH}.patch" ]; then
# Apply the patch file
- patch "${F_MERLIN}" "${F_PATCH}.patch"
+ patch --no-backup-if-mismatch --merge "${F_MERLIN}" "${F_PATCH}.patch"
echo "patched ${F_MERLIN}"
else
rm "${F_PATCH}.patch"
diff --git a/upstream/ocaml_503/base-rev.txt b/upstream/ocaml_503/base-rev.txt
new file mode 100644
index 0000000000..8d00851f35
--- /dev/null
+++ b/upstream/ocaml_503/base-rev.txt
@@ -0,0 +1 @@
+630a342bf2b033a1be1c8746cbd34d0c63801ded
diff --git a/upstream/ocaml_503/file_formats/cmi_format.ml b/upstream/ocaml_503/file_formats/cmi_format.ml
new file mode 100644
index 0000000000..8e8c27edc2
--- /dev/null
+++ b/upstream/ocaml_503/file_formats/cmi_format.ml
@@ -0,0 +1,119 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+open Misc
+
+type pers_flags =
+ | Rectypes
+ | Alerts of alerts
+ | Opaque
+
+type error =
+ | Not_an_interface of filepath
+ | Wrong_version_interface of filepath * string
+ | Corrupted_interface of filepath
+
+exception Error of error
+
+(* these type abbreviations are not exported;
+ they are used to provide consistency across
+ input_value and output_value usage. *)
+type signature = Types.signature_item list
+type flags = pers_flags list
+type header = modname * signature
+
+type cmi_infos = {
+ cmi_name : modname;
+ cmi_sign : signature;
+ cmi_crcs : crcs;
+ cmi_flags : flags;
+}
+
+let input_cmi ic =
+ let (name, sign) = (Compression.input_value ic : header) in
+ let crcs = (input_value ic : crcs) in
+ let flags = (input_value ic : flags) in
+ {
+ cmi_name = name;
+ cmi_sign = sign;
+ cmi_crcs = crcs;
+ cmi_flags = flags;
+ }
+
+let read_cmi filename =
+ let ic = open_in_bin filename in
+ try
+ let buffer =
+ really_input_string ic (String.length Config.cmi_magic_number)
+ in
+ if buffer <> Config.cmi_magic_number then begin
+ close_in ic;
+ let pre_len = String.length Config.cmi_magic_number - 3 in
+ if String.sub buffer 0 pre_len
+ = String.sub Config.cmi_magic_number 0 pre_len then
+ begin
+ let msg =
+ if buffer < Config.cmi_magic_number then "an older" else "a newer" in
+ raise (Error (Wrong_version_interface (filename, msg)))
+ end else begin
+ raise(Error(Not_an_interface filename))
+ end
+ end;
+ let cmi = input_cmi ic in
+ close_in ic;
+ cmi
+ with End_of_file | Failure _ ->
+ close_in ic;
+ raise(Error(Corrupted_interface(filename)))
+ | Error e ->
+ close_in ic;
+ raise (Error e)
+
+let output_cmi filename oc cmi =
+(* beware: the provided signature must have been substituted for saving *)
+ output_string oc Config.cmi_magic_number;
+ Compression.output_value oc ((cmi.cmi_name, cmi.cmi_sign) : header);
+ flush oc;
+ let crc = Digest.file filename in
+ let crcs = (cmi.cmi_name, Some crc) :: cmi.cmi_crcs in
+ output_value oc (crcs : crcs);
+ output_value oc (cmi.cmi_flags : flags);
+ crc
+
+(* Error report *)
+
+open Format_doc
+
+let report_error_doc ppf = function
+ | Not_an_interface filename ->
+ fprintf ppf "%a@ is not a compiled interface"
+ Location.Doc.quoted_filename filename
+ | Wrong_version_interface (filename, older_newer) ->
+ fprintf ppf
+ "%a@ is not a compiled interface for this version of OCaml.@.\
+ It seems to be for %s version of OCaml."
+ Location.Doc.quoted_filename filename older_newer
+ | Corrupted_interface filename ->
+ fprintf ppf "Corrupted compiled interface@ %a"
+ Location.Doc.quoted_filename filename
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err -> Some (Location.error_of_printer_file report_error_doc err)
+ | _ -> None
+ )
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/upstream/ocaml_503/file_formats/cmi_format.mli b/upstream/ocaml_503/file_formats/cmi_format.mli
new file mode 100644
index 0000000000..1a170106ce
--- /dev/null
+++ b/upstream/ocaml_503/file_formats/cmi_format.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+open Misc
+
+type pers_flags =
+ | Rectypes
+ | Alerts of alerts
+ | Opaque
+
+type cmi_infos = {
+ cmi_name : modname;
+ cmi_sign : Types.signature_item list;
+ cmi_crcs : crcs;
+ cmi_flags : pers_flags list;
+}
+
+(* write the magic + the cmi information *)
+val output_cmi : string -> out_channel -> cmi_infos -> Digest.t
+
+(* read the cmi information (the magic is supposed to have already been read) *)
+val input_cmi : in_channel -> cmi_infos
+
+(* read a cmi from a filename, checking the magic *)
+val read_cmi : string -> cmi_infos
+
+(* Error report *)
+
+type error =
+ | Not_an_interface of filepath
+ | Wrong_version_interface of filepath * string
+ | Corrupted_interface of filepath
+
+exception Error of error
+
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
diff --git a/upstream/ocaml_503/file_formats/cmt_format.ml b/upstream/ocaml_503/file_formats/cmt_format.ml
new file mode 100644
index 0000000000..c9efa3c051
--- /dev/null
+++ b/upstream/ocaml_503/file_formats/cmt_format.ml
@@ -0,0 +1,483 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+open Cmi_format
+open Typedtree
+
+(* Note that in Typerex, there is an awful hack to save a cmt file
+ together with the interface file that was generated by ocaml (this
+ is because the installed version of ocaml might differ from the one
+ integrated in Typerex).
+*)
+
+
+
+let read_magic_number ic =
+ let len_magic_number = String.length Config.cmt_magic_number in
+ really_input_string ic len_magic_number
+
+type binary_annots =
+ | Packed of Types.signature * string list
+ | Implementation of structure
+ | Interface of signature
+ | Partial_implementation of binary_part array
+ | Partial_interface of binary_part array
+
+and binary_part =
+ | Partial_structure of structure
+ | Partial_structure_item of structure_item
+ | Partial_expression of expression
+ | Partial_pattern : 'k pattern_category * 'k general_pattern -> binary_part
+ | Partial_class_expr of class_expr
+ | Partial_signature of signature
+ | Partial_signature_item of signature_item
+ | Partial_module_type of module_type
+
+type dependency_kind = Definition_to_declaration | Declaration_to_declaration
+type cmt_infos = {
+ cmt_modname : string;
+ cmt_annots : binary_annots;
+ cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
+ cmt_comments : (string * Location.t) list;
+ cmt_args : string array;
+ cmt_sourcefile : string option;
+ cmt_builddir : string;
+ cmt_loadpath : Load_path.paths;
+ cmt_source_digest : Digest.t option;
+ cmt_initial_env : Env.t;
+ cmt_imports : (string * Digest.t option) list;
+ cmt_interface_digest : Digest.t option;
+ cmt_use_summaries : bool;
+ cmt_uid_to_decl : item_declaration Shape.Uid.Tbl.t;
+ cmt_impl_shape : Shape.t option; (* None for mli *)
+ cmt_ident_occurrences :
+ (Longident.t Location.loc * Shape_reduce.result) list
+}
+
+type error =
+ Not_a_typedtree of string
+
+let iter_on_parts (it : Tast_iterator.iterator) = function
+ | Partial_structure s -> it.structure it s
+ | Partial_structure_item s -> it.structure_item it s
+ | Partial_expression e -> it.expr it e
+ | Partial_pattern (_category, p) -> it.pat it p
+ | Partial_class_expr ce -> it.class_expr it ce
+ | Partial_signature s -> it.signature it s
+ | Partial_signature_item s -> it.signature_item it s
+ | Partial_module_type s -> it.module_type it s
+
+let iter_on_annots (it : Tast_iterator.iterator) = function
+ | Implementation s -> it.structure it s
+ | Interface s -> it.signature it s
+ | Packed _ -> ()
+ | Partial_implementation array -> Array.iter (iter_on_parts it) array
+ | Partial_interface array -> Array.iter (iter_on_parts it) array
+
+let iter_on_declaration f decl =
+ match decl with
+ | Value vd -> f vd.val_val.val_uid decl;
+ | Value_binding vb ->
+ let bound_idents = let_bound_idents_full [vb] in
+ List.iter (fun (_, _, _, uid) -> f uid decl) bound_idents
+ | Type td ->
+ if not (Btype.is_row_name (Ident.name td.typ_id)) then
+ f td.typ_type.type_uid (Type td)
+ | Constructor cd -> f cd.cd_uid decl
+ | Extension_constructor ec -> f ec.ext_type.ext_uid decl;
+ | Label ld -> f ld.ld_uid decl
+ | Module md -> f md.md_uid decl
+ | Module_type mtd -> f mtd.mtd_uid decl
+ | Module_substitution ms -> f ms.ms_uid decl
+ | Module_binding mb -> f mb.mb_uid decl
+ | Class cd -> f cd.ci_decl.cty_uid decl
+ | Class_type ct -> f ct.ci_decl.cty_uid decl
+
+let iter_on_declarations ~(f: Shape.Uid.t -> item_declaration -> unit) = {
+ Tast_iterator.default_iterator with
+ item_declaration = (fun _sub decl -> iter_on_declaration f decl);
+}
+
+let need_to_clear_env =
+ try ignore (Sys.getenv "OCAML_BINANNOT_WITHENV"); false
+ with Not_found -> true
+
+let keep_only_summary = Env.keep_only_summary
+
+let cenv =
+ {Tast_mapper.default with env = fun _sub env -> keep_only_summary env}
+
+let clear_part = function
+ | Partial_structure s -> Partial_structure (cenv.structure cenv s)
+ | Partial_structure_item s ->
+ Partial_structure_item (cenv.structure_item cenv s)
+ | Partial_expression e -> Partial_expression (cenv.expr cenv e)
+ | Partial_pattern (category, p) -> Partial_pattern (category, cenv.pat cenv p)
+ | Partial_class_expr ce -> Partial_class_expr (cenv.class_expr cenv ce)
+ | Partial_signature s -> Partial_signature (cenv.signature cenv s)
+ | Partial_signature_item s ->
+ Partial_signature_item (cenv.signature_item cenv s)
+ | Partial_module_type s -> Partial_module_type (cenv.module_type cenv s)
+
+let clear_env binary_annots =
+ if need_to_clear_env then
+ match binary_annots with
+ | Implementation s -> Implementation (cenv.structure cenv s)
+ | Interface s -> Interface (cenv.signature cenv s)
+ | Packed _ -> binary_annots
+ | Partial_implementation array ->
+ Partial_implementation (Array.map clear_part array)
+ | Partial_interface array ->
+ Partial_interface (Array.map clear_part array)
+
+ else binary_annots
+
+(* Every typedtree node with a located longident corresponding to user-facing
+ syntax should be indexed. *)
+let iter_on_occurrences
+ ~(f : namespace:Shape.Sig_component_kind.t ->
+ Env.t -> Path.t -> Longident.t Location.loc ->
+ unit) =
+ let path_in_type typ name =
+ match Types.get_desc typ with
+ | Tconstr (type_path, _, _) ->
+ Some (Path.Pdot (type_path, name))
+ | _ -> None
+ in
+ let add_constructor_description env lid =
+ function
+ | { Types.cstr_tag = Cstr_extension (path, _); _ } ->
+ f ~namespace:Extension_constructor env path lid
+ | { Types.cstr_uid = Predef name; _} ->
+ let id = List.assoc name Predef.builtin_idents in
+ f ~namespace:Constructor env (Pident id) lid
+ | { Types.cstr_res; cstr_name; _ } ->
+ let path = path_in_type cstr_res cstr_name in
+ Option.iter (fun path -> f ~namespace:Constructor env path lid) path
+ in
+ let add_label env lid { Types.lbl_name; lbl_res; _ } =
+ let path = path_in_type lbl_res lbl_name in
+ Option.iter (fun path -> f ~namespace:Label env path lid) path
+ in
+ let with_constraint ~env (_path, _lid, with_constraint) =
+ match with_constraint with
+ | Twith_module (path', lid') | Twith_modsubst (path', lid') ->
+ f ~namespace:Module env path' lid'
+ | _ -> ()
+ in
+ Tast_iterator.{ default_iterator with
+
+ expr = (fun sub ({ exp_desc; exp_env; _ } as e) ->
+ (match exp_desc with
+ | Texp_ident (path, lid, _) ->
+ f ~namespace:Value exp_env path lid
+ | Texp_construct (lid, constr_desc, _) ->
+ add_constructor_description exp_env lid constr_desc
+ | Texp_field (_, lid, label_desc)
+ | Texp_setfield (_, lid, label_desc, _) ->
+ add_label exp_env lid label_desc
+ | Texp_new (path, lid, _) ->
+ f ~namespace:Class exp_env path lid
+ | Texp_record { fields; _ } ->
+ Array.iter (fun (label_descr, record_label_definition) ->
+ match record_label_definition with
+ | Overridden (
+ { Location.txt; loc},
+ {exp_loc; _})
+ when not exp_loc.loc_ghost
+ && loc.loc_start = exp_loc.loc_start
+ && loc.loc_end = exp_loc.loc_end ->
+ (* In the presence of punning we want to index the label
+ even if it is ghosted *)
+ let lid = { Location.txt; loc = {loc with loc_ghost = false} } in
+ add_label exp_env lid label_descr
+ | Overridden (lid, _) -> add_label exp_env lid label_descr
+ | Kept _ -> ()) fields
+ | Texp_instvar (_self_path, path, name) ->
+ let lid = { name with txt = Longident.Lident name.txt } in
+ f ~namespace:Value exp_env path lid
+ | Texp_setinstvar (_self_path, path, name, _) ->
+ let lid = { name with txt = Longident.Lident name.txt } in
+ f ~namespace:Value exp_env path lid
+ | Texp_override (_self_path, modifs) ->
+ List.iter (fun (id, (name : string Location.loc), _exp) ->
+ let lid = { name with txt = Longident.Lident name.txt } in
+ f ~namespace:Value exp_env (Path.Pident id) lid)
+ modifs
+ | Texp_extension_constructor (lid, path) ->
+ f ~namespace:Extension_constructor exp_env path lid
+ | Texp_constant _ | Texp_let _ | Texp_function _ | Texp_apply _
+ | Texp_match _ | Texp_try _ | Texp_tuple _ | Texp_variant _ | Texp_array _
+ | Texp_ifthenelse _ | Texp_sequence _ | Texp_while _ | Texp_for _
+ | Texp_send _
+ | Texp_letmodule _ | Texp_letexception _ | Texp_assert _ | Texp_lazy _
+ | Texp_object _ | Texp_pack _ | Texp_letop _ | Texp_unreachable
+ | Texp_open _ -> ());
+ default_iterator.expr sub e);
+
+ (* Remark: some types get iterated over twice due to how constraints are
+ encoded in the typedtree. For example, in [let x : t = 42], [t] is
+ present in both a [Tpat_constraint] and a [Texp_constraint] node) *)
+ typ =
+ (fun sub ({ ctyp_desc; ctyp_env; _ } as ct) ->
+ (match ctyp_desc with
+ | Ttyp_constr (path, lid, _ctyps) ->
+ f ~namespace:Type ctyp_env path lid
+ | Ttyp_package {pack_path; pack_txt} ->
+ f ~namespace:Module_type ctyp_env pack_path pack_txt
+ | Ttyp_class (path, lid, _typs) ->
+ (* Deprecated syntax to extend a polymorphic variant *)
+ f ~namespace:Type ctyp_env path lid
+ | Ttyp_open (path, lid, _ct) ->
+ f ~namespace:Module ctyp_env path lid
+ | Ttyp_any | Ttyp_var _ | Ttyp_arrow _ | Ttyp_tuple _ | Ttyp_object _
+ | Ttyp_alias _ | Ttyp_variant _ | Ttyp_poly _ -> ());
+ default_iterator.typ sub ct);
+
+ pat =
+ (fun (type a) sub
+ ({ pat_desc; pat_extra; pat_env; _ } as pat : a general_pattern) ->
+ (match pat_desc with
+ | Tpat_construct (lid, constr_desc, _, _) ->
+ add_constructor_description pat_env lid constr_desc
+ | Tpat_record (fields, _) ->
+ List.iter (fun (lid, label_descr, pat) ->
+ let lid =
+ let open Location in
+ (* In the presence of punning we want to index the label
+ even if it is ghosted *)
+ if (not pat.pat_loc.loc_ghost
+ && lid.loc.loc_start = pat.pat_loc.loc_start
+ && lid.loc.loc_end = pat.pat_loc.loc_end)
+ then {lid with loc = {lid.loc with loc_ghost = false}}
+ else lid
+ in
+ add_label pat_env lid label_descr)
+ fields
+ | Tpat_any | Tpat_var _ | Tpat_alias _ | Tpat_constant _ | Tpat_tuple _
+ | Tpat_variant _ | Tpat_array _ | Tpat_lazy _ | Tpat_value _
+ | Tpat_exception _ | Tpat_or _ -> ());
+ List.iter (fun (pat_extra, _, _) ->
+ match pat_extra with
+ | Tpat_open (path, lid, _) ->
+ f ~namespace:Module pat_env path lid
+ | Tpat_type (path, lid) ->
+ f ~namespace:Type pat_env path lid
+ | Tpat_constraint _ | Tpat_unpack -> ())
+ pat_extra;
+ default_iterator.pat sub pat);
+
+ binding_op = (fun sub ({bop_op_path; bop_op_name; bop_exp; _} as bop) ->
+ let lid = { bop_op_name with txt = Longident.Lident bop_op_name.txt } in
+ f ~namespace:Value bop_exp.exp_env bop_op_path lid;
+ default_iterator.binding_op sub bop);
+
+ module_expr =
+ (fun sub ({ mod_desc; mod_env; _ } as me) ->
+ (match mod_desc with
+ | Tmod_ident (path, lid) -> f ~namespace:Module mod_env path lid
+ | Tmod_structure _ | Tmod_functor _ | Tmod_apply _ | Tmod_apply_unit _
+ | Tmod_constraint _ | Tmod_unpack _ -> ());
+ default_iterator.module_expr sub me);
+
+ open_description =
+ (fun sub ({ open_expr = (path, lid); open_env; _ } as od) ->
+ f ~namespace:Module open_env path lid;
+ default_iterator.open_description sub od);
+
+ module_type =
+ (fun sub ({ mty_desc; mty_env; _ } as mty) ->
+ (match mty_desc with
+ | Tmty_ident (path, lid) ->
+ f ~namespace:Module_type mty_env path lid
+ | Tmty_with (_mty, l) ->
+ List.iter (with_constraint ~env:mty_env) l
+ | Tmty_alias (path, lid) ->
+ f ~namespace:Module mty_env path lid
+ | Tmty_signature _ | Tmty_functor _ | Tmty_typeof _ -> ());
+ default_iterator.module_type sub mty);
+
+ class_expr =
+ (fun sub ({ cl_desc; cl_env; _} as ce) ->
+ (match cl_desc with
+ | Tcl_ident (path, lid, _) -> f ~namespace:Class cl_env path lid
+ | Tcl_structure _ | Tcl_fun _ | Tcl_apply _ | Tcl_let _
+ | Tcl_constraint _ | Tcl_open _ -> ());
+ default_iterator.class_expr sub ce);
+
+ class_type =
+ (fun sub ({ cltyp_desc; cltyp_env; _} as ct) ->
+ (match cltyp_desc with
+ | Tcty_constr (path, lid, _) -> f ~namespace:Class_type cltyp_env path lid
+ | Tcty_signature _ | Tcty_arrow _ | Tcty_open _ -> ());
+ default_iterator.class_type sub ct);
+
+ signature_item =
+ (fun sub ({ sig_desc; sig_env; _ } as sig_item) ->
+ (match sig_desc with
+ | Tsig_exception {
+ tyexn_constructor = { ext_kind = Text_rebind (path, lid)}} ->
+ f ~namespace:Extension_constructor sig_env path lid
+ | Tsig_modsubst { ms_manifest; ms_txt } ->
+ f ~namespace:Module sig_env ms_manifest ms_txt
+ | Tsig_typext { tyext_path; tyext_txt } ->
+ f ~namespace:Type sig_env tyext_path tyext_txt
+ | Tsig_value _ | Tsig_type _ | Tsig_typesubst _ | Tsig_exception _
+ | Tsig_module _ | Tsig_recmodule _ | Tsig_modtype _ | Tsig_modtypesubst _
+ | Tsig_open _ | Tsig_include _ | Tsig_class _ | Tsig_class_type _
+ | Tsig_attribute _ -> ());
+ default_iterator.signature_item sub sig_item);
+
+ structure_item =
+ (fun sub ({ str_desc; str_env; _ } as str_item) ->
+ (match str_desc with
+ | Tstr_exception {
+ tyexn_constructor = { ext_kind = Text_rebind (path, lid)}} ->
+ f ~namespace:Extension_constructor str_env path lid
+ | Tstr_typext { tyext_path; tyext_txt } ->
+ f ~namespace:Type str_env tyext_path tyext_txt
+ | Tstr_eval _ | Tstr_value _ | Tstr_primitive _ | Tstr_type _
+ | Tstr_exception _ | Tstr_module _ | Tstr_recmodule _
+ | Tstr_modtype _ | Tstr_open _ | Tstr_class _ | Tstr_class_type _
+ | Tstr_include _ | Tstr_attribute _ -> ());
+ default_iterator.structure_item sub str_item)
+}
+
+let index_declarations binary_annots =
+ let index : item_declaration Types.Uid.Tbl.t = Types.Uid.Tbl.create 16 in
+ let f uid fragment = Types.Uid.Tbl.add index uid fragment in
+ iter_on_annots (iter_on_declarations ~f) binary_annots;
+ index
+
+let index_occurrences binary_annots =
+ let index : (Longident.t Location.loc * Shape_reduce.result) list ref =
+ ref []
+ in
+ let f ~namespace env path lid =
+ let not_ghost { Location.loc = { loc_ghost; _ }; _ } = not loc_ghost in
+ if not_ghost lid then
+ match Env.shape_of_path ~namespace env path with
+ | exception Not_found -> ()
+ | { uid = Some (Predef _); _ } -> ()
+ | path_shape ->
+ let result = Shape_reduce.local_reduce_for_uid env path_shape in
+ index := (lid, result) :: !index
+ in
+ iter_on_annots (iter_on_occurrences ~f) binary_annots;
+ !index
+
+exception Error of error
+
+let input_cmt ic = (Compression.input_value ic : cmt_infos)
+
+let output_cmt oc cmt =
+ output_string oc Config.cmt_magic_number;
+ Compression.output_value oc (cmt : cmt_infos)
+
+let read filename =
+(* Printf.fprintf stderr "Cmt_format.read %s\n%!" filename; *)
+ let ic = open_in_bin filename in
+ Misc.try_finally
+ ~always:(fun () -> close_in ic)
+ (fun () ->
+ let magic_number = read_magic_number ic in
+ let cmi, cmt =
+ if magic_number = Config.cmt_magic_number then
+ None, Some (input_cmt ic)
+ else if magic_number = Config.cmi_magic_number then
+ let cmi = Cmi_format.input_cmi ic in
+ let cmt = try
+ let magic_number = read_magic_number ic in
+ if magic_number = Config.cmt_magic_number then
+ let cmt = input_cmt ic in
+ Some cmt
+ else None
+ with _ -> None
+ in
+ Some cmi, cmt
+ else
+ raise(Cmi_format.Error(Cmi_format.Not_an_interface filename))
+ in
+ cmi, cmt
+ )
+
+let read_cmt filename =
+ match read filename with
+ _, None -> raise (Error (Not_a_typedtree filename))
+ | _, Some cmt -> cmt
+
+let read_cmi filename =
+ match read filename with
+ None, _ ->
+ raise (Cmi_format.Error (Cmi_format.Not_an_interface filename))
+ | Some cmi, _ -> cmi
+
+let saved_types = ref []
+let uids_deps : (dependency_kind * Uid.t * Uid.t) list ref = ref []
+
+let clear () =
+ saved_types := [];
+ uids_deps := []
+
+let add_saved_type b = saved_types := b :: !saved_types
+let get_saved_types () = !saved_types
+let set_saved_types l = saved_types := l
+
+let record_declaration_dependency (rk, uid1, uid2) =
+ if not (Uid.equal uid1 uid2) then
+ uids_deps := (rk, uid1, uid2) :: !uids_deps
+
+let save_cmt target binary_annots initial_env cmi shape =
+ if !Clflags.binary_annotations && not !Clflags.print_types then begin
+ Misc.output_to_file_via_temporary
+ ~mode:[Open_binary] (Unit_info.Artifact.filename target)
+ (fun temp_file_name oc ->
+ let this_crc =
+ match cmi with
+ | None -> None
+ | Some cmi -> Some (output_cmi temp_file_name oc cmi)
+ in
+ let sourcefile = Unit_info.Artifact.source_file target in
+ let cmt_ident_occurrences =
+ if !Clflags.store_occurrences then
+ index_occurrences binary_annots
+ else
+ []
+ in
+ let cmt_annots = clear_env binary_annots in
+ let cmt_uid_to_decl = index_declarations cmt_annots in
+ let source_digest = Option.map Digest.file sourcefile in
+ let cmt = {
+ cmt_modname = Unit_info.Artifact.modname target;
+ cmt_annots;
+ cmt_declaration_dependencies = !uids_deps;
+ cmt_comments = Lexer.comments ();
+ cmt_args = Sys.argv;
+ cmt_sourcefile = sourcefile;
+ cmt_builddir = Location.rewrite_absolute_path (Sys.getcwd ());
+ cmt_loadpath = Load_path.get_paths ();
+ cmt_source_digest = source_digest;
+ cmt_initial_env = if need_to_clear_env then
+ keep_only_summary initial_env else initial_env;
+ cmt_imports = List.sort compare (Env.imports ());
+ cmt_interface_digest = this_crc;
+ cmt_use_summaries = need_to_clear_env;
+ cmt_uid_to_decl;
+ cmt_impl_shape = shape;
+ cmt_ident_occurrences;
+ } in
+ output_cmt oc cmt)
+ end;
+ clear ()
diff --git a/upstream/ocaml_503/file_formats/cmt_format.mli b/upstream/ocaml_503/file_formats/cmt_format.mli
new file mode 100644
index 0000000000..524283bc6f
--- /dev/null
+++ b/upstream/ocaml_503/file_formats/cmt_format.mli
@@ -0,0 +1,124 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(** cmt and cmti files format. *)
+
+open Misc
+
+(** The layout of a cmt file is as follows:
+ <cmt> := \{<cmi>\} <cmt magic> \{cmt infos\} \{<source info>\}
+ where <cmi> is the cmi file format:
+ <cmi> := <cmi magic> <cmi info>.
+ More precisely, the optional <cmi> part must be present if and only if
+ the file is:
+ - a cmti, or
+ - a cmt, for a ml file which has no corresponding mli (hence no
+ corresponding cmti).
+
+ Thus, we provide a common reading function for cmi and cmt(i)
+ files which returns an option for each of the three parts: cmi
+ info, cmt info, source info. *)
+
+open Typedtree
+
+type binary_annots =
+ | Packed of Types.signature * string list
+ | Implementation of structure
+ | Interface of signature
+ | Partial_implementation of binary_part array
+ | Partial_interface of binary_part array
+
+and binary_part =
+ | Partial_structure of structure
+ | Partial_structure_item of structure_item
+ | Partial_expression of expression
+ | Partial_pattern : 'k pattern_category * 'k general_pattern -> binary_part
+ | Partial_class_expr of class_expr
+ | Partial_signature of signature
+ | Partial_signature_item of signature_item
+ | Partial_module_type of module_type
+
+type dependency_kind = Definition_to_declaration | Declaration_to_declaration
+type cmt_infos = {
+ cmt_modname : modname;
+ cmt_annots : binary_annots;
+ cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
+ cmt_comments : (string * Location.t) list;
+ cmt_args : string array;
+ cmt_sourcefile : string option;
+ cmt_builddir : string;
+ cmt_loadpath : Load_path.paths;
+ cmt_source_digest : string option;
+ cmt_initial_env : Env.t;
+ cmt_imports : crcs;
+ cmt_interface_digest : Digest.t option;
+ cmt_use_summaries : bool;
+ cmt_uid_to_decl : item_declaration Shape.Uid.Tbl.t;
+ cmt_impl_shape : Shape.t option; (* None for mli *)
+ cmt_ident_occurrences :
+ (Longident.t Location.loc * Shape_reduce.result) list
+}
+
+type error =
+ Not_a_typedtree of string
+
+exception Error of error
+
+(** [read filename] opens filename, and extract both the cmi_infos, if
+ it exists, and the cmt_infos, if it exists. Thus, it can be used
+ with .cmi, .cmt and .cmti files.
+
+ .cmti files always contain a cmi_infos at the beginning. .cmt files
+ only contain a cmi_infos at the beginning if there is no associated
+ .cmti file.
+*)
+val read : string -> Cmi_format.cmi_infos option * cmt_infos option
+
+val read_cmt : string -> cmt_infos
+val read_cmi : string -> Cmi_format.cmi_infos
+
+(** [save_cmt filename modname binary_annots sourcefile initial_env cmi]
+ writes a cmt(i) file. *)
+val save_cmt :
+ Unit_info.Artifact.t ->
+ binary_annots ->
+ Env.t -> (* initial env *)
+ Cmi_format.cmi_infos option -> (* if a .cmi was generated *)
+ Shape.t option ->
+ unit
+
+(* Miscellaneous functions *)
+
+val read_magic_number : in_channel -> string
+
+val clear: unit -> unit
+
+val add_saved_type : binary_part -> unit
+val get_saved_types : unit -> binary_part list
+val set_saved_types : binary_part list -> unit
+
+val record_declaration_dependency: dependency_kind * Uid.t * Uid.t -> unit
+
+(*
+
+ val is_magic_number : string -> bool
+ val read : in_channel -> Env.cmi_infos option * t
+ val write_magic_number : out_channel -> unit
+ val write : out_channel -> t -> unit
+
+ val find : string list -> string -> string
+ val read_signature : 'a -> string -> Types.signature * 'b list * 'c list
+
+*)
diff --git a/upstream/ocaml_503/parsing/ast_helper.ml b/upstream/ocaml_503/parsing/ast_helper.ml
new file mode 100644
index 0000000000..daa73c4205
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_helper.ml
@@ -0,0 +1,653 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(** Helpers to produce Parsetree fragments *)
+
+open Asttypes
+open Parsetree
+open Docstrings
+
+type 'a with_loc = 'a Location.loc
+type loc = Location.t
+
+type lid = Longident.t with_loc
+type str = string with_loc
+type str_opt = string option with_loc
+type attrs = attribute list
+
+let default_loc = ref Location.none
+
+let with_default_loc l f =
+ Misc.protect_refs [Misc.R (default_loc, l)] f
+
+module Const = struct
+ let mk ?(loc = !default_loc) d =
+ {pconst_desc = d;
+ pconst_loc = loc}
+
+ let integer ?loc ?suffix i = mk ?loc (Pconst_integer (i, suffix))
+ let int ?loc ?suffix i = integer ?loc ?suffix (Int.to_string i)
+ let int32 ?loc ?(suffix='l') i = integer ?loc ~suffix (Int32.to_string i)
+ let int64 ?loc ?(suffix='L') i = integer ?loc ~suffix (Int64.to_string i)
+ let nativeint ?loc ?(suffix='n') i =
+ integer ?loc ~suffix (Nativeint.to_string i)
+ let float ?loc ?suffix f = mk ?loc (Pconst_float (f, suffix))
+ let char ?loc c = mk ?loc (Pconst_char c)
+ let string ?quotation_delimiter ?(loc= !default_loc) s =
+ mk ~loc (Pconst_string (s, loc, quotation_delimiter))
+end
+
+module Attr = struct
+ let mk ?(loc= !default_loc) name payload =
+ { attr_name = name;
+ attr_payload = payload;
+ attr_loc = loc }
+end
+
+module Typ = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) d =
+ {ptyp_desc = d;
+ ptyp_loc = loc;
+ ptyp_loc_stack = [];
+ ptyp_attributes = attrs}
+
+ let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]}
+
+ let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any
+ let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
+ let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c))
+ let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
+ let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
+ let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
+ let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))
+ let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
+ let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
+ let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
+ let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)
+ let open_ ?loc ?attrs mod_ident t = mk ?loc ?attrs (Ptyp_open (mod_ident, t))
+
+ let force_poly t =
+ match t.ptyp_desc with
+ | Ptyp_poly _ -> t
+ | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *)
+
+ let varify_constructors var_names t =
+ let check_variable vl loc v =
+ if List.mem v vl then
+ raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in
+ let var_names = List.map (fun v -> v.txt) var_names in
+ let rec loop t =
+ let desc =
+ match t.ptyp_desc with
+ | Ptyp_any -> Ptyp_any
+ | Ptyp_var x ->
+ check_variable var_names t.ptyp_loc x;
+ Ptyp_var x
+ | Ptyp_arrow (label,core_type,core_type') ->
+ Ptyp_arrow(label, loop core_type, loop core_type')
+ | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+ | Ptyp_constr( { txt = Longident.Lident s }, [])
+ when List.mem s var_names ->
+ Ptyp_var s
+ | Ptyp_constr(longident, lst) ->
+ Ptyp_constr(longident, List.map loop lst)
+ | Ptyp_object (lst, o) ->
+ Ptyp_object (List.map loop_object_field lst, o)
+ | Ptyp_class (longident, lst) ->
+ Ptyp_class (longident, List.map loop lst)
+ | Ptyp_alias(core_type, alias) ->
+ check_variable var_names alias.loc alias.txt;
+ Ptyp_alias(loop core_type, alias)
+ | Ptyp_variant(row_field_list, flag, lbl_lst_option) ->
+ Ptyp_variant(List.map loop_row_field row_field_list,
+ flag, lbl_lst_option)
+ | Ptyp_poly(string_lst, core_type) ->
+ List.iter (fun v ->
+ check_variable var_names t.ptyp_loc v.txt) string_lst;
+ Ptyp_poly(string_lst, loop core_type)
+ | Ptyp_package(longident,lst) ->
+ Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+ | Ptyp_open (mod_ident, core_type) ->
+ Ptyp_open (mod_ident, loop core_type)
+ | Ptyp_extension (s, arg) ->
+ Ptyp_extension (s, arg)
+ in
+ {t with ptyp_desc = desc}
+ and loop_row_field field =
+ let prf_desc = match field.prf_desc with
+ | Rtag(label,flag,lst) ->
+ Rtag(label,flag,List.map loop lst)
+ | Rinherit t ->
+ Rinherit (loop t)
+ in
+ { field with prf_desc; }
+ and loop_object_field field =
+ let pof_desc = match field.pof_desc with
+ | Otag(label, t) ->
+ Otag(label, loop t)
+ | Oinherit t ->
+ Oinherit (loop t)
+ in
+ { field with pof_desc; }
+ in
+ loop t
+
+end
+
+module Pat = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) d =
+ {ppat_desc = d;
+ ppat_loc = loc;
+ ppat_loc_stack = [];
+ ppat_attributes = attrs}
+ let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]}
+
+ let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any
+ let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a)
+ let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))
+ let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)
+ let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))
+ let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)
+ let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b))
+ let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))
+ let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b))
+ let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a)
+ let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b))
+ let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b))
+ let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a)
+ let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a)
+ let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
+ let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b))
+ let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)
+ let effect_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_effect(a, b))
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
+end
+
+module Exp = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) d =
+ {pexp_desc = d;
+ pexp_loc = loc;
+ pexp_loc_stack = [];
+ pexp_attributes = attrs}
+ let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]}
+
+ let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
+ let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
+ let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
+ let function_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_function (a, b, c))
+ let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b))
+ let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
+ let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))
+ let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a)
+ let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b))
+ let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b))
+ let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b))
+ let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b))
+ let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c))
+ let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a)
+ let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c))
+ let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b))
+ let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b))
+ let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e))
+ let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b))
+ let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c))
+ let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b))
+ let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a)
+ let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b))
+ let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a)
+ let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c))
+ let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b))
+ let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a)
+ let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a)
+ let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))
+ let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a)
+ let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))
+ let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
+ let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b))
+ let letop ?loc ?attrs let_ ands body =
+ mk ?loc ?attrs (Pexp_letop {let_; ands; body})
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
+ let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable
+
+ let case lhs ?guard rhs =
+ {
+ pc_lhs = lhs;
+ pc_guard = guard;
+ pc_rhs = rhs;
+ }
+
+ let binding_op op pat exp loc =
+ {
+ pbop_op = op;
+ pbop_pat = pat;
+ pbop_exp = exp;
+ pbop_loc = loc;
+ }
+end
+
+module Mty = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) d =
+ {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs}
+ let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]}
+
+ let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a)
+ let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a)
+ let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a)
+ let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b))
+ let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b))
+ let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a)
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a)
+end
+
+module Mod = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) d =
+ {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs}
+ let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]}
+
+ let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x)
+ let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x)
+ let functor_ ?loc ?attrs arg body =
+ mk ?loc ?attrs (Pmod_functor (arg, body))
+ let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2))
+ let apply_unit ?loc ?attrs m1 = mk ?loc ?attrs (Pmod_apply_unit m1)
+ let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))
+ let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a)
+end
+
+module Sig = struct
+ let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc}
+
+ let value ?loc a = mk ?loc (Psig_value a)
+ let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a))
+ let type_subst ?loc a = mk ?loc (Psig_typesubst a)
+ let type_extension ?loc a = mk ?loc (Psig_typext a)
+ let exception_ ?loc a = mk ?loc (Psig_exception a)
+ let module_ ?loc a = mk ?loc (Psig_module a)
+ let mod_subst ?loc a = mk ?loc (Psig_modsubst a)
+ let rec_module ?loc a = mk ?loc (Psig_recmodule a)
+ let modtype ?loc a = mk ?loc (Psig_modtype a)
+ let modtype_subst ?loc a = mk ?loc (Psig_modtypesubst a)
+ let open_ ?loc a = mk ?loc (Psig_open a)
+ let include_ ?loc a = mk ?loc (Psig_include a)
+ let class_ ?loc a = mk ?loc (Psig_class a)
+ let class_type ?loc a = mk ?loc (Psig_class_type a)
+ let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))
+ let attribute ?loc a = mk ?loc (Psig_attribute a)
+ let text txt =
+ let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ f_txt
+end
+
+module Str = struct
+ let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc}
+
+ let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs))
+ let value ?loc a b = mk ?loc (Pstr_value (a, b))
+ let primitive ?loc a = mk ?loc (Pstr_primitive a)
+ let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a))
+ let type_extension ?loc a = mk ?loc (Pstr_typext a)
+ let exception_ ?loc a = mk ?loc (Pstr_exception a)
+ let module_ ?loc a = mk ?loc (Pstr_module a)
+ let rec_module ?loc a = mk ?loc (Pstr_recmodule a)
+ let modtype ?loc a = mk ?loc (Pstr_modtype a)
+ let open_ ?loc a = mk ?loc (Pstr_open a)
+ let class_ ?loc a = mk ?loc (Pstr_class a)
+ let class_type ?loc a = mk ?loc (Pstr_class_type a)
+ let include_ ?loc a = mk ?loc (Pstr_include a)
+ let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
+ let attribute ?loc a = mk ?loc (Pstr_attribute a)
+ let text txt =
+ let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ f_txt
+end
+
+module Cl = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) d =
+ {
+ pcl_desc = d;
+ pcl_loc = loc;
+ pcl_attributes = attrs;
+ }
+ let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]}
+
+ let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b))
+ let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a)
+ let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d))
+ let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b))
+ let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c))
+ let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b))
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a)
+ let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b))
+end
+
+module Cty = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) d =
+ {
+ pcty_desc = d;
+ pcty_loc = loc;
+ pcty_attributes = attrs;
+ }
+ let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]}
+
+ let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b))
+ let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a)
+ let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c))
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a)
+ let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b))
+end
+
+module Ctf = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) d =
+ {
+ pctf_desc = d;
+ pctf_loc = loc;
+ pctf_attributes = add_docs_attrs docs attrs;
+ }
+
+ let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a)
+ let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d))
+ let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d))
+ let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b))
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)
+ let attribute ?loc a = mk ?loc (Pctf_attribute a)
+ let text txt =
+ let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ f_txt
+
+ let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]}
+
+end
+
+module Cf = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) d =
+ {
+ pcf_desc = d;
+ pcf_loc = loc;
+ pcf_attributes = add_docs_attrs docs attrs;
+ }
+
+ let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c))
+ let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c))
+ let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c))
+ let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b))
+ let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a)
+ let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)
+ let attribute ?loc a = mk ?loc (Pcf_attribute a)
+ let text txt =
+ let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ f_txt
+
+ let virtual_ ct = Cfk_virtual ct
+ let concrete o e = Cfk_concrete (o, e)
+
+ let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]}
+
+end
+
+module Val = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(prim = []) name typ =
+ {
+ pval_name = name;
+ pval_type = typ;
+ pval_attributes = add_docs_attrs docs attrs;
+ pval_loc = loc;
+ pval_prim = prim;
+ }
+end
+
+module Md = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = []) name typ =
+ {
+ pmd_name = name;
+ pmd_type = typ;
+ pmd_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
+ pmd_loc = loc;
+ }
+end
+
+module Ms = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = []) name syn =
+ {
+ pms_name = name;
+ pms_manifest = syn;
+ pms_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
+ pms_loc = loc;
+ }
+end
+
+module Mtd = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = []) ?typ name =
+ {
+ pmtd_name = name;
+ pmtd_type = typ;
+ pmtd_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
+ pmtd_loc = loc;
+ }
+end
+
+module Mb = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = []) name expr =
+ {
+ pmb_name = name;
+ pmb_expr = expr;
+ pmb_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
+ pmb_loc = loc;
+ }
+end
+
+module Opn = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(override = Fresh) expr =
+ {
+ popen_expr = expr;
+ popen_override = override;
+ popen_loc = loc;
+ popen_attributes = add_docs_attrs docs attrs;
+ }
+end
+
+module Incl = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr =
+ {
+ pincl_mod = mexpr;
+ pincl_loc = loc;
+ pincl_attributes = add_docs_attrs docs attrs;
+ }
+
+end
+
+module Vb = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(text = []) ?value_constraint pat expr =
+ {
+ pvb_pat = pat;
+ pvb_expr = expr;
+ pvb_constraint=value_constraint;
+ pvb_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
+ pvb_loc = loc;
+ }
+end
+
+module Ci = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = [])
+ ?(virt = Concrete) ?(params = []) name expr =
+ {
+ pci_virt = virt;
+ pci_params = params;
+ pci_name = name;
+ pci_expr = expr;
+ pci_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
+ pci_loc = loc;
+ }
+end
+
+module Type = struct
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = [])
+ ?(params = [])
+ ?(cstrs = [])
+ ?(kind = Ptype_abstract)
+ ?(priv = Public)
+ ?manifest
+ name =
+ {
+ ptype_name = name;
+ ptype_params = params;
+ ptype_cstrs = cstrs;
+ ptype_kind = kind;
+ ptype_private = priv;
+ ptype_manifest = manifest;
+ ptype_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
+ ptype_loc = loc;
+ }
+
+ let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)
+ ?(vars = []) ?(args = Pcstr_tuple []) ?res name =
+ {
+ pcd_name = name;
+ pcd_vars = vars;
+ pcd_args = args;
+ pcd_res = res;
+ pcd_loc = loc;
+ pcd_attributes = add_info_attrs info attrs;
+ }
+
+ let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)
+ ?(mut = Immutable) name typ =
+ {
+ pld_name = name;
+ pld_mutable = mut;
+ pld_type = typ;
+ pld_loc = loc;
+ pld_attributes = add_info_attrs info attrs;
+ }
+
+end
+
+(** Type extensions *)
+module Te = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(params = []) ?(priv = Public) path constructors =
+ {
+ ptyext_path = path;
+ ptyext_params = params;
+ ptyext_constructors = constructors;
+ ptyext_private = priv;
+ ptyext_loc = loc;
+ ptyext_attributes = add_docs_attrs docs attrs;
+ }
+
+ let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ constructor =
+ {
+ ptyexn_constructor = constructor;
+ ptyexn_loc = loc;
+ ptyexn_attributes = add_docs_attrs docs attrs;
+ }
+
+ let constructor ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(info = empty_info) name kind =
+ {
+ pext_name = name;
+ pext_kind = kind;
+ pext_loc = loc;
+ pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
+ }
+
+ let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(info = empty_info) ?(vars = []) ?(args = Pcstr_tuple []) ?res name =
+ {
+ pext_name = name;
+ pext_kind = Pext_decl(vars, args, res);
+ pext_loc = loc;
+ pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
+ }
+
+ let rebind ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(info = empty_info) name lid =
+ {
+ pext_name = name;
+ pext_kind = Pext_rebind lid;
+ pext_loc = loc;
+ pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
+ }
+end
+
+module Csig = struct
+ let mk self fields =
+ {
+ pcsig_self = self;
+ pcsig_fields = fields;
+ }
+end
+
+module Cstr = struct
+ let mk self fields =
+ {
+ pcstr_self = self;
+ pcstr_fields = fields;
+ }
+end
+
+(** Row fields *)
+module Rf = struct
+ let mk ?(loc = !default_loc) ?(attrs = []) desc = {
+ prf_desc = desc;
+ prf_loc = loc;
+ prf_attributes = attrs;
+ }
+ let tag ?loc ?attrs label const tys =
+ mk ?loc ?attrs (Rtag (label, const, tys))
+ let inherit_?loc ty =
+ mk ?loc (Rinherit ty)
+end
+
+(** Object fields *)
+module Of = struct
+ let mk ?(loc = !default_loc) ?(attrs=[]) desc = {
+ pof_desc = desc;
+ pof_loc = loc;
+ pof_attributes = attrs;
+ }
+ let tag ?loc ?attrs label ty =
+ mk ?loc ?attrs (Otag (label, ty))
+ let inherit_ ?loc ty =
+ mk ?loc (Oinherit ty)
+end
diff --git a/upstream/ocaml_503/parsing/ast_helper.mli b/upstream/ocaml_503/parsing/ast_helper.mli
new file mode 100644
index 0000000000..6a8a0fa368
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_helper.mli
@@ -0,0 +1,501 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(** Helpers to produce Parsetree fragments
+
+ {b Warning} This module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Asttypes
+open Docstrings
+open Parsetree
+
+type 'a with_loc = 'a Location.loc
+type loc = Location.t
+
+type lid = Longident.t with_loc
+type str = string with_loc
+type str_opt = string option with_loc
+type attrs = attribute list
+
+(** {1 Default locations} *)
+
+val default_loc: loc ref
+ (** Default value for all optional location arguments. *)
+
+val with_default_loc: loc -> (unit -> 'a) -> 'a
+ (** Set the [default_loc] within the scope of the execution
+ of the provided function. *)
+
+(** {1 Constants} *)
+
+module Const : sig
+ val mk : ?loc:loc -> constant_desc -> constant
+ val char : ?loc:loc -> char -> constant
+ val string :
+ ?quotation_delimiter:string -> ?loc:Location.t -> string -> constant
+ val integer : ?loc:loc -> ?suffix:char -> string -> constant
+ val int : ?loc:loc -> ?suffix:char -> int -> constant
+ val int32 : ?loc:loc -> ?suffix:char -> int32 -> constant
+ val int64 : ?loc:loc -> ?suffix:char -> int64 -> constant
+ val nativeint : ?loc:loc -> ?suffix:char -> nativeint -> constant
+ val float : ?loc:loc -> ?suffix:char -> string -> constant
+end
+
+(** {1 Attributes} *)
+module Attr : sig
+ val mk: ?loc:loc -> str -> payload -> attribute
+end
+
+(** {1 Core language} *)
+
+(** Type expressions *)
+module Typ :
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type
+ val attr: core_type -> attribute -> core_type
+
+ val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type
+ val var: ?loc:loc -> ?attrs:attrs -> string -> core_type
+ val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type
+ -> core_type
+ val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
+ val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+ val object_: ?loc:loc -> ?attrs:attrs -> object_field list
+ -> closed_flag -> core_type
+ val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+ val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string with_loc
+ -> core_type
+ val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag
+ -> label list option -> core_type
+ val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type
+ val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list
+ -> core_type
+ val open_ : ?loc:loc -> ?attrs:attrs -> lid -> core_type -> core_type
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type
+
+ val force_poly: core_type -> core_type
+
+ val varify_constructors: str list -> core_type -> core_type
+ (** [varify_constructors newtypes te] is type expression [te], of which
+ any of nullary type constructor [tc] is replaced by type variable of
+ the same name, if [tc]'s name appears in [newtypes].
+ Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te]
+ appears in [newtypes].
+ @since 4.05
+ *)
+ end
+
+(** Patterns *)
+module Pat:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern
+ val attr:pattern -> attribute -> pattern
+
+ val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern
+ val var: ?loc:loc -> ?attrs:attrs -> str -> pattern
+ val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern
+ val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern
+ val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
+ val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+ val construct: ?loc:loc -> ?attrs:attrs ->
+ lid -> (str list * pattern) option -> pattern
+ val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
+ val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag
+ -> pattern
+ val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+ val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
+ val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern
+ val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern
+ val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+ val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern
+ val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern
+ val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+ val effect_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
+ end
+
+(** Expressions *)
+module Exp:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression
+ val attr: expression -> attribute -> expression
+
+ val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression
+ val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression
+ val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list
+ -> expression -> expression
+ val function_ : ?loc:loc -> ?attrs:attrs -> function_param list
+ -> type_constraint option -> function_body
+ -> expression
+ val apply: ?loc:loc -> ?attrs:attrs -> expression
+ -> (arg_label * expression) list -> expression
+ val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list
+ -> expression
+ val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
+ val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression
+ val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option
+ -> expression
+ val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option
+ -> expression
+ val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list
+ -> expression option -> expression
+ val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+ val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+ -> expression
+ val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression
+ val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression
+ -> expression option -> expression
+ val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression
+ -> expression
+ val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+ -> expression
+ val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression
+ -> direction_flag -> expression -> expression
+ val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option
+ -> core_type -> expression
+ val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type
+ -> expression
+ val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression
+ val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression
+ val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
+ val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list
+ -> expression
+ val letmodule: ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr
+ -> expression -> expression
+ val letexception:
+ ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression
+ -> expression
+ val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+ val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+ val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option
+ -> expression
+ val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression
+ val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
+ val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression
+ val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression
+ -> expression
+ val letop: ?loc:loc -> ?attrs:attrs -> binding_op
+ -> binding_op list -> expression -> expression
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression
+ val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression
+
+ val case: pattern -> ?guard:expression -> expression -> case
+ val binding_op: str -> pattern -> expression -> loc -> binding_op
+ end
+
+(** Value declarations *)
+module Val:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+ ?prim:string list -> str -> core_type -> value_description
+ end
+
+(** Type declarations *)
+module Type:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ ?params:(core_type * (variance * injectivity)) list ->
+ ?cstrs:(core_type * core_type * loc) list ->
+ ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str ->
+ type_declaration
+
+ val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info ->
+ ?vars:str list -> ?args:constructor_arguments -> ?res:core_type ->
+ str ->
+ constructor_declaration
+ val field: ?loc:loc -> ?attrs:attrs -> ?info:info ->
+ ?mut:mutable_flag -> str -> core_type -> label_declaration
+ end
+
+(** Type extensions *)
+module Te:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+ ?params:(core_type * (variance * injectivity)) list ->
+ ?priv:private_flag -> lid -> extension_constructor list -> type_extension
+
+ val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+ extension_constructor -> type_exception
+
+ val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+ str -> extension_constructor_kind -> extension_constructor
+
+ val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+ ?vars:str list -> ?args:constructor_arguments -> ?res:core_type ->
+ str ->
+ extension_constructor
+ val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+ str -> lid -> extension_constructor
+ end
+
+(** {1 Module language} *)
+
+(** Module type expressions *)
+module Mty:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type
+ val attr: module_type -> attribute -> module_type
+
+ val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type
+ val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type
+ val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type
+ val functor_: ?loc:loc -> ?attrs:attrs ->
+ functor_parameter -> module_type -> module_type
+ val with_: ?loc:loc -> ?attrs:attrs -> module_type ->
+ with_constraint list -> module_type
+ val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type
+ end
+
+(** Module expressions *)
+module Mod:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr
+ val attr: module_expr -> attribute -> module_expr
+
+ val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr
+ val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr
+ val functor_: ?loc:loc -> ?attrs:attrs ->
+ functor_parameter -> module_expr -> module_expr
+ val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr ->
+ module_expr
+ val apply_unit: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr
+ val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type ->
+ module_expr
+ val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr
+ end
+
+(** Signature items *)
+module Sig:
+ sig
+ val mk: ?loc:loc -> signature_item_desc -> signature_item
+
+ val value: ?loc:loc -> value_description -> signature_item
+ val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item
+ val type_subst: ?loc:loc -> type_declaration list -> signature_item
+ val type_extension: ?loc:loc -> type_extension -> signature_item
+ val exception_: ?loc:loc -> type_exception -> signature_item
+ val module_: ?loc:loc -> module_declaration -> signature_item
+ val mod_subst: ?loc:loc -> module_substitution -> signature_item
+ val rec_module: ?loc:loc -> module_declaration list -> signature_item
+ val modtype: ?loc:loc -> module_type_declaration -> signature_item
+ val modtype_subst: ?loc:loc -> module_type_declaration -> signature_item
+ val open_: ?loc:loc -> open_description -> signature_item
+ val include_: ?loc:loc -> include_description -> signature_item
+ val class_: ?loc:loc -> class_description list -> signature_item
+ val class_type: ?loc:loc -> class_type_declaration list -> signature_item
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item
+ val attribute: ?loc:loc -> attribute -> signature_item
+ val text: text -> signature_item list
+ end
+
+(** Structure items *)
+module Str:
+ sig
+ val mk: ?loc:loc -> structure_item_desc -> structure_item
+
+ val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item
+ val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item
+ val primitive: ?loc:loc -> value_description -> structure_item
+ val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item
+ val type_extension: ?loc:loc -> type_extension -> structure_item
+ val exception_: ?loc:loc -> type_exception -> structure_item
+ val module_: ?loc:loc -> module_binding -> structure_item
+ val rec_module: ?loc:loc -> module_binding list -> structure_item
+ val modtype: ?loc:loc -> module_type_declaration -> structure_item
+ val open_: ?loc:loc -> open_declaration -> structure_item
+ val class_: ?loc:loc -> class_declaration list -> structure_item
+ val class_type: ?loc:loc -> class_type_declaration list -> structure_item
+ val include_: ?loc:loc -> include_declaration -> structure_item
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item
+ val attribute: ?loc:loc -> attribute -> structure_item
+ val text: text -> structure_item list
+ end
+
+(** Module declarations *)
+module Md:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ str_opt -> module_type -> module_declaration
+ end
+
+(** Module substitutions *)
+module Ms:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ str -> lid -> module_substitution
+ end
+
+(** Module type declarations *)
+module Mtd:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ ?typ:module_type -> str -> module_type_declaration
+ end
+
+(** Module bindings *)
+module Mb:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ str_opt -> module_expr -> module_binding
+ end
+
+(** Opens *)
+module Opn:
+ sig
+ val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs ->
+ ?override:override_flag -> 'a -> 'a open_infos
+ end
+
+(** Includes *)
+module Incl:
+ sig
+ val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos
+ end
+
+(** Value bindings *)
+module Vb:
+ sig
+ val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ ?value_constraint:value_constraint -> pattern -> expression ->
+ value_binding
+ end
+
+
+(** {1 Class language} *)
+
+(** Class type expressions *)
+module Cty:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type
+ val attr: class_type -> attribute -> class_type
+
+ val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type
+ val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type
+ val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type ->
+ class_type -> class_type
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type
+ val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type
+ -> class_type
+ end
+
+(** Class type fields *)
+module Ctf:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+ class_type_field_desc -> class_type_field
+ val attr: class_type_field -> attribute -> class_type_field
+
+ val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field
+ val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag ->
+ virtual_flag -> core_type -> class_type_field
+ val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag ->
+ virtual_flag -> core_type -> class_type_field
+ val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type ->
+ class_type_field
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field
+ val attribute: ?loc:loc -> attribute -> class_type_field
+ val text: text -> class_type_field list
+ end
+
+(** Class expressions *)
+module Cl:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr
+ val attr: class_expr -> attribute -> class_expr
+
+ val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr
+ val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr
+ val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option ->
+ pattern -> class_expr -> class_expr
+ val apply: ?loc:loc -> ?attrs:attrs -> class_expr ->
+ (arg_label * expression) list -> class_expr
+ val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list ->
+ class_expr -> class_expr
+ val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type ->
+ class_expr
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr
+ val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr
+ -> class_expr
+ end
+
+(** Class fields *)
+module Cf:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc ->
+ class_field
+ val attr: class_field -> attribute -> class_field
+
+ val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr ->
+ str option -> class_field
+ val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag ->
+ class_field_kind -> class_field
+ val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag ->
+ class_field_kind -> class_field
+ val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type ->
+ class_field
+ val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field
+ val attribute: ?loc:loc -> attribute -> class_field
+ val text: text -> class_field list
+
+ val virtual_: core_type -> class_field_kind
+ val concrete: override_flag -> expression -> class_field_kind
+
+ end
+
+(** Classes *)
+module Ci:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ ?virt:virtual_flag ->
+ ?params:(core_type * (variance * injectivity)) list ->
+ str -> 'a -> 'a class_infos
+ end
+
+(** Class signatures *)
+module Csig:
+ sig
+ val mk: core_type -> class_type_field list -> class_signature
+ end
+
+(** Class structures *)
+module Cstr:
+ sig
+ val mk: pattern -> class_field list -> class_structure
+ end
+
+(** Row fields *)
+module Rf:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field
+ val tag: ?loc:loc -> ?attrs:attrs ->
+ label with_loc -> bool -> core_type list -> row_field
+ val inherit_: ?loc:loc -> core_type -> row_field
+ end
+
+(** Object fields *)
+module Of:
+ sig
+ val mk: ?loc:loc -> ?attrs:attrs ->
+ object_field_desc -> object_field
+ val tag: ?loc:loc -> ?attrs:attrs ->
+ label with_loc -> core_type -> object_field
+ val inherit_: ?loc:loc -> core_type -> object_field
+ end
diff --git a/upstream/ocaml_503/parsing/ast_invariants.ml b/upstream/ocaml_503/parsing/ast_invariants.ml
new file mode 100644
index 0000000000..53e8a1629c
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_invariants.ml
@@ -0,0 +1,213 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2015 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Parsetree
+open Ast_iterator
+
+let err = Syntaxerr.ill_formed_ast
+
+let empty_record loc = err loc "Records cannot be empty."
+let invalid_tuple loc = err loc "Tuples must have at least 2 components."
+let no_args loc = err loc "Function application with no argument."
+let empty_let loc = err loc "Let with no bindings."
+let empty_type loc = err loc "Type declarations cannot be empty."
+let empty_poly_binder loc =
+ err loc "Explicit universal type quantification cannot be empty."
+let complex_id loc = err loc "Functor application not allowed here."
+let module_type_substitution_missing_rhs loc =
+ err loc "Module type substitution with no right hand side"
+let function_without_value_parameters loc =
+ err loc "Function without any value parameters"
+
+let simple_longident id =
+ let rec is_simple = function
+ | Longident.Lident _ -> true
+ | Longident.Ldot (id, _) -> is_simple id
+ | Longident.Lapply _ -> false
+ in
+ if not (is_simple id.txt) then complex_id id.loc
+
+let iterator =
+ let super = Ast_iterator.default_iterator in
+ let type_declaration self td =
+ super.type_declaration self td;
+ let loc = td.ptype_loc in
+ match td.ptype_kind with
+ | Ptype_record [] -> empty_record loc
+ | _ -> ()
+ in
+ let typ self ty =
+ super.typ self ty;
+ let loc = ty.ptyp_loc in
+ match ty.ptyp_desc with
+ | Ptyp_tuple ([] | [_]) -> invalid_tuple loc
+ | Ptyp_package (_, cstrs) ->
+ List.iter (fun (id, _) -> simple_longident id) cstrs
+ | Ptyp_poly([],_) -> empty_poly_binder loc
+ | _ -> ()
+ in
+ let pat self pat =
+ begin match pat.ppat_desc with
+ | Ppat_construct (_, Some (_, ({ppat_desc = Ppat_tuple _} as p)))
+ when Builtin_attributes.explicit_arity pat.ppat_attributes ->
+ super.pat self p (* allow unary tuple, see GPR#523. *)
+ | _ ->
+ super.pat self pat
+ end;
+ let loc = pat.ppat_loc in
+ match pat.ppat_desc with
+ | Ppat_tuple ([] | [_]) -> invalid_tuple loc
+ | Ppat_record ([], _) -> empty_record loc
+ | Ppat_construct (id, _) -> simple_longident id
+ | Ppat_record (fields, _) ->
+ List.iter (fun (id, _) -> simple_longident id) fields
+ | _ -> ()
+ in
+ let expr self exp =
+ begin match exp.pexp_desc with
+ | Pexp_construct (_, Some ({pexp_desc = Pexp_tuple _} as e))
+ when Builtin_attributes.explicit_arity exp.pexp_attributes ->
+ super.expr self e (* allow unary tuple, see GPR#523. *)
+ | _ ->
+ super.expr self exp
+ end;
+ let loc = exp.pexp_loc in
+ match exp.pexp_desc with
+ | Pexp_tuple ([] | [_]) -> invalid_tuple loc
+ | Pexp_record ([], _) -> empty_record loc
+ | Pexp_apply (_, []) -> no_args loc
+ | Pexp_let (_, [], _) -> empty_let loc
+ | Pexp_ident id
+ | Pexp_construct (id, _)
+ | Pexp_field (_, id)
+ | Pexp_setfield (_, id, _)
+ | Pexp_new id -> simple_longident id
+ | Pexp_record (fields, _) ->
+ List.iter (fun (id, _) -> simple_longident id) fields
+ | Pexp_function (params, _, Pfunction_body _) ->
+ if
+ List.for_all
+ (function
+ | { pparam_desc = Pparam_newtype _ } -> true
+ | { pparam_desc = Pparam_val _ } -> false)
+ params
+ then function_without_value_parameters loc
+ | _ -> ()
+ in
+ let extension_constructor self ec =
+ super.extension_constructor self ec;
+ match ec.pext_kind with
+ | Pext_rebind id -> simple_longident id
+ | _ -> ()
+ in
+ let class_expr self ce =
+ super.class_expr self ce;
+ let loc = ce.pcl_loc in
+ match ce.pcl_desc with
+ | Pcl_apply (_, []) -> no_args loc
+ | Pcl_constr (id, _) -> simple_longident id
+ | _ -> ()
+ in
+ let module_type self mty =
+ super.module_type self mty;
+ match mty.pmty_desc with
+ | Pmty_alias id -> simple_longident id
+ | _ -> ()
+ in
+ let open_description self opn =
+ super.open_description self opn
+ in
+ let with_constraint self wc =
+ super.with_constraint self wc;
+ match wc with
+ | Pwith_type (id, _)
+ | Pwith_module (id, _) -> simple_longident id
+ | _ -> ()
+ in
+ let module_expr self me =
+ super.module_expr self me;
+ match me.pmod_desc with
+ | Pmod_ident id -> simple_longident id
+ | _ -> ()
+ in
+ let structure_item self st =
+ super.structure_item self st;
+ let loc = st.pstr_loc in
+ match st.pstr_desc with
+ | Pstr_type (_, []) -> empty_type loc
+ | Pstr_value (_, []) -> empty_let loc
+ | _ -> ()
+ in
+ let signature_item self sg =
+ super.signature_item self sg;
+ let loc = sg.psig_loc in
+ match sg.psig_desc with
+ | Psig_type (_, []) -> empty_type loc
+ | Psig_modtypesubst {pmtd_type=None; _ } ->
+ module_type_substitution_missing_rhs loc
+ | _ -> ()
+ in
+ let row_field self field =
+ super.row_field self field;
+ let loc = field.prf_loc in
+ match field.prf_desc with
+ | Rtag _ -> ()
+ | Rinherit _ ->
+ if field.prf_attributes = []
+ then ()
+ else err loc
+ "In variant types, attaching attributes to inherited \
+ subtypes is not allowed."
+ in
+ let object_field self field =
+ super.object_field self field;
+ let loc = field.pof_loc in
+ match field.pof_desc with
+ | Otag _ -> ()
+ | Oinherit _ ->
+ if field.pof_attributes = []
+ then ()
+ else err loc
+ "In object types, attaching attributes to inherited \
+ subtypes is not allowed."
+ in
+ let attribute self attr =
+ (* The change to `self` here avoids registering attributes within attributes
+ for the purposes of warning 53, while keeping all the other invariant
+ checks for attribute payloads. See comment on [current_phase] in
+ [builtin_attributes.mli]. *)
+ super.attribute { self with attribute = super.attribute } attr;
+ Builtin_attributes.(register_attr Invariant_check attr.attr_name)
+ in
+ { super with
+ type_declaration
+ ; typ
+ ; pat
+ ; expr
+ ; extension_constructor
+ ; class_expr
+ ; module_expr
+ ; module_type
+ ; open_description
+ ; with_constraint
+ ; structure_item
+ ; signature_item
+ ; row_field
+ ; object_field
+ ; attribute
+ }
+
+let structure st = iterator.structure iterator st
+let signature sg = iterator.signature iterator sg
diff --git a/upstream/ocaml_503/parsing/ast_invariants.mli b/upstream/ocaml_503/parsing/ast_invariants.mli
new file mode 100644
index 0000000000..fdb56aa5ef
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_invariants.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2015 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Check AST invariants
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val structure : Parsetree.structure -> unit
+val signature : Parsetree.signature -> unit
diff --git a/upstream/ocaml_503/parsing/ast_iterator.ml b/upstream/ocaml_503/parsing/ast_iterator.ml
new file mode 100644
index 0000000000..389a9a4042
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_iterator.ml
@@ -0,0 +1,747 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(* A generic Parsetree mapping class *)
+
+(*
+[@@@ocaml.warning "+9"]
+ (* Ensure that record patterns don't miss any field. *)
+*)
+
+
+open Parsetree
+open Location
+
+type iterator = {
+ attribute: iterator -> attribute -> unit;
+ attributes: iterator -> attribute list -> unit;
+ binding_op: iterator -> binding_op -> unit;
+ case: iterator -> case -> unit;
+ cases: iterator -> case list -> unit;
+ class_declaration: iterator -> class_declaration -> unit;
+ class_description: iterator -> class_description -> unit;
+ class_expr: iterator -> class_expr -> unit;
+ class_field: iterator -> class_field -> unit;
+ class_signature: iterator -> class_signature -> unit;
+ class_structure: iterator -> class_structure -> unit;
+ class_type: iterator -> class_type -> unit;
+ class_type_declaration: iterator -> class_type_declaration -> unit;
+ class_type_field: iterator -> class_type_field -> unit;
+ constructor_declaration: iterator -> constructor_declaration -> unit;
+ directive_argument: iterator -> directive_argument -> unit;
+ expr: iterator -> expression -> unit;
+ extension: iterator -> extension -> unit;
+ extension_constructor: iterator -> extension_constructor -> unit;
+ include_declaration: iterator -> include_declaration -> unit;
+ include_description: iterator -> include_description -> unit;
+ label_declaration: iterator -> label_declaration -> unit;
+ location: iterator -> Location.t -> unit;
+ module_binding: iterator -> module_binding -> unit;
+ module_declaration: iterator -> module_declaration -> unit;
+ module_substitution: iterator -> module_substitution -> unit;
+ module_expr: iterator -> module_expr -> unit;
+ module_type: iterator -> module_type -> unit;
+ module_type_declaration: iterator -> module_type_declaration -> unit;
+ open_declaration: iterator -> open_declaration -> unit;
+ open_description: iterator -> open_description -> unit;
+ pat: iterator -> pattern -> unit;
+ payload: iterator -> payload -> unit;
+ signature: iterator -> signature -> unit;
+ signature_item: iterator -> signature_item -> unit;
+ structure: iterator -> structure -> unit;
+ structure_item: iterator -> structure_item -> unit;
+ toplevel_directive: iterator -> toplevel_directive -> unit;
+ toplevel_phrase: iterator -> toplevel_phrase -> unit;
+ typ: iterator -> core_type -> unit;
+ row_field: iterator -> row_field -> unit;
+ object_field: iterator -> object_field -> unit;
+ type_declaration: iterator -> type_declaration -> unit;
+ type_extension: iterator -> type_extension -> unit;
+ type_exception: iterator -> type_exception -> unit;
+ type_kind: iterator -> type_kind -> unit;
+ value_binding: iterator -> value_binding -> unit;
+ value_description: iterator -> value_description -> unit;
+ with_constraint: iterator -> with_constraint -> unit;
+}
+(** A [iterator] record implements one "method" per syntactic category,
+ using an open recursion style: each method takes as its first
+ argument the iterator to be applied to children in the syntax
+ tree. *)
+
+let iter_fst f (x, _) = f x
+let iter_snd f (_, y) = f y
+let iter_tuple f1 f2 (x, y) = f1 x; f2 y
+let iter_tuple3 f1 f2 f3 (x, y, z) = f1 x; f2 y; f3 z
+let iter_opt f = function None -> () | Some x -> f x
+
+let iter_loc sub {loc; txt = _} = sub.location sub loc
+
+module T = struct
+ (* Type expressions for the core language *)
+
+ let row_field sub {
+ prf_desc;
+ prf_loc;
+ prf_attributes;
+ } =
+ sub.location sub prf_loc;
+ sub.attributes sub prf_attributes;
+ match prf_desc with
+ | Rtag (_, _, tl) -> List.iter (sub.typ sub) tl
+ | Rinherit t -> sub.typ sub t
+
+ let object_field sub {
+ pof_desc;
+ pof_loc;
+ pof_attributes;
+ } =
+ sub.location sub pof_loc;
+ sub.attributes sub pof_attributes;
+ match pof_desc with
+ | Otag (_, t) -> sub.typ sub t
+ | Oinherit t -> sub.typ sub t
+
+ let iter sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Ptyp_any
+ | Ptyp_var _ -> ()
+ | Ptyp_arrow (_lab, t1, t2) ->
+ sub.typ sub t1; sub.typ sub t2
+ | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl
+ | Ptyp_constr (lid, tl) ->
+ iter_loc sub lid; List.iter (sub.typ sub) tl
+ | Ptyp_object (ol, _o) ->
+ List.iter (object_field sub) ol
+ | Ptyp_class (lid, tl) ->
+ iter_loc sub lid; List.iter (sub.typ sub) tl
+ | Ptyp_alias (t, _) -> sub.typ sub t
+ | Ptyp_variant (rl, _b, _ll) ->
+ List.iter (row_field sub) rl
+ | Ptyp_poly (_, t) -> sub.typ sub t
+ | Ptyp_package (lid, l) ->
+ iter_loc sub lid;
+ List.iter (iter_tuple (iter_loc sub) (sub.typ sub)) l
+ | Ptyp_open (mod_ident, t) ->
+ iter_loc sub mod_ident;
+ sub.typ sub t
+ | Ptyp_extension x -> sub.extension sub x
+
+ let iter_type_declaration sub
+ {ptype_name; ptype_params; ptype_cstrs;
+ ptype_kind;
+ ptype_private = _;
+ ptype_manifest;
+ ptype_attributes;
+ ptype_loc} =
+ iter_loc sub ptype_name;
+ List.iter (iter_fst (sub.typ sub)) ptype_params;
+ List.iter
+ (iter_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub))
+ ptype_cstrs;
+ sub.type_kind sub ptype_kind;
+ iter_opt (sub.typ sub) ptype_manifest;
+ sub.location sub ptype_loc;
+ sub.attributes sub ptype_attributes
+
+ let iter_type_kind sub = function
+ | Ptype_abstract -> ()
+ | Ptype_variant l ->
+ List.iter (sub.constructor_declaration sub) l
+ | Ptype_record l -> List.iter (sub.label_declaration sub) l
+ | Ptype_open -> ()
+
+ let iter_constructor_arguments sub = function
+ | Pcstr_tuple l -> List.iter (sub.typ sub) l
+ | Pcstr_record l ->
+ List.iter (sub.label_declaration sub) l
+
+ let iter_type_extension sub
+ {ptyext_path; ptyext_params;
+ ptyext_constructors;
+ ptyext_private = _;
+ ptyext_loc;
+ ptyext_attributes} =
+ iter_loc sub ptyext_path;
+ List.iter (sub.extension_constructor sub) ptyext_constructors;
+ List.iter (iter_fst (sub.typ sub)) ptyext_params;
+ sub.location sub ptyext_loc;
+ sub.attributes sub ptyext_attributes
+
+ let iter_type_exception sub
+ {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} =
+ sub.extension_constructor sub ptyexn_constructor;
+ sub.location sub ptyexn_loc;
+ sub.attributes sub ptyexn_attributes
+
+ let iter_extension_constructor_kind sub = function
+ Pext_decl(vars, ctl, cto) ->
+ List.iter (iter_loc sub) vars;
+ iter_constructor_arguments sub ctl;
+ iter_opt (sub.typ sub) cto
+ | Pext_rebind li ->
+ iter_loc sub li
+
+ let iter_extension_constructor sub
+ {pext_name;
+ pext_kind;
+ pext_loc;
+ pext_attributes} =
+ iter_loc sub pext_name;
+ iter_extension_constructor_kind sub pext_kind;
+ sub.location sub pext_loc;
+ sub.attributes sub pext_attributes
+
+end
+
+module CT = struct
+ (* Type expressions for the class language *)
+
+ let iter sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Pcty_constr (lid, tys) ->
+ iter_loc sub lid; List.iter (sub.typ sub) tys
+ | Pcty_signature x -> sub.class_signature sub x
+ | Pcty_arrow (_lab, t, ct) ->
+ sub.typ sub t; sub.class_type sub ct
+ | Pcty_extension x -> sub.extension sub x
+ | Pcty_open (o, e) ->
+ sub.open_description sub o; sub.class_type sub e
+
+ let iter_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs}
+ =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Pctf_inherit ct -> sub.class_type sub ct
+ | Pctf_val (_s, _m, _v, t) -> sub.typ sub t
+ | Pctf_method (_s, _p, _v, t) -> sub.typ sub t
+ | Pctf_constraint (t1, t2) ->
+ sub.typ sub t1; sub.typ sub t2
+ | Pctf_attribute x -> sub.attribute sub x
+ | Pctf_extension x -> sub.extension sub x
+
+ let iter_signature sub {pcsig_self; pcsig_fields} =
+ sub.typ sub pcsig_self;
+ List.iter (sub.class_type_field sub) pcsig_fields
+end
+
+let iter_functor_param sub = function
+ | Unit -> ()
+ | Named (name, mty) ->
+ iter_loc sub name;
+ sub.module_type sub mty
+
+module MT = struct
+ (* Type expressions for the module language *)
+
+ let iter sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Pmty_ident s -> iter_loc sub s
+ | Pmty_alias s -> iter_loc sub s
+ | Pmty_signature sg -> sub.signature sub sg
+ | Pmty_functor (param, mt2) ->
+ iter_functor_param sub param;
+ sub.module_type sub mt2
+ | Pmty_with (mt, l) ->
+ sub.module_type sub mt;
+ List.iter (sub.with_constraint sub) l
+ | Pmty_typeof me -> sub.module_expr sub me
+ | Pmty_extension x -> sub.extension sub x
+
+ let iter_with_constraint sub = function
+ | Pwith_type (lid, d) ->
+ iter_loc sub lid; sub.type_declaration sub d
+ | Pwith_module (lid, lid2) ->
+ iter_loc sub lid; iter_loc sub lid2
+ | Pwith_modtype (lid, mty) ->
+ iter_loc sub lid; sub.module_type sub mty
+ | Pwith_typesubst (lid, d) ->
+ iter_loc sub lid; sub.type_declaration sub d
+ | Pwith_modsubst (s, lid) ->
+ iter_loc sub s; iter_loc sub lid
+ | Pwith_modtypesubst (lid, mty) ->
+ iter_loc sub lid; sub.module_type sub mty
+
+ let iter_signature_item sub {psig_desc = desc; psig_loc = loc} =
+ sub.location sub loc;
+ match desc with
+ | Psig_value vd -> sub.value_description sub vd
+ | Psig_type (_, l)
+ | Psig_typesubst l ->
+ List.iter (sub.type_declaration sub) l
+ | Psig_typext te -> sub.type_extension sub te
+ | Psig_exception ed -> sub.type_exception sub ed
+ | Psig_module x -> sub.module_declaration sub x
+ | Psig_modsubst x -> sub.module_substitution sub x
+ | Psig_recmodule l ->
+ List.iter (sub.module_declaration sub) l
+ | Psig_modtype x | Psig_modtypesubst x -> sub.module_type_declaration sub x
+ | Psig_open x -> sub.open_description sub x
+ | Psig_include x -> sub.include_description sub x
+ | Psig_class l -> List.iter (sub.class_description sub) l
+ | Psig_class_type l ->
+ List.iter (sub.class_type_declaration sub) l
+ | Psig_extension (x, attrs) ->
+ sub.attributes sub attrs;
+ sub.extension sub x
+ | Psig_attribute x -> sub.attribute sub x
+end
+
+
+module M = struct
+ (* Value expressions for the module language *)
+
+ let iter sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Pmod_ident x -> iter_loc sub x
+ | Pmod_structure str -> sub.structure sub str
+ | Pmod_functor (param, body) ->
+ iter_functor_param sub param;
+ sub.module_expr sub body
+ | Pmod_apply (m1, m2) ->
+ sub.module_expr sub m1;
+ sub.module_expr sub m2
+ | Pmod_apply_unit m1 ->
+ sub.module_expr sub m1
+ | Pmod_constraint (m, mty) ->
+ sub.module_expr sub m; sub.module_type sub mty
+ | Pmod_unpack e -> sub.expr sub e
+ | Pmod_extension x -> sub.extension sub x
+
+ let iter_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
+ sub.location sub loc;
+ match desc with
+ | Pstr_eval (x, attrs) ->
+ sub.attributes sub attrs; sub.expr sub x
+ | Pstr_value (_r, vbs) -> List.iter (sub.value_binding sub) vbs
+ | Pstr_primitive vd -> sub.value_description sub vd
+ | Pstr_type (_rf, l) -> List.iter (sub.type_declaration sub) l
+ | Pstr_typext te -> sub.type_extension sub te
+ | Pstr_exception ed -> sub.type_exception sub ed
+ | Pstr_module x -> sub.module_binding sub x
+ | Pstr_recmodule l -> List.iter (sub.module_binding sub) l
+ | Pstr_modtype x -> sub.module_type_declaration sub x
+ | Pstr_open x -> sub.open_declaration sub x
+ | Pstr_class l -> List.iter (sub.class_declaration sub) l
+ | Pstr_class_type l ->
+ List.iter (sub.class_type_declaration sub) l
+ | Pstr_include x -> sub.include_declaration sub x
+ | Pstr_extension (x, attrs) ->
+ sub.attributes sub attrs; sub.extension sub x
+ | Pstr_attribute x -> sub.attribute sub x
+end
+
+module E = struct
+ (* Value expressions for the core language *)
+
+ let iter_function_param sub { pparam_loc = loc; pparam_desc = desc } =
+ sub.location sub loc;
+ match desc with
+ | Pparam_val (_lab, def, p) ->
+ iter_opt (sub.expr sub) def;
+ sub.pat sub p
+ | Pparam_newtype ty ->
+ iter_loc sub ty
+
+ let iter_body sub body =
+ match body with
+ | Pfunction_body e ->
+ sub.expr sub e
+ | Pfunction_cases (cases, loc, attrs) ->
+ sub.cases sub cases;
+ sub.location sub loc;
+ sub.attributes sub attrs
+
+ let iter_constraint sub constraint_ =
+ match constraint_ with
+ | Pconstraint ty ->
+ sub.typ sub ty
+ | Pcoerce (ty1, ty2) ->
+ iter_opt (sub.typ sub) ty1;
+ sub.typ sub ty2
+
+ let iter sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Pexp_ident x -> iter_loc sub x
+ | Pexp_constant _ -> ()
+ | Pexp_let (_r, vbs, e) ->
+ List.iter (sub.value_binding sub) vbs;
+ sub.expr sub e
+ | Pexp_function (params, constraint_, body) ->
+ List.iter (iter_function_param sub) params;
+ iter_opt (iter_constraint sub) constraint_;
+ iter_body sub body
+ | Pexp_apply (e, l) ->
+ sub.expr sub e; List.iter (iter_snd (sub.expr sub)) l
+ | Pexp_match (e, pel) ->
+ sub.expr sub e; sub.cases sub pel
+ | Pexp_try (e, pel) -> sub.expr sub e; sub.cases sub pel
+ | Pexp_tuple el -> List.iter (sub.expr sub) el
+ | Pexp_construct (lid, arg) ->
+ iter_loc sub lid; iter_opt (sub.expr sub) arg
+ | Pexp_variant (_lab, eo) ->
+ iter_opt (sub.expr sub) eo
+ | Pexp_record (l, eo) ->
+ List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) l;
+ iter_opt (sub.expr sub) eo
+ | Pexp_field (e, lid) ->
+ sub.expr sub e; iter_loc sub lid
+ | Pexp_setfield (e1, lid, e2) ->
+ sub.expr sub e1; iter_loc sub lid;
+ sub.expr sub e2
+ | Pexp_array el -> List.iter (sub.expr sub) el
+ | Pexp_ifthenelse (e1, e2, e3) ->
+ sub.expr sub e1; sub.expr sub e2;
+ iter_opt (sub.expr sub) e3
+ | Pexp_sequence (e1, e2) ->
+ sub.expr sub e1; sub.expr sub e2
+ | Pexp_while (e1, e2) ->
+ sub.expr sub e1; sub.expr sub e2
+ | Pexp_for (p, e1, e2, _d, e3) ->
+ sub.pat sub p; sub.expr sub e1; sub.expr sub e2;
+ sub.expr sub e3
+ | Pexp_coerce (e, t1, t2) ->
+ sub.expr sub e; iter_opt (sub.typ sub) t1;
+ sub.typ sub t2
+ | Pexp_constraint (e, t) ->
+ sub.expr sub e; sub.typ sub t
+ | Pexp_send (e, _s) -> sub.expr sub e
+ | Pexp_new lid -> iter_loc sub lid
+ | Pexp_setinstvar (s, e) ->
+ iter_loc sub s; sub.expr sub e
+ | Pexp_override sel ->
+ List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) sel
+ | Pexp_letmodule (s, me, e) ->
+ iter_loc sub s; sub.module_expr sub me;
+ sub.expr sub e
+ | Pexp_letexception (cd, e) ->
+ sub.extension_constructor sub cd;
+ sub.expr sub e
+ | Pexp_assert e -> sub.expr sub e
+ | Pexp_lazy e -> sub.expr sub e
+ | Pexp_poly (e, t) ->
+ sub.expr sub e; iter_opt (sub.typ sub) t
+ | Pexp_object cls -> sub.class_structure sub cls
+ | Pexp_newtype (_s, e) -> sub.expr sub e
+ | Pexp_pack me -> sub.module_expr sub me
+ | Pexp_open (o, e) ->
+ sub.open_declaration sub o; sub.expr sub e
+ | Pexp_letop {let_; ands; body} ->
+ sub.binding_op sub let_;
+ List.iter (sub.binding_op sub) ands;
+ sub.expr sub body
+ | Pexp_extension x -> sub.extension sub x
+ | Pexp_unreachable -> ()
+
+ let iter_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
+ iter_loc sub pbop_op;
+ sub.pat sub pbop_pat;
+ sub.expr sub pbop_exp;
+ sub.location sub pbop_loc
+
+end
+
+module P = struct
+ (* Patterns *)
+
+ let iter sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Ppat_any -> ()
+ | Ppat_var s -> iter_loc sub s
+ | Ppat_alias (p, s) -> sub.pat sub p; iter_loc sub s
+ | Ppat_constant _ -> ()
+ | Ppat_interval _ -> ()
+ | Ppat_tuple pl -> List.iter (sub.pat sub) pl
+ | Ppat_construct (l, p) ->
+ iter_loc sub l;
+ iter_opt
+ (fun (vl,p) ->
+ List.iter (iter_loc sub) vl;
+ sub.pat sub p)
+ p
+ | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
+ | Ppat_record (lpl, _cf) ->
+ List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl
+ | Ppat_array pl -> List.iter (sub.pat sub) pl
+ | Ppat_or (p1, p2) -> sub.pat sub p1; sub.pat sub p2
+ | Ppat_constraint (p, t) ->
+ sub.pat sub p; sub.typ sub t
+ | Ppat_type s -> iter_loc sub s
+ | Ppat_lazy p -> sub.pat sub p
+ | Ppat_unpack s -> iter_loc sub s
+ | Ppat_effect (p1,p2) -> sub.pat sub p1; sub.pat sub p2
+ | Ppat_exception p -> sub.pat sub p
+ | Ppat_extension x -> sub.extension sub x
+ | Ppat_open (lid, p) ->
+ iter_loc sub lid; sub.pat sub p
+
+end
+
+module CE = struct
+ (* Value expressions for the class language *)
+
+ let iter sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Pcl_constr (lid, tys) ->
+ iter_loc sub lid; List.iter (sub.typ sub) tys
+ | Pcl_structure s ->
+ sub.class_structure sub s
+ | Pcl_fun (_lab, e, p, ce) ->
+ iter_opt (sub.expr sub) e;
+ sub.pat sub p;
+ sub.class_expr sub ce
+ | Pcl_apply (ce, l) ->
+ sub.class_expr sub ce;
+ List.iter (iter_snd (sub.expr sub)) l
+ | Pcl_let (_r, vbs, ce) ->
+ List.iter (sub.value_binding sub) vbs;
+ sub.class_expr sub ce
+ | Pcl_constraint (ce, ct) ->
+ sub.class_expr sub ce; sub.class_type sub ct
+ | Pcl_extension x -> sub.extension sub x
+ | Pcl_open (o, e) ->
+ sub.open_description sub o; sub.class_expr sub e
+
+ let iter_kind sub = function
+ | Cfk_concrete (_o, e) -> sub.expr sub e
+ | Cfk_virtual t -> sub.typ sub t
+
+ let iter_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match desc with
+ | Pcf_inherit (_o, ce, _s) -> sub.class_expr sub ce
+ | Pcf_val (s, _m, k) -> iter_loc sub s; iter_kind sub k
+ | Pcf_method (s, _p, k) ->
+ iter_loc sub s; iter_kind sub k
+ | Pcf_constraint (t1, t2) ->
+ sub.typ sub t1; sub.typ sub t2
+ | Pcf_initializer e -> sub.expr sub e
+ | Pcf_attribute x -> sub.attribute sub x
+ | Pcf_extension x -> sub.extension sub x
+
+ let iter_structure sub {pcstr_self; pcstr_fields} =
+ sub.pat sub pcstr_self;
+ List.iter (sub.class_field sub) pcstr_fields
+
+ let class_infos sub f {pci_virt = _; pci_params = pl; pci_name; pci_expr;
+ pci_loc; pci_attributes} =
+ List.iter (iter_fst (sub.typ sub)) pl;
+ iter_loc sub pci_name;
+ f pci_expr;
+ sub.location sub pci_loc;
+ sub.attributes sub pci_attributes
+end
+
+(* Now, a generic AST mapper, to be extended to cover all kinds and
+ cases of the OCaml grammar. The default behavior of the mapper is
+ the identity. *)
+
+let default_iterator =
+ {
+ structure = (fun this l -> List.iter (this.structure_item this) l);
+ structure_item = M.iter_structure_item;
+ module_expr = M.iter;
+ signature = (fun this l -> List.iter (this.signature_item this) l);
+ signature_item = MT.iter_signature_item;
+ module_type = MT.iter;
+ with_constraint = MT.iter_with_constraint;
+ class_declaration =
+ (fun this -> CE.class_infos this (this.class_expr this));
+ class_expr = CE.iter;
+ class_field = CE.iter_field;
+ class_structure = CE.iter_structure;
+ class_type = CT.iter;
+ class_type_field = CT.iter_field;
+ class_signature = CT.iter_signature;
+ class_type_declaration =
+ (fun this -> CE.class_infos this (this.class_type this));
+ class_description =
+ (fun this -> CE.class_infos this (this.class_type this));
+ type_declaration = T.iter_type_declaration;
+ type_kind = T.iter_type_kind;
+ typ = T.iter;
+ row_field = T.row_field;
+ object_field = T.object_field;
+ type_extension = T.iter_type_extension;
+ type_exception = T.iter_type_exception;
+ extension_constructor = T.iter_extension_constructor;
+ value_description =
+ (fun this {pval_name; pval_type; pval_prim = _; pval_loc;
+ pval_attributes} ->
+ iter_loc this pval_name;
+ this.typ this pval_type;
+ this.location this pval_loc;
+ this.attributes this pval_attributes;
+ );
+
+ pat = P.iter;
+ expr = E.iter;
+ binding_op = E.iter_binding_op;
+
+ module_declaration =
+ (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} ->
+ iter_loc this pmd_name;
+ this.module_type this pmd_type;
+ this.location this pmd_loc;
+ this.attributes this pmd_attributes;
+ );
+
+ module_substitution =
+ (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} ->
+ iter_loc this pms_name;
+ iter_loc this pms_manifest;
+ this.location this pms_loc;
+ this.attributes this pms_attributes;
+ );
+
+ module_type_declaration =
+ (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} ->
+ iter_loc this pmtd_name;
+ iter_opt (this.module_type this) pmtd_type;
+ this.location this pmtd_loc;
+ this.attributes this pmtd_attributes;
+ );
+
+ module_binding =
+ (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} ->
+ iter_loc this pmb_name; this.module_expr this pmb_expr;
+ this.location this pmb_loc;
+ this.attributes this pmb_attributes;
+ );
+
+ open_declaration =
+ (fun this {popen_expr; popen_override = _; popen_attributes; popen_loc} ->
+ this.module_expr this popen_expr;
+ this.location this popen_loc;
+ this.attributes this popen_attributes
+ );
+
+ open_description =
+ (fun this {popen_expr; popen_override = _; popen_attributes; popen_loc} ->
+ iter_loc this popen_expr;
+ this.location this popen_loc;
+ this.attributes this popen_attributes
+ );
+
+
+ include_description =
+ (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+ this.module_type this pincl_mod;
+ this.location this pincl_loc;
+ this.attributes this pincl_attributes
+ );
+
+ include_declaration =
+ (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+ this.module_expr this pincl_mod;
+ this.location this pincl_loc;
+ this.attributes this pincl_attributes
+ );
+
+
+ value_binding =
+ (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc; pvb_constraint} ->
+ this.pat this pvb_pat;
+ this.expr this pvb_expr;
+ Option.iter (function
+ | Parsetree.Pvc_constraint {locally_abstract_univars=vars; typ} ->
+ List.iter (iter_loc this) vars;
+ this.typ this typ
+ | Pvc_coercion { ground; coercion } ->
+ Option.iter (this.typ this) ground;
+ this.typ this coercion;
+ ) pvb_constraint;
+ this.location this pvb_loc;
+ this.attributes this pvb_attributes
+ );
+
+
+ constructor_declaration =
+ (fun this {pcd_name; pcd_vars; pcd_args;
+ pcd_res; pcd_loc; pcd_attributes} ->
+ iter_loc this pcd_name;
+ List.iter (iter_loc this) pcd_vars;
+ T.iter_constructor_arguments this pcd_args;
+ iter_opt (this.typ this) pcd_res;
+ this.location this pcd_loc;
+ this.attributes this pcd_attributes
+ );
+
+ label_declaration =
+ (fun this {pld_name; pld_type; pld_loc; pld_mutable = _; pld_attributes}->
+ iter_loc this pld_name;
+ this.typ this pld_type;
+ this.location this pld_loc;
+ this.attributes this pld_attributes
+ );
+
+ cases = (fun this l -> List.iter (this.case this) l);
+ case =
+ (fun this {pc_lhs; pc_guard; pc_rhs} ->
+ this.pat this pc_lhs;
+ iter_opt (this.expr this) pc_guard;
+ this.expr this pc_rhs
+ );
+
+ location = (fun _this _l -> ());
+
+ extension = (fun this (s, e) -> iter_loc this s; this.payload this e);
+ attribute = (fun this a ->
+ iter_loc this a.attr_name;
+ this.payload this a.attr_payload;
+ this.location this a.attr_loc
+ );
+ attributes = (fun this l -> List.iter (this.attribute this) l);
+ payload =
+ (fun this -> function
+ | PStr x -> this.structure this x
+ | PSig x -> this.signature this x
+ | PTyp x -> this.typ this x
+ | PPat (x, g) -> this.pat this x; iter_opt (this.expr this) g
+ );
+
+ directive_argument =
+ (fun this a ->
+ this.location this a.pdira_loc
+ );
+
+ toplevel_directive =
+ (fun this d ->
+ iter_loc this d.pdir_name;
+ iter_opt (this.directive_argument this) d.pdir_arg;
+ this.location this d.pdir_loc
+ );
+
+ toplevel_phrase =
+ (fun this -> function
+ | Ptop_def s -> this.structure this s
+ | Ptop_dir d -> this.toplevel_directive this d
+ );
+ }
diff --git a/upstream/ocaml_503/parsing/ast_iterator.mli b/upstream/ocaml_503/parsing/ast_iterator.mli
new file mode 100644
index 0000000000..6b02889163
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_iterator.mli
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(** {!Ast_iterator.iterator} enables AST inspection using open recursion. A
+ typical mapper would be based on {!Ast_iterator.default_iterator}, a
+ trivial iterator, and will fall back on it for handling the syntax it does
+ not modify.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Parsetree
+
+(** {1 A generic Parsetree iterator} *)
+
+type iterator = {
+ attribute: iterator -> attribute -> unit;
+ attributes: iterator -> attribute list -> unit;
+ binding_op: iterator -> binding_op -> unit;
+ case: iterator -> case -> unit;
+ cases: iterator -> case list -> unit;
+ class_declaration: iterator -> class_declaration -> unit;
+ class_description: iterator -> class_description -> unit;
+ class_expr: iterator -> class_expr -> unit;
+ class_field: iterator -> class_field -> unit;
+ class_signature: iterator -> class_signature -> unit;
+ class_structure: iterator -> class_structure -> unit;
+ class_type: iterator -> class_type -> unit;
+ class_type_declaration: iterator -> class_type_declaration -> unit;
+ class_type_field: iterator -> class_type_field -> unit;
+ constructor_declaration: iterator -> constructor_declaration -> unit;
+ directive_argument: iterator -> directive_argument -> unit;
+ expr: iterator -> expression -> unit;
+ extension: iterator -> extension -> unit;
+ extension_constructor: iterator -> extension_constructor -> unit;
+ include_declaration: iterator -> include_declaration -> unit;
+ include_description: iterator -> include_description -> unit;
+ label_declaration: iterator -> label_declaration -> unit;
+ location: iterator -> Location.t -> unit;
+ module_binding: iterator -> module_binding -> unit;
+ module_declaration: iterator -> module_declaration -> unit;
+ module_substitution: iterator -> module_substitution -> unit;
+ module_expr: iterator -> module_expr -> unit;
+ module_type: iterator -> module_type -> unit;
+ module_type_declaration: iterator -> module_type_declaration -> unit;
+ open_declaration: iterator -> open_declaration -> unit;
+ open_description: iterator -> open_description -> unit;
+ pat: iterator -> pattern -> unit;
+ payload: iterator -> payload -> unit;
+ signature: iterator -> signature -> unit;
+ signature_item: iterator -> signature_item -> unit;
+ structure: iterator -> structure -> unit;
+ structure_item: iterator -> structure_item -> unit;
+ toplevel_directive: iterator -> toplevel_directive -> unit;
+ toplevel_phrase: iterator -> toplevel_phrase -> unit;
+ typ: iterator -> core_type -> unit;
+ row_field: iterator -> row_field -> unit;
+ object_field: iterator -> object_field -> unit;
+ type_declaration: iterator -> type_declaration -> unit;
+ type_extension: iterator -> type_extension -> unit;
+ type_exception: iterator -> type_exception -> unit;
+ type_kind: iterator -> type_kind -> unit;
+ value_binding: iterator -> value_binding -> unit;
+ value_description: iterator -> value_description -> unit;
+ with_constraint: iterator -> with_constraint -> unit;
+}
+(** A [iterator] record implements one "method" per syntactic category,
+ using an open recursion style: each method takes as its first
+ argument the iterator to be applied to children in the syntax
+ tree. *)
+
+val default_iterator: iterator
+(** A default iterator, which implements a "do not do anything" mapping. *)
diff --git a/upstream/ocaml_503/parsing/ast_mapper.ml b/upstream/ocaml_503/parsing/ast_mapper.ml
new file mode 100644
index 0000000000..25512e59c6
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_mapper.ml
@@ -0,0 +1,1177 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(* A generic Parsetree mapping class *)
+
+(*
+[@@@ocaml.warning "+9"]
+ (* Ensure that record patterns don't miss any field. *)
+*)
+
+[@@@ocaml.warning "-60"] module Str = Ast_helper.Str (* For ocamldep *)
+[@@@ocaml.warning "+60"]
+
+open Parsetree
+open Ast_helper
+open Location
+
+module String = Misc.Stdlib.String
+
+type mapper = {
+ attribute: mapper -> attribute -> attribute;
+ attributes: mapper -> attribute list -> attribute list;
+ binding_op: mapper -> binding_op -> binding_op;
+ case: mapper -> case -> case;
+ cases: mapper -> case list -> case list;
+ class_declaration: mapper -> class_declaration -> class_declaration;
+ class_description: mapper -> class_description -> class_description;
+ class_expr: mapper -> class_expr -> class_expr;
+ class_field: mapper -> class_field -> class_field;
+ class_signature: mapper -> class_signature -> class_signature;
+ class_structure: mapper -> class_structure -> class_structure;
+ class_type: mapper -> class_type -> class_type;
+ class_type_declaration: mapper -> class_type_declaration
+ -> class_type_declaration;
+ class_type_field: mapper -> class_type_field -> class_type_field;
+ constant: mapper -> constant -> constant;
+ constructor_declaration: mapper -> constructor_declaration
+ -> constructor_declaration;
+ directive_argument: mapper -> directive_argument -> directive_argument;
+ expr: mapper -> expression -> expression;
+ extension: mapper -> extension -> extension;
+ extension_constructor: mapper -> extension_constructor
+ -> extension_constructor;
+ include_declaration: mapper -> include_declaration -> include_declaration;
+ include_description: mapper -> include_description -> include_description;
+ label_declaration: mapper -> label_declaration -> label_declaration;
+ location: mapper -> Location.t -> Location.t;
+ module_binding: mapper -> module_binding -> module_binding;
+ module_declaration: mapper -> module_declaration -> module_declaration;
+ module_substitution: mapper -> module_substitution -> module_substitution;
+ module_expr: mapper -> module_expr -> module_expr;
+ module_type: mapper -> module_type -> module_type;
+ module_type_declaration: mapper -> module_type_declaration
+ -> module_type_declaration;
+ open_declaration: mapper -> open_declaration -> open_declaration;
+ open_description: mapper -> open_description -> open_description;
+ pat: mapper -> pattern -> pattern;
+ payload: mapper -> payload -> payload;
+ signature: mapper -> signature -> signature;
+ signature_item: mapper -> signature_item -> signature_item;
+ structure: mapper -> structure -> structure;
+ structure_item: mapper -> structure_item -> structure_item;
+ toplevel_directive: mapper -> toplevel_directive -> toplevel_directive;
+ toplevel_phrase: mapper -> toplevel_phrase -> toplevel_phrase;
+ typ: mapper -> core_type -> core_type;
+ type_declaration: mapper -> type_declaration -> type_declaration;
+ type_extension: mapper -> type_extension -> type_extension;
+ type_exception: mapper -> type_exception -> type_exception;
+ type_kind: mapper -> type_kind -> type_kind;
+ value_binding: mapper -> value_binding -> value_binding;
+ value_description: mapper -> value_description -> value_description;
+ with_constraint: mapper -> with_constraint -> with_constraint;
+}
+
+let map_fst f (x, y) = (f x, y)
+let map_snd f (x, y) = (x, f y)
+let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
+let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
+let map_opt f = function None -> None | Some x -> Some (f x)
+
+let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
+
+module C = struct
+ (* Constants *)
+
+ let map sub { pconst_desc; pconst_loc } =
+ let loc = sub.location sub pconst_loc in
+ let desc =
+ match pconst_desc with
+ | Pconst_integer _
+ | Pconst_char _
+ | Pconst_float _ ->
+ pconst_desc
+ | Pconst_string (s, loc, quotation_delimiter) ->
+ Pconst_string (s, sub.location sub loc, quotation_delimiter)
+ in
+ Const.mk ~loc desc
+end
+
+module T = struct
+ (* Type expressions for the core language *)
+
+ let row_field sub {
+ prf_desc;
+ prf_loc;
+ prf_attributes;
+ } =
+ let loc = sub.location sub prf_loc in
+ let attrs = sub.attributes sub prf_attributes in
+ let desc = match prf_desc with
+ | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl)
+ | Rinherit t -> Rinherit (sub.typ sub t)
+ in
+ Rf.mk ~loc ~attrs desc
+
+ let object_field sub {
+ pof_desc;
+ pof_loc;
+ pof_attributes;
+ } =
+ let loc = sub.location sub pof_loc in
+ let attrs = sub.attributes sub pof_attributes in
+ let desc = match pof_desc with
+ | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t)
+ | Oinherit t -> Oinherit (sub.typ sub t)
+ in
+ Of.mk ~loc ~attrs desc
+
+ let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} =
+ let open Typ in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Ptyp_any -> any ~loc ~attrs ()
+ | Ptyp_var s -> var ~loc ~attrs s
+ | Ptyp_arrow (lab, t1, t2) ->
+ arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2)
+ | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
+ | Ptyp_constr (lid, tl) ->
+ constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+ | Ptyp_object (l, o) ->
+ object_ ~loc ~attrs (List.map (object_field sub) l) o
+ | Ptyp_class (lid, tl) ->
+ class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+ | Ptyp_alias (t, s) ->
+ let s = map_loc sub s in
+ alias ~loc ~attrs (sub.typ sub t) s
+ | Ptyp_variant (rl, b, ll) ->
+ variant ~loc ~attrs (List.map (row_field sub) rl) b ll
+ | Ptyp_poly (sl, t) -> poly ~loc ~attrs
+ (List.map (map_loc sub) sl) (sub.typ sub t)
+ | Ptyp_package (lid, l) ->
+ package ~loc ~attrs (map_loc sub lid)
+ (List.map (map_tuple (map_loc sub) (sub.typ sub)) l)
+ | Ptyp_open (mod_ident, t) ->
+ open_ ~loc ~attrs (map_loc sub mod_ident) (sub.typ sub t)
+ | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+ let map_type_declaration sub
+ {ptype_name; ptype_params; ptype_cstrs;
+ ptype_kind;
+ ptype_private;
+ ptype_manifest;
+ ptype_attributes;
+ ptype_loc} =
+ let loc = sub.location sub ptype_loc in
+ let attrs = sub.attributes sub ptype_attributes in
+ Type.mk ~loc ~attrs (map_loc sub ptype_name)
+ ~params:(List.map (map_fst (sub.typ sub)) ptype_params)
+ ~priv:ptype_private
+ ~cstrs:(List.map
+ (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub))
+ ptype_cstrs)
+ ~kind:(sub.type_kind sub ptype_kind)
+ ?manifest:(map_opt (sub.typ sub) ptype_manifest)
+
+ let map_type_kind sub = function
+ | Ptype_abstract -> Ptype_abstract
+ | Ptype_variant l ->
+ Ptype_variant (List.map (sub.constructor_declaration sub) l)
+ | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l)
+ | Ptype_open -> Ptype_open
+
+ let map_constructor_arguments sub = function
+ | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l)
+ | Pcstr_record l ->
+ Pcstr_record (List.map (sub.label_declaration sub) l)
+
+ let map_type_extension sub
+ {ptyext_path; ptyext_params;
+ ptyext_constructors;
+ ptyext_private;
+ ptyext_loc;
+ ptyext_attributes} =
+ let loc = sub.location sub ptyext_loc in
+ let attrs = sub.attributes sub ptyext_attributes in
+ Te.mk ~loc ~attrs
+ (map_loc sub ptyext_path)
+ (List.map (sub.extension_constructor sub) ptyext_constructors)
+ ~params:(List.map (map_fst (sub.typ sub)) ptyext_params)
+ ~priv:ptyext_private
+
+ let map_type_exception sub
+ {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} =
+ let loc = sub.location sub ptyexn_loc in
+ let attrs = sub.attributes sub ptyexn_attributes in
+ Te.mk_exception ~loc ~attrs
+ (sub.extension_constructor sub ptyexn_constructor)
+
+ let map_extension_constructor_kind sub = function
+ Pext_decl(vars, ctl, cto) ->
+ Pext_decl(List.map (map_loc sub) vars,
+ map_constructor_arguments sub ctl,
+ map_opt (sub.typ sub) cto)
+ | Pext_rebind li ->
+ Pext_rebind (map_loc sub li)
+
+ let map_extension_constructor sub
+ {pext_name;
+ pext_kind;
+ pext_loc;
+ pext_attributes} =
+ let loc = sub.location sub pext_loc in
+ let attrs = sub.attributes sub pext_attributes in
+ Te.constructor ~loc ~attrs
+ (map_loc sub pext_name)
+ (map_extension_constructor_kind sub pext_kind)
+
+end
+
+module CT = struct
+ (* Type expressions for the class language *)
+
+ let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} =
+ let open Cty in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Pcty_constr (lid, tys) ->
+ constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+ | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x)
+ | Pcty_arrow (lab, t, ct) ->
+ arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct)
+ | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x)
+ | Pcty_open (o, ct) ->
+ open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct)
+
+ let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs}
+ =
+ let open Ctf in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct)
+ | Pctf_val (s, m, v, t) ->
+ val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t)
+ | Pctf_method (s, p, v, t) ->
+ method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t)
+ | Pctf_constraint (t1, t2) ->
+ constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
+ | Pctf_attribute x -> attribute ~loc (sub.attribute sub x)
+ | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+ let map_signature sub {pcsig_self; pcsig_fields} =
+ Csig.mk
+ (sub.typ sub pcsig_self)
+ (List.map (sub.class_type_field sub) pcsig_fields)
+end
+
+let map_functor_param sub = function
+ | Unit -> Unit
+ | Named (s, mt) -> Named (map_loc sub s, sub.module_type sub mt)
+
+module MT = struct
+ (* Type expressions for the module language *)
+
+ let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} =
+ let open Mty in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
+ | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s)
+ | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
+ | Pmty_functor (param, mt) ->
+ functor_ ~loc ~attrs
+ (map_functor_param sub param)
+ (sub.module_type sub mt)
+ | Pmty_with (mt, l) ->
+ with_ ~loc ~attrs (sub.module_type sub mt)
+ (List.map (sub.with_constraint sub) l)
+ | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me)
+ | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+ let map_with_constraint sub = function
+ | Pwith_type (lid, d) ->
+ Pwith_type (map_loc sub lid, sub.type_declaration sub d)
+ | Pwith_module (lid, lid2) ->
+ Pwith_module (map_loc sub lid, map_loc sub lid2)
+ | Pwith_modtype (lid, mty) ->
+ Pwith_modtype (map_loc sub lid, sub.module_type sub mty)
+ | Pwith_typesubst (lid, d) ->
+ Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d)
+ | Pwith_modsubst (s, lid) ->
+ Pwith_modsubst (map_loc sub s, map_loc sub lid)
+ | Pwith_modtypesubst (lid, mty) ->
+ Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty)
+
+ let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
+ let open Sig in
+ let loc = sub.location sub loc in
+ match desc with
+ | Psig_value vd -> value ~loc (sub.value_description sub vd)
+ | Psig_type (rf, l) ->
+ type_ ~loc rf (List.map (sub.type_declaration sub) l)
+ | Psig_typesubst l ->
+ type_subst ~loc (List.map (sub.type_declaration sub) l)
+ | Psig_typext te -> type_extension ~loc (sub.type_extension sub te)
+ | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed)
+ | Psig_module x -> module_ ~loc (sub.module_declaration sub x)
+ | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x)
+ | Psig_recmodule l ->
+ rec_module ~loc (List.map (sub.module_declaration sub) l)
+ | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
+ | Psig_modtypesubst x ->
+ modtype_subst ~loc (sub.module_type_declaration sub x)
+ | Psig_open x -> open_ ~loc (sub.open_description sub x)
+ | Psig_include x -> include_ ~loc (sub.include_description sub x)
+ | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l)
+ | Psig_class_type l ->
+ class_type ~loc (List.map (sub.class_type_declaration sub) l)
+ | Psig_extension (x, attrs) ->
+ let attrs = sub.attributes sub attrs in
+ extension ~loc ~attrs (sub.extension sub x)
+ | Psig_attribute x -> attribute ~loc (sub.attribute sub x)
+end
+
+
+module M = struct
+ (* Value expressions for the module language *)
+
+ let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} =
+ let open Mod in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
+ | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
+ | Pmod_functor (param, body) ->
+ functor_ ~loc ~attrs
+ (map_functor_param sub param)
+ (sub.module_expr sub body)
+ | Pmod_apply (m1, m2) ->
+ apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2)
+ | Pmod_apply_unit m1 ->
+ apply_unit ~loc ~attrs (sub.module_expr sub m1)
+ | Pmod_constraint (m, mty) ->
+ constraint_ ~loc ~attrs (sub.module_expr sub m)
+ (sub.module_type sub mty)
+ | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e)
+ | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+ let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
+ let open Str in
+ let loc = sub.location sub loc in
+ match desc with
+ | Pstr_eval (x, attrs) ->
+ let attrs = sub.attributes sub attrs in
+ eval ~loc ~attrs (sub.expr sub x)
+ | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs)
+ | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd)
+ | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l)
+ | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te)
+ | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed)
+ | Pstr_module x -> module_ ~loc (sub.module_binding sub x)
+ | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l)
+ | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
+ | Pstr_open x -> open_ ~loc (sub.open_declaration sub x)
+ | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l)
+ | Pstr_class_type l ->
+ class_type ~loc (List.map (sub.class_type_declaration sub) l)
+ | Pstr_include x -> include_ ~loc (sub.include_declaration sub x)
+ | Pstr_extension (x, attrs) ->
+ let attrs = sub.attributes sub attrs in
+ extension ~loc ~attrs (sub.extension sub x)
+ | Pstr_attribute x -> attribute ~loc (sub.attribute sub x)
+end
+
+module E = struct
+ (* Value expressions for the core language *)
+
+ let map_function_param sub { pparam_loc = loc; pparam_desc = desc } =
+ let loc = sub.location sub loc in
+ let desc =
+ match desc with
+ | Pparam_val (lab, def, p) ->
+ Pparam_val
+ (lab,
+ map_opt (sub.expr sub) def,
+ sub.pat sub p)
+ | Pparam_newtype ty ->
+ Pparam_newtype (map_loc sub ty)
+ in
+ { pparam_loc = loc; pparam_desc = desc }
+
+ let map_function_body sub body =
+ match body with
+ | Pfunction_body e ->
+ Pfunction_body (sub.expr sub e)
+ | Pfunction_cases (cases, loc, attributes) ->
+ let cases = sub.cases sub cases in
+ let loc = sub.location sub loc in
+ let attributes = sub.attributes sub attributes in
+ Pfunction_cases (cases, loc, attributes)
+
+ let map_constraint sub c =
+ match c with
+ | Pconstraint ty -> Pconstraint (sub.typ sub ty)
+ | Pcoerce (ty1, ty2) -> Pcoerce (map_opt (sub.typ sub) ty1, sub.typ sub ty2)
+
+ let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} =
+ let open Exp in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x)
+ | Pexp_constant x -> constant ~loc ~attrs (sub.constant sub x)
+ | Pexp_let (r, vbs, e) ->
+ let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs)
+ (sub.expr sub e)
+ | Pexp_function (ps, c, b) ->
+ function_ ~loc ~attrs
+ (List.map (map_function_param sub) ps)
+ (map_opt (map_constraint sub) c)
+ (map_function_body sub b)
+ | Pexp_apply (e, l) ->
+ apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l)
+ | Pexp_match (e, pel) ->
+ match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
+ | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
+ | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el)
+ | Pexp_construct (lid, arg) ->
+ construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
+ | Pexp_variant (lab, eo) ->
+ variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
+ | Pexp_record (l, eo) ->
+ record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l)
+ (map_opt (sub.expr sub) eo)
+ | Pexp_field (e, lid) ->
+ field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
+ | Pexp_setfield (e1, lid, e2) ->
+ setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid)
+ (sub.expr sub e2)
+ | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el)
+ | Pexp_ifthenelse (e1, e2, e3) ->
+ ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+ (map_opt (sub.expr sub) e3)
+ | Pexp_sequence (e1, e2) ->
+ sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+ | Pexp_while (e1, e2) ->
+ while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+ | Pexp_for (p, e1, e2, d, e3) ->
+ for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d
+ (sub.expr sub e3)
+ | Pexp_coerce (e, t1, t2) ->
+ coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1)
+ (sub.typ sub t2)
+ | Pexp_constraint (e, t) ->
+ constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t)
+ | Pexp_send (e, s) ->
+ send ~loc ~attrs (sub.expr sub e) (map_loc sub s)
+ | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid)
+ | Pexp_setinstvar (s, e) ->
+ setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e)
+ | Pexp_override sel ->
+ override ~loc ~attrs
+ (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel)
+ | Pexp_letmodule (s, me, e) ->
+ letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me)
+ (sub.expr sub e)
+ | Pexp_letexception (cd, e) ->
+ letexception ~loc ~attrs
+ (sub.extension_constructor sub cd)
+ (sub.expr sub e)
+ | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e)
+ | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e)
+ | Pexp_poly (e, t) ->
+ poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t)
+ | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls)
+ | Pexp_newtype (s, e) ->
+ newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
+ | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
+ | Pexp_open (o, e) ->
+ open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e)
+ | Pexp_letop {let_; ands; body} ->
+ letop ~loc ~attrs (sub.binding_op sub let_)
+ (List.map (sub.binding_op sub) ands) (sub.expr sub body)
+ | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+ | Pexp_unreachable -> unreachable ~loc ~attrs ()
+
+ let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
+ let open Exp in
+ let op = map_loc sub pbop_op in
+ let pat = sub.pat sub pbop_pat in
+ let exp = sub.expr sub pbop_exp in
+ let loc = sub.location sub pbop_loc in
+ binding_op op pat exp loc
+
+end
+
+module P = struct
+ (* Patterns *)
+
+ let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} =
+ let open Pat in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Ppat_any -> any ~loc ~attrs ()
+ | Ppat_var s -> var ~loc ~attrs (map_loc sub s)
+ | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s)
+ | Ppat_constant c -> constant ~loc ~attrs (sub.constant sub c)
+ | Ppat_interval (c1, c2) ->
+ interval ~loc ~attrs (sub.constant sub c1) (sub.constant sub c2)
+ | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
+ | Ppat_construct (l, p) ->
+ construct ~loc ~attrs (map_loc sub l)
+ (map_opt
+ (fun (vl, p) -> List.map (map_loc sub) vl, sub.pat sub p)
+ p)
+ | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
+ | Ppat_record (lpl, cf) ->
+ record ~loc ~attrs
+ (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf
+ | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl)
+ | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
+ | Ppat_constraint (p, t) ->
+ constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t)
+ | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s)
+ | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p)
+ | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s)
+ | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p)
+ | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p)
+ | Ppat_effect(p1, p2) ->
+ effect_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
+ | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x)
+end
+
+module CE = struct
+ (* Value expressions for the class language *)
+
+ let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} =
+ let open Cl in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Pcl_constr (lid, tys) ->
+ constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+ | Pcl_structure s ->
+ structure ~loc ~attrs (sub.class_structure sub s)
+ | Pcl_fun (lab, e, p, ce) ->
+ fun_ ~loc ~attrs lab
+ (map_opt (sub.expr sub) e)
+ (sub.pat sub p)
+ (sub.class_expr sub ce)
+ | Pcl_apply (ce, l) ->
+ apply ~loc ~attrs (sub.class_expr sub ce)
+ (List.map (map_snd (sub.expr sub)) l)
+ | Pcl_let (r, vbs, ce) ->
+ let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs)
+ (sub.class_expr sub ce)
+ | Pcl_constraint (ce, ct) ->
+ constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct)
+ | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x)
+ | Pcl_open (o, ce) ->
+ open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce)
+
+ let map_kind sub = function
+ | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e)
+ | Cfk_virtual t -> Cfk_virtual (sub.typ sub t)
+
+ let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} =
+ let open Cf in
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ match desc with
+ | Pcf_inherit (o, ce, s) ->
+ inherit_ ~loc ~attrs o (sub.class_expr sub ce)
+ (map_opt (map_loc sub) s)
+ | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k)
+ | Pcf_method (s, p, k) ->
+ method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k)
+ | Pcf_constraint (t1, t2) ->
+ constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
+ | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e)
+ | Pcf_attribute x -> attribute ~loc (sub.attribute sub x)
+ | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+ let map_structure sub {pcstr_self; pcstr_fields} =
+ {
+ pcstr_self = sub.pat sub pcstr_self;
+ pcstr_fields = List.map (sub.class_field sub) pcstr_fields;
+ }
+
+ let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr;
+ pci_loc; pci_attributes} =
+ let loc = sub.location sub pci_loc in
+ let attrs = sub.attributes sub pci_attributes in
+ Ci.mk ~loc ~attrs
+ ~virt:pci_virt
+ ~params:(List.map (map_fst (sub.typ sub)) pl)
+ (map_loc sub pci_name)
+ (f pci_expr)
+end
+
+(* Now, a generic AST mapper, to be extended to cover all kinds and
+ cases of the OCaml grammar. The default behavior of the mapper is
+ the identity. *)
+
+let default_mapper =
+ {
+ constant = C.map;
+ structure = (fun this l -> List.map (this.structure_item this) l);
+ structure_item = M.map_structure_item;
+ module_expr = M.map;
+ signature = (fun this l -> List.map (this.signature_item this) l);
+ signature_item = MT.map_signature_item;
+ module_type = MT.map;
+ with_constraint = MT.map_with_constraint;
+ class_declaration =
+ (fun this -> CE.class_infos this (this.class_expr this));
+ class_expr = CE.map;
+ class_field = CE.map_field;
+ class_structure = CE.map_structure;
+ class_type = CT.map;
+ class_type_field = CT.map_field;
+ class_signature = CT.map_signature;
+ class_type_declaration =
+ (fun this -> CE.class_infos this (this.class_type this));
+ class_description =
+ (fun this -> CE.class_infos this (this.class_type this));
+ type_declaration = T.map_type_declaration;
+ type_kind = T.map_type_kind;
+ typ = T.map;
+ type_extension = T.map_type_extension;
+ type_exception = T.map_type_exception;
+ extension_constructor = T.map_extension_constructor;
+ value_description =
+ (fun this {pval_name; pval_type; pval_prim; pval_loc;
+ pval_attributes} ->
+ Val.mk
+ (map_loc this pval_name)
+ (this.typ this pval_type)
+ ~attrs:(this.attributes this pval_attributes)
+ ~loc:(this.location this pval_loc)
+ ~prim:pval_prim
+ );
+
+ pat = P.map;
+ expr = E.map;
+ binding_op = E.map_binding_op;
+
+ module_declaration =
+ (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} ->
+ Md.mk
+ (map_loc this pmd_name)
+ (this.module_type this pmd_type)
+ ~attrs:(this.attributes this pmd_attributes)
+ ~loc:(this.location this pmd_loc)
+ );
+
+ module_substitution =
+ (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} ->
+ Ms.mk
+ (map_loc this pms_name)
+ (map_loc this pms_manifest)
+ ~attrs:(this.attributes this pms_attributes)
+ ~loc:(this.location this pms_loc)
+ );
+
+ module_type_declaration =
+ (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} ->
+ Mtd.mk
+ (map_loc this pmtd_name)
+ ?typ:(map_opt (this.module_type this) pmtd_type)
+ ~attrs:(this.attributes this pmtd_attributes)
+ ~loc:(this.location this pmtd_loc)
+ );
+
+ module_binding =
+ (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} ->
+ Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr)
+ ~attrs:(this.attributes this pmb_attributes)
+ ~loc:(this.location this pmb_loc)
+ );
+
+
+ open_declaration =
+ (fun this {popen_expr; popen_override; popen_attributes; popen_loc} ->
+ Opn.mk (this.module_expr this popen_expr)
+ ~override:popen_override
+ ~loc:(this.location this popen_loc)
+ ~attrs:(this.attributes this popen_attributes)
+ );
+
+ open_description =
+ (fun this {popen_expr; popen_override; popen_attributes; popen_loc} ->
+ Opn.mk (map_loc this popen_expr)
+ ~override:popen_override
+ ~loc:(this.location this popen_loc)
+ ~attrs:(this.attributes this popen_attributes)
+ );
+
+ include_description =
+ (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+ Incl.mk (this.module_type this pincl_mod)
+ ~loc:(this.location this pincl_loc)
+ ~attrs:(this.attributes this pincl_attributes)
+ );
+
+ include_declaration =
+ (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+ Incl.mk (this.module_expr this pincl_mod)
+ ~loc:(this.location this pincl_loc)
+ ~attrs:(this.attributes this pincl_attributes)
+ );
+
+
+ value_binding =
+ (fun this {pvb_pat; pvb_expr; pvb_constraint; pvb_attributes; pvb_loc} ->
+ let map_ct (ct:Parsetree.value_constraint) = match ct with
+ | Pvc_constraint {locally_abstract_univars=vars; typ} ->
+ Pvc_constraint
+ { locally_abstract_univars = List.map (map_loc this) vars;
+ typ = this.typ this typ
+ }
+ | Pvc_coercion { ground; coercion } ->
+ Pvc_coercion {
+ ground = Option.map (this.typ this) ground;
+ coercion = this.typ this coercion
+ }
+ in
+ Vb.mk
+ (this.pat this pvb_pat)
+ (this.expr this pvb_expr)
+ ?value_constraint:(Option.map map_ct pvb_constraint)
+ ~loc:(this.location this pvb_loc)
+ ~attrs:(this.attributes this pvb_attributes)
+ );
+
+
+ constructor_declaration =
+ (fun this {pcd_name; pcd_vars; pcd_args;
+ pcd_res; pcd_loc; pcd_attributes} ->
+ Type.constructor
+ (map_loc this pcd_name)
+ ~vars:(List.map (map_loc this) pcd_vars)
+ ~args:(T.map_constructor_arguments this pcd_args)
+ ?res:(map_opt (this.typ this) pcd_res)
+ ~loc:(this.location this pcd_loc)
+ ~attrs:(this.attributes this pcd_attributes)
+ );
+
+ label_declaration =
+ (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} ->
+ Type.field
+ (map_loc this pld_name)
+ (this.typ this pld_type)
+ ~mut:pld_mutable
+ ~loc:(this.location this pld_loc)
+ ~attrs:(this.attributes this pld_attributes)
+ );
+
+ cases = (fun this l -> List.map (this.case this) l);
+ case =
+ (fun this {pc_lhs; pc_guard; pc_rhs} ->
+ {
+ pc_lhs = this.pat this pc_lhs;
+ pc_guard = map_opt (this.expr this) pc_guard;
+ pc_rhs = this.expr this pc_rhs;
+ }
+ );
+
+
+
+ location = (fun _this l -> l);
+
+ extension = (fun this (s, e) -> (map_loc this s, this.payload this e));
+ attribute = (fun this a ->
+ {
+ attr_name = map_loc this a.attr_name;
+ attr_payload = this.payload this a.attr_payload;
+ attr_loc = this.location this a.attr_loc
+ }
+ );
+ attributes = (fun this l -> List.map (this.attribute this) l);
+ payload =
+ (fun this -> function
+ | PStr x -> PStr (this.structure this x)
+ | PSig x -> PSig (this.signature this x)
+ | PTyp x -> PTyp (this.typ this x)
+ | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g)
+ );
+
+ directive_argument =
+ (fun this a ->
+ { pdira_desc= a.pdira_desc
+ ; pdira_loc= this.location this a.pdira_loc} );
+
+ toplevel_directive =
+ (fun this d ->
+ { pdir_name= map_loc this d.pdir_name
+ ; pdir_arg= map_opt (this.directive_argument this) d.pdir_arg
+ ; pdir_loc= this.location this d.pdir_loc } );
+
+ toplevel_phrase =
+ (fun this -> function
+ | Ptop_def s -> Ptop_def (this.structure this s)
+ | Ptop_dir d -> Ptop_dir (this.toplevel_directive this d) );
+ }
+
+let extension_of_error {kind; main; sub} =
+ if kind <> Location.Report_error then
+ raise (Invalid_argument "extension_of_error: expected kind Report_error");
+ let str_of_msg msg = Format.asprintf "%a" Format_doc.Doc.format msg in
+ let extension_of_sub sub =
+ { loc = sub.loc; txt = "ocaml.error" },
+ PStr ([Str.eval (Exp.constant
+ (Const.string ~loc:sub.loc (str_of_msg sub.txt)))])
+ in
+ { loc = main.loc; txt = "ocaml.error" },
+ PStr (Str.eval (Exp.constant
+ (Const.string ~loc:main.loc (str_of_msg main.txt))) ::
+ List.map (fun msg -> Str.extension (extension_of_sub msg)) sub)
+
+let attribute_of_warning loc s =
+ Attr.mk
+ {loc; txt = "ocaml.ppwarning" }
+ (PStr ([Str.eval ~loc (Exp.constant (Const.string ~loc s))]))
+
+let cookies = ref String.Map.empty
+
+let get_cookie k =
+ try Some (String.Map.find k !cookies)
+ with Not_found -> None
+
+let set_cookie k v =
+ cookies := String.Map.add k v !cookies
+
+let tool_name_ref = ref "_none_"
+
+let tool_name () = !tool_name_ref
+
+
+module PpxContext = struct
+ open Longident
+ open Asttypes
+ open Ast_helper
+
+ let lid name = { txt = Lident name; loc = Location.none }
+
+ let make_string s = Exp.constant (Const.string s)
+
+ let make_bool x =
+ if x
+ then Exp.construct (lid "true") None
+ else Exp.construct (lid "false") None
+
+ let rec make_list f lst =
+ match lst with
+ | x :: rest ->
+ Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest]))
+ | [] ->
+ Exp.construct (lid "[]") None
+
+ let make_pair f1 f2 (x1, x2) =
+ Exp.tuple [f1 x1; f2 x2]
+
+ let make_option f opt =
+ match opt with
+ | Some x -> Exp.construct (lid "Some") (Some (f x))
+ | None -> Exp.construct (lid "None") None
+
+ let get_cookies () =
+ lid "cookies",
+ make_list (make_pair make_string (fun x -> x))
+ (String.Map.bindings !cookies)
+
+ let mk fields =
+ {
+ attr_name = { txt = "ocaml.ppx.context"; loc = Location.none };
+ attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)];
+ attr_loc = Location.none
+ }
+
+ let make ~tool_name () =
+ let Load_path.{ visible; hidden } = Load_path.get_paths () in
+ let fields =
+ [
+ lid "tool_name", make_string tool_name;
+ lid "include_dirs", make_list make_string (!Clflags.include_dirs);
+ lid "hidden_include_dirs",
+ make_list make_string (!Clflags.hidden_include_dirs);
+ lid "load_path",
+ make_pair (make_list make_string) (make_list make_string)
+ (visible, hidden);
+ lid "open_modules", make_list make_string !Clflags.open_modules;
+ lid "for_package", make_option make_string !Clflags.for_package;
+ lid "debug", make_bool !Clflags.debug;
+ lid "use_threads", make_bool !Clflags.use_threads;
+ lid "use_vmthreads", make_bool false;
+ lid "recursive_types", make_bool !Clflags.recursive_types;
+ lid "principal", make_bool !Clflags.principal;
+ lid "transparent_modules", make_bool !Clflags.transparent_modules;
+ lid "unboxed_types", make_bool !Clflags.unboxed_types;
+ lid "unsafe_string", make_bool false; (* kept for compatibility *)
+ get_cookies ()
+ ]
+ in
+ mk fields
+
+ let get_fields = function
+ | PStr [{pstr_desc = Pstr_eval
+ ({ pexp_desc = Pexp_record (fields, None) }, [])}] ->
+ fields
+ | _ ->
+ raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax"
+
+ let restore fields =
+ let field name payload =
+ let rec get_string = function
+ | {pexp_desc = Pexp_constant
+ {pconst_desc = Pconst_string (str, _, None); _}} -> str
+ | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+ { %s }] string syntax" name
+ and get_bool pexp =
+ match pexp with
+ | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"},
+ None)} ->
+ true
+ | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"},
+ None)} ->
+ false
+ | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+ { %s }] bool syntax" name
+ and get_list elem = function
+ | {pexp_desc =
+ Pexp_construct ({txt = Longident.Lident "::"},
+ Some {pexp_desc = Pexp_tuple [exp; rest]}) } ->
+ elem exp :: get_list elem rest
+ | {pexp_desc =
+ Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
+ []
+ | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+ { %s }] list syntax" name
+ and get_pair f1 f2 = function
+ | {pexp_desc = Pexp_tuple [e1; e2]} ->
+ (f1 e1, f2 e2)
+ | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+ { %s }] pair syntax" name
+ and get_option elem = function
+ | { pexp_desc =
+ Pexp_construct ({ txt = Longident.Lident "Some" }, Some exp) } ->
+ Some (elem exp)
+ | { pexp_desc =
+ Pexp_construct ({ txt = Longident.Lident "None" }, None) } ->
+ None
+ | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+ { %s }] option syntax" name
+ in
+ match name with
+ | "tool_name" ->
+ tool_name_ref := get_string payload
+ | "include_dirs" ->
+ Clflags.include_dirs := get_list get_string payload
+ | "hidden_include_dirs" ->
+ Clflags.hidden_include_dirs := get_list get_string payload
+ | "load_path" ->
+ (* Duplicates Compmisc.auto_include, since we can't reference Compmisc
+ from this module. *)
+ let auto_include find_in_dir fn =
+ if !Clflags.no_std_include then
+ raise Not_found
+ else
+ let alert = Location.auto_include_alert in
+ Load_path.auto_include_otherlibs alert find_in_dir fn
+ in
+ let visible, hidden =
+ get_pair (get_list get_string) (get_list get_string) payload
+ in
+ Load_path.init ~auto_include ~visible ~hidden
+ | "open_modules" ->
+ Clflags.open_modules := get_list get_string payload
+ | "for_package" ->
+ Clflags.for_package := get_option get_string payload
+ | "debug" ->
+ Clflags.debug := get_bool payload
+ | "use_threads" ->
+ Clflags.use_threads := get_bool payload
+ | "use_vmthreads" ->
+ if get_bool payload then
+ raise_errorf "Internal error: vmthreads not supported after 4.09.0"
+ | "recursive_types" ->
+ Clflags.recursive_types := get_bool payload
+ | "principal" ->
+ Clflags.principal := get_bool payload
+ | "transparent_modules" ->
+ Clflags.transparent_modules := get_bool payload
+ | "unboxed_types" ->
+ Clflags.unboxed_types := get_bool payload
+ | "cookies" ->
+ let l = get_list (get_pair get_string (fun x -> x)) payload in
+ cookies :=
+ List.fold_left
+ (fun s (k, v) -> String.Map.add k v s) String.Map.empty
+ l
+ | _ ->
+ ()
+ in
+ List.iter (function ({txt=Lident name}, x) -> field name x | _ -> ()) fields
+
+ let update_cookies fields =
+ let fields =
+ List.filter
+ (function ({txt=Lident "cookies"}, _) -> false | _ -> true)
+ fields
+ in
+ fields @ [get_cookies ()]
+end
+
+let ppx_context = PpxContext.make
+
+let extension_of_exn exn =
+ match error_of_exn exn with
+ | Some (`Ok error) -> extension_of_error error
+ | Some `Already_displayed ->
+ { loc = Location.none; txt = "ocaml.error" }, PStr []
+ | None -> raise exn
+
+
+let apply_lazy ~source ~target mapper =
+ let implem ast =
+ let fields, ast =
+ match ast with
+ | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"};
+ attr_payload = x})} :: l ->
+ PpxContext.get_fields x, l
+ | _ -> [], ast
+ in
+ PpxContext.restore fields;
+ let ast =
+ try
+ let mapper = mapper () in
+ mapper.structure mapper ast
+ with exn ->
+ [{pstr_desc = Pstr_extension (extension_of_exn exn, []);
+ pstr_loc = Location.none}]
+ in
+ let fields = PpxContext.update_cookies fields in
+ Str.attribute (PpxContext.mk fields) :: ast
+ in
+ let iface ast =
+ let fields, ast =
+ match ast with
+ | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"};
+ attr_payload = x;
+ attr_loc = _})} :: l ->
+ PpxContext.get_fields x, l
+ | _ -> [], ast
+ in
+ PpxContext.restore fields;
+ let ast =
+ try
+ let mapper = mapper () in
+ mapper.signature mapper ast
+ with exn ->
+ [{psig_desc = Psig_extension (extension_of_exn exn, []);
+ psig_loc = Location.none}]
+ in
+ let fields = PpxContext.update_cookies fields in
+ Sig.attribute (PpxContext.mk fields) :: ast
+ in
+
+ let ic = open_in_bin source in
+ let magic =
+ really_input_string ic (String.length Config.ast_impl_magic_number)
+ in
+
+ let rewrite transform =
+ Location.input_name := input_value ic;
+ let ast = input_value ic in
+ close_in ic;
+ let ast = transform ast in
+ let oc = open_out_bin target in
+ output_string oc magic;
+ output_value oc !Location.input_name;
+ output_value oc ast;
+ close_out oc
+ and fail () =
+ close_in ic;
+ failwith "Ast_mapper: OCaml version mismatch or malformed input";
+ in
+
+ if magic = Config.ast_impl_magic_number then
+ rewrite (implem : structure -> structure)
+ else if magic = Config.ast_intf_magic_number then
+ rewrite (iface : signature -> signature)
+ else fail ()
+
+let drop_ppx_context_str ~restore = function
+ | {pstr_desc = Pstr_attribute
+ {attr_name = {Location.txt = "ocaml.ppx.context"};
+ attr_payload = a;
+ attr_loc = _}}
+ :: items ->
+ if restore then
+ PpxContext.restore (PpxContext.get_fields a);
+ items
+ | items -> items
+
+let drop_ppx_context_sig ~restore = function
+ | {psig_desc = Psig_attribute
+ {attr_name = {Location.txt = "ocaml.ppx.context"};
+ attr_payload = a;
+ attr_loc = _}}
+ :: items ->
+ if restore then
+ PpxContext.restore (PpxContext.get_fields a);
+ items
+ | items -> items
+
+let add_ppx_context_str ~tool_name ast =
+ Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast
+
+let add_ppx_context_sig ~tool_name ast =
+ Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast
+
+
+let apply ~source ~target mapper =
+ apply_lazy ~source ~target (fun () -> mapper)
+
+let run_main mapper =
+ try
+ let a = Sys.argv in
+ let n = Array.length a in
+ if n > 2 then
+ let mapper () =
+ try mapper (Array.to_list (Array.sub a 1 (n - 3)))
+ with exn ->
+ (* PR#6463 *)
+ let f _ _ = raise exn in
+ {default_mapper with structure = f; signature = f}
+ in
+ apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper
+ else begin
+ Printf.eprintf "Usage: %s [extra_args] <infile> <outfile>\n%!"
+ Sys.executable_name;
+ exit 2
+ end
+ with exn ->
+ prerr_endline (Printexc.to_string exn);
+ exit 2
+
+let register_function = ref (fun _name f -> run_main f)
+let register name f = !register_function name f
diff --git a/upstream/ocaml_503/parsing/ast_mapper.mli b/upstream/ocaml_503/parsing/ast_mapper.mli
new file mode 100644
index 0000000000..541c1f7dac
--- /dev/null
+++ b/upstream/ocaml_503/parsing/ast_mapper.mli
@@ -0,0 +1,211 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(** The interface of a -ppx rewriter
+
+ A -ppx rewriter is a program that accepts a serialized abstract syntax
+ tree and outputs another, possibly modified, abstract syntax tree.
+ This module encapsulates the interface between the compiler and
+ the -ppx rewriters, handling such details as the serialization format,
+ forwarding of command-line flags, and storing state.
+
+ {!mapper} enables AST rewriting using open recursion.
+ A typical mapper would be based on {!default_mapper}, a deep
+ identity mapper, and will fall back on it for handling the syntax it
+ does not modify. For example:
+
+ {[
+open Asttypes
+open Parsetree
+open Ast_mapper
+
+let test_mapper argv =
+ { default_mapper with
+ expr = fun mapper expr ->
+ match expr with
+ | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} ->
+ Ast_helper.Exp.constant (Pconst_integer ("42", None))
+ | other -> default_mapper.expr mapper other; }
+
+let () =
+ register "ppx_test" test_mapper]}
+
+ This -ppx rewriter, which replaces [[%test]] in expressions with
+ the constant [42], can be compiled using
+ [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml].
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+ *)
+
+open Parsetree
+
+(** {1 A generic Parsetree mapper} *)
+
+type mapper = {
+ attribute: mapper -> attribute -> attribute;
+ attributes: mapper -> attribute list -> attribute list;
+ binding_op: mapper -> binding_op -> binding_op;
+ case: mapper -> case -> case;
+ cases: mapper -> case list -> case list;
+ class_declaration: mapper -> class_declaration -> class_declaration;
+ class_description: mapper -> class_description -> class_description;
+ class_expr: mapper -> class_expr -> class_expr;
+ class_field: mapper -> class_field -> class_field;
+ class_signature: mapper -> class_signature -> class_signature;
+ class_structure: mapper -> class_structure -> class_structure;
+ class_type: mapper -> class_type -> class_type;
+ class_type_declaration: mapper -> class_type_declaration
+ -> class_type_declaration;
+ class_type_field: mapper -> class_type_field -> class_type_field;
+ constant: mapper -> constant -> constant;
+ constructor_declaration: mapper -> constructor_declaration
+ -> constructor_declaration;
+ directive_argument: mapper -> directive_argument -> directive_argument;
+ expr: mapper -> expression -> expression;
+ extension: mapper -> extension -> extension;
+ extension_constructor: mapper -> extension_constructor
+ -> extension_constructor;
+ include_declaration: mapper -> include_declaration -> include_declaration;
+ include_description: mapper -> include_description -> include_description;
+ label_declaration: mapper -> label_declaration -> label_declaration;
+ location: mapper -> Location.t -> Location.t;
+ module_binding: mapper -> module_binding -> module_binding;
+ module_declaration: mapper -> module_declaration -> module_declaration;
+ module_substitution: mapper -> module_substitution -> module_substitution;
+ module_expr: mapper -> module_expr -> module_expr;
+ module_type: mapper -> module_type -> module_type;
+ module_type_declaration: mapper -> module_type_declaration
+ -> module_type_declaration;
+ open_declaration: mapper -> open_declaration -> open_declaration;
+ open_description: mapper -> open_description -> open_description;
+ pat: mapper -> pattern -> pattern;
+ payload: mapper -> payload -> payload;
+ signature: mapper -> signature -> signature;
+ signature_item: mapper -> signature_item -> signature_item;
+ structure: mapper -> structure -> structure;
+ structure_item: mapper -> structure_item -> structure_item;
+ toplevel_directive: mapper -> toplevel_directive -> toplevel_directive;
+ toplevel_phrase: mapper -> toplevel_phrase -> toplevel_phrase;
+ typ: mapper -> core_type -> core_type;
+ type_declaration: mapper -> type_declaration -> type_declaration;
+ type_extension: mapper -> type_extension -> type_extension;
+ type_exception: mapper -> type_exception -> type_exception;
+ type_kind: mapper -> type_kind -> type_kind;
+ value_binding: mapper -> value_binding -> value_binding;
+ value_description: mapper -> value_description -> value_description;
+ with_constraint: mapper -> with_constraint -> with_constraint;
+}
+(** A mapper record implements one "method" per syntactic category,
+ using an open recursion style: each method takes as its first
+ argument the mapper to be applied to children in the syntax
+ tree. *)
+
+val default_mapper: mapper
+(** A default mapper, which implements a "deep identity" mapping. *)
+
+(** {1 Apply mappers to compilation units} *)
+
+val tool_name: unit -> string
+(** Can be used within a ppx preprocessor to know which tool is
+ calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"],
+ ["ocaml"], ... Some global variables that reflect command-line
+ options are automatically synchronized between the calling tool
+ and the ppx preprocessor: {!Clflags.include_dirs},
+ {!Clflags.hidden_include_dirs}, {!Load_path}, {!Clflags.open_modules},
+ {!Clflags.for_package}, {!Clflags.debug}. *)
+
+
+val apply: source:string -> target:string -> mapper -> unit
+(** Apply a mapper (parametrized by the unit name) to a dumped
+ parsetree found in the [source] file and put the result in the
+ [target] file. The [structure] or [signature] field of the mapper
+ is applied to the implementation or interface. *)
+
+val run_main: (string list -> mapper) -> unit
+(** Entry point to call to implement a standalone -ppx rewriter from a
+ mapper, parametrized by the command line arguments. The current
+ unit name can be obtained from {!Location.input_name}. This
+ function implements proper error reporting for uncaught
+ exceptions. *)
+
+(** {1 Registration API} *)
+
+val register_function: (string -> (string list -> mapper) -> unit) ref
+
+val register: string -> (string list -> mapper) -> unit
+(** Apply the [register_function]. The default behavior is to run the
+ mapper immediately, taking arguments from the process command
+ line. This is to support a scenario where a mapper is linked as a
+ stand-alone executable.
+
+ It is possible to overwrite the [register_function] to define
+ "-ppx drivers", which combine several mappers in a single process.
+ Typically, a driver starts by defining [register_function] to a
+ custom implementation, then lets ppx rewriters (linked statically
+ or dynamically) register themselves, and then run all or some of
+ them. It is also possible to have -ppx drivers apply rewriters to
+ only specific parts of an AST.
+
+ The first argument to [register] is a symbolic name to be used by
+ the ppx driver. *)
+
+
+(** {1 Convenience functions to write mappers} *)
+
+val map_opt: ('a -> 'b) -> 'a option -> 'b option
+
+val extension_of_error: Location.error -> extension
+(** Encode an error into an 'ocaml.error' extension node which can be
+ inserted in a generated Parsetree. The compiler will be
+ responsible for reporting the error. *)
+
+val attribute_of_warning: Location.t -> string -> attribute
+(** Encode a warning message into an 'ocaml.ppwarning' attribute which can be
+ inserted in a generated Parsetree. The compiler will be
+ responsible for reporting the warning. *)
+
+(** {1 Helper functions to call external mappers} *)
+
+val add_ppx_context_str:
+ tool_name:string -> Parsetree.structure -> Parsetree.structure
+(** Extract information from the current environment and encode it
+ into an attribute which is prepended to the list of structure
+ items in order to pass the information to an external
+ processor. *)
+
+val add_ppx_context_sig:
+ tool_name:string -> Parsetree.signature -> Parsetree.signature
+(** Same as [add_ppx_context_str], but for signatures. *)
+
+val drop_ppx_context_str:
+ restore:bool -> Parsetree.structure -> Parsetree.structure
+(** Drop the ocaml.ppx.context attribute from a structure. If
+ [restore] is true, also restore the associated data in the current
+ process. *)
+
+val drop_ppx_context_sig:
+ restore:bool -> Parsetree.signature -> Parsetree.signature
+(** Same as [drop_ppx_context_str], but for signatures. *)
+
+(** {1 Cookies} *)
+
+(** Cookies are used to pass information from a ppx processor to
+ a further invocation of itself, when called from the OCaml
+ toplevel (or other tools that support cookies). *)
+
+val set_cookie: string -> Parsetree.expression -> unit
+val get_cookie: string -> Parsetree.expression option
diff --git a/upstream/ocaml_503/parsing/asttypes.ml b/upstream/ocaml_503/parsing/asttypes.ml
new file mode 100644
index 0000000000..0a5e73a4da
--- /dev/null
+++ b/upstream/ocaml_503/parsing/asttypes.ml
@@ -0,0 +1,72 @@
+(**************************************************************************)
+(* *)
+(* 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
+ | NoVariance
+
+type injectivity =
+ | Injective
+ | NoInjectivity
+
+let string_of_label = function
+ Nolabel -> ""
+ | Labelled s -> s
+ | Optional s -> "?"^s
diff --git a/upstream/ocaml_503/parsing/asttypes.mli b/upstream/ocaml_503/parsing/asttypes.mli
new file mode 100644
index 0000000000..e3cf5ae4e7
--- /dev/null
+++ b/upstream/ocaml_503/parsing/asttypes.mli
@@ -0,0 +1,69 @@
+(**************************************************************************)
+(* *)
+(* 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
+ | NoVariance
+
+type injectivity =
+ | Injective
+ | NoInjectivity
+
+val string_of_label: arg_label -> string
diff --git a/upstream/ocaml_503/parsing/attr_helper.ml b/upstream/ocaml_503/parsing/attr_helper.ml
new file mode 100644
index 0000000000..f531cf95b0
--- /dev/null
+++ b/upstream/ocaml_503/parsing/attr_helper.ml
@@ -0,0 +1,59 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2015 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Parsetree
+
+module Style = Misc.Style
+
+type error =
+ | Multiple_attributes of string
+ | No_payload_expected of string
+
+exception Error of Location.t * error
+
+let get_no_payload_attribute nm attrs =
+ let actions = [(nm, Builtin_attributes.Return)] in
+ match Builtin_attributes.select_attributes actions attrs with
+ | [] -> None
+ | [ {attr_name = name; attr_payload = PStr []; attr_loc = _} ] -> Some name
+ | [ {attr_name = name; _} ] ->
+ raise (Error (name.loc, No_payload_expected name.txt))
+ | _ :: {attr_name = name; _} :: _ ->
+ raise (Error (name.loc, Multiple_attributes name.txt))
+
+let has_no_payload_attribute alt_names attrs =
+ match get_no_payload_attribute alt_names attrs with
+ | None -> false
+ | Some _ -> true
+
+open Format_doc
+
+let report_error_doc ppf = function
+ | Multiple_attributes name ->
+ fprintf ppf "Too many %a attributes" Style.inline_code name
+ | No_payload_expected name ->
+ fprintf ppf "Attribute %a does not accept a payload" Style.inline_code name
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc, err) ->
+ Some (Location.error_of_printer ~loc report_error_doc err)
+ | _ ->
+ None
+ )
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/upstream/ocaml_503/parsing/attr_helper.mli b/upstream/ocaml_503/parsing/attr_helper.mli
new file mode 100644
index 0000000000..2782cba80a
--- /dev/null
+++ b/upstream/ocaml_503/parsing/attr_helper.mli
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2015 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. *)
+(* *)
+(**************************************************************************)
+
+(** Helpers for attributes
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Asttypes
+open Parsetree
+
+type error =
+ | Multiple_attributes of string
+ | No_payload_expected of string
+
+(** The [string] argument of the following functions is the name of the
+ attribute we are looking for. If the argument is ["foo"], these functions
+ will find attributes with the name ["foo"] or ["ocaml.foo"] *)
+val get_no_payload_attribute : string -> attributes -> string loc option
+val has_no_payload_attribute : string -> attributes -> bool
+
+exception Error of Location.t * error
+
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
diff --git a/upstream/ocaml_503/parsing/builtin_attributes.ml b/upstream/ocaml_503/parsing/builtin_attributes.ml
new file mode 100644
index 0000000000..4d730d3026
--- /dev/null
+++ b/upstream/ocaml_503/parsing/builtin_attributes.ml
@@ -0,0 +1,412 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Parsetree
+open Ast_helper
+
+
+module Attribute_table = Hashtbl.Make (struct
+ type t = string with_loc
+
+ let hash : t -> int = Hashtbl.hash
+ let equal : t -> t -> bool = (=)
+end)
+let unused_attrs = Attribute_table.create 128
+let mark_used t = Attribute_table.remove unused_attrs t
+
+(* [attr_order] is used to issue unused attribute warnings in the order the
+ attributes occur in the file rather than the random order of the hash table
+*)
+let attr_order a1 a2 =
+ match String.compare a1.loc.loc_start.pos_fname a2.loc.loc_start.pos_fname
+ with
+ | 0 -> Int.compare a1.loc.loc_start.pos_cnum a2.loc.loc_start.pos_cnum
+ | n -> n
+
+let compiler_stops_before_attributes_consumed () =
+ let stops_before_lambda =
+ match !Clflags.stop_after with
+ | None -> false
+ | Some pass -> Clflags.Compiler_pass.(compare pass Lambda) < 0
+ in
+ stops_before_lambda || !Clflags.print_types
+
+let warn_unused () =
+ let keys = List.of_seq (Attribute_table.to_seq_keys unused_attrs) in
+ Attribute_table.clear unused_attrs;
+ if not (compiler_stops_before_attributes_consumed ()) then
+ let keys = List.sort attr_order keys in
+ List.iter (fun sloc ->
+ Location.prerr_warning sloc.loc (Warnings.Misplaced_attribute sloc.txt))
+ keys
+
+(* These are the attributes that are tracked in the builtin_attrs table for
+ misplaced attribute warnings. *)
+let builtin_attrs =
+ [ "alert"
+ ; "boxed"
+ ; "deprecated"
+ ; "deprecated_mutable"
+ ; "explicit_arity"
+ ; "immediate"
+ ; "immediate64"
+ ; "inline"
+ ; "inlined"
+ ; "noalloc"
+ ; "poll"
+ ; "ppwarning"
+ ; "specialise"
+ ; "specialised"
+ ; "tailcall"
+ ; "tail_mod_cons"
+ ; "unboxed"
+ ; "untagged"
+ ; "unrolled"
+ ; "warnerror"
+ ; "warning"
+ ; "warn_on_literal_pattern"
+ ]
+
+let builtin_attrs =
+ let tbl = Hashtbl.create 128 in
+ List.iter (fun attr -> Hashtbl.add tbl attr ()) builtin_attrs;
+ tbl
+
+let drop_ocaml_attr_prefix s =
+ let len = String.length s in
+ if String.starts_with ~prefix:"ocaml." s && len > 6 then
+ String.sub s 6 (len - 6)
+ else
+ s
+
+let is_builtin_attr s = Hashtbl.mem builtin_attrs (drop_ocaml_attr_prefix s)
+
+type current_phase = Parser | Invariant_check
+
+let register_attr current_phase name =
+ match current_phase with
+ | Parser when !Clflags.all_ppx <> [] -> ()
+ | Parser | Invariant_check ->
+ if is_builtin_attr name.txt then
+ Attribute_table.replace unused_attrs name ()
+
+let string_of_cst const =
+ match const.pconst_desc with
+ | Pconst_string(s, _, _) -> Some s
+ | _ -> None
+
+let string_of_payload = function
+ | PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant c},_)}] ->
+ string_of_cst c
+ | _ -> None
+
+let string_of_opt_payload p =
+ match string_of_payload p with
+ | Some s -> s
+ | None -> ""
+
+module Style = Misc.Style
+let error_of_extension ext =
+ let submessage_from main_loc main_txt = function
+ | {pstr_desc=Pstr_extension
+ (({txt = ("ocaml.error"|"error"); loc}, p), _)} ->
+ begin match p with
+ | PStr([{pstr_desc=Pstr_eval
+ ({pexp_desc=Pexp_constant
+ {pconst_desc=Pconst_string(msg, _, _); _}}, _)}
+ ]) ->
+ Location.msg ~loc "%a" Format_doc.pp_print_text msg
+ | _ ->
+ Location.msg ~loc "Invalid syntax for sub-message of extension %a."
+ Style.inline_code main_txt
+ end
+ | {pstr_desc=Pstr_extension (({txt; loc}, _), _)} ->
+ Location.msg ~loc "Uninterpreted extension '%a'."
+ Style.inline_code txt
+ | _ ->
+ Location.msg ~loc:main_loc
+ "Invalid syntax for sub-message of extension %a."
+ Style.inline_code main_txt
+ in
+ match ext with
+ | ({txt = ("ocaml.error"|"error") as txt; loc}, p) ->
+ begin match p with
+ | PStr [] -> raise Location.Already_displayed_error
+ | PStr({pstr_desc=Pstr_eval
+ ({pexp_desc=Pexp_constant
+ {pconst_desc=Pconst_string(msg, _, _)}}, _)}::
+ inner) ->
+ let sub = List.map (submessage_from loc txt) inner in
+ Location.error_of_printer ~loc ~sub Format_doc.pp_print_text msg
+ | _ ->
+ Location.errorf ~loc "Invalid syntax for extension '%s'." txt
+ end
+ | ({txt; loc}, _) ->
+ Location.errorf ~loc "Uninterpreted extension '%s'." txt
+
+let attr_equals_builtin {attr_name = {txt; _}; _} s =
+ (* Check for attribute s or ocaml.s. Avoid allocating a fresh string. *)
+ txt = s ||
+ ( String.length txt = 6 + String.length s
+ && String.starts_with ~prefix:"ocaml." txt
+ && String.ends_with ~suffix:s txt)
+
+let mark_alert_used a =
+ if attr_equals_builtin a "deprecated" || attr_equals_builtin a "alert"
+ then mark_used a.attr_name
+
+let mark_alerts_used l = List.iter mark_alert_used l
+
+let mark_warn_on_literal_pattern_used l =
+ List.iter (fun a ->
+ if attr_equals_builtin a "warn_on_literal_pattern"
+ then mark_used a.attr_name)
+ l
+
+let mark_deprecated_mutable_used l =
+ List.iter (fun a ->
+ if attr_equals_builtin a "deprecated_mutable"
+ then mark_used a.attr_name)
+ l
+
+let mark_payload_attrs_used payload =
+ let iter =
+ { Ast_iterator.default_iterator
+ with attribute = fun self a ->
+ mark_used a.attr_name;
+ Ast_iterator.default_iterator.attribute self a
+ }
+ in
+ iter.payload iter payload
+
+let kind_and_message = function
+ | PStr[
+ {pstr_desc=
+ Pstr_eval
+ ({pexp_desc=Pexp_apply
+ ({pexp_desc=Pexp_ident{txt=Longident.Lident id}},
+ [Nolabel,{pexp_desc=Pexp_constant
+ {pconst_desc=Pconst_string(s,_,_); _}}])
+ },_)}] ->
+ Some (id, s)
+ | PStr[
+ {pstr_desc=
+ Pstr_eval
+ ({pexp_desc=Pexp_ident{txt=Longident.Lident id}},_)}] ->
+ Some (id, "")
+ | _ -> None
+
+let cat s1 s2 =
+ if s2 = "" then s1 else s1 ^ "\n" ^ s2
+
+let alert_attr x =
+ if attr_equals_builtin x "deprecated" then
+ Some (x, "deprecated", string_of_opt_payload x.attr_payload)
+ else if attr_equals_builtin x "alert" then
+ begin match kind_and_message x.attr_payload with
+ | Some (kind, message) -> Some (x, kind, message)
+ | None -> None (* note: bad payloads detected by warning_attribute *)
+ end
+ else None
+
+let alert_attrs l =
+ List.filter_map alert_attr l
+
+let alerts_of_attrs l =
+ List.fold_left
+ (fun acc (_, kind, message) ->
+ let upd = function
+ | None | Some "" -> Some message
+ | Some s -> Some (cat s message)
+ in
+ Misc.Stdlib.String.Map.update kind upd acc
+ )
+ Misc.Stdlib.String.Map.empty
+ (alert_attrs l)
+
+let check_alerts loc attrs s =
+ Misc.Stdlib.String.Map.iter
+ (fun kind message -> Location.alert loc ~kind (cat s message))
+ (alerts_of_attrs attrs)
+
+let check_alerts_inclusion ~def ~use loc attrs1 attrs2 s =
+ let m2 = alerts_of_attrs attrs2 in
+ Misc.Stdlib.String.Map.iter
+ (fun kind msg ->
+ if not (Misc.Stdlib.String.Map.mem kind m2) then
+ Location.alert ~def ~use ~kind loc (cat s msg)
+ )
+ (alerts_of_attrs attrs1)
+
+let rec deprecated_mutable_of_attrs = function
+ | [] -> None
+ | attr :: _ when attr_equals_builtin attr "deprecated_mutable" ->
+ Some (string_of_opt_payload attr.attr_payload)
+ | _ :: tl -> deprecated_mutable_of_attrs tl
+
+let check_deprecated_mutable loc attrs s =
+ match deprecated_mutable_of_attrs attrs with
+ | None -> ()
+ | Some txt ->
+ Location.deprecated loc (Printf.sprintf "mutating field %s" (cat s txt))
+
+let check_deprecated_mutable_inclusion ~def ~use loc attrs1 attrs2 s =
+ match deprecated_mutable_of_attrs attrs1,
+ deprecated_mutable_of_attrs attrs2
+ with
+ | None, _ | Some _, Some _ -> ()
+ | Some txt, None ->
+ Location.deprecated ~def ~use loc
+ (Printf.sprintf "mutating field %s" (cat s txt))
+
+let rec attrs_of_sig = function
+ | {psig_desc = Psig_attribute a} :: tl ->
+ a :: attrs_of_sig tl
+ | _ ->
+ []
+
+let alerts_of_sig ~mark sg =
+ let a = attrs_of_sig sg in
+ if mark then mark_alerts_used a;
+ alerts_of_attrs a
+
+let rec attrs_of_str = function
+ | {pstr_desc = Pstr_attribute a} :: tl ->
+ a :: attrs_of_str tl
+ | _ ->
+ []
+
+let alerts_of_str ~mark str =
+ let a = attrs_of_str str in
+ if mark then mark_alerts_used a;
+ alerts_of_attrs a
+
+let warn_payload loc txt msg =
+ Location.prerr_warning loc (Warnings.Attribute_payload (txt, msg))
+
+let warning_attribute ?(ppwarning = true) =
+ let process loc name errflag payload =
+ mark_used name;
+ match string_of_payload payload with
+ | Some s ->
+ begin try
+ Option.iter (Location.prerr_alert loc)
+ (Warnings.parse_options errflag s)
+ with Arg.Bad msg -> warn_payload loc name.txt msg
+ end
+ | None ->
+ warn_payload loc name.txt "A single string literal is expected"
+ in
+ let process_alert loc name = function
+ | PStr[{pstr_desc=
+ Pstr_eval(
+ {pexp_desc=Pexp_constant {pconst_desc=Pconst_string(s,_,_); _}},
+ _)
+ }] ->
+ begin
+ mark_used name;
+ try Warnings.parse_alert_option s
+ with Arg.Bad msg -> warn_payload loc name.txt msg
+ end
+ | k ->
+ match kind_and_message k with
+ | Some ("all", _) ->
+ warn_payload loc name.txt "The alert name 'all' is reserved"
+ | Some _ ->
+ (* Do [mark_used] in the [Some] case only if Warning 53 is
+ disabled. Later, they will be marked used (provided they are in a
+ valid place) in [compile_common], when they are extracted to be
+ persisted inside the [.cmi] file. *)
+ if not (Warnings.is_active (Misplaced_attribute ""))
+ then mark_used name
+ | None -> begin
+ (* Do [mark_used] in the [None] case, which is just malformed and
+ covered by the "Invalid payload" warning. *)
+ mark_used name;
+ warn_payload loc name.txt "Invalid payload"
+ end
+ in
+ fun ({attr_name; attr_loc; attr_payload} as attr) ->
+ if attr_equals_builtin attr "warning" then
+ process attr_loc attr_name false attr_payload
+ else if attr_equals_builtin attr "warnerror" then
+ process attr_loc attr_name true attr_payload
+ else if attr_equals_builtin attr "alert" then
+ process_alert attr_loc attr_name attr_payload
+ else if ppwarning && attr_equals_builtin attr "ppwarning" then
+ begin match attr_payload with
+ | PStr [{ pstr_desc=
+ Pstr_eval({pexp_desc=Pexp_constant
+ {pconst_desc=Pconst_string (s, _, _); _}},_);
+ pstr_loc }] ->
+ (mark_used attr_name;
+ Location.prerr_warning pstr_loc (Warnings.Preprocessor s))
+ | _ ->
+ (mark_used attr_name;
+ warn_payload attr_loc attr_name.txt
+ "A single string literal is expected")
+ end
+
+let warning_scope ?ppwarning attrs f =
+ let prev = Warnings.backup () in
+ try
+ List.iter (warning_attribute ?ppwarning) (List.rev attrs);
+ let ret = f () in
+ Warnings.restore prev;
+ ret
+ with exn ->
+ Warnings.restore prev;
+ raise exn
+
+let has_attribute nm attrs =
+ List.exists
+ (fun a ->
+ if attr_equals_builtin a nm
+ then (mark_used a.attr_name; true)
+ else false)
+ attrs
+
+type attr_action = Mark_used_only | Return
+let select_attributes actions attrs =
+ List.filter (fun a ->
+ List.exists (fun (nm, action) ->
+ attr_equals_builtin a nm &&
+ begin
+ mark_used a.attr_name;
+ action = Return
+ end)
+ actions
+ ) attrs
+
+let warn_on_literal_pattern attrs =
+ has_attribute "warn_on_literal_pattern" attrs
+
+let explicit_arity attrs = has_attribute "explicit_arity" attrs
+
+let immediate attrs = has_attribute "immediate" attrs
+
+let immediate64 attrs = has_attribute "immediate64" attrs
+
+(* The "ocaml.boxed (default)" and "ocaml.unboxed (default)"
+ attributes cannot be input by the user, they are added by the
+ compiler when applying the default setting. This is done to record
+ in the .cmi the default used by the compiler when compiling the
+ source file because the default can change between compiler
+ invocations. *)
+
+let has_unboxed attrs = has_attribute "unboxed" attrs
+
+let has_boxed attrs = has_attribute "boxed" attrs
diff --git a/upstream/ocaml_503/parsing/builtin_attributes.mli b/upstream/ocaml_503/parsing/builtin_attributes.mli
new file mode 100644
index 0000000000..4176bcb93e
--- /dev/null
+++ b/upstream/ocaml_503/parsing/builtin_attributes.mli
@@ -0,0 +1,187 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(** Support for the builtin attributes:
+
+ - ocaml.alert
+ - ocaml.boxed
+ - ocaml.deprecated
+ - ocaml.deprecated_mutable
+ - ocaml.explicit_arity
+ - ocaml.immediate
+ - ocaml.immediate64
+ - ocaml.inline
+ - ocaml.inlined
+ - ocaml.noalloc
+ - ocaml.poll
+ - ocaml.ppwarning
+ - ocaml.specialise
+ - ocaml.specialised
+ - ocaml.tailcall
+ - ocaml.tail_mod_cons
+ - ocaml.unboxed
+ - ocaml.untagged
+ - ocaml.unrolled
+ - ocaml.warnerror
+ - ocaml.warning
+ - ocaml.warn_on_literal_pattern
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+(** {2 Attribute tracking for warning 53} *)
+
+(** [register_attr] must be called on the locations of all attributes that
+ should be tracked for the purpose of misplaced attribute warnings. In
+ particular, it should be called on all attributes that are present in the
+ source program except those that are contained in the payload of another
+ attribute (because these may be left behind by a ppx and intentionally
+ ignored by the compiler).
+
+ The [current_phase] argument indicates when this function is being called
+ - either when an attribute is created in the parser or when we see an
+ attribute while running the check in the [Ast_invariants] module. This is
+ used to ensure that we track only attributes from the final version of the
+ parse tree: we skip adding attributes seen at parse time if we can see that
+ a ppx will be run later, because the [Ast_invariants] check is always run on
+ the result of a ppx.
+
+ Note that the [Ast_invariants] check is also run on parse trees created from
+ marshalled ast files if no ppx is being used, ensuring we don't miss
+ attributes in that case.
+*)
+type current_phase = Parser | Invariant_check
+val register_attr : current_phase -> string Location.loc -> unit
+
+(** Marks the attributes hiding in the payload of another attribute used, for
+ the purposes of misplaced attribute warnings (see comment on
+ [current_phase] above). In the parser, it's simplest to add these to
+ the table and remove them later, rather than threading through state
+ tracking whether we're in an attribute payload. *)
+val mark_payload_attrs_used : Parsetree.payload -> unit
+
+(** Issue misplaced attribute warnings for all attributes created with
+ [mk_internal] but not yet marked used. Does nothing if compilation
+ is stopped before lambda due to command-line flags. *)
+val warn_unused : unit -> unit
+
+(** {3 Warning 53 helpers for environment attributes}
+
+ Some attributes, like deprecation markers, do not affect the compilation of
+ the definition on which they appear, but rather result in warnings on future
+ uses of that definition. This is implemented by moving the raw attributes
+ into the environment, where they will be noticed on future accesses.
+
+ To make misplaced attribute warnings work appropriately for these
+ attributes, we mark them "used" when they are moved into the environment.
+ This is done with the helper functions in this section.
+*)
+
+(** Marks the attribute used for the purposes of misplaced attribute warnings if
+ it is an alert. Call this when moving things allowed to have alert
+ attributes into the environment. *)
+val mark_alert_used : Parsetree.attribute -> unit
+
+(** The same as [List.iter mark_alert_used]. *)
+val mark_alerts_used : Parsetree.attributes -> unit
+
+(** Marks "warn_on_literal_pattern" attributes used for the purposes of
+ misplaced attribute warnings. Call this when moving constructors into the
+ environment. *)
+val mark_warn_on_literal_pattern_used : Parsetree.attributes -> unit
+
+(** Marks "deprecated_mutable" attributes used for the purposes of misplaced
+ attribute warnings. Call this when moving labels of mutable fields into the
+ environment. *)
+val mark_deprecated_mutable_used : Parsetree.attributes -> unit
+
+(** {2 Helpers for alert and warning attributes} *)
+
+val check_alerts: Location.t -> Parsetree.attributes -> string -> unit
+val check_alerts_inclusion:
+ def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes ->
+ Parsetree.attributes -> string -> unit
+val alerts_of_attrs: Parsetree.attributes -> Misc.alerts
+val alerts_of_sig: mark:bool -> Parsetree.signature -> Misc.alerts
+val alerts_of_str: mark:bool -> Parsetree.structure -> Misc.alerts
+
+val check_deprecated_mutable:
+ Location.t -> Parsetree.attributes -> string -> unit
+val check_deprecated_mutable_inclusion:
+ def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes ->
+ Parsetree.attributes -> string -> unit
+
+val error_of_extension: Parsetree.extension -> Location.error
+
+val warning_attribute: ?ppwarning:bool -> Parsetree.attribute -> unit
+ (** Apply warning settings from the specified attribute.
+ "ocaml.warning"/"ocaml.warnerror" (and variants without the prefix) are
+ processed and marked used for warning 53. Other attributes are ignored.
+
+ Also implement ocaml.ppwarning (unless ~ppwarning:false is
+ passed).
+ *)
+
+val warning_scope:
+ ?ppwarning:bool ->
+ Parsetree.attributes -> (unit -> 'a) -> 'a
+ (** Execute a function in a new scope for warning settings. This
+ means that the effect of any call to [warning_attribute] during
+ the execution of this function will be discarded after
+ execution.
+
+ The function also takes a list of attributes which are processed
+ with [warning_attribute] in the fresh scope before the function
+ is executed.
+ *)
+
+(** {2 Helpers for searching for particular attributes} *)
+
+(** [has_attribute name attrs] is true if an attribute with name [name] or
+ ["ocaml." ^ name] is present in [attrs]. It marks that attribute used for
+ the purposes of misplaced attribute warnings. *)
+val has_attribute : string -> Parsetree.attributes -> bool
+
+(** [select_attributes actions attrs] finds the elements of [attrs] that appear
+ in [actions] and either returns them or just marks them used, according to
+ the corresponding [attr_action].
+
+ Each element [(nm, action)] of the [actions] list is an attribute along with
+ an [attr_action] specifying what to do with that attribute. The action is
+ used to accommodate different compiler configurations. If an attribute is
+ used only in some compiler configurations, it's important that we still look
+ for it and mark it used when compiling with other configurations.
+ Otherwise, we would issue spurious misplaced attribute warnings. *)
+type attr_action = Mark_used_only | Return
+val select_attributes :
+ (string * attr_action) list -> Parsetree.attributes -> Parsetree.attributes
+
+(** [attr_equals_builtin attr s] is true if the name of the attribute is [s] or
+ ["ocaml." ^ s]. This is useful for manually inspecting attribute names, but
+ note that doing so will not result in marking the attribute used for the
+ purpose of warning 53, so it is usually preferable to use [has_attribute]
+ or [select_attributes]. *)
+val attr_equals_builtin : Parsetree.attribute -> string -> bool
+
+val warn_on_literal_pattern: Parsetree.attributes -> bool
+val explicit_arity: Parsetree.attributes -> bool
+
+val immediate: Parsetree.attributes -> bool
+val immediate64: Parsetree.attributes -> bool
+
+val has_unboxed: Parsetree.attributes -> bool
+val has_boxed: Parsetree.attributes -> bool
diff --git a/upstream/ocaml_503/parsing/depend.ml b/upstream/ocaml_503/parsing/depend.ml
new file mode 100644
index 0000000000..bed4fd707e
--- /dev/null
+++ b/upstream/ocaml_503/parsing/depend.ml
@@ -0,0 +1,632 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1999 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Location
+open Longident
+open Parsetree
+module String = Misc.Stdlib.String
+
+let pp_deps = ref []
+
+(* Module resolution map *)
+(* Node (set of imports for this path, map for submodules) *)
+type map_tree = Node of String.Set.t * bound_map
+and bound_map = map_tree String.Map.t
+let bound = Node (String.Set.empty, String.Map.empty)
+
+(*let get_free (Node (s, _m)) = s*)
+let get_map (Node (_s, m)) = m
+let make_leaf s = Node (String.Set.singleton s, String.Map.empty)
+let make_node m = Node (String.Set.empty, m)
+let rec weaken_map s (Node(s0,m0)) =
+ Node (String.Set.union s s0, String.Map.map (weaken_map s) m0)
+let rec collect_free (Node (s, m)) =
+ String.Map.fold (fun _ n -> String.Set.union (collect_free n)) m s
+
+(* Returns the imports required to access the structure at path p *)
+(* Only raises Not_found if the head of p is not in the toplevel map *)
+let rec lookup_free p m =
+ match p with
+ [] -> raise Not_found
+ | s::p ->
+ let Node (f, m') = String.Map.find s m in
+ try lookup_free p m' with Not_found -> f
+
+(* Returns the node corresponding to the structure at path p *)
+let rec lookup_map lid m =
+ match lid with
+ Lident s -> String.Map.find s m
+ | Ldot (l, s) -> String.Map.find s (get_map (lookup_map l m))
+ | Lapply _ -> raise Not_found
+
+let free_structure_names = ref String.Set.empty
+
+let add_names s =
+ free_structure_names := String.Set.union s !free_structure_names
+
+let rec add_path bv ?(p=[]) = function
+ | Lident s ->
+ let free =
+ try lookup_free (s::p) bv with Not_found -> String.Set.singleton s
+ in
+ (*String.Set.iter (fun s -> Printf.eprintf "%s " s) free;
+ prerr_endline "";*)
+ add_names free
+ | Ldot(l, s) -> add_path bv ~p:(s::p) l
+ | Lapply(l1, l2) -> add_path bv l1; add_path bv l2
+
+let open_module bv lid =
+ match lookup_map lid bv with
+ | Node (s, m) ->
+ add_names s;
+ String.Map.fold String.Map.add m bv
+ | exception Not_found ->
+ add_path bv lid; bv
+
+let add_parent bv lid =
+ match lid.txt with
+ Ldot(l, _s) -> add_path bv l
+ | _ -> ()
+
+let add = add_parent
+
+let add_module_path bv lid = add_path bv lid.txt
+
+let handle_extension ext =
+ match (fst ext).txt with
+ | "error" | "ocaml.error" ->
+ raise (Location.Error
+ (Builtin_attributes.error_of_extension ext))
+ | _ ->
+ ()
+
+let rec add_type bv ty =
+ match ty.ptyp_desc with
+ Ptyp_any -> ()
+ | Ptyp_var _ -> ()
+ | Ptyp_arrow(_, t1, t2) -> add_type bv t1; add_type bv t2
+ | Ptyp_tuple tl -> List.iter (add_type bv) tl
+ | Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl
+ | Ptyp_object (fl, _) ->
+ List.iter
+ (fun {pof_desc; _} -> match pof_desc with
+ | Otag (_, t) -> add_type bv t
+ | Oinherit t -> add_type bv t) fl
+ | Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
+ | Ptyp_alias(t, _) -> add_type bv t
+ | Ptyp_variant(fl, _, _) ->
+ List.iter
+ (fun {prf_desc; _} -> match prf_desc with
+ | Rtag(_, _, stl) -> List.iter (add_type bv) stl
+ | Rinherit sty -> add_type bv sty)
+ fl
+ | Ptyp_poly(_, t) -> add_type bv t
+ | Ptyp_package pt -> add_package_type bv pt
+ | Ptyp_open (mod_ident, t) ->
+ let bv = open_module bv mod_ident.txt in
+ add_type bv t
+ | Ptyp_extension e -> handle_extension e
+
+and add_package_type bv (lid, l) =
+ add bv lid;
+ List.iter (add_type bv) (List.map (fun (_, e) -> e) l)
+
+let add_opt add_fn bv = function
+ None -> ()
+ | Some x -> add_fn bv x
+
+let add_constructor_arguments bv = function
+ | Pcstr_tuple l -> List.iter (add_type bv) l
+ | Pcstr_record l -> List.iter (fun l -> add_type bv l.pld_type) l
+
+let add_constructor_decl bv pcd =
+ add_constructor_arguments bv pcd.pcd_args;
+ Option.iter (add_type bv) pcd.pcd_res
+
+let add_type_declaration bv td =
+ List.iter
+ (fun (ty1, ty2, _) -> add_type bv ty1; add_type bv ty2)
+ td.ptype_cstrs;
+ add_opt add_type bv td.ptype_manifest;
+ let add_tkind = function
+ Ptype_abstract -> ()
+ | Ptype_variant cstrs ->
+ List.iter (add_constructor_decl bv) cstrs
+ | Ptype_record lbls ->
+ List.iter (fun pld -> add_type bv pld.pld_type) lbls
+ | Ptype_open -> () in
+ add_tkind td.ptype_kind
+
+let add_extension_constructor bv ext =
+ match ext.pext_kind with
+ Pext_decl(_, args, rty) ->
+ add_constructor_arguments bv args;
+ Option.iter (add_type bv) rty
+ | Pext_rebind lid -> add bv lid
+
+let add_type_extension bv te =
+ add bv te.ptyext_path;
+ List.iter (add_extension_constructor bv) te.ptyext_constructors
+
+let add_type_exception bv te =
+ add_extension_constructor bv te.ptyexn_constructor
+
+let pattern_bv = ref String.Map.empty
+
+let rec add_pattern bv pat =
+ match pat.ppat_desc with
+ Ppat_any -> ()
+ | Ppat_var _ -> ()
+ | Ppat_alias(p, _) -> add_pattern bv p
+ | Ppat_interval _
+ | Ppat_constant _ -> ()
+ | Ppat_tuple pl -> List.iter (add_pattern bv) pl
+ | Ppat_construct(c, opt) ->
+ add bv c;
+ add_opt
+ (fun bv (_,p) -> add_pattern bv p)
+ bv opt
+ | Ppat_record(pl, _) ->
+ List.iter (fun (lbl, p) -> add bv lbl; add_pattern bv p) pl
+ | Ppat_array pl -> List.iter (add_pattern bv) pl
+ | Ppat_or(p1, p2) -> add_pattern bv p1; add_pattern bv p2
+ | Ppat_constraint(p, ty) -> add_pattern bv p; add_type bv ty
+ | Ppat_variant(_, op) -> add_opt add_pattern bv op
+ | Ppat_type li -> add bv li
+ | Ppat_lazy p -> add_pattern bv p
+ | Ppat_unpack id ->
+ Option.iter
+ (fun name -> pattern_bv := String.Map.add name bound !pattern_bv) id.txt
+ | Ppat_open ( m, p) -> let bv = open_module bv m.txt in add_pattern bv p
+ | Ppat_effect(p1, p2) -> add_pattern bv p1; add_pattern bv p2
+ | Ppat_exception p -> add_pattern bv p
+ | Ppat_extension e -> handle_extension e
+
+let add_pattern bv pat =
+ pattern_bv := bv;
+ add_pattern bv pat;
+ !pattern_bv
+
+let rec add_expr bv exp =
+ match exp.pexp_desc with
+ Pexp_ident l -> add bv l
+ | Pexp_constant _ -> ()
+ | Pexp_let(rf, pel, e) ->
+ let bv = add_bindings rf bv pel in add_expr bv e
+ | Pexp_function (params, constraint_, body) ->
+ let bv = List.fold_left add_function_param bv params in
+ add_opt add_constraint bv constraint_;
+ add_function_body bv body
+ | Pexp_apply(e, el) ->
+ add_expr bv e; List.iter (fun (_,e) -> add_expr bv e) el
+ | Pexp_match(e, pel) -> add_expr bv e; add_cases bv pel
+ | Pexp_try(e, pel) -> add_expr bv e; add_cases bv pel
+ | Pexp_tuple el -> List.iter (add_expr bv) el
+ | Pexp_construct(c, opte) -> add bv c; add_opt add_expr bv opte
+ | Pexp_variant(_, opte) -> add_opt add_expr bv opte
+ | Pexp_record(lblel, opte) ->
+ List.iter (fun (lbl, e) -> add bv lbl; add_expr bv e) lblel;
+ add_opt add_expr bv opte
+ | Pexp_field(e, fld) -> add_expr bv e; add bv fld
+ | Pexp_setfield(e1, fld, e2) -> add_expr bv e1; add bv fld; add_expr bv e2
+ | Pexp_array el -> List.iter (add_expr bv) el
+ | Pexp_ifthenelse(e1, e2, opte3) ->
+ add_expr bv e1; add_expr bv e2; add_opt add_expr bv opte3
+ | Pexp_sequence(e1, e2) -> add_expr bv e1; add_expr bv e2
+ | Pexp_while(e1, e2) -> add_expr bv e1; add_expr bv e2
+ | Pexp_for( _, e1, e2, _, e3) ->
+ add_expr bv e1; add_expr bv e2; add_expr bv e3
+ | Pexp_coerce(e1, oty2, ty3) ->
+ add_expr bv e1;
+ add_opt add_type bv oty2;
+ add_type bv ty3
+ | Pexp_constraint(e1, ty2) ->
+ add_expr bv e1;
+ add_type bv ty2
+ | Pexp_send(e, _m) -> add_expr bv e
+ | Pexp_new li -> add bv li
+ | Pexp_setinstvar(_v, e) -> add_expr bv e
+ | Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel
+ | Pexp_letmodule(id, m, e) ->
+ let b = add_module_binding bv m in
+ let bv =
+ match id.txt with
+ | None -> bv
+ | Some id -> String.Map.add id b bv
+ in
+ add_expr bv e
+ | Pexp_letexception(_, e) -> add_expr bv e
+ | Pexp_assert (e) -> add_expr bv e
+ | Pexp_lazy (e) -> add_expr bv e
+ | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
+ | Pexp_object { pcstr_self = pat; pcstr_fields = fieldl } ->
+ let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
+ | Pexp_newtype (_, e) -> add_expr bv e
+ | Pexp_pack m -> add_module_expr bv m
+ | Pexp_open (o, e) ->
+ let bv = open_declaration bv o in
+ add_expr bv e
+ | Pexp_letop {let_; ands; body} ->
+ let bv' = add_binding_op bv bv let_ in
+ let bv' = List.fold_left (add_binding_op bv) bv' ands in
+ add_expr bv' body
+ | Pexp_extension (({ txt = ("ocaml.extension_constructor"|
+ "extension_constructor"); _ },
+ PStr [item]) as e) ->
+ begin match item.pstr_desc with
+ | Pstr_eval ({ pexp_desc = Pexp_construct (c, None) }, _) -> add bv c
+ | _ -> handle_extension e
+ end
+ | Pexp_extension e -> handle_extension e
+ | Pexp_unreachable -> ()
+
+and add_function_param bv param =
+ match param.pparam_desc with
+ | Pparam_val (_, opte, pat) ->
+ add_opt add_expr bv opte;
+ add_pattern bv pat
+ | Pparam_newtype _ -> bv
+
+and add_function_body bv body =
+ match body with
+ | Pfunction_body e ->
+ add_expr bv e
+ | Pfunction_cases (cases, _, _) ->
+ add_cases bv cases
+
+and add_constraint bv constraint_ =
+ match constraint_ with
+ | Pconstraint ty ->
+ add_type bv ty
+ | Pcoerce (ty1, ty2) ->
+ add_opt add_type bv ty1;
+ add_type bv ty2
+
+and add_cases bv cases =
+ List.iter (add_case bv) cases
+
+and add_case bv {pc_lhs; pc_guard; pc_rhs} =
+ let bv = add_pattern bv pc_lhs in
+ add_opt add_expr bv pc_guard;
+ add_expr bv pc_rhs
+
+and add_bindings recf bv pel =
+ let bv' = List.fold_left (fun bv x -> add_pattern bv x.pvb_pat) bv pel in
+ let bv = if recf = Recursive then bv' else bv in
+ let add_constraint = function
+ | Pvc_constraint {locally_abstract_univars=_; typ} ->
+ add_type bv typ
+ | Pvc_coercion { ground; coercion } ->
+ Option.iter (add_type bv) ground;
+ add_type bv coercion
+ in
+ let add_one_binding { pvb_pat= _ ; pvb_loc= _ ; pvb_constraint; pvb_expr } =
+ add_expr bv pvb_expr;
+ Option.iter add_constraint pvb_constraint
+ in
+ List.iter add_one_binding pel;
+ bv'
+
+and add_binding_op bv bv' pbop =
+ add_expr bv pbop.pbop_exp;
+ add_pattern bv' pbop.pbop_pat
+
+and add_modtype bv mty =
+ match mty.pmty_desc with
+ Pmty_ident l -> add bv l
+ | Pmty_alias l -> add_module_path bv l
+ | Pmty_signature s -> add_signature bv s
+ | Pmty_functor(param, mty2) ->
+ let bv =
+ match param with
+ | Unit -> bv
+ | Named (id, mty1) ->
+ add_modtype bv mty1;
+ match id.txt with
+ | None -> bv
+ | Some name -> String.Map.add name bound bv
+ in
+ add_modtype bv mty2
+ | Pmty_with(mty, cstrl) ->
+ add_modtype bv mty;
+ List.iter
+ (function
+ | Pwith_type (_, td) -> add_type_declaration bv td
+ | Pwith_module (_, lid) -> add_module_path bv lid
+ | Pwith_modtype (_, mty) -> add_modtype bv mty
+ | Pwith_typesubst (_, td) -> add_type_declaration bv td
+ | Pwith_modsubst (_, lid) -> add_module_path bv lid
+ | Pwith_modtypesubst (_, mty) -> add_modtype bv mty
+ )
+ cstrl
+ | Pmty_typeof m -> add_module_expr bv m
+ | Pmty_extension e -> handle_extension e
+
+and add_module_alias bv l =
+ (* If we are in delayed dependencies mode, we delay the dependencies
+ induced by "Lident s" *)
+ (if !Clflags.transparent_modules then add_parent else add_module_path) bv l;
+ try
+ lookup_map l.txt bv
+ with Not_found ->
+ match l.txt with
+ Lident s -> make_leaf s
+ | _ -> add_module_path bv l; bound (* cannot delay *)
+
+and add_modtype_binding bv mty =
+ match mty.pmty_desc with
+ Pmty_alias l ->
+ add_module_alias bv l
+ | Pmty_signature s ->
+ make_node (add_signature_binding bv s)
+ | Pmty_typeof modl ->
+ add_module_binding bv modl
+ | _ ->
+ add_modtype bv mty; bound
+
+and add_signature bv sg =
+ ignore (add_signature_binding bv sg)
+
+and add_signature_binding bv sg =
+ snd (List.fold_left add_sig_item (bv, String.Map.empty) sg)
+
+and add_sig_item (bv, m) item =
+ match item.psig_desc with
+ Psig_value vd ->
+ add_type bv vd.pval_type; (bv, m)
+ | Psig_type (_, dcls)
+ | Psig_typesubst dcls->
+ List.iter (add_type_declaration bv) dcls; (bv, m)
+ | Psig_typext te ->
+ add_type_extension bv te; (bv, m)
+ | Psig_exception te ->
+ add_type_exception bv te; (bv, m)
+ | Psig_module pmd ->
+ let m' = add_modtype_binding bv pmd.pmd_type in
+ let add map =
+ match pmd.pmd_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name m' map
+ in
+ (add bv, add m)
+ | Psig_modsubst pms ->
+ let m' = add_module_alias bv pms.pms_manifest in
+ let add = String.Map.add pms.pms_name.txt m' in
+ (add bv, add m)
+ | Psig_recmodule decls ->
+ let add =
+ List.fold_right (fun pmd map ->
+ match pmd.pmd_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name bound map
+ ) decls
+ in
+ let bv' = add bv and m' = add m in
+ List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
+ (bv', m')
+ | Psig_modtype x | Psig_modtypesubst x->
+ begin match x.pmtd_type with
+ None -> ()
+ | Some mty -> add_modtype bv mty
+ end;
+ (bv, m)
+ | Psig_open od ->
+ (open_description bv od, m)
+ | Psig_include incl ->
+ let Node (s, m') = add_modtype_binding bv incl.pincl_mod in
+ add_names s;
+ let add = String.Map.fold String.Map.add m' in
+ (add bv, add m)
+ | Psig_class cdl ->
+ List.iter (add_class_description bv) cdl; (bv, m)
+ | Psig_class_type cdtl ->
+ List.iter (add_class_type_declaration bv) cdtl; (bv, m)
+ | Psig_attribute _ -> (bv, m)
+ | Psig_extension (e, _) ->
+ handle_extension e;
+ (bv, m)
+
+and open_description bv od =
+ let Node(s, m) = add_module_alias bv od.popen_expr in
+ add_names s;
+ String.Map.fold String.Map.add m bv
+
+and open_declaration bv od =
+ let Node (s, m) = add_module_binding bv od.popen_expr in
+ add_names s;
+ String.Map.fold String.Map.add m bv
+
+and add_module_binding bv modl =
+ match modl.pmod_desc with
+ Pmod_ident l -> add_module_alias bv l
+ | Pmod_structure s ->
+ make_node (snd @@ add_structure_binding bv s)
+ | _ -> add_module_expr bv modl; bound
+
+and add_module_expr bv modl =
+ match modl.pmod_desc with
+ Pmod_ident l -> add_module_path bv l
+ | Pmod_structure s -> ignore (add_structure bv s)
+ | Pmod_functor(param, modl) ->
+ let bv =
+ match param with
+ | Unit -> bv
+ | Named (id, mty) ->
+ add_modtype bv mty;
+ match id.txt with
+ | None -> bv
+ | Some name -> String.Map.add name bound bv
+ in
+ add_module_expr bv modl
+ | Pmod_apply (mod1, mod2) ->
+ add_module_expr bv mod1;
+ add_module_expr bv mod2
+ | Pmod_apply_unit mod1 ->
+ add_module_expr bv mod1
+ | Pmod_constraint(modl, mty) ->
+ add_module_expr bv modl; add_modtype bv mty
+ | Pmod_unpack(e) ->
+ add_expr bv e
+ | Pmod_extension e ->
+ handle_extension e
+
+and add_class_type bv cty =
+ match cty.pcty_desc with
+ Pcty_constr(l, tyl) ->
+ add bv l; List.iter (add_type bv) tyl
+ | Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } ->
+ add_type bv ty;
+ List.iter (add_class_type_field bv) fieldl
+ | Pcty_arrow(_, ty1, cty2) ->
+ add_type bv ty1; add_class_type bv cty2
+ | Pcty_extension e -> handle_extension e
+ | Pcty_open (o, e) ->
+ let bv = open_description bv o in
+ add_class_type bv e
+
+and add_class_type_field bv pctf =
+ match pctf.pctf_desc with
+ Pctf_inherit cty -> add_class_type bv cty
+ | Pctf_val(_, _, _, ty) -> add_type bv ty
+ | Pctf_method(_, _, _, ty) -> add_type bv ty
+ | Pctf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+ | Pctf_attribute _ -> ()
+ | Pctf_extension e -> handle_extension e
+
+and add_class_description bv infos =
+ add_class_type bv infos.pci_expr
+
+and add_class_type_declaration bv infos = add_class_description bv infos
+
+and add_structure bv item_list =
+ let (bv, m) = add_structure_binding bv item_list in
+ add_names (collect_free (make_node m));
+ bv
+
+and add_structure_binding bv item_list =
+ List.fold_left add_struct_item (bv, String.Map.empty) item_list
+
+and add_struct_item (bv, m) item : _ String.Map.t * _ String.Map.t =
+ match item.pstr_desc with
+ Pstr_eval (e, _attrs) ->
+ add_expr bv e; (bv, m)
+ | Pstr_value(rf, pel) ->
+ let bv = add_bindings rf bv pel in (bv, m)
+ | Pstr_primitive vd ->
+ add_type bv vd.pval_type; (bv, m)
+ | Pstr_type (_, dcls) ->
+ List.iter (add_type_declaration bv) dcls; (bv, m)
+ | Pstr_typext te ->
+ add_type_extension bv te;
+ (bv, m)
+ | Pstr_exception te ->
+ add_type_exception bv te;
+ (bv, m)
+ | Pstr_module x ->
+ let b = add_module_binding bv x.pmb_expr in
+ let add map =
+ match x.pmb_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name b map
+ in
+ (add bv, add m)
+ | Pstr_recmodule bindings ->
+ let add =
+ List.fold_right (fun x map ->
+ match x.pmb_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name bound map
+ ) bindings
+ in
+ let bv' = add bv and m = add m in
+ List.iter
+ (fun x -> add_module_expr bv' x.pmb_expr)
+ bindings;
+ (bv', m)
+ | Pstr_modtype x ->
+ begin match x.pmtd_type with
+ None -> ()
+ | Some mty -> add_modtype bv mty
+ end;
+ (bv, m)
+ | Pstr_open od ->
+ (open_declaration bv od, m)
+ | Pstr_class cdl ->
+ List.iter (add_class_declaration bv) cdl; (bv, m)
+ | Pstr_class_type cdtl ->
+ List.iter (add_class_type_declaration bv) cdtl; (bv, m)
+ | Pstr_include incl ->
+ let Node (s, m') as n = add_module_binding bv incl.pincl_mod in
+ if !Clflags.transparent_modules then
+ add_names s
+ else
+ (* If we are not in the delayed dependency mode, we need to
+ collect all delayed dependencies imported by the include statement *)
+ add_names (collect_free n);
+ let add = String.Map.fold String.Map.add m' in
+ (add bv, add m)
+ | Pstr_attribute _ -> (bv, m)
+ | Pstr_extension (e, _) ->
+ handle_extension e;
+ (bv, m)
+
+and add_use_file bv top_phrs =
+ ignore (List.fold_left add_top_phrase bv top_phrs)
+
+and add_implementation bv l =
+ ignore (add_structure_binding bv l)
+
+and add_implementation_binding bv l =
+ snd (add_structure_binding bv l)
+
+and add_top_phrase bv = function
+ | Ptop_def str -> add_structure bv str
+ | Ptop_dir _ -> bv
+
+and add_class_expr bv ce =
+ match ce.pcl_desc with
+ Pcl_constr(l, tyl) ->
+ add bv l; List.iter (add_type bv) tyl
+ | Pcl_structure { pcstr_self = pat; pcstr_fields = fieldl } ->
+ let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
+ | Pcl_fun(_, opte, pat, ce) ->
+ add_opt add_expr bv opte;
+ let bv = add_pattern bv pat in add_class_expr bv ce
+ | Pcl_apply(ce, exprl) ->
+ add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl
+ | Pcl_let(rf, pel, ce) ->
+ let bv = add_bindings rf bv pel in add_class_expr bv ce
+ | Pcl_constraint(ce, ct) ->
+ add_class_expr bv ce; add_class_type bv ct
+ | Pcl_extension e -> handle_extension e
+ | Pcl_open (o, e) ->
+ let bv = open_description bv o in
+ add_class_expr bv e
+
+and add_class_field bv pcf =
+ match pcf.pcf_desc with
+ Pcf_inherit(_, ce, _) -> add_class_expr bv ce
+ | Pcf_val(_, _, Cfk_concrete (_, e))
+ | Pcf_method(_, _, Cfk_concrete (_, e)) -> add_expr bv e
+ | Pcf_val(_, _, Cfk_virtual ty)
+ | Pcf_method(_, _, Cfk_virtual ty) -> add_type bv ty
+ | Pcf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+ | Pcf_initializer e -> add_expr bv e
+ | Pcf_attribute _ -> ()
+ | Pcf_extension e -> handle_extension e
+
+and add_class_declaration bv decl =
+ add_class_expr bv decl.pci_expr
diff --git a/upstream/ocaml_503/parsing/depend.mli b/upstream/ocaml_503/parsing/depend.mli
new file mode 100644
index 0000000000..745cc722c7
--- /dev/null
+++ b/upstream/ocaml_503/parsing/depend.mli
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1999 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. *)
+(* *)
+(**************************************************************************)
+
+(** Module dependencies.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module String = Misc.Stdlib.String
+
+type map_tree = Node of String.Set.t * bound_map
+and bound_map = map_tree String.Map.t
+val make_leaf : string -> map_tree
+val make_node : bound_map -> map_tree
+val weaken_map : String.Set.t -> map_tree -> map_tree
+
+(** Collect free module identifiers in the a.s.t. *)
+val free_structure_names : String.Set.t ref
+
+(** Dependencies found by preprocessing tools. *)
+val pp_deps : string list ref
+
+val open_module : bound_map -> Longident.t -> bound_map
+
+val add_use_file : bound_map -> Parsetree.toplevel_phrase list -> unit
+
+val add_signature : bound_map -> Parsetree.signature -> unit
+
+val add_implementation : bound_map -> Parsetree.structure -> unit
+
+val add_implementation_binding : bound_map -> Parsetree.structure -> bound_map
+val add_signature_binding : bound_map -> Parsetree.signature -> bound_map
diff --git a/upstream/ocaml_503/parsing/docstrings.ml b/upstream/ocaml_503/parsing/docstrings.ml
new file mode 100644
index 0000000000..32b8e8c468
--- /dev/null
+++ b/upstream/ocaml_503/parsing/docstrings.ml
@@ -0,0 +1,427 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Leo White *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Location
+
+(* Docstrings *)
+
+(* A docstring is "attached" if it has been inserted in the AST. This
+ is used for generating unexpected docstring warnings. *)
+type ds_attached =
+ | Unattached (* Not yet attached anything.*)
+ | Info (* Attached to a field or constructor. *)
+ | Docs (* Attached to an item or as floating text. *)
+
+(* A docstring is "associated" with an item if there are no blank lines between
+ them. This is used for generating docstring ambiguity warnings. *)
+type ds_associated =
+ | Zero (* Not associated with an item *)
+ | One (* Associated with one item *)
+ | Many (* Associated with multiple items (ambiguity) *)
+
+type docstring =
+ { ds_body: string;
+ ds_loc: Location.t;
+ mutable ds_attached: ds_attached;
+ mutable ds_associated: ds_associated; }
+
+(* List of docstrings *)
+
+let docstrings : docstring list ref = ref []
+
+(* Warn for unused and ambiguous docstrings *)
+
+let warn_bad_docstrings () =
+ if Warnings.is_active (Warnings.Unexpected_docstring true) then begin
+ List.iter
+ (fun ds ->
+ match ds.ds_attached with
+ | Info -> ()
+ | Unattached ->
+ prerr_warning ds.ds_loc (Warnings.Unexpected_docstring true)
+ | Docs ->
+ match ds.ds_associated with
+ | Zero | One -> ()
+ | Many ->
+ prerr_warning ds.ds_loc (Warnings.Unexpected_docstring false))
+ (List.rev !docstrings)
+end
+
+(* Docstring constructors and destructors *)
+
+let docstring body loc =
+ let ds =
+ { ds_body = body;
+ ds_loc = loc;
+ ds_attached = Unattached;
+ ds_associated = Zero; }
+ in
+ ds
+
+let register ds =
+ docstrings := ds :: !docstrings
+
+let docstring_body ds = ds.ds_body
+
+let docstring_loc ds = ds.ds_loc
+
+(* Docstrings attached to items *)
+
+type docs =
+ { docs_pre: docstring option;
+ docs_post: docstring option; }
+
+let empty_docs = { docs_pre = None; docs_post = None }
+
+let doc_loc = {txt = "ocaml.doc"; loc = Location.none}
+
+let docs_attr ds =
+ let open Parsetree in
+ let body = ds.ds_body in
+ let loc = ds.ds_loc in
+ let const = { pconst_desc= Pconst_string(body,loc,None); pconst_loc= loc } in
+ let exp =
+ { pexp_desc = Pexp_constant const;
+ pexp_loc = loc;
+ pexp_loc_stack = [];
+ pexp_attributes = []; }
+ in
+ let item =
+ { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc }
+ in
+ { attr_name = doc_loc;
+ attr_payload = PStr [item];
+ attr_loc = loc }
+
+let add_docs_attrs docs attrs =
+ let attrs =
+ match docs.docs_pre with
+ | None | Some { ds_body=""; _ } -> attrs
+ | Some ds -> docs_attr ds :: attrs
+ in
+ let attrs =
+ match docs.docs_post with
+ | None | Some { ds_body=""; _ } -> attrs
+ | Some ds -> attrs @ [docs_attr ds]
+ in
+ attrs
+
+(* Docstrings attached to constructors or fields *)
+
+type info = docstring option
+
+let empty_info = None
+
+let info_attr = docs_attr
+
+let add_info_attrs info attrs =
+ match info with
+ | None | Some {ds_body=""; _} -> attrs
+ | Some ds -> attrs @ [info_attr ds]
+
+(* Docstrings not attached to a specific item *)
+
+type text = docstring list
+
+let empty_text = []
+let empty_text_lazy = lazy []
+
+let text_loc = {txt = "ocaml.text"; loc = Location.none}
+
+let text_attr ds =
+ let open Parsetree in
+ let body = ds.ds_body in
+ let loc = ds.ds_loc in
+ let const = { pconst_desc= Pconst_string(body,loc,None); pconst_loc= loc } in
+ let exp =
+ { pexp_desc = Pexp_constant const;
+ pexp_loc = loc;
+ pexp_loc_stack = [];
+ pexp_attributes = []; }
+ in
+ let item =
+ { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc }
+ in
+ { attr_name = text_loc;
+ attr_payload = PStr [item];
+ attr_loc = loc }
+
+let add_text_attrs dsl attrs =
+ let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in
+ (List.map text_attr fdsl) @ attrs
+
+(* Find the first non-info docstring in a list, attach it and return it *)
+let get_docstring ~info dsl =
+ let rec loop = function
+ | [] -> None
+ | {ds_attached = Info; _} :: rest -> loop rest
+ | ds :: _ ->
+ ds.ds_attached <- if info then Info else Docs;
+ Some ds
+ in
+ loop dsl
+
+(* Find all the non-info docstrings in a list, attach them and return them *)
+let get_docstrings dsl =
+ let rec loop acc = function
+ | [] -> List.rev acc
+ | {ds_attached = Info; _} :: rest -> loop acc rest
+ | ds :: rest ->
+ ds.ds_attached <- Docs;
+ loop (ds :: acc) rest
+ in
+ loop [] dsl
+
+(* "Associate" all the docstrings in a list *)
+let associate_docstrings dsl =
+ List.iter
+ (fun ds ->
+ match ds.ds_associated with
+ | Zero -> ds.ds_associated <- One
+ | (One | Many) -> ds.ds_associated <- Many)
+ dsl
+
+(* Map from positions to pre docstrings *)
+
+let pre_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_pre_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add pre_table pos dsl
+
+let get_pre_docs pos =
+ try
+ let dsl = Hashtbl.find pre_table pos in
+ associate_docstrings dsl;
+ get_docstring ~info:false dsl
+ with Not_found -> None
+
+let mark_pre_docs pos =
+ try
+ let dsl = Hashtbl.find pre_table pos in
+ associate_docstrings dsl
+ with Not_found -> ()
+
+(* Map from positions to post docstrings *)
+
+let post_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_post_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add post_table pos dsl
+
+let get_post_docs pos =
+ try
+ let dsl = Hashtbl.find post_table pos in
+ associate_docstrings dsl;
+ get_docstring ~info:false dsl
+ with Not_found -> None
+
+let mark_post_docs pos =
+ try
+ let dsl = Hashtbl.find post_table pos in
+ associate_docstrings dsl
+ with Not_found -> ()
+
+let get_info pos =
+ try
+ let dsl = Hashtbl.find post_table pos in
+ get_docstring ~info:true dsl
+ with Not_found -> None
+
+(* Map from positions to floating docstrings *)
+
+let floating_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_floating_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add floating_table pos dsl
+
+let get_text pos =
+ try
+ let dsl = Hashtbl.find floating_table pos in
+ get_docstrings dsl
+ with Not_found -> []
+
+let get_post_text pos =
+ try
+ let dsl = Hashtbl.find post_table pos in
+ get_docstrings dsl
+ with Not_found -> []
+
+(* Maps from positions to extra docstrings *)
+
+let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_pre_extra_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add pre_extra_table pos dsl
+
+let get_pre_extra_text pos =
+ try
+ let dsl = Hashtbl.find pre_extra_table pos in
+ get_docstrings dsl
+ with Not_found -> []
+
+let post_extra_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_post_extra_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add post_extra_table pos dsl
+
+let get_post_extra_text pos =
+ try
+ let dsl = Hashtbl.find post_extra_table pos in
+ get_docstrings dsl
+ with Not_found -> []
+
+(* Docstrings from parser actions *)
+module WithParsing = struct
+let symbol_docs () =
+ { docs_pre = get_pre_docs (Parsing.symbol_start_pos ());
+ docs_post = get_post_docs (Parsing.symbol_end_pos ()); }
+
+let symbol_docs_lazy () =
+ let p1 = Parsing.symbol_start_pos () in
+ let p2 = Parsing.symbol_end_pos () in
+ lazy { docs_pre = get_pre_docs p1;
+ docs_post = get_post_docs p2; }
+
+let rhs_docs pos1 pos2 =
+ { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1);
+ docs_post = get_post_docs (Parsing.rhs_end_pos pos2); }
+
+let rhs_docs_lazy pos1 pos2 =
+ let p1 = Parsing.rhs_start_pos pos1 in
+ let p2 = Parsing.rhs_end_pos pos2 in
+ lazy { docs_pre = get_pre_docs p1;
+ docs_post = get_post_docs p2; }
+
+let mark_symbol_docs () =
+ mark_pre_docs (Parsing.symbol_start_pos ());
+ mark_post_docs (Parsing.symbol_end_pos ())
+
+let mark_rhs_docs pos1 pos2 =
+ mark_pre_docs (Parsing.rhs_start_pos pos1);
+ mark_post_docs (Parsing.rhs_end_pos pos2)
+
+let symbol_info () =
+ get_info (Parsing.symbol_end_pos ())
+
+let rhs_info pos =
+ get_info (Parsing.rhs_end_pos pos)
+
+let symbol_text () =
+ get_text (Parsing.symbol_start_pos ())
+
+let symbol_text_lazy () =
+ let pos = Parsing.symbol_start_pos () in
+ lazy (get_text pos)
+
+let rhs_text pos =
+ get_text (Parsing.rhs_start_pos pos)
+
+let rhs_post_text pos =
+ get_post_text (Parsing.rhs_end_pos pos)
+
+let rhs_text_lazy pos =
+ let pos = Parsing.rhs_start_pos pos in
+ lazy (get_text pos)
+
+let symbol_pre_extra_text () =
+ get_pre_extra_text (Parsing.symbol_start_pos ())
+
+let symbol_post_extra_text () =
+ get_post_extra_text (Parsing.symbol_end_pos ())
+
+let rhs_pre_extra_text pos =
+ get_pre_extra_text (Parsing.rhs_start_pos pos)
+
+let rhs_post_extra_text pos =
+ get_post_extra_text (Parsing.rhs_end_pos pos)
+end
+
+include WithParsing
+
+module WithMenhir = struct
+let symbol_docs (startpos, endpos) =
+ { docs_pre = get_pre_docs startpos;
+ docs_post = get_post_docs endpos; }
+
+let symbol_docs_lazy (p1, p2) =
+ lazy { docs_pre = get_pre_docs p1;
+ docs_post = get_post_docs p2; }
+
+let rhs_docs pos1 pos2 =
+ { docs_pre = get_pre_docs pos1;
+ docs_post = get_post_docs pos2; }
+
+let rhs_docs_lazy p1 p2 =
+ lazy { docs_pre = get_pre_docs p1;
+ docs_post = get_post_docs p2; }
+
+let mark_symbol_docs (startpos, endpos) =
+ mark_pre_docs startpos;
+ mark_post_docs endpos;
+ ()
+
+let mark_rhs_docs pos1 pos2 =
+ mark_pre_docs pos1;
+ mark_post_docs pos2;
+ ()
+
+let symbol_info endpos =
+ get_info endpos
+
+let rhs_info endpos =
+ get_info endpos
+
+let symbol_text startpos =
+ get_text startpos
+
+let symbol_text_lazy startpos =
+ lazy (get_text startpos)
+
+let rhs_text pos =
+ get_text pos
+
+let rhs_post_text pos =
+ get_post_text pos
+
+let rhs_text_lazy pos =
+ lazy (get_text pos)
+
+let symbol_pre_extra_text startpos =
+ get_pre_extra_text startpos
+
+let symbol_post_extra_text endpos =
+ get_post_extra_text endpos
+
+let rhs_pre_extra_text pos =
+ get_pre_extra_text pos
+
+let rhs_post_extra_text pos =
+ get_post_extra_text pos
+end
+
+(* (Re)Initialise all comment state *)
+
+let init () =
+ docstrings := [];
+ Hashtbl.reset pre_table;
+ Hashtbl.reset post_table;
+ Hashtbl.reset floating_table;
+ Hashtbl.reset pre_extra_table;
+ Hashtbl.reset post_extra_table
diff --git a/upstream/ocaml_503/parsing/docstrings.mli b/upstream/ocaml_503/parsing/docstrings.mli
new file mode 100644
index 0000000000..bf2508fdc4
--- /dev/null
+++ b/upstream/ocaml_503/parsing/docstrings.mli
@@ -0,0 +1,223 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Leo White *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Documentation comments
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+(** (Re)Initialise all docstring state *)
+val init : unit -> unit
+
+(** Emit warnings for unattached and ambiguous docstrings *)
+val warn_bad_docstrings : unit -> unit
+
+(** {2 Docstrings} *)
+
+(** Documentation comments *)
+type docstring
+
+(** Create a docstring *)
+val docstring : string -> Location.t -> docstring
+
+(** Register a docstring *)
+val register : docstring -> unit
+
+(** Get the text of a docstring *)
+val docstring_body : docstring -> string
+
+(** Get the location of a docstring *)
+val docstring_loc : docstring -> Location.t
+
+(** {2 Set functions}
+
+ These functions are used by the lexer to associate docstrings to
+ the locations of tokens. *)
+
+(** Docstrings immediately preceding a token *)
+val set_pre_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately following a token *)
+val set_post_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings not immediately adjacent to a token *)
+val set_floating_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately following the token which precedes this one *)
+val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately preceding the token which follows this one *)
+val set_post_extra_docstrings : Lexing.position -> docstring list -> unit
+
+(** {2 Items}
+
+ The {!docs} type represents documentation attached to an item. *)
+
+type docs =
+ { docs_pre: docstring option;
+ docs_post: docstring option; }
+
+val empty_docs : docs
+
+val docs_attr : docstring -> Parsetree.attribute
+
+(** Convert item documentation to attributes and add them to an
+ attribute list *)
+val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the item documentation for the current symbol. This also
+ marks this documentation (for ambiguity warnings). *)
+val symbol_docs : unit -> docs
+val symbol_docs_lazy : unit -> docs Lazy.t
+
+(** Fetch the item documentation for the symbols between two
+ positions. This also marks this documentation (for ambiguity
+ warnings). *)
+val rhs_docs : int -> int -> docs
+val rhs_docs_lazy : int -> int -> docs Lazy.t
+
+(** Mark the item documentation for the current symbol (for ambiguity
+ warnings). *)
+val mark_symbol_docs : unit -> unit
+
+(** Mark as associated the item documentation for the symbols between
+ two positions (for ambiguity warnings) *)
+val mark_rhs_docs : int -> int -> unit
+
+(** {2 Fields and constructors}
+
+ The {!info} type represents documentation attached to a field or
+ constructor. *)
+
+type info = docstring option
+
+val empty_info : info
+
+val info_attr : docstring -> Parsetree.attribute
+
+(** Convert field info to attributes and add them to an
+ attribute list *)
+val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the field info for the current symbol. *)
+val symbol_info : unit -> info
+
+(** Fetch the field info following the symbol at a given position. *)
+val rhs_info : int -> info
+
+(** {2 Unattached comments}
+
+ The {!text} type represents documentation which is not attached to
+ anything. *)
+
+type text = docstring list
+
+val empty_text : text
+val empty_text_lazy : text Lazy.t
+
+val text_attr : docstring -> Parsetree.attribute
+
+(** Convert text to attributes and add them to an attribute list *)
+val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the text preceding the current symbol. *)
+val symbol_text : unit -> text
+val symbol_text_lazy : unit -> text Lazy.t
+
+(** Fetch the text preceding the symbol at the given position. *)
+val rhs_text : int -> text
+val rhs_text_lazy : int -> text Lazy.t
+
+(** {2 Extra text}
+
+ There may be additional text attached to the delimiters of a block
+ (e.g. [struct] and [end]). This is fetched by the following
+ functions, which are applied to the contents of the block rather
+ than the delimiters. *)
+
+(** Fetch additional text preceding the current symbol *)
+val symbol_pre_extra_text : unit -> text
+
+(** Fetch additional text following the current symbol *)
+val symbol_post_extra_text : unit -> text
+
+(** Fetch additional text preceding the symbol at the given position *)
+val rhs_pre_extra_text : int -> text
+
+(** Fetch additional text following the symbol at the given position *)
+val rhs_post_extra_text : int -> text
+
+(** Fetch text following the symbol at the given position *)
+val rhs_post_text : int -> text
+
+module WithMenhir: sig
+(** Fetch the item documentation for the current symbol. This also
+ marks this documentation (for ambiguity warnings). *)
+val symbol_docs : Lexing.position * Lexing.position -> docs
+val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t
+
+(** Fetch the item documentation for the symbols between two
+ positions. This also marks this documentation (for ambiguity
+ warnings). *)
+val rhs_docs : Lexing.position -> Lexing.position -> docs
+val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t
+
+(** Mark the item documentation for the current symbol (for ambiguity
+ warnings). *)
+val mark_symbol_docs : Lexing.position * Lexing.position -> unit
+
+(** Mark as associated the item documentation for the symbols between
+ two positions (for ambiguity warnings) *)
+val mark_rhs_docs : Lexing.position -> Lexing.position -> unit
+
+(** Fetch the field info for the current symbol. *)
+val symbol_info : Lexing.position -> info
+
+(** Fetch the field info following the symbol at a given position. *)
+val rhs_info : Lexing.position -> info
+
+(** Fetch the text preceding the current symbol. *)
+val symbol_text : Lexing.position -> text
+val symbol_text_lazy : Lexing.position -> text Lazy.t
+
+(** Fetch the text preceding the symbol at the given position. *)
+val rhs_text : Lexing.position -> text
+val rhs_text_lazy : Lexing.position -> text Lazy.t
+
+(** {3 Extra text}
+
+ There may be additional text attached to the delimiters of a block
+ (e.g. [struct] and [end]). This is fetched by the following
+ functions, which are applied to the contents of the block rather
+ than the delimiters. *)
+
+(** Fetch additional text preceding the current symbol *)
+val symbol_pre_extra_text : Lexing.position -> text
+
+(** Fetch additional text following the current symbol *)
+val symbol_post_extra_text : Lexing.position -> text
+
+(** Fetch additional text preceding the symbol at the given position *)
+val rhs_pre_extra_text : Lexing.position -> text
+
+(** Fetch additional text following the symbol at the given position *)
+val rhs_post_extra_text : Lexing.position -> text
+
+(** Fetch text following the symbol at the given position *)
+val rhs_post_text : Lexing.position -> text
+
+end
diff --git a/upstream/ocaml_503/parsing/lexer.mli b/upstream/ocaml_503/parsing/lexer.mli
new file mode 100644
index 0000000000..fc43eee28c
--- /dev/null
+++ b/upstream/ocaml_503/parsing/lexer.mli
@@ -0,0 +1,71 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** The lexical analyzer
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val init : ?keyword_edition:((int*int) option * string list) -> unit -> unit
+val token: Lexing.lexbuf -> Parser.token
+val skip_hash_bang: Lexing.lexbuf -> unit
+
+type error =
+ | Illegal_character of char
+ | Illegal_escape of string * string option
+ | Reserved_sequence of string * string option
+ | Unterminated_comment of Location.t
+ | Unterminated_string
+ | Unterminated_string_in_comment of Location.t * Location.t
+ | Empty_character_literal
+ | Keyword_as_label of string
+ | Capitalized_label of string
+ | Invalid_literal of string
+ | Invalid_directive of string * string option
+ | Invalid_encoding of string
+ | Invalid_char_in_ident of Uchar.t
+ | Non_lowercase_delimiter of string
+ | Capitalized_raw_identifier of string
+ | Unknown_keyword of string
+
+exception Error of error * Location.t
+
+val in_comment : unit -> bool
+val in_string : unit -> bool
+
+val is_keyword : string -> bool
+
+val print_warnings : bool ref
+val handle_docstrings: bool ref
+val comments : unit -> (string * Location.t) list
+val token_with_comments : Lexing.lexbuf -> Parser.token
+
+(*
+ [set_preprocessor init preprocessor] registers [init] as the function
+to call to initialize the preprocessor when the lexer is initialized,
+and [preprocessor] a function that is called when a new token is needed
+by the parser, as [preprocessor lexer lexbuf] where [lexer] is the
+lexing function.
+
+When a preprocessor is configured by calling [set_preprocessor], the lexer
+changes its behavior to accept backslash-newline as a token-separating blank.
+*)
+
+val set_preprocessor :
+ (unit -> unit) ->
+ ((Lexing.lexbuf -> Parser.token) -> Lexing.lexbuf -> Parser.token) ->
+ unit
diff --git a/upstream/ocaml_503/parsing/lexer.mll b/upstream/ocaml_503/parsing/lexer.mll
new file mode 100644
index 0000000000..d4d069d0b7
--- /dev/null
+++ b/upstream/ocaml_503/parsing/lexer.mll
@@ -0,0 +1,1019 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* The lexer definition *)
+
+{
+open Lexing
+open Misc
+open Parser
+
+type error =
+ | Illegal_character of char
+ | Illegal_escape of string * string option
+ | Reserved_sequence of string * string option
+ | Unterminated_comment of Location.t
+ | Unterminated_string
+ | Unterminated_string_in_comment of Location.t * Location.t
+ | Empty_character_literal
+ | Keyword_as_label of string
+ | Capitalized_label of string
+ | Invalid_literal of string
+ | Invalid_directive of string * string option
+ | Invalid_encoding of string
+ | Invalid_char_in_ident of Uchar.t
+ | Non_lowercase_delimiter of string
+ | Capitalized_raw_identifier of string
+ | Unknown_keyword of string
+
+exception Error of error * Location.t
+
+(* The table of keywords *)
+
+let all_keywords =
+ let v5_3 = Some (5,3) in
+ let v1_0 = Some (1,0) in
+ let v1_6 = Some (1,6) in
+ let v4_2 = Some (4,2) in
+ let always = None in
+ [
+ "and", AND, always;
+ "as", AS, always;
+ "assert", ASSERT, v1_6;
+ "begin", BEGIN, always;
+ "class", CLASS, v1_0;
+ "constraint", CONSTRAINT, v1_0;
+ "do", DO, always;
+ "done", DONE, always;
+ "downto", DOWNTO, always;
+ "effect", EFFECT, v5_3;
+ "else", ELSE, always;
+ "end", END, always;
+ "exception", EXCEPTION, always;
+ "external", EXTERNAL, always;
+ "false", FALSE, always;
+ "for", FOR, always;
+ "fun", FUN, always;
+ "function", FUNCTION, always;
+ "functor", FUNCTOR, always;
+ "if", IF, always;
+ "in", IN, always;
+ "include", INCLUDE, always;
+ "inherit", INHERIT, v1_0;
+ "initializer", INITIALIZER, v1_0;
+ "lazy", LAZY, v1_6;
+ "let", LET, always;
+ "match", MATCH, always;
+ "method", METHOD, v1_0;
+ "module", MODULE, always;
+ "mutable", MUTABLE, always;
+ "new", NEW, v1_0;
+ "nonrec", NONREC, v4_2;
+ "object", OBJECT, v1_0;
+ "of", OF, always;
+ "open", OPEN, always;
+ "or", OR, always;
+(* "parser", PARSER; *)
+ "private", PRIVATE, v1_0;
+ "rec", REC, always;
+ "sig", SIG, always;
+ "struct", STRUCT, always;
+ "then", THEN, always;
+ "to", TO, always;
+ "true", TRUE, always;
+ "try", TRY, always;
+ "type", TYPE, always;
+ "val", VAL, always;
+ "virtual", VIRTUAL, v1_0;
+ "when", WHEN, always;
+ "while", WHILE, always;
+ "with", WITH, always;
+
+ "lor", INFIXOP3("lor"), always; (* Should be INFIXOP2 *)
+ "lxor", INFIXOP3("lxor"), always; (* Should be INFIXOP2 *)
+ "mod", INFIXOP3("mod"), always;
+ "land", INFIXOP3("land"), always;
+ "lsl", INFIXOP4("lsl"), always;
+ "lsr", INFIXOP4("lsr"), always;
+ "asr", INFIXOP4("asr"), always
+]
+
+
+let keyword_table = Hashtbl.create 149
+
+let populate_keywords (version,keywords) =
+ let greater (x:(int*int) option) (y:(int*int) option) =
+ match x, y with
+ | None, _ | _, None -> true
+ | Some x, Some y -> x >= y
+ in
+ let tbl = keyword_table in
+ Hashtbl.clear tbl;
+ let add_keyword (name, token, since) =
+ if greater version since then Hashtbl.replace tbl name (Some token)
+ in
+ List.iter add_keyword all_keywords;
+ List.iter (fun name ->
+ match List.find (fun (n,_,_) -> n = name) all_keywords with
+ | (_,tok,_) -> Hashtbl.replace tbl name (Some tok)
+ | exception Not_found -> Hashtbl.replace tbl name None
+ ) keywords
+
+
+(* To buffer string literals *)
+
+let string_buffer = Buffer.create 256
+let reset_string_buffer () = Buffer.reset string_buffer
+let get_stored_string () = Buffer.contents string_buffer
+
+let store_string_char c = Buffer.add_char string_buffer c
+let store_string_utf_8_uchar u = Buffer.add_utf_8_uchar string_buffer u
+let store_string s = Buffer.add_string string_buffer s
+let store_substring s ~pos ~len = Buffer.add_substring string_buffer s pos len
+
+let store_lexeme lexbuf = store_string (Lexing.lexeme lexbuf)
+let store_normalized_newline newline =
+ (* #12502: we normalize "\r\n" to "\n" at lexing time,
+ to avoid behavior difference due to OS-specific
+ newline characters in string literals.
+
+ (For example, Git for Windows will translate \n in versioned
+ files into \r\n sequences when checking out files on Windows. If
+ your code contains multiline quoted string literals, the raw
+ content of the string literal would be different between Git for
+ Windows users and all other users. Thanks to newline
+ normalization, the value of the literal as a string constant will
+ be the same no matter which programming tools are used.)
+
+ Many programming languages use the same approach, for example
+ Java, Javascript, Kotlin, Python, Swift and C++.
+ *)
+ (* Our 'newline' regexp accepts \r*\n, but we only wish
+ to normalize \r?\n into \n -- see the discussion in #12502.
+ All carriage returns except for the (optional) last one
+ are reproduced in the output. We implement this by skipping
+ the first carriage return, if any. *)
+ let len = String.length newline in
+ if len = 1
+ then store_string_char '\n'
+ else store_substring newline ~pos:1 ~len:(len - 1)
+
+(* To store the position of the beginning of a string and comment *)
+let string_start_loc = ref Location.none
+let comment_start_loc = ref []
+let in_comment () = !comment_start_loc <> []
+let is_in_string = ref false
+let in_string () = !is_in_string
+let print_warnings = ref true
+
+(* Escaped chars are interpreted in strings unless they are in comments. *)
+let store_escaped_char lexbuf c =
+ if in_comment () then store_lexeme lexbuf else store_string_char c
+
+let store_escaped_uchar lexbuf u =
+ if in_comment () then store_lexeme lexbuf else store_string_utf_8_uchar u
+
+let compute_quoted_string_idloc {Location.loc_start = orig_loc } shift id =
+ let id_start_pos = orig_loc.Lexing.pos_cnum + shift in
+ let loc_start =
+ Lexing.{orig_loc with pos_cnum = id_start_pos }
+ in
+ let loc_end =
+ Lexing.{orig_loc with pos_cnum = id_start_pos + String.length id}
+ in
+ {Location. loc_start ; loc_end ; loc_ghost = false }
+
+let wrap_string_lexer f lexbuf =
+ let loc_start = lexbuf.lex_curr_p in
+ reset_string_buffer();
+ is_in_string := true;
+ let string_start = lexbuf.lex_start_p in
+ string_start_loc := Location.curr lexbuf;
+ let loc_end = f lexbuf in
+ is_in_string := false;
+ lexbuf.lex_start_p <- string_start;
+ let loc = Location.{loc_ghost= false; loc_start; loc_end} in
+ get_stored_string (), loc
+
+let wrap_comment_lexer comment lexbuf =
+ let start_loc = Location.curr lexbuf in
+ comment_start_loc := [start_loc];
+ reset_string_buffer ();
+ let end_loc = comment lexbuf in
+ let s = get_stored_string () in
+ reset_string_buffer ();
+ s,
+ { start_loc with Location.loc_end = end_loc.Location.loc_end }
+
+let error lexbuf e = raise (Error(e, Location.curr lexbuf))
+let error_loc loc e = raise (Error(e, loc))
+
+(* to translate escape sequences *)
+
+let digit_value c =
+ match c with
+ | 'a' .. 'f' -> 10 + Char.code c - Char.code 'a'
+ | 'A' .. 'F' -> 10 + Char.code c - Char.code 'A'
+ | '0' .. '9' -> Char.code c - Char.code '0'
+ | _ -> assert false
+
+let num_value lexbuf ~base ~first ~last =
+ let c = ref 0 in
+ for i = first to last do
+ let v = digit_value (Lexing.lexeme_char lexbuf i) in
+ assert(v < base);
+ c := (base * !c) + v
+ done;
+ !c
+
+let char_for_backslash = function
+ | 'n' -> '\010'
+ | 'r' -> '\013'
+ | 'b' -> '\008'
+ | 't' -> '\009'
+ | c -> c
+
+let illegal_escape lexbuf reason =
+ let error = Illegal_escape (Lexing.lexeme lexbuf, Some reason) in
+ raise (Error (error, Location.curr lexbuf))
+
+let char_for_decimal_code lexbuf i =
+ let c = num_value lexbuf ~base:10 ~first:i ~last:(i+2) in
+ if (c < 0 || c > 255) then
+ if in_comment ()
+ then 'x'
+ else
+ illegal_escape lexbuf
+ (Printf.sprintf
+ "%d is outside the range of legal characters (0-255)." c)
+ else Char.chr c
+
+let char_for_octal_code lexbuf i =
+ let c = num_value lexbuf ~base:8 ~first:i ~last:(i+2) in
+ if (c < 0 || c > 255) then
+ if in_comment ()
+ then 'x'
+ else
+ illegal_escape lexbuf
+ (Printf.sprintf
+ "o%o (=%d) is outside the range of legal characters (0-255)." c c)
+ else Char.chr c
+
+let char_for_hexadecimal_code lexbuf i =
+ Char.chr (num_value lexbuf ~base:16 ~first:i ~last:(i+1))
+
+let uchar_for_uchar_escape lexbuf =
+ let len = Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf in
+ let first = 3 (* skip opening \u{ *) in
+ let last = len - 2 (* skip closing } *) in
+ let digit_count = last - first + 1 in
+ match digit_count > 6 with
+ | true ->
+ illegal_escape lexbuf
+ "too many digits, expected 1 to 6 hexadecimal digits"
+ | false ->
+ let cp = num_value lexbuf ~base:16 ~first ~last in
+ if Uchar.is_valid cp then Uchar.unsafe_of_int cp else
+ illegal_escape lexbuf
+ (Printf.sprintf "%X is not a Unicode scalar value" cp)
+
+let validate_encoding lexbuf raw_name =
+ match Utf8_lexeme.normalize raw_name with
+ | Error _ -> error lexbuf (Invalid_encoding raw_name)
+ | Ok name -> name
+
+let ident_for_extended lexbuf raw_name =
+ let name = validate_encoding lexbuf raw_name in
+ match Utf8_lexeme.validate_identifier name with
+ | Utf8_lexeme.Valid -> name
+ | Utf8_lexeme.Invalid_character u -> error lexbuf (Invalid_char_in_ident u)
+ | Utf8_lexeme.Invalid_beginning _ ->
+ assert false (* excluded by the regexps *)
+
+let validate_delim lexbuf raw_name =
+ let name = validate_encoding lexbuf raw_name in
+ if Utf8_lexeme.is_lowercase name then name
+ else error lexbuf (Non_lowercase_delimiter name)
+
+let validate_ext lexbuf name =
+ let name = validate_encoding lexbuf name in
+ match Utf8_lexeme.validate_identifier ~with_dot:true name with
+ | Utf8_lexeme.Valid -> name
+ | Utf8_lexeme.Invalid_character u -> error lexbuf (Invalid_char_in_ident u)
+ | Utf8_lexeme.Invalid_beginning _ ->
+ assert false (* excluded by the regexps *)
+
+let lax_delim raw_name =
+ match Utf8_lexeme.normalize raw_name with
+ | Error _ -> None
+ | Ok name ->
+ if Utf8_lexeme.is_lowercase name then Some name
+ else None
+
+let is_keyword name =
+ Hashtbl.mem keyword_table name
+
+let find_keyword lexbuf name =
+ match Hashtbl.find keyword_table name with
+ | Some x -> x
+ | None -> error lexbuf (Unknown_keyword name)
+ | exception Not_found -> LIDENT name
+
+let check_label_name ?(raw_escape=false) lexbuf name =
+ if Utf8_lexeme.is_capitalized name then
+ error lexbuf (Capitalized_label name);
+ if not raw_escape && is_keyword name then
+ error lexbuf (Keyword_as_label name)
+
+(* Update the current location with file name and line number. *)
+
+let update_loc lexbuf file line absolute chars =
+ let pos = lexbuf.lex_curr_p in
+ let new_file = match file with
+ | None -> pos.pos_fname
+ | Some s -> s
+ in
+ lexbuf.lex_curr_p <- { pos with
+ pos_fname = new_file;
+ pos_lnum = if absolute then line else pos.pos_lnum + line;
+ pos_bol = pos.pos_cnum - chars;
+ }
+
+let preprocessor = ref None
+
+let escaped_newlines = ref false
+
+let handle_docstrings = ref true
+let comment_list = ref []
+
+let add_comment com =
+ comment_list := com :: !comment_list
+
+let add_docstring_comment ds =
+ let com =
+ ("*" ^ Docstrings.docstring_body ds, Docstrings.docstring_loc ds)
+ in
+ add_comment com
+
+let comments () = List.rev !comment_list
+
+(* Error report *)
+
+open Format_doc
+
+let prepare_error loc = function
+ | Illegal_character c ->
+ Location.errorf ~loc "Illegal character (%s)" (Char.escaped c)
+ | Illegal_escape (s, explanation) ->
+ Location.errorf ~loc
+ "Illegal backslash escape in string or character (%s)%t" s
+ (fun ppf -> match explanation with
+ | None -> ()
+ | Some expl -> fprintf ppf ": %s" expl)
+ | Reserved_sequence (s, explanation) ->
+ Location.errorf ~loc
+ "Reserved character sequence: %s%t" s
+ (fun ppf -> match explanation with
+ | None -> ()
+ | Some expl -> fprintf ppf " %s" expl)
+ | Unterminated_comment _ ->
+ Location.errorf ~loc "Comment not terminated"
+ | Unterminated_string ->
+ Location.errorf ~loc "String literal not terminated"
+ | Unterminated_string_in_comment (_, literal_loc) ->
+ Location.errorf ~loc
+ "This comment contains an unterminated string literal"
+ ~sub:[Location.msg ~loc:literal_loc "String literal begins here"]
+ | Empty_character_literal ->
+ let msg = "Illegal empty character literal ''" in
+ let sub =
+ [Location.msg
+ "@{<hint>Hint@}: Did you mean ' ' or a type variable 'a?"] in
+ Location.error ~loc ~sub msg
+ | Keyword_as_label kwd ->
+ Location.errorf ~loc
+ "%a is a keyword, it cannot be used as label name" Style.inline_code kwd
+ | Capitalized_label lbl ->
+ Location.errorf ~loc
+ "%a cannot be used as label name, \
+ it must start with a lowercase letter" Style.inline_code lbl
+ | Invalid_literal s ->
+ Location.errorf ~loc "Invalid literal %s" s
+ | Invalid_directive (dir, explanation) ->
+ Location.errorf ~loc "Invalid lexer directive %S%t" dir
+ (fun ppf -> match explanation with
+ | None -> ()
+ | Some expl -> fprintf ppf ": %s" expl)
+ | Invalid_encoding s ->
+ Location.errorf ~loc "Invalid encoding of identifier %s." s
+ | Invalid_char_in_ident u ->
+ Location.errorf ~loc "Invalid character U+%X in identifier"
+ (Uchar.to_int u)
+ | Capitalized_raw_identifier lbl ->
+ Location.errorf ~loc
+ "%a cannot be used as a raw identifier, \
+ it must start with a lowercase letter" Style.inline_code lbl
+ | Non_lowercase_delimiter name ->
+ Location.errorf ~loc
+ "%a cannot be used as a quoted string delimiter,@ \
+ it must contain only lowercase letters."
+ Style.inline_code name
+ | Unknown_keyword name ->
+ Location.errorf ~loc
+ "%a has been defined as an additional keyword.@ \
+ This version of OCaml does not support this keyword."
+ Style.inline_code name
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (err, loc) ->
+ Some (prepare_error loc err)
+ | _ ->
+ None
+ )
+
+}
+
+let newline = ('\013'* '\010')
+let blank = [' ' '\009' '\012']
+let lowercase = ['a'-'z' '_']
+let uppercase = ['A'-'Z']
+let identstart = lowercase | uppercase
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
+let utf8 = ['\192'-'\255'] ['\128'-'\191']*
+let identstart_ext = identstart | utf8
+let identchar_ext = identchar | utf8
+let delim_ext = (lowercase | uppercase | utf8)*
+(* ascii uppercase letters in quoted string delimiters ({delim||delim}) are
+ rejected by the delimiter validation function, we accept them temporarily to
+ have the same error message for ascii and non-ascii uppercase letters *)
+
+let symbolchar =
+ ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
+let dotsymbolchar =
+ ['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|']
+let symbolchar_or_hash =
+ symbolchar | '#'
+let kwdopchar =
+ ['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|']
+
+let ident = (lowercase | uppercase) identchar*
+let ident_ext = identstart_ext identchar_ext*
+let extattrident = ident_ext ('.' ident_ext)*
+
+let decimal_literal =
+ ['0'-'9'] ['0'-'9' '_']*
+let hex_digit =
+ ['0'-'9' 'A'-'F' 'a'-'f']
+let hex_literal =
+ '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']['0'-'9' 'A'-'F' 'a'-'f' '_']*
+let oct_literal =
+ '0' ['o' 'O'] ['0'-'7'] ['0'-'7' '_']*
+let bin_literal =
+ '0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']*
+let int_literal =
+ decimal_literal | hex_literal | oct_literal | bin_literal
+let float_literal =
+ ['0'-'9'] ['0'-'9' '_']*
+ ('.' ['0'-'9' '_']* )?
+ (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']* )?
+let hex_float_literal =
+ '0' ['x' 'X']
+ ['0'-'9' 'A'-'F' 'a'-'f'] ['0'-'9' 'A'-'F' 'a'-'f' '_']*
+ ('.' ['0'-'9' 'A'-'F' 'a'-'f' '_']* )?
+ (['p' 'P'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']* )?
+let literal_modifier = ['G'-'Z' 'g'-'z']
+let raw_ident_escape = "\\#"
+
+rule token = parse
+ | ('\\' as bs) newline {
+ if not !escaped_newlines then error lexbuf (Illegal_character bs);
+ update_loc lexbuf None 1 false 0;
+ token lexbuf }
+ | newline
+ { update_loc lexbuf None 1 false 0;
+ EOL }
+ | blank +
+ { token lexbuf }
+ | "_"
+ { UNDERSCORE }
+ | "~"
+ { TILDE }
+ | ".~"
+ { error lexbuf
+ (Reserved_sequence (".~", Some "is reserved for use in MetaOCaml")) }
+ | "~" (identstart identchar * as name) ':'
+ { check_label_name lexbuf name;
+ LABEL name }
+ | "~" (raw_ident_escape? as escape) (ident_ext as raw_name) ':'
+ { let name = ident_for_extended lexbuf raw_name in
+ check_label_name ~raw_escape:(escape<>"") lexbuf name;
+ LABEL name }
+ | "?"
+ { QUESTION }
+ | "?" (lowercase identchar * as name) ':'
+ { check_label_name lexbuf name;
+ OPTLABEL name }
+ | "?" (raw_ident_escape? as escape) (ident_ext as raw_name) ':'
+ { let name = ident_for_extended lexbuf raw_name in
+ check_label_name ~raw_escape:(escape<>"") lexbuf name;
+ OPTLABEL name
+ }
+ | lowercase identchar * as name
+ { find_keyword lexbuf name }
+ | uppercase identchar * as name
+ { UIDENT name } (* No capitalized keywords *)
+ | (raw_ident_escape? as escape) (ident_ext as raw_name)
+ { let name = ident_for_extended lexbuf raw_name in
+ if Utf8_lexeme.is_capitalized name then begin
+ if escape="" then UIDENT name
+ else
+ (* we don't have capitalized keywords, and thus no needs for
+ capitalized raw identifiers. *)
+ error lexbuf (Capitalized_raw_identifier name)
+ end else
+ LIDENT name
+ } (* No non-ascii keywords *)
+ | int_literal as lit { INT (lit, None) }
+ | (int_literal as lit) (literal_modifier as modif)
+ { INT (lit, Some modif) }
+ | float_literal | hex_float_literal as lit
+ { FLOAT (lit, None) }
+ | (float_literal | hex_float_literal as lit) (literal_modifier as modif)
+ { FLOAT (lit, Some modif) }
+ | (float_literal | hex_float_literal | int_literal) identchar+ as invalid
+ { error lexbuf (Invalid_literal invalid) }
+ | "\""
+ { let s, loc = wrap_string_lexer string lexbuf in
+ STRING (s, loc, None) }
+ | "{" (delim_ext as raw_name) '|'
+ { let delim = validate_delim lexbuf raw_name in
+ let s, loc = wrap_string_lexer (quoted_string delim) lexbuf in
+ STRING (s, loc, Some delim)
+ }
+ | "{%" (extattrident as raw_id) "|"
+ { let orig_loc = Location.curr lexbuf in
+ let id = validate_ext lexbuf raw_id in
+ let s, loc = wrap_string_lexer (quoted_string "") lexbuf in
+ let idloc = compute_quoted_string_idloc orig_loc 2 id in
+ QUOTED_STRING_EXPR (id, idloc, s, loc, Some "") }
+ | "{%" (extattrident as raw_id) blank+ (delim_ext as raw_delim) "|"
+ { let orig_loc = Location.curr lexbuf in
+ let id = validate_ext lexbuf raw_id in
+ let delim = validate_delim lexbuf raw_delim in
+ let s, loc = wrap_string_lexer (quoted_string delim) lexbuf in
+ let idloc = compute_quoted_string_idloc orig_loc 2 id in
+ QUOTED_STRING_EXPR (id, idloc, s, loc, Some delim) }
+ | "{%%" (extattrident as raw_id) "|"
+ { let orig_loc = Location.curr lexbuf in
+ let id = validate_ext lexbuf raw_id in
+ let s, loc = wrap_string_lexer (quoted_string "") lexbuf in
+ let idloc = compute_quoted_string_idloc orig_loc 3 id in
+ QUOTED_STRING_ITEM (id, idloc, s, loc, Some "") }
+ | "{%%" (extattrident as raw_id) blank+ (delim_ext as raw_delim) "|"
+ { let orig_loc = Location.curr lexbuf in
+ let id = validate_ext lexbuf raw_id in
+ let delim = validate_delim lexbuf raw_delim in
+ let s, loc = wrap_string_lexer (quoted_string delim) lexbuf in
+ let idloc = compute_quoted_string_idloc orig_loc 3 id in
+ QUOTED_STRING_ITEM (id, idloc, s, loc, Some delim) }
+ | "\'" newline "\'"
+ { update_loc lexbuf None 1 false 1;
+ (* newline is ('\013'* '\010') *)
+ CHAR '\n' }
+ | "\'" ([^ '\\' '\'' '\010' '\013'] as c) "\'"
+ { CHAR c }
+ | "\'\\" (['\\' '\'' '\"' 'n' 't' 'b' 'r' ' '] as c) "\'"
+ { CHAR (char_for_backslash c) }
+ | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'"
+ { CHAR(char_for_decimal_code lexbuf 2) }
+ | "\'\\" 'o' ['0'-'7'] ['0'-'7'] ['0'-'7'] "\'"
+ { CHAR(char_for_octal_code lexbuf 3) }
+ | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'"
+ { CHAR(char_for_hexadecimal_code lexbuf 3) }
+ | "\'" ("\\" [^ '#'] as esc)
+ { error lexbuf (Illegal_escape (esc, None)) }
+ | "\'\'"
+ { error lexbuf Empty_character_literal }
+ | "(*"
+ { let s, loc = wrap_comment_lexer comment lexbuf in
+ COMMENT (s, loc) }
+ | "(**"
+ { let s, loc = wrap_comment_lexer comment lexbuf in
+ if !handle_docstrings then
+ DOCSTRING (Docstrings.docstring s loc)
+ else
+ COMMENT ("*" ^ s, loc)
+ }
+ | "(**" (('*'+) as stars)
+ { let s, loc =
+ wrap_comment_lexer
+ (fun lexbuf ->
+ store_string ("*" ^ stars);
+ comment lexbuf)
+ lexbuf
+ in
+ COMMENT (s, loc) }
+ | "(*)"
+ { if !print_warnings then
+ Location.prerr_warning (Location.curr lexbuf) Warnings.Comment_start;
+ let s, loc = wrap_comment_lexer comment lexbuf in
+ COMMENT (s, loc) }
+ | "(*" (('*'*) as stars) "*)"
+ { if !handle_docstrings && stars="" then
+ (* (**) is an empty docstring *)
+ DOCSTRING(Docstrings.docstring "" (Location.curr lexbuf))
+ else
+ COMMENT (stars, Location.curr lexbuf) }
+ | "*)"
+ { let loc = Location.curr lexbuf in
+ Location.prerr_warning loc Warnings.Comment_not_end;
+ lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
+ let curpos = lexbuf.lex_curr_p in
+ lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 };
+ STAR
+ }
+ | "#"
+ { let at_beginning_of_line pos = (pos.pos_cnum = pos.pos_bol) in
+ if not (at_beginning_of_line lexbuf.lex_start_p)
+ then HASH
+ else try directive lexbuf with Failure _ -> HASH
+ }
+ | "&" { AMPERSAND }
+ | "&&" { AMPERAMPER }
+ | "`" { BACKQUOTE }
+ | "\'" { QUOTE }
+ | "(" { LPAREN }
+ | ")" { RPAREN }
+ | "*" { STAR }
+ | "," { COMMA }
+ | "->" { MINUSGREATER }
+ | "." { DOT }
+ | ".." { DOTDOT }
+ | "." (dotsymbolchar symbolchar* as op) { DOTOP op }
+ | ":" { COLON }
+ | "::" { COLONCOLON }
+ | ":=" { COLONEQUAL }
+ | ":>" { COLONGREATER }
+ | ";" { SEMI }
+ | ";;" { SEMISEMI }
+ | "<" { LESS }
+ | "<-" { LESSMINUS }
+ | "=" { EQUAL }
+ | "[" { LBRACKET }
+ | "[|" { LBRACKETBAR }
+ | "[<" { LBRACKETLESS }
+ | "[>" { LBRACKETGREATER }
+ | "]" { RBRACKET }
+ | "{" { LBRACE }
+ | "{<" { LBRACELESS }
+ | "|" { BAR }
+ | "||" { BARBAR }
+ | "|]" { BARRBRACKET }
+ | ">" { GREATER }
+ | ">]" { GREATERRBRACKET }
+ | "}" { RBRACE }
+ | ">}" { GREATERRBRACE }
+ | "[@" { LBRACKETAT }
+ | "[@@" { LBRACKETATAT }
+ | "[@@@" { LBRACKETATATAT }
+ | "[%" { LBRACKETPERCENT }
+ | "[%%" { LBRACKETPERCENTPERCENT }
+ | "!" { BANG }
+ | "!=" { INFIXOP0 "!=" }
+ | "+" { PLUS }
+ | "+." { PLUSDOT }
+ | "+=" { PLUSEQ }
+ | "-" { MINUS }
+ | "-." { MINUSDOT }
+
+ | "!" symbolchar_or_hash + as op
+ { PREFIXOP op }
+ | ['~' '?'] symbolchar_or_hash + as op
+ { PREFIXOP op }
+ | ['=' '<' '>' '|' '&' '$'] symbolchar * as op
+ { INFIXOP0 op }
+ | ['@' '^'] symbolchar * as op
+ { INFIXOP1 op }
+ | ['+' '-'] symbolchar * as op
+ { INFIXOP2 op }
+ | "**" symbolchar * as op
+ { INFIXOP4 op }
+ | '%' { PERCENT }
+ | ['*' '/' '%'] symbolchar * as op
+ { INFIXOP3 op }
+ | '#' symbolchar_or_hash + as op
+ { HASHOP op }
+ | "let" kwdopchar dotsymbolchar * as op
+ { LETOP op }
+ | "and" kwdopchar dotsymbolchar * as op
+ { ANDOP op }
+ | eof { EOF }
+ | (_ as illegal_char)
+ { error lexbuf (Illegal_character illegal_char) }
+
+and directive = parse
+ | ([' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
+ ("\"" ([^ '\010' '\013' '\"' ] * as name) "\"") as directive)
+ [^ '\010' '\013'] *
+ {
+ match int_of_string num with
+ | exception _ ->
+ (* PR#7165 *)
+ let explanation = "line number out of range" in
+ error lexbuf (Invalid_directive ("#" ^ directive, Some explanation))
+ | line_num ->
+ (* Documentation says that the line number should be
+ positive, but we have never guarded against this and it
+ might have useful hackish uses. *)
+ update_loc lexbuf (Some name) (line_num - 1) true 0;
+ token lexbuf
+ }
+and comment = parse
+ "(*"
+ { comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc;
+ store_lexeme lexbuf;
+ comment lexbuf
+ }
+ | "*)"
+ { match !comment_start_loc with
+ | [] -> assert false
+ | [_] -> comment_start_loc := []; Location.curr lexbuf
+ | _ :: l -> comment_start_loc := l;
+ store_lexeme lexbuf;
+ comment lexbuf
+ }
+ | "\""
+ {
+ string_start_loc := Location.curr lexbuf;
+ store_string_char '\"';
+ is_in_string := true;
+ let _loc = try string lexbuf
+ with Error (Unterminated_string, str_start) ->
+ match !comment_start_loc with
+ | [] -> assert false
+ | loc :: _ ->
+ let start = List.hd (List.rev !comment_start_loc) in
+ comment_start_loc := [];
+ error_loc loc (Unterminated_string_in_comment (start, str_start))
+ in
+ is_in_string := false;
+ store_string_char '\"';
+ comment lexbuf }
+ | "{" ('%' '%'? extattrident blank*)? (delim_ext as raw_delim) "|"
+ { match lax_delim raw_delim with
+ | None -> store_lexeme lexbuf; comment lexbuf
+ | Some delim ->
+ string_start_loc := Location.curr lexbuf;
+ store_lexeme lexbuf;
+ is_in_string := true;
+ let _loc = try quoted_string delim lexbuf
+ with Error (Unterminated_string, str_start) ->
+ match !comment_start_loc with
+ | [] -> assert false
+ | loc :: _ ->
+ let start = List.hd (List.rev !comment_start_loc) in
+ comment_start_loc := [];
+ error_loc loc (Unterminated_string_in_comment (start, str_start))
+ in
+ is_in_string := false;
+ store_string_char '|';
+ store_string delim;
+ store_string_char '}';
+ comment lexbuf }
+ | "\'\'"
+ { store_lexeme lexbuf; comment lexbuf }
+ | "\'" (newline as nl) "\'"
+ { update_loc lexbuf None 1 false 1;
+ store_string_char '\'';
+ store_normalized_newline nl;
+ store_string_char '\'';
+ comment lexbuf
+ }
+ | "\'" [^ '\\' '\'' '\010' '\013' ] "\'"
+ { store_lexeme lexbuf; comment lexbuf }
+ | "\'\\" ['\\' '\"' '\'' 'n' 't' 'b' 'r' ' '] "\'"
+ { store_lexeme lexbuf; comment lexbuf }
+ | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'"
+ { store_lexeme lexbuf; comment lexbuf }
+ | "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'"
+ { store_lexeme lexbuf; comment lexbuf }
+ | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'"
+ { store_lexeme lexbuf; comment lexbuf }
+ | eof
+ { match !comment_start_loc with
+ | [] -> assert false
+ | loc :: _ ->
+ let start = List.hd (List.rev !comment_start_loc) in
+ comment_start_loc := [];
+ error_loc loc (Unterminated_comment start)
+ }
+ | newline as nl
+ { update_loc lexbuf None 1 false 0;
+ store_normalized_newline nl;
+ comment lexbuf
+ }
+ | ident
+ { store_lexeme lexbuf; comment lexbuf }
+ | _
+ { store_lexeme lexbuf; comment lexbuf }
+
+and string = parse
+ '\"'
+ { lexbuf.lex_start_p }
+ | '\\' (newline as nl) ([' ' '\t'] * as space)
+ { update_loc lexbuf None 1 false (String.length space);
+ if in_comment () then begin
+ store_string_char '\\';
+ store_normalized_newline nl;
+ store_string space;
+ end;
+ string lexbuf
+ }
+ | '\\' (['\\' '\'' '\"' 'n' 't' 'b' 'r' ' '] as c)
+ { store_escaped_char lexbuf (char_for_backslash c);
+ string lexbuf }
+ | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+ { store_escaped_char lexbuf (char_for_decimal_code lexbuf 1);
+ string lexbuf }
+ | '\\' 'o' ['0'-'7'] ['0'-'7'] ['0'-'7']
+ { store_escaped_char lexbuf (char_for_octal_code lexbuf 2);
+ string lexbuf }
+ | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F']
+ { store_escaped_char lexbuf (char_for_hexadecimal_code lexbuf 2);
+ string lexbuf }
+ | '\\' 'u' '{' hex_digit+ '}'
+ { store_escaped_uchar lexbuf (uchar_for_uchar_escape lexbuf);
+ string lexbuf }
+ | '\\' _
+ { if not (in_comment ()) then begin
+(* Should be an error, but we are very lax.
+ error lexbuf (Illegal_escape (Lexing.lexeme lexbuf, None))
+*)
+ let loc = Location.curr lexbuf in
+ Location.prerr_warning loc Warnings.Illegal_backslash;
+ end;
+ store_lexeme lexbuf;
+ string lexbuf
+ }
+ | newline as nl
+ { update_loc lexbuf None 1 false 0;
+ store_normalized_newline nl;
+ string lexbuf
+ }
+ | eof
+ { is_in_string := false;
+ error_loc !string_start_loc Unterminated_string }
+ | (_ as c)
+ { store_string_char c;
+ string lexbuf }
+
+and quoted_string delim = parse
+ | newline as nl
+ { update_loc lexbuf None 1 false 0;
+ store_normalized_newline nl;
+ quoted_string delim lexbuf
+ }
+ | eof
+ { is_in_string := false;
+ error_loc !string_start_loc Unterminated_string }
+ | "|" (ident_ext? as raw_edelim) "}"
+ {
+ let edelim = validate_encoding lexbuf raw_edelim in
+ if delim = edelim then lexbuf.lex_start_p
+ else (store_lexeme lexbuf; quoted_string delim lexbuf)
+ }
+ | (_ as c)
+ { store_string_char c;
+ quoted_string delim lexbuf }
+
+and skip_hash_bang = parse
+ | "#!" [^ '\n']* '\n' [^ '\n']* "\n!#\n"
+ { update_loc lexbuf None 3 false 0 }
+ | "#!" [^ '\n']* '\n'
+ { update_loc lexbuf None 1 false 0 }
+ | "" { () }
+
+{
+
+ let token_with_comments lexbuf =
+ match !preprocessor with
+ | None -> token lexbuf
+ | Some (_init, preprocess) -> preprocess token lexbuf
+
+ type newline_state =
+ | NoLine (* There have been no blank lines yet. *)
+ | NewLine
+ (* There have been no blank lines, and the previous
+ token was a newline. *)
+ | BlankLine (* There have been blank lines. *)
+
+ type doc_state =
+ | Initial (* There have been no docstrings yet *)
+ | After of docstring list
+ (* There have been docstrings, none of which were
+ preceded by a blank line *)
+ | Before of docstring list * docstring list * docstring list
+ (* There have been docstrings, some of which were
+ preceded by a blank line *)
+
+ and docstring = Docstrings.docstring
+
+ let token lexbuf =
+ let post_pos = lexeme_end_p lexbuf in
+ let attach lines docs pre_pos =
+ let open Docstrings in
+ match docs, lines with
+ | Initial, _ -> ()
+ | After a, (NoLine | NewLine) ->
+ set_post_docstrings post_pos (List.rev a);
+ set_pre_docstrings pre_pos a;
+ | After a, BlankLine ->
+ set_post_docstrings post_pos (List.rev a);
+ set_pre_extra_docstrings pre_pos (List.rev a)
+ | Before(a, f, b), (NoLine | NewLine) ->
+ set_post_docstrings post_pos (List.rev a);
+ set_post_extra_docstrings post_pos
+ (List.rev_append f (List.rev b));
+ set_floating_docstrings pre_pos (List.rev f);
+ set_pre_extra_docstrings pre_pos (List.rev a);
+ set_pre_docstrings pre_pos b
+ | Before(a, f, b), BlankLine ->
+ set_post_docstrings post_pos (List.rev a);
+ set_post_extra_docstrings post_pos
+ (List.rev_append f (List.rev b));
+ set_floating_docstrings pre_pos
+ (List.rev_append f (List.rev b));
+ set_pre_extra_docstrings pre_pos (List.rev a)
+ in
+ let rec loop lines docs lexbuf =
+ match token_with_comments lexbuf with
+ | COMMENT (s, loc) ->
+ add_comment (s, loc);
+ let lines' =
+ match lines with
+ | NoLine -> NoLine
+ | NewLine -> NoLine
+ | BlankLine -> BlankLine
+ in
+ loop lines' docs lexbuf
+ | EOL ->
+ let lines' =
+ match lines with
+ | NoLine -> NewLine
+ | NewLine -> BlankLine
+ | BlankLine -> BlankLine
+ in
+ loop lines' docs lexbuf
+ | DOCSTRING doc ->
+ Docstrings.register doc;
+ add_docstring_comment doc;
+ let docs' =
+ if Docstrings.docstring_body doc = "/*" then
+ match docs with
+ | Initial -> Before([], [doc], [])
+ | After a -> Before (a, [doc], [])
+ | Before(a, f, b) -> Before(a, doc :: b @ f, [])
+ else
+ match docs, lines with
+ | Initial, (NoLine | NewLine) -> After [doc]
+ | Initial, BlankLine -> Before([], [], [doc])
+ | After a, (NoLine | NewLine) -> After (doc :: a)
+ | After a, BlankLine -> Before (a, [], [doc])
+ | Before(a, f, b), (NoLine | NewLine) -> Before(a, f, doc :: b)
+ | Before(a, f, b), BlankLine -> Before(a, b @ f, [doc])
+ in
+ loop NoLine docs' lexbuf
+ | tok ->
+ attach lines docs (lexeme_start_p lexbuf);
+ tok
+ in
+ loop NoLine Initial lexbuf
+
+ let init ?(keyword_edition=None,[]) () =
+ populate_keywords keyword_edition;
+ is_in_string := false;
+ comment_start_loc := [];
+ comment_list := [];
+ match !preprocessor with
+ | None -> ()
+ | Some (init, _preprocess) -> init ()
+
+ let set_preprocessor init preprocess =
+ escaped_newlines := true;
+ preprocessor := Some (init, preprocess)
+
+}
diff --git a/upstream/ocaml_503/parsing/location.ml b/upstream/ocaml_503/parsing/location.ml
new file mode 100644
index 0000000000..865ca5f203
--- /dev/null
+++ b/upstream/ocaml_503/parsing/location.ml
@@ -0,0 +1,1016 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Lexing
+
+type t = Warnings.loc =
+ { loc_start: position; loc_end: position; loc_ghost: bool }
+
+let in_file = Warnings.ghost_loc_in_file
+
+let none = in_file "_none_"
+let is_none l = (l = none)
+
+let curr lexbuf = {
+ loc_start = lexbuf.lex_start_p;
+ loc_end = lexbuf.lex_curr_p;
+ loc_ghost = false
+}
+
+let init lexbuf fname =
+ lexbuf.lex_curr_p <- {
+ pos_fname = fname;
+ pos_lnum = 1;
+ pos_bol = 0;
+ pos_cnum = 0;
+ }
+
+let symbol_rloc () = {
+ loc_start = Parsing.symbol_start_pos ();
+ loc_end = Parsing.symbol_end_pos ();
+ loc_ghost = false;
+}
+
+let symbol_gloc () = {
+ loc_start = Parsing.symbol_start_pos ();
+ loc_end = Parsing.symbol_end_pos ();
+ loc_ghost = true;
+}
+
+let rhs_loc n = {
+ loc_start = Parsing.rhs_start_pos n;
+ loc_end = Parsing.rhs_end_pos n;
+ loc_ghost = false;
+}
+
+let rhs_interval m n = {
+ loc_start = Parsing.rhs_start_pos m;
+ loc_end = Parsing.rhs_end_pos n;
+ loc_ghost = false;
+}
+
+(* return file, line, char from the given position *)
+let get_pos_info pos =
+ (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
+
+type 'a loc = {
+ txt : 'a;
+ loc : t;
+}
+
+let mkloc txt loc = { txt ; loc }
+let mknoloc txt = mkloc txt none
+
+(******************************************************************************)
+(* Input info *)
+
+let input_name = ref "_none_"
+let input_lexbuf = ref (None : lexbuf option)
+let input_phrase_buffer = ref (None : Buffer.t option)
+
+(******************************************************************************)
+(* Terminal info *)
+
+let status = ref Terminfo.Uninitialised
+
+let setup_terminal () =
+ if !status = Terminfo.Uninitialised then
+ status := Terminfo.setup stdout
+
+(* The number of lines already printed after input.
+
+ This is used by [highlight_terminfo] to identify the current position of the
+ input in the terminal. This would not be possible without this information,
+ since printing several warnings/errors adds text between the user input and
+ the bottom of the terminal.
+
+ We also use for {!is_first_report}, see below.
+*)
+let num_loc_lines = ref 0
+
+(* We use [num_loc_lines] to determine if the report about to be
+ printed is the first or a follow-up report of the current
+ "batch" -- contiguous reports without user input in between, for
+ example for the current toplevel phrase. We use this to print
+ a blank line between messages of the same batch.
+*)
+let is_first_message () =
+ !num_loc_lines = 0
+
+(* This is used by the toplevel to reset [num_loc_lines] before each phrase *)
+let reset () =
+ num_loc_lines := 0
+
+(* This is used by the toplevel *)
+let echo_eof () =
+ print_newline ();
+ incr num_loc_lines
+
+(* Code printing errors and warnings must be wrapped using this function, in
+ order to update [num_loc_lines].
+
+ [print_updating_num_loc_lines ppf f arg] is equivalent to calling [f ppf
+ arg], and additionally updates [num_loc_lines]. *)
+let print_updating_num_loc_lines ppf f arg =
+ let open Format in
+ let out_functions = pp_get_formatter_out_functions ppf () in
+ let out_string str start len =
+ let rec count i c =
+ if i = start + len then c
+ else if String.get str i = '\n' then count (succ i) (succ c)
+ else count (succ i) c in
+ num_loc_lines := !num_loc_lines + count start 0 ;
+ out_functions.out_string str start len in
+ pp_set_formatter_out_functions ppf
+ { out_functions with out_string } ;
+ f ppf arg ;
+ pp_print_flush ppf ();
+ pp_set_formatter_out_functions ppf out_functions
+
+(** {1 Printing setup }*)
+
+let setup_tags () =
+ Misc.Style.setup !Clflags.color
+
+(******************************************************************************)
+(* Printing locations, e.g. 'File "foo.ml", line 3, characters 10-12' *)
+
+let rewrite_absolute_path path =
+ match Misc.get_build_path_prefix_map () with
+ | None -> path
+ | Some map -> Build_path_prefix_map.rewrite map path
+
+let rewrite_find_first_existing path =
+ match Misc.get_build_path_prefix_map () with
+ | None ->
+ if Sys.file_exists path then Some path
+ else None
+ | Some prefix_map ->
+ match Build_path_prefix_map.rewrite_all prefix_map path with
+ | [] ->
+ if Sys.file_exists path then Some path
+ else None
+ | matches ->
+ Some (List.find Sys.file_exists matches)
+
+let rewrite_find_all_existing_dirs path =
+ let ok path = Sys.file_exists path && Sys.is_directory path in
+ match Misc.get_build_path_prefix_map () with
+ | None ->
+ if ok path then [path]
+ else []
+ | Some prefix_map ->
+ match Build_path_prefix_map.rewrite_all prefix_map path with
+ | [] ->
+ if ok path then [path]
+ else []
+ | matches ->
+ match (List.filter ok matches) with
+ | [] -> raise Not_found
+ | results -> results
+
+let absolute_path s = (* This function could go into Filename *)
+ let open Filename in
+ let s = if (is_relative s) then (concat (Sys.getcwd ()) s) else s in
+ let s = rewrite_absolute_path s in
+ (* Now simplify . and .. components *)
+ let rec aux s =
+ let base = basename s in
+ let dir = dirname s in
+ if dir = s then dir
+ else if base = current_dir_name then aux dir
+ else if base = parent_dir_name then dirname (aux dir)
+ else concat (aux dir) base
+ in
+ aux s
+
+let show_filename file =
+ if !Clflags.absname then absolute_path file else file
+
+module Fmt = Format_doc
+module Doc = struct
+
+ (* This is used by the toplevel and the report printers below. *)
+ let separate_new_message ppf () =
+ if not (is_first_message ()) then begin
+ Fmt.pp_print_newline ppf ();
+ incr num_loc_lines
+ end
+
+ let filename ppf file =
+ Fmt.pp_print_string ppf (show_filename file)
+
+(* Best-effort printing of the text describing a location, of the form
+ 'File "foo.ml", line 3, characters 10-12'.
+
+ Some of the information (filename, line number or characters numbers) in the
+ location might be invalid; in which case we do not print it.
+ *)
+ let loc ppf loc =
+ setup_tags ();
+ let file_valid = function
+ | "_none_" ->
+ (* This is a dummy placeholder, but we print it anyway to please
+ editors that parse locations in error messages (e.g. Emacs). *)
+ true
+ | "" | "//toplevel//" -> false
+ | _ -> true
+ in
+ let line_valid line = line > 0 in
+ let chars_valid ~startchar ~endchar = startchar <> -1 && endchar <> -1 in
+
+ let file =
+ (* According to the comment in location.mli, if [pos_fname] is "", we must
+ use [!input_name]. *)
+ if loc.loc_start.pos_fname = "" then !input_name
+ else loc.loc_start.pos_fname
+ in
+ let startline = loc.loc_start.pos_lnum in
+ let endline = loc.loc_end.pos_lnum in
+ let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
+ let endchar = loc.loc_end.pos_cnum - loc.loc_end.pos_bol in
+
+ let first = ref true in
+ let capitalize s =
+ if !first then (first := false; String.capitalize_ascii s)
+ else s in
+ let comma () =
+ if !first then () else Fmt.fprintf ppf ", " in
+
+ Fmt.fprintf ppf "@{<loc>";
+
+ if file_valid file then
+ Fmt.fprintf ppf "%s \"%a\"" (capitalize "file") filename file;
+
+ (* Print "line 1" in the case of a dummy line number. This is to please the
+ existing setup of editors that parse locations in error messages (e.g.
+ Emacs). *)
+ comma ();
+ let startline = if line_valid startline then startline else 1 in
+ let endline = if line_valid endline then endline else startline in
+ begin if startline = endline then
+ Fmt.fprintf ppf "%s %i" (capitalize "line") startline
+ else
+ Fmt.fprintf ppf "%s %i-%i" (capitalize "lines") startline endline
+ end;
+
+ if chars_valid ~startchar ~endchar then (
+ comma ();
+ Fmt.fprintf ppf "%s %i-%i" (capitalize "characters") startchar endchar
+ );
+
+ Fmt.fprintf ppf "@}"
+
+ (* Print a comma-separated list of locations *)
+ let locs ppf locs =
+ Fmt.pp_print_list ~pp_sep:(fun ppf () -> Fmt.fprintf ppf ",@ ")
+ loc ppf locs
+ let quoted_filename ppf f = Misc.Style.as_inline_code filename ppf f
+
+end
+
+let print_filename = Fmt.compat Doc.filename
+let print_loc = Fmt.compat Doc.loc
+let print_locs = Fmt.compat Doc.locs
+let separate_new_message ppf = Fmt.compat Doc.separate_new_message ppf ()
+
+(******************************************************************************)
+(* An interval set structure; additionally, it stores user-provided information
+ at interval boundaries.
+
+ The implementation provided here is naive and assumes the number of intervals
+ to be small, but the interface would allow for a more efficient
+ implementation if needed.
+
+ Note: the structure only stores maximal intervals (that therefore do not
+ overlap).
+*)
+
+module ISet : sig
+ type 'a bound = 'a * int
+ type 'a t
+ (* bounds are included *)
+ val of_intervals : ('a bound * 'a bound) list -> 'a t
+
+ val mem : 'a t -> pos:int -> bool
+ val find_bound_in : 'a t -> range:(int * int) -> 'a bound option
+
+ val is_start : 'a t -> pos:int -> 'a option
+ val is_end : 'a t -> pos:int -> 'a option
+
+ val extrema : 'a t -> ('a bound * 'a bound) option
+end
+=
+struct
+ type 'a bound = 'a * int
+
+ (* non overlapping intervals *)
+ type 'a t = ('a bound * 'a bound) list
+
+ let of_intervals intervals =
+ let pos =
+ List.map (fun ((a, x), (b, y)) ->
+ if x > y then [] else [((a, x), `S); ((b, y), `E)]
+ ) intervals
+ |> List.flatten
+ |> List.sort (fun ((_, x), k) ((_, y), k') ->
+ (* Make `S come before `E so that consecutive intervals get merged
+ together in the fold below *)
+ let kn = function `S -> 0 | `E -> 1 in
+ compare (x, kn k) (y, kn k'))
+ in
+ let nesting, acc =
+ List.fold_left (fun (nesting, acc) (a, kind) ->
+ match kind, nesting with
+ | `S, `Outside -> `Inside (a, 0), acc
+ | `S, `Inside (s, n) -> `Inside (s, n+1), acc
+ | `E, `Outside -> assert false
+ | `E, `Inside (s, 0) -> `Outside, ((s, a) :: acc)
+ | `E, `Inside (s, n) -> `Inside (s, n-1), acc
+ ) (`Outside, []) pos in
+ assert (nesting = `Outside);
+ List.rev acc
+
+ let mem iset ~pos =
+ List.exists (fun ((_, s), (_, e)) -> s <= pos && pos <= e) iset
+
+ let find_bound_in iset ~range:(start, end_) =
+ List.find_map (fun ((a, x), (b, y)) ->
+ if start <= x && x <= end_ then Some (a, x)
+ else if start <= y && y <= end_ then Some (b, y)
+ else None
+ ) iset
+
+ let is_start iset ~pos =
+ List.find_map (fun ((a, x), _) ->
+ if pos = x then Some a else None
+ ) iset
+
+ let is_end iset ~pos =
+ List.find_map (fun (_, (b, y)) ->
+ if pos = y then Some b else None
+ ) iset
+
+ let extrema iset =
+ if iset = [] then None
+ else Some (fst (List.hd iset), snd (List.hd (List.rev iset)))
+end
+
+(******************************************************************************)
+(* Toplevel: highlighting and quoting locations *)
+
+(* Highlight the locations using standout mode.
+
+ If [locs] is empty, this function is a no-op.
+*)
+let highlight_terminfo lb ppf locs =
+ Format.pp_print_flush ppf (); (* avoid mixing Format and normal output *)
+ (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
+ let pos0 = -lb.lex_abs_pos in
+ (* Do nothing if the buffer does not contain the whole phrase. *)
+ if pos0 < 0 then raise Exit;
+ (* Count number of lines in phrase *)
+ let lines = ref !num_loc_lines in
+ for i = pos0 to lb.lex_buffer_len - 1 do
+ if Bytes.get lb.lex_buffer i = '\n' then incr lines
+ done;
+ (* If too many lines, give up *)
+ if !lines >= Terminfo.num_lines stdout - 2 then raise Exit;
+ (* Move cursor up that number of lines *)
+ flush stdout; Terminfo.backup stdout !lines;
+ (* Print the input, switching to standout for the location *)
+ let bol = ref false in
+ print_string "# ";
+ for pos = 0 to lb.lex_buffer_len - pos0 - 1 do
+ if !bol then (print_string " "; bol := false);
+ if List.exists (fun loc -> pos = loc.loc_start.pos_cnum) locs then
+ Terminfo.standout stdout true;
+ if List.exists (fun loc -> pos = loc.loc_end.pos_cnum) locs then
+ Terminfo.standout stdout false;
+ let c = Bytes.get lb.lex_buffer (pos + pos0) in
+ print_char c;
+ bol := (c = '\n')
+ done;
+ (* Make sure standout mode is over *)
+ Terminfo.standout stdout false;
+ (* Position cursor back to original location *)
+ Terminfo.resume stdout !num_loc_lines;
+ flush stdout
+
+let highlight_terminfo lb ppf locs =
+ try highlight_terminfo lb ppf locs
+ with Exit -> ()
+
+(* Highlight the location by printing it again.
+
+ There are two different styles for highlighting errors in "dumb" mode,
+ depending if the error fits on a single line or spans across several lines.
+
+ For single-line errors,
+
+ foo the_error bar
+
+ gets displayed as follows, where X is the line number:
+
+ X | foo the_error bar
+ ^^^^^^^^^
+
+
+ For multi-line errors,
+
+ foo the_
+ error bar
+
+ gets displayed as:
+
+ X1 | ....the_
+ X2 | error....
+
+ An ellipsis hides the middle lines of the multi-line error if it has more
+ than [max_lines] lines.
+
+ If [locs] is empty then this function is a no-op.
+*)
+
+type input_line = {
+ text : string;
+ start_pos : int;
+}
+
+(* Takes a list of lines with possibly missing line numbers.
+
+ If the line numbers that are present are consistent with the number of lines
+ between them, then infer the intermediate line numbers.
+
+ This is not always the case, typically if lexer line directives are
+ involved... *)
+let infer_line_numbers
+ (lines: (int option * input_line) list):
+ (int option * input_line) list
+ =
+ let (_, offset, consistent) =
+ List.fold_left (fun (i, offset, consistent) (lnum, _) ->
+ match lnum, offset with
+ | None, _ -> (i+1, offset, consistent)
+ | Some n, None -> (i+1, Some (n - i), consistent)
+ | Some n, Some m -> (i+1, offset, consistent && n = m + i)
+ ) (0, None, true) lines
+ in
+ match offset, consistent with
+ | Some m, true ->
+ List.mapi (fun i (_, line) -> (Some (m + i), line)) lines
+ | _, _ ->
+ lines
+
+(* [get_lines] must return the lines to highlight, given starting and ending
+ positions.
+
+ See [lines_around_from_current_input] below for an instantiation of
+ [get_lines] that reads from the current input.
+*)
+let highlight_quote ppf
+ ~(get_lines: start_pos:position -> end_pos:position -> input_line list)
+ ?(max_lines = 10)
+ highlight_tag
+ locs
+ =
+ let iset = ISet.of_intervals @@ List.filter_map (fun loc ->
+ let s, e = loc.loc_start, loc.loc_end in
+ if s.pos_cnum = -1 || e.pos_cnum = -1 then None
+ else Some ((s, s.pos_cnum), (e, e.pos_cnum - 1))
+ ) locs in
+ match ISet.extrema iset with
+ | None -> ()
+ | Some ((leftmost, _), (rightmost, _)) ->
+ let lines =
+ get_lines ~start_pos:leftmost ~end_pos:rightmost
+ |> List.map (fun ({ text; start_pos } as line) ->
+ let end_pos = start_pos + String.length text - 1 in
+ let line_nb =
+ match ISet.find_bound_in iset ~range:(start_pos, end_pos) with
+ | None -> None
+ | Some (p, _) -> Some p.pos_lnum
+ in
+ (line_nb, line))
+ |> infer_line_numbers
+ |> List.map (fun (lnum, { text; start_pos }) ->
+ (text,
+ Option.fold ~some:Int.to_string ~none:"" lnum,
+ start_pos))
+ in
+ Fmt.fprintf ppf "@[<v>";
+ begin match lines with
+ | [] | [("", _, _)] -> ()
+ | [(line, line_nb, line_start_cnum)] ->
+ (* Single-line error *)
+ Fmt.fprintf ppf "%s | %s@," line_nb line;
+ Fmt.fprintf ppf "%*s " (String.length line_nb) "";
+ (* Iterate up to [rightmost], which can be larger than the length of
+ the line because we may point to a location after the end of the
+ last token on the line, for instance:
+ {[
+ token
+ ^
+ Did you forget ...
+ ]} *)
+ for i = 0 to rightmost.pos_cnum - line_start_cnum - 1 do
+ let pos = line_start_cnum + i in
+ if ISet.is_start iset ~pos <> None then
+ Fmt.fprintf ppf "@{<%s>" highlight_tag;
+ if ISet.mem iset ~pos then Fmt.pp_print_char ppf '^'
+ else if i < String.length line then begin
+ (* For alignment purposes, align using a tab for each tab in the
+ source code *)
+ if line.[i] = '\t' then Fmt.pp_print_char ppf '\t'
+ else Fmt.pp_print_char ppf ' '
+ end;
+ if ISet.is_end iset ~pos <> None then
+ Fmt.fprintf ppf "@}"
+ done;
+ Fmt.fprintf ppf "@}@,"
+ | _ ->
+ (* Multi-line error *)
+ Fmt.pp_two_columns ~sep:"|" ~max_lines ppf
+ @@ List.map (fun (line, line_nb, line_start_cnum) ->
+ let line = String.mapi (fun i car ->
+ if ISet.mem iset ~pos:(line_start_cnum + i) then car else '.'
+ ) line in
+ (line_nb, line)
+ ) lines
+ end;
+ Fmt.fprintf ppf "@]"
+
+
+
+let lines_around
+ ~(start_pos: position) ~(end_pos: position)
+ ~(seek: int -> unit)
+ ~(read_char: unit -> char option):
+ input_line list
+ =
+ seek start_pos.pos_bol;
+ let lines = ref [] in
+ let bol = ref start_pos.pos_bol in
+ let cur = ref start_pos.pos_bol in
+ let b = Buffer.create 80 in
+ let add_line () =
+ if !bol < !cur then begin
+ let text = Buffer.contents b in
+ Buffer.clear b;
+ lines := { text; start_pos = !bol } :: !lines;
+ bol := !cur
+ end
+ in
+ let rec loop () =
+ if !bol >= end_pos.pos_cnum then ()
+ else begin
+ match read_char () with
+ | None ->
+ (* end of input *)
+ add_line ()
+ | Some c ->
+ incr cur;
+ match c with
+ | '\r' -> loop ()
+ | '\n' -> add_line (); loop ()
+ | _ -> Buffer.add_char b c; loop ()
+ end
+ in
+ loop ();
+ List.rev !lines
+
+(* Attempt to get lines from the lexing buffer. *)
+let lines_around_from_lexbuf
+ ~(start_pos: position) ~(end_pos: position)
+ (lb: lexbuf):
+ input_line list
+ =
+ (* Converts a global position to one that is relative to the lexing buffer *)
+ let rel n = n - lb.lex_abs_pos in
+ if rel start_pos.pos_bol < 0 then begin
+ (* Do nothing if the buffer does not contain the input (because it has been
+ refilled while lexing it) *)
+ []
+ end else begin
+ let pos = ref 0 in (* relative position *)
+ let seek n = pos := rel n in
+ let read_char () =
+ if !pos >= lb.lex_buffer_len then (* end of buffer *) None
+ else
+ let c = Bytes.get lb.lex_buffer !pos in
+ incr pos; Some c
+ in
+ lines_around ~start_pos ~end_pos ~seek ~read_char
+ end
+
+(* Attempt to get lines from the phrase buffer *)
+let lines_around_from_phrasebuf
+ ~(start_pos: position) ~(end_pos: position)
+ (pb: Buffer.t):
+ input_line list
+ =
+ let pos = ref 0 in
+ let seek n = pos := n in
+ let read_char () =
+ if !pos >= Buffer.length pb then None
+ else begin
+ let c = Buffer.nth pb !pos in
+ incr pos; Some c
+ end
+ in
+ lines_around ~start_pos ~end_pos ~seek ~read_char
+
+(* A [get_lines] function for [highlight_quote] that reads from the current
+ input. *)
+let lines_around_from_current_input ~start_pos ~end_pos =
+ match !input_lexbuf, !input_phrase_buffer, !input_name with
+ | _, Some pb, "//toplevel//" ->
+ lines_around_from_phrasebuf pb ~start_pos ~end_pos
+ | Some lb, _, _ ->
+ lines_around_from_lexbuf lb ~start_pos ~end_pos
+ | None, _, _ ->
+ []
+
+(******************************************************************************)
+(* Reporting errors and warnings *)
+
+type msg = Fmt.t loc
+
+let msg ?(loc = none) fmt =
+ Fmt.kdoc_printf (fun txt -> { loc; txt }) fmt
+
+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;
+ footnote: Fmt.t option;
+}
+
+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 -> Fmt.t -> 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 -> Fmt.t -> unit;
+}
+
+let is_dummy_loc loc =
+ (* Fixme: this should be just [loc.loc_ghost] and the function should be
+ inlined below. However, currently, the compiler emits in some places ghost
+ locations with valid ranges that should still be printed. These locations
+ should be made non-ghost -- in the meantime we just check if the ranges are
+ valid. *)
+ loc.loc_start.pos_cnum = -1 || loc.loc_end.pos_cnum = -1
+
+(* It only makes sense to highlight (i.e. quote or underline the corresponding
+ source code) locations that originate from the current input.
+
+ As of now, this should only happen in the following cases:
+
+ - if dummy locs or ghost locs leak out of the compiler or a buggy ppx;
+
+ - more generally, if some code uses the compiler-libs API and feeds it
+ locations that do not match the current values of [!Location.input_name],
+ [!Location.input_lexbuf];
+
+ - when calling the compiler on a .ml file that contains lexer line directives
+ indicating an other file. This should happen relatively rarely in practice --
+ in particular this is not what happens when using -pp or -ppx or a ppx
+ driver.
+*)
+let is_quotable_loc loc =
+ not (is_dummy_loc loc)
+ && loc.loc_start.pos_fname = !input_name
+ && loc.loc_end.pos_fname = !input_name
+
+let error_style () =
+ match !Clflags.error_style with
+ | Some setting -> setting
+ | None -> Misc.Error_style.default_setting
+
+let batch_mode_printer : report_printer =
+ let pp_loc _self report ppf loc =
+ let tag = match report.kind with
+ | Report_warning_as_error _
+ | Report_alert_as_error _
+ | Report_error -> "error"
+ | Report_warning _
+ | Report_alert _ -> "warning"
+ in
+ let highlight ppf loc =
+ match error_style () with
+ | Misc.Error_style.Contextual ->
+ if is_quotable_loc loc then
+ highlight_quote ppf
+ ~get_lines:lines_around_from_current_input
+ tag [loc]
+ | Misc.Error_style.Short ->
+ ()
+ in
+ Format.fprintf ppf "@[<v>%a:@ %a@]" print_loc loc
+ (Fmt.compat highlight) loc
+ in
+ let pp_txt ppf txt = Format.fprintf ppf "@[%a@]" Fmt.Doc.format txt in
+ let pp_footnote ppf f =
+ Option.iter (Format.fprintf ppf "@,%a" pp_txt) f
+ in
+ let pp self ppf report =
+ setup_tags ();
+ separate_new_message ppf;
+ (* Make sure we keep [num_loc_lines] updated.
+ The tabulation box is here to give submessage the option
+ to be aligned with the main message box
+ *)
+ print_updating_num_loc_lines ppf (fun ppf () ->
+ Format.fprintf ppf "@[<v>%a%a%a: %a%a%a%a%a@]@."
+ Format.pp_open_tbox ()
+ (self.pp_main_loc self report) report.main.loc
+ (self.pp_report_kind self report) report.kind
+ Format.pp_set_tab ()
+ (self.pp_main_txt self report) report.main.txt
+ (self.pp_submsgs self report) report.sub
+ pp_footnote report.footnote
+ Format.pp_close_tbox ()
+ ) ()
+ in
+ let pp_report_kind _self _ ppf = function
+ | Report_error -> Format.fprintf ppf "@{<error>Error@}"
+ | Report_warning w -> Format.fprintf ppf "@{<warning>Warning@} %s" w
+ | Report_warning_as_error w ->
+ Format.fprintf ppf "@{<error>Error@} (warning %s)" w
+ | Report_alert w -> Format.fprintf ppf "@{<warning>Alert@} %s" w
+ | Report_alert_as_error w ->
+ Format.fprintf ppf "@{<error>Error@} (alert %s)" w
+ in
+ let pp_main_loc self report ppf loc =
+ pp_loc self report ppf loc
+ in
+ let pp_main_txt _self _ ppf txt =
+ pp_txt ppf txt
+ in
+ let pp_submsgs self report ppf msgs =
+ List.iter (fun msg ->
+ Format.fprintf ppf "@,%a" (self.pp_submsg self report) msg
+ ) msgs
+ in
+ let pp_submsg self report ppf { loc; txt } =
+ Format.fprintf ppf "@[%a %a@]"
+ (self.pp_submsg_loc self report) loc
+ (self.pp_submsg_txt self report) txt
+ in
+ let pp_submsg_loc self report ppf loc =
+ if not loc.loc_ghost then
+ pp_loc self report ppf loc
+ in
+ let pp_submsg_txt _self _ ppf loc =
+ pp_txt ppf loc
+ in
+ { pp; pp_report_kind; pp_main_loc; pp_main_txt;
+ pp_submsgs; pp_submsg; pp_submsg_loc; pp_submsg_txt }
+
+let terminfo_toplevel_printer (lb: lexbuf): report_printer =
+ let pp self ppf err =
+ setup_tags ();
+ (* Highlight all toplevel locations of the report, instead of displaying
+ the main location. Do it now instead of in [pp_main_loc], to avoid
+ messing with Format boxes. *)
+ let sub_locs = List.map (fun { loc; _ } -> loc) err.sub in
+ let all_locs = err.main.loc :: sub_locs in
+ let locs_highlighted = List.filter is_quotable_loc all_locs in
+ highlight_terminfo lb ppf locs_highlighted;
+ batch_mode_printer.pp self ppf err
+ in
+ let pp_main_loc _ _ _ _ = () in
+ let pp_submsg_loc _ _ ppf loc =
+ if not loc.loc_ghost then
+ Format.fprintf ppf "%a:@ " print_loc loc in
+ { batch_mode_printer with pp; pp_main_loc; pp_submsg_loc }
+
+let best_toplevel_printer () =
+ setup_terminal ();
+ match !status, !input_lexbuf with
+ | Terminfo.Good_term, Some lb ->
+ terminfo_toplevel_printer lb
+ | _, _ ->
+ batch_mode_printer
+
+(* Creates a printer for the current input *)
+let default_report_printer () : report_printer =
+ if !input_name = "//toplevel//" then
+ best_toplevel_printer ()
+ else
+ batch_mode_printer
+
+let report_printer = ref default_report_printer
+
+let print_report ppf report =
+ let printer = !report_printer () in
+ printer.pp printer ppf report
+
+(******************************************************************************)
+(* Reporting errors *)
+
+type error = report
+type delayed_msg = unit -> Fmt.t option
+
+let report_error ppf err =
+ print_report ppf err
+
+let mkerror loc sub footnote txt =
+ { kind = Report_error; main = { loc; txt }; sub; footnote=footnote () }
+
+let errorf ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) =
+ Fmt.kdoc_printf (mkerror loc sub footnote)
+
+let error ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) msg_str =
+ mkerror loc sub footnote Fmt.Doc.(string msg_str empty)
+
+let error_of_printer ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) pp x =
+ mkerror loc sub footnote (Fmt.doc_printf "%a" pp x)
+
+let error_of_printer_file print x =
+ error_of_printer ~loc:(in_file !input_name) print x
+
+(******************************************************************************)
+(* Reporting warnings: generating a report from a warning number using the
+ information in [Warnings] + convenience functions. *)
+
+let default_warning_alert_reporter report mk (loc: t) w : report option =
+ match report w with
+ | `Inactive -> None
+ | `Active { Warnings.id; message; is_error; sub_locs } ->
+ let msg_of_str str = Format_doc.Doc.(empty |> string str) in
+ let kind = mk is_error id in
+ let main = { loc; txt = msg_of_str message } in
+ let sub = List.map (fun (loc, sub_message) ->
+ { loc; txt = msg_of_str sub_message }
+ ) sub_locs in
+ Some { kind; main; sub; footnote=None }
+
+
+let default_warning_reporter =
+ default_warning_alert_reporter
+ Warnings.report
+ (fun is_error id ->
+ if is_error then Report_warning_as_error id
+ else Report_warning id
+ )
+
+let warning_reporter = ref default_warning_reporter
+let report_warning loc w = !warning_reporter loc w
+
+let formatter_for_warnings = ref Format.err_formatter
+
+let print_warning loc ppf w =
+ match report_warning loc w with
+ | None -> ()
+ | Some report -> print_report ppf report
+
+let prerr_warning loc w = print_warning loc !formatter_for_warnings w
+
+let default_alert_reporter =
+ default_warning_alert_reporter
+ Warnings.report_alert
+ (fun is_error id ->
+ if is_error then Report_alert_as_error id
+ else Report_alert id
+ )
+
+let alert_reporter = ref default_alert_reporter
+let report_alert loc w = !alert_reporter loc w
+
+let print_alert loc ppf w =
+ match report_alert loc w with
+ | None -> ()
+ | Some report -> print_report ppf report
+
+let prerr_alert loc w = print_alert loc !formatter_for_warnings w
+
+let alert ?(def = none) ?(use = none) ~kind loc message =
+ prerr_alert loc {Warnings.kind; message; def; use}
+
+let deprecated ?def ?use loc message =
+ alert ?def ?use ~kind:"deprecated" loc message
+
+module Style = Misc.Style
+
+let auto_include_alert lib =
+ let message = Fmt.asprintf "\
+ OCaml's lib directory layout changed in 5.0. The %a subdirectory has been \
+ automatically added to the search path, but you should add %a to the \
+ command-line to silence this alert (e.g. by adding %a to the list of \
+ libraries in your dune file, or adding %a to your %a file for \
+ ocamlbuild, or using %a for ocamlfind)."
+ Style.inline_code lib
+ Style.inline_code ("-I +" ^lib)
+ Style.inline_code lib
+ Style.inline_code ("use_"^lib)
+ Style.inline_code "_tags"
+ Style.inline_code ("-package " ^ lib) in
+ let alert =
+ {Warnings.kind="ocaml_deprecated_auto_include"; use=none; def=none;
+ message = Format.asprintf "@[@\n%a@]" Format.pp_print_text message}
+ in
+ prerr_alert none alert
+
+let deprecated_script_alert program =
+ let message = Fmt.asprintf "\
+ Running %a where the first argument is an implicit basename with no \
+ extension (e.g. %a) is deprecated. Either rename the script \
+ (%a) or qualify the basename (%a)"
+ Style.inline_code program
+ Style.inline_code (program ^ " script-file")
+ Style.inline_code (program ^ " script-file.ml")
+ Style.inline_code (program ^ " ./script-file")
+ in
+ let alert =
+ {Warnings.kind="ocaml_deprecated_cli"; use=none; def=none;
+ message = Format.asprintf "@[@\n%a@]" Format.pp_print_text message}
+ in
+ prerr_alert none alert
+
+(******************************************************************************)
+(* Reporting errors on exceptions *)
+
+let error_of_exn : (exn -> error option) list ref = ref []
+
+let register_error_of_exn f = error_of_exn := f :: !error_of_exn
+
+exception Already_displayed_error = Warnings.Errors
+
+let error_of_exn exn =
+ match exn with
+ | Already_displayed_error -> Some `Already_displayed
+ | _ ->
+ let rec loop = function
+ | [] -> None
+ | f :: rest ->
+ match f exn with
+ | Some error -> Some (`Ok error)
+ | None -> loop rest
+ in
+ loop !error_of_exn
+
+let () =
+ register_error_of_exn
+ (function
+ | Sys_error msg ->
+ Some (errorf ~loc:(in_file !input_name) "I/O error: %s" msg)
+ | _ -> None
+ )
+
+external reraise : exn -> 'a = "%reraise"
+
+let report_exception ppf exn =
+ let rec loop n exn =
+ match error_of_exn exn with
+ | None -> reraise exn
+ | Some `Already_displayed -> ()
+ | Some (`Ok err) -> report_error ppf err
+ | exception exn when n > 0 -> loop (n-1) exn
+ in
+ loop 5 exn
+
+exception Error of error
+
+let () =
+ register_error_of_exn
+ (function
+ | Error e -> Some e
+ | _ -> None
+ )
+
+let raise_errorf ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) =
+ Fmt.kdoc_printf (fun txt -> raise (Error (mkerror loc sub footnote txt)))
diff --git a/upstream/ocaml_503/parsing/location.mli b/upstream/ocaml_503/parsing/location.mli
new file mode 100644
index 0000000000..5298386f39
--- /dev/null
+++ b/upstream/ocaml_503/parsing/location.mli
@@ -0,0 +1,368 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** 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 Rewriting path } *)
+
+val rewrite_absolute_path: string -> string
+(** [rewrite_absolute_path path] rewrites [path] to honor the
+ BUILD_PATH_PREFIX_MAP variable
+ if it is set. It does not check whether [path] is absolute or not.
+ The result is as follows:
+ - If BUILD_PATH_PREFIX_MAP is not set, just return [path].
+ - otherwise, rewrite using the mapping (and if there are no
+ matching prefixes that will just return [path]).
+
+ See
+ {{: https://reproducible-builds.org/specs/build-path-prefix-map/ }
+ the BUILD_PATH_PREFIX_MAP spec}
+ *)
+
+val rewrite_find_first_existing: string -> string option
+(** [rewrite_find_first_existing path] uses a BUILD_PATH_PREFIX_MAP mapping
+ and tries to find a source in mapping
+ that maps to a result that exists in the file system.
+ There are the following return values:
+ - [None], means either
+ {ul {- BUILD_PATH_PREFIX_MAP is not set and [path] does not exists, or}
+ {- no source prefixes of [path] in the mapping were found,}}
+ - [Some target], means [target] exists and either
+ {ul {- BUILD_PATH_PREFIX_MAP is not set and [target] = [path], or}
+ {- [target] is the first file (in priority
+ order) that [path] mapped to that exists in the file system.}}
+ - [Not_found] raised, means some source prefixes in the map
+ were found that matched [path], but none of them existed
+ in the file system. The caller should catch this and issue
+ an appropriate error message.
+
+ See
+ {{: https://reproducible-builds.org/specs/build-path-prefix-map/ }
+ the BUILD_PATH_PREFIX_MAP spec}
+ *)
+
+val rewrite_find_all_existing_dirs: string -> string list
+(** [rewrite_find_all_existing_dirs dir] accumulates a list of existing
+ directories, [dirs], that are the result of mapping a potentially
+ abstract directory, [dir], over all the mapping pairs in the
+ BUILD_PATH_PREFIX_MAP environment variable, if any. The list [dirs]
+ will be in priority order (head as highest priority).
+
+ The possible results are:
+ - [[]], means either
+ {ul {- BUILD_PATH_PREFIX_MAP is not set and [dir] is not an existing
+ directory, or}
+ {- if set, then there were no matching prefixes of [dir].}}
+ - [Some dirs], means dirs are the directories found. Either
+ {ul {- BUILD_PATH_PREFIX_MAP is not set and [dirs = [dir]], or}
+ {- it was set and [dirs] are the mapped existing directories.}}
+ - Not_found raised, means some source prefixes in the map
+ were found that matched [dir], but none of mapping results
+ were existing directories (possibly due to misconfiguration).
+ The caller should catch this and issue an appropriate error
+ message.
+
+ See
+ {{: https://reproducible-builds.org/specs/build-path-prefix-map/ }
+ the BUILD_PATH_PREFIX_MAP spec}
+ *)
+
+val absolute_path: string -> string
+ (** [absolute_path path] first makes an absolute path, [s] from [path],
+ prepending the current working directory if [path] was relative.
+ Then [s] is rewritten using [rewrite_absolute_path].
+ Finally the result is normalized by eliminating instances of
+ ['.'] or ['..']. *)
+
+(** {1 Printing locations} *)
+
+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
+val separate_new_message: formatter -> unit
+
+module Doc: sig
+ val separate_new_message: unit Format_doc.printer
+ val filename: string Format_doc.printer
+ val quoted_filename: string Format_doc.printer
+ val loc: t Format_doc.printer
+ val locs: t list Format_doc.printer
+end
+
+(** {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_doc.t loc
+
+val msg: ?loc:t -> ('a, Format_doc.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;
+ footnote: Format_doc.t option
+}
+
+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_doc.t -> 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_doc.t -> 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. *)
+
+val auto_include_alert: string -> unit
+(** Prints an alert that -I +lib has been automatically added to the load
+ path *)
+
+val deprecated_script_alert: string -> unit
+(** [deprecated_script_alert command] prints an alert that [command foo] has
+ been deprecated in favour of [command ./foo] *)
+
+(** {1 Reporting errors} *)
+
+type error = report
+(** An [error] is a [report] which [report_kind] must be [Report_error]. *)
+
+type delayed_msg = unit -> Format_doc.t option
+
+val error: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg -> string -> error
+
+val errorf: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+ ('a, Format_doc.formatter, unit, error) format4 -> 'a
+
+val error_of_printer: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+ (Format_doc.formatter -> 'a -> unit) -> 'a -> error
+
+val error_of_printer_file: (Format_doc.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 -> ?footnote:delayed_msg ->
+ ('a, Format_doc.formatter, unit, 'b) format4 -> 'a
+
+val report_exception: formatter -> exn -> unit
+(** Reraise the exception if it is unknown. *)
diff --git a/upstream/ocaml_503/parsing/longident.ml b/upstream/ocaml_503/parsing/longident.ml
new file mode 100644
index 0000000000..eaafb02bee
--- /dev/null
+++ b/upstream/ocaml_503/parsing/longident.ml
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+type t =
+ Lident of string
+ | Ldot of t * string
+ | Lapply of t * t
+
+let rec flat accu = function
+ Lident s -> s :: accu
+ | Ldot(lid, s) -> flat (s :: accu) lid
+ | Lapply(_, _) -> Misc.fatal_error "Longident.flat"
+
+let flatten lid = flat [] lid
+
+let last = function
+ Lident s -> s
+ | Ldot(_, s) -> s
+ | Lapply(_, _) -> Misc.fatal_error "Longident.last"
+
+
+let rec split_at_dots s pos =
+ try
+ let dot = String.index_from s pos '.' in
+ String.sub s pos (dot - pos) :: split_at_dots s (dot + 1)
+ with Not_found ->
+ [String.sub s pos (String.length s - pos)]
+
+let unflatten l =
+ match l with
+ | [] -> None
+ | hd :: tl -> Some (List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl)
+
+let parse s =
+ match unflatten (split_at_dots s 0) with
+ | None -> Lident "" (* should not happen, but don't put assert false
+ so as not to crash the toplevel (see Genprintval) *)
+ | Some v -> v
diff --git a/upstream/ocaml_503/parsing/longident.mli b/upstream/ocaml_503/parsing/longident.mli
new file mode 100644
index 0000000000..8704a7780e
--- /dev/null
+++ b/upstream/ocaml_503/parsing/longident.mli
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(* *)
+(* 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}.
+
+ To print a longident, see {!Pprintast.longident}, using
+ {!Format.asprintf} to convert to a string.
+
+*)
+
+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.
+
+*)
diff --git a/upstream/ocaml_503/parsing/parse.ml b/upstream/ocaml_503/parsing/parse.ml
new file mode 100644
index 0000000000..2ef1392c2b
--- /dev/null
+++ b/upstream/ocaml_503/parsing/parse.ml
@@ -0,0 +1,181 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Entry points in the parser *)
+
+(* Skip tokens to the end of the phrase *)
+
+let last_token = ref Parser.EOF
+
+let token lexbuf =
+ let token = Lexer.token lexbuf in
+ last_token := token;
+ token
+
+let rec skip_phrase lexbuf =
+ match token lexbuf with
+ | Parser.SEMISEMI | Parser.EOF -> ()
+ | _ -> skip_phrase lexbuf
+ | exception (Lexer.Error (Lexer.Unterminated_comment _, _)
+ | Lexer.Error (Lexer.Unterminated_string, _)
+ | Lexer.Error (Lexer.Reserved_sequence _, _)
+ | Lexer.Error (Lexer.Unterminated_string_in_comment _, _)
+ | Lexer.Error (Lexer.Illegal_character _, _)) ->
+ skip_phrase lexbuf
+
+let maybe_skip_phrase lexbuf =
+ match !last_token with
+ | Parser.SEMISEMI | Parser.EOF -> ()
+ | _ -> skip_phrase lexbuf
+
+type 'a parser =
+ (Lexing.lexbuf -> Parser.token) -> Lexing.lexbuf -> 'a
+
+let wrap (parser : 'a parser) lexbuf : 'a =
+ try
+ Docstrings.init ();
+ let keyword_edition =
+ Clflags.(Option.map parse_keyword_edition !keyword_edition)
+ in
+ Lexer.init ?keyword_edition ();
+ let ast = parser token lexbuf in
+ Parsing.clear_parser();
+ Docstrings.warn_bad_docstrings ();
+ last_token := Parser.EOF;
+ ast
+ with
+ | Lexer.Error(Lexer.Illegal_character _, _) as err
+ when !Location.input_name = "//toplevel//"->
+ skip_phrase lexbuf;
+ raise err
+ | Syntaxerr.Error _ as err
+ when !Location.input_name = "//toplevel//" ->
+ maybe_skip_phrase lexbuf;
+ raise err
+ | Parsing.Parse_error | Syntaxerr.Escape_error ->
+ let loc = Location.curr lexbuf in
+ if !Location.input_name = "//toplevel//"
+ then maybe_skip_phrase lexbuf;
+ raise(Syntaxerr.Error(Syntaxerr.Other loc))
+
+(* We pass [--strategy simplified] to Menhir, which means that we wish to use
+ its "simplified" strategy for handling errors. When a syntax error occurs,
+ the current token is replaced with an [error] token. The parser then
+ continues shifting and reducing, as far as possible. After (possibly)
+ shifting the [error] token, though, the parser remains in error-handling
+ mode, and does not request the next token, so the current token remains
+ [error].
+
+ In OCaml's grammar, the [error] token always appears at the end of a
+ production, and this production always raises an exception. In such
+ a situation, the strategy described above means that:
+
+ - either the parser will not be able to shift [error],
+ and will raise [Parser.Error];
+
+ - or it will be able to shift [error] and will then reduce
+ a production whose semantic action raises an exception.
+
+ In either case, the parser will not attempt to read one token past
+ the syntax error. *)
+
+let implementation = wrap Parser.implementation
+and interface = wrap Parser.interface
+and toplevel_phrase = wrap Parser.toplevel_phrase
+and use_file = wrap Parser.use_file
+and core_type = wrap Parser.parse_core_type
+and expression = wrap Parser.parse_expression
+and pattern = wrap Parser.parse_pattern
+let module_type = wrap Parser.parse_module_type
+let module_expr = wrap Parser.parse_module_expr
+
+let longident = wrap Parser.parse_any_longident
+let val_ident = wrap Parser.parse_val_longident
+let constr_ident= wrap Parser.parse_constr_longident
+let extended_module_path = wrap Parser.parse_mod_ext_longident
+let simple_module_path = wrap Parser.parse_mod_longident
+let type_ident = wrap Parser.parse_mty_longident
+
+(* Error reporting for Syntaxerr *)
+(* The code has been moved here so that one can reuse Pprintast.tyvar *)
+
+module Style = Misc.Style
+
+let prepare_error err =
+ let open Syntaxerr in
+ match err with
+ | Unclosed(opening_loc, opening, closing_loc, closing) ->
+ Location.errorf
+ ~loc:closing_loc
+ ~sub:[
+ Location.msg ~loc:opening_loc
+ "This %a might be unmatched" Style.inline_code opening
+ ]
+ "Syntax error: %a expected" Style.inline_code closing
+
+ | Expecting (loc, nonterm) ->
+ Location.errorf ~loc "Syntax error: %a expected."
+ Style.inline_code nonterm
+ | Not_expecting (loc, nonterm) ->
+ Location.errorf ~loc "Syntax error: %a not expected."
+ Style.inline_code nonterm
+ | Applicative_path loc ->
+ Location.errorf ~loc
+ "Syntax error: applicative paths of the form %a \
+ are not supported when the option %a is set."
+ Style.inline_code "F(X).t"
+ Style.inline_code "-no-app-func"
+ | Variable_in_scope (loc, var) ->
+ Location.errorf ~loc
+ "In this scoped type, variable %a \
+ is reserved for the local type %a."
+ (Style.as_inline_code Pprintast.Doc.tyvar) var
+ Style.inline_code var
+ | Other loc ->
+ Location.errorf ~loc "Syntax error"
+ | Ill_formed_ast (loc, s) ->
+ Location.errorf ~loc
+ "broken invariant in parsetree: %s" s
+ | Invalid_package_type (loc, ipt) ->
+ let invalid ppf ipt = match ipt with
+ | Syntaxerr.Parameterized_types ->
+ Format_doc.fprintf ppf "parametrized types are not supported"
+ | Constrained_types ->
+ Format_doc.fprintf ppf "constrained types are not supported"
+ | Private_types ->
+ Format_doc.fprintf ppf "private types are not supported"
+ | Not_with_type ->
+ Format_doc.fprintf ppf "only %a constraints are supported"
+ Style.inline_code "with type t ="
+ | Neither_identifier_nor_with_type ->
+ Format_doc.fprintf ppf
+ "only module type identifier and %a constraints are supported"
+ Style.inline_code "with type"
+ in
+ Location.errorf ~loc "Syntax error: invalid package type: %a" invalid ipt
+ | Removed_string_set loc ->
+ Location.errorf ~loc
+ "Syntax error: strings are immutable, there is no assignment \
+ syntax for them.\n\
+ @{<hint>Hint@}: Mutable sequences of bytes are available in \
+ the Bytes module.\n\
+ @{<hint>Hint@}: Did you mean to use %a?"
+ Style.inline_code "Bytes.set"
+let () =
+ Location.register_error_of_exn
+ (function
+ | Syntaxerr.Error err -> Some (prepare_error err)
+ | _ -> None
+ )
diff --git a/upstream/ocaml_503/parsing/parse.mli b/upstream/ocaml_503/parsing/parse.mli
new file mode 100644
index 0000000000..0de6b48a13
--- /dev/null
+++ b/upstream/ocaml_503/parsing/parse.mli
@@ -0,0 +1,110 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Entry points in the parser
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val implementation : Lexing.lexbuf -> Parsetree.structure
+val interface : Lexing.lexbuf -> Parsetree.signature
+val toplevel_phrase : Lexing.lexbuf -> Parsetree.toplevel_phrase
+val use_file : Lexing.lexbuf -> Parsetree.toplevel_phrase list
+val core_type : Lexing.lexbuf -> Parsetree.core_type
+val expression : Lexing.lexbuf -> Parsetree.expression
+val pattern : Lexing.lexbuf -> Parsetree.pattern
+val module_type : Lexing.lexbuf -> Parsetree.module_type
+val module_expr : Lexing.lexbuf -> Parsetree.module_expr
+
+(** The functions below can be used to parse Longident safely. *)
+
+val longident: Lexing.lexbuf -> Longident.t
+(**
+ The function [longident] is guaranteed to parse all subclasses
+ of {!Longident.t} used in OCaml: values, constructors, simple or extended
+ module paths, and types or module types.
+
+ However, this function accepts inputs which are not accepted by the
+ compiler, because they combine functor applications and infix operators.
+ In valid OCaml syntax, only value-level identifiers may end with infix
+ operators [Foo.( + )].
+ Moreover, in value-level identifiers the module path [Foo] must be simple
+ ([M.N] rather than [F(X)]): functor applications may only appear in
+ type-level identifiers.
+ As a consequence, a path such as [F(X).( + )] is not a valid OCaml
+ identifier; but it is accepted by this function.
+*)
+
+(** The next functions are specialized to a subclass of {!Longident.t} *)
+
+val val_ident: Lexing.lexbuf -> Longident.t
+(**
+ This function parses a syntactically valid path for a value. For instance,
+ [x], [M.x], and [(+.)] are valid. Contrarily, [M.A], [F(X).x], and [true]
+ are rejected.
+
+ Longident for OCaml's value cannot contain functor application.
+ The last component of the {!Longident.t} is not capitalized,
+ but can be an operator [A.Path.To.(.%.%.(;..)<-)]
+*)
+
+val constr_ident: Lexing.lexbuf -> Longident.t
+(**
+ This function parses a syntactically valid path for a variant constructor.
+ For instance, [A], [M.A] and [M.(::)] are valid, but both [M.a]
+ and [F(X).A] are rejected.
+
+ Longident for OCaml's variant constructors cannot contain functor
+ application.
+ The last component of the {!Longident.t} is capitalized,
+ or it may be one the special constructors: [true],[false],[()],[[]],[(::)].
+ Among those special constructors, only [(::)] can be prefixed by a module
+ path ([A.B.C.(::)]).
+*)
+
+
+val simple_module_path: Lexing.lexbuf -> Longident.t
+(**
+ This function parses a syntactically valid path for a module.
+ For instance, [A], and [M.A] are valid, but both [M.a]
+ and [F(X).A] are rejected.
+
+ Longident for OCaml's module cannot contain functor application.
+ The last component of the {!Longident.t} is capitalized.
+*)
+
+
+val extended_module_path: Lexing.lexbuf -> Longident.t
+(**
+ This function parse syntactically valid path for an extended module.
+ For instance, [A.B] and [F(A).B] are valid. Contrarily,
+ [(.%())] or [[]] are both rejected.
+
+ The last component of the {!Longident.t} is capitalized.
+
+*)
+
+val type_ident: Lexing.lexbuf -> Longident.t
+(**
+ This function parse syntactically valid path for a type or a module type.
+ For instance, [A], [t], [M.t] and [F(X).t] are valid. Contrarily,
+ [(.%())] or [[]] are both rejected.
+
+ In path for type and module types, only operators and special constructors
+ are rejected.
+
+*)
diff --git a/upstream/ocaml_503/parsing/parser.mly b/upstream/ocaml_503/parsing/parser.mly
new file mode 100644
index 0000000000..84597d962a
--- /dev/null
+++ b/upstream/ocaml_503/parsing/parser.mly
@@ -0,0 +1,4152 @@
+/**************************************************************************/
+/* */
+/* 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. */
+/* */
+/**************************************************************************/
+
+/* The parser definition */
+
+/* The commands [make list-parse-errors] and [make generate-parse-errors]
+ run Menhir on a modified copy of the parser where every block of
+ text comprised between the markers [BEGIN AVOID] and -----------
+ [END AVOID] has been removed. This file should be formatted in
+ such a way that this results in a clean removal of certain
+ symbols, productions, or declarations. */
+
+%{
+
+[@@@ocaml.warning "-60"] module Str = Ast_helper.Str (* For ocamldep *)
+[@@@ocaml.warning "+60"]
+
+open Asttypes
+open Longident
+open Parsetree
+open Ast_helper
+open Docstrings
+open Docstrings.WithMenhir
+
+let mkloc = Location.mkloc
+let mknoloc = Location.mknoloc
+
+let make_loc (startpos, endpos) = {
+ Location.loc_start = startpos;
+ Location.loc_end = endpos;
+ Location.loc_ghost = false;
+}
+
+let ghost_loc (startpos, endpos) = {
+ Location.loc_start = startpos;
+ Location.loc_end = endpos;
+ Location.loc_ghost = true;
+}
+
+let mktyp ~loc ?attrs d = Typ.mk ~loc:(make_loc loc) ?attrs d
+let mkpat ~loc d = Pat.mk ~loc:(make_loc loc) d
+let mkexp ~loc d = Exp.mk ~loc:(make_loc loc) d
+let mkmty ~loc ?attrs d = Mty.mk ~loc:(make_loc loc) ?attrs d
+let mksig ~loc d = Sig.mk ~loc:(make_loc loc) d
+let mkmod ~loc ?attrs d = Mod.mk ~loc:(make_loc loc) ?attrs d
+let mkstr ~loc d = Str.mk ~loc:(make_loc loc) d
+let mkclass ~loc ?attrs d = Cl.mk ~loc:(make_loc loc) ?attrs d
+let mkcty ~loc ?attrs d = Cty.mk ~loc:(make_loc loc) ?attrs d
+let mkconst ~loc c = Const.mk ~loc:(make_loc loc) c
+
+let pstr_typext (te, ext) =
+ (Pstr_typext te, ext)
+let pstr_primitive (vd, ext) =
+ (Pstr_primitive vd, ext)
+let pstr_type ((nr, ext), tys) =
+ (Pstr_type (nr, tys), ext)
+let pstr_exception (te, ext) =
+ (Pstr_exception te, ext)
+let pstr_include (body, ext) =
+ (Pstr_include body, ext)
+let pstr_recmodule (ext, bindings) =
+ (Pstr_recmodule bindings, ext)
+
+let psig_typext (te, ext) =
+ (Psig_typext te, ext)
+let psig_value (vd, ext) =
+ (Psig_value vd, ext)
+let psig_type ((nr, ext), tys) =
+ (Psig_type (nr, tys), ext)
+let psig_typesubst ((nr, ext), tys) =
+ assert (nr = Recursive); (* see [no_nonrec_flag] *)
+ (Psig_typesubst tys, ext)
+let psig_exception (te, ext) =
+ (Psig_exception te, ext)
+let psig_include (body, ext) =
+ (Psig_include body, ext)
+
+let mkctf ~loc ?attrs ?docs d =
+ Ctf.mk ~loc:(make_loc loc) ?attrs ?docs d
+let mkcf ~loc ?attrs ?docs d =
+ Cf.mk ~loc:(make_loc loc) ?attrs ?docs d
+
+let mkrhs rhs loc = mkloc rhs (make_loc loc)
+let ghrhs rhs loc = mkloc rhs (ghost_loc loc)
+
+let push_loc x acc =
+ if x.Location.loc_ghost
+ then acc
+ else x :: acc
+
+let reloc_pat ~loc x =
+ { x with ppat_loc = make_loc loc;
+ ppat_loc_stack = push_loc x.ppat_loc x.ppat_loc_stack }
+let reloc_exp ~loc x =
+ { x with pexp_loc = make_loc loc;
+ pexp_loc_stack = push_loc x.pexp_loc x.pexp_loc_stack }
+let reloc_typ ~loc x =
+ { x with ptyp_loc = make_loc loc;
+ ptyp_loc_stack = push_loc x.ptyp_loc x.ptyp_loc_stack }
+
+let mkexpvar ~loc (name : string) =
+ mkexp ~loc (Pexp_ident(mkrhs (Lident name) loc))
+
+let mkoperator =
+ mkexpvar
+
+let mkpatvar ~loc name =
+ mkpat ~loc (Ppat_var (mkrhs name loc))
+
+(*
+ Ghost expressions and patterns:
+ expressions and patterns that do not appear explicitly in the
+ source file they have the loc_ghost flag set to true.
+ Then the profiler will not try to instrument them and the
+ -annot option will not try to display their type.
+
+ Every grammar rule that generates an element with a location must
+ make at most one non-ghost element, the topmost one.
+
+ How to tell whether your location must be ghost:
+ A location corresponds to a range of characters in the source file.
+ If the location contains a piece of code that is syntactically
+ valid (according to the documentation), and corresponds to the
+ AST node, then the location must be real; in all other cases,
+ it must be ghost.
+*)
+let ghexp ~loc d = Exp.mk ~loc:(ghost_loc loc) d
+let ghpat ~loc d = Pat.mk ~loc:(ghost_loc loc) d
+let ghtyp ~loc d = Typ.mk ~loc:(ghost_loc loc) d
+let ghloc ~loc d = { txt = d; loc = ghost_loc loc }
+let ghstr ~loc d = Str.mk ~loc:(ghost_loc loc) d
+let ghsig ~loc d = Sig.mk ~loc:(ghost_loc loc) d
+
+let mkinfix arg1 op arg2 =
+ Pexp_apply(op, [Nolabel, arg1; Nolabel, arg2])
+
+let neg_string f =
+ if String.length f > 0 && f.[0] = '-'
+ then String.sub f 1 (String.length f - 1)
+ else "-" ^ f
+
+(* Pre-apply the special [-], [-.], [+] and [+.] prefix operators into
+ constants if possible, otherwise turn them into the corresponding prefix
+ operators [~-], [~-.], etc.. *)
+let mkuminus ~sloc ~oploc name arg =
+ match name, arg.pexp_desc, arg.pexp_attributes with
+ | "-",
+ Pexp_constant({pconst_desc = Pconst_integer (n,m); pconst_loc=_}),
+ [] ->
+ Pexp_constant(mkconst ~loc:sloc (Pconst_integer(neg_string n, m)))
+ | ("-" | "-."),
+ Pexp_constant({pconst_desc = Pconst_float (f, m); pconst_loc=_}), [] ->
+ Pexp_constant(mkconst ~loc:sloc (Pconst_float(neg_string f, m)))
+ | _ ->
+ Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
+
+let mkuplus ~sloc ~oploc name arg =
+ let desc = arg.pexp_desc in
+ match name, desc, arg.pexp_attributes with
+ | "+",
+ Pexp_constant({pconst_desc = Pconst_integer _ as desc; pconst_loc=_}),
+ []
+ | ("+" | "+."),
+ Pexp_constant({pconst_desc = Pconst_float _ as desc; pconst_loc=_}),
+ [] ->
+ Pexp_constant(mkconst ~loc:sloc desc)
+ | _ ->
+ Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
+
+let mk_attr ~loc name payload =
+ Builtin_attributes.(register_attr Parser name);
+ Attr.mk ~loc name payload
+
+(* TODO define an abstraction boundary between locations-as-pairs
+ and locations-as-Location.t; it should be clear when we move from
+ one world to the other *)
+
+let mkexp_cons_desc consloc args =
+ Pexp_construct(mkrhs (Lident "::") consloc, Some args)
+let mkexp_cons ~loc consloc args =
+ mkexp ~loc (mkexp_cons_desc consloc args)
+
+let mkpat_cons_desc consloc args =
+ Ppat_construct(mkrhs (Lident "::") consloc, Some ([], args))
+let mkpat_cons ~loc consloc args =
+ mkpat ~loc (mkpat_cons_desc consloc args)
+
+let ghexp_cons_desc consloc args =
+ Pexp_construct(ghrhs (Lident "::") consloc, Some args)
+let ghpat_cons_desc consloc args =
+ Ppat_construct(ghrhs (Lident "::") consloc, Some ([], args))
+
+let rec mktailexp nilloc = let open Location in function
+ [] ->
+ let nil = ghloc ~loc:nilloc (Lident "[]") in
+ Pexp_construct (nil, None), nilloc
+ | e1 :: el ->
+ let exp_el, el_loc = mktailexp nilloc el in
+ let loc = (e1.pexp_loc.loc_start, snd el_loc) in
+ let arg = ghexp ~loc (Pexp_tuple [e1; ghexp ~loc:el_loc exp_el]) in
+ ghexp_cons_desc loc arg, loc
+
+let rec mktailpat nilloc = let open Location in function
+ [] ->
+ let nil = ghloc ~loc:nilloc (Lident "[]") in
+ Ppat_construct (nil, None), nilloc
+ | p1 :: pl ->
+ let pat_pl, el_loc = mktailpat nilloc pl in
+ let loc = (p1.ppat_loc.loc_start, snd el_loc) in
+ let arg = ghpat ~loc (Ppat_tuple [p1; ghpat ~loc:el_loc pat_pl]) in
+ ghpat_cons_desc loc arg, loc
+
+let mkstrexp e attrs =
+ { pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc }
+
+let mkexp_desc_constraint e t =
+ match t with
+ | Pconstraint t -> Pexp_constraint(e, t)
+ | Pcoerce(t1, t2) -> Pexp_coerce(e, t1, t2)
+
+let mkexp_constraint ~loc e t =
+ mkexp ~loc (mkexp_desc_constraint e t)
+
+let mkexp_opt_constraint ~loc e = function
+ | None -> e
+ | Some constraint_ -> mkexp_constraint ~loc e constraint_
+
+let mkpat_opt_constraint ~loc p = function
+ | None -> p
+ | Some typ -> mkpat ~loc (Ppat_constraint(p, typ))
+
+let syntax_error () =
+ raise Syntaxerr.Escape_error
+
+let unclosed opening_name opening_loc closing_name closing_loc =
+ raise(Syntaxerr.Error(Syntaxerr.Unclosed(make_loc opening_loc, opening_name,
+ make_loc closing_loc, closing_name)))
+
+let expecting loc nonterm =
+ raise Syntaxerr.(Error(Expecting(make_loc loc, nonterm)))
+
+let removed_string_set loc =
+ raise(Syntaxerr.Error(Syntaxerr.Removed_string_set(make_loc loc)))
+
+(* Using the function [not_expecting] in a semantic action means that this
+ syntactic form is recognized by the parser but is in fact incorrect. This
+ idiom is used in a few places to produce ad hoc syntax error messages. *)
+
+(* This idiom should be used as little as possible, because it confuses the
+ analyses performed by Menhir. Because Menhir views the semantic action as
+ opaque, it believes that this syntactic form is correct. This can lead
+ [make generate-parse-errors] to produce sentences that cause an early
+ (unexpected) syntax error and do not achieve the desired effect. This could
+ also lead a completion system to propose completions which in fact are
+ incorrect. In order to avoid these problems, the productions that use
+ [not_expecting] should be marked with AVOID. *)
+
+let not_expecting loc nonterm =
+ raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm)))
+
+(* Helper functions for desugaring array indexing operators *)
+type paren_kind = Paren | Brace | Bracket
+
+(* We classify the dimension of indices: Bigarray distinguishes
+ indices of dimension 1,2,3, or more. Similarly, user-defined
+ indexing operator behave differently for indices of dimension 1
+ or more.
+*)
+type index_dim =
+ | One
+ | Two
+ | Three
+ | Many
+type ('dot,'index) array_family = {
+
+ name:
+ Lexing.position * Lexing.position -> 'dot -> assign:bool -> paren_kind
+ -> index_dim -> Longident.t Location.loc
+ (*
+ This functions computes the name of the explicit indexing operator
+ associated with a sugared array indexing expression.
+
+ For instance, for builtin arrays, if Clflags.unsafe is set,
+ * [ a.[index] ] => [String.unsafe_get]
+ * [ a.{x,y} <- 1 ] => [ Bigarray.Array2.unsafe_set]
+
+ User-defined indexing operator follows a more local convention:
+ * [ a .%(index)] => [ (.%()) ]
+ * [ a.![1;2] <- 0 ] => [(.![;..]<-)]
+ * [ a.My.Map.?(0) => [My.Map.(.?())]
+ *);
+
+ index:
+ Lexing.position * Lexing.position -> paren_kind -> 'index
+ -> index_dim * (arg_label * expression) list
+ (*
+ [index (start,stop) paren index] computes the dimension of the
+ index argument and how it should be desugared when transformed
+ to a list of arguments for the indexing operator.
+ In particular, in both the Bigarray case and the user-defined case,
+ beyond a certain dimension, multiple indices are packed into a single
+ array argument:
+ * [ a.(x) ] => [ [One, [Nolabel, <<x>>] ]
+ * [ a.{1,2} ] => [ [Two, [Nolabel, <<1>>; Nolabel, <<2>>] ]
+ * [ a.{1,2,3,4} ] => [ [Many, [Nolabel, <<[|1;2;3;4|]>>] ] ]
+ *);
+
+}
+
+let bigarray_untuplify = function
+ { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
+ | exp -> [exp]
+
+let builtin_arraylike_name loc _ ~assign paren_kind n =
+ let opname = if assign then "set" else "get" in
+ let opname = if !Clflags.unsafe then "unsafe_" ^ opname else opname in
+ let prefix = match paren_kind with
+ | Paren -> Lident "Array"
+ | Bracket ->
+ if assign then removed_string_set loc
+ else Lident "String"
+ | Brace ->
+ let submodule_name = match n with
+ | One -> "Array1"
+ | Two -> "Array2"
+ | Three -> "Array3"
+ | Many -> "Genarray" in
+ Ldot(Lident "Bigarray", submodule_name) in
+ ghloc ~loc (Ldot(prefix,opname))
+
+let builtin_arraylike_index loc paren_kind index = match paren_kind with
+ | Paren | Bracket -> One, [Nolabel, index]
+ | Brace ->
+ (* Multi-indices for bigarray are comma-separated ([a.{1,2,3,4}]) *)
+ match bigarray_untuplify index with
+ | [x] -> One, [Nolabel, x]
+ | [x;y] -> Two, [Nolabel, x; Nolabel, y]
+ | [x;y;z] -> Three, [Nolabel, x; Nolabel, y; Nolabel, z]
+ | coords -> Many, [Nolabel, ghexp ~loc (Pexp_array coords)]
+
+let builtin_indexing_operators : (unit, expression) array_family =
+ { index = builtin_arraylike_index; name = builtin_arraylike_name }
+
+let paren_to_strings = function
+ | Paren -> "(", ")"
+ | Bracket -> "[", "]"
+ | Brace -> "{", "}"
+
+let user_indexing_operator_name loc (prefix,ext) ~assign paren_kind n =
+ let name =
+ let assign = if assign then "<-" else "" in
+ let mid = match n with
+ | Many | Three | Two -> ";.."
+ | One -> "" in
+ let left, right = paren_to_strings paren_kind in
+ String.concat "" ["."; ext; left; mid; right; assign] in
+ let lid = match prefix with
+ | None -> Lident name
+ | Some p -> Ldot(p,name) in
+ ghloc ~loc lid
+
+let user_index loc _ index =
+ (* Multi-indices for user-defined operators are semicolon-separated
+ ([a.%[1;2;3;4]]) *)
+ match index with
+ | [a] -> One, [Nolabel, a]
+ | l -> Many, [Nolabel, mkexp ~loc (Pexp_array l)]
+
+let user_indexing_operators:
+ (Longident.t option * string, expression list) array_family
+ = { index = user_index; name = user_indexing_operator_name }
+
+let mk_indexop_expr array_indexing_operator ~loc
+ (array,dot,paren,index,set_expr) =
+ let assign = match set_expr with None -> false | Some _ -> true in
+ let n, index = array_indexing_operator.index loc paren index in
+ let fn = array_indexing_operator.name loc dot ~assign paren n in
+ let set_arg = match set_expr with
+ | None -> []
+ | Some expr -> [Nolabel, expr] in
+ let args = (Nolabel,array) :: index @ set_arg in
+ mkexp ~loc (Pexp_apply(ghexp ~loc (Pexp_ident fn), args))
+
+let indexop_unclosed_error loc_s s loc_e =
+ let left, right = paren_to_strings s in
+ unclosed left loc_s right loc_e
+
+let lapply ~loc p1 p2 =
+ if !Clflags.applicative_functors
+ then Lapply(p1, p2)
+ else raise (Syntaxerr.Error(
+ Syntaxerr.Applicative_path (make_loc loc)))
+
+(* [loc_map] could be [Location.map]. *)
+let loc_map (f : 'a -> 'b) (x : 'a Location.loc) : 'b Location.loc =
+ { x with txt = f x.txt }
+
+let make_ghost x = { x with loc = { x.loc with loc_ghost = true }}
+
+let loc_last (id : Longident.t Location.loc) : string Location.loc =
+ loc_map Longident.last id
+
+let loc_lident (id : string Location.loc) : Longident.t Location.loc =
+ loc_map (fun x -> Lident x) id
+
+let exp_of_longident lid =
+ let lid = loc_map (fun id -> Lident (Longident.last id)) lid in
+ Exp.mk ~loc:lid.loc (Pexp_ident lid)
+
+let exp_of_label lbl =
+ Exp.mk ~loc:lbl.loc (Pexp_ident (loc_lident lbl))
+
+let pat_of_label lbl =
+ Pat.mk ~loc:lbl.loc (Ppat_var (loc_last lbl))
+
+let mk_newtypes ~loc newtypes exp =
+ let mkexp = mkexp ~loc in
+ List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp)))
+ newtypes exp
+
+let wrap_type_annotation ~loc newtypes core_type body =
+ let mkexp, ghtyp = mkexp ~loc, ghtyp ~loc in
+ let mk_newtypes = mk_newtypes ~loc in
+ let exp = mkexp(Pexp_constraint(body,core_type)) in
+ let exp = mk_newtypes newtypes exp in
+ (exp, ghtyp(Ptyp_poly(newtypes, Typ.varify_constructors newtypes core_type)))
+
+let wrap_exp_attrs ~loc body (ext, attrs) =
+ let ghexp = ghexp ~loc in
+ (* todo: keep exact location for the entire attribute *)
+ let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in
+ match ext with
+ | None -> body
+ | Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []]))
+
+let mkexp_attrs ~loc d attrs =
+ wrap_exp_attrs ~loc (mkexp ~loc d) attrs
+
+let wrap_typ_attrs ~loc typ (ext, attrs) =
+ (* todo: keep exact location for the entire attribute *)
+ let typ = {typ with ptyp_attributes = attrs @ typ.ptyp_attributes} in
+ match ext with
+ | None -> typ
+ | Some id -> ghtyp ~loc (Ptyp_extension (id, PTyp typ))
+
+let wrap_pat_attrs ~loc pat (ext, attrs) =
+ (* todo: keep exact location for the entire attribute *)
+ let pat = {pat with ppat_attributes = attrs @ pat.ppat_attributes} in
+ match ext with
+ | None -> pat
+ | Some id -> ghpat ~loc (Ppat_extension (id, PPat (pat, None)))
+
+let mkpat_attrs ~loc d attrs =
+ wrap_pat_attrs ~loc (mkpat ~loc d) attrs
+
+let wrap_class_attrs ~loc:_ body attrs =
+ {body with pcl_attributes = attrs @ body.pcl_attributes}
+let wrap_mod_attrs ~loc:_ attrs body =
+ {body with pmod_attributes = attrs @ body.pmod_attributes}
+let wrap_mty_attrs ~loc:_ attrs body =
+ {body with pmty_attributes = attrs @ body.pmty_attributes}
+
+let wrap_str_ext ~loc body ext =
+ match ext with
+ | None -> body
+ | Some id -> ghstr ~loc (Pstr_extension ((id, PStr [body]), []))
+
+let wrap_mkstr_ext ~loc (item, ext) =
+ wrap_str_ext ~loc (mkstr ~loc item) ext
+
+let wrap_sig_ext ~loc body ext =
+ match ext with
+ | None -> body
+ | Some id -> ghsig ~loc (Psig_extension ((id, PSig [body]), []))
+
+let wrap_mksig_ext ~loc (item, ext) =
+ wrap_sig_ext ~loc (mksig ~loc item) ext
+
+let mk_quotedext ~loc (id, idloc, str, strloc, delim) =
+ let exp_id = mkloc id idloc in
+ let const = Const.mk ~loc:strloc (Pconst_string (str, strloc, delim)) in
+ let e = ghexp ~loc (Pexp_constant const) in
+ (exp_id, PStr [mkstrexp e []])
+
+let text_str pos = Str.text (rhs_text pos)
+let text_sig pos = Sig.text (rhs_text pos)
+let text_cstr pos = Cf.text (rhs_text pos)
+let text_csig pos = Ctf.text (rhs_text pos)
+let text_def pos =
+ List.map (fun def -> Ptop_def [def]) (Str.text (rhs_text pos))
+
+let extra_text startpos endpos text items =
+ match items with
+ | [] ->
+ let post = rhs_post_text endpos in
+ let post_extras = rhs_post_extra_text endpos in
+ text post @ text post_extras
+ | _ :: _ ->
+ let pre_extras = rhs_pre_extra_text startpos in
+ let post_extras = rhs_post_extra_text endpos in
+ text pre_extras @ items @ text post_extras
+
+let extra_str p1 p2 items = extra_text p1 p2 Str.text items
+let extra_sig p1 p2 items = extra_text p1 p2 Sig.text items
+let extra_cstr p1 p2 items = extra_text p1 p2 Cf.text items
+let extra_csig p1 p2 items = extra_text p1 p2 Ctf.text items
+let extra_def p1 p2 items =
+ extra_text p1 p2
+ (fun txt -> List.map (fun def -> Ptop_def [def]) (Str.text txt))
+ items
+
+let extra_rhs_core_type ct ~pos =
+ let docs = rhs_info pos in
+ { ct with ptyp_attributes = add_info_attrs docs ct.ptyp_attributes }
+
+type let_binding =
+ { lb_pattern: pattern;
+ lb_expression: expression;
+ lb_constraint: value_constraint option;
+ lb_is_pun: bool;
+ lb_attributes: attributes;
+ lb_docs: docs Lazy.t;
+ lb_text: text Lazy.t;
+ lb_loc: Location.t; }
+
+type let_bindings =
+ { lbs_bindings: let_binding list;
+ lbs_rec: rec_flag;
+ lbs_extension: string Asttypes.loc option }
+
+let mklb first ~loc (p, e, typ, is_pun) attrs =
+ {
+ lb_pattern = p;
+ lb_expression = e;
+ lb_constraint=typ;
+ lb_is_pun = is_pun;
+ lb_attributes = attrs;
+ lb_docs = symbol_docs_lazy loc;
+ lb_text = (if first then empty_text_lazy
+ else symbol_text_lazy (fst loc));
+ lb_loc = make_loc loc;
+ }
+
+let addlb lbs lb =
+ if lb.lb_is_pun && lbs.lbs_extension = None then syntax_error ();
+ { lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+
+let mklbs ext rf lb =
+ let lbs = {
+ lbs_bindings = [];
+ lbs_rec = rf;
+ lbs_extension = ext;
+ } in
+ addlb lbs lb
+
+let val_of_let_bindings ~loc lbs =
+ let bindings =
+ List.map
+ (fun lb ->
+ Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+ ~docs:(Lazy.force lb.lb_docs)
+ ~text:(Lazy.force lb.lb_text)
+ ?value_constraint:lb.lb_constraint lb.lb_pattern lb.lb_expression)
+ lbs.lbs_bindings
+ in
+ let str = mkstr ~loc (Pstr_value(lbs.lbs_rec, List.rev bindings)) in
+ match lbs.lbs_extension with
+ | None -> str
+ | Some id -> ghstr ~loc (Pstr_extension((id, PStr [str]), []))
+
+let expr_of_let_bindings ~loc lbs body =
+ let bindings =
+ List.map
+ (fun lb ->
+ Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+ ?value_constraint:lb.lb_constraint lb.lb_pattern lb.lb_expression)
+ lbs.lbs_bindings
+ in
+ mkexp_attrs ~loc (Pexp_let(lbs.lbs_rec, List.rev bindings, body))
+ (lbs.lbs_extension, [])
+
+let class_of_let_bindings ~loc lbs body =
+ let bindings =
+ List.map
+ (fun lb ->
+ Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+ ?value_constraint:lb.lb_constraint lb.lb_pattern lb.lb_expression)
+ lbs.lbs_bindings
+ in
+ (* Our use of let_bindings(no_ext) guarantees the following: *)
+ assert (lbs.lbs_extension = None);
+ mkclass ~loc (Pcl_let (lbs.lbs_rec, List.rev bindings, body))
+
+(* If all the parameters are [Pparam_newtype x], then return [Some xs] where
+ [xs] is the corresponding list of values [x]. This function is optimized for
+ the common case, where a list of parameters contains at least one value
+ parameter.
+*)
+let all_params_as_newtypes =
+ let is_newtype { pparam_desc; _ } =
+ match pparam_desc with
+ | Pparam_newtype _ -> true
+ | Pparam_val _ -> false
+ in
+ let as_newtype { pparam_desc; pparam_loc } =
+ match pparam_desc with
+ | Pparam_newtype x -> Some (x, pparam_loc)
+ | Pparam_val _ -> None
+ in
+ fun params ->
+ if List.for_all is_newtype params
+ then Some (List.filter_map as_newtype params)
+ else None
+
+(* Given a construct [fun (type a b c) : t -> e], we construct
+ [Pexp_newtype(a, Pexp_newtype(b, Pexp_newtype(c, Pexp_constraint(e, t))))]
+ rather than a [Pexp_function].
+*)
+let mkghost_newtype_function_body newtypes body_constraint body =
+ let wrapped_body =
+ match body_constraint with
+ | None -> body
+ | Some body_constraint ->
+ let loc = { body.pexp_loc with loc_ghost = true } in
+ Exp.mk (mkexp_desc_constraint body body_constraint) ~loc
+ in
+ let expr =
+ List.fold_right
+ (fun (newtype, newtype_loc) e ->
+ (* Mints a ghost location that approximates the newtype's "extent" as
+ being from the start of the newtype param until the end of the
+ function body.
+ *)
+ let loc = (newtype_loc.Location.loc_start, body.pexp_loc.loc_end) in
+ ghexp (Pexp_newtype (newtype, e)) ~loc)
+ newtypes
+ wrapped_body
+ in
+ expr.pexp_desc
+
+let mkfunction params body_constraint body =
+ match body with
+ | Pfunction_cases _ -> Pexp_function (params, body_constraint, body)
+ | Pfunction_body body_exp ->
+ (* If all the params are newtypes, then we don't create a function node;
+ we create nested newtype nodes. *)
+ match all_params_as_newtypes params with
+ | None -> Pexp_function (params, body_constraint, body)
+ | Some newtypes ->
+ mkghost_newtype_function_body newtypes body_constraint body_exp
+
+let mk_functor_typ args mty =
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmty ~loc:(startpos, mty.pmty_loc.loc_end) (Pmty_functor (arg, acc)))
+ mty args
+
+(* Alternatively, we could keep the generic module type in the Parsetree
+ and extract the package type during type-checking. In that case,
+ the assertions below should be turned into explicit checks. *)
+let package_type_of_module_type pmty =
+ let err loc s =
+ raise (Syntaxerr.Error (Syntaxerr.Invalid_package_type (loc, s)))
+ in
+ let map_cstr = function
+ | Pwith_type (lid, ptyp) ->
+ let loc = ptyp.ptype_loc in
+ if ptyp.ptype_params <> [] then
+ err loc Syntaxerr.Parameterized_types;
+ if ptyp.ptype_cstrs <> [] then
+ err loc Syntaxerr.Constrained_types;
+ if ptyp.ptype_private <> Public then
+ err loc Syntaxerr.Private_types;
+
+ (* restrictions below are checked by the 'with_constraint' rule *)
+ assert (ptyp.ptype_kind = Ptype_abstract);
+ assert (ptyp.ptype_attributes = []);
+ let ty =
+ match ptyp.ptype_manifest with
+ | Some ty -> ty
+ | None -> assert false
+ in
+ (lid, ty)
+ | _ ->
+ err pmty.pmty_loc Not_with_type
+ in
+ match pmty with
+ | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes)
+ | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
+ (lid, List.map map_cstr cstrs, pmty.pmty_attributes)
+ | _ ->
+ err pmty.pmty_loc Neither_identifier_nor_with_type
+
+let mk_directive_arg ~loc k =
+ { pdira_desc = k;
+ pdira_loc = make_loc loc;
+ }
+
+let mk_directive ~loc name arg =
+ Ptop_dir {
+ pdir_name = name;
+ pdir_arg = arg;
+ pdir_loc = make_loc loc;
+ }
+
+%}
+
+/* Tokens */
+
+/* The alias that follows each token is used by Menhir when it needs to
+ produce a sentence (that is, a sequence of tokens) in concrete syntax. */
+
+/* Some tokens represent multiple concrete strings. In most cases, an
+ arbitrary concrete string can be chosen. In a few cases, one must
+ be careful: e.g., in PREFIXOP and INFIXOP2, one must choose a concrete
+ string that will not trigger a syntax error; see how [not_expecting]
+ is used in the definition of [type_variance]. */
+
+%token AMPERAMPER "&&"
+%token AMPERSAND "&"
+%token AND "and"
+%token AS "as"
+%token ASSERT "assert"
+%token BACKQUOTE "`"
+%token BANG "!"
+%token BAR "|"
+%token BARBAR "||"
+%token BARRBRACKET "|]"
+%token BEGIN "begin"
+%token <char> CHAR "'a'" (* just an example *)
+%token CLASS "class"
+%token COLON ":"
+%token COLONCOLON "::"
+%token COLONEQUAL ":="
+%token COLONGREATER ":>"
+%token COMMA ","
+%token CONSTRAINT "constraint"
+%token DO "do"
+%token DONE "done"
+%token DOT "."
+%token DOTDOT ".."
+%token DOWNTO "downto"
+%token EFFECT "effect"
+%token ELSE "else"
+%token END "end"
+%token EOF ""
+%token EQUAL "="
+%token EXCEPTION "exception"
+%token EXTERNAL "external"
+%token FALSE "false"
+%token <string * char option> FLOAT "42.0" (* just an example *)
+%token FOR "for"
+%token FUN "fun"
+%token FUNCTION "function"
+%token FUNCTOR "functor"
+%token GREATER ">"
+%token GREATERRBRACE ">}"
+%token GREATERRBRACKET ">]"
+%token IF "if"
+%token IN "in"
+%token INCLUDE "include"
+%token <string> INFIXOP0 "!=" (* just an example *)
+%token <string> INFIXOP1 "@" (* just an example *)
+%token <string> INFIXOP2 "+!" (* chosen with care; see above *)
+%token <string> INFIXOP3 "land" (* just an example *)
+%token <string> INFIXOP4 "**" (* just an example *)
+%token <string> DOTOP ".+"
+%token <string> LETOP "let*" (* just an example *)
+%token <string> ANDOP "and*" (* just an example *)
+%token INHERIT "inherit"
+%token INITIALIZER "initializer"
+%token <string * char option> INT "42" (* just an example *)
+%token <string> LABEL "~label:" (* just an example *)
+%token LAZY "lazy"
+%token LBRACE "{"
+%token LBRACELESS "{<"
+%token LBRACKET "["
+%token LBRACKETBAR "[|"
+%token LBRACKETLESS "[<"
+%token LBRACKETGREATER "[>"
+%token LBRACKETPERCENT "[%"
+%token LBRACKETPERCENTPERCENT "[%%"
+%token LESS "<"
+%token LESSMINUS "<-"
+%token LET "let"
+%token <string> LIDENT "lident" (* just an example *)
+%token LPAREN "("
+%token LBRACKETAT "[@"
+%token LBRACKETATAT "[@@"
+%token LBRACKETATATAT "[@@@"
+%token MATCH "match"
+%token METHOD "method"
+%token MINUS "-"
+%token MINUSDOT "-."
+%token MINUSGREATER "->"
+%token MODULE "module"
+%token MUTABLE "mutable"
+%token NEW "new"
+%token NONREC "nonrec"
+%token OBJECT "object"
+%token OF "of"
+%token OPEN "open"
+%token <string> OPTLABEL "?label:" (* just an example *)
+%token OR "or"
+/* %token PARSER "parser" */
+%token PERCENT "%"
+%token PLUS "+"
+%token PLUSDOT "+."
+%token PLUSEQ "+="
+%token <string> PREFIXOP "!+" (* chosen with care; see above *)
+%token PRIVATE "private"
+%token QUESTION "?"
+%token QUOTE "'"
+%token RBRACE "}"
+%token RBRACKET "]"
+%token REC "rec"
+%token RPAREN ")"
+%token SEMI ";"
+%token SEMISEMI ";;"
+%token HASH "#"
+%token <string> HASHOP "##" (* just an example *)
+%token SIG "sig"
+%token STAR "*"
+%token <string * Location.t * string option>
+ STRING "\"hello\"" (* just an example *)
+%token <string * Location.t * string * Location.t * string option>
+ QUOTED_STRING_EXPR "{%hello|world|}" (* just an example *)
+%token <string * Location.t * string * Location.t * string option>
+ QUOTED_STRING_ITEM "{%%hello|world|}" (* just an example *)
+%token STRUCT "struct"
+%token THEN "then"
+%token TILDE "~"
+%token TO "to"
+%token TRUE "true"
+%token TRY "try"
+%token TYPE "type"
+%token <string> UIDENT "UIdent" (* just an example *)
+%token UNDERSCORE "_"
+%token VAL "val"
+%token VIRTUAL "virtual"
+%token WHEN "when"
+%token WHILE "while"
+%token WITH "with"
+%token <string * Location.t> COMMENT "(* comment *)"
+%token <Docstrings.docstring> DOCSTRING "(** documentation *)"
+
+%token EOL "\\n" (* not great, but EOL is unused *)
+
+(* see the [metaocaml_expr] comment *)
+%token METAOCAML_ESCAPE ".~"
+%token METAOCAML_BRACKET_OPEN ".<"
+%token METAOCAML_BRACKET_CLOSE ">."
+
+/* Precedences and associativities.
+
+Tokens and rules have precedences. A reduce/reduce conflict is resolved
+in favor of the first rule (in source file order). A shift/reduce conflict
+is resolved by comparing the precedence and associativity of the token to
+be shifted with those of the rule to be reduced.
+
+By default, a rule has the precedence of its rightmost terminal (if any).
+
+When there is a shift/reduce conflict between a rule and a token that
+have the same precedence, it is resolved using the associativity:
+if the token is left-associative, the parser will reduce; if
+right-associative, the parser will shift; if non-associative,
+the parser will declare a syntax error.
+
+We will only use associativities with operators of the kind x * x -> x
+for example, in the rules of the form expr: expr BINOP expr
+in all other cases, we define two precedences if needed to resolve
+conflicts.
+
+The precedences must be listed from low to high.
+*/
+
+%nonassoc IN
+%nonassoc below_SEMI
+%nonassoc SEMI /* below EQUAL ({lbl=...; lbl=...}) */
+%nonassoc LET /* above SEMI ( ...; let ... in ...) */
+%nonassoc below_WITH
+%nonassoc FUNCTION WITH /* below BAR (match ... with ...) */
+%nonassoc AND /* above WITH (module rec A: SIG with ... and ...) */
+%nonassoc THEN /* below ELSE (if ... then ...) */
+%nonassoc ELSE /* (if ... then ... else ...) */
+%nonassoc LESSMINUS /* below COLONEQUAL (lbl <- x := e) */
+%right COLONEQUAL /* expr (e := e := e) */
+%nonassoc AS
+%left BAR /* pattern (p|p|p) */
+%nonassoc below_COMMA
+%left COMMA /* expr/expr_comma_list (e,e,e) */
+%right MINUSGREATER /* function_type (t -> t -> t) */
+%right OR BARBAR /* expr (e || e || e) */
+%right AMPERSAND AMPERAMPER /* expr (e && e && e) */
+%nonassoc below_EQUAL
+%left INFIXOP0 EQUAL LESS GREATER /* expr (e OP e OP e) */
+%right INFIXOP1 /* expr (e OP e OP e) */
+%nonassoc below_LBRACKETAT
+%nonassoc LBRACKETAT
+%right COLONCOLON /* expr (e :: e :: e) */
+%left INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT PLUSEQ /* expr (e OP e OP e) */
+%left PERCENT INFIXOP3 STAR /* expr (e OP e OP e) */
+%right INFIXOP4 /* expr (e OP e OP e) */
+%nonassoc prec_unary_minus prec_unary_plus /* unary - */
+%nonassoc prec_constant_constructor /* cf. simple_expr (C versus C x) */
+%nonassoc prec_constr_appl /* above AS BAR COLONCOLON COMMA */
+%nonassoc below_HASH
+%nonassoc HASH /* simple_expr/toplevel_directive */
+%left HASHOP
+%nonassoc below_DOT
+%nonassoc DOT DOTOP
+/* Finally, the first tokens of simple_expr are above everything else. */
+%nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT OBJECT
+ LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
+ NEW PREFIXOP STRING TRUE UIDENT
+ LBRACKETPERCENT QUOTED_STRING_EXPR
+ METAOCAML_BRACKET_OPEN METAOCAML_ESCAPE
+
+/* Entry points */
+
+/* Several start symbols are marked with AVOID so that they are not used by
+ [make generate-parse-errors]. The three start symbols that we keep are
+ [implementation], [use_file], and [toplevel_phrase]. The latter two are
+ of marginal importance; only [implementation] really matters, since most
+ states in the automaton are reachable from it. */
+
+%start implementation /* for implementation files */
+%type <Parsetree.structure> implementation
+/* BEGIN AVOID */
+%start interface /* for interface files */
+%type <Parsetree.signature> interface
+/* END AVOID */
+%start toplevel_phrase /* for interactive use */
+%type <Parsetree.toplevel_phrase> toplevel_phrase
+%start use_file /* for the #use directive */
+%type <Parsetree.toplevel_phrase list> use_file
+/* BEGIN AVOID */
+%start parse_module_type
+%type <Parsetree.module_type> parse_module_type
+%start parse_module_expr
+%type <Parsetree.module_expr> parse_module_expr
+%start parse_core_type
+%type <Parsetree.core_type> parse_core_type
+%start parse_expression
+%type <Parsetree.expression> parse_expression
+%start parse_pattern
+%type <Parsetree.pattern> parse_pattern
+%start parse_constr_longident
+%type <Longident.t> parse_constr_longident
+%start parse_val_longident
+%type <Longident.t> parse_val_longident
+%start parse_mty_longident
+%type <Longident.t> parse_mty_longident
+%start parse_mod_ext_longident
+%type <Longident.t> parse_mod_ext_longident
+%start parse_mod_longident
+%type <Longident.t> parse_mod_longident
+%start parse_any_longident
+%type <Longident.t> parse_any_longident
+/* END AVOID */
+
+%%
+
+/* macros */
+%inline extra_str(symb): symb { extra_str $startpos $endpos $1 };
+%inline extra_sig(symb): symb { extra_sig $startpos $endpos $1 };
+%inline extra_cstr(symb): symb { extra_cstr $startpos $endpos $1 };
+%inline extra_csig(symb): symb { extra_csig $startpos $endpos $1 };
+%inline extra_def(symb): symb { extra_def $startpos $endpos $1 };
+%inline extra_text(symb): symb { extra_text $startpos $endpos $1 };
+%inline extra_rhs(symb): symb { extra_rhs_core_type $1 ~pos:$endpos($1) };
+%inline mkrhs(symb): symb
+ { mkrhs $1 $sloc }
+;
+
+%inline text_str(symb): symb
+ { text_str $startpos @ [$1] }
+%inline text_str_SEMISEMI: SEMISEMI
+ { text_str $startpos }
+%inline text_sig(symb): symb
+ { text_sig $startpos @ [$1] }
+%inline text_sig_SEMISEMI: SEMISEMI
+ { text_sig $startpos }
+%inline text_def(symb): symb
+ { text_def $startpos @ [$1] }
+%inline top_def(symb): symb
+ { Ptop_def [$1] }
+%inline text_cstr(symb): symb
+ { text_cstr $startpos @ [$1] }
+%inline text_csig(symb): symb
+ { text_csig $startpos @ [$1] }
+
+(* Using this %inline definition means that we do not control precisely
+ when [mark_rhs_docs] is called, but I don't think this matters. *)
+%inline mark_rhs_docs(symb): symb
+ { mark_rhs_docs $startpos $endpos;
+ $1 }
+
+%inline op(symb): symb
+ { mkoperator ~loc:$sloc $1 }
+
+%inline mkloc(symb): symb
+ { mkloc $1 (make_loc $sloc) }
+
+%inline mkexp(symb): symb
+ { mkexp ~loc:$sloc $1 }
+%inline mkpat(symb): symb
+ { mkpat ~loc:$sloc $1 }
+%inline mktyp(symb): symb
+ { mktyp ~loc:$sloc $1 }
+%inline mkstr(symb): symb
+ { mkstr ~loc:$sloc $1 }
+%inline mksig(symb): symb
+ { mksig ~loc:$sloc $1 }
+%inline mkmod(symb): symb
+ { mkmod ~loc:$sloc $1 }
+%inline mkmty(symb): symb
+ { mkmty ~loc:$sloc $1 }
+%inline mkcty(symb): symb
+ { mkcty ~loc:$sloc $1 }
+%inline mkctf(symb): symb
+ { mkctf ~loc:$sloc $1 }
+%inline mkcf(symb): symb
+ { mkcf ~loc:$sloc $1 }
+%inline mkclass(symb): symb
+ { mkclass ~loc:$sloc $1 }
+
+%inline wrap_mkstr_ext(symb): symb
+ { wrap_mkstr_ext ~loc:$sloc $1 }
+%inline wrap_mksig_ext(symb): symb
+ { wrap_mksig_ext ~loc:$sloc $1 }
+
+%inline mk_directive_arg(symb): symb
+ { mk_directive_arg ~loc:$sloc $1 }
+
+/* Generic definitions */
+
+(* [iloption(X)] recognizes either nothing or [X]. Assuming [X] produces
+ an OCaml list, it produces an OCaml list, too. *)
+
+%inline iloption(X):
+ /* nothing */
+ { [] }
+| x = X
+ { x }
+
+(* [llist(X)] recognizes a possibly empty list of [X]s. It is left-recursive. *)
+
+reversed_llist(X):
+ /* empty */
+ { [] }
+| xs = reversed_llist(X) x = X
+ { x :: xs }
+
+%inline llist(X):
+ xs = rev(reversed_llist(X))
+ { xs }
+
+(* [reversed_nonempty_llist(X)] recognizes a nonempty list of [X]s, and produces
+ an OCaml list in reverse order -- that is, the last element in the input text
+ appears first in this list. Its definition is left-recursive. *)
+
+reversed_nonempty_llist(X):
+ x = X
+ { [ x ] }
+| xs = reversed_nonempty_llist(X) x = X
+ { x :: xs }
+
+(* [nonempty_llist(X)] recognizes a nonempty list of [X]s, and produces an OCaml
+ list in direct order -- that is, the first element in the input text appears
+ first in this list. *)
+
+%inline nonempty_llist(X):
+ xs = rev(reversed_nonempty_llist(X))
+ { xs }
+
+(* [reversed_nonempty_concat(X)] recognizes a nonempty sequence of [X]s (each of
+ which is a list), and produces an OCaml list of their concatenation in
+ reverse order -- that is, the last element of the last list in the input text
+ appears first in the list.
+*)
+reversed_nonempty_concat(X):
+ x = X
+ { List.rev x }
+| xs = reversed_nonempty_concat(X) x = X
+ { List.rev_append x xs }
+
+(* [nonempty_concat(X)] recognizes a nonempty sequence of [X]s
+ (each of which is a list), and produces an OCaml list of their concatenation
+ in direct order -- that is, the first element of the first list in the input
+ text appears first in the list.
+*)
+
+%inline nonempty_concat(X):
+ xs = rev(reversed_nonempty_concat(X))
+ { xs }
+
+(* [reversed_separated_nonempty_llist(separator, X)] recognizes a nonempty list
+ of [X]s, separated with [separator]s, and produces an OCaml list in reverse
+ order -- that is, the last element in the input text appears first in this
+ list. Its definition is left-recursive. *)
+
+(* [inline_reversed_separated_nonempty_llist(separator, X)] is semantically
+ equivalent to [reversed_separated_nonempty_llist(separator, X)], but is
+ marked %inline, which means that the case of a list of length one and
+ the case of a list of length more than one will be distinguished at the
+ use site, and will give rise there to two productions. This can be used
+ to avoid certain conflicts. *)
+
+%inline inline_reversed_separated_nonempty_llist(separator, X):
+ x = X
+ { [ x ] }
+| xs = reversed_separated_nonempty_llist(separator, X)
+ separator
+ x = X
+ { x :: xs }
+
+reversed_separated_nonempty_llist(separator, X):
+ xs = inline_reversed_separated_nonempty_llist(separator, X)
+ { xs }
+
+(* [separated_nonempty_llist(separator, X)] recognizes a nonempty list of [X]s,
+ separated with [separator]s, and produces an OCaml list in direct order --
+ that is, the first element in the input text appears first in this list. *)
+
+%inline separated_nonempty_llist(separator, X):
+ xs = rev(reversed_separated_nonempty_llist(separator, X))
+ { xs }
+
+%inline inline_separated_nonempty_llist(separator, X):
+ xs = rev(inline_reversed_separated_nonempty_llist(separator, X))
+ { xs }
+
+(* [reversed_separated_nontrivial_llist(separator, X)] recognizes a list of at
+ least two [X]s, separated with [separator]s, and produces an OCaml list in
+ reverse order -- that is, the last element in the input text appears first
+ in this list. Its definition is left-recursive. *)
+
+reversed_separated_nontrivial_llist(separator, X):
+ xs = reversed_separated_nontrivial_llist(separator, X)
+ separator
+ x = X
+ { x :: xs }
+| x1 = X
+ separator
+ x2 = X
+ { [ x2; x1 ] }
+
+(* [separated_nontrivial_llist(separator, X)] recognizes a list of at least
+ two [X]s, separated with [separator]s, and produces an OCaml list in direct
+ order -- that is, the first element in the input text appears first in this
+ list. *)
+
+%inline separated_nontrivial_llist(separator, X):
+ xs = rev(reversed_separated_nontrivial_llist(separator, X))
+ { xs }
+
+(* [separated_or_terminated_nonempty_list(delimiter, X)] recognizes a nonempty
+ list of [X]s, separated with [delimiter]s, and optionally terminated with a
+ final [delimiter]. Its definition is right-recursive. *)
+
+separated_or_terminated_nonempty_list(delimiter, X):
+ x = X ioption(delimiter)
+ { [x] }
+| x = X
+ delimiter
+ xs = separated_or_terminated_nonempty_list(delimiter, X)
+ { x :: xs }
+
+(* [reversed_preceded_or_separated_nonempty_llist(delimiter, X)] recognizes a
+ nonempty list of [X]s, separated with [delimiter]s, and optionally preceded
+ with a leading [delimiter]. It produces an OCaml list in reverse order. Its
+ definition is left-recursive. *)
+
+reversed_preceded_or_separated_nonempty_llist(delimiter, X):
+ ioption(delimiter) x = X
+ { [x] }
+| xs = reversed_preceded_or_separated_nonempty_llist(delimiter, X)
+ delimiter
+ x = X
+ { x :: xs }
+
+(* [preceded_or_separated_nonempty_llist(delimiter, X)] recognizes a nonempty
+ list of [X]s, separated with [delimiter]s, and optionally preceded with a
+ leading [delimiter]. It produces an OCaml list in direct order. *)
+
+%inline preceded_or_separated_nonempty_llist(delimiter, X):
+ xs = rev(reversed_preceded_or_separated_nonempty_llist(delimiter, X))
+ { xs }
+
+(* [bar_llist(X)] recognizes a nonempty list of [X]'s, separated with BARs,
+ with an optional leading BAR. We assume that [X] is itself parameterized
+ with an opening symbol, which can be [epsilon] or [BAR]. *)
+
+(* This construction may seem needlessly complicated: one might think that
+ using [preceded_or_separated_nonempty_llist(BAR, X)], where [X] is *not*
+ itself parameterized, would be sufficient. Indeed, this simpler approach
+ would recognize the same language. However, the two approaches differ in
+ the footprint of [X]. We want the start location of [X] to include [BAR]
+ when present. In the future, we might consider switching to the simpler
+ definition, at the cost of producing slightly different locations. TODO *)
+
+reversed_bar_llist(X):
+ (* An [X] without a leading BAR. *)
+ x = X(epsilon)
+ { [x] }
+ | (* An [X] with a leading BAR. *)
+ x = X(BAR)
+ { [x] }
+ | (* An initial list, followed with a BAR and an [X]. *)
+ xs = reversed_bar_llist(X)
+ x = X(BAR)
+ { x :: xs }
+
+%inline bar_llist(X):
+ xs = reversed_bar_llist(X)
+ { List.rev xs }
+
+(* [xlist(A, B)] recognizes [AB*]. We assume that the semantic value for [A]
+ is a pair [x, b], while the semantic value for [B*] is a list [bs].
+ We return the pair [x, b :: bs]. *)
+
+%inline xlist(A, B):
+ a = A bs = B*
+ { let (x, b) = a in x, b :: bs }
+
+(* [listx(delimiter, X, Y)] recognizes a nonempty list of [X]s, optionally
+ followed with a [Y], separated-or-terminated with [delimiter]s. The
+ semantic value is a pair of a list of [X]s and an optional [Y]. *)
+
+listx(delimiter, X, Y):
+| x = X ioption(delimiter)
+ { [x], None }
+| x = X delimiter y = Y delimiter?
+ { [x], Some y }
+| x = X
+ delimiter
+ tail = listx(delimiter, X, Y)
+ { let xs, y = tail in
+ x :: xs, y }
+
+(* -------------------------------------------------------------------------- *)
+
+(* Entry points. *)
+
+(* An .ml file. *)
+implementation:
+ structure EOF
+ { $1 }
+;
+
+/* BEGIN AVOID */
+(* An .mli file. *)
+interface:
+ signature EOF
+ { $1 }
+;
+/* END AVOID */
+
+(* A toplevel phrase. *)
+toplevel_phrase:
+ (* An expression with attributes, ended by a double semicolon. *)
+ extra_str(text_str(str_exp))
+ SEMISEMI
+ { Ptop_def $1 }
+| (* A list of structure items, ended by a double semicolon. *)
+ extra_str(flatten(text_str(structure_item)*))
+ SEMISEMI
+ { Ptop_def $1 }
+| (* A directive, ended by a double semicolon. *)
+ toplevel_directive
+ SEMISEMI
+ { $1 }
+| (* End of input. *)
+ EOF
+ { raise End_of_file }
+;
+
+(* An .ml file that is read by #use. *)
+use_file:
+ (* An optional standalone expression,
+ followed with a series of elements,
+ followed with EOF. *)
+ extra_def(append(
+ optional_use_file_standalone_expression,
+ flatten(use_file_element*)
+ ))
+ EOF
+ { $1 }
+;
+
+(* An optional standalone expression is just an expression with attributes
+ (str_exp), with extra wrapping. *)
+%inline optional_use_file_standalone_expression:
+ iloption(text_def(top_def(str_exp)))
+ { $1 }
+;
+
+(* An element in a #used file is one of the following:
+ - a double semicolon followed with an optional standalone expression;
+ - a structure item;
+ - a toplevel directive.
+ *)
+%inline use_file_element:
+ preceded(SEMISEMI, optional_use_file_standalone_expression)
+| text_def(top_def(structure_item))
+| text_def(mark_rhs_docs(toplevel_directive))
+ { $1 }
+;
+
+/* BEGIN AVOID */
+parse_module_type:
+ module_type EOF
+ { $1 }
+;
+
+parse_module_expr:
+ module_expr EOF
+ { $1 }
+;
+
+parse_core_type:
+ core_type EOF
+ { $1 }
+;
+
+parse_expression:
+ seq_expr EOF
+ { $1 }
+;
+
+parse_pattern:
+ pattern EOF
+ { $1 }
+;
+
+parse_mty_longident:
+ mty_longident EOF
+ { $1 }
+;
+
+parse_val_longident:
+ val_longident EOF
+ { $1 }
+;
+
+parse_constr_longident:
+ constr_longident EOF
+ { $1 }
+;
+
+parse_mod_ext_longident:
+ mod_ext_longident EOF
+ { $1 }
+;
+
+parse_mod_longident:
+ mod_longident EOF
+ { $1 }
+;
+
+parse_any_longident:
+ any_longident EOF
+ { $1 }
+;
+/* END AVOID */
+
+(* -------------------------------------------------------------------------- *)
+
+(* Functor arguments appear in module expressions and module types. *)
+
+%inline functor_args:
+ reversed_nonempty_llist(functor_arg)
+ { $1 }
+ (* Produce a reversed list on purpose;
+ later processed using [fold_left]. *)
+;
+
+functor_arg:
+ (* An anonymous and untyped argument. *)
+ LPAREN RPAREN
+ { $startpos, Unit }
+ | (* An argument accompanied with an explicit type. *)
+ LPAREN x = mkrhs(module_name) COLON mty = module_type RPAREN
+ { $startpos, Named (x, mty) }
+;
+
+module_name:
+ (* A named argument. *)
+ x = UIDENT
+ { Some x }
+ | (* An anonymous argument. *)
+ UNDERSCORE
+ { None }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Module expressions. *)
+
+(* The syntax of module expressions is not properly stratified. The cases of
+ functors, functor applications, and attributes interact and cause conflicts,
+ which are resolved by precedence declarations. This is concise but fragile.
+ Perhaps in the future an explicit stratification could be used. *)
+
+module_expr:
+ | STRUCT attrs = attributes s = structure END
+ { mkmod ~loc:$sloc ~attrs (Pmod_structure s) }
+ | STRUCT attributes structure error
+ { unclosed "struct" $loc($1) "end" $loc($4) }
+ | SIG error
+ { expecting $loc($1) "struct" }
+ | FUNCTOR attrs = attributes args = functor_args MINUSGREATER me = module_expr
+ { wrap_mod_attrs ~loc:$sloc attrs (
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmod ~loc:(startpos, $endpos) (Pmod_functor (arg, acc))
+ ) me args
+ ) }
+ | me = paren_module_expr
+ { me }
+ | me = module_expr attr = attribute
+ { Mod.attr me attr }
+ | mkmod(
+ (* A module identifier. *)
+ x = mkrhs(mod_longident)
+ { Pmod_ident x }
+ | (* In a functor application, the actual argument must be parenthesized. *)
+ me1 = module_expr me2 = paren_module_expr
+ { Pmod_apply(me1, me2) }
+ | (* Functor applied to unit. *)
+ me = module_expr LPAREN RPAREN
+ { Pmod_apply_unit me }
+ | (* An extension. *)
+ ex = extension
+ { Pmod_extension ex }
+ )
+ { $1 }
+;
+
+(* A parenthesized module expression is a module expression that begins
+ and ends with parentheses. *)
+
+paren_module_expr:
+ (* A module expression annotated with a module type. *)
+ LPAREN me = module_expr COLON mty = module_type RPAREN
+ { mkmod ~loc:$sloc (Pmod_constraint(me, mty)) }
+ | LPAREN module_expr COLON module_type error
+ { unclosed "(" $loc($1) ")" $loc($5) }
+ | (* A module expression within parentheses. *)
+ LPAREN me = module_expr RPAREN
+ { me (* TODO consider reloc *) }
+ | LPAREN module_expr error
+ { unclosed "(" $loc($1) ")" $loc($3) }
+ | (* A core language expression that produces a first-class module.
+ This expression can be annotated in various ways. *)
+ LPAREN VAL attrs = attributes e = expr_colon_package_type RPAREN
+ { mkmod ~loc:$sloc ~attrs (Pmod_unpack e) }
+ | LPAREN VAL attributes expr COLON error
+ { unclosed "(" $loc($1) ")" $loc($6) }
+ | LPAREN VAL attributes expr COLONGREATER error
+ { unclosed "(" $loc($1) ")" $loc($6) }
+ | LPAREN VAL attributes expr error
+ { unclosed "(" $loc($1) ")" $loc($5) }
+;
+
+(* The various ways of annotating a core language expression that
+ produces a first-class module that we wish to unpack. *)
+%inline expr_colon_package_type:
+ e = expr
+ { e }
+ | e = expr COLON ty = package_type
+ { ghexp ~loc:$loc (Pexp_constraint (e, ty)) }
+ | e = expr COLON ty1 = package_type COLONGREATER ty2 = package_type
+ { ghexp ~loc:$loc (Pexp_coerce (e, Some ty1, ty2)) }
+ | e = expr COLONGREATER ty2 = package_type
+ { ghexp ~loc:$loc (Pexp_coerce (e, None, ty2)) }
+;
+
+(* A structure, which appears between STRUCT and END (among other places),
+ begins with an optional standalone expression, and continues with a list
+ of structure elements. *)
+structure:
+ extra_str(append(
+ optional_structure_standalone_expression,
+ flatten(structure_element*)
+ ))
+ { $1 }
+;
+
+(* An optional standalone expression is just an expression with attributes
+ (str_exp), with extra wrapping. *)
+%inline optional_structure_standalone_expression:
+ items = iloption(mark_rhs_docs(text_str(str_exp)))
+ { items }
+;
+
+(* An expression with attributes, wrapped as a structure item. *)
+%inline str_exp:
+ e = seq_expr
+ attrs = post_item_attributes
+ { mkstrexp e attrs }
+;
+
+(* A structure element is one of the following:
+ - a double semicolon followed with an optional standalone expression;
+ - a structure item. *)
+%inline structure_element:
+ append(text_str_SEMISEMI, optional_structure_standalone_expression)
+ | text_str(structure_item)
+ { $1 }
+;
+
+(* A structure item. *)
+structure_item:
+ let_bindings(ext)
+ { val_of_let_bindings ~loc:$sloc $1 }
+ | mkstr(
+ item_extension post_item_attributes
+ { let docs = symbol_docs $sloc in
+ Pstr_extension ($1, add_docs_attrs docs $2) }
+ | floating_attribute
+ { Pstr_attribute $1 }
+ )
+ | wrap_mkstr_ext(
+ primitive_declaration
+ { pstr_primitive $1 }
+ | value_description
+ { pstr_primitive $1 }
+ | type_declarations
+ { pstr_type $1 }
+ | str_type_extension
+ { pstr_typext $1 }
+ | str_exception_declaration
+ { pstr_exception $1 }
+ | module_binding
+ { $1 }
+ | rec_module_bindings
+ { pstr_recmodule $1 }
+ | module_type_declaration
+ { let (body, ext) = $1 in (Pstr_modtype body, ext) }
+ | open_declaration
+ { let (body, ext) = $1 in (Pstr_open body, ext) }
+ | class_declarations
+ { let (ext, l) = $1 in (Pstr_class l, ext) }
+ | class_type_declarations
+ { let (ext, l) = $1 in (Pstr_class_type l, ext) }
+ | include_statement(module_expr)
+ { pstr_include $1 }
+ )
+ { $1 }
+;
+
+(* A single module binding. *)
+%inline module_binding:
+ MODULE
+ ext = ext attrs1 = attributes
+ name = mkrhs(module_name)
+ body = module_binding_body
+ attrs2 = post_item_attributes
+ { let docs = symbol_docs $sloc in
+ let loc = make_loc $sloc in
+ let attrs = attrs1 @ attrs2 in
+ let body = Mb.mk name body ~attrs ~loc ~docs in
+ Pstr_module body, ext }
+;
+
+(* The body (right-hand side) of a module binding. *)
+module_binding_body:
+ EQUAL me = module_expr
+ { me }
+ | COLON error
+ { expecting $loc($1) "=" }
+ | mkmod(
+ COLON mty = module_type EQUAL me = module_expr
+ { Pmod_constraint(me, mty) }
+ | arg_and_pos = functor_arg body = module_binding_body
+ { let (_, arg) = arg_and_pos in
+ Pmod_functor(arg, body) }
+ ) { $1 }
+;
+
+(* A group of recursive module bindings. *)
+%inline rec_module_bindings:
+ xlist(rec_module_binding, and_module_binding)
+ { $1 }
+;
+
+(* The first binding in a group of recursive module bindings. *)
+%inline rec_module_binding:
+ MODULE
+ ext = ext
+ attrs1 = attributes
+ REC
+ name = mkrhs(module_name)
+ body = module_binding_body
+ attrs2 = post_item_attributes
+ {
+ let loc = make_loc $sloc in
+ let attrs = attrs1 @ attrs2 in
+ let docs = symbol_docs $sloc in
+ ext,
+ Mb.mk name body ~attrs ~loc ~docs
+ }
+;
+
+(* The following bindings in a group of recursive module bindings. *)
+%inline and_module_binding:
+ AND
+ attrs1 = attributes
+ name = mkrhs(module_name)
+ body = module_binding_body
+ attrs2 = post_item_attributes
+ {
+ let loc = make_loc $sloc in
+ let attrs = attrs1 @ attrs2 in
+ let docs = symbol_docs $sloc in
+ let text = symbol_text $symbolstartpos in
+ Mb.mk name body ~attrs ~loc ~text ~docs
+ }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Shared material between structures and signatures. *)
+
+(* An [include] statement can appear in a structure or in a signature,
+ which is why this definition is parameterized. *)
+%inline include_statement(thing):
+ INCLUDE
+ ext = ext
+ attrs1 = attributes
+ thing = thing
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Incl.mk thing ~attrs ~loc ~docs, ext
+ }
+;
+
+(* A module type declaration. *)
+module_type_declaration:
+ MODULE TYPE
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(ident)
+ typ = preceded(EQUAL, module_type)?
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Mtd.mk id ?typ ~attrs ~loc ~docs, ext
+ }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Opens. *)
+
+open_declaration:
+ OPEN
+ override = override_flag
+ ext = ext
+ attrs1 = attributes
+ me = module_expr
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Opn.mk me ~override ~attrs ~loc ~docs, ext
+ }
+;
+
+open_description:
+ OPEN
+ override = override_flag
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(mod_ext_longident)
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Opn.mk id ~override ~attrs ~loc ~docs, ext
+ }
+;
+
+%inline open_dot_declaration: mkrhs(mod_longident)
+ { let loc = make_loc $loc($1) in
+ let me = Mod.ident ~loc $1 in
+ Opn.mk ~loc me }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+/* Module types */
+
+module_type:
+ | SIG attrs = attributes s = signature END
+ { mkmty ~loc:$sloc ~attrs (Pmty_signature s) }
+ | SIG attributes signature error
+ { unclosed "sig" $loc($1) "end" $loc($4) }
+ | STRUCT error
+ { expecting $loc($1) "sig" }
+ | FUNCTOR attrs = attributes args = functor_args
+ MINUSGREATER mty = module_type
+ %prec below_WITH
+ { wrap_mty_attrs ~loc:$sloc attrs (mk_functor_typ args mty) }
+ | args = functor_args
+ MINUSGREATER mty = module_type
+ %prec below_WITH
+ { mk_functor_typ args mty }
+ | MODULE TYPE OF attributes module_expr %prec below_LBRACKETAT
+ { mkmty ~loc:$sloc ~attrs:$4 (Pmty_typeof $5) }
+ | LPAREN module_type RPAREN
+ { $2 }
+ | LPAREN module_type error
+ { unclosed "(" $loc($1) ")" $loc($3) }
+ | module_type attribute
+ { Mty.attr $1 $2 }
+ | mkmty(
+ mkrhs(mty_longident)
+ { Pmty_ident $1 }
+ | module_type MINUSGREATER module_type
+ %prec below_WITH
+ { Pmty_functor(Named (mknoloc None, $1), $3) }
+ | module_type WITH separated_nonempty_llist(AND, with_constraint)
+ { Pmty_with($1, $3) }
+/* | LPAREN MODULE mkrhs(mod_longident) RPAREN
+ { Pmty_alias $3 } */
+ | extension
+ { Pmty_extension $1 }
+ )
+ { $1 }
+;
+(* A signature, which appears between SIG and END (among other places),
+ is a list of signature elements. *)
+signature:
+ extra_sig(flatten(signature_element*))
+ { $1 }
+;
+
+(* A signature element is one of the following:
+ - a double semicolon;
+ - a signature item. *)
+%inline signature_element:
+ text_sig_SEMISEMI
+ | text_sig(signature_item)
+ { $1 }
+;
+
+(* A signature item. *)
+signature_item:
+ | item_extension post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mksig ~loc:$sloc (Psig_extension ($1, (add_docs_attrs docs $2))) }
+ | mksig(
+ floating_attribute
+ { Psig_attribute $1 }
+ )
+ { $1 }
+ | wrap_mksig_ext(
+ value_description
+ { psig_value $1 }
+ | primitive_declaration
+ { psig_value $1 }
+ | type_declarations
+ { psig_type $1 }
+ | type_subst_declarations
+ { psig_typesubst $1 }
+ | sig_type_extension
+ { psig_typext $1 }
+ | sig_exception_declaration
+ { psig_exception $1 }
+ | module_declaration
+ { let (body, ext) = $1 in (Psig_module body, ext) }
+ | module_alias
+ { let (body, ext) = $1 in (Psig_module body, ext) }
+ | module_subst
+ { let (body, ext) = $1 in (Psig_modsubst body, ext) }
+ | rec_module_declarations
+ { let (ext, l) = $1 in (Psig_recmodule l, ext) }
+ | module_type_declaration
+ { let (body, ext) = $1 in (Psig_modtype body, ext) }
+ | module_type_subst
+ { let (body, ext) = $1 in (Psig_modtypesubst body, ext) }
+ | open_description
+ { let (body, ext) = $1 in (Psig_open body, ext) }
+ | include_statement(module_type)
+ { psig_include $1 }
+ | class_descriptions
+ { let (ext, l) = $1 in (Psig_class l, ext) }
+ | class_type_declarations
+ { let (ext, l) = $1 in (Psig_class_type l, ext) }
+ )
+ { $1 }
+
+(* A module declaration. *)
+%inline module_declaration:
+ MODULE
+ ext = ext attrs1 = attributes
+ name = mkrhs(module_name)
+ body = module_declaration_body
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Md.mk name body ~attrs ~loc ~docs, ext
+ }
+;
+
+(* The body (right-hand side) of a module declaration. *)
+module_declaration_body:
+ COLON mty = module_type
+ { mty }
+ | EQUAL error
+ { expecting $loc($1) ":" }
+ | mkmty(
+ arg_and_pos = functor_arg body = module_declaration_body
+ { let (_, arg) = arg_and_pos in
+ Pmty_functor(arg, body) }
+ )
+ { $1 }
+;
+
+(* A module alias declaration (in a signature). *)
+%inline module_alias:
+ MODULE
+ ext = ext attrs1 = attributes
+ name = mkrhs(module_name)
+ EQUAL
+ body = module_expr_alias
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Md.mk name body ~attrs ~loc ~docs, ext
+ }
+;
+%inline module_expr_alias:
+ id = mkrhs(mod_longident)
+ { Mty.alias ~loc:(make_loc $sloc) id }
+;
+(* A module substitution (in a signature). *)
+module_subst:
+ MODULE
+ ext = ext attrs1 = attributes
+ uid = mkrhs(UIDENT)
+ COLONEQUAL
+ body = mkrhs(mod_ext_longident)
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Ms.mk uid body ~attrs ~loc ~docs, ext
+ }
+| MODULE ext attributes mkrhs(UIDENT) COLONEQUAL error
+ { expecting $loc($6) "module path" }
+;
+
+(* A group of recursive module declarations. *)
+%inline rec_module_declarations:
+ xlist(rec_module_declaration, and_module_declaration)
+ { $1 }
+;
+%inline rec_module_declaration:
+ MODULE
+ ext = ext
+ attrs1 = attributes
+ REC
+ name = mkrhs(module_name)
+ COLON
+ mty = module_type
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ ext, Md.mk name mty ~attrs ~loc ~docs
+ }
+;
+%inline and_module_declaration:
+ AND
+ attrs1 = attributes
+ name = mkrhs(module_name)
+ COLON
+ mty = module_type
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let docs = symbol_docs $sloc in
+ let loc = make_loc $sloc in
+ let text = symbol_text $symbolstartpos in
+ Md.mk name mty ~attrs ~loc ~text ~docs
+ }
+;
+
+(* A module type substitution *)
+module_type_subst:
+ MODULE TYPE
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(ident)
+ COLONEQUAL
+ typ=module_type
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Mtd.mk id ~typ ~attrs ~loc ~docs, ext
+ }
+
+
+(* -------------------------------------------------------------------------- *)
+
+(* Class declarations. *)
+
+%inline class_declarations:
+ xlist(class_declaration, and_class_declaration)
+ { $1 }
+;
+%inline class_declaration:
+ CLASS
+ ext = ext
+ attrs1 = attributes
+ virt = virtual_flag
+ params = formal_class_parameters
+ id = mkrhs(LIDENT)
+ body = class_fun_binding
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ ext,
+ Ci.mk id body ~virt ~params ~attrs ~loc ~docs
+ }
+;
+%inline and_class_declaration:
+ AND
+ attrs1 = attributes
+ virt = virtual_flag
+ params = formal_class_parameters
+ id = mkrhs(LIDENT)
+ body = class_fun_binding
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ let text = symbol_text $symbolstartpos in
+ Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
+ }
+;
+
+class_fun_binding:
+ EQUAL class_expr
+ { $2 }
+ | mkclass(
+ COLON class_type EQUAL class_expr
+ { Pcl_constraint($4, $2) }
+ | labeled_simple_pattern class_fun_binding
+ { let (l,o,p) = $1 in Pcl_fun(l, o, p, $2) }
+ ) { $1 }
+;
+
+formal_class_parameters:
+ params = class_parameters(type_parameter)
+ { params }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Class expressions. *)
+
+class_expr:
+ class_simple_expr
+ { $1 }
+ | FUN attributes class_fun_def
+ { wrap_class_attrs ~loc:$sloc $3 $2 }
+ | let_bindings(no_ext) IN class_expr
+ { class_of_let_bindings ~loc:$sloc $1 $3 }
+ | LET OPEN override_flag attributes mkrhs(mod_longident) IN class_expr
+ { let loc = ($startpos($2), $endpos($5)) in
+ let od = Opn.mk ~override:$3 ~loc:(make_loc loc) $5 in
+ mkclass ~loc:$sloc ~attrs:$4 (Pcl_open(od, $7)) }
+ | class_expr attribute
+ { Cl.attr $1 $2 }
+ | mkclass(
+ class_simple_expr nonempty_llist(labeled_simple_expr)
+ { Pcl_apply($1, $2) }
+ | extension
+ { Pcl_extension $1 }
+ ) { $1 }
+;
+class_simple_expr:
+ | LPAREN class_expr RPAREN
+ { $2 }
+ | LPAREN class_expr error
+ { unclosed "(" $loc($1) ")" $loc($3) }
+ | mkclass(
+ tys = actual_class_parameters cid = mkrhs(class_longident)
+ { Pcl_constr(cid, tys) }
+ | OBJECT attributes class_structure error
+ { unclosed "object" $loc($1) "end" $loc($4) }
+ | LPAREN class_expr COLON class_type RPAREN
+ { Pcl_constraint($2, $4) }
+ | LPAREN class_expr COLON class_type error
+ { unclosed "(" $loc($1) ")" $loc($5) }
+ ) { $1 }
+ | OBJECT attributes class_structure END
+ { mkclass ~loc:$sloc ~attrs:$2 (Pcl_structure $3) }
+;
+
+class_fun_def:
+ mkclass(
+ labeled_simple_pattern MINUSGREATER e = class_expr
+ | labeled_simple_pattern e = class_fun_def
+ { let (l,o,p) = $1 in Pcl_fun(l, o, p, e) }
+ ) { $1 }
+;
+%inline class_structure:
+ | class_self_pattern extra_cstr(class_fields)
+ { Cstr.mk $1 $2 }
+;
+class_self_pattern:
+ LPAREN pattern RPAREN
+ { reloc_pat ~loc:$sloc $2 }
+ | mkpat(LPAREN pattern COLON core_type RPAREN
+ { Ppat_constraint($2, $4) })
+ { $1 }
+ | /* empty */
+ { ghpat ~loc:$sloc Ppat_any }
+;
+%inline class_fields:
+ flatten(text_cstr(class_field)*)
+ { $1 }
+;
+class_field:
+ | INHERIT override_flag attributes class_expr
+ self = preceded(AS, mkrhs(LIDENT))?
+ post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkcf ~loc:$sloc (Pcf_inherit ($2, $4, self)) ~attrs:($3@$6) ~docs }
+ | VAL value post_item_attributes
+ { let v, attrs = $2 in
+ let docs = symbol_docs $sloc in
+ mkcf ~loc:$sloc (Pcf_val v) ~attrs:(attrs@$3) ~docs }
+ | METHOD method_ post_item_attributes
+ { let meth, attrs = $2 in
+ let docs = symbol_docs $sloc in
+ mkcf ~loc:$sloc (Pcf_method meth) ~attrs:(attrs@$3) ~docs }
+ | CONSTRAINT attributes constrain_field post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkcf ~loc:$sloc (Pcf_constraint $3) ~attrs:($2@$4) ~docs }
+ | INITIALIZER attributes seq_expr post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkcf ~loc:$sloc (Pcf_initializer $3) ~attrs:($2@$4) ~docs }
+ | item_extension post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkcf ~loc:$sloc (Pcf_extension $1) ~attrs:$2 ~docs }
+ | mkcf(floating_attribute
+ { Pcf_attribute $1 })
+ { $1 }
+;
+value:
+ no_override_flag
+ attrs = attributes
+ mutable_ = virtual_with_mutable_flag
+ label = mkrhs(label) COLON ty = core_type
+ { (label, mutable_, Cfk_virtual ty), attrs }
+ | override_flag attributes mutable_flag mkrhs(label) EQUAL seq_expr
+ { ($4, $3, Cfk_concrete ($1, $6)), $2 }
+ | override_flag attributes mutable_flag mkrhs(label) type_constraint
+ EQUAL seq_expr
+ { let e = mkexp_constraint ~loc:$sloc $7 $5 in
+ ($4, $3, Cfk_concrete ($1, e)), $2
+ }
+;
+method_:
+ no_override_flag
+ attrs = attributes
+ private_ = virtual_with_private_flag
+ label = mkrhs(label) COLON ty = poly_type
+ { (label, private_, Cfk_virtual ty), attrs }
+ | override_flag attributes private_flag mkrhs(label) strict_binding
+ { let e = $5 in
+ let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
+ ($4, $3,
+ Cfk_concrete ($1, ghexp ~loc (Pexp_poly (e, None)))), $2 }
+ | override_flag attributes private_flag mkrhs(label)
+ COLON poly_type EQUAL seq_expr
+ { let poly_exp =
+ let loc = ($startpos($6), $endpos($8)) in
+ ghexp ~loc (Pexp_poly($8, Some $6)) in
+ ($4, $3, Cfk_concrete ($1, poly_exp)), $2 }
+ | override_flag attributes private_flag mkrhs(label) COLON TYPE lident_list
+ DOT core_type EQUAL seq_expr
+ { let poly_exp_loc = ($startpos($7), $endpos($11)) in
+ let poly_exp =
+ let exp, poly =
+ (* it seems odd to use the global ~loc here while poly_exp_loc
+ is tighter, but this is what ocamlyacc does;
+ TODO improve parser.mly *)
+ wrap_type_annotation ~loc:$sloc $7 $9 $11 in
+ ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
+ ($4, $3,
+ Cfk_concrete ($1, poly_exp)), $2 }
+;
+
+/* Class types */
+
+class_type:
+ class_signature
+ { $1 }
+ | mkcty(
+ label = arg_label
+ domain = tuple_type
+ MINUSGREATER
+ codomain = class_type
+ { Pcty_arrow(label, domain, codomain) }
+ ) { $1 }
+ ;
+class_signature:
+ mkcty(
+ tys = actual_class_parameters cid = mkrhs(clty_longident)
+ { Pcty_constr (cid, tys) }
+ | extension
+ { Pcty_extension $1 }
+ ) { $1 }
+ | OBJECT attributes class_sig_body END
+ { mkcty ~loc:$sloc ~attrs:$2 (Pcty_signature $3) }
+ | OBJECT attributes class_sig_body error
+ { unclosed "object" $loc($1) "end" $loc($4) }
+ | class_signature attribute
+ { Cty.attr $1 $2 }
+ | LET OPEN override_flag attributes mkrhs(mod_longident) IN class_signature
+ { let loc = ($startpos($2), $endpos($5)) in
+ let od = Opn.mk ~override:$3 ~loc:(make_loc loc) $5 in
+ mkcty ~loc:$sloc ~attrs:$4 (Pcty_open(od, $7)) }
+;
+%inline class_parameters(parameter):
+ | /* empty */
+ { [] }
+ | LBRACKET params = separated_nonempty_llist(COMMA, parameter) RBRACKET
+ { params }
+;
+%inline actual_class_parameters:
+ tys = class_parameters(core_type)
+ { tys }
+;
+%inline class_sig_body:
+ class_self_type extra_csig(class_sig_fields)
+ { Csig.mk $1 $2 }
+;
+class_self_type:
+ LPAREN core_type RPAREN
+ { $2 }
+ | mktyp((* empty *) { Ptyp_any })
+ { $1 }
+;
+%inline class_sig_fields:
+ flatten(text_csig(class_sig_field)*)
+ { $1 }
+;
+class_sig_field:
+ INHERIT attributes class_signature post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkctf ~loc:$sloc (Pctf_inherit $3) ~attrs:($2@$4) ~docs }
+ | VAL attributes value_type post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkctf ~loc:$sloc (Pctf_val $3) ~attrs:($2@$4) ~docs }
+ | METHOD attributes private_virtual_flags mkrhs(label) COLON poly_type
+ post_item_attributes
+ { let (p, v) = $3 in
+ let docs = symbol_docs $sloc in
+ mkctf ~loc:$sloc (Pctf_method ($4, p, v, $6)) ~attrs:($2@$7) ~docs }
+ | CONSTRAINT attributes constrain_field post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkctf ~loc:$sloc (Pctf_constraint $3) ~attrs:($2@$4) ~docs }
+ | item_extension post_item_attributes
+ { let docs = symbol_docs $sloc in
+ mkctf ~loc:$sloc (Pctf_extension $1) ~attrs:$2 ~docs }
+ | mkctf(floating_attribute
+ { Pctf_attribute $1 })
+ { $1 }
+;
+%inline value_type:
+ flags = mutable_virtual_flags
+ label = mkrhs(label)
+ COLON
+ ty = core_type
+ {
+ let mut, virt = flags in
+ label, mut, virt, ty
+ }
+;
+%inline constrain:
+ core_type EQUAL core_type
+ { $1, $3, make_loc $sloc }
+;
+constrain_field:
+ core_type EQUAL core_type
+ { $1, $3 }
+;
+(* A group of class descriptions. *)
+%inline class_descriptions:
+ xlist(class_description, and_class_description)
+ { $1 }
+;
+%inline class_description:
+ CLASS
+ ext = ext
+ attrs1 = attributes
+ virt = virtual_flag
+ params = formal_class_parameters
+ id = mkrhs(LIDENT)
+ COLON
+ cty = class_type
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ ext,
+ Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
+ }
+;
+%inline and_class_description:
+ AND
+ attrs1 = attributes
+ virt = virtual_flag
+ params = formal_class_parameters
+ id = mkrhs(LIDENT)
+ COLON
+ cty = class_type
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ let text = symbol_text $symbolstartpos in
+ Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
+ }
+;
+class_type_declarations:
+ xlist(class_type_declaration, and_class_type_declaration)
+ { $1 }
+;
+%inline class_type_declaration:
+ CLASS TYPE
+ ext = ext
+ attrs1 = attributes
+ virt = virtual_flag
+ params = formal_class_parameters
+ id = mkrhs(LIDENT)
+ EQUAL
+ csig = class_signature
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ ext,
+ Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
+ }
+;
+%inline and_class_type_declaration:
+ AND
+ attrs1 = attributes
+ virt = virtual_flag
+ params = formal_class_parameters
+ id = mkrhs(LIDENT)
+ EQUAL
+ csig = class_signature
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ let text = symbol_text $symbolstartpos in
+ Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
+ }
+;
+
+/* Core expressions */
+
+%inline or_function(EXPR):
+ | EXPR
+ { $1 }
+ | FUNCTION ext_attributes match_cases
+ { let loc = make_loc $sloc in
+ let cases = $3 in
+ (* There are two choices of where to put attributes: on the
+ Pexp_function node; on the Pfunction_cases body. We put them on the
+ Pexp_function node here because the compiler only uses
+ Pfunction_cases attributes for enabling/disabling warnings in
+ typechecking. For standalone function cases, we want the compiler to
+ respect, e.g., [@inline] attributes.
+ *)
+ let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
+ mkexp_attrs ~loc:$sloc desc $2
+ }
+;
+
+(* [fun_seq_expr] (and [fun_expr]) are legal expression bodies of a function.
+ [seq_expr] (and [expr]) are expressions that appear in other contexts
+ (e.g. subexpressions of the expression body of a function).
+
+ [fun_seq_expr] can't be a bare [function _ -> ...]. [seq_expr] can.
+
+ This distinction exists because [function _ -> ...] is parsed as a *function
+ cases* body of a function, not an expression body. This so functions can be
+ parsed with the intended arity.
+*)
+fun_seq_expr:
+ | fun_expr %prec below_SEMI { $1 }
+ | fun_expr SEMI { $1 }
+ | mkexp(fun_expr SEMI seq_expr
+ { Pexp_sequence($1, $3) })
+ { $1 }
+ | fun_expr SEMI PERCENT attr_id seq_expr
+ { let seq = mkexp ~loc:$sloc (Pexp_sequence ($1, $5)) in
+ let payload = PStr [mkstrexp seq []] in
+ mkexp ~loc:$sloc (Pexp_extension ($4, payload)) }
+;
+seq_expr:
+ | or_function(fun_seq_expr) { $1 }
+;
+labeled_simple_pattern:
+ QUESTION LPAREN label_let_pattern opt_default RPAREN
+ { (Optional (fst $3), $4, snd $3) }
+ | QUESTION label_var
+ { (Optional (fst $2), None, snd $2) }
+ | OPTLABEL LPAREN let_pattern opt_default RPAREN
+ { (Optional $1, $4, $3) }
+ | OPTLABEL pattern_var
+ { (Optional $1, None, $2) }
+ | TILDE LPAREN label_let_pattern RPAREN
+ { (Labelled (fst $3), None, snd $3) }
+ | TILDE label_var
+ { (Labelled (fst $2), None, snd $2) }
+ | LABEL simple_pattern
+ { (Labelled $1, None, $2) }
+ | simple_pattern
+ { (Nolabel, None, $1) }
+;
+
+pattern_var:
+ mkpat(
+ mkrhs(LIDENT) { Ppat_var $1 }
+ | UNDERSCORE { Ppat_any }
+ ) { $1 }
+;
+
+%inline opt_default:
+ preceded(EQUAL, seq_expr)?
+ { $1 }
+;
+label_let_pattern:
+ x = label_var
+ { x }
+ | x = label_var COLON cty = core_type
+ { let lab, pat = x in
+ lab,
+ mkpat ~loc:$sloc (Ppat_constraint (pat, cty)) }
+;
+%inline label_var:
+ mkrhs(LIDENT)
+ { ($1.Location.txt, mkpat ~loc:$sloc (Ppat_var $1)) }
+;
+let_pattern:
+ pattern
+ { $1 }
+ | mkpat(pattern COLON core_type
+ { Ppat_constraint($1, $3) })
+ { $1 }
+;
+
+%inline indexop_expr(dot, index, right):
+ | array=simple_expr d=dot LPAREN i=index RPAREN r=right
+ { array, d, Paren, i, r }
+ | array=simple_expr d=dot LBRACE i=index RBRACE r=right
+ { array, d, Brace, i, r }
+ | array=simple_expr d=dot LBRACKET i=index RBRACKET r=right
+ { array, d, Bracket, i, r }
+;
+
+%inline indexop_error(dot, index):
+ | simple_expr dot _p=LPAREN index _e=error
+ { indexop_unclosed_error $loc(_p) Paren $loc(_e) }
+ | simple_expr dot _p=LBRACE index _e=error
+ { indexop_unclosed_error $loc(_p) Brace $loc(_e) }
+ | simple_expr dot _p=LBRACKET index _e=error
+ { indexop_unclosed_error $loc(_p) Bracket $loc(_e) }
+;
+
+%inline qualified_dotop: ioption(DOT mod_longident {$2}) DOTOP { $1, $2 };
+
+fun_expr:
+ simple_expr %prec below_HASH
+ { $1 }
+ | fun_expr_attrs
+ { let desc, attrs = $1 in
+ mkexp_attrs ~loc:$sloc desc attrs }
+ | mkexp(expr_)
+ { $1 }
+ | let_bindings(ext) IN seq_expr
+ { expr_of_let_bindings ~loc:$sloc $1 $3 }
+ | pbop_op = mkrhs(LETOP) bindings = letop_bindings IN body = seq_expr
+ { let (pbop_pat, pbop_exp, rev_ands) = bindings in
+ let ands = List.rev rev_ands in
+ let pbop_loc = make_loc $sloc in
+ let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
+ mkexp ~loc:$sloc (Pexp_letop{ let_; ands; body}) }
+ | fun_expr COLONCOLON expr
+ { mkexp_cons ~loc:$sloc $loc($2) (ghexp ~loc:$sloc (Pexp_tuple[$1;$3])) }
+ | mkrhs(label) LESSMINUS expr
+ { mkexp ~loc:$sloc (Pexp_setinstvar($1, $3)) }
+ | simple_expr DOT mkrhs(label_longident) LESSMINUS expr
+ { mkexp ~loc:$sloc (Pexp_setfield($1, $3, $5)) }
+ | indexop_expr(DOT, seq_expr, LESSMINUS v=expr {Some v})
+ { mk_indexop_expr builtin_indexing_operators ~loc:$sloc $1 }
+ | indexop_expr(qualified_dotop, expr_semi_list, LESSMINUS v=expr {Some v})
+ { mk_indexop_expr user_indexing_operators ~loc:$sloc $1 }
+ | fun_expr attribute
+ { Exp.attr $1 $2 }
+/* BEGIN AVOID */
+ | UNDERSCORE
+ { not_expecting $loc($1) "wildcard \"_\"" }
+/* END AVOID */
+;
+%inline expr:
+ | or_function(fun_expr) { $1 }
+;
+%inline fun_expr_attrs:
+ | LET MODULE ext_attributes mkrhs(module_name) module_binding_body IN seq_expr
+ { Pexp_letmodule($4, $5, $7), $3 }
+ | LET EXCEPTION ext_attributes let_exception_declaration IN seq_expr
+ { Pexp_letexception($4, $6), $3 }
+ | LET OPEN override_flag ext_attributes module_expr IN seq_expr
+ { let open_loc = make_loc ($startpos($2), $endpos($5)) in
+ let od = Opn.mk $5 ~override:$3 ~loc:open_loc in
+ Pexp_open(od, $7), $4 }
+ /* Cf #5939: we used to accept (fun p when e0 -> e) */
+ | FUN ext_attributes fun_params preceded(COLON, atomic_type)?
+ MINUSGREATER fun_body
+ { let body_constraint = Option.map (fun x -> Pconstraint x) $4 in
+ mkfunction $3 body_constraint $6, $2
+ }
+ | MATCH ext_attributes seq_expr WITH match_cases
+ { Pexp_match($3, $5), $2 }
+ | TRY ext_attributes seq_expr WITH match_cases
+ { Pexp_try($3, $5), $2 }
+ | TRY ext_attributes seq_expr WITH error
+ { syntax_error() }
+ | IF ext_attributes seq_expr THEN expr ELSE expr
+ { Pexp_ifthenelse($3, $5, Some $7), $2 }
+ | IF ext_attributes seq_expr THEN expr
+ { Pexp_ifthenelse($3, $5, None), $2 }
+ | WHILE ext_attributes seq_expr do_done_expr
+ { Pexp_while($3, $4), $2 }
+ | FOR ext_attributes pattern EQUAL seq_expr direction_flag seq_expr
+ do_done_expr
+ { Pexp_for($3, $5, $7, $6, $8), $2 }
+ | ASSERT ext_attributes simple_expr %prec below_HASH
+ { Pexp_assert $3, $2 }
+ | LAZY ext_attributes simple_expr %prec below_HASH
+ { Pexp_lazy $3, $2 }
+;
+%inline do_done_expr:
+ | DO e = seq_expr DONE
+ { e }
+ | DO seq_expr error
+ { unclosed "do" $loc($1) "done" $loc($2) }
+;
+%inline expr_:
+ | simple_expr nonempty_llist(labeled_simple_expr)
+ { Pexp_apply($1, $2) }
+ | expr_comma_list %prec below_COMMA
+ { Pexp_tuple($1) }
+ | mkrhs(constr_longident) simple_expr %prec below_HASH
+ { Pexp_construct($1, Some $2) }
+ | name_tag simple_expr %prec below_HASH
+ { Pexp_variant($1, Some $2) }
+ | e1 = fun_expr op = op(infix_operator) e2 = expr
+ { mkinfix e1 op e2 }
+ | subtractive expr %prec prec_unary_minus
+ { mkuminus ~sloc:$sloc ~oploc:$loc($1) $1 $2 }
+ | additive expr %prec prec_unary_plus
+ { mkuplus ~sloc:$sloc ~oploc:$loc($1) $1 $2 }
+;
+
+simple_expr:
+ | LPAREN seq_expr RPAREN
+ { reloc_exp ~loc:$sloc $2 }
+ | LPAREN seq_expr error
+ { unclosed "(" $loc($1) ")" $loc($3) }
+ | LPAREN seq_expr type_constraint RPAREN
+ { mkexp_constraint ~loc:$sloc $2 $3 }
+ | indexop_expr(DOT, seq_expr, { None })
+ { mk_indexop_expr builtin_indexing_operators ~loc:$sloc $1 }
+ | indexop_expr(qualified_dotop, expr_semi_list, { None })
+ { mk_indexop_expr user_indexing_operators ~loc:$sloc $1 }
+ | indexop_error (DOT, seq_expr) { $1 }
+ | indexop_error (qualified_dotop, expr_semi_list) { $1 }
+ | metaocaml_expr { $1 }
+ | simple_expr_attrs
+ { let desc, attrs = $1 in
+ mkexp_attrs ~loc:$sloc desc attrs }
+ | mkexp(simple_expr_)
+ { $1 }
+;
+%inline simple_expr_attrs:
+ | BEGIN ext = ext attrs = attributes e = seq_expr END
+ { e.pexp_desc, (ext, attrs @ e.pexp_attributes) }
+ | BEGIN ext_attributes END
+ { Pexp_construct (mkloc (Lident "()") (make_loc $sloc), None), $2 }
+ | BEGIN ext_attributes seq_expr error
+ { unclosed "begin" $loc($1) "end" $loc($4) }
+ | NEW ext_attributes mkrhs(class_longident)
+ { Pexp_new($3), $2 }
+ | LPAREN MODULE ext_attributes module_expr RPAREN
+ { Pexp_pack $4, $3 }
+ | LPAREN MODULE ext_attributes module_expr COLON package_type RPAREN
+ { Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $4), $6), $3 }
+ | LPAREN MODULE ext_attributes module_expr COLON error
+ { unclosed "(" $loc($1) ")" $loc($6) }
+ | OBJECT ext_attributes class_structure END
+ { Pexp_object $3, $2 }
+ | OBJECT ext_attributes class_structure error
+ { unclosed "object" $loc($1) "end" $loc($4) }
+;
+
+(* We include this parsing rule from the BER-MetaOCaml patchset
+ (see https://okmij.org/ftp/ML/MetaOCaml.html)
+ even though the lexer does *not* include any lexing rule
+ for the METAOCAML_* tokens, so they
+ will never be produced by the upstream compiler.
+
+ The intention of this dead parsing rule is purely to ease the
+ future maintenance work on MetaOCaml.
+*)
+%inline metaocaml_expr:
+ | METAOCAML_ESCAPE e = simple_expr
+ { wrap_exp_attrs ~loc:$sloc e
+ (Some (mknoloc "metaocaml.escape"), []) }
+ | METAOCAML_BRACKET_OPEN e = seq_expr METAOCAML_BRACKET_CLOSE
+ { wrap_exp_attrs ~loc:$sloc e
+ (Some (mknoloc "metaocaml.bracket"),[]) }
+;
+
+%inline simple_expr_:
+ | mkrhs(val_longident)
+ { Pexp_ident ($1) }
+ | constant
+ { Pexp_constant $1 }
+ | mkrhs(constr_longident) %prec prec_constant_constructor
+ { Pexp_construct($1, None) }
+ | name_tag %prec prec_constant_constructor
+ { Pexp_variant($1, None) }
+ | op(PREFIXOP) simple_expr
+ { Pexp_apply($1, [Nolabel,$2]) }
+ | op(BANG {"!"}) simple_expr
+ { Pexp_apply($1, [Nolabel,$2]) }
+ | LBRACELESS object_expr_content GREATERRBRACE
+ { Pexp_override $2 }
+ | LBRACELESS object_expr_content error
+ { unclosed "{<" $loc($1) ">}" $loc($3) }
+ | LBRACELESS GREATERRBRACE
+ { Pexp_override [] }
+ | simple_expr DOT mkrhs(label_longident)
+ { Pexp_field($1, $3) }
+ | od=open_dot_declaration DOT LPAREN seq_expr RPAREN
+ { Pexp_open(od, $4) }
+ | od=open_dot_declaration DOT LBRACELESS object_expr_content GREATERRBRACE
+ { (* TODO: review the location of Pexp_override *)
+ Pexp_open(od, mkexp ~loc:$sloc (Pexp_override $4)) }
+ | mod_longident DOT LBRACELESS object_expr_content error
+ { unclosed "{<" $loc($3) ">}" $loc($5) }
+ | simple_expr HASH mkrhs(label)
+ { Pexp_send($1, $3) }
+ | simple_expr op(HASHOP) simple_expr
+ { mkinfix $1 $2 $3 }
+ | extension
+ { Pexp_extension $1 }
+ | od=open_dot_declaration DOT mkrhs(LPAREN RPAREN {Lident "()"})
+ { Pexp_open(od, mkexp ~loc:($loc($3)) (Pexp_construct($3, None))) }
+ | mod_longident DOT LPAREN seq_expr error
+ { unclosed "(" $loc($3) ")" $loc($5) }
+ | LBRACE record_expr_content RBRACE
+ { let (exten, fields) = $2 in
+ Pexp_record(fields, exten) }
+ | LBRACE record_expr_content error
+ { unclosed "{" $loc($1) "}" $loc($3) }
+ | od=open_dot_declaration DOT LBRACE record_expr_content RBRACE
+ { let (exten, fields) = $4 in
+ Pexp_open(od, mkexp ~loc:($startpos($3), $endpos)
+ (Pexp_record(fields, exten))) }
+ | mod_longident DOT LBRACE record_expr_content error
+ { unclosed "{" $loc($3) "}" $loc($5) }
+ | LBRACKETBAR expr_semi_list BARRBRACKET
+ { Pexp_array($2) }
+ | LBRACKETBAR expr_semi_list error
+ { unclosed "[|" $loc($1) "|]" $loc($3) }
+ | LBRACKETBAR BARRBRACKET
+ { Pexp_array [] }
+ | od=open_dot_declaration DOT LBRACKETBAR expr_semi_list BARRBRACKET
+ { Pexp_open(od, mkexp ~loc:($startpos($3), $endpos) (Pexp_array($4))) }
+ | od=open_dot_declaration DOT LBRACKETBAR BARRBRACKET
+ { (* TODO: review the location of Pexp_array *)
+ Pexp_open(od, mkexp ~loc:($startpos($3), $endpos) (Pexp_array [])) }
+ | mod_longident DOT
+ LBRACKETBAR expr_semi_list error
+ { unclosed "[|" $loc($3) "|]" $loc($5) }
+ | LBRACKET expr_semi_list RBRACKET
+ { fst (mktailexp $loc($3) $2) }
+ | LBRACKET expr_semi_list error
+ { unclosed "[" $loc($1) "]" $loc($3) }
+ | od=open_dot_declaration DOT LBRACKET expr_semi_list RBRACKET
+ { let list_exp =
+ (* TODO: review the location of list_exp *)
+ let tail_exp, _tail_loc = mktailexp $loc($5) $4 in
+ mkexp ~loc:($startpos($3), $endpos) tail_exp in
+ Pexp_open(od, list_exp) }
+ | od=open_dot_declaration DOT mkrhs(LBRACKET RBRACKET {Lident "[]"})
+ { Pexp_open(od, mkexp ~loc:$loc($3) (Pexp_construct($3, None))) }
+ | mod_longident DOT
+ LBRACKET expr_semi_list error
+ { unclosed "[" $loc($3) "]" $loc($5) }
+ | od=open_dot_declaration DOT LPAREN MODULE ext_attributes module_expr COLON
+ package_type RPAREN
+ { let modexp =
+ mkexp_attrs ~loc:($startpos($3), $endpos)
+ (Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $6), $8)) $5 in
+ Pexp_open(od, modexp) }
+ | mod_longident DOT
+ LPAREN MODULE ext_attributes module_expr COLON error
+ { unclosed "(" $loc($3) ")" $loc($8) }
+;
+labeled_simple_expr:
+ simple_expr %prec below_HASH
+ { (Nolabel, $1) }
+ | LABEL simple_expr %prec below_HASH
+ { (Labelled $1, $2) }
+ | TILDE label = LIDENT
+ { let loc = $loc(label) in
+ (Labelled label, mkexpvar ~loc label) }
+ | TILDE LPAREN label = LIDENT ty = type_constraint RPAREN
+ { (Labelled label, mkexp_constraint ~loc:($startpos($2), $endpos)
+ (mkexpvar ~loc:$loc(label) label) ty) }
+ | QUESTION label = LIDENT
+ { let loc = $loc(label) in
+ (Optional label, mkexpvar ~loc label) }
+ | OPTLABEL simple_expr %prec below_HASH
+ { (Optional $1, $2) }
+;
+%inline lident_list:
+ xs = mkrhs(LIDENT)+
+ { xs }
+;
+%inline let_ident:
+ val_ident { mkpatvar ~loc:$sloc $1 }
+;
+let_binding_body_no_punning:
+ let_ident strict_binding
+ { ($1, $2, None) }
+ | let_ident type_constraint EQUAL seq_expr
+ { let v = $1 in (* PR#7344 *)
+ let t =
+ match $2 with
+ Pconstraint t ->
+ Pvc_constraint { locally_abstract_univars = []; typ=t }
+ | Pcoerce (ground, coercion) -> Pvc_coercion { ground; coercion}
+ in
+ (v, $4, Some t)
+ }
+ | let_ident COLON poly(core_type) EQUAL seq_expr
+ {
+ let t = ghtyp ~loc:($loc($3)) $3 in
+ ($1, $5, Some (Pvc_constraint { locally_abstract_univars = []; typ=t }))
+ }
+ | let_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
+ { let constraint' =
+ Pvc_constraint { locally_abstract_univars=$4; typ = $6}
+ in
+ ($1, $8, Some constraint') }
+ | pattern_no_exn EQUAL seq_expr
+ { ($1, $3, None) }
+ | simple_pattern_not_ident COLON core_type EQUAL seq_expr
+ { ($1, $5, Some(Pvc_constraint { locally_abstract_univars=[]; typ=$3 })) }
+;
+let_binding_body:
+ | let_binding_body_no_punning
+ { let p,e,c = $1 in (p,e,c,false) }
+/* BEGIN AVOID */
+ | val_ident %prec below_HASH
+ { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1, None, true) }
+ (* The production that allows puns is marked so that [make list-parse-errors]
+ does not attempt to exploit it. That would be problematic because it
+ would then generate bindings such as [let x], which are rejected by the
+ auxiliary function [addlb] via a call to [syntax_error]. *)
+/* END AVOID */
+;
+(* The formal parameter EXT can be instantiated with ext or no_ext
+ so as to indicate whether an extension is allowed or disallowed. *)
+let_bindings(EXT):
+ let_binding(EXT) { $1 }
+ | let_bindings(EXT) and_let_binding { addlb $1 $2 }
+;
+%inline let_binding(EXT):
+ LET
+ ext = EXT
+ attrs1 = attributes
+ rec_flag = rec_flag
+ body = let_binding_body
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ mklbs ext rec_flag (mklb ~loc:$sloc true body attrs)
+ }
+;
+and_let_binding:
+ AND
+ attrs1 = attributes
+ body = let_binding_body
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ mklb ~loc:$sloc false body attrs
+ }
+;
+letop_binding_body:
+ pat = let_ident exp = strict_binding
+ { (pat, exp) }
+ | val_ident
+ (* Let-punning *)
+ { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1) }
+ | pat = simple_pattern COLON typ = core_type EQUAL exp = seq_expr
+ { let loc = ($startpos(pat), $endpos(typ)) in
+ (ghpat ~loc (Ppat_constraint(pat, typ)), exp) }
+ | pat = pattern_no_exn EQUAL exp = seq_expr
+ { (pat, exp) }
+;
+letop_bindings:
+ body = letop_binding_body
+ { let let_pat, let_exp = body in
+ let_pat, let_exp, [] }
+ | bindings = letop_bindings pbop_op = mkrhs(ANDOP) body = letop_binding_body
+ { let let_pat, let_exp, rev_ands = bindings in
+ let pbop_pat, pbop_exp = body in
+ let pbop_loc = make_loc $sloc in
+ let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
+ let_pat, let_exp, and_ :: rev_ands }
+;
+strict_binding:
+ EQUAL seq_expr
+ { $2 }
+ | fun_params type_constraint? EQUAL fun_body
+ { ghexp ~loc:$sloc (mkfunction $1 $2 $4)
+ }
+;
+fun_body:
+ | FUNCTION ext_attributes match_cases
+ { let ext, attrs = $2 in
+ match ext with
+ | None -> Pfunction_cases ($3, make_loc $sloc, attrs)
+ | Some _ ->
+ (* function%foo extension nodes interrupt the arity *)
+ let cases = Pfunction_cases ($3, make_loc $sloc, []) in
+ Pfunction_body
+ (mkexp_attrs ~loc:$sloc (mkfunction [] None cases) $2)
+ }
+ | fun_seq_expr
+ { Pfunction_body $1 }
+;
+%inline match_cases:
+ xs = preceded_or_separated_nonempty_llist(BAR, match_case)
+ { xs }
+;
+match_case:
+ pattern MINUSGREATER seq_expr
+ { Exp.case $1 $3 }
+ | pattern WHEN seq_expr MINUSGREATER seq_expr
+ { Exp.case $1 ~guard:$3 $5 }
+ | pattern MINUSGREATER DOT
+ { Exp.case $1 (Exp.unreachable ~loc:(make_loc $loc($3)) ()) }
+;
+fun_param_as_list:
+ | LPAREN TYPE ty_params = lident_list RPAREN
+ { (* We desugar (type a b c) to (type a) (type b) (type c).
+ If we do this desugaring, the loc for each parameter is a ghost.
+ *)
+ let loc =
+ match ty_params with
+ | [] -> assert false (* lident_list is non-empty *)
+ | [_] -> make_loc $sloc
+ | _ :: _ :: _ -> ghost_loc $sloc
+ in
+ List.map
+ (fun x -> { pparam_loc = loc; pparam_desc = Pparam_newtype x })
+ ty_params
+ }
+ | labeled_simple_pattern
+ { let a, b, c = $1 in
+ [ { pparam_loc = make_loc $sloc; pparam_desc = Pparam_val (a, b, c) } ]
+ }
+;
+fun_params:
+ | nonempty_concat(fun_param_as_list) { $1 }
+;
+%inline expr_comma_list:
+ es = separated_nontrivial_llist(COMMA, expr)
+ { es }
+;
+record_expr_content:
+ eo = ioption(terminated(simple_expr, WITH))
+ fields = separated_or_terminated_nonempty_list(SEMI, record_expr_field)
+ { eo, fields }
+;
+%inline record_expr_field:
+ | label = mkrhs(label_longident)
+ c = type_constraint?
+ eo = preceded(EQUAL, expr)?
+ { let constraint_loc, label, e =
+ match eo with
+ | None ->
+ (* No pattern; this is a pun. Desugar it. *)
+ $sloc, make_ghost label, exp_of_longident label
+ | Some e ->
+ ($startpos(c), $endpos), label, e
+ in
+ label, mkexp_opt_constraint ~loc:constraint_loc e c }
+;
+%inline object_expr_content:
+ xs = separated_or_terminated_nonempty_list(SEMI, object_expr_field)
+ { xs }
+;
+%inline object_expr_field:
+ label = mkrhs(label)
+ oe = preceded(EQUAL, expr)?
+ { let label, e =
+ match oe with
+ | None ->
+ (* No expression; this is a pun. Desugar it. *)
+ make_ghost label, exp_of_label label
+ | Some e ->
+ label, e
+ in
+ label, e }
+;
+%inline expr_semi_list:
+ es = separated_or_terminated_nonempty_list(SEMI, expr)
+ { es }
+;
+type_constraint:
+ COLON core_type { Pconstraint $2 }
+ | COLON core_type COLONGREATER core_type { Pcoerce (Some $2, $4) }
+ | COLONGREATER core_type { Pcoerce (None, $2) }
+ | COLON error { syntax_error() }
+ | COLONGREATER error { syntax_error() }
+;
+
+/* Patterns */
+
+(* Whereas [pattern] is an arbitrary pattern, [pattern_no_exn] is a pattern
+ that does not begin with the [EXCEPTION] keyword. Thus, [pattern_no_exn]
+ is the intersection of the context-free language [pattern] with the
+ regular language [^EXCEPTION .*].
+
+ Ideally, we would like to use [pattern] everywhere and check in a later
+ phase that EXCEPTION patterns are used only where they are allowed (there
+ is code in typing/typecore.ml to this end). Unfortunately, in the
+ definition of [let_binding_body], we cannot allow [pattern]. That would
+ create a shift/reduce conflict: upon seeing LET EXCEPTION ..., the parser
+ wouldn't know whether this is the beginning of a LET EXCEPTION construct or
+ the beginning of a LET construct whose pattern happens to begin with
+ EXCEPTION. The conflict is avoided there by using [pattern_no_exn] in the
+ definition of [let_binding_body].
+
+ In order to avoid duplication between the definitions of [pattern] and
+ [pattern_no_exn], we create a parameterized definition [pattern_(self)]
+ and instantiate it twice. *)
+
+pattern:
+ pattern_(pattern)
+ { $1 }
+ | EXCEPTION ext_attributes pattern %prec prec_constr_appl
+ { mkpat_attrs ~loc:$sloc (Ppat_exception $3) $2}
+ | EFFECT pattern_gen COMMA simple_pattern
+ { mkpat ~loc:$sloc (Ppat_effect($2,$4)) }
+;
+
+pattern_no_exn:
+ pattern_(pattern_no_exn)
+ { $1 }
+;
+
+%inline pattern_(self):
+ | self COLONCOLON pattern
+ { mkpat_cons ~loc:$sloc $loc($2) (ghpat ~loc:$sloc (Ppat_tuple[$1;$3])) }
+ | self attribute
+ { Pat.attr $1 $2 }
+ | pattern_gen
+ { $1 }
+ | mkpat(
+ self AS mkrhs(val_ident)
+ { Ppat_alias($1, $3) }
+ | self AS error
+ { expecting $loc($3) "identifier" }
+ | pattern_comma_list(self) %prec below_COMMA
+ { Ppat_tuple(List.rev $1) }
+ | self COLONCOLON error
+ { expecting $loc($3) "pattern" }
+ | self BAR pattern
+ { Ppat_or($1, $3) }
+ | self BAR error
+ { expecting $loc($3) "pattern" }
+ ) { $1 }
+;
+
+pattern_gen:
+ simple_pattern
+ { $1 }
+ | mkpat(
+ mkrhs(constr_longident) pattern %prec prec_constr_appl
+ { Ppat_construct($1, Some ([], $2)) }
+ | constr=mkrhs(constr_longident) LPAREN TYPE newtypes=lident_list RPAREN
+ pat=simple_pattern
+ { Ppat_construct(constr, Some (newtypes, pat)) }
+ | name_tag pattern %prec prec_constr_appl
+ { Ppat_variant($1, Some $2) }
+ ) { $1 }
+ | LAZY ext_attributes simple_pattern
+ { mkpat_attrs ~loc:$sloc (Ppat_lazy $3) $2}
+;
+
+simple_pattern:
+ mkpat(mkrhs(val_ident) %prec below_EQUAL
+ { Ppat_var ($1) })
+ { $1 }
+ | simple_pattern_not_ident { $1 }
+;
+
+simple_pattern_not_ident:
+ | LPAREN pattern RPAREN
+ { reloc_pat ~loc:$sloc $2 }
+ | simple_delimited_pattern
+ { $1 }
+ | LPAREN MODULE ext_attributes mkrhs(module_name) RPAREN
+ { mkpat_attrs ~loc:$sloc (Ppat_unpack $4) $3 }
+ | LPAREN MODULE ext_attributes mkrhs(module_name) COLON package_type RPAREN
+ { mkpat_attrs ~loc:$sloc
+ (Ppat_constraint(mkpat ~loc:$loc($4) (Ppat_unpack $4), $6))
+ $3 }
+ | mkpat(simple_pattern_not_ident_)
+ { $1 }
+;
+%inline simple_pattern_not_ident_:
+ | UNDERSCORE
+ { Ppat_any }
+ | signed_constant
+ { Ppat_constant $1 }
+ | signed_constant DOTDOT signed_constant
+ { Ppat_interval ($1, $3) }
+ | mkrhs(constr_longident)
+ { Ppat_construct($1, None) }
+ | name_tag
+ { Ppat_variant($1, None) }
+ | HASH mkrhs(type_longident)
+ { Ppat_type ($2) }
+ | mkrhs(mod_longident) DOT simple_delimited_pattern
+ { Ppat_open($1, $3) }
+ | mkrhs(mod_longident) DOT mkrhs(LBRACKET RBRACKET {Lident "[]"})
+ { Ppat_open($1, mkpat ~loc:$sloc (Ppat_construct($3, None))) }
+ | mkrhs(mod_longident) DOT mkrhs(LPAREN RPAREN {Lident "()"})
+ { Ppat_open($1, mkpat ~loc:$sloc (Ppat_construct($3, None))) }
+ | mkrhs(mod_longident) DOT LPAREN pattern RPAREN
+ { Ppat_open ($1, $4) }
+ | mod_longident DOT LPAREN pattern error
+ { unclosed "(" $loc($3) ")" $loc($5) }
+ | mod_longident DOT LPAREN error
+ { expecting $loc($4) "pattern" }
+ | LPAREN pattern error
+ { unclosed "(" $loc($1) ")" $loc($3) }
+ | LPAREN pattern COLON core_type RPAREN
+ { Ppat_constraint($2, $4) }
+ | LPAREN pattern COLON core_type error
+ { unclosed "(" $loc($1) ")" $loc($5) }
+ | LPAREN pattern COLON error
+ { expecting $loc($4) "type" }
+ | LPAREN MODULE ext_attributes module_name COLON package_type
+ error
+ { unclosed "(" $loc($1) ")" $loc($7) }
+ | extension
+ { Ppat_extension $1 }
+;
+
+simple_delimited_pattern:
+ mkpat(
+ LBRACE record_pat_content RBRACE
+ { let (fields, closed) = $2 in
+ Ppat_record(fields, closed) }
+ | LBRACE record_pat_content error
+ { unclosed "{" $loc($1) "}" $loc($3) }
+ | LBRACKET pattern_semi_list RBRACKET
+ { fst (mktailpat $loc($3) $2) }
+ | LBRACKET pattern_semi_list error
+ { unclosed "[" $loc($1) "]" $loc($3) }
+ | LBRACKETBAR pattern_semi_list BARRBRACKET
+ { Ppat_array $2 }
+ | LBRACKETBAR BARRBRACKET
+ { Ppat_array [] }
+ | LBRACKETBAR pattern_semi_list error
+ { unclosed "[|" $loc($1) "|]" $loc($3) }
+ ) { $1 }
+
+pattern_comma_list(self):
+ pattern_comma_list(self) COMMA pattern { $3 :: $1 }
+ | self COMMA pattern { [$3; $1] }
+ | self COMMA error { expecting $loc($3) "pattern" }
+;
+%inline pattern_semi_list:
+ ps = separated_or_terminated_nonempty_list(SEMI, pattern)
+ { ps }
+;
+(* A label-pattern list is a nonempty list of label-pattern pairs, optionally
+ followed with an UNDERSCORE, separated-or-terminated with semicolons. *)
+%inline record_pat_content:
+ listx(SEMI, record_pat_field, UNDERSCORE)
+ { let fields, closed = $1 in
+ let closed = match closed with Some () -> Open | None -> Closed in
+ fields, closed }
+;
+%inline record_pat_field:
+ label = mkrhs(label_longident)
+ octy = preceded(COLON, core_type)?
+ opat = preceded(EQUAL, pattern)?
+ { let constraint_loc, label, pat =
+ match opat with
+ | None ->
+ (* No pattern; this is a pun. Desugar it.
+ But that the pattern was there and the label reconstructed (which
+ piece of AST is marked as ghost is important for warning
+ emission). *)
+ $sloc, make_ghost label, pat_of_label label
+ | Some pat ->
+ ($startpos(octy), $endpos), label, pat
+ in
+ label, mkpat_opt_constraint ~loc:constraint_loc pat octy
+ }
+;
+
+/* Value descriptions */
+
+value_description:
+ VAL
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(val_ident)
+ COLON
+ ty = possibly_poly(core_type)
+ attrs2 = post_item_attributes
+ { let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Val.mk id ty ~attrs ~loc ~docs,
+ ext }
+;
+
+/* Primitive declarations */
+
+primitive_declaration:
+ EXTERNAL
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(val_ident)
+ COLON
+ ty = possibly_poly(core_type)
+ EQUAL
+ prim = raw_string+
+ attrs2 = post_item_attributes
+ { let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Val.mk id ty ~prim ~attrs ~loc ~docs,
+ ext }
+;
+
+(* Type declarations and type substitutions. *)
+
+(* Type declarations [type t = u] and type substitutions [type t := u] are very
+ similar, so we view them as instances of [generic_type_declarations]. In the
+ case of a type declaration, the use of [nonrec_flag] means that [NONREC] may
+ be absent or present, whereas in the case of a type substitution, the use of
+ [no_nonrec_flag] means that [NONREC] must be absent. The use of [type_kind]
+ versus [type_subst_kind] means that in the first case, we expect an [EQUAL]
+ sign, whereas in the second case, we expect [COLONEQUAL]. *)
+
+%inline type_declarations:
+ generic_type_declarations(nonrec_flag, type_kind)
+ { $1 }
+;
+
+%inline type_subst_declarations:
+ generic_type_declarations(no_nonrec_flag, type_subst_kind)
+ { $1 }
+;
+
+(* A set of type declarations or substitutions begins with a
+ [generic_type_declaration] and continues with a possibly empty list of
+ [generic_and_type_declaration]s. *)
+
+%inline generic_type_declarations(flag, kind):
+ xlist(
+ generic_type_declaration(flag, kind),
+ generic_and_type_declaration(kind)
+ )
+ { $1 }
+;
+
+(* [generic_type_declaration] and [generic_and_type_declaration] look similar,
+ but are in reality different enough that it is difficult to share anything
+ between them. *)
+
+generic_type_declaration(flag, kind):
+ TYPE
+ ext = ext
+ attrs1 = attributes
+ flag = flag
+ params = type_parameters
+ id = mkrhs(LIDENT)
+ kind_priv_manifest = kind
+ cstrs = constraints
+ attrs2 = post_item_attributes
+ {
+ let (kind, priv, manifest) = kind_priv_manifest in
+ let docs = symbol_docs $sloc in
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ (flag, ext),
+ Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
+ }
+;
+%inline generic_and_type_declaration(kind):
+ AND
+ attrs1 = attributes
+ params = type_parameters
+ id = mkrhs(LIDENT)
+ kind_priv_manifest = kind
+ cstrs = constraints
+ attrs2 = post_item_attributes
+ {
+ let (kind, priv, manifest) = kind_priv_manifest in
+ let docs = symbol_docs $sloc in
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let text = symbol_text $symbolstartpos in
+ Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
+ }
+;
+%inline constraints:
+ llist(preceded(CONSTRAINT, constrain))
+ { $1 }
+;
+(* Lots of %inline expansion are required for [nonempty_type_kind] to be
+ LR(1). At the cost of some manual expansion, it would be possible to give a
+ definition that leads to a smaller grammar (after expansion) and therefore
+ a smaller automaton. *)
+nonempty_type_kind:
+ | priv = inline_private_flag
+ ty = core_type
+ { (Ptype_abstract, priv, Some ty) }
+ | oty = type_synonym
+ priv = inline_private_flag
+ cs = constructor_declarations
+ { (Ptype_variant cs, priv, oty) }
+ | oty = type_synonym
+ priv = inline_private_flag
+ DOTDOT
+ { (Ptype_open, priv, oty) }
+ | oty = type_synonym
+ priv = inline_private_flag
+ LBRACE ls = label_declarations RBRACE
+ { (Ptype_record ls, priv, oty) }
+;
+%inline type_synonym:
+ ioption(terminated(core_type, EQUAL))
+ { $1 }
+;
+type_kind:
+ /*empty*/
+ { (Ptype_abstract, Public, None) }
+ | EQUAL nonempty_type_kind
+ { $2 }
+;
+%inline type_subst_kind:
+ COLONEQUAL nonempty_type_kind
+ { $2 }
+;
+type_parameters:
+ /* empty */
+ { [] }
+ | p = type_parameter
+ { [p] }
+ | LPAREN ps = separated_nonempty_llist(COMMA, type_parameter) RPAREN
+ { ps }
+;
+type_parameter:
+ type_variance type_variable { $2, $1 }
+;
+type_variable:
+ mktyp(
+ QUOTE tyvar = ident
+ { Ptyp_var tyvar }
+ | UNDERSCORE
+ { Ptyp_any }
+ ) { $1 }
+;
+
+type_variance:
+ /* empty */ { NoVariance, NoInjectivity }
+ | PLUS { Covariant, NoInjectivity }
+ | MINUS { Contravariant, NoInjectivity }
+ | BANG { NoVariance, Injective }
+ | PLUS BANG | BANG PLUS { Covariant, Injective }
+ | MINUS BANG | BANG MINUS { Contravariant, Injective }
+ | INFIXOP2
+ { if $1 = "+!" then Covariant, Injective else
+ if $1 = "-!" then Contravariant, Injective else
+ expecting $loc($1) "type_variance" }
+ | PREFIXOP
+ { if $1 = "!+" then Covariant, Injective else
+ if $1 = "!-" then Contravariant, Injective else
+ expecting $loc($1) "type_variance" }
+;
+
+(* A sequence of constructor declarations is either a single BAR, which
+ means that the list is empty, or a nonempty BAR-separated list of
+ declarations, with an optional leading BAR. *)
+constructor_declarations:
+ | BAR
+ { [] }
+ | cs = bar_llist(constructor_declaration)
+ { cs }
+;
+(* A constructor declaration begins with an opening symbol, which can
+ be either epsilon or BAR. Note that this opening symbol is included
+ in the footprint $sloc. *)
+(* Because [constructor_declaration] and [extension_constructor_declaration]
+ are identical except for their semantic actions, we introduce the symbol
+ [generic_constructor_declaration], whose semantic action is neutral -- it
+ merely returns a tuple. *)
+generic_constructor_declaration(opening):
+ opening
+ cid = mkrhs(constr_ident)
+ vars_args_res = generalized_constructor_arguments
+ attrs = attributes
+ {
+ let vars, args, res = vars_args_res in
+ let info = symbol_info $endpos in
+ let loc = make_loc $sloc in
+ cid, vars, args, res, attrs, loc, info
+ }
+;
+%inline constructor_declaration(opening):
+ d = generic_constructor_declaration(opening)
+ {
+ let cid, vars, args, res, attrs, loc, info = d in
+ Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
+ }
+;
+str_exception_declaration:
+ sig_exception_declaration
+ { $1 }
+| EXCEPTION
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(constr_ident)
+ EQUAL
+ lid = mkrhs(constr_longident)
+ attrs2 = attributes
+ attrs = post_item_attributes
+ { let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Te.mk_exception ~attrs
+ (Te.rebind id lid ~attrs:(attrs1 @ attrs2) ~loc ~docs)
+ , ext }
+;
+sig_exception_declaration:
+ EXCEPTION
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(constr_ident)
+ vars_args_res = generalized_constructor_arguments
+ attrs2 = attributes
+ attrs = post_item_attributes
+ { let vars, args, res = vars_args_res in
+ let loc = make_loc ($startpos, $endpos(attrs2)) in
+ let docs = symbol_docs $sloc in
+ Te.mk_exception ~attrs
+ (Te.decl id ~vars ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
+ , ext }
+;
+%inline let_exception_declaration:
+ mkrhs(constr_ident) generalized_constructor_arguments attributes
+ { let vars, args, res = $2 in
+ Te.decl $1 ~vars ~args ?res ~attrs:$3 ~loc:(make_loc $sloc) }
+;
+generalized_constructor_arguments:
+ /*empty*/ { ([],Pcstr_tuple [],None) }
+ | OF constructor_arguments { ([],$2,None) }
+ | COLON constructor_arguments MINUSGREATER atomic_type %prec below_HASH
+ { ([],$2,Some $4) }
+ | COLON typevar_list DOT constructor_arguments MINUSGREATER atomic_type
+ %prec below_HASH
+ { ($2,$4,Some $6) }
+ | COLON atomic_type %prec below_HASH
+ { ([],Pcstr_tuple [],Some $2) }
+ | COLON typevar_list DOT atomic_type %prec below_HASH
+ { ($2,Pcstr_tuple [],Some $4) }
+;
+
+constructor_arguments:
+ | tys = inline_separated_nonempty_llist(STAR, atomic_type)
+ %prec below_HASH
+ { Pcstr_tuple tys }
+ | LBRACE label_declarations RBRACE
+ { Pcstr_record $2 }
+;
+label_declarations:
+ label_declaration { [$1] }
+ | label_declaration_semi { [$1] }
+ | label_declaration_semi label_declarations { $1 :: $2 }
+;
+label_declaration:
+ mutable_flag mkrhs(label) COLON poly_type_no_attr attributes
+ { let info = symbol_info $endpos in
+ Type.field $2 $4 ~mut:$1 ~attrs:$5 ~loc:(make_loc $sloc) ~info }
+;
+label_declaration_semi:
+ mutable_flag mkrhs(label) COLON poly_type_no_attr attributes SEMI attributes
+ { let info =
+ match rhs_info $endpos($5) with
+ | Some _ as info_before_semi -> info_before_semi
+ | None -> symbol_info $endpos
+ in
+ Type.field $2 $4 ~mut:$1 ~attrs:($5 @ $7) ~loc:(make_loc $sloc) ~info }
+;
+
+/* Type Extensions */
+
+%inline str_type_extension:
+ type_extension(extension_constructor)
+ { $1 }
+;
+%inline sig_type_extension:
+ type_extension(extension_constructor_declaration)
+ { $1 }
+;
+%inline type_extension(declaration):
+ TYPE
+ ext = ext
+ attrs1 = attributes
+ no_nonrec_flag
+ params = type_parameters
+ tid = mkrhs(type_longident)
+ PLUSEQ
+ priv = private_flag
+ cs = bar_llist(declaration)
+ attrs2 = post_item_attributes
+ { let docs = symbol_docs $sloc in
+ let attrs = attrs1 @ attrs2 in
+ Te.mk tid cs ~params ~priv ~attrs ~docs,
+ ext }
+;
+%inline extension_constructor(opening):
+ extension_constructor_declaration(opening)
+ { $1 }
+ | extension_constructor_rebind(opening)
+ { $1 }
+;
+%inline extension_constructor_declaration(opening):
+ d = generic_constructor_declaration(opening)
+ {
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
+ }
+;
+extension_constructor_rebind(opening):
+ opening
+ cid = mkrhs(constr_ident)
+ EQUAL
+ lid = mkrhs(constr_longident)
+ attrs = attributes
+ { let info = symbol_info $endpos in
+ Te.rebind cid lid ~attrs ~loc:(make_loc $sloc) ~info }
+;
+
+/* "with" constraints (additional type equations over signature components) */
+
+with_constraint:
+ TYPE type_parameters mkrhs(label_longident) with_type_binder
+ core_type_no_attr constraints
+ { let lident = loc_last $3 in
+ Pwith_type
+ ($3,
+ (Type.mk lident
+ ~params:$2
+ ~cstrs:$6
+ ~manifest:$5
+ ~priv:$4
+ ~loc:(make_loc $sloc))) }
+ /* used label_longident instead of type_longident to disallow
+ functor applications in type path */
+ | TYPE type_parameters mkrhs(label_longident)
+ COLONEQUAL core_type_no_attr
+ { let lident = loc_last $3 in
+ Pwith_typesubst
+ ($3,
+ (Type.mk lident
+ ~params:$2
+ ~manifest:$5
+ ~loc:(make_loc $sloc))) }
+ | MODULE mkrhs(mod_longident) EQUAL mkrhs(mod_ext_longident)
+ { Pwith_module ($2, $4) }
+ | MODULE mkrhs(mod_longident) COLONEQUAL mkrhs(mod_ext_longident)
+ { Pwith_modsubst ($2, $4) }
+ | MODULE TYPE l=mkrhs(mty_longident) EQUAL rhs=module_type
+ { Pwith_modtype (l, rhs) }
+ | MODULE TYPE l=mkrhs(mty_longident) COLONEQUAL rhs=module_type
+ { Pwith_modtypesubst (l, rhs) }
+;
+with_type_binder:
+ EQUAL { Public }
+ | EQUAL PRIVATE { Private }
+;
+
+/* Polymorphic types */
+
+%inline typevar:
+ QUOTE ident
+ { mkrhs $2 $sloc }
+;
+%inline typevar_list:
+ nonempty_llist(typevar)
+ { $1 }
+;
+%inline poly(X):
+ typevar_list DOT X
+ { Ptyp_poly($1, $3) }
+;
+possibly_poly(X):
+ X
+ { $1 }
+| mktyp(poly(X))
+ { $1 }
+;
+%inline poly_type:
+ possibly_poly(core_type)
+ { $1 }
+;
+%inline poly_type_no_attr:
+ possibly_poly(core_type_no_attr)
+ { $1 }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Core language types. *)
+
+(* A core type (core_type) is a core type without attributes (core_type_no_attr)
+ followed with a list of attributes. *)
+core_type:
+ core_type_no_attr
+ { $1 }
+ | core_type attribute
+ { Typ.attr $1 $2 }
+;
+
+(* A core type without attributes is currently defined as an alias type, but
+ this could change in the future if new forms of types are introduced. From
+ the outside, one should use core_type_no_attr. *)
+%inline core_type_no_attr:
+ alias_type
+ { $1 }
+;
+
+(* Alias types include:
+ - function types (see below);
+ - proper alias types: 'a -> int as 'a
+ *)
+alias_type:
+ function_type
+ { $1 }
+ | mktyp(
+ ty = alias_type AS tyvar = typevar
+ { Ptyp_alias(ty, tyvar) }
+ )
+ { $1 }
+;
+
+(* Function types include:
+ - tuple types (see below);
+ - proper function types: int -> int
+ foo: int -> int
+ ?foo: int -> int
+ *)
+function_type:
+ | ty = tuple_type
+ %prec MINUSGREATER
+ { ty }
+ | mktyp(
+ label = arg_label
+ domain = extra_rhs(tuple_type)
+ MINUSGREATER
+ codomain = function_type
+ { Ptyp_arrow(label, domain, codomain) }
+ )
+ { $1 }
+;
+%inline arg_label:
+ | label = optlabel
+ { Optional label }
+ | label = LIDENT COLON
+ { Labelled label }
+ | /* empty */
+ { Nolabel }
+;
+(* Tuple types include:
+ - atomic types (see below);
+ - proper tuple types: int * int * int list
+ A proper tuple type is a star-separated list of at least two atomic types.
+ *)
+tuple_type:
+ | ty = atomic_type
+ %prec below_HASH
+ { ty }
+ | mktyp(
+ tys = separated_nontrivial_llist(STAR, atomic_type)
+ { Ptyp_tuple tys }
+ )
+ { $1 }
+;
+
+(* Atomic types are the most basic level in the syntax of types.
+ Atomic types include:
+ - types between parentheses: (int -> int)
+ - first-class module types: (module S)
+ - type variables: 'a
+ - applications of type constructors: int, int list, int option list
+ - variant types: [`A]
+ *)
+
+
+(*
+ Delimited types:
+ - parenthesised type (type)
+ - first-class module types (module S)
+ - object types < x: t; ... >
+ - variant types [ `A ]
+ - extension [%foo ...]
+
+ We support local opens on the following classes of types:
+ - parenthesised
+ - first-class module types
+ - variant types
+
+ Object types are not support for local opens due to a potential
+ conflict with MetaOCaml syntax:
+ M.< x: t, y: t >
+ and quoted expressions:
+ .< e >.
+
+ Extension types are not support for local opens merely as a precaution.
+*)
+delimited_type_supporting_local_open:
+ | LPAREN type_ = core_type RPAREN
+ { type_ }
+ | LPAREN MODULE attrs = ext_attributes package_type = package_type RPAREN
+ { wrap_typ_attrs ~loc:$sloc (reloc_typ ~loc:$sloc package_type) attrs }
+ | mktyp(
+ LBRACKET field = tag_field RBRACKET
+ { Ptyp_variant([ field ], Closed, None) }
+ | LBRACKET BAR fields = row_field_list RBRACKET
+ { Ptyp_variant(fields, Closed, None) }
+ | LBRACKET field = row_field BAR fields = row_field_list RBRACKET
+ { Ptyp_variant(field :: fields, Closed, None) }
+ | LBRACKETGREATER BAR? fields = row_field_list RBRACKET
+ { Ptyp_variant(fields, Open, None) }
+ | LBRACKETGREATER RBRACKET
+ { Ptyp_variant([], Open, None) }
+ | LBRACKETLESS BAR? fields = row_field_list RBRACKET
+ { Ptyp_variant(fields, Closed, Some []) }
+ | LBRACKETLESS BAR? fields = row_field_list
+ GREATER
+ tags = name_tag_list
+ RBRACKET
+ { Ptyp_variant(fields, Closed, Some tags) }
+ )
+ { $1 }
+;
+
+object_type:
+ | mktyp(
+ LESS meth_list = meth_list GREATER
+ { let (f, c) = meth_list in Ptyp_object (f, c) }
+ | LESS GREATER
+ { Ptyp_object ([], Closed) }
+ )
+ { $1 }
+;
+
+extension_type:
+ | mktyp (
+ ext = extension
+ { Ptyp_extension ext }
+ )
+ { $1 }
+;
+
+delimited_type:
+ | object_type
+ | extension_type
+ | delimited_type_supporting_local_open
+ { $1 }
+;
+
+atomic_type:
+ | type_ = delimited_type
+ { type_ }
+ | mktyp( /* begin mktyp group */
+ tys = actual_type_parameters
+ tid = mkrhs(type_longident)
+ { Ptyp_constr (tid, tys) }
+ | tys = actual_type_parameters
+ HASH
+ cid = mkrhs(clty_longident)
+ { Ptyp_class (cid, tys) }
+ | mod_ident = mkrhs(mod_ext_longident)
+ DOT
+ type_ = delimited_type_supporting_local_open
+ { Ptyp_open (mod_ident, type_) }
+ | QUOTE ident = ident
+ { Ptyp_var ident }
+ | UNDERSCORE
+ { Ptyp_any }
+ )
+ { $1 } /* end mktyp group */
+;
+
+(* This is the syntax of the actual type parameters in an application of
+ a type constructor, such as int, int list, or (int, bool) Hashtbl.t.
+ We allow one of the following:
+ - zero parameters;
+ - one parameter:
+ an atomic type;
+ among other things, this can be an arbitrary type between parentheses;
+ - two or more parameters:
+ arbitrary types, between parentheses, separated with commas.
+ *)
+%inline actual_type_parameters:
+ | /* empty */
+ { [] }
+ | ty = atomic_type
+ { [ ty ] }
+ | LPAREN tys = separated_nontrivial_llist(COMMA, core_type) RPAREN
+ { tys }
+;
+
+%inline package_type: module_type
+ { let (lid, cstrs, attrs) = package_type_of_module_type $1 in
+ let descr = Ptyp_package (lid, cstrs) in
+ mktyp ~loc:$sloc ~attrs descr }
+;
+%inline row_field_list:
+ separated_nonempty_llist(BAR, row_field)
+ { $1 }
+;
+row_field:
+ tag_field
+ { $1 }
+ | core_type
+ { Rf.inherit_ ~loc:(make_loc $sloc) $1 }
+;
+tag_field:
+ mkrhs(name_tag) OF opt_ampersand amper_type_list attributes
+ { let info = symbol_info $endpos in
+ let attrs = add_info_attrs info $5 in
+ Rf.tag ~loc:(make_loc $sloc) ~attrs $1 $3 $4 }
+ | mkrhs(name_tag) attributes
+ { let info = symbol_info $endpos in
+ let attrs = add_info_attrs info $2 in
+ Rf.tag ~loc:(make_loc $sloc) ~attrs $1 true [] }
+;
+opt_ampersand:
+ AMPERSAND { true }
+ | /* empty */ { false }
+;
+%inline amper_type_list:
+ separated_nonempty_llist(AMPERSAND, core_type_no_attr)
+ { $1 }
+;
+%inline name_tag_list:
+ nonempty_llist(name_tag)
+ { $1 }
+;
+(* A method list (in an object type). *)
+meth_list:
+ head = field_semi tail = meth_list
+ | head = inherit_field SEMI tail = meth_list
+ { let (f, c) = tail in (head :: f, c) }
+ | head = field_semi
+ | head = inherit_field SEMI
+ { [head], Closed }
+ | head = field
+ | head = inherit_field
+ { [head], Closed }
+ | DOTDOT
+ { [], Open }
+;
+%inline field:
+ mkrhs(label) COLON poly_type_no_attr attributes
+ { let info = symbol_info $endpos in
+ let attrs = add_info_attrs info $4 in
+ Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 }
+;
+
+%inline field_semi:
+ mkrhs(label) COLON poly_type_no_attr attributes SEMI attributes
+ { let info =
+ match rhs_info $endpos($4) with
+ | Some _ as info_before_semi -> info_before_semi
+ | None -> symbol_info $endpos
+ in
+ let attrs = add_info_attrs info ($4 @ $6) in
+ Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 }
+;
+
+%inline inherit_field:
+ ty = atomic_type
+ { Of.inherit_ ~loc:(make_loc $sloc) ty }
+;
+
+%inline label:
+ LIDENT { $1 }
+;
+
+/* Constants */
+
+constant:
+ | INT { let (n, m) = $1 in
+ mkconst ~loc:$sloc (Pconst_integer (n, m)) }
+ | CHAR { mkconst ~loc:$sloc (Pconst_char $1) }
+ | STRING { let (s, strloc, d) = $1 in
+ mkconst ~loc:$sloc (Pconst_string (s,strloc,d)) }
+ | FLOAT { let (f, m) = $1 in
+ mkconst ~loc:$sloc (Pconst_float (f, m)) }
+;
+signed_constant:
+ constant { $1 }
+ | MINUS INT { let (n, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_integer("-" ^ n, m)) }
+ | MINUS FLOAT { let (f, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_float("-" ^ f, m)) }
+ | PLUS INT { let (n, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_integer (n, m)) }
+ | PLUS FLOAT { let (f, m) = $2 in
+ mkconst ~loc:$sloc (Pconst_float(f, m)) }
+;
+
+/* Identifiers and long identifiers */
+
+ident:
+ UIDENT { $1 }
+ | LIDENT { $1 }
+;
+val_extra_ident:
+ | LPAREN operator RPAREN { $2 }
+ | LPAREN operator error { unclosed "(" $loc($1) ")" $loc($3) }
+ | LPAREN error { expecting $loc($2) "operator" }
+ | LPAREN MODULE error { expecting $loc($3) "module-expr" }
+;
+val_ident:
+ LIDENT { $1 }
+ | val_extra_ident { $1 }
+;
+operator:
+ PREFIXOP { $1 }
+ | LETOP { $1 }
+ | ANDOP { $1 }
+ | DOTOP LPAREN index_mod RPAREN { "."^ $1 ^"(" ^ $3 ^ ")" }
+ | DOTOP LPAREN index_mod RPAREN LESSMINUS { "."^ $1 ^ "(" ^ $3 ^ ")<-" }
+ | DOTOP LBRACKET index_mod RBRACKET { "."^ $1 ^"[" ^ $3 ^ "]" }
+ | DOTOP LBRACKET index_mod RBRACKET LESSMINUS { "."^ $1 ^ "[" ^ $3 ^ "]<-" }
+ | DOTOP LBRACE index_mod RBRACE { "."^ $1 ^"{" ^ $3 ^ "}" }
+ | DOTOP LBRACE index_mod RBRACE LESSMINUS { "."^ $1 ^ "{" ^ $3 ^ "}<-" }
+ | HASHOP { $1 }
+ | BANG { "!" }
+ | infix_operator { $1 }
+;
+%inline infix_operator:
+ | op = INFIXOP0 { op }
+ | op = INFIXOP1 { op }
+ | op = INFIXOP2 { op }
+ | op = INFIXOP3 { op }
+ | op = INFIXOP4 { op }
+ | PLUS {"+"}
+ | PLUSDOT {"+."}
+ | PLUSEQ {"+="}
+ | MINUS {"-"}
+ | MINUSDOT {"-."}
+ | STAR {"*"}
+ | PERCENT {"%"}
+ | EQUAL {"="}
+ | LESS {"<"}
+ | GREATER {">"}
+ | OR {"or"}
+ | BARBAR {"||"}
+ | AMPERSAND {"&"}
+ | AMPERAMPER {"&&"}
+ | COLONEQUAL {":="}
+;
+index_mod:
+| { "" }
+| SEMI DOTDOT { ";.." }
+;
+
+%inline constr_extra_ident:
+ | LPAREN COLONCOLON RPAREN { "::" }
+;
+constr_extra_nonprefix_ident:
+ | LBRACKET RBRACKET { "[]" }
+ | LPAREN RPAREN { "()" }
+ | FALSE { "false" }
+ | TRUE { "true" }
+;
+constr_ident:
+ UIDENT { $1 }
+ | constr_extra_ident { $1 }
+ | constr_extra_nonprefix_ident { $1 }
+;
+constr_longident:
+ mod_longident %prec below_DOT { $1 } /* A.B.x vs (A).B.x */
+ | mod_longident DOT constr_extra_ident { Ldot($1,$3) }
+ | constr_extra_ident { Lident $1 }
+ | constr_extra_nonprefix_ident { Lident $1 }
+;
+mk_longident(prefix,final):
+ | final { Lident $1 }
+ | prefix DOT final { Ldot($1,$3) }
+;
+val_longident:
+ mk_longident(mod_longident, val_ident) { $1 }
+;
+label_longident:
+ mk_longident(mod_longident, LIDENT) { $1 }
+;
+type_longident:
+ mk_longident(mod_ext_longident, LIDENT) { $1 }
+;
+mod_longident:
+ mk_longident(mod_longident, UIDENT) { $1 }
+;
+mod_ext_longident:
+ mk_longident(mod_ext_longident, UIDENT) { $1 }
+ | mod_ext_longident LPAREN mod_ext_longident RPAREN
+ { lapply ~loc:$sloc $1 $3 }
+ | mod_ext_longident LPAREN error
+ { expecting $loc($3) "module path" }
+;
+mty_longident:
+ mk_longident(mod_ext_longident,ident) { $1 }
+;
+clty_longident:
+ mk_longident(mod_ext_longident,LIDENT) { $1 }
+;
+class_longident:
+ mk_longident(mod_longident,LIDENT) { $1 }
+;
+
+/* BEGIN AVOID */
+/* For compiler-libs: parse all valid longidents and a little more:
+ final identifiers which are value specific are accepted even when
+ the path prefix is only valid for types: (e.g. F(X).(::)) */
+any_longident:
+ | mk_longident (mod_ext_longident,
+ ident | constr_extra_ident | val_extra_ident { $1 }
+ ) { $1 }
+ | constr_extra_nonprefix_ident { Lident $1 }
+;
+/* END AVOID */
+
+/* Toplevel directives */
+
+toplevel_directive:
+ HASH dir = mkrhs(ident)
+ arg = ioption(mk_directive_arg(toplevel_directive_argument))
+ { mk_directive ~loc:$sloc dir arg }
+;
+
+%inline toplevel_directive_argument:
+ | STRING { let (s, _, _) = $1 in Pdir_string s }
+ | INT { let (n, m) = $1 in Pdir_int (n ,m) }
+ | val_longident { Pdir_ident $1 }
+ | mod_longident { Pdir_ident $1 }
+ | FALSE { Pdir_bool false }
+ | TRUE { Pdir_bool true }
+;
+
+/* Miscellaneous */
+
+(* The symbol epsilon can be used instead of an /* empty */ comment. *)
+%inline epsilon:
+ /* empty */
+ { () }
+;
+
+%inline raw_string:
+ s = STRING
+ { let body, _, _ = s in body }
+;
+
+name_tag:
+ BACKQUOTE ident { $2 }
+;
+rec_flag:
+ /* empty */ { Nonrecursive }
+ | REC { Recursive }
+;
+%inline nonrec_flag:
+ /* empty */ { Recursive }
+ | NONREC { Nonrecursive }
+;
+%inline no_nonrec_flag:
+ /* empty */ { Recursive }
+/* BEGIN AVOID */
+ | NONREC { not_expecting $loc "nonrec flag" }
+/* END AVOID */
+;
+direction_flag:
+ TO { Upto }
+ | DOWNTO { Downto }
+;
+private_flag:
+ inline_private_flag
+ { $1 }
+;
+%inline inline_private_flag:
+ /* empty */ { Public }
+ | PRIVATE { Private }
+;
+mutable_flag:
+ /* empty */ { Immutable }
+ | MUTABLE { Mutable }
+;
+virtual_flag:
+ /* empty */ { Concrete }
+ | VIRTUAL { Virtual }
+;
+mutable_virtual_flags:
+ /* empty */
+ { Immutable, Concrete }
+ | MUTABLE
+ { Mutable, Concrete }
+ | VIRTUAL
+ { Immutable, Virtual }
+ | MUTABLE VIRTUAL
+ | VIRTUAL MUTABLE
+ { Mutable, Virtual }
+;
+private_virtual_flags:
+ /* empty */ { Public, Concrete }
+ | PRIVATE { Private, Concrete }
+ | VIRTUAL { Public, Virtual }
+ | PRIVATE VIRTUAL { Private, Virtual }
+ | VIRTUAL PRIVATE { Private, Virtual }
+;
+(* This nonterminal symbol indicates the definite presence of a VIRTUAL
+ keyword and the possible presence of a MUTABLE keyword. *)
+virtual_with_mutable_flag:
+ | VIRTUAL { Immutable }
+ | MUTABLE VIRTUAL { Mutable }
+ | VIRTUAL MUTABLE { Mutable }
+;
+(* This nonterminal symbol indicates the definite presence of a VIRTUAL
+ keyword and the possible presence of a PRIVATE keyword. *)
+virtual_with_private_flag:
+ | VIRTUAL { Public }
+ | PRIVATE VIRTUAL { Private }
+ | VIRTUAL PRIVATE { Private }
+;
+%inline no_override_flag:
+ /* empty */ { Fresh }
+;
+%inline override_flag:
+ /* empty */ { Fresh }
+ | BANG { Override }
+;
+subtractive:
+ | MINUS { "-" }
+ | MINUSDOT { "-." }
+;
+additive:
+ | PLUS { "+" }
+ | PLUSDOT { "+." }
+;
+optlabel:
+ | OPTLABEL { $1 }
+ | QUESTION LIDENT COLON { $2 }
+;
+
+/* Attributes and extensions */
+
+single_attr_id:
+ LIDENT { $1 }
+ | UIDENT { $1 }
+ | AND { "and" }
+ | AS { "as" }
+ | ASSERT { "assert" }
+ | BEGIN { "begin" }
+ | CLASS { "class" }
+ | CONSTRAINT { "constraint" }
+ | DO { "do" }
+ | DONE { "done" }
+ | DOWNTO { "downto" }
+ | ELSE { "else" }
+ | END { "end" }
+ | EXCEPTION { "exception" }
+ | EXTERNAL { "external" }
+ | FALSE { "false" }
+ | FOR { "for" }
+ | FUN { "fun" }
+ | FUNCTION { "function" }
+ | FUNCTOR { "functor" }
+ | IF { "if" }
+ | IN { "in" }
+ | INCLUDE { "include" }
+ | INHERIT { "inherit" }
+ | INITIALIZER { "initializer" }
+ | LAZY { "lazy" }
+ | LET { "let" }
+ | MATCH { "match" }
+ | METHOD { "method" }
+ | MODULE { "module" }
+ | MUTABLE { "mutable" }
+ | NEW { "new" }
+ | NONREC { "nonrec" }
+ | OBJECT { "object" }
+ | OF { "of" }
+ | OPEN { "open" }
+ | OR { "or" }
+ | PRIVATE { "private" }
+ | REC { "rec" }
+ | SIG { "sig" }
+ | STRUCT { "struct" }
+ | THEN { "then" }
+ | TO { "to" }
+ | TRUE { "true" }
+ | TRY { "try" }
+ | TYPE { "type" }
+ | VAL { "val" }
+ | VIRTUAL { "virtual" }
+ | WHEN { "when" }
+ | WHILE { "while" }
+ | WITH { "with" }
+/* mod/land/lor/lxor/lsl/lsr/asr are not supported for now */
+;
+
+attr_id:
+ mkloc(
+ single_attr_id { $1 }
+ | single_attr_id DOT attr_id { $1 ^ "." ^ $3.txt }
+ ) { $1 }
+;
+attribute:
+ LBRACKETAT attr_id attr_payload RBRACKET
+ { mk_attr ~loc:(make_loc $sloc) $2 $3 }
+;
+post_item_attribute:
+ LBRACKETATAT attr_id attr_payload RBRACKET
+ { mk_attr ~loc:(make_loc $sloc) $2 $3 }
+;
+floating_attribute:
+ LBRACKETATATAT attr_id attr_payload RBRACKET
+ { mark_symbol_docs $sloc;
+ mk_attr ~loc:(make_loc $sloc) $2 $3 }
+;
+%inline post_item_attributes:
+ post_item_attribute*
+ { $1 }
+;
+%inline attributes:
+ attribute*
+ { $1 }
+;
+ext:
+ | /* empty */ { None }
+ | PERCENT attr_id { Some $2 }
+;
+%inline no_ext:
+ | /* empty */ { None }
+/* BEGIN AVOID */
+ | PERCENT attr_id { not_expecting $loc "extension" }
+/* END AVOID */
+;
+%inline ext_attributes:
+ ext attributes { $1, $2 }
+;
+extension:
+ | LBRACKETPERCENT attr_id payload RBRACKET { ($2, $3) }
+ | QUOTED_STRING_EXPR
+ { mk_quotedext ~loc:$sloc $1 }
+;
+item_extension:
+ | LBRACKETPERCENTPERCENT attr_id payload RBRACKET { ($2, $3) }
+ | QUOTED_STRING_ITEM
+ { mk_quotedext ~loc:$sloc $1 }
+;
+payload:
+ structure { PStr $1 }
+ | COLON signature { PSig $2 }
+ | COLON core_type { PTyp $2 }
+ | QUESTION pattern { PPat ($2, None) }
+ | QUESTION pattern WHEN seq_expr { PPat ($2, Some $4) }
+;
+attr_payload:
+ payload
+ { Builtin_attributes.mark_payload_attrs_used $1;
+ $1
+ }
+;
+%%
diff --git a/upstream/ocaml_503/parsing/parsetree.mli b/upstream/ocaml_503/parsing/parsetree.mli
new file mode 100644
index 0000000000..e22a9a7813
--- /dev/null
+++ b/upstream/ocaml_503/parsing/parsetree.mli
@@ -0,0 +1,1125 @@
+(**************************************************************************)
+(* *)
+(* 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_desc : constant_desc;
+ pconst_loc : Location.t;
+}
+
+and constant_desc =
+ | Pconst_integer of string * char option
+ (** Integer constants such as [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 (** Character such as ['c']. *)
+ | Pconst_string of string * Location.t * string option
+ (** Constant string such as ["constant"] or
+ [{delim|other constant|delim}].
+
+ The location span the content of the string, without the delimiters.
+ *)
+ | Pconst_float of string * char option
+ (** Float constant such as [3.4], [2e5] or [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;
+ }
+(** Attributes such as [[\@id ARG]] and [[\@\@id ARG]].
+
+ Metadata containers passed around within the AST.
+ The compiler ignores unknown attributes.
+ *)
+
+and extension = string loc * payload
+(** Extension points such as [[%id ARG] and [%%id ARG]].
+
+ Sub-language placeholder -- rejected by the typechecker.
+ *)
+
+and attributes = attribute list
+
+and payload =
+ | PStr of structure
+ | PSig of signature (** [: SIG] in an attribute or an extension point *)
+ | PTyp of core_type (** [: T] in an attribute or an extension point *)
+ | PPat of pattern * expression option
+ (** [? P] or [? P when E], in an attribute or an extension point *)
+
+(** {1 Core language} *)
+(** {2 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 type variable such as ['a] *)
+ | Ptyp_arrow of arg_label * core_type * core_type
+ (** [Ptyp_arrow(lbl, T1, T2)] represents:
+ - [T1 -> T2] when [lbl] is
+ {{!Asttypes.arg_label.Nolabel}[Nolabel]},
+ - [~l:T1 -> T2] when [lbl] is
+ {{!Asttypes.arg_label.Labelled}[Labelled]},
+ - [?l:T1 -> T2] when [lbl] is
+ {{!Asttypes.arg_label.Optional}[Optional]}.
+ *)
+ | Ptyp_tuple of core_type list
+ (** [Ptyp_tuple([T1 ; ... ; Tn])]
+ represents a product type [T1 * ... * Tn].
+
+ Invariant: [n >= 2].
+ *)
+ | Ptyp_constr of Longident.t loc * core_type list
+ (** [Ptyp_constr(lident, l)] represents:
+ - [tconstr] when [l=[]],
+ - [T tconstr] when [l=[T]],
+ - [(T1, ..., Tn) tconstr] when [l=[T1 ; ... ; Tn]].
+ *)
+ | Ptyp_object of object_field list * closed_flag
+ (** [Ptyp_object([ l1:T1; ...; ln:Tn ], flag)] represents:
+ - [< l1:T1; ...; ln:Tn >] when [flag] is
+ {{!Asttypes.closed_flag.Closed}[Closed]},
+ - [< l1:T1; ...; ln:Tn; .. >] when [flag] is
+ {{!Asttypes.closed_flag.Open}[Open]}.
+ *)
+ | Ptyp_class of Longident.t loc * core_type list
+ (** [Ptyp_class(tconstr, l)] represents:
+ - [#tconstr] when [l=[]],
+ - [T #tconstr] when [l=[T]],
+ - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]].
+ *)
+ | Ptyp_alias of core_type * string loc (** [T as 'a]. *)
+ | Ptyp_variant of row_field list * closed_flag * label list option
+ (** [Ptyp_variant([`A;`B], flag, labels)] represents:
+ - [[ `A|`B ]]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]},
+ and [labels] is [None],
+ - [[> `A|`B ]]
+ when [flag] is {{!Asttypes.closed_flag.Open}[Open]},
+ and [labels] is [None],
+ - [[< `A|`B ]]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]},
+ and [labels] is [Some []],
+ - [[< `A|`B > `X `Y ]]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]},
+ and [labels] is [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
+ {{!pattern_desc.Ppat_constraint}[Ppat_constraint]} node corresponding
+ to a constraint on a let-binding:
+ {[let x : 'a1 ... 'an. T = e ...]}
+
+ - Under {{!class_field_kind.Cfk_virtual}[Cfk_virtual]} for methods
+ (not values).
+
+ - As the {!core_type} of a
+ {{!class_type_field_desc.Pctf_method}[Pctf_method]} node.
+
+ - As the {!core_type} of a {{!expression_desc.Pexp_poly}[Pexp_poly]}
+ node.
+
+ - As the {{!label_declaration.pld_type}[pld_type]} field of a
+ {!label_declaration}.
+
+ - As a {!core_type} of a {{!core_type_desc.Ptyp_object}[Ptyp_object]}
+ node.
+
+ - As the {{!value_description.pval_type}[pval_type]} field of a
+ {!value_description}.
+ *)
+ | Ptyp_package of package_type (** [(module S)]. *)
+ | Ptyp_open of Longident.t loc * core_type (** [M.(T)] *)
+ | Ptyp_extension of extension (** [[%id]]. *)
+
+and package_type = Longident.t loc * (Longident.t loc * core_type) list
+(** As {!package_type} typed values:
+ - [(S, [])] represents [(module S)],
+ - [(S, [(t1, T1) ; ... ; (tn, Tn)])]
+ represents [(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
+ (** [Rtag(`A, b, l)] represents:
+ - [`A] when [b] is [true] and [l] is [[]],
+ - [`A of T] when [b] is [false] and [l] is [[T]],
+ - [`A of T1 & .. & Tn] when [b] is [false] and [l] is [[T1;...Tn]],
+ - [`A of & T1 & .. & Tn] when [b] is [true] and [l] is [[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
+
+(** {2 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 (** The pattern [_]. *)
+ | Ppat_var of string loc (** A variable pattern such as [x] *)
+ | Ppat_alias of pattern * string loc
+ (** An alias pattern such as [P as 'a] *)
+ | Ppat_constant of constant
+ (** Patterns such as [1], ['a'], ["true"], [1.0], [1l], [1L], [1n] *)
+ | Ppat_interval of constant * constant
+ (** Patterns such as ['a'..'z'].
+
+ Other forms of interval are recognized by the parser
+ but rejected by the type-checker. *)
+ | Ppat_tuple of pattern list
+ (** Patterns [(P1, ..., Pn)].
+
+ Invariant: [n >= 2]
+ *)
+ | Ppat_construct of Longident.t loc * (string loc list * pattern) option
+ (** [Ppat_construct(C, args)] represents:
+ - [C] when [args] is [None],
+ - [C P] when [args] is [Some ([], P)]
+ - [C (P1, ..., Pn)] when [args] is
+ [Some ([], Ppat_tuple [P1; ...; Pn])]
+ - [C (type a b) P] when [args] is [Some ([a; b], P)]
+ *)
+ | Ppat_variant of label * pattern option
+ (** [Ppat_variant(`A, pat)] represents:
+ - [`A] when [pat] is [None],
+ - [`A P] when [pat] is [Some P]
+ *)
+ | Ppat_record of (Longident.t loc * pattern) list * closed_flag
+ (** [Ppat_record([(l1, P1) ; ... ; (ln, Pn)], flag)] represents:
+ - [{ l1=P1; ...; ln=Pn }]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}
+ - [{ l1=P1; ...; ln=Pn; _}]
+ when [flag] is {{!Asttypes.closed_flag.Open}[Open]}
+
+ Invariant: [n > 0]
+ *)
+ | Ppat_array of pattern list (** Pattern [[| P1; ...; Pn |]] *)
+ | Ppat_or of pattern * pattern (** Pattern [P1 | P2] *)
+ | Ppat_constraint of pattern * core_type (** Pattern [(P : T)] *)
+ | Ppat_type of Longident.t loc (** Pattern [#tconst] *)
+ | Ppat_lazy of pattern (** Pattern [lazy P] *)
+ | Ppat_unpack of string option loc
+ (** [Ppat_unpack(s)] represents:
+ - [(module P)] when [s] is [Some "P"]
+ - [(module _)] when [s] is [None]
+
+ Note: [(module P : S)] is represented as
+ [Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)]
+ *)
+ | Ppat_exception of pattern (** Pattern [exception P] *)
+ | Ppat_effect of pattern * pattern (* Pattern [effect P P] *)
+ | Ppat_extension of extension (** Pattern [[%id]] *)
+ | Ppat_open of Longident.t loc * pattern (** Pattern [M.(P)] *)
+
+(** {2 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
+ (** Identifiers such as [x] and [M.x]
+ *)
+ | Pexp_constant of constant
+ (** Expressions constant such as [1], ['a'], ["true"], [1.0], [1l],
+ [1L], [1n] *)
+ | Pexp_let of rec_flag * value_binding list * expression
+ (** [Pexp_let(flag, [(P1,E1) ; ... ; (Pn,En)], E)] represents:
+ - [let P1 = E1 and ... and Pn = EN in E]
+ when [flag] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
+ - [let rec P1 = E1 and ... and Pn = EN in E]
+ when [flag] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
+ *)
+ | Pexp_function of
+ function_param list * type_constraint option * function_body
+ (** [Pexp_function ([P1; ...; Pn], C, body)] represents any construct
+ involving [fun] or [function], including:
+ - [fun P1 ... Pn -> E]
+ when [body = Pfunction_body E]
+ - [fun P1 ... Pn -> function p1 -> e1 | ... | pm -> em]
+ when [body = Pfunction_cases [ p1 -> e1; ...; pm -> em ]]
+
+ [C] represents a type constraint or coercion placed immediately before the
+ arrow, e.g. [fun P1 ... Pn : ty -> ...] when [C = Some (Pconstraint ty)].
+
+ A function must have parameters. [Pexp_function (params, _, body)] must
+ have non-empty [params] or a [Pfunction_cases _] body.
+ *)
+ | Pexp_apply of expression * (arg_label * expression) list
+ (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])]
+ represents [E0 ~l1:E1 ... ~ln:En]
+
+ [li] can be
+ {{!Asttypes.arg_label.Nolabel}[Nolabel]} (non labeled argument),
+ {{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or
+ {{!Asttypes.arg_label.Optional}[Optional]} (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
+ (** Expressions [(E1, ..., En)]
+
+ Invariant: [n >= 2]
+ *)
+ | Pexp_construct of Longident.t loc * expression option
+ (** [Pexp_construct(C, exp)] represents:
+ - [C] when [exp] is [None],
+ - [C E] when [exp] is [Some E],
+ - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple[E1;...;En])]
+ *)
+ | Pexp_variant of label * expression option
+ (** [Pexp_variant(`A, exp)] represents
+ - [`A] when [exp] is [None]
+ - [`A E] when [exp] is [Some E]
+ *)
+ | Pexp_record of (Longident.t loc * expression) list * expression option
+ (** [Pexp_record([(l1,P1) ; ... ; (ln,Pn)], exp0)] represents
+ - [{ l1=P1; ...; ln=Pn }] when [exp0] is [None]
+ - [{ E0 with l1=P1; ...; ln=Pn }] when [exp0] is [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
+ (** [Pexp_for(i, E1, E2, direction, E3)] represents:
+ - [for i = E1 to E2 do E3 done]
+ when [direction] is {{!Asttypes.direction_flag.Upto}[Upto]}
+ - [for i = E1 downto E2 do E3 done]
+ when [direction] is {{!Asttypes.direction_flag.Downto}[Downto]}
+ *)
+ | Pexp_constraint of expression * core_type (** [(E : T)] *)
+ | Pexp_coerce of expression * core_type option * core_type
+ (** [Pexp_coerce(E, from, T)] represents
+ - [(E :> T)] when [from] is [None],
+ - [(E : T0 :> T)] when [from] is [Some T0].
+ *)
+ | 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
+ {{!class_field_kind.Cfk_concrete}[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 ME, 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 = E0 in E1]
+ - [let* P0 = E00 and* P1 = E01 in E1] *)
+ | Pexp_extension of extension (** [[%id]] *)
+ | Pexp_unreachable (** [.] *)
+
+and case =
+ {
+ pc_lhs: pattern;
+ pc_guard: expression option;
+ pc_rhs: expression;
+ }
+(** Values of type {!case} represents [(P -> E)] or [(P when E0 -> E)] *)
+
+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;
+ }
+
+and function_param_desc =
+ | Pparam_val of arg_label * expression option * pattern
+ (** [Pparam_val (lbl, exp0, P)] represents the parameter:
+ - [P]
+ when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
+ and [exp0] is [None]
+ - [~l:P]
+ when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}
+ and [exp0] is [None]
+ - [?l:P]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [None]
+ - [?l:(P = E0)]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [Some E0]
+
+ Note: If [E0] is provided, only
+ {{!Asttypes.arg_label.Optional}[Optional]} is allowed.
+ *)
+ | Pparam_newtype of string loc
+ (** [Pparam_newtype x] represents the parameter [(type x)].
+ [x] carries the location of the identifier, whereas the [pparam_loc]
+ on the enclosing [function_param] node is the location of the [(type x)]
+ as a whole.
+
+ Multiple parameters [(type a b c)] are represented as multiple
+ [Pparam_newtype] nodes, let's say:
+
+ {[ [ { pparam_kind = Pparam_newtype a; pparam_loc = loc1 };
+ { pparam_kind = Pparam_newtype b; pparam_loc = loc2 };
+ { pparam_kind = Pparam_newtype c; pparam_loc = loc3 };
+ ]
+ ]}
+
+ Here, the first loc [loc1] is the location of [(type a b c)], and the
+ subsequent locs [loc2] and [loc3] are the same as [loc1], except marked as
+ ghost locations. The locations on [a], [b], [c], correspond to the
+ variables [a], [b], and [c] in the source code.
+ *)
+
+and function_param =
+ { pparam_loc : Location.t;
+ pparam_desc : function_param_desc;
+ }
+
+and function_body =
+ | Pfunction_body of expression
+ | Pfunction_cases of case list * Location.t * attributes
+ (** In [Pfunction_cases (_, loc, attrs)], the location extends from the
+ start of the [function] keyword to the end of the last case. The compiler
+ will only use typechecking-related attributes from [attrs], e.g. enabling
+ or disabling a warning.
+ *)
+(** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *)
+
+and type_constraint =
+ | Pconstraint of core_type
+ | Pcoerce of core_type option * core_type
+(** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *)
+
+(** {2 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;
+ }
+(** Values of type {!value_description} represents:
+ - [val x: T],
+ when {{!value_description.pval_prim}[pval_prim]} is [[]]
+ - [external x: T = "s1" ... "sn"]
+ when {{!value_description.pval_prim}[pval_prim]} is [["s1";..."sn"]]
+*)
+
+(** {2 Type declarations} *)
+
+and type_declaration =
+ {
+ ptype_name: string loc;
+ ptype_params: (core_type * (variance * injectivity)) list;
+ (** [('a1,...'an) t] *)
+ ptype_cstrs: (core_type * core_type * Location.t) list;
+ (** [... constraint T1=T1' ... constraint Tn=Tn'] *)
+ ptype_kind: type_kind;
+ ptype_private: private_flag; (** for [= private ...] *)
+ ptype_manifest: core_type option; (** represents [= T] *)
+ ptype_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
+ ptype_loc: Location.t;
+ }
+(**
+ Here are type declarations and their representation,
+ for various {{!type_declaration.ptype_kind}[ptype_kind]}
+ and {{!type_declaration.ptype_manifest}[ptype_manifest]} values:
+ - [type t] when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]},
+ and [manifest] is [None],
+ - [type t = T0]
+ when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]},
+ and [manifest] is [Some T0],
+ - [type t = C of T | ...]
+ when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]},
+ and [manifest] is [None],
+ - [type t = T0 = C of T | ...]
+ when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]},
+ and [manifest] is [Some T0],
+ - [type t = {l: T; ...}]
+ when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]},
+ and [manifest] is [None],
+ - [type t = T0 = {l : T; ...}]
+ when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]},
+ and [manifest] is [Some T0],
+ - [type t = ..]
+ when [type_kind] is {{!type_kind.Ptype_open}[Ptype_open]},
+ and [manifest] is [None].
+*)
+
+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; ... }]
+ when {{!label_declaration.pld_mutable}[pld_mutable]}
+ is {{!Asttypes.mutable_flag.Immutable}[Immutable]},
+ - [{ ...; mutable l: T; ... }]
+ when {{!label_declaration.pld_mutable}[pld_mutable]}
+ is {{!Asttypes.mutable_flag.Mutable}[Mutable]}.
+
+ Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}.
+*)
+
+and constructor_declaration =
+ {
+ pcd_name: string loc;
+ pcd_vars: string loc list;
+ 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
+ (** Values of type {!constructor_declaration}
+ represents the constructor arguments of:
+ - [C of T1 * ... * Tn] when [res = None],
+ and [args = Pcstr_tuple [T1; ... ; Tn]],
+ - [C: T0] when [res = Some T0],
+ and [args = Pcstr_tuple []],
+ - [C: T1 * ... * Tn -> T0] when [res = Some T0],
+ and [args = Pcstr_tuple [T1; ... ; Tn]],
+ - [C of {...}] when [res = None],
+ and [args = Pcstr_record [...]],
+ - [C: {...} -> T0] when [res = Some T0],
+ and [args = Pcstr_record [...]].
+*)
+
+and type_extension =
+ {
+ ptyext_path: Longident.t loc;
+ ptyext_params: (core_type * (variance * injectivity)) list;
+ ptyext_constructors: extension_constructor list;
+ ptyext_private: private_flag;
+ ptyext_loc: Location.t;
+ ptyext_attributes: attributes; (** ... [\@\@id1] [\@\@id2] *)
+ }
+(**
+ Definition of new extensions constructors for the extensive sum type [t]
+ ([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]] *)
+ }
+
+and type_exception =
+ {
+ ptyexn_constructor : extension_constructor;
+ ptyexn_loc : Location.t;
+ ptyexn_attributes : attributes; (** [... [\@\@id1] [\@\@id2]] *)
+ }
+(** Definition of a new exception ([exception E]). *)
+
+and extension_constructor_kind =
+ | Pext_decl of string loc list * constructor_arguments * core_type option
+ (** [Pext_decl(existentials, c_args, t_opt)]
+ describes a new extension constructor. It can be:
+ - [C of T1 * ... * Tn] when:
+ {ul {- [existentials] is [[]],}
+ {- [c_args] is [[T1; ...; Tn]],}
+ {- [t_opt] is [None]}.}
+ - [C: T0] when
+ {ul {- [existentials] is [[]],}
+ {- [c_args] is [[]],}
+ {- [t_opt] is [Some T0].}}
+ - [C: T1 * ... * Tn -> T0] when
+ {ul {- [existentials] is [[]],}
+ {- [c_args] is [[T1; ...; Tn]],}
+ {- [t_opt] is [Some T0].}}
+ - [C: 'a... . T1 * ... * Tn -> T0] when
+ {ul {- [existentials] is [['a;...]],}
+ {- [c_args] is [[T1; ... ; Tn]],}
+ {- [t_opt] is [Some T0].}}
+ *)
+ | Pext_rebind of Longident.t loc
+ (** [Pext_rebind(D)] re-export the constructor [D] with the new name [C] *)
+
+(** {1 Class language} *)
+(** {2 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
+ (** [Pcty_arrow(lbl, T, CT)] represents:
+ - [T -> CT]
+ when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]},
+ - [~l:T -> CT]
+ when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]},
+ - [?l:T -> CT]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[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;
+ }
+(** Values of type [class_signature] represents:
+ - [object('selfpat) ... end]
+ - [object ... end] when {{!class_signature.pcsig_self}[pcsig_self]}
+ is {{!core_type_desc.Ptyp_any}[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 {{!core_type_desc.Ptyp_poly}[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 * injectivity)) list;
+ pci_name: string loc;
+ pci_expr: 'a;
+ pci_loc: Location.t;
+ pci_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
+ }
+(** Values of type [class_expr class_infos] represents:
+ - [class c = ...]
+ - [class ['a1,...,'an] c = ...]
+ - [class virtual c = ...]
+
+ They are also used for "class type" declaration.
+*)
+
+and class_description = class_type class_infos
+
+and class_type_declaration = class_type class_infos
+
+(** {2 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] and [['a1, ..., 'an] c] *)
+ | Pcl_structure of class_structure (** [object ... end] *)
+ | Pcl_fun of arg_label * expression option * pattern * class_expr
+ (** [Pcl_fun(lbl, exp0, P, CE)] represents:
+ - [fun P -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
+ and [exp0] is [None],
+ - [fun ~l:P -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}
+ and [exp0] is [None],
+ - [fun ?l:P -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [None],
+ - [fun ?l:(P = E0) -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [Some E0].
+ *)
+ | Pcl_apply of class_expr * (arg_label * expression) list
+ (** [Pcl_apply(CE, [(l1,E1) ; ... ; (ln,En)])]
+ represents [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
+ (** [Pcl_let(rec, [(P1, E1); ... ; (Pn, En)], CE)] represents:
+ - [let P1 = E1 and ... and Pn = EN in CE]
+ when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
+ - [let rec P1 = E1 and ... and Pn = EN in CE]
+ when [rec] is {{!Asttypes.rec_flag.Recursive}[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;
+ }
+(** Values of type {!class_structure} represents:
+ - [object(selfpat) ... end]
+ - [object ... end] when {{!class_structure.pcstr_self}[pcstr_self]}
+ is {{!pattern_desc.Ppat_any}[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
+ (** [Pcf_inherit(flag, CE, s)] represents:
+ - [inherit CE]
+ when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]}
+ and [s] is [None],
+ - [inherit CE as x]
+ when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]}
+ and [s] is [Some x],
+ - [inherit! CE]
+ when [flag] is {{!Asttypes.override_flag.Override}[Override]}
+ and [s] is [None],
+ - [inherit! CE as x]
+ when [flag] is {{!Asttypes.override_flag.Override}[Override]}
+ and [s] is [Some x]
+ *)
+ | Pcf_val of (label loc * mutable_flag * class_field_kind)
+ (** [Pcf_val(x,flag, kind)] represents:
+ - [val x = E]
+ when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]}
+ and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]}
+ - [val virtual x: T]
+ when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]}
+ and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]}
+ - [val mutable x = E]
+ when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]}
+ and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]}
+ - [val mutable virtual x: T]
+ when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]}
+ and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]}
+ *)
+ | Pcf_method of (label loc * private_flag * class_field_kind)
+ (** - [method x = E]
+ ([E] can be a {{!expression_desc.Pexp_poly}[Pexp_poly]})
+ - [method virtual x: T]
+ ([T] can be a {{!core_type_desc.Ptyp_poly}[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} *)
+(** {2 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 (** [Pmty_ident(S)] represents [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
+ (** [Named(name, MT)] represents:
+ - [(X : MT)] when [name] is [Some X],
+ - [(_ : MT)] when [name] is [None] *)
+
+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] and [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] and [module type S] *)
+ | Psig_modtypesubst of module_type_declaration
+ (** [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;
+ }
+(** Values of type [module_declaration] represents [S : MT] *)
+
+and module_substitution =
+ {
+ pms_name: string loc;
+ pms_manifest: Longident.t loc;
+ pms_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
+ pms_loc: Location.t;
+ }
+(** Values of type [module_substitution] represents [S := M] *)
+
+and module_type_declaration =
+ {
+ pmtd_name: string loc;
+ pmtd_type: module_type option;
+ pmtd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
+ pmtd_loc: Location.t;
+ }
+(** Values of type [module_type_declaration] represents:
+ - [S = MT],
+ - [S] for abstract module type declaration,
+ when {{!module_type_declaration.pmtd_type}[pmtd_type]} is [None].
+*)
+
+and 'a open_infos =
+ {
+ popen_expr: 'a;
+ popen_override: override_flag;
+ popen_loc: Location.t;
+ popen_attributes: attributes;
+ }
+(** Values of type ['a open_infos] represents:
+ - [open! X] when {{!open_infos.popen_override}[popen_override]}
+ is {{!Asttypes.override_flag.Override}[Override]}
+ (silences the "used identifier shadowing" warning)
+ - [open X] when {{!open_infos.popen_override}[popen_override]}
+ is {{!Asttypes.override_flag.Fresh}[Fresh]}
+*)
+
+and open_description = Longident.t loc open_infos
+(** Values of type [open_description] represents:
+ - [open M.N]
+ - [open M(N).O] *)
+
+and open_declaration = module_expr open_infos
+(** Values of type [open_declaration] represents:
+ - [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
+(** Values of type [include_description] represents [include MT] *)
+
+and include_declaration = module_expr include_infos
+(** Values of type [include_declaration] represents [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_modtype of Longident.t loc * module_type
+ (** [with module type X.Y = Z] *)
+ | Pwith_modtypesubst of Longident.t loc * module_type
+ (** [with module type X.Y := sig end] *)
+ | 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] *)
+
+(** {2 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_apply_unit of module_expr (** [ME1()] *)
+ | 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
+ (** [Pstr_value(rec, [(P1, E1 ; ... ; (Pn, En))])] represents:
+ - [let P1 = E1 and ... and Pn = EN]
+ when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
+ - [let rec P1 = E1 and ... and Pn = EN ]
+ when [rec] is {{!Asttypes.rec_flag.Recursive}[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_constraint =
+ | Pvc_constraint of {
+ locally_abstract_univars:string loc list;
+ typ:core_type;
+ }
+ | Pvc_coercion of {ground:core_type option; coercion:core_type }
+ (**
+ - [Pvc_constraint { locally_abstract_univars=[]; typ}]
+ is a simple type constraint on a value binding: [ let x : typ]
+ - More generally, in [Pvc_constraint { locally_abstract_univars; typ}]
+ [locally_abstract_univars] is the list of locally abstract type
+ variables in [ let x: type a ... . typ ]
+ - [Pvc_coercion { ground=None; coercion }] represents [let x :> typ]
+ - [Pvc_coercion { ground=Some g; coercion }] represents [let x : g :> typ]
+ *)
+
+and value_binding =
+ {
+ pvb_pat: pattern;
+ pvb_expr: expression;
+ pvb_constraint: value_constraint option;
+ pvb_attributes: attributes;
+ pvb_loc: Location.t;
+ }(** [let pat : type_constraint = exp] *)
+
+and module_binding =
+ {
+ pmb_name: string option loc;
+ pmb_expr: module_expr;
+ pmb_attributes: attributes;
+ pmb_loc: Location.t;
+ }
+(** Values of type [module_binding] represents [module X = ME] *)
+
+(** {1 Toplevel} *)
+
+(** {2 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/upstream/ocaml_503/parsing/pprintast.ml b/upstream/ocaml_503/parsing/pprintast.ml
new file mode 100644
index 0000000000..48d96c8f28
--- /dev/null
+++ b/upstream/ocaml_503/parsing/pprintast.ml
@@ -0,0 +1,1876 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Thomas Gazagnaire, OCamlPro *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* Hongbo Zhang, University of Pennsylvania *)
+(* *)
+(* Copyright 2007 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. *)
+(* *)
+(**************************************************************************)
+
+(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
+(* Printing code expressions *)
+(* Authors: Ed Pizzi, Fabrice Le Fessant *)
+(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
+(* TODO more fine-grained precedence pretty-printing *)
+
+open Asttypes
+open Format
+open Location
+open Longident
+open Parsetree
+
+let prefix_symbols = [ '!'; '?'; '~' ]
+let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
+ '$'; '%'; '#' ]
+
+(* type fixity = Infix| Prefix *)
+let special_infix_strings =
+ ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
+
+let letop s =
+ String.length s > 3
+ && s.[0] = 'l'
+ && s.[1] = 'e'
+ && s.[2] = 't'
+ && List.mem s.[3] infix_symbols
+
+let andop s =
+ String.length s > 3
+ && s.[0] = 'a'
+ && s.[1] = 'n'
+ && s.[2] = 'd'
+ && List.mem s.[3] infix_symbols
+
+(* determines if the string is an infix string.
+ checks backwards, first allowing a renaming postfix ("_102") which
+ may have resulted from Pexp -> Texp -> Pexp translation, then checking
+ if all the characters in the beginning of the string are valid infix
+ characters. *)
+let fixity_of_string = function
+ | "" -> `Normal
+ | s when List.mem s special_infix_strings -> `Infix s
+ | s when List.mem s.[0] infix_symbols -> `Infix s
+ | s when List.mem s.[0] prefix_symbols -> `Prefix s
+ | s when s.[0] = '.' -> `Mixfix s
+ | s when letop s -> `Letop s
+ | s when andop s -> `Andop s
+ | _ -> `Normal
+
+let view_fixity_of_exp = function
+ | {pexp_desc = Pexp_ident {txt=Lident l;_}; pexp_attributes = []} ->
+ fixity_of_string l
+ | _ -> `Normal
+
+let is_infix = function `Infix _ -> true | _ -> false
+let is_mixfix = function `Mixfix _ -> true | _ -> false
+let is_kwdop = function `Letop _ | `Andop _ -> true | _ -> false
+
+let first_is c str =
+ str <> "" && str.[0] = c
+let last_is c str =
+ str <> "" && str.[String.length str - 1] = c
+
+let first_is_in cs str =
+ str <> "" && List.mem str.[0] cs
+
+(** The OCaml grammar generates [longident]s from five different rules:
+ - module longident (a sequence of uppercase identifiers [A.B.C])
+ - constructor longident, either
+ - a module [longident]
+ - [[]], [()], [true], [false]
+ - an optional module [longident] followed by [(::)] ([A.B.(::)])
+ - class longident, an optional module [longident] followed by a lowercase
+ identifier.
+ - value longident, an optional module [longident] followed by either:
+ - a lowercase identifier ([A.x])
+ - an operator (and in particular the [mod] keyword), ([A.(+), B.(mod)])
+ - type [longident]: a tree of applications and projections of
+ uppercase identifiers followed by a projection ending with
+ a lowercase identifier (for ordinary types), or any identifier
+ (for module types) (e.g [A.B(C.D(E.F).K)(G).X.Y.t])
+All these [longident]s share a common core and optionally add some extensions.
+Unfortunately, these extensions intersect while having different escaping
+and parentheses rules depending on the kind of [longident]:
+ - [true] or [false] can be either constructor [longident]s,
+ or value, type or class [longident]s using the raw identifier syntax.
+ - [mod] can be either an operator value [longident], or a class or type
+ [longident] using the raw identifier syntax.
+Thus in order to print correctly [longident]s, we need to keep track of their
+kind using the context in which they appear.
+*)
+type longindent_kind =
+ | Constr (** variant constructors *)
+ | Type (** core types, module types, class types, and classes *)
+ | Other (** values and modules *)
+
+(* which identifiers are in fact operators needing parentheses *)
+let needs_parens ~kind txt =
+ match kind with
+ | Type -> false
+ | Constr | Other ->
+ let fix = fixity_of_string txt in
+ is_infix fix
+ || is_mixfix fix
+ || is_kwdop fix
+ || first_is_in prefix_symbols txt
+
+(* some infixes need spaces around parens to avoid clashes with comment
+ syntax *)
+let needs_spaces txt =
+ first_is '*' txt || last_is '*' txt
+
+let tyvar_of_name s =
+ if String.length s >= 2 && s.[1] = '\'' then
+ (* without the space, this would be parsed as
+ a character literal *)
+ "' " ^ s
+ else if Lexer.is_keyword s then
+ "'\\#" ^ s
+ else if String.equal s "_" then
+ s
+ else
+ "'" ^ s
+
+module Doc = struct
+(* Turn an arbitrary variable name into a valid OCaml identifier by adding \#
+ in case it is a keyword, or parenthesis when it is an infix or prefix
+ operator. *)
+ let ident_of_name ~kind ppf txt =
+ let format : (_, _, _) format =
+ if Lexer.is_keyword txt then begin
+ match kind, txt with
+ | Constr, ("true"|"false") -> "%s"
+ | _ -> "\\#%s"
+ end
+ else if not (needs_parens ~kind txt) then "%s"
+ else if needs_spaces txt then "(@;%s@;)"
+ else "(%s)"
+ in Format_doc.fprintf ppf format txt
+
+ let protect_longident ~kind ppf print_longident longprefix txt =
+ if not (needs_parens ~kind txt) then
+ Format_doc.fprintf ppf "%a.%a"
+ print_longident longprefix
+ (ident_of_name ~kind) txt
+ else if needs_spaces txt then
+ Format_doc.fprintf ppf "%a.(@;%s@;)" print_longident longprefix txt
+ else
+ Format_doc.fprintf ppf "%a.(%s)" print_longident longprefix txt
+
+ let rec any_longident ~kind f = function
+ | Lident s -> ident_of_name ~kind f s
+ | Ldot(y,s) ->
+ protect_longident ~kind f (any_longident ~kind:Other) y s
+ | Lapply (y,s) ->
+ Format_doc.fprintf f "%a(%a)"
+ (any_longident ~kind:Other) y
+ (any_longident ~kind:Other) s
+
+ let value_longident ppf l = any_longident ~kind:Other ppf l
+ let longident = value_longident
+ let constr ppf l = any_longident ~kind:Constr ppf l
+ let type_longident ppf l = any_longident ~kind:Type ppf l
+
+ let tyvar ppf s =
+ Format_doc.fprintf ppf "%s" (tyvar_of_name s)
+
+ (* Expressions are considered nominal if they can be used as the subject of a
+ sentence or action. In practice, we consider that an expression is nominal
+ if they satisfy one of:
+ - Similar to an identifier: words separated by '.' or '#'.
+ - Do not contain spaces when printed.
+ - Is a constant that is short enough.
+ *)
+ let nominal_exp t =
+ let open Format_doc.Doc in
+ let longident ?(is_constr=false) l =
+ let kind= if is_constr then Constr else Other in
+ Format_doc.doc_printer (any_longident ~kind) l.Location.txt in
+ let rec nominal_exp doc exp =
+ match exp.pexp_desc with
+ | _ when exp.pexp_attributes <> [] -> None
+ | Pexp_ident l ->
+ Some (longident l doc)
+ | Pexp_variant (lbl, None) ->
+ Some (printf "`%s" lbl doc)
+ | Pexp_construct (l, None) ->
+ Some (longident ~is_constr:true l doc)
+ | Pexp_field (parent, lbl) ->
+ Option.map
+ (printf ".%t" (longident lbl))
+ (nominal_exp doc parent)
+ | Pexp_send (parent, meth) ->
+ Option.map
+ (printf "#%s" meth.txt)
+ (nominal_exp doc parent)
+ (* String constants are syntactically too complex. For example, the
+ quotes conflict with the 'inline_code' style and they might contain
+ spaces. *)
+ | Pexp_constant { pconst_desc = Pconst_string _; _ } -> None
+ (* Char, integer and float constants are nominal. *)
+ | Pexp_constant { pconst_desc = Pconst_char c; _ } ->
+ Some (msg "%C" c)
+ | Pexp_constant
+ { pconst_desc = Pconst_integer (cst, suf) | Pconst_float (cst, suf);
+ _ } ->
+ Some (msg "%s%t" cst (option char suf))
+ | _ -> None
+ in
+ nominal_exp empty t
+end
+
+let value_longident ppf l = Format_doc.compat Doc.value_longident ppf l
+let type_longident ppf l = Format_doc.compat Doc.type_longident ppf l
+
+let ident_of_name ppf i =
+ Format_doc.compat (Doc.ident_of_name ~kind:Other) ppf i
+
+let constr ppf l = Format_doc.compat Doc.constr ppf l
+
+let ident_of_name_loc ppf s = ident_of_name ppf s.txt
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+let override = function
+ | Override -> "!"
+ | Fresh -> ""
+
+(* variance encoding: need to sync up with the [parser.mly] *)
+let type_variance = function
+ | NoVariance -> ""
+ | Covariant -> "+"
+ | Contravariant -> "-"
+
+let type_injectivity = function
+ | NoInjectivity -> ""
+ | Injective -> "!"
+
+type construct =
+ [ `cons of expression list
+ | `list of expression list
+ | `nil
+ | `normal
+ | `simple of Longident.t
+ | `tuple
+ | `btrue
+ | `bfalse ]
+
+let view_expr x =
+ match x.pexp_desc with
+ | Pexp_construct ( {txt= Lident "()"; _},None) -> `tuple
+ | Pexp_construct ( {txt= Lident "true"; _},None) -> `btrue
+ | Pexp_construct ( {txt= Lident "false"; _},None) -> `bfalse
+ | Pexp_construct ( {txt= Lident "[]";_},None) -> `nil
+ | Pexp_construct ( {txt= Lident"::";_},Some _) ->
+ let rec loop exp acc = match exp with
+ | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
+ pexp_attributes = []} ->
+ (List.rev acc,true)
+ | {pexp_desc=
+ Pexp_construct ({txt=Lident "::";_},
+ Some ({pexp_desc= Pexp_tuple([e1;e2]);
+ pexp_attributes = []}));
+ pexp_attributes = []}
+ ->
+ loop e2 (e1::acc)
+ | e -> (List.rev (e::acc),false) in
+ let (ls,b) = loop x [] in
+ if b then
+ `list ls
+ else `cons ls
+ | Pexp_construct (x,None) -> `simple (x.txt)
+ | _ -> `normal
+
+let is_simple_construct :construct -> bool = function
+ | `nil | `tuple | `list _ | `simple _ | `btrue | `bfalse -> true
+ | `cons _ | `normal -> false
+
+let pp = fprintf
+
+type ctxt = {
+ pipe : bool;
+ semi : bool;
+ ifthenelse : bool;
+ functionrhs : bool;
+}
+
+let reset_ctxt = { pipe=false; semi=false; ifthenelse=false; functionrhs=false }
+let under_pipe ctxt = { ctxt with pipe=true }
+let under_semi ctxt = { ctxt with semi=true }
+let under_ifthenelse ctxt = { ctxt with ifthenelse=true }
+let under_functionrhs ctxt = { ctxt with functionrhs = true }
+(*
+let reset_semi ctxt = { ctxt with semi=false }
+let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
+let reset_pipe ctxt = { ctxt with pipe=false }
+*)
+
+let list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
+ ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
+ Format.formatter -> 'a list -> unit
+ = fun ?sep ?first ?last fu f xs ->
+ let first = match first with Some x -> x |None -> ("": _ format6)
+ and last = match last with Some x -> x |None -> ("": _ format6)
+ and sep = match sep with Some x -> x |None -> ("@ ": _ format6) in
+ let aux f = function
+ | [] -> ()
+ | [x] -> fu f x
+ | xs ->
+ let rec loop f = function
+ | [x] -> fu f x
+ | x::xs -> fu f x; pp f sep; loop f xs;
+ | _ -> assert false in begin
+ pp f first; loop f xs; pp f last;
+ end in
+ aux f xs
+
+let option : 'a. ?first:space_formatter -> ?last:space_formatter ->
+ (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
+ = fun ?first ?last fu f a ->
+ let first = match first with Some x -> x | None -> ("": _ format6)
+ and last = match last with Some x -> x | None -> ("": _ format6) in
+ match a with
+ | None -> ()
+ | Some x -> pp f first; fu f x; pp f last
+
+let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
+ bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+ = fun ?(first=("": _ format6)) ?(last=("": _ format6)) b fu f x ->
+ if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
+ else fu f x
+
+let with_loc pr ppf x = pr ppf x.txt
+let value_longident_loc = with_loc value_longident
+
+let constant_desc f = function
+ | Pconst_char i ->
+ pp f "%C" i
+ | Pconst_string (i, _, None) ->
+ pp f "%S" i
+ | Pconst_string (i, _, Some delim) ->
+ pp f "{%s|%s|%s}" delim i delim
+ | Pconst_integer (i, None) ->
+ paren (first_is '-' i) (fun f -> pp f "%s") f i
+ | Pconst_integer (i, Some m) ->
+ paren (first_is '-' i) (fun f (i, m) -> pp f "%s%c" i m) f (i,m)
+ | Pconst_float (i, None) ->
+ paren (first_is '-' i) (fun f -> pp f "%s") f i
+ | Pconst_float (i, Some m) ->
+ paren (first_is '-' i) (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
+
+let constant f const = constant_desc f const.pconst_desc
+
+(* trailing space*)
+let mutable_flag f = function
+ | Immutable -> ()
+ | Mutable -> pp f "mutable@;"
+let virtual_flag f = function
+ | Concrete -> ()
+ | Virtual -> pp f "virtual@;"
+
+(* trailing space added *)
+let rec_flag f rf =
+ match rf with
+ | Nonrecursive -> ()
+ | Recursive -> pp f "rec "
+let nonrec_flag f rf =
+ match rf with
+ | Nonrecursive -> pp f "nonrec "
+ | Recursive -> ()
+let direction_flag f = function
+ | Upto -> pp f "to@ "
+ | Downto -> pp f "downto@ "
+let private_flag f = function
+ | Public -> ()
+ | Private -> pp f "private@ "
+
+let iter_loc f ctxt {txt; loc = _} = f ctxt txt
+
+let constant_string f s = pp f "%S" s
+
+
+
+let tyvar ppf v = Format_doc.compat Doc.tyvar ppf v
+
+let tyvar_loc f str = tyvar f str.txt
+let string_quot f x = pp f "`%a" ident_of_name x
+
+(* c ['a,'b] *)
+let rec class_params_def ctxt f = function
+ | [] -> ()
+ | l ->
+ pp f "[%a] " (* space *)
+ (list (type_param ctxt) ~sep:",") l
+
+and type_with_label ctxt f (label, c) =
+ match label with
+ | Nolabel -> core_type1 ctxt f c (* otherwise parenthesize *)
+ | Labelled s -> pp f "%a:%a" ident_of_name s (core_type1 ctxt) c
+ | Optional s -> pp f "?%a:%a" ident_of_name s (core_type1 ctxt) c
+
+and core_type ctxt f x =
+ if x.ptyp_attributes <> [] then begin
+ pp f "((%a)%a)" (core_type ctxt) {x with ptyp_attributes=[]}
+ (attributes ctxt) x.ptyp_attributes
+ end
+ else match x.ptyp_desc with
+ | Ptyp_arrow (l, ct1, ct2) ->
+ pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+ (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2
+ | Ptyp_alias (ct, s) ->
+ pp f "@[<2>%a@;as@;%a@]" (core_type1 ctxt) ct tyvar s.txt
+ | Ptyp_poly ([], ct) ->
+ core_type ctxt f ct
+ | Ptyp_poly (sl, ct) ->
+ pp f "@[<2>%a%a@]"
+ (fun f l -> match l with
+ | [] -> ()
+ | _ ->
+ pp f "%a@;.@;"
+ (list tyvar_loc ~sep:"@;") l)
+ sl (core_type ctxt) ct
+ | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
+
+and core_type1 ctxt f x =
+ if x.ptyp_attributes <> [] then core_type ctxt f x
+ else match x.ptyp_desc with
+ | Ptyp_any -> pp f "_";
+ | Ptyp_var s -> tyvar f s;
+ | Ptyp_tuple l -> pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
+ | Ptyp_constr (li, l) ->
+ pp f (* "%a%a@;" *) "%a%a"
+ (fun f l -> match l with
+ |[] -> ()
+ |[x]-> pp f "%a@;" (core_type1 ctxt) x
+ | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
+ l (with_loc type_longident) li
+ | Ptyp_variant (l, closed, low) ->
+ let first_is_inherit = match l with
+ | {Parsetree.prf_desc = Rinherit _}::_ -> true
+ | _ -> false in
+ let type_variant_helper f x =
+ match x.prf_desc with
+ | Rtag (l, _, ctl) ->
+ pp f "@[<2>%a%a@;%a@]" (iter_loc string_quot) l
+ (fun f l -> match l with
+ |[] -> ()
+ | _ -> pp f "@;of@;%a"
+ (list (core_type ctxt) ~sep:"&") ctl) ctl
+ (attributes ctxt) x.prf_attributes
+ | Rinherit ct -> core_type ctxt f ct in
+ pp f "@[<2>[%a%a]@]"
+ (fun f l ->
+ match l, closed with
+ | [], Closed -> ()
+ | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
+ | _ ->
+ pp f "%s@;%a"
+ (match (closed,low) with
+ | (Closed,None) -> if first_is_inherit then " |" else ""
+ | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
+ | (Open,_) -> ">")
+ (list type_variant_helper ~sep:"@;<1 -2>| ") l) l
+ (fun f low -> match low with
+ |Some [] |None -> ()
+ |Some xs ->
+ pp f ">@ %a"
+ (list string_quot) xs) low
+ | Ptyp_object (l, o) ->
+ let core_field_type f x = match x.pof_desc with
+ | Otag (l, ct) ->
+ (* Cf #7200 *)
+ pp f "@[<hov2>%a: %a@ %a@ @]" ident_of_name l.txt
+ (core_type ctxt) ct (attributes ctxt) x.pof_attributes
+ | Oinherit ct ->
+ pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
+ in
+ let field_var f = function
+ | Asttypes.Closed -> ()
+ | Asttypes.Open ->
+ match l with
+ | [] -> pp f ".."
+ | _ -> pp f " ;.."
+ in
+ pp f "@[<hov2><@ %a%a@ > @]"
+ (list core_field_type ~sep:";") l
+ field_var o (* Cf #7200 *)
+ | Ptyp_class (li, l) -> (*FIXME*)
+ pp f "@[<hov2>%a#%a@]"
+ (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
+ (with_loc type_longident) li
+ | Ptyp_package (lid, cstrs) ->
+ let aux f (s, ct) =
+ pp f "type %a@ =@ %a"
+ (with_loc type_longident) s
+ (core_type ctxt) ct in
+ (match cstrs with
+ |[] -> pp f "@[<hov2>(module@ %a)@]" (with_loc type_longident) lid
+ |_ ->
+ pp f "@[<hov2>(module@ %a@ with@ %a)@]"
+ (with_loc type_longident) lid
+ (list aux ~sep:"@ and@ ") cstrs)
+ | Ptyp_open(li, ct) ->
+ pp f "@[<hov2>%a.(%a)@]" value_longident_loc li (core_type ctxt) ct
+ | Ptyp_extension e -> extension ctxt f e
+ | (Ptyp_arrow _ | Ptyp_alias _ | Ptyp_poly _) ->
+ paren true (core_type ctxt) f x
+
+(********************pattern********************)
+(* be cautious when use [pattern], [pattern1] is preferred *)
+and pattern ctxt f x =
+ if x.ppat_attributes <> [] then begin
+ pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
+ (attributes ctxt) x.ppat_attributes
+ end
+ else match x.ppat_desc with
+ | Ppat_alias (p, s) ->
+ pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p ident_of_name s.txt
+ | _ -> pattern_or ctxt f x
+
+and pattern_or ctxt f x =
+ let rec left_associative x acc = match x with
+ | {ppat_desc=Ppat_or (p1,p2); ppat_attributes = []} ->
+ left_associative p1 (p2 :: acc)
+ | x -> x :: acc
+ in
+ match left_associative x [] with
+ | [] -> assert false
+ | [x] -> pattern1 ctxt f x
+ | orpats ->
+ pp f "@[<hov0>%a@]" (list ~sep:"@ | " (pattern1 ctxt)) orpats
+
+and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
+ let rec pattern_list_helper f = function
+ | {ppat_desc =
+ Ppat_construct
+ ({ txt = Lident("::") ;_},
+ Some ([], {ppat_desc = Ppat_tuple([pat1; pat2]);_}));
+ ppat_attributes = []}
+
+ ->
+ pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
+ | p -> pattern1 ctxt f p
+ in
+ if x.ppat_attributes <> [] then pattern ctxt f x
+ else match x.ppat_desc with
+ | Ppat_variant (l, Some p) ->
+ pp f "@[<2>`%a@;%a@]" ident_of_name l (simple_pattern ctxt) p
+ | Ppat_construct (({txt=Lident("()"|"[]"|"true"|"false");_}), _) ->
+ simple_pattern ctxt f x
+ | Ppat_construct (({txt;_} as li), po) ->
+ (* FIXME The third field always false *)
+ if txt = Lident "::" then
+ pp f "%a" pattern_list_helper x
+ else
+ (match po with
+ | Some ([], x) ->
+ (* [true] and [false] are handled above *)
+ pp f "%a@;%a" value_longident_loc li (simple_pattern ctxt) x
+ | Some (vl, x) ->
+ pp f "%a@ (type %a)@;%a" value_longident_loc li
+ (list ~sep:"@ " ident_of_name_loc) vl
+ (simple_pattern ctxt) x
+ | None -> pp f "%a" value_longident_loc li)
+ | _ -> simple_pattern ctxt f x
+
+and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
+ if x.ppat_attributes <> [] then pattern ctxt f x
+ else match x.ppat_desc with
+ | Ppat_construct (({txt=Lident ("()"|"[]"|"true"|"false" as x);_}), None) ->
+ pp f "%s" x
+ | Ppat_any -> pp f "_";
+ | Ppat_var ({txt = txt;_}) -> ident_of_name f txt
+ | Ppat_array l ->
+ pp f "@[<2>[|%a|]@]" (list (pattern1 ctxt) ~sep:";") l
+ | Ppat_unpack { txt = None } ->
+ pp f "(module@ _)@ "
+ | Ppat_unpack { txt = Some s } ->
+ pp f "(module@ %s)@ " s
+ | Ppat_type li ->
+ pp f "#%a" (with_loc type_longident) li
+ | Ppat_record (l, closed) ->
+ let longident_x_pattern f (li, p) =
+ match (li,p) with
+ | ({txt=Lident s;_ },
+ {ppat_desc=Ppat_var {txt;_};
+ ppat_attributes=[]; _})
+ when s = txt ->
+ pp f "@[<2>%a@]" value_longident_loc li
+ | _ ->
+ pp f "@[<2>%a@;=@;%a@]" value_longident_loc li (pattern1 ctxt) p
+ in
+ begin match closed with
+ | Closed ->
+ pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
+ | _ ->
+ pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l
+ end
+ | Ppat_tuple l ->
+ pp f "@[<1>(%a)@]" (list ~sep:",@;" (pattern1 ctxt)) l (* level1*)
+ | Ppat_constant (c) -> pp f "%a" constant c
+ | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
+ | Ppat_variant (l,None) -> pp f "`%a" ident_of_name l
+ | Ppat_constraint (p, ct) ->
+ pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
+ | Ppat_lazy p ->
+ pp f "@[<2>(lazy@;%a)@]" (simple_pattern ctxt) p
+ | Ppat_exception p ->
+ pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+ | Ppat_effect(p1, p2) ->
+ pp f "@[<2>effect@;%a, @;%a@]" (pattern1 ctxt) p1 (pattern1 ctxt) p2
+ | Ppat_extension e -> extension ctxt f e
+ | Ppat_open (lid, p) ->
+ let with_paren =
+ match p.ppat_desc with
+ | Ppat_array _ | Ppat_record _
+ | Ppat_construct (({txt=Lident ("()"|"[]"|"true"|"false");_}), None) ->
+ false
+ | _ -> true in
+ pp f "@[<2>%a.%a @]" value_longident_loc lid
+ (paren with_paren @@ pattern1 ctxt) p
+ | _ -> paren true (pattern ctxt) f x
+
+and label_exp ctxt f (l,opt,p) =
+ match l with
+ | Nolabel ->
+ (* single case pattern parens needed here *)
+ pp f "%a@ " (simple_pattern ctxt) p
+ | Optional rest ->
+ begin match p with
+ | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
+ when txt = rest ->
+ (match opt with
+ | Some o ->
+ pp f "?(%a=@;%a)@;" ident_of_name rest (expression ctxt) o
+ | None -> pp f "?%a@ " ident_of_name rest)
+ | _ ->
+ (match opt with
+ | Some o ->
+ pp f "?%a:(%a=@;%a)@;"
+ ident_of_name rest (pattern1 ctxt) p (expression ctxt) o
+ | None -> pp f "?%a:%a@;" ident_of_name rest (simple_pattern ctxt) p)
+ end
+ | Labelled l -> match p with
+ | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
+ when txt = l ->
+ pp f "~%a@;" ident_of_name l
+ | _ -> pp f "~%a:%a@;" ident_of_name l (simple_pattern ctxt) p
+
+and sugar_expr ctxt f e =
+ if e.pexp_attributes <> [] then false
+ else match e.pexp_desc with
+ | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
+ pexp_attributes=[]; _}, args)
+ when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
+ let print_indexop a path_prefix assign left sep right print_index indices
+ rem_args =
+ let print_path ppf = function
+ | None -> ()
+ | Some m -> pp ppf ".%a" value_longident m in
+ match assign, rem_args with
+ | false, [] ->
+ pp f "@[%a%a%s%a%s@]"
+ (simple_expr ctxt) a print_path path_prefix
+ left (list ~sep print_index) indices right; true
+ | true, [v] ->
+ pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
+ (simple_expr ctxt) a print_path path_prefix
+ left (list ~sep print_index) indices right
+ (simple_expr ctxt) v; true
+ | _ -> false in
+ match id, List.map snd args with
+ | Lident "!", [e] ->
+ pp f "@[<hov>!%a@]" (simple_expr ctxt) e; true
+ | Ldot (path, ("get"|"set" as func)), a :: other_args -> begin
+ let assign = func = "set" in
+ let print = print_indexop a None assign in
+ match path, other_args with
+ | Lident "Array", i :: rest ->
+ print ".(" "" ")" (expression ctxt) [i] rest
+ | Lident "String", i :: rest ->
+ print ".[" "" "]" (expression ctxt) [i] rest
+ | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
+ print ".{" "," "}" (simple_expr ctxt) [i1] rest
+ | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
+ print ".{" "," "}" (simple_expr ctxt) [i1; i2] rest
+ | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
+ print ".{" "," "}" (simple_expr ctxt) [i1; i2; i3] rest
+ | Ldot (Lident "Bigarray", "Genarray"),
+ {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
+ print ".{" "," "}" (simple_expr ctxt) indexes rest
+ | _ -> false
+ end
+ | (Lident s | Ldot(_,s)) , a :: i :: rest
+ when first_is '.' s ->
+ (* extract operator:
+ assignment operators end with [right_bracket ^ "<-"],
+ access operators end with [right_bracket] directly
+ *)
+ let multi_indices = String.contains s ';' in
+ let i =
+ match i.pexp_desc with
+ | Pexp_array l when multi_indices -> l
+ | _ -> [ i ] in
+ let assign = last_is '-' s in
+ let kind =
+ (* extract the right end bracket *)
+ let n = String.length s in
+ if assign then s.[n - 3] else s.[n - 1] in
+ let left, right = match kind with
+ | ')' -> '(', ")"
+ | ']' -> '[', "]"
+ | '}' -> '{', "}"
+ | _ -> assert false in
+ let path_prefix = match id with
+ | Ldot(m,_) -> Some m
+ | _ -> None in
+ let left = String.sub s 0 (1+String.index s left) in
+ print_indexop a path_prefix assign left ";" right
+ (if multi_indices then expression ctxt else simple_expr ctxt)
+ i rest
+ | _ -> false
+ end
+ | _ -> false
+
+and function_param ctxt f param =
+ match param.pparam_desc with
+ | Pparam_val (a, b, c) -> label_exp ctxt f (a, b, c)
+ | Pparam_newtype ty -> pp f "(type %a)@;" ident_of_name ty.txt
+
+and function_body ctxt f function_body =
+ match function_body with
+ | Pfunction_body body -> expression ctxt f body
+ | Pfunction_cases (cases, _, attrs) ->
+ pp f "@[<hv>function%a%a@]"
+ (item_attributes ctxt) attrs
+ (case_list ctxt) cases
+
+and type_constraint ctxt f constraint_ =
+ match constraint_ with
+ | Pconstraint ty ->
+ pp f ":@;%a" (core_type ctxt) ty
+ | Pcoerce (ty1, ty2) ->
+ pp f "%a:>@;%a"
+ (option ~first:":@;" (core_type ctxt)) ty1
+ (core_type ctxt) ty2
+
+and function_params_then_body ctxt f params constraint_ body ~delimiter =
+ pp f "%a%a%s@;%a"
+ (list (function_param ctxt) ~sep:"") params
+ (option (type_constraint ctxt)) constraint_
+ delimiter
+ (function_body (under_functionrhs ctxt)) body
+
+and expression ctxt f x =
+ if x.pexp_attributes <> [] then
+ pp f "((%a)@,%a)" (expression ctxt) {x with pexp_attributes=[]}
+ (attributes ctxt) x.pexp_attributes
+ else match x.pexp_desc with
+ | Pexp_function _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+ | Pexp_newtype _
+ when ctxt.pipe || ctxt.semi ->
+ paren true (expression reset_ctxt) f x
+ | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse ->
+ paren true (expression reset_ctxt) f x
+ | Pexp_let _ | Pexp_letmodule _ | Pexp_open _
+ | Pexp_letexception _ | Pexp_letop _
+ when ctxt.semi ->
+ paren true (expression reset_ctxt) f x
+ | Pexp_newtype (lid, e) ->
+ pp f "@[<2>fun@;(type@;%a)@;->@;%a@]" ident_of_name lid.txt
+ (expression ctxt) e
+ | Pexp_function (params, c, body) ->
+ begin match params, c with
+ (* Omit [fun] if there are no params. *)
+ | [], None ->
+ (* If function cases are a direct body of a function,
+ the function node should be wrapped in parens so
+ it doesn't become part of the enclosing function. *)
+ let should_paren =
+ match body with
+ | Pfunction_cases _ -> ctxt.functionrhs
+ | Pfunction_body _ -> false
+ in
+ let ctxt' = if should_paren then reset_ctxt else ctxt in
+ pp f "@[<2>%a@]" (paren should_paren (function_body ctxt')) body
+ | [], Some c ->
+ pp f "@[<2>(%a@;%a)@]"
+ (function_body ctxt) body
+ (type_constraint ctxt) c
+ | _ :: _, _ ->
+ pp f "@[<2>fun@;%a@]"
+ (fun f () ->
+ function_params_then_body ctxt f params c body ~delimiter:"->")
+ ();
+
+ end
+ | Pexp_match (e, l) ->
+ pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]"
+ (expression reset_ctxt) e (case_list ctxt) l
+
+ | Pexp_try (e, l) ->
+ pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
+ (* "try@;@[<2>%a@]@\nwith@\n%a"*)
+ (expression reset_ctxt) e (case_list ctxt) l
+ | Pexp_let (rf, l, e) ->
+ (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
+ (*no indentation here, a new line*) *)
+ (* rec_flag rf *)
+ pp f "@[<2>%a in@;<1 -2>%a@]"
+ (bindings reset_ctxt) (rf,l)
+ (expression ctxt) e
+ | Pexp_apply (e, l) ->
+ begin if not (sugar_expr ctxt f x) then
+ match view_fixity_of_exp e with
+ | `Infix s ->
+ begin match l with
+ | [ (Nolabel, _) as arg1; (Nolabel, _) as arg2 ] ->
+ (* FIXME associativity label_x_expression_param *)
+ pp f "@[<2>%a@;%s@;%a@]"
+ (label_x_expression_param reset_ctxt) arg1 s
+ (label_x_expression_param ctxt) arg2
+ | _ ->
+ pp f "@[<2>%a %a@]"
+ (simple_expr ctxt) e
+ (list (label_x_expression_param ctxt)) l
+ end
+ | `Prefix s ->
+ let s =
+ if List.mem s ["~+";"~-";"~+.";"~-."] &&
+ (match l with
+ (* See #7200: avoid turning (~- 1) into (- 1) which is
+ parsed as an int literal *)
+ |[(_,{pexp_desc=Pexp_constant _})] -> false
+ | _ -> true)
+ then String.sub s 1 (String.length s -1)
+ else s in
+ begin match l with
+ | [(Nolabel, x)] ->
+ pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
+ | _ ->
+ pp f "@[<2>%a %a@]" (simple_expr ctxt) e
+ (list (label_x_expression_param ctxt)) l
+ end
+ | _ ->
+ pp f "@[<hov2>%a@]" begin fun f (e,l) ->
+ pp f "%a@ %a" (expression2 ctxt) e
+ (list (label_x_expression_param reset_ctxt)) l
+ (* reset here only because [function,match,try,sequence]
+ are lower priority *)
+ end (e,l)
+ end
+
+ | Pexp_construct (li, Some eo)
+ when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
+ (match view_expr x with
+ | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
+ | `normal ->
+ pp f "@[<2>%a@;%a@]" (with_loc constr) li
+ (simple_expr ctxt) eo
+ | _ -> assert false)
+ | Pexp_setfield (e1, li, e2) ->
+ pp f "@[<2>%a.%a@ <-@ %a@]"
+ (simple_expr ctxt) e1 value_longident_loc li (simple_expr ctxt) e2
+ | Pexp_ifthenelse (e1, e2, eo) ->
+ (* @;@[<2>else@ %a@]@] *)
+ let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
+ let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
+ pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
+ (fun f eo -> match eo with
+ | Some x ->
+ pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
+ | None -> () (* pp f "()" *)) eo
+ | Pexp_sequence _ ->
+ let rec sequence_helper acc = function
+ | {pexp_desc=Pexp_sequence(e1,e2); pexp_attributes = []} ->
+ sequence_helper (e1::acc) e2
+ | v -> List.rev (v::acc) in
+ let lst = sequence_helper [] x in
+ pp f "@[<hv>%a@]"
+ (list (expression (under_semi ctxt)) ~sep:";@;") lst
+ | Pexp_new (li) ->
+ pp f "@[<hov2>new@ %a@]" (with_loc type_longident) li;
+ | Pexp_setinstvar (s, e) ->
+ pp f "@[<hov2>%a@ <-@ %a@]" ident_of_name s.txt (expression ctxt) e
+ | Pexp_override l -> (* FIXME *)
+ let string_x_expression f (s, e) =
+ pp f "@[<hov2>%a@ =@ %a@]" ident_of_name s.txt (expression ctxt) e in
+ pp f "@[<hov2>{<%a>}@]"
+ (list string_x_expression ~sep:";" ) l;
+ | Pexp_letmodule (s, me, e) ->
+ pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]"
+ (Option.value s.txt ~default:"_")
+ (module_expr reset_ctxt) me (expression ctxt) e
+ | Pexp_letexception (cd, e) ->
+ pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
+ (extension_constructor ctxt) cd
+ (expression ctxt) e
+ | Pexp_assert e ->
+ pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
+ | Pexp_lazy (e) ->
+ pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
+ (* Pexp_poly: impossible but we should print it anyway, rather than
+ assert false *)
+ | Pexp_poly (e, None) ->
+ pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
+ | Pexp_poly (e, Some ct) ->
+ pp f "@[<hov2>(!poly!@ %a@ : %a)@]"
+ (simple_expr ctxt) e (core_type ctxt) ct
+ | Pexp_open (o, e) ->
+ pp f "@[<2>let open%s %a in@;%a@]"
+ (override o.popen_override) (module_expr ctxt) o.popen_expr
+ (expression ctxt) e
+ | Pexp_variant (l,Some eo) ->
+ pp f "@[<2>`%a@;%a@]" ident_of_name l (simple_expr ctxt) eo
+ | Pexp_letop {let_; ands; body} ->
+ pp f "@[<2>@[<v>%a@,%a@] in@;<1 -2>%a@]"
+ (binding_op ctxt) let_
+ (list ~sep:"@," (binding_op ctxt)) ands
+ (expression ctxt) body
+ | Pexp_extension e -> extension ctxt f e
+ | Pexp_unreachable -> pp f "."
+ | _ -> expression1 ctxt f x
+
+and expression1 ctxt f x =
+ if x.pexp_attributes <> [] then expression ctxt f x
+ else match x.pexp_desc with
+ | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
+ | _ -> expression2 ctxt f x
+(* used in [Pexp_apply] *)
+
+and expression2 ctxt f x =
+ if x.pexp_attributes <> [] then expression ctxt f x
+ else match x.pexp_desc with
+ | Pexp_field (e, li) ->
+ pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e value_longident_loc li
+ | Pexp_send (e, s) ->
+ pp f "@[<hov2>%a#%a@]" (simple_expr ctxt) e ident_of_name s.txt
+
+ | _ -> simple_expr ctxt f x
+
+and simple_expr ctxt f x =
+ if x.pexp_attributes <> [] then expression ctxt f x
+ else match x.pexp_desc with
+ | Pexp_construct _ when is_simple_construct (view_expr x) ->
+ (match view_expr x with
+ | `nil -> pp f "[]"
+ | `tuple -> pp f "()"
+ | `btrue -> pp f "true"
+ | `bfalse -> pp f "false"
+ | `list xs ->
+ pp f "@[<hv0>[%a]@]"
+ (list (expression (under_semi ctxt)) ~sep:";@;") xs
+ | `simple x -> constr f x
+ | _ -> assert false)
+ | Pexp_ident li ->
+ value_longident_loc f li
+ (* (match view_fixity_of_exp x with *)
+ (* |`Normal -> longident_loc f li *)
+ (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
+ | Pexp_constant c -> constant f c;
+ | Pexp_pack me ->
+ pp f "(module@;%a)" (module_expr ctxt) me
+ | Pexp_tuple l ->
+ pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
+ | Pexp_constraint (e, ct) ->
+ pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
+ | Pexp_coerce (e, cto1, ct) ->
+ pp f "(%a%a :> %a)" (expression ctxt) e
+ (option (core_type ctxt) ~first:" : " ~last:" ") cto1 (* no sep hint*)
+ (core_type ctxt) ct
+ | Pexp_variant (l, None) -> pp f "`%a" ident_of_name l
+ | Pexp_record (l, eo) ->
+ let longident_x_expression f ( li, e) =
+ match e with
+ | {pexp_desc=Pexp_ident {txt;_};
+ pexp_attributes=[]; _} when li.txt = txt ->
+ pp f "@[<hov2>%a@]" value_longident_loc li
+ | _ ->
+ pp f "@[<hov2>%a@;=@;%a@]"
+ value_longident_loc li
+ (simple_expr ctxt) e
+ in
+ pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
+ (option ~last:" with@;" (simple_expr ctxt)) eo
+ (list longident_x_expression ~sep:";@;") l
+ | Pexp_array (l) ->
+ pp f "@[<0>@[<2>[|%a|]@]@]"
+ (list (simple_expr (under_semi ctxt)) ~sep:";") l
+ | Pexp_while (e1, e2) ->
+ let fmt : (_,_,_) format = "@[<2>while@;%a@;do@;%a@;done@]" in
+ pp f fmt (expression ctxt) e1 (expression ctxt) e2
+ | Pexp_for (s, e1, e2, df, e3) ->
+ let fmt:(_,_,_)format =
+ "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
+ let expression = expression ctxt in
+ pp f fmt (pattern ctxt) s expression e1 direction_flag
+ df expression e2 expression e3
+ | _ -> paren true (expression ctxt) f x
+
+and attributes ctxt f l =
+ List.iter (attribute ctxt f) l
+
+and item_attributes ctxt f l =
+ List.iter (item_attribute ctxt f) l
+
+and attribute ctxt f a =
+ pp f "@[<2>[@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and item_attribute ctxt f a =
+ pp f "@[<2>[@@@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and floating_attribute ctxt f a =
+ pp f "@[<2>[@@@@@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and value_description ctxt f x =
+ (* note: value_description has an attribute field,
+ but they're already printed by the callers this method *)
+ pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
+ (fun f x ->
+ if x.pval_prim <> []
+ then pp f "@ =@ %a" (list constant_string) x.pval_prim
+ ) x
+
+and extension ctxt f (s, e) =
+ pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and item_extension ctxt f (s, e) =
+ pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and exception_declaration ctxt f x =
+ pp f "@[<hov2>exception@ %a@]%a"
+ (extension_constructor ctxt) x.ptyexn_constructor
+ (item_attributes ctxt) x.ptyexn_attributes
+
+and class_type_field ctxt f x =
+ match x.pctf_desc with
+ | Pctf_inherit (ct) ->
+ pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_val (s, mf, vf, ct) ->
+ pp f "@[<2>val @ %a%a%a@ :@ %a@]%a"
+ mutable_flag mf virtual_flag vf
+ ident_of_name s.txt (core_type ctxt) ct
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_method (s, pf, vf, ct) ->
+ pp f "@[<2>method %a %a%a :@;%a@]%a"
+ private_flag pf virtual_flag vf
+ ident_of_name s.txt (core_type ctxt) ct
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_constraint (ct1, ct2) ->
+ pp f "@[<2>constraint@ %a@ =@ %a@]%a"
+ (core_type ctxt) ct1 (core_type ctxt) ct2
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_attribute a -> floating_attribute ctxt f a
+ | Pctf_extension e ->
+ item_extension ctxt f e;
+ item_attributes ctxt f x.pctf_attributes
+
+and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
+ pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
+ (fun f -> function
+ {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
+ | ct -> pp f " (%a)" (core_type ctxt) ct) ct
+ (list (class_type_field ctxt) ~sep:"@;") l
+
+(* call [class_signature] called by [class_signature] *)
+and class_type ctxt f x =
+ match x.pcty_desc with
+ | Pcty_signature cs ->
+ class_signature ctxt f cs;
+ attributes ctxt f x.pcty_attributes
+ | Pcty_constr (li, l) ->
+ pp f "%a%a%a"
+ (fun f l -> match l with
+ | [] -> ()
+ | _ -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
+ (with_loc type_longident) li
+ (attributes ctxt) x.pcty_attributes
+ | Pcty_arrow (l, co, cl) ->
+ pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+ (type_with_label ctxt) (l,co)
+ (class_type ctxt) cl
+ | Pcty_extension e ->
+ extension ctxt f e;
+ attributes ctxt f x.pcty_attributes
+ | Pcty_open (o, e) ->
+ pp f "@[<2>let open%s %a in@;%a@]"
+ (override o.popen_override) value_longident_loc o.popen_expr
+ (class_type ctxt) e
+
+(* [class type a = object end] *)
+and class_type_declaration_list ctxt f l =
+ let class_type_declaration kwd f x =
+ let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
+ pp f "@[<2>%s %a%a%a@ =@ %a@]%a" kwd
+ virtual_flag x.pci_virt
+ (class_params_def ctxt) ls
+ ident_of_name txt
+ (class_type ctxt) x.pci_expr
+ (item_attributes ctxt) x.pci_attributes
+ in
+ match l with
+ | [] -> ()
+ | [x] -> class_type_declaration "class type" f x
+ | x :: xs ->
+ pp f "@[<v>%a@,%a@]"
+ (class_type_declaration "class type") x
+ (list ~sep:"@," (class_type_declaration "and")) xs
+
+and class_field ctxt f x =
+ match x.pcf_desc with
+ | Pcf_inherit (ovf, ce, so) ->
+ pp f "@[<2>inherit@ %s@ %a%a@]%a" (override ovf)
+ (class_expr ctxt) ce
+ (fun f so -> match so with
+ | None -> ();
+ | Some (s) -> pp f "@ as %a" ident_of_name s.txt ) so
+ (item_attributes ctxt) x.pcf_attributes
+ | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
+ pp f "@[<2>val%s %a%a =@;%a@]%a" (override ovf)
+ mutable_flag mf
+ ident_of_name s.txt
+ (expression ctxt) e
+ (item_attributes ctxt) x.pcf_attributes
+ | Pcf_method (s, pf, Cfk_virtual ct) ->
+ pp f "@[<2>method virtual %a %a :@;%a@]%a"
+ private_flag pf
+ ident_of_name s.txt
+ (core_type ctxt) ct
+ (item_attributes ctxt) x.pcf_attributes
+ | Pcf_val (s, mf, Cfk_virtual ct) ->
+ pp f "@[<2>val virtual %a%a :@ %a@]%a"
+ mutable_flag mf
+ ident_of_name s.txt
+ (core_type ctxt) ct
+ (item_attributes ctxt) x.pcf_attributes
+ | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
+ let bind e =
+ binding ctxt f
+ {pvb_pat=
+ {ppat_desc=Ppat_var s;
+ ppat_loc=Location.none;
+ ppat_loc_stack=[];
+ ppat_attributes=[]};
+ pvb_expr=e;
+ pvb_constraint=None;
+ pvb_attributes=[];
+ pvb_loc=Location.none;
+ }
+ in
+ pp f "@[<2>method%s %a%a@]%a"
+ (override ovf)
+ private_flag pf
+ (fun f -> function
+ | {pexp_desc=Pexp_poly (e, Some ct); pexp_attributes=[]; _} ->
+ pp f "%a :@;%a=@;%a"
+ ident_of_name s.txt (core_type ctxt) ct (expression ctxt) e
+ | {pexp_desc=Pexp_poly (e, None); pexp_attributes=[]; _} ->
+ bind e
+ | _ -> bind e) e
+ (item_attributes ctxt) x.pcf_attributes
+ | Pcf_constraint (ct1, ct2) ->
+ pp f "@[<2>constraint %a =@;%a@]%a"
+ (core_type ctxt) ct1
+ (core_type ctxt) ct2
+ (item_attributes ctxt) x.pcf_attributes
+ | Pcf_initializer (e) ->
+ pp f "@[<2>initializer@ %a@]%a"
+ (expression ctxt) e
+ (item_attributes ctxt) x.pcf_attributes
+ | Pcf_attribute a -> floating_attribute ctxt f a
+ | Pcf_extension e ->
+ item_extension ctxt f e;
+ item_attributes ctxt f x.pcf_attributes
+
+and class_structure ctxt f { pcstr_self = p; pcstr_fields = l } =
+ pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
+ (fun f p -> match p.ppat_desc with
+ | Ppat_any -> ()
+ | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
+ | _ -> pp f " (%a)" (pattern ctxt) p) p
+ (list (class_field ctxt)) l
+
+and class_expr ctxt f x =
+ if x.pcl_attributes <> [] then begin
+ pp f "((%a)%a)" (class_expr ctxt) {x with pcl_attributes=[]}
+ (attributes ctxt) x.pcl_attributes
+ end else
+ match x.pcl_desc with
+ | Pcl_structure (cs) -> class_structure ctxt f cs
+ | Pcl_fun (l, eo, p, e) ->
+ pp f "fun@ %a@ ->@ %a"
+ (label_exp ctxt) (l,eo,p)
+ (class_expr ctxt) e
+ | Pcl_let (rf, l, ce) ->
+ pp f "%a@ in@ %a"
+ (bindings ctxt) (rf,l)
+ (class_expr ctxt) ce
+ | Pcl_apply (ce, l) ->
+ pp f "((%a)@ %a)" (* Cf: #7200 *)
+ (class_expr ctxt) ce
+ (list (label_x_expression_param ctxt)) l
+ | Pcl_constr (li, l) ->
+ pp f "%a%a"
+ (fun f l-> if l <>[] then
+ pp f "[%a]@ "
+ (list (core_type ctxt) ~sep:",") l) l
+ (with_loc type_longident) li
+ | Pcl_constraint (ce, ct) ->
+ pp f "(%a@ :@ %a)"
+ (class_expr ctxt) ce
+ (class_type ctxt) ct
+ | Pcl_extension e -> extension ctxt f e
+ | Pcl_open (o, e) ->
+ pp f "@[<2>let open%s %a in@;%a@]"
+ (override o.popen_override) value_longident_loc o.popen_expr
+ (class_expr ctxt) e
+
+and module_type ctxt f x =
+ if x.pmty_attributes <> [] then begin
+ pp f "((%a)%a)" (module_type ctxt) {x with pmty_attributes=[]}
+ (attributes ctxt) x.pmty_attributes
+ end else
+ match x.pmty_desc with
+ | Pmty_functor (Unit, mt2) ->
+ pp f "@[<hov2>() ->@ %a@]" (module_type ctxt) mt2
+ | Pmty_functor (Named (s, mt1), mt2) ->
+ begin match s.txt with
+ | None ->
+ pp f "@[<hov2>%a@ ->@ %a@]"
+ (module_type1 ctxt) mt1 (module_type ctxt) mt2
+ | Some name ->
+ pp f "@[<hov2>(%s@ :@ %a)@ ->@ %a@]" name
+ (module_type ctxt) mt1 (module_type ctxt) mt2
+ end
+ | Pmty_with (mt, []) -> module_type ctxt f mt
+ | Pmty_with (mt, l) ->
+ pp f "@[<hov2>%a@ with@ %a@]"
+ (module_type1 ctxt) mt
+ (list (with_constraint ctxt) ~sep:"@ and@ ") l
+ | _ -> module_type1 ctxt f x
+
+and with_constraint ctxt f = function
+ | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
+ pp f "type@ %a %a =@ %a"
+ (type_params ctxt) ls
+ (with_loc type_longident) li (type_declaration ctxt) td
+ | Pwith_module (li, li2) ->
+ pp f "module %a =@ %a" value_longident_loc li value_longident_loc li2;
+ | Pwith_modtype (li, mty) ->
+ pp f "module type %a =@ %a"
+ (with_loc type_longident) li
+ (module_type ctxt) mty;
+ | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
+ pp f "type@ %a %a :=@ %a"
+ (type_params ctxt) ls
+ (with_loc type_longident) li
+ (type_declaration ctxt) td
+ | Pwith_modsubst (li, li2) ->
+ pp f "module %a :=@ %a" value_longident_loc li value_longident_loc li2
+ | Pwith_modtypesubst (li, mty) ->
+ pp f "module type %a :=@ %a"
+ (with_loc type_longident) li
+ (module_type ctxt) mty;
+
+
+and module_type1 ctxt f x =
+ if x.pmty_attributes <> [] then module_type ctxt f x
+ else match x.pmty_desc with
+ | Pmty_ident li ->
+ pp f "%a" (with_loc type_longident) li;
+ | Pmty_alias li ->
+ pp f "(module %a)" (with_loc type_longident) li;
+ | Pmty_signature (s) ->
+ pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+ (list (signature_item ctxt)) s (* FIXME wrong indentation*)
+ | Pmty_typeof me ->
+ pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
+ | Pmty_extension e -> extension ctxt f e
+ | _ -> paren true (module_type ctxt) f x
+
+and signature ctxt f x = list ~sep:"@\n" (signature_item ctxt) f x
+
+and signature_item ctxt f x : unit =
+ match x.psig_desc with
+ | Psig_type (rf, l) ->
+ type_def_list ctxt f (rf, true, l)
+ | Psig_typesubst l ->
+ (* Psig_typesubst is never recursive, but we specify [Recursive] here to
+ avoid printing a [nonrec] flag, which would be rejected by the parser.
+ *)
+ type_def_list ctxt f (Recursive, false, l)
+ | Psig_value vd ->
+ let intro = if vd.pval_prim = [] then "val" else "external" in
+ pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
+ ident_of_name vd.pval_name.txt
+ (value_description ctxt) vd
+ (item_attributes ctxt) vd.pval_attributes
+ | Psig_typext te ->
+ type_extension ctxt f te
+ | Psig_exception ed ->
+ exception_declaration ctxt f ed
+ | Psig_class l ->
+ let class_description kwd f ({pci_params=ls;pci_name={txt;_};_} as x) =
+ pp f "@[<2>%s %a%a%a@;:@;%a@]%a" kwd
+ virtual_flag x.pci_virt
+ (class_params_def ctxt) ls
+ ident_of_name txt
+ (class_type ctxt) x.pci_expr
+ (item_attributes ctxt) x.pci_attributes
+ in begin
+ match l with
+ | [] -> ()
+ | [x] -> class_description "class" f x
+ | x :: xs ->
+ pp f "@[<v>%a@,%a@]"
+ (class_description "class") x
+ (list ~sep:"@," (class_description "and")) xs
+ end
+ | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
+ pmty_attributes=[]; _};_} as pmd) ->
+ pp f "@[<hov>module@ %s@ =@ %a@]%a"
+ (Option.value pmd.pmd_name.txt ~default:"_")
+ value_longident_loc alias
+ (item_attributes ctxt) pmd.pmd_attributes
+ | Psig_module pmd ->
+ pp f "@[<hov>module@ %s@ :@ %a@]%a"
+ (Option.value pmd.pmd_name.txt ~default:"_")
+ (module_type ctxt) pmd.pmd_type
+ (item_attributes ctxt) pmd.pmd_attributes
+ | Psig_modsubst pms ->
+ pp f "@[<hov>module@ %s@ :=@ %a@]%a" pms.pms_name.txt
+ value_longident_loc pms.pms_manifest
+ (item_attributes ctxt) pms.pms_attributes
+ | Psig_open od ->
+ pp f "@[<hov2>open%s@ %a@]%a"
+ (override od.popen_override)
+ value_longident_loc od.popen_expr
+ (item_attributes ctxt) od.popen_attributes
+ | Psig_include incl ->
+ pp f "@[<hov2>include@ %a@]%a"
+ (module_type ctxt) incl.pincl_mod
+ (item_attributes ctxt) incl.pincl_attributes
+ | Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+ pp f "@[<hov2>module@ type@ %a%a@]%a"
+ ident_of_name s.txt
+ (fun f md -> match md with
+ | None -> ()
+ | Some mt ->
+ pp_print_space f () ;
+ pp f "@ =@ %a" (module_type ctxt) mt
+ ) md
+ (item_attributes ctxt) attrs
+ | Psig_modtypesubst {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+ let md = match md with
+ | None -> assert false (* ast invariant *)
+ | Some mt -> mt in
+ pp f "@[<hov2>module@ type@ %s@ :=@ %a@]%a"
+ s.txt (module_type ctxt) md
+ (item_attributes ctxt) attrs
+ | Psig_class_type (l) -> class_type_declaration_list ctxt f l
+ | Psig_recmodule decls ->
+ let rec string_x_module_type_list f ?(first=true) l =
+ match l with
+ | [] -> () ;
+ | pmd :: tl ->
+ if not first then
+ pp f "@ @[<hov2>and@ %s:@ %a@]%a"
+ (Option.value pmd.pmd_name.txt ~default:"_")
+ (module_type1 ctxt) pmd.pmd_type
+ (item_attributes ctxt) pmd.pmd_attributes
+ else
+ pp f "@[<hov2>module@ rec@ %s:@ %a@]%a"
+ (Option.value pmd.pmd_name.txt ~default:"_")
+ (module_type1 ctxt) pmd.pmd_type
+ (item_attributes ctxt) pmd.pmd_attributes;
+ string_x_module_type_list f ~first:false tl
+ in
+ string_x_module_type_list f decls
+ | Psig_attribute a -> floating_attribute ctxt f a
+ | Psig_extension(e, a) ->
+ item_extension ctxt f e;
+ item_attributes ctxt f a
+
+and module_expr ctxt f x =
+ if x.pmod_attributes <> [] then
+ pp f "((%a)%a)" (module_expr ctxt) {x with pmod_attributes=[]}
+ (attributes ctxt) x.pmod_attributes
+ else match x.pmod_desc with
+ | Pmod_structure (s) ->
+ pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
+ (list (structure_item ctxt) ~sep:"@\n") s;
+ | Pmod_constraint (me, mt) ->
+ pp f "@[<hov2>(%a@ :@ %a)@]"
+ (module_expr ctxt) me
+ (module_type ctxt) mt
+ | Pmod_ident (li) ->
+ pp f "%a" value_longident_loc li;
+ | Pmod_functor (Unit, me) ->
+ pp f "functor ()@;->@;%a" (module_expr ctxt) me
+ | Pmod_functor (Named (s, mt), me) ->
+ pp f "functor@ (%s@ :@ %a)@;->@;%a"
+ (Option.value s.txt ~default:"_")
+ (module_type ctxt) mt (module_expr ctxt) me
+ | Pmod_apply (me1, me2) ->
+ pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
+ (* Cf: #7200 *)
+ | Pmod_apply_unit me1 ->
+ pp f "(%a)()" (module_expr ctxt) me1
+ | Pmod_unpack e ->
+ pp f "(val@ %a)" (expression ctxt) e
+ | Pmod_extension e -> extension ctxt f e
+
+and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
+
+and payload ctxt f = function
+ | PStr [{pstr_desc = Pstr_eval (e, attrs)}] ->
+ pp f "@[<2>%a@]%a"
+ (expression ctxt) e
+ (item_attributes ctxt) attrs
+ | PStr x -> structure ctxt f x
+ | PTyp x -> pp f ":@ "; core_type ctxt f x
+ | PSig x -> pp f ":@ "; signature ctxt f x
+ | PPat (x, None) -> pp f "?@ "; pattern ctxt f x
+ | PPat (x, Some e) ->
+ pp f "?@ "; pattern ctxt f x;
+ pp f " when "; expression ctxt f e
+
+(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
+and binding ctxt f {pvb_pat=p; pvb_expr=x; pvb_constraint = ct; _} =
+ (* .pvb_attributes have already been printed by the caller, #bindings *)
+ let rec pp_print_pexp_function f x =
+ if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
+ else match x.pexp_desc with
+ | Pexp_function (params, c, body) ->
+ function_params_then_body ctxt f params c body ~delimiter:"="
+ | Pexp_newtype (str,e) ->
+ pp f "(type@ %a)@ %a" ident_of_name str.txt pp_print_pexp_function e
+ | _ -> pp f "=@;%a" (expression ctxt) x
+ in
+ match ct with
+ | Some (Pvc_constraint { locally_abstract_univars = []; typ }) ->
+ pp f "%a@;:@;%a@;=@;%a"
+ (simple_pattern ctxt) p (core_type ctxt) typ (expression ctxt) x
+ | Some (Pvc_constraint { locally_abstract_univars = vars; typ }) ->
+ pp f "%a@;: type@;%a.@;%a@;=@;%a"
+ (simple_pattern ctxt) p (list ident_of_name ~sep:"@;")
+ (List.map (fun x -> x.txt) vars)
+ (core_type ctxt) typ (expression ctxt) x
+ | Some (Pvc_coercion {ground=None; coercion }) ->
+ pp f "%a@;:>@;%a@;=@;%a"
+ (simple_pattern ctxt) p (core_type ctxt) coercion (expression ctxt) x
+ | Some (Pvc_coercion {ground=Some ground; coercion }) ->
+ pp f "%a@;:%a@;:>@;%a@;=@;%a"
+ (simple_pattern ctxt) p
+ (core_type ctxt) ground
+ (core_type ctxt) coercion
+ (expression ctxt) x
+ | None -> begin
+ match p with
+ | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
+ pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
+ | _ ->
+ pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+ end
+
+(* [in] is not printed *)
+and bindings ctxt f (rf,l) =
+ let binding kwd rf f x =
+ pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf
+ (binding ctxt) x (item_attributes ctxt) x.pvb_attributes
+ in
+ match l with
+ | [] -> ()
+ | [x] -> binding "let" rf f x
+ | x::xs ->
+ pp f "@[<v>%a@,%a@]"
+ (binding "let" rf) x
+ (list ~sep:"@," (binding "and" Nonrecursive)) xs
+
+and binding_op ctxt f x =
+ match x.pbop_pat, x.pbop_exp with
+ | {ppat_desc = Ppat_var { txt=pvar; _ }; ppat_attributes = []; _},
+ {pexp_desc = Pexp_ident { txt=Lident evar; _}; pexp_attributes = []; _}
+ when pvar = evar ->
+ pp f "@[<2>%s %s@]" x.pbop_op.txt evar
+ | pat, exp ->
+ pp f "@[<2>%s %a@;=@;%a@]"
+ x.pbop_op.txt (pattern ctxt) pat (expression ctxt) exp
+
+and structure_item ctxt f x =
+ match x.pstr_desc with
+ | Pstr_eval (e, attrs) ->
+ pp f "@[<hov2>;;%a@]%a"
+ (expression ctxt) e
+ (item_attributes ctxt) attrs
+ | Pstr_type (_, []) -> assert false
+ | Pstr_type (rf, l) -> type_def_list ctxt f (rf, true, l)
+ | Pstr_value (rf, l) ->
+ (* pp f "@[<hov2>let %a%a@]" rec_flag rf bindings l *)
+ pp f "@[<2>%a@]" (bindings ctxt) (rf,l)
+ | Pstr_typext te -> type_extension ctxt f te
+ | Pstr_exception ed -> exception_declaration ctxt f ed
+ | Pstr_module x ->
+ let rec module_helper = function
+ | {pmod_desc=Pmod_functor(arg_opt,me'); pmod_attributes = []} ->
+ begin match arg_opt with
+ | Unit -> pp f "()"
+ | Named (s, mt) ->
+ pp f "(%s:%a)" (Option.value s.txt ~default:"_")
+ (module_type ctxt) mt
+ end;
+ module_helper me'
+ | me -> me
+ in
+ pp f "@[<hov2>module %s%a@]%a"
+ (Option.value x.pmb_name.txt ~default:"_")
+ (fun f me ->
+ let me = module_helper me in
+ match me with
+ | {pmod_desc=
+ Pmod_constraint
+ (me',
+ ({pmty_desc=(Pmty_ident (_)
+ | Pmty_signature (_));_} as mt));
+ pmod_attributes = []} ->
+ pp f " :@;%a@;=@;%a@;"
+ (module_type ctxt) mt (module_expr ctxt) me'
+ | _ -> pp f " =@ %a" (module_expr ctxt) me
+ ) x.pmb_expr
+ (item_attributes ctxt) x.pmb_attributes
+ | Pstr_open od ->
+ pp f "@[<2>open%s@;%a@]%a"
+ (override od.popen_override)
+ (module_expr ctxt) od.popen_expr
+ (item_attributes ctxt) od.popen_attributes
+ | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+ pp f "@[<hov2>module@ type@ %a%a@]%a"
+ ident_of_name s.txt
+ (fun f md -> match md with
+ | None -> ()
+ | Some mt ->
+ pp_print_space f () ;
+ pp f "@ =@ %a" (module_type ctxt) mt
+ ) md
+ (item_attributes ctxt) attrs
+ | Pstr_class l ->
+ let extract_class_args cl =
+ let rec loop acc = function
+ | {pcl_desc=Pcl_fun (l, eo, p, cl'); pcl_attributes = []} ->
+ loop ((l,eo,p) :: acc) cl'
+ | cl -> List.rev acc, cl
+ in
+ let args, cl = loop [] cl in
+ let constr, cl =
+ match cl with
+ | {pcl_desc=Pcl_constraint (cl', ct); pcl_attributes = []} ->
+ Some ct, cl'
+ | _ -> None, cl
+ in
+ args, constr, cl
+ in
+ let class_constraint f ct = pp f ": @[%a@] " (class_type ctxt) ct in
+ let class_declaration kwd f
+ ({pci_params=ls; pci_name={txt;_}; _} as x) =
+ let args, constr, cl = extract_class_args x.pci_expr in
+ pp f "@[<2>%s %a%a%a %a%a=@;%a@]%a" kwd
+ virtual_flag x.pci_virt
+ (class_params_def ctxt) ls
+ ident_of_name txt
+ (list (label_exp ctxt)) args
+ (option class_constraint) constr
+ (class_expr ctxt) cl
+ (item_attributes ctxt) x.pci_attributes
+ in begin
+ match l with
+ | [] -> ()
+ | [x] -> class_declaration "class" f x
+ | x :: xs ->
+ pp f "@[<v>%a@,%a@]"
+ (class_declaration "class") x
+ (list ~sep:"@," (class_declaration "and")) xs
+ end
+ | Pstr_class_type l -> class_type_declaration_list ctxt f l
+ | Pstr_primitive vd ->
+ pp f "@[<hov2>external@ %a@ :@ %a@]%a"
+ ident_of_name vd.pval_name.txt
+ (value_description ctxt) vd
+ (item_attributes ctxt) vd.pval_attributes
+ | Pstr_include incl ->
+ pp f "@[<hov2>include@ %a@]%a"
+ (module_expr ctxt) incl.pincl_mod
+ (item_attributes ctxt) incl.pincl_attributes
+ | Pstr_recmodule decls -> (* 3.07 *)
+ let aux f = function
+ | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
+ pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a"
+ (Option.value pmb.pmb_name.txt ~default:"_")
+ (module_type ctxt) typ
+ (module_expr ctxt) expr
+ (item_attributes ctxt) pmb.pmb_attributes
+ | pmb ->
+ pp f "@[<hov2>@ and@ %s@ =@ %a@]%a"
+ (Option.value pmb.pmb_name.txt ~default:"_")
+ (module_expr ctxt) pmb.pmb_expr
+ (item_attributes ctxt) pmb.pmb_attributes
+ in
+ begin match decls with
+ | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
+ pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
+ (Option.value pmb.pmb_name.txt ~default:"_")
+ (module_type ctxt) typ
+ (module_expr ctxt) expr
+ (item_attributes ctxt) pmb.pmb_attributes
+ (fun f l2 -> List.iter (aux f) l2) l2
+ | pmb :: l2 ->
+ pp f "@[<hv>@[<hov2>module@ rec@ %s@ =@ %a@]%a@ %a@]"
+ (Option.value pmb.pmb_name.txt ~default:"_")
+ (module_expr ctxt) pmb.pmb_expr
+ (item_attributes ctxt) pmb.pmb_attributes
+ (fun f l2 -> List.iter (aux f) l2) l2
+ | _ -> assert false
+ end
+ | Pstr_attribute a -> floating_attribute ctxt f a
+ | Pstr_extension(e, a) ->
+ item_extension ctxt f e;
+ item_attributes ctxt f a
+
+and type_param ctxt f (ct, (a,b)) =
+ pp f "%s%s%a" (type_variance a) (type_injectivity b) (core_type ctxt) ct
+
+and type_params ctxt f = function
+ | [] -> ()
+ | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+
+and type_def_list ctxt f (rf, exported, l) =
+ let type_decl kwd rf f x =
+ let eq =
+ if (x.ptype_kind = Ptype_abstract)
+ && (x.ptype_manifest = None) then ""
+ else if exported then " ="
+ else " :="
+ in
+ pp f "@[<2>%s %a%a%a%s%a@]%a" kwd
+ nonrec_flag rf
+ (type_params ctxt) x.ptype_params
+ ident_of_name x.ptype_name.txt
+ eq
+ (type_declaration ctxt) x
+ (item_attributes ctxt) x.ptype_attributes
+ in
+ match l with
+ | [] -> assert false
+ | [x] -> type_decl "type" rf f x
+ | x :: xs -> pp f "@[<v>%a@,%a@]"
+ (type_decl "type" rf) x
+ (list ~sep:"@," (type_decl "and" Recursive)) xs
+
+and record_declaration ctxt f lbls =
+ let type_record_field f pld =
+ pp f "@[<2>%a%a:@;%a@;%a@]"
+ mutable_flag pld.pld_mutable
+ ident_of_name pld.pld_name.txt
+ (core_type ctxt) pld.pld_type
+ (attributes ctxt) pld.pld_attributes
+ in
+ pp f "{@\n%a}"
+ (list type_record_field ~sep:";@\n" ) lbls
+
+and type_declaration ctxt f x =
+ (* type_declaration has an attribute field,
+ but it's been printed by the caller of this method *)
+ let priv f =
+ match x.ptype_private with
+ | Public -> ()
+ | Private -> pp f "@;private"
+ in
+ let manifest f =
+ match x.ptype_manifest with
+ | None -> ()
+ | Some y ->
+ if x.ptype_kind = Ptype_abstract then
+ pp f "%t@;%a" priv (core_type ctxt) y
+ else
+ pp f "@;%a" (core_type ctxt) y
+ in
+ let constructor_declaration f pcd =
+ pp f "|@;";
+ constructor_declaration ctxt f
+ (pcd.pcd_name.txt, pcd.pcd_vars,
+ pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
+ in
+ let repr f =
+ let intro f =
+ if x.ptype_manifest = None then ()
+ else pp f "@;="
+ in
+ match x.ptype_kind with
+ | Ptype_variant xs ->
+ let variants fmt xs =
+ if xs = [] then pp fmt " |" else
+ pp fmt "@\n%a" (list ~sep:"@\n" constructor_declaration) xs
+ in pp f "%t%t%a" intro priv variants xs
+ | Ptype_abstract -> ()
+ | Ptype_record l ->
+ pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
+ | Ptype_open -> pp f "%t%t@;.." intro priv
+ in
+ let constraints f =
+ List.iter
+ (fun (ct1,ct2,_) ->
+ pp f "@[<hov2>@ constraint@ %a@ =@ %a@]"
+ (core_type ctxt) ct1 (core_type ctxt) ct2)
+ x.ptype_cstrs
+ in
+ pp f "%t%t%t" manifest repr constraints
+
+and type_extension ctxt f x =
+ let extension_constructor f x =
+ pp f "@\n|@;%a" (extension_constructor ctxt) x
+ in
+ pp f "@[<2>type %a%a += %a@ %a@]%a"
+ (fun f -> function
+ | [] -> ()
+ | l ->
+ pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
+ x.ptyext_params
+ (with_loc type_longident) x.ptyext_path
+ private_flag x.ptyext_private (* Cf: #7200 *)
+ (list ~sep:"" extension_constructor)
+ x.ptyext_constructors
+ (item_attributes ctxt) x.ptyext_attributes
+
+and constructor_declaration ctxt f (name, vars, args, res, attrs) =
+ let name =
+ match name with
+ | "::" -> "(::)"
+ | s -> s in
+ let pp_vars f vs =
+ match vs with
+ | [] -> ()
+ | vs -> pp f "%a@;.@;" (list tyvar_loc ~sep:"@;") vs in
+ match res with
+ | None ->
+ pp f "%s%a@;%a" name
+ (fun f -> function
+ | Pcstr_tuple [] -> ()
+ | Pcstr_tuple l ->
+ pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
+ | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l
+ ) args
+ (attributes ctxt) attrs
+ | Some r ->
+ pp f "%s:@;%a%a@;%a" name
+ pp_vars vars
+ (fun f -> function
+ | Pcstr_tuple [] -> core_type1 ctxt f r
+ | Pcstr_tuple l -> pp f "%a@;->@;%a"
+ (list (core_type1 ctxt) ~sep:"@;*@;") l
+ (core_type1 ctxt) r
+ | Pcstr_record l ->
+ pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r
+ )
+ args
+ (attributes ctxt) attrs
+
+and extension_constructor ctxt f x =
+ (* Cf: #7200 *)
+ match x.pext_kind with
+ | Pext_decl(v, l, r) ->
+ constructor_declaration ctxt f
+ (x.pext_name.txt, v, l, r, x.pext_attributes)
+ | Pext_rebind li ->
+ pp f "%s@;=@;%a%a" x.pext_name.txt
+ (with_loc constr) li
+ (attributes ctxt) x.pext_attributes
+
+and case_list ctxt f l : unit =
+ let aux f {pc_lhs; pc_guard; pc_rhs} =
+ pp f "@;| @[<2>%a%a@;->@;%a@]"
+ (pattern ctxt) pc_lhs (option (expression ctxt) ~first:"@;when@;")
+ pc_guard (expression (under_pipe ctxt)) pc_rhs
+ in
+ list aux f l ~sep:""
+
+and label_x_expression_param ctxt f (l,e) =
+ let simple_name = match e with
+ | {pexp_desc=Pexp_ident {txt=Lident l;_};
+ pexp_attributes=[]} -> Some l
+ | _ -> None
+ in match l with
+ | Nolabel -> expression2 ctxt f e (* level 2*)
+ | Optional str ->
+ if Some str = simple_name then
+ pp f "?%a" ident_of_name str
+ else
+ pp f "?%a:%a" ident_of_name str (simple_expr ctxt) e
+ | Labelled lbl ->
+ if Some lbl = simple_name then
+ pp f "~%a" ident_of_name lbl
+ else
+ pp f "~%a:%a" ident_of_name lbl (simple_expr ctxt) e
+
+and directive_argument f x =
+ match x.pdira_desc with
+ | Pdir_string (s) -> pp f "@ %S" s
+ | Pdir_int (n, None) -> pp f "@ %s" n
+ | Pdir_int (n, Some m) -> pp f "@ %s%c" n m
+ | Pdir_ident (li) -> pp f "@ %a" value_longident li
+ | Pdir_bool (b) -> pp f "@ %s" (string_of_bool b)
+
+let toplevel_phrase f x =
+ match x with
+ | Ptop_def (s) ->pp f "@[<hov0>%a@]" (list (structure_item reset_ctxt)) s
+ (* pp_open_hvbox f 0; *)
+ (* pp_print_list structure_item f s ; *)
+ (* pp_close_box f (); *)
+ | Ptop_dir {pdir_name; pdir_arg = None; _} ->
+ pp f "@[<hov2>#%s@]" pdir_name.txt
+ | Ptop_dir {pdir_name; pdir_arg = Some pdir_arg; _} ->
+ pp f "@[<hov2>#%s@ %a@]" pdir_name.txt directive_argument pdir_arg
+
+let expression f x =
+ pp f "@[%a@]" (expression reset_ctxt) x
+
+let string_of_expression x =
+ ignore (flush_str_formatter ()) ;
+ let f = str_formatter in
+ expression f x;
+ flush_str_formatter ()
+
+let string_of_structure x =
+ ignore (flush_str_formatter ());
+ let f = str_formatter in
+ structure reset_ctxt f x;
+ flush_str_formatter ()
+
+let top_phrase f x =
+ pp_print_newline f ();
+ toplevel_phrase f x;
+ pp f ";;";
+ pp_print_newline f ()
+
+let core_type = core_type reset_ctxt
+let pattern = pattern reset_ctxt
+let signature = signature reset_ctxt
+let structure = structure reset_ctxt
+let module_expr = module_expr reset_ctxt
+let module_type = module_type reset_ctxt
+let class_field = class_field reset_ctxt
+let class_type_field = class_type_field reset_ctxt
+let class_expr = class_expr reset_ctxt
+let class_type = class_type reset_ctxt
+let structure_item = structure_item reset_ctxt
+let signature_item = signature_item reset_ctxt
+let binding = binding reset_ctxt
+let payload = payload reset_ctxt
+let longident = value_longident
diff --git a/upstream/ocaml_503/parsing/pprintast.mli b/upstream/ocaml_503/parsing/pprintast.mli
new file mode 100644
index 0000000000..3d26895ee9
--- /dev/null
+++ b/upstream/ocaml_503/parsing/pprintast.mli
@@ -0,0 +1,74 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Hongbo Zhang (University of Pennsylvania) *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+
+(** Pretty-printers for {!Parsetree}
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+val longident : Format.formatter -> Longident.t -> unit
+val constr : Format.formatter -> Longident.t -> unit
+
+val expression : Format.formatter -> Parsetree.expression -> unit
+val string_of_expression : Parsetree.expression -> string
+
+val pattern: Format.formatter -> Parsetree.pattern -> unit
+
+val core_type: Format.formatter -> Parsetree.core_type -> unit
+
+val signature: Format.formatter -> Parsetree.signature -> unit
+val structure: Format.formatter -> Parsetree.structure -> unit
+val string_of_structure: Parsetree.structure -> string
+
+val module_expr: Format.formatter -> Parsetree.module_expr -> unit
+
+val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
+val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit
+
+val class_field: Format.formatter -> Parsetree.class_field -> unit
+val class_type_field: Format.formatter -> Parsetree.class_type_field -> unit
+val class_expr: Format.formatter -> Parsetree.class_expr -> unit
+val class_type: Format.formatter -> Parsetree.class_type -> unit
+val module_type: Format.formatter -> Parsetree.module_type -> unit
+val structure_item: Format.formatter -> Parsetree.structure_item -> unit
+val signature_item: Format.formatter -> Parsetree.signature_item -> unit
+val binding: Format.formatter -> Parsetree.value_binding -> unit
+val payload: Format.formatter -> Parsetree.payload -> unit
+
+val tyvar_of_name : string -> string
+ (** Turn a type variable name into a valid identifier, taking care of the
+ special treatment required for the single quote character in second
+ position, or for keywords by escaping them with \#. No-op on "_". *)
+
+val tyvar: Format.formatter -> string -> unit
+ (** Print a type variable name as a valid identifier, taking care of the
+ special treatment required for the single quote character in second
+ position, or for keywords by escaping them with \#. No-op on "_". *)
+
+(** {!Format_doc} functions for error messages *)
+module Doc:sig
+ val longident: Longident.t Format_doc.printer
+ val constr: Longident.t Format_doc.printer
+ val tyvar: string Format_doc.printer
+
+ (** Returns a format document if the expression reads nicely as the subject
+ of a sentence in a error message. *)
+ val nominal_exp : Parsetree.expression -> Format_doc.t option
+end
diff --git a/upstream/ocaml_503/parsing/printast.ml b/upstream/ocaml_503/parsing/printast.ml
new file mode 100644
index 0000000000..17f28836ad
--- /dev/null
+++ b/upstream/ocaml_503/parsing/printast.ml
@@ -0,0 +1,1023 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Para, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1999 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Format
+open Lexing
+open Location
+open Parsetree
+
+let fmt_position with_name f l =
+ let fname = if with_name then l.pos_fname else "" in
+ if l.pos_lnum = -1
+ then fprintf f "%s[%d]" fname l.pos_cnum
+ else fprintf f "%s[%d,%d+%d]" fname l.pos_lnum l.pos_bol
+ (l.pos_cnum - l.pos_bol)
+
+let fmt_location f loc =
+ if not !Clflags.locations then ()
+ else begin
+ let p_2nd_name = loc.loc_start.pos_fname <> loc.loc_end.pos_fname in
+ fprintf f "(%a..%a)" (fmt_position true) loc.loc_start
+ (fmt_position p_2nd_name) loc.loc_end;
+ if loc.loc_ghost then fprintf f " ghost";
+ end
+
+let rec fmt_longident_aux f x =
+ match x with
+ | Longident.Lident (s) -> fprintf f "%s" s
+ | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s
+ | Longident.Lapply (y, z) ->
+ fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z
+
+let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x
+
+let fmt_longident_loc f (x : Longident.t loc) =
+ fprintf f "\"%a\" %a" fmt_longident_aux x.txt fmt_location x.loc
+
+let fmt_string_loc f (x : string loc) =
+ fprintf f "\"%s\" %a" x.txt fmt_location x.loc
+
+let fmt_str_opt_loc f (x : string option loc) =
+ fprintf f "\"%s\" %a" (Option.value x.txt ~default:"_") fmt_location x.loc
+
+let fmt_char_option f = function
+ | None -> fprintf f "None"
+ | Some c -> fprintf f "Some %c" c
+
+let fmt_mutable_flag f x =
+ match x with
+ | Immutable -> fprintf f "Immutable"
+ | Mutable -> fprintf f "Mutable"
+
+let fmt_virtual_flag f x =
+ match x with
+ | Virtual -> fprintf f "Virtual"
+ | Concrete -> fprintf f "Concrete"
+
+let fmt_override_flag f x =
+ match x with
+ | Override -> fprintf f "Override"
+ | Fresh -> fprintf f "Fresh"
+
+let fmt_closed_flag f x =
+ match x with
+ | Closed -> fprintf f "Closed"
+ | Open -> fprintf f "Open"
+
+let fmt_rec_flag f x =
+ match x with
+ | Nonrecursive -> fprintf f "Nonrec"
+ | Recursive -> fprintf f "Rec"
+
+let fmt_direction_flag f x =
+ match x with
+ | Upto -> fprintf f "Up"
+ | Downto -> fprintf f "Down"
+
+let fmt_private_flag f x =
+ match x with
+ | Public -> fprintf f "Public"
+ | Private -> fprintf f "Private"
+
+let line i f s (*...*) =
+ fprintf f "%s" (String.make ((2*i) mod 72) ' ');
+ fprintf f s (*...*)
+
+let fmt_constant i f x =
+ line i f "constant %a\n" fmt_location x.pconst_loc;
+ let i = i+1 in
+ match x.pconst_desc with
+ | Pconst_integer (j,m) -> line i f "PConst_int (%s,%a)\n" j fmt_char_option m
+ | Pconst_char c -> line i f "PConst_char %02x\n" (Char.code c)
+ | Pconst_string (s, strloc, None) ->
+ line i f "PConst_string(%S,%a,None)\n" s fmt_location strloc
+ | Pconst_string (s, strloc, Some delim) ->
+ line i f "PConst_string (%S,%a,Some %S)\n" s fmt_location strloc delim
+ | Pconst_float (s,m) -> line i f "PConst_float (%s,%a)\n" s fmt_char_option m
+
+let list i f ppf l =
+ match l with
+ | [] -> line i ppf "[]\n"
+ | _ :: _ ->
+ line i ppf "[\n";
+ List.iter (f (i+1) ppf) l;
+ line i ppf "]\n"
+
+let option i f ppf x =
+ match x with
+ | None -> line i ppf "None\n"
+ | Some x ->
+ line i ppf "Some\n";
+ f (i+1) ppf x
+
+let longident_loc i ppf li = line i ppf "%a\n" fmt_longident_loc li
+let string i ppf s = line i ppf "\"%s\"\n" s
+let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s
+let str_opt_loc i ppf s = line i ppf "%a\n" fmt_str_opt_loc s
+let arg_label i ppf = function
+ | Nolabel -> line i ppf "Nolabel\n"
+ | Optional s -> line i ppf "Optional \"%s\"\n" s
+ | Labelled s -> line i ppf "Labelled \"%s\"\n" s
+
+let typevars ppf vs =
+ List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt) vs
+
+let rec core_type i ppf x =
+ line i ppf "core_type %a\n" fmt_location x.ptyp_loc;
+ attributes i ppf x.ptyp_attributes;
+ let i = i+1 in
+ match x.ptyp_desc with
+ | Ptyp_any -> line i ppf "Ptyp_any\n";
+ | Ptyp_var (s) -> line i ppf "Ptyp_var %s\n" s;
+ | Ptyp_arrow (l, ct1, ct2) ->
+ line i ppf "Ptyp_arrow\n";
+ arg_label i ppf l;
+ core_type i ppf ct1;
+ core_type i ppf ct2;
+ | Ptyp_tuple l ->
+ line i ppf "Ptyp_tuple\n";
+ list i core_type ppf l;
+ | Ptyp_constr (li, l) ->
+ line i ppf "Ptyp_constr %a\n" fmt_longident_loc li;
+ list i core_type ppf l;
+ | Ptyp_variant (l, closed, low) ->
+ line i ppf "Ptyp_variant closed=%a\n" fmt_closed_flag closed;
+ list i label_x_bool_x_core_type_list ppf l;
+ option i (fun i -> list i string) ppf low
+ | Ptyp_object (l, c) ->
+ line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
+ let i = i + 1 in
+ List.iter (fun field ->
+ match field.pof_desc with
+ | Otag (l, t) ->
+ line i ppf "method %s\n" l.txt;
+ attributes i ppf field.pof_attributes;
+ core_type (i + 1) ppf t
+ | Oinherit ct ->
+ line i ppf "Oinherit\n";
+ core_type (i + 1) ppf ct
+ ) l
+ | Ptyp_class (li, l) ->
+ line i ppf "Ptyp_class %a\n" fmt_longident_loc li;
+ list i core_type ppf l
+ | Ptyp_alias (ct, s) ->
+ line i ppf "Ptyp_alias \"%s\"\n" s.txt;
+ core_type i ppf ct;
+ | Ptyp_poly (sl, ct) ->
+ line i ppf "Ptyp_poly%a\n" typevars sl;
+ core_type i ppf ct;
+ | Ptyp_package (s, l) ->
+ line i ppf "Ptyp_package %a\n" fmt_longident_loc s;
+ list i package_with ppf l;
+ | Ptyp_open (mod_ident, t) ->
+ line i ppf "Ptyp_open \"%a\"\n" fmt_longident_loc mod_ident;
+ core_type i ppf t
+ | Ptyp_extension (s, arg) ->
+ line i ppf "Ptyp_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+
+and package_with i ppf (s, t) =
+ line i ppf "with type %a\n" fmt_longident_loc s;
+ core_type i ppf t
+
+and pattern i ppf x =
+ line i ppf "pattern %a\n" fmt_location x.ppat_loc;
+ attributes i ppf x.ppat_attributes;
+ let i = i+1 in
+ match x.ppat_desc with
+ | Ppat_any -> line i ppf "Ppat_any\n";
+ | Ppat_var (s) -> line i ppf "Ppat_var %a\n" fmt_string_loc s;
+ | Ppat_alias (p, s) ->
+ line i ppf "Ppat_alias %a\n" fmt_string_loc s;
+ pattern i ppf p;
+ | Ppat_constant (c) ->
+ line i ppf "Ppat_constant\n";
+ fmt_constant i ppf c;
+ | Ppat_interval (c1, c2) ->
+ line i ppf "Ppat_interval\n";
+ fmt_constant i ppf c1;
+ fmt_constant i ppf c2;
+ | Ppat_tuple (l) ->
+ line i ppf "Ppat_tuple\n";
+ list i pattern ppf l;
+ | Ppat_construct (li, po) ->
+ line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
+ option i
+ (fun i ppf (vl, p) ->
+ list i string_loc ppf vl;
+ pattern i ppf p)
+ ppf po
+ | Ppat_variant (l, po) ->
+ line i ppf "Ppat_variant \"%s\"\n" l;
+ option i pattern ppf po;
+ | Ppat_record (l, c) ->
+ line i ppf "Ppat_record %a\n" fmt_closed_flag c;
+ list i longident_x_pattern ppf l;
+ | Ppat_array (l) ->
+ line i ppf "Ppat_array\n";
+ list i pattern ppf l;
+ | Ppat_or (p1, p2) ->
+ line i ppf "Ppat_or\n";
+ pattern i ppf p1;
+ pattern i ppf p2;
+ | Ppat_lazy p ->
+ line i ppf "Ppat_lazy\n";
+ pattern i ppf p;
+ | Ppat_constraint (p, ct) ->
+ line i ppf "Ppat_constraint\n";
+ pattern i ppf p;
+ core_type i ppf ct;
+ | Ppat_type (li) ->
+ line i ppf "Ppat_type\n";
+ longident_loc i ppf li
+ | Ppat_unpack s ->
+ line i ppf "Ppat_unpack %a\n" fmt_str_opt_loc s;
+ | Ppat_exception p ->
+ line i ppf "Ppat_exception\n";
+ pattern i ppf p
+ | Ppat_effect(p1, p2) ->
+ line i ppf "Ppat_effect\n";
+ pattern i ppf p1;
+ pattern i ppf p2
+ | Ppat_open (m,p) ->
+ line i ppf "Ppat_open \"%a\"\n" fmt_longident_loc m;
+ pattern i ppf p
+ | Ppat_extension (s, arg) ->
+ line i ppf "Ppat_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+
+and expression i ppf x =
+ line i ppf "expression %a\n" fmt_location x.pexp_loc;
+ attributes i ppf x.pexp_attributes;
+ let i = i+1 in
+ match x.pexp_desc with
+ | Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident_loc li;
+ | Pexp_constant (c) ->
+ line i ppf "Pexp_constant\n";
+ fmt_constant i ppf c;
+ | Pexp_let (rf, l, e) ->
+ line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
+ list i value_binding ppf l;
+ expression i ppf e;
+ | Pexp_function (params, c, body) ->
+ line i ppf "Pexp_function\n";
+ list i function_param ppf params;
+ option i type_constraint ppf c;
+ function_body i ppf body
+ | Pexp_apply (e, l) ->
+ line i ppf "Pexp_apply\n";
+ expression i ppf e;
+ list i label_x_expression ppf l;
+ | Pexp_match (e, l) ->
+ line i ppf "Pexp_match\n";
+ expression i ppf e;
+ list i case ppf l;
+ | Pexp_try (e, l) ->
+ line i ppf "Pexp_try\n";
+ expression i ppf e;
+ list i case ppf l;
+ | Pexp_tuple (l) ->
+ line i ppf "Pexp_tuple\n";
+ list i expression ppf l;
+ | Pexp_construct (li, eo) ->
+ line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
+ option i expression ppf eo;
+ | Pexp_variant (l, eo) ->
+ line i ppf "Pexp_variant \"%s\"\n" l;
+ option i expression ppf eo;
+ | Pexp_record (l, eo) ->
+ line i ppf "Pexp_record\n";
+ list i longident_x_expression ppf l;
+ option i expression ppf eo;
+ | Pexp_field (e, li) ->
+ line i ppf "Pexp_field\n";
+ expression i ppf e;
+ longident_loc i ppf li;
+ | Pexp_setfield (e1, li, e2) ->
+ line i ppf "Pexp_setfield\n";
+ expression i ppf e1;
+ longident_loc i ppf li;
+ expression i ppf e2;
+ | Pexp_array (l) ->
+ line i ppf "Pexp_array\n";
+ list i expression ppf l;
+ | Pexp_ifthenelse (e1, e2, eo) ->
+ line i ppf "Pexp_ifthenelse\n";
+ expression i ppf e1;
+ expression i ppf e2;
+ option i expression ppf eo;
+ | Pexp_sequence (e1, e2) ->
+ line i ppf "Pexp_sequence\n";
+ expression i ppf e1;
+ expression i ppf e2;
+ | Pexp_while (e1, e2) ->
+ line i ppf "Pexp_while\n";
+ expression i ppf e1;
+ expression i ppf e2;
+ | Pexp_for (p, e1, e2, df, e3) ->
+ line i ppf "Pexp_for %a\n" fmt_direction_flag df;
+ pattern i ppf p;
+ expression i ppf e1;
+ expression i ppf e2;
+ expression i ppf e3;
+ | Pexp_constraint (e, ct) ->
+ line i ppf "Pexp_constraint\n";
+ expression i ppf e;
+ core_type i ppf ct;
+ | Pexp_coerce (e, cto1, cto2) ->
+ line i ppf "Pexp_coerce\n";
+ expression i ppf e;
+ option i core_type ppf cto1;
+ core_type i ppf cto2;
+ | Pexp_send (e, s) ->
+ line i ppf "Pexp_send \"%s\"\n" s.txt;
+ expression i ppf e;
+ | Pexp_new (li) -> line i ppf "Pexp_new %a\n" fmt_longident_loc li;
+ | Pexp_setinstvar (s, e) ->
+ line i ppf "Pexp_setinstvar %a\n" fmt_string_loc s;
+ expression i ppf e;
+ | Pexp_override (l) ->
+ line i ppf "Pexp_override\n";
+ list i string_x_expression ppf l;
+ | Pexp_letmodule (s, me, e) ->
+ line i ppf "Pexp_letmodule %a\n" fmt_str_opt_loc s;
+ module_expr i ppf me;
+ expression i ppf e;
+ | Pexp_letexception (cd, e) ->
+ line i ppf "Pexp_letexception\n";
+ extension_constructor i ppf cd;
+ expression i ppf e;
+ | Pexp_assert (e) ->
+ line i ppf "Pexp_assert\n";
+ expression i ppf e;
+ | Pexp_lazy (e) ->
+ line i ppf "Pexp_lazy\n";
+ expression i ppf e;
+ | Pexp_poly (e, cto) ->
+ line i ppf "Pexp_poly\n";
+ expression i ppf e;
+ option i core_type ppf cto;
+ | Pexp_object s ->
+ line i ppf "Pexp_object\n";
+ class_structure i ppf s
+ | Pexp_newtype (s, e) ->
+ line i ppf "Pexp_newtype \"%s\"\n" s.txt;
+ expression i ppf e
+ | Pexp_pack me ->
+ line i ppf "Pexp_pack\n";
+ module_expr i ppf me
+ | Pexp_open (o, e) ->
+ line i ppf "Pexp_open %a\n" fmt_override_flag o.popen_override;
+ module_expr i ppf o.popen_expr;
+ expression i ppf e
+ | Pexp_letop {let_; ands; body} ->
+ line i ppf "Pexp_letop\n";
+ binding_op i ppf let_;
+ list i binding_op ppf ands;
+ expression i ppf body
+ | Pexp_extension (s, arg) ->
+ line i ppf "Pexp_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+ | Pexp_unreachable ->
+ line i ppf "Pexp_unreachable"
+
+and function_param i ppf { pparam_desc = desc; pparam_loc = loc } =
+ match desc with
+ | Pparam_val (l, eo, p) ->
+ line i ppf "Pparam_val %a\n" fmt_location loc;
+ arg_label (i+1) ppf l;
+ option (i+1) expression ppf eo;
+ pattern (i+1) ppf p
+ | Pparam_newtype ty ->
+ line i ppf "Pparam_newtype \"%s\" %a\n" ty.txt fmt_location loc
+
+and function_body i ppf body =
+ match body with
+ | Pfunction_body e ->
+ line i ppf "Pfunction_body\n";
+ expression (i+1) ppf e
+ | Pfunction_cases (cases, loc, attrs) ->
+ line i ppf "Pfunction_cases %a\n" fmt_location loc;
+ attributes (i+1) ppf attrs;
+ list (i+1) case ppf cases
+
+and type_constraint i ppf constraint_ =
+ match constraint_ with
+ | Pconstraint ty ->
+ line i ppf "Pconstraint\n";
+ core_type (i+1) ppf ty
+ | Pcoerce (ty1, ty2) ->
+ line i ppf "Pcoerce\n";
+ option (i+1) core_type ppf ty1;
+ core_type (i+1) ppf ty2
+
+and value_description i ppf x =
+ line i ppf "value_description %a %a\n" fmt_string_loc
+ x.pval_name fmt_location x.pval_loc;
+ attributes i ppf x.pval_attributes;
+ core_type (i+1) ppf x.pval_type;
+ list (i+1) string ppf x.pval_prim
+
+and type_parameter i ppf (x, _variance) = core_type i ppf x
+
+and type_declaration i ppf x =
+ line i ppf "type_declaration %a %a\n" fmt_string_loc x.ptype_name
+ fmt_location x.ptype_loc;
+ attributes i ppf x.ptype_attributes;
+ let i = i+1 in
+ line i ppf "ptype_params =\n";
+ list (i+1) type_parameter ppf x.ptype_params;
+ line i ppf "ptype_cstrs =\n";
+ list (i+1) core_type_x_core_type_x_location ppf x.ptype_cstrs;
+ line i ppf "ptype_kind =\n";
+ type_kind (i+1) ppf x.ptype_kind;
+ line i ppf "ptype_private = %a\n" fmt_private_flag x.ptype_private;
+ line i ppf "ptype_manifest =\n";
+ option (i+1) core_type ppf x.ptype_manifest
+
+and attribute i ppf k a =
+ line i ppf "%s \"%s\"\n" k a.attr_name.txt;
+ payload i ppf a.attr_payload;
+
+and attributes i ppf l =
+ let i = i + 1 in
+ List.iter (fun a ->
+ line i ppf "attribute \"%s\"\n" a.attr_name.txt;
+ payload (i + 1) ppf a.attr_payload;
+ ) l;
+
+and payload i ppf = function
+ | PStr x -> structure i ppf x
+ | PSig x -> signature i ppf x
+ | PTyp x -> core_type i ppf x
+ | PPat (x, None) -> pattern i ppf x
+ | PPat (x, Some g) ->
+ pattern i ppf x;
+ line i ppf "<when>\n";
+ expression (i + 1) ppf g
+
+
+and type_kind i ppf x =
+ match x with
+ | Ptype_abstract ->
+ line i ppf "Ptype_abstract\n"
+ | Ptype_variant l ->
+ line i ppf "Ptype_variant\n";
+ list (i+1) constructor_decl ppf l;
+ | Ptype_record l ->
+ line i ppf "Ptype_record\n";
+ list (i+1) label_decl ppf l;
+ | Ptype_open ->
+ line i ppf "Ptype_open\n";
+
+and type_extension i ppf x =
+ line i ppf "type_extension\n";
+ attributes i ppf x.ptyext_attributes;
+ let i = i+1 in
+ line i ppf "ptyext_path = %a\n" fmt_longident_loc x.ptyext_path;
+ line i ppf "ptyext_params =\n";
+ list (i+1) type_parameter ppf x.ptyext_params;
+ line i ppf "ptyext_constructors =\n";
+ list (i+1) extension_constructor ppf x.ptyext_constructors;
+ line i ppf "ptyext_private = %a\n" fmt_private_flag x.ptyext_private;
+
+and type_exception i ppf x =
+ line i ppf "type_exception\n";
+ attributes i ppf x.ptyexn_attributes;
+ let i = i+1 in
+ line i ppf "ptyext_constructor =\n";
+ let i = i+1 in
+ extension_constructor i ppf x.ptyexn_constructor
+
+and extension_constructor i ppf x =
+ line i ppf "extension_constructor %a\n" fmt_location x.pext_loc;
+ attributes i ppf x.pext_attributes;
+ let i = i + 1 in
+ line i ppf "pext_name = \"%s\"\n" x.pext_name.txt;
+ line i ppf "pext_kind =\n";
+ extension_constructor_kind (i + 1) ppf x.pext_kind;
+
+and extension_constructor_kind i ppf x =
+ match x with
+ Pext_decl(v, a, r) ->
+ line i ppf "Pext_decl\n";
+ if v <> [] then line (i+1) ppf "vars%a\n" typevars v;
+ constructor_arguments (i+1) ppf a;
+ option (i+1) core_type ppf r;
+ | Pext_rebind li ->
+ line i ppf "Pext_rebind\n";
+ line (i+1) ppf "%a\n" fmt_longident_loc li;
+
+and class_type i ppf x =
+ line i ppf "class_type %a\n" fmt_location x.pcty_loc;
+ attributes i ppf x.pcty_attributes;
+ let i = i+1 in
+ match x.pcty_desc with
+ | Pcty_constr (li, l) ->
+ line i ppf "Pcty_constr %a\n" fmt_longident_loc li;
+ list i core_type ppf l;
+ | Pcty_signature (cs) ->
+ line i ppf "Pcty_signature\n";
+ class_signature i ppf cs;
+ | Pcty_arrow (l, co, cl) ->
+ line i ppf "Pcty_arrow\n";
+ arg_label i ppf l;
+ core_type i ppf co;
+ class_type i ppf cl;
+ | Pcty_extension (s, arg) ->
+ line i ppf "Pcty_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+ | Pcty_open (o, e) ->
+ line i ppf "Pcty_open %a %a\n" fmt_override_flag o.popen_override
+ fmt_longident_loc o.popen_expr;
+ class_type i ppf e
+
+and class_signature i ppf cs =
+ line i ppf "class_signature\n";
+ core_type (i+1) ppf cs.pcsig_self;
+ list (i+1) class_type_field ppf cs.pcsig_fields;
+
+and class_type_field i ppf x =
+ line i ppf "class_type_field %a\n" fmt_location x.pctf_loc;
+ let i = i+1 in
+ attributes i ppf x.pctf_attributes;
+ match x.pctf_desc with
+ | Pctf_inherit (ct) ->
+ line i ppf "Pctf_inherit\n";
+ class_type i ppf ct;
+ | Pctf_val (s, mf, vf, ct) ->
+ line i ppf "Pctf_val \"%s\" %a %a\n" s.txt fmt_mutable_flag mf
+ fmt_virtual_flag vf;
+ core_type (i+1) ppf ct;
+ | Pctf_method (s, pf, vf, ct) ->
+ line i ppf "Pctf_method \"%s\" %a %a\n" s.txt fmt_private_flag pf
+ fmt_virtual_flag vf;
+ core_type (i+1) ppf ct;
+ | Pctf_constraint (ct1, ct2) ->
+ line i ppf "Pctf_constraint\n";
+ core_type (i+1) ppf ct1;
+ core_type (i+1) ppf ct2;
+ | Pctf_attribute a ->
+ attribute i ppf "Pctf_attribute" a
+ | Pctf_extension (s, arg) ->
+ line i ppf "Pctf_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+
+and class_description i ppf x =
+ line i ppf "class_description %a\n" fmt_location x.pci_loc;
+ attributes i ppf x.pci_attributes;
+ let i = i+1 in
+ line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
+ line i ppf "pci_params =\n";
+ list (i+1) type_parameter ppf x.pci_params;
+ line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
+ line i ppf "pci_expr =\n";
+ class_type (i+1) ppf x.pci_expr;
+
+and class_type_declaration i ppf x =
+ line i ppf "class_type_declaration %a\n" fmt_location x.pci_loc;
+ attributes i ppf x.pci_attributes;
+ let i = i+1 in
+ line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
+ line i ppf "pci_params =\n";
+ list (i+1) type_parameter ppf x.pci_params;
+ line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
+ line i ppf "pci_expr =\n";
+ class_type (i+1) ppf x.pci_expr;
+
+and class_expr i ppf x =
+ line i ppf "class_expr %a\n" fmt_location x.pcl_loc;
+ attributes i ppf x.pcl_attributes;
+ let i = i+1 in
+ match x.pcl_desc with
+ | Pcl_constr (li, l) ->
+ line i ppf "Pcl_constr %a\n" fmt_longident_loc li;
+ list i core_type ppf l;
+ | Pcl_structure (cs) ->
+ line i ppf "Pcl_structure\n";
+ class_structure i ppf cs;
+ | Pcl_fun (l, eo, p, e) ->
+ line i ppf "Pcl_fun\n";
+ arg_label i ppf l;
+ option i expression ppf eo;
+ pattern i ppf p;
+ class_expr i ppf e;
+ | Pcl_apply (ce, l) ->
+ line i ppf "Pcl_apply\n";
+ class_expr i ppf ce;
+ list i label_x_expression ppf l;
+ | Pcl_let (rf, l, ce) ->
+ line i ppf "Pcl_let %a\n" fmt_rec_flag rf;
+ list i value_binding ppf l;
+ class_expr i ppf ce;
+ | Pcl_constraint (ce, ct) ->
+ line i ppf "Pcl_constraint\n";
+ class_expr i ppf ce;
+ class_type i ppf ct;
+ | Pcl_extension (s, arg) ->
+ line i ppf "Pcl_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+ | Pcl_open (o, e) ->
+ line i ppf "Pcl_open %a %a\n" fmt_override_flag o.popen_override
+ fmt_longident_loc o.popen_expr;
+ class_expr i ppf e
+
+and class_structure i ppf { pcstr_self = p; pcstr_fields = l } =
+ line i ppf "class_structure\n";
+ pattern (i+1) ppf p;
+ list (i+1) class_field ppf l;
+
+and class_field i ppf x =
+ line i ppf "class_field %a\n" fmt_location x.pcf_loc;
+ let i = i + 1 in
+ attributes i ppf x.pcf_attributes;
+ match x.pcf_desc with
+ | Pcf_inherit (ovf, ce, so) ->
+ line i ppf "Pcf_inherit %a\n" fmt_override_flag ovf;
+ class_expr (i+1) ppf ce;
+ option (i+1) string_loc ppf so;
+ | Pcf_val (s, mf, k) ->
+ line i ppf "Pcf_val %a\n" fmt_mutable_flag mf;
+ line (i+1) ppf "%a\n" fmt_string_loc s;
+ class_field_kind (i+1) ppf k
+ | Pcf_method (s, pf, k) ->
+ line i ppf "Pcf_method %a\n" fmt_private_flag pf;
+ line (i+1) ppf "%a\n" fmt_string_loc s;
+ class_field_kind (i+1) ppf k
+ | Pcf_constraint (ct1, ct2) ->
+ line i ppf "Pcf_constraint\n";
+ core_type (i+1) ppf ct1;
+ core_type (i+1) ppf ct2;
+ | Pcf_initializer (e) ->
+ line i ppf "Pcf_initializer\n";
+ expression (i+1) ppf e;
+ | Pcf_attribute a ->
+ attribute i ppf "Pcf_attribute" a
+ | Pcf_extension (s, arg) ->
+ line i ppf "Pcf_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+
+and class_field_kind i ppf = function
+ | Cfk_concrete (o, e) ->
+ line i ppf "Concrete %a\n" fmt_override_flag o;
+ expression i ppf e
+ | Cfk_virtual t ->
+ line i ppf "Virtual\n";
+ core_type i ppf t
+
+and class_declaration i ppf x =
+ line i ppf "class_declaration %a\n" fmt_location x.pci_loc;
+ attributes i ppf x.pci_attributes;
+ let i = i+1 in
+ line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
+ line i ppf "pci_params =\n";
+ list (i+1) type_parameter ppf x.pci_params;
+ line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
+ line i ppf "pci_expr =\n";
+ class_expr (i+1) ppf x.pci_expr;
+
+and module_type i ppf x =
+ line i ppf "module_type %a\n" fmt_location x.pmty_loc;
+ attributes i ppf x.pmty_attributes;
+ let i = i+1 in
+ match x.pmty_desc with
+ | Pmty_ident li -> line i ppf "Pmty_ident %a\n" fmt_longident_loc li;
+ | Pmty_alias li -> line i ppf "Pmty_alias %a\n" fmt_longident_loc li;
+ | Pmty_signature (s) ->
+ line i ppf "Pmty_signature\n";
+ signature i ppf s;
+ | Pmty_functor (Unit, mt2) ->
+ line i ppf "Pmty_functor ()\n";
+ module_type i ppf mt2;
+ | Pmty_functor (Named (s, mt1), mt2) ->
+ line i ppf "Pmty_functor %a\n" fmt_str_opt_loc s;
+ module_type i ppf mt1;
+ module_type i ppf mt2;
+ | Pmty_with (mt, l) ->
+ line i ppf "Pmty_with\n";
+ module_type i ppf mt;
+ list i with_constraint ppf l;
+ | Pmty_typeof m ->
+ line i ppf "Pmty_typeof\n";
+ module_expr i ppf m;
+ | Pmty_extension (s, arg) ->
+ line i ppf "Pmod_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+
+and signature i ppf x = list i signature_item ppf x
+
+and signature_item i ppf x =
+ line i ppf "signature_item %a\n" fmt_location x.psig_loc;
+ let i = i+1 in
+ match x.psig_desc with
+ | Psig_value vd ->
+ line i ppf "Psig_value\n";
+ value_description i ppf vd;
+ | Psig_type (rf, l) ->
+ line i ppf "Psig_type %a\n" fmt_rec_flag rf;
+ list i type_declaration ppf l;
+ | Psig_typesubst l ->
+ line i ppf "Psig_typesubst\n";
+ list i type_declaration ppf l;
+ | Psig_typext te ->
+ line i ppf "Psig_typext\n";
+ type_extension i ppf te
+ | Psig_exception te ->
+ line i ppf "Psig_exception\n";
+ type_exception i ppf te
+ | Psig_module pmd ->
+ line i ppf "Psig_module %a\n" fmt_str_opt_loc pmd.pmd_name;
+ attributes i ppf pmd.pmd_attributes;
+ module_type i ppf pmd.pmd_type
+ | Psig_modsubst pms ->
+ line i ppf "Psig_modsubst %a = %a\n"
+ fmt_string_loc pms.pms_name
+ fmt_longident_loc pms.pms_manifest;
+ attributes i ppf pms.pms_attributes;
+ | Psig_recmodule decls ->
+ line i ppf "Psig_recmodule\n";
+ list i module_declaration ppf decls;
+ | Psig_modtype x ->
+ line i ppf "Psig_modtype %a\n" fmt_string_loc x.pmtd_name;
+ attributes i ppf x.pmtd_attributes;
+ modtype_declaration i ppf x.pmtd_type
+ | Psig_modtypesubst x ->
+ line i ppf "Psig_modtypesubst %a\n" fmt_string_loc x.pmtd_name;
+ attributes i ppf x.pmtd_attributes;
+ modtype_declaration i ppf x.pmtd_type
+ | Psig_open od ->
+ line i ppf "Psig_open %a %a\n" fmt_override_flag od.popen_override
+ fmt_longident_loc od.popen_expr;
+ attributes i ppf od.popen_attributes
+ | Psig_include incl ->
+ line i ppf "Psig_include\n";
+ module_type i ppf incl.pincl_mod;
+ attributes i ppf incl.pincl_attributes
+ | Psig_class (l) ->
+ line i ppf "Psig_class\n";
+ list i class_description ppf l;
+ | Psig_class_type (l) ->
+ line i ppf "Psig_class_type\n";
+ list i class_type_declaration ppf l;
+ | Psig_extension ((s, arg), attrs) ->
+ line i ppf "Psig_extension \"%s\"\n" s.txt;
+ attributes i ppf attrs;
+ payload i ppf arg
+ | Psig_attribute a ->
+ attribute i ppf "Psig_attribute" a
+
+and modtype_declaration i ppf = function
+ | None -> line i ppf "#abstract"
+ | Some mt -> module_type (i+1) ppf mt
+
+and with_constraint i ppf x =
+ match x with
+ | Pwith_type (lid, td) ->
+ line i ppf "Pwith_type %a\n" fmt_longident_loc lid;
+ type_declaration (i+1) ppf td;
+ | Pwith_typesubst (lid, td) ->
+ line i ppf "Pwith_typesubst %a\n" fmt_longident_loc lid;
+ type_declaration (i+1) ppf td;
+ | Pwith_module (lid1, lid2) ->
+ line i ppf "Pwith_module %a = %a\n"
+ fmt_longident_loc lid1
+ fmt_longident_loc lid2;
+ | Pwith_modsubst (lid1, lid2) ->
+ line i ppf "Pwith_modsubst %a = %a\n"
+ fmt_longident_loc lid1
+ fmt_longident_loc lid2;
+ | Pwith_modtype (lid1, mty) ->
+ line i ppf "Pwith_modtype %a\n"
+ fmt_longident_loc lid1;
+ module_type (i+1) ppf mty
+ | Pwith_modtypesubst (lid1, mty) ->
+ line i ppf "Pwith_modtypesubst %a\n"
+ fmt_longident_loc lid1;
+ module_type (i+1) ppf mty
+
+and module_expr i ppf x =
+ line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
+ attributes i ppf x.pmod_attributes;
+ let i = i+1 in
+ match x.pmod_desc with
+ | Pmod_ident (li) -> line i ppf "Pmod_ident %a\n" fmt_longident_loc li;
+ | Pmod_structure (s) ->
+ line i ppf "Pmod_structure\n";
+ structure i ppf s;
+ | Pmod_functor (Unit, me) ->
+ line i ppf "Pmod_functor ()\n";
+ module_expr i ppf me;
+ | Pmod_functor (Named (s, mt), me) ->
+ line i ppf "Pmod_functor %a\n" fmt_str_opt_loc s;
+ module_type i ppf mt;
+ module_expr i ppf me;
+ | Pmod_apply (me1, me2) ->
+ line i ppf "Pmod_apply\n";
+ module_expr i ppf me1;
+ module_expr i ppf me2;
+ | Pmod_apply_unit me1 ->
+ line i ppf "Pmod_apply_unit\n";
+ module_expr i ppf me1
+ | Pmod_constraint (me, mt) ->
+ line i ppf "Pmod_constraint\n";
+ module_expr i ppf me;
+ module_type i ppf mt;
+ | Pmod_unpack (e) ->
+ line i ppf "Pmod_unpack\n";
+ expression i ppf e;
+ | Pmod_extension (s, arg) ->
+ line i ppf "Pmod_extension \"%s\"\n" s.txt;
+ payload i ppf arg
+
+and structure i ppf x = list i structure_item ppf x
+
+and structure_item i ppf x =
+ line i ppf "structure_item %a\n" fmt_location x.pstr_loc;
+ let i = i+1 in
+ match x.pstr_desc with
+ | Pstr_eval (e, attrs) ->
+ line i ppf "Pstr_eval\n";
+ attributes i ppf attrs;
+ expression i ppf e;
+ | Pstr_value (rf, l) ->
+ line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
+ list i value_binding ppf l;
+ | Pstr_primitive vd ->
+ line i ppf "Pstr_primitive\n";
+ value_description i ppf vd;
+ | Pstr_type (rf, l) ->
+ line i ppf "Pstr_type %a\n" fmt_rec_flag rf;
+ list i type_declaration ppf l;
+ | Pstr_typext te ->
+ line i ppf "Pstr_typext\n";
+ type_extension i ppf te
+ | Pstr_exception te ->
+ line i ppf "Pstr_exception\n";
+ type_exception i ppf te
+ | Pstr_module x ->
+ line i ppf "Pstr_module\n";
+ module_binding i ppf x
+ | Pstr_recmodule bindings ->
+ line i ppf "Pstr_recmodule\n";
+ list i module_binding ppf bindings;
+ | Pstr_modtype x ->
+ line i ppf "Pstr_modtype %a\n" fmt_string_loc x.pmtd_name;
+ attributes i ppf x.pmtd_attributes;
+ modtype_declaration i ppf x.pmtd_type
+ | Pstr_open od ->
+ line i ppf "Pstr_open %a\n" fmt_override_flag od.popen_override;
+ module_expr i ppf od.popen_expr;
+ attributes i ppf od.popen_attributes
+ | Pstr_class (l) ->
+ line i ppf "Pstr_class\n";
+ list i class_declaration ppf l;
+ | Pstr_class_type (l) ->
+ line i ppf "Pstr_class_type\n";
+ list i class_type_declaration ppf l;
+ | Pstr_include incl ->
+ line i ppf "Pstr_include";
+ attributes i ppf incl.pincl_attributes;
+ module_expr i ppf incl.pincl_mod
+ | Pstr_extension ((s, arg), attrs) ->
+ line i ppf "Pstr_extension \"%s\"\n" s.txt;
+ attributes i ppf attrs;
+ payload i ppf arg
+ | Pstr_attribute a ->
+ attribute i ppf "Pstr_attribute" a
+
+and module_declaration i ppf pmd =
+ str_opt_loc i ppf pmd.pmd_name;
+ attributes i ppf pmd.pmd_attributes;
+ module_type (i+1) ppf pmd.pmd_type;
+
+and module_binding i ppf x =
+ str_opt_loc i ppf x.pmb_name;
+ attributes i ppf x.pmb_attributes;
+ module_expr (i+1) ppf x.pmb_expr
+
+and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
+ line i ppf "<constraint> %a\n" fmt_location l;
+ core_type (i+1) ppf ct1;
+ core_type (i+1) ppf ct2;
+
+and constructor_decl i ppf
+ {pcd_name; pcd_vars; pcd_args; pcd_res; pcd_loc; pcd_attributes} =
+ line i ppf "%a\n" fmt_location pcd_loc;
+ line (i+1) ppf "%a\n" fmt_string_loc pcd_name;
+ if pcd_vars <> [] then line (i+1) ppf "pcd_vars =%a\n" typevars pcd_vars;
+ attributes i ppf pcd_attributes;
+ constructor_arguments (i+1) ppf pcd_args;
+ option (i+1) core_type ppf pcd_res
+
+and constructor_arguments i ppf = function
+ | Pcstr_tuple l -> list i core_type ppf l
+ | Pcstr_record l -> list i label_decl ppf l
+
+and label_decl i ppf {pld_name; pld_mutable; pld_type; pld_loc; pld_attributes}=
+ line i ppf "%a\n" fmt_location pld_loc;
+ attributes i ppf pld_attributes;
+ line (i+1) ppf "%a\n" fmt_mutable_flag pld_mutable;
+ line (i+1) ppf "%a" fmt_string_loc pld_name;
+ core_type (i+1) ppf pld_type
+
+and longident_x_pattern i ppf (li, p) =
+ line i ppf "%a\n" fmt_longident_loc li;
+ pattern (i+1) ppf p;
+
+and case i ppf {pc_lhs; pc_guard; pc_rhs} =
+ line i ppf "<case>\n";
+ pattern (i+1) ppf pc_lhs;
+ begin match pc_guard with
+ | None -> ()
+ | Some g -> line (i+1) ppf "<when>\n"; expression (i + 2) ppf g
+ end;
+ expression (i+1) ppf pc_rhs;
+
+and value_binding i ppf x =
+ line i ppf "<def>\n";
+ attributes (i+1) ppf x.pvb_attributes;
+ pattern (i+1) ppf x.pvb_pat;
+ Option.iter (value_constraint (i+1) ppf) x.pvb_constraint;
+ expression (i+1) ppf x.pvb_expr
+
+and value_constraint i ppf x =
+ let pp_sep ppf () = Format.fprintf ppf "@ "; in
+ let pp_newtypes = Format.pp_print_list fmt_string_loc ~pp_sep in
+ match x with
+ | Pvc_constraint { locally_abstract_univars = []; typ } ->
+ core_type i ppf typ
+ | Pvc_constraint { locally_abstract_univars=newtypes; typ} ->
+ line i ppf "<type> %a.\n" pp_newtypes newtypes;
+ core_type i ppf typ
+ | Pvc_coercion { ground; coercion} ->
+ line i ppf "<coercion>\n";
+ option i core_type ppf ground;
+ core_type i ppf coercion;
+
+
+and binding_op i ppf x =
+ line i ppf "<binding_op> %a %a"
+ fmt_string_loc x.pbop_op fmt_location x.pbop_loc;
+ pattern (i+1) ppf x.pbop_pat;
+ expression (i+1) ppf x.pbop_exp;
+
+and string_x_expression i ppf (s, e) =
+ line i ppf "<override> %a\n" fmt_string_loc s;
+ expression (i+1) ppf e;
+
+and longident_x_expression i ppf (li, e) =
+ line i ppf "%a\n" fmt_longident_loc li;
+ expression (i+1) ppf e;
+
+and label_x_expression i ppf (l,e) =
+ line i ppf "<arg>\n";
+ arg_label i ppf l;
+ expression (i+1) ppf e;
+
+and label_x_bool_x_core_type_list i ppf x =
+ match x.prf_desc with
+ Rtag (l, b, ctl) ->
+ line i ppf "Rtag \"%s\" %s\n" l.txt (string_of_bool b);
+ attributes (i+1) ppf x.prf_attributes;
+ list (i+1) core_type ppf ctl
+ | Rinherit (ct) ->
+ line i ppf "Rinherit\n";
+ core_type (i+1) ppf ct
+
+let rec toplevel_phrase i ppf x =
+ match x with
+ | Ptop_def (s) ->
+ line i ppf "Ptop_def\n";
+ structure (i+1) ppf s;
+ | Ptop_dir {pdir_name; pdir_arg; _} ->
+ line i ppf "Ptop_dir \"%s\"\n" pdir_name.txt;
+ match pdir_arg with
+ | None -> ()
+ | Some da -> directive_argument i ppf da;
+
+and directive_argument i ppf x =
+ match x.pdira_desc with
+ | Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s
+ | Pdir_int (n, None) -> line i ppf "Pdir_int %s\n" n
+ | Pdir_int (n, Some m) -> line i ppf "Pdir_int %s%c\n" n m
+ | Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li
+ | Pdir_bool (b) -> line i ppf "Pdir_bool %s\n" (string_of_bool b)
+
+let interface ppf x = list 0 signature_item ppf x
+
+let implementation ppf x = list 0 structure_item ppf x
+
+let top_phrase ppf x = toplevel_phrase 0 ppf x
diff --git a/upstream/ocaml_503/parsing/printast.mli b/upstream/ocaml_503/parsing/printast.mli
new file mode 100644
index 0000000000..5bc496182f
--- /dev/null
+++ b/upstream/ocaml_503/parsing/printast.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Para, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1999 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. *)
+(* *)
+(**************************************************************************)
+
+(** Raw printer for {!Parsetree}
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Parsetree
+open Format
+
+val interface : formatter -> signature_item list -> unit
+val implementation : formatter -> structure_item list -> unit
+val top_phrase : formatter -> toplevel_phrase -> unit
+
+val expression: int -> formatter -> expression -> unit
+val structure: int -> formatter -> structure -> unit
+val payload: int -> formatter -> payload -> unit
diff --git a/upstream/ocaml_503/parsing/syntaxerr.ml b/upstream/ocaml_503/parsing/syntaxerr.ml
new file mode 100644
index 0000000000..8a326c1104
--- /dev/null
+++ b/upstream/ocaml_503/parsing/syntaxerr.ml
@@ -0,0 +1,52 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1997 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 type for reporting syntax errors *)
+
+type invalid_package_type =
+ | Parameterized_types
+ | Constrained_types
+ | Private_types
+ | Not_with_type
+ | Neither_identifier_nor_with_type
+
+type error =
+ Unclosed of Location.t * string * Location.t * string
+ | Expecting of Location.t * string
+ | Not_expecting of Location.t * string
+ | Applicative_path of Location.t
+ | Variable_in_scope of Location.t * string
+ | Other of Location.t
+ | Ill_formed_ast of Location.t * string
+ | Invalid_package_type of Location.t * invalid_package_type
+ | Removed_string_set of Location.t
+
+exception Error of error
+exception Escape_error
+
+let location_of_error = function
+ | Unclosed(l,_,_,_)
+ | Applicative_path l
+ | Variable_in_scope(l,_)
+ | Other l
+ | Not_expecting (l, _)
+ | Ill_formed_ast (l, _)
+ | Invalid_package_type (l, _)
+ | Expecting (l, _)
+ | Removed_string_set l -> l
+
+
+let ill_formed_ast loc s =
+ raise (Error (Ill_formed_ast (loc, s)))
diff --git a/upstream/ocaml_503/parsing/syntaxerr.mli b/upstream/ocaml_503/parsing/syntaxerr.mli
new file mode 100644
index 0000000000..a84bc6664c
--- /dev/null
+++ b/upstream/ocaml_503/parsing/syntaxerr.mli
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1997 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 type for reporting syntax errors
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type invalid_package_type =
+ | Parameterized_types
+ | Constrained_types
+ | Private_types
+ | Not_with_type
+ | Neither_identifier_nor_with_type
+
+type error =
+ Unclosed of Location.t * string * Location.t * string
+ | Expecting of Location.t * string
+ | Not_expecting of Location.t * string
+ | Applicative_path of Location.t
+ | Variable_in_scope of Location.t * string
+ | Other of Location.t
+ | Ill_formed_ast of Location.t * string
+ | Invalid_package_type of Location.t * invalid_package_type
+ | Removed_string_set of Location.t
+
+exception Error of error
+exception Escape_error
+
+val location_of_error: error -> Location.t
+val ill_formed_ast: Location.t -> string -> 'a
diff --git a/upstream/ocaml_503/parsing/unit_info.ml b/upstream/ocaml_503/parsing/unit_info.ml
new file mode 100644
index 0000000000..66ad51b7cb
--- /dev/null
+++ b/upstream/ocaml_503/parsing/unit_info.ml
@@ -0,0 +1,141 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2023 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. *)
+(* *)
+(**************************************************************************)
+
+type intf_or_impl = Intf | Impl
+type modname = string
+type filename = string
+type file_prefix = string
+
+type error = Invalid_encoding of string
+exception Error of error
+
+type t = {
+ source_file: filename;
+ prefix: file_prefix;
+ modname: modname;
+ kind: intf_or_impl;
+}
+
+let source_file (x: t) = x.source_file
+let modname (x: t) = x.modname
+let kind (x: t) = x.kind
+let prefix (x: t) = x.prefix
+
+let basename_chop_extensions basename =
+ match String.index basename '.' with
+ | dot_pos -> String.sub basename 0 dot_pos
+ | exception Not_found -> basename
+
+let strict_modulize s =
+ match Misc.Utf8_lexeme.capitalize s with
+ | Ok x -> x
+ | Error _ -> raise (Error (Invalid_encoding s))
+
+let modulize s = match Misc.Utf8_lexeme.capitalize s with Ok x | Error x -> x
+
+(* We re-export the [Misc] definition, and ignore encoding errors under the
+ assumption that we should focus our effort on not *producing* badly encoded
+ module names *)
+let normalize x = match Misc.normalized_unit_filename x with
+ | Ok x | Error x -> x
+
+let stem source_file =
+ source_file |> Filename.basename |> basename_chop_extensions
+
+let strict_modname_from_source source_file =
+ source_file |> stem |> strict_modulize
+
+let lax_modname_from_source source_file =
+ source_file |> stem |> modulize
+
+(* Check validity of module name *)
+let is_unit_name name = Misc.Utf8_lexeme.is_valid_identifier name
+
+let check_unit_name file =
+ if not (is_unit_name (modname file)) then
+ Location.prerr_warning (Location.in_file (source_file file))
+ (Warnings.Bad_module_name (modname file))
+
+let make ?(check_modname=true) ~source_file kind prefix =
+ let modname = strict_modname_from_source prefix in
+ let p = { modname; prefix; source_file; kind } in
+ if check_modname then check_unit_name p;
+ p
+
+module Artifact = struct
+ type t =
+ {
+ source_file: filename option;
+ filename: filename;
+ modname: modname;
+ }
+ let source_file x = x.source_file
+ let filename x = x.filename
+ let modname x = x.modname
+ let prefix x = Filename.remove_extension (filename x)
+
+ let from_filename filename =
+ let modname = lax_modname_from_source filename in
+ { modname; filename; source_file = None }
+
+end
+
+let mk_artifact ext u =
+ {
+ Artifact.filename = u.prefix ^ ext;
+ modname = u.modname;
+ source_file = Some u.source_file;
+ }
+
+let companion_artifact ext x =
+ { x with Artifact.filename = Artifact.prefix x ^ ext }
+
+let cmi f = mk_artifact ".cmi" f
+let cmo f = mk_artifact ".cmo" f
+let cmx f = mk_artifact ".cmx" f
+let obj f = mk_artifact Config.ext_obj f
+let cmt f = mk_artifact ".cmt" f
+let cmti f = mk_artifact ".cmti" f
+let annot f = mk_artifact ".annot" f
+
+let companion_obj f = companion_artifact Config.ext_obj f
+let companion_cmt f = companion_artifact ".cmt" f
+
+let companion_cmi f =
+ let prefix = Misc.chop_extensions f.Artifact.filename in
+ { f with Artifact.filename = prefix ^ ".cmi"}
+
+let mli_from_artifact f = Artifact.prefix f ^ !Config.interface_suffix
+let mli_from_source u =
+ let prefix = Filename.remove_extension (source_file u) in
+ prefix ^ !Config.interface_suffix
+
+let is_cmi f = Filename.check_suffix (Artifact.filename f) ".cmi"
+
+let find_normalized_cmi f =
+ let filename = modname f ^ ".cmi" in
+ let filename = Load_path.find_normalized filename in
+ { Artifact.filename; modname = modname f; source_file = Some f.source_file }
+
+let report_error = function
+ | Invalid_encoding name ->
+ Location.errorf "Invalid encoding of output name: %s." name
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err -> Some (report_error err)
+ | _ -> None
+ )
diff --git a/upstream/ocaml_503/parsing/unit_info.mli b/upstream/ocaml_503/parsing/unit_info.mli
new file mode 100644
index 0000000000..04002b2520
--- /dev/null
+++ b/upstream/ocaml_503/parsing/unit_info.mli
@@ -0,0 +1,172 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2023 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. *)
+(* *)
+(**************************************************************************)
+
+(** This module centralize the handling of compilation files and their metadata.
+
+ Maybe more importantly, this module provides functions for deriving module
+ names from strings or filenames.
+*)
+
+(** {1:modname_from_strings Module name convention and computation} *)
+
+type intf_or_impl = Intf | Impl
+type modname = string
+type filename = string
+type file_prefix = string
+
+type error = Invalid_encoding of filename
+exception Error of error
+
+(** [modulize s] capitalizes the first letter of [s]. *)
+val modulize: string -> modname
+
+(** [normalize s] uncapitalizes the first letter of [s]. *)
+val normalize: string -> string
+
+(** [lax_modname_from_source filename] is [modulize stem] where [stem] is the
+ basename of the filename [filename] stripped from all its extensions.
+ For instance, [modname_from_source "/pa.th/x.ml.pp"] is ["X"]. *)
+val lax_modname_from_source: filename -> modname
+
+(** Same as {!lax_modname_from_source} but raises an {!error.Invalid_encoding}
+ error on filename with invalid utf8 encoding. *)
+val strict_modname_from_source: filename -> modname
+
+(** {2:module_name_validation Module name validation function}*)
+
+(** [is_unit_name name] is true only if [name] can be used as a
+ valid module name. *)
+val is_unit_name : modname -> bool
+
+
+(** {1:unit_info Metadata for compilation unit} *)
+
+type t
+(** Metadata for a compilation unit:
+ - the module name associated to the unit
+ - the filename prefix (dirname + basename with all extensions stripped)
+ for compilation artifacts
+ - the input source file
+ For instance, when calling [ocamlopt dir/x.mli -o target/y.cmi],
+ - the input source file is [dir/x.mli]
+ - the module name is [Y]
+ - the prefix is [target/y]
+*)
+
+(** [source_file u] is the source file of [u]. *)
+val source_file: t -> filename
+
+(** [prefix u] is the filename prefix of the unit. *)
+val prefix: t -> file_prefix
+
+(** [modname u] or [artifact_modname a] is the module name of the unit
+ or compilation artifact.*)
+val modname: t -> modname
+
+(** [kind u] is the kind (interface or implementation) of the unit. *)
+val kind: t -> intf_or_impl
+
+(** [check_unit_name u] prints a warning if the derived module name [modname u]
+ should not be used as a module name as specified
+ by {!is_unit_name}[ ~strict:true]. *)
+val check_unit_name : t -> unit
+
+(** [make ~check ~source_file kind prefix] associates both the
+ [source_file] and the module name {!modname_from_source}[ target_prefix] to
+ the prefix filesystem path [prefix].
+
+ If [check_modname=true], this function emits a warning if the derived module
+ name is not valid according to {!check_unit_name}.
+*)
+val make:
+ ?check_modname:bool -> source_file:filename ->
+ intf_or_impl -> file_prefix -> t
+
+(** {1:artifact_function Build artifacts }*)
+module Artifact: sig
+ type t
+(** Metadata for a single compilation artifact:
+ - the module name associated to the artifact
+ - the filesystem path
+ - the input source file if it exists
+*)
+
+ (** [source_file a] is the source file of [a] if it exists. *)
+ val source_file: t -> filename option
+
+ (** [prefix a] is the filename prefix of the compilation artifact. *)
+ val prefix: t -> file_prefix
+
+ (** [filename u] is the filesystem path for a compilation artifact. *)
+ val filename: t -> filename
+
+ (** [modname a] is the module name of the compilation artifact.*)
+ val modname: t -> modname
+
+ (** [from_filename filename] reconstructs the module name
+ [modname_from_source filename] associated to the artifact [filename]. *)
+ val from_filename: filename -> t
+
+end
+
+(** {1:info_build_artifacts Derived build artifact metadata} *)
+
+(** Those functions derive a specific [artifact] metadata from an [unit]
+ metadata.*)
+val cmi: t -> Artifact.t
+val cmo: t -> Artifact.t
+val cmx: t -> Artifact.t
+val obj: t -> Artifact.t
+val cmt: t -> Artifact.t
+val cmti: t -> Artifact.t
+val annot: t -> Artifact.t
+
+(** The functions below change the type of an artifact by updating the
+ extension of its filename.
+ Those functions purposefully do not cover all artifact kinds because we want
+ to track which artifacts are assumed to be bundled together. *)
+val companion_obj: Artifact.t -> Artifact.t
+val companion_cmt: Artifact.t -> Artifact.t
+
+val companion_cmi: Artifact.t -> Artifact.t
+(** Beware that [companion_cmi a] strips all extensions from the
+ filename of [a] before adding the [".cmi"] suffix contrarily to
+ the other functions which only remove the rightmost extension.
+ In other words, the companion cmi of a file [something.d.cmo] is
+ [something.cmi] and not [something.d.cmi].
+*)
+
+(** {1:ml_mli_cmi_interaction Mli and cmi derived from implementation files } *)
+
+(** The compilation of module implementation changes in presence of mli and cmi
+ files, the function belows help to handle this. *)
+
+(** [mli_from_source u] is the interface source filename associated to the unit
+ [u]. The actual suffix depends on {!Config.interface_suffix}.
+*)
+val mli_from_source: t -> filename
+
+(** [mli_from_artifact t] is the name of the interface source file derived from
+ the artifact [t]. This variant is necessary when handling artifacts derived
+ from an unknown source files (e.g. packed modules). *)
+val mli_from_artifact: Artifact.t -> filename
+
+(** Check if the artifact is a cmi *)
+val is_cmi: Artifact.t -> bool
+
+(** [find_normalized_cmi u] finds in the load_path a file matching the module
+ name [modname u].
+ @raise Not_found if no such cmi exists *)
+val find_normalized_cmi: t -> Artifact.t
diff --git a/upstream/ocaml_503/typing/annot.mli b/upstream/ocaml_503/typing/annot.mli
new file mode 100644
index 0000000000..bbaade5b03
--- /dev/null
+++ b/upstream/ocaml_503/typing/annot.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Gallium, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2007 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. *)
+(* *)
+(**************************************************************************)
+
+(* Data types for annotations (Stypes.ml) *)
+
+type call = Tail | Stack | Inline
+
+type ident =
+ | Iref_internal of Location.t (* defining occurrence *)
+ | Iref_external
+ | Idef of Location.t (* scope *)
diff --git a/upstream/ocaml_503/typing/btype.ml b/upstream/ocaml_503/typing/btype.ml
new file mode 100644
index 0000000000..75a9f5f237
--- /dev/null
+++ b/upstream/ocaml_503/typing/btype.ml
@@ -0,0 +1,788 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy and Jerome Vouillon, 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. *)
+(* *)
+(**************************************************************************)
+
+(* Basic operations on core types *)
+
+open Asttypes
+open Types
+
+open Local_store
+
+(**** Sets, maps and hashtables of types ****)
+
+let wrap_repr f ty = f (Transient_expr.repr ty)
+let wrap_type_expr f tty = f (Transient_expr.type_expr tty)
+
+module TransientTypeSet = Set.Make(TransientTypeOps)
+module TypeSet = struct
+ include TransientTypeSet
+ let add = wrap_repr add
+ let mem = wrap_repr mem
+ let singleton = wrap_repr singleton
+ let exists p = TransientTypeSet.exists (wrap_type_expr p)
+ let elements set =
+ List.map Transient_expr.type_expr (TransientTypeSet.elements set)
+end
+module TransientTypeMap = Map.Make(TransientTypeOps)
+module TypeMap = struct
+ include TransientTypeMap
+ let add ty = wrap_repr add ty
+ let find ty = wrap_repr find ty
+ let singleton ty = wrap_repr singleton ty
+ let fold f = TransientTypeMap.fold (wrap_type_expr f)
+end
+module TypeHash = struct
+ include TransientTypeHash
+ let mem hash = wrap_repr (mem hash)
+ let add hash = wrap_repr (add hash)
+ let remove hash = wrap_repr (remove hash)
+ let find hash = wrap_repr (find hash)
+ let find_opt hash = wrap_repr (find_opt hash)
+ let iter f = TransientTypeHash.iter (wrap_type_expr f)
+end
+module TransientTypePairs =
+ Hashtbl.Make (struct
+ type t = transient_expr * transient_expr
+ let equal (t1, t1') (t2, t2') = (t1 == t2) && (t1' == t2')
+ let hash (t, t') = t.id + 93 * t'.id
+ end)
+module TypePairs = struct
+ module H = TransientTypePairs
+ open Transient_expr
+
+ type t = {
+ set : unit H.t;
+ mutable elems : (transient_expr * transient_expr) list;
+ (* elems preserves the (reversed) insertion order of elements *)
+ }
+
+ let create n =
+ { elems = []; set = H.create n }
+
+ let clear t =
+ t.elems <- [];
+ H.clear t.set
+
+ let repr2 (t1, t2) = (repr t1, repr t2)
+
+ let add t p =
+ let p = repr2 p in
+ if H.mem t.set p then () else begin
+ H.add t.set p ();
+ t.elems <- p :: t.elems
+ end
+
+ let mem t p = H.mem t.set (repr2 p)
+
+ let iter f t =
+ (* iterate in insertion order, not Hashtbl.iter order *)
+ List.rev t.elems
+ |> List.iter (fun (t1,t2) ->
+ f (type_expr t1, type_expr t2))
+end
+
+(**** Type level management ****)
+
+let generic_level = Ident.highest_scope
+let lowest_level = Ident.lowest_scope
+
+(**** leveled type pool ****)
+(* This defines a stack of pools of type nodes indexed by the level
+ we will try to generalize them in [Ctype.with_local_level_gen].
+ [pool_of_level] returns the pool in which types at level [level]
+ should be kept, which is the topmost pool whose level is lower or
+ equal to [level].
+ [Ctype.with_local_level_gen] shall call [with_new_pool] to create
+ a new pool at a given level. On return it shall process all nodes
+ that were added to the pool.
+ Remark: the only function adding to a pool is [add_to_pool], and
+ the only function returning the contents of a pool is [with_new_pool],
+ so that the initial pool can be added to, but never read from. *)
+
+type pool = {level: int; mutable pool: transient_expr list; next: pool}
+(* To avoid an indirection we choose to add a dummy level at the end of
+ the list. It will never be accessed, as [pool_of_level] is always called
+ with [level >= 0]. *)
+let rec dummy = {level = max_int; pool = []; next = dummy}
+let pool_stack = s_table (fun () -> {level = 0; pool = []; next = dummy}) ()
+
+(* Lookup in the stack is linear, but the depth is the number of nested
+ generalization points (e.g. lhs of let-definitions), which in ML is known
+ to be generally low. In most cases we are allocating in the topmost pool.
+ In [Ctype.with_local_gen], we move non-generalizable type nodes from the
+ topmost pool to one deeper in the stack, so that for each type node the
+ accumulated depth of lookups over its life is bounded by the depth of
+ the stack when it was allocated.
+ In case this linear search turns out to be costly, we could switch to
+ binary search, exploiting the fact that the levels of pools in the stack
+ are expected to grow. *)
+let rec pool_of_level level pool =
+ if level >= pool.level then pool else pool_of_level level pool.next
+
+(* Create a new pool at given level, and use it locally. *)
+let with_new_pool ~level f =
+ let pool = {level; pool = []; next = !pool_stack} in
+ let r =
+ Misc.protect_refs [ R(pool_stack, pool) ] f
+ in
+ (r, pool.pool)
+
+let add_to_pool ~level ty =
+ if level >= generic_level || level <= lowest_level then () else
+ let pool = pool_of_level level !pool_stack in
+ pool.pool <- ty :: pool.pool
+
+(**** Some type creators ****)
+
+let newty3 ~level ~scope desc =
+ let ty = proto_newty3 ~level ~scope desc in
+ add_to_pool ~level ty;
+ Transient_expr.type_expr ty
+
+let newty2 ~level desc =
+ newty3 ~level ~scope:Ident.lowest_scope desc
+
+let newgenty desc = newty2 ~level:generic_level desc
+let newgenvar ?name () = newgenty (Tvar name)
+let newgenstub ~scope = newty3 ~level:generic_level ~scope (Tvar None)
+
+(**** Check some types ****)
+
+let is_Tvar ty = match get_desc ty with Tvar _ -> true | _ -> false
+let is_Tunivar ty = match get_desc ty with Tunivar _ -> true | _ -> false
+let is_Tconstr ty = match get_desc ty with Tconstr _ -> true | _ -> false
+let is_poly_Tpoly ty =
+ match get_desc ty with Tpoly (_, _ :: _) -> true | _ -> false
+let type_kind_is_abstract decl =
+ match decl.type_kind with Type_abstract _ -> true | _ -> false
+let type_origin decl =
+ match decl.type_kind with
+ | Type_abstract origin -> origin
+ | Type_variant _ | Type_record _ | Type_open -> Definition
+let label_is_poly lbl = is_poly_Tpoly lbl.lbl_arg
+
+let dummy_method = "*dummy method*"
+
+(**** Representative of a type ****)
+
+let merge_fixed_explanation fixed1 fixed2 =
+ match fixed1, fixed2 with
+ | Some Univar _ as x, _ | _, (Some Univar _ as x) -> x
+ | Some Fixed_private as x, _ | _, (Some Fixed_private as x) -> x
+ | Some Reified _ as x, _ | _, (Some Reified _ as x) -> x
+ | Some Rigid as x, _ | _, (Some Rigid as x) -> x
+ | None, None -> None
+
+
+let fixed_explanation row =
+ match row_fixed row with
+ | Some _ as x -> x
+ | None ->
+ let ty = row_more row in
+ match get_desc ty with
+ | Tvar _ | Tnil -> None
+ | Tunivar _ -> Some (Univar ty)
+ | Tconstr (p,_,_) -> Some (Reified p)
+ | _ -> assert false
+
+let is_fixed row = match row_fixed row with
+ | None -> false
+ | Some _ -> true
+
+let has_fixed_explanation row = fixed_explanation row <> None
+
+let static_row row =
+ row_closed row &&
+ List.for_all
+ (fun (_,f) -> match row_field_repr f with Reither _ -> false | _ -> true)
+ (row_fields row)
+
+let hash_variant s =
+ let accu = ref 0 in
+ for i = 0 to String.length s - 1 do
+ accu := 223 * !accu + Char.code s.[i]
+ done;
+ (* reduce to 31 bits *)
+ accu := !accu land (1 lsl 31 - 1);
+ (* make it signed for 64 bits architectures *)
+ if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu
+
+let proxy ty =
+ match get_desc ty with
+ | Tvariant row when not (static_row row) ->
+ row_more row
+ | Tobject (ty, _) ->
+ let rec proxy_obj ty =
+ match get_desc ty with
+ Tfield (_, _, _, ty) -> proxy_obj ty
+ | Tvar _ | Tunivar _ | Tconstr _ -> ty
+ | Tnil -> ty
+ | _ -> assert false
+ in proxy_obj ty
+ | _ -> ty
+
+(**** Utilities for fixed row private types ****)
+
+let row_of_type t =
+ match get_desc t with
+ Tobject(t,_) ->
+ let rec get_row t =
+ match get_desc t with
+ Tfield(_,_,_,t) -> get_row t
+ | _ -> t
+ in get_row t
+ | Tvariant row ->
+ row_more row
+ | _ ->
+ t
+
+let has_constr_row t =
+ not (is_Tconstr t) && is_Tconstr (row_of_type t)
+
+let is_row_name s =
+ let l = String.length s in
+ (* PR#10661: when l=4 and s is "#row", this is not a row name
+ but the valid #-type name of a class named "row". *)
+ l > 4 && String.sub s (l-4) 4 = "#row"
+
+let is_constr_row ~allow_ident t =
+ match get_desc t with
+ Tconstr (Path.Pident id, _, _) when allow_ident ->
+ is_row_name (Ident.name id)
+ | Tconstr (Path.Pdot (_, s), _, _) -> is_row_name s
+ | _ -> false
+
+(* TODO: where should this really be *)
+(* Set row_name in Env, cf. GPR#1204/1329 *)
+let set_static_row_name decl path =
+ match decl.type_manifest with
+ None -> ()
+ | Some ty ->
+ match get_desc ty with
+ Tvariant row when static_row row ->
+ let row =
+ set_row_name row (Some (path, decl.type_params)) in
+ set_type_desc ty (Tvariant row)
+ | _ -> ()
+
+ (**********************************)
+ (* Utilities for type traversal *)
+ (**********************************)
+
+let fold_row f init row =
+ let result =
+ List.fold_left
+ (fun init (_, fi) ->
+ match row_field_repr fi with
+ | Rpresent(Some ty) -> f init ty
+ | Reither(_, tl, _) -> List.fold_left f init tl
+ | _ -> init)
+ init
+ (row_fields row)
+ in
+ match get_desc (row_more row) with
+ | Tvar _ | Tunivar _ | Tsubst _ | Tconstr _ | Tnil ->
+ begin match
+ Option.map (fun (_,l) -> List.fold_left f result l) (row_name row)
+ with
+ | None -> result
+ | Some result -> result
+ end
+ | _ -> assert false
+
+let iter_row f row =
+ fold_row (fun () v -> f v) () row
+
+let fold_type_expr f init ty =
+ match get_desc ty with
+ Tvar _ -> init
+ | Tarrow (_, ty1, ty2, _) ->
+ let result = f init ty1 in
+ f result ty2
+ | Ttuple l -> List.fold_left f init l
+ | Tconstr (_, l, _) -> List.fold_left f init l
+ | Tobject(ty, {contents = Some (_, p)}) ->
+ let result = f init ty in
+ List.fold_left f result p
+ | Tobject (ty, _) -> f init ty
+ | Tvariant row ->
+ let result = fold_row f init row in
+ f result (row_more row)
+ | Tfield (_, _, ty1, ty2) ->
+ let result = f init ty1 in
+ f result ty2
+ | Tnil -> init
+ | Tlink _
+ | Tsubst _ -> assert false
+ | Tunivar _ -> init
+ | Tpoly (ty, tyl) ->
+ let result = f init ty in
+ List.fold_left f result tyl
+ | Tpackage (_, fl) ->
+ List.fold_left (fun result (_n, ty) -> f result ty) init fl
+
+let iter_type_expr f ty =
+ fold_type_expr (fun () v -> f v) () ty
+
+let rec iter_abbrev f = function
+ Mnil -> ()
+ | Mcons(_, _, ty, ty', rem) -> f ty; f ty'; iter_abbrev f rem
+ | Mlink rem -> iter_abbrev f !rem
+
+let iter_type_expr_cstr_args f = function
+ | Cstr_tuple tl -> List.iter f tl
+ | Cstr_record lbls -> List.iter (fun d -> f d.ld_type) lbls
+
+let map_type_expr_cstr_args f = function
+ | Cstr_tuple tl -> Cstr_tuple (List.map f tl)
+ | Cstr_record lbls ->
+ Cstr_record (List.map (fun d -> {d with ld_type=f d.ld_type}) lbls)
+
+let iter_type_expr_kind f = function
+ | Type_abstract _ -> ()
+ | Type_variant (cstrs, _) ->
+ List.iter
+ (fun cd ->
+ iter_type_expr_cstr_args f cd.cd_args;
+ Option.iter f cd.cd_res
+ )
+ cstrs
+ | Type_record(lbls, _) ->
+ List.iter (fun d -> f d.ld_type) lbls
+ | Type_open ->
+ ()
+
+ (**********************************)
+ (* Utilities for marking *)
+ (**********************************)
+
+let rec mark_type mark ty =
+ if try_mark_node mark ty then iter_type_expr (mark_type mark) ty
+
+let mark_type_params mark ty =
+ iter_type_expr (mark_type mark) ty
+
+ (**********************************)
+ (* (Object-oriented) iterator *)
+ (**********************************)
+
+type 'a type_iterators =
+ { it_signature: 'a type_iterators -> signature -> unit;
+ it_signature_item: 'a type_iterators -> signature_item -> unit;
+ it_value_description: 'a type_iterators -> value_description -> unit;
+ it_type_declaration: 'a type_iterators -> type_declaration -> unit;
+ it_extension_constructor:
+ 'a type_iterators -> extension_constructor -> unit;
+ it_module_declaration: 'a type_iterators -> module_declaration -> unit;
+ it_modtype_declaration: 'a type_iterators -> modtype_declaration -> unit;
+ it_class_declaration: 'a type_iterators -> class_declaration -> unit;
+ it_class_type_declaration:
+ 'a type_iterators -> class_type_declaration -> unit;
+ it_functor_param: 'a type_iterators -> functor_parameter -> unit;
+ it_module_type: 'a type_iterators -> module_type -> unit;
+ it_class_type: 'a type_iterators -> class_type -> unit;
+ it_type_kind: 'a type_iterators -> type_decl_kind -> unit;
+ it_do_type_expr: 'a type_iterators -> 'a;
+ it_type_expr: 'a type_iterators -> type_expr -> unit;
+ it_path: Path.t -> unit; }
+
+type type_iterators_full = (type_expr -> unit) type_iterators
+type type_iterators_without_type_expr = (unit -> unit) type_iterators
+
+let type_iterators_without_type_expr =
+ let it_signature it =
+ List.iter (it.it_signature_item it)
+ and it_signature_item it = function
+ Sig_value (_, vd, _) -> it.it_value_description it vd
+ | Sig_type (_, td, _, _) -> it.it_type_declaration it td
+ | Sig_typext (_, td, _, _) -> it.it_extension_constructor it td
+ | Sig_module (_, _, md, _, _) -> it.it_module_declaration it md
+ | Sig_modtype (_, mtd, _) -> it.it_modtype_declaration it mtd
+ | Sig_class (_, cd, _, _) -> it.it_class_declaration it cd
+ | Sig_class_type (_, ctd, _, _) -> it.it_class_type_declaration it ctd
+ and it_value_description it vd =
+ it.it_type_expr it vd.val_type
+ and it_type_declaration it td =
+ List.iter (it.it_type_expr it) td.type_params;
+ Option.iter (it.it_type_expr it) td.type_manifest;
+ it.it_type_kind it td.type_kind
+ and it_extension_constructor it td =
+ it.it_path td.ext_type_path;
+ List.iter (it.it_type_expr it) td.ext_type_params;
+ iter_type_expr_cstr_args (it.it_type_expr it) td.ext_args;
+ Option.iter (it.it_type_expr it) td.ext_ret_type
+ and it_module_declaration it md =
+ it.it_module_type it md.md_type
+ and it_modtype_declaration it mtd =
+ Option.iter (it.it_module_type it) mtd.mtd_type
+ and it_class_declaration it cd =
+ List.iter (it.it_type_expr it) cd.cty_params;
+ it.it_class_type it cd.cty_type;
+ Option.iter (it.it_type_expr it) cd.cty_new;
+ it.it_path cd.cty_path
+ and it_class_type_declaration it ctd =
+ List.iter (it.it_type_expr it) ctd.clty_params;
+ it.it_class_type it ctd.clty_type;
+ it.it_path ctd.clty_path
+ and it_functor_param it = function
+ | Unit -> ()
+ | Named (_, mt) -> it.it_module_type it mt
+ and it_module_type it = function
+ Mty_ident p
+ | Mty_alias p -> it.it_path p
+ | Mty_signature sg -> it.it_signature it sg
+ | Mty_functor (p, mt) ->
+ it.it_functor_param it p;
+ it.it_module_type it mt
+ and it_class_type it = function
+ Cty_constr (p, tyl, cty) ->
+ it.it_path p;
+ List.iter (it.it_type_expr it) tyl;
+ it.it_class_type it cty
+ | Cty_signature cs ->
+ it.it_type_expr it cs.csig_self;
+ it.it_type_expr it cs.csig_self_row;
+ Vars.iter (fun _ (_,_,ty) -> it.it_type_expr it ty) cs.csig_vars;
+ Meths.iter (fun _ (_,_,ty) -> it.it_type_expr it ty) cs.csig_meths
+ | Cty_arrow (_, ty, cty) ->
+ it.it_type_expr it ty;
+ it.it_class_type it cty
+ and it_type_kind it kind =
+ iter_type_expr_kind (it.it_type_expr it) kind
+ and it_path _p = ()
+ in
+ { it_path; it_type_expr = (fun _ _ -> ()); it_do_type_expr = (fun _ _ -> ());
+ it_type_kind; it_class_type; it_functor_param; it_module_type;
+ it_signature; it_class_type_declaration; it_class_declaration;
+ it_modtype_declaration; it_module_declaration; it_extension_constructor;
+ it_type_declaration; it_value_description; it_signature_item; }
+
+let type_iterators mark =
+ let it_type_expr it ty =
+ if try_mark_node mark ty then it.it_do_type_expr it ty
+ and it_do_type_expr it ty =
+ iter_type_expr (it.it_type_expr it) ty;
+ match get_desc ty with
+ Tconstr (p, _, _)
+ | Tobject (_, {contents=Some (p, _)})
+ | Tpackage (p, _) ->
+ it.it_path p
+ | Tvariant row ->
+ Option.iter (fun (p,_) -> it.it_path p) (row_name row)
+ | _ -> ()
+ in
+ {type_iterators_without_type_expr with it_type_expr; it_do_type_expr}
+
+ (**********************************)
+ (* Utilities for copying *)
+ (**********************************)
+
+let copy_row f fixed row keep more =
+ let Row {fields = orig_fields; fixed = orig_fixed; closed; name = orig_name} =
+ row_repr row in
+ let fields = List.map
+ (fun (l, fi) -> l,
+ match row_field_repr fi with
+ | Rpresent oty -> rf_present (Option.map f oty)
+ | Reither(c, tl, m) ->
+ let use_ext_of = if keep then Some fi else None in
+ let m = if is_fixed row then fixed else m in
+ let tl = List.map f tl in
+ rf_either tl ?use_ext_of ~no_arg:c ~matched:m
+ | Rabsent -> rf_absent)
+ orig_fields in
+ let name =
+ match orig_name with
+ | None -> None
+ | Some (path, tl) -> Some (path, List.map f tl) in
+ let fixed = if fixed then orig_fixed else None in
+ create_row ~fields ~more ~fixed ~closed ~name
+
+let copy_commu c = if is_commu_ok c then commu_ok else commu_var ()
+
+let rec copy_type_desc ?(keep_names=false) f = function
+ Tvar _ as ty -> if keep_names then ty else Tvar None
+ | Tarrow (p, ty1, ty2, c)-> Tarrow (p, f ty1, f ty2, copy_commu c)
+ | Ttuple l -> Ttuple (List.map f l)
+ | Tconstr (p, l, _) -> Tconstr (p, List.map f l, ref Mnil)
+ | Tobject(ty, {contents = Some (p, tl)})
+ -> Tobject (f ty, ref (Some(p, List.map f tl)))
+ | Tobject (ty, _) -> Tobject (f ty, ref None)
+ | Tvariant _ -> assert false (* too ambiguous *)
+ | Tfield (p, k, ty1, ty2) ->
+ Tfield (p, field_kind_internal_repr k, f ty1, f ty2)
+ (* the kind is kept shared, with indirections removed for performance *)
+ | Tnil -> Tnil
+ | Tlink ty -> copy_type_desc f (get_desc ty)
+ | Tsubst _ -> assert false
+ | Tunivar _ as ty -> ty (* always keep the name *)
+ | Tpoly (ty, tyl) ->
+ let tyl = List.map f tyl in
+ Tpoly (f ty, tyl)
+ | Tpackage (p, fl) -> Tpackage (p, List.map (fun (n, ty) -> (n, f ty)) fl)
+
+(* TODO: rename to [module Copy_scope] *)
+module For_copy : sig
+ type copy_scope
+
+ val redirect_desc: copy_scope -> type_expr -> type_desc -> unit
+
+ val with_scope: (copy_scope -> 'a) -> 'a
+end = struct
+ type copy_scope = {
+ mutable saved_desc : (transient_expr * type_desc) list;
+ (* Save association of generic nodes with their description. *)
+ }
+
+ let redirect_desc copy_scope ty desc =
+ let ty = Transient_expr.repr ty in
+ copy_scope.saved_desc <- (ty, ty.desc) :: copy_scope.saved_desc;
+ Transient_expr.set_desc ty desc
+
+ (* Restore type descriptions. *)
+ let cleanup { saved_desc; _ } =
+ List.iter (fun (ty, desc) -> Transient_expr.set_desc ty desc) saved_desc
+
+ let with_scope f =
+ let scope = { saved_desc = [] } in
+ Fun.protect ~finally:(fun () -> cleanup scope) (fun () -> f scope)
+
+end
+
+ (*******************************************)
+ (* Memorization of abbreviation expansion *)
+ (*******************************************)
+
+(* Search whether the expansion has been memorized. *)
+
+let lte_public p1 p2 = (* Private <= Public *)
+ match p1, p2 with
+ | Private, _ | _, Public -> true
+ | Public, Private -> false
+
+let rec find_expans priv p1 = function
+ Mnil -> None
+ | Mcons (priv', p2, _ty0, ty, _)
+ when lte_public priv priv' && Path.same p1 p2 -> Some ty
+ | Mcons (_, _, _, _, rem) -> find_expans priv p1 rem
+ | Mlink {contents = rem} -> find_expans priv p1 rem
+
+(* debug: check for cycles in abbreviation. only works with -principal
+let rec check_expans visited ty =
+ let ty = repr ty in
+ assert (not (List.memq ty visited));
+ match ty.desc with
+ Tconstr (path, args, abbrev) ->
+ begin match find_expans path !abbrev with
+ Some ty' -> check_expans (ty :: visited) ty'
+ | None -> ()
+ end
+ | _ -> ()
+*)
+
+let memo = s_ref []
+ (* Contains the list of saved abbreviation expansions. *)
+
+let cleanup_abbrev () =
+ (* Remove all memorized abbreviation expansions. *)
+ List.iter (fun abbr -> abbr := Mnil) !memo;
+ memo := []
+
+let memorize_abbrev mem priv path v v' =
+ (* Memorize the expansion of an abbreviation. *)
+ mem := Mcons (priv, path, v, v', !mem);
+ (* check_expans [] v; *)
+ memo := mem :: !memo
+
+let rec forget_abbrev_rec mem path =
+ match mem with
+ Mnil ->
+ mem
+ | Mcons (_, path', _, _, rem) when Path.same path path' ->
+ rem
+ | Mcons (priv, path', v, v', rem) ->
+ Mcons (priv, path', v, v', forget_abbrev_rec rem path)
+ | Mlink mem' ->
+ mem' := forget_abbrev_rec !mem' path;
+ raise Exit
+
+let forget_abbrev mem path =
+ try mem := forget_abbrev_rec !mem path with Exit -> ()
+
+(* debug: check for invalid abbreviations
+let rec check_abbrev_rec = function
+ Mnil -> true
+ | Mcons (_, ty1, ty2, rem) ->
+ repr ty1 != repr ty2
+ | Mlink mem' ->
+ check_abbrev_rec !mem'
+
+let check_memorized_abbrevs () =
+ List.for_all (fun mem -> check_abbrev_rec !mem) !memo
+*)
+
+(* Re-export backtrack *)
+
+let snapshot = snapshot
+let backtrack = backtrack ~cleanup_abbrev
+
+ (**********************************)
+ (* Utilities for labels *)
+ (**********************************)
+
+let is_optional = function Optional _ -> true | _ -> false
+
+let label_name = function
+ Nolabel -> ""
+ | Labelled s
+ | Optional s -> s
+
+let prefixed_label_name = function
+ Nolabel -> ""
+ | Labelled s -> "~" ^ s
+ | Optional s -> "?" ^ s
+
+let rec extract_label_aux hd l = function
+ | [] -> None
+ | (l',t as p) :: ls ->
+ if label_name l' = l then
+ Some (l', t, hd <> [], List.rev_append hd ls)
+ else
+ extract_label_aux (p::hd) l ls
+
+let extract_label l ls = extract_label_aux [] l ls
+
+ (*******************************)
+ (* Operations on class types *)
+ (*******************************)
+
+let rec signature_of_class_type =
+ function
+ Cty_constr (_, _, cty) -> signature_of_class_type cty
+ | Cty_signature sign -> sign
+ | Cty_arrow (_, _, cty) -> signature_of_class_type cty
+
+let rec class_body cty =
+ match cty with
+ Cty_constr _ ->
+ cty (* Only class bodies can be abbreviated *)
+ | Cty_signature _ ->
+ cty
+ | Cty_arrow (_, _, cty) ->
+ class_body cty
+
+(* Fully expand the head of a class type *)
+let rec scrape_class_type =
+ function
+ Cty_constr (_, _, cty) -> scrape_class_type cty
+ | cty -> cty
+
+let rec class_type_arity =
+ function
+ Cty_constr (_, _, cty) -> class_type_arity cty
+ | Cty_signature _ -> 0
+ | Cty_arrow (_, _, cty) -> 1 + class_type_arity cty
+
+let rec abbreviate_class_type path params cty =
+ match cty with
+ Cty_constr (_, _, _) | Cty_signature _ ->
+ Cty_constr (path, params, cty)
+ | Cty_arrow (l, ty, cty) ->
+ Cty_arrow (l, ty, abbreviate_class_type path params cty)
+
+let self_type cty =
+ (signature_of_class_type cty).csig_self
+
+let self_type_row cty =
+ (signature_of_class_type cty).csig_self_row
+
+(* Return the methods of a class signature *)
+let methods sign =
+ Meths.fold
+ (fun name _ l -> name :: l)
+ sign.csig_meths []
+
+(* Return the virtual methods of a class signature *)
+let virtual_methods sign =
+ Meths.fold
+ (fun name (_priv, vr, _ty) l ->
+ match vr with
+ | Virtual -> name :: l
+ | Concrete -> l)
+ sign.csig_meths []
+
+(* Return the concrete methods of a class signature *)
+let concrete_methods sign =
+ Meths.fold
+ (fun name (_priv, vr, _ty) s ->
+ match vr with
+ | Virtual -> s
+ | Concrete -> MethSet.add name s)
+ sign.csig_meths MethSet.empty
+
+(* Return the public methods of a class signature *)
+let public_methods sign =
+ Meths.fold
+ (fun name (priv, _vr, _ty) l ->
+ match priv with
+ | Mprivate _ -> l
+ | Mpublic -> name :: l)
+ sign.csig_meths []
+
+(* Return the instance variables of a class signature *)
+let instance_vars sign =
+ Vars.fold
+ (fun name _ l -> name :: l)
+ sign.csig_vars []
+
+(* Return the virtual instance variables of a class signature *)
+let virtual_instance_vars sign =
+ Vars.fold
+ (fun name (_mut, vr, _ty) l ->
+ match vr with
+ | Virtual -> name :: l
+ | Concrete -> l)
+ sign.csig_vars []
+
+(* Return the concrete instance variables of a class signature *)
+let concrete_instance_vars sign =
+ Vars.fold
+ (fun name (_mut, vr, _ty) s ->
+ match vr with
+ | Virtual -> s
+ | Concrete -> VarSet.add name s)
+ sign.csig_vars VarSet.empty
+
+let method_type label sign =
+ match Meths.find label sign.csig_meths with
+ | (_, _, ty) -> ty
+ | exception Not_found -> assert false
+
+let instance_variable_type label sign =
+ match Vars.find label sign.csig_vars with
+ | (_, _, ty) -> ty
+ | exception Not_found -> assert false
+
+
+ (**********)
+ (* Misc *)
+ (**********)
+
+(**** Type information getter ****)
+
+let cstr_type_path cstr =
+ match get_desc cstr.cstr_res with
+ | Tconstr (p, _, _) -> p
+ | _ -> assert false
diff --git a/upstream/ocaml_503/typing/btype.mli b/upstream/ocaml_503/typing/btype.mli
new file mode 100644
index 0000000000..f8fd3ad3e8
--- /dev/null
+++ b/upstream/ocaml_503/typing/btype.mli
@@ -0,0 +1,311 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Basic operations on core types *)
+
+open Asttypes
+open Types
+
+(**** Sets, maps and hashtables of types ****)
+
+module TypeSet : sig
+ include Set.S with type elt = transient_expr
+ val add: type_expr -> t -> t
+ val mem: type_expr -> t -> bool
+ val singleton: type_expr -> t
+ val exists: (type_expr -> bool) -> t -> bool
+ val elements: t -> type_expr list
+end
+module TransientTypeMap : Map.S with type key = transient_expr
+module TypeMap : sig
+ include Map.S with type key = transient_expr
+ and type 'a t = 'a TransientTypeMap.t
+ val add: type_expr -> 'a -> 'a t -> 'a t
+ val find: type_expr -> 'a t -> 'a
+ val singleton: type_expr -> 'a -> 'a t
+ val fold: (type_expr -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+end
+module TypeHash : sig
+ include Hashtbl.S with type key = transient_expr
+ val mem: 'a t -> type_expr -> bool
+ val add: 'a t -> type_expr -> 'a -> unit
+ val remove: 'a t -> type_expr -> unit
+ val find: 'a t -> type_expr -> 'a
+ val find_opt: 'a t -> type_expr -> 'a option
+ val iter: (type_expr -> 'a -> unit) -> 'a t -> unit
+end
+module TypePairs : sig
+ type t
+ val create: int -> t
+ val clear: t -> unit
+ val add: t -> type_expr * type_expr -> unit
+ val mem: t -> type_expr * type_expr -> bool
+ val iter: (type_expr * type_expr -> unit) -> t -> unit
+end
+
+(**** Levels ****)
+
+val generic_level: int
+ (* level of polymorphic variables; = Ident.highest_scope *)
+val lowest_level: int
+ (* lowest level for type nodes; = Ident.lowest_scope *)
+
+val with_new_pool: level:int -> (unit -> 'a) -> 'a * transient_expr list
+ (* [with_new_pool ~level f] executes [f] and returns the nodes
+ that were created at level [level] and above *)
+val add_to_pool: level:int -> transient_expr -> unit
+ (* Add a type node to the pool associated to the level (which should
+ be the level of the type node).
+ Do nothing if [level = generic_level] or [level = lowest_level]. *)
+
+val newty3: level:int -> scope:int -> type_desc -> type_expr
+ (* Create a type with a fresh id *)
+val newty2: level:int -> type_desc -> type_expr
+ (* Create a type with a fresh id and no scope *)
+
+val newgenty: type_desc -> type_expr
+ (* Create a generic type *)
+val newgenvar: ?name:string -> unit -> type_expr
+ (* Return a fresh generic variable *)
+val newgenstub: scope:int -> type_expr
+ (* Return a fresh generic node, to be instantiated
+ by [Transient_expr.set_stub_desc] *)
+
+(**** Types ****)
+
+val is_Tvar: type_expr -> bool
+val is_Tunivar: type_expr -> bool
+val is_Tconstr: type_expr -> bool
+val is_poly_Tpoly: type_expr -> bool
+val dummy_method: label
+val type_kind_is_abstract: type_declaration -> bool
+val type_origin: type_declaration -> type_origin
+val label_is_poly: label_description -> bool
+
+(**** polymorphic variants ****)
+
+val is_fixed: row_desc -> bool
+(* Return whether the row is directly marked as fixed or not *)
+
+val has_fixed_explanation: row_desc -> bool
+(* Return whether the row should be treated as fixed or not.
+ In particular, [is_fixed row] implies [has_fixed_explanation row].
+*)
+
+val fixed_explanation: row_desc -> fixed_explanation option
+(* Return the potential explanation for the fixed row *)
+
+val merge_fixed_explanation:
+ fixed_explanation option -> fixed_explanation option
+ -> fixed_explanation option
+(* Merge two explanations for a fixed row *)
+
+val static_row: row_desc -> bool
+ (* Return whether the row is static or not *)
+val hash_variant: label -> int
+ (* Hash function for variant tags *)
+
+val proxy: type_expr -> type_expr
+ (* Return the proxy representative of the type: either itself
+ or a row variable *)
+
+(**** Utilities for private abbreviations with fixed rows ****)
+val row_of_type: type_expr -> type_expr
+val has_constr_row: type_expr -> bool
+val is_row_name: string -> bool
+val is_constr_row: allow_ident:bool -> type_expr -> bool
+
+(* Set the polymorphic variant row_name field *)
+val set_static_row_name: type_declaration -> Path.t -> unit
+
+(**** Utilities for type traversal ****)
+
+val iter_type_expr: (type_expr -> unit) -> type_expr -> unit
+ (* Iteration on types *)
+val fold_type_expr: ('a -> type_expr -> 'a) -> 'a -> type_expr -> 'a
+val iter_row: (type_expr -> unit) -> row_desc -> unit
+ (* Iteration on types in a row *)
+val fold_row: ('a -> type_expr -> 'a) -> 'a -> row_desc -> 'a
+val iter_abbrev: (type_expr -> unit) -> abbrev_memo -> unit
+ (* Iteration on types in an abbreviation list *)
+val iter_type_expr_kind: (type_expr -> unit) -> (type_decl_kind -> unit)
+
+val iter_type_expr_cstr_args: (type_expr -> unit) ->
+ (constructor_arguments -> unit)
+val map_type_expr_cstr_args: (type_expr -> type_expr) ->
+ (constructor_arguments -> constructor_arguments)
+
+(**** Utilities for type marking ****)
+
+val mark_type: type_mark -> type_expr -> unit
+ (* Mark a type recursively *)
+val mark_type_params: type_mark -> type_expr -> unit
+ (* Mark the sons of a type node recursively *)
+
+(**** (Object-oriented) iterator ****)
+
+type 'a type_iterators =
+ { it_signature: 'a type_iterators -> signature -> unit;
+ it_signature_item: 'a type_iterators -> signature_item -> unit;
+ it_value_description: 'a type_iterators -> value_description -> unit;
+ it_type_declaration: 'a type_iterators -> type_declaration -> unit;
+ it_extension_constructor:
+ 'a type_iterators -> extension_constructor -> unit;
+ it_module_declaration: 'a type_iterators -> module_declaration -> unit;
+ it_modtype_declaration: 'a type_iterators -> modtype_declaration -> unit;
+ it_class_declaration: 'a type_iterators -> class_declaration -> unit;
+ it_class_type_declaration:
+ 'a type_iterators -> class_type_declaration -> unit;
+ it_functor_param: 'a type_iterators -> functor_parameter -> unit;
+ it_module_type: 'a type_iterators -> module_type -> unit;
+ it_class_type: 'a type_iterators -> class_type -> unit;
+ it_type_kind: 'a type_iterators -> type_decl_kind -> unit;
+ it_do_type_expr: 'a type_iterators -> 'a;
+ it_type_expr: 'a type_iterators -> type_expr -> unit;
+ it_path: Path.t -> unit; }
+
+type type_iterators_full = (type_expr -> unit) type_iterators
+type type_iterators_without_type_expr = (unit -> unit) type_iterators
+
+val type_iterators: type_mark -> type_iterators_full
+ (* Iteration on arbitrary type information, including [type_expr].
+ [it_type_expr] calls [mark_node] to avoid loops. *)
+
+val type_iterators_without_type_expr: type_iterators_without_type_expr
+ (* Iteration on arbitrary type information.
+ Cannot recurse on [type_expr]. *)
+
+(**** Utilities for copying ****)
+
+val copy_type_desc:
+ ?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc
+ (* Copy on types *)
+val copy_row:
+ (type_expr -> type_expr) ->
+ bool -> row_desc -> bool -> type_expr -> row_desc
+
+module For_copy : sig
+
+ type copy_scope
+ (* The private state that the primitives below are mutating, it should
+ remain scoped within a single [with_scope] call.
+
+ While it is possible to circumvent that discipline in various
+ ways, you should NOT do that. *)
+
+ val redirect_desc: copy_scope -> type_expr -> type_desc -> unit
+ (* Temporarily change a type description *)
+
+ val with_scope: (copy_scope -> 'a) -> 'a
+ (* [with_scope f] calls [f] and restores saved type descriptions
+ before returning its result. *)
+end
+
+(**** Memorization of abbreviation expansion ****)
+
+val find_expans: private_flag -> Path.t -> abbrev_memo -> type_expr option
+ (* Look up a memorized abbreviation *)
+val cleanup_abbrev: unit -> unit
+ (* Flush the cache of abbreviation expansions.
+ When some types are saved (using [output_value]), this
+ function MUST be called just before. *)
+val memorize_abbrev:
+ abbrev_memo ref ->
+ private_flag -> Path.t -> type_expr -> type_expr -> unit
+ (* Add an expansion in the cache *)
+val forget_abbrev:
+ abbrev_memo ref -> Path.t -> unit
+ (* Remove an abbreviation from the cache *)
+
+(**** Backtracking ****)
+
+val snapshot: unit -> snapshot
+val backtrack: snapshot -> unit
+ (* Backtrack to a given snapshot. Only possible if you have
+ not already backtracked to a previous snapshot.
+ Calls [cleanup_abbrev] internally *)
+
+(**** Utilities for labels ****)
+
+val is_optional : arg_label -> bool
+val label_name : arg_label -> label
+
+(* Returns the label name with first character '?' or '~' as appropriate. *)
+val prefixed_label_name : arg_label -> label
+
+val extract_label :
+ label -> (arg_label * 'a) list ->
+ (arg_label * 'a * bool * (arg_label * 'a) list) option
+(* actual label,
+ value,
+ whether (label, value) was at the head of the list,
+ list without the extracted (label, value) *)
+
+(**** Utilities for class types ****)
+
+(* Get the class signature within a class type *)
+val signature_of_class_type : class_type -> class_signature
+
+(* Get the body of a class type (i.e. without parameters) *)
+val class_body : class_type -> class_type
+
+(* Fully expand the head of a class type *)
+val scrape_class_type : class_type -> class_type
+
+(* Return the number of parameters of a class type *)
+val class_type_arity : class_type -> int
+
+(* Given a path and type parameters, add an abbreviation to a class type *)
+val abbreviate_class_type :
+ Path.t -> type_expr list -> class_type -> class_type
+
+(* Get the self type of a class *)
+val self_type : class_type -> type_expr
+
+(* Get the row variable of the self type of a class *)
+val self_type_row : class_type -> type_expr
+
+(* Return the methods of a class signature *)
+val methods : class_signature -> string list
+
+(* Return the virtual methods of a class signature *)
+val virtual_methods : class_signature -> string list
+
+(* Return the concrete methods of a class signature *)
+val concrete_methods : class_signature -> MethSet.t
+
+(* Return the public methods of a class signature *)
+val public_methods : class_signature -> string list
+
+(* Return the instance variables of a class signature *)
+val instance_vars : class_signature -> string list
+
+(* Return the virtual instance variables of a class signature *)
+val virtual_instance_vars : class_signature -> string list
+
+(* Return the concrete instance variables of a class signature *)
+val concrete_instance_vars : class_signature -> VarSet.t
+
+(* Return the type of a method.
+ @raises [Assert_failure] if the class has no such method. *)
+val method_type : label -> class_signature -> type_expr
+
+(* Return the type of an instance variable.
+ @raises [Assert_failure] if the class has no such method. *)
+val instance_variable_type : label -> class_signature -> type_expr
+
+(**** Type information getter ****)
+
+val cstr_type_path : constructor_description -> Path.t
diff --git a/upstream/ocaml_503/typing/cmt2annot.ml b/upstream/ocaml_503/typing/cmt2annot.ml
new file mode 100644
index 0000000000..698cccab99
--- /dev/null
+++ b/upstream/ocaml_503/typing/cmt2annot.ml
@@ -0,0 +1,192 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+(* Generate an .annot file from a .cmt file. *)
+
+open Asttypes
+open Typedtree
+open Tast_iterator
+
+let variables_iterator scope =
+ let super = default_iterator in
+ let pat sub (type k) (p : k general_pattern) =
+ begin match p.pat_desc with
+ | Tpat_var (id, _, _) | Tpat_alias (_, id, _, _) ->
+ Stypes.record (Stypes.An_ident (p.pat_loc,
+ Ident.name id,
+ Annot.Idef scope))
+ | _ -> ()
+ end;
+ super.pat sub p
+ in
+ {super with pat}
+
+let bind_variables scope =
+ let iter = variables_iterator scope in
+ fun p -> iter.pat iter p
+
+let bind_bindings scope bindings =
+ let o = bind_variables scope in
+ List.iter (fun x -> o x.vb_pat) bindings
+
+let bind_cases l =
+ List.iter
+ (fun {c_lhs; c_guard; c_rhs} ->
+ let loc =
+ let open Location in
+ match c_guard with
+ | None -> c_rhs.exp_loc
+ | Some g -> {c_rhs.exp_loc with loc_start=g.exp_loc.loc_start}
+ in
+ bind_variables loc c_lhs
+ )
+ l
+
+let bind_function_param loc fp =
+ match fp.fp_kind with
+ | Tparam_pat pat -> bind_variables loc pat
+ | Tparam_optional_default (pat, _) -> bind_variables loc pat
+
+let record_module_binding scope mb =
+ Stypes.record (Stypes.An_ident
+ (mb.mb_name.loc,
+ Option.value mb.mb_name.txt ~default:"_",
+ Annot.Idef scope))
+
+let rec iterator ~scope rebuild_env =
+ let super = default_iterator in
+ let class_expr sub node =
+ Stypes.record (Stypes.Ti_class node);
+ super.class_expr sub node
+
+ and module_expr _sub node =
+ Stypes.record (Stypes.Ti_mod node);
+ super.module_expr (iterator ~scope:node.mod_loc rebuild_env) node
+
+ and expr sub exp =
+ begin match exp.exp_desc with
+ | Texp_ident (path, _, _) ->
+ let full_name = Path.name ~paren:Oprint.parenthesized_ident path in
+ let env =
+ if rebuild_env then
+ Env.env_of_only_summary Envaux.env_from_summary exp.exp_env
+ else
+ exp.exp_env
+ in
+ let annot =
+ try
+ let desc = Env.find_value path env in
+ let dloc = desc.Types.val_loc in
+ if dloc.Location.loc_ghost then Annot.Iref_external
+ else Annot.Iref_internal dloc
+ with Not_found ->
+ Annot.Iref_external
+ in
+ Stypes.record
+ (Stypes.An_ident (exp.exp_loc, full_name , annot))
+ | Texp_let (Recursive, bindings, _) ->
+ bind_bindings exp.exp_loc bindings
+ | Texp_let (Nonrecursive, bindings, body) ->
+ bind_bindings body.exp_loc bindings
+ | Texp_match (_, f1, f2, _) ->
+ bind_cases f1;
+ bind_cases f2
+ | Texp_try (_, f1, f2) ->
+ bind_cases f1;
+ bind_cases f2
+ | Texp_function (params, _) ->
+ List.iter (bind_function_param exp.exp_loc) params
+ | Texp_letmodule (_, modname, _, _, body ) ->
+ Stypes.record (Stypes.An_ident
+ (modname.loc,Option.value ~default:"_" modname.txt,
+ Annot.Idef body.exp_loc))
+ | _ -> ()
+ end;
+ Stypes.record (Stypes.Ti_expr exp);
+ super.expr sub exp
+
+ and pat sub (type k) (p : k general_pattern) =
+ Stypes.record (Stypes.Ti_pat (classify_pattern p, p));
+ super.pat sub p
+ in
+
+ let structure_item_rem sub str rem =
+ let open Location in
+ let loc = str.str_loc in
+ begin match str.str_desc with
+ | Tstr_value (rec_flag, bindings) ->
+ let doit loc_start = bind_bindings {scope with loc_start} bindings in
+ begin match rec_flag, rem with
+ | Recursive, _ -> doit loc.loc_start
+ | Nonrecursive, [] -> doit loc.loc_end
+ | Nonrecursive, {str_loc = loc2} :: _ -> doit loc2.loc_start
+ end
+ | Tstr_module mb ->
+ record_module_binding
+ { scope with Location.loc_start = loc.loc_end } mb
+ | Tstr_recmodule mbs ->
+ List.iter (record_module_binding
+ { scope with Location.loc_start = loc.loc_start }) mbs
+ | _ ->
+ ()
+ end;
+ Stypes.record_phrase loc;
+ super.structure_item sub str
+ in
+ let structure_item sub s =
+ (* This will be used for Partial_structure_item.
+ We don't have here the location of the "next" item,
+ this will give a slightly different scope for the non-recursive
+ binding case. *)
+ structure_item_rem sub s []
+ in
+ let structure sub l =
+ let rec loop = function
+ | str :: rem -> structure_item_rem sub str rem; loop rem
+ | [] -> ()
+ in
+ loop l.str_items
+ in
+ {super with class_expr; module_expr; expr; pat; structure_item; structure}
+
+let binary_part iter x =
+ let open Cmt_format in
+ match x with
+ | Partial_structure x -> iter.structure iter x
+ | Partial_structure_item x -> iter.structure_item iter x
+ | Partial_expression x -> iter.expr iter x
+ | Partial_pattern (_, x) -> iter.pat iter x
+ | Partial_class_expr x -> iter.class_expr iter x
+ | Partial_signature x -> iter.signature iter x
+ | Partial_signature_item x -> iter.signature_item iter x
+ | Partial_module_type x -> iter.module_type iter x
+
+let gen_annot target_filename ~sourcefile ~use_summaries annots =
+ let open Cmt_format in
+ let scope =
+ match sourcefile with
+ | None -> Location.none
+ | Some s -> Location.in_file s
+ in
+ let iter = iterator ~scope use_summaries in
+ match annots with
+ | Implementation typedtree ->
+ iter.structure iter typedtree;
+ Stypes.dump target_filename
+ | Partial_implementation parts ->
+ Array.iter (binary_part iter) parts;
+ Stypes.dump target_filename
+ | Interface _ | Packed _ | Partial_interface _ ->
+ ()
diff --git a/upstream/ocaml_503/typing/cmt2annot.mli b/upstream/ocaml_503/typing/cmt2annot.mli
new file mode 100644
index 0000000000..978e00d36b
--- /dev/null
+++ b/upstream/ocaml_503/typing/cmt2annot.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Sebastien Hinderer, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2022 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. *)
+(* *)
+(**************************************************************************)
+
+(* Generate an .annot file from a .cmt file. *)
+
+val gen_annot :
+ string option ->
+ sourcefile:string option ->
+ use_summaries:bool -> Cmt_format.binary_annots ->
+ unit
+
+val iterator : scope:Location.t -> bool -> Tast_iterator.iterator
+
+val binary_part : Tast_iterator.iterator -> Cmt_format.binary_part -> unit
diff --git a/upstream/ocaml_503/typing/ctype.ml b/upstream/ocaml_503/typing/ctype.ml
new file mode 100644
index 0000000000..692c4da3c8
--- /dev/null
+++ b/upstream/ocaml_503/typing/ctype.ml
@@ -0,0 +1,5671 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy and Jerome Vouillon, 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. *)
+(* *)
+(**************************************************************************)
+
+(* Operations on core types *)
+
+open Misc
+open Asttypes
+open Types
+open Btype
+open Errortrace
+
+open Local_store
+
+(*
+ General notes
+ =============
+ - As much sharing as possible should be kept : it makes types
+ smaller and better abbreviated.
+ When necessary, some sharing can be lost. Types will still be
+ printed correctly (+++ TO DO...), and abbreviations defined by a
+ class do not depend on sharing thanks to constrained
+ abbreviations. (Of course, even if some sharing is lost, typing
+ will still be correct.)
+ - All nodes of a type have a level : that way, one knows whether a
+ node need to be duplicated or not when instantiating a type.
+ - Levels of a type are decreasing (generic level being considered
+ as greatest).
+ - The level of a type constructor is superior to the binding
+ time of its path.
+ - Recursive types without limitation should be handled (even if
+ there is still an occur check). This avoid treating specially the
+ case for objects, for instance. Furthermore, the occur check
+ policy can then be easily changed.
+*)
+
+(**** Errors ****)
+
+(* There are two classes of errortrace-related exceptions: *traces* and
+ *errors*. The former, whose names end with [_trace], contain
+ [Errortrace.trace]s, representing traces that are currently being built; they
+ are local to this file. All the internal functions that implement
+ unification, type equality, and moregen raise trace exceptions. Once we are
+ done, in the top level functions such as [unify], [equal], and [moregen], we
+ catch the trace exceptions and transform them into the analogous error
+ exception. This indicates that we are done building the trace, and expect
+ the error to flow out of unification, type equality, or moregen into
+ surrounding code (with some few exceptions when these top-level functions are
+ used as building blocks elsewhere.) Only the error exceptions are exposed in
+ [ctype.mli]; the trace exceptions are an implementation detail. Any trace
+ exception that escapes from a function in this file is a bug. *)
+
+exception Unify_trace of unification trace
+exception Equality_trace of comparison trace
+exception Moregen_trace of comparison trace
+
+exception Unify of unification_error
+exception Equality of equality_error
+exception Moregen of moregen_error
+exception Subtype of Subtype.error
+
+exception Escape of type_expr escape
+
+(* For local use: throw the appropriate exception. Can be passed into local
+ functions as a parameter *)
+type _ trace_exn =
+| Unify : unification trace_exn
+| Moregen : comparison trace_exn
+| Equality : comparison trace_exn
+
+let raise_trace_for
+ (type variant)
+ (tr_exn : variant trace_exn)
+ (tr : variant trace) : 'a =
+ match tr_exn with
+ | Unify -> raise (Unify_trace tr)
+ | Equality -> raise (Equality_trace tr)
+ | Moregen -> raise (Moregen_trace tr)
+
+(* Uses of this function are a bit suspicious, as we usually want to maintain
+ trace information; sometimes it makes sense, however, since we're maintaining
+ the trace at an outer exception handler. *)
+let raise_unexplained_for tr_exn =
+ raise_trace_for tr_exn []
+
+let raise_for tr_exn e =
+ raise_trace_for tr_exn [e]
+
+(* Thrown from [moregen_kind] *)
+exception Public_method_to_private_method
+
+let escape kind = {kind; context = None}
+let escape_exn kind = Escape (escape kind)
+let scope_escape_exn ty = escape_exn (Equation ty)
+let raise_escape_exn kind = raise (escape_exn kind)
+let raise_scope_escape_exn ty = raise (scope_escape_exn ty)
+
+exception Tags of label * label
+
+let () =
+ let open Format_doc in
+ Location.register_error_of_exn
+ (function
+ | Tags (l, l') ->
+ let pp_tag ppf s = fprintf ppf "`%s" s in
+ let inline_tag = Misc.Style.as_inline_code pp_tag in
+ Some
+ Location.
+ (errorf ~loc:(in_file !input_name)
+ "In this program,@ variant constructors@ %a and %a@ \
+ have the same hash value.@ Change one of them."
+ inline_tag l inline_tag l'
+ )
+ | _ -> None
+ )
+
+exception Cannot_expand
+
+exception Cannot_apply
+
+exception Cannot_subst
+
+exception Cannot_unify_universal_variables
+
+exception Out_of_scope_universal_variable
+
+exception Matches_failure of Env.t * unification_error
+
+exception Incompatible
+
+(**** Control tracing of GADT instances *)
+
+let trace_gadt_instances = ref false
+let check_trace_gadt_instances ?(force=false) env =
+ not !trace_gadt_instances && (force || Env.has_local_constraints env) &&
+ (trace_gadt_instances := true; cleanup_abbrev (); true)
+
+let reset_trace_gadt_instances b =
+ if b then trace_gadt_instances := false
+
+let wrap_trace_gadt_instances ?force env f x =
+ let b = check_trace_gadt_instances ?force env in
+ Misc.try_finally (fun () -> f x)
+ ~always:(fun () -> reset_trace_gadt_instances b)
+
+(**** Abbreviations without parameters ****)
+(* Shall reset after generalizing *)
+
+let simple_abbrevs = ref Mnil
+
+let proper_abbrevs tl abbrev =
+ if tl <> [] || !trace_gadt_instances || !Clflags.principal
+ then abbrev
+ else simple_abbrevs
+
+(**** Type level management ****)
+
+let current_level = s_ref 0
+let nongen_level = s_ref 0
+let global_level = s_ref 0
+let saved_level = s_ref []
+
+let get_current_level () = !current_level
+let init_def level = current_level := level; nongen_level := level
+let begin_def () =
+ saved_level := (!current_level, !nongen_level) :: !saved_level;
+ incr current_level; nongen_level := !current_level
+let begin_class_def () =
+ saved_level := (!current_level, !nongen_level) :: !saved_level;
+ incr current_level
+let raise_nongen_level () =
+ saved_level := (!current_level, !nongen_level) :: !saved_level;
+ nongen_level := !current_level
+let end_def () =
+ let (cl, nl) = List.hd !saved_level in
+ saved_level := List.tl !saved_level;
+ current_level := cl; nongen_level := nl
+let create_scope () =
+ let level = !current_level + 1 in
+ init_def level;
+ level
+
+let wrap_end_def f = Misc.try_finally f ~always:end_def
+let wrap_end_def_new_pool f =
+ wrap_end_def (fun _ -> with_new_pool ~level:!current_level f)
+
+(* [with_local_level_gen] handles both the scoping structure of levels
+ and automatic generalization through pools (cf. btype.ml) *)
+let with_local_level_gen ~begin_def ~structure ?before_generalize f =
+ begin_def ();
+ let level = !current_level in
+ let result, pool = wrap_end_def_new_pool f in
+ Option.iter (fun g -> g result) before_generalize;
+ simple_abbrevs := Mnil;
+ (* Nodes in [pool] were either created by the above call to [f],
+ or they were created before, generalized, and then added to
+ the pool by [update_level].
+ In the latter case, their level was already kept for backtracking
+ by a call to [set_level] inside [update_level].
+ Since backtracking can only go back to a snapshot taken before [f] was
+ called, this means that either they did not exists in that snapshot,
+ or that they original level is already stored, so that there is no need
+ to register levels for backtracking when we change them with
+ [Transient_expr.set_level] here *)
+ List.iter begin fun ty ->
+ (* Already generic nodes are not tracked *)
+ if ty.level = generic_level then () else
+ match ty.desc with
+ | Tvar _ when structure ->
+ (* In structure mode, we do do not generalize type variables,
+ so we need to lower their level, and move them to an outer pool.
+ The goal of this mode is to allow unsharing inner nodes
+ without introducing polymorphism *)
+ if ty.level >= level then Transient_expr.set_level ty !current_level;
+ add_to_pool ~level:ty.level ty
+ | Tlink _ -> ()
+ (* If a node is no longer used as representative, no need
+ to track it anymore *)
+ | _ ->
+ if ty.level < level then
+ (* If a node was introduced locally, but its level was lowered
+ through unification, keeping that node as representative,
+ then we need to move it to an outer pool. *)
+ add_to_pool ~level:ty.level ty
+ else begin
+ (* Generalize all remaining nodes *)
+ Transient_expr.set_level ty generic_level;
+ if structure then match ty.desc with
+ Tconstr (_, _, abbrev) ->
+ (* In structure mode, we drop abbreviations, as the goal of
+ this mode is to reduce sharing *)
+ abbrev := Mnil
+ | _ -> ()
+ end
+ end pool;
+ result
+
+let with_local_level_generalize_structure f =
+ with_local_level_gen ~begin_def ~structure:true f
+let with_local_level_generalize ?before_generalize f =
+ with_local_level_gen ~begin_def ~structure:false ?before_generalize f
+let with_local_level_generalize_if cond ?before_generalize f =
+ if cond then with_local_level_generalize ?before_generalize f else f ()
+let with_local_level_generalize_structure_if cond f =
+ if cond then with_local_level_generalize_structure f else f ()
+let with_local_level_generalize_structure_if_principal f =
+ if !Clflags.principal then with_local_level_generalize_structure f else f ()
+let with_local_level_generalize_for_class f =
+ with_local_level_gen ~begin_def:begin_class_def ~structure:false f
+
+let with_local_level ?post f =
+ begin_def ();
+ let result = wrap_end_def f in
+ Option.iter (fun g -> g result) post;
+ result
+let with_local_level_if cond f ~post =
+ if cond then with_local_level f ~post else f ()
+let with_local_level_iter f ~post =
+ begin_def ();
+ let (result, l) = wrap_end_def f in
+ List.iter post l;
+ result
+let with_local_level_iter_if cond f ~post =
+ if cond then with_local_level_iter f ~post else fst (f ())
+let with_local_level_if_principal f ~post =
+ with_local_level_if !Clflags.principal f ~post
+let with_local_level_iter_if_principal f ~post =
+ with_local_level_iter_if !Clflags.principal f ~post
+let with_level ~level f =
+ begin_def (); init_def level;
+ wrap_end_def f
+let with_level_if cond ~level f =
+ if cond then with_level ~level f else f ()
+
+let with_local_level_for_class ?post f =
+ begin_class_def ();
+ let result = wrap_end_def f in
+ Option.iter (fun g -> g result) post;
+ result
+
+let with_raised_nongen_level f =
+ raise_nongen_level ();
+ wrap_end_def f
+
+
+let reset_global_level () =
+ global_level := !current_level
+let increase_global_level () =
+ let gl = !global_level in
+ global_level := !current_level;
+ gl
+let restore_global_level gl =
+ global_level := gl
+
+(**** Some type creators ****)
+
+(* Re-export generic type creators *)
+
+let newty desc = newty2 ~level:!current_level desc
+let new_scoped_ty scope desc = newty3 ~level:!current_level ~scope desc
+
+let newvar ?name () = newty2 ~level:!current_level (Tvar name)
+let newvar2 ?name level = newty2 ~level:level (Tvar name)
+let new_global_var ?name () = newty2 ~level:!global_level (Tvar name)
+let newstub ~scope = newty3 ~level:!current_level ~scope (Tvar None)
+
+let newobj fields = newty (Tobject (fields, ref None))
+
+let newconstr path tyl = newty (Tconstr (path, tyl, ref Mnil))
+
+let none = newty (Ttuple []) (* Clearly ill-formed type *)
+
+(**** information for [Typecore.unify_pat_*] ****)
+
+module Pattern_env : sig
+ type t = private
+ { mutable env : Env.t;
+ equations_scope : int;
+ allow_recursive_equations : bool; }
+ val make: Env.t -> equations_scope:int -> allow_recursive_equations:bool -> t
+ val copy: ?equations_scope:int -> t -> t
+ val set_env: t -> Env.t -> unit
+end = struct
+ type t =
+ { mutable env : Env.t;
+ equations_scope : int;
+ allow_recursive_equations : bool; }
+ let make env ~equations_scope ~allow_recursive_equations =
+ { env;
+ equations_scope;
+ allow_recursive_equations; }
+ let copy ?equations_scope penv =
+ let equations_scope =
+ match equations_scope with None -> penv.equations_scope | Some s -> s in
+ { penv with equations_scope }
+ let set_env penv env = penv.env <- env
+end
+
+(**** unification mode ****)
+
+type unification_environment =
+ | Expression of
+ { env : Env.t;
+ in_subst : bool; }
+ (* normal unification mode *)
+ | Pattern of
+ { penv : Pattern_env.t;
+ equated_types : TypePairs.t;
+ assume_injective : bool;
+ unify_eq_set : TypePairs.t; }
+ (* GADT constraint unification mode:
+ only used for type indices of GADT constructors
+ during pattern matching.
+ This allows adding local constraints. *)
+
+let get_env = function
+ | Expression {env} -> env
+ | Pattern {penv} -> penv.env
+
+let set_env uenv env =
+ match uenv with
+ | Expression _ -> invalid_arg "Ctype.set_env"
+ | Pattern {penv} -> Pattern_env.set_env penv env
+
+let in_pattern_mode = function
+ | Expression _ -> false
+ | Pattern _ -> true
+
+let get_equations_scope = function
+ | Expression _ -> invalid_arg "Ctype.get_equations_scope"
+ | Pattern r -> r.penv.equations_scope
+
+let order_type_pair t1 t2 =
+ if get_id t1 <= get_id t2 then (t1, t2) else (t2, t1)
+
+let add_type_equality uenv t1 t2 =
+ match uenv with
+ | Expression _ -> invalid_arg "Ctype.add_type_equality"
+ | Pattern r -> TypePairs.add r.unify_eq_set (order_type_pair t1 t2)
+
+let unify_eq uenv t1 t2 =
+ eq_type t1 t2 ||
+ match uenv with
+ | Expression _ -> false
+ | Pattern r -> TypePairs.mem r.unify_eq_set (order_type_pair t1 t2)
+
+(* unification during type constructor expansion:
+ This mode disables the propagation of the level and scope of
+ the row variable to the whole type during the unification.
+ (see unify_{row, fields} and PR #11771) *)
+let in_subst_mode = function
+ | Expression {in_subst} -> in_subst
+ | Pattern _ -> false
+
+(* Can only be called when generate_equations is true *)
+let record_equation uenv t1 t2 =
+ match uenv with
+ | Expression _ ->
+ invalid_arg "Ctype.record_equation"
+ | Pattern { equated_types } ->
+ TypePairs.add equated_types (t1, t2)
+
+let can_assume_injective = function
+ | Expression _ -> false
+ | Pattern { assume_injective } -> assume_injective
+
+let in_counterexample uenv =
+ match uenv with
+ | Expression _ -> false
+ | Pattern { penv } -> penv.allow_recursive_equations
+
+let allow_recursive_equations uenv =
+ !Clflags.recursive_types || in_counterexample uenv
+
+(* Though without_* functions can be in a direct style,
+ CPS clarifies the structure of the code better. *)
+let without_assume_injective uenv f =
+ match uenv with
+ | Expression _ as uenv -> f uenv
+ | Pattern r -> f (Pattern { r with assume_injective = false })
+
+(*** Checks for type definitions ***)
+
+let rec in_current_module = function
+ | Path.Pident _ -> true
+ | Path.Pdot _ | Path.Papply _ -> false
+ | Path.Pextra_ty (p, _) -> in_current_module p
+
+let in_pervasives p =
+ in_current_module p &&
+ try ignore (Env.find_type p Env.initial); true
+ with Not_found -> false
+
+let is_datatype decl=
+ match decl.type_kind with
+ Type_record _ | Type_variant _ | Type_open -> true
+ | Type_abstract _ -> false
+
+
+ (**********************************************)
+ (* Miscellaneous operations on object types *)
+ (**********************************************)
+
+(* Note:
+ We need to maintain some invariants:
+ * cty_self must be a Tobject
+ * ...
+*)
+
+(**** Object field manipulation. ****)
+
+let object_fields ty =
+ match get_desc ty with
+ Tobject (fields, _) -> fields
+ | _ -> assert false
+
+let flatten_fields ty =
+ let rec flatten l ty =
+ match get_desc ty with
+ Tfield(s, k, ty1, ty2) ->
+ flatten ((s, k, ty1)::l) ty2
+ | _ ->
+ (l, ty)
+ in
+ let (l, r) = flatten [] ty in
+ (List.sort (fun (n, _, _) (n', _, _) -> compare n n') l, r)
+
+let build_fields level =
+ List.fold_right
+ (fun (s, k, ty1) ty2 -> newty2 ~level (Tfield(s, k, ty1, ty2)))
+
+let associate_fields fields1 fields2 =
+ let rec associate p s s' =
+ function
+ (l, []) ->
+ (List.rev p, (List.rev s) @ l, List.rev s')
+ | ([], l') ->
+ (List.rev p, List.rev s, (List.rev s') @ l')
+ | ((n, k, t)::r, (n', k', t')::r') when n = n' ->
+ associate ((n, k, t, k', t')::p) s s' (r, r')
+ | ((n, k, t)::r, ((n', _k', _t')::_ as l')) when n < n' ->
+ associate p ((n, k, t)::s) s' (r, l')
+ | (((_n, _k, _t)::_ as l), (n', k', t')::r') (* when n > n' *) ->
+ associate p s ((n', k', t')::s') (l, r')
+ in
+ associate [] [] [] (fields1, fields2)
+
+(**** Check whether an object is open ****)
+
+(* +++ The abbreviation should eventually be expanded *)
+let rec object_row ty =
+ match get_desc ty with
+ Tobject (t, _) -> object_row t
+ | Tfield(_, _, _, t) -> object_row t
+ | _ -> ty
+
+let opened_object ty =
+ match get_desc (object_row ty) with
+ | Tvar _ | Tunivar _ | Tconstr _ -> true
+ | _ -> false
+
+let concrete_object ty =
+ match get_desc (object_row ty) with
+ | Tvar _ -> false
+ | _ -> true
+
+(**** Row variable of an object type ****)
+
+let rec fields_row_variable ty =
+ match get_desc ty with
+ | Tfield (_, _, _, ty) -> fields_row_variable ty
+ | Tvar _ -> ty
+ | _ -> assert false
+
+(**** Object name manipulation ****)
+(* +++ Bientot obsolete *)
+
+let set_object_name id params ty =
+ match get_desc ty with
+ | Tobject (fi, nm) ->
+ let rv = fields_row_variable fi in
+ set_name nm (Some (Path.Pident id, rv::params))
+ | Tconstr (_, _, _) -> ()
+ | _ -> fatal_error "Ctype.set_object_name"
+
+let remove_object_name ty =
+ match get_desc ty with
+ Tobject (_, nm) -> set_name nm None
+ | Tconstr (_, _, _) -> ()
+ | _ -> fatal_error "Ctype.remove_object_name"
+
+ (*******************************************)
+ (* Miscellaneous operations on row types *)
+ (*******************************************)
+
+let sort_row_fields = List.sort (fun (p,_) (q,_) -> compare p q)
+
+let rec merge_rf r1 r2 pairs fi1 fi2 =
+ match fi1, fi2 with
+ (l1,f1 as p1)::fi1', (l2,f2 as p2)::fi2' ->
+ if l1 = l2 then merge_rf r1 r2 ((l1,f1,f2)::pairs) fi1' fi2' else
+ if l1 < l2 then merge_rf (p1::r1) r2 pairs fi1' fi2 else
+ merge_rf r1 (p2::r2) pairs fi1 fi2'
+ | [], _ -> (List.rev r1, List.rev_append r2 fi2, pairs)
+ | _, [] -> (List.rev_append r1 fi1, List.rev r2, pairs)
+
+let merge_row_fields fi1 fi2 =
+ match fi1, fi2 with
+ [], _ | _, [] -> (fi1, fi2, [])
+ | [p1], _ when not (List.mem_assoc (fst p1) fi2) -> (fi1, fi2, [])
+ | _, [p2] when not (List.mem_assoc (fst p2) fi1) -> (fi1, fi2, [])
+ | _ -> merge_rf [] [] [] (sort_row_fields fi1) (sort_row_fields fi2)
+
+let rec filter_row_fields erase = function
+ [] -> []
+ | (_l,f as p)::fi ->
+ let fi = filter_row_fields erase fi in
+ match row_field_repr f with
+ Rabsent -> fi
+ | Reither(_,_,false) when erase ->
+ link_row_field_ext ~inside:f rf_absent; fi
+ | _ -> p :: fi
+
+ (**************************************)
+ (* Check genericity of type schemes *)
+ (**************************************)
+
+type variable_kind = Row_variable | Type_variable
+exception Non_closed of type_expr * variable_kind
+
+(* [free_vars] walks over the variables of the input type expression. It
+ is used for several different things in the type-checker, with the
+ following bells and whistles:
+ - If [env] is Some typing environment, types in the environment
+ are expanded to check whether the apparently-free variable would vanish
+ during expansion.
+ - We do not count "virtual" free variables -- free variables stored in
+ the abbreviation of an object type that has been expanded (we store
+ the abbreviations for use when displaying the type).
+
+ [free_vars] accumulates its answer in a monoid-like structure, with
+ an initial element [zero] and a combining function [add_one], passing
+ [add_one] information about whether the variable is a normal type variable
+ or a row variable.
+ *)
+let free_vars ~init ~add_one ?env mark ty =
+ let rec fv ~kind acc ty =
+ if not (try_mark_node mark ty) then acc
+ else match get_desc ty, env with
+ | Tvar _, _ ->
+ add_one ty kind acc
+ | Tconstr (path, tl, _), Some env ->
+ let acc =
+ match Env.find_type_expansion path env with
+ | exception Not_found -> acc
+ | (_, body, _) ->
+ if get_level body = generic_level then acc
+ else add_one ty kind acc
+ in
+ List.fold_left (fv ~kind:Type_variable) acc tl
+ | Tobject (ty, _), _ ->
+ (* ignoring the second parameter of [Tobject] amounts to not
+ counting "virtual free variables". *)
+ fv ~kind:Row_variable acc ty
+ | Tfield (_, _, ty1, ty2), _ ->
+ let acc = fv ~kind:Type_variable acc ty1 in
+ fv ~kind:Row_variable acc ty2
+ | Tvariant row, _ ->
+ let acc = fold_row (fv ~kind:Type_variable) acc row in
+ if static_row row then acc
+ else fv ~kind:Row_variable acc (row_more row)
+ | _ ->
+ fold_type_expr (fv ~kind) acc ty
+ in fv ~kind:Type_variable init ty
+
+let free_variables ?env ty =
+ let add_one ty _kind acc = ty :: acc in
+ with_type_mark (fun mark -> free_vars ~init:[] ~add_one ?env mark ty)
+
+let closed_type ?env mark ty =
+ let add_one ty kind _acc = raise (Non_closed (ty, kind)) in
+ free_vars ~init:() ~add_one ?env mark ty
+
+let closed_type_expr ?env ty =
+ with_type_mark (fun mark ->
+ try closed_type ?env mark ty; true
+ with Non_closed _ -> false)
+
+let closed_parameterized_type params ty =
+ with_type_mark begin fun mark ->
+ List.iter (mark_type mark) params;
+ try closed_type mark ty; true with Non_closed _ -> false
+ end
+
+let closed_type_decl decl =
+ with_type_mark begin fun mark -> try
+ List.iter (mark_type mark) decl.type_params;
+ begin match decl.type_kind with
+ Type_abstract _ ->
+ ()
+ | Type_variant (v, _rep) ->
+ List.iter
+ (fun {cd_args; cd_res; _} ->
+ match cd_res with
+ | Some _ -> ()
+ | None ->
+ match cd_args with
+ | Cstr_tuple l -> List.iter (closed_type mark) l
+ | Cstr_record l ->
+ List.iter (fun l -> closed_type mark l.ld_type) l
+ )
+ v
+ | Type_record(r, _rep) ->
+ List.iter (fun l -> closed_type mark l.ld_type) r
+ | Type_open -> ()
+ end;
+ begin match decl.type_manifest with
+ None -> ()
+ | Some ty -> closed_type mark ty
+ end;
+ None
+ with Non_closed (ty, _) ->
+ Some ty
+ end
+
+let closed_extension_constructor ext =
+ with_type_mark begin fun mark -> try
+ List.iter (mark_type mark) ext.ext_type_params;
+ begin match ext.ext_ret_type with
+ | Some _ -> ()
+ | None -> iter_type_expr_cstr_args (closed_type mark) ext.ext_args
+ end;
+ None
+ with Non_closed (ty, _) ->
+ Some ty
+ end
+
+type closed_class_failure = {
+ free_variable: type_expr * variable_kind;
+ meth: string;
+ meth_ty: type_expr;
+}
+exception CCFailure of closed_class_failure
+
+let closed_class params sign =
+ with_type_mark begin fun mark ->
+ List.iter (mark_type mark) params;
+ ignore (try_mark_node mark sign.csig_self_row);
+ try
+ Meths.iter
+ (fun lab (priv, _, ty) ->
+ if priv = Mpublic then begin
+ try closed_type mark ty with Non_closed (ty0, variable_kind) ->
+ raise (CCFailure {
+ free_variable = (ty0, variable_kind);
+ meth = lab;
+ meth_ty = ty;
+ })
+ end)
+ sign.csig_meths;
+ None
+ with CCFailure reason ->
+ Some reason
+ end
+
+ (**********************)
+ (* Type duplication *)
+ (**********************)
+
+
+(* Duplicate a type, preserving only type variables *)
+let duplicate_type ty =
+ Subst.type_expr Subst.identity ty
+
+(* Same, for class types *)
+let duplicate_class_type ty =
+ Subst.class_type Subst.identity ty
+
+
+ (*****************************)
+ (* Type level manipulation *)
+ (*****************************)
+
+
+(*
+ Build a copy of a type in which nodes reachable through a path composed
+ only of Tarrow, Tpoly, Ttuple, Tpackage and Tconstr, and whose level
+ was no lower than [!current_level], are at [generic_level].
+ This is different from [with_local_level_gen], which generalizes in place,
+ and only nodes with a level higher than [!current_level].
+ This is used for typing classes, to indicate which types have been
+ inferred in the first pass, and can be considered as "known" during the
+ second pass.
+ *)
+
+let rec copy_spine copy_scope ty =
+ match get_desc ty with
+ | Tsubst (ty, _) -> ty
+ | Tvar _
+ | Tfield _
+ | Tnil
+ | Tvariant _
+ | Tobject _
+ | Tlink _
+ | Tunivar _ -> ty
+ | (Tarrow _ | Tpoly _ | Ttuple _ | Tpackage _ | Tconstr _) as desc ->
+ let level = get_level ty in
+ if level < !current_level || level = generic_level then ty else
+ let t = newgenstub ~scope:(get_scope ty) in
+ For_copy.redirect_desc copy_scope ty (Tsubst (t, None));
+ let copy_rec = copy_spine copy_scope in
+ let desc' = match desc with
+ | Tarrow (lbl, ty1, ty2, _) ->
+ Tarrow (lbl, copy_rec ty1, copy_rec ty2, commu_ok)
+ | Tpoly (ty', tvl) ->
+ Tpoly (copy_rec ty', tvl)
+ | Ttuple tyl ->
+ Ttuple (List.map copy_rec tyl)
+ | Tpackage (path, fl) ->
+ let fl = List.map (fun (n, ty) -> n, copy_rec ty) fl in
+ Tpackage (path, fl)
+ | Tconstr (path, tyl, _) ->
+ Tconstr (path, List.map copy_rec tyl, ref Mnil)
+ | _ -> assert false
+ in
+ Transient_expr.set_stub_desc t desc';
+ t
+
+let copy_spine ty =
+ For_copy.with_scope (fun copy_scope -> copy_spine copy_scope ty)
+
+let forward_try_expand_safe = (* Forward declaration *)
+ ref (fun _env _ty -> assert false)
+
+(*
+ Lower the levels of a type (assume [level] is not
+ [generic_level]).
+*)
+
+let rec normalize_package_path env p =
+ let t =
+ try (Env.find_modtype p env).mtd_type
+ with Not_found -> None
+ in
+ match t with
+ | Some (Mty_ident p) -> normalize_package_path env p
+ | Some (Mty_signature _ | Mty_functor _ | Mty_alias _) | None ->
+ match p with
+ Path.Pdot (p1, s) ->
+ (* For module aliases *)
+ let p1' = Env.normalize_module_path None env p1 in
+ if Path.same p1 p1' then p else
+ normalize_package_path env (Path.Pdot (p1', s))
+ | _ -> p
+
+let rec check_scope_escape mark env level ty =
+ let orig_level = get_level ty in
+ if try_mark_node mark ty then begin
+ if level < get_scope ty then
+ raise_scope_escape_exn ty;
+ begin match get_desc ty with
+ | Tconstr (p, _, _) when level < Path.scope p ->
+ begin match !forward_try_expand_safe env ty with
+ | ty' ->
+ check_scope_escape mark env level ty'
+ | exception Cannot_expand ->
+ raise_escape_exn (Constructor p)
+ end
+ | Tpackage (p, fl) when level < Path.scope p ->
+ let p' = normalize_package_path env p in
+ if Path.same p p' then raise_escape_exn (Module_type p);
+ check_scope_escape mark env level
+ (newty2 ~level:orig_level (Tpackage (p', fl)))
+ | _ ->
+ iter_type_expr (check_scope_escape mark env level) ty
+ end;
+ end
+
+let check_scope_escape env level ty =
+ with_type_mark begin fun mark -> try
+ check_scope_escape mark env level ty
+ with Escape e ->
+ raise (Escape { e with context = Some ty })
+ end
+
+let rec update_scope scope ty =
+ if get_scope ty < scope then begin
+ if get_level ty < scope then raise_scope_escape_exn ty;
+ set_scope ty scope;
+ (* Only recurse in principal mode as this is not necessary for soundness *)
+ if !Clflags.principal then iter_type_expr (update_scope scope) ty
+ end
+
+let update_scope_for tr_exn scope ty =
+ try
+ update_scope scope ty
+ with Escape e -> raise_for tr_exn (Escape e)
+
+(* Note: the level of a type constructor must be greater than its binding
+ time. That way, a type constructor cannot escape the scope of its
+ definition, as would be the case in
+ let x = ref []
+ module M = struct type t let _ = (x : t list ref) end
+ (without this constraint, the type system would actually be unsound.)
+*)
+
+let rec update_level env level expand ty =
+ let ty_level = get_level ty in
+ if ty_level > level then begin
+ if level < get_scope ty then raise_scope_escape_exn ty;
+ let set_level () =
+ set_level ty level;
+ if ty_level = generic_level then
+ add_to_pool ~level (Transient_expr.repr ty)
+ in
+ match get_desc ty with
+ Tconstr(p, _tl, _abbrev) when level < Path.scope p ->
+ (* Try first to replace an abbreviation by its expansion. *)
+ begin try
+ let ty' = !forward_try_expand_safe env ty in
+ link_type ty ty';
+ update_level env level expand ty'
+ with Cannot_expand ->
+ raise_escape_exn (Constructor p)
+ end
+ | Tconstr(p, (_ :: _ as tl), _) ->
+ let variance =
+ try (Env.find_type p env).type_variance
+ with Not_found -> List.map (fun _ -> Variance.unknown) tl in
+ let needs_expand =
+ expand ||
+ List.exists2
+ (fun var ty -> var = Variance.null && get_level ty > level)
+ variance tl
+ in
+ begin try
+ if not needs_expand then raise Cannot_expand;
+ let ty' = !forward_try_expand_safe env ty in
+ link_type ty ty';
+ update_level env level expand ty'
+ with Cannot_expand ->
+ set_level ();
+ iter_type_expr (update_level env level expand) ty
+ end
+ | Tpackage (p, fl) when level < Path.scope p ->
+ let p' = normalize_package_path env p in
+ if Path.same p p' then raise_escape_exn (Module_type p);
+ set_type_desc ty (Tpackage (p', fl));
+ update_level env level expand ty
+ | Tobject (_, ({contents=Some(p, _tl)} as nm))
+ when level < Path.scope p ->
+ set_name nm None;
+ update_level env level expand ty
+ | Tvariant row ->
+ begin match row_name row with
+ | Some (p, _tl) when level < Path.scope p ->
+ set_type_desc ty (Tvariant (set_row_name row None))
+ | _ -> ()
+ end;
+ set_level ();
+ iter_type_expr (update_level env level expand) ty
+ | Tfield(lab, _, ty1, _)
+ when lab = dummy_method && level < get_scope ty1 ->
+ raise_escape_exn Self
+ | _ ->
+ set_level ();
+ (* XXX what about abbreviations in Tconstr ? *)
+ iter_type_expr (update_level env level expand) ty
+ end
+
+(* First try without expanding, then expand everything,
+ to avoid combinatorial blow-up *)
+let update_level env level ty =
+ if get_level ty > level then begin
+ let snap = snapshot () in
+ try
+ update_level env level false ty
+ with Escape _ ->
+ backtrack snap;
+ update_level env level true ty
+ end
+
+let update_level_for tr_exn env level ty =
+ try
+ update_level env level ty
+ with Escape e -> raise_for tr_exn (Escape e)
+
+(* Lower level of type variables inside contravariant branches *)
+
+let rec lower_contravariant env var_level visited contra ty =
+ let must_visit =
+ get_level ty > var_level &&
+ match Hashtbl.find visited (get_id ty) with
+ | done_contra -> contra && not done_contra
+ | exception Not_found -> true
+ in
+ if must_visit then begin
+ Hashtbl.add visited (get_id ty) contra;
+ let lower_rec = lower_contravariant env var_level visited in
+ match get_desc ty with
+ Tvar _ -> if contra then set_level ty var_level
+ | Tconstr (_, [], _) -> ()
+ | Tconstr (path, tyl, _abbrev) ->
+ let variance, maybe_expand =
+ try
+ let typ = Env.find_type path env in
+ typ.type_variance,
+ type_kind_is_abstract typ
+ with Not_found ->
+ (* See testsuite/tests/typing-missing-cmi-2 for an example *)
+ List.map (fun _ -> Variance.unknown) tyl,
+ false
+ in
+ if List.for_all ((=) Variance.null) variance then () else
+ let not_expanded () =
+ List.iter2
+ (fun v t ->
+ if v = Variance.null then () else
+ if Variance.(mem May_weak v)
+ then lower_rec true t
+ else lower_rec contra t)
+ variance tyl in
+ if maybe_expand then (* we expand cautiously to avoid missing cmis *)
+ match !forward_try_expand_safe env ty with
+ | ty -> lower_rec contra ty
+ | exception Cannot_expand -> not_expanded ()
+ else not_expanded ()
+ | Tpackage (_, fl) ->
+ List.iter (fun (_n, ty) -> lower_rec true ty) fl
+ | Tarrow (_, t1, t2, _) ->
+ lower_rec true t1;
+ lower_rec contra t2
+ | _ ->
+ iter_type_expr (lower_rec contra) ty
+ end
+
+let lower_variables_only env level ty =
+ simple_abbrevs := Mnil;
+ lower_contravariant env level (Hashtbl.create 7) true ty
+
+let lower_contravariant env ty =
+ simple_abbrevs := Mnil;
+ lower_contravariant env !nongen_level (Hashtbl.create 7) false ty
+
+let rec generalize_class_type gen =
+ function
+ Cty_constr (_, params, cty) ->
+ List.iter gen params;
+ generalize_class_type gen cty
+ | Cty_signature csig ->
+ gen csig.csig_self;
+ gen csig.csig_self_row;
+ Vars.iter (fun _ (_, _, ty) -> gen ty) csig.csig_vars;
+ Meths.iter (fun _ (_, _, ty) -> gen ty) csig.csig_meths
+ | Cty_arrow (_, ty, cty) ->
+ gen ty;
+ generalize_class_type gen cty
+
+(* Only generalize the type ty0 in ty *)
+let limited_generalize ty0 ~inside:ty =
+ let graph = TypeHash.create 17 in
+ let roots = ref [] in
+
+ let rec inverse pty ty =
+ match TypeHash.find_opt graph ty with
+ | Some parents -> parents := pty @ !parents
+ | None ->
+ let level = get_level ty in
+ if level > !current_level then begin
+ TypeHash.add graph ty (ref pty);
+ (* XXX: why generic_level needs to be a root *)
+ if (level = generic_level) || eq_type ty ty0 then
+ roots := ty :: !roots;
+ iter_type_expr (inverse [ty]) ty
+ end
+ in
+
+ let rec generalize_parents ~is_root ty =
+ if is_root || get_level ty <> generic_level then begin
+ set_level ty generic_level;
+ List.iter (generalize_parents ~is_root:false) !(TypeHash.find graph ty);
+ (* Special case for rows: must generalize the row variable *)
+ match get_desc ty with
+ Tvariant row ->
+ let more = row_more row in
+ let lv = get_level more in
+ if (TypeHash.mem graph more || lv > !current_level)
+ && lv <> generic_level then set_level more generic_level
+ | _ -> ()
+ end
+ in
+
+ inverse [] ty;
+ List.iter (generalize_parents ~is_root:true) !roots;
+ TypeHash.iter
+ (fun ty _ ->
+ if get_level ty <> generic_level then set_level ty !current_level)
+ graph
+
+let limited_generalize_class_type rv ~inside:cty =
+ generalize_class_type (fun inside -> limited_generalize rv ~inside) cty
+
+(* Compute statically the free univars of all nodes in a type *)
+(* This avoids doing it repeatedly during instantiation *)
+
+type inv_type_expr =
+ { inv_type : type_expr;
+ mutable inv_parents : inv_type_expr list }
+
+let rec inv_type hash pty ty =
+ try
+ let inv = TypeHash.find hash ty in
+ inv.inv_parents <- pty @ inv.inv_parents
+ with Not_found ->
+ let inv = { inv_type = ty; inv_parents = pty } in
+ TypeHash.add hash ty inv;
+ iter_type_expr (inv_type hash [inv]) ty
+
+let compute_univars ty =
+ let inverted = TypeHash.create 17 in
+ inv_type inverted [] ty;
+ let node_univars = TypeHash.create 17 in
+ let rec add_univar univ inv =
+ match get_desc inv.inv_type with
+ Tpoly (_ty, tl) when List.memq (get_id univ) (List.map get_id tl) -> ()
+ | _ ->
+ try
+ let univs = TypeHash.find node_univars inv.inv_type in
+ if not (TypeSet.mem univ !univs) then begin
+ univs := TypeSet.add univ !univs;
+ List.iter (add_univar univ) inv.inv_parents
+ end
+ with Not_found ->
+ TypeHash.add node_univars inv.inv_type (ref(TypeSet.singleton univ));
+ List.iter (add_univar univ) inv.inv_parents
+ in
+ TypeHash.iter (fun ty inv -> if is_Tunivar ty then add_univar ty inv)
+ inverted;
+ fun ty ->
+ try !(TypeHash.find node_univars ty) with Not_found -> TypeSet.empty
+
+
+let fully_generic ty =
+ with_type_mark begin fun mark ->
+ let rec aux ty =
+ if try_mark_node mark ty then
+ if get_level ty = generic_level then iter_type_expr aux ty
+ else raise Exit
+ in
+ try aux ty; true with Exit -> false
+ end
+
+
+ (*******************)
+ (* Instantiation *)
+ (*******************)
+
+
+let rec find_repr p1 =
+ function
+ Mnil ->
+ None
+ | Mcons (Public, p2, ty, _, _) when Path.same p1 p2 ->
+ Some ty
+ | Mcons (_, _, _, _, rem) ->
+ find_repr p1 rem
+ | Mlink {contents = rem} ->
+ find_repr p1 rem
+
+(*
+ Generic nodes are duplicated, while non-generic nodes are left
+ as-is.
+
+ During instantiation, the result of copying a generic node is
+ "cached" in-place by temporarily mutating the node description by
+ a stub [Tsubst (newvar ())] using [For_copy.redirect_desc]. The
+ scope of this mutation is determined by the [copy_scope] parameter,
+ and the [For_copy.with_scope] helper is in charge of creating a new
+ scope and performing the necessary book-keeping -- in particular
+ reverting the in-place updates after the instantiation is done. *)
+
+let abbreviations = ref (ref Mnil)
+ (* Abbreviation memorized. *)
+
+(* partial: we may not wish to copy the non generic types
+ before we call type_pat *)
+let rec copy ?partial ?keep_names copy_scope ty =
+ let copy = copy ?partial ?keep_names copy_scope in
+ match get_desc ty with
+ Tsubst (ty, _) -> ty
+ | desc ->
+ let level = get_level ty in
+ if level <> generic_level && partial = None then ty else
+ (* We only forget types that are non generic and do not contain
+ free univars *)
+ let forget =
+ if level = generic_level then generic_level else
+ match partial with
+ None -> assert false
+ | Some (free_univars, keep) ->
+ if TypeSet.is_empty (free_univars ty) then
+ if keep then level else !current_level
+ else generic_level
+ in
+ if forget <> generic_level then newty2 ~level:forget (Tvar None) else
+ let t = newstub ~scope:(get_scope ty) in
+ For_copy.redirect_desc copy_scope ty (Tsubst (t, None));
+ let desc' =
+ match desc with
+ | Tconstr (p, tl, _) ->
+ let abbrevs = proper_abbrevs tl !abbreviations in
+ begin match find_repr p !abbrevs with
+ Some ty when not (eq_type ty t) ->
+ Tlink ty
+ | _ ->
+ (*
+ One must allocate a new reference, so that abbrevia-
+ tions belonging to different branches of a type are
+ independent.
+ Moreover, a reference containing a [Mcons] must be
+ shared, so that the memorized expansion of an abbrevi-
+ ation can be released by changing the content of just
+ one reference.
+ *)
+ Tconstr (p, List.map copy tl,
+ ref (match !(!abbreviations) with
+ Mcons _ -> Mlink !abbreviations
+ | abbrev -> abbrev))
+ end
+ | Tvariant row ->
+ let more = row_more row in
+ let mored = get_desc more in
+ (* We must substitute in a subtle way *)
+ (* Tsubst takes a tuple containing the row var and the variant *)
+ begin match mored with
+ Tsubst (_, Some ty2) ->
+ (* This variant type has been already copied *)
+ (* Change the stub to avoid Tlink in the new type *)
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty2, None));
+ Tlink ty2
+ | _ ->
+ (* If the row variable is not generic, we must keep it *)
+ let keep = get_level more <> generic_level && partial = None in
+ let more' =
+ match mored with
+ Tsubst (ty, None) -> ty
+ (* TODO: is this case possible?
+ possibly an interaction with (copy more) below? *)
+ | Tconstr _ | Tnil ->
+ copy more
+ | Tvar _ | Tunivar _ ->
+ if keep then more else newty mored
+ | _ -> assert false
+ in
+ let row =
+ match get_desc more' with (* PR#6163 *)
+ Tconstr (x,_,_) when not (is_fixed row) ->
+ let Row {fields; more; closed; name} = row_repr row in
+ create_row ~fields ~more ~closed ~name
+ ~fixed:(Some (Reified x))
+ | _ -> row
+ in
+ (* Open row if partial for pattern and contains Reither *)
+ let more', row =
+ match partial with
+ Some (free_univars, false) ->
+ let not_reither (_, f) =
+ match row_field_repr f with
+ Reither _ -> false
+ | _ -> true
+ in
+ let fields = row_fields row in
+ if row_closed row && not (is_fixed row)
+ && TypeSet.is_empty (free_univars ty)
+ && not (List.for_all not_reither fields) then
+ let more' = newvar () in
+ (more',
+ create_row ~fields:(List.filter not_reither fields)
+ ~more:more' ~closed:false ~fixed:None ~name:None)
+ else (more', row)
+ | _ -> (more', row)
+ in
+ (* Register new type first for recursion *)
+ For_copy.redirect_desc copy_scope more
+ (Tsubst(more', Some t));
+ (* Return a new copy *)
+ Tvariant (copy_row copy true row keep more')
+ end
+ | Tobject (ty1, _) when partial <> None ->
+ Tobject (copy ty1, ref None)
+ | _ -> copy_type_desc ?keep_names copy desc
+ in
+ Transient_expr.set_stub_desc t desc';
+ t
+
+(**** Variants of instantiations ****)
+
+let instance ?partial sch =
+ let partial =
+ match partial with
+ None -> None
+ | Some keep -> Some (compute_univars sch, keep)
+ in
+ For_copy.with_scope (fun copy_scope ->
+ copy ?partial copy_scope sch)
+
+let generic_instance sch =
+ with_level ~level:generic_level (fun () -> instance sch)
+
+let instance_list schl =
+ For_copy.with_scope (fun copy_scope ->
+ List.map (fun t -> copy copy_scope t) schl)
+
+(* Create unique names to new type constructors.
+ Used for existential types and local constraints. *)
+let get_new_abstract_name env s =
+ let name index =
+ if index = 0 && s <> "" && s.[String.length s - 1] <> '$' then s else
+ Printf.sprintf "%s%d" s index
+ in
+ let check index =
+ match Env.find_type_by_name (Longident.Lident (name index)) env with
+ | _ -> false
+ | exception Not_found -> true
+ in
+ let index = Misc.find_first_mono check in
+ name index
+
+let new_local_type ?(loc = Location.none) ?manifest_and_scope origin =
+ let manifest, expansion_scope =
+ match manifest_and_scope with
+ None -> None, Btype.lowest_level
+ | Some (ty, scope) -> Some ty, scope
+ in
+ {
+ type_params = [];
+ type_arity = 0;
+ type_kind = Type_abstract origin;
+ type_private = Public;
+ type_manifest = manifest;
+ type_variance = [];
+ type_separability = [];
+ type_is_newtype = true;
+ type_expansion_scope = expansion_scope;
+ type_loc = loc;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+
+let existential_name name_counter ty =
+ let name =
+ match get_desc ty with
+ | Tvar (Some name) -> name
+ | _ ->
+ let name = Misc.letter_of_int !name_counter in
+ incr name_counter;
+ name
+ in
+ "$" ^ name
+
+type existential_treatment =
+ | Keep_existentials_flexible
+ | Make_existentials_abstract of Pattern_env.t
+
+let instance_constructor existential_treatment cstr =
+ For_copy.with_scope (fun copy_scope ->
+ let name_counter = ref 0 in
+ let copy_existential =
+ match existential_treatment with
+ | Keep_existentials_flexible -> copy copy_scope
+ | Make_existentials_abstract penv ->
+ fun existential ->
+ let env = penv.env in
+ let fresh_constr_scope = penv.equations_scope in
+ let decl = new_local_type (Existential cstr.cstr_name) in
+ let name = existential_name name_counter existential in
+ let (id, new_env) =
+ Env.enter_type (get_new_abstract_name env name) decl env
+ ~scope:fresh_constr_scope in
+ Pattern_env.set_env penv new_env;
+ let to_unify = newty (Tconstr (Path.Pident id,[],ref Mnil)) in
+ let tv = copy copy_scope existential in
+ assert (is_Tvar tv);
+ link_type tv to_unify;
+ tv
+ in
+ let ty_ex = List.map copy_existential cstr.cstr_existentials in
+ let ty_res = copy copy_scope cstr.cstr_res in
+ let ty_args = List.map (copy copy_scope) cstr.cstr_args in
+ (ty_args, ty_res, ty_ex)
+ )
+
+let instance_parameterized_type ?keep_names sch_args sch =
+ For_copy.with_scope (fun copy_scope ->
+ let ty_args = List.map (fun t -> copy ?keep_names copy_scope t) sch_args in
+ let ty = copy copy_scope sch in
+ (ty_args, ty)
+ )
+
+let map_kind f = function
+ | Type_abstract r -> Type_abstract r
+ | Type_open -> Type_open
+ | Type_variant (cl, rep) ->
+ Type_variant (
+ List.map
+ (fun c ->
+ {c with
+ cd_args = map_type_expr_cstr_args f c.cd_args;
+ cd_res = Option.map f c.cd_res
+ })
+ cl, rep)
+ | Type_record (fl, rr) ->
+ Type_record (
+ List.map
+ (fun l ->
+ {l with ld_type = f l.ld_type}
+ ) fl, rr)
+
+
+let instance_declaration decl =
+ For_copy.with_scope (fun copy_scope ->
+ {decl with type_params = List.map (copy copy_scope) decl.type_params;
+ type_manifest = Option.map (copy copy_scope) decl.type_manifest;
+ type_kind = map_kind (copy copy_scope) decl.type_kind;
+ }
+ )
+
+let generic_instance_declaration decl =
+ with_level ~level:generic_level (fun () -> instance_declaration decl)
+
+let instance_class params cty =
+ let rec copy_class_type copy_scope = function
+ | Cty_constr (path, tyl, cty) ->
+ let tyl' = List.map (copy copy_scope) tyl in
+ let cty' = copy_class_type copy_scope cty in
+ Cty_constr (path, tyl', cty')
+ | Cty_signature sign ->
+ Cty_signature
+ {csig_self = copy copy_scope sign.csig_self;
+ csig_self_row = copy copy_scope sign.csig_self_row;
+ csig_vars =
+ Vars.map
+ (function (m, v, ty) -> (m, v, copy copy_scope ty))
+ sign.csig_vars;
+ csig_meths =
+ Meths.map
+ (function (p, v, ty) -> (p, v, copy copy_scope ty))
+ sign.csig_meths}
+ | Cty_arrow (l, ty, cty) ->
+ Cty_arrow (l, copy copy_scope ty, copy_class_type copy_scope cty)
+ in
+ For_copy.with_scope (fun copy_scope ->
+ let params' = List.map (copy copy_scope) params in
+ let cty' = copy_class_type copy_scope cty in
+ (params', cty')
+ )
+
+(**** Instantiation for types with free universal variables ****)
+
+(* [copy_sep] is used to instantiate first-class polymorphic types.
+ * It first makes a separate copy of the type as a graph, omitting nodes
+ that have no free univars.
+ * In this first pass, [visited] is used as a mapping for previously visited
+ nodes, and must already contain all the free univars in [ty].
+ * The remaining (univar-closed) parts of the type are then instantiated
+ with [copy] using a common [copy_scope].
+ The reason to work in two passes lies in recursive types such as:
+ [let h (x : < m : 'a. < n : 'a; p : 'b > > as 'b) = x#m]
+ The type of [x#m] should be:
+ [ < n : 'c; p : < m : 'a. < n : 'a; p : 'b > > as 'b > ]
+ I.e., the universal type variable ['a] is both instantiated as a fresh
+ type variable ['c] when outside of its binder, and kept as universal
+ when under its binder.
+ Assumption: in the first call to [copy_sep], all the free univars should
+ be bound by the same [Tpoly] node. This guarantees that they are only
+ bound when under this [Tpoly] node, which has no free univars, and as
+ such is not part of the separate copy. In turn, this allows the separate
+ copy to keep the sharing of the original type without breaking its
+ binding structure.
+ *)
+let copy_sep ~copy_scope ~fixed ~(visited : type_expr TypeHash.t) sch =
+ let free = compute_univars sch in
+ let delayed_copies = ref [] in
+ let add_delayed_copy t ty =
+ delayed_copies :=
+ (fun () -> Transient_expr.set_stub_desc t (Tlink (copy copy_scope ty))) ::
+ !delayed_copies
+ in
+ let rec copy_rec ~may_share (ty : type_expr) =
+ let univars = free ty in
+ if is_Tvar ty || may_share && TypeSet.is_empty univars then
+ if get_level ty <> generic_level then ty else
+ let t = newstub ~scope:(get_scope ty) in
+ add_delayed_copy t ty;
+ t
+ else try
+ TypeHash.find visited ty
+ with Not_found -> begin
+ let t = newstub ~scope:(get_scope ty) in
+ TypeHash.add visited ty t;
+ let desc' =
+ match get_desc ty with
+ | Tvariant row ->
+ let more = row_more row in
+ (* We shall really check the level on the row variable *)
+ let keep = is_Tvar more && get_level more <> generic_level in
+ (* In that case we should keep the original, but we still
+ call copy to correct the levels *)
+ if keep then (add_delayed_copy t ty; Tvar None) else
+ let more' = copy_rec ~may_share:false more in
+ let fixed' = fixed && (is_Tvar more || is_Tunivar more) in
+ let row =
+ copy_row (copy_rec ~may_share:true) fixed' row keep more' in
+ Tvariant row
+ | Tfield (p, k, ty1, ty2) ->
+ (* the kind is kept shared, see Btype.copy_type_desc *)
+ Tfield (p, field_kind_internal_repr k,
+ copy_rec ~may_share:true ty1,
+ copy_rec ~may_share:false ty2)
+ | desc -> copy_type_desc (copy_rec ~may_share:true) desc
+ in
+ Transient_expr.set_stub_desc t desc';
+ t
+ end
+ in
+ let ty = copy_rec ~may_share:true sch in
+ List.iter (fun force -> force ()) !delayed_copies;
+ ty
+
+let instance_poly' copy_scope ~keep_names ~fixed univars sch =
+ (* In order to compute univars below, [sch] should not contain [Tsubst] *)
+ let copy_var ty =
+ match get_desc ty with
+ Tunivar name -> if keep_names then newty (Tvar name) else newvar ()
+ | _ -> assert false
+ in
+ let vars = List.map copy_var univars in
+ let visited = TypeHash.create 17 in
+ List.iter2 (TypeHash.add visited) univars vars;
+ let ty = copy_sep ~copy_scope ~fixed ~visited sch in
+ vars, ty
+
+let instance_poly ?(keep_names=false) ~fixed univars sch =
+ For_copy.with_scope (fun copy_scope ->
+ instance_poly' copy_scope ~keep_names ~fixed univars sch
+ )
+
+let instance_label ~fixed lbl =
+ For_copy.with_scope (fun copy_scope ->
+ let vars, ty_arg =
+ match get_desc lbl.lbl_arg with
+ Tpoly (ty, tl) ->
+ instance_poly' copy_scope ~keep_names:false ~fixed tl ty
+ | _ ->
+ [], copy copy_scope lbl.lbl_arg
+ in
+ (* call [copy] after [instance_poly] to avoid introducing [Tsubst] *)
+ let ty_res = copy copy_scope lbl.lbl_res in
+ (vars, ty_arg, ty_res)
+ )
+
+(**** Instantiation with parameter substitution ****)
+
+(* NB: since this is [unify_var], it raises [Unify], not [Unify_trace] *)
+let unify_var' = (* Forward declaration *)
+ ref (fun _env _ty1 _ty2 -> assert false)
+
+let subst env level priv abbrev oty params args body =
+ if List.length params <> List.length args then raise Cannot_subst;
+ with_level ~level begin fun () ->
+ let body0 = newvar () in (* Stub *)
+ let undo_abbrev =
+ match oty with
+ | None -> fun () -> () (* No abbreviation added *)
+ | Some ty ->
+ match get_desc ty with
+ Tconstr (path, tl, _) ->
+ let abbrev = proper_abbrevs tl abbrev in
+ memorize_abbrev abbrev priv path ty body0;
+ fun () -> forget_abbrev abbrev path
+ | _ -> assert false
+ in
+ abbreviations := abbrev;
+ let (params', body') = instance_parameterized_type params body in
+ abbreviations := ref Mnil;
+ let uenv = Expression {env; in_subst = true} in
+ try
+ !unify_var' uenv body0 body';
+ List.iter2 (!unify_var' uenv) params' args;
+ body'
+ with Unify _ ->
+ undo_abbrev ();
+ raise Cannot_subst
+ end
+
+(*
+ Default to generic level. Usually, only the shape of the type matters, not
+ whether it is generic or not. [generic_level] might be somewhat slower, but
+ it ensures invariants on types are enforced (decreasing levels), and we don't
+ care about efficiency here.
+*)
+let apply ?(use_current_level = false) env params body args =
+ simple_abbrevs := Mnil;
+ let level = if use_current_level then !current_level else generic_level in
+ try
+ subst env level Public (ref Mnil) None params args body
+ with
+ Cannot_subst -> raise Cannot_apply
+
+ (****************************)
+ (* Abbreviation expansion *)
+ (****************************)
+
+(*
+ If the environment has changed, memorized expansions might not
+ be correct anymore, and so we flush the cache. The test used
+ checks whether any of types, modules, or local constraints have
+ been changed.
+*)
+let previous_env = ref Env.empty
+(*let string_of_kind = function Public -> "public" | Private -> "private"*)
+let check_abbrev_env env =
+ if not (Env.same_type_declarations env !previous_env) then begin
+ (* prerr_endline "cleanup expansion cache"; *)
+ cleanup_abbrev ();
+ simple_abbrevs := Mnil;
+ previous_env := env
+ end
+
+
+(* Expand an abbreviation. The expansion is memorized. *)
+(*
+ Assume the level is greater than the path binding time of the
+ expanded abbreviation.
+*)
+(*
+ An abbreviation expansion will fail in either of these cases:
+ 1. The type constructor does not correspond to a manifest type.
+ 2. The type constructor is defined in an external file, and this
+ file is not in the path (missing -I options).
+ 3. The type constructor is not in the "local" environment. This can
+ happens when a non-generic type variable has been instantiated
+ afterwards to the not yet defined type constructor. (Actually,
+ this cannot happen at the moment due to the strong constraints
+ between type levels and constructor binding time.)
+ 4. The expansion requires the expansion of another abbreviation,
+ and this other expansion fails.
+*)
+let expand_abbrev_gen kind find_type_expansion env ty =
+ let path, args, abbrev = match get_desc ty with
+ | Tconstr (path,args,abbrev) -> path, args, abbrev
+ | _ -> assert false
+ in
+ check_abbrev_env env;
+ let level = get_level ty in
+ let scope = get_scope ty in
+ let lookup_abbrev = proper_abbrevs args abbrev in
+ let expansion =
+ (* first look for an existing expansion *)
+ match find_expans kind path !lookup_abbrev with
+ | None -> None
+ | Some ty' -> try
+ (* prerr_endline
+ ("found a "^string_of_kind kind^" expansion for "^Path.name path);*)
+ if level <> generic_level then update_level env level ty';
+ update_scope scope ty';
+ Some ty'
+ with Escape _ ->
+ (* in case of Escape, discard the stale expansion and re-expand *)
+ forget_abbrev lookup_abbrev path;
+ None
+ in
+ begin match expansion with
+ | Some ty' -> ty'
+ | None ->
+ (* attempt to (re-)expand *)
+ match find_type_expansion path env with
+ | exception Not_found ->
+ (* another way to expand is to normalize the path itself *)
+ let path' = Env.normalize_type_path None env path in
+ if Path.same path path' then raise Cannot_expand
+ else newty2 ~level (Tconstr (path', args, abbrev))
+ | (params, body, lv) ->
+ (* prerr_endline
+ ("add a "^string_of_kind kind^" expansion for "^Path.name path);*)
+ let ty' =
+ try
+ subst env level kind abbrev (Some ty) params args body
+ with Cannot_subst -> raise_escape_exn Constraint
+ in
+ (* For gadts, remember type as non exportable *)
+ (* The ambiguous level registered for ty' should be the highest *)
+ (* if !trace_gadt_instances then begin *)
+ let scope = Int.max lv (get_scope ty) in
+ update_scope scope ty;
+ update_scope scope ty';
+ ty'
+ end
+
+(* Expand respecting privacy *)
+let expand_abbrev env ty =
+ expand_abbrev_gen Public Env.find_type_expansion env ty
+
+(* Expand once the head of a type *)
+let expand_head_once env ty =
+ try
+ expand_abbrev env ty
+ with Cannot_expand | Escape _ -> assert false
+
+(* Check whether a type can be expanded *)
+let safe_abbrev env ty =
+ let snap = Btype.snapshot () in
+ try ignore (expand_abbrev env ty); true with
+ Cannot_expand ->
+ Btype.backtrack snap;
+ false
+ | Escape _ ->
+ Btype.backtrack snap;
+ cleanup_abbrev ();
+ false
+
+(* Expand the head of a type once.
+ Raise Cannot_expand if the type cannot be expanded.
+ May raise Escape, if a recursion was hidden in the type. *)
+let try_expand_once env ty =
+ match get_desc ty with
+ Tconstr _ -> expand_abbrev env ty
+ | _ -> raise Cannot_expand
+
+(* This one only raises Cannot_expand *)
+let try_expand_safe env ty =
+ let snap = Btype.snapshot () in
+ try try_expand_once env ty
+ with Escape _ ->
+ Btype.backtrack snap; cleanup_abbrev (); raise Cannot_expand
+
+(* Fully expand the head of a type. *)
+let rec try_expand_head
+ (try_once : Env.t -> type_expr -> type_expr) env ty =
+ let ty' = try_once env ty in
+ try try_expand_head try_once env ty'
+ with Cannot_expand -> ty'
+
+(* Unsafe full expansion, may raise [Unify [Escape _]]. *)
+let expand_head_unif env ty =
+ try
+ try_expand_head try_expand_once env ty
+ with
+ | Cannot_expand -> ty
+ | Escape e -> raise_for Unify (Escape e)
+
+(* Safe version of expand_head, never fails *)
+let expand_head env ty =
+ try try_expand_head try_expand_safe env ty
+ with Cannot_expand -> ty
+
+let _ = forward_try_expand_safe := try_expand_safe
+
+
+(* Expand until we find a non-abstract type declaration,
+ use try_expand_safe to avoid raising "Unify _" when
+ called on recursive types
+ *)
+
+type typedecl_extraction_result =
+ | Typedecl of Path.t * Path.t * type_declaration
+ | Has_no_typedecl
+ | May_have_typedecl
+
+let rec extract_concrete_typedecl env ty =
+ match get_desc ty with
+ Tconstr (p, _, _) ->
+ begin match Env.find_type p env with
+ | exception Not_found -> May_have_typedecl
+ | decl ->
+ if not (type_kind_is_abstract decl) then Typedecl(p, p, decl)
+ else begin
+ match try_expand_safe env ty with
+ | exception Cannot_expand -> May_have_typedecl
+ | ty ->
+ match extract_concrete_typedecl env ty with
+ | Typedecl(_, p', decl) -> Typedecl(p, p', decl)
+ | Has_no_typedecl -> Has_no_typedecl
+ | May_have_typedecl -> May_have_typedecl
+ end
+ end
+ | Tpoly(ty, _) -> extract_concrete_typedecl env ty
+ | Tarrow _ | Ttuple _ | Tobject _ | Tfield _ | Tnil
+ | Tvariant _ | Tpackage _ -> Has_no_typedecl
+ | Tvar _ | Tunivar _ -> May_have_typedecl
+ | Tlink _ | Tsubst _ -> assert false
+
+(* Implementing function [expand_head_opt], the compiler's own version of
+ [expand_head] used for type-based optimisations.
+ [expand_head_opt] uses [Env.find_type_expansion_opt] to access the
+ manifest type information of private abstract data types which is
+ normally hidden to the type-checker out of the implementation module of
+ the private abbreviation. *)
+
+let expand_abbrev_opt env ty =
+ expand_abbrev_gen Private Env.find_type_expansion_opt env ty
+
+let safe_abbrev_opt env ty =
+ let snap = Btype.snapshot () in
+ try ignore (expand_abbrev_opt env ty); true
+ with Cannot_expand | Escape _ ->
+ Btype.backtrack snap;
+ false
+
+let try_expand_once_opt env ty =
+ match get_desc ty with
+ Tconstr _ -> expand_abbrev_opt env ty
+ | _ -> raise Cannot_expand
+
+let try_expand_safe_opt env ty =
+ let snap = Btype.snapshot () in
+ try try_expand_once_opt env ty
+ with Escape _ ->
+ Btype.backtrack snap; raise Cannot_expand
+
+let expand_head_opt env ty =
+ try try_expand_head try_expand_safe_opt env ty with Cannot_expand -> ty
+
+(* Recursively expand the head of a type.
+ Also expand #-types.
+
+ Error printing relies on [full_expand] returning exactly its input (i.e., a
+ physically equal type) when nothing changes. *)
+let full_expand ~may_forget_scope env ty =
+ let ty =
+ if may_forget_scope then
+ try expand_head_unif env ty with Unify_trace _ ->
+ (* #10277: forget scopes when printing trace *)
+ with_level ~level:(get_level ty) begin fun () ->
+ (* The same as [expand_head], except in the failing case we return the
+ *original* type, not [duplicate_type ty].*)
+ try try_expand_head try_expand_safe env (duplicate_type ty) with
+ | Cannot_expand -> ty
+ end
+ else expand_head env ty
+ in
+ match get_desc ty with
+ Tobject (fi, {contents = Some (_, v::_)}) when is_Tvar v ->
+ newty2 ~level:(get_level ty) (Tobject (fi, ref None))
+ | _ ->
+ ty
+
+(*
+ Check whether the abbreviation expands to a well-defined type.
+ During the typing of a class, abbreviations for correspondings
+ types expand to non-generic types.
+*)
+let generic_abbrev env path =
+ try
+ let (_, body, _) = Env.find_type_expansion path env in
+ get_level body = generic_level
+ with
+ Not_found ->
+ false
+
+let generic_private_abbrev env path =
+ try
+ match Env.find_type path env with
+ {type_kind = Type_abstract _;
+ type_private = Private;
+ type_manifest = Some body} ->
+ get_level body = generic_level
+ | _ -> false
+ with Not_found -> false
+
+let is_contractive env p =
+ try
+ let decl = Env.find_type p env in
+ in_pervasives p && decl.type_manifest = None || is_datatype decl
+ with Not_found -> false
+
+
+ (*****************)
+ (* Occur check *)
+ (*****************)
+
+
+exception Occur
+
+let rec occur_rec env allow_recursive visited ty0 ty =
+ if eq_type ty ty0 then raise Occur;
+ match get_desc ty with
+ Tconstr(p, _tl, _abbrev) ->
+ if allow_recursive && is_contractive env p then () else
+ begin try
+ if TypeSet.mem ty visited then raise Occur;
+ let visited = TypeSet.add ty visited in
+ iter_type_expr (occur_rec env allow_recursive visited ty0) ty
+ with Occur -> try
+ let ty' = try_expand_head try_expand_safe env ty in
+ (* This call used to be inlined, but there seems no reason for it.
+ Message was referring to change in rev. 1.58 of the CVS repo. *)
+ occur_rec env allow_recursive visited ty0 ty'
+ with Cannot_expand ->
+ raise Occur
+ end
+ | Tobject _ | Tvariant _ ->
+ ()
+ | _ ->
+ if allow_recursive || TypeSet.mem ty visited then () else begin
+ let visited = TypeSet.add ty visited in
+ iter_type_expr (occur_rec env allow_recursive visited ty0) ty
+ end
+
+let type_changed = ref false (* trace possible changes to the studied type *)
+
+let merge r b = if b then r := true
+
+let occur uenv ty0 ty =
+ let env = get_env uenv in
+ let allow_recursive = allow_recursive_equations uenv in
+ let old = !type_changed in
+ try
+ while
+ type_changed := false;
+ if not (eq_type ty0 ty) then
+ occur_rec env allow_recursive TypeSet.empty ty0 ty;
+ !type_changed
+ do () (* prerr_endline "changed" *) done;
+ merge type_changed old
+ with exn ->
+ merge type_changed old;
+ raise exn
+
+let occur_for tr_exn uenv t1 t2 =
+ try
+ occur uenv t1 t2
+ with Occur -> raise_for tr_exn (Rec_occur(t1, t2))
+
+let occur_in env ty0 t =
+ try occur (Expression {env; in_subst = false}) ty0 t; false with Occur -> true
+
+(* Check that a local constraint is well-founded *)
+(* PR#6405: not needed since we allow recursion and work on normalized types *)
+(* PR#6992: we actually need it for contractiveness *)
+(* This is a simplified version of occur, only for the rectypes case *)
+
+let rec local_non_recursive_abbrev ~allow_rec strict visited env p ty =
+ (*Format.eprintf "@[Check %s =@ %a@]@." (Path.name p) !Btype.print_raw ty;*)
+ if not (List.memq (get_id ty) visited) then begin
+ match get_desc ty with
+ Tconstr(p', args, _abbrev) ->
+ if Path.same p p' then raise Occur;
+ if allow_rec && not strict && is_contractive env p' then () else
+ let visited = get_id ty :: visited in
+ begin try
+ (* try expanding, since [p] could be hidden *)
+ local_non_recursive_abbrev ~allow_rec strict visited env p
+ (try_expand_head try_expand_safe_opt env ty)
+ with Cannot_expand ->
+ let params =
+ try (Env.find_type p' env).type_params
+ with Not_found -> args
+ in
+ List.iter2
+ (fun tv ty ->
+ let strict = strict || not (is_Tvar tv) in
+ local_non_recursive_abbrev ~allow_rec strict visited env p ty)
+ params args
+ end
+ | Tobject _ | Tvariant _ when not strict ->
+ ()
+ | _ ->
+ if strict || not allow_rec then (* PR#7374 *)
+ let visited = get_id ty :: visited in
+ iter_type_expr
+ (local_non_recursive_abbrev ~allow_rec true visited env p) ty
+ end
+
+let local_non_recursive_abbrev uenv p ty =
+ let env = get_env uenv in
+ let allow_rec = allow_recursive_equations uenv in
+ try (* PR#7397: need to check trace_gadt_instances *)
+ wrap_trace_gadt_instances env
+ (local_non_recursive_abbrev ~allow_rec false [] env p) ty;
+ true
+ with Occur -> false
+
+
+ (*****************************)
+ (* Polymorphic Unification *)
+ (*****************************)
+
+(* Polymorphic unification is hard in the presence of recursive types. A
+ correctness argument for the approach below can be made by reference to
+ "Numbering matters: first-order canonical forms for second-order recursive
+ types" (ICFP'04) by Gauthier & Pottier. That work describes putting numbers
+ on nodes; we do not do that here, but instead make a decision about whether
+ to abort or continue based on the comparison of the numbers if we calculated
+ them. A different approach would actually store the relevant numbers in the
+ [Tpoly] nodes. (The algorithm here actually pre-dates that paper, which was
+ developed independently. But reading and understanding the paper will help
+ guide intuition for reading this algorithm nonetheless.) *)
+
+(* Since we cannot duplicate universal variables, unification must
+ be done at meta-level, using bindings in univar_pairs *)
+let rec unify_univar t1 t2 = function
+ (cl1, cl2) :: rem ->
+ let find_univ t cl =
+ List.find_map (fun (t', r) ->
+ if eq_type t t' then Some r else None
+ ) cl
+ in
+ begin match find_univ t1 cl1, find_univ t2 cl2 with
+ Some {contents=Some t'2}, Some _ when eq_type t2 t'2 ->
+ ()
+ | Some({contents=None} as r1), Some({contents=None} as r2) ->
+ set_univar r1 t2; set_univar r2 t1
+ | None, None ->
+ unify_univar t1 t2 rem
+ | _ ->
+ raise Cannot_unify_universal_variables
+ end
+ | [] ->
+ raise Out_of_scope_universal_variable
+
+(* The same as [unify_univar], but raises the appropriate exception instead of
+ [Cannot_unify_universal_variables] *)
+let unify_univar_for (type a) (tr_exn : a trace_exn) t1 t2 univar_pairs =
+ try unify_univar t1 t2 univar_pairs with
+ | Cannot_unify_universal_variables -> raise_unexplained_for tr_exn
+ | Out_of_scope_universal_variable ->
+ (* Allow unscoped univars when checking for equality, since one
+ might want to compare arbitrary subparts of types, ignoring scopes;
+ see Typedecl_variance (#13514) for instance *)
+ match tr_exn with
+ | Equality -> raise_unexplained_for tr_exn
+ | _ -> fatal_error "Ctype.unify_univar_for: univar not in scope"
+
+(* Test the occurrence of free univars in a type *)
+(* That's way too expensive. Must do some kind of caching *)
+(* If [inj_only=true], only check injective positions *)
+let occur_univar ?(inj_only=false) env ty =
+ let visited = ref TypeMap.empty in
+ with_type_mark begin fun mark ->
+ let rec occur_rec bound ty =
+ if not_marked_node mark ty then
+ if TypeSet.is_empty bound then
+ (ignore (try_mark_node mark ty); occur_desc bound ty)
+ else try
+ let bound' = TypeMap.find ty !visited in
+ if not (TypeSet.subset bound' bound) then begin
+ visited := TypeMap.add ty (TypeSet.inter bound bound') !visited;
+ occur_desc bound ty
+ end
+ with Not_found ->
+ visited := TypeMap.add ty bound !visited;
+ occur_desc bound ty
+ and occur_desc bound ty =
+ match get_desc ty with
+ Tunivar _ ->
+ if not (TypeSet.mem ty bound) then
+ raise_escape_exn (Univ ty)
+ | Tpoly (ty, tyl) ->
+ let bound = List.fold_right TypeSet.add tyl bound in
+ occur_rec bound ty
+ | Tconstr (_, [], _) -> ()
+ | Tconstr (p, tl, _) ->
+ begin try
+ let td = Env.find_type p env in
+ List.iter2
+ (fun t v ->
+ (* The null variance only occurs in type abbreviations and
+ corresponds to type variables that do not occur in the
+ definition (expansion would erase them completely).
+ The type-checker consistently ignores type expressions
+ in this position. Physical expansion, as done in `occur`,
+ would be costly here, since we need to check inside
+ object and variant types too. *)
+ if Variance.(if inj_only then mem Inj v else not (eq v null))
+ then occur_rec bound t)
+ tl td.type_variance
+ with Not_found ->
+ if not inj_only then List.iter (occur_rec bound) tl
+ end
+ | _ -> iter_type_expr (occur_rec bound) ty
+ in
+ occur_rec TypeSet.empty ty
+ end
+
+let has_free_univars env ty =
+ try occur_univar ~inj_only:false env ty; false with Escape _ -> true
+let has_injective_univars env ty =
+ try occur_univar ~inj_only:true env ty; false with Escape _ -> true
+
+let occur_univar_for tr_exn env ty =
+ try
+ occur_univar env ty
+ with Escape e -> raise_for tr_exn (Escape e)
+
+(* Grouping univars by families according to their binders *)
+let add_univars =
+ List.fold_left (fun s (t,_) -> TypeSet.add t s)
+
+let get_univar_family univar_pairs univars =
+ if univars = [] then TypeSet.empty else
+ let insert s = function
+ cl1, (_::_ as cl2) ->
+ if List.exists (fun (t1,_) -> TypeSet.mem t1 s) cl1 then
+ add_univars s cl2
+ else s
+ | _ -> s
+ in
+ let s = List.fold_right TypeSet.add univars TypeSet.empty in
+ List.fold_left insert s univar_pairs
+
+(* Whether a family of univars escapes from a type *)
+let univars_escape env univar_pairs vl ty =
+ let family = get_univar_family univar_pairs vl in
+ with_type_mark begin fun mark ->
+ let rec occur t =
+ if try_mark_node mark t then begin
+ match get_desc t with
+ Tpoly (t, tl) ->
+ if List.exists (fun t -> TypeSet.mem t family) tl then ()
+ else occur t
+ | Tunivar _ -> if TypeSet.mem t family then raise_escape_exn (Univ t)
+ | Tconstr (_, [], _) -> ()
+ | Tconstr (p, tl, _) ->
+ begin try
+ let td = Env.find_type p env in
+ List.iter2
+ (* see occur_univar *)
+ (fun t v -> if not Variance.(eq v null) then occur t)
+ tl td.type_variance
+ with Not_found ->
+ List.iter occur tl
+ end
+ | _ ->
+ iter_type_expr occur t
+ end
+ in
+ occur ty
+ end
+
+let univar_pairs = ref []
+
+let with_univar_pairs pairs f =
+ let old = !univar_pairs in
+ univar_pairs := pairs;
+ Misc.try_finally f
+ ~always:(fun () -> univar_pairs := old)
+
+(* Wrapper checking that no variable escapes and updating univar_pairs *)
+let enter_poly env t1 tl1 t2 tl2 f =
+ let old_univars = !univar_pairs in
+ let known_univars =
+ List.fold_left (fun s (cl,_) -> add_univars s cl)
+ TypeSet.empty old_univars
+ in
+ if List.exists (fun t -> TypeSet.mem t known_univars) tl1 then
+ univars_escape env old_univars tl1 (newty(Tpoly(t2,tl2)));
+ if List.exists (fun t -> TypeSet.mem t known_univars) tl2 then
+ univars_escape env old_univars tl2 (newty(Tpoly(t1,tl1)));
+ let cl1 = List.map (fun t -> t, ref None) tl1
+ and cl2 = List.map (fun t -> t, ref None) tl2 in
+ with_univar_pairs
+ ((cl1,cl2) :: (cl2,cl1) :: old_univars)
+ (fun () -> f t1 t2)
+
+let enter_poly_for tr_exn env t1 tl1 t2 tl2 f =
+ try
+ enter_poly env t1 tl1 t2 tl2 f
+ with Escape e -> raise_for tr_exn (Escape e)
+
+(**** Instantiate a generic type into a poly type ***)
+
+let polyfy env ty vars =
+ let subst_univar copy_scope ty =
+ match get_desc ty with
+ | Tvar name when get_level ty = generic_level ->
+ let t = newty (Tunivar name) in
+ For_copy.redirect_desc copy_scope ty (Tsubst (t, None));
+ Some t
+ | _ -> None
+ in
+ (* need to expand twice? cf. Ctype.unify2 *)
+ let vars = List.map (expand_head env) vars in
+ let vars = List.map (expand_head env) vars in
+ For_copy.with_scope (fun copy_scope ->
+ let vars' = List.filter_map (subst_univar copy_scope) vars in
+ let ty = copy copy_scope ty in
+ let ty = newty2 ~level:(get_level ty) (Tpoly(ty, vars')) in
+ let complete = List.length vars = List.length vars' in
+ ty, complete
+ )
+
+(* assumption: [ty] is fully generalized. *)
+let reify_univars env ty =
+ let vars = free_variables ty in
+ let ty, _ = polyfy env ty vars in
+ ty
+
+ (*****************)
+ (* Unification *)
+ (*****************)
+
+
+
+let rec has_cached_expansion p abbrev =
+ match abbrev with
+ Mnil -> false
+ | Mcons(_, p', _, _, rem) -> Path.same p p' || has_cached_expansion p rem
+ | Mlink rem -> has_cached_expansion p !rem
+
+(**** Transform error trace ****)
+(* +++ Move it to some other place ? *)
+(* That's hard to do because it relies on the expansion machinery in Ctype,
+ but still might be nice. *)
+
+let expand_type env ty =
+ { ty = ty;
+ expanded = full_expand ~may_forget_scope:true env ty }
+
+let expand_any_trace map env trace =
+ map (expand_type env) trace
+
+let expand_trace env trace =
+ expand_any_trace Errortrace.map env trace
+
+let expand_subtype_trace env trace =
+ expand_any_trace Subtype.map env trace
+
+let expand_to_unification_error env trace =
+ unification_error ~trace:(expand_trace env trace)
+
+let expand_to_equality_error env trace subst =
+ equality_error ~trace:(expand_trace env trace) ~subst
+
+let expand_to_moregen_error env trace =
+ moregen_error ~trace:(expand_trace env trace)
+
+(* [expand_trace] and the [expand_to_*_error] functions take care of most of the
+ expansion in this file, but we occasionally need to build [Errortrace.error]s
+ in other ways/elsewhere, so we expose some machinery for doing so
+*)
+
+(* Equivalent to [expand_trace env [Diff {got; expected}]] for a single
+ element *)
+let expanded_diff env ~got ~expected =
+ Diff (map_diff (expand_type env) {got; expected})
+
+(* Diff while transforming a [type_expr] into an [expanded_type] without
+ expanding *)
+let unexpanded_diff ~got ~expected =
+ Diff (map_diff trivial_expansion {got; expected})
+
+(**** Unification ****)
+
+(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
+let deep_occur t0 ty =
+ with_type_mark begin fun mark ->
+ let rec occur_rec ty =
+ if get_level ty >= get_level t0 && try_mark_node mark ty then begin
+ if eq_type ty t0 then raise Occur;
+ iter_type_expr occur_rec ty
+ end
+ in
+ try
+ occur_rec ty; false
+ with Occur ->
+ true
+ end
+
+
+(* A local constraint can be added only if the rhs
+ of the constraint does not contain any Tvars.
+ They need to be removed using this function.
+ This function is called only in [Pattern] mode. *)
+let reify uenv t =
+ let fresh_constr_scope = get_equations_scope uenv in
+ let create_fresh_constr lev name =
+ let name = match name with Some s -> "$'"^s | _ -> "$" in
+ let decl = new_local_type Definition in
+ let env = get_env uenv in
+ let new_name =
+ (* unique names are needed only for error messages *)
+ if in_counterexample uenv then name else get_new_abstract_name env name
+ in
+ let (id, new_env) =
+ Env.enter_type new_name decl env ~scope:fresh_constr_scope in
+ let path = Path.Pident id in
+ let t = newty2 ~level:lev (Tconstr (path,[],ref Mnil)) in
+ set_env uenv new_env;
+ path, t
+ in
+ let visited = ref TypeSet.empty in
+ let rec iterator ty =
+ if TypeSet.mem ty !visited then () else begin
+ visited := TypeSet.add ty !visited;
+ match get_desc ty with
+ Tvar o ->
+ let level = get_level ty in
+ let path, t = create_fresh_constr level o in
+ link_type ty t;
+ if level < fresh_constr_scope then
+ raise_for Unify (Escape (escape (Constructor path)))
+ | Tvariant r ->
+ if not (static_row r) then begin
+ if is_fixed r then iterator (row_more r) else
+ let m = row_more r in
+ match get_desc m with
+ Tvar o ->
+ let level = get_level m in
+ let path, t = create_fresh_constr level o in
+ let row =
+ let fixed = Some (Reified path) in
+ create_row ~fields:[] ~more:t ~fixed
+ ~name:(row_name r) ~closed:(row_closed r) in
+ link_type m (newty2 ~level (Tvariant row));
+ if level < fresh_constr_scope then
+ raise_for Unify (Escape (escape (Constructor path)))
+ | _ -> assert false
+ end;
+ iter_row iterator r
+ | _ ->
+ iter_type_expr iterator ty
+ end
+ in
+ iterator t
+
+let find_expansion_scope env path =
+ match Env.find_type path env with
+ | { type_manifest = None ; _ } | exception Not_found -> generic_level
+ | decl -> decl.type_expansion_scope
+
+let non_aliasable p decl =
+ (* in_pervasives p || (subsumed by in_current_module) *)
+ in_current_module p && not decl.type_is_newtype
+
+let is_instantiable env p =
+ try
+ let decl = Env.find_type p env in
+ type_kind_is_abstract decl &&
+ decl.type_private = Public &&
+ decl.type_arity = 0 &&
+ decl.type_manifest = None &&
+ not (non_aliasable p decl)
+ with Not_found -> false
+
+
+let compatible_paths p1 p2 =
+ let open Predef in
+ Path.same p1 p2 ||
+ Path.same p1 path_bytes && Path.same p2 path_string ||
+ Path.same p1 path_string && Path.same p2 path_bytes
+
+(* Two labels are considered compatible under certain conditions.
+ - they are the same
+ - in classic mode, only optional labels are relavant
+ - in pattern mode, we act as if we were in classic mode. If not, interactions
+ with GADTs from files compiled in classic mode would be unsound.
+*)
+let compatible_labels ~in_pattern_mode l1 l2 =
+ l1 = l2
+ || (!Clflags.classic || in_pattern_mode)
+ && not (is_optional l1 || is_optional l2)
+
+let eq_labels error_mode ~in_pattern_mode l1 l2 =
+ if not (compatible_labels ~in_pattern_mode l1 l2) then
+ raise_for error_mode (Function_label_mismatch {got=l1; expected=l2})
+
+(* Check for datatypes carefully; see PR#6348 *)
+let rec expands_to_datatype env ty =
+ match get_desc ty with
+ Tconstr (p, _, _) ->
+ begin try
+ is_datatype (Env.find_type p env) ||
+ expands_to_datatype env (try_expand_safe env ty)
+ with Not_found | Cannot_expand -> false
+ end
+ | _ -> false
+
+(* [mcomp] tests if two types are "compatible" -- i.e., if there could
+ exist a witness of their equality. This is distinct from [eqtype],
+ which checks if two types *are* exactly the same.
+ [mcomp] is used to decide whether GADT cases are unreachable.
+ The existence of a witness is necessarily an incomplete property,
+ i.e. there exists types for which we cannot tell if an equality
+ witness could exist or not. Typically, this is the case for
+ abstract types, which could be equal to anything, depending on
+ their actual definition. As a result [mcomp] overapproximates
+ compatibilty, i.e. when it says that two types are incompatible, we
+ are sure that there exists no equality witness, but if it does not
+ say so, there is no guarantee that such a witness could exist.
+ *)
+
+(* [mcomp type_pairs subst env t1 t2] should not raise an
+ exception if it is possible that t1 and t2 are actually
+ equal, assuming the types in type_pairs are equal and
+ that the mapping subst holds.
+ Assumes that both t1 and t2 do not contain any tvars
+ and that both their objects and variants are closed
+ *)
+
+let rec mcomp type_pairs env t1 t2 =
+ if eq_type t1 t2 then () else
+ match (get_desc t1, get_desc t2) with
+ | (Tvar _, _)
+ | (_, Tvar _) ->
+ ()
+ | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+ ()
+ | _ ->
+ let t1' = expand_head_opt env t1 in
+ let t2' = expand_head_opt env t2 in
+ (* Expansion may have changed the representative of the types... *)
+ if eq_type t1' t2' then () else
+ if not (TypePairs.mem type_pairs (t1', t2')) then begin
+ TypePairs.add type_pairs (t1', t2');
+ match (get_desc t1', get_desc t2') with
+ | (Tvar _, _)
+ | (_, Tvar _) ->
+ ()
+ | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _))
+ when compatible_labels ~in_pattern_mode:true l1 l2 ->
+ mcomp type_pairs env t1 t2;
+ mcomp type_pairs env u1 u2;
+ | (Ttuple tl1, Ttuple tl2) ->
+ mcomp_list type_pairs env tl1 tl2
+ | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) ->
+ mcomp_type_decl type_pairs env p1 p2 tl1 tl2
+ | (Tconstr (_, [], _), _) when has_injective_univars env t2' ->
+ raise_unexplained_for Unify
+ | (_, Tconstr (_, [], _)) when has_injective_univars env t1' ->
+ raise_unexplained_for Unify
+ | (Tconstr (p, _, _), _) | (_, Tconstr (p, _, _)) ->
+ begin try
+ let decl = Env.find_type p env in
+ if non_aliasable p decl || is_datatype decl then
+ raise Incompatible
+ with Not_found -> ()
+ end
+ (*
+ | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) when n1 = n2 ->
+ mcomp_list type_pairs env tl1 tl2
+ *)
+ | (Tpackage _, Tpackage _) -> ()
+ | (Tvariant row1, Tvariant row2) ->
+ mcomp_row type_pairs env row1 row2
+ | (Tobject (fi1, _), Tobject (fi2, _)) ->
+ mcomp_fields type_pairs env fi1 fi2
+ | (Tfield _, Tfield _) -> (* Actually unused *)
+ mcomp_fields type_pairs env t1' t2'
+ | (Tnil, Tnil) ->
+ ()
+ | (Tpoly (t1, []), Tpoly (t2, [])) ->
+ mcomp type_pairs env t1 t2
+ | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+ (try
+ enter_poly env
+ t1 tl1 t2 tl2 (mcomp type_pairs env)
+ with Escape _ -> raise Incompatible)
+ | (Tunivar _, Tunivar _) ->
+ begin try unify_univar t1' t2' !univar_pairs with
+ | Cannot_unify_universal_variables -> raise Incompatible
+ | Out_of_scope_universal_variable -> ()
+ end
+ | (_, _) ->
+ raise Incompatible
+ end
+
+and mcomp_list type_pairs env tl1 tl2 =
+ if List.length tl1 <> List.length tl2 then
+ raise Incompatible;
+ List.iter2 (mcomp type_pairs env) tl1 tl2
+
+and mcomp_fields type_pairs env ty1 ty2 =
+ if not (concrete_object ty1 && concrete_object ty2) then assert false;
+ let (fields2, rest2) = flatten_fields ty2 in
+ let (fields1, rest1) = flatten_fields ty1 in
+ let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+ let has_present =
+ List.exists (fun (_, k, _) -> field_kind_repr k = Fpublic) in
+ mcomp type_pairs env rest1 rest2;
+ if has_present miss1 && get_desc (object_row ty2) = Tnil
+ || has_present miss2 && get_desc (object_row ty1) = Tnil
+ then raise Incompatible;
+ List.iter
+ (function (_n, k1, t1, k2, t2) ->
+ mcomp_kind k1 k2;
+ mcomp type_pairs env t1 t2)
+ pairs
+
+and mcomp_kind k1 k2 =
+ let k1 = field_kind_repr k1 in
+ let k2 = field_kind_repr k2 in
+ match k1, k2 with
+ (Fpublic, Fabsent)
+ | (Fabsent, Fpublic) -> raise Incompatible
+ | _ -> ()
+
+and mcomp_row type_pairs env row1 row2 =
+ let r1, r2, pairs = merge_row_fields (row_fields row1) (row_fields row2) in
+ let cannot_erase (_,f) =
+ match row_field_repr f with
+ Rpresent _ -> true
+ | Rabsent | Reither _ -> false
+ in
+ if row_closed row1 && List.exists cannot_erase r2
+ || row_closed row2 && List.exists cannot_erase r1 then raise Incompatible;
+ List.iter
+ (fun (_,f1,f2) ->
+ match row_field_repr f1, row_field_repr f2 with
+ | Rpresent None, (Rpresent (Some _) | Reither (_, _::_, _) | Rabsent)
+ | Rpresent (Some _), (Rpresent None | Reither (true, _, _) | Rabsent)
+ | (Reither (_, _::_, _) | Rabsent), Rpresent None
+ | (Reither (true, _, _) | Rabsent), Rpresent (Some _) ->
+ raise Incompatible
+ | Rpresent(Some t1), Rpresent(Some t2) ->
+ mcomp type_pairs env t1 t2
+ | Rpresent(Some t1), Reither(false, tl2, _) ->
+ List.iter (mcomp type_pairs env t1) tl2
+ | Reither(false, tl1, _), Rpresent(Some t2) ->
+ List.iter (mcomp type_pairs env t2) tl1
+ | _ -> ())
+ pairs
+
+and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
+ try
+ let decl = Env.find_type p1 env in
+ let decl' = Env.find_type p2 env in
+ if compatible_paths p1 p2 then begin
+ let inj =
+ try List.map Variance.(mem Inj) (Env.find_type p1 env).type_variance
+ with Not_found -> List.map (fun _ -> false) tl1
+ in
+ List.iter2
+ (fun i (t1,t2) -> if i then mcomp type_pairs env t1 t2)
+ inj (List.combine tl1 tl2)
+ end else if non_aliasable p1 decl && non_aliasable p2 decl' then
+ raise Incompatible
+ else
+ match decl.type_kind, decl'.type_kind with
+ | Type_record (lst,r), Type_record (lst',r') when r = r' ->
+ mcomp_list type_pairs env tl1 tl2;
+ mcomp_record_description type_pairs env lst lst'
+ | Type_variant (v1,r), Type_variant (v2,r') when r = r' ->
+ mcomp_list type_pairs env tl1 tl2;
+ mcomp_variant_description type_pairs env v1 v2
+ | Type_open, Type_open ->
+ mcomp_list type_pairs env tl1 tl2
+ | Type_abstract _, Type_abstract _ -> ()
+ | Type_abstract _, _ when not (non_aliasable p1 decl)-> ()
+ | _, Type_abstract _ when not (non_aliasable p2 decl') -> ()
+ | _ -> raise Incompatible
+ with Not_found -> ()
+
+and mcomp_type_option type_pairs env t t' =
+ match t, t' with
+ None, None -> ()
+ | Some t, Some t' -> mcomp type_pairs env t t'
+ | _ -> raise Incompatible
+
+and mcomp_variant_description type_pairs env xs ys =
+ let rec iter = fun x y ->
+ match x, y with
+ | c1 :: xs, c2 :: ys ->
+ mcomp_type_option type_pairs env c1.cd_res c2.cd_res;
+ begin match c1.cd_args, c2.cd_args with
+ | Cstr_tuple l1, Cstr_tuple l2 -> mcomp_list type_pairs env l1 l2
+ | Cstr_record l1, Cstr_record l2 ->
+ mcomp_record_description type_pairs env l1 l2
+ | _ -> raise Incompatible
+ end;
+ if Ident.name c1.cd_id = Ident.name c2.cd_id
+ then iter xs ys
+ else raise Incompatible
+ | [],[] -> ()
+ | _ -> raise Incompatible
+ in
+ iter xs ys
+
+and mcomp_record_description type_pairs env =
+ let rec iter x y =
+ match x, y with
+ | l1 :: xs, l2 :: ys ->
+ mcomp type_pairs env l1.ld_type l2.ld_type;
+ if Ident.name l1.ld_id = Ident.name l2.ld_id &&
+ l1.ld_mutable = l2.ld_mutable
+ then iter xs ys
+ else raise Incompatible
+ | [], [] -> ()
+ | _ -> raise Incompatible
+ in
+ iter
+
+let mcomp env t1 t2 =
+ mcomp (TypePairs.create 4) env t1 t2
+
+let mcomp_for tr_exn env t1 t2 =
+ try
+ mcomp env t1 t2
+ with Incompatible -> raise_unexplained_for tr_exn
+
+(* Real unification *)
+
+let find_lowest_level ty =
+ let lowest = ref generic_level in
+ with_type_mark begin fun mark ->
+ let rec find ty =
+ if try_mark_node mark ty then begin
+ let level = get_level ty in
+ if level < !lowest then lowest := level;
+ iter_type_expr find ty
+ end
+ in find ty
+ end;
+ !lowest
+
+(* This function can be called only in [Pattern] mode. *)
+let add_gadt_equation uenv source destination =
+ (* Format.eprintf "@[add_gadt_equation %s %a@]@."
+ (Path.name source) !Btype.print_raw destination; *)
+ let env = get_env uenv in
+ if has_free_univars env destination then
+ occur_univar ~inj_only:true env destination
+ else if local_non_recursive_abbrev uenv source destination then begin
+ let destination = duplicate_type destination in
+ let expansion_scope =
+ Int.max (Path.scope source) (get_equations_scope uenv)
+ in
+ let type_origin =
+ match Env.find_type source env with
+ | decl -> type_origin decl
+ | exception Not_found -> assert false
+ in
+ let decl =
+ new_local_type
+ ~manifest_and_scope:(destination, expansion_scope)
+ type_origin
+ in
+ set_env uenv (Env.add_local_constraint source decl env);
+ cleanup_abbrev ()
+ end
+
+let eq_package_path env p1 p2 =
+ Path.same p1 p2 ||
+ Path.same (normalize_package_path env p1) (normalize_package_path env p2)
+
+let nondep_type' = ref (fun _ _ _ -> assert false)
+let package_subtype = ref (fun _ _ _ _ _ -> assert false)
+
+exception Nondep_cannot_erase of Ident.t
+
+let rec concat_longident lid1 =
+ let open Longident in
+ function
+ Lident s -> Ldot (lid1, s)
+ | Ldot (lid2, s) -> Ldot (concat_longident lid1 lid2, s)
+ | Lapply (lid2, lid) -> Lapply (concat_longident lid1 lid2, lid)
+
+let nondep_instance env level id ty =
+ let ty = !nondep_type' env [id] ty in
+ if level = generic_level then duplicate_type ty else
+ with_level ~level (fun () -> instance ty)
+
+(* Find the type paths nl1 in the module type mty2, and add them to the
+ list (nl2, tl2). raise Not_found if impossible *)
+let complete_type_list ?(allow_absent=false) env fl1 lv2 mty2 fl2 =
+ (* This is morally WRONG: we're adding a (dummy) module without a scope in the
+ environment. However no operation which cares about levels/scopes is going
+ to happen while this module exists.
+ The only operations that happen are:
+ - Env.find_type_by_name
+ - nondep_instance
+ None of which check the scope.
+
+ It'd be nice if we avoided creating such temporary dummy modules and broken
+ environments though. *)
+ let id2 = Ident.create_local "Pkg" in
+ let env' = Env.add_module id2 Mp_present mty2 env in
+ let rec complete fl1 fl2 =
+ match fl1, fl2 with
+ [], _ -> fl2
+ | (n, _) :: nl, (n2, _ as nt2) :: ntl' when n >= n2 ->
+ nt2 :: complete (if n = n2 then nl else fl1) ntl'
+ | (n, _) :: nl, _ ->
+ let lid = concat_longident (Longident.Lident "Pkg") n in
+ match Env.find_type_by_name lid env' with
+ | (_, {type_arity = 0; type_kind = Type_abstract _;
+ type_private = Public; type_manifest = Some t2}) ->
+ begin match nondep_instance env' lv2 id2 t2 with
+ | t -> (n, t) :: complete nl fl2
+ | exception Nondep_cannot_erase _ ->
+ if allow_absent then
+ complete nl fl2
+ else
+ raise Exit
+ end
+ | (_, {type_arity = 0; type_kind = Type_abstract _;
+ type_private = Public; type_manifest = None})
+ when allow_absent ->
+ complete nl fl2
+ | _ -> raise Exit
+ | exception Not_found when allow_absent->
+ complete nl fl2
+ in
+ match complete fl1 fl2 with
+ | res -> res
+ | exception Exit -> raise Not_found
+
+(* raise Not_found rather than Unify if the module types are incompatible *)
+let unify_package env unify_list lv1 p1 fl1 lv2 p2 fl2 =
+ let ntl2 = complete_type_list env fl1 lv2 (Mty_ident p2) fl2
+ and ntl1 = complete_type_list env fl2 lv1 (Mty_ident p1) fl1 in
+ unify_list (List.map snd ntl1) (List.map snd ntl2);
+ if eq_package_path env p1 p2 then Ok ()
+ else Result.bind
+ (!package_subtype env p1 fl1 p2 fl2)
+ (fun () -> !package_subtype env p2 fl2 p1 fl1)
+
+(* force unification in Reither when one side has a non-conjunctive type *)
+(* Code smell: this could also be put in unification_environment.
+ Only modified by expand_head_rigid, but the corresponding unification
+ environment is built in subst. *)
+let rigid_variants = ref false
+
+let unify1_var uenv t1 t2 =
+ assert (is_Tvar t1);
+ occur_for Unify uenv t1 t2;
+ let env = get_env uenv in
+ match occur_univar_for Unify env t2 with
+ | () ->
+ begin
+ try
+ update_level env (get_level t1) t2;
+ update_scope (get_scope t1) t2;
+ with Escape e ->
+ raise_for Unify (Escape e)
+ end;
+ link_type t1 t2;
+ true
+ | exception Unify_trace _ when in_pattern_mode uenv ->
+ false
+
+(* Called from unify3 *)
+let unify3_var uenv t1' t2 t2' =
+ occur_for Unify uenv t1' t2;
+ match occur_univar_for Unify (get_env uenv) t2 with
+ | () -> link_type t1' t2
+ | exception Unify_trace _ when in_pattern_mode uenv ->
+ reify uenv t1';
+ reify uenv t2';
+ occur_univar ~inj_only:true (get_env uenv) t2';
+ record_equation uenv t1' t2'
+
+(*
+ 1. When unifying two non-abbreviated types, one type is made a link
+ to the other. When unifying an abbreviated type with a
+ non-abbreviated type, the non-abbreviated type is made a link to
+ the other one. When unifying to abbreviated types, these two
+ types are kept distincts, but they are made to (temporally)
+ expand to the same type.
+ 2. Abbreviations with at least one parameter are systematically
+ expanded. The overhead does not seem too high, and that way
+ abbreviations where some parameters does not appear in the
+ expansion, such as ['a t = int], are correctly handled. In
+ particular, for this example, unifying ['a t] with ['b t] keeps
+ ['a] and ['b] distincts. (Is it really important ?)
+ 3. Unifying an abbreviation ['a t = 'a] with ['a] should not yield
+ ['a t as 'a]. Indeed, the type variable would otherwise be lost.
+ This problem occurs for abbreviations expanding to a type
+ variable, but also to many other constrained abbreviations (for
+ instance, [(< x : 'a > -> unit) t = <x : 'a>]). The solution is
+ that, if an abbreviation is unified with some subpart of its
+ parameters, then the parameter actually does not get
+ abbreviated. It would be possible to check whether some
+ information is indeed lost, but it probably does not worth it.
+*)
+
+let rec unify uenv t1 t2 =
+ (* First step: special cases (optimizations) *)
+ if unify_eq uenv t1 t2 then () else
+ let reset_tracing = check_trace_gadt_instances (get_env uenv) in
+
+ try
+ type_changed := true;
+ begin match (get_desc t1, get_desc t2) with
+ (Tvar _, Tconstr _) when deep_occur t1 t2 ->
+ unify2 uenv t1 t2
+ | (Tconstr _, Tvar _) when deep_occur t2 t1 ->
+ unify2 uenv t1 t2
+ | (Tvar _, _) ->
+ if unify1_var uenv t1 t2 then () else unify2 uenv t1 t2
+ | (_, Tvar _) ->
+ if unify1_var uenv t2 t1 then () else unify2 uenv t1 t2
+ | (Tunivar _, Tunivar _) ->
+ unify_univar_for Unify t1 t2 !univar_pairs;
+ update_level_for Unify (get_env uenv) (get_level t1) t2;
+ update_scope_for Unify (get_scope t1) t2;
+ link_type t1 t2
+ | (Tconstr (p1, [], a1), Tconstr (p2, [], a2))
+ when Path.same p1 p2
+ (* This optimization assumes that t1 does not expand to t2
+ (and conversely), so we fall back to the general case
+ when any of the types has a cached expansion. *)
+ && not (has_cached_expansion p1 !a1
+ || has_cached_expansion p2 !a2) ->
+ update_level_for Unify (get_env uenv) (get_level t1) t2;
+ update_scope_for Unify (get_scope t1) t2;
+ link_type t1 t2
+ | (Tconstr _, Tconstr _) when Env.has_local_constraints (get_env uenv) ->
+ unify2_rec uenv t1 t1 t2 t2
+ | _ ->
+ unify2 uenv t1 t2
+ end;
+ reset_trace_gadt_instances reset_tracing;
+ with Unify_trace trace ->
+ reset_trace_gadt_instances reset_tracing;
+ raise_trace_for Unify (Diff {got = t1; expected = t2} :: trace)
+
+and unify2 uenv t1 t2 = unify2_expand uenv t1 t1 t2 t2
+
+and unify2_rec uenv t10 t1 t20 t2 =
+ if unify_eq uenv t1 t2 then () else
+ try match (get_desc t1, get_desc t2) with
+ | (Tconstr (p1, tl1, a1), Tconstr (p2, tl2, a2)) ->
+ if Path.same p1 p2 && tl1 = [] && tl2 = []
+ && not (has_cached_expansion p1 !a1 || has_cached_expansion p2 !a2)
+ then begin
+ update_level_for Unify (get_env uenv) (get_level t1) t2;
+ update_scope_for Unify (get_scope t1) t2;
+ link_type t1 t2
+ end else
+ let env = get_env uenv in
+ if find_expansion_scope env p1 > find_expansion_scope env p2
+ then unify2_rec uenv t10 t1 t20 (try_expand_safe env t2)
+ else unify2_rec uenv t10 (try_expand_safe env t1) t20 t2
+ | _ ->
+ raise Cannot_expand
+ with Cannot_expand ->
+ unify2_expand uenv t10 t1 t20 t2
+
+and unify2_expand uenv t1 t1' t2 t2' =
+ (* Second step: expansion of abbreviations *)
+ (* Expansion may change the representative of the types. *)
+ let env = get_env uenv in
+ ignore (expand_head_unif env t1');
+ ignore (expand_head_unif env t2');
+ let t1' = expand_head_unif env t1' in
+ let t2' = expand_head_unif env t2' in
+ let lv = Int.min (get_level t1') (get_level t2') in
+ let scope = Int.max (get_scope t1') (get_scope t2') in
+ update_level_for Unify env lv t2;
+ update_level_for Unify env lv t1;
+ update_scope_for Unify scope t2;
+ update_scope_for Unify scope t1;
+ if unify_eq uenv t1' t2' then () else
+
+ let t1, t2 =
+ if !Clflags.principal
+ && (find_lowest_level t1' < lv || find_lowest_level t2' < lv) then
+ (* Expand abbreviations hiding a lower level *)
+ (* Should also do it for parameterized types, after unification... *)
+ (match get_desc t1 with Tconstr (_, [], _) -> t1' | _ -> t1),
+ (match get_desc t2 with Tconstr (_, [], _) -> t2' | _ -> t2)
+ else (t1, t2)
+ in
+ if unify_eq uenv t1 t1' || not (unify_eq uenv t2 t2') then
+ unify3 uenv t1 t1' t2 t2'
+ else
+ try unify3 uenv t2 t2' t1 t1' with Unify_trace trace ->
+ raise_trace_for Unify (swap_trace trace)
+
+and unify3 uenv t1 t1' t2 t2' =
+ (* Third step: truly unification *)
+ (* Assumes either [t1 == t1'] or [t2 != t2'] *)
+ let tt1' = Transient_expr.repr t1' in
+ let d1 = tt1'.desc and d2 = get_desc t2' in
+ let create_recursion =
+ (not (eq_type t2 t2')) && (deep_occur t1' t2) in
+
+ begin match (d1, d2) with (* handle vars and univars specially *)
+ (Tunivar _, Tunivar _) ->
+ unify_univar_for Unify t1' t2' !univar_pairs;
+ link_type t1' t2'
+ | (Tvar _, _) ->
+ unify3_var uenv t1' t2 t2'
+ | (_, Tvar _) ->
+ unify3_var uenv t2' t1 t1'
+ | (Tfield _, Tfield _) -> (* special case for GADTs *)
+ unify_fields uenv t1' t2'
+ | _ ->
+ if in_pattern_mode uenv then
+ add_type_equality uenv t1' t2'
+ else begin
+ occur_for Unify uenv t1' t2;
+ link_type t1' t2
+ end;
+ try
+ begin match (d1, d2) with
+ (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) ->
+ eq_labels Unify ~in_pattern_mode:(in_pattern_mode uenv) l1 l2;
+ unify uenv t1 t2; unify uenv u1 u2;
+ begin match is_commu_ok c1, is_commu_ok c2 with
+ | false, true -> set_commu_ok c1
+ | true, false -> set_commu_ok c2
+ | false, false -> link_commu ~inside:c1 c2
+ | true, true -> ()
+ end
+ | (Ttuple tl1, Ttuple tl2) ->
+ unify_list uenv tl1 tl2
+ | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
+ if not (in_pattern_mode uenv) then
+ unify_list uenv tl1 tl2
+ else if can_assume_injective uenv then
+ without_assume_injective uenv (fun uenv -> unify_list uenv tl1 tl2)
+ else if in_current_module p1 (* || in_pervasives p1 *)
+ || List.exists (expands_to_datatype (get_env uenv)) [t1'; t1; t2]
+ then
+ unify_list uenv tl1 tl2
+ else
+ let inj =
+ try List.map Variance.(mem Inj)
+ (Env.find_type p1 (get_env uenv)).type_variance
+ with Not_found -> List.map (fun _ -> false) tl1
+ in
+ List.iter2
+ (fun i (t1, t2) ->
+ if i then unify uenv t1 t2 else begin
+ reify uenv t1;
+ reify uenv t2
+ end)
+ inj (List.combine tl1 tl2)
+ | (Tconstr (path,[],_),
+ Tconstr (path',[],_))
+ when in_pattern_mode uenv &&
+ let env = get_env uenv in
+ is_instantiable env path && is_instantiable env path' ->
+ let source, destination =
+ if Path.scope path > Path.scope path'
+ then path , t2'
+ else path', t1'
+ in
+ record_equation uenv t1' t2';
+ add_gadt_equation uenv source destination
+ | (Tconstr (path,[],_), _)
+ when in_pattern_mode uenv && is_instantiable (get_env uenv) path ->
+ reify uenv t2';
+ record_equation uenv t1' t2';
+ add_gadt_equation uenv path t2'
+ | (_, Tconstr (path,[],_))
+ when in_pattern_mode uenv && is_instantiable (get_env uenv) path ->
+ reify uenv t1';
+ record_equation uenv t1' t2';
+ add_gadt_equation uenv path t1'
+ | (Tconstr (_,_,_), _) | (_, Tconstr (_,_,_)) when in_pattern_mode uenv ->
+ reify uenv t1';
+ reify uenv t2';
+ mcomp_for Unify (get_env uenv) t1' t2';
+ record_equation uenv t1' t2'
+ | (Tobject (fi1, nm1), Tobject (fi2, _)) ->
+ unify_fields uenv fi1 fi2;
+ (* Type [t2'] may have been instantiated by [unify_fields] *)
+ (* XXX One should do some kind of unification... *)
+ begin match get_desc t2' with
+ Tobject (_, {contents = Some (_, va::_)}) when
+ (match get_desc va with
+ Tvar _|Tunivar _|Tnil -> true | _ -> false) -> ()
+ | Tobject (_, nm2) -> set_name nm2 !nm1
+ | _ -> ()
+ end
+ | (Tvariant row1, Tvariant row2) ->
+ if not (in_pattern_mode uenv) then
+ unify_row uenv row1 row2
+ else begin
+ let snap = snapshot () in
+ try unify_row uenv row1 row2
+ with Unify_trace _ ->
+ backtrack snap;
+ reify uenv t1';
+ reify uenv t2';
+ mcomp_for Unify (get_env uenv) t1' t2';
+ record_equation uenv t1' t2'
+ end
+ | (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
+ begin match field_kind_repr kind with
+ Fprivate when f <> dummy_method ->
+ link_kind ~inside:kind field_absent;
+ if d2 = Tnil then unify uenv rem t2'
+ else unify uenv (newgenty Tnil) rem
+ | _ ->
+ if f = dummy_method then
+ raise_for Unify (Obj Self_cannot_be_closed)
+ else if d1 = Tnil then
+ raise_for Unify (Obj (Missing_field(First, f)))
+ else
+ raise_for Unify (Obj (Missing_field(Second, f)))
+ end
+ | (Tnil, Tnil) ->
+ ()
+ | (Tpoly (t1, []), Tpoly (t2, [])) ->
+ unify uenv t1 t2
+ | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+ enter_poly_for Unify (get_env uenv) t1 tl1 t2 tl2
+ (unify uenv)
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
+ begin match
+ unify_package (get_env uenv) (unify_list uenv)
+ (get_level t1) p1 fl1 (get_level t2) p2 fl2
+ with
+ | Ok () -> ()
+ | Error fm_err ->
+ if not (in_pattern_mode uenv) then
+ raise_for Unify (Errortrace.First_class_module fm_err);
+ List.iter (fun (_n, ty) -> reify uenv ty) (fl1 @ fl2);
+ | exception Not_found ->
+ if not (in_pattern_mode uenv) then raise_unexplained_for Unify;
+ List.iter (fun (_n, ty) -> reify uenv ty) (fl1 @ fl2);
+ (* if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 *)
+ end
+ | (Tnil, Tconstr _ ) ->
+ raise_for Unify (Obj (Abstract_row Second))
+ | (Tconstr _, Tnil ) ->
+ raise_for Unify (Obj (Abstract_row First))
+ | (_, _) -> raise_unexplained_for Unify
+ end;
+ (* XXX Commentaires + changer "create_recursion"
+ ||| Comments + change "create_recursion" *)
+ if create_recursion then
+ match get_desc t2 with
+ Tconstr (p, tl, abbrev) ->
+ forget_abbrev abbrev p;
+ let t2'' = expand_head_unif (get_env uenv) t2 in
+ if not (closed_parameterized_type tl t2'') then
+ link_type t2 t2'
+ | _ ->
+ () (* t2 has already been expanded by update_level *)
+ with Unify_trace trace ->
+ Transient_expr.set_desc tt1' d1;
+ raise_trace_for Unify trace
+ end
+
+and unify_list env tl1 tl2 =
+ if List.length tl1 <> List.length tl2 then
+ raise_unexplained_for Unify;
+ List.iter2 (unify env) tl1 tl2
+
+(* Build a fresh row variable for unification *)
+and make_rowvar level use1 rest1 use2 rest2 =
+ let set_name ty name =
+ match get_desc ty with
+ Tvar None -> set_type_desc ty (Tvar name)
+ | _ -> ()
+ in
+ let name =
+ match get_desc rest1, get_desc rest2 with
+ Tvar (Some _ as name1), Tvar (Some _ as name2) ->
+ if get_level rest1 <= get_level rest2 then name1 else name2
+ | Tvar (Some _ as name), _ ->
+ if use2 then set_name rest2 name; name
+ | _, Tvar (Some _ as name) ->
+ if use1 then set_name rest2 name; name
+ | _ -> None
+ in
+ if use1 then rest1 else
+ if use2 then rest2 else newty2 ~level (Tvar name)
+
+and unify_fields uenv ty1 ty2 = (* Optimization *)
+ let (fields1, rest1) = flatten_fields ty1
+ and (fields2, rest2) = flatten_fields ty2 in
+ let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+ let l1 = get_level ty1 and l2 = get_level ty2 in
+ let va = make_rowvar (Int.min l1 l2) (miss2=[]) rest1 (miss1=[]) rest2 in
+ let tr1 = Transient_expr.repr rest1 and tr2 = Transient_expr.repr rest2 in
+ let d1 = tr1.desc and d2 = tr2.desc in
+ try
+ unify uenv (build_fields l1 miss1 va) rest2;
+ unify uenv rest1 (build_fields l2 miss2 va);
+ List.iter
+ (fun (name, k1, t1, k2, t2) ->
+ unify_kind k1 k2;
+ try
+ if !trace_gadt_instances && not (in_subst_mode uenv) then begin
+ (* in_subst_mode: see PR#11771 *)
+ update_level_for Unify (get_env uenv) (get_level va) t1;
+ update_scope_for Unify (get_scope va) t1
+ end;
+ unify uenv t1 t2
+ with Unify_trace trace ->
+ raise_trace_for Unify
+ (incompatible_fields ~name ~got:t1 ~expected:t2 :: trace)
+ )
+ pairs
+ with exn ->
+ Transient_expr.set_desc tr1 d1;
+ Transient_expr.set_desc tr2 d2;
+ raise exn
+
+and unify_kind k1 k2 =
+ match field_kind_repr k1, field_kind_repr k2 with
+ (Fprivate, (Fprivate | Fpublic)) -> link_kind ~inside:k1 k2
+ | (Fpublic, Fprivate) -> link_kind ~inside:k2 k1
+ | (Fpublic, Fpublic) -> ()
+ | _ -> assert false
+
+and unify_row uenv row1 row2 =
+ let Row {fields = row1_fields; more = rm1;
+ closed = row1_closed; name = row1_name} = row_repr row1 in
+ let Row {fields = row2_fields; more = rm2;
+ closed = row2_closed; name = row2_name} = row_repr row2 in
+ if unify_eq uenv rm1 rm2 then () else
+ let r1, r2, pairs = merge_row_fields row1_fields row2_fields in
+ if r1 <> [] && r2 <> [] then begin
+ let ht = Hashtbl.create (List.length r1) in
+ List.iter (fun (l,_) -> Hashtbl.add ht (hash_variant l) l) r1;
+ List.iter
+ (fun (l,_) ->
+ try raise (Tags(l, Hashtbl.find ht (hash_variant l)))
+ with Not_found -> ())
+ r2
+ end;
+ let fixed1 = fixed_explanation row1 and fixed2 = fixed_explanation row2 in
+ let more = match fixed1, fixed2 with
+ | Some _, Some _ -> if get_level rm2 < get_level rm1 then rm2 else rm1
+ | Some _, None -> rm1
+ | None, Some _ -> rm2
+ | None, None ->
+ newty2 ~level:(Int.min (get_level rm1) (get_level rm2)) (Tvar None)
+ in
+ let fixed = merge_fixed_explanation fixed1 fixed2
+ and closed = row1_closed || row2_closed in
+ let keep switch =
+ List.for_all
+ (fun (_,f1,f2) ->
+ let f1, f2 = switch f1 f2 in
+ row_field_repr f1 = Rabsent || row_field_repr f2 <> Rabsent)
+ pairs
+ in
+ let empty fields =
+ List.for_all (fun (_,f) -> row_field_repr f = Rabsent) fields in
+ (* Check whether we are going to build an empty type *)
+ if closed && (empty r1 || row2_closed) && (empty r2 || row1_closed)
+ && List.for_all
+ (fun (_,f1,f2) ->
+ row_field_repr f1 = Rabsent || row_field_repr f2 = Rabsent)
+ pairs
+ then raise_for Unify (Variant No_intersection);
+ let name =
+ if row1_name <> None && (row1_closed || empty r2) &&
+ (not row2_closed || keep (fun f1 f2 -> f1, f2) && empty r1)
+ then row1_name
+ else if row2_name <> None && (row2_closed || empty r1) &&
+ (not row1_closed || keep (fun f1 f2 -> f2, f1) && empty r2)
+ then row2_name
+ else None
+ in
+ let set_more pos row rest =
+ let rest =
+ if closed then
+ filter_row_fields (row_closed row) rest
+ else rest in
+ begin match fixed_explanation row with
+ | None ->
+ if rest <> [] && row_closed row then
+ raise_for Unify (Variant (No_tags(pos,rest)))
+ | Some fixed ->
+ if closed && not (row_closed row) then
+ raise_for Unify (Variant (Fixed_row(pos,Cannot_be_closed,fixed)))
+ else if rest <> [] then
+ let case = Cannot_add_tags (List.map fst rest) in
+ raise_for Unify (Variant (Fixed_row(pos,case,fixed)))
+ end;
+ (* The following test is not principal... should rather use Tnil *)
+ let rm = row_more row in
+ (*if !trace_gadt_instances && rm.desc = Tnil then () else*)
+ if !trace_gadt_instances && not (in_subst_mode uenv) then
+ (* in_subst_mode: see PR#11771 *)
+ update_level_for Unify (get_env uenv) (get_level rm)
+ (newgenty (Tvariant row));
+ if has_fixed_explanation row then
+ if eq_type more rm then () else
+ if is_Tvar rm then link_type rm more else unify uenv rm more
+ else
+ let ty =
+ newgenty (Tvariant
+ (create_row ~fields:rest ~more ~closed ~fixed ~name))
+ in
+ update_level_for Unify (get_env uenv) (get_level rm) ty;
+ update_scope_for Unify (get_scope rm) ty;
+ link_type rm ty
+ in
+ let tm1 = Transient_expr.repr rm1 and tm2 = Transient_expr.repr rm2 in
+ let md1 = tm1.desc and md2 = tm2.desc in
+ begin try
+ set_more Second row2 r1;
+ set_more First row1 r2;
+ List.iter
+ (fun (l,f1,f2) ->
+ try unify_row_field uenv fixed1 fixed2 rm1 rm2 l f1 f2
+ with Unify_trace trace ->
+ raise_trace_for Unify (Variant (Incompatible_types_for l) :: trace)
+ )
+ pairs;
+ if static_row row1 then begin
+ let rm = row_more row1 in
+ if is_Tvar rm then link_type rm (newty2 ~level:(get_level rm) Tnil)
+ end
+ with exn ->
+ Transient_expr.set_desc tm1 md1;
+ Transient_expr.set_desc tm2 md2;
+ raise exn
+ end
+
+and unify_row_field uenv fixed1 fixed2 rm1 rm2 l f1 f2 =
+ let if_not_fixed (pos,fixed) f =
+ match fixed with
+ | None -> f ()
+ | Some fix ->
+ let tr = [Variant(Fixed_row(pos,Cannot_add_tags [l],fix))] in
+ raise_trace_for Unify tr in
+ let first = First, fixed1 and second = Second, fixed2 in
+ let either_fixed = match fixed1, fixed2 with
+ | None, None -> false
+ | _ -> true in
+ if f1 == f2 then () else
+ match row_field_repr f1, row_field_repr f2 with
+ Rpresent(Some t1), Rpresent(Some t2) -> unify uenv t1 t2
+ | Rpresent None, Rpresent None -> ()
+ | Reither(c1, tl1, m1), Reither(c2, tl2, m2) ->
+ if eq_row_field_ext f1 f2 then () else
+ let no_arg = c1 || c2 and matched = m1 || m2 in
+ if either_fixed && not no_arg
+ && List.length tl1 = List.length tl2 then begin
+ (* PR#7496 *)
+ let f = rf_either [] ~no_arg ~matched in
+ link_row_field_ext ~inside:f1 f; link_row_field_ext ~inside:f2 f;
+ List.iter2 (unify uenv) tl1 tl2
+ end
+ else let redo =
+ (m1 || m2 || either_fixed ||
+ !rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) &&
+ begin match tl1 @ tl2 with [] -> false
+ | t1 :: tl ->
+ if no_arg then raise_unexplained_for Unify;
+ Types.changed_row_field_exts [f1;f2] (fun () ->
+ List.iter (unify uenv t1) tl
+ )
+ end in
+ if redo then unify_row_field uenv fixed1 fixed2 rm1 rm2 l f1 f2 else
+ let remq tl =
+ List.filter (fun ty -> not (List.exists (eq_type ty) tl)) in
+ let tl1' = remq tl2 tl1 and tl2' = remq tl1 tl2 in
+ (* PR#6744 *)
+ let env = get_env uenv in
+ let (tlu1,tl1') = List.partition (has_free_univars env) tl1'
+ and (tlu2,tl2') = List.partition (has_free_univars env) tl2' in
+ begin match tlu1, tlu2 with
+ [], [] -> ()
+ | (tu1::tlu1), _ :: _ ->
+ (* Attempt to merge all the types containing univars *)
+ List.iter (unify uenv tu1) (tlu1@tlu2)
+ | (tu::_, []) | ([], tu::_) ->
+ occur_univar_for Unify env tu
+ end;
+ (* Is this handling of levels really principal? *)
+ let update_levels rm =
+ let env = get_env uenv in
+ List.iter
+ (fun ty ->
+ update_level_for Unify env (get_level rm) ty;
+ update_scope_for Unify (get_scope rm) ty)
+ in
+ update_levels rm2 tl1';
+ update_levels rm1 tl2';
+ let f1' = rf_either tl2' ~no_arg ~matched in
+ let f2' = rf_either tl1' ~use_ext_of:f1' ~no_arg ~matched in
+ link_row_field_ext ~inside:f1 f1'; link_row_field_ext ~inside:f2 f2';
+ | Reither(_, _, false), Rabsent ->
+ if_not_fixed first (fun () -> link_row_field_ext ~inside:f1 f2)
+ | Rabsent, Reither(_, _, false) ->
+ if_not_fixed second (fun () -> link_row_field_ext ~inside:f2 f1)
+ | Rabsent, Rabsent -> ()
+ | Reither(false, tl, _), Rpresent(Some t2) ->
+ if_not_fixed first (fun () ->
+ let s = snapshot () in
+ link_row_field_ext ~inside:f1 f2;
+ update_level_for Unify (get_env uenv) (get_level rm1) t2;
+ update_scope_for Unify (get_scope rm1) t2;
+ (try List.iter (fun t1 -> unify uenv t1 t2) tl
+ with exn -> undo_first_change_after s; raise exn)
+ )
+ | Rpresent(Some t1), Reither(false, tl, _) ->
+ if_not_fixed second (fun () ->
+ let s = snapshot () in
+ link_row_field_ext ~inside:f2 f1;
+ update_level_for Unify (get_env uenv) (get_level rm2) t1;
+ update_scope_for Unify (get_scope rm2) t1;
+ (try List.iter (unify uenv t1) tl
+ with exn -> undo_first_change_after s; raise exn)
+ )
+ | Reither(true, [], _), Rpresent None ->
+ if_not_fixed first (fun () -> link_row_field_ext ~inside:f1 f2)
+ | Rpresent None, Reither(true, [], _) ->
+ if_not_fixed second (fun () -> link_row_field_ext ~inside:f2 f1)
+ | Rabsent, (Rpresent _ | Reither(_,_,true)) ->
+ raise_trace_for Unify [Variant(No_tags(First, [l,f1]))]
+ | (Rpresent _ | Reither (_,_,true)), Rabsent ->
+ raise_trace_for Unify [Variant(No_tags(Second, [l,f2]))]
+ | (Rpresent (Some _) | Reither(false,_,_)),
+ (Rpresent None | Reither(true,_,_))
+ | (Rpresent None | Reither(true,_,_)),
+ (Rpresent (Some _) | Reither(false,_,_)) ->
+ (* constructor arity mismatch: 0 <> 1 *)
+ raise_unexplained_for Unify
+ | Reither(true, _ :: _, _ ), Rpresent _
+ | Rpresent _ , Reither(true, _ :: _, _ ) ->
+ (* inconsistent conjunction on a non-absent field *)
+ raise_unexplained_for Unify
+
+let unify uenv ty1 ty2 =
+ let snap = Btype.snapshot () in
+ try
+ unify uenv ty1 ty2
+ with
+ Unify_trace trace ->
+ undo_compress snap;
+ raise (Unify (expand_to_unification_error (get_env uenv) trace))
+
+let unify_gadt (penv : Pattern_env.t) ty1 ty2 =
+ let equated_types = TypePairs.create 0 in
+ let do_unify_gadt () =
+ let uenv = Pattern
+ { penv;
+ equated_types;
+ assume_injective = true;
+ unify_eq_set = TypePairs.create 11; }
+ in
+ unify uenv ty1 ty2;
+ equated_types
+ in
+ let no_leak = penv.allow_recursive_equations || closed_type_expr ty2 in
+ if no_leak then with_univar_pairs [] do_unify_gadt else
+ let snap = Btype.snapshot () in
+ try
+ (* If there are free variables, first try normal unification *)
+ let uenv = Expression {env = penv.env; in_subst = false} in
+ with_univar_pairs [] (fun () -> unify uenv ty1 ty2);
+ equated_types
+ with Unify _ ->
+ (* If it fails, retry in pattern mode *)
+ Btype.backtrack snap;
+ with_univar_pairs [] do_unify_gadt
+
+let unify_var uenv t1 t2 =
+ if eq_type t1 t2 then () else
+ match get_desc t1, get_desc t2 with
+ Tvar _, Tconstr _ when deep_occur t1 t2 ->
+ unify uenv t1 t2
+ | Tvar _, _ ->
+ let env = get_env uenv in
+ let reset_tracing = check_trace_gadt_instances env in
+ begin try
+ occur_for Unify uenv t1 t2;
+ update_level_for Unify env (get_level t1) t2;
+ update_scope_for Unify (get_scope t1) t2;
+ link_type t1 t2;
+ reset_trace_gadt_instances reset_tracing;
+ with Unify_trace trace ->
+ reset_trace_gadt_instances reset_tracing;
+ raise (Unify (expand_to_unification_error
+ env
+ (Diff { got = t1; expected = t2 } :: trace)))
+ end
+ | _ ->
+ unify uenv t1 t2
+
+let _ = unify_var' := unify_var
+
+(* the final versions of unification functions *)
+let unify_var env ty1 ty2 =
+ unify_var (Expression {env; in_subst = false}) ty1 ty2
+
+let unify_pairs env ty1 ty2 pairs =
+ with_univar_pairs pairs (fun () ->
+ unify (Expression {env; in_subst = false}) ty1 ty2)
+
+let unify env ty1 ty2 =
+ unify_pairs env ty1 ty2 []
+
+(* Lower the level of a type to the current level *)
+let enforce_current_level env ty = unify_var env (newvar ()) ty
+
+
+(**** Special cases of unification ****)
+
+let expand_head_trace env t =
+ let reset_tracing = check_trace_gadt_instances env in
+ let t = expand_head_unif env t in
+ reset_trace_gadt_instances reset_tracing;
+ t
+
+(*
+ Unify [t] and [l:'a -> 'b]. Return ['a] and ['b].
+ In [-nolabels] mode, label mismatch is accepted when
+ (1) the requested label is ""
+ (2) the original label is not optional
+*)
+
+type filter_arrow_failure =
+ | Unification_error of unification_error
+ | Label_mismatch of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ }
+ | Not_a_function
+
+exception Filter_arrow_failed of filter_arrow_failure
+
+let filter_arrow env t l =
+ let function_type level =
+ let t1 = newvar2 level and t2 = newvar2 level in
+ let t' = newty2 ~level (Tarrow (l, t1, t2, commu_ok)) in
+ t', t1, t2
+ in
+ let t =
+ try expand_head_trace env t
+ with Unify_trace trace ->
+ let t', _, _ = function_type (get_level t) in
+ raise (Filter_arrow_failed
+ (Unification_error
+ (expand_to_unification_error
+ env
+ (Diff { got = t'; expected = t } :: trace))))
+ in
+ match get_desc t with
+ | Tvar _ ->
+ let t', t1, t2 = function_type (get_level t) in
+ link_type t t';
+ (t1, t2)
+ | Tarrow(l', t1, t2, _) ->
+ if l = l' || !Clflags.classic && l = Nolabel && not (is_optional l')
+ then (t1, t2)
+ else raise (Filter_arrow_failed
+ (Label_mismatch
+ { got = l; expected = l'; expected_type = t }))
+ | _ ->
+ raise (Filter_arrow_failed Not_a_function)
+
+type filter_method_failure =
+ | Unification_error of unification_error
+ | Not_a_method
+ | Not_an_object of type_expr
+
+exception Filter_method_failed of filter_method_failure
+
+(* Used by [filter_method]. *)
+let rec filter_method_field env name ty =
+ let method_type ~level =
+ let ty1 = newvar2 level and ty2 = newvar2 level in
+ let ty' = newty2 ~level (Tfield (name, field_public, ty1, ty2)) in
+ ty', ty1
+ in
+ let ty =
+ try expand_head_trace env ty
+ with Unify_trace trace ->
+ let level = get_level ty in
+ let ty', _ = method_type ~level in
+ raise (Filter_method_failed
+ (Unification_error
+ (expand_to_unification_error
+ env
+ (Diff { got = ty; expected = ty' } :: trace))))
+ in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ let ty', ty1 = method_type ~level in
+ link_type ty ty';
+ ty1
+ | Tfield(n, kind, ty1, ty2) ->
+ if n = name then begin
+ unify_kind kind field_public;
+ ty1
+ end else
+ filter_method_field env name ty2
+ | _ ->
+ raise (Filter_method_failed Not_a_method)
+
+(* Unify [ty] and [< name : 'a; .. >]. Return ['a]. *)
+let filter_method env name ty =
+ let object_type ~level ~scope =
+ let ty1 = newvar2 level in
+ let ty' = newty3 ~level ~scope (Tobject (ty1, ref None)) in
+ let ty_meth = filter_method_field env name ty1 in
+ (ty', ty_meth)
+ in
+ let ty =
+ try expand_head_trace env ty
+ with Unify_trace trace ->
+ let level = get_level ty in
+ let scope = get_scope ty in
+ let ty', _ = object_type ~level ~scope in
+ raise (Filter_method_failed
+ (Unification_error
+ (expand_to_unification_error
+ env
+ (Diff { got = ty; expected = ty' } :: trace))))
+ in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ let scope = get_scope ty in
+ let ty', ty_meth = object_type ~level ~scope in
+ link_type ty ty';
+ ty_meth
+ | Tobject(f, _) ->
+ filter_method_field env name f
+ | _ ->
+ raise (Filter_method_failed (Not_an_object ty))
+
+exception Filter_method_row_failed
+
+let rec filter_method_row env name priv ty =
+ let ty = expand_head env ty in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ let field = newvar2 level in
+ let row = newvar2 level in
+ let kind, priv =
+ match priv with
+ | Private ->
+ let kind = field_private () in
+ kind, Mprivate kind
+ | Public ->
+ field_public, Mpublic
+ in
+ let ty' = newty2 ~level (Tfield (name, kind, field, row)) in
+ link_type ty ty';
+ priv, field, row
+ | Tfield(n, kind, ty1, ty2) ->
+ if n = name then begin
+ let priv =
+ match priv with
+ | Public ->
+ unify_kind kind field_public;
+ Mpublic
+ | Private -> Mprivate kind
+ in
+ priv, ty1, ty2
+ end else begin
+ let level = get_level ty in
+ let priv, field, row = filter_method_row env name priv ty2 in
+ let row = newty2 ~level (Tfield (n, kind, ty1, row)) in
+ priv, field, row
+ end
+ | Tnil ->
+ if name = Btype.dummy_method then raise Filter_method_row_failed
+ else begin
+ match priv with
+ | Public -> raise Filter_method_row_failed
+ | Private ->
+ let level = get_level ty in
+ let kind = field_absent in
+ Mprivate kind, newvar2 level, ty
+ end
+ | _ ->
+ raise Filter_method_row_failed
+
+(* Operations on class signatures *)
+
+let new_class_signature () =
+ let row = newvar () in
+ let self = newobj row in
+ { csig_self = self;
+ csig_self_row = row;
+ csig_vars = Vars.empty;
+ csig_meths = Meths.empty; }
+
+let add_dummy_method env ~scope sign =
+ let _, ty, row =
+ filter_method_row env dummy_method Private sign.csig_self_row
+ in
+ unify env ty (new_scoped_ty scope (Ttuple []));
+ sign.csig_self_row <- row
+
+type add_method_failure =
+ | Unexpected_method
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_method_failed of add_method_failure
+
+let add_method env label priv virt ty sign =
+ let meths = sign.csig_meths in
+ let priv, virt =
+ match Meths.find label meths with
+ | (priv', virt', ty') -> begin
+ let priv =
+ match priv' with
+ | Mpublic -> Mpublic
+ | Mprivate k ->
+ match priv with
+ | Public ->
+ begin match field_kind_repr k with
+ | Fpublic -> ()
+ | Fprivate -> link_kind ~inside:k field_public
+ | Fabsent -> assert false
+ end;
+ Mpublic
+ | Private -> priv'
+ in
+ let virt =
+ match virt' with
+ | Concrete -> Concrete
+ | Virtual -> virt
+ in
+ match unify env ty ty' with
+ | () -> priv, virt
+ | exception Unify trace ->
+ raise (Add_method_failed (Type_mismatch trace))
+ end
+ | exception Not_found -> begin
+ let priv, ty', row =
+ match filter_method_row env label priv sign.csig_self_row with
+ | priv, ty', row ->
+ priv, ty', row
+ | exception Filter_method_row_failed ->
+ raise (Add_method_failed Unexpected_method)
+ in
+ match unify env ty ty' with
+ | () ->
+ sign.csig_self_row <- row;
+ priv, virt
+ | exception Unify trace ->
+ raise (Add_method_failed (Type_mismatch trace))
+ end
+ in
+ let meths = Meths.add label (priv, virt, ty) meths in
+ sign.csig_meths <- meths
+
+type add_instance_variable_failure =
+ | Mutability_mismatch of mutable_flag
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_instance_variable_failed of add_instance_variable_failure
+
+let check_mutability mut mut' =
+ match mut, mut' with
+ | Mutable, Mutable -> ()
+ | Immutable, Immutable -> ()
+ | Mutable, Immutable | Immutable, Mutable ->
+ raise (Add_instance_variable_failed (Mutability_mismatch mut))
+
+let add_instance_variable ~strict env label mut virt ty sign =
+ let vars = sign.csig_vars in
+ let virt =
+ match Vars.find label vars with
+ | (mut', virt', ty') ->
+ let virt =
+ match virt' with
+ | Concrete -> Concrete
+ | Virtual -> virt
+ in
+ if strict then begin
+ check_mutability mut mut';
+ match unify env ty ty' with
+ | () -> ()
+ | exception Unify trace ->
+ raise (Add_instance_variable_failed (Type_mismatch trace))
+ end;
+ virt
+ | exception Not_found -> virt
+ in
+ let vars = Vars.add label (mut, virt, ty) vars in
+ sign.csig_vars <- vars
+
+type inherit_class_signature_failure =
+ | Self_type_mismatch of Errortrace.unification_error
+ | Method of label * add_method_failure
+ | Instance_variable of label * add_instance_variable_failure
+
+exception Inherit_class_signature_failed of inherit_class_signature_failure
+
+let unify_self_types env sign1 sign2 =
+ let self_type1 = sign1.csig_self in
+ let self_type2 = sign2.csig_self in
+ match unify env self_type1 self_type2 with
+ | () -> ()
+ | exception Unify err -> begin
+ match err.trace with
+ | Errortrace.Diff _ :: Errortrace.Incompatible_fields {name; _} :: rem ->
+ let err = Errortrace.unification_error ~trace:rem in
+ let failure = Method (name, Type_mismatch err) in
+ raise (Inherit_class_signature_failed failure)
+ | _ ->
+ raise (Inherit_class_signature_failed (Self_type_mismatch err))
+ end
+
+(* Unify components of sign2 into sign1 *)
+let inherit_class_signature ~strict env sign1 sign2 =
+ unify_self_types env sign1 sign2;
+ Meths.iter
+ (fun label (priv, virt, ty) ->
+ let priv =
+ match priv with
+ | Mpublic -> Public
+ | Mprivate kind ->
+ assert (field_kind_repr kind = Fabsent);
+ Private
+ in
+ match add_method env label priv virt ty sign1 with
+ | () -> ()
+ | exception Add_method_failed failure ->
+ let failure = Method(label, failure) in
+ raise (Inherit_class_signature_failed failure))
+ sign2.csig_meths;
+ Vars.iter
+ (fun label (mut, virt, ty) ->
+ match add_instance_variable ~strict env label mut virt ty sign1 with
+ | () -> ()
+ | exception Add_instance_variable_failed failure ->
+ let failure = Instance_variable(label, failure) in
+ raise (Inherit_class_signature_failed failure))
+ sign2.csig_vars
+
+let update_class_signature env sign =
+ let self = expand_head env sign.Types.csig_self in
+ let fields, row = flatten_fields (object_fields self) in
+ let meths, implicitly_public, implicitly_declared =
+ List.fold_left
+ (fun (meths, implicitly_public, implicitly_declared) (lab, k, ty) ->
+ if lab = dummy_method then
+ meths, implicitly_public, implicitly_declared
+ else begin
+ match Meths.find lab meths with
+ | priv, virt, ty' ->
+ let meths, implicitly_public =
+ match priv, field_kind_repr k with
+ | Mpublic, _ -> meths, implicitly_public
+ | Mprivate _, Fpublic ->
+ let meths = Meths.add lab (Mpublic, virt, ty') meths in
+ let implicitly_public = lab :: implicitly_public in
+ meths, implicitly_public
+ | Mprivate _, _ -> meths, implicitly_public
+ in
+ meths, implicitly_public, implicitly_declared
+ | exception Not_found ->
+ let meths, implicitly_declared =
+ match field_kind_repr k with
+ | Fpublic ->
+ let meths = Meths.add lab (Mpublic, Virtual, ty) meths in
+ let implicitly_declared = lab :: implicitly_declared in
+ meths, implicitly_declared
+ | Fprivate ->
+ let meths =
+ Meths.add lab (Mprivate k, Virtual, ty) meths
+ in
+ let implicitly_declared = lab :: implicitly_declared in
+ meths, implicitly_declared
+ | Fabsent -> meths, implicitly_declared
+ in
+ meths, implicitly_public, implicitly_declared
+ end)
+ (sign.csig_meths, [], []) fields
+ in
+ sign.csig_meths <- meths;
+ sign.csig_self_row <- row;
+ implicitly_public, implicitly_declared
+
+let hide_private_methods env sign =
+ let self = expand_head env sign.Types.csig_self in
+ let fields, _ = flatten_fields (object_fields self) in
+ List.iter
+ (fun (_, k, _) ->
+ match field_kind_repr k with
+ | Fprivate -> link_kind ~inside:k field_absent
+ | _ -> ())
+ fields
+
+let close_class_signature env sign =
+ let rec close env ty =
+ let ty = expand_head env ty in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ link_type ty (newty2 ~level Tnil); true
+ | Tfield(lab, _, _, _) when lab = dummy_method ->
+ false
+ | Tfield(_, _, _, ty') -> close env ty'
+ | Tnil -> true
+ | _ -> assert false
+ in
+ let self = expand_head env sign.csig_self in
+ close env (object_fields self)
+
+let generalize_class_signature_spine sign =
+ (* Generalize the spine of methods *)
+ sign.csig_meths <-
+ Meths.map (fun (priv, virt, ty) -> priv, virt, copy_spine ty)
+ sign.csig_meths
+
+ (***********************************)
+ (* Matching between type schemes *)
+ (***********************************)
+
+(* Level of the subject, should be just below generic_level *)
+let subject_level = generic_level - 1
+
+(*
+ Update the level of [ty]. First check that the levels of generic
+ variables from the subject are not lowered.
+*)
+let moregen_occur env level ty =
+ with_type_mark begin fun mark ->
+ let rec occur ty =
+ let lv = get_level ty in
+ if lv <= level then () else
+ if is_Tvar ty && lv >= subject_level then raise Occur else
+ if try_mark_node mark ty then iter_type_expr occur ty
+ in
+ try
+ occur ty
+ with Occur ->
+ raise_unexplained_for Moregen
+ end;
+ (* also check for free univars *)
+ occur_univar_for Moregen env ty;
+ update_level_for Moregen env level ty
+
+let may_instantiate inst_nongen t1 =
+ let level = get_level t1 in
+ if inst_nongen then level <> subject_level
+ else level = generic_level
+
+let rec moregen inst_nongen type_pairs env t1 t2 =
+ if eq_type t1 t2 then () else
+
+ try
+ match (get_desc t1, get_desc t2) with
+ (Tvar _, _) when may_instantiate inst_nongen t1 ->
+ moregen_occur env (get_level t1) t2;
+ update_scope_for Moregen (get_scope t1) t2;
+ occur_for Moregen (Expression {env; in_subst = false}) t1 t2;
+ link_type t1 t2
+ | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+ ()
+ | _ ->
+ let t1' = expand_head env t1 in
+ let t2' = expand_head env t2 in
+ (* Expansion may have changed the representative of the types... *)
+ if eq_type t1' t2' then () else
+ if not (TypePairs.mem type_pairs (t1', t2')) then begin
+ TypePairs.add type_pairs (t1', t2');
+ match (get_desc t1', get_desc t2') with
+ (Tvar _, _) when may_instantiate inst_nongen t1' ->
+ moregen_occur env (get_level t1') t2;
+ update_scope_for Moregen (get_scope t1') t2;
+ link_type t1' t2
+ | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) ->
+ eq_labels Moregen ~in_pattern_mode:false l1 l2;
+ moregen inst_nongen type_pairs env t1 t2;
+ moregen inst_nongen type_pairs env u1 u2
+ | (Ttuple tl1, Ttuple tl2) ->
+ moregen_list inst_nongen type_pairs env tl1 tl2
+ | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
+ when Path.same p1 p2 ->
+ moregen_list inst_nongen type_pairs env tl1 tl2
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
+ begin match
+ unify_package env (moregen_list inst_nongen type_pairs env)
+ (get_level t1') p1 fl1 (get_level t2') p2 fl2
+ with
+ | Ok () -> ()
+ | Error fme -> raise_for Moregen (First_class_module fme)
+ | exception Not_found -> raise_unexplained_for Moregen
+ end
+ | (Tnil, Tconstr _ ) -> raise_for Moregen (Obj (Abstract_row Second))
+ | (Tconstr _, Tnil ) -> raise_for Moregen (Obj (Abstract_row First))
+ | (Tvariant row1, Tvariant row2) ->
+ moregen_row inst_nongen type_pairs env row1 row2
+ | (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
+ moregen_fields inst_nongen type_pairs env fi1 fi2
+ | (Tfield _, Tfield _) -> (* Actually unused *)
+ moregen_fields inst_nongen type_pairs env
+ t1' t2'
+ | (Tnil, Tnil) ->
+ ()
+ | (Tpoly (t1, []), Tpoly (t2, [])) ->
+ moregen inst_nongen type_pairs env t1 t2
+ | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+ enter_poly_for Moregen env t1 tl1 t2 tl2
+ (moregen inst_nongen type_pairs env)
+ | (Tunivar _, Tunivar _) ->
+ unify_univar_for Moregen t1' t2' !univar_pairs
+ | (_, _) ->
+ raise_unexplained_for Moregen
+ end
+ with Moregen_trace trace ->
+ raise_trace_for Moregen (Diff {got = t1; expected = t2} :: trace)
+
+
+and moregen_list inst_nongen type_pairs env tl1 tl2 =
+ if List.length tl1 <> List.length tl2 then
+ raise_unexplained_for Moregen;
+ List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
+
+and moregen_fields inst_nongen type_pairs env ty1 ty2 =
+ let (fields1, rest1) = flatten_fields ty1
+ and (fields2, rest2) = flatten_fields ty2 in
+ let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+ begin
+ match miss1 with
+ | (n, _, _) :: _ -> raise_for Moregen (Obj (Missing_field (Second, n)))
+ | [] -> ()
+ end;
+ moregen inst_nongen type_pairs env rest1
+ (build_fields (get_level ty2) miss2 rest2);
+ List.iter
+ (fun (name, k1, t1, k2, t2) ->
+ (* The below call should never throw [Public_method_to_private_method] *)
+ moregen_kind k1 k2;
+ try moregen inst_nongen type_pairs env t1 t2 with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (incompatible_fields ~name ~got:t1 ~expected:t2 :: trace)
+ )
+ pairs
+
+and moregen_kind k1 k2 =
+ match field_kind_repr k1, field_kind_repr k2 with
+ (Fprivate, (Fprivate | Fpublic)) -> link_kind ~inside:k1 k2
+ | (Fpublic, Fpublic) -> ()
+ | (Fpublic, Fprivate) -> raise Public_method_to_private_method
+ | (Fabsent, _) | (_, Fabsent) -> assert false
+
+and moregen_row inst_nongen type_pairs env row1 row2 =
+ let Row {fields = row1_fields; more = rm1; closed = row1_closed} =
+ row_repr row1 in
+ let Row {fields = row2_fields; more = rm2; closed = row2_closed;
+ fixed = row2_fixed} = row_repr row2 in
+ if eq_type rm1 rm2 then () else
+ let may_inst =
+ is_Tvar rm1 && may_instantiate inst_nongen rm1 || get_desc rm1 = Tnil in
+ let r1, r2, pairs = merge_row_fields row1_fields row2_fields in
+ let r1, r2 =
+ if row2_closed then
+ filter_row_fields may_inst r1, filter_row_fields false r2
+ else r1, r2
+ in
+ begin
+ if r1 <> [] then raise_for Moregen (Variant (No_tags (Second, r1)))
+ end;
+ if row1_closed then begin
+ match row2_closed, r2 with
+ | false, _ -> raise_for Moregen (Variant (Openness Second))
+ | _, _ :: _ -> raise_for Moregen (Variant (No_tags (First, r2)))
+ | _, [] -> ()
+ end;
+ let md1 = get_desc rm1 (* This lets us undo a following [link_type] *) in
+ begin match md1, get_desc rm2 with
+ Tunivar _, Tunivar _ ->
+ unify_univar_for Moregen rm1 rm2 !univar_pairs
+ | Tunivar _, _ | _, Tunivar _ ->
+ raise_unexplained_for Moregen
+ | _ when static_row row1 -> ()
+ | _ when may_inst ->
+ let ext =
+ newgenty (Tvariant
+ (create_row ~fields:r2 ~more:rm2 ~name:None
+ ~fixed:row2_fixed ~closed:row2_closed))
+ in
+ moregen_occur env (get_level rm1) ext;
+ update_scope_for Moregen (get_scope rm1) ext;
+ (* This [link_type] has to be undone if the rest of the function fails *)
+ link_type rm1 ext
+ | Tconstr _, Tconstr _ ->
+ moregen inst_nongen type_pairs env rm1 rm2
+ | _ -> raise_unexplained_for Moregen
+ end;
+ try
+ List.iter
+ (fun (l,f1,f2) ->
+ if f1 == f2 then () else
+ match row_field_repr f1, row_field_repr f2 with
+ (* Both matching [Rpresent]s *)
+ | Rpresent(Some t1), Rpresent(Some t2) -> begin
+ try
+ moregen inst_nongen type_pairs env t1 t2
+ with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ | Rpresent None, Rpresent None -> ()
+ (* Both [Reither] *)
+ | Reither(c1, tl1, _), Reither(c2, tl2, m2) -> begin
+ try
+ if not (eq_row_field_ext f1 f2) then begin
+ if c1 && not c2 then raise_unexplained_for Moregen;
+ let f2' =
+ rf_either [] ~use_ext_of:f2 ~no_arg:c2 ~matched:m2 in
+ link_row_field_ext ~inside:f1 f2';
+ if List.length tl1 = List.length tl2 then
+ List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
+ else match tl2 with
+ | t2 :: _ ->
+ List.iter
+ (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
+ tl1
+ | [] -> if tl1 <> [] then raise_unexplained_for Moregen
+ end
+ with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ (* Generalizing [Reither] *)
+ | Reither(false, tl1, _), Rpresent(Some t2) when may_inst -> begin
+ try
+ link_row_field_ext ~inside:f1 f2;
+ List.iter
+ (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
+ tl1
+ with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ | Reither(true, [], _), Rpresent None when may_inst ->
+ link_row_field_ext ~inside:f1 f2
+ | Reither(_, _, _), Rabsent when may_inst ->
+ link_row_field_ext ~inside:f1 f2
+ (* Both [Rabsent]s *)
+ | Rabsent, Rabsent -> ()
+ (* Mismatched constructor arguments *)
+ | Rpresent (Some _), Rpresent None
+ | Rpresent None, Rpresent (Some _) ->
+ raise_for Moregen (Variant (Incompatible_types_for l))
+ (* Mismatched presence *)
+ | Reither _, Rpresent _ ->
+ raise_for Moregen
+ (Variant (Presence_not_guaranteed_for (First, l)))
+ | Rpresent _, Reither _ ->
+ raise_for Moregen
+ (Variant (Presence_not_guaranteed_for (Second, l)))
+ (* Missing tags *)
+ | Rabsent, (Rpresent _ | Reither _) ->
+ raise_for Moregen (Variant (No_tags (First, [l, f2])))
+ | (Rpresent _ | Reither _), Rabsent ->
+ raise_for Moregen (Variant (No_tags (Second, [l, f1]))))
+ pairs
+ with exn ->
+ (* Undo [link_type] if we failed *)
+ set_type_desc rm1 md1; raise exn
+
+(* Must empty univar_pairs first *)
+let moregen inst_nongen type_pairs env patt subj =
+ with_univar_pairs [] (fun () ->
+ moregen inst_nongen type_pairs env patt subj)
+
+(*
+ Non-generic variable can be instantiated only if [inst_nongen] is
+ true. So, [inst_nongen] should be set to false if the subject might
+ contain non-generic variables (and we do not want them to be
+ instantiated).
+ Usually, the subject is given by the user, and the pattern
+ is unimportant. So, no need to propagate abbreviations.
+*)
+let moregeneral env inst_nongen pat_sch subj_sch =
+ (* Moregen splits the generic level into two finer levels:
+ [generic_level] and [subject_level = generic_level - 1].
+ In order to properly detect and print weak variables when
+ printing errors, we need to merge those levels back together.
+ We do that by starting at level [subject_level - 1], using
+ [with_local_level_generalize] to first set the current level
+ to [subject_level], and then generalize nodes at [subject_level]
+ on exit.
+ Strictly speaking, we could avoid generalizing when there is no error,
+ as nodes at level [subject_level] are never unified with nodes of
+ the original types, but that would be rather ad hoc.
+ *)
+ with_level ~level:(subject_level - 1) begin fun () ->
+ match with_local_level_generalize begin fun () ->
+ assert (!current_level = subject_level);
+ (*
+ Generic variables are first duplicated with [instance]. So,
+ their levels are lowered to [subject_level]. The subject is
+ then copied with [duplicate_type]. That way, its levels won't be
+ changed.
+ *)
+ let subj_inst = instance subj_sch in
+ let subj = duplicate_type subj_inst in
+ (* Duplicate generic variables *)
+ let patt = generic_instance pat_sch in
+ try Ok (moregen inst_nongen (TypePairs.create 13) env patt subj)
+ with Moregen_trace trace -> Error trace
+ end with
+ | Ok () -> ()
+ | Error trace -> raise (Moregen (expand_to_moregen_error env trace))
+ end
+
+let is_moregeneral env inst_nongen pat_sch subj_sch =
+ match moregeneral env inst_nongen pat_sch subj_sch with
+ | () -> true
+ | exception Moregen _ -> false
+
+(* Alternative approach: "rigidify" a type scheme,
+ and check validity after unification *)
+(* Simpler, no? *)
+
+let rec rigidify_rec mark vars ty =
+ if try_mark_node mark ty then
+ begin match get_desc ty with
+ | Tvar _ ->
+ if not (TypeSet.mem ty !vars) then vars := TypeSet.add ty !vars
+ | Tvariant row ->
+ let Row {more; name; closed} = row_repr row in
+ if is_Tvar more && not (has_fixed_explanation row) then begin
+ let more' = newty2 ~level:(get_level more) (get_desc more) in
+ let row' =
+ create_row ~fixed:(Some Rigid) ~fields:[] ~more:more'
+ ~name ~closed
+ in link_type more (newty2 ~level:(get_level ty) (Tvariant row'))
+ end;
+ iter_row (rigidify_rec mark vars) row;
+ (* only consider the row variable if the variant is not static *)
+ if not (static_row row) then
+ rigidify_rec mark vars (row_more row)
+ | _ ->
+ iter_type_expr (rigidify_rec mark vars) ty
+ end
+
+let rigidify ty =
+ let vars = ref TypeSet.empty in
+ with_type_mark (fun mark -> rigidify_rec mark vars ty);
+ TypeSet.elements !vars
+
+let all_distinct_vars env vars =
+ let tys = ref TypeSet.empty in
+ List.for_all
+ (fun ty ->
+ let ty = expand_head env ty in
+ if TypeSet.mem ty !tys then false else
+ (tys := TypeSet.add ty !tys; is_Tvar ty))
+ vars
+
+let matches ~expand_error_trace env ty ty' =
+ let snap = snapshot () in
+ let vars = rigidify ty in
+ cleanup_abbrev ();
+ match unify env ty ty' with
+ | () ->
+ if not (all_distinct_vars env vars) then begin
+ backtrack snap;
+ let diff =
+ if expand_error_trace
+ then expanded_diff env ~got:ty ~expected:ty'
+ else unexpanded_diff ~got:ty ~expected:ty'
+ in
+ raise (Matches_failure (env, unification_error ~trace:[diff]))
+ end;
+ backtrack snap
+ | exception Unify err ->
+ backtrack snap;
+ raise (Matches_failure (env, err))
+
+let does_match env ty ty' =
+ match matches ~expand_error_trace:false env ty ty' with
+ | () -> true
+ | exception Matches_failure (_, _) -> false
+
+ (*********************************************)
+ (* Equivalence between parameterized types *)
+ (*********************************************)
+
+let expand_head_rigid env ty =
+ let old = !rigid_variants in
+ rigid_variants := true;
+ let ty' = expand_head env ty in
+ rigid_variants := old; ty'
+
+let eqtype_subst type_pairs subst t1 t2 =
+ if List.exists
+ (fun (t,t') ->
+ let found1 = eq_type t1 t in
+ let found2 = eq_type t2 t' in
+ if found1 && found2 then true else
+ if found1 || found2 then raise_unexplained_for Equality else false)
+ !subst
+ then ()
+ else begin
+ subst := (t1, t2) :: !subst;
+ TypePairs.add type_pairs (t1, t2)
+ end
+
+let rec eqtype rename type_pairs subst env t1 t2 =
+ let check_phys_eq t1 t2 =
+ not rename && eq_type t1 t2
+ in
+ (* Checking for physical equality of type representatives when [rename] is
+ true would be incorrect: imagine comparing ['a * 'a] with ['b * 'a]. The
+ first ['a] and ['b] would be identified in [eqtype_subst], and then the
+ second ['a] and ['a] would be [eq_type]. So we do not call [eq_type] here.
+
+ On the other hand, when [rename] is false we need to check for physical
+ equality, as that's the only way variables can be identified.
+ *)
+ if check_phys_eq t1 t2 then () else
+ try
+ match (get_desc t1, get_desc t2) with
+ (Tvar _, Tvar _) when rename ->
+ eqtype_subst type_pairs subst t1 t2
+ | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+ ()
+ | _ ->
+ let t1' = expand_head_rigid env t1 in
+ let t2' = expand_head_rigid env t2 in
+ (* Expansion may have changed the representative of the types... *)
+ if check_phys_eq t1' t2' then () else
+ if not (TypePairs.mem type_pairs (t1', t2')) then begin
+ TypePairs.add type_pairs (t1', t2');
+ match (get_desc t1', get_desc t2') with
+ (Tvar _, Tvar _) when rename ->
+ eqtype_subst type_pairs subst t1' t2'
+ | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) ->
+ eq_labels Equality ~in_pattern_mode:false l1 l2;
+ eqtype rename type_pairs subst env t1 t2;
+ eqtype rename type_pairs subst env u1 u2
+ | (Ttuple tl1, Ttuple tl2) ->
+ eqtype_list rename type_pairs subst env tl1 tl2
+ | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
+ when Path.same p1 p2 ->
+ eqtype_list_same_length rename type_pairs subst env tl1 tl2
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
+ begin match
+ unify_package env (eqtype_list rename type_pairs subst env)
+ (get_level t1') p1 fl1 (get_level t2') p2 fl2
+ with
+ | Ok () -> ()
+ | Error fme -> raise_for Equality (First_class_module fme)
+ | exception Not_found -> raise_unexplained_for Equality
+ end
+ | (Tnil, Tconstr _ ) ->
+ raise_for Equality (Obj (Abstract_row Second))
+ | (Tconstr _, Tnil ) ->
+ raise_for Equality (Obj (Abstract_row First))
+ | (Tvariant row1, Tvariant row2) ->
+ eqtype_row rename type_pairs subst env row1 row2
+ | (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
+ eqtype_fields rename type_pairs subst env fi1 fi2
+ | (Tfield _, Tfield _) -> (* Actually unused *)
+ eqtype_fields rename type_pairs subst env
+ t1' t2'
+ | (Tnil, Tnil) ->
+ ()
+ | (Tpoly (t1, []), Tpoly (t2, [])) ->
+ eqtype rename type_pairs subst env t1 t2
+ | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+ enter_poly_for Equality env t1 tl1 t2 tl2
+ (eqtype rename type_pairs subst env)
+ | (Tunivar _, Tunivar _) ->
+ unify_univar_for Equality t1' t2' !univar_pairs
+ | (_, _) ->
+ raise_unexplained_for Equality
+ end
+ with Equality_trace trace ->
+ raise_trace_for Equality (Diff {got = t1; expected = t2} :: trace)
+
+and eqtype_list_same_length rename type_pairs subst env tl1 tl2 =
+ List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+
+and eqtype_list rename type_pairs subst env tl1 tl2 =
+ if List.length tl1 <> List.length tl2 then
+ raise_unexplained_for Equality;
+ eqtype_list_same_length rename type_pairs subst env tl1 tl2
+
+and eqtype_fields rename type_pairs subst env ty1 ty2 =
+ let (fields1, rest1) = flatten_fields ty1 in
+ let (fields2, rest2) = flatten_fields ty2 in
+ (* First check if same row => already equal *)
+ let same_row =
+ (* [not rename]: see comment at top of [eqtype] *)
+ (not rename && eq_type rest1 rest2) ||
+ TypePairs.mem type_pairs (rest1,rest2)
+ in
+ if same_row then () else
+ (* Try expansion, needed when called from Includecore.type_manifest *)
+ match get_desc (expand_head_rigid env rest2) with
+ Tobject(ty2,_) -> eqtype_fields rename type_pairs subst env ty1 ty2
+ | _ ->
+ let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+ eqtype rename type_pairs subst env rest1 rest2;
+ match miss1, miss2 with
+ | ((n, _, _)::_, _) -> raise_for Equality (Obj (Missing_field (Second, n)))
+ | (_, (n, _, _)::_) -> raise_for Equality (Obj (Missing_field (First, n)))
+ | [], [] ->
+ List.iter
+ (function (name, k1, t1, k2, t2) ->
+ eqtype_kind k1 k2;
+ try
+ eqtype rename type_pairs subst env t1 t2;
+ with Equality_trace trace ->
+ raise_trace_for Equality
+ (incompatible_fields ~name ~got:t1 ~expected:t2 :: trace))
+ pairs
+
+and eqtype_kind k1 k2 =
+ let k1 = field_kind_repr k1 in
+ let k2 = field_kind_repr k2 in
+ match k1, k2 with
+ | (Fprivate, Fprivate)
+ | (Fpublic, Fpublic) -> ()
+ | _ -> raise_unexplained_for Unify
+ (* It's probably not possible to hit this case with
+ real OCaml code *)
+
+and eqtype_row rename type_pairs subst env row1 row2 =
+ (* Try expansion, needed when called from Includecore.type_manifest *)
+ match get_desc (expand_head_rigid env (row_more row2)) with
+ Tvariant row2 -> eqtype_row rename type_pairs subst env row1 row2
+ | _ ->
+ let r1, r2, pairs = merge_row_fields (row_fields row1) (row_fields row2) in
+ if row_closed row1 <> row_closed row2 then begin
+ raise_for Equality
+ (Variant (Openness (if row_closed row2 then First else Second)))
+ end;
+ if not (row_closed row1) then begin
+ match r1, r2 with
+ | _::_, _ -> raise_for Equality (Variant (No_tags (Second, r1)))
+ | _, _::_ -> raise_for Equality (Variant (No_tags (First, r2)))
+ | _, _ -> ()
+ end;
+ begin
+ match filter_row_fields false r1 with
+ | [] -> ();
+ | _ :: _ as r1 -> raise_for Equality (Variant (No_tags (Second, r1)))
+ end;
+ begin
+ match filter_row_fields false r2 with
+ | [] -> ()
+ | _ :: _ as r2 -> raise_for Equality (Variant (No_tags (First, r2)))
+ end;
+ if not (static_row row1) then
+ eqtype rename type_pairs subst env (row_more row1) (row_more row2);
+ List.iter
+ (fun (l,f1,f2) ->
+ if f1 == f2 then () else
+ match row_field_repr f1, row_field_repr f2 with
+ (* Both matching [Rpresent]s *)
+ | Rpresent(Some t1), Rpresent(Some t2) -> begin
+ try
+ eqtype rename type_pairs subst env t1 t2
+ with Equality_trace trace ->
+ raise_trace_for Equality
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ | Rpresent None, Rpresent None -> ()
+ (* Both matching [Reither]s *)
+ | Reither(c1, [], _), Reither(c2, [], _) when c1 = c2 -> ()
+ | Reither(c1, t1::tl1, _), Reither(c2, t2::tl2, _)
+ when c1 = c2 -> begin
+ try
+ eqtype rename type_pairs subst env t1 t2;
+ if List.length tl1 = List.length tl2 then
+ (* if same length allow different types (meaning?) *)
+ List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+ else begin
+ (* otherwise everything must be equal *)
+ List.iter (eqtype rename type_pairs subst env t1) tl2;
+ List.iter
+ (fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1
+ end
+ with Equality_trace trace ->
+ raise_trace_for Equality
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ (* Both [Rabsent]s *)
+ | Rabsent, Rabsent -> ()
+ (* Mismatched constructor arguments *)
+ | Rpresent (Some _), Rpresent None
+ | Rpresent None, Rpresent (Some _)
+ | Reither _, Reither _ ->
+ raise_for Equality (Variant (Incompatible_types_for l))
+ (* Mismatched presence *)
+ | Reither _, Rpresent _ ->
+ raise_for Equality
+ (Variant (Presence_not_guaranteed_for (First, l)))
+ | Rpresent _, Reither _ ->
+ raise_for Equality
+ (Variant (Presence_not_guaranteed_for (Second, l)))
+ (* Missing tags *)
+ | Rabsent, (Rpresent _ | Reither _) ->
+ raise_for Equality (Variant (No_tags (First, [l, f2])))
+ | (Rpresent _ | Reither _), Rabsent ->
+ raise_for Equality (Variant (No_tags (Second, [l, f1]))))
+ pairs
+
+(* Must empty univar_pairs first *)
+let eqtype_list_same_length rename type_pairs subst env tl1 tl2 =
+ with_univar_pairs [] (fun () ->
+ let snap = Btype.snapshot () in
+ Misc.try_finally
+ ~always:(fun () -> backtrack snap)
+ (fun () -> eqtype_list_same_length rename type_pairs subst env tl1 tl2))
+
+let eqtype rename type_pairs subst env t1 t2 =
+ eqtype_list_same_length rename type_pairs subst env [t1] [t2]
+
+(* Two modes: with or without renaming of variables *)
+let equal env rename tyl1 tyl2 =
+ if List.length tyl1 <> List.length tyl2 then
+ raise_unexplained_for Equality;
+ if List.for_all2 eq_type tyl1 tyl2 then () else
+ let subst = ref [] in
+ try eqtype_list_same_length rename (TypePairs.create 11) subst env tyl1 tyl2
+ with Equality_trace trace ->
+ raise (Equality (expand_to_equality_error env trace !subst))
+
+let is_equal env rename tyl1 tyl2 =
+ match equal env rename tyl1 tyl2 with
+ | () -> true
+ | exception Equality _ -> false
+
+let rec equal_private env params1 ty1 params2 ty2 =
+ match equal env true (params1 @ [ty1]) (params2 @ [ty2]) with
+ | () -> ()
+ | exception (Equality _ as err) ->
+ match try_expand_safe_opt env (expand_head env ty1) with
+ | ty1' -> equal_private env params1 ty1' params2 ty2
+ | exception Cannot_expand -> raise err
+
+ (*************************)
+ (* Class type matching *)
+ (*************************)
+
+type class_match_failure =
+ CM_Virtual_class
+ | CM_Parameter_arity_mismatch of int * int
+ | CM_Type_parameter_mismatch of int * Env.t * equality_error
+ | CM_Class_type_mismatch of Env.t * class_type * class_type
+ | CM_Parameter_mismatch of int * Env.t * moregen_error
+ | CM_Val_type_mismatch of string * Env.t * comparison_error
+ | CM_Meth_type_mismatch of string * Env.t * comparison_error
+ | CM_Non_mutable_value of string
+ | CM_Non_concrete_value of string
+ | CM_Missing_value of string
+ | CM_Missing_method of string
+ | CM_Hide_public of string
+ | CM_Hide_virtual of string * string
+ | CM_Public_method of string
+ | CM_Private_method of string
+ | CM_Virtual_method of string
+
+exception Failure of class_match_failure list
+
+let match_class_sig_shape ~strict sign1 sign2 =
+ let errors =
+ Meths.fold
+ (fun lab (priv, vr, _) err ->
+ match Meths.find lab sign1.csig_meths with
+ | exception Not_found -> CM_Missing_method lab::err
+ | (priv', vr', _) ->
+ match priv', priv with
+ | Mpublic, Mprivate _ -> CM_Public_method lab::err
+ | Mprivate _, Mpublic when strict -> CM_Private_method lab::err
+ | _, _ ->
+ match vr', vr with
+ | Virtual, Concrete -> CM_Virtual_method lab::err
+ | _, _ -> err)
+ sign2.csig_meths []
+ in
+ let errors =
+ Meths.fold
+ (fun lab (priv, vr, _) err ->
+ if Meths.mem lab sign2.csig_meths then err
+ else begin
+ let err =
+ match priv with
+ | Mpublic -> CM_Hide_public lab :: err
+ | Mprivate _ -> err
+ in
+ match vr with
+ | Virtual -> CM_Hide_virtual ("method", lab) :: err
+ | Concrete -> err
+ end)
+ sign1.csig_meths errors
+ in
+ let errors =
+ Vars.fold
+ (fun lab (mut, vr, _) err ->
+ match Vars.find lab sign1.csig_vars with
+ | exception Not_found -> CM_Missing_value lab::err
+ | (mut', vr', _) ->
+ match mut', mut with
+ | Immutable, Mutable -> CM_Non_mutable_value lab::err
+ | _, _ ->
+ match vr', vr with
+ | Virtual, Concrete -> CM_Non_concrete_value lab::err
+ | _, _ -> err)
+ sign2.csig_vars errors
+ in
+ Vars.fold
+ (fun lab (_,vr,_) err ->
+ if vr = Virtual && not (Vars.mem lab sign2.csig_vars) then
+ CM_Hide_virtual ("instance variable", lab) :: err
+ else err)
+ sign1.csig_vars errors
+
+(* [arrow_index] is the number of [Cty_arrow]
+ constructors we've seen so far. *)
+let rec moregen_clty ~arrow_index trace type_pairs env cty1 cty2 =
+ try
+ match cty1, cty2 with
+ | Cty_constr (_, _, cty1), _ ->
+ moregen_clty ~arrow_index true type_pairs env cty1 cty2
+ | _, Cty_constr (_, _, cty2) ->
+ moregen_clty ~arrow_index true type_pairs env cty1 cty2
+ | Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
+ let arrow_index = arrow_index + 1 in
+ begin
+ try moregen true type_pairs env ty1 ty2 with Moregen_trace trace ->
+ raise (Failure [
+ CM_Parameter_mismatch
+ (arrow_index, env, expand_to_moregen_error env trace)])
+ end;
+ moregen_clty ~arrow_index false type_pairs env cty1' cty2'
+ | Cty_signature sign1, Cty_signature sign2 ->
+ Meths.iter
+ (fun lab (_, _, ty) ->
+ match Meths.find lab sign1.csig_meths with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all methods in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match moregen true type_pairs env ty' ty with
+ | () -> ()
+ | exception Moregen_trace trace ->
+ raise (Failure [
+ CM_Meth_type_mismatch
+ (lab,
+ env,
+ Moregen_error
+ (expand_to_moregen_error env trace))]))
+ sign2.csig_meths;
+ Vars.iter
+ (fun lab (_, _, ty) ->
+ match Vars.find lab sign1.csig_vars with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all instance variables in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match moregen true type_pairs env ty' ty with
+ | () -> ()
+ | exception Moregen_trace trace ->
+ raise (Failure [
+ CM_Val_type_mismatch
+ (lab,
+ env,
+ Moregen_error
+ (expand_to_moregen_error env trace))]))
+ sign2.csig_vars
+ | _ ->
+ raise (Failure [])
+ with
+ Failure error when trace || error = [] ->
+ raise (Failure (CM_Class_type_mismatch (env, cty1, cty2)::error))
+
+let moregen_clty trace type_pairs env cty1 cty2 =
+ moregen_clty ~arrow_index:0 trace type_pairs env cty1 cty2
+
+let match_class_types ?(trace=true) env pat_sch subj_sch =
+ let sign1 = signature_of_class_type pat_sch in
+ let sign2 = signature_of_class_type subj_sch in
+ let errors = match_class_sig_shape ~strict:false sign1 sign2 in
+ match errors with
+ | [] ->
+ (* Moregen splits the generic level into two finer levels:
+ [generic_level] and [subject_level = generic_level - 1].
+ In order to properly detect and print weak variables when
+ printing errors, we need to merge those levels back together.
+ We do that by starting at level [subject_level - 1], using
+ [with_local_level_generalize] to first set the current level
+ to [subject_level], and then generalize nodes at [subject_level]
+ on exit.
+ Strictly speaking, we could avoid generalizing when there is no error,
+ as nodes at level [subject_level] are never unified with nodes of
+ the original types, but that would be rather ad hoc.
+ *)
+ with_level ~level:(subject_level - 1) begin fun () ->
+ with_local_level_generalize begin fun () ->
+ assert (!current_level = subject_level);
+ (*
+ Generic variables are first duplicated with [instance]. So,
+ their levels are lowered to [subject_level]. The subject is
+ then copied with [duplicate_type]. That way, its levels won't be
+ changed.
+ *)
+ let (_, subj_inst) = instance_class [] subj_sch in
+ let subj = duplicate_class_type subj_inst in
+ (* Duplicate generic variables *)
+ let (_, patt) =
+ with_level ~level:generic_level
+ (fun () -> instance_class [] pat_sch) in
+ let type_pairs = TypePairs.create 53 in
+ let sign1 = signature_of_class_type patt in
+ let sign2 = signature_of_class_type subj in
+ let self1 = sign1.csig_self in
+ let self2 = sign2.csig_self in
+ let row1 = sign1.csig_self_row in
+ let row2 = sign2.csig_self_row in
+ TypePairs.add type_pairs (self1, self2);
+ (* Always succeeds *)
+ moregen true type_pairs env row1 row2;
+ (* May fail *)
+ try moregen_clty trace type_pairs env patt subj; []
+ with Failure res -> res
+ end
+ end
+ | errors ->
+ CM_Class_type_mismatch (env, pat_sch, subj_sch) :: errors
+
+let equal_clsig trace type_pairs subst env sign1 sign2 =
+ try
+ Meths.iter
+ (fun lab (_, _, ty) ->
+ match Meths.find lab sign1.csig_meths with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all methods in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match eqtype true type_pairs subst env ty' ty with
+ | () -> ()
+ | exception Equality_trace trace ->
+ raise (Failure [
+ CM_Meth_type_mismatch
+ (lab,
+ env,
+ Equality_error
+ (expand_to_equality_error env trace !subst))]))
+ sign2.csig_meths;
+ Vars.iter
+ (fun lab (_, _, ty) ->
+ match Vars.find lab sign1.csig_vars with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all instance variables in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match eqtype true type_pairs subst env ty' ty with
+ | () -> ()
+ | exception Equality_trace trace ->
+ raise (Failure [
+ CM_Val_type_mismatch
+ (lab,
+ env,
+ Equality_error
+ (expand_to_equality_error env trace !subst))]))
+ sign2.csig_vars
+ with
+ Failure error when trace ->
+ raise (Failure (CM_Class_type_mismatch
+ (env, Cty_signature sign1, Cty_signature sign2)::error))
+
+let match_class_declarations env patt_params patt_type subj_params subj_type =
+ let sign1 = signature_of_class_type patt_type in
+ let sign2 = signature_of_class_type subj_type in
+ let errors = match_class_sig_shape ~strict:true sign1 sign2 in
+ match errors with
+ | [] -> begin
+ try
+ let subst = ref [] in
+ let type_pairs = TypePairs.create 53 in
+ let self1 = sign1.csig_self in
+ let self2 = sign2.csig_self in
+ let row1 = sign1.csig_self_row in
+ let row2 = sign2.csig_self_row in
+ TypePairs.add type_pairs (self1, self2);
+ (* Always succeeds *)
+ eqtype true type_pairs subst env row1 row2;
+ let lp = List.length patt_params in
+ let ls = List.length subj_params in
+ if lp <> ls then
+ raise (Failure [CM_Parameter_arity_mismatch (lp, ls)]);
+ Stdlib.List.iteri2 (fun n p s ->
+ try eqtype true type_pairs subst env p s with Equality_trace trace ->
+ raise (Failure
+ [CM_Type_parameter_mismatch
+ (n+1, env, expand_to_equality_error env trace !subst)]))
+ patt_params subj_params;
+ (* old code: equal_clty false type_pairs subst env patt_type subj_type; *)
+ equal_clsig false type_pairs subst env sign1 sign2;
+ (* Use moregeneral for class parameters, need to recheck everything to
+ keeps relationships (PR#4824) *)
+ let clty_params =
+ List.fold_right (fun ty cty -> Cty_arrow (Labelled "*",ty,cty)) in
+ match_class_types ~trace:false env
+ (clty_params patt_params patt_type)
+ (clty_params subj_params subj_type)
+ with Failure r -> r
+ end
+ | error ->
+ error
+
+
+ (***************)
+ (* Subtyping *)
+ (***************)
+
+
+(**** Build a subtype of a given type. ****)
+
+(* build_subtype:
+ [visited] traces traversed object and variant types
+ [loops] is a mapping from variables to variables, to reproduce
+ positive loops in a class type
+ [posi] true if the current variance is positive
+ [level] number of expansions/enlargement allowed on this branch *)
+
+let warn = ref false (* whether double coercion might do better *)
+let pred_expand n = if n mod 2 = 0 && n > 0 then pred n else n
+let pred_enlarge n = if n mod 2 = 1 then pred n else n
+
+type change = Unchanged | Equiv | Changed
+let max_change c1 c2 =
+ match c1, c2 with
+ | _, Changed | Changed, _ -> Changed
+ | Equiv, _ | _, Equiv -> Equiv
+ | _ -> Unchanged
+
+let collect l = List.fold_left (fun c1 (_, c2) -> max_change c1 c2) Unchanged l
+
+let rec filter_visited = function
+ [] -> []
+ | {desc=Tobject _|Tvariant _} :: _ as l -> l
+ | _ :: l -> filter_visited l
+
+let memq_warn t visited =
+ if List.memq t visited then (warn := true; true) else false
+
+let find_cltype_for_path env p =
+ let cl_abbr = Env.find_hash_type p env in
+ match cl_abbr.type_manifest with
+ Some ty ->
+ begin match get_desc ty with
+ Tobject(_,{contents=Some(p',_)}) when Path.same p p' -> cl_abbr, ty
+ | _ -> raise Not_found
+ end
+ | None -> assert false
+
+let has_constr_row' env t =
+ has_constr_row (expand_abbrev env t)
+
+let rec build_subtype env (visited : transient_expr list)
+ (loops : (int * type_expr) list) posi level t =
+ match get_desc t with
+ Tvar _ ->
+ if posi then
+ try
+ let t' = List.assq (get_id t) loops in
+ warn := true;
+ (t', Equiv)
+ with Not_found ->
+ (t, Unchanged)
+ else
+ (t, Unchanged)
+ | Tarrow(l, t1, t2, _) ->
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited then (t, Unchanged) else
+ let visited = tt :: visited in
+ let (t1', c1) = build_subtype env visited loops (not posi) level t1 in
+ let (t2', c2) = build_subtype env visited loops posi level t2 in
+ let c = max_change c1 c2 in
+ if c > Unchanged
+ then (newty (Tarrow(l, t1', t2', commu_ok)), c)
+ else (t, Unchanged)
+ | Ttuple tlist ->
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited then (t, Unchanged) else
+ let visited = tt :: visited in
+ let tlist' =
+ List.map (build_subtype env visited loops posi level) tlist
+ in
+ let c = collect tlist' in
+ if c > Unchanged then (newty (Ttuple (List.map fst tlist')), c)
+ else (t, Unchanged)
+ | Tconstr(p, tl, abbrev)
+ when level > 0 && generic_abbrev env p && safe_abbrev env t
+ && not (has_constr_row' env t) ->
+ let t' = expand_abbrev env t in
+ let level' = pred_expand level in
+ begin try match get_desc t' with
+ Tobject _ when posi && not (opened_object t') ->
+ let cl_abbr, body = find_cltype_for_path env p in
+ let ty =
+ try
+ subst env !current_level Public abbrev None
+ cl_abbr.type_params tl body
+ with Cannot_subst -> assert false in
+ let ty1, tl1 =
+ match get_desc ty with
+ Tobject(ty1,{contents=Some(p',tl1)}) when Path.same p p' ->
+ ty1, tl1
+ | _ -> raise Not_found
+ in
+ (* Fix PR#4505: do not set ty to Tvar when it appears in tl1,
+ as this occurrence might break the occur check.
+ XXX not clear whether this correct anyway... *)
+ if List.exists (deep_occur ty) tl1 then raise Not_found;
+ set_type_desc ty (Tvar None);
+ let t'' = newvar () in
+ let loops = (get_id ty, t'') :: loops in
+ (* May discard [visited] as level is going down *)
+ let (ty1', c) =
+ build_subtype env [Transient_expr.repr t']
+ loops posi (pred_enlarge level') ty1 in
+ assert (is_Tvar t'');
+ let nm =
+ if c > Equiv || deep_occur ty ty1' then None else Some(p,tl1) in
+ set_type_desc t'' (Tobject (ty1', ref nm));
+ (try unify_var env ty t with Unify _ -> assert false);
+ ( t'', Changed)
+ | _ -> raise Not_found
+ with Not_found ->
+ let (t'',c) =
+ build_subtype env visited loops posi level' t' in
+ if c > Unchanged then (t'',c)
+ else (t, Unchanged)
+ end
+ | Tconstr(p, tl, _abbrev) ->
+ (* Must check recursion on constructors, since we do not always
+ expand them *)
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited then (t, Unchanged) else
+ let visited = tt :: visited in
+ begin try
+ let decl = Env.find_type p env in
+ if level = 0 && generic_abbrev env p && safe_abbrev env t
+ && not (has_constr_row' env t)
+ then warn := true;
+ let tl' =
+ List.map2
+ (fun v t ->
+ let (co,cn) = Variance.get_upper v in
+ if cn then
+ if co then (t, Unchanged)
+ else build_subtype env visited loops (not posi) level t
+ else
+ if co then build_subtype env visited loops posi level t
+ else (newvar(), Changed))
+ decl.type_variance tl
+ in
+ let c = collect tl' in
+ if c > Unchanged then (newconstr p (List.map fst tl'), c)
+ else (t, Unchanged)
+ with Not_found ->
+ (t, Unchanged)
+ end
+ | Tvariant row ->
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited || not (static_row row) then (t, Unchanged) else
+ let level' = pred_enlarge level in
+ let visited =
+ tt :: if level' < level then [] else filter_visited visited in
+ let fields = filter_row_fields false (row_fields row) in
+ let fields =
+ List.map
+ (fun (l,f as orig) -> match row_field_repr f with
+ Rpresent None ->
+ if posi then
+ (l, rf_either_of None), Unchanged
+ else
+ orig, Unchanged
+ | Rpresent(Some t) ->
+ let (t', c) = build_subtype env visited loops posi level' t in
+ let f =
+ if posi && level > 0
+ then rf_either_of (Some t')
+ else rf_present (Some t')
+ in (l, f), c
+ | _ -> assert false)
+ fields
+ in
+ let c = collect fields in
+ let row =
+ create_row ~fields:(List.map fst fields) ~more:(newvar ())
+ ~closed:posi ~fixed:None
+ ~name:(if c > Unchanged then None else row_name row)
+ in
+ (newty (Tvariant row), Changed)
+ | Tobject (t1, _) ->
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited || opened_object t1 then (t, Unchanged) else
+ let level' = pred_enlarge level in
+ let visited =
+ tt :: if level' < level then [] else filter_visited visited in
+ let (t1', c) = build_subtype env visited loops posi level' t1 in
+ if c > Unchanged then (newty (Tobject (t1', ref None)), c)
+ else (t, Unchanged)
+ | Tfield(s, _, t1, t2) (* Always present *) ->
+ let (t1', c1) = build_subtype env visited loops posi level t1 in
+ let (t2', c2) = build_subtype env visited loops posi level t2 in
+ let c = max_change c1 c2 in
+ if c > Unchanged then (newty (Tfield(s, field_public, t1', t2')), c)
+ else (t, Unchanged)
+ | Tnil ->
+ if posi then
+ let v = newvar () in
+ (v, Changed)
+ else begin
+ warn := true;
+ (t, Unchanged)
+ end
+ | Tsubst _ | Tlink _ ->
+ assert false
+ | Tpoly(t1, tl) ->
+ let (t1', c) = build_subtype env visited loops posi level t1 in
+ if c > Unchanged then (newty (Tpoly(t1', tl)), c)
+ else (t, Unchanged)
+ | Tunivar _ | Tpackage _ ->
+ (t, Unchanged)
+
+let enlarge_type env ty =
+ warn := false;
+ (* [level = 4] allows 2 expansions involving objects/variants *)
+ let (ty', _) = build_subtype env [] [] true 4 ty in
+ (ty', !warn)
+
+(**** Check whether a type is a subtype of another type. ****)
+
+(*
+ During the traversal, a trace of visited types is maintained. It
+ is printed in case of error.
+ Constraints (pairs of types that must be equals) are accumulated
+ rather than being enforced straight. Indeed, the result would
+ otherwise depend on the order in which these constraints are
+ enforced.
+ A function enforcing these constraints is returned. That way, type
+ variables can be bound to their actual values before this function
+ is called (see Typecore).
+ Only well-defined abbreviations are expanded (hence the tests
+ [generic_abbrev ...]).
+*)
+
+let subtypes = TypePairs.create 17
+
+let subtype_error ~env ~trace ~unification_trace =
+ raise (Subtype (Subtype.error
+ ~trace:(expand_subtype_trace env (List.rev trace))
+ ~unification_trace))
+
+let rec subtype_rec env trace t1 t2 cstrs =
+ if eq_type t1 t2 then cstrs else
+
+ if TypePairs.mem subtypes (t1, t2) then
+ cstrs
+ else begin
+ TypePairs.add subtypes (t1, t2);
+ match (get_desc t1, get_desc t2) with
+ (Tvar _, _) | (_, Tvar _) ->
+ (trace, t1, t2, !univar_pairs)::cstrs
+ | (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _))
+ when compatible_labels ~in_pattern_mode:false l1 l2 ->
+ let cstrs =
+ subtype_rec
+ env
+ (Subtype.Diff {got = t2; expected = t1} :: trace)
+ t2 t1
+ cstrs
+ in
+ subtype_rec
+ env
+ (Subtype.Diff {got = u1; expected = u2} :: trace)
+ u1 u2
+ cstrs
+ | (Ttuple tl1, Ttuple tl2) ->
+ subtype_list env trace tl1 tl2 cstrs
+ | (Tconstr(p1, [], _), Tconstr(p2, [], _)) when Path.same p1 p2 ->
+ cstrs
+ | (Tconstr(p1, _tl1, _abbrev1), _)
+ when generic_abbrev env p1 && safe_abbrev env t1 ->
+ subtype_rec env trace (expand_abbrev env t1) t2 cstrs
+ | (_, Tconstr(p2, _tl2, _abbrev2))
+ when generic_abbrev env p2 && safe_abbrev env t2 ->
+ subtype_rec env trace t1 (expand_abbrev env t2) cstrs
+ | (Tconstr(p1, tl1, _), Tconstr(p2, tl2, _)) when Path.same p1 p2 ->
+ begin try
+ let decl = Env.find_type p1 env in
+ List.fold_left2
+ (fun cstrs v (t1, t2) ->
+ let (co, cn) = Variance.get_upper v in
+ if co then
+ if cn then
+ (trace, newty2 ~level:(get_level t1) (Ttuple[t1]),
+ newty2 ~level:(get_level t2) (Ttuple[t2]), !univar_pairs)
+ :: cstrs
+ else
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
+ else
+ if cn
+ then
+ subtype_rec
+ env
+ (Subtype.Diff {got = t2; expected = t1} :: trace)
+ t2 t1
+ cstrs
+ else cstrs)
+ cstrs decl.type_variance (List.combine tl1 tl2)
+ with Not_found ->
+ (trace, t1, t2, !univar_pairs)::cstrs
+ end
+ | (Tconstr(p1, _, _), _)
+ when generic_private_abbrev env p1 && safe_abbrev_opt env t1 ->
+ subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
+(* | (_, Tconstr(p2, _, _)) when generic_private_abbrev false env p2 ->
+ subtype_rec env trace t1 (expand_abbrev_opt env t2) cstrs *)
+ | (Tobject (f1, _), Tobject (f2, _))
+ when is_Tvar (object_row f1) && is_Tvar (object_row f2) ->
+ (* Same row variable implies same object. *)
+ (trace, t1, t2, !univar_pairs)::cstrs
+ | (Tobject (f1, _), Tobject (f2, _)) ->
+ subtype_fields env trace f1 f2 cstrs
+ | (Tvariant row1, Tvariant row2) ->
+ begin try
+ subtype_row env trace row1 row2 cstrs
+ with Exit ->
+ (trace, t1, t2, !univar_pairs)::cstrs
+ end
+ | (Tpoly (u1, []), Tpoly (u2, [])) ->
+ subtype_rec env trace u1 u2 cstrs
+ | (Tpoly (u1, tl1), Tpoly (u2, [])) ->
+ let _, u1' = instance_poly ~fixed:false tl1 u1 in
+ subtype_rec env trace u1' u2 cstrs
+ | (Tpoly (u1, tl1), Tpoly (u2,tl2)) ->
+ begin try
+ enter_poly env u1 tl1 u2 tl2
+ (fun t1 t2 -> subtype_rec env trace t1 t2 cstrs)
+ with Escape _ ->
+ (trace, t1, t2, !univar_pairs)::cstrs
+ end
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
+ begin try
+ let ntl1 =
+ complete_type_list env fl2 (get_level t1) (Mty_ident p1) fl1
+ and ntl2 =
+ complete_type_list env fl1 (get_level t2) (Mty_ident p2) fl2
+ ~allow_absent:true in
+ let cstrs' =
+ List.map
+ (fun (n2,t2) -> (trace, List.assoc n2 ntl1, t2, !univar_pairs))
+ ntl2
+ in
+ if eq_package_path env p1 p2 then cstrs' @ cstrs
+ else begin
+ (* need to check module subtyping *)
+ let snap = Btype.snapshot () in
+ match List.iter (fun (_, t1, t2, _) -> unify env t1 t2) cstrs' with
+ | () when Result.is_ok (!package_subtype env p1 fl1 p2 fl2) ->
+ Btype.backtrack snap; cstrs' @ cstrs
+ | () | exception Unify _ ->
+ Btype.backtrack snap; raise Not_found
+ end
+ with Not_found ->
+ (trace, t1, t2, !univar_pairs)::cstrs
+ end
+ | (_, _) ->
+ (trace, t1, t2, !univar_pairs)::cstrs
+ end
+
+and subtype_list env trace tl1 tl2 cstrs =
+ if List.length tl1 <> List.length tl2 then
+ subtype_error ~env ~trace ~unification_trace:[];
+ List.fold_left2
+ (fun cstrs t1 t2 ->
+ subtype_rec
+ env
+ (Subtype.Diff { got = t1; expected = t2 } :: trace)
+ t1 t2
+ cstrs)
+ cstrs tl1 tl2
+
+and subtype_fields env trace ty1 ty2 cstrs =
+ (* Assume that either rest1 or rest2 is not Tvar *)
+ let (fields1, rest1) = flatten_fields ty1 in
+ let (fields2, rest2) = flatten_fields ty2 in
+ let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+ let cstrs =
+ if get_desc rest2 = Tnil then cstrs else
+ if miss1 = [] then
+ subtype_rec
+ env
+ (Subtype.Diff {got = rest1; expected = rest2} :: trace)
+ rest1 rest2
+ cstrs
+ else
+ (trace, build_fields (get_level ty1) miss1 rest1, rest2,
+ !univar_pairs) :: cstrs
+ in
+ let cstrs =
+ if miss2 = [] then cstrs else
+ (trace, rest1, build_fields (get_level ty2) miss2 (newvar ()),
+ !univar_pairs) :: cstrs
+ in
+ List.fold_left
+ (fun cstrs (_, _k1, t1, _k2, t2) ->
+ (* These fields are always present *)
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs)
+ cstrs pairs
+
+and subtype_row env trace row1 row2 cstrs =
+ let Row {fields = row1_fields; more = more1; closed = row1_closed} =
+ row_repr row1 in
+ let Row {fields = row2_fields; more = more2; closed = row2_closed} =
+ row_repr row2 in
+ let r1, r2, pairs =
+ merge_row_fields row1_fields row2_fields in
+ let r1 = if row2_closed then filter_row_fields false r1 else r1 in
+ let r2 = if row1_closed then filter_row_fields false r2 else r2 in
+ match get_desc more1, get_desc more2 with
+ Tconstr(p1,_,_), Tconstr(p2,_,_) when Path.same p1 p2 ->
+ subtype_rec
+ env
+ (Subtype.Diff {got = more1; expected = more2} :: trace)
+ more1 more2
+ cstrs
+ | (Tvar _|Tconstr _|Tnil), (Tvar _|Tconstr _|Tnil)
+ when row1_closed && r1 = [] ->
+ List.fold_left
+ (fun cstrs (_,f1,f2) ->
+ match row_field_repr f1, row_field_repr f2 with
+ (Rpresent None|Reither(true,_,_)), Rpresent None ->
+ cstrs
+ | Rpresent(Some t1), Rpresent(Some t2) ->
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
+ | Reither(false, t1::_, _), Rpresent(Some t2) ->
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
+ | Rabsent, _ -> cstrs
+ | _ -> raise Exit)
+ cstrs pairs
+ | Tunivar _, Tunivar _
+ when row1_closed = row2_closed && r1 = [] && r2 = [] ->
+ let cstrs =
+ subtype_rec
+ env
+ (Subtype.Diff {got = more1; expected = more2} :: trace)
+ more1 more2
+ cstrs
+ in
+ List.fold_left
+ (fun cstrs (_,f1,f2) ->
+ match row_field_repr f1, row_field_repr f2 with
+ Rpresent None, Rpresent None
+ | Reither(true,[],_), Reither(true,[],_)
+ | Rabsent, Rabsent ->
+ cstrs
+ | Rpresent(Some t1), Rpresent(Some t2)
+ | Reither(false,[t1],_), Reither(false,[t2],_) ->
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
+ | _ -> raise Exit)
+ cstrs pairs
+ | _ ->
+ raise Exit
+
+let subtype env ty1 ty2 =
+ TypePairs.clear subtypes;
+ with_univar_pairs [] (fun () ->
+ (* Build constraint set. *)
+ let cstrs =
+ subtype_rec env [Subtype.Diff {got = ty1; expected = ty2}] ty1 ty2 []
+ in
+ TypePairs.clear subtypes;
+ (* Enforce constraints. *)
+ function () ->
+ List.iter
+ (function (trace0, t1, t2, pairs) ->
+ try unify_pairs env t1 t2 pairs with Unify {trace} ->
+ subtype_error
+ ~env
+ ~trace:trace0
+ ~unification_trace:(List.tl trace))
+ (List.rev cstrs))
+
+ (*******************)
+ (* Miscellaneous *)
+ (*******************)
+
+(* Utility for printing. The resulting type is not used in computation. *)
+let rec unalias_object ty =
+ let level = get_level ty in
+ match get_desc ty with
+ Tfield (s, k, t1, t2) ->
+ newty2 ~level (Tfield (s, k, t1, unalias_object t2))
+ | Tvar _ | Tnil as desc ->
+ newty2 ~level desc
+ | Tunivar _ ->
+ ty
+ | Tconstr _ ->
+ newvar2 level
+ | _ ->
+ assert false
+
+let unalias ty =
+ let level = get_level ty in
+ match get_desc ty with
+ Tvar _ | Tunivar _ ->
+ ty
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ newty2 ~level
+ (Tvariant
+ (create_row ~fields ~name ~fixed ~closed ~more:
+ (newty2 ~level:(get_level more) (get_desc more))))
+ | Tobject (ty, nm) ->
+ newty2 ~level (Tobject (unalias_object ty, nm))
+ | desc ->
+ newty2 ~level desc
+
+(* Return the arity (as for curried functions) of the given type. *)
+let rec arity ty =
+ match get_desc ty with
+ Tarrow(_, _t1, t2, _) -> 1 + arity t2
+ | _ -> 0
+
+(* Check for non-generalizable type variables *)
+let add_nongen_vars_in_schema =
+ let rec loop env ((visited, weak_set) as acc) ty =
+ if TypeSet.mem ty visited
+ then acc
+ else begin
+ let visited = TypeSet.add ty visited in
+ match get_desc ty with
+ | Tvar _ when get_level ty <> generic_level ->
+ visited, TypeSet.add ty weak_set
+ | Tconstr _ ->
+ let (_, unexpanded_candidate) as unexpanded_candidate' =
+ fold_type_expr
+ (loop env)
+ (visited, weak_set)
+ ty
+ in
+ (* Using `==` is okay because `loop` will return the original set
+ when it does not change it. Similarly, `TypeSet.add` will return
+ the original set if the element is already present. *)
+ if unexpanded_candidate == weak_set
+ then (visited, weak_set)
+ else begin
+ match
+ loop env (visited, weak_set)
+ (try_expand_head try_expand_safe env ty)
+ with
+ | exception Cannot_expand -> unexpanded_candidate'
+ | expanded_result -> expanded_result
+ end
+ | Tfield(_, kind, t1, t2) ->
+ let visited, weak_set =
+ match field_kind_repr kind with
+ | Fpublic -> loop env (visited, weak_set) t1
+ | _ -> visited, weak_set
+ in
+ loop env (visited, weak_set) t2
+ | Tvariant row ->
+ let visited, weak_set =
+ fold_row (loop env) (visited, weak_set) row
+ in
+ if not (static_row row)
+ then loop env (visited, weak_set) (row_more row)
+ else (visited, weak_set)
+ | _ ->
+ fold_type_expr (loop env) (visited, weak_set) ty
+ end
+ in
+ fun env acc ty ->
+ let _, result = loop env (TypeSet.empty, acc) ty in
+ result
+
+(* Return all non-generic variables of [ty]. *)
+let nongen_vars_in_schema env ty =
+ let result = add_nongen_vars_in_schema env TypeSet.empty ty in
+ if TypeSet.is_empty result
+ then None
+ else Some result
+
+(* Check that all type variables are generalizable *)
+(* Use Env.empty to prevent expansion of recursively defined object types;
+ cf. typing-poly/poly.ml *)
+let nongen_class_type =
+ let add_nongen_vars_in_schema' ty weak_set =
+ add_nongen_vars_in_schema Env.empty weak_set ty
+ in
+ let add_nongen_vars_in_schema_fold fold m weak_set =
+ let f _key (_,_,ty) weak_set =
+ add_nongen_vars_in_schema Env.empty weak_set ty
+ in
+ fold f m weak_set
+ in
+ let rec nongen_class_type cty weak_set =
+ match cty with
+ | Cty_constr (_, params, _) ->
+ List.fold_left
+ (add_nongen_vars_in_schema Env.empty)
+ weak_set
+ params
+ | Cty_signature sign ->
+ weak_set
+ |> add_nongen_vars_in_schema' sign.csig_self
+ |> add_nongen_vars_in_schema' sign.csig_self_row
+ |> add_nongen_vars_in_schema_fold Meths.fold sign.csig_meths
+ |> add_nongen_vars_in_schema_fold Vars.fold sign.csig_vars
+ | Cty_arrow (_, ty, cty) ->
+ add_nongen_vars_in_schema' ty weak_set
+ |> nongen_class_type cty
+ in
+ nongen_class_type
+
+let nongen_class_declaration cty =
+ List.fold_left
+ (add_nongen_vars_in_schema Env.empty)
+ TypeSet.empty
+ cty.cty_params
+ |> nongen_class_type cty.cty_type
+
+let nongen_vars_in_class_declaration cty =
+ let result = nongen_class_declaration cty in
+ if TypeSet.is_empty result
+ then None
+ else Some result
+
+(* Normalize a type before printing, saving... *)
+(* Cannot use mark_type because deep_occur uses it too *)
+let rec normalize_type_rec mark ty =
+ if try_mark_node mark ty then begin
+ let tm = row_of_type ty in
+ begin if not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm then
+ match get_desc tm with (* PR#7348 *)
+ Tconstr (Path.Pdot(m,i), tl, _abbrev) ->
+ let i' = String.sub i 0 (String.length i - 4) in
+ set_type_desc ty (Tconstr(Path.Pdot(m,i'), tl, ref Mnil))
+ | _ -> assert false
+ else match get_desc ty with
+ | Tvariant row ->
+ let Row {fields = orig_fields; more; name; fixed; closed} =
+ row_repr row in
+ let fields = List.map
+ (fun (l,f) ->
+ l,
+ match row_field_repr f with Reither(b, ty::(_::_ as tyl), m) ->
+ let tyl' =
+ List.fold_left
+ (fun tyl ty ->
+ if List.exists
+ (fun ty' -> is_equal Env.empty false [ty] [ty'])
+ tyl
+ then tyl
+ else ty::tyl)
+ [ty] tyl
+ in
+ if List.length tyl' <= List.length tyl then
+ rf_either (List.rev tyl') ~use_ext_of:f ~no_arg:b ~matched:m
+ else f
+ | _ -> f)
+ orig_fields in
+ let fields =
+ List.sort (fun (p,_) (q,_) -> compare p q)
+ (List.filter (fun (_,fi) -> row_field_repr fi <> Rabsent) fields) in
+ set_type_desc ty (Tvariant
+ (create_row ~fields ~more ~name ~fixed ~closed))
+ | Tobject (fi, nm) ->
+ begin match !nm with
+ | None -> ()
+ | Some (n, v :: l) ->
+ if deep_occur ty (newgenty (Ttuple l)) then
+ (* The abbreviation may be hiding something, so remove it *)
+ set_name nm None
+ else
+ begin match get_desc v with
+ | Tvar _ | Tunivar _ -> ()
+ | Tnil -> set_type_desc ty (Tconstr (n, l, ref Mnil))
+ | _ -> set_name nm None
+ end
+ | _ ->
+ fatal_error "Ctype.normalize_type_rec"
+ end;
+ let level = get_level fi in
+ if level < lowest_level then () else
+ let fields, row = flatten_fields fi in
+ let fi' = build_fields level fields row in
+ set_type_desc fi (get_desc fi')
+ | _ -> ()
+ end;
+ iter_type_expr (normalize_type_rec mark) ty;
+ end
+
+let normalize_type ty =
+ with_type_mark (fun mark -> normalize_type_rec mark ty)
+
+
+ (*************************)
+ (* Remove dependencies *)
+ (*************************)
+
+
+(*
+ Variables are left unchanged. Other type nodes are duplicated, with
+ levels set to generic level.
+ We cannot use Tsubst here, because unification may be called by
+ expand_abbrev.
+*)
+
+let nondep_hash = TypeHash.create 47
+let nondep_variants = TypeHash.create 17
+let clear_hash () =
+ TypeHash.clear nondep_hash; TypeHash.clear nondep_variants
+
+let rec nondep_type_rec ?(expand_private=false) env ids ty =
+ let try_expand env t =
+ if expand_private then try_expand_safe_opt env t
+ else try_expand_safe env t
+ in
+ match get_desc ty with
+ Tvar _ | Tunivar _ -> ty
+ | _ -> try TypeHash.find nondep_hash ty
+ with Not_found ->
+ let ty' = newgenstub ~scope:(get_scope ty) in
+ TypeHash.add nondep_hash ty ty';
+ match
+ match get_desc ty with
+ | Tconstr(p, tl, _abbrev) as desc ->
+ begin try
+ (* First, try keeping the same type constructor p *)
+ match Path.find_free_opt ids p with
+ | Some id ->
+ raise (Nondep_cannot_erase id)
+ | None ->
+ Tconstr(p, List.map (nondep_type_rec env ids) tl, ref Mnil)
+ with (Nondep_cannot_erase _) as exn ->
+ (* If that doesn't work, try expanding abbrevs *)
+ try Tlink (nondep_type_rec ~expand_private env ids
+ (try_expand env (newty2 ~level:(get_level ty) desc)))
+ (*
+ The [Tlink] is important. The expanded type may be a
+ variable, or may not be completely copied yet
+ (recursive type), so one cannot just take its
+ description.
+ *)
+ with Cannot_expand -> raise exn
+ end
+ | Tpackage(p, fl) when Path.exists_free ids p ->
+ let p' = normalize_package_path env p in
+ begin match Path.find_free_opt ids p' with
+ | Some id -> raise (Nondep_cannot_erase id)
+ | None ->
+ let nondep_field_rec (n, ty) = (n, nondep_type_rec env ids ty) in
+ Tpackage (p', List.map nondep_field_rec fl)
+ end
+ | Tobject (t1, name) ->
+ Tobject (nondep_type_rec env ids t1,
+ ref (match !name with
+ None -> None
+ | Some (p, tl) ->
+ if Path.exists_free ids p then None
+ else Some (p, List.map (nondep_type_rec env ids) tl)))
+ | Tvariant row ->
+ let more = row_more row in
+ (* We must keep sharing according to the row variable *)
+ begin try
+ let ty2 = TypeHash.find nondep_variants more in
+ (* This variant type has been already copied *)
+ TypeHash.add nondep_hash ty ty2;
+ Tlink ty2
+ with Not_found ->
+ (* Register new type first for recursion *)
+ TypeHash.add nondep_variants more ty';
+ let static = static_row row in
+ let more' =
+ if static then newgenty Tnil else nondep_type_rec env ids more
+ in
+ (* Return a new copy *)
+ let row =
+ copy_row (nondep_type_rec env ids) true row true more' in
+ match row_name row with
+ Some (p, _tl) when Path.exists_free ids p ->
+ Tvariant (set_row_name row None)
+ | _ -> Tvariant row
+ end
+ | desc -> copy_type_desc (nondep_type_rec env ids) desc
+ with
+ | desc ->
+ Transient_expr.set_stub_desc ty' desc;
+ ty'
+ | exception e ->
+ TypeHash.remove nondep_hash ty;
+ raise e
+
+let nondep_type env id ty =
+ try
+ let ty' = nondep_type_rec env id ty in
+ clear_hash ();
+ ty'
+ with Nondep_cannot_erase _ as exn ->
+ clear_hash ();
+ raise exn
+
+let () = nondep_type' := nondep_type
+
+(* Preserve sharing inside type declarations. *)
+let nondep_type_decl env mid is_covariant decl =
+ try
+ let params = List.map (nondep_type_rec env mid) decl.type_params in
+ let tk =
+ try map_kind (nondep_type_rec env mid) decl.type_kind
+ with Nondep_cannot_erase _ when is_covariant -> Type_abstract Definition
+ and tm, priv =
+ match decl.type_manifest with
+ | None -> None, decl.type_private
+ | Some ty ->
+ try Some (nondep_type_rec env mid ty), decl.type_private
+ with Nondep_cannot_erase _ when is_covariant ->
+ clear_hash ();
+ try Some (nondep_type_rec ~expand_private:true env mid ty),
+ Private
+ with Nondep_cannot_erase _ ->
+ None, decl.type_private
+ in
+ clear_hash ();
+ let priv =
+ match tm with
+ | Some ty when Btype.has_constr_row ty -> Private
+ | _ -> priv
+ in
+ { type_params = params;
+ type_arity = decl.type_arity;
+ type_kind = tk;
+ type_manifest = tm;
+ type_private = priv;
+ type_variance = decl.type_variance;
+ type_separability = decl.type_separability;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = decl.type_loc;
+ type_attributes = decl.type_attributes;
+ type_immediate = decl.type_immediate;
+ type_unboxed_default = decl.type_unboxed_default;
+ type_uid = decl.type_uid;
+ }
+ with Nondep_cannot_erase _ as exn ->
+ clear_hash ();
+ raise exn
+
+(* Preserve sharing inside extension constructors. *)
+let nondep_extension_constructor env ids ext =
+ try
+ let type_path, type_params =
+ match Path.find_free_opt ids ext.ext_type_path with
+ | Some id ->
+ begin
+ let ty =
+ newgenty (Tconstr(ext.ext_type_path, ext.ext_type_params, ref Mnil))
+ in
+ let ty' = nondep_type_rec env ids ty in
+ match get_desc ty' with
+ Tconstr(p, tl, _) -> p, tl
+ | _ -> raise (Nondep_cannot_erase id)
+ end
+ | None ->
+ let type_params =
+ List.map (nondep_type_rec env ids) ext.ext_type_params
+ in
+ ext.ext_type_path, type_params
+ in
+ let args = map_type_expr_cstr_args (nondep_type_rec env ids) ext.ext_args in
+ let ret_type = Option.map (nondep_type_rec env ids) ext.ext_ret_type in
+ clear_hash ();
+ { ext_type_path = type_path;
+ ext_type_params = type_params;
+ ext_args = args;
+ ext_ret_type = ret_type;
+ ext_private = ext.ext_private;
+ ext_attributes = ext.ext_attributes;
+ ext_loc = ext.ext_loc;
+ ext_uid = ext.ext_uid;
+ }
+ with Nondep_cannot_erase _ as exn ->
+ clear_hash ();
+ raise exn
+
+
+(* Preserve sharing inside class types. *)
+let nondep_class_signature env id sign =
+ { csig_self = nondep_type_rec env id sign.csig_self;
+ csig_self_row = nondep_type_rec env id sign.csig_self_row;
+ csig_vars =
+ Vars.map (function (m, v, t) -> (m, v, nondep_type_rec env id t))
+ sign.csig_vars;
+ csig_meths =
+ Meths.map (function (p, v, t) -> (p, v, nondep_type_rec env id t))
+ sign.csig_meths }
+
+let rec nondep_class_type env ids =
+ function
+ Cty_constr (p, _, cty) when Path.exists_free ids p ->
+ nondep_class_type env ids cty
+ | Cty_constr (p, tyl, cty) ->
+ Cty_constr (p, List.map (nondep_type_rec env ids) tyl,
+ nondep_class_type env ids cty)
+ | Cty_signature sign ->
+ Cty_signature (nondep_class_signature env ids sign)
+ | Cty_arrow (l, ty, cty) ->
+ Cty_arrow (l, nondep_type_rec env ids ty, nondep_class_type env ids cty)
+
+let nondep_class_declaration env ids decl =
+ assert (not (Path.exists_free ids decl.cty_path));
+ let decl =
+ { cty_params = List.map (nondep_type_rec env ids) decl.cty_params;
+ cty_variance = decl.cty_variance;
+ cty_type = nondep_class_type env ids decl.cty_type;
+ cty_path = decl.cty_path;
+ cty_new =
+ begin match decl.cty_new with
+ None -> None
+ | Some ty -> Some (nondep_type_rec env ids ty)
+ end;
+ cty_loc = decl.cty_loc;
+ cty_attributes = decl.cty_attributes;
+ cty_uid = decl.cty_uid;
+ }
+ in
+ clear_hash ();
+ decl
+
+let nondep_cltype_declaration env ids decl =
+ assert (not (Path.exists_free ids decl.clty_path));
+ let decl =
+ { clty_params = List.map (nondep_type_rec env ids) decl.clty_params;
+ clty_variance = decl.clty_variance;
+ clty_type = nondep_class_type env ids decl.clty_type;
+ clty_path = decl.clty_path;
+ clty_hash_type = nondep_type_decl env ids false decl.clty_hash_type ;
+ clty_loc = decl.clty_loc;
+ clty_attributes = decl.clty_attributes;
+ clty_uid = decl.clty_uid;
+ }
+ in
+ clear_hash ();
+ decl
+
+(* collapse conjunctive types in class parameters *)
+let rec collapse_conj env visited ty =
+ let id = get_id ty in
+ if List.memq id visited then () else
+ let visited = id :: visited in
+ match get_desc ty with
+ Tvariant row ->
+ List.iter
+ (fun (_l,fi) ->
+ match row_field_repr fi with
+ Reither (_c, t1::(_::_ as tl), _m) ->
+ List.iter (unify env t1) tl
+ | _ ->
+ ())
+ (row_fields row);
+ iter_row (collapse_conj env visited) row
+ | _ ->
+ iter_type_expr (collapse_conj env visited) ty
+
+let collapse_conj_params env params =
+ List.iter (collapse_conj env []) params
+
+let same_constr env t1 t2 =
+ let t1 = expand_head env t1 in
+ let t2 = expand_head env t2 in
+ match get_desc t1, get_desc t2 with
+ | Tconstr (p1, _, _), Tconstr (p2, _, _) -> Path.same p1 p2
+ | _ -> false
+
+let () =
+ Env.same_constr := same_constr
+
+let immediacy env typ =
+ match get_desc typ with
+ | Tconstr(p, _args, _abbrev) ->
+ begin try
+ let type_decl = Env.find_type p env in
+ type_decl.type_immediate
+ with Not_found -> Type_immediacy.Unknown
+ (* This can happen due to e.g. missing -I options,
+ causing some .cmi files to be unavailable.
+ Maybe we should emit a warning. *)
+ end
+ | Tvariant row ->
+ (* if all labels are devoid of arguments, not a pointer *)
+ if
+ not (row_closed row)
+ || List.exists
+ (fun (_, f) -> match row_field_repr f with
+ | Rpresent (Some _) | Reither (false, _, _) -> true
+ | _ -> false)
+ (row_fields row)
+ then
+ Type_immediacy.Unknown
+ else
+ Type_immediacy.Always
+ | _ -> Type_immediacy.Unknown
diff --git a/upstream/ocaml_503/typing/ctype.mli b/upstream/ocaml_503/typing/ctype.mli
new file mode 100644
index 0000000000..169969321a
--- /dev/null
+++ b/upstream/ocaml_503/typing/ctype.mli
@@ -0,0 +1,480 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Operations on core types *)
+
+open Asttypes
+open Types
+
+exception Unify of Errortrace.unification_error
+exception Equality of Errortrace.equality_error
+exception Moregen of Errortrace.moregen_error
+exception Subtype of Errortrace.Subtype.error
+
+exception Escape of type_expr Errortrace.escape
+
+exception Tags of label * label
+exception Cannot_expand
+exception Cannot_apply
+exception Matches_failure of Env.t * Errortrace.unification_error
+ (* Raised from [matches], hence the odd name *)
+exception Incompatible
+ (* Raised from [mcomp] *)
+
+(* All the following wrapper functions revert to the original level,
+ even in case of exception. *)
+val with_local_level_generalize:
+ ?before_generalize:('a -> unit) -> (unit -> 'a) -> 'a
+val with_local_level_generalize_if:
+ bool -> ?before_generalize:('a -> unit) -> (unit -> 'a) -> 'a
+val with_local_level_generalize_structure: (unit -> 'a) -> 'a
+val with_local_level_generalize_structure_if: bool -> (unit -> 'a) -> 'a
+val with_local_level_generalize_structure_if_principal: (unit -> 'a) -> 'a
+val with_local_level_generalize_for_class: (unit -> 'a) -> 'a
+
+val with_local_level: ?post:('a -> unit) -> (unit -> 'a) -> 'a
+ (* [with_local_level (fun () -> cmd) ~post] evaluates [cmd] at a
+ raised level.
+ If given, [post] is applied to the result, at the original level.
+ It is expected to contain only level related post-processing. *)
+val with_local_level_if: bool -> (unit -> 'a) -> post:('a -> unit) -> 'a
+ (* Same as [with_local_level], but only raise the level conditionally.
+ [post] also is only called if the level is raised. *)
+val with_local_level_iter: (unit -> 'a * 'b list) -> post:('b -> unit) -> 'a
+ (* Variant of [with_local_level], where [post] is iterated on the
+ returned list. *)
+val with_local_level_iter_if:
+ bool -> (unit -> 'a * 'b list) -> post:('b -> unit) -> 'a
+ (* Conditional variant of [with_local_level_iter] *)
+val with_level: level: int -> (unit -> 'a) -> 'a
+ (* [with_level ~level (fun () -> cmd)] evaluates [cmd] with
+ [current_level] set to [level] *)
+val with_level_if: bool -> level: int -> (unit -> 'a) -> 'a
+ (* Conditional variant of [with_level] *)
+val with_local_level_if_principal: (unit -> 'a) -> post:('a -> unit) -> 'a
+val with_local_level_iter_if_principal:
+ (unit -> 'a * 'b list) -> post:('b -> unit) -> 'a
+ (* Applications of [with_local_level_if] and [with_local_level_iter_if]
+ to [!Clflags.principal] *)
+
+val with_local_level_for_class: ?post:('a -> unit) -> (unit -> 'a) -> 'a
+ (* Variant of [with_local_level], where the current level is raised but
+ the nongen level is not touched *)
+val with_raised_nongen_level: (unit -> 'a) -> 'a
+ (* Variant of [with_local_level],
+ raises the nongen level to the current level *)
+
+val reset_global_level: unit -> unit
+ (* Reset the global level before typing an expression *)
+val increase_global_level: unit -> int
+val restore_global_level: int -> unit
+ (* This pair of functions is only used in Typetexp *)
+
+val create_scope : unit -> int
+
+val newty: type_desc -> type_expr
+val new_scoped_ty: int -> type_desc -> type_expr
+val newvar: ?name:string -> unit -> type_expr
+val newvar2: ?name:string -> int -> type_expr
+ (* Return a fresh variable *)
+val new_global_var: ?name:string -> unit -> type_expr
+ (* Return a fresh variable, bound at toplevel
+ (as type variables ['a] in type constraints). *)
+val newobj: type_expr -> type_expr
+val newconstr: Path.t -> type_expr list -> type_expr
+val none: type_expr
+ (* A dummy type expression *)
+
+val object_fields: type_expr -> type_expr
+val flatten_fields:
+ type_expr -> (string * field_kind * type_expr) list * type_expr
+(** Transform a field type into a list of pairs label-type.
+ The fields are sorted.
+
+ Beware of the interaction with GADTs:
+
+ Due to the introduction of object indexes for GADTs, the row variable of
+ an object may now be an expansible type abbreviation.
+ A first consequence is that [flatten_fields] will not completely flatten
+ the object, since the type abbreviation will not be expanded
+ ([flatten_fields] does not receive the current environment).
+ Another consequence is that various functions may be called with the
+ expansion of this type abbreviation, which is a Tfield, e.g. during
+ printing.
+
+ Concrete problems have been fixed, but new bugs may appear in the
+ future. (Test cases were added to typing-gadts/test.ml)
+*)
+
+val associate_fields:
+ (string * field_kind * type_expr) list ->
+ (string * field_kind * type_expr) list ->
+ (string * field_kind * type_expr * field_kind * type_expr) list *
+ (string * field_kind * type_expr) list *
+ (string * field_kind * type_expr) list
+val opened_object: type_expr -> bool
+val set_object_name:
+ Ident.t -> type_expr list -> type_expr -> unit
+val remove_object_name: type_expr -> unit
+val find_cltype_for_path: Env.t -> Path.t -> type_declaration * type_expr
+
+val sort_row_fields: (label * row_field) list -> (label * row_field) list
+val merge_row_fields:
+ (label * row_field) list -> (label * row_field) list ->
+ (label * row_field) list * (label * row_field) list *
+ (label * row_field * row_field) list
+val filter_row_fields:
+ bool -> (label * row_field) list -> (label * row_field) list
+
+val lower_contravariant: Env.t -> type_expr -> unit
+ (* Lower level of type variables inside contravariant branches;
+ to be used before generalize for expansive expressions *)
+val lower_variables_only: Env.t -> int -> type_expr -> unit
+ (* Lower all variables to the given level *)
+val enforce_current_level: Env.t -> type_expr -> unit
+ (* Lower whole type to !current_level *)
+val generalize_class_signature_spine: class_signature -> unit
+ (* Special function to generalize methods during inference *)
+val limited_generalize: type_expr -> inside:type_expr -> unit
+ (* Only generalize some part of the type
+ Make the remaining of the type non-generalizable *)
+val limited_generalize_class_type: type_expr -> inside:class_type -> unit
+ (* Same, but for class types *)
+
+val duplicate_type: type_expr -> type_expr
+ (* Returns a copy with non-variable nodes at generic level *)
+val fully_generic: type_expr -> bool
+
+val check_scope_escape : Env.t -> int -> type_expr -> unit
+ (* [check_scope_escape env lvl ty] ensures that [ty] could be raised
+ to the level [lvl] without any scope escape.
+ Raises [Escape] otherwise *)
+
+val instance: ?partial:bool -> type_expr -> type_expr
+ (* Take an instance of a type scheme *)
+ (* partial=None -> normal
+ partial=false -> newvar() for non generic subterms
+ partial=true -> newty2 ty.level Tvar for non generic subterms *)
+val generic_instance: type_expr -> type_expr
+ (* Same as instance, but new nodes at generic_level *)
+val instance_list: type_expr list -> type_expr list
+ (* Take an instance of a list of type schemes *)
+val new_local_type:
+ ?loc:Location.t ->
+ ?manifest_and_scope:(type_expr * int) ->
+ type_origin -> type_declaration
+
+module Pattern_env : sig
+ type t = private
+ { mutable env : Env.t;
+ equations_scope : int;
+ (* scope for local type declarations *)
+ allow_recursive_equations : bool;
+ (* true iff checking counter examples *)
+ }
+ val make: Env.t -> equations_scope:int -> allow_recursive_equations:bool -> t
+ val copy: ?equations_scope:int -> t -> t
+ val set_env: t -> Env.t -> unit
+end
+
+type existential_treatment =
+ | Keep_existentials_flexible
+ | Make_existentials_abstract of Pattern_env.t
+
+val instance_constructor: existential_treatment ->
+ constructor_description -> type_expr list * type_expr * type_expr list
+ (* Same, for a constructor. Also returns existentials. *)
+val instance_parameterized_type:
+ ?keep_names:bool ->
+ type_expr list -> type_expr -> type_expr list * type_expr
+val instance_declaration: type_declaration -> type_declaration
+val generic_instance_declaration: type_declaration -> type_declaration
+ (* Same as instance_declaration, but new nodes at generic_level *)
+val instance_class:
+ type_expr list -> class_type -> type_expr list * class_type
+
+val instance_poly:
+ ?keep_names:bool -> fixed:bool ->
+ type_expr list -> type_expr -> type_expr list * type_expr
+ (* Take an instance of a type scheme containing free univars *)
+val polyfy: Env.t -> type_expr -> type_expr list -> type_expr * bool
+val instance_label:
+ fixed:bool ->
+ label_description -> type_expr list * type_expr * type_expr
+ (* Same, for a label *)
+val apply:
+ ?use_current_level:bool ->
+ Env.t -> type_expr list -> type_expr -> type_expr list -> type_expr
+ (* [apply [p1...pN] t [a1...aN]] applies the type function
+ [fun p1 ... pN -> t] to the arguments [a1...aN] and returns the
+ resulting instance of [t].
+ New nodes default to generic level except if [use_current_level] is
+ set to true.
+ Exception [Cannot_apply] is raised in case of failure. *)
+
+val try_expand_once_opt: Env.t -> type_expr -> type_expr
+val try_expand_safe_opt: Env.t -> type_expr -> type_expr
+
+val expand_head_once: Env.t -> type_expr -> type_expr
+val expand_head: Env.t -> type_expr -> type_expr
+val expand_head_opt: Env.t -> type_expr -> type_expr
+(** The compiler's own version of [expand_head] necessary for type-based
+ optimisations. *)
+
+(** Expansion of types for error traces; lives here instead of in [Errortrace]
+ because the expansion machinery lives here. *)
+
+(** Create an [Errortrace.Diff] by expanding the two types *)
+val expanded_diff :
+ Env.t ->
+ got:type_expr -> expected:type_expr ->
+ (Errortrace.expanded_type, 'variant) Errortrace.elt
+
+(** Create an [Errortrace.Diff] by *duplicating* the two types, so that each
+ one's expansion is identical to itself. Despite the name, does create
+ [Errortrace.expanded_type]s. *)
+val unexpanded_diff :
+ got:type_expr -> expected:type_expr ->
+ (Errortrace.expanded_type, 'variant) Errortrace.elt
+
+val full_expand: may_forget_scope:bool -> Env.t -> type_expr -> type_expr
+
+type typedecl_extraction_result =
+ | Typedecl of Path.t * Path.t * type_declaration
+ (* The original path of the types, and the first concrete
+ type declaration found expanding it. *)
+ | Has_no_typedecl
+ | May_have_typedecl
+
+val extract_concrete_typedecl:
+ Env.t -> type_expr -> typedecl_extraction_result
+
+val get_new_abstract_name : Env.t -> string -> string
+
+val unify: Env.t -> type_expr -> type_expr -> unit
+ (* Unify the two types given. Raise [Unify] if not possible. *)
+val unify_gadt:
+ Pattern_env.t -> type_expr -> type_expr -> Btype.TypePairs.t
+ (* [unify_gadt penv ty1 ty2] unifies [ty1] and [ty2] in
+ [Pattern] mode, possible adding local constraints to the
+ environment in [penv]. Raises [Unify] if not possible.
+ Returns the pairs of types that have been equated.
+ Type variables in [ty1] are assumed to be non-leaking (safely
+ reifiable), moreover if [penv.allow_recursive_equations = true]
+ the same assumption is made for [ty2]. *)
+val unify_var: Env.t -> type_expr -> type_expr -> unit
+ (* Same as [unify], but allow free univars when first type
+ is a variable. *)
+val filter_arrow: Env.t -> type_expr -> arg_label -> type_expr * type_expr
+ (* A special case of unification with [l:'a -> 'b]. Raises
+ [Filter_arrow_failed] instead of [Unify]. *)
+val filter_method: Env.t -> string -> type_expr -> type_expr
+ (* A special case of unification (with {m : 'a; 'b}). Raises
+ [Filter_method_failed] instead of [Unify]. *)
+val occur_in: Env.t -> type_expr -> type_expr -> bool
+val deep_occur: type_expr -> type_expr -> bool
+val moregeneral: Env.t -> bool -> type_expr -> type_expr -> unit
+ (* Check if the first type scheme is more general than the second. *)
+val is_moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
+val rigidify: type_expr -> type_expr list
+ (* "Rigidify" a type and return its type variable *)
+val all_distinct_vars: Env.t -> type_expr list -> bool
+ (* Check those types are all distinct type variables *)
+val matches: expand_error_trace:bool -> Env.t -> type_expr -> type_expr -> unit
+ (* Same as [moregeneral false], implemented using the two above
+ functions and backtracking. Ignore levels. The [expand_error_trace]
+ flag controls whether the error raised performs expansion; this
+ should almost always be [true]. *)
+val does_match: Env.t -> type_expr -> type_expr -> bool
+ (* Same as [matches], but returns a [bool] *)
+
+val reify_univars : Env.t -> Types.type_expr -> Types.type_expr
+ (* Replaces all the variables of a type by a univar. *)
+
+(* Exceptions for special cases of unify *)
+
+type filter_arrow_failure =
+ | Unification_error of Errortrace.unification_error
+ | Label_mismatch of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ }
+ | Not_a_function
+
+exception Filter_arrow_failed of filter_arrow_failure
+
+type filter_method_failure =
+ | Unification_error of Errortrace.unification_error
+ | Not_a_method
+ | Not_an_object of type_expr
+
+exception Filter_method_failed of filter_method_failure
+
+type class_match_failure =
+ CM_Virtual_class
+ | CM_Parameter_arity_mismatch of int * int
+ | CM_Type_parameter_mismatch of int * Env.t * Errortrace.equality_error
+ | CM_Class_type_mismatch of Env.t * class_type * class_type
+ | CM_Parameter_mismatch of int * Env.t * Errortrace.moregen_error
+ | CM_Val_type_mismatch of string * Env.t * Errortrace.comparison_error
+ | CM_Meth_type_mismatch of string * Env.t * Errortrace.comparison_error
+ | CM_Non_mutable_value of string
+ | CM_Non_concrete_value of string
+ | CM_Missing_value of string
+ | CM_Missing_method of string
+ | CM_Hide_public of string
+ | CM_Hide_virtual of string * string
+ | CM_Public_method of string
+ | CM_Private_method of string
+ | CM_Virtual_method of string
+
+val match_class_types:
+ ?trace:bool -> Env.t -> class_type -> class_type -> class_match_failure list
+ (* Check if the first class type is more general than the second. *)
+val equal: Env.t -> bool -> type_expr list -> type_expr list -> unit
+ (* [equal env [x1...xn] tau [y1...yn] sigma]
+ checks whether the parameterized types
+ [/\x1.../\xn.tau] and [/\y1.../\yn.sigma] are equivalent. *)
+val is_equal : Env.t -> bool -> type_expr list -> type_expr list -> bool
+val equal_private :
+ Env.t -> type_expr list -> type_expr ->
+ type_expr list -> type_expr -> unit
+(* [equal_private env t1 params1 t2 params2] checks that [t1::params1]
+ equals [t2::params2] but it is allowed to expand [t1] if it is a
+ private abbreviations. *)
+
+val match_class_declarations:
+ Env.t -> type_expr list -> class_type -> type_expr list ->
+ class_type -> class_match_failure list
+ (* Check if the first class type is more general than the second. *)
+
+val enlarge_type: Env.t -> type_expr -> type_expr * bool
+ (* Make a type larger, flag is true if some pruning had to be done *)
+val subtype: Env.t -> type_expr -> type_expr -> unit -> unit
+ (* [subtype env t1 t2] checks that [t1] is a subtype of [t2].
+ It accumulates the constraints the type variables must
+ enforce and returns a function that enforces this
+ constraints. *)
+
+(* Operations on class signatures *)
+
+val new_class_signature : unit -> class_signature
+val add_dummy_method : Env.t -> scope:int -> class_signature -> unit
+
+type add_method_failure =
+ | Unexpected_method
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_method_failed of add_method_failure
+
+val add_method : Env.t ->
+ label -> private_flag -> virtual_flag -> type_expr -> class_signature -> unit
+
+type add_instance_variable_failure =
+ | Mutability_mismatch of mutable_flag
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_instance_variable_failed of add_instance_variable_failure
+
+val add_instance_variable : strict:bool -> Env.t ->
+ label -> mutable_flag -> virtual_flag -> type_expr -> class_signature -> unit
+
+type inherit_class_signature_failure =
+ | Self_type_mismatch of Errortrace.unification_error
+ | Method of label * add_method_failure
+ | Instance_variable of label * add_instance_variable_failure
+
+exception Inherit_class_signature_failed of inherit_class_signature_failure
+
+val inherit_class_signature : strict:bool -> Env.t ->
+ class_signature -> class_signature -> unit
+
+val update_class_signature :
+ Env.t -> class_signature -> label list * label list
+
+val hide_private_methods : Env.t -> class_signature -> unit
+
+val close_class_signature : Env.t -> class_signature -> bool
+
+exception Nondep_cannot_erase of Ident.t
+
+val nondep_type: Env.t -> Ident.t list -> type_expr -> type_expr
+ (* Return a type equivalent to the given type but without
+ references to any of the given identifiers.
+ Raise [Nondep_cannot_erase id] if no such type exists because [id],
+ in particular, could not be erased. *)
+val nondep_type_decl:
+ Env.t -> Ident.t list -> bool -> type_declaration -> type_declaration
+ (* Same for type declarations. *)
+val nondep_extension_constructor:
+ Env.t -> Ident.t list -> extension_constructor ->
+ extension_constructor
+ (* Same for extension constructor *)
+val nondep_class_declaration:
+ Env.t -> Ident.t list -> class_declaration -> class_declaration
+ (* Same for class declarations. *)
+val nondep_cltype_declaration:
+ Env.t -> Ident.t list -> class_type_declaration -> class_type_declaration
+ (* Same for class type declarations. *)
+(*val correct_abbrev: Env.t -> Path.t -> type_expr list -> type_expr -> unit*)
+val is_contractive: Env.t -> Path.t -> bool
+val normalize_type: type_expr -> unit
+
+val nongen_vars_in_schema: Env.t -> type_expr -> Btype.TypeSet.t option
+ (* Return any non-generic variables in the type scheme *)
+
+val nongen_vars_in_class_declaration:class_declaration -> Btype.TypeSet.t option
+ (* Return any non-generic variables in the class type.
+ Uses the empty environment. *)
+
+type variable_kind = Row_variable | Type_variable
+type closed_class_failure = {
+ free_variable: type_expr * variable_kind;
+ meth: string;
+ meth_ty: type_expr;
+}
+
+val free_variables: ?env:Env.t -> type_expr -> type_expr list
+ (* If env present, then check for incomplete definitions too *)
+val closed_type_expr: ?env:Env.t -> type_expr -> bool
+val closed_type_decl: type_declaration -> type_expr option
+val closed_extension_constructor: extension_constructor -> type_expr option
+val closed_class:
+ type_expr list -> class_signature ->
+ closed_class_failure option
+ (* Check whether all type variables are bound *)
+
+val unalias: type_expr -> type_expr
+
+val arity: type_expr -> int
+ (* Return the arity (as for curried functions) of the given type. *)
+
+val collapse_conj_params: Env.t -> type_expr list -> unit
+ (* Collapse conjunctive types in class parameters *)
+
+val get_current_level: unit -> int
+val wrap_trace_gadt_instances: ?force:bool -> Env.t -> ('a -> 'b) -> 'a -> 'b
+
+val immediacy : Env.t -> type_expr -> Type_immediacy.t
+
+(* Stubs *)
+val package_subtype :
+ (Env.t -> Path.t -> (Longident.t * type_expr) list ->
+ Path.t -> (Longident.t * type_expr) list ->
+ (unit,Errortrace.first_class_module) Result.t) ref
+
+(* Raises [Incompatible] *)
+val mcomp : Env.t -> type_expr -> type_expr -> unit
diff --git a/upstream/ocaml_503/typing/datarepr.ml b/upstream/ocaml_503/typing/datarepr.ml
new file mode 100644
index 0000000000..5228031155
--- /dev/null
+++ b/upstream/ocaml_503/typing/datarepr.ml
@@ -0,0 +1,239 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Compute constructor and label descriptions from type declarations,
+ determining their representation. *)
+
+open Asttypes
+open Types
+open Btype
+
+(* Simplified version of Ctype.free_vars *)
+let free_vars ?(param=false) ty =
+ let ret = ref TypeSet.empty in
+ with_type_mark begin fun mark ->
+ let rec loop ty =
+ if try_mark_node mark ty then
+ match get_desc ty with
+ | Tvar _ ->
+ ret := TypeSet.add ty !ret
+ | Tvariant row ->
+ iter_row loop row;
+ if not (static_row row) then begin
+ match get_desc (row_more row) with
+ | Tvar _ when param -> ret := TypeSet.add ty !ret
+ | _ -> loop (row_more row)
+ end
+ (* XXX: What about Tobject ? *)
+ | _ ->
+ iter_type_expr loop ty
+ in
+ loop ty
+ end;
+ !ret
+
+let newgenconstr path tyl = newgenty (Tconstr (path, tyl, ref Mnil))
+
+let constructor_existentials cd_args cd_res =
+ let tyl =
+ match cd_args with
+ | Cstr_tuple l -> l
+ | Cstr_record l -> List.map (fun l -> l.ld_type) l
+ in
+ let existentials =
+ match cd_res with
+ | None -> []
+ | Some type_ret ->
+ let arg_vars_set = free_vars (newgenty (Ttuple tyl)) in
+ let res_vars = free_vars type_ret in
+ TypeSet.elements (TypeSet.diff arg_vars_set res_vars)
+ in
+ (tyl, existentials)
+
+let constructor_args ~current_unit priv cd_args cd_res path rep =
+ let tyl, existentials = constructor_existentials cd_args cd_res in
+ match cd_args with
+ | Cstr_tuple l -> existentials, l, None
+ | Cstr_record lbls ->
+ let arg_vars_set = free_vars ~param:true (newgenty (Ttuple tyl)) in
+ let type_params = TypeSet.elements arg_vars_set in
+ let arity = List.length type_params in
+ let tdecl =
+ {
+ type_params;
+ type_arity = arity;
+ type_kind = Type_record (lbls, rep);
+ type_private = priv;
+ type_manifest = None;
+ type_variance = Variance.unknown_signature ~injective:true ~arity;
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = Location.none;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.mk ~current_unit;
+ }
+ in
+ existentials,
+ [ newgenconstr path type_params ],
+ Some tdecl
+
+let constructor_descrs ~current_unit ty_path decl cstrs rep =
+ let ty_res = newgenconstr ty_path decl.type_params in
+ let num_consts = ref 0 and num_nonconsts = ref 0 in
+ List.iter
+ (fun {cd_args; _} ->
+ if cd_args = Cstr_tuple [] then incr num_consts else incr num_nonconsts)
+ cstrs;
+ let rec describe_constructors idx_const idx_nonconst = function
+ [] -> []
+ | {cd_id; cd_args; cd_res; cd_loc; cd_attributes; cd_uid} :: rem ->
+ let ty_res =
+ match cd_res with
+ | Some ty_res' -> ty_res'
+ | None -> ty_res
+ in
+ let (tag, descr_rem) =
+ match cd_args, rep with
+ | _, Variant_unboxed ->
+ assert (rem = []);
+ (Cstr_unboxed, [])
+ | Cstr_tuple [], Variant_regular ->
+ (Cstr_constant idx_const,
+ describe_constructors (idx_const+1) idx_nonconst rem)
+ | _, Variant_regular ->
+ (Cstr_block idx_nonconst,
+ describe_constructors idx_const (idx_nonconst+1) rem) in
+ let cstr_name = Ident.name cd_id in
+ let existentials, cstr_args, cstr_inlined =
+ let representation =
+ match rep with
+ | Variant_unboxed -> Record_unboxed true
+ | Variant_regular -> Record_inlined idx_nonconst
+ in
+ constructor_args ~current_unit decl.type_private cd_args cd_res
+ Path.(Pextra_ty (ty_path, Pcstr_ty cstr_name)) representation
+ in
+ let cstr =
+ { cstr_name;
+ cstr_res = ty_res;
+ cstr_existentials = existentials;
+ cstr_args;
+ cstr_arity = List.length cstr_args;
+ cstr_tag = tag;
+ cstr_consts = !num_consts;
+ cstr_nonconsts = !num_nonconsts;
+ cstr_private = decl.type_private;
+ cstr_generalized = cd_res <> None;
+ cstr_loc = cd_loc;
+ cstr_attributes = cd_attributes;
+ cstr_inlined;
+ cstr_uid = cd_uid;
+ } in
+ (cd_id, cstr) :: descr_rem in
+ describe_constructors 0 0 cstrs
+
+let extension_descr ~current_unit path_ext ext =
+ let ty_res =
+ match ext.ext_ret_type with
+ Some type_ret -> type_ret
+ | None -> newgenconstr ext.ext_type_path ext.ext_type_params
+ in
+ let existentials, cstr_args, cstr_inlined =
+ constructor_args ~current_unit ext.ext_private ext.ext_args ext.ext_ret_type
+ Path.(Pextra_ty (path_ext, Pext_ty)) (Record_extension path_ext)
+ in
+ { cstr_name = Path.last path_ext;
+ cstr_res = ty_res;
+ cstr_existentials = existentials;
+ cstr_args;
+ cstr_arity = List.length cstr_args;
+ cstr_tag = Cstr_extension(path_ext, cstr_args = []);
+ cstr_consts = -1;
+ cstr_nonconsts = -1;
+ cstr_private = ext.ext_private;
+ cstr_generalized = ext.ext_ret_type <> None;
+ cstr_loc = ext.ext_loc;
+ cstr_attributes = ext.ext_attributes;
+ cstr_inlined;
+ cstr_uid = ext.ext_uid;
+ }
+
+let none =
+ create_expr (Ttuple []) ~level:(-1) ~scope:Btype.generic_level ~id:(-1)
+ (* Clearly ill-formed type *)
+
+let dummy_label =
+ { lbl_name = ""; lbl_res = none; lbl_arg = none; lbl_mut = Immutable;
+ lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular;
+ lbl_private = Public;
+ lbl_loc = Location.none;
+ lbl_attributes = [];
+ lbl_uid = Uid.internal_not_actually_unique;
+ }
+
+let label_descrs ty_res lbls repres priv =
+ let all_labels = Array.make (List.length lbls) dummy_label in
+ let rec describe_labels num = function
+ [] -> []
+ | l :: rest ->
+ let lbl =
+ { lbl_name = Ident.name l.ld_id;
+ lbl_res = ty_res;
+ lbl_arg = l.ld_type;
+ lbl_mut = l.ld_mutable;
+ lbl_pos = num;
+ lbl_all = all_labels;
+ lbl_repres = repres;
+ lbl_private = priv;
+ lbl_loc = l.ld_loc;
+ lbl_attributes = l.ld_attributes;
+ lbl_uid = l.ld_uid;
+ } in
+ all_labels.(num) <- lbl;
+ (l.ld_id, lbl) :: describe_labels (num+1) rest in
+ describe_labels 0 lbls
+
+exception Constr_not_found
+
+let rec find_constr tag num_const num_nonconst = function
+ [] ->
+ raise Constr_not_found
+ | {cd_args = Cstr_tuple []; _} as c :: rem ->
+ if tag = Cstr_constant num_const
+ then c
+ else find_constr tag (num_const + 1) num_nonconst rem
+ | c :: rem ->
+ if tag = Cstr_block num_nonconst || tag = Cstr_unboxed
+ then c
+ else find_constr tag num_const (num_nonconst + 1) rem
+
+let find_constr_by_tag tag cstrlist =
+ find_constr tag 0 0 cstrlist
+
+let constructors_of_type ~current_unit ty_path decl =
+ match decl.type_kind with
+ | Type_variant (cstrs,rep) ->
+ constructor_descrs ~current_unit ty_path decl cstrs rep
+ | Type_record _ | Type_abstract _ | Type_open -> []
+
+let labels_of_type ty_path decl =
+ match decl.type_kind with
+ | Type_record(labels, rep) ->
+ label_descrs (newgenconstr ty_path decl.type_params)
+ labels rep decl.type_private
+ | Type_variant _ | Type_abstract _ | Type_open -> []
diff --git a/upstream/ocaml_503/typing/datarepr.mli b/upstream/ocaml_503/typing/datarepr.mli
new file mode 100644
index 0000000000..1ccb918e59
--- /dev/null
+++ b/upstream/ocaml_503/typing/datarepr.mli
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Compute constructor and label descriptions from type declarations,
+ determining their representation. *)
+
+open Types
+
+val extension_descr:
+ current_unit:(Unit_info.t option) -> Path.t -> extension_constructor ->
+ constructor_description
+
+val labels_of_type:
+ Path.t -> type_declaration ->
+ (Ident.t * label_description) list
+val constructors_of_type:
+ current_unit:(Unit_info.t option) -> Path.t -> type_declaration ->
+ (Ident.t * constructor_description) list
+
+
+exception Constr_not_found
+
+val find_constr_by_tag:
+ constructor_tag -> constructor_declaration list ->
+ constructor_declaration
+
+val constructor_existentials :
+ constructor_arguments -> type_expr option -> type_expr list * type_expr list
+(** Takes [cd_args] and [cd_res] from a [constructor_declaration] and
+ returns:
+ - the types of the constructor's arguments
+ - the existential variables introduced by the constructor
+ *)
diff --git a/upstream/ocaml_503/typing/env.ml b/upstream/ocaml_503/typing/env.ml
new file mode 100644
index 0000000000..07f7398ab7
--- /dev/null
+++ b/upstream/ocaml_503/typing/env.ml
@@ -0,0 +1,3726 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Environment handling *)
+
+open Cmi_format
+open Misc
+open Asttypes
+open Longident
+open Path
+open Types
+
+open Local_store
+
+module String = Misc.Stdlib.String
+
+let add_delayed_check_forward = ref (fun _ -> assert false)
+
+type 'a usage_tbl = ('a -> unit) Types.Uid.Tbl.t
+(** This table is used to track usage of value declarations.
+ A declaration is identified by its uid.
+ The callback attached to a declaration is called whenever the value (or
+ type, or ...) is used explicitly (lookup_value, ...) or implicitly
+ (inclusion test between signatures, cf Includemod.value_descriptions, ...).
+*)
+
+let value_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
+let type_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
+let module_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
+
+type constructor_usage = Positive | Pattern | Exported_private | Exported
+type constructor_usages =
+ {
+ mutable cu_positive: bool;
+ mutable cu_pattern: bool;
+ mutable cu_exported_private: bool;
+ }
+let add_constructor_usage cu usage =
+ match usage with
+ | Positive -> cu.cu_positive <- true
+ | Pattern -> cu.cu_pattern <- true
+ | Exported_private -> cu.cu_exported_private <- true
+ | Exported ->
+ cu.cu_positive <- true;
+ cu.cu_pattern <- true;
+ cu.cu_exported_private <- true
+
+let constructor_usages () =
+ {cu_positive = false; cu_pattern = false; cu_exported_private = false}
+
+let constructor_usage_complaint ~rebind priv cu
+ : Warnings.constructor_usage_warning option =
+ match priv, rebind with
+ | Asttypes.Private, _ | _, true ->
+ if cu.cu_positive || cu.cu_pattern || cu.cu_exported_private then None
+ else Some Unused
+ | Asttypes.Public, false -> begin
+ match cu.cu_positive, cu.cu_pattern, cu.cu_exported_private with
+ | true, _, _ -> None
+ | false, false, false -> Some Unused
+ | false, true, _ -> Some Not_constructed
+ | false, false, true -> Some Only_exported_private
+ end
+
+let used_constructors : constructor_usage usage_tbl ref =
+ s_table Types.Uid.Tbl.create 16
+
+type label_usage =
+ Projection | Mutation | Construct | Exported_private | Exported
+type label_usages =
+ {
+ mutable lu_projection: bool;
+ mutable lu_mutation: bool;
+ mutable lu_construct: bool;
+ }
+let add_label_usage lu usage =
+ match usage with
+ | Projection -> lu.lu_projection <- true;
+ | Mutation -> lu.lu_mutation <- true
+ | Construct -> lu.lu_construct <- true
+ | Exported_private ->
+ lu.lu_projection <- true
+ | Exported ->
+ lu.lu_projection <- true;
+ lu.lu_mutation <- true;
+ lu.lu_construct <- true
+
+let is_mutating_label_usage = function
+ | Mutation -> true
+ | (Projection | Construct | Exported_private | Exported) -> false
+
+let label_usages () =
+ {lu_projection = false; lu_mutation = false; lu_construct = false}
+
+let label_usage_complaint priv mut lu
+ : Warnings.field_usage_warning option =
+ match priv, mut with
+ | Asttypes.Private, _ ->
+ if lu.lu_projection then None
+ else Some Unused
+ | Asttypes.Public, Asttypes.Immutable -> begin
+ match lu.lu_projection, lu.lu_construct with
+ | true, _ -> None
+ | false, false -> Some Unused
+ | false, true -> Some Not_read
+ end
+ | Asttypes.Public, Asttypes.Mutable -> begin
+ match lu.lu_projection, lu.lu_mutation, lu.lu_construct with
+ | true, true, _ -> None
+ | false, false, false -> Some Unused
+ | false, _, _ -> Some Not_read
+ | true, false, _ -> Some Not_mutated
+ end
+
+let used_labels : label_usage usage_tbl ref =
+ s_table Types.Uid.Tbl.create 16
+
+(** Map indexed by the name of module components. *)
+module NameMap = String.Map
+
+type value_unbound_reason =
+ | Val_unbound_instance_variable
+ | Val_unbound_self
+ | Val_unbound_ancestor
+ | Val_unbound_ghost_recursive of Location.t
+
+type module_unbound_reason =
+ | Mod_unbound_illegal_recursion
+
+type summary =
+ Env_empty
+ | Env_value of summary * Ident.t * value_description
+ | Env_type of summary * Ident.t * type_declaration
+ | Env_extension of summary * Ident.t * extension_constructor
+ | Env_module of summary * Ident.t * module_presence * module_declaration
+ | Env_modtype of summary * Ident.t * modtype_declaration
+ | Env_class of summary * Ident.t * class_declaration
+ | Env_cltype of summary * Ident.t * class_type_declaration
+ | Env_open of summary * Path.t
+ | Env_functor_arg of summary * Ident.t
+ | Env_constraints of summary * type_declaration Path.Map.t
+ | Env_copy_types of summary
+ | Env_persistent of summary * Ident.t
+ | Env_value_unbound of summary * string * value_unbound_reason
+ | Env_module_unbound of summary * string * module_unbound_reason
+
+let map_summary f = function
+ Env_empty -> Env_empty
+ | Env_value (s, id, d) -> Env_value (f s, id, d)
+ | Env_type (s, id, d) -> Env_type (f s, id, d)
+ | Env_extension (s, id, d) -> Env_extension (f s, id, d)
+ | Env_module (s, id, p, d) -> Env_module (f s, id, p, d)
+ | Env_modtype (s, id, d) -> Env_modtype (f s, id, d)
+ | Env_class (s, id, d) -> Env_class (f s, id, d)
+ | Env_cltype (s, id, d) -> Env_cltype (f s, id, d)
+ | Env_open (s, p) -> Env_open (f s, p)
+ | Env_functor_arg (s, id) -> Env_functor_arg (f s, id)
+ | Env_constraints (s, m) -> Env_constraints (f s, m)
+ | Env_copy_types s -> Env_copy_types (f s)
+ | Env_persistent (s, id) -> Env_persistent (f s, id)
+ | Env_value_unbound (s, u, r) -> Env_value_unbound (f s, u, r)
+ | Env_module_unbound (s, u, r) -> Env_module_unbound (f s, u, r)
+
+type address =
+ | Aident of Ident.t
+ | Adot of address * int
+
+module TycompTbl =
+ struct
+ (** This module is used to store components of types (i.e. labels
+ and constructors). We keep a representation of each nested
+ "open" and the set of local bindings between each of them. *)
+
+ type 'a t = {
+ current: 'a Ident.tbl;
+ (** Local bindings since the last open. *)
+
+ opened: 'a opened option;
+ (** Symbolic representation of the last (innermost) open, if any. *)
+ }
+
+ and 'a opened = {
+ components: ('a list) NameMap.t;
+ (** Components from the opened module. We keep a list of
+ bindings for each name, as in comp_labels and
+ comp_constrs. *)
+
+ root: Path.t;
+ (** Only used to check removal of open *)
+
+ using: (string -> ('a * 'a) option -> unit) option;
+ (** A callback to be applied when a component is used from this
+ "open". This is used to detect unused "opens". The
+ arguments are used to detect shadowing. *)
+
+ next: 'a t;
+ (** The table before opening the module. *)
+ }
+
+ let empty = { current = Ident.empty; opened = None }
+
+ let add id x tbl =
+ {tbl with current = Ident.add id x tbl.current}
+
+ let add_open slot wrap root components next =
+ let using =
+ match slot with
+ | None -> None
+ | Some f -> Some (fun s x -> f s (wrap x))
+ in
+ {
+ current = Ident.empty;
+ opened = Some {using; components; root; next};
+ }
+
+ let remove_last_open rt tbl =
+ match tbl.opened with
+ | Some {root; next; _} when Path.same rt root ->
+ { next with current =
+ Ident.fold_all Ident.add tbl.current next.current }
+ | _ ->
+ assert false
+
+ let rec find_same id tbl =
+ try Ident.find_same id tbl.current
+ with Not_found as exn ->
+ begin match tbl.opened with
+ | Some {next; _} -> find_same id next
+ | None -> raise exn
+ end
+
+ let nothing = fun () -> ()
+
+ let mk_callback rest name desc using =
+ match using with
+ | None -> nothing
+ | Some f ->
+ (fun () ->
+ match rest with
+ | [] -> f name None
+ | (hidden, _) :: _ -> f name (Some (desc, hidden)))
+
+ let rec find_all ~mark name tbl =
+ List.map (fun (_id, desc) -> desc, nothing)
+ (Ident.find_all name tbl.current) @
+ match tbl.opened with
+ | None -> []
+ | Some {using; next; components; root = _} ->
+ let rest = find_all ~mark name next in
+ let using = if mark then using else None in
+ match NameMap.find name components with
+ | exception Not_found -> rest
+ | opened ->
+ List.map
+ (fun desc -> desc, mk_callback rest name desc using)
+ opened
+ @ rest
+
+ let rec fold_name f tbl acc =
+ let acc = Ident.fold_name (fun _id d -> f d) tbl.current acc in
+ match tbl.opened with
+ | Some {using = _; next; components; root = _} ->
+ acc
+ |> NameMap.fold
+ (fun _name -> List.fold_right f)
+ components
+ |> fold_name f next
+ | None ->
+ acc
+
+ let rec local_keys tbl acc =
+ let acc = Ident.fold_all (fun k _ accu -> k::accu) tbl.current acc in
+ match tbl.opened with
+ | Some o -> local_keys o.next acc
+ | None -> acc
+
+ let diff_keys is_local tbl1 tbl2 =
+ let keys2 = local_keys tbl2 [] in
+ List.filter
+ (fun id ->
+ is_local (find_same id tbl2) &&
+ try ignore (find_same id tbl1); false
+ with Not_found -> true)
+ keys2
+
+ end
+
+
+module IdTbl =
+ struct
+ (** This module is used to store all kinds of components except
+ (labels and constructors) in environments. We keep a
+ representation of each nested "open" and the set of local
+ bindings between each of them. *)
+
+
+ type ('a, 'b) t = {
+ current: 'a Ident.tbl;
+ (** Local bindings since the last open *)
+
+ layer: ('a, 'b) layer;
+ (** Symbolic representation of the last (innermost) open, if any. *)
+ }
+
+ and ('a, 'b) layer =
+ | Open of {
+ root: Path.t;
+ (** The path of the opened module, to be prefixed in front of
+ its local names to produce a valid path in the current
+ environment. *)
+
+ components: 'b NameMap.t;
+ (** Components from the opened module. *)
+
+ using: (string -> ('a * 'a) option -> unit) option;
+ (** A callback to be applied when a component is used from this
+ "open". This is used to detect unused "opens". The
+ arguments are used to detect shadowing. *)
+
+ next: ('a, 'b) t;
+ (** The table before opening the module. *)
+ }
+
+ | Map of {
+ f: ('a -> 'a);
+ next: ('a, 'b) t;
+ }
+
+ | Nothing
+
+ let empty = { current = Ident.empty; layer = Nothing }
+
+ let add id x tbl =
+ {tbl with current = Ident.add id x tbl.current}
+
+ let remove id tbl =
+ {tbl with current = Ident.remove id tbl.current}
+
+ let add_open slot wrap root components next =
+ let using =
+ match slot with
+ | None -> None
+ | Some f -> Some (fun s x -> f s (wrap x))
+ in
+ {
+ current = Ident.empty;
+ layer = Open {using; root; components; next};
+ }
+
+ let remove_last_open rt tbl =
+ match tbl.layer with
+ | Open {root; next; _} when Path.same rt root ->
+ { next with current =
+ Ident.fold_all Ident.add tbl.current next.current }
+ | _ ->
+ assert false
+
+ let map f next =
+ {
+ current = Ident.empty;
+ layer = Map {f; next}
+ }
+
+ let rec find_same id tbl =
+ try Ident.find_same id tbl.current
+ with Not_found as exn ->
+ begin match tbl.layer with
+ | Open {next; _} -> find_same id next
+ | Map {f; next} -> f (find_same id next)
+ | Nothing -> raise exn
+ end
+
+ let rec find_name wrap ~mark name tbl =
+ try
+ let (id, desc) = Ident.find_name name tbl.current in
+ Pident id, desc
+ with Not_found as exn ->
+ begin match tbl.layer with
+ | Open {using; root; next; components} ->
+ begin try
+ let descr = wrap (NameMap.find name components) in
+ let res = Pdot (root, name), descr in
+ if mark then begin match using with
+ | None -> ()
+ | Some f -> begin
+ match find_name wrap ~mark:false name next with
+ | exception Not_found -> f name None
+ | _, descr' -> f name (Some (descr', descr))
+ end
+ end;
+ res
+ with Not_found ->
+ find_name wrap ~mark name next
+ end
+ | Map {f; next} ->
+ let (p, desc) = find_name wrap ~mark name next in
+ p, f desc
+ | Nothing ->
+ raise exn
+ end
+
+ let rec find_all wrap name tbl =
+ List.map
+ (fun (id, desc) -> Pident id, desc)
+ (Ident.find_all name tbl.current) @
+ match tbl.layer with
+ | Nothing -> []
+ | Open {root; using = _; next; components} ->
+ begin try
+ let desc = wrap (NameMap.find name components) in
+ (Pdot (root, name), desc) :: find_all wrap name next
+ with Not_found ->
+ find_all wrap name next
+ end
+ | Map {f; next} ->
+ List.map (fun (p, desc) -> (p, f desc))
+ (find_all wrap name next)
+
+ let rec find_all_idents name tbl () =
+ let current =
+ Ident.find_all_seq name tbl.current
+ |> Seq.map (fun (id, _) -> Some id)
+ in
+ let next () =
+ match tbl.layer with
+ | Nothing -> Seq.Nil
+ | Open { next; components; _ } ->
+ if NameMap.mem name components then
+ Seq.Cons(None, find_all_idents name next)
+ else
+ find_all_idents name next ()
+ | Map {next; _ } -> find_all_idents name next ()
+ in
+ Seq.append current next ()
+
+ let rec fold_name wrap f tbl acc =
+ let acc =
+ Ident.fold_name
+ (fun id d -> f (Ident.name id) (Pident id, d))
+ tbl.current acc
+ in
+ match tbl.layer with
+ | Open {root; using = _; next; components} ->
+ acc
+ |> NameMap.fold
+ (fun name desc -> f name (Pdot (root, name), wrap desc))
+ components
+ |> fold_name wrap f next
+ | Nothing ->
+ acc
+ | Map {f=g; next} ->
+ acc
+ |> fold_name wrap
+ (fun name (path, desc) -> f name (path, g desc))
+ next
+
+ let rec local_keys tbl acc =
+ let acc = Ident.fold_all (fun k _ accu -> k::accu) tbl.current acc in
+ match tbl.layer with
+ | Open {next; _ } | Map {next; _} -> local_keys next acc
+ | Nothing -> acc
+
+
+ let rec iter wrap f tbl =
+ Ident.iter (fun id desc -> f id (Pident id, desc)) tbl.current;
+ match tbl.layer with
+ | Open {root; using = _; next; components} ->
+ NameMap.iter
+ (fun s x ->
+ let root_scope = Path.scope root in
+ f (Ident.create_scoped ~scope:root_scope s)
+ (Pdot (root, s), wrap x))
+ components;
+ iter wrap f next
+ | Map {f=g; next} ->
+ iter wrap (fun id (path, desc) -> f id (path, g desc)) next
+ | Nothing -> ()
+
+ let diff_keys tbl1 tbl2 =
+ let keys2 = local_keys tbl2 [] in
+ List.filter
+ (fun id ->
+ try ignore (find_same id tbl1); false
+ with Not_found -> true)
+ keys2
+
+
+ end
+
+type type_descr_kind =
+ (label_description, constructor_description) type_kind
+
+type type_descriptions = type_descr_kind
+
+let in_signature_flag = 0x01
+
+type t = {
+ values: (value_entry, value_data) IdTbl.t;
+ constrs: constructor_data TycompTbl.t;
+ labels: label_data TycompTbl.t;
+ types: (type_data, type_data) IdTbl.t;
+ modules: (module_entry, module_data) IdTbl.t;
+ modtypes: (modtype_data, modtype_data) IdTbl.t;
+ classes: (class_data, class_data) IdTbl.t;
+ cltypes: (cltype_data, cltype_data) IdTbl.t;
+ functor_args: unit Ident.tbl;
+ summary: summary;
+ local_constraints: type_declaration Path.Map.t;
+ flags: int;
+}
+
+and module_components =
+ {
+ alerts: alerts;
+ uid: Uid.t;
+ comps:
+ (components_maker,
+ (module_components_repr, module_components_failure) result)
+ Lazy_backtrack.t;
+ }
+
+and components_maker = {
+ cm_env: t;
+ cm_prefixing_subst: Subst.t;
+ cm_path: Path.t;
+ cm_addr: address_lazy;
+ cm_mty: Subst.Lazy.modtype;
+ cm_shape: Shape.t;
+}
+
+and module_components_repr =
+ Structure_comps of structure_components
+ | Functor_comps of functor_components
+
+and module_components_failure =
+ | No_components_abstract
+ | No_components_alias of Path.t
+
+and structure_components = {
+ mutable comp_values: value_data NameMap.t;
+ mutable comp_constrs: constructor_data list NameMap.t;
+ mutable comp_labels: label_data list NameMap.t;
+ mutable comp_types: type_data NameMap.t;
+ mutable comp_modules: module_data NameMap.t;
+ mutable comp_modtypes: modtype_data NameMap.t;
+ mutable comp_classes: class_data NameMap.t;
+ mutable comp_cltypes: cltype_data NameMap.t;
+}
+
+and functor_components = {
+ fcomp_arg: functor_parameter;
+ (* Formal parameter and argument signature *)
+ fcomp_res: module_type; (* Result signature *)
+ fcomp_shape: Shape.t;
+ fcomp_cache: (Path.t, module_components) Hashtbl.t; (* For memoization *)
+ fcomp_subst_cache: (Path.t, module_type) Hashtbl.t
+}
+
+and address_unforced =
+ | Projection of { parent : address_lazy; pos : int; }
+ | ModAlias of { env : t; path : Path.t; }
+
+and address_lazy = (address_unforced, address) Lazy_backtrack.t
+
+and value_data =
+ { vda_description : value_description;
+ vda_address : address_lazy;
+ vda_shape : Shape.t }
+
+and value_entry =
+ | Val_bound of value_data
+ | Val_unbound of value_unbound_reason
+
+and constructor_data =
+ { cda_description : constructor_description;
+ cda_address : address_lazy option;
+ cda_shape: Shape.t; }
+
+and label_data = label_description
+
+and type_data =
+ { tda_declaration : type_declaration;
+ tda_descriptions : type_descriptions;
+ tda_shape : Shape.t; }
+
+and module_data =
+ { mda_declaration : Subst.Lazy.module_decl;
+ mda_components : module_components;
+ mda_address : address_lazy;
+ mda_shape: Shape.t; }
+
+and module_entry =
+ | Mod_local of module_data
+ | Mod_persistent
+ | Mod_unbound of module_unbound_reason
+
+and modtype_data =
+ { mtda_declaration : Subst.Lazy.modtype_declaration;
+ mtda_shape : Shape.t; }
+
+and class_data =
+ { clda_declaration : class_declaration;
+ clda_address : address_lazy;
+ clda_shape : Shape.t }
+
+and cltype_data =
+ { cltda_declaration : class_type_declaration;
+ cltda_shape : Shape.t }
+
+let empty_structure =
+ Structure_comps {
+ comp_values = NameMap.empty;
+ comp_constrs = NameMap.empty;
+ comp_labels = NameMap.empty;
+ comp_types = NameMap.empty;
+ comp_modules = NameMap.empty; comp_modtypes = NameMap.empty;
+ comp_classes = NameMap.empty;
+ comp_cltypes = NameMap.empty }
+
+type unbound_value_hint =
+ | No_hint
+ | Missing_rec of Location.t
+
+type lookup_error =
+ | Unbound_value of Longident.t * unbound_value_hint
+ | Unbound_type of Longident.t
+ | Unbound_constructor of Longident.t
+ | Unbound_label of Longident.t
+ | Unbound_module of Longident.t
+ | Unbound_class of Longident.t
+ | Unbound_modtype of Longident.t
+ | Unbound_cltype of Longident.t
+ | Unbound_instance_variable of string
+ | Not_an_instance_variable of string
+ | Masked_instance_variable of Longident.t
+ | Masked_self_variable of Longident.t
+ | Masked_ancestor_variable of Longident.t
+ | Structure_used_as_functor of Longident.t
+ | Abstract_used_as_functor of Longident.t
+ | Functor_used_as_structure of Longident.t
+ | Abstract_used_as_structure of Longident.t
+ | Generative_used_as_applicative of Longident.t
+ | Illegal_reference_to_recursive_module
+ | Cannot_scrape_alias of Longident.t * Path.t
+
+type error =
+ | Missing_module of Location.t * Path.t * Path.t
+ | Illegal_value_name of Location.t * string
+ | Lookup_error of Location.t * t * lookup_error
+
+exception Error of error
+
+let error err = raise (Error err)
+
+let lookup_error loc env err =
+ error (Lookup_error(loc, env, err))
+
+let same_type_declarations e1 e2 =
+ e1.types == e2.types &&
+ e1.modules == e2.modules &&
+ e1.local_constraints == e2.local_constraints
+
+let same_constr = ref (fun _ _ _ -> assert false)
+
+let check_well_formed_module = ref (fun _ -> assert false)
+
+(* Helper to decide whether to report an identifier shadowing
+ by some 'open'. For labels and constructors, we do not report
+ if the two elements are from the same re-exported declaration.
+
+ Later, one could also interpret some attributes on value and
+ type declarations to silence the shadowing warnings. *)
+
+let check_shadowing env = function
+ | `Constructor (Some (cda1, cda2))
+ when not (!same_constr env
+ cda1.cda_description.cstr_res
+ cda2.cda_description.cstr_res) ->
+ Some "constructor"
+ | `Label (Some (l1, l2))
+ when not (!same_constr env l1.lbl_res l2.lbl_res) ->
+ Some "label"
+ | `Value (Some (Val_unbound _, _)) -> None
+ | `Value (Some (_, _)) -> Some "value"
+ | `Type (Some _) -> Some "type"
+ | `Module (Some (Mod_unbound _, _)) -> None
+ | `Module (Some _) | `Component (Some _) ->
+ Some "module"
+ | `Module_type (Some _) -> Some "module type"
+ | `Class (Some _) -> Some "class"
+ | `Class_type (Some _) -> Some "class type"
+ | `Constructor _ | `Label _
+ | `Value None | `Type None | `Module None | `Module_type None
+ | `Class None | `Class_type None | `Component None ->
+ None
+
+let empty = {
+ values = IdTbl.empty; constrs = TycompTbl.empty;
+ labels = TycompTbl.empty; types = IdTbl.empty;
+ modules = IdTbl.empty; modtypes = IdTbl.empty;
+ classes = IdTbl.empty; cltypes = IdTbl.empty;
+ summary = Env_empty; local_constraints = Path.Map.empty;
+ flags = 0;
+ functor_args = Ident.empty;
+ }
+
+let in_signature b env =
+ let flags =
+ if b then env.flags lor in_signature_flag
+ else env.flags land (lnot in_signature_flag)
+ in
+ {env with flags}
+
+let is_in_signature env = env.flags land in_signature_flag <> 0
+
+let has_local_constraints env =
+ not (Path.Map.is_empty env.local_constraints)
+
+let is_ext cda =
+ match cda.cda_description with
+ | {cstr_tag = Cstr_extension _} -> true
+ | _ -> false
+
+let is_local_ext cda =
+ match cda.cda_description with
+ | {cstr_tag = Cstr_extension(p, _)} -> begin
+ match p with
+ | Pident _ -> true
+ | Pdot _ | Papply _ | Pextra_ty _ -> false
+ end
+ | _ -> false
+
+let diff env1 env2 =
+ IdTbl.diff_keys env1.values env2.values @
+ TycompTbl.diff_keys is_local_ext env1.constrs env2.constrs @
+ IdTbl.diff_keys env1.modules env2.modules @
+ IdTbl.diff_keys env1.classes env2.classes
+
+(* Functions for use in "wrap" parameters in IdTbl *)
+let wrap_identity x = x
+let wrap_value vda = Val_bound vda
+let wrap_module mda = Mod_local mda
+
+(* Forward declarations *)
+
+let components_of_module_maker' =
+ ref ((fun _ -> assert false) :
+ components_maker ->
+ (module_components_repr, module_components_failure) result)
+
+let components_of_functor_appl' =
+ ref ((fun ~loc:_ ~f_path:_ ~f_comp:_ ~arg:_ _env -> assert false) :
+ loc:Location.t -> f_path:Path.t -> f_comp:functor_components ->
+ arg:Path.t -> t -> module_components)
+let check_functor_application =
+ (* to be filled by Includemod *)
+ ref ((fun ~errors:_ ~loc:_
+ ~lid_whole_app:_ ~f0_path:_ ~args:_
+ ~arg_path:_ ~arg_mty:_ ~param_mty:_
+ _env
+ -> assert false) :
+ errors:bool -> loc:Location.t ->
+ lid_whole_app:Longident.t ->
+ f0_path:Path.t -> args:(Path.t * Types.module_type) list ->
+ arg_path:Path.t -> arg_mty:module_type -> param_mty:module_type ->
+ t -> unit)
+let strengthen =
+ (* to be filled with Mtype.strengthen *)
+ ref ((fun ~aliasable:_ _env _mty _path -> assert false) :
+ aliasable:bool -> t -> Subst.Lazy.modtype ->
+ Path.t -> Subst.Lazy.modtype)
+
+let md md_type =
+ {md_type; md_attributes=[]; md_loc=Location.none
+ ;md_uid = Uid.internal_not_actually_unique}
+
+(* Print addresses *)
+
+let rec print_address ppf = function
+ | Aident id -> Format.fprintf ppf "%s" (Ident.name id)
+ | Adot(a, pos) -> Format.fprintf ppf "%a.[%i]" print_address a pos
+
+(* The name of the compilation unit currently compiled.
+ "" if outside a compilation unit. *)
+module Current_unit : sig
+ val get : unit -> Unit_info.t option
+ val set : Unit_info.t -> unit
+ val unset : unit -> unit
+
+ module Name : sig
+ val get : unit -> modname
+ val is : modname -> bool
+ val is_ident : Ident.t -> bool
+ val is_path : Path.t -> bool
+ end
+end = struct
+ let current_unit : Unit_info.t option ref =
+ ref None
+ let get () =
+ !current_unit
+ let set cu =
+ current_unit := Some cu
+ let unset () =
+ current_unit := None
+
+ module Name = struct
+ let get () =
+ match !current_unit with
+ | None -> ""
+ | Some cu -> Unit_info.modname cu
+ let is name =
+ get () = name
+ let is_ident id =
+ Ident.persistent id && is (Ident.name id)
+ let is_path = function
+ | Pident id -> is_ident id
+ | Pdot _ | Papply _ | Pextra_ty _ -> false
+ end
+end
+
+let set_current_unit = Current_unit.set
+let get_current_unit = Current_unit.get
+let get_current_unit_name = Current_unit.Name.get
+
+let find_same_module id tbl =
+ match IdTbl.find_same id tbl with
+ | x -> x
+ | exception Not_found
+ when Ident.persistent id && not (Current_unit.Name.is_ident id) ->
+ Mod_persistent
+
+let find_name_module ~mark name tbl =
+ match IdTbl.find_name wrap_module ~mark name tbl with
+ | x -> x
+ | exception Not_found when not (Current_unit.Name.is name) ->
+ let path = Pident(Ident.create_persistent name) in
+ path, Mod_persistent
+
+let add_persistent_structure id env =
+ if not (Ident.persistent id) then invalid_arg "Env.add_persistent_structure";
+ if Current_unit.Name.is_ident id then env
+ else begin
+ let material =
+ (* This addition only observably changes the environment if it shadows a
+ non-persistent module already in the environment.
+ (See PR#9345) *)
+ match
+ IdTbl.find_name wrap_module ~mark:false (Ident.name id) env.modules
+ with
+ | exception Not_found | _, Mod_persistent -> false
+ | _ -> true
+ in
+ let summary =
+ if material then Env_persistent (env.summary, id)
+ else env.summary
+ in
+ let modules =
+ (* With [-no-alias-deps], non-material additions should not
+ affect the environment at all. We should only observe the
+ existence of a cmi when accessing components of the module.
+ (See #9991). *)
+ if material || not !Clflags.transparent_modules then
+ IdTbl.add id Mod_persistent env.modules
+ else
+ env.modules
+ in
+ { env with modules; summary }
+ end
+
+let components_of_module ~alerts ~uid env ps path addr mty shape =
+ {
+ alerts;
+ uid;
+ comps = Lazy_backtrack.create {
+ cm_env = env;
+ cm_prefixing_subst = ps;
+ cm_path = path;
+ cm_addr = addr;
+ cm_mty = mty;
+ cm_shape = shape;
+ }
+ }
+
+let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } =
+ let name = cmi.cmi_name in
+ let sign = cmi.cmi_sign in
+ let flags = cmi.cmi_flags in
+ let id = Ident.create_persistent name in
+ let path = Pident id in
+ let alerts =
+ List.fold_left (fun acc -> function Alerts s -> s | _ -> acc)
+ Misc.Stdlib.String.Map.empty
+ flags
+ in
+ let md =
+ { md_type = Mty_signature sign;
+ md_loc = Location.none;
+ md_attributes = [];
+ md_uid = Uid.of_compilation_unit_id id;
+ }
+ in
+ let mda_address = Lazy_backtrack.create_forced (Aident id) in
+ let mda_declaration =
+ Subst.(Lazy.module_decl Make_local identity (Lazy.of_module_decl md))
+ in
+ let mda_shape = Shape.for_persistent_unit name in
+ let mda_components =
+ let mty = Subst.Lazy.of_modtype (Mty_signature sign) in
+ let mty =
+ if freshen then
+ Subst.Lazy.modtype (Subst.Rescope (Path.scope path))
+ Subst.identity mty
+ else mty
+ in
+ components_of_module ~alerts ~uid:md.md_uid
+ empty Subst.identity
+ path mda_address mty mda_shape
+ in
+ {
+ mda_declaration;
+ mda_components;
+ mda_address;
+ mda_shape;
+ }
+
+let read_sign_of_cmi = sign_of_cmi ~freshen:true
+
+let save_sign_of_cmi = sign_of_cmi ~freshen:false
+
+let persistent_env : module_data Persistent_env.t ref =
+ s_table Persistent_env.empty ()
+
+let without_cmis f x =
+ Persistent_env.without_cmis !persistent_env f x
+
+let imports () = Persistent_env.imports !persistent_env
+
+let import_crcs ~source crcs =
+ Persistent_env.import_crcs !persistent_env ~source crcs
+
+let read_pers_mod cmi =
+ Persistent_env.read !persistent_env read_sign_of_cmi cmi
+
+let find_pers_mod name =
+ Persistent_env.find !persistent_env read_sign_of_cmi name
+
+let check_pers_mod ~loc name =
+ Persistent_env.check !persistent_env read_sign_of_cmi ~loc name
+
+let crc_of_unit name =
+ Persistent_env.crc_of_unit !persistent_env read_sign_of_cmi name
+
+let is_imported_opaque modname =
+ Persistent_env.is_imported_opaque !persistent_env modname
+
+let register_import_as_opaque modname =
+ Persistent_env.register_import_as_opaque !persistent_env modname
+
+let reset_declaration_caches () =
+ Types.Uid.Tbl.clear !value_declarations;
+ Types.Uid.Tbl.clear !type_declarations;
+ Types.Uid.Tbl.clear !module_declarations;
+ Types.Uid.Tbl.clear !used_constructors;
+ Types.Uid.Tbl.clear !used_labels;
+ ()
+
+let reset_cache () =
+ Current_unit.unset ();
+ Persistent_env.clear !persistent_env;
+ reset_declaration_caches ();
+ ()
+
+let reset_cache_toplevel () =
+ Persistent_env.clear_missing !persistent_env;
+ reset_declaration_caches ();
+ ()
+
+(* get_components *)
+
+let get_components_res c =
+ match Persistent_env.can_load_cmis !persistent_env with
+ | Persistent_env.Can_load_cmis ->
+ Lazy_backtrack.force !components_of_module_maker' c.comps
+ | Persistent_env.Cannot_load_cmis log ->
+ Lazy_backtrack.force_logged log !components_of_module_maker' c.comps
+
+let get_components c =
+ match get_components_res c with
+ | Error _ -> empty_structure
+ | Ok c -> c
+
+(* Module type of functor application *)
+
+let modtype_of_functor_appl fcomp p1 p2 =
+ match fcomp.fcomp_res with
+ | Mty_alias _ as mty -> mty
+ | mty ->
+ try
+ Hashtbl.find fcomp.fcomp_subst_cache p2
+ with Not_found ->
+ let scope = Path.scope (Papply(p1, p2)) in
+ let mty =
+ let subst =
+ match fcomp.fcomp_arg with
+ | Unit
+ | Named (None, _) -> Subst.identity
+ | Named (Some param, _) -> Subst.add_module param p2 Subst.identity
+ in
+ Subst.modtype (Rescope scope) subst mty
+ in
+ Hashtbl.add fcomp.fcomp_subst_cache p2 mty;
+ mty
+
+let check_functor_appl
+ ~errors ~loc ~lid_whole_app ~f0_path ~args
+ ~f_comp
+ ~arg_path ~arg_mty ~param_mty
+ env =
+ if not (Hashtbl.mem f_comp.fcomp_cache arg_path) then
+ !check_functor_application
+ ~errors ~loc ~lid_whole_app ~f0_path ~args
+ ~arg_path ~arg_mty ~param_mty
+ env
+
+(* Lookup by identifier *)
+
+let find_ident_module id env =
+ match find_same_module id env.modules with
+ | Mod_local data -> data
+ | Mod_unbound _ -> raise Not_found
+ | Mod_persistent -> find_pers_mod ~allow_hidden:true (Ident.name id)
+
+let rec find_module_components path env =
+ match path with
+ | Pident id -> (find_ident_module id env).mda_components
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ (NameMap.find s sc.comp_modules).mda_components
+ | Papply(f_path, arg) ->
+ let f_comp = find_functor_components f_path env in
+ let loc = Location.(in_file !input_name) in
+ !components_of_functor_appl' ~loc ~f_path ~f_comp ~arg env
+ | Pextra_ty _ -> raise Not_found
+
+and find_structure_components path env =
+ match get_components (find_module_components path env) with
+ | Structure_comps c -> c
+ | Functor_comps _ -> raise Not_found
+
+and find_functor_components path env =
+ match get_components (find_module_components path env) with
+ | Functor_comps f -> f
+ | Structure_comps _ -> raise Not_found
+
+let find_module ~alias path env =
+ match path with
+ | Pident id ->
+ let data = find_ident_module id env in
+ Subst.Lazy.force_module_decl data.mda_declaration
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ let data = NameMap.find s sc.comp_modules in
+ Subst.Lazy.force_module_decl data.mda_declaration
+ | Papply(p1, p2) ->
+ let fc = find_functor_components p1 env in
+ if alias then md (fc.fcomp_res)
+ else md (modtype_of_functor_appl fc p1 p2)
+ | Pextra_ty _ -> raise Not_found
+
+let find_module_lazy ~alias path env =
+ match path with
+ | Pident id ->
+ let data = find_ident_module id env in
+ data.mda_declaration
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ let data = NameMap.find s sc.comp_modules in
+ data.mda_declaration
+ | Papply(p1, p2) ->
+ let fc = find_functor_components p1 env in
+ let md =
+ if alias then md (fc.fcomp_res)
+ else md (modtype_of_functor_appl fc p1 p2)
+ in
+ Subst.Lazy.of_module_decl md
+ | Pextra_ty _ -> raise Not_found
+
+let find_strengthened_module ~aliasable path env =
+ let md = find_module_lazy ~alias:true path env in
+ let mty = !strengthen ~aliasable env md.mdl_type path in
+ Subst.Lazy.force_modtype mty
+
+let find_value_full path env =
+ match path with
+ | Pident id -> begin
+ match IdTbl.find_same id env.values with
+ | Val_bound data -> data
+ | Val_unbound _ -> raise Not_found
+ end
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_values
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+let find_extension_full path env =
+ match path with
+ | Pident id -> TycompTbl.find_same id env.constrs
+ | Pdot(p, s) -> begin
+ let comps = find_structure_components p env in
+ let cstrs = NameMap.find s comps.comp_constrs in
+ let exts = List.filter is_ext cstrs in
+ match exts with
+ | [cda] -> cda
+ | _ -> raise Not_found
+ end
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+let type_of_cstr path = function
+ | {cstr_inlined = Some decl; _} ->
+ let labels =
+ List.map snd (Datarepr.labels_of_type path decl)
+ in
+ begin match decl.type_kind with
+ | Type_record (_, repr) ->
+ {
+ tda_declaration = decl;
+ tda_descriptions = Type_record (labels, repr);
+ tda_shape = Shape.leaf decl.type_uid;
+ }
+ | _ -> assert false
+ end
+ | _ -> assert false
+
+let rec find_type_data path env =
+ match Path.Map.find path env.local_constraints with
+ | decl ->
+ {
+ tda_declaration = decl;
+ tda_descriptions = Type_abstract (Btype.type_origin decl);
+ tda_shape = Shape.leaf decl.type_uid;
+ }
+ | exception Not_found -> begin
+ match path with
+ | Pident id -> IdTbl.find_same id env.types
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_types
+ | Papply _ -> raise Not_found
+ | Pextra_ty (p, extra) -> begin
+ match extra with
+ | Pcstr_ty s ->
+ let cstr = find_cstr p s env in
+ type_of_cstr path cstr
+ | Pext_ty ->
+ let cda = find_extension_full p env in
+ type_of_cstr path cda.cda_description
+ end
+ end
+and find_cstr path name env =
+ let tda = find_type_data path env in
+ match tda.tda_descriptions with
+ | Type_variant (cstrs, _) ->
+ List.find (fun cstr -> cstr.cstr_name = name) cstrs
+ | Type_record _ | Type_abstract _ | Type_open -> raise Not_found
+
+
+
+let find_modtype_lazy path env =
+ match path with
+ | Pident id -> (IdTbl.find_same id env.modtypes).mtda_declaration
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ (NameMap.find s sc.comp_modtypes).mtda_declaration
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+let find_modtype path env =
+ Subst.Lazy.force_modtype_decl (find_modtype_lazy path env)
+
+let find_class_full path env =
+ match path with
+ | Pident id -> IdTbl.find_same id env.classes
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_classes
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+let find_cltype path env =
+ match path with
+ | Pident id -> (IdTbl.find_same id env.cltypes).cltda_declaration
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ (NameMap.find s sc.comp_cltypes).cltda_declaration
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+let find_value path env =
+ (find_value_full path env).vda_description
+
+let find_class path env =
+ (find_class_full path env).clda_declaration
+
+let find_ident_constructor id env =
+ (TycompTbl.find_same id env.constrs).cda_description
+
+let find_ident_label id env =
+ TycompTbl.find_same id env.labels
+
+let find_type p env =
+ (find_type_data p env).tda_declaration
+let find_type_descrs p env =
+ (find_type_data p env).tda_descriptions
+
+let rec find_module_address path env =
+ match path with
+ | Pident id -> get_address (find_ident_module id env).mda_address
+ | Pdot(p, s) ->
+ let c = find_structure_components p env in
+ get_address (NameMap.find s c.comp_modules).mda_address
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+and force_address = function
+ | Projection { parent; pos } -> Adot(get_address parent, pos)
+ | ModAlias { env; path } -> find_module_address path env
+
+and get_address a =
+ Lazy_backtrack.force force_address a
+
+let find_value_address path env =
+ get_address (find_value_full path env).vda_address
+
+let find_class_address path env =
+ get_address (find_class_full path env).clda_address
+
+let rec get_constrs_address = function
+ | [] -> raise Not_found
+ | cda :: rest ->
+ match cda.cda_address with
+ | None -> get_constrs_address rest
+ | Some a -> get_address a
+
+let find_constructor_address path env =
+ match path with
+ | Pident id -> begin
+ let cda = TycompTbl.find_same id env.constrs in
+ match cda.cda_address with
+ | None -> raise Not_found
+ | Some addr -> get_address addr
+ end
+ | Pdot(p, s) ->
+ let c = find_structure_components p env in
+ get_constrs_address (NameMap.find s c.comp_constrs)
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+let find_hash_type path env =
+ match path with
+ | Pident id ->
+ let name = Ident.name id in
+ let _, cltda =
+ IdTbl.find_name wrap_identity ~mark:false name env.cltypes
+ in
+ cltda.cltda_declaration.clty_hash_type
+ | Pdot(p, name) ->
+ let c = find_structure_components p env in
+ let cltda = NameMap.find name c.comp_cltypes in
+ cltda.cltda_declaration.clty_hash_type
+ | Papply _ | Pextra_ty _ -> raise Not_found
+
+let find_shape env (ns : Shape.Sig_component_kind.t) id =
+ match ns with
+ | Type ->
+ (IdTbl.find_same id env.types).tda_shape
+ | Constructor ->
+ Shape.leaf ((TycompTbl.find_same id env.constrs).cda_description.cstr_uid)
+ | Label ->
+ Shape.leaf ((TycompTbl.find_same id env.labels).lbl_uid)
+ | Extension_constructor ->
+ (TycompTbl.find_same id env.constrs).cda_shape
+ | Value ->
+ begin match IdTbl.find_same id env.values with
+ | Val_bound x -> x.vda_shape
+ | Val_unbound _ -> raise Not_found
+ end
+ | Module ->
+ begin match IdTbl.find_same id env.modules with
+ | Mod_local { mda_shape; _ } -> mda_shape
+ | Mod_persistent -> Shape.for_persistent_unit (Ident.name id)
+ | Mod_unbound _ ->
+ (* Only present temporarily while approximating the environment for
+ recursive modules.
+ [find_shape] is only ever called after the environment gets
+ properly populated. *)
+ assert false
+ | exception Not_found
+ when Ident.persistent id && not (Current_unit.Name.is_ident id) ->
+ Shape.for_persistent_unit (Ident.name id)
+ end
+ | Module_type ->
+ (IdTbl.find_same id env.modtypes).mtda_shape
+ | Class ->
+ (IdTbl.find_same id env.classes).clda_shape
+ | Class_type ->
+ (IdTbl.find_same id env.cltypes).cltda_shape
+
+let shape_of_path ~namespace env =
+ Shape.of_path ~namespace ~find_shape:(find_shape env)
+
+let shape_or_leaf uid = function
+ | None -> Shape.leaf uid
+ | Some shape -> shape
+
+let required_globals = s_ref []
+let reset_required_globals () = required_globals := []
+let get_required_globals () = !required_globals
+let add_required_global id =
+ if Ident.global id && not !Clflags.transparent_modules
+ && not (List.exists (Ident.same id) !required_globals)
+ then required_globals := id :: !required_globals
+
+let rec normalize_module_path lax env = function
+ | Pident id as path when lax && Ident.persistent id ->
+ path (* fast path (avoids lookup) *)
+ | Pdot (p, s) as path ->
+ let p' = normalize_module_path lax env p in
+ if p == p' then expand_module_path lax env path
+ else expand_module_path lax env (Pdot(p', s))
+ | Papply (p1, p2) as path ->
+ let p1' = normalize_module_path lax env p1 in
+ let p2' = normalize_module_path true env p2 in
+ if p1 == p1' && p2 == p2' then expand_module_path lax env path
+ else expand_module_path lax env (Papply(p1', p2'))
+ | Pident _ as path ->
+ expand_module_path lax env path
+ | Pextra_ty _ -> assert false
+
+and expand_module_path lax env path =
+ try match find_module_lazy ~alias:true path env with
+ {mdl_type=MtyL_alias path1} ->
+ let path' = normalize_module_path lax env path1 in
+ if lax || !Clflags.transparent_modules then path' else
+ let id = Path.head path in
+ if Ident.global id && not (Ident.same id (Path.head path'))
+ then add_required_global id;
+ path'
+ | _ -> path
+ with Not_found when lax
+ || (match path with Pident id -> not (Ident.persistent id) | _ -> true) ->
+ path
+
+let normalize_module_path oloc env path =
+ try normalize_module_path (oloc = None) env path
+ with Not_found ->
+ match oloc with None -> assert false
+ | Some loc ->
+ error (Missing_module(loc, path,
+ normalize_module_path true env path))
+
+let rec normalize_path_prefix oloc env path =
+ match path with
+ | Pdot(p, s) ->
+ let p2 = normalize_module_path oloc env p in
+ if p == p2 then path else Pdot(p2, s)
+ | Pident _ ->
+ path
+ | Pextra_ty (p, extra) ->
+ let p2 = normalize_path_prefix oloc env p in
+ if p == p2 then path else Pextra_ty (p2, extra)
+ | Papply _ ->
+ assert false
+
+let normalize_type_path = normalize_path_prefix
+
+let normalize_value_path = normalize_path_prefix
+
+let rec normalize_modtype_path env path =
+ let path = normalize_path_prefix None env path in
+ expand_modtype_path env path
+
+and expand_modtype_path env path =
+ match (find_modtype_lazy path env).mtdl_type with
+ | Some (MtyL_ident path) -> normalize_modtype_path env path
+ | _ | exception Not_found -> path
+
+let find_module path env =
+ find_module ~alias:false path env
+
+let find_module_lazy path env =
+ find_module_lazy ~alias:false path env
+
+(* Find the manifest type associated to a type when appropriate:
+ - the type should be public or should have a private row,
+ - the type should have an associated manifest type. *)
+let find_type_expansion path env =
+ let decl = find_type path env in
+ match decl.type_manifest with
+ | Some body when decl.type_private = Public
+ || not (Btype.type_kind_is_abstract decl)
+ || Btype.has_constr_row body ->
+ (decl.type_params, body, decl.type_expansion_scope)
+ (* The manifest type of Private abstract data types without
+ private row are still considered unknown to the type system.
+ Hence, this case is caught by the following clause that also handles
+ purely abstract data types without manifest type definition. *)
+ | _ -> raise Not_found
+
+(* Find the manifest type information associated to a type, i.e.
+ the necessary information for the compiler's type-based optimisations.
+ In particular, the manifest type associated to a private abstract type
+ is revealed for the sake of compiler's type-based optimisations. *)
+let find_type_expansion_opt path env =
+ let decl = find_type path env in
+ match decl.type_manifest with
+ (* The manifest type of Private abstract data types can still get
+ an approximation using their manifest type. *)
+ | Some body ->
+ (decl.type_params, body, decl.type_expansion_scope)
+ | _ -> raise Not_found
+
+let find_modtype_expansion_lazy path env =
+ match (find_modtype_lazy path env).mtdl_type with
+ | None -> raise Not_found
+ | Some mty -> mty
+
+let find_modtype_expansion path env =
+ Subst.Lazy.force_modtype (find_modtype_expansion_lazy path env)
+
+let rec is_functor_arg path env =
+ match path with
+ Pident id ->
+ begin try Ident.find_same id env.functor_args; true
+ with Not_found -> false
+ end
+ | Pdot (p, _) | Pextra_ty (p, _) -> is_functor_arg p env
+ | Papply _ -> true
+
+(* Copying types associated with values *)
+
+let make_copy_of_types env0 =
+ let memo = Hashtbl.create 16 in
+ let copy t =
+ try
+ Hashtbl.find memo (get_id t)
+ with Not_found ->
+ let t2 = Subst.type_expr Subst.identity t in
+ Hashtbl.add memo (get_id t) t2;
+ t2
+ in
+ let f = function
+ | Val_unbound _ as entry -> entry
+ | Val_bound vda ->
+ let desc = vda.vda_description in
+ let desc = { desc with val_type = copy desc.val_type } in
+ Val_bound { vda with vda_description = desc }
+ in
+ let values =
+ IdTbl.map f env0.values
+ in
+ (fun env ->
+ (*if env.values != env0.values then fatal_error "Env.make_copy_of_types";*)
+ {env with values; summary = Env_copy_types env.summary}
+ )
+
+(* Iter on an environment (ignoring the body of functors and
+ not yet evaluated structures) *)
+
+type iter_cont = unit -> unit
+let iter_env_cont = ref []
+
+let rec scrape_alias_for_visit env mty =
+ let open Subst.Lazy in
+ match mty with
+ | MtyL_alias path -> begin
+ match path with
+ | Pident id
+ when Ident.persistent id
+ && not (Persistent_env.looked_up !persistent_env (Ident.name id)) ->
+ false
+ | path -> (* PR#6600: find_module may raise Not_found *)
+ try
+ scrape_alias_for_visit env (find_module_lazy path env).mdl_type
+ with Not_found -> false
+ end
+ | _ -> true
+
+let iter_env wrap proj1 proj2 f env () =
+ IdTbl.iter wrap (fun id x -> f (Pident id) x) (proj1 env);
+ let rec iter_components path path' mcomps =
+ let cont () =
+ let visit =
+ match Lazy_backtrack.get_arg mcomps.comps with
+ | None -> true
+ | Some { cm_mty; _ } ->
+ scrape_alias_for_visit env cm_mty
+ in
+ if not visit then () else
+ match get_components mcomps with
+ Structure_comps comps ->
+ NameMap.iter
+ (fun s d -> f (Pdot (path, s)) (Pdot (path', s), d))
+ (proj2 comps);
+ NameMap.iter
+ (fun s mda ->
+ iter_components
+ (Pdot (path, s)) (Pdot (path', s)) mda.mda_components)
+ comps.comp_modules
+ | Functor_comps _ -> ()
+ in iter_env_cont := (path, cont) :: !iter_env_cont
+ in
+ IdTbl.iter wrap_module
+ (fun id (path, entry) ->
+ match entry with
+ | Mod_unbound _ -> ()
+ | Mod_local data ->
+ iter_components (Pident id) path data.mda_components
+ | Mod_persistent ->
+ let modname = Ident.name id in
+ match Persistent_env.find_in_cache !persistent_env modname with
+ | None -> ()
+ | Some data ->
+ iter_components (Pident id) path data.mda_components)
+ env.modules
+
+let run_iter_cont l =
+ iter_env_cont := [];
+ List.iter (fun c -> c ()) l;
+ let cont = List.rev !iter_env_cont in
+ iter_env_cont := [];
+ cont
+
+let iter_types f =
+ iter_env wrap_identity (fun env -> env.types) (fun sc -> sc.comp_types)
+ (fun p1 (p2, tda) -> f p1 (p2, tda.tda_declaration))
+
+let same_types env1 env2 =
+ env1.types == env2.types && env1.modules == env2.modules
+
+let used_persistent () =
+ Persistent_env.fold !persistent_env
+ (fun s _m r -> String.Set.add s r)
+ String.Set.empty
+
+let find_all_comps wrap proj s (p, mda) =
+ match get_components mda.mda_components with
+ Functor_comps _ -> []
+ | Structure_comps comps ->
+ try
+ let c = NameMap.find s (proj comps) in
+ [Pdot(p,s), wrap c]
+ with Not_found -> []
+
+let rec find_shadowed_comps path env =
+ match path with
+ | Pident id ->
+ List.filter_map
+ (fun (p, data) ->
+ match data with
+ | Mod_local x -> Some (p, x)
+ | Mod_unbound _ | Mod_persistent -> None)
+ (IdTbl.find_all wrap_module (Ident.name id) env.modules)
+ | Pdot (p, s) ->
+ let l = find_shadowed_comps p env in
+ let l' =
+ List.map
+ (find_all_comps wrap_identity
+ (fun comps -> comps.comp_modules) s) l
+ in
+ List.flatten l'
+ | Papply _ | Pextra_ty _ -> []
+
+let find_shadowed wrap proj1 proj2 path env =
+ match path with
+ Pident id ->
+ IdTbl.find_all wrap (Ident.name id) (proj1 env)
+ | Pdot (p, s) ->
+ let l = find_shadowed_comps p env in
+ let l' = List.map (find_all_comps wrap proj2 s) l in
+ List.flatten l'
+ | Papply _ | Pextra_ty _ -> []
+
+let find_shadowed_types path env =
+ List.map fst
+ (find_shadowed wrap_identity
+ (fun env -> env.types) (fun comps -> comps.comp_types) path env)
+
+(* Expand manifest module type names at the top of the given module type *)
+
+let rec scrape_alias env ?path mty =
+ let open Subst.Lazy in
+ match mty, path with
+ MtyL_ident p, _ ->
+ begin try
+ scrape_alias env (find_modtype_expansion_lazy p env) ?path
+ with Not_found ->
+ mty
+ end
+ | MtyL_alias path, _ ->
+ begin try
+ scrape_alias env ((find_module_lazy path env).mdl_type) ~path
+ with Not_found ->
+ (*Location.prerr_warning Location.none
+ (Warnings.No_cmi_file (Path.name path));*)
+ mty
+ end
+ | mty, Some path ->
+ !strengthen ~aliasable:true env mty path
+ | _ -> mty
+
+(* Given a signature and a root path, prefix all idents in the signature
+ by the root path and build the corresponding substitution. *)
+
+let prefix_idents root prefixing_sub sg =
+ let open Subst.Lazy in
+ let rec prefix_idents root items_and_paths prefixing_sub =
+ function
+ | [] -> (List.rev items_and_paths, prefixing_sub)
+ | SigL_value(id, _, _) as item :: rem ->
+ let p = Pdot(root, Ident.name id) in
+ prefix_idents root
+ ((item, p) :: items_and_paths) prefixing_sub rem
+ | SigL_type(id, td, rs, vis) :: rem ->
+ let p = Pdot(root, Ident.name id) in
+ prefix_idents root
+ ((SigL_type(id, td, rs, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
+ rem
+ | SigL_typext(id, ec, es, vis) :: rem ->
+ let p = Pdot(root, Ident.name id) in
+ (* we extend the substitution in case of an inlined record *)
+ prefix_idents root
+ ((SigL_typext(id, ec, es, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
+ rem
+ | SigL_module(id, pres, md, rs, vis) :: rem ->
+ let p = Pdot(root, Ident.name id) in
+ prefix_idents root
+ ((SigL_module(id, pres, md, rs, vis), p) :: items_and_paths)
+ (Subst.add_module id p prefixing_sub)
+ rem
+ | SigL_modtype(id, mtd, vis) :: rem ->
+ let p = Pdot(root, Ident.name id) in
+ prefix_idents root
+ ((SigL_modtype(id, mtd, vis), p) :: items_and_paths)
+ (Subst.add_modtype id p prefixing_sub)
+ rem
+ | SigL_class(id, cd, rs, vis) :: rem ->
+ (* pretend this is a type, cf. PR#6650 *)
+ let p = Pdot(root, Ident.name id) in
+ prefix_idents root
+ ((SigL_class(id, cd, rs, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
+ rem
+ | SigL_class_type(id, ctd, rs, vis) :: rem ->
+ let p = Pdot(root, Ident.name id) in
+ prefix_idents root
+ ((SigL_class_type(id, ctd, rs, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
+ rem
+ in
+ let sg = Subst.Lazy.force_signature_once sg in
+ prefix_idents root [] prefixing_sub sg
+
+(* Compute structure descriptions *)
+
+let add_to_tbl id decl tbl =
+ let decls = try NameMap.find id tbl with Not_found -> [] in
+ NameMap.add id (decl :: decls) tbl
+
+let value_declaration_address (_ : t) id decl =
+ match decl.val_kind with
+ | Val_prim _ -> Lazy_backtrack.create_failed Not_found
+ | _ -> Lazy_backtrack.create_forced (Aident id)
+
+let extension_declaration_address (_ : t) id (_ : extension_constructor) =
+ Lazy_backtrack.create_forced (Aident id)
+
+let class_declaration_address (_ : t) id (_ : class_declaration) =
+ Lazy_backtrack.create_forced (Aident id)
+
+let module_declaration_address env id presence md =
+ match presence with
+ | Mp_absent -> begin
+ let open Subst.Lazy in
+ match md.mdl_type with
+ | MtyL_alias path -> Lazy_backtrack.create (ModAlias {env; path})
+ | _ -> assert false
+ end
+ | Mp_present ->
+ Lazy_backtrack.create_forced (Aident id)
+
+let rec components_of_module_maker
+ {cm_env; cm_prefixing_subst;
+ cm_path; cm_addr; cm_mty; cm_shape} : _ result =
+ match scrape_alias cm_env cm_mty with
+ MtyL_signature sg ->
+ let c =
+ { comp_values = NameMap.empty;
+ comp_constrs = NameMap.empty;
+ comp_labels = NameMap.empty; comp_types = NameMap.empty;
+ comp_modules = NameMap.empty; comp_modtypes = NameMap.empty;
+ comp_classes = NameMap.empty; comp_cltypes = NameMap.empty }
+ in
+ let items_and_paths, sub =
+ prefix_idents cm_path cm_prefixing_subst sg
+ in
+ let env = ref cm_env in
+ let pos = ref 0 in
+ let next_address () =
+ let addr : address_unforced =
+ Projection { parent = cm_addr; pos = !pos }
+ in
+ incr pos;
+ Lazy_backtrack.create addr
+ in
+ List.iter (fun ((item : Subst.Lazy.signature_item), path) ->
+ match item with
+ SigL_value(id, decl, _) ->
+ let decl' = Subst.value_description sub decl in
+ let addr =
+ match decl.val_kind with
+ | Val_prim _ -> Lazy_backtrack.create_failed Not_found
+ | _ -> next_address ()
+ in
+ let vda_shape = Shape.proj cm_shape (Shape.Item.value id) in
+ let vda =
+ { vda_description = decl'; vda_address = addr; vda_shape }
+ in
+ c.comp_values <- NameMap.add (Ident.name id) vda c.comp_values;
+ | SigL_type(id, decl, _, _) ->
+ let final_decl = Subst.type_declaration sub decl in
+ Btype.set_static_row_name final_decl
+ (Subst.type_path sub (Path.Pident id));
+ let descrs =
+ match decl.type_kind with
+ | Type_variant (_,repr) ->
+ let cstrs = List.map snd
+ (Datarepr.constructors_of_type path final_decl
+ ~current_unit:(get_current_unit ()))
+ in
+ List.iter
+ (fun descr ->
+ let cda_shape = Shape.leaf descr.cstr_uid in
+ let cda = {
+ cda_description = descr;
+ cda_address = None;
+ cda_shape }
+ in
+ c.comp_constrs <-
+ add_to_tbl descr.cstr_name cda c.comp_constrs
+ ) cstrs;
+ Type_variant (cstrs, repr)
+ | Type_record (_, repr) ->
+ let lbls = List.map snd
+ (Datarepr.labels_of_type path final_decl)
+ in
+ List.iter
+ (fun descr ->
+ c.comp_labels <-
+ add_to_tbl descr.lbl_name descr c.comp_labels)
+ lbls;
+ Type_record (lbls, repr)
+ | Type_abstract r -> Type_abstract r
+ | Type_open -> Type_open
+ in
+ let shape = Shape.proj cm_shape (Shape.Item.type_ id) in
+ let tda =
+ { tda_declaration = final_decl;
+ tda_descriptions = descrs;
+ tda_shape = shape; }
+ in
+ c.comp_types <- NameMap.add (Ident.name id) tda c.comp_types;
+ env := store_type_infos ~tda_shape:shape id decl !env
+ | SigL_typext(id, ext, _, _) ->
+ let ext' = Subst.extension_constructor sub ext in
+ let descr =
+ Datarepr.extension_descr ~current_unit:(get_current_unit ()) path
+ ext'
+ in
+ let addr = next_address () in
+ let cda_shape =
+ Shape.proj cm_shape (Shape.Item.extension_constructor id)
+ in
+ let cda =
+ { cda_description = descr; cda_address = Some addr; cda_shape }
+ in
+ c.comp_constrs <- add_to_tbl (Ident.name id) cda c.comp_constrs
+ | SigL_module(id, pres, md, _, _) ->
+ let md' =
+ (* The prefixed items get the same scope as [cm_path], which is
+ the prefix. *)
+ Subst.Lazy.module_decl
+ (Subst.Rescope (Path.scope cm_path)) sub md
+ in
+ let addr =
+ match pres with
+ | Mp_absent -> begin
+ match md.mdl_type with
+ | MtyL_alias path ->
+ Lazy_backtrack.create (ModAlias {env = !env; path})
+ | _ -> assert false
+ end
+ | Mp_present -> next_address ()
+ in
+ let alerts =
+ Builtin_attributes.alerts_of_attrs md.mdl_attributes
+ in
+ let shape = Shape.proj cm_shape (Shape.Item.module_ id) in
+ let comps =
+ components_of_module ~alerts ~uid:md.mdl_uid !env
+ sub path addr md.mdl_type shape
+ in
+ let mda =
+ { mda_declaration = md';
+ mda_components = comps;
+ mda_address = addr;
+ mda_shape = shape; }
+ in
+ c.comp_modules <-
+ NameMap.add (Ident.name id) mda c.comp_modules;
+ env :=
+ store_module ~update_summary:false ~check:None
+ id addr pres md shape !env
+ | SigL_modtype(id, decl, _) ->
+ let final_decl =
+ (* The prefixed items get the same scope as [cm_path], which is
+ the prefix. *)
+ Subst.Lazy.modtype_decl (Rescope (Path.scope cm_path))
+ sub decl
+ in
+ let shape = Shape.proj cm_shape (Shape.Item.module_type id) in
+ let mtda =
+ { mtda_declaration = final_decl;
+ mtda_shape = shape; }
+ in
+ c.comp_modtypes <-
+ NameMap.add (Ident.name id) mtda c.comp_modtypes;
+ env := store_modtype ~update_summary:false id decl shape !env
+ | SigL_class(id, decl, _, _) ->
+ let decl' = Subst.class_declaration sub decl in
+ let addr = next_address () in
+ let shape = Shape.proj cm_shape (Shape.Item.class_ id) in
+ let clda =
+ { clda_declaration = decl';
+ clda_address = addr;
+ clda_shape = shape; }
+ in
+ c.comp_classes <- NameMap.add (Ident.name id) clda c.comp_classes
+ | SigL_class_type(id, decl, _, _) ->
+ let decl' = Subst.cltype_declaration sub decl in
+ let shape = Shape.proj cm_shape (Shape.Item.class_type id) in
+ let cltda = { cltda_declaration = decl'; cltda_shape = shape } in
+ c.comp_cltypes <-
+ NameMap.add (Ident.name id) cltda c.comp_cltypes)
+ items_and_paths;
+ Ok (Structure_comps c)
+ | MtyL_functor(arg, ty_res) ->
+ let sub = cm_prefixing_subst in
+ let scoping = Subst.Rescope (Path.scope cm_path) in
+ let open Subst.Lazy in
+ Ok (Functor_comps {
+ (* fcomp_arg and fcomp_res must be prefixed eagerly, because
+ they are interpreted in the outer environment *)
+ fcomp_arg =
+ (match arg with
+ | Unit -> Unit
+ | Named (param, ty_arg) ->
+ Named (param, force_modtype (modtype scoping sub ty_arg)));
+ fcomp_res = force_modtype (modtype scoping sub ty_res);
+ fcomp_shape = cm_shape;
+ fcomp_cache = Hashtbl.create 17;
+ fcomp_subst_cache = Hashtbl.create 17 })
+ | MtyL_ident _ -> Error No_components_abstract
+ | MtyL_alias p -> Error (No_components_alias p)
+
+(* Insertion of bindings by identifier + path *)
+
+and check_usage loc id uid warn tbl =
+ if not loc.Location.loc_ghost &&
+ Uid.for_actual_declaration uid &&
+ Warnings.is_active (warn "")
+ then begin
+ let name = Ident.name id in
+ if Types.Uid.Tbl.mem tbl uid then ()
+ else let used = ref false in
+ Types.Uid.Tbl.add tbl uid (fun () -> used := true);
+ if not (name = "" || name.[0] = '_' || name.[0] = '#')
+ then
+ !add_delayed_check_forward
+ (fun () -> if not !used then Location.prerr_warning loc (warn name))
+ end;
+
+and check_value_name name loc =
+ (* Note: we could also check here general validity of the
+ identifier, to protect against bad identifiers forged by -pp or
+ -ppx preprocessors. *)
+ if String.length name > 0 && not
+ (Utf8_lexeme.starts_like_a_valid_identifier name) then
+ for i = 1 to String.length name - 1 do
+ if name.[i] = '#' then
+ error (Illegal_value_name(loc, name))
+ done
+
+and store_value ?check id addr decl shape env =
+ check_value_name (Ident.name id) decl.val_loc;
+ Builtin_attributes.mark_alerts_used decl.val_attributes;
+ Option.iter
+ (fun f -> check_usage decl.val_loc id decl.val_uid f !value_declarations)
+ check;
+ let vda =
+ { vda_description = decl;
+ vda_address = addr;
+ vda_shape = shape }
+ in
+ { env with
+ values = IdTbl.add id (Val_bound vda) env.values;
+ summary = Env_value(env.summary, id, decl) }
+
+and store_constructor ~check type_decl type_id cstr_id cstr env =
+ Builtin_attributes.warning_scope cstr.cstr_attributes (fun () ->
+ if check && not type_decl.type_loc.Location.loc_ghost
+ && Warnings.is_active (Warnings.Unused_constructor ("", Unused))
+ then begin
+ let ty_name = Ident.name type_id in
+ let name = cstr.cstr_name in
+ let loc = cstr.cstr_loc in
+ let k = cstr.cstr_uid in
+ let priv = type_decl.type_private in
+ if not (Types.Uid.Tbl.mem !used_constructors k) then begin
+ let used = constructor_usages () in
+ Types.Uid.Tbl.add !used_constructors k
+ (add_constructor_usage used);
+ if not (ty_name = "" || ty_name.[0] = '_')
+ then
+ !add_delayed_check_forward
+ (fun () ->
+ Option.iter
+ (fun complaint ->
+ if not (is_in_signature env) then
+ Location.prerr_warning loc
+ (Warnings.Unused_constructor(name, complaint)))
+ (constructor_usage_complaint ~rebind:false priv used));
+ end;
+ end);
+ Builtin_attributes.mark_alerts_used cstr.cstr_attributes;
+ Builtin_attributes.mark_warn_on_literal_pattern_used cstr.cstr_attributes;
+ let cda_shape = Shape.leaf cstr.cstr_uid in
+ { env with
+ constrs =
+ TycompTbl.add cstr_id
+ { cda_description = cstr; cda_address = None; cda_shape } env.constrs;
+ }
+
+and store_label ~check type_decl type_id lbl_id lbl env =
+ Builtin_attributes.warning_scope lbl.lbl_attributes (fun () ->
+ if check && not type_decl.type_loc.Location.loc_ghost
+ && Warnings.is_active (Warnings.Unused_field ("", Unused))
+ then begin
+ let ty_name = Ident.name type_id in
+ let priv = type_decl.type_private in
+ let name = lbl.lbl_name in
+ let loc = lbl.lbl_loc in
+ let mut = lbl.lbl_mut in
+ let k = lbl.lbl_uid in
+ if not (Types.Uid.Tbl.mem !used_labels k) then
+ let used = label_usages () in
+ Types.Uid.Tbl.add !used_labels k
+ (add_label_usage used);
+ if not (ty_name = "" || ty_name.[0] = '_' || name.[0] = '_')
+ then !add_delayed_check_forward
+ (fun () ->
+ Option.iter
+ (fun complaint ->
+ if not (is_in_signature env) then
+ Location.prerr_warning
+ loc (Warnings.Unused_field(name, complaint)))
+ (label_usage_complaint priv mut used))
+ end);
+ Builtin_attributes.mark_alerts_used lbl.lbl_attributes;
+ if lbl.lbl_mut = Mutable then
+ Builtin_attributes.mark_deprecated_mutable_used lbl.lbl_attributes;
+ { env with
+ labels = TycompTbl.add lbl_id lbl env.labels;
+ }
+
+and store_type ~check id info shape env =
+ let loc = info.type_loc in
+ if check then
+ check_usage loc id info.type_uid
+ (fun s -> Warnings.Unused_type_declaration s)
+ !type_declarations;
+ let descrs, env =
+ let path = Pident id in
+ match info.type_kind with
+ | Type_variant (_,repr) ->
+ let constructors = Datarepr.constructors_of_type path info
+ ~current_unit:(get_current_unit ())
+ in
+ Type_variant (List.map snd constructors, repr),
+ List.fold_left
+ (fun env (cstr_id, cstr) ->
+ store_constructor ~check info id cstr_id cstr env)
+ env constructors
+ | Type_record (_, repr) ->
+ let labels = Datarepr.labels_of_type path info in
+ Type_record (List.map snd labels, repr),
+ List.fold_left
+ (fun env (lbl_id, lbl) ->
+ store_label ~check info id lbl_id lbl env)
+ env labels
+ | Type_abstract r -> Type_abstract r, env
+ | Type_open -> Type_open, env
+ in
+ let tda =
+ { tda_declaration = info;
+ tda_descriptions = descrs;
+ tda_shape = shape }
+ in
+ Builtin_attributes.mark_alerts_used info.type_attributes;
+ { env with
+ types = IdTbl.add id tda env.types;
+ summary = Env_type(env.summary, id, info) }
+
+and store_type_infos ~tda_shape id info env =
+ (* Simplified version of store_type that doesn't compute and store
+ constructor and label infos, but simply record the arity and
+ manifest-ness of the type. Used in components_of_module to
+ keep track of type abbreviations (e.g. type t = float) in the
+ computation of label representations. *)
+ let tda =
+ {
+ tda_declaration = info;
+ tda_descriptions = Type_abstract (Btype.type_origin info);
+ tda_shape
+ }
+ in
+ { env with
+ types = IdTbl.add id tda env.types;
+ summary = Env_type(env.summary, id, info) }
+
+and store_extension ~check ~rebind id addr ext shape env =
+ let loc = ext.ext_loc in
+ let cstr =
+ Datarepr.extension_descr
+ ~current_unit:(get_current_unit ()) (Pident id) ext
+ in
+ let cda =
+ { cda_description = cstr;
+ cda_address = Some addr;
+ cda_shape = shape }
+ in
+ Builtin_attributes.mark_alerts_used ext.ext_attributes;
+ Builtin_attributes.mark_warn_on_literal_pattern_used ext.ext_attributes;
+ Builtin_attributes.warning_scope ext.ext_attributes (fun () ->
+ if check && not loc.Location.loc_ghost &&
+ Warnings.is_active (Warnings.Unused_extension ("", false, Unused))
+ then begin
+ let priv = ext.ext_private in
+ let is_exception = Path.same ext.ext_type_path Predef.path_exn in
+ let name = cstr.cstr_name in
+ let k = cstr.cstr_uid in
+ if not (Types.Uid.Tbl.mem !used_constructors k) then begin
+ let used = constructor_usages () in
+ Types.Uid.Tbl.add !used_constructors k
+ (add_constructor_usage used);
+ !add_delayed_check_forward
+ (fun () ->
+ Option.iter
+ (fun complaint ->
+ if not (is_in_signature env) then
+ Location.prerr_warning loc
+ (Warnings.Unused_extension
+ (name, is_exception, complaint)))
+ (constructor_usage_complaint ~rebind priv used))
+ end;
+ end);
+ { env with
+ constrs = TycompTbl.add id cda env.constrs;
+ summary = Env_extension(env.summary, id, ext) }
+
+and store_module ?(update_summary=true) ~check
+ id addr presence md shape env =
+ let open Subst.Lazy in
+ let loc = md.mdl_loc in
+ Option.iter
+ (fun f -> check_usage loc id md.mdl_uid f !module_declarations) check;
+ Builtin_attributes.mark_alerts_used md.mdl_attributes;
+ let alerts = Builtin_attributes.alerts_of_attrs md.mdl_attributes in
+ let comps =
+ components_of_module ~alerts ~uid:md.mdl_uid
+ env Subst.identity (Pident id) addr md.mdl_type shape
+ in
+ let mda =
+ { mda_declaration = md;
+ mda_components = comps;
+ mda_address = addr;
+ mda_shape = shape }
+ in
+ let summary =
+ if not update_summary then env.summary
+ else Env_module (env.summary, id, presence, force_module_decl md) in
+ { env with
+ modules = IdTbl.add id (Mod_local mda) env.modules;
+ summary }
+
+and store_modtype ?(update_summary=true) id info shape env =
+ Builtin_attributes.mark_alerts_used info.Subst.Lazy.mtdl_attributes;
+ let mtda = { mtda_declaration = info; mtda_shape = shape } in
+ let summary =
+ if not update_summary then env.summary
+ else Env_modtype (env.summary, id, Subst.Lazy.force_modtype_decl info) in
+ { env with
+ modtypes = IdTbl.add id mtda env.modtypes;
+ summary }
+
+and store_class id addr desc shape env =
+ Builtin_attributes.mark_alerts_used desc.cty_attributes;
+ let clda =
+ { clda_declaration = desc;
+ clda_address = addr;
+ clda_shape = shape; }
+ in
+ { env with
+ classes = IdTbl.add id clda env.classes;
+ summary = Env_class(env.summary, id, desc) }
+
+and store_cltype id desc shape env =
+ Builtin_attributes.mark_alerts_used desc.clty_attributes;
+ let cltda = { cltda_declaration = desc; cltda_shape = shape } in
+ { env with
+ cltypes = IdTbl.add id cltda env.cltypes;
+ summary = Env_cltype(env.summary, id, desc) }
+
+let scrape_alias env mty = scrape_alias env mty
+
+(* Compute the components of a functor application in a path. *)
+
+let components_of_functor_appl ~loc ~f_path ~f_comp ~arg env =
+ try
+ let c = Hashtbl.find f_comp.fcomp_cache arg in
+ c
+ with Not_found ->
+ let p = Papply(f_path, arg) in
+ let sub =
+ match f_comp.fcomp_arg with
+ | Unit
+ | Named (None, _) -> Subst.identity
+ | Named (Some param, _) -> Subst.add_module param arg Subst.identity
+ in
+ (* we have to apply eagerly instead of passing sub to [components_of_module]
+ because of the call to [check_well_formed_module]. *)
+ let mty = Subst.modtype (Rescope (Path.scope p)) sub f_comp.fcomp_res in
+ let addr = Lazy_backtrack.create_failed Not_found in
+ !check_well_formed_module env loc
+ ("the signature of " ^ Path.name p) mty;
+ let shape_arg =
+ shape_of_path ~namespace:Shape.Sig_component_kind.Module env arg
+ in
+ let shape = Shape.app f_comp.fcomp_shape ~arg:shape_arg in
+ let comps =
+ components_of_module ~alerts:Misc.Stdlib.String.Map.empty
+ ~uid:Uid.internal_not_actually_unique
+ (*???*)
+ env Subst.identity p addr (Subst.Lazy.of_modtype mty) shape
+ in
+ Hashtbl.add f_comp.fcomp_cache arg comps;
+ comps
+
+(* Define forward functions *)
+
+let _ =
+ components_of_functor_appl' := components_of_functor_appl;
+ components_of_module_maker' := components_of_module_maker
+
+(* Insertion of bindings by identifier *)
+
+let add_functor_arg id env =
+ {env with
+ functor_args = Ident.add id () env.functor_args;
+ summary = Env_functor_arg (env.summary, id)}
+
+let add_value ?check ?shape id desc env =
+ let addr = value_declaration_address env id desc in
+ let shape = shape_or_leaf desc.val_uid shape in
+ store_value ?check id addr desc shape env
+
+let add_type ~check ?shape id info env =
+ let shape = shape_or_leaf info.type_uid shape in
+ store_type ~check id info shape env
+
+and add_extension ~check ?shape ~rebind id ext env =
+ let addr = extension_declaration_address env id ext in
+ let shape = shape_or_leaf ext.ext_uid shape in
+ store_extension ~check ~rebind id addr ext shape env
+
+and add_module_declaration ?(arg=false) ?shape ~check id presence md env =
+ let check =
+ if not check then
+ None
+ else if arg && is_in_signature env then
+ Some (fun s -> Warnings.Unused_functor_parameter s)
+ else
+ Some (fun s -> Warnings.Unused_module s)
+ in
+ let md = Subst.Lazy.of_module_decl md in
+ let addr = module_declaration_address env id presence md in
+ let shape = shape_or_leaf md.mdl_uid shape in
+ let env = store_module ~check id addr presence md shape env in
+ if arg then add_functor_arg id env else env
+
+and add_module_declaration_lazy ~update_summary id presence md env =
+ let addr = module_declaration_address env id presence md in
+ let shape = Shape.leaf md.Subst.Lazy.mdl_uid in
+ let env =
+ store_module ~update_summary ~check:None id addr presence md shape env
+ in
+ env
+
+and add_modtype ?shape id info env =
+ let shape = shape_or_leaf info.mtd_uid shape in
+ store_modtype id (Subst.Lazy.of_modtype_decl info) shape env
+
+and add_modtype_lazy ~update_summary id info env =
+ let shape = Shape.leaf info.Subst.Lazy.mtdl_uid in
+ store_modtype ~update_summary id info shape env
+
+and add_class ?shape id ty env =
+ let addr = class_declaration_address env id ty in
+ let shape = shape_or_leaf ty.cty_uid shape in
+ store_class id addr ty shape env
+
+and add_cltype ?shape id ty env =
+ let shape = shape_or_leaf ty.clty_uid shape in
+ store_cltype id ty shape env
+
+let add_module ?arg ?shape id presence mty env =
+ add_module_declaration ~check:false ?arg ?shape id presence (md mty) env
+
+let add_module_lazy ~update_summary id presence mty env =
+ let md = Subst.Lazy.{mdl_type = mty;
+ mdl_attributes = [];
+ mdl_loc = Location.none;
+ mdl_uid = Uid.internal_not_actually_unique}
+ in
+ add_module_declaration_lazy ~update_summary id presence md env
+
+let add_local_constraint path info env =
+ { env with
+ local_constraints = Path.Map.add path info env.local_constraints }
+
+(* Non-lazy version of scrape_alias *)
+let scrape_alias t mty =
+ mty |> Subst.Lazy.of_modtype |> scrape_alias t |> Subst.Lazy.force_modtype
+
+(* Insertion of bindings by name *)
+
+let enter_value ?check name desc env =
+ let id = Ident.create_local name in
+ let addr = value_declaration_address env id desc in
+ let env = store_value ?check id addr desc (Shape.leaf desc.val_uid) env in
+ (id, env)
+
+let enter_type ~scope name info env =
+ let id = Ident.create_scoped ~scope name in
+ let env = store_type ~check:true id info (Shape.leaf info.type_uid) env in
+ (id, env)
+
+let enter_extension ~scope ~rebind name ext env =
+ let id = Ident.create_scoped ~scope name in
+ let addr = extension_declaration_address env id ext in
+ let shape = Shape.leaf ext.ext_uid in
+ let env = store_extension ~check:true ~rebind id addr ext shape env in
+ (id, env)
+
+let enter_module_declaration ~scope ?arg ?shape s presence md env =
+ let id = Ident.create_scoped ~scope s in
+ (id, add_module_declaration ?arg ?shape ~check:true id presence md env)
+
+let enter_modtype ~scope name mtd env =
+ let id = Ident.create_scoped ~scope name in
+ let shape = Shape.leaf mtd.mtd_uid in
+ let env = store_modtype id (Subst.Lazy.of_modtype_decl mtd) shape env in
+ (id, env)
+
+let enter_class ~scope name desc env =
+ let id = Ident.create_scoped ~scope name in
+ let addr = class_declaration_address env id desc in
+ let env = store_class id addr desc (Shape.leaf desc.cty_uid) env in
+ (id, env)
+
+let enter_cltype ~scope name desc env =
+ let id = Ident.create_scoped ~scope name in
+ let env = store_cltype id desc (Shape.leaf desc.clty_uid) env in
+ (id, env)
+
+let enter_module ~scope ?arg s presence mty env =
+ enter_module_declaration ~scope ?arg s presence (md mty) env
+
+(* Insertion of all components of a signature *)
+
+let add_item (map, mod_shape) comp env =
+ let proj_shape item =
+ match mod_shape with
+ | None -> map, None
+ | Some mod_shape ->
+ let shape = Shape.proj mod_shape item in
+ Shape.Map.add map item shape, Some shape
+ in
+ match comp with
+ | Sig_value(id, decl, _) ->
+ let map, shape = proj_shape (Shape.Item.value id) in
+ map, add_value ?shape id decl env
+ | Sig_type(id, decl, _, _) ->
+ let map, shape = proj_shape (Shape.Item.type_ id) in
+ map, add_type ~check:false ?shape id decl env
+ | Sig_typext(id, ext, _, _) ->
+ let map, shape = proj_shape (Shape.Item.extension_constructor id) in
+ map, add_extension ~check:false ?shape ~rebind:false id ext env
+ | Sig_module(id, presence, md, _, _) ->
+ let map, shape = proj_shape (Shape.Item.module_ id) in
+ map, add_module_declaration ~check:false ?shape id presence md env
+ | Sig_modtype(id, decl, _) ->
+ let map, shape = proj_shape (Shape.Item.module_type id) in
+ map, add_modtype ?shape id decl env
+ | Sig_class(id, decl, _, _) ->
+ let map, shape = proj_shape (Shape.Item.class_ id) in
+ map, add_class ?shape id decl env
+ | Sig_class_type(id, decl, _, _) ->
+ let map, shape = proj_shape (Shape.Item.class_type id) in
+ map, add_cltype ?shape id decl env
+
+let rec add_signature (map, mod_shape) sg env =
+ match sg with
+ [] -> map, env
+ | comp :: rem ->
+ let map, env = add_item (map, mod_shape) comp env in
+ add_signature (map, mod_shape) rem env
+
+let enter_signature_and_shape ~scope ~parent_shape mod_shape sg env =
+ let sg = Subst.signature (Rescope scope) Subst.identity sg in
+ let shape, env = add_signature (parent_shape, mod_shape) sg env in
+ sg, shape, env
+
+let enter_signature ?mod_shape ~scope sg env =
+ let sg, _, env =
+ enter_signature_and_shape ~scope ~parent_shape:Shape.Map.empty
+ mod_shape sg env
+ in
+ sg, env
+
+let enter_signature_and_shape ~scope ~parent_shape mod_shape sg env =
+ enter_signature_and_shape ~scope ~parent_shape (Some mod_shape) sg env
+
+let add_value = add_value ?shape:None
+let add_class = add_class ?shape:None
+let add_cltype = add_cltype ?shape:None
+let add_modtype = add_modtype ?shape:None
+let add_signature sg env =
+ let _, env = add_signature (Shape.Map.empty, None) sg env in
+ env
+
+(* Add "unbound" bindings *)
+
+let enter_unbound_value name reason env =
+ let id = Ident.create_local name in
+ { env with
+ values = IdTbl.add id (Val_unbound reason) env.values;
+ summary = Env_value_unbound(env.summary, name, reason) }
+
+let enter_unbound_module name reason env =
+ let id = Ident.create_local name in
+ { env with
+ modules = IdTbl.add id (Mod_unbound reason) env.modules;
+ summary = Env_module_unbound(env.summary, name, reason) }
+
+(* Open a signature path *)
+
+let add_components slot root env0 comps =
+ let add_l w comps env0 =
+ TycompTbl.add_open slot w root comps env0
+ in
+ let add w comps env0 = IdTbl.add_open slot w root comps env0 in
+ let constrs =
+ add_l (fun x -> `Constructor x) comps.comp_constrs env0.constrs
+ in
+ let labels =
+ add_l (fun x -> `Label x) comps.comp_labels env0.labels
+ in
+ let values =
+ add (fun x -> `Value x) comps.comp_values env0.values
+ in
+ let types =
+ add (fun x -> `Type x) comps.comp_types env0.types
+ in
+ let modtypes =
+ add (fun x -> `Module_type x) comps.comp_modtypes env0.modtypes
+ in
+ let classes =
+ add (fun x -> `Class x) comps.comp_classes env0.classes
+ in
+ let cltypes =
+ add (fun x -> `Class_type x) comps.comp_cltypes env0.cltypes
+ in
+ let modules =
+ add (fun x -> `Module x) comps.comp_modules env0.modules
+ in
+ { env0 with
+ summary = Env_open(env0.summary, root);
+ constrs;
+ labels;
+ values;
+ types;
+ modtypes;
+ classes;
+ cltypes;
+ modules;
+ }
+
+let open_signature slot root env0 : (_,_) result =
+ match get_components_res (find_module_components root env0) with
+ | Error _ -> Error `Not_found
+ | exception Not_found -> Error `Not_found
+ | Ok (Functor_comps _) -> Error `Functor
+ | Ok (Structure_comps comps) ->
+ Ok (add_components slot root env0 comps)
+
+let remove_last_open root env0 =
+ let rec filter_summary summary =
+ match summary with
+ Env_empty -> raise Exit
+ | Env_open (s, p) ->
+ if Path.same p root then s else raise Exit
+ | Env_value _
+ | Env_type _
+ | Env_extension _
+ | Env_module _
+ | Env_modtype _
+ | Env_class _
+ | Env_cltype _
+ | Env_functor_arg _
+ | Env_constraints _
+ | Env_persistent _
+ | Env_copy_types _
+ | Env_value_unbound _
+ | Env_module_unbound _ ->
+ map_summary filter_summary summary
+ in
+ match filter_summary env0.summary with
+ | summary ->
+ let rem_l tbl = TycompTbl.remove_last_open root tbl
+ and rem tbl = IdTbl.remove_last_open root tbl in
+ Some { env0 with
+ summary;
+ constrs = rem_l env0.constrs;
+ labels = rem_l env0.labels;
+ values = rem env0.values;
+ types = rem env0.types;
+ modtypes = rem env0.modtypes;
+ classes = rem env0.classes;
+ cltypes = rem env0.cltypes;
+ modules = rem env0.modules; }
+ | exception Exit ->
+ None
+
+(* Open a signature from a file *)
+
+let open_pers_signature name env =
+ match open_signature None (Pident(Ident.create_persistent name)) env with
+ | (Ok _ | Error `Not_found as res) -> res
+ | Error `Functor -> assert false
+ (* a compilation unit cannot refer to a functor *)
+
+let open_signature
+ ?(used_slot = ref false)
+ ?(loc = Location.none) ?(toplevel = false)
+ ovf root env =
+ let unused =
+ match ovf with
+ | Asttypes.Fresh -> Warnings.Unused_open (Path.name root)
+ | Asttypes.Override -> Warnings.Unused_open_bang (Path.name root)
+ in
+ let warn_unused =
+ Warnings.is_active unused
+ and warn_shadow_id =
+ Warnings.is_active (Warnings.Open_shadow_identifier ("", ""))
+ and warn_shadow_lc =
+ Warnings.is_active (Warnings.Open_shadow_label_constructor ("",""))
+ in
+ if not toplevel && not loc.Location.loc_ghost
+ && (warn_unused || warn_shadow_id || warn_shadow_lc)
+ then begin
+ let used = used_slot in
+ if warn_unused then
+ !add_delayed_check_forward
+ (fun () ->
+ if not !used then begin
+ used := true;
+ Location.prerr_warning loc unused
+ end
+ );
+ let shadowed = ref [] in
+ let slot s b =
+ begin match check_shadowing env b with
+ | Some kind when
+ ovf = Asttypes.Fresh && not (List.mem (kind, s) !shadowed) ->
+ shadowed := (kind, s) :: !shadowed;
+ let w =
+ match kind with
+ | "label" | "constructor" ->
+ Warnings.Open_shadow_label_constructor (kind, s)
+ | _ -> Warnings.Open_shadow_identifier (kind, s)
+ in
+ Location.prerr_warning loc w
+ | _ -> ()
+ end;
+ used := true
+ in
+ open_signature (Some slot) root env
+ end
+ else open_signature None root env
+
+(* Read a signature from a file *)
+let read_signature u =
+ let mda = read_pers_mod u in
+ let md = Subst.Lazy.force_module_decl mda.mda_declaration in
+ match md.md_type with
+ | Mty_signature sg -> sg
+ | Mty_ident _ | Mty_functor _ | Mty_alias _ -> assert false
+
+
+let unit_name_of_filename fn =
+ match Filename.extension fn with
+ | ".cmi" ->
+ let modname = Unit_info.strict_modname_from_source fn in
+ if Unit_info.is_unit_name modname then Some modname
+ else None
+ | _ -> None
+
+let persistent_structures_of_dir dir =
+ Load_path.Dir.files dir
+ |> List.to_seq
+ |> Seq.filter_map unit_name_of_filename
+ |> String.Set.of_seq
+
+(* Save a signature to a file *)
+let save_signature_with_transform cmi_transform ~alerts sg cmi_info =
+ Btype.cleanup_abbrev ();
+ Subst.reset_for_saving ();
+ let sg = Subst.signature Make_local (Subst.for_saving Subst.identity) sg in
+ let cmi =
+ Persistent_env.make_cmi !persistent_env
+ (Unit_info.Artifact.modname cmi_info) sg alerts
+ |> cmi_transform in
+ let filename = Unit_info.Artifact.filename cmi_info in
+ let pers_sig =
+ Persistent_env.Persistent_signature.{ cmi; filename; visibility = Visible }
+ in
+ let pm = save_sign_of_cmi pers_sig in
+ Persistent_env.save_cmi !persistent_env pers_sig pm;
+ cmi
+
+let save_signature ~alerts sg cmi =
+ save_signature_with_transform (fun cmi -> cmi) ~alerts sg cmi
+
+let save_signature_with_imports ~alerts sg cmi imports =
+ let with_imports cmi = { cmi with cmi_crcs = imports } in
+ save_signature_with_transform with_imports ~alerts sg cmi
+
+(* Make the initial environment *)
+let initial =
+ Predef.build_initial_env
+ (add_type ~check:false)
+ (add_extension ~check:false ~rebind:false)
+ empty
+
+(* Tracking usage *)
+
+let mark_module_used uid =
+ match Types.Uid.Tbl.find !module_declarations uid with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_modtype_used _uid = ()
+
+let mark_value_used uid =
+ match Types.Uid.Tbl.find !value_declarations uid with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_type_used uid =
+ match Types.Uid.Tbl.find !type_declarations uid with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_type_path_used env path =
+ match find_type path env with
+ | decl -> mark_type_used decl.type_uid
+ | exception Not_found -> ()
+
+let mark_constructor_used usage cd =
+ match Types.Uid.Tbl.find !used_constructors cd.cd_uid with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_extension_used usage ext =
+ match Types.Uid.Tbl.find !used_constructors ext.ext_uid with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_label_used usage ld =
+ match Types.Uid.Tbl.find !used_labels ld.ld_uid with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_constructor_description_used usage env cstr =
+ let ty_path = Btype.cstr_type_path cstr in
+ mark_type_path_used env ty_path;
+ match Types.Uid.Tbl.find !used_constructors cstr.cstr_uid with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_label_description_used usage env lbl =
+ let ty_path =
+ match get_desc lbl.lbl_res with
+ | Tconstr(path, _, _) -> path
+ | _ -> assert false
+ in
+ mark_type_path_used env ty_path;
+ match Types.Uid.Tbl.find !used_labels lbl.lbl_uid with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_class_used uid =
+ match Types.Uid.Tbl.find !type_declarations uid with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_cltype_used uid =
+ match Types.Uid.Tbl.find !type_declarations uid with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let set_value_used_callback vd callback =
+ Types.Uid.Tbl.add !value_declarations vd.val_uid callback
+
+let set_type_used_callback td callback =
+ if Uid.for_actual_declaration td.type_uid then
+ let old =
+ try Types.Uid.Tbl.find !type_declarations td.type_uid
+ with Not_found -> ignore
+ in
+ Types.Uid.Tbl.replace !type_declarations td.type_uid
+ (fun () -> callback old)
+
+(* Lookup by name *)
+
+let may_lookup_error report_errors loc env err =
+ if report_errors then lookup_error loc env err
+ else raise Not_found
+
+let report_module_unbound ~errors ~loc env reason =
+ match reason with
+ | Mod_unbound_illegal_recursion ->
+ (* see #5965 *)
+ may_lookup_error errors loc env Illegal_reference_to_recursive_module
+
+let report_value_unbound ~errors ~loc env reason lid =
+ match reason with
+ | Val_unbound_instance_variable ->
+ may_lookup_error errors loc env (Masked_instance_variable lid)
+ | Val_unbound_self ->
+ may_lookup_error errors loc env (Masked_self_variable lid)
+ | Val_unbound_ancestor ->
+ may_lookup_error errors loc env (Masked_ancestor_variable lid)
+ | Val_unbound_ghost_recursive rloc ->
+ let show_hint =
+ (* Only display the "missing rec" hint for non-ghost code *)
+ not loc.Location.loc_ghost
+ && not rloc.Location.loc_ghost
+ in
+ let hint =
+ if show_hint then Missing_rec rloc else No_hint
+ in
+ may_lookup_error errors loc env (Unbound_value(lid, hint))
+
+let use_module ~use ~loc path mda =
+ if use then begin
+ let comps = mda.mda_components in
+ mark_module_used comps.uid;
+ Misc.Stdlib.String.Map.iter
+ (fun kind message ->
+ let message = if message = "" then "" else "\n" ^ message in
+ Location.alert ~kind loc
+ (Printf.sprintf "module %s%s" (Path.name path) message)
+ )
+ comps.alerts
+ end
+
+let use_value ~use ~loc path vda =
+ if use then begin
+ let desc = vda.vda_description in
+ mark_value_used desc.val_uid;
+ Builtin_attributes.check_alerts loc desc.val_attributes
+ (Path.name path)
+ end
+
+let use_type ~use ~loc path tda =
+ if use then begin
+ let decl = tda.tda_declaration in
+ mark_type_used decl.type_uid;
+ Builtin_attributes.check_alerts loc decl.type_attributes
+ (Path.name path)
+ end
+
+let use_modtype ~use ~loc path desc =
+ let open Subst.Lazy in
+ if use then begin
+ mark_modtype_used desc.mtdl_uid;
+ Builtin_attributes.check_alerts loc desc.mtdl_attributes
+ (Path.name path)
+ end
+
+let use_class ~use ~loc path clda =
+ if use then begin
+ let desc = clda.clda_declaration in
+ mark_class_used desc.cty_uid;
+ Builtin_attributes.check_alerts loc desc.cty_attributes
+ (Path.name path)
+ end
+
+let use_cltype ~use ~loc path desc =
+ if use then begin
+ mark_cltype_used desc.clty_uid;
+ Builtin_attributes.check_alerts loc desc.clty_attributes
+ (Path.name path)
+ end
+
+let use_label ~use ~loc usage env lbl =
+ if use then begin
+ mark_label_description_used usage env lbl;
+ Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name;
+ if is_mutating_label_usage usage then
+ Builtin_attributes.check_deprecated_mutable loc lbl.lbl_attributes
+ lbl.lbl_name
+ end
+
+let use_constructor_desc ~use ~loc usage env cstr =
+ if use then begin
+ mark_constructor_description_used usage env cstr;
+ Builtin_attributes.check_alerts loc cstr.cstr_attributes cstr.cstr_name
+ end
+
+let use_constructor ~use ~loc usage env cda =
+ use_constructor_desc ~use ~loc usage env cda.cda_description
+
+type _ load =
+ | Load : module_data load
+ | Don't_load : unit load
+
+let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env =
+ let path, data =
+ match find_name_module ~mark:use s env.modules with
+ | res -> res
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_module (Lident s))
+ in
+ match data with
+ | Mod_local mda -> begin
+ use_module ~use ~loc path mda;
+ match load with
+ | Load -> path, (mda : a)
+ | Don't_load -> path, (() : a)
+ end
+ | Mod_unbound reason ->
+ report_module_unbound ~errors ~loc env reason
+ | Mod_persistent -> begin
+ match load with
+ | Don't_load ->
+ check_pers_mod ~allow_hidden:false ~loc s;
+ path, (() : a)
+ | Load -> begin
+ match find_pers_mod ~allow_hidden:false s with
+ | mda ->
+ use_module ~use ~loc path mda;
+ path, (mda : a)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_module (Lident s))
+ end
+ end
+
+let lookup_ident_value ~errors ~use ~loc name env =
+ match IdTbl.find_name wrap_value ~mark:use name env.values with
+ | (path, Val_bound vda) ->
+ use_value ~use ~loc path vda;
+ path, vda.vda_description
+ | (_, Val_unbound reason) ->
+ report_value_unbound ~errors ~loc env reason (Lident name)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_value (Lident name, No_hint))
+
+let lookup_ident_type ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.types with
+ | (path, data) as res ->
+ use_type ~use ~loc path data;
+ res
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_type (Lident s))
+
+let lookup_ident_modtype ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.modtypes with
+ | (path, data) ->
+ use_modtype ~use ~loc path data.mtda_declaration;
+ (path, data.mtda_declaration)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_modtype (Lident s))
+
+let lookup_ident_class ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.classes with
+ | (path, clda) ->
+ use_class ~use ~loc path clda;
+ path, clda.clda_declaration
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_class (Lident s))
+
+let lookup_ident_cltype ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.cltypes with
+ | path, cltda ->
+ use_cltype ~use ~loc path cltda.cltda_declaration;
+ path, cltda.cltda_declaration
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_cltype (Lident s))
+
+let lookup_all_ident_labels ~errors ~use ~loc usage s env =
+ match TycompTbl.find_all ~mark:use s env.labels with
+ | [] -> may_lookup_error errors loc env (Unbound_label (Lident s))
+ | lbls -> begin
+ List.map
+ (fun (lbl, use_fn) ->
+ let use_fn () =
+ use_label ~use ~loc usage env lbl;
+ use_fn ()
+ in
+ (lbl, use_fn))
+ lbls
+ end
+
+let lookup_all_ident_constructors ~errors ~use ~loc usage s env =
+ match TycompTbl.find_all ~mark:use s env.constrs with
+ | [] -> may_lookup_error errors loc env (Unbound_constructor (Lident s))
+ | cstrs ->
+ List.map
+ (fun (cda, use_fn) ->
+ let use_fn () =
+ use_constructor ~use ~loc usage env cda;
+ use_fn ()
+ in
+ (cda.cda_description, use_fn))
+ cstrs
+
+let rec lookup_module_components ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s ->
+ let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
+ path, data.mda_components
+ | Ldot(l, s) ->
+ let path, data = lookup_dot_module ~errors ~use ~loc l s env in
+ path, data.mda_components
+ | Lapply _ as lid ->
+ let f_path, f_comp, arg = lookup_apply ~errors ~use ~loc lid env in
+ let comps =
+ !components_of_functor_appl' ~loc ~f_path ~f_comp ~arg env in
+ Papply (f_path, arg), comps
+
+and lookup_structure_components ~errors ~use ~loc lid env =
+ let path, comps = lookup_module_components ~errors ~use ~loc lid env in
+ match get_components_res comps with
+ | Ok (Structure_comps comps) -> path, comps
+ | Ok (Functor_comps _) ->
+ may_lookup_error errors loc env (Functor_used_as_structure lid)
+ | Error No_components_abstract ->
+ may_lookup_error errors loc env (Abstract_used_as_structure lid)
+ | Error (No_components_alias p) ->
+ may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
+
+and get_functor_components ~errors ~loc lid env comps =
+ match get_components_res comps with
+ | Ok (Functor_comps fcomps) -> begin
+ match fcomps.fcomp_arg with
+ | Unit -> (* PR#7611 *)
+ may_lookup_error errors loc env (Generative_used_as_applicative lid)
+ | Named (_, arg) -> fcomps, arg
+ end
+ | Ok (Structure_comps _) ->
+ may_lookup_error errors loc env (Structure_used_as_functor lid)
+ | Error No_components_abstract ->
+ may_lookup_error errors loc env (Abstract_used_as_functor lid)
+ | Error (No_components_alias p) ->
+ may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
+
+and lookup_all_args ~errors ~use ~loc lid0 env =
+ let rec loop_lid_arg args = function
+ | Lident _ | Ldot _ as f_lid ->
+ (f_lid, args)
+ | Lapply (f_lid, arg_lid) ->
+ let arg_path, arg_md = lookup_module ~errors ~use ~loc arg_lid env in
+ loop_lid_arg ((f_lid,arg_path,arg_md.md_type)::args) f_lid
+ in
+ loop_lid_arg [] lid0
+
+and lookup_apply ~errors ~use ~loc lid0 env =
+ let f0_lid, args0 = lookup_all_args ~errors ~use ~loc lid0 env in
+ let args_for_errors = List.map (fun (_,p,mty) -> (p,mty)) args0 in
+ let f0_path, f0_comp =
+ lookup_module_components ~errors ~use ~loc f0_lid env
+ in
+ let check_one_apply ~errors ~loc ~f_lid ~f_comp ~arg_path ~arg_mty env =
+ let f_comp, param_mty =
+ get_functor_components ~errors ~loc f_lid env f_comp
+ in
+ check_functor_appl
+ ~errors ~loc ~lid_whole_app:lid0
+ ~f0_path ~args:args_for_errors ~f_comp
+ ~arg_path ~arg_mty ~param_mty
+ env;
+ arg_path, f_comp
+ in
+ let rec check_apply ~path:f_path ~comp:f_comp = function
+ | [] -> invalid_arg "Env.lookup_apply: empty argument list"
+ | [ f_lid, arg_path, arg_mty ] ->
+ let arg_path, comps =
+ check_one_apply ~errors ~loc ~f_lid ~f_comp
+ ~arg_path ~arg_mty env
+ in
+ f_path, comps, arg_path
+ | (f_lid, arg_path, arg_mty) :: args ->
+ let arg_path, f_comp =
+ check_one_apply ~errors ~loc ~f_lid ~f_comp
+ ~arg_path ~arg_mty env
+ in
+ let comp =
+ !components_of_functor_appl' ~loc ~f_path ~f_comp ~arg:arg_path env
+ in
+ let path = Papply (f_path, arg_path) in
+ check_apply ~path ~comp args
+ in
+ check_apply ~path:f0_path ~comp:f0_comp args0
+
+and lookup_module ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s ->
+ let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
+ let md = Subst.Lazy.force_module_decl data.mda_declaration in
+ path, md
+ | Ldot(l, s) ->
+ let path, data = lookup_dot_module ~errors ~use ~loc l s env in
+ let md = Subst.Lazy.force_module_decl data.mda_declaration in
+ path, md
+ | Lapply _ as lid ->
+ let path_f, comp_f, path_arg = lookup_apply ~errors ~use ~loc lid env in
+ let md = md (modtype_of_functor_appl comp_f path_f path_arg) in
+ Papply(path_f, path_arg), md
+
+and lookup_dot_module ~errors ~use ~loc l s env =
+ let p, comps = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_modules with
+ | mda ->
+ let path = Pdot(p, s) in
+ use_module ~use ~loc path mda;
+ (path, mda)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_module (Ldot(l, s)))
+
+let lookup_dot_value ~errors ~use ~loc l s env =
+ let (path, comps) =
+ lookup_structure_components ~errors ~use ~loc l env
+ in
+ match NameMap.find s comps.comp_values with
+ | vda ->
+ let path = Pdot(path, s) in
+ use_value ~use ~loc path vda;
+ (path, vda.vda_description)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_value (Ldot(l, s), No_hint))
+
+let lookup_dot_type ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_types with
+ | tda ->
+ let path = Pdot(p, s) in
+ use_type ~use ~loc path tda;
+ (path, tda)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_type (Ldot(l, s)))
+
+let lookup_dot_modtype ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_modtypes with
+ | mta ->
+ let path = Pdot(p, s) in
+ use_modtype ~use ~loc path mta.mtda_declaration;
+ (path, mta.mtda_declaration)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_modtype (Ldot(l, s)))
+
+let lookup_dot_class ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_classes with
+ | clda ->
+ let path = Pdot(p, s) in
+ use_class ~use ~loc path clda;
+ (path, clda.clda_declaration)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_class (Ldot(l, s)))
+
+let lookup_dot_cltype ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_cltypes with
+ | cltda ->
+ let path = Pdot(p, s) in
+ use_cltype ~use ~loc path cltda.cltda_declaration;
+ (path, cltda.cltda_declaration)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_cltype (Ldot(l, s)))
+
+let lookup_all_dot_labels ~errors ~use ~loc usage l s env =
+ let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_labels with
+ | [] | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_label (Ldot(l, s)))
+ | lbls ->
+ List.map
+ (fun lbl ->
+ let use_fun () = use_label ~use ~loc usage env lbl in
+ (lbl, use_fun))
+ lbls
+
+let lookup_all_dot_constructors ~errors ~use ~loc usage l s env =
+ match l with
+ | Longident.Lident "*predef*" ->
+ (* Hack to support compilation of default arguments *)
+ lookup_all_ident_constructors
+ ~errors ~use ~loc usage s initial
+ | _ ->
+ let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_constrs with
+ | [] | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_constructor (Ldot(l, s)))
+ | cstrs ->
+ List.map
+ (fun cda ->
+ let use_fun () = use_constructor ~use ~loc usage env cda in
+ (cda.cda_description, use_fun))
+ cstrs
+
+(* General forms of the lookup functions *)
+
+let lookup_module_path ~errors ~use ~loc ~load lid env : Path.t =
+ match lid with
+ | Lident s ->
+ if !Clflags.transparent_modules && not load then
+ fst (lookup_ident_module Don't_load ~errors ~use ~loc s env)
+ else
+ fst (lookup_ident_module Load ~errors ~use ~loc s env)
+ | Ldot(l, s) -> fst (lookup_dot_module ~errors ~use ~loc l s env)
+ | Lapply _ as lid ->
+ let path_f, _comp_f, path_arg = lookup_apply ~errors ~use ~loc lid env in
+ Papply(path_f, path_arg)
+
+let lookup_value ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_value ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_value ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_type_full ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_type ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_type ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_type ~errors ~use ~loc lid env =
+ let (path, tda) = lookup_type_full ~errors ~use ~loc lid env in
+ path, tda.tda_declaration
+
+let lookup_modtype_lazy ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_modtype ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_modtype ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_modtype ~errors ~use ~loc lid env =
+ let (path, mt) = lookup_modtype_lazy ~errors ~use ~loc lid env in
+ path, Subst.Lazy.force_modtype_decl mt
+
+let lookup_class ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_class ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_class ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_cltype ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_cltype ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_cltype ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_all_labels ~errors ~use ~loc usage lid env =
+ match lid with
+ | Lident s -> lookup_all_ident_labels ~errors ~use ~loc usage s env
+ | Ldot(l, s) -> lookup_all_dot_labels ~errors ~use ~loc usage l s env
+ | Lapply _ -> assert false
+
+let lookup_label ~errors ~use ~loc usage lid env =
+ match lookup_all_labels ~errors ~use ~loc usage lid env with
+ | [] -> assert false
+ | (desc, use) :: _ -> use (); desc
+
+let lookup_all_labels_from_type ~use ~loc usage ty_path env =
+ match find_type_descrs ty_path env with
+ | exception Not_found -> []
+ | Type_variant _ | Type_abstract _ | Type_open -> []
+ | Type_record (lbls, _) ->
+ List.map
+ (fun lbl ->
+ let use_fun () = use_label ~use ~loc usage env lbl in
+ (lbl, use_fun))
+ lbls
+
+let lookup_all_constructors ~errors ~use ~loc usage lid env =
+ match lid with
+ | Lident s -> lookup_all_ident_constructors ~errors ~use ~loc usage s env
+ | Ldot(l, s) -> lookup_all_dot_constructors ~errors ~use ~loc usage l s env
+ | Lapply _ -> assert false
+
+let lookup_constructor ~errors ~use ~loc usage lid env =
+ match lookup_all_constructors ~errors ~use ~loc usage lid env with
+ | [] -> assert false
+ | (desc, use) :: _ -> use (); desc
+
+let lookup_all_constructors_from_type ~use ~loc usage ty_path env =
+ match find_type_descrs ty_path env with
+ | exception Not_found -> []
+ | Type_record _ | Type_abstract _ | Type_open -> []
+ | Type_variant (cstrs, _) ->
+ List.map
+ (fun cstr ->
+ let use_fun () =
+ use_constructor_desc ~use ~loc usage env cstr
+ in
+ (cstr, use_fun))
+ cstrs
+
+(* Lookup functions that do not mark the item as used or
+ warn if it has alerts, and raise [Not_found] rather
+ than report errors *)
+
+let find_module_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_module ~errors:false ~use:false ~loc lid env
+
+let find_value_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_value ~errors:false ~use:false ~loc lid env
+
+let find_type_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_type ~errors:false ~use:false ~loc lid env
+
+let find_modtype_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_modtype ~errors:false ~use:false ~loc lid env
+
+let find_class_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_class ~errors:false ~use:false ~loc lid env
+
+let find_cltype_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_cltype ~errors:false ~use:false ~loc lid env
+
+let find_constructor_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_constructor ~errors:false ~use:false ~loc Positive lid env
+
+let find_label_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_label ~errors:false ~use:false ~loc Projection lid env
+
+(* Stable name lookup for printing *)
+
+let find_index_tbl ident tbl =
+ let lbs = IdTbl.find_all_idents (Ident.name ident) tbl in
+ let find_ident (n,p) = match p with
+ | Some id -> if Ident.same ident id then Some n else None
+ | _ -> None
+ in
+ Seq.find_map find_ident @@ Seq.mapi (fun i x -> i,x) lbs
+
+let find_value_index id env = find_index_tbl id env.values
+let find_type_index id env = find_index_tbl id env.types
+let find_module_index id env = find_index_tbl id env.modules
+let find_modtype_index id env = find_index_tbl id env.modtypes
+let find_class_index id env = find_index_tbl id env.classes
+let find_cltype_index id env = find_index_tbl id env.cltypes
+
+(* Ordinary lookup functions *)
+
+let lookup_module_path ?(use=true) ~loc ~load lid env =
+ lookup_module_path ~errors:true ~use ~loc ~load lid env
+
+let lookup_module ?(use=true) ~loc lid env =
+ lookup_module ~errors:true ~use ~loc lid env
+
+let lookup_value ?(use=true) ~loc lid env =
+ check_value_name (Longident.last lid) loc;
+ lookup_value ~errors:true ~use ~loc lid env
+
+let lookup_type ?(use=true) ~loc lid env =
+ lookup_type ~errors:true ~use ~loc lid env
+
+let lookup_modtype ?(use=true) ~loc lid env =
+ lookup_modtype ~errors:true ~use ~loc lid env
+
+let lookup_modtype_path ?(use=true) ~loc lid env =
+ fst (lookup_modtype_lazy ~errors:true ~use ~loc lid env)
+
+let lookup_class ?(use=true) ~loc lid env =
+ lookup_class ~errors:true ~use ~loc lid env
+
+let lookup_cltype ?(use=true) ~loc lid env =
+ lookup_cltype ~errors:true ~use ~loc lid env
+
+let lookup_all_constructors ?(use=true) ~loc usage lid env =
+ match lookup_all_constructors ~errors:true ~use ~loc usage lid env with
+ | exception Error(Lookup_error(loc', env', err)) ->
+ (Error(loc', env', err) : _ result)
+ | cstrs -> Ok cstrs
+
+let lookup_constructor ?(use=true) ~loc lid env =
+ lookup_constructor ~errors:true ~use ~loc lid env
+
+let lookup_all_constructors_from_type ?(use=true) ~loc usage ty_path env =
+ lookup_all_constructors_from_type ~use ~loc usage ty_path env
+
+let lookup_all_labels ?(use=true) ~loc usage lid env =
+ match lookup_all_labels ~errors:true ~use ~loc usage lid env with
+ | exception Error(Lookup_error(loc', env', err)) ->
+ (Error(loc', env', err) : _ result)
+ | lbls -> Ok lbls
+
+let lookup_label ?(use=true) ~loc lid env =
+ lookup_label ~errors:true ~use ~loc lid env
+
+let lookup_all_labels_from_type ?(use=true) ~loc usage ty_path env =
+ lookup_all_labels_from_type ~use ~loc usage ty_path env
+
+let lookup_instance_variable ?(use=true) ~loc name env =
+ match IdTbl.find_name wrap_value ~mark:use name env.values with
+ | (path, Val_bound vda) -> begin
+ let desc = vda.vda_description in
+ match desc.val_kind with
+ | Val_ivar(mut, cl_num) ->
+ use_value ~use ~loc path vda;
+ path, mut, cl_num, desc.val_type
+ | _ ->
+ lookup_error loc env (Not_an_instance_variable name)
+ end
+ | (_, Val_unbound Val_unbound_instance_variable) ->
+ lookup_error loc env (Masked_instance_variable (Lident name))
+ | (_, Val_unbound Val_unbound_self) ->
+ lookup_error loc env (Not_an_instance_variable name)
+ | (_, Val_unbound Val_unbound_ancestor) ->
+ lookup_error loc env (Not_an_instance_variable name)
+ | (_, Val_unbound Val_unbound_ghost_recursive _) ->
+ lookup_error loc env (Unbound_instance_variable name)
+ | exception Not_found ->
+ lookup_error loc env (Unbound_instance_variable name)
+
+(* Checking if a name is bound *)
+
+let bound_module name env =
+ match IdTbl.find_name wrap_module ~mark:false name env.modules with
+ | _ -> true
+ | exception Not_found ->
+ if Current_unit.Name.is name then false
+ else begin
+ match find_pers_mod ~allow_hidden:false name with
+ | _ -> true
+ | exception Not_found -> false
+ end
+
+let bound wrap proj name env =
+ match IdTbl.find_name wrap ~mark:false name (proj env) with
+ | _ -> true
+ | exception Not_found -> false
+
+let bound_value name env =
+ bound wrap_value (fun env -> env.values) name env
+
+let bound_type name env =
+ bound wrap_identity (fun env -> env.types) name env
+
+let bound_modtype name env =
+ bound wrap_identity (fun env -> env.modtypes) name env
+
+let bound_class name env =
+ bound wrap_identity (fun env -> env.classes) name env
+
+let bound_cltype name env =
+ bound wrap_identity (fun env -> env.cltypes) name env
+
+(* Folding on environments *)
+
+let find_all wrap proj1 proj2 f lid env acc =
+ match lid with
+ | None ->
+ IdTbl.fold_name wrap
+ (fun name (p, data) acc -> f name p data acc)
+ (proj1 env) acc
+ | Some l ->
+ let p, desc =
+ lookup_module_components
+ ~errors:false ~use:false ~loc:Location.none l env
+ in
+ begin match get_components desc with
+ | Structure_comps c ->
+ NameMap.fold
+ (fun s data acc -> f s (Pdot (p, s)) (wrap data) acc)
+ (proj2 c) acc
+ | Functor_comps _ ->
+ acc
+ end
+
+let find_all_simple_list proj1 proj2 f lid env acc =
+ match lid with
+ | None ->
+ TycompTbl.fold_name
+ (fun data acc -> f data acc)
+ (proj1 env) acc
+ | Some l ->
+ let (_p, desc) =
+ lookup_module_components
+ ~errors:false ~use:false ~loc:Location.none l env
+ in
+ begin match get_components desc with
+ | Structure_comps c ->
+ NameMap.fold
+ (fun _s comps acc ->
+ match comps with
+ | [] -> acc
+ | data :: _ -> f data acc)
+ (proj2 c) acc
+ | Functor_comps _ ->
+ acc
+ end
+
+let fold_modules f lid env acc =
+ match lid with
+ | None ->
+ IdTbl.fold_name wrap_module
+ (fun name (p, entry) acc ->
+ match entry with
+ | Mod_unbound _ -> acc
+ | Mod_local mda ->
+ let md =
+ Subst.Lazy.force_module_decl mda.mda_declaration
+ in
+ f name p md acc
+ | Mod_persistent ->
+ match Persistent_env.find_in_cache !persistent_env name with
+ | None -> acc
+ | Some mda ->
+ let md =
+ Subst.Lazy.force_module_decl mda.mda_declaration
+ in
+ f name p md acc)
+ env.modules
+ acc
+ | Some l ->
+ let p, desc =
+ lookup_module_components
+ ~errors:false ~use:false ~loc:Location.none l env
+ in
+ begin match get_components desc with
+ | Structure_comps c ->
+ NameMap.fold
+ (fun s mda acc ->
+ let md =
+ Subst.Lazy.force_module_decl mda.mda_declaration
+ in
+ f s (Pdot (p, s)) md acc)
+ c.comp_modules
+ acc
+ | Functor_comps _ ->
+ acc
+ end
+
+let fold_values f =
+ find_all wrap_value (fun env -> env.values) (fun sc -> sc.comp_values)
+ (fun k p ve acc ->
+ match ve with
+ | Val_unbound _ -> acc
+ | Val_bound vda -> f k p vda.vda_description acc)
+and fold_constructors f =
+ find_all_simple_list (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
+ (fun cda acc -> f cda.cda_description acc)
+and fold_labels f =
+ find_all_simple_list (fun env -> env.labels) (fun sc -> sc.comp_labels) f
+and fold_types f =
+ find_all wrap_identity
+ (fun env -> env.types) (fun sc -> sc.comp_types)
+ (fun k p tda acc -> f k p tda.tda_declaration acc)
+and fold_modtypes f =
+ let f l path data acc = f l path (Subst.Lazy.force_modtype_decl data) acc in
+ find_all wrap_identity
+ (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
+ (fun k p mta acc -> f k p mta.mtda_declaration acc)
+and fold_classes f =
+ find_all wrap_identity (fun env -> env.classes) (fun sc -> sc.comp_classes)
+ (fun k p clda acc -> f k p clda.clda_declaration acc)
+and fold_cltypes f =
+ find_all wrap_identity
+ (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+ (fun k p cltda acc -> f k p cltda.cltda_declaration acc)
+
+let filter_non_loaded_persistent f env =
+ let to_remove =
+ IdTbl.fold_name wrap_module
+ (fun name (_, entry) acc ->
+ match entry with
+ | Mod_local _ -> acc
+ | Mod_unbound _ -> acc
+ | Mod_persistent ->
+ match Persistent_env.find_in_cache !persistent_env name with
+ | Some _ -> acc
+ | None ->
+ if f (Ident.create_persistent name) then
+ acc
+ else
+ String.Set.add name acc)
+ env.modules
+ String.Set.empty
+ in
+ let remove_ids tbl ids =
+ String.Set.fold
+ (fun name tbl -> IdTbl.remove (Ident.create_persistent name) tbl)
+ ids
+ tbl
+ in
+ let rec filter_summary summary ids =
+ if String.Set.is_empty ids then
+ summary
+ else
+ match summary with
+ Env_persistent (s, id) when String.Set.mem (Ident.name id) ids ->
+ filter_summary s (String.Set.remove (Ident.name id) ids)
+ | Env_empty
+ | Env_value _
+ | Env_type _
+ | Env_extension _
+ | Env_module _
+ | Env_modtype _
+ | Env_class _
+ | Env_cltype _
+ | Env_open _
+ | Env_functor_arg _
+ | Env_constraints _
+ | Env_copy_types _
+ | Env_persistent _
+ | Env_value_unbound _
+ | Env_module_unbound _ ->
+ map_summary (fun s -> filter_summary s ids) summary
+ in
+ { env with
+ modules = remove_ids env.modules to_remove;
+ summary = filter_summary env.summary to_remove;
+ }
+
+(* Return the environment summary *)
+
+let summary env =
+ if Path.Map.is_empty env.local_constraints then env.summary
+ else Env_constraints (env.summary, env.local_constraints)
+
+let last_env = s_ref empty
+let last_reduced_env = s_ref empty
+
+let keep_only_summary env =
+ if !last_env == env then !last_reduced_env
+ else begin
+ let new_env =
+ {
+ empty with
+ summary = env.summary;
+ local_constraints = env.local_constraints;
+ flags = env.flags;
+ }
+ in
+ last_env := env;
+ last_reduced_env := new_env;
+ new_env
+ end
+
+
+let env_of_only_summary env_from_summary env =
+ let new_env = env_from_summary env.summary Subst.identity in
+ { new_env with
+ local_constraints = env.local_constraints;
+ flags = env.flags;
+ }
+
+(* Error report *)
+
+open Format_doc
+
+(* Forward declarations *)
+
+let print_path: Path.t printer ref = ref (fun _ _ -> assert false)
+let pp_path ppf l = !print_path ppf l
+
+let spellcheck ppf extract env lid =
+ let choices ~path name = Misc.spellcheck (extract path env) name in
+ match lid with
+ | Longident.Lapply _ -> ()
+ | Longident.Lident s ->
+ Misc.did_you_mean ppf (fun () -> choices ~path:None s)
+ | Longident.Ldot (r, s) ->
+ Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s)
+
+let spellcheck_name ppf extract env name =
+ Misc.did_you_mean ppf
+ (fun () -> Misc.spellcheck (extract env) name)
+
+let extract_values path env =
+ fold_values (fun name _ _ acc -> name :: acc) path env []
+let extract_types path env =
+ fold_types (fun name _ _ acc -> name :: acc) path env []
+let extract_modules path env =
+ fold_modules (fun name _ _ acc -> name :: acc) path env []
+let extract_constructors path env =
+ fold_constructors (fun desc acc -> desc.cstr_name :: acc) path env []
+let extract_labels path env =
+ fold_labels (fun desc acc -> desc.lbl_name :: acc) path env []
+let extract_classes path env =
+ fold_classes (fun name _ _ acc -> name :: acc) path env []
+let extract_modtypes path env =
+ fold_modtypes (fun name _ _ acc -> name :: acc) path env []
+let extract_cltypes path env =
+ fold_cltypes (fun name _ _ acc -> name :: acc) path env []
+let extract_instance_variables env =
+ fold_values
+ (fun name _ descr acc ->
+ match descr.val_kind with
+ | Val_ivar _ -> name :: acc
+ | _ -> acc) None env []
+
+module Style = Misc.Style
+
+let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
+let report_lookup_error_doc _loc env ppf = function
+ | Unbound_value(lid, hint) -> begin
+ fprintf ppf "Unbound value %a" quoted_longident lid;
+ spellcheck ppf extract_values env lid;
+ match hint with
+ | No_hint -> ()
+ | Missing_rec def_loc ->
+ let (_, line, _) =
+ Location.get_pos_info def_loc.Location.loc_start
+ in
+ fprintf ppf
+ "@.@[@{<hint>Hint@}: If this is a recursive definition,@ \
+ you should add the %a keyword on line %i@]"
+ Style.inline_code "rec"
+ line
+ end
+ | Unbound_type lid ->
+ fprintf ppf "Unbound type constructor %a"
+ quoted_longident lid;
+ spellcheck ppf extract_types env lid;
+ | Unbound_module lid -> begin
+ fprintf ppf "Unbound module %a"
+ quoted_longident lid;
+ match find_modtype_by_name lid env with
+ | exception Not_found -> spellcheck ppf extract_modules env lid;
+ | _ ->
+ fprintf ppf
+ "@.@[@{<hint>Hint@}: There is a module type named %a, %s@]"
+ quoted_longident lid
+ "but module types are not modules"
+ end
+ | Unbound_constructor lid ->
+ fprintf ppf "Unbound constructor %a"
+ quoted_constr lid;
+ spellcheck ppf extract_constructors env lid;
+ | Unbound_label lid ->
+ fprintf ppf "Unbound record field %a"
+ quoted_longident lid;
+ spellcheck ppf extract_labels env lid;
+ | Unbound_class lid -> begin
+ fprintf ppf "Unbound class %a"
+ quoted_longident lid;
+ match find_cltype_by_name lid env with
+ | exception Not_found -> spellcheck ppf extract_classes env lid;
+ | _ ->
+ fprintf ppf
+ "@.@[@{<hint>Hint@}: There is a class type named %a, %s@]"
+ quoted_longident lid
+ "but classes are not class types"
+ end
+ | Unbound_modtype lid -> begin
+ fprintf ppf "Unbound module type %a"
+ quoted_longident lid;
+ match find_module_by_name lid env with
+ | exception Not_found -> spellcheck ppf extract_modtypes env lid;
+ | _ ->
+ fprintf ppf
+ "@.@[@{<hint>Hint@}: There is a module named %a, %s@]"
+ quoted_longident lid
+ "but modules are not module types"
+ end
+ | Unbound_cltype lid ->
+ fprintf ppf "Unbound class type %a"
+ quoted_longident lid;
+ spellcheck ppf extract_cltypes env lid;
+ | Unbound_instance_variable s ->
+ fprintf ppf "Unbound instance variable %a" Style.inline_code s;
+ spellcheck_name ppf extract_instance_variables env s;
+ | Not_an_instance_variable s ->
+ fprintf ppf "The value %a is not an instance variable"
+ Style.inline_code s;
+ spellcheck_name ppf extract_instance_variables env s;
+ | Masked_instance_variable lid ->
+ fprintf ppf
+ "The instance variable %a@ \
+ cannot be accessed from the definition of another instance variable"
+ quoted_longident lid
+ | Masked_self_variable lid ->
+ fprintf ppf
+ "The self variable %a@ \
+ cannot be accessed from the definition of an instance variable"
+ quoted_longident lid
+ | Masked_ancestor_variable lid ->
+ fprintf ppf
+ "The ancestor variable %a@ \
+ cannot be accessed from the definition of an instance variable"
+ quoted_longident lid
+ | Illegal_reference_to_recursive_module ->
+ fprintf ppf "Illegal recursive module reference"
+ | Structure_used_as_functor lid ->
+ fprintf ppf "@[The module %a is a structure, it cannot be applied@]"
+ quoted_longident lid
+ | Abstract_used_as_functor lid ->
+ fprintf ppf "@[The module %a is abstract, it cannot be applied@]"
+ quoted_longident lid
+ | Functor_used_as_structure lid ->
+ fprintf ppf "@[The module %a is a functor, \
+ it cannot have any components@]" quoted_longident lid
+ | Abstract_used_as_structure lid ->
+ fprintf ppf "@[The module %a is abstract, \
+ it cannot have any components@]"
+ quoted_longident lid
+ | Generative_used_as_applicative lid ->
+ fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \
+ applied@ in@ type@ expressions@]"
+ quoted_longident lid
+ | Cannot_scrape_alias(lid, p) ->
+ let cause =
+ if Current_unit.Name.is_path p then "is the current compilation unit"
+ else "is missing"
+ in
+ fprintf ppf
+ "The module %a is an alias for module %a, which %s"
+ quoted_longident lid
+ (Style.as_inline_code pp_path) p cause
+
+let report_error_doc ppf = function
+ | Missing_module(_, path1, path2) ->
+ fprintf ppf "@[@[<hov>";
+ if Path.same path1 path2 then
+ fprintf ppf "Internal path@ %a@ is dangling."
+ Style.inline_code (Path.name path1)
+ else
+ fprintf ppf "Internal path@ %a@ expands to@ %a@ which is dangling."
+ Style.inline_code (Path.name path1)
+ Style.inline_code (Path.name path2);
+ fprintf ppf "@]@ @[%s@ %a@ %s.@]@]"
+ "The compiled interface for module"
+ Style.inline_code (Ident.name (Path.head path2))
+ "was not found"
+ | Illegal_value_name(_loc, name) ->
+ fprintf ppf "%a is not a valid value identifier."
+ Style.inline_code name
+ | Lookup_error(loc, t, err) -> report_lookup_error_doc loc t ppf err
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err ->
+ let loc =
+ match err with
+ | Missing_module (loc, _, _)
+ | Illegal_value_name (loc, _)
+ | Lookup_error(loc, _, _) -> loc
+ in
+ let error_of_printer =
+ if loc = Location.none
+ then Location.error_of_printer_file
+ else Location.error_of_printer ~loc ?sub:None ?footnote:None
+ in
+ Some (error_of_printer report_error_doc err)
+ | _ ->
+ None
+ )
+
+let report_lookup_error = Format_doc.compat2 report_lookup_error_doc
+let report_error = Format_doc.compat report_error_doc
diff --git a/upstream/ocaml_503/typing/env.mli b/upstream/ocaml_503/typing/env.mli
new file mode 100644
index 0000000000..1ad27a11bf
--- /dev/null
+++ b/upstream/ocaml_503/typing/env.mli
@@ -0,0 +1,526 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Environment handling *)
+
+open Types
+open Misc
+
+type value_unbound_reason =
+ | Val_unbound_instance_variable
+ | Val_unbound_self
+ | Val_unbound_ancestor
+ | Val_unbound_ghost_recursive of Location.t
+
+type module_unbound_reason =
+ | Mod_unbound_illegal_recursion
+
+type summary =
+ Env_empty
+ | Env_value of summary * Ident.t * value_description
+ | Env_type of summary * Ident.t * type_declaration
+ | Env_extension of summary * Ident.t * extension_constructor
+ | Env_module of summary * Ident.t * module_presence * module_declaration
+ | Env_modtype of summary * Ident.t * modtype_declaration
+ | Env_class of summary * Ident.t * class_declaration
+ | Env_cltype of summary * Ident.t * class_type_declaration
+ | Env_open of summary * Path.t
+ (** The string set argument of [Env_open] represents a list of module names
+ to skip, i.e. that won't be imported in the toplevel namespace. *)
+ | Env_functor_arg of summary * Ident.t
+ | Env_constraints of summary * type_declaration Path.Map.t
+ | Env_copy_types of summary
+ | Env_persistent of summary * Ident.t
+ | Env_value_unbound of summary * string * value_unbound_reason
+ | Env_module_unbound of summary * string * module_unbound_reason
+
+type address =
+ | Aident of Ident.t
+ | Adot of address * int
+
+type t
+
+val empty: t
+val initial: t
+val diff: t -> t -> Ident.t list
+
+(* approximation to the preimage equivalence class of [find_type] *)
+val same_type_declarations: t -> t -> bool
+
+type type_descr_kind =
+ (label_description, constructor_description) type_kind
+
+ (* alias for compatibility *)
+type type_descriptions = type_descr_kind
+
+(* For short-paths *)
+type iter_cont
+val iter_types:
+ (Path.t -> Path.t * type_declaration -> unit) ->
+ t -> iter_cont
+val run_iter_cont: iter_cont list -> (Path.t * iter_cont) list
+val same_types: t -> t -> bool
+val used_persistent: unit -> Stdlib.String.Set.t
+val find_shadowed_types: Path.t -> t -> Path.t list
+val without_cmis: ('a -> 'b) -> 'a -> 'b
+(* [without_cmis f arg] applies [f] to [arg], but does not
+ allow opening cmis during its execution *)
+
+(* Lookup by paths *)
+
+val find_value: Path.t -> t -> value_description
+val find_type: Path.t -> t -> type_declaration
+val find_type_descrs: Path.t -> t -> type_descriptions
+val find_module: Path.t -> t -> module_declaration
+val find_modtype: Path.t -> t -> modtype_declaration
+val find_class: Path.t -> t -> class_declaration
+val find_cltype: Path.t -> t -> class_type_declaration
+
+val find_strengthened_module:
+ aliasable:bool -> Path.t -> t -> module_type
+
+val find_ident_constructor: Ident.t -> t -> constructor_description
+val find_ident_label: Ident.t -> t -> label_description
+
+val find_type_expansion:
+ Path.t -> t -> type_expr list * type_expr * int
+val find_type_expansion_opt:
+ Path.t -> t -> type_expr list * type_expr * int
+(* Find the manifest type information associated to a type for the sake
+ of the compiler's type-based optimisations. *)
+val find_modtype_expansion: Path.t -> t -> module_type
+val find_modtype_expansion_lazy: Path.t -> t -> Subst.Lazy.modtype
+
+val find_hash_type: Path.t -> t -> type_declaration
+(* Find the "#t" type given the path for "t" *)
+
+val find_value_address: Path.t -> t -> address
+val find_module_address: Path.t -> t -> address
+val find_class_address: Path.t -> t -> address
+val find_constructor_address: Path.t -> t -> address
+
+val shape_of_path:
+ namespace:Shape.Sig_component_kind.t -> t -> Path.t -> Shape.t
+
+val add_functor_arg: Ident.t -> t -> t
+val is_functor_arg: Path.t -> t -> bool
+
+val normalize_module_path: Location.t option -> t -> Path.t -> Path.t
+(* Normalize the path to a concrete module.
+ If the option is None, allow returning dangling paths.
+ Otherwise raise a Missing_module error, and may add forgotten
+ head as required global. *)
+
+val normalize_type_path: Location.t option -> t -> Path.t -> Path.t
+(* Normalize the prefix part of the type path *)
+
+val normalize_value_path: Location.t option -> t -> Path.t -> Path.t
+(* Normalize the prefix part of the value path *)
+
+val normalize_modtype_path: t -> Path.t -> Path.t
+(* Normalize a module type path *)
+
+val reset_required_globals: unit -> unit
+val get_required_globals: unit -> Ident.t list
+val add_required_global: Ident.t -> unit
+
+val has_local_constraints: t -> bool
+
+(* Mark definitions as used *)
+val mark_value_used: Uid.t -> unit
+val mark_module_used: Uid.t -> unit
+val mark_type_used: Uid.t -> unit
+
+type constructor_usage = Positive | Pattern | Exported_private | Exported
+val mark_constructor_used:
+ constructor_usage -> constructor_declaration -> unit
+val mark_extension_used:
+ constructor_usage -> extension_constructor -> unit
+
+type label_usage =
+ Projection | Mutation | Construct | Exported_private | Exported
+val mark_label_used:
+ label_usage -> label_declaration -> unit
+
+(* Lookup by long identifiers *)
+
+(* Lookup errors *)
+
+type unbound_value_hint =
+ | No_hint
+ | Missing_rec of Location.t
+
+type lookup_error =
+ | Unbound_value of Longident.t * unbound_value_hint
+ | Unbound_type of Longident.t
+ | Unbound_constructor of Longident.t
+ | Unbound_label of Longident.t
+ | Unbound_module of Longident.t
+ | Unbound_class of Longident.t
+ | Unbound_modtype of Longident.t
+ | Unbound_cltype of Longident.t
+ | Unbound_instance_variable of string
+ | Not_an_instance_variable of string
+ | Masked_instance_variable of Longident.t
+ | Masked_self_variable of Longident.t
+ | Masked_ancestor_variable of Longident.t
+ | Structure_used_as_functor of Longident.t
+ | Abstract_used_as_functor of Longident.t
+ | Functor_used_as_structure of Longident.t
+ | Abstract_used_as_structure of Longident.t
+ | Generative_used_as_applicative of Longident.t
+ | Illegal_reference_to_recursive_module
+ | Cannot_scrape_alias of Longident.t * Path.t
+
+val lookup_error: Location.t -> t -> lookup_error -> 'a
+
+(* The [lookup_foo] functions will emit proper error messages (by
+ raising [Error]) if the identifier cannot be found, whereas the
+ [find_foo_by_name] functions will raise [Not_found] instead.
+
+ The [~use] parameters of the [lookup_foo] functions control
+ whether this lookup should be counted as a use for usage
+ warnings and alerts.
+
+ [Longident.t]s in the program source should be looked up using
+ [lookup_foo ~use:true] exactly one time -- otherwise warnings may be
+ emitted the wrong number of times. *)
+
+val lookup_value:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * value_description
+val lookup_type:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * type_declaration
+val lookup_module:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * module_declaration
+val lookup_modtype:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * modtype_declaration
+val lookup_class:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * class_declaration
+val lookup_cltype:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * class_type_declaration
+
+val lookup_module_path:
+ ?use:bool -> loc:Location.t -> load:bool -> Longident.t -> t -> Path.t
+val lookup_modtype_path:
+ ?use:bool -> loc:Location.t -> Longident.t -> t -> Path.t
+
+val lookup_constructor:
+ ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
+ constructor_description
+val lookup_all_constructors:
+ ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
+ ((constructor_description * (unit -> unit)) list,
+ Location.t * t * lookup_error) result
+val lookup_all_constructors_from_type:
+ ?use:bool -> loc:Location.t -> constructor_usage -> Path.t -> t ->
+ (constructor_description * (unit -> unit)) list
+
+val lookup_label:
+ ?use:bool -> loc:Location.t -> label_usage -> Longident.t -> t ->
+ label_description
+val lookup_all_labels:
+ ?use:bool -> loc:Location.t -> label_usage -> Longident.t -> t ->
+ ((label_description * (unit -> unit)) list,
+ Location.t * t * lookup_error) result
+val lookup_all_labels_from_type:
+ ?use:bool -> loc:Location.t -> label_usage -> Path.t -> t ->
+ (label_description * (unit -> unit)) list
+
+val lookup_instance_variable:
+ ?use:bool -> loc:Location.t -> string -> t ->
+ Path.t * Asttypes.mutable_flag * string * type_expr
+
+val find_value_by_name:
+ Longident.t -> t -> Path.t * value_description
+val find_type_by_name:
+ Longident.t -> t -> Path.t * type_declaration
+val find_module_by_name:
+ Longident.t -> t -> Path.t * module_declaration
+val find_modtype_by_name:
+ Longident.t -> t -> Path.t * modtype_declaration
+val find_class_by_name:
+ Longident.t -> t -> Path.t * class_declaration
+val find_cltype_by_name:
+ Longident.t -> t -> Path.t * class_type_declaration
+
+val find_constructor_by_name:
+ Longident.t -> t -> constructor_description
+val find_label_by_name:
+ Longident.t -> t -> label_description
+
+(** The [find_*_index] functions computes a "namespaced" De Bruijn index
+ of an identifier in a given environment. In other words, it returns how many
+ times an identifier has been shadowed by a more recent identifiers with the
+ same name in a given environment.
+ Those functions return [None] when the identifier is not bound in the
+ environment. This behavior is there to facilitate the detection of
+ inconsistent printing environment, but should disappear in the long term.
+*)
+val find_value_index: Ident.t -> t -> int option
+val find_type_index: Ident.t -> t -> int option
+val find_module_index: Ident.t -> t -> int option
+val find_modtype_index: Ident.t -> t -> int option
+val find_class_index: Ident.t -> t -> int option
+val find_cltype_index: Ident.t -> t -> int option
+
+(* Check if a name is bound *)
+
+val bound_value: string -> t -> bool
+val bound_module: string -> t -> bool
+val bound_type: string -> t -> bool
+val bound_modtype: string -> t -> bool
+val bound_class: string -> t -> bool
+val bound_cltype: string -> t -> bool
+
+val make_copy_of_types: t -> (t -> t)
+
+(* Insertion by identifier *)
+
+val add_value:
+ ?check:(string -> Warnings.t) -> Ident.t -> value_description -> t -> t
+val add_type:
+ check:bool -> ?shape:Shape.t -> Ident.t -> type_declaration -> t -> t
+val add_extension:
+ check:bool -> ?shape:Shape.t -> rebind:bool -> Ident.t ->
+ extension_constructor -> t -> t
+val add_module: ?arg:bool -> ?shape:Shape.t ->
+ Ident.t -> module_presence -> module_type -> t -> t
+val add_module_lazy: update_summary:bool ->
+ Ident.t -> module_presence -> Subst.Lazy.modtype -> t -> t
+val add_module_declaration: ?arg:bool -> ?shape:Shape.t -> check:bool ->
+ Ident.t -> module_presence -> module_declaration -> t -> t
+val add_module_declaration_lazy: update_summary:bool ->
+ Ident.t -> module_presence -> Subst.Lazy.module_decl -> t -> t
+val add_modtype: Ident.t -> modtype_declaration -> t -> t
+val add_modtype_lazy: update_summary:bool ->
+ Ident.t -> Subst.Lazy.modtype_declaration -> t -> t
+val add_class: Ident.t -> class_declaration -> t -> t
+val add_cltype: Ident.t -> class_type_declaration -> t -> t
+val add_local_constraint: Path.t -> type_declaration -> t -> t
+
+(* Insertion of persistent signatures *)
+
+(* [add_persistent_structure id env] is an environment such that
+ module [id] points to the persistent structure contained in the
+ external compilation unit with the same name.
+
+ The compilation unit itself is looked up in the load path when the
+ contents of the module is accessed. *)
+val add_persistent_structure : Ident.t -> t -> t
+
+ (* Returns the set of persistent structures found in the given
+ directory. *)
+val persistent_structures_of_dir : Load_path.Dir.t -> Misc.Stdlib.String.Set.t
+
+(* [filter_non_loaded_persistent f env] removes all the persistent
+ structures that are not yet loaded and for which [f] returns
+ [false]. *)
+val filter_non_loaded_persistent : (Ident.t -> bool) -> t -> t
+
+(* Insertion of all fields of a signature. *)
+
+val add_signature: signature -> t -> t
+
+(* Insertion of all fields of a signature, relative to the given path.
+ Used to implement open. Returns None if the path refers to a functor,
+ not a structure. *)
+val open_signature:
+ ?used_slot:bool ref ->
+ ?loc:Location.t -> ?toplevel:bool ->
+ Asttypes.override_flag -> Path.t ->
+ t -> (t, [`Not_found | `Functor]) result
+
+val open_pers_signature: string -> t -> (t, [`Not_found]) result
+
+val remove_last_open: Path.t -> t -> t option
+
+(* Insertion by name *)
+
+val enter_value:
+ ?check:(string -> Warnings.t) ->
+ string -> value_description -> t -> Ident.t * t
+val enter_type: scope:int -> string -> type_declaration -> t -> Ident.t * t
+val enter_extension:
+ scope:int -> rebind:bool -> string ->
+ extension_constructor -> t -> Ident.t * t
+val enter_module:
+ scope:int -> ?arg:bool -> string -> module_presence ->
+ module_type -> t -> Ident.t * t
+val enter_module_declaration:
+ scope:int -> ?arg:bool -> ?shape:Shape.t -> string -> module_presence ->
+ module_declaration -> t -> Ident.t * t
+val enter_modtype:
+ scope:int -> string -> modtype_declaration -> t -> Ident.t * t
+val enter_class: scope:int -> string -> class_declaration -> t -> Ident.t * t
+val enter_cltype:
+ scope:int -> string -> class_type_declaration -> t -> Ident.t * t
+
+(* Same as [add_signature] but refreshes (new stamp) and rescopes bound idents
+ in the process. *)
+val enter_signature: ?mod_shape:Shape.t -> scope:int -> signature -> t ->
+ signature * t
+
+(* Same as [enter_signature] but also extends the shape map ([parent_shape])
+ with all the the items from the signature, their shape being a projection
+ from the given shape. *)
+val enter_signature_and_shape: scope:int -> parent_shape:Shape.Map.t ->
+ Shape.t -> signature -> t -> signature * Shape.Map.t * t
+
+val enter_unbound_value : string -> value_unbound_reason -> t -> t
+
+val enter_unbound_module : string -> module_unbound_reason -> t -> t
+
+(* Initialize the cache of in-core module interfaces. *)
+val reset_cache: unit -> unit
+
+(* To be called before each toplevel phrase. *)
+val reset_cache_toplevel: unit -> unit
+
+(* Remember the current compilation unit. *)
+val set_current_unit: Unit_info.t -> unit
+val get_current_unit : unit -> Unit_info.t option
+val get_current_unit_name: unit -> string
+
+(* Read, save a signature to/from a file *)
+val read_signature: Unit_info.Artifact.t -> signature
+ (* Arguments: module name, file name. Results: signature. *)
+val save_signature:
+ alerts:alerts -> Types.signature -> Unit_info.Artifact.t
+ -> Cmi_format.cmi_infos
+ (* Arguments: signature, module name, file name. *)
+val save_signature_with_imports:
+ alerts:alerts -> signature -> Unit_info.Artifact.t -> crcs
+ -> Cmi_format.cmi_infos
+ (* Arguments: signature, module name, file name,
+ imported units with their CRCs. *)
+
+(* Return the CRC of the interface of the given compilation unit *)
+val crc_of_unit: modname -> Digest.t
+
+(* Return the set of compilation units imported, with their CRC *)
+val imports: unit -> crcs
+
+(* may raise Persistent_env.Consistbl.Inconsistency *)
+val import_crcs: source:string -> crcs -> unit
+
+(* [is_imported_opaque md] returns true if [md] is an opaque imported module *)
+val is_imported_opaque: modname -> bool
+
+(* [register_import_as_opaque md] registers [md] as an opaque imported module *)
+val register_import_as_opaque: modname -> unit
+
+(* Summaries -- compact representation of an environment, to be
+ exported in debugging information. *)
+
+val summary: t -> summary
+
+(* Return an equivalent environment where all fields have been reset,
+ except the summary. The initial environment can be rebuilt from the
+ summary, using Envaux.env_of_only_summary. *)
+
+val keep_only_summary : t -> t
+val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t
+
+(* Error report *)
+
+type error =
+ | Missing_module of Location.t * Path.t * Path.t
+ | Illegal_value_name of Location.t * string
+ | Lookup_error of Location.t * t * lookup_error
+
+exception Error of error
+
+
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
+
+val report_lookup_error:
+ Location.t -> t -> lookup_error Format_doc.format_printer
+val report_lookup_error_doc:
+ Location.t -> t -> lookup_error Format_doc.printer
+val in_signature: bool -> t -> t
+
+val is_in_signature: t -> bool
+
+val set_value_used_callback:
+ value_description -> (unit -> unit) -> unit
+val set_type_used_callback:
+ type_declaration -> ((unit -> unit) -> unit) -> unit
+
+(* Forward declaration to break mutual recursion with Includemod. *)
+val check_functor_application:
+ (errors:bool -> loc:Location.t ->
+ lid_whole_app:Longident.t ->
+ f0_path:Path.t -> args:(Path.t * Types.module_type) list ->
+ arg_path:Path.t -> arg_mty:Types.module_type ->
+ param_mty:Types.module_type ->
+ t -> unit) ref
+(* Forward declaration to break mutual recursion with Typemod. *)
+val check_well_formed_module:
+ (t -> Location.t -> string -> module_type -> unit) ref
+(* Forward declaration to break mutual recursion with Typecore. *)
+val add_delayed_check_forward: ((unit -> unit) -> unit) ref
+(* Forward declaration to break mutual recursion with Mtype. *)
+val strengthen:
+ (aliasable:bool -> t -> Subst.Lazy.modtype ->
+ Path.t -> Subst.Lazy.modtype) ref
+(* Forward declaration to break mutual recursion with Ctype. *)
+val same_constr: (t -> type_expr -> type_expr -> bool) ref
+(* Forward declaration to break mutual recursion with Printtyp. *)
+val print_path: Path.t Format_doc.printer ref
+
+
+(** Folds *)
+
+val fold_values:
+ (string -> Path.t -> value_description -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_types:
+ (string -> Path.t -> type_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_constructors:
+ (constructor_description -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_labels:
+ (label_description -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+
+(** Persistent structures are only traversed if they are already loaded. *)
+val fold_modules:
+ (string -> Path.t -> module_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+
+val fold_modtypes:
+ (string -> Path.t -> modtype_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_classes:
+ (string -> Path.t -> class_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_cltypes:
+ (string -> Path.t -> class_type_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+
+
+(** Utilities *)
+val scrape_alias: t -> module_type -> module_type
+val check_value_name: string -> Location.t -> unit
+
+val print_address : Format.formatter -> address -> unit
diff --git a/upstream/ocaml_503/typing/envaux.ml b/upstream/ocaml_503/typing/envaux.ml
new file mode 100644
index 0000000000..df75c5d5b6
--- /dev/null
+++ b/upstream/ocaml_503/typing/envaux.ml
@@ -0,0 +1,119 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
+(* OCaml port by John Malecki and Xavier Leroy *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Env
+
+type error =
+ Module_not_found of Path.t
+
+exception Error of error
+
+let env_cache =
+ (Hashtbl.create 59 : ((Env.summary * Subst.t), Env.t) Hashtbl.t)
+
+let reset_cache () =
+ Hashtbl.clear env_cache;
+ Env.reset_cache()
+
+let rec env_from_summary sum subst =
+ try
+ Hashtbl.find env_cache (sum, subst)
+ with Not_found ->
+ let env =
+ match sum with
+ Env_empty ->
+ Env.empty
+ | Env_value(s, id, desc) ->
+ Env.add_value id (Subst.value_description subst desc)
+ (env_from_summary s subst)
+ | Env_type(s, id, desc) ->
+ Env.add_type ~check:false id
+ (Subst.type_declaration subst desc)
+ (env_from_summary s subst)
+ | Env_extension(s, id, desc) ->
+ Env.add_extension ~check:false ~rebind:false id
+ (Subst.extension_constructor subst desc)
+ (env_from_summary s subst)
+ | Env_module(s, id, pres, desc) ->
+ Env.add_module_declaration ~check:false id pres
+ (Subst.module_declaration Keep subst desc)
+ (env_from_summary s subst)
+ | Env_modtype(s, id, desc) ->
+ Env.add_modtype id (Subst.modtype_declaration Keep subst desc)
+ (env_from_summary s subst)
+ | Env_class(s, id, desc) ->
+ Env.add_class id (Subst.class_declaration subst desc)
+ (env_from_summary s subst)
+ | Env_cltype (s, id, desc) ->
+ Env.add_cltype id (Subst.cltype_declaration subst desc)
+ (env_from_summary s subst)
+ | Env_open(s, path) ->
+ let env = env_from_summary s subst in
+ let path' = Subst.module_path subst path in
+ begin match Env.open_signature Asttypes.Override path' env with
+ | Ok env -> env
+ | Error `Functor -> assert false
+ | Error `Not_found -> raise (Error (Module_not_found path'))
+ end
+ | Env_functor_arg(Env_module(s, id, pres, desc), id')
+ when Ident.same id id' ->
+ Env.add_module_declaration ~check:false
+ id pres (Subst.module_declaration Keep subst desc)
+ ~arg:true (env_from_summary s subst)
+ | Env_functor_arg _ -> assert false
+ | Env_constraints(s, map) ->
+ Path.Map.fold
+ (fun path info ->
+ Env.add_local_constraint (Subst.type_path subst path)
+ (Subst.type_declaration subst info))
+ map (env_from_summary s subst)
+ | Env_copy_types s ->
+ let env = env_from_summary s subst in
+ Env.make_copy_of_types env env
+ | Env_persistent (s, id) ->
+ let env = env_from_summary s subst in
+ Env.add_persistent_structure id env
+ | Env_value_unbound (s, str, reason) ->
+ let env = env_from_summary s subst in
+ Env.enter_unbound_value str reason env
+ | Env_module_unbound (s, str, reason) ->
+ let env = env_from_summary s subst in
+ Env.enter_unbound_module str reason env
+ in
+ Hashtbl.add env_cache (sum, subst) env;
+ env
+
+let env_of_only_summary env =
+ Env.env_of_only_summary env_from_summary env
+
+(* Error report *)
+
+open Format_doc
+module Style = Misc.Style
+
+let report_error_doc ppf = function
+ | Module_not_found p ->
+ fprintf ppf "@[Cannot find module %a@].@."
+ (Style.as_inline_code Printtyp.Doc.path) p
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err -> Some (Location.error_of_printer_file report_error_doc err)
+ | _ -> None
+ )
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/upstream/ocaml_503/typing/envaux.mli b/upstream/ocaml_503/typing/envaux.mli
new file mode 100644
index 0000000000..5fbb8410bd
--- /dev/null
+++ b/upstream/ocaml_503/typing/envaux.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
+(* OCaml port by John Malecki and Xavier Leroy *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Convert environment summaries to environments *)
+
+val env_from_summary : Env.summary -> Subst.t -> Env.t
+
+(* Empty the environment caches. To be called when load_path changes. *)
+
+val reset_cache: unit -> unit
+
+val env_of_only_summary : Env.t -> Env.t
+
+(* Error report *)
+
+type error =
+ Module_not_found of Path.t
+
+exception Error of error
+
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
diff --git a/upstream/ocaml_503/typing/errortrace.ml b/upstream/ocaml_503/typing/errortrace.ml
new file mode 100644
index 0000000000..347e5c9a4f
--- /dev/null
+++ b/upstream/ocaml_503/typing/errortrace.ml
@@ -0,0 +1,202 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* Antal Spector-Zabusky, Jane Street, New York *)
+(* *)
+(* Copyright 2018 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2021 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Types
+open Format_doc
+
+type position = First | Second
+
+let swap_position = function
+ | First -> Second
+ | Second -> First
+
+let print_pos ppf = function
+ | First -> fprintf ppf "first"
+ | Second -> fprintf ppf "second"
+
+type expanded_type = { ty: type_expr; expanded: type_expr }
+
+let trivial_expansion ty = { ty; expanded = ty }
+
+type 'a diff = { got: 'a; expected: 'a }
+
+let map_diff f r =
+ (* ordering is often meaningful when dealing with type_expr *)
+ let got = f r.got in
+ let expected = f r.expected in
+ { got; expected }
+
+let swap_diff x = { got = x.expected; expected = x.got }
+
+type 'a escape_kind =
+ | Constructor of Path.t
+ | Univ of type_expr
+ (* The type_expr argument of [Univ] is always a [Tunivar _],
+ we keep a [type_expr] to track renaming in {!Printtyp} *)
+ | Self
+ | Module_type of Path.t
+ | Equation of 'a
+ | Constraint
+
+type 'a escape =
+ { kind : 'a escape_kind;
+ context : type_expr option }
+
+let map_escape f esc =
+ {esc with kind = match esc.kind with
+ | Equation eq -> Equation (f eq)
+ | (Constructor _ | Univ _ | Self | Module_type _ | Constraint) as c -> c}
+
+let explain trace f =
+ let rec explain = function
+ | [] -> None
+ | [h] -> f ~prev:None h
+ | h :: (prev :: _ as rem) ->
+ match f ~prev:(Some prev) h with
+ | Some _ as m -> m
+ | None -> explain rem in
+ explain (List.rev trace)
+
+(* Type indices *)
+type unification = private Unification
+type comparison = private Comparison
+
+type fixed_row_case =
+ | Cannot_be_closed
+ | Cannot_add_tags of string list
+
+type 'variety variant =
+ (* Common *)
+ | Incompatible_types_for : string -> _ variant
+ | No_tags : position * (Asttypes.label * row_field) list -> _ variant
+ (* Unification *)
+ | No_intersection : unification variant
+ | Fixed_row :
+ position * fixed_row_case * fixed_explanation -> unification variant
+ (* Equality & Moregen *)
+ | Presence_not_guaranteed_for : position * string -> comparison variant
+ | Openness : position (* Always [Second] for Moregen *) -> comparison variant
+
+type 'variety obj =
+ (* Common *)
+ | Missing_field : position * string -> _ obj
+ | Abstract_row : position -> _ obj
+ (* Unification *)
+ | Self_cannot_be_closed : unification obj
+
+type first_class_module =
+ | Package_cannot_scrape of Path.t
+ | Package_inclusion of Format_doc.doc
+ | Package_coercion of Format_doc.doc
+
+type ('a, 'variety) elt =
+ (* Common *)
+ | Diff : 'a diff -> ('a, _) elt
+ | Variant : 'variety variant -> ('a, 'variety) elt
+ | Obj : 'variety obj -> ('a, 'variety) elt
+ | Escape : 'a escape -> ('a, _) elt
+ | Function_label_mismatch of Asttypes.arg_label diff
+ | Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
+ (* Could move [Incompatible_fields] into [obj] *)
+ | First_class_module: first_class_module -> ('a,_) elt
+ (* Unification & Moregen; included in Equality for simplicity *)
+ | Rec_occur : type_expr * type_expr -> ('a, _) elt
+
+type ('a, 'variety) t = ('a, 'variety) elt list
+
+type 'variety trace = (type_expr, 'variety) t
+type 'variety error = (expanded_type, 'variety) t
+
+let map_elt (type variety) f : ('a, variety) elt -> ('b, variety) elt = function
+ | Diff x -> Diff (map_diff f x)
+ | Escape {kind = Equation x; context} ->
+ Escape { kind = Equation (f x); context }
+ | Escape {kind = (Univ _ | Self | Constructor _ | Module_type _ | Constraint);
+ _}
+ | Variant _ | Obj _ | Function_label_mismatch _ | Incompatible_fields _
+ | Rec_occur (_, _) | First_class_module _ as x -> x
+
+let map f t = List.map (map_elt f) t
+
+let incompatible_fields ~name ~got ~expected =
+ Incompatible_fields { name; diff={got; expected} }
+
+let swap_elt (type variety) : ('a, variety) elt -> ('a, variety) elt = function
+ | Diff x -> Diff (swap_diff x)
+ | Incompatible_fields { name; diff } ->
+ Incompatible_fields { name; diff = swap_diff diff}
+ | Obj (Missing_field(pos,s)) -> Obj (Missing_field(swap_position pos,s))
+ | Obj (Abstract_row pos) -> Obj (Abstract_row (swap_position pos))
+ | Variant (Fixed_row(pos,k,f)) ->
+ Variant (Fixed_row(swap_position pos,k,f))
+ | Variant (No_tags(pos,f)) ->
+ Variant (No_tags(swap_position pos,f))
+ | x -> x
+
+let swap_trace e = List.map swap_elt e
+
+type unification_error = { trace : unification error } [@@unboxed]
+
+type equality_error =
+ { trace : comparison error;
+ subst : (type_expr * type_expr) list }
+
+type moregen_error = { trace : comparison error } [@@unboxed]
+
+let unification_error ~trace : unification_error =
+ assert (trace <> []);
+ { trace }
+
+let equality_error ~trace ~subst : equality_error =
+ assert (trace <> []);
+ { trace; subst }
+
+let moregen_error ~trace : moregen_error =
+ assert (trace <> []);
+ { trace }
+
+type comparison_error =
+ | Equality_error of equality_error
+ | Moregen_error of moregen_error
+
+let swap_unification_error ({trace} : unification_error) =
+ ({trace = swap_trace trace} : unification_error)
+
+module Subtype = struct
+ type 'a elt =
+ | Diff of 'a diff
+
+ type 'a t = 'a elt list
+
+ type trace = type_expr t
+ type error_trace = expanded_type t
+
+ type unification_error_trace = unification error (** To avoid shadowing *)
+
+ type nonrec error =
+ { trace : error_trace
+ ; unification_trace : unification error }
+
+ let error ~trace ~unification_trace =
+ assert (trace <> []);
+ { trace; unification_trace }
+
+ let map_elt f = function
+ | Diff x -> Diff (map_diff f x)
+
+ let map f t = List.map (map_elt f) t
+end
diff --git a/upstream/ocaml_503/typing/errortrace.mli b/upstream/ocaml_503/typing/errortrace.mli
new file mode 100644
index 0000000000..6b42b66a34
--- /dev/null
+++ b/upstream/ocaml_503/typing/errortrace.mli
@@ -0,0 +1,175 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* Antal Spector-Zabusky, Jane Street, New York *)
+(* *)
+(* Copyright 2018 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2021 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Types
+
+type position = First | Second
+
+val swap_position : position -> position
+val print_pos : position Format_doc.printer
+
+type expanded_type = { ty: type_expr; expanded: type_expr }
+
+(** [trivial_expansion ty] creates an [expanded_type] whose expansion is also
+ [ty]. Usually, you want [Ctype.expand_type] instead, since the expansion
+ carries useful information; however, in certain circumstances, the error is
+ about the expansion of the type, meaning that actually performing the
+ expansion produces more confusing or inaccurate output. *)
+val trivial_expansion : type_expr -> expanded_type
+
+type 'a diff = { got: 'a; expected: 'a }
+
+(** [map_diff f {expected;got}] is [{expected=f expected; got=f got}] *)
+val map_diff: ('a -> 'b) -> 'a diff -> 'b diff
+
+(** Scope escape related errors *)
+type 'a escape_kind =
+ | Constructor of Path.t
+ | Univ of type_expr
+ (* The type_expr argument of [Univ] is always a [Tunivar _],
+ we keep a [type_expr] to track renaming in {!Printtyp} *)
+ | Self
+ | Module_type of Path.t
+ | Equation of 'a
+ | Constraint
+
+type 'a escape =
+ { kind : 'a escape_kind;
+ context : type_expr option }
+
+val map_escape : ('a -> 'b) -> 'a escape -> 'b escape
+
+val explain: 'a list ->
+ (prev:'a option -> 'a -> 'b option) ->
+ 'b option
+
+(** Type indices *)
+type unification = private Unification
+type comparison = private Comparison
+
+type fixed_row_case =
+ | Cannot_be_closed
+ | Cannot_add_tags of string list
+
+type 'variety variant =
+ (* Common *)
+ | Incompatible_types_for : string -> _ variant
+ | No_tags : position * (Asttypes.label * row_field) list -> _ variant
+ (* Unification *)
+ | No_intersection : unification variant
+ | Fixed_row :
+ position * fixed_row_case * fixed_explanation -> unification variant
+ (* Equality & Moregen *)
+ | Presence_not_guaranteed_for : position * string -> comparison variant
+ | Openness : position (* Always [Second] for Moregen *) -> comparison variant
+
+type 'variety obj =
+ (* Common *)
+ | Missing_field : position * string -> _ obj
+ | Abstract_row : position -> _ obj
+ (* Unification *)
+ | Self_cannot_be_closed : unification obj
+
+type first_class_module =
+ | Package_cannot_scrape of Path.t
+ | Package_inclusion of Format_doc.doc
+ | Package_coercion of Format_doc.doc
+
+type ('a, 'variety) elt =
+ (* Common *)
+ | Diff : 'a diff -> ('a, _) elt
+ | Variant : 'variety variant -> ('a, 'variety) elt
+ | Obj : 'variety obj -> ('a, 'variety) elt
+ | Escape : 'a escape -> ('a, _) elt
+ | Function_label_mismatch of Asttypes.arg_label diff
+ | Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
+ | First_class_module: first_class_module -> ('a,_) elt
+ (* Unification & Moregen; included in Equality for simplicity *)
+ | Rec_occur : type_expr * type_expr -> ('a, _) elt
+
+type ('a, 'variety) t = ('a, 'variety) elt list
+
+type 'variety trace = (type_expr, 'variety) t
+type 'variety error = (expanded_type, 'variety) t
+
+val map : ('a -> 'b) -> ('a, 'variety) t -> ('b, 'variety) t
+
+val incompatible_fields :
+ name:string -> got:type_expr -> expected:type_expr -> (type_expr, _) elt
+
+val swap_trace : ('a, 'variety) t -> ('a, 'variety) t
+
+(** The traces (['variety t]) are the core error types. However, we bundle them
+ up into three "top-level" error types, which are used elsewhere:
+ [unification_error], [equality_error], and [moregen_error]. In the case of
+ [equality_error], this has to bundle in extra information; in general, it
+ distinguishes the three types of errors and allows us to distinguish traces
+ that are being built (or processed) from those that are complete and have
+ become the final error. These error types have the invariants that their
+ traces are nonempty; we ensure that through three smart constructors with
+ matching names. *)
+
+type unification_error = private { trace : unification error } [@@unboxed]
+
+type equality_error = private
+ { trace : comparison error;
+ subst : (type_expr * type_expr) list }
+
+type moregen_error = private { trace : comparison error } [@@unboxed]
+
+val unification_error : trace:unification error -> unification_error
+
+val equality_error :
+ trace:comparison error -> subst:(type_expr * type_expr) list -> equality_error
+
+val moregen_error : trace:comparison error -> moregen_error
+
+(** Wraps up the two different kinds of [comparison] errors in one type *)
+type comparison_error =
+ | Equality_error of equality_error
+ | Moregen_error of moregen_error
+
+(** Lift [swap_trace] to [unification_error] *)
+val swap_unification_error : unification_error -> unification_error
+
+module Subtype : sig
+ type 'a elt =
+ | Diff of 'a diff
+
+ type 'a t = 'a elt list
+
+ (** Just as outside [Subtype], we split traces, completed traces, and complete
+ errors. However, in a minor asymmetry, the name [Subtype.error_trace]
+ corresponds to the outside [error] type, and [Subtype.error] corresponds
+ to the outside [*_error] types (e.g., [unification_error]). This [error]
+ type has the invariant that the subtype trace is nonempty; note that no
+ such invariant is imposed on the unification trace. *)
+
+ type trace = type_expr t
+ type error_trace = expanded_type t
+
+ type unification_error_trace = unification error (** To avoid shadowing *)
+
+ type nonrec error = private
+ { trace : error_trace
+ ; unification_trace : unification error }
+
+ val error :
+ trace:error_trace -> unification_trace:unification_error_trace -> error
+
+ val map : ('a -> 'b) -> 'a t -> 'b t
+end
diff --git a/upstream/ocaml_503/typing/errortrace_report.ml b/upstream/ocaml_503/typing/errortrace_report.ml
new file mode 100644
index 0000000000..03012f7d82
--- /dev/null
+++ b/upstream/ocaml_503/typing/errortrace_report.ml
@@ -0,0 +1,590 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+(* Trace-specific printing *)
+
+(* A configuration type that controls which trace we print. This could be
+ exposed, but we instead expose three separate
+ [{unification,equality,moregen}] functions. This also lets us
+ give the unification case an extra optional argument without adding it to the
+ equality and moregen cases. *)
+type 'variety trace_format =
+ | Unification : Errortrace.unification trace_format
+ | Equality : Errortrace.comparison trace_format
+ | Moregen : Errortrace.comparison trace_format
+
+let incompatibility_phrase (type variety) : variety trace_format -> string =
+ function
+ | Unification -> "is not compatible with type"
+ | Equality -> "is not equal to type"
+ | Moregen -> "is not compatible with type"
+
+(* Print a unification error *)
+open Out_type
+open Format_doc
+module Fmt = Format_doc
+module Style = Misc.Style
+
+type 'a diff = 'a Out_type.diff = Same of 'a | Diff of 'a * 'a
+
+let trees_of_trace mode =
+ List.map (Errortrace.map_diff (trees_of_type_expansion mode))
+
+let rec trace fst txt ppf = function
+ | {Errortrace.got; expected} :: rem ->
+ if not fst then fprintf ppf "@,";
+ fprintf ppf "@[Type@;<1 2>%a@ %s@;<1 2>%a@]%a"
+ pp_type_expansion got txt pp_type_expansion expected
+ (trace false txt) rem
+ | _ -> ()
+
+type printing_status =
+ | Discard
+ | Keep
+ | Optional_refinement
+ (** An [Optional_refinement] printing status is attributed to trace
+ elements that are focusing on a new subpart of a structural type.
+ Since the whole type should have been printed earlier in the trace,
+ we only print those elements if they are the last printed element
+ of a trace, and there is no explicit explanation for the
+ type error.
+ *)
+
+let diff_printing_status Errortrace.{ got = {ty = t1; expanded = t1'};
+ expected = {ty = t2; expanded = t2'} } =
+ if Btype.is_constr_row ~allow_ident:true t1'
+ || Btype.is_constr_row ~allow_ident:true t2'
+ then Discard
+ else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
+ else Keep
+
+let printing_status = function
+ | Errortrace.Diff d -> diff_printing_status d
+ | Errortrace.Escape {kind = Constraint} -> Keep
+ | _ -> Keep
+
+(** Flatten the trace and remove elements that are always discarded
+ during printing *)
+
+(* Takes [printing_status] to change behavior for [Subtype] *)
+let prepare_any_trace printing_status tr =
+ let clean_trace x l = match printing_status x with
+ | Keep -> x :: l
+ | Optional_refinement when l = [] -> [x]
+ | Optional_refinement | Discard -> l
+ in
+ match tr with
+ | [] -> []
+ | elt :: rem -> elt :: List.fold_right clean_trace rem []
+
+let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.map f tr)
+
+(** Keep elements that are [Diff _ ] and split the the last element if it is
+ optionally elidable, require a prepared trace *)
+let rec filter_trace = function
+ | [] -> [], None
+ | [Errortrace.Diff d as elt]
+ when printing_status elt = Optional_refinement -> [], Some d
+ | Errortrace.Diff d :: rem ->
+ let filtered, last = filter_trace rem in
+ d :: filtered, last
+ | _ :: rem -> filter_trace rem
+
+let may_prepare_expansion compact (Errortrace.{ty; expanded} as ty_exp) =
+ match Types.get_desc expanded with
+ Tvariant _ | Tobject _ when compact ->
+ Variable_names.reserve ty; Errortrace.{ty; expanded = ty}
+ | _ -> prepare_expansion ty_exp
+
+let print_path p =
+ Fmt.dprintf "%a" !Oprint.out_ident (namespaced_tree_of_path Type p)
+
+let print_tag ppf s = Style.inline_code ppf ("`" ^ s)
+
+let print_tags ppf tags =
+ Fmt.(pp_print_list ~pp_sep:comma) print_tag ppf tags
+
+let is_unit env ty =
+ match Types.get_desc (Ctype.expand_head env ty) with
+ | Tconstr (p, _, _) -> Path.same p Predef.path_unit
+ | _ -> false
+
+let unifiable env ty1 ty2 =
+ let snap = Btype.snapshot () in
+ let res =
+ try Ctype.unify env ty1 ty2; true
+ with Ctype.Unify _ -> false
+ in
+ Btype.backtrack snap;
+ res
+
+let explanation_diff env t3 t4 =
+ match Types.get_desc t3, Types.get_desc t4 with
+ | Tarrow (_, ty1, ty2, _), _
+ when is_unit env ty1 && unifiable env ty2 t4 ->
+ Some (doc_printf
+ "@,@[@{<hint>Hint@}: Did you forget to provide %a as argument?@]"
+ Style.inline_code "()"
+ )
+ | _, Tarrow (_, ty1, ty2, _)
+ when is_unit env ty1 && unifiable env t3 ty2 ->
+ Some (doc_printf
+ "@,@[@{<hint>Hint@}: Did you forget to wrap the expression using \
+ %a?@]"
+ Style.inline_code "fun () ->"
+ )
+ | _ ->
+ None
+
+let explain_fixed_row_case = function
+ | Errortrace.Cannot_be_closed -> doc_printf "it cannot be closed"
+ | Errortrace.Cannot_add_tags tags ->
+ doc_printf "it may not allow the tag(s) %a"
+ print_tags tags
+
+let pp_path ppf p =
+ Style.as_inline_code Printtyp.Doc.path ppf p
+
+let explain_fixed_row pos expl = match expl with
+ | Types.Fixed_private ->
+ doc_printf "The %a variant type is private" Errortrace.print_pos pos
+ | Types.Univar x ->
+ Variable_names.reserve x;
+ doc_printf "The %a variant type is bound to the universal type variable %a"
+ Errortrace.print_pos pos
+ (Style.as_inline_code type_expr_with_reserved_names) x
+ | Types.Reified p ->
+ doc_printf "The %a variant type is bound to %a"
+ Errortrace.print_pos pos
+ (Style.as_inline_code
+ (fun ppf p ->
+ Internal_names.add p;
+ print_path p ppf))
+ p
+ | Types.Rigid -> Format_doc.Doc.empty
+
+let explain_variant (type variety) : variety Errortrace.variant -> _ = function
+ (* Common *)
+ | Errortrace.Incompatible_types_for s ->
+ Some(doc_printf "@,Types for tag %a are incompatible"
+ print_tag s
+ )
+ (* Unification *)
+ | Errortrace.No_intersection ->
+ Some(doc_printf "@,These two variant types have no intersection")
+ | Errortrace.No_tags(pos,fields) -> Some(
+ doc_printf
+ "@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
+ Errortrace.print_pos pos
+ print_tags (List.map fst fields)
+ )
+ | Errortrace.Fixed_row (pos,
+ k,
+ (Univar _ | Reified _ | Fixed_private as e)) ->
+ Some (
+ doc_printf "@,@[%a,@ %a@]" pp_doc (explain_fixed_row pos e)
+ pp_doc (explain_fixed_row_case k)
+ )
+ | Errortrace.Fixed_row (_,_, Rigid) ->
+ (* this case never happens *)
+ None
+ (* Equality & Moregen *)
+ | Errortrace.Presence_not_guaranteed_for (pos, s) -> Some(
+ doc_printf
+ "@,@[The tag %a is guaranteed to be present in the %a variant type,\
+ @ but not in the %a@]"
+ print_tag s
+ Errortrace.print_pos (Errortrace.swap_position pos)
+ Errortrace.print_pos pos
+ )
+ | Errortrace.Openness pos ->
+ Some(doc_printf "@,The %a variant type is open and the %a is not"
+ Errortrace.print_pos pos
+ Errortrace.print_pos (Errortrace.swap_position pos))
+
+let explain_escape pre = function
+ | Errortrace.Univ u ->
+ Variable_names.reserve u;
+ Some(
+ doc_printf "%a@,The universal variable %a would escape its scope"
+ pp_doc pre
+ (Style.as_inline_code type_expr_with_reserved_names) u
+ )
+ | Errortrace.Constructor p -> Some(
+ doc_printf
+ "%a@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
+ pp_doc pre pp_path p
+ )
+ | Errortrace.Module_type p -> Some(
+ doc_printf
+ "%a@,@[The module type@;<1 2>%a@ would escape its scope@]"
+ pp_doc pre pp_path p
+ )
+ | Errortrace.Equation Errortrace.{ty = _; expanded = t} ->
+ Variable_names.reserve t;
+ Some(
+ doc_printf "%a@ @[<hov>This instance of %a is ambiguous:@ %s@]"
+ pp_doc pre
+ (Style.as_inline_code type_expr_with_reserved_names) t
+ "it would escape the scope of its equation"
+ )
+ | Errortrace.Self ->
+ Some (doc_printf "%a@,Self type cannot escape its class" pp_doc pre)
+ | Errortrace.Constraint ->
+ None
+
+let explain_object (type variety) : variety Errortrace.obj -> _ = function
+ | Errortrace.Missing_field (pos,f) -> Some(
+ doc_printf "@,@[The %a object type has no method %a@]"
+ Errortrace.print_pos pos Style.inline_code f
+ )
+ | Errortrace.Abstract_row pos -> Some(
+ doc_printf
+ "@,@[The %a object type has an abstract row, it cannot be closed@]"
+ Errortrace.print_pos pos
+ )
+ | Errortrace.Self_cannot_be_closed ->
+ Some (doc_printf
+ "@,Self type cannot be unified with a closed object type"
+ )
+
+let explain_incompatible_fields name (diff: Types.type_expr Errortrace.diff) =
+ Variable_names.reserve diff.got;
+ Variable_names.reserve diff.expected;
+ doc_printf "@,@[The method %a has type@ %a,@ \
+ but the expected method type was@ %a@]"
+ Style.inline_code name
+ (Style.as_inline_code type_expr_with_reserved_names) diff.got
+ (Style.as_inline_code type_expr_with_reserved_names) diff.expected
+
+
+let explain_label_mismatch ~got ~expected =
+ let quoted_label ppf l = Style.inline_code ppf (Asttypes.string_of_label l) in
+ match got, expected with
+ | Asttypes.Nolabel, Asttypes.(Labelled _ | Optional _ ) ->
+ doc_printf "@,@[A label@ %a@ was expected@]"
+ quoted_label expected
+ | Asttypes.(Labelled _|Optional _), Asttypes.Nolabel ->
+ doc_printf
+ "@,@[The first argument is labeled@ %a,@ \
+ but an unlabeled argument was expected@]"
+ quoted_label got
+ | Asttypes.Labelled g, Asttypes.Optional e when g = e ->
+ doc_printf
+ "@,@[The label@ %a@ was expected to be optional@]"
+ quoted_label got
+ | Asttypes.Optional g, Asttypes.Labelled e when g = e ->
+ doc_printf
+ "@,@[The label@ %a@ was expected to not be optional@]"
+ quoted_label got
+ | Asttypes.(Labelled _ | Optional _), Asttypes.(Labelled _ | Optional _) ->
+ doc_printf "@,@[Labels %a@ and@ %a do not match@]"
+ quoted_label got
+ quoted_label expected
+ | Asttypes.Nolabel, Asttypes.Nolabel ->
+ (* Two empty labels cannot be mismatched*)
+ assert false
+
+
+let explain_first_class_module = function
+ | Errortrace.Package_cannot_scrape p -> Some(
+ doc_printf "@,@[The module alias %a could not be expanded@]"
+ pp_path p
+ )
+ | Errortrace.Package_inclusion pr ->
+ Some(doc_printf "@,@[%a@]" Fmt.pp_doc pr)
+ | Errortrace.Package_coercion pr ->
+ Some(doc_printf "@,@[%a@]" Fmt.pp_doc pr)
+
+let explanation (type variety) intro prev env
+ : (Errortrace.expanded_type, variety) Errortrace.elt -> _ = function
+ | Errortrace.Diff {got; expected} ->
+ explanation_diff env got.expanded expected.expanded
+ | Errortrace.Escape {kind; context} ->
+ let pre =
+ match context, kind, prev with
+ | Some ctx, _, _ ->
+ Variable_names.reserve ctx;
+ doc_printf "@[%a@;<1 2>%a@]" pp_doc intro
+ (Style.as_inline_code type_expr_with_reserved_names) ctx
+ | None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
+ explain_incompatible_fields name diff
+ | _ -> Format_doc.Doc.empty
+ in
+ explain_escape pre kind
+ | Errortrace.Incompatible_fields { name; diff} ->
+ Some(explain_incompatible_fields name diff)
+ | Errortrace.Function_label_mismatch diff ->
+ Some(explain_label_mismatch ~got:diff.got ~expected:diff.expected)
+ | Errortrace.Variant v ->
+ explain_variant v
+ | Errortrace.Obj o ->
+ explain_object o
+ | Errortrace.First_class_module fm ->
+ explain_first_class_module fm
+ | Errortrace.Rec_occur(x,y) ->
+ add_type_to_preparation x;
+ add_type_to_preparation y;
+ begin match Types.get_desc x with
+ | Tvar _ | Tunivar _ ->
+ Some(
+ doc_printf "@,@[<hov>The type variable %a occurs inside@ %a@]"
+ (Style.as_inline_code prepared_type_expr) x
+ (Style.as_inline_code prepared_type_expr) y
+ )
+ | _ ->
+ (* We had a delayed unification of the type variable with
+ a non-variable after the occur check. *)
+ Some Format_doc.Doc.empty
+ (* There is no need to search further for an explanation, but
+ we don't want to print a message of the form:
+ {[ The type int occurs inside int list -> 'a |}
+ *)
+ end
+
+let mismatch intro env trace =
+ Errortrace.explain trace (fun ~prev h -> explanation intro prev env h)
+
+let warn_on_missing_def env ppf t =
+ match Types.get_desc t with
+ | Tconstr (p,_,_) ->
+ begin match Env.find_type p env with
+ | exception Not_found ->
+ fprintf ppf
+ "@,@[<hov>Type %a is abstract because@ no corresponding\
+ @ cmi file@ was found@ in path.@]" pp_path p
+ | { type_manifest = Some _; _ } -> ()
+ | { type_manifest = None; _ } as decl ->
+ match Btype.type_origin decl with
+ | Rec_check_regularity ->
+ fprintf ppf
+ "@,@[<hov>Type %a was considered abstract@ when checking\
+ @ constraints@ in this@ recursive type definition.@]"
+ pp_path p
+ | Definition | Existential _ -> ()
+ end
+ | _ -> ()
+
+let prepare_expansion_head empty_tr = function
+ | Errortrace.Diff d ->
+ Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
+ | _ -> None
+
+let head_error_printer mode txt_got txt_but = function
+ | None -> Format_doc.Doc.empty
+ | Some d ->
+ let d = Errortrace.map_diff (trees_of_type_expansion mode) d in
+ doc_printf "%a@;<1 2>%a@ %a@;<1 2>%a"
+ pp_doc txt_got pp_type_expansion d.Errortrace.got
+ pp_doc txt_but pp_type_expansion d.Errortrace.expected
+
+let warn_on_missing_defs env ppf = function
+ | None -> ()
+ | Some Errortrace.{got = {ty=te1; expanded=_};
+ expected = {ty=te2; expanded=_} } ->
+ warn_on_missing_def env ppf te1;
+ warn_on_missing_def env ppf te2
+
+(* [subst] comes out of equality, and is [[]] otherwise *)
+let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation =
+ reset ();
+ (* We want to substitute in the opposite order from [Eqtype] *)
+ Variable_names.add_subst (List.map (fun (ty1,ty2) -> ty2,ty1) subst);
+ let tr =
+ prepare_trace
+ (fun ty_exp ->
+ Errortrace.{ty_exp with expanded = hide_variant_name ty_exp.expanded})
+ tr
+ in
+ match tr with
+ | [] -> assert false
+ | (elt :: tr) as full_trace ->
+ with_labels (not !Clflags.classic) (fun () ->
+ let tr, last = filter_trace tr in
+ let head = prepare_expansion_head (tr=[] && last=None) elt in
+ let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
+ let last = Option.map (Errortrace.map_diff prepare_expansion) last in
+ let head_error = head_error_printer mode txt1 txt2 head in
+ let tr = trees_of_trace mode tr in
+ let last =
+ Option.map (Errortrace.map_diff (trees_of_type_expansion mode)) last in
+ let mis = mismatch txt1 env full_trace in
+ let tr = match mis, last with
+ | None, Some elt -> tr @ [elt]
+ | Some _, _ | _, None -> tr
+ in
+ fprintf ppf
+ "@[<v>\
+ @[%a%a@]%a%a\
+ @]"
+ pp_doc head_error
+ pp_doc ty_expect_explanation
+ (trace false (incompatibility_phrase trace_format)) tr
+ (pp_print_option pp_doc) mis;
+ if env <> Env.empty
+ then warn_on_missing_defs env ppf head;
+ Internal_names.print_explanations env ppf;
+ Ident_conflicts.err_print ppf
+ )
+
+let report_error trace_format ppf mode env tr
+ ?(subst = [])
+ ?(type_expected_explanation = Fmt.Doc.empty)
+ txt1 txt2 =
+ wrap_printing_env ~error:true env (fun () ->
+ error trace_format mode subst env tr txt1 ppf txt2
+ type_expected_explanation)
+
+let unification
+ ppf env ({trace} : Errortrace.unification_error) =
+ report_error Unification ppf Type env
+ ?subst:None trace
+
+let equality
+ ppf mode env ({subst; trace} : Errortrace.equality_error) =
+ report_error Equality ppf mode env
+ ~subst ?type_expected_explanation:None trace
+
+let moregen
+ ppf mode env ({trace} : Errortrace.moregen_error) =
+ report_error Moregen ppf mode env
+ ?subst:None ?type_expected_explanation:None trace
+
+let comparison ppf mode env = function
+ | Errortrace.Equality_error error -> equality ppf mode env error
+ | Errortrace.Moregen_error error -> moregen ppf mode env error
+
+module Subtype = struct
+ (* There's a frustrating amount of code duplication between this module and
+ the outside code, particularly in [prepare_trace] and [filter_trace].
+ Unfortunately, [Subtype] is *just* similar enough to have code duplication,
+ while being *just* different enough (it's only [Diff]) for the abstraction
+ to be nonobvious. Someday, perhaps... *)
+
+ let printing_status = function
+ | Errortrace.Subtype.Diff d -> diff_printing_status d
+
+ let prepare_unification_trace = prepare_trace
+
+ let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.Subtype.map f tr)
+
+ let trace filter_trace get_diff fst keep_last txt ppf tr =
+ with_labels (not !Clflags.classic) (fun () ->
+ match tr with
+ | elt :: tr' ->
+ let diffed_elt = get_diff elt in
+ let tr, last = filter_trace tr' in
+ let tr = match keep_last, last with
+ | true, Some last -> tr @ [last]
+ | _ -> tr
+ in
+ let tr =
+ trees_of_trace Type
+ @@ List.map (Errortrace.map_diff prepare_expansion) tr in
+ let tr =
+ match fst, diffed_elt with
+ | true, Some elt -> elt :: tr
+ | _, _ -> tr
+ in
+ trace fst txt ppf tr
+ | _ -> ()
+ )
+
+ let rec filter_subtype_trace = function
+ | [] -> [], None
+ | [Errortrace.Subtype.Diff d as elt]
+ when printing_status elt = Optional_refinement ->
+ [], Some d
+ | Errortrace.Subtype.Diff d :: rem ->
+ let ftr, last = filter_subtype_trace rem in
+ d :: ftr, last
+
+ let unification_get_diff = function
+ | Errortrace.Diff diff ->
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+ | _ -> None
+
+ let subtype_get_diff = function
+ | Errortrace.Subtype.Diff diff ->
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+
+ let error
+ ppf
+ env
+ (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif})
+ txt1 =
+ wrap_printing_env ~error:true env (fun () ->
+ reset ();
+ let tr_sub = prepare_trace prepare_expansion tr_sub in
+ let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
+ let keep_first = match tr_unif with
+ | [Obj _ | Variant _ | Escape _ ] | [] -> true
+ | _ -> false in
+ fprintf ppf "@[<v>%a"
+ (trace filter_subtype_trace subtype_get_diff true keep_first txt1)
+ tr_sub;
+ if tr_unif = [] then fprintf ppf "@]" else
+ let mis = mismatch (doc_printf "Within this type") env tr_unif in
+ fprintf ppf "%a%a%t@]"
+ (trace filter_trace unification_get_diff false
+ (mis = None) "is not compatible with type") tr_unif
+ (pp_print_option pp_doc) mis
+ Ident_conflicts.err_print
+ )
+end
+
+let subtype = Subtype.error
+
+let quoted_ident ppf t =
+ Style.as_inline_code !Oprint.out_ident ppf t
+
+let type_path_expansion ppf = function
+ | Same p -> quoted_ident ppf p
+ | Diff(p,p') ->
+ fprintf ppf "@[<2>%a@ =@ %a@]"
+ quoted_ident p
+ quoted_ident p'
+
+let trees_of_type_path_expansion (tp,tp') =
+ let path_tree = namespaced_tree_of_path Type in
+ if Path.same tp tp' then Same(path_tree tp) else
+ Diff(path_tree tp, path_tree tp)
+
+let type_path_list ppf l =
+ Fmt.pp_print_list ~pp_sep:(fun ppf () -> Fmt.pp_print_break ppf 2 0)
+ type_path_expansion ppf l
+
+let ambiguous_type ppf env tp0 tpl txt1 txt2 txt3 =
+ wrap_printing_env ~error:true env (fun () ->
+ reset ();
+ let tp0 = trees_of_type_path_expansion tp0 in
+ match tpl with
+ [] -> assert false
+ | [tp] ->
+ fprintf ppf
+ "@[%a@;<1 2>%a@ \
+ %a@;<1 2>%a\
+ @]"
+ pp_doc txt1 type_path_expansion (trees_of_type_path_expansion tp)
+ pp_doc txt3 type_path_expansion tp0
+ | _ ->
+ fprintf ppf
+ "@[%a@;<1 2>@[<hv>%a@]\
+ @ %a@;<1 2>%a\
+ @]"
+ pp_doc txt2 type_path_list (List.map trees_of_type_path_expansion tpl)
+ pp_doc txt3 type_path_expansion tp0)
diff --git a/upstream/ocaml_503/typing/errortrace_report.mli b/upstream/ocaml_503/typing/errortrace_report.mli
new file mode 100644
index 0000000000..bb6f0ea9e1
--- /dev/null
+++ b/upstream/ocaml_503/typing/errortrace_report.mli
@@ -0,0 +1,56 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+(** Functions for reporting core level type errors. *)
+
+open Format_doc
+
+val ambiguous_type:
+ formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
+ Format_doc.t -> Format_doc.t -> Format_doc.t -> unit
+
+val unification :
+ formatter ->
+ Env.t -> Errortrace.unification_error ->
+ ?type_expected_explanation:Format_doc.t -> Format_doc.t -> Format_doc.t ->
+ unit
+
+val equality :
+ formatter ->
+ Out_type.type_or_scheme ->
+ Env.t -> Errortrace.equality_error ->
+ Format_doc.t -> Format_doc.t ->
+ unit
+
+val moregen :
+ formatter ->
+ Out_type.type_or_scheme ->
+ Env.t -> Errortrace.moregen_error ->
+ Format_doc.t -> Format_doc.t ->
+ unit
+
+val comparison :
+ formatter ->
+ Out_type.type_or_scheme ->
+ Env.t -> Errortrace.comparison_error ->
+ Format_doc.t -> Format_doc.t ->
+ unit
+
+val subtype :
+ formatter ->
+ Env.t ->
+ Errortrace.Subtype.error ->
+ string ->
+ unit
diff --git a/upstream/ocaml_503/typing/gprinttyp.ml b/upstream/ocaml_503/typing/gprinttyp.ml
new file mode 100644
index 0000000000..0056efb93a
--- /dev/null
+++ b/upstream/ocaml_503/typing/gprinttyp.ml
@@ -0,0 +1,912 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+
+(* Print a raw type expression, with sharing *)
+open Format
+
+module String_set = Set.Make(String)
+
+module Decoration = struct
+ type color =
+ | Named of string
+ | HSL of {h:float;s:float;l:float}
+
+ let red = Named "red"
+ let blue = Named "blue"
+ let green = Named "green"
+ let purple = Named "purple"
+ let lightgrey = Named "lightgrey"
+ let hsl ~h ~s ~l = HSL {h;s;l}
+
+ type style =
+ | Filled of color option
+ | Dotted
+ | Dash
+
+ type shape =
+ | Ellipse
+ | Circle
+ | Diamond
+
+ type property =
+ | Color of color
+ | Font_color of color
+ | Style of style
+ | Label of string list
+ | Shape of shape
+
+ let filled c = Style (Filled (Some c))
+
+ type r = {
+ color: color option;
+ font_color:color option;
+ style: style option;
+ label: string list;
+ shape: shape option;
+ }
+
+ let update r l = match l with
+ | Color c -> { r with color = Some c}
+ | Style s -> { r with style = Some s}
+ | Label s -> { r with label = s}
+ | Font_color c -> { r with font_color = Some c}
+ | Shape s -> { r with shape = Some s }
+
+ let none = { color=None; font_color=None; style=None; shape=None; label = [] }
+
+ let make l = List.fold_left update none l
+
+ let label r = if r.label = [] then None else Some (Label r.label)
+ let color r = Option.map (fun x -> Color x) r.color
+ let font_color r = Option.map (fun x -> Font_color x) r.font_color
+ let style r = Option.map (fun x -> Style x) r.style
+ let shape r = Option.map (fun x -> Shape x) r.shape
+
+ let decompose r =
+ let (@?) x l = match x with
+ | None -> l
+ | Some x -> x :: l
+ in
+ label r @? color r @? font_color r @? style r @? shape r @? []
+
+ let alt x y = match x with
+ | None -> y
+ | Some _ -> x
+
+ let merge_label l r =
+ let r' = String_set.of_list r in
+ let l' = String_set.of_list l in
+ List.filter (fun x -> not (String_set.mem x r') ) l
+ @ List.filter (fun x -> not (String_set.mem x l') ) r
+
+ let merge l r =
+ { color = alt l.color r.color;
+ style = alt l.style r.style;
+ label = merge_label l.label r.label;
+ font_color = alt l.font_color r.font_color;
+ shape = alt l.shape r.shape;
+ }
+ let txt t = Label [t]
+
+end
+type decoration = Decoration.r
+
+type dir = Toward | From
+
+let txt = Decoration.txt
+let std = Decoration.none
+let dotted = Decoration.(make [Style Dotted])
+let memo = Decoration.(make [txt "expand"; Style Dash] )
+
+
+type params = {
+ short_ids:bool;
+ elide_links:bool;
+ expansion_as_hyperedge:bool;
+ colorize:bool;
+ follow_expansions:bool;
+}
+
+let elide_links ty =
+ let rec follow_safe visited t =
+ let t = Types.Transient_expr.coerce t in
+ if List.memq t visited then t
+ else match t.Types.desc with
+ | Tlink t' -> follow_safe (t::visited) t'
+ | _ -> t
+ in
+ follow_safe [] ty
+
+let repr params ty =
+ if params.elide_links then elide_links ty
+ else Types.Transient_expr.coerce ty
+
+module Index: sig
+ type t = private
+ | Main of int
+ | Synthetic of int
+ | Named_subnode of { id:int; synth:bool; name:string }
+ val subnode: name:string -> t -> t
+ val either_ext: Types.row_field_cell -> t
+ val split:
+ params -> Types.type_expr -> t * Decoration.color option * Types.type_desc
+ val colorize: params -> t -> Decoration.color option
+end = struct
+ type t =
+ | Main of int
+ | Synthetic of int
+ | Named_subnode of { id:int; synth:bool; name:string }
+
+ type name_map = {
+ (* We keep the main and synthetic and index space separate to avoid index
+ collision when we use the typechecker provided [id]s as main indices *)
+ main_last: int ref;
+ synthetic_last: int ref;
+ either_cell_ids: (Types.row_field_cell * int) list ref;
+ tbl: (int,int) Hashtbl.t;
+ }
+
+ let id_map = {
+ main_last = ref 0;
+ synthetic_last = ref 0;
+ either_cell_ids = ref [];
+ tbl = Hashtbl.create 20;
+ }
+
+ let fresh_main_id () =
+ incr id_map.main_last;
+ !(id_map.main_last)
+
+ let fresh_synthetic_id () =
+ incr id_map.synthetic_last;
+ !(id_map.synthetic_last)
+
+ let stable_id = function
+ | Main id | Synthetic id | Named_subnode {id;_} -> id
+
+ let pretty_id params id =
+ if not params.short_ids then Main id else
+ match Hashtbl.find_opt id_map.tbl id with
+ | Some x -> Main x
+ | None ->
+ let last = fresh_main_id () in
+ Hashtbl.replace id_map.tbl id last;
+ Main last
+
+ (** Generate color from the node id to keep the color stable inbetween
+ different calls to the typechecker on the same input. *)
+ let colorize_id params id =
+ if not params.colorize then None
+ else
+ (* Generate pseudo-random color by cycling over 200 hues while keeping
+ pastel level of saturation and lightness *)
+ let nhues = 200 in
+ (* 17 and 200 are relatively prime, thus 17 is of order 200 in Z/200Z. A
+ step size around 20 makes it relatively easy to spot different hues. *)
+ let h = float_of_int (17 * id mod nhues) /. float_of_int nhues in
+ (* Add a modulation of period 3 and 7 to the saturation and lightness *)
+ let s = match id mod 3 with
+ | 0 -> 0.3
+ | 1 -> 0.5
+ | 2 | _ -> 0.7
+ in
+ let l = match id mod 7 with
+ | 0 -> 0.5
+ | 1 -> 0.55
+ | 2 -> 0.60
+ | 3 -> 0.65
+ | 4 -> 0.70
+ | 5 -> 0.75
+ | 6 | _ -> 0.8
+ in
+ (* With 3, 7 and 200 relatively prime, we cycle over the full parameter
+ space with 4200 different colors. *)
+ Some (Decoration.hsl ~h ~s ~l)
+
+ let colorize params index = colorize_id params (stable_id index)
+
+ let split params x =
+ let x = repr params x in
+ let color = colorize_id params x.id in
+ pretty_id params x.id, color, x.desc
+
+ let subnode ~name x = match x with
+ | Main id -> Named_subnode {id;name;synth=false}
+ | Named_subnode r -> Named_subnode {r with name}
+ | Synthetic id -> Named_subnode {id;name;synth=true}
+
+ let either_ext r =
+ let either_ids = !(id_map.either_cell_ids) in
+ match List.assq_opt r either_ids with
+ | Some n -> Synthetic n
+ | None ->
+ let n = fresh_synthetic_id () in
+ id_map.either_cell_ids := (r,n) :: either_ids;
+ Synthetic n
+
+end
+
+
+type index = Index.t
+module Node_set = Set.Make(struct
+ type t = Index.t
+ let compare = Stdlib.compare
+end)
+
+module Edge_set = Set.Make(struct
+ type t = Index.t * Index.t
+ let compare = Stdlib.compare
+end)
+
+module Hyperedge_set = Set.Make(struct
+ type t = (dir * Decoration.r * index) list
+ let compare = Stdlib.compare
+end)
+
+type subgraph =
+ {
+ nodes: Node_set.t;
+ edges: Edge_set.t;
+ hyperedges: Hyperedge_set.t;
+ subgraphes: (Decoration.r * subgraph) list;
+ }
+
+
+let empty_subgraph=
+ { nodes = Node_set.empty;
+ edges=Edge_set.empty;
+ hyperedges = Hyperedge_set.empty;
+ subgraphes = [];
+ }
+
+
+type 'index elt =
+ | Node of 'index
+ | Edge of 'index * 'index
+ | Hyperedge of (dir * Decoration.r * 'index) list
+type element = Types.type_expr elt
+
+
+module Elt_map = Map.Make(struct
+ type t = Index.t elt
+ let compare = Stdlib.compare
+ end)
+let (.%()) map e =
+ Option.value ~default:Decoration.none @@
+ Elt_map.find_opt e map
+
+type digraph = {
+ elts: Decoration.r Elt_map.t;
+ graph: subgraph
+}
+
+module Pp = struct
+
+ let semi ppf () = fprintf ppf ";@ "
+ let space ppf () = fprintf ppf "@ "
+ let empty ppf () = fprintf ppf ""
+ let string =pp_print_string
+ let list ~sep = pp_print_list ~pp_sep:sep
+ let seq ~sep = pp_print_seq ~pp_sep:sep
+ let rec longident ppf = function
+ | Longident.Lident s -> fprintf ppf "%s" s
+ | Longident.Ldot (l,s) -> fprintf ppf "%a.%s" longident l s
+ | Longident.Lapply(f,x) -> fprintf ppf "%a(%a)" longident f longident x
+
+ let color ppf = function
+ | Decoration.Named s -> fprintf ppf "%s" s
+ | Decoration.HSL r -> fprintf ppf "%1.3f %1.3f %1.3f" r.h r.s r.l
+
+ let style ppf = function
+ | Decoration.Filled _ -> fprintf ppf "filled"
+ | Decoration.Dash -> fprintf ppf "dashed"
+ | Decoration.Dotted -> fprintf ppf "dotted"
+
+ let shape ppf = function
+ | Decoration.Circle -> fprintf ppf "circle"
+ | Decoration.Diamond -> fprintf ppf "diamond"
+ | Decoration.Ellipse -> fprintf ppf "ellipse"
+
+ let property ppf = function
+ | Decoration.Color c -> fprintf ppf {|color="%a"|} color c
+ | Decoration.Font_color c -> fprintf ppf {|fontcolor="%a"|} color c
+ | Decoration.Style s ->
+ fprintf ppf {|style="%a"|} style s;
+ begin match s with
+ | Filled (Some c) -> fprintf ppf {|;@ fillcolor="%a"|} color c;
+ | _ -> ()
+ end;
+ | Decoration.Shape s -> fprintf ppf {|shape="%a"|} shape s
+ | Decoration.Label s ->
+ fprintf ppf {|label=<%a>|} (list ~sep:space string) s
+
+ let inline_decoration ppf r =
+ match Decoration.decompose r with
+ | [] -> ()
+ | l -> fprintf ppf "@[<v>%a@]" (list ~sep:semi property) l
+
+ let decoration ppf r =
+ match Decoration.decompose r with
+ | [] -> ()
+ | l -> fprintf ppf "[@[<h>%a@]]" (list ~sep:semi property) l
+
+ let row_fixed ppf = function
+ | None -> fprintf ppf ""
+ | Some Types.Fixed_private -> fprintf ppf "private"
+ | Some Types.Rigid -> fprintf ppf "rigid"
+ | Some Types.Univar _t -> fprintf ppf "univar"
+ | Some Types.Reified _p -> fprintf ppf "reified"
+
+ let field_kind ppf v =
+ match Types.field_kind_repr v with
+ | Fpublic -> fprintf ppf "public"
+ | Fabsent -> fprintf ppf "absent"
+ | Fprivate -> fprintf ppf "private"
+
+ let index ppf = function
+ | Index.Main id -> fprintf ppf "i%d" id
+ | Index.Synthetic id -> fprintf ppf "s%d" id
+ | Index.Named_subnode r ->
+ fprintf ppf "%s%dRF%s" (if r.synth then "s" else "i") r.id r.name
+
+ let prettier_index ppf = function
+ | Index.Main id -> fprintf ppf "%d" id
+ | Index.Synthetic id -> fprintf ppf "[%d]" id
+ | Index.Named_subnode r -> fprintf ppf "%d(%s)" r.id r.name
+
+ let hyperedge_id ppf l =
+ let sep ppf () = fprintf ppf "h" in
+ let elt ppf (_,_,x) = index ppf x in
+ fprintf ppf "h%a" (list ~sep elt) l
+
+ let node graph ppf x =
+ let d = graph.%(Node x) in
+ fprintf ppf "%a%a;@ " index x decoration d
+
+ let edge graph ppf (x,y) =
+ let d = graph.%(Edge (x,y)) in
+ fprintf ppf "%a->%a%a;@ " index x index y decoration d
+
+ let hyperedge graph ppf l =
+ let d = graph.%(Hyperedge l) in
+ fprintf ppf "%a%a;@ " hyperedge_id l decoration d;
+ List.iter (fun (dir,d,x) ->
+ match dir with
+ | From ->
+ fprintf ppf "%a->%a%a;@ " index x hyperedge_id l decoration d
+ | Toward ->
+ fprintf ppf "%a->%a%a;@ " hyperedge_id l index x decoration d
+ ) l
+
+ let cluster_counter = ref 0
+ let pp_cluster ppf =
+ incr cluster_counter;
+ fprintf ppf "cluster_%d" !cluster_counter
+
+ let exponent_of_label ppf = function
+ | Asttypes.Nolabel -> ()
+ | Asttypes.Labelled s -> fprintf ppf "<SUP>%s</SUP>" s
+ | Asttypes.Optional s -> fprintf ppf "<SUP>?%s</SUP>" s
+
+ let pretty_var ppf name =
+ let name = Option.value ~default:"_" name in
+ let name' =
+ match name with
+ | "a" -> "𝛼"
+ | "b" -> "𝛽"
+ | "c" -> "𝛾"
+ | "d" -> "𝛿"
+ | "e" -> "𝜀"
+ | "f" -> "𝜑"
+ | "t" -> "𝜏"
+ | "r" -> "𝜌"
+ | "s" -> "𝜎"
+ | "p" -> "𝜋"
+ | "i" -> "𝜄"
+ | "h" -> "𝜂"
+ | "k" -> "𝜅"
+ | "l" -> "𝜆"
+ | "m" -> "𝜇"
+ | "x" -> "𝜒"
+ | "n" -> "𝜐"
+ | "o" -> "𝜔"
+ | name -> name
+ in
+ if name = name' then
+ fprintf ppf "'%s" name
+ else pp_print_string ppf name'
+
+ let rec subgraph elts ppf (d,sg) =
+ fprintf ppf
+ "@[<v 2>subgraph %t {@,\
+ %a;@ \
+ %a%a%a%a}@]@."
+ pp_cluster
+ inline_decoration d
+ (seq ~sep:empty (node elts)) (Node_set.to_seq sg.nodes)
+ (seq ~sep:empty (edge elts)) (Edge_set.to_seq sg.edges)
+ (seq ~sep:empty (hyperedge elts)) (Hyperedge_set.to_seq sg.hyperedges)
+ (list ~sep:empty (subgraph elts)) sg.subgraphes
+
+ let graph ppf {elts;graph} =
+ fprintf ppf "@[<v 2>digraph {@,%a%a%a%a}@]@."
+ (seq ~sep:empty (node elts)) (Node_set.to_seq graph.nodes)
+ (seq ~sep:empty (edge elts)) (Edge_set.to_seq graph.edges)
+ (seq ~sep:empty (hyperedge elts)) (Hyperedge_set.to_seq graph.hyperedges)
+ (list ~sep:empty (subgraph elts)) graph.subgraphes
+
+end
+
+
+module Digraph = struct
+
+ type t = digraph = {
+ elts: Decoration.r Elt_map.t;
+ graph: subgraph
+ }
+
+ let empty = { elts = Elt_map.empty; graph = empty_subgraph }
+
+ let add_to_subgraph s = function
+ | Node ty ->
+ let nodes = Node_set.add ty s.nodes in
+ { s with nodes }
+ | Edge (x,y) ->
+ let edges = Edge_set.add (x,y) s.edges in
+ { s with edges }
+ | Hyperedge l ->
+ let hyperedges = Hyperedge_set.add l s.hyperedges in
+ { s with hyperedges }
+
+ let add_subgraph sub g =
+ { g with subgraphes = sub :: g.subgraphes }
+
+ let add ?(override=false) d entry dg =
+ match Elt_map.find_opt entry dg.elts with
+ | Some d' ->
+ let d =
+ if override then Decoration.merge d d'
+ else Decoration.merge d' d
+ in
+ { dg with elts = Elt_map.add entry d dg.elts }
+ | None ->
+ let elts = Elt_map.add entry d dg.elts in
+ { elts; graph = add_to_subgraph dg.graph entry }
+
+ let rec hyperedges_of_memo ty params id abbrev dg =
+ match abbrev with
+ | Types.Mnil -> dg
+ | Types.Mcons (_priv, _p, t1, t2, rem) ->
+ let s, dg = ty params t1 dg in
+ let exp, dg = ty params t2 dg in
+ dg |>
+ add memo
+ (Hyperedge
+ [From, dotted, id;
+ Toward, dotted, s;
+ Toward, Decoration.make [txt "expand"], exp
+ ])
+ |> hyperedges_of_memo ty params id rem
+ | Types.Mlink rem -> hyperedges_of_memo ty params id !rem dg
+
+ let rec edges_of_memo ty params abbrev dg =
+ match abbrev with
+ | Types.Mnil -> dg
+ | Types.Mcons (_priv, _p, t1, t2, rem) ->
+ let x, dg = ty params t1 dg in
+ let y, dg = ty params t2 dg in
+ dg |> add memo (Edge (x,y)) |> edges_of_memo ty params rem
+ | Types.Mlink rem -> edges_of_memo ty params !rem dg
+
+ let expansions ty params id memo dg =
+ if params.expansion_as_hyperedge then
+ hyperedges_of_memo ty params id memo dg
+ else
+ edges_of_memo ty params memo dg
+
+ let labelk k fmt = kasprintf (fun s -> k [txt s]) fmt
+ let labelf fmt = labelk Fun.id fmt
+ let labelr fmt = labelk Decoration.make fmt
+
+ let add_node explicit_d color id tynode dg =
+ let d = labelf "<SUB>%a</SUB>" Pp.prettier_index id in
+ let d = match color with
+ | None -> Decoration.make d
+ | Some x -> Decoration.(make (filled x :: d))
+ in
+ let d = Decoration.merge explicit_d d in
+ add d tynode dg
+
+ let field_node color lbl rf =
+ let col = match color with
+ | None -> []
+ | Some c -> [Decoration.Color c]
+ in
+ let pr_lbl ppf = match lbl with
+ | None -> ()
+ | Some lbl -> fprintf ppf "`%s" lbl
+ in
+ let lbl =
+ Types.match_row_field
+ ~absent:(fun _ -> labelf "`-%t" pr_lbl)
+ ~present:(fun _ -> labelf ">%t" pr_lbl)
+ ~either:(fun c _tl m _e ->
+ labelf "%s%t%s"
+ (if m then "?" else "")
+ pr_lbl
+ (if c then "(∅)" else "")
+ )
+ rf
+ in
+ Decoration.(make (Shape Diamond::col@lbl))
+
+ let group ty id0 lbl l dg =
+ match l with
+ | [] -> dg
+ | first :: l ->
+ let sub = { dg with graph = empty_subgraph } in
+ let id, sub = ty first sub in
+ let sub = List.fold_left (fun dg t -> snd (ty t dg)) sub l in
+ let dg = { sub with graph = add_subgraph (lbl,sub.graph) dg.graph } in
+ dg |> add std (Edge(id0,id))
+
+ let split_fresh_typ params ty0 g =
+ let (id, color, desc) = Index.split params ty0 in
+ let tynode = Node id in
+ if Elt_map.mem tynode g then id, None else id, Some (tynode,color,desc)
+
+ let pp_path = Format_doc.compat Path.print
+
+ let rec inject_typ params ty0 dg =
+ let id, next = split_fresh_typ params ty0 dg.elts in
+ match next with
+ | None -> id, dg
+ | Some (tynode,color,desc) ->
+ id, node params color id tynode desc dg
+ and edge params id0 lbl ty gh =
+ let id, gh = inject_typ params ty gh in
+ add lbl (Edge(id0,id)) gh
+ and poly_edge ~color params id0 gh ty =
+ let id, gh = inject_typ params ty gh in
+ match color with
+ | None -> add (labelr "bind") (Edge (id0,id)) gh
+ | Some c ->
+ let d = Decoration.(make [txt "bind"; Color c]) in
+ let gh = add d (Edge (id0,id)) gh in
+ add ~override:true Decoration.(make [filled c]) (Node id) gh
+ and numbered_edge params id0 (i,gh) ty =
+ let l = labelr "%d" i in
+ i + 1, edge params id0 l ty gh
+ and numbered_edges params id0 l gh =
+ snd @@ List.fold_left
+ (numbered_edge params id0)
+ (0,gh) l
+ and node params color id tynode desc dg =
+ let add_tynode l = add_node l color id tynode dg in
+ let mk fmt = labelk (fun l -> add_tynode (Decoration.make l)) fmt in
+ let numbered = numbered_edges params id in
+ let edge = edge params id in
+ let std_edge = edge std in
+ match desc with
+ | Types.Tvar name -> mk "%a" Pp.pretty_var name
+ | Types.Tarrow(l,t1,t2,_) ->
+ mk "→%a" Pp.exponent_of_label l |> numbered [t1; t2]
+ | Types.Ttuple tl ->
+ mk "*" |> numbered tl
+ | Types.Tconstr (p,tl,abbrevs) ->
+ let constr = mk "%a" pp_path p |> numbered tl in
+ if not params.follow_expansions then
+ constr
+ else
+ expansions inject_typ params id !abbrevs constr
+ | Types.Tobject (t, name) ->
+ let dg =
+ begin match !name with
+ | None -> mk "[obj]"
+ | Some (p,[]) -> (* invalid format *)
+ mk "[obj(%a)]" pp_path p
+ | Some (p, (rv_or_nil :: tl)) ->
+ match Types.get_desc rv_or_nil with
+ | Tnil ->
+ mk "[obj(%a)]" pp_path p |> std_edge t |> numbered tl
+ | _ ->
+ mk "[obj(#%a)]" pp_path p
+ |> edge (labelr "row variable") rv_or_nil
+ |> numbered tl
+ end
+ in
+ begin match split_fresh_typ params t dg.elts with
+ | _, None -> dg
+ | next_id, Some (_, color, desc) ->
+ group_fields ~params ~prev_id:id
+ dg.elts dg.graph empty_subgraph
+ ~id:next_id ~color ~desc
+ end
+ | Types.Tfield _ ->
+ group_fields ~params ~prev_id:id
+ dg.elts dg.graph empty_subgraph
+ ~color ~id ~desc
+ | Types.Tnil -> mk "[Nil]"
+ | Types.Tlink t -> add_tynode Decoration.(make [Style Dash]) |> std_edge t
+ | Types.Tsubst (t, o) ->
+ let dg = add_tynode (labelr "[Subst]") |> std_edge t in
+ begin match o with
+ | None -> dg
+ | Some row -> edge (labelr "parent polyvar") row dg
+ end
+ | Types.Tunivar name ->
+ mk "%a<SUP>∀</SUP>" Pp.pretty_var name
+ | Types.Tpoly (t, tl) ->
+ let dg = mk "∀" |> std_edge t in
+ List.fold_left (poly_edge ~color params id) dg tl
+ | Types.Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = Types.row_repr row in
+ let closed = if closed then "<SUP>closed</SUP>" else "" in
+ let dg = match name with
+ | None -> mk "[Row%s]" closed
+ | Some (p,tl) ->
+ mk "[Row %a%s]" pp_path p closed
+ |> numbered tl
+ in
+ let more_lbl = labelr "%a row variable" Pp.row_fixed fixed in
+ let dg = dg |> edge more_lbl more in
+ let elts, main, fields =
+ List.fold_left (variant params id)
+ (dg.elts, dg.graph, empty_subgraph)
+ fields
+ in
+ { elts; graph = add_subgraph (labelr "polyvar", fields) main }
+ | Types.Tpackage (p, fl) ->
+ let types = List.map snd fl in
+ mk "[mod %a with %a]"
+ pp_path p
+ Pp.(list ~sep:semi longident) (List.map fst fl)
+ |> numbered types
+ and variant params id0 (elts,main,fields) (name,rf) =
+ let id = Index.subnode ~name id0 in
+ let fnode = Node id in
+ let color = Index.colorize params id in
+ let fgraph = { elts; graph=fields } in
+ let fgraph = add (field_node color (Some name) rf) fnode fgraph in
+ let { elts; graph=fields} = add dotted (Edge(id0,id)) fgraph in
+ let mgraph = { elts; graph=main } in
+ let {elts; graph=main} =
+ variant_inside params id rf mgraph
+ in
+ elts, main, fields
+ and variant_inside params id rf dg =
+ Types.match_row_field
+ ~absent:(fun () -> dg)
+ ~present:(function
+ | None -> dg
+ | Some arg -> numbered_edges params id [arg] dg
+ )
+ ~either:(fun _ tl _ (cell,e) ->
+ let dg = match tl with
+ | [] -> dg
+ | [x] -> edge params id std x dg
+ | _ :: _ as tls ->
+ let label = Decoration.(make [txt "⋀"; filled lightgrey]) in
+ group (inject_typ params) id label tls dg
+ in
+ match e with
+ | None -> dg
+ | Some f ->
+ let id_ext = Index.either_ext cell in
+ let color = Index.colorize params id_ext in
+ let dg = add (field_node color None f) (Node id_ext) dg in
+ let dg = add std (Edge(id,id_ext)) dg in
+ variant_inside params id_ext f dg
+ )
+ rf
+ and group_fields ~params ~prev_id elts main fields
+ ~color ~id ~desc =
+ let add_tynode dg l = add_node l color id (Node id) dg in
+ let mk dg fmt = labelk (fun l -> add_tynode dg (Decoration.make l)) fmt in
+ let merge elts ~main ~fields =
+ {elts; graph= add_subgraph (labelr "fields", fields) main }
+ in
+ match desc with
+ | Types.Tfield (f, k,typ, next) ->
+ let fgraph = { elts; graph=fields } in
+ let fgraph = mk fgraph "%s<SUP>%a</SUP>" f Pp.field_kind k in
+ let {elts; graph=fields} = add dotted (Edge (prev_id,id)) fgraph in
+ let {elts; graph=main} =
+ edge params id (labelr "method type") typ
+ {elts; graph= main}
+ in
+ let id_next, next = split_fresh_typ params next elts in
+ begin match next with
+ | None -> {elts; graph=main}
+ | Some (_,color,desc) ->
+ group_fields ~params ~prev_id:id
+ elts main fields
+ ~id:id_next ~desc ~color
+ end
+ | Types.Tvar name ->
+ let dg = mk {elts; graph= fields } "%a" Pp.pretty_var name in
+ let {elts; graph=fields} =
+ add (labelr "row variable") (Edge(prev_id,id)) dg
+ in
+ merge elts ~main ~fields
+ | Types.Tnil -> merge elts ~main ~fields
+ | _ ->
+ let dg = merge elts ~main ~fields in
+ node params color id (Node id) desc dg
+end
+
+let params
+ ?(elide_links=true)
+ ?(expansion_as_hyperedge=false)
+ ?(short_ids=true)
+ ?(colorize=true)
+ ?(follow_expansions=true)
+ () =
+ {
+ expansion_as_hyperedge;
+ short_ids;
+ elide_links;
+ colorize;
+ follow_expansions;
+ }
+
+let update_params ?elide_links
+ ?expansion_as_hyperedge
+ ?short_ids
+ ?colorize
+ ?follow_expansions
+ params =
+ {
+ elide_links = Option.value ~default:params.elide_links elide_links;
+ expansion_as_hyperedge =
+ Option.value ~default:params.expansion_as_hyperedge
+ expansion_as_hyperedge;
+ short_ids = Option.value ~default:params.short_ids short_ids;
+ colorize = Option.value ~default:params.colorize colorize;
+ follow_expansions =
+ Option.value ~default:params.follow_expansions follow_expansions;
+ }
+
+
+let translate params dg (label,entry) =
+ let node, dg = match entry with
+ | Node ty ->
+ let id, dg = Digraph.inject_typ params ty dg in
+ Node id, dg
+ | Edge (ty,ty') ->
+ let id, dg = Digraph.inject_typ params ty dg in
+ let id', dg = Digraph.inject_typ params ty' dg in
+ Edge(id,id'), dg
+ | Hyperedge l ->
+ let l, dg = List.fold_left (fun (l,dg) (d,lbl,ty) ->
+ let id, dg = Digraph.inject_typ params ty dg in
+ (d,lbl,id)::l, dg
+ ) ([],dg) l
+ in
+ Hyperedge l, dg
+ in
+ Digraph.add ~override:true label node dg
+
+let add params ts dg =
+ List.fold_left (translate params) dg ts
+
+
+let make params ts =
+ add params ts Digraph.empty
+let pp = Pp.graph
+
+let add_subgraph params d elts dg =
+ let sub = add params elts { dg with graph = empty_subgraph } in
+ { sub with graph = Digraph.add_subgraph (d,sub.graph) dg.graph }
+
+let group_nodes (decoration, {graph=sub; elts=_}) ({elts;graph=main} as gmain) =
+ let nodes = Node_set.inter sub.nodes main.nodes in
+ if Node_set.cardinal nodes > 1 then
+ let sub = { empty_subgraph with nodes } in
+ let graph =
+ { main with
+ nodes = Node_set.diff main.nodes sub.nodes;
+ subgraphes = (decoration,sub) :: main.subgraphes
+ }
+ in { graph; elts}
+ else gmain
+
+let file_counter = ref 0
+
+let compact_loc ppf (loc:Warnings.loc) =
+ let startline = loc.loc_start.pos_lnum in
+ let endline = loc.loc_end.pos_lnum in
+ let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
+ let endchar = loc.loc_end.pos_cnum - loc.loc_end.pos_bol in
+ if startline = endline then
+ fprintf ppf "l%d[%d-%d]" startline startchar endchar
+ else
+ fprintf ppf "l%d-%d[%d-%d]" startline endline startchar endchar
+
+type 'a context = 'a option ref * (Format.formatter -> 'a -> unit)
+
+let set_context (r,_pr) x = r := Some x
+let pp_context (r,pr) ppf = match !r with
+ | None -> ()
+ | Some x -> fprintf ppf "%a" pr x
+
+let with_context (r,_) x f =
+ let old = !r in
+ r:= Some x;
+ Fun.protect f ~finally:(fun () -> r := old)
+
+let global = ref None, pp_print_string
+let loc = ref None, compact_loc
+let context = [pp_context global; pp_context loc]
+let dash ppf () = fprintf ppf "-"
+
+let node_register = ref []
+let register_type (label,ty) =
+ node_register := (label,Node ty) :: !node_register
+
+let subgraph_register = ref []
+let default_style = Decoration.(make [filled lightgrey])
+let register_subgraph params ?(decoration=default_style) tys =
+ let node x = Decoration.none, Node x in
+ let subgraph = make params (List.map node tys) in
+ subgraph_register := (decoration, subgraph) :: !subgraph_register
+
+let forget () =
+ node_register := [];
+ subgraph_register := []
+
+let node x = Node x
+let edge x y = Edge(x,y)
+let hyperedge l = Hyperedge l
+
+let nodes ~title params ts =
+ incr file_counter;
+ let filename =
+ match !Clflags.dump_dir with
+ | None -> asprintf "%04d-%s.dot" !file_counter title
+ | Some d ->
+ asprintf "%s%s%04d-%s-%a.dot"
+ d Filename.dir_sep
+ !file_counter
+ title
+ Pp.(list ~sep:dash (fun ppf pr -> pr ppf)) context
+ in
+ Out_channel.with_open_bin filename (fun ch ->
+ let ppf = Format.formatter_of_out_channel ch in
+ let ts = List.map (fun (l,t) -> l, t) ts in
+ let g = make params (ts @ !node_register) in
+ let g =
+ List.fold_left (fun g sub -> group_nodes sub g) g !subgraph_register
+ in
+ Pp.graph ppf g
+ )
+
+let types ~title params ts =
+ nodes ~title params (List.map (fun (lbl,ty) -> lbl, Node ty) ts)
+
+let make params elts = make params elts
+let add params elts = add params elts
+
+
+(** Debugging hooks *)
+let debug_on = ref (fun () -> false)
+let debug f = if !debug_on () then f ()
+
+let debug_off f =
+ let old = !debug_on in
+ debug_on := Fun.const false;
+ Fun.protect f
+ ~finally:(fun () -> debug_on := old)
diff --git a/upstream/ocaml_503/typing/gprinttyp.mli b/upstream/ocaml_503/typing/gprinttyp.mli
new file mode 100644
index 0000000000..1feef0c2c2
--- /dev/null
+++ b/upstream/ocaml_503/typing/gprinttyp.mli
@@ -0,0 +1,325 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+(**
+ This module provides function for printing type expressions as digraph using
+ graphviz format. This is mostly aimed at providing a better representation
+ of type expressions during debugging session.
+*)
+(**
+A type node is printed as
+{[
+ .------------.
+ | <desc> id |---->
+ | |--->
+ .------------.
+]}
+where the description part might be:
+- a path: [list/8!]
+- a type variable: ['name], [α], [β], [γ]
+- [*] for tuples
+- [→] for arrows type
+- an universal type variable: [[β]∀], ['name ∀], ...
+- [[mod X with ...]] for a first class module
+
+- [∀] for a universal type binder
+
+The more complex encoding for polymorphic variants and object types uses nodes
+as head of the subgraph representing those types
+
+- [[obj...]] for the head of an object subgraph
+- [[Nil]] for the end of an object subgraph
+- [[Row...]] for the head of a polymorphic variant subgraph
+
+- [[Subst]] for a temporary substitution node
+
+Then each nodes is relied by arrows to any of its children types.
+
+- Type variables, universal type variables, [Nil], and [Subst] nodes don't have
+ children.
+
+- For tuples, the children types are the elements of the tuple. For instance,
+ [int * float] is represented as
+{[
+ .------. 0 .-------.
+ | * 1 |-------->| int! 2|
+ .------. .-------.
+ |
+ | 1
+ v
+ .----------.
+ | float! 3 |
+ .----------.
+]}
+
+- For arrows, the children types are the type of the argument and the result
+ type. For instance, for [int -> float]:
+{[
+ .------. 0 .-------.
+ | → 4 |-------->| int! 2|
+ .------. .-------.
+ |
+ | 1
+ v
+ .----------.
+ | float! 3 |
+ .----------.
+]}
+
+- For type constructor, like list the main children nodes are the argument
+ types. For instance, [(int,float) result] is represented as:
+
+{[
+ .-------------. 0 .-------.
+ | Result.t 5 |-------->| int! 2|
+ .-------------. .-------.
+ |
+ | 1
+ v
+ .----------.
+ | float! 3 |
+ .----------.
+]}
+
+Moreover, type abbreviations might be linked to the expanded nodes.
+If I define: [type 'a pair = 'a * 'a], a type expression [int pair] might
+correspond to the nodes:
+
+{[
+ .--------. 0 .--------.
+ | pair 6 |------> | int! 2 |
+ .--------. .--------.
+ ┆ ^
+ ┆ expand |
+ ┆ |
+ .------. 0 + 1 |
+ | * 7 |------>-------.
+ .------.
+]}
+
+- Universal type binders have two kind of children: bound variables,
+ and the main body. For instance, ['a. 'a -> 'a] is represented as
+{[
+
+ .------. bind .-------.
+ | ∀ 8 |----------> | 𝛼 10 |
+ .------. .------.
+ | ^
+ | |
+ v |
+ .------. 0 + 1 |
+ | → 9 |------>-------.
+ .------.
+
+]}
+
+- [[Subst]] node are children are the type graph guarded by the
+ substitution node, and an eventual link to the parent row variable.
+
+- The children of first-class modules are the type expressions that may appear
+ in the right hand side of constraints.
+ For instance, [module M with type t = 'a and type u = 'b] is represented as
+{[
+ .----------------------. 0 .-----.
+ | [mod M with t, u] 11 |-------->| 𝛼 12|
+ .----------------------. .-----
+ |
+ | 1
+ v
+ .------.
+ | 𝛽 13 |
+ .------.
+]}
+
+
+- The children of [obj] (resp. [row]) are the methods (resp. constructor) of the
+ object type (resp. polymorphic variant). Each method is then linked to its
+ type. To make them easier to read they are grouped inside graphviz cluster.
+ For instance, [<a:int; m:'self; ..> as 'self] will be represented as:
+
+{[
+
+ .----------------.
+ | .----------. |
+ | | [obj] 14 |<------<-----<-----.
+ | .----------. | |
+ | ┆ | |
+ | .-------------. | .------. | .-------.
+ | | a public 15 |----->| ∀ 18 |----->| int! 2 |
+ | .-------------. | .------. | .-------.
+ | ┆ | |
+ | .-------------. | .------. |
+ | | m public 16 |-----| ∀ 19 |>--|
+ | .------------. | .------.
+ | ┆ |
+ | ┆ row var |
+ | ┆ |
+ | .-------. |
+ | | '_ 17 | |
+ | .-------. |
+ .-----------------.
+
+]}
+*)
+
+type digraph
+(** Digraph with nodes, edges, hyperedges and subgraphes *)
+
+type params
+(** Various possible choices on how to represent types, see the {!params}
+ functions for more detail.*)
+
+type element
+(** Graph element, see the {!node}, {!edge} and {!hyperedge} function *)
+
+type decoration
+(** Visual decoration on graph elements, see the {!Decoration} module.*)
+
+
+val types: title:string -> params -> (decoration * Types.type_expr) list -> unit
+(** Print a graph to the file
+ [asprintf "%s/%04d-%s-%a.dot"
+ dump_dir
+ session_unique_id
+ title
+ pp_context context
+ ]
+
+ If the [dump_dir] flag is not set, the local directory is used.
+ See the {!context} type on how and why to setup the context. *)
+
+(** Full version of {!types} that allow to print any kind of graph element *)
+val nodes: title:string -> params -> (decoration * element) list -> unit
+
+val params:
+ ?elide_links:bool ->
+ ?expansion_as_hyperedge:bool ->
+ ?short_ids:bool ->
+ ?colorize:bool ->
+ ?follow_expansions:bool ->
+ unit -> params
+(** Choice of details for printing type graphes:
+ - if [elide_links] is [true] link nodes are not displayed (default:[true])
+ - with [expansion_as_hyperedge], memoized constructor expansion are
+ displayed as a hyperedge between the node storing the memoized expansion,
+ the expanded node and the expansion (default:[false]).
+ - with [short_ids], we use an independent counter for node ids, in order to
+ have shorter ids for small digraphs (default:[true]).
+ - with [colorize] nodes are colorized according to their typechecker ids
+ (default:[true]).
+ - with [follow_expansions], we add memoized type constructor expansions to
+ the digraph (default:[true]).
+*)
+
+(** Update an existing [params] with new values. *)
+val update_params:
+ ?elide_links:bool ->
+ ?expansion_as_hyperedge:bool ->
+ ?short_ids:bool ->
+ ?colorize:bool ->
+ ?follow_expansions:bool ->
+ params -> params
+
+val node: Types.type_expr -> element
+val edge: Types.type_expr -> Types.type_expr -> element
+
+type dir = Toward | From
+val hyperedge: (dir * decoration * Types.type_expr) list -> element
+(** Edges between more than two elements. *)
+
+(** {1 Node and decoration types} *)
+module Decoration: sig
+ type color =
+ | Named of string
+ | HSL of {h:float;s:float;l:float}
+
+ val green: color
+ val blue: color
+ val red:color
+ val purple:color
+ val hsl: h:float -> s:float -> l:float -> color
+
+ type style =
+ | Filled of color option
+ | Dotted
+ | Dash
+
+ type shape =
+ | Ellipse
+ | Circle
+ | Diamond
+
+ type property =
+ | Color of color
+ | Font_color of color
+ | Style of style
+ | Label of string list
+ | Shape of shape
+ val filled: color -> property
+ val txt: string -> property
+ val make: property list -> decoration
+end
+
+(** {1 Digraph construction and printing}*)
+
+val make: params -> (decoration * element) list -> digraph
+val add: params -> (decoration * element) list -> digraph -> digraph
+
+(** add a subgraph to a digraph, only fresh nodes are added to the subgraph *)
+val add_subgraph:
+ params -> decoration -> (decoration * element) list -> digraph -> digraph
+
+(** groups existing nodes inside a subgraph *)
+val group_nodes: decoration * digraph -> digraph -> digraph
+
+val pp: Format.formatter -> digraph -> unit
+
+
+(** {1 Debugging helper functions } *)
+
+(** {2 Generic print debugging function} *)
+
+(** Conditional graph printing *)
+val debug_on: (unit -> bool) ref
+
+(** [debug_off f] switches off debugging before running [f]. *)
+val debug_off: (unit -> 'a) -> 'a
+
+(** [debug f] runs [f] when [!debug_on ()]*)
+val debug: (unit -> unit) -> unit
+
+(** {2 Node tracking functions }*)
+
+(** [register_type (lbl,ty)] adds the type [t] to all graph printed until
+ {!forget} is called *)
+val register_type: decoration * Types.type_expr -> unit
+
+(** [register_subgraph params tys] groups together all types reachable from
+ [tys] at this point in printed digraphs, until {!forget} is called *)
+val register_subgraph:
+ params -> ?decoration:decoration -> Types.type_expr list -> unit
+
+(** Forget all recorded context types *)
+val forget : unit -> unit
+
+(** {2 Contextual information}
+
+ Those functions can be used to modify the filename of the generated digraphs.
+ Use those functions to provide contextual information on a graph emitted
+ during an execution trace.*)
+type 'a context
+val global: string context
+val loc: Warnings.loc context
+val set_context: 'a context -> 'a -> unit
+val with_context: 'a context -> 'a -> (unit -> 'b) -> 'b
diff --git a/upstream/ocaml_503/typing/ident.ml b/upstream/ocaml_503/typing/ident.ml
new file mode 100644
index 0000000000..9a736abed4
--- /dev/null
+++ b/upstream/ocaml_503/typing/ident.ml
@@ -0,0 +1,392 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Local_store
+
+let lowest_scope = 0
+let highest_scope = 100_000_000
+ (* assumed to fit in 27 bits, see Types.scope_field *)
+
+type t =
+ | Local of { name: string; stamp: int }
+ | Scoped of { name: string; stamp: int; scope: int }
+ | Global of string
+ | Predef of { name: string; stamp: int }
+ (* the stamp is here only for fast comparison, but the name of
+ predefined identifiers is always unique. *)
+
+(* A stamp of 0 denotes a persistent identifier *)
+
+let currentstamp = s_ref 0
+let predefstamp = s_ref 0
+
+let create_scoped ~scope s =
+ incr currentstamp;
+ Scoped { name = s; stamp = !currentstamp; scope }
+
+let create_local s =
+ incr currentstamp;
+ Local { name = s; stamp = !currentstamp }
+
+let create_predef s =
+ incr predefstamp;
+ Predef { name = s; stamp = !predefstamp }
+
+let create_persistent s =
+ Global s
+
+let name = function
+ | Local { name; _ }
+ | Scoped { name; _ }
+ | Global name
+ | Predef { name; _ } -> name
+
+let rename = function
+ | Local { name; stamp = _ }
+ | Scoped { name; stamp = _; scope = _ } ->
+ incr currentstamp;
+ Local { name; stamp = !currentstamp }
+ | id ->
+ Misc.fatal_errorf "Ident.rename %s" (name id)
+
+let unique_name = function
+ | Local { name; stamp }
+ | Scoped { name; stamp } -> name ^ "_" ^ Int.to_string stamp
+ | Global name ->
+ (* we're adding a fake stamp, because someone could have named his unit
+ [Foo_123] and since we're using unique_name to produce symbol names,
+ we might clash with an ident [Local { "Foo"; 123 }]. *)
+ name ^ "_0"
+ | Predef { name; _ } ->
+ (* we know that none of the predef names (currently) finishes in
+ "_<some number>", and that their name is unique. *)
+ name
+
+let unique_toplevel_name = function
+ | Local { name; stamp }
+ | Scoped { name; stamp } -> name ^ "/" ^ Int.to_string stamp
+ | Global name
+ | Predef { name; _ } -> name
+
+let persistent = function
+ | Global _ -> true
+ | _ -> false
+
+let equal i1 i2 =
+ match i1, i2 with
+ | Local { name = name1; _ }, Local { name = name2; _ }
+ | Scoped { name = name1; _ }, Scoped { name = name2; _ }
+ | Global name1, Global name2 ->
+ name1 = name2
+ | Predef { stamp = s1; _ }, Predef { stamp = s2 } ->
+ (* if they don't have the same stamp, they don't have the same name *)
+ s1 = s2
+ | _ ->
+ false
+
+let same i1 i2 =
+ match i1, i2 with
+ | Local { stamp = s1; _ }, Local { stamp = s2; _ }
+ | Scoped { stamp = s1; _ }, Scoped { stamp = s2; _ }
+ | Predef { stamp = s1; _ }, Predef { stamp = s2 } ->
+ s1 = s2
+ | Global name1, Global name2 ->
+ name1 = name2
+ | _ ->
+ false
+
+let stamp = function
+ | Local { stamp; _ }
+ | Scoped { stamp; _ } -> stamp
+ | _ -> 0
+
+let compare_stamp id1 id2 =
+ compare (stamp id1) (stamp id2)
+
+let scope = function
+ | Scoped { scope; _ } -> scope
+ | Local _ -> highest_scope
+ | Global _ | Predef _ -> lowest_scope
+
+let reinit_level = ref (-1)
+
+let reinit () =
+ if !reinit_level < 0
+ then reinit_level := !currentstamp
+ else currentstamp := !reinit_level
+
+let global = function
+ | Local _
+ | Scoped _ -> false
+ | Global _
+ | Predef _ -> true
+
+let is_predef = function
+ | Predef _ -> true
+ | _ -> false
+
+let print ~with_scope ppf =
+ let open Format_doc in
+ function
+ | Global name -> fprintf ppf "%s!" name
+ | Predef { name; stamp = n } ->
+ fprintf ppf "%s%s!" name
+ (if !Clflags.unique_ids then asprintf "/%i" n else "")
+ | Local { name; stamp = n } ->
+ fprintf ppf "%s%s" name
+ (if !Clflags.unique_ids then asprintf "/%i" n else "")
+ | Scoped { name; stamp = n; scope } ->
+ fprintf ppf "%s%s%s" name
+ (if !Clflags.unique_ids then asprintf "/%i" n else "")
+ (if with_scope then asprintf "[%i]" scope else "")
+
+let print_with_scope ppf id = print ~with_scope:true ppf id
+
+let doc_print ppf id = print ~with_scope:false ppf id
+let print ppf id = Format_doc.compat doc_print ppf id
+(* For the documentation of ['a Ident.tbl], see ident.mli.
+
+ The implementation is a copy-paste specialization of
+ a balanced-tree implementation similar to Map.
+ ['a tbl]
+ is a slightly more compact version of
+ [(Ident.t * 'a) list Map.Make(String)]
+
+ This implementation comes from Caml Light where duplication was
+ unavoidable in absence of functors. It works well enough, and so
+ far we have not had strong incentives to do the deduplication work
+ (implementation, tests, benchmarks, etc.).
+*)
+type 'a tbl =
+ Empty
+ | Node of 'a tbl * 'a data * 'a tbl * int
+
+and 'a data =
+ { ident: t;
+ data: 'a;
+ previous: 'a data option }
+
+let empty = Empty
+
+(* Inline expansion of height for better speed
+ * let height = function
+ * Empty -> 0
+ * | Node(_,_,_,h) -> h
+ *)
+
+let mknode l d r =
+ let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
+ and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
+ Node(l, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+let balance l d r =
+ let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
+ and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
+ if hl > hr + 1 then
+ match l with
+ | Node (ll, ld, lr, _)
+ when (match ll with Empty -> 0 | Node(_,_,_,h) -> h) >=
+ (match lr with Empty -> 0 | Node(_,_,_,h) -> h) ->
+ mknode ll ld (mknode lr d r)
+ | Node (ll, ld, Node(lrl, lrd, lrr, _), _) ->
+ mknode (mknode ll ld lrl) lrd (mknode lrr d r)
+ | _ -> assert false
+ else if hr > hl + 1 then
+ match r with
+ | Node (rl, rd, rr, _)
+ when (match rr with Empty -> 0 | Node(_,_,_,h) -> h) >=
+ (match rl with Empty -> 0 | Node(_,_,_,h) -> h) ->
+ mknode (mknode l d rl) rd rr
+ | Node (Node (rll, rld, rlr, _), rd, rr, _) ->
+ mknode (mknode l d rll) rld (mknode rlr rd rr)
+ | _ -> assert false
+ else
+ mknode l d r
+
+let rec add id data = function
+ Empty ->
+ Node(Empty, {ident = id; data = data; previous = None}, Empty, 1)
+ | Node(l, k, r, h) ->
+ let c = String.compare (name id) (name k.ident) in
+ if c = 0 then
+ Node(l, {ident = id; data = data; previous = Some k}, r, h)
+ else if c < 0 then
+ balance (add id data l) k r
+ else
+ balance l k (add id data r)
+
+let rec min_binding = function
+ Empty -> raise Not_found
+ | Node (Empty, d, _, _) -> d
+ | Node (l, _, _, _) -> min_binding l
+
+let rec remove_min_binding = function
+ Empty -> invalid_arg "Map.remove_min_elt"
+ | Node (Empty, _, r, _) -> r
+ | Node (l, d, r, _) -> balance (remove_min_binding l) d r
+
+let merge t1 t2 =
+ match (t1, t2) with
+ (Empty, t) -> t
+ | (t, Empty) -> t
+ | (_, _) ->
+ let d = min_binding t2 in
+ balance t1 d (remove_min_binding t2)
+
+let rec remove id = function
+ Empty ->
+ Empty
+ | (Node (l, k, r, h) as m) ->
+ let c = String.compare (name id) (name k.ident) in
+ if c = 0 then
+ match k.previous with
+ | None -> merge l r
+ | Some k -> Node (l, k, r, h)
+ else if c < 0 then
+ let ll = remove id l in if l == ll then m else balance ll k r
+ else
+ let rr = remove id r in if r == rr then m else balance l k rr
+
+let rec find_previous id = function
+ None ->
+ raise Not_found
+ | Some k ->
+ if same id k.ident then k.data else find_previous id k.previous
+
+let rec find_same id = function
+ Empty ->
+ raise Not_found
+ | Node(l, k, r, _) ->
+ let c = String.compare (name id) (name k.ident) in
+ if c = 0 then
+ if same id k.ident
+ then k.data
+ else find_previous id k.previous
+ else
+ find_same id (if c < 0 then l else r)
+
+let rec find_name n = function
+ Empty ->
+ raise Not_found
+ | Node(l, k, r, _) ->
+ let c = String.compare n (name k.ident) in
+ if c = 0 then
+ k.ident, k.data
+ else
+ find_name n (if c < 0 then l else r)
+
+let rec get_all = function
+ | None -> []
+ | Some k -> (k.ident, k.data) :: get_all k.previous
+
+let rec find_all n = function
+ Empty ->
+ []
+ | Node(l, k, r, _) ->
+ let c = String.compare n (name k.ident) in
+ if c = 0 then
+ (k.ident, k.data) :: get_all k.previous
+ else
+ find_all n (if c < 0 then l else r)
+
+let get_all_seq k () =
+ Seq.unfold (Option.map (fun k -> (k.ident, k.data), k.previous))
+ k ()
+
+let rec find_all_seq n tbl () =
+ match tbl with
+ | Empty -> Seq.Nil
+ | Node(l, k, r, _) ->
+ let c = String.compare n (name k.ident) in
+ if c = 0 then
+ Seq.Cons((k.ident, k.data), get_all_seq k.previous)
+ else
+ find_all_seq n (if c < 0 then l else r) ()
+
+
+let rec fold_aux f stack accu = function
+ Empty ->
+ begin match stack with
+ [] -> accu
+ | a :: l -> fold_aux f l accu a
+ end
+ | Node(l, k, r, _) ->
+ fold_aux f (l :: stack) (f k accu) r
+
+let fold_name f tbl accu = fold_aux (fun k -> f k.ident k.data) [] accu tbl
+
+let rec fold_data f d accu =
+ match d with
+ None -> accu
+ | Some k -> f k.ident k.data (fold_data f k.previous accu)
+
+let fold_all f tbl accu =
+ fold_aux (fun k -> fold_data f (Some k)) [] accu tbl
+
+(* let keys tbl = fold_name (fun k _ accu -> k::accu) tbl [] *)
+
+let rec iter f = function
+ Empty -> ()
+ | Node(l, k, r, _) ->
+ iter f l; f k.ident k.data; iter f r
+
+(* Idents for sharing keys *)
+
+(* They should be 'totally fresh' -> neg numbers *)
+let key_name = ""
+
+let make_key_generator () =
+ let c = ref 1 in
+ function
+ | Local _
+ | Scoped _ ->
+ let stamp = !c in
+ decr c ;
+ Local { name = key_name; stamp = stamp }
+ | global_id ->
+ Misc.fatal_errorf "Ident.make_key_generator () %s" (name global_id)
+
+let compare x y =
+ match x, y with
+ | Local x, Local y ->
+ let c = x.stamp - y.stamp in
+ if c <> 0 then c
+ else compare x.name y.name
+ | Local _, _ -> 1
+ | _, Local _ -> (-1)
+ | Scoped x, Scoped y ->
+ let c = x.stamp - y.stamp in
+ if c <> 0 then c
+ else compare x.name y.name
+ | Scoped _, _ -> 1
+ | _, Scoped _ -> (-1)
+ | Global x, Global y -> compare x y
+ | Global _, _ -> 1
+ | _, Global _ -> (-1)
+ | Predef { stamp = s1; _ }, Predef { stamp = s2; _ } -> compare s1 s2
+
+let output oc id = output_string oc (unique_name id)
+let hash i = (Char.code (name i).[0]) lxor (stamp i)
+
+let original_equal = equal
+include Identifiable.Make (struct
+ type nonrec t = t
+ let compare = compare
+ let output = output
+ let print = print
+ let hash = hash
+ let equal = same
+end)
+let equal = original_equal
diff --git a/upstream/ocaml_503/typing/ident.mli b/upstream/ocaml_503/typing/ident.mli
new file mode 100644
index 0000000000..588123242d
--- /dev/null
+++ b/upstream/ocaml_503/typing/ident.mli
@@ -0,0 +1,115 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Identifiers (unique names) *)
+
+type t
+
+include Identifiable.S with type t := t
+(* Notes:
+ - [equal] compares identifiers by name
+ - [compare x y] is 0 if [same x y] is true.
+ - [compare] compares identifiers by binding location
+*)
+
+val doc_print: t Format_doc.printer
+val print_with_scope : t Format_doc.printer
+ (** Same as {!print} except that it will also add a "[n]" suffix
+ if the scope of the argument is [n]. *)
+
+
+val create_scoped: scope:int -> string -> t
+val create_local: string -> t
+val create_persistent: string -> t
+val create_predef: string -> t
+
+val rename: t -> t
+ (** Creates an identifier with the same name as the input, a fresh
+ stamp, and no scope.
+ @raise [Fatal_error] if called on a persistent / predef ident. *)
+
+val name: t -> string
+val unique_name: t -> string
+val unique_toplevel_name: t -> string
+val persistent: t -> bool
+val same: t -> t -> bool
+ (** Compare identifiers by binding location.
+ Two identifiers are the same either if they are both
+ non-persistent and have been created by the same call to
+ [create_*], or if they are both persistent and have the same
+ name. *)
+
+val compare_stamp: t -> t -> int
+ (** Compare only the internal stamps, 0 if absent *)
+
+val compare: t -> t -> int
+ (** Compare identifiers structurally, including the name *)
+
+val global: t -> bool
+val is_predef: t -> bool
+
+val scope: t -> int
+
+val lowest_scope : int
+val highest_scope: int
+
+val reinit: unit -> unit
+
+type 'a tbl
+(** ['a tbl] represents association tables from identifiers to values
+ of type ['a].
+
+ ['a tbl] plays the role of map, but bindings can be looked up
+ from either the full Ident using [find_same], or just its
+ user-visible name using [find_name]. In general the two lookups may
+ not return the same result, as an identifier may have been shadowed
+ in the environment by a distinct identifier with the same name.
+
+ [find_all] returns the bindings for all idents of a given name,
+ most recently introduced first.
+
+ In other words,
+ ['a tbl]
+ corresponds to
+ [(Ident.t * 'a) list Map.Make(String)]
+ and the implementation is very close to that representation.
+
+ Note in particular that searching among idents of the same name
+ takes linear time, and that [add] simply extends the list without
+ checking for duplicates. So it is not a good idea to implement
+ union by repeated [add] calls, which may result in many duplicated
+ identifiers and poor [find_same] performance. It is even possible
+ to build overly large same-name lists such that non-recursive
+ functions like [find_all] or [fold_all] blow the stack.
+
+ You should probably use [Map.Make(Ident)] instead, unless you
+ really need to query bindings by user-visible name, not just by
+ unique identifiers.
+*)
+
+val empty: 'a tbl
+val add: t -> 'a -> 'a tbl -> 'a tbl
+val find_same: t -> 'a tbl -> 'a
+val find_name: string -> 'a tbl -> t * 'a
+val find_all: string -> 'a tbl -> (t * 'a) list
+val find_all_seq: string -> 'a tbl -> (t * 'a) Seq.t
+val fold_name: (t -> 'a -> 'b -> 'b) -> 'a tbl -> 'b -> 'b
+val fold_all: (t -> 'a -> 'b -> 'b) -> 'a tbl -> 'b -> 'b
+val iter: (t -> 'a -> unit) -> 'a tbl -> unit
+val remove: t -> 'a tbl -> 'a tbl
+
+(* Idents for sharing keys *)
+
+val make_key_generator : unit -> (t -> t)
diff --git a/upstream/ocaml_503/typing/includeclass.ml b/upstream/ocaml_503/typing/includeclass.ml
new file mode 100644
index 0000000000..5c560c156b
--- /dev/null
+++ b/upstream/ocaml_503/typing/includeclass.ml
@@ -0,0 +1,114 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1997 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. *)
+(* *)
+(**************************************************************************)
+
+(* Inclusion checks for the class language *)
+
+open Types
+
+let class_types env cty1 cty2 =
+ Ctype.match_class_types env cty1 cty2
+
+let class_type_declarations ~loc env cty1 cty2 =
+ Builtin_attributes.check_alerts_inclusion
+ ~def:cty1.clty_loc
+ ~use:cty2.clty_loc
+ loc
+ cty1.clty_attributes cty2.clty_attributes
+ (Path.last cty1.clty_path);
+ Ctype.match_class_declarations env
+ cty1.clty_params cty1.clty_type
+ cty2.clty_params cty2.clty_type
+
+let class_declarations env cty1 cty2 =
+ match cty1.cty_new, cty2.cty_new with
+ None, Some _ ->
+ [Ctype.CM_Virtual_class]
+ | _ ->
+ Ctype.match_class_declarations env
+ cty1.cty_params cty1.cty_type
+ cty2.cty_params cty2.cty_type
+
+open Format_doc
+open Ctype
+module Printtyp=Printtyp.Doc
+
+(*
+let rec hide_params = function
+ Tcty_arrow ("*", _, cty) -> hide_params cty
+ | cty -> cty
+*)
+
+let include_err mode ppf =
+ let msg fmt = Format_doc.Doc.msg fmt in
+ function
+ | CM_Virtual_class ->
+ fprintf ppf "A class cannot be changed from virtual to concrete"
+ | CM_Parameter_arity_mismatch _ ->
+ fprintf ppf
+ "The classes do not have the same number of type parameters"
+ | CM_Type_parameter_mismatch (n, env, err) ->
+ Errortrace_report.equality ppf mode env err
+ (msg "The %d%s type parameter has type"
+ n (Misc.ordinal_suffix n))
+ (msg "but is expected to have type")
+ | CM_Class_type_mismatch (env, cty1, cty2) ->
+ Printtyp.wrap_printing_env ~error:true env (fun () ->
+ fprintf ppf
+ "@[The class type@;<1 2>%a@ %s@;<1 2>%a@]"
+ Printtyp.class_type cty1
+ "is not matched by the class type"
+ Printtyp.class_type cty2)
+ | CM_Parameter_mismatch (n, env, err) ->
+ Errortrace_report.moregen ppf mode env err
+ (msg "The %d%s parameter has type"
+ n (Misc.ordinal_suffix n))
+ (msg "but is expected to have type")
+ | CM_Val_type_mismatch (lab, env, err) ->
+ Errortrace_report.comparison ppf mode env err
+ (msg "The instance variable %s@ has type" lab)
+ (msg "but is expected to have type")
+ | CM_Meth_type_mismatch (lab, env, err) ->
+ Errortrace_report.comparison ppf mode env err
+ (msg "The method %s@ has type" lab)
+ (msg "but is expected to have type")
+ | CM_Non_mutable_value lab ->
+ fprintf ppf
+ "@[The non-mutable instance variable %s cannot become mutable@]" lab
+ | CM_Non_concrete_value lab ->
+ fprintf ppf
+ "@[The virtual instance variable %s cannot become concrete@]" lab
+ | CM_Missing_value lab ->
+ fprintf ppf "@[The first class type has no instance variable %s@]" lab
+ | CM_Missing_method lab ->
+ fprintf ppf "@[The first class type has no method %s@]" lab
+ | CM_Hide_public lab ->
+ fprintf ppf "@[The public method %s cannot be hidden@]" lab
+ | CM_Hide_virtual (k, lab) ->
+ fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab
+ | CM_Public_method lab ->
+ fprintf ppf "@[The public method %s cannot become private@]" lab
+ | CM_Virtual_method lab ->
+ fprintf ppf "@[The virtual method %s cannot become concrete@]" lab
+ | CM_Private_method lab ->
+ fprintf ppf "@[The private method %s cannot become public@]" lab
+
+let report_error_doc mode ppf = function
+ | [] -> ()
+ | err :: errs ->
+ let print_errs ppf errs =
+ List.iter (fun err -> fprintf ppf "@ %a" (include_err mode) err) errs in
+ fprintf ppf "@[<v>%a%a@]" (include_err mode) err print_errs errs
+
+let report_error = Format_doc.compat1 report_error_doc
diff --git a/upstream/ocaml_503/typing/includeclass.mli b/upstream/ocaml_503/typing/includeclass.mli
new file mode 100644
index 0000000000..a4d4d85882
--- /dev/null
+++ b/upstream/ocaml_503/typing/includeclass.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1997 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. *)
+(* *)
+(**************************************************************************)
+
+(* Inclusion checks for the class language *)
+
+open Types
+open Ctype
+
+val class_types:
+ Env.t -> class_type -> class_type -> class_match_failure list
+val class_type_declarations:
+ loc:Location.t ->
+ Env.t -> class_type_declaration -> class_type_declaration ->
+ class_match_failure list
+val class_declarations:
+ Env.t -> class_declaration -> class_declaration ->
+ class_match_failure list
+
+val report_error :
+ Out_type.type_or_scheme -> class_match_failure list Format_doc.format_printer
+val report_error_doc :
+ Out_type.type_or_scheme -> class_match_failure list Format_doc.printer
diff --git a/upstream/ocaml_503/typing/includecore.ml b/upstream/ocaml_503/typing/includecore.ml
new file mode 100644
index 0000000000..e23315f1ee
--- /dev/null
+++ b/upstream/ocaml_503/typing/includecore.ml
@@ -0,0 +1,1074 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Inclusion checks for the core language *)
+
+open Asttypes
+open Path
+open Types
+open Typedtree
+
+type position = Errortrace.position = First | Second
+
+(* Inclusion between value descriptions *)
+
+type primitive_mismatch =
+ | Name
+ | Arity
+ | No_alloc of position
+ | Native_name
+ | Result_repr
+ | Argument_repr of int
+
+let native_repr_args nra1 nra2 =
+ let rec loop i nra1 nra2 =
+ match nra1, nra2 with
+ | [], [] -> None
+ | [], _ :: _ -> assert false
+ | _ :: _, [] -> assert false
+ | nr1 :: nra1, nr2 :: nra2 ->
+ if not (Primitive.equal_native_repr nr1 nr2) then Some (Argument_repr i)
+ else loop (i+1) nra1 nra2
+ in
+ loop 1 nra1 nra2
+
+let primitive_descriptions pd1 pd2 =
+ let open Primitive in
+ if not (String.equal pd1.prim_name pd2.prim_name) then
+ Some Name
+ else if not (Int.equal pd1.prim_arity pd2.prim_arity) then
+ Some Arity
+ else if (not pd1.prim_alloc) && pd2.prim_alloc then
+ Some (No_alloc First)
+ else if pd1.prim_alloc && (not pd2.prim_alloc) then
+ Some (No_alloc Second)
+ else if not (String.equal pd1.prim_native_name pd2.prim_native_name) then
+ Some Native_name
+ else if not
+ (Primitive.equal_native_repr
+ pd1.prim_native_repr_res pd2.prim_native_repr_res) then
+ Some Result_repr
+ else
+ native_repr_args pd1.prim_native_repr_args pd2.prim_native_repr_args
+
+type value_mismatch =
+ | Primitive_mismatch of primitive_mismatch
+ | Not_a_primitive
+ | Type of Errortrace.moregen_error
+
+exception Dont_match of value_mismatch
+
+(* A value description [vd1] is consistent with the value description [vd2] if
+ there is a context E such that [E |- vd1 <: vd2] for the ordinary subtyping.
+ For values, this is the case as soon as the kind of [vd1] is a subkind of the
+ [vd2] kind. *)
+let value_descriptions_consistency env vd1 vd2 =
+ match (vd1.val_kind, vd2.val_kind) with
+ | (Val_prim p1, Val_prim p2) -> begin
+ match primitive_descriptions p1 p2 with
+ | None -> Tcoerce_none
+ | Some err -> raise (Dont_match (Primitive_mismatch err))
+ end
+ | (Val_prim p, _) ->
+ let pc =
+ { pc_desc = p; pc_type = vd2.Types.val_type;
+ pc_env = env; pc_loc = vd1.Types.val_loc; }
+ in
+ Tcoerce_primitive pc
+ | (_, Val_prim _) -> raise (Dont_match Not_a_primitive)
+ | (_, _) -> Tcoerce_none
+
+let value_descriptions ~loc env name
+ (vd1 : Types.value_description)
+ (vd2 : Types.value_description) =
+ Builtin_attributes.check_alerts_inclusion
+ ~def:vd1.val_loc
+ ~use:vd2.val_loc
+ loc
+ vd1.val_attributes vd2.val_attributes
+ name;
+ match Ctype.moregeneral env true vd1.val_type vd2.val_type with
+ | exception Ctype.Moregen err -> raise (Dont_match (Type err))
+ | () -> value_descriptions_consistency env vd1 vd2
+
+(* Inclusion between manifest types (particularly for private row types) *)
+
+let is_absrow env ty =
+ match get_desc ty with
+ | Tconstr(Pident _, _, _) ->
+ (* This function is checking for an abstract row on the side that is being
+ included into (usually numbered with "2" in this file). In this case,
+ the abstract row variable has been substituted for an object or variant
+ type. *)
+ begin match get_desc (Ctype.expand_head env ty) with
+ | Tobject _|Tvariant _ -> true
+ | _ -> false
+ end
+ | _ -> false
+
+(* Inclusion between type declarations *)
+
+let choose ord first second =
+ match ord with
+ | First -> first
+ | Second -> second
+
+let choose_other ord first second =
+ match ord with
+ | First -> choose Second first second
+ | Second -> choose First first second
+
+(* Documents which kind of private thing would be revealed *)
+type privacy_mismatch =
+ | Private_type_abbreviation
+ | Private_variant_type
+ | Private_record_type
+ | Private_extensible_variant
+ | Private_row_type
+
+type type_kind =
+ | Kind_abstract
+ | Kind_record
+ | Kind_variant
+ | Kind_open
+
+let of_kind = function
+ | Type_abstract _ -> Kind_abstract
+ | Type_record (_, _) -> Kind_record
+ | Type_variant (_, _) -> Kind_variant
+ | Type_open -> Kind_open
+
+type kind_mismatch = type_kind * type_kind
+
+type label_mismatch =
+ | Type of Errortrace.equality_error
+ | Mutability of position
+
+type record_change =
+ (Types.label_declaration, Types.label_declaration, label_mismatch)
+ Diffing_with_keys.change
+
+type record_mismatch =
+ | Label_mismatch of record_change list
+ | Unboxed_float_representation of position
+
+type constructor_mismatch =
+ | Type of Errortrace.equality_error
+ | Arity
+ | Inline_record of record_change list
+ | Kind of position
+ | Explicit_return_type of position
+
+type extension_constructor_mismatch =
+ | Constructor_privacy
+ | Constructor_mismatch of Ident.t
+ * Types.extension_constructor
+ * Types.extension_constructor
+ * constructor_mismatch
+
+type private_variant_mismatch =
+ | Only_outer_closed (* It's only dangerous in one direction *)
+ | Missing of position * string
+ | Presence of string
+ | Incompatible_types_for of string
+ | Types of Errortrace.equality_error
+
+type private_object_mismatch =
+ | Missing of string
+ | Types of Errortrace.equality_error
+
+type variant_change =
+ (Types.constructor_declaration as 'l, 'l, constructor_mismatch)
+ Diffing_with_keys.change
+
+type type_mismatch =
+ | Arity
+ | Privacy of privacy_mismatch
+ | Kind of kind_mismatch
+ | Constraint of Errortrace.equality_error
+ | Manifest of Errortrace.equality_error
+ | Private_variant of type_expr * type_expr * private_variant_mismatch
+ | Private_object of type_expr * type_expr * private_object_mismatch
+ | Variance
+ | Record_mismatch of record_mismatch
+ | Variant_mismatch of variant_change list
+ | Unboxed_representation of position
+ | Immediate of Type_immediacy.Violation.t
+
+module Style = Misc.Style
+module Fmt = Format_doc
+module Printtyp = Printtyp.Doc
+
+let report_primitive_mismatch first second ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ match (err : primitive_mismatch) with
+ | Name ->
+ pr "The names of the primitives are not the same"
+ | Arity ->
+ pr "The syntactic arities of these primitives were not the same.@ \
+ (They must have the same number of arrows present in the source.)"
+ | No_alloc ord ->
+ pr "%s primitive is %a but %s is not"
+ (String.capitalize_ascii (choose ord first second))
+ Style.inline_code "[@@noalloc]"
+ (choose_other ord first second)
+ | Native_name ->
+ pr "The native names of the primitives are not the same"
+ | Result_repr ->
+ pr "The two primitives' results have different representations"
+ | Argument_repr n ->
+ pr "The two primitives' %d%s arguments have different representations"
+ n (Misc.ordinal_suffix n)
+
+let report_value_mismatch first second env ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ pr "@ ";
+ match (err : value_mismatch) with
+ | Primitive_mismatch pm ->
+ report_primitive_mismatch first second ppf pm
+ | Not_a_primitive ->
+ pr "The implementation is not a primitive."
+ | Type trace ->
+ let msg = Fmt.Doc.msg in
+ Errortrace_report.moregen ppf Type_scheme env trace
+ (msg "The type")
+ (msg "is not compatible with the type")
+
+let report_type_inequality env ppf err =
+ let msg = Fmt.Doc.msg in
+ Errortrace_report.equality ppf Type_scheme env err
+ (msg "The type")
+ (msg "is not equal to the type")
+
+let report_privacy_mismatch ppf err =
+ let singular, item =
+ match err with
+ | Private_type_abbreviation -> true, "type abbreviation"
+ | Private_variant_type -> false, "variant constructor(s)"
+ | Private_record_type -> true, "record constructor"
+ | Private_extensible_variant -> true, "extensible variant"
+ | Private_row_type -> true, "row type"
+ in Format_doc.fprintf ppf "%s %s would be revealed."
+ (if singular then "A private" else "Private")
+ item
+
+let report_label_mismatch first second env ppf err =
+ match (err : label_mismatch) with
+ | Type err ->
+ report_type_inequality env ppf err
+ | Mutability ord ->
+ Format_doc.fprintf ppf "%s is mutable and %s is not."
+ (String.capitalize_ascii (choose ord first second))
+ (choose_other ord first second)
+
+let pp_record_diff first second prefix decl env ppf (x : record_change) =
+ match x with
+ | Delete cd ->
+ Fmt.fprintf ppf "%aAn extra field, %a, is provided in %s %s."
+ prefix x Style.inline_code (Ident.name cd.delete.ld_id) first decl
+ | Insert cd ->
+ Fmt.fprintf ppf "%aA field, %a, is missing in %s %s."
+ prefix x Style.inline_code (Ident.name cd.insert.ld_id) first decl
+ | Change Type {got=lbl1; expected=lbl2; reason} ->
+ Fmt.fprintf ppf
+ "@[<hv>%aFields do not match:@;<1 2>\
+ %a@ is not the same as:\
+ @;<1 2>%a@ %a@]"
+ prefix x
+ (Style.as_inline_code Printtyp.label) lbl1
+ (Style.as_inline_code Printtyp.label) lbl2
+ (report_label_mismatch first second env) reason
+ | Change Name n ->
+ Fmt.fprintf ppf "%aFields have different names, %a and %a."
+ prefix x
+ Style.inline_code n.got
+ Style.inline_code n.expected
+ | Swap sw ->
+ Fmt.fprintf ppf "%aFields %a and %a have been swapped."
+ prefix x
+ Style.inline_code sw.first
+ Style.inline_code sw.last
+ | Move {name; got; expected } ->
+ Fmt.fprintf ppf
+ "@[<2>%aField %a has been moved@ from@ position %d@ to %d.@]"
+ prefix x Style.inline_code name expected got
+
+let report_patch pr_diff first second decl env ppf patch =
+ let nl ppf () = Fmt.fprintf ppf "@," in
+ let no_prefix _ppf _ = () in
+ match patch with
+ | [ elt ] ->
+ Fmt.fprintf ppf "@[<hv>%a@]"
+ (pr_diff first second no_prefix decl env) elt
+ | _ ->
+ let pp_diff = pr_diff first second Diffing_with_keys.prefix decl env in
+ Fmt.fprintf ppf "@[<hv>%a@]"
+ (Fmt.pp_print_list ~pp_sep:nl pp_diff) patch
+
+let report_record_mismatch first second decl env ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ match err with
+ | Label_mismatch patch ->
+ report_patch pp_record_diff first second decl env ppf patch
+ | Unboxed_float_representation ord ->
+ pr "@[<hv>Their internal representations differ:@ %s %s %s.@]"
+ (choose ord first second) decl
+ "uses unboxed float representation"
+
+let report_constructor_mismatch first second decl env ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ match (err : constructor_mismatch) with
+ | Type err -> report_type_inequality env ppf err
+ | Arity -> pr "They have different arities."
+ | Inline_record err ->
+ report_patch pp_record_diff first second decl env ppf err
+ | Kind ord ->
+ pr "%s uses inline records and %s doesn't."
+ (String.capitalize_ascii (choose ord first second))
+ (choose_other ord first second)
+ | Explicit_return_type ord ->
+ pr "%s has explicit return type and %s doesn't."
+ (String.capitalize_ascii (choose ord first second))
+ (choose_other ord first second)
+
+let pp_variant_diff first second prefix decl env ppf (x : variant_change) =
+ match x with
+ | Delete cd ->
+ Fmt.fprintf ppf "%aAn extra constructor, %a, is provided in %s %s."
+ prefix x Style.inline_code (Ident.name cd.delete.cd_id) first decl
+ | Insert cd ->
+ Fmt.fprintf ppf "%aA constructor, %a, is missing in %s %s."
+ prefix x Style.inline_code (Ident.name cd.insert.cd_id) first decl
+ | Change Type {got; expected; reason} ->
+ Fmt.fprintf ppf
+ "@[<hv>%aConstructors do not match:@;<1 2>\
+ %a@ is not the same as:\
+ @;<1 2>%a@ %a@]"
+ prefix x
+ (Style.as_inline_code Printtyp.constructor) got
+ (Style.as_inline_code Printtyp.constructor) expected
+ (report_constructor_mismatch first second decl env) reason
+ | Change Name n ->
+ Fmt.fprintf ppf
+ "%aConstructors have different names, %a and %a."
+ prefix x
+ Style.inline_code n.got
+ Style.inline_code n.expected
+ | Swap sw ->
+ Fmt.fprintf ppf
+ "%aConstructors %a and %a have been swapped."
+ prefix x
+ Style.inline_code sw.first
+ Style.inline_code sw.last
+ | Move {name; got; expected} ->
+ Fmt.fprintf ppf
+ "@[<2>%aConstructor %a has been moved@ from@ position %d@ to %d.@]"
+ prefix x Style.inline_code name expected got
+
+let report_extension_constructor_mismatch first second decl env ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ match (err : extension_constructor_mismatch) with
+ | Constructor_privacy ->
+ pr "Private extension constructor(s) would be revealed."
+ | Constructor_mismatch (id, ext1, ext2, err) ->
+ let constructor =
+ Style.as_inline_code (Printtyp.extension_only_constructor id)
+ in
+ pr "@[<hv>Constructors do not match:@;<1 2>%a@ is not the same as:\
+ @;<1 2>%a@ %a@]"
+ constructor ext1
+ constructor ext2
+ (report_constructor_mismatch first second decl env) err
+
+
+let report_private_variant_mismatch first second decl env ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ let pp_tag ppf x = Fmt.fprintf ppf "`%s" x in
+ match (err : private_variant_mismatch) with
+ | Only_outer_closed ->
+ (* It's only dangerous in one direction, so we don't have a position *)
+ pr "%s is private and closed, but %s is not closed"
+ (String.capitalize_ascii second) first
+ | Missing (ord, name) ->
+ pr "The constructor %a is only present in %s %s."
+ Style.inline_code name (choose ord first second) decl
+ | Presence s ->
+ pr "The tag %a is present in the %s %s,@ but might not be in the %s"
+ (Style.as_inline_code pp_tag) s second decl first
+ | Incompatible_types_for s -> pr "Types for tag `%s are incompatible" s
+ | Types err ->
+ report_type_inequality env ppf err
+
+let report_private_object_mismatch env ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ match (err : private_object_mismatch) with
+ | Missing s ->
+ pr "The implementation is missing the method %a" Style.inline_code s
+ | Types err -> report_type_inequality env ppf err
+
+let report_kind_mismatch first second ppf (kind1, kind2) =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ let kind_to_string = function
+ | Kind_abstract -> "abstract"
+ | Kind_record -> "a record"
+ | Kind_variant -> "a variant"
+ | Kind_open -> "an extensible variant" in
+ pr "%s is %s, but %s is %s."
+ (String.capitalize_ascii first)
+ (kind_to_string kind1)
+ second
+ (kind_to_string kind2)
+
+let report_type_mismatch first second decl env ppf err =
+ let pr fmt = Fmt.fprintf ppf fmt in
+ pr "@ ";
+ match err with
+ | Arity ->
+ pr "They have different arities."
+ | Privacy err ->
+ report_privacy_mismatch ppf err
+ | Kind err ->
+ report_kind_mismatch first second ppf err
+ | Constraint err ->
+ (* This error can come from implicit parameter disagreement or from
+ explicit `constraint`s. Both affect the parameters, hence this choice
+ of explanatory text *)
+ pr "Their parameters differ@,";
+ report_type_inequality env ppf err
+ | Manifest err ->
+ report_type_inequality env ppf err
+ | Private_variant (_ty1, _ty2, mismatch) ->
+ report_private_variant_mismatch first second decl env ppf mismatch
+ | Private_object (_ty1, _ty2, mismatch) ->
+ report_private_object_mismatch env ppf mismatch
+ | Variance ->
+ pr "Their variances do not agree."
+ | Record_mismatch err ->
+ report_record_mismatch first second decl env ppf err
+ | Variant_mismatch err ->
+ report_patch pp_variant_diff first second decl env ppf err
+ | Unboxed_representation ord ->
+ pr "Their internal representations differ:@ %s %s %s."
+ (choose ord first second) decl
+ "uses unboxed representation"
+ | Immediate violation ->
+ let first = StringLabels.capitalize_ascii first in
+ match violation with
+ | Type_immediacy.Violation.Not_always_immediate ->
+ pr "%s is not an immediate type." first
+ | Type_immediacy.Violation.Not_always_immediate_on_64bits ->
+ pr "%s is not a type that is always immediate on 64 bit platforms."
+ first
+
+module Record_diffing = struct
+
+ let compare_labels env params1 params2
+ (ld1 : Types.label_declaration)
+ (ld2 : Types.label_declaration) =
+ if ld1.ld_mutable <> ld2.ld_mutable
+ then
+ let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
+ Some (Mutability ord)
+ else
+ let tl1 = params1 @ [ld1.ld_type] in
+ let tl2 = params2 @ [ld2.ld_type] in
+ match Ctype.equal env true tl1 tl2 with
+ | exception Ctype.Equality err ->
+ Some (Type err : label_mismatch)
+ | () -> None
+
+ let rec equal ~loc env params1 params2
+ (labels1 : Types.label_declaration list)
+ (labels2 : Types.label_declaration list) =
+ match labels1, labels2 with
+ | [], [] -> true
+ | _ :: _ , [] | [], _ :: _ -> false
+ | ld1 :: rem1, ld2 :: rem2 ->
+ if Ident.name ld1.ld_id <> Ident.name ld2.ld_id
+ then false
+ else begin
+ Builtin_attributes.check_deprecated_mutable_inclusion
+ ~def:ld1.ld_loc
+ ~use:ld2.ld_loc
+ loc
+ ld1.ld_attributes ld2.ld_attributes
+ (Ident.name ld1.ld_id);
+ match compare_labels env params1 params2 ld1 ld2 with
+ | Some _ -> false
+ (* add arguments to the parameters, cf. PR#7378 *)
+ | None ->
+ equal ~loc env
+ (ld1.ld_type::params1) (ld2.ld_type::params2)
+ rem1 rem2
+ end
+
+ module Defs = struct
+ type left = Types.label_declaration
+ type right = left
+ type diff = label_mismatch
+ type state = type_expr list * type_expr list
+ end
+ module Diff = Diffing_with_keys.Define(Defs)
+
+ let update (d:Diff.change) (params1,params2 as st) =
+ match d with
+ | Insert _ | Change _ | Delete _ -> st
+ | Keep (x,y,_) ->
+ (* We need to add equality between existential type parameters
+ (in inline records) *)
+ x.data.ld_type::params1, y.data.ld_type::params2
+
+ let test _loc env (params1,params2)
+ ({pos; data=lbl1}: Diff.left)
+ ({data=lbl2; _ }: Diff.right)
+ =
+ let name1, name2 = Ident.name lbl1.ld_id, Ident.name lbl2.ld_id in
+ if name1 <> name2 then
+ let types_match =
+ match compare_labels env params1 params2 lbl1 lbl2 with
+ | Some _ -> false
+ | None -> true
+ in
+ Error
+ (Diffing_with_keys.Name {types_match; pos; got=name1; expected=name2})
+ else
+ match compare_labels env params1 params2 lbl1 lbl2 with
+ | Some reason ->
+ Error (
+ Diffing_with_keys.Type {pos; got=lbl1; expected=lbl2; reason}
+ )
+ | None -> Ok ()
+
+ let weight: Diff.change -> _ = function
+ | Insert _ | Delete _ ->
+ (* Insertion and deletion are symmetrical for definitions *)
+ 100
+ | Keep _ -> 0
+ (* [Keep] must have the smallest weight. *)
+ | Change (_,_,c) ->
+ (* Constraints:
+ - [ Change < Insert + Delete ], otherwise [Change] are never optimal
+
+ - [ Swap < Move ] => [ 2 Change < Insert + Delete ] =>
+ [ Change < Delete ], in order to favour consecutive [Swap]s
+ over [Move]s.
+
+ - For some D and a large enough R,
+ [Delete^D Keep^R Insert^D < Change^(D+R)]
+ => [ Change > (2 D)/(D+R) Delete ].
+ Note that the case [D=1,R=1] is incompatible with the inequation
+ above. If we choose [R = D + 1] for [D<5], we can specialize the
+ inequation to [ Change > 10 / 11 Delete ]. *)
+ match c with
+ (* With [Type<Name with type<Name], we pick constructor with the right
+ name over the one with the right type. *)
+ | Diffing_with_keys.Name t ->
+ if t.types_match then 98 else 99
+ | Diffing_with_keys.Type _ -> 50
+ (* With the uniqueness constraint on keys, the only relevant constraint
+ is [Type-only change < Name change]. Indeed, names can only match at
+ one position. In other words, if a [ Type ] patch is admissible, the
+ only admissible patches at this position are of the form [Delete^D
+ Name_change]. And with the constranit [Type_change < Name_change],
+ we have [Type_change Delete^D < Delete^D Name_change]. *)
+
+ let key (x: Defs.left) = Ident.name x.ld_id
+ let diffing loc env params1 params2 cstrs_1 cstrs_2 =
+ let module Compute = Diff.Simple(struct
+ let key_left = key
+ let key_right = key
+ let update = update
+ let test = test loc env
+ let weight = weight
+ end)
+ in
+ Compute.diff (params1,params2) cstrs_1 cstrs_2
+
+ let compare ~loc env params1 params2 l r =
+ if equal ~loc env params1 params2 l r then
+ None
+ else
+ Some (diffing loc env params1 params2 l r)
+
+
+ let compare_with_representation ~loc env params1 params2 l r rep1 rep2 =
+ if not (equal ~loc env params1 params2 l r) then
+ let patch = diffing loc env params1 params2 l r in
+ Some (Record_mismatch (Label_mismatch patch))
+ else
+ match rep1, rep2 with
+ | Record_unboxed _, Record_unboxed _ -> None
+ | Record_unboxed _, _ -> Some (Unboxed_representation First)
+ | _, Record_unboxed _ -> Some (Unboxed_representation Second)
+
+ | Record_float, Record_float -> None
+ | Record_float, _ ->
+ Some (Record_mismatch (Unboxed_float_representation First))
+ | _, Record_float ->
+ Some (Record_mismatch (Unboxed_float_representation Second))
+
+ | Record_regular, Record_regular
+ | Record_inlined _, Record_inlined _
+ | Record_extension _, Record_extension _ -> None
+ | (Record_regular|Record_inlined _|Record_extension _),
+ (Record_regular|Record_inlined _|Record_extension _) ->
+ assert false
+
+end
+
+
+module Variant_diffing = struct
+
+ let compare_constructor_arguments ~loc env params1 params2 arg1 arg2 =
+ match arg1, arg2 with
+ | Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 ->
+ if List.length arg1 <> List.length arg2 then
+ Some (Arity : constructor_mismatch)
+ else begin
+ (* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
+ match Ctype.equal env true (params1 @ arg1) (params2 @ arg2) with
+ | exception Ctype.Equality err -> Some (Type err)
+ | () -> None
+ end
+ | Types.Cstr_record l1, Types.Cstr_record l2 ->
+ Option.map
+ (fun rec_err -> Inline_record rec_err)
+ (Record_diffing.compare env ~loc params1 params2 l1 l2)
+ | Types.Cstr_record _, _ -> Some (Kind First : constructor_mismatch)
+ | _, Types.Cstr_record _ -> Some (Kind Second : constructor_mismatch)
+
+ let compare_constructors ~loc env params1 params2 res1 res2 args1 args2 =
+ match res1, res2 with
+ | Some r1, Some r2 ->
+ begin match Ctype.equal env true [r1] [r2] with
+ | exception Ctype.Equality err -> Some (Type err)
+ | () -> compare_constructor_arguments ~loc env [r1] [r2] args1 args2
+ end
+ | Some _, None -> Some (Explicit_return_type First)
+ | None, Some _ -> Some (Explicit_return_type Second)
+ | None, None ->
+ compare_constructor_arguments ~loc env params1 params2 args1 args2
+
+ let equal ~loc env params1 params2
+ (cstrs1 : Types.constructor_declaration list)
+ (cstrs2 : Types.constructor_declaration list) =
+ List.length cstrs1 = List.length cstrs2 &&
+ List.for_all2 (fun (cd1:Types.constructor_declaration)
+ (cd2:Types.constructor_declaration) ->
+ Ident.name cd1.cd_id = Ident.name cd2.cd_id
+ &&
+ begin
+ Builtin_attributes.check_alerts_inclusion
+ ~def:cd1.cd_loc
+ ~use:cd2.cd_loc
+ loc
+ cd1.cd_attributes cd2.cd_attributes
+ (Ident.name cd1.cd_id)
+ ;
+ match compare_constructors ~loc env params1 params2
+ cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+ | Some _ -> false
+ | None -> true
+ end) cstrs1 cstrs2
+
+ module Defs = struct
+ type left = Types.constructor_declaration
+ type right = left
+ type diff = constructor_mismatch
+ type state = type_expr list * type_expr list
+ end
+ module D = Diffing_with_keys.Define(Defs)
+
+ let update _ st = st
+
+ let weight: D.change -> _ = function
+ | Insert _ | Delete _ -> 100
+ | Keep _ -> 0
+ | Change (_,_,Diffing_with_keys.Name c) ->
+ if c.types_match then 98 else 99
+ | Change (_,_,Diffing_with_keys.Type _) -> 50
+ (** See {!Variant_diffing.weight} for an explanation *)
+
+ let test loc env (params1,params2)
+ ({pos; data=cd1}: D.left)
+ ({data=cd2; _}: D.right) =
+ let name1, name2 = Ident.name cd1.cd_id, Ident.name cd2.cd_id in
+ if name1 <> name2 then
+ let types_match =
+ match compare_constructors ~loc env params1 params2
+ cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+ | Some _ -> false
+ | None -> true
+ in
+ Error
+ (Diffing_with_keys.Name {types_match; pos; got=name1; expected=name2})
+ else
+ match compare_constructors ~loc env params1 params2
+ cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+ | Some reason ->
+ Error (Diffing_with_keys.Type {pos; got=cd1; expected=cd2; reason})
+ | None -> Ok ()
+
+ let diffing loc env params1 params2 cstrs_1 cstrs_2 =
+ let key (x:Defs.left) = Ident.name x.cd_id in
+ let module Compute = D.Simple(struct
+ let key_left = key
+ let key_right = key
+ let test = test loc env
+ let update = update
+ let weight = weight
+ end)
+ in
+ Compute.diff (params1,params2) cstrs_1 cstrs_2
+
+ let compare ~loc env params1 params2 l r =
+ if equal ~loc env params1 params2 l r then
+ None
+ else
+ Some (diffing loc env params1 params2 l r)
+
+ let compare_with_representation ~loc env params1 params2
+ cstrs1 cstrs2 rep1 rep2
+ =
+ let err = compare ~loc env params1 params2 cstrs1 cstrs2 in
+ match err, rep1, rep2 with
+ | None, Variant_regular, Variant_regular
+ | None, Variant_unboxed, Variant_unboxed ->
+ None
+ | Some err, _, _ ->
+ Some (Variant_mismatch err)
+ | None, Variant_unboxed, Variant_regular ->
+ Some (Unboxed_representation First)
+ | None, Variant_regular, Variant_unboxed ->
+ Some (Unboxed_representation Second)
+end
+
+(* Inclusion between "private" annotations *)
+let privacy_mismatch env decl1 decl2 =
+ match decl1.type_private, decl2.type_private with
+ | Private, Public -> begin
+ match decl1.type_kind, decl2.type_kind with
+ | Type_record _, Type_record _ -> Some Private_record_type
+ | Type_variant _, Type_variant _ -> Some Private_variant_type
+ | Type_open, Type_open -> Some Private_extensible_variant
+ | Type_abstract _, Type_abstract _
+ when Option.is_some decl2.type_manifest -> begin
+ match decl1.type_manifest with
+ | Some ty1 -> begin
+ let ty1 = Ctype.expand_head env ty1 in
+ match get_desc ty1 with
+ | Tvariant row when Btype.is_constr_row ~allow_ident:true
+ (row_more row) ->
+ Some Private_row_type
+ | Tobject (fi, _) when Btype.is_constr_row ~allow_ident:true
+ (snd (Ctype.flatten_fields fi)) ->
+ Some Private_row_type
+ | _ ->
+ Some Private_type_abbreviation
+ end
+ | None ->
+ None
+ end
+ | _, _ ->
+ None
+ end
+ | _, _ ->
+ None
+
+let private_variant env row1 params1 row2 params2 =
+ let r1, r2, pairs =
+ Ctype.merge_row_fields (row_fields row1) (row_fields row2)
+ in
+ let row1_closed = row_closed row1 in
+ let row2_closed = row_closed row2 in
+ let err =
+ if row2_closed && not row1_closed then Some Only_outer_closed
+ else begin
+ match row2_closed, Ctype.filter_row_fields false r1 with
+ | true, (s, _) :: _ ->
+ Some (Missing (Second, s) : private_variant_mismatch)
+ | _, _ -> None
+ end
+ in
+ if err <> None then err else
+ let err =
+ let missing =
+ List.find_opt
+ (fun (_,f) ->
+ match row_field_repr f with
+ | Rabsent | Reither _ -> false
+ | Rpresent _ -> true)
+ r2
+ in
+ match missing with
+ | None -> None
+ | Some (s, _) -> Some (Missing (First, s) : private_variant_mismatch)
+ in
+ if err <> None then err else
+ let rec loop tl1 tl2 pairs =
+ match pairs with
+ | [] -> begin
+ match Ctype.equal env true tl1 tl2 with
+ | exception Ctype.Equality err ->
+ Some (Types err : private_variant_mismatch)
+ | () -> None
+ end
+ | (s, f1, f2) :: pairs -> begin
+ match row_field_repr f1, row_field_repr f2 with
+ | Rpresent to1, Rpresent to2 -> begin
+ match to1, to2 with
+ | Some t1, Some t2 ->
+ loop (t1 :: tl1) (t2 :: tl2) pairs
+ | None, None ->
+ loop tl1 tl2 pairs
+ | Some _, None | None, Some _ ->
+ Some (Incompatible_types_for s)
+ end
+ | Rpresent to1, Reither(const2, ts2, _) -> begin
+ match to1, const2, ts2 with
+ | Some t1, false, [t2] -> loop (t1 :: tl1) (t2 :: tl2) pairs
+ | None, true, [] -> loop tl1 tl2 pairs
+ | _, _, _ -> Some (Incompatible_types_for s)
+ end
+ | Rpresent _, Rabsent ->
+ Some (Missing (Second, s) : private_variant_mismatch)
+ | Reither(const1, ts1, _), Reither(const2, ts2, _) ->
+ if const1 = const2 && List.length ts1 = List.length ts2 then
+ loop (ts1 @ tl1) (ts2 @ tl2) pairs
+ else
+ Some (Incompatible_types_for s)
+ | Reither _, Rpresent _ ->
+ Some (Presence s)
+ | Reither _, Rabsent ->
+ Some (Missing (Second, s) : private_variant_mismatch)
+ | Rabsent, (Reither _ | Rabsent) ->
+ loop tl1 tl2 pairs
+ | Rabsent, Rpresent _ ->
+ Some (Missing (First, s) : private_variant_mismatch)
+ end
+ in
+ loop params1 params2 pairs
+
+let private_object env fields1 params1 fields2 params2 =
+ let pairs, _miss1, miss2 = Ctype.associate_fields fields1 fields2 in
+ let err =
+ match miss2 with
+ | [] -> None
+ | (f, _, _) :: _ -> Some (Missing f)
+ in
+ if err <> None then err else
+ let tl1, tl2 =
+ List.split (List.map (fun (_,_,t1,_,t2) -> t1, t2) pairs)
+ in
+ begin
+ match Ctype.equal env true (params1 @ tl1) (params2 @ tl2) with
+ | exception Ctype.Equality err -> Some (Types err)
+ | () -> None
+ end
+
+let type_manifest env ty1 params1 ty2 params2 priv2 kind2 =
+ let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
+ match get_desc ty1', get_desc ty2' with
+ | Tvariant row1, Tvariant row2
+ when is_absrow env (row_more row2) -> begin
+ assert (Ctype.is_equal env true (ty1::params1) (row_more row2::params2));
+ match private_variant env row1 params1 row2 params2 with
+ | None -> None
+ | Some err -> Some (Private_variant(ty1, ty2, err))
+ end
+ | Tobject (fi1, _), Tobject (fi2, _)
+ when is_absrow env (snd (Ctype.flatten_fields fi2)) -> begin
+ let (fields2,rest2) = Ctype.flatten_fields fi2 in
+ let (fields1,_) = Ctype.flatten_fields fi1 in
+ assert (Ctype.is_equal env true (ty1::params1) (rest2::params2));
+ match private_object env fields1 params1 fields2 params2 with
+ | None -> None
+ | Some err -> Some (Private_object(ty1, ty2, err))
+ end
+ | _ -> begin
+ let is_private_abbrev_2 =
+ match priv2, kind2 with
+ | Private, Type_abstract _ -> begin
+ (* Same checks as the [when] guards from above, inverted *)
+ match get_desc ty2' with
+ | Tvariant row ->
+ not (is_absrow env (row_more row))
+ | Tobject (fi, _) ->
+ not (is_absrow env (snd (Ctype.flatten_fields fi)))
+ | _ -> true
+ end
+ | _, _ -> false
+ in
+ match
+ if is_private_abbrev_2 then
+ Ctype.equal_private env params1 ty1 params2 ty2
+ else
+ Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
+ with
+ | exception Ctype.Equality err -> Some (Manifest err)
+ | () -> None
+ end
+
+(* A type declarations [td1] is consistent with the type declaration [td2] if
+ there is a context E such E |- td1 <: td2 for the ordinary subtyping. For
+ types, this is the case as soon as the two type declarations share the same
+ arity and the privacy of [td1] is less than the privacy of [td2] (consider a
+ context E where all type constructors are equal). *)
+let type_declarations_consistency env decl1 decl2 =
+ if decl1.type_arity <> decl2.type_arity then Some Arity
+ else match privacy_mismatch env decl1 decl2 with
+ | Some err -> Some (Privacy err)
+ | None -> None
+
+let type_declarations ?(equality = false) ~loc env ~mark name
+ decl1 path decl2 =
+ Builtin_attributes.check_alerts_inclusion
+ ~def:decl1.type_loc
+ ~use:decl2.type_loc
+ loc
+ decl1.type_attributes decl2.type_attributes
+ name;
+ let err = type_declarations_consistency env decl1 decl2 in
+ if err <> None then err else
+ let err = match (decl1.type_manifest, decl2.type_manifest) with
+ (_, None) ->
+ begin
+ match Ctype.equal env true decl1.type_params decl2.type_params with
+ | exception Ctype.Equality err -> Some (Constraint err)
+ | () -> None
+ end
+ | (Some ty1, Some ty2) ->
+ type_manifest env ty1 decl1.type_params ty2 decl2.type_params
+ decl2.type_private decl2.type_kind
+ | (None, Some ty2) ->
+ let ty1 =
+ Btype.newgenty (Tconstr(path, decl2.type_params, ref Mnil))
+ in
+ match Ctype.equal env true decl1.type_params decl2.type_params with
+ | exception Ctype.Equality err -> Some (Constraint err)
+ | () ->
+ match Ctype.equal env false [ty1] [ty2] with
+ | exception Ctype.Equality err -> Some (Manifest err)
+ | () -> None
+ in
+ if err <> None then err else
+ let err = match (decl1.type_kind, decl2.type_kind) with
+ (_, Type_abstract _) -> None
+ | (Type_variant (cstrs1, rep1), Type_variant (cstrs2, rep2)) ->
+ if mark then begin
+ let mark usage cstrs =
+ List.iter (Env.mark_constructor_used usage) cstrs
+ in
+ let usage : Env.constructor_usage =
+ if decl2.type_private = Public then Env.Exported
+ else Env.Exported_private
+ in
+ mark usage cstrs1;
+ if equality then mark Env.Exported cstrs2
+ end;
+ Variant_diffing.compare_with_representation ~loc env
+ decl1.type_params
+ decl2.type_params
+ cstrs1
+ cstrs2
+ rep1
+ rep2
+ | (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
+ if mark then begin
+ let mark usage lbls =
+ List.iter (Env.mark_label_used usage) lbls
+ in
+ let usage : Env.label_usage =
+ if decl2.type_private = Public then Env.Exported
+ else Env.Exported_private
+ in
+ mark usage labels1;
+ if equality then mark Env.Exported labels2
+ end;
+ Record_diffing.compare_with_representation ~loc env
+ decl1.type_params decl2.type_params
+ labels1 labels2
+ rep1 rep2
+ | (Type_open, Type_open) -> None
+ | (_, _) -> Some (Kind (of_kind decl1.type_kind, of_kind decl2.type_kind))
+ in
+ if err <> None then err else
+ let abstr = Btype.type_kind_is_abstract decl2 && decl2.type_manifest = None in
+ (* If attempt to assign a non-immediate type (e.g. string) to a type that
+ * must be immediate, then we error *)
+ let err =
+ if not abstr then
+ None
+ else
+ match
+ Type_immediacy.coerce decl1.type_immediate ~as_:decl2.type_immediate
+ with
+ | Ok () -> None
+ | Error violation -> Some (Immediate violation)
+ in
+ if err <> None then err else
+ let need_variance =
+ abstr || decl1.type_private = Private || decl1.type_kind = Type_open in
+ if not need_variance then None else
+ let abstr = abstr || decl2.type_private = Private in
+ let opn = decl2.type_kind = Type_open && decl2.type_manifest = None in
+ let constrained ty = not (Btype.is_Tvar ty) in
+ if List.for_all2
+ (fun ty (v1,v2) ->
+ let open Variance in
+ let imp a b = not a || b in
+ let (co1,cn1) = get_upper v1 and (co2,cn2) = get_upper v2 in
+ (if abstr then (imp co1 co2 && imp cn1 cn2)
+ else if opn || constrained ty then (co1 = co2 && cn1 = cn2)
+ else true) &&
+ let (p1,n1,j1) = get_lower v1 and (p2,n2,j2) = get_lower v2 in
+ imp abstr (imp p2 p1 && imp n2 n1 && imp j2 j1))
+ decl2.type_params (List.combine decl1.type_variance decl2.type_variance)
+ then None else Some Variance
+
+(* Inclusion between extension constructors *)
+
+let extension_constructors ~loc env ~mark id ext1 ext2 =
+ if mark then begin
+ let usage : Env.constructor_usage =
+ if ext2.ext_private = Public then Env.Exported
+ else Env.Exported_private
+ in
+ Env.mark_extension_used usage ext1
+ end;
+ let ty1 =
+ Btype.newgenty (Tconstr(ext1.ext_type_path, ext1.ext_type_params, ref Mnil))
+ in
+ let ty2 =
+ Btype.newgenty (Tconstr(ext2.ext_type_path, ext2.ext_type_params, ref Mnil))
+ in
+ let tl1 = ty1 :: ext1.ext_type_params in
+ let tl2 = ty2 :: ext2.ext_type_params in
+ match Ctype.equal env true tl1 tl2 with
+ | exception Ctype.Equality err ->
+ Some (Constructor_mismatch (id, ext1, ext2, Type err))
+ | () ->
+ let r =
+ Variant_diffing.compare_constructors ~loc env
+ ext1.ext_type_params ext2.ext_type_params
+ ext1.ext_ret_type ext2.ext_ret_type
+ ext1.ext_args ext2.ext_args
+ in
+ match r with
+ | Some r -> Some (Constructor_mismatch (id, ext1, ext2, r))
+ | None ->
+ match ext1.ext_private, ext2.ext_private with
+ | Private, Public -> Some Constructor_privacy
+ | _, _ -> None
diff --git a/upstream/ocaml_503/typing/includecore.mli b/upstream/ocaml_503/typing/includecore.mli
new file mode 100644
index 0000000000..bed53fb036
--- /dev/null
+++ b/upstream/ocaml_503/typing/includecore.mli
@@ -0,0 +1,154 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Inclusion checks for the core language *)
+
+open Typedtree
+open Types
+
+type position = Errortrace.position = First | Second
+
+type primitive_mismatch =
+ | Name
+ | Arity
+ | No_alloc of position
+ | Native_name
+ | Result_repr
+ | Argument_repr of int
+
+type value_mismatch =
+ | Primitive_mismatch of primitive_mismatch
+ | Not_a_primitive
+ | Type of Errortrace.moregen_error
+
+exception Dont_match of value_mismatch
+
+(* Documents which kind of private thing would be revealed *)
+type privacy_mismatch =
+ | Private_type_abbreviation
+ | Private_variant_type
+ | Private_record_type
+ | Private_extensible_variant
+ | Private_row_type
+
+type type_kind =
+ | Kind_abstract
+ | Kind_record
+ | Kind_variant
+ | Kind_open
+
+type kind_mismatch = type_kind * type_kind
+
+type label_mismatch =
+ | Type of Errortrace.equality_error
+ | Mutability of position
+
+type record_change =
+ (Types.label_declaration as 'ld, 'ld, label_mismatch) Diffing_with_keys.change
+
+type record_mismatch =
+ | Label_mismatch of record_change list
+ | Unboxed_float_representation of position
+
+type constructor_mismatch =
+ | Type of Errortrace.equality_error
+ | Arity
+ | Inline_record of record_change list
+ | Kind of position
+ | Explicit_return_type of position
+
+type extension_constructor_mismatch =
+ | Constructor_privacy
+ | Constructor_mismatch of Ident.t
+ * extension_constructor
+ * extension_constructor
+ * constructor_mismatch
+type variant_change =
+ (Types.constructor_declaration as 'cd, 'cd, constructor_mismatch)
+ Diffing_with_keys.change
+
+type private_variant_mismatch =
+ | Only_outer_closed
+ | Missing of position * string
+ | Presence of string
+ | Incompatible_types_for of string
+ | Types of Errortrace.equality_error
+
+type private_object_mismatch =
+ | Missing of string
+ | Types of Errortrace.equality_error
+
+type type_mismatch =
+ | Arity
+ | Privacy of privacy_mismatch
+ | Kind of kind_mismatch
+ | Constraint of Errortrace.equality_error
+ | Manifest of Errortrace.equality_error
+ | Private_variant of type_expr * type_expr * private_variant_mismatch
+ | Private_object of type_expr * type_expr * private_object_mismatch
+ | Variance
+ | Record_mismatch of record_mismatch
+ | Variant_mismatch of variant_change list
+ | Unboxed_representation of position
+ | Immediate of Type_immediacy.Violation.t
+
+val value_descriptions:
+ loc:Location.t -> Env.t -> string ->
+ value_description -> value_description -> module_coercion
+
+val type_declarations:
+ ?equality:bool ->
+ loc:Location.t ->
+ Env.t -> mark:bool -> string ->
+ type_declaration -> Path.t -> type_declaration -> type_mismatch option
+
+val extension_constructors:
+ loc:Location.t -> Env.t -> mark:bool -> Ident.t ->
+ extension_constructor -> extension_constructor ->
+ extension_constructor_mismatch option
+
+(** The functions [value_descriptions_consistency] and
+ [type_declarations_consistency] check if two declaration are consistent.
+ Declarations are consistent when there exists an environment such that the
+ first declaration is a subtype of the second one.
+
+ Notably, if a type declaration [td1] is consistent with [td2] then a type
+ expression [te] which is well-formed with the [td2] declaration in scope
+ is still well-formed with the [td1] declaration: [E, td2 |- te] => [E, td1
+ |- te]. *)
+val value_descriptions_consistency:
+ Env.t -> value_description -> value_description -> module_coercion
+val type_declarations_consistency:
+ Env.t -> type_declaration -> type_declaration -> type_mismatch option
+
+(*
+val class_types:
+ Env.t -> class_type -> class_type -> bool
+*)
+
+val report_value_mismatch :
+ string -> string ->
+ Env.t ->
+ value_mismatch Format_doc.printer
+
+val report_type_mismatch :
+ string -> string -> string ->
+ Env.t ->
+ type_mismatch Format_doc.printer
+
+val report_extension_constructor_mismatch :
+ string -> string -> string ->
+ Env.t ->
+ extension_constructor_mismatch Format_doc.printer
diff --git a/upstream/ocaml_503/typing/includemod.ml b/upstream/ocaml_503/typing/includemod.ml
new file mode 100644
index 0000000000..dda0464c3a
--- /dev/null
+++ b/upstream/ocaml_503/typing/includemod.ml
@@ -0,0 +1,1411 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Inclusion checks for the module language *)
+
+open Misc
+open Typedtree
+open Types
+
+type symptom =
+ Missing_field of Ident.t * Location.t * string (* kind *)
+ | Value_descriptions of Ident.t * value_description * value_description
+ * Includecore.value_mismatch
+ | Type_declarations of Ident.t * type_declaration
+ * type_declaration * Includecore.type_mismatch
+ | Extension_constructors of Ident.t * extension_constructor
+ * extension_constructor * Includecore.extension_constructor_mismatch
+ | Module_types of module_type * module_type
+ | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
+ | Modtype_permutation of Types.module_type * Typedtree.module_coercion
+ | Interface_mismatch of string * string
+ | Class_type_declarations of
+ Ident.t * class_type_declaration * class_type_declaration *
+ Ctype.class_match_failure list
+ | Class_declarations of
+ Ident.t * class_declaration * class_declaration *
+ Ctype.class_match_failure list
+ | Unbound_module_path of Path.t
+ | Invalid_module_alias of Path.t
+
+type pos =
+ | Module of Ident.t
+ | Modtype of Ident.t
+ | Arg of functor_parameter
+ | Body of functor_parameter
+
+
+module Error = struct
+
+ type functor_arg_descr =
+ | Anonymous
+ | Named of Path.t
+ | Unit
+ | Empty_struct
+ (** For backward compatibility's sake, an empty struct can be implicitly
+ converted to an unit module *)
+
+ type ('a,'b) diff = {got:'a; expected:'a; symptom:'b}
+ type 'a core_diff =('a,unit) diff
+ let diff x y s = {got=x;expected=y; symptom=s}
+ let sdiff x y = {got=x; expected=y; symptom=()}
+
+ type core_sigitem_symptom =
+ | Value_descriptions of (value_description, Includecore.value_mismatch) diff
+ | Type_declarations of (type_declaration, Includecore.type_mismatch) diff
+ | Extension_constructors of
+ (extension_constructor, Includecore.extension_constructor_mismatch) diff
+ | Class_type_declarations of
+ (class_type_declaration, Ctype.class_match_failure list) diff
+ | Class_declarations of
+ (class_declaration, Ctype.class_match_failure list) diff
+
+ type core_module_type_symptom =
+ | Not_an_alias
+ | Not_an_identifier
+ | Incompatible_aliases
+ | Abstract_module_type
+ | Unbound_module_path of Path.t
+
+ type module_type_symptom =
+ | Mt_core of core_module_type_symptom
+ | Signature of signature_symptom
+ | Functor of functor_symptom
+ | Invalid_module_alias of Path.t
+ | After_alias_expansion of module_type_diff
+
+
+ and module_type_diff = (module_type, module_type_symptom) diff
+
+ and functor_symptom =
+ | Params of functor_params_diff
+ | Result of module_type_diff
+
+ and ('arg,'path) functor_param_symptom =
+ | Incompatible_params of 'arg * functor_parameter
+ | Mismatch of module_type_diff
+
+ and arg_functor_param_symptom =
+ (functor_parameter, Ident.t) functor_param_symptom
+
+ and functor_params_diff = (functor_parameter list * module_type) core_diff
+
+ and signature_symptom = {
+ env: Env.t;
+ missings: signature_item list;
+ incompatibles: (Ident.t * sigitem_symptom) list;
+ oks: (int * module_coercion) list;
+ leftovers: (signature_item * signature_item * int) list;
+ }
+ and sigitem_symptom =
+ | Core of core_sigitem_symptom
+ | Module_type_declaration of
+ (modtype_declaration, module_type_declaration_symptom) diff
+ | Module_type of module_type_diff
+
+ and module_type_declaration_symptom =
+ | Illegal_permutation of Typedtree.module_coercion
+ | Not_greater_than of module_type_diff
+ | Not_less_than of module_type_diff
+ | Incomparable of
+ {less_than:module_type_diff; greater_than: module_type_diff}
+
+
+ type all =
+ | In_Compilation_unit of (string, signature_symptom) diff
+ | In_Signature of signature_symptom
+ | In_Module_type of module_type_diff
+ | In_Module_type_substitution of
+ Ident.t * (Types.module_type,module_type_declaration_symptom) diff
+ | In_Type_declaration of Ident.t * core_sigitem_symptom
+ | In_Expansion of core_module_type_symptom
+
+end
+
+module Directionality = struct
+
+
+ type mark =
+ | Mark_both
+ | Mark_positive
+ | Mark_neither
+
+ type pos =
+ | Strictly_positive
+ (** Strictly positive positions are notable for tools since they are the
+ the case where we match a implementation definition with an interface
+ declaration. Oherwise in the positive case we are matching
+ declatations inside functor arguments at even level of nesting.*)
+ | Positive
+ | Negative
+
+
+(**
+ When checking inclusion, the [Directionality.t] type tracks the
+ subtyping direction at the syntactic level.
+
+ The [posivity] field is used in the [cmt_declaration_dependencies] to
+ distinguish between directed and undirected edges, and to avoid recording
+ matched declarations twice.
+
+ The [mark_as_used] field describes if we should record only positive use,
+ any use (because there is no clear implementation side), or none (because we
+ are inside an auxiliary check function.)
+
+ The [in_eq] field is [true] when we are checking both directions inside of
+ module types which allows optimizing module type equality checks. The module
+ subtyping relation [A <: B] checks that [A.T = B.T] when [A] and [B] define a
+ module type [T]. The relation [A.T = B.T] is equivalent to [(A.T <: B.T) and
+ (B.T <: A.T)], but checking both recursively would lead to an exponential
+ slowdown (see #10598 and #10616). To avoid this issue, when [in_eq] is
+ [true], we compute a coarser relation [A << B] which is the same as [A <: B]
+ except that module types [T] are checked only for [A.T << B.T] and not the
+ reverse. Thus, we can implement a cheap module type equality check [A.T =
+ B.T] by computing [(A.T << B.T) and (B.T << A.T)], avoiding the exponential
+ slowdown described above.
+*)
+ type t = {
+ in_eq:bool;
+ mark_as_used:mark;
+ pos:pos;
+ }
+
+ let strictly_positive ~mark =
+ let mark_as_used = if mark then Mark_positive else Mark_neither in
+ { in_eq=false; pos=Strictly_positive; mark_as_used }
+
+ let unknown ~mark =
+ let mark_as_used = if mark then Mark_both else Mark_neither in
+ { in_eq=false; pos=Positive; mark_as_used }
+
+ let negate_pos = function
+ | Positive | Strictly_positive -> Negative
+ | Negative -> Positive
+
+ let negate d = { d with pos = negate_pos d.pos }
+
+ let at_most_positive = function
+ | Strictly_positive -> Positive
+ | Positive | Negative as non_strict -> non_strict
+
+ let enter_eq d =
+ {
+ in_eq = true;
+ pos = at_most_positive d.pos;
+ mark_as_used = d.mark_as_used
+ }
+
+ let mark_as_used d = match d.mark_as_used with
+ | Mark_neither -> false
+ | Mark_both -> true
+ | Mark_positive ->
+ match d.pos with
+ | Positive | Strictly_positive -> true
+ | Negative -> false
+
+end
+
+module Core_inclusion = struct
+ (* All functions "blah env x1 x2" check that x1 is included in x2,
+ i.e. that x1 is the type of an implementation that fulfills the
+ specification x2. If not, Error is raised with a backtrace of the error. *)
+
+ (* Inclusion between value descriptions *)
+
+ let value_descriptions ~loc env ~direction subst id vd1 vd2 =
+ if Directionality.mark_as_used direction then
+ Env.mark_value_used vd1.val_uid;
+ let vd2 = Subst.value_description subst vd2 in
+ try
+ Ok (Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2)
+ with Includecore.Dont_match err ->
+ Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
+
+ (* Inclusion between type declarations *)
+
+ let type_declarations ~loc env ~direction subst id decl1 decl2 =
+ let mark = Directionality.mark_as_used direction in
+ if mark then
+ Env.mark_type_used decl1.type_uid;
+ let decl2 = Subst.type_declaration subst decl2 in
+ match
+ Includecore.type_declarations ~loc env ~mark
+ (Ident.name id) decl1 (Path.Pident id) decl2
+ with
+ | None -> Ok Tcoerce_none
+ | Some err ->
+ Error Error.(Core(Type_declarations (diff decl1 decl2 err)))
+
+ (* Inclusion between extension constructors *)
+
+ let extension_constructors ~loc env ~direction subst id ext1 ext2 =
+ let mark = Directionality.mark_as_used direction in
+ let ext2 = Subst.extension_constructor subst ext2 in
+ match Includecore.extension_constructors ~loc env ~mark id ext1 ext2 with
+ | None -> Ok Tcoerce_none
+ | Some err ->
+ Error Error.(Core(Extension_constructors(diff ext1 ext2 err)))
+
+ (* Inclusion between class declarations *)
+
+ let class_type_declarations ~loc env ~direction:_ subst _id decl1 decl2 =
+ let decl2 = Subst.cltype_declaration subst decl2 in
+ match Includeclass.class_type_declarations ~loc env decl1 decl2 with
+ [] -> Ok Tcoerce_none
+ | reason ->
+ Error Error.(Core(Class_type_declarations(diff decl1 decl2 reason)))
+
+ let class_declarations ~loc:_ env ~direction:_ subst _id decl1 decl2 =
+ let decl2 = Subst.class_declaration subst decl2 in
+ match Includeclass.class_declarations env decl1 decl2 with
+ [] -> Ok Tcoerce_none
+ | reason ->
+ Error Error.(Core(Class_declarations(diff decl1 decl2 reason)))
+end
+
+(* Expand a module type identifier when possible *)
+
+let expand_modtype_path env path =
+ match Env.find_modtype_expansion path env with
+ | exception Not_found -> None
+ | x -> Some x
+
+let expand_module_alias ~strengthen env path =
+ match
+ if strengthen then Env.find_strengthened_module ~aliasable:true path env
+ else (Env.find_module path env).md_type
+ with
+ | x -> Ok x
+ | exception Not_found -> Error (Error.Unbound_module_path path)
+
+(* Extract name, kind and ident from a signature item *)
+
+type field_kind =
+ | Field_value
+ | Field_type
+ | Field_exception
+ | Field_typext
+ | Field_module
+ | Field_modtype
+ | Field_class
+ | Field_classtype
+
+
+
+type field_desc = { name: string; kind: field_kind }
+
+let kind_of_field_desc fd = match fd.kind with
+ | Field_value -> "value"
+ | Field_type -> "type"
+ | Field_exception -> "exception"
+ | Field_typext -> "extension constructor"
+ | Field_module -> "module"
+ | Field_modtype -> "module type"
+ | Field_class -> "class"
+ | Field_classtype -> "class type"
+
+let field_desc kind id = { kind; name = Ident.name id }
+
+(** Map indexed by both field types and names.
+ This avoids name clashes between different sorts of fields
+ such as values and types. *)
+module FieldMap = Map.Make(struct
+ type t = field_desc
+ let compare = Stdlib.compare
+ end)
+
+let item_ident_name = function
+ Sig_value(id, d, _) -> (id, d.val_loc, field_desc Field_value id)
+ | Sig_type(id, d, _, _) -> (id, d.type_loc, field_desc Field_type id )
+ | Sig_typext(id, d, _, _) ->
+ let kind =
+ if Path.same d.ext_type_path Predef.path_exn
+ then Field_exception
+ else Field_typext
+ in
+ (id, d.ext_loc, field_desc kind id)
+ | Sig_module(id, _, d, _, _) -> (id, d.md_loc, field_desc Field_module id)
+ | Sig_modtype(id, d, _) -> (id, d.mtd_loc, field_desc Field_modtype id)
+ | Sig_class(id, d, _, _) -> (id, d.cty_loc, field_desc Field_class id)
+ | Sig_class_type(id, d, _, _) ->
+ (id, d.clty_loc, field_desc Field_classtype id)
+
+let is_runtime_component = function
+ | Sig_value(_,{val_kind = Val_prim _}, _)
+ | Sig_type(_,_,_,_)
+ | Sig_module(_,Mp_absent,_,_,_)
+ | Sig_modtype(_,_,_)
+ | Sig_class_type(_,_,_,_) -> false
+ | Sig_value(_,_,_)
+ | Sig_typext(_,_,_,_)
+ | Sig_module(_,Mp_present,_,_,_)
+ | Sig_class(_,_,_,_) -> true
+
+(* Print a coercion *)
+
+let rec print_list pr ppf = function
+ [] -> ()
+ | [a] -> pr ppf a
+ | a :: l -> pr ppf a; Format.fprintf ppf ";@ "; print_list pr ppf l
+let print_list pr ppf l =
+ Format.fprintf ppf "[@[%a@]]" (print_list pr) l
+
+let rec print_coercion ppf c =
+ let pr fmt = Format.fprintf ppf fmt in
+ match c with
+ Tcoerce_none -> pr "id"
+ | Tcoerce_structure (fl, nl) ->
+ pr "@[<2>struct@ %a@ %a@]"
+ (print_list print_coercion2) fl
+ (print_list print_coercion3) nl
+ | Tcoerce_functor (inp, out) ->
+ pr "@[<2>functor@ (%a)@ (%a)@]"
+ print_coercion inp
+ print_coercion out
+ | Tcoerce_primitive {pc_desc; pc_env = _; pc_type} ->
+ pr "prim %s@ (%a)" pc_desc.Primitive.prim_name
+ Rawprinttyp.type_expr pc_type
+ | Tcoerce_alias (_, p, c) ->
+ pr "@[<2>alias %a@ (%a)@]"
+ Printtyp.path p
+ print_coercion c
+and print_coercion2 ppf (n, c) =
+ Format.fprintf ppf "@[%d,@ %a@]" n print_coercion c
+and print_coercion3 ppf (i, n, c) =
+ Format.fprintf ppf "@[%s, %d,@ %a@]"
+ (Ident.unique_name i) n print_coercion c
+
+(* Simplify a structure coercion *)
+
+let equal_module_paths env p1 subst p2 =
+ Path.same p1 p2
+ || Path.same (Env.normalize_module_path None env p1)
+ (Env.normalize_module_path None env
+ (Subst.module_path subst p2))
+
+let equal_modtype_paths env p1 subst p2 =
+ Path.same p1 p2
+ || Path.same (Env.normalize_modtype_path env p1)
+ (Env.normalize_modtype_path env
+ (Subst.modtype_path subst p2))
+
+let simplify_structure_coercion cc id_pos_list =
+ let rec is_identity_coercion pos = function
+ | [] ->
+ true
+ | (n, c) :: rem ->
+ n = pos && c = Tcoerce_none && is_identity_coercion (pos + 1) rem in
+ if is_identity_coercion 0 cc
+ then Tcoerce_none
+ else Tcoerce_structure (cc, id_pos_list)
+
+let retrieve_functor_params env mty =
+ let rec retrieve_functor_params before env =
+ function
+ | Mty_ident p as res ->
+ begin match expand_modtype_path env p with
+ | Some mty -> retrieve_functor_params before env mty
+ | None -> List.rev before, res
+ end
+ | Mty_alias p as res ->
+ begin match expand_module_alias ~strengthen:false env p with
+ | Ok mty -> retrieve_functor_params before env mty
+ | Error _ -> List.rev before, res
+ end
+ | Mty_functor (p, res) -> retrieve_functor_params (p :: before) env res
+ | Mty_signature _ as res -> List.rev before, res
+ in
+ retrieve_functor_params [] env mty
+
+(* Inclusion between module types.
+ Return the restriction that transforms a value of the smaller type
+ into a value of the bigger type. *)
+
+(* When computing a signature difference, we need to distinguish between
+ recoverable errors at the value level and unrecoverable errors at the type
+ level that require us to stop the computation of the difference due to
+ incoherent types.
+*)
+type 'a recoverable_error = { error: 'a; recoverable:bool }
+let mark_error_as_recoverable r =
+ Result.map_error (fun error -> { error; recoverable=true}) r
+let mark_error_as_unrecoverable r =
+ Result.map_error (fun error -> { error; recoverable=false}) r
+
+
+module Sign_diff = struct
+ type t = {
+ runtime_coercions: (int * Typedtree.module_coercion) list;
+ shape_map: Shape.Map.t;
+ deep_modifications:bool;
+ errors: (Ident.t * Error.sigitem_symptom) list;
+ leftovers: ((Types.signature_item as 'it) * 'it * int) list
+ }
+
+ let empty = {
+ runtime_coercions = [];
+ shape_map = Shape.Map.empty;
+ deep_modifications = false;
+ errors = [];
+ leftovers = []
+ }
+
+ let merge x y =
+ {
+ runtime_coercions = x.runtime_coercions @ y.runtime_coercions;
+ shape_map = y.shape_map;
+ (* the shape map is threaded the map during the difference computation,
+ the last shape map contains all previous elements. *)
+ deep_modifications = x.deep_modifications || y.deep_modifications;
+ errors = x.errors @ y.errors;
+ leftovers = x.leftovers @ y.leftovers
+ }
+end
+
+(** Core type system subtyping-like relation that we want to lift at the module
+ level. We have two relations that we want to lift:
+
+ - the normal subtyping relation [<:].
+ - the coarse-grain consistency relation [C], which is defined by
+ [d1 C d2] if there is an environment [E] such that [E |- d1 <: d2]. *)
+type 'a core_incl =
+ loc:Location.t -> Env.t -> direction:Directionality.t -> Subst.t -> Ident.t ->
+ 'a -> 'a -> (module_coercion, Error.sigitem_symptom) result
+
+type core_relation = {
+ value_descriptions: Types.value_description core_incl;
+ type_declarations: Types.type_declaration core_incl;
+ extension_constructors: Types.extension_constructor core_incl;
+ class_declarations: Types.class_declaration core_incl;
+ class_type_declarations: Types.class_type_declaration core_incl;
+}
+
+
+let rec modtypes ~core ~direction ~loc env subst mty1 mty2 shape =
+ match try_modtypes ~core ~direction ~loc env subst mty1 mty2 shape with
+ | Ok _ as ok -> ok
+ | Error reason ->
+ let mty2 = Subst.modtype Make_local subst mty2 in
+ Error Error.(diff mty1 mty2 reason)
+
+and try_modtypes ~core ~direction ~loc env subst mty1 mty2 orig_shape =
+ match mty1, mty2 with
+ | (Mty_alias p1, Mty_alias p2) ->
+ if Env.is_functor_arg p2 env then
+ Error (Error.Invalid_module_alias p2)
+ else if not (equal_module_paths env p1 subst p2) then
+ Error Error.(Mt_core Incompatible_aliases)
+ else Ok (Tcoerce_none, orig_shape)
+ | (Mty_alias p1, _) -> begin
+ match
+ Env.normalize_module_path (Some Location.none) env p1
+ with
+ | exception Env.Error (Env.Missing_module (_, _, path)) ->
+ Error Error.(Mt_core(Unbound_module_path path))
+ | p1 ->
+ begin match expand_module_alias ~strengthen:false env p1 with
+ | Error e -> Error (Error.Mt_core e)
+ | Ok mty1 ->
+ match strengthened_modtypes ~core ~direction ~loc ~aliasable:true
+ env subst mty1 p1 mty2 orig_shape
+ with
+ | Ok _ as x -> x
+ | Error reason -> Error (Error.After_alias_expansion reason)
+ end
+ end
+ | (Mty_ident p1, Mty_ident p2) ->
+ let p1 = Env.normalize_modtype_path env p1 in
+ let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
+ if Path.same p1 p2 then Ok (Tcoerce_none, orig_shape)
+ else
+ begin match expand_modtype_path env p1, expand_modtype_path env p2 with
+ | Some mty1, Some mty2 ->
+ try_modtypes ~core ~direction ~loc env subst mty1 mty2 orig_shape
+ | None, _ | _, None -> Error (Error.Mt_core Abstract_module_type)
+ end
+ | (Mty_ident p1, _) ->
+ let p1 = Env.normalize_modtype_path env p1 in
+ begin match expand_modtype_path env p1 with
+ | Some p1 ->
+ try_modtypes ~core ~direction ~loc env subst p1 mty2 orig_shape
+ | None -> Error (Error.Mt_core Abstract_module_type)
+ end
+ | (_, Mty_ident p2) ->
+ let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
+ begin match expand_modtype_path env p2 with
+ | Some p2 ->
+ try_modtypes ~core ~direction ~loc env subst mty1 p2 orig_shape
+ | None ->
+ begin match mty1 with
+ | Mty_functor _ ->
+ let params1 = retrieve_functor_params env mty1 in
+ let d = Error.sdiff params1 ([],mty2) in
+ Error Error.(Functor (Params d))
+ | _ -> Error Error.(Mt_core Not_an_identifier)
+ end
+ end
+ | (Mty_signature sig1, Mty_signature sig2) ->
+ begin match
+ signatures ~core ~direction ~loc env subst sig1 sig2 orig_shape
+ with
+ | Ok _ as ok -> ok
+ | Error e -> Error (Error.Signature e)
+ end
+ | Mty_functor (param1, res1), Mty_functor (param2, res2) ->
+ let cc_arg, env, subst =
+ let direction = Directionality.negate direction in
+ functor_param ~core ~direction ~loc env
+ subst param1 param2
+ in
+ let var, res_shape =
+ match Shape.decompose_abs orig_shape with
+ | Some (var, res_shape) -> var, res_shape
+ | None ->
+ (* Using a fresh variable with a placeholder uid here is fine: users
+ will never try to jump to the definition of that variable. If
+ they try to jump to the parameter from inside the functor, they
+ will use the variable shape that is stored in the local
+ environment. *)
+ let var, shape_var =
+ Shape.fresh_var Uid.internal_not_actually_unique
+ in
+ var, Shape.app orig_shape ~arg:shape_var
+ in
+ let cc_res =
+ modtypes ~core ~direction ~loc env subst res1 res2 res_shape
+ in
+ begin match cc_arg, cc_res with
+ | Ok Tcoerce_none, Ok (Tcoerce_none, final_res_shape) ->
+ let final_shape =
+ if final_res_shape == res_shape
+ then orig_shape
+ else Shape.abs var final_res_shape
+ in
+ Ok (Tcoerce_none, final_shape)
+ | Ok cc_arg, Ok (cc_res, final_res_shape) ->
+ let final_shape =
+ if final_res_shape == res_shape
+ then orig_shape
+ else Shape.abs var final_res_shape
+ in
+ Ok (Tcoerce_functor(cc_arg, cc_res), final_shape)
+ | _, Error {Error.symptom = Error.Functor Error.Params res; _} ->
+ let got_params, got_res = res.got in
+ let expected_params, expected_res = res.expected in
+ let d = Error.sdiff
+ (param1::got_params, got_res)
+ (param2::expected_params, expected_res) in
+ Error Error.(Functor (Params d))
+ | Error _, _ ->
+ let params1, res1 = retrieve_functor_params env res1 in
+ let params2, res2 = retrieve_functor_params env res2 in
+ let d = Error.sdiff (param1::params1, res1) (param2::params2, res2) in
+ Error Error.(Functor (Params d))
+ | Ok _, Error res ->
+ Error Error.(Functor (Result res))
+ end
+ | Mty_functor _, _
+ | _, Mty_functor _ ->
+ let params1 = retrieve_functor_params env mty1 in
+ let params2 = retrieve_functor_params env mty2 in
+ let d = Error.sdiff params1 params2 in
+ Error Error.(Functor (Params d))
+ | _, Mty_alias _ ->
+ Error (Error.Mt_core Error.Not_an_alias)
+
+(* Functor parameters *)
+
+and functor_param ~core ~direction ~loc env subst param1 param2 =
+ match param1, param2 with
+ | Unit, Unit ->
+ Ok Tcoerce_none, env, subst
+ | Named (name1, arg1), Named (name2, arg2) ->
+ let arg2' = Subst.modtype Keep subst arg2 in
+ let cc_arg =
+ match
+ modtypes ~core ~direction ~loc env Subst.identity arg2' arg1
+ Shape.dummy_mod
+ with
+ | Ok (cc, _) -> Ok cc
+ | Error err -> Error (Error.Mismatch err)
+ in
+ let env, subst = equate_one_functor_param subst env arg2' name1 name2 in
+ cc_arg, env, subst
+ | _, _ ->
+ Error (Error.Incompatible_params (param1, param2)), env, subst
+
+and equate_one_functor_param subst env arg2' name1 name2 =
+ match name1, name2 with
+ | Some id1, Some id2 ->
+ (* two matching abstract parameters: we add one identifier to the
+ environment and record the equality between the two identifiers
+ in the substitution *)
+ Env.add_module id1 Mp_present arg2' env,
+ Subst.add_module id2 (Path.Pident id1) subst
+ | None, Some id2 ->
+ let id1 = Ident.rename id2 in
+ Env.add_module id1 Mp_present arg2' env,
+ Subst.add_module id2 (Path.Pident id1) subst
+ | Some id1, None ->
+ Env.add_module id1 Mp_present arg2' env, subst
+ | None, None ->
+ env, subst
+
+and strengthened_modtypes ~core ~direction ~loc ~aliasable env
+ subst mty1 path1 mty2 shape =
+ match mty1, mty2 with
+ | Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
+ Ok (Tcoerce_none, shape)
+ | _, _ ->
+ let mty1 = Mtype.strengthen ~aliasable env mty1 path1 in
+ modtypes ~core ~direction ~loc env subst mty1 mty2 shape
+
+and strengthened_module_decl ~core ~loc ~aliasable ~direction env
+ subst md1 path1 md2 shape =
+ match md1.md_type, md2.md_type with
+ | Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
+ Ok (Tcoerce_none, shape)
+ | _, _ ->
+ let md1 = Mtype.strengthen_decl ~aliasable env md1 path1 in
+ modtypes ~core ~direction ~loc env subst md1.md_type md2.md_type shape
+
+(* Inclusion between signatures *)
+
+and signatures ~core ~direction ~loc env subst sig1 sig2 mod_shape =
+ (* Environment used to check inclusion of components *)
+ let new_env =
+ Env.add_signature sig1 (Env.in_signature true env) in
+ (* Keep ids for module aliases *)
+ let (id_pos_list,_) =
+ List.fold_left
+ (fun (l,pos) -> function
+ Sig_module (id, Mp_present, _, _, _) ->
+ ((id,pos,Tcoerce_none)::l , pos+1)
+ | item -> (l, if is_runtime_component item then pos+1 else pos))
+ ([], 0) sig1 in
+ (* Build a table of the components of sig1, along with their positions.
+ The table is indexed by kind and name of component *)
+ let rec build_component_table nb_exported pos tbl = function
+ [] -> nb_exported, pos, tbl
+ | item :: rem ->
+ let pos, nextpos =
+ if is_runtime_component item then pos, pos + 1
+ else -1, pos
+ in
+ match item_visibility item with
+ | Hidden ->
+ (* do not pair private items. *)
+ build_component_table nb_exported nextpos tbl rem
+ | Exported ->
+ let (id, _loc, name) = item_ident_name item in
+ build_component_table (nb_exported + 1) nextpos
+ (FieldMap.add name (id, item, pos) tbl) rem
+ in
+ let exported_len1, runtime_len1, comps1 =
+ build_component_table 0 0 FieldMap.empty sig1
+ in
+ let exported_len2, runtime_len2 =
+ List.fold_left (fun (el, rl) i ->
+ let el = match item_visibility i with Hidden -> el | Exported -> el + 1 in
+ let rl = if is_runtime_component i then rl + 1 else rl in
+ el, rl
+ ) (0, 0) sig2
+ in
+ (* Pair each component of sig2 with a component of sig1,
+ identifying the names along the way.
+ Return a coercion list indicating, for all run-time components
+ of sig2, the position of the matching run-time components of sig1
+ and the coercion to be applied to it. *)
+ let rec pair_components ~core subst paired unpaired = function
+ [] ->
+ let open Sign_diff in
+ let d =
+ signature_components ~core ~direction ~loc env new_env subst
+ mod_shape Shape.Map.empty
+ (List.rev paired)
+ in
+ begin match unpaired, d.errors, d.runtime_coercions, d.leftovers with
+ | [], [], cc, [] ->
+ let shape =
+ if not d.deep_modifications && exported_len1 = exported_len2
+ then mod_shape
+ else Shape.str ?uid:mod_shape.Shape.uid d.shape_map
+ in
+ if runtime_len1 = runtime_len2 then (* see PR#5098 *)
+ Ok (simplify_structure_coercion cc id_pos_list, shape)
+ else
+ Ok (Tcoerce_structure (cc, id_pos_list), shape)
+ | missings, incompatibles, runtime_coercions, leftovers ->
+ Error {
+ Error.env=new_env;
+ missings;
+ incompatibles;
+ oks=runtime_coercions;
+ leftovers;
+ }
+ end
+ | item2 :: rem ->
+ let (id2, _loc, name2) = item_ident_name item2 in
+ let name2, report =
+ match item2, name2 with
+ Sig_type (_, {type_manifest=None}, _, _), {name=s; kind=Field_type}
+ when Btype.is_row_name s ->
+ (* Do not report in case of failure,
+ as the main type will generate an error *)
+ { kind=Field_type; name=String.sub s 0 (String.length s - 4) },
+ false
+ | _ -> name2, true
+ in
+ begin match FieldMap.find name2 comps1 with
+ | (id1, item1, pos1) ->
+ let new_subst =
+ match item2 with
+ Sig_type _ ->
+ Subst.add_type id2 (Path.Pident id1) subst
+ | Sig_module _ ->
+ Subst.add_module id2 (Path.Pident id1) subst
+ | Sig_modtype _ ->
+ Subst.add_modtype id2 (Path.Pident id1) subst
+ | Sig_value _ | Sig_typext _
+ | Sig_class _ | Sig_class_type _ ->
+ subst
+ in
+ pair_components ~core new_subst
+ ((item1, item2, pos1) :: paired) unpaired rem
+ | exception Not_found ->
+ let unpaired =
+ if report then
+ item2 :: unpaired
+ else unpaired in
+ pair_components ~core subst paired unpaired rem
+ end in
+ (* Do the pairing and checking, and return the final coercion *)
+ pair_components ~core subst [] [] sig2
+
+(* Inclusion between signature components *)
+
+and signature_components ~core ~direction ~loc old_env env subst
+ orig_shape shape_map paired =
+ match paired with
+ | [] -> Sign_diff.{ empty with shape_map }
+ | (sigi1, sigi2, pos) :: rem ->
+ let shape_modified = ref false in
+ let id, item, paired_uids, shape_map, present_at_runtime =
+ match sigi1, sigi2 with
+ | Sig_value(id1, valdecl1, _) ,Sig_value(_id2, valdecl2, _) ->
+ let item =
+ core.value_descriptions ~loc ~direction env subst id1
+ valdecl1 valdecl2
+ in
+ let item = mark_error_as_recoverable item in
+ let present_at_runtime = match valdecl2.val_kind with
+ | Val_prim _ -> false
+ | _ -> true
+ in
+ let shape_map = Shape.Map.add_value_proj shape_map id1 orig_shape in
+ let paired_uids = (valdecl1.val_uid, valdecl2.val_uid) in
+ id1, item, paired_uids, shape_map, present_at_runtime
+ | Sig_type(id1, tydec1, _, _), Sig_type(_id2, tydec2, _, _) ->
+ let item =
+ core.type_declarations ~loc ~direction env subst id1 tydec1 tydec2
+ in
+ let item = mark_error_as_unrecoverable item in
+ (* Right now we don't filter hidden constructors / labels from the
+ shape. *)
+ let shape_map = Shape.Map.add_type_proj shape_map id1 orig_shape in
+ id1, item, (tydec1.type_uid, tydec2.type_uid), shape_map, false
+ | Sig_typext(id1, ext1, _, _), Sig_typext(_id2, ext2, _, _) ->
+ let item =
+ core.extension_constructors ~loc ~direction env subst id1
+ ext1 ext2
+ in
+ let item = mark_error_as_unrecoverable item in
+ let shape_map =
+ Shape.Map.add_extcons_proj shape_map id1 orig_shape
+ in
+ id1, item, (ext1.ext_uid, ext2.ext_uid), shape_map, true
+ | Sig_module(id1, pres1, mty1, _, _), Sig_module(_, pres2, mty2, _, _)
+ -> begin
+ let orig_shape =
+ Shape.(proj orig_shape (Item.module_ id1))
+ in
+ let item =
+ module_declarations ~core ~direction ~loc env subst id1
+ mty1 mty2 orig_shape
+ in
+ let item, shape_map =
+ match item with
+ | Ok (cc, shape) ->
+ if shape != orig_shape then shape_modified := true;
+ let mod_shape = Shape.set_uid_if_none shape mty1.md_uid in
+ Ok cc, Shape.Map.add_module shape_map id1 mod_shape
+ | Error diff ->
+ Error (Error.Module_type diff),
+ (* We add the original shape to the map, even though
+ there is a type error.
+ It could still be useful for merlin. *)
+ Shape.Map.add_module shape_map id1 orig_shape
+ in
+ let present_at_runtime, item =
+ match pres1, pres2, mty1.md_type with
+ | Mp_present, Mp_present, _ -> true, item
+ | _, Mp_absent, _ -> false, item
+ | Mp_absent, Mp_present, Mty_alias p1 ->
+ true, Result.map (fun i -> Tcoerce_alias (env, p1, i)) item
+ | Mp_absent, Mp_present, _ -> assert false
+ in
+ let item = mark_error_as_unrecoverable item in
+ let paired_uids = (mty1.md_uid, mty2.md_uid) in
+ id1, item, paired_uids, shape_map, present_at_runtime
+ end
+ | Sig_modtype(id1, info1, _), Sig_modtype(_id2, info2, _) ->
+ let item =
+ modtype_infos ~core ~direction ~loc env subst id1 info1 info2
+ in
+ let shape_map =
+ Shape.Map.add_module_type_proj shape_map id1 orig_shape
+ in
+ let item = mark_error_as_unrecoverable item in
+ id1, item, (info1.mtd_uid, info2.mtd_uid), shape_map, false
+ | Sig_class(id1, decl1, _, _), Sig_class(_id2, decl2, _, _) ->
+ let item =
+ core.class_declarations ~loc ~direction env subst id1 decl1 decl2
+ in
+ let shape_map =
+ Shape.Map.add_class_proj shape_map id1 orig_shape
+ in
+ let item = mark_error_as_unrecoverable item in
+ id1, item, (decl1.cty_uid, decl2.cty_uid), shape_map, true
+ | Sig_class_type(id1, info1, _, _), Sig_class_type(_id2, info2, _, _) ->
+ let item =
+ core.class_type_declarations ~loc ~direction env subst id1
+ info1 info2
+ in
+ let item = mark_error_as_unrecoverable item in
+ let shape_map =
+ Shape.Map.add_class_type_proj shape_map id1 orig_shape
+ in
+ id1, item, (info1.clty_uid, info2.clty_uid), shape_map, false
+ | _ ->
+ assert false
+ in
+ let deep_modifications = !shape_modified in
+ let first =
+ match item with
+ | Ok x ->
+ begin match direction with
+ | { Directionality.in_eq = true; pos = Negative }
+ | { Directionality.mark_as_used = Mark_neither; _ } ->
+ (* We do not store paired uids when checking for reverse
+ module-type inclusion as it would introduce duplicates. *)
+ ()
+ | { Directionality.pos; _} ->
+ let paired_uids =
+ let elt1, elt2 = paired_uids in
+ match pos with
+ | Negative ->
+ (Cmt_format.Declaration_to_declaration, elt2, elt1)
+ | Positive ->
+ (Cmt_format.Declaration_to_declaration, elt1, elt2)
+ | Strictly_positive ->
+ (Cmt_format. Definition_to_declaration, elt1, elt2)
+ in
+ Cmt_format.record_declaration_dependency paired_uids
+ end;
+ let runtime_coercions =
+ if present_at_runtime then [pos,x] else []
+ in
+ Sign_diff.{ empty with deep_modifications; runtime_coercions }
+ | Error { error; recoverable=_ } ->
+ Sign_diff.{ empty with errors=[id,error]; deep_modifications }
+ in
+ let continue = match item with
+ | Ok _ -> true
+ | Error x -> x.recoverable
+ in
+ let rest =
+ if continue then
+ signature_components ~core ~direction ~loc old_env env subst
+ orig_shape shape_map rem
+ else Sign_diff.{ empty with leftovers=rem }
+ in
+ Sign_diff.merge first rest
+
+and module_declarations ~direction ~loc env subst id1 md1 md2 orig_shape =
+ Builtin_attributes.check_alerts_inclusion
+ ~def:md1.md_loc
+ ~use:md2.md_loc
+ loc
+ md1.md_attributes md2.md_attributes
+ (Ident.name id1);
+ let p1 = Path.Pident id1 in
+ if Directionality.mark_as_used direction then
+ Env.mark_module_used md1.md_uid;
+ strengthened_modtypes ~direction ~loc ~aliasable:true env subst
+ md1.md_type p1 md2.md_type orig_shape
+
+(* Inclusion between module type specifications *)
+
+and modtype_infos ~core ~direction ~loc env subst id info1 info2 =
+ Builtin_attributes.check_alerts_inclusion
+ ~def:info1.mtd_loc
+ ~use:info2.mtd_loc
+ loc
+ info1.mtd_attributes info2.mtd_attributes
+ (Ident.name id);
+ let info2 = Subst.modtype_declaration Keep subst info2 in
+ let r =
+ match (info1.mtd_type, info2.mtd_type) with
+ (None, None) -> Ok Tcoerce_none
+ | (Some _, None) -> Ok Tcoerce_none
+ | (Some mty1, Some mty2) ->
+ check_modtype_equiv ~core ~direction ~loc env mty1 mty2
+ | (None, Some mty2) ->
+ let mty1 = Mty_ident(Path.Pident id) in
+ check_modtype_equiv ~core ~direction ~loc env mty1 mty2 in
+ match r with
+ | Ok _ as ok -> ok
+ | Error e -> Error Error.(Module_type_declaration (diff info1 info2 e))
+
+and check_modtype_equiv ~core ~direction ~loc env mty1 mty2 =
+ let nested_eq = direction.Directionality.in_eq in
+ let direction = Directionality.enter_eq direction in
+ let c1 =
+ modtypes ~core ~direction ~loc env Subst.identity mty1 mty2 Shape.dummy_mod
+ in
+ let c2 =
+ (* For nested module type paths, we check only one side of the equivalence:
+ the outer module type is the one responsible for checking the other side
+ of the equivalence.
+ *)
+ if nested_eq then None
+ else
+ let direction = Directionality.negate direction in
+ Some (
+ modtypes ~core ~direction ~loc env Subst.identity
+ mty2 mty1 Shape.dummy_mod
+ )
+ in
+ match c1, c2 with
+ | Ok (Tcoerce_none, _), (Some Ok (Tcoerce_none, _)|None) -> Ok Tcoerce_none
+ | Ok (c1, _), (Some Ok _ | None) ->
+ (* Format.eprintf "@[c1 = %a@ c2 = %a@]@."
+ print_coercion _c1 print_coercion _c2; *)
+ Error Error.(Illegal_permutation c1)
+ | Ok _, Some Error e -> Error Error.(Not_greater_than e)
+ | Error e, (Some Ok _ | None) -> Error Error.(Not_less_than e)
+ | Error less_than, Some Error greater_than ->
+ Error Error.(Incomparable {less_than; greater_than})
+
+
+(* Simplified inclusion check between module types (for Env) *)
+
+let can_alias env path =
+ let rec no_apply = function
+ | Path.Pident _ -> true
+ | Path.Pdot(p, _) | Path.Pextra_ty (p, _) -> no_apply p
+ | Path.Papply _ -> false
+ in
+ no_apply path && not (Env.is_functor_arg path env)
+
+let core_inclusion = Core_inclusion.{
+ type_declarations;
+ value_descriptions;
+ extension_constructors;
+ class_type_declarations;
+ class_declarations;
+}
+
+let core_consistency =
+ let type_declarations ~loc:_ env ~direction:_ _ _ d1 d2 =
+ match Includecore.type_declarations_consistency env d1 d2 with
+ | None -> Ok Tcoerce_none
+ | Some err -> Error Error.(Core(Type_declarations (diff d1 d2 err)))
+ in
+ let value_descriptions ~loc:_ env ~direction:_ _ _ vd1 vd2 =
+ match Includecore.value_descriptions_consistency env vd1 vd2 with
+ | x -> Ok x
+ | exception Includecore.Dont_match err ->
+ Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
+ in
+ let accept ~loc:_ _env ~direction:_ _subst _id _d1 _d2 = Ok Tcoerce_none in
+ {
+ type_declarations;
+ value_descriptions;
+ class_declarations=accept;
+ class_type_declarations=accept;
+ extension_constructors=accept;
+ }
+
+type explanation = Env.t * Error.all
+exception Error of explanation
+
+type application_name =
+ | Anonymous_functor
+ | Full_application_path of Longident.t
+ | Named_leftmost_functor of Longident.t
+exception Apply_error of {
+ loc : Location.t ;
+ env : Env.t ;
+ app_name : application_name ;
+ mty_f : module_type ;
+ args : (Error.functor_arg_descr * module_type) list ;
+ }
+
+let check_modtype_inclusion_raw ~loc env mty1 path1 mty2 =
+ let aliasable = can_alias env path1 in
+ let direction = Directionality.unknown ~mark:true in
+ strengthened_modtypes ~core:core_inclusion ~direction ~loc ~aliasable env
+ Subst.identity mty1 path1 mty2 Shape.dummy_mod
+ |> Result.map fst
+
+let check_modtype_inclusion ~loc env mty1 path1 mty2 =
+ match check_modtype_inclusion_raw ~loc env mty1 path1 mty2 with
+ | Ok _ -> None
+ | Error e -> Some (env, Error.In_Module_type e)
+
+let check_functor_application_in_path
+ ~errors ~loc ~lid_whole_app ~f0_path ~args
+ ~arg_path ~arg_mty ~param_mty env =
+ match check_modtype_inclusion_raw ~loc env arg_mty arg_path param_mty with
+ | Ok _ -> ()
+ | Error _errs ->
+ if errors then
+ let prepare_arg (arg_path, arg_mty) =
+ let aliasable = can_alias env arg_path in
+ let smd = Mtype.strengthen ~aliasable env arg_mty arg_path in
+ (Error.Named arg_path, smd)
+ in
+ let mty_f = (Env.find_module f0_path env).md_type in
+ let args = List.map prepare_arg args in
+ let app_name = Full_application_path lid_whole_app in
+ raise (Apply_error {loc; env; app_name; mty_f; args})
+ else
+ raise Not_found
+
+let () =
+ Env.check_functor_application := check_functor_application_in_path
+
+
+(* Check that an implementation of a compilation unit meets its
+ interface. *)
+
+let compunit env ~mark impl_name impl_sig intf_name intf_sig unit_shape =
+ let loc = Location.in_file impl_name in
+ let direction = Directionality.strictly_positive ~mark in
+ match
+ signatures ~core:core_inclusion ~direction ~loc env Subst.identity
+ impl_sig intf_sig unit_shape
+ with Result.Error reasons ->
+ let cdiff =
+ Error.In_Compilation_unit(Error.diff impl_name intf_name reasons) in
+ raise(Error(env, cdiff))
+ | Ok x -> x
+
+(* Functor diffing computation:
+ The diffing computation uses the internal typing function
+ *)
+
+module Functor_inclusion_diff = struct
+
+ module Defs = struct
+ type left = Types.functor_parameter
+ type right = left
+ type eq = Typedtree.module_coercion
+ type diff = (Types.functor_parameter, unit) Error.functor_param_symptom
+ type state = {
+ res: module_type option;
+ env: Env.t;
+ subst: Subst.t;
+ }
+ end
+ open Defs
+
+ module Diff = Diffing.Define(Defs)
+
+ let param_name = function
+ | Named(x,_) -> x
+ | Unit -> None
+
+ let weight: Diff.change -> _ = function
+ | Insert _ -> 10
+ | Delete _ -> 10
+ | Change _ -> 10
+ | Keep (param1, param2, _) -> begin
+ match param_name param1, param_name param2 with
+ | None, None
+ -> 0
+ | Some n1, Some n2
+ when String.equal (Ident.name n1) (Ident.name n2)
+ -> 0
+ | Some _, Some _ -> 1
+ | Some _, None | None, Some _ -> 1
+ end
+
+
+
+ let keep_expansible_param = function
+ | Mty_ident _ | Mty_alias _ as mty -> Some mty
+ | Mty_signature _ | Mty_functor _ -> None
+
+ let lookup_expansion { env ; res ; _ } = match res with
+ | None -> None
+ | Some res ->
+ match retrieve_functor_params env res with
+ | [], _ -> None
+ | params, res ->
+ let more = Array.of_list params in
+ Some (keep_expansible_param res, more)
+
+ let expand_params state =
+ match lookup_expansion state with
+ | None -> state, [||]
+ | Some (res, expansion) -> { state with res }, expansion
+
+ (* Whenever we have a named parameter that doesn't match it anonymous
+ counterpart, we add it to the typing environment because it may
+ contain useful abbreviations, but without adding any equations *)
+ let bind id arg state =
+ let arg' = Subst.modtype Keep state.subst arg in
+ let env = Env.add_module id Mp_present arg' state.env in
+ { state with env }
+
+ let rec update (d:Diff.change) st =
+ match d with
+ | Insert (Unit | Named (None,_))
+ | Delete (Unit | Named (None,_))
+ | Keep (Unit,_,_)
+ | Keep (_,Unit,_) ->
+ (* No named abstract parameters: we keep the same environment *)
+ st, [||]
+ | Insert (Named (Some id, arg)) | Delete (Named (Some id, arg)) ->
+ (* one named parameter to bind *)
+ st |> bind id arg |> expand_params
+ | Change (delete, insert, _) ->
+ (* Change should be delete + insert: we add both abstract parameters
+ to the environment without equating them. *)
+ let st, _expansion = update (Diffing.Delete delete) st in
+ update (Diffing.Insert insert) st
+ | Keep (Named (name1, _), Named (name2, arg2), _) ->
+ let arg = Subst.modtype Keep st.subst arg2 in
+ let env, subst =
+ equate_one_functor_param st.subst st.env arg name1 name2
+ in
+ expand_params { st with env; subst }
+
+ let diff env (l1,res1) (l2,_) =
+ let module Compute = Diff.Left_variadic(struct
+ let test st mty1 mty2 =
+ let loc = Location.none in
+ let res, _, _ =
+ let direction=Directionality.unknown ~mark:false in
+ functor_param ~core:core_inclusion ~direction ~loc st.env
+ st.subst mty1 mty2
+ in
+ res
+ let update = update
+ let weight = weight
+ end)
+ in
+ let param1 = Array.of_list l1 in
+ let param2 = Array.of_list l2 in
+ let state =
+ { env; subst = Subst.identity; res = keep_expansible_param res1}
+ in
+ Compute.diff state param1 param2
+
+end
+
+module Functor_app_diff = struct
+ module I = Functor_inclusion_diff
+ module Defs= struct
+ type left = Error.functor_arg_descr * Types.module_type
+ type right = Types.functor_parameter
+ type eq = Typedtree.module_coercion
+ type diff = (Error.functor_arg_descr, unit) Error.functor_param_symptom
+ type state = I.Defs.state
+ end
+ module Diff = Diffing.Define(Defs)
+
+ let weight: Diff.change -> _ = function
+ | Insert _ -> 10
+ | Delete _ -> 10
+ | Change _ -> 10
+ | Keep (param1, param2, _) ->
+ (* We assign a small penalty to named arguments with
+ non-matching names *)
+ begin
+ let desc1 : Error.functor_arg_descr = fst param1 in
+ match desc1, I.param_name param2 with
+ | (Unit | Empty_struct | Anonymous) , None
+ -> 0
+ | Named (Path.Pident n1), Some n2
+ when String.equal (Ident.name n1) (Ident.name n2)
+ -> 0
+ | Named _, Some _ -> 1
+ | Named _, None | (Unit | Empty_struct | Anonymous), Some _ -> 1
+ end
+
+ let update (d: Diff.change) (st:Defs.state) =
+ let open Error in
+ match d with
+ | Insert (Unit|Named(None,_))
+ | Delete _ (* delete is a concrete argument, not an abstract parameter*)
+ | Keep ((Unit,_),_,_) (* Keep(Unit,_) implies Keep(Unit,Unit) *)
+ | Keep (_,(Unit|Named(None,_)),_)
+ | Change (_,(Unit|Named (None,_)), _ ) ->
+ (* no abstract parameters to add, nor any equations *)
+ st, [||]
+ | Insert(Named(Some param, param_ty))
+ | Change(_, Named(Some param, param_ty), _ ) ->
+ (* Change is Delete + Insert: we add the Inserted parameter to the
+ environment to track equalities with external components that the
+ parameter might add. *)
+ let mty = Subst.modtype Keep st.subst param_ty in
+ let env = Env.add_module ~arg:true param Mp_present mty st.env in
+ I.expand_params { st with env }
+ | Keep ((Named arg, _mty) , Named (Some param, _param), _) ->
+ let res =
+ Option.map (fun res ->
+ let scope = Ctype.create_scope () in
+ let subst = Subst.add_module param arg Subst.identity in
+ Subst.modtype (Rescope scope) subst res
+ )
+ st.res
+ in
+ let subst = Subst.add_module param arg st.subst in
+ I.expand_params { st with subst; res }
+ | Keep (((Anonymous|Empty_struct), mty),
+ Named (Some param, _param), _) ->
+ let mty' = Subst.modtype Keep st.subst mty in
+ let env = Env.add_module ~arg:true param Mp_present mty' st.env in
+ let res = Option.map (Mtype.nondep_supertype env [param]) st.res in
+ I.expand_params { st with env; res}
+
+ let diff env ~f ~args =
+ let params, res = retrieve_functor_params env f in
+ let module Compute = Diff.Right_variadic(struct
+ let update = update
+ let test (state:Defs.state) (arg,arg_mty) param =
+ let loc = Location.none in
+ let res = match (arg:Error.functor_arg_descr), param with
+ | (Unit|Empty_struct), Unit -> Ok Tcoerce_none
+ | Unit, Named _ | (Anonymous | Named _), Unit ->
+ Result.Error (Error.Incompatible_params(arg,param))
+ | ( Anonymous | Named _ | Empty_struct ), Named (_, param) ->
+ let direction=Directionality.unknown ~mark:false in
+ match
+ modtypes
+ ~core:core_inclusion ~direction ~loc
+ state.env state.subst arg_mty param
+ Shape.dummy_mod
+ with
+ | Error mty -> Result.Error (Error.Mismatch mty)
+ | Ok (cc, _) -> Ok cc
+ in
+ res
+ let weight = weight
+ end)
+ in
+ let args = Array.of_list args in
+ let params = Array.of_list params in
+ let state : Defs.state =
+ { env; subst = Subst.identity; res = I.keep_expansible_param res }
+ in
+ Compute.diff state args params
+
+end
+
+(* Hide the context and substitution parameters to the outside world *)
+
+let modtypes_with_shape ~shape ~loc env ~mark mty1 mty2 =
+ (* modtypes with shape is used when typing module expressions in [Typemod] *)
+ let direction = Directionality.strictly_positive ~mark in
+ match
+ modtypes ~core:core_inclusion ~direction ~loc env Subst.identity
+ mty1 mty2 shape
+ with
+ | Ok (cc, shape) -> cc, shape
+ | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+
+let modtypes_consistency ~loc env mty1 mty2 =
+ let direction = Directionality.unknown ~mark:false in
+ match
+ modtypes ~core:core_consistency ~direction ~loc env Subst.identity
+ mty1 mty2 Shape.dummy_mod
+ with
+ | Ok _ -> ()
+ | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+
+let modtypes ~loc env ~mark mty1 mty2 =
+ let direction = Directionality.unknown ~mark in
+ match
+ modtypes ~core:core_inclusion ~direction ~loc env Subst.identity
+ mty1 mty2 Shape.dummy_mod
+ with
+ | Ok (cc, _) -> cc
+ | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+
+let gen_signatures env ~direction sig1 sig2 =
+ match
+ signatures
+ ~core:core_inclusion ~direction ~loc:Location.none env
+ Subst.identity sig1 sig2 Shape.dummy_mod
+ with
+ | Ok (cc, _) -> cc
+ | Error reason -> raise (Error(env,Error.(In_Signature reason)))
+
+let signatures env ~mark sig1 sig2 =
+ let direction = Directionality.unknown ~mark in
+ gen_signatures env ~direction sig1 sig2
+
+let check_implementation env impl intf =
+ let direction = Directionality.strictly_positive ~mark:true in
+ ignore (gen_signatures env ~direction impl intf)
+
+let type_declarations ~loc env ~mark id decl1 decl2 =
+ let direction = Directionality.unknown ~mark in
+ match Core_inclusion.type_declarations ~loc env ~direction
+ Subst.identity id decl1 decl2
+ with
+ | Ok _ -> ()
+ | Error (Error.Core reason) ->
+ raise (Error(env,Error.(In_Type_declaration(id,reason))))
+ | Error _ -> assert false
+
+let strengthened_module_decl ~loc ~aliasable env ~mark md1 path1 md2 =
+ let direction = Directionality.unknown ~mark in
+ match strengthened_module_decl ~core:core_inclusion ~loc ~aliasable ~direction
+ env Subst.identity md1 path1 md2 Shape.dummy_mod with
+ | Ok (x, _shape) -> x
+ | Error mdiff ->
+ raise (Error(env,Error.(In_Module_type mdiff)))
+
+let expand_module_alias ~strengthen env path =
+ match expand_module_alias ~strengthen env path with
+ | Ok x -> x
+ | Result.Error _ ->
+ raise (Error(env,In_Expansion(Error.Unbound_module_path path)))
+
+let check_modtype_equiv ~loc env id mty1 mty2 =
+ let direction = Directionality.unknown ~mark:true in
+ match
+ check_modtype_equiv ~core:core_inclusion ~loc ~direction env mty1 mty2
+ with
+ | Ok _ -> ()
+ | Error e ->
+ raise (Error(env,
+ Error.(In_Module_type_substitution (id,diff mty1 mty2 e)))
+ )
diff --git a/upstream/ocaml_503/typing/includemod.mli b/upstream/ocaml_503/typing/includemod.mli
new file mode 100644
index 0000000000..fa749601ff
--- /dev/null
+++ b/upstream/ocaml_503/typing/includemod.mli
@@ -0,0 +1,254 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Inclusion checks for the module language *)
+
+open Typedtree
+open Types
+
+module Error: sig
+
+ type ('elt,'explanation) diff = {
+ got:'elt;
+ expected:'elt;
+ symptom:'explanation
+ }
+ type 'elt core_diff =('elt,unit) diff
+
+ type functor_arg_descr =
+ | Anonymous
+ | Named of Path.t
+ | Unit
+ | Empty_struct
+ (** For backward compatibility's sake, an empty struct can be implicitly
+ converted to an unit module. *)
+
+ type core_sigitem_symptom =
+ | Value_descriptions of
+ (Types.value_description, Includecore.value_mismatch) diff
+ | Type_declarations of
+ (Types.type_declaration, Includecore.type_mismatch) diff
+ | Extension_constructors of
+ (Types.extension_constructor,
+ Includecore.extension_constructor_mismatch) diff
+ | Class_type_declarations of
+ (Types.class_type_declaration, Ctype.class_match_failure list) diff
+ | Class_declarations of
+ (Types.class_declaration, Ctype.class_match_failure list) diff
+
+ type core_module_type_symptom =
+ | Not_an_alias
+ | Not_an_identifier
+ | Incompatible_aliases
+ | Abstract_module_type
+ | Unbound_module_path of Path.t
+
+ type module_type_symptom =
+ | Mt_core of core_module_type_symptom
+ | Signature of signature_symptom
+ | Functor of functor_symptom
+ | Invalid_module_alias of Path.t
+ | After_alias_expansion of module_type_diff
+
+
+ and module_type_diff = (Types.module_type, module_type_symptom) diff
+
+ and functor_symptom =
+ | Params of functor_params_diff
+ | Result of module_type_diff
+
+ and ('arg,'path) functor_param_symptom =
+ | Incompatible_params of 'arg * Types.functor_parameter
+ | Mismatch of module_type_diff
+
+ and arg_functor_param_symptom =
+ (Types.functor_parameter, Ident.t) functor_param_symptom
+
+ and functor_params_diff =
+ (Types.functor_parameter list * Types.module_type) core_diff
+
+ and signature_symptom = {
+ env: Env.t;
+ missings: Types.signature_item list;
+ incompatibles: (Ident.t * sigitem_symptom) list;
+ oks: (int * Typedtree.module_coercion) list;
+ leftovers: ((Types.signature_item as 'it) * 'it * int) list
+ (** signature items that could not be compared due to type divergence *)
+ }
+ and sigitem_symptom =
+ | Core of core_sigitem_symptom
+ | Module_type_declaration of
+ (Types.modtype_declaration, module_type_declaration_symptom) diff
+ | Module_type of module_type_diff
+
+ and module_type_declaration_symptom =
+ | Illegal_permutation of Typedtree.module_coercion
+ | Not_greater_than of module_type_diff
+ | Not_less_than of module_type_diff
+ | Incomparable of
+ {less_than:module_type_diff; greater_than: module_type_diff}
+
+
+ type all =
+ | In_Compilation_unit of (string, signature_symptom) diff
+ | In_Signature of signature_symptom
+ | In_Module_type of module_type_diff
+ | In_Module_type_substitution of
+ Ident.t * (Types.module_type,module_type_declaration_symptom) diff
+ | In_Type_declaration of Ident.t * core_sigitem_symptom
+ | In_Expansion of core_module_type_symptom
+end
+type explanation = Env.t * Error.all
+
+(* Extract name, kind and ident from a signature item *)
+type field_kind =
+ | Field_value
+ | Field_type
+ | Field_exception
+ | Field_typext
+ | Field_module
+ | Field_modtype
+ | Field_class
+ | Field_classtype
+
+type field_desc = { name: string; kind: field_kind }
+
+val kind_of_field_desc: field_desc -> string
+val field_desc: field_kind -> Ident.t -> field_desc
+
+(** Map indexed by both field types and names.
+ This avoids name clashes between different sorts of fields
+ such as values and types. *)
+module FieldMap: Map.S with type key = field_desc
+
+val item_ident_name: Types.signature_item -> Ident.t * Location.t * field_desc
+val is_runtime_component: Types.signature_item -> bool
+
+
+(* Typechecking *)
+
+val modtypes:
+ loc:Location.t -> Env.t -> mark:bool ->
+ module_type -> module_type -> module_coercion
+
+val modtypes_consistency:
+ loc:Location.t -> Env.t -> module_type -> module_type -> unit
+
+val modtypes_with_shape:
+ shape:Shape.t -> loc:Location.t -> Env.t -> mark:bool ->
+ module_type -> module_type -> module_coercion * Shape.t
+
+val strengthened_module_decl:
+ loc:Location.t -> aliasable:bool -> Env.t -> mark:bool ->
+ module_declaration -> Path.t -> module_declaration -> module_coercion
+
+val check_modtype_inclusion :
+ loc:Location.t -> Env.t -> Types.module_type -> Path.t -> Types.module_type ->
+ explanation option
+(** [check_modtype_inclusion ~loc env mty1 path1 mty2] checks that the
+ functor application F(M) is well typed, where mty2 is the type of
+ the argument of F and path1/mty1 is the path/unstrenghened type of M. *)
+
+val check_modtype_equiv:
+ loc:Location.t -> Env.t -> Ident.t -> module_type -> module_type -> unit
+
+val signatures: Env.t -> mark:bool -> signature -> signature -> module_coercion
+
+(** Check an implementation against an interface *)
+val check_implementation: Env.t -> signature -> signature -> unit
+
+val compunit:
+ Env.t -> mark:bool -> string -> signature ->
+ string -> signature -> Shape.t -> module_coercion * Shape.t
+
+val type_declarations:
+ loc:Location.t -> Env.t -> mark:bool ->
+ Ident.t -> type_declaration -> type_declaration -> unit
+
+val print_coercion: Format.formatter -> module_coercion -> unit
+
+type symptom =
+ Missing_field of Ident.t * Location.t * string (* kind *)
+ | Value_descriptions of
+ Ident.t * value_description * value_description
+ * Includecore.value_mismatch
+ | Type_declarations of Ident.t * type_declaration
+ * type_declaration * Includecore.type_mismatch
+ | Extension_constructors of Ident.t * extension_constructor
+ * extension_constructor * Includecore.extension_constructor_mismatch
+ | Module_types of module_type * module_type
+ | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
+ | Modtype_permutation of Types.module_type * Typedtree.module_coercion
+ | Interface_mismatch of string * string
+ | Class_type_declarations of
+ Ident.t * class_type_declaration * class_type_declaration *
+ Ctype.class_match_failure list
+ | Class_declarations of
+ Ident.t * class_declaration * class_declaration *
+ Ctype.class_match_failure list
+ | Unbound_module_path of Path.t
+ | Invalid_module_alias of Path.t
+
+type pos =
+ | Module of Ident.t
+ | Modtype of Ident.t
+ | Arg of functor_parameter
+ | Body of functor_parameter
+
+exception Error of explanation
+
+type application_name =
+ | Anonymous_functor (** [(functor (_:sig end) -> struct end)(Int)] *)
+ | Full_application_path of Longident.t (** [F(G(X).P)(Y)] *)
+ | Named_leftmost_functor of Longident.t (** [F(struct end)...(...)] *)
+
+exception Apply_error of {
+ loc : Location.t ;
+ env : Env.t ;
+ app_name : application_name ;
+ mty_f : module_type ;
+ args : (Error.functor_arg_descr * Types.module_type) list ;
+ }
+
+val expand_module_alias: strengthen:bool -> Env.t -> Path.t -> Types.module_type
+
+module Functor_inclusion_diff: sig
+ module Defs: sig
+ type left = Types.functor_parameter
+ type right = left
+ type eq = Typedtree.module_coercion
+ type diff = (Types.functor_parameter, unit) Error.functor_param_symptom
+ type state
+ end
+ val diff: Env.t ->
+ Types.functor_parameter list * Types.module_type ->
+ Types.functor_parameter list * Types.module_type ->
+ Diffing.Define(Defs).patch
+end
+
+module Functor_app_diff: sig
+ module Defs: sig
+ type left = Error.functor_arg_descr * Types.module_type
+ type right = Types.functor_parameter
+ type eq = Typedtree.module_coercion
+ type diff = (Error.functor_arg_descr, unit) Error.functor_param_symptom
+ type state
+ end
+ val diff:
+ Env.t ->
+ f:Types.module_type ->
+ args:(Error.functor_arg_descr * Types.module_type) list ->
+ Diffing.Define(Defs).patch
+end
diff --git a/upstream/ocaml_503/typing/includemod_errorprinter.ml b/upstream/ocaml_503/typing/includemod_errorprinter.ml
new file mode 100644
index 0000000000..fd74a073a2
--- /dev/null
+++ b/upstream/ocaml_503/typing/includemod_errorprinter.ml
@@ -0,0 +1,1045 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+module Style = Misc.Style
+module Fmt = Format_doc
+module Printtyp = Printtyp.Doc
+
+module Context = struct
+ type pos =
+ | Module of Ident.t
+ | Modtype of Ident.t
+ | Arg of Types.functor_parameter
+ | Body of Types.functor_parameter
+
+ let path_of_context = function
+ Module id :: rem ->
+ let rec subm path = function
+ | [] -> path
+ | Module id :: rem -> subm (Path.Pdot (path, Ident.name id)) rem
+ | _ -> assert false
+ in subm (Path.Pident id) rem
+ | _ -> assert false
+
+
+ let rec context ppf = function
+ Module id :: rem ->
+ Fmt.fprintf ppf "@[<2>module %a%a@]" Printtyp.ident id args rem
+ | Modtype id :: rem ->
+ Fmt.fprintf ppf "@[<2>module type %a =@ %a@]"
+ Printtyp.ident id context_mty rem
+ | Body x :: rem ->
+ Fmt.fprintf ppf "(%s) ->@ %a" (argname x) context_mty rem
+ | Arg x :: rem ->
+ Fmt.fprintf ppf "(%s : %a) -> ..."
+ (argname x) context_mty rem
+ | [] ->
+ Fmt.fprintf ppf "<here>"
+ and context_mty ppf = function
+ (Module _ | Modtype _) :: _ as rem ->
+ Fmt.fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+ | cxt -> context ppf cxt
+ and args ppf = function
+ Body x :: rem ->
+ Fmt.fprintf ppf "(%s)%a" (argname x) args rem
+ | Arg x :: rem ->
+ Fmt.fprintf ppf "(%s :@ %a) : ..." (argname x) context_mty rem
+ | cxt ->
+ Fmt.fprintf ppf " :@ %a" context_mty cxt
+ and argname = function
+ | Types.Unit -> ""
+ | Types.Named (None, _) -> "_"
+ | Types.Named (Some id, _) -> Ident.name id
+
+ let alt_pp ppf cxt =
+ if cxt = [] then () else
+ if List.for_all (function Module _ -> true | _ -> false) cxt then
+ Fmt.fprintf ppf ",@ in module %a"
+ (Style.as_inline_code Printtyp.path) (path_of_context cxt)
+ else
+ Fmt.fprintf ppf ",@ @[<hv 2>at position@ %a@]"
+ (Style.as_inline_code context) cxt
+
+ let pp ppf cxt =
+ if cxt = [] then () else
+ if List.for_all (function Module _ -> true | _ -> false) cxt then
+ Fmt.fprintf ppf "In module %a:@ "
+ (Style.as_inline_code Printtyp.path) (path_of_context cxt)
+ else
+ Fmt.fprintf ppf "@[<hv 2>At position@ %a@]@ "
+ (Style.as_inline_code context) cxt
+end
+
+module Runtime_coercion = struct
+ (** Extraction of a small change from a non-identity runtime coercion *)
+
+ (** When examining coercions, we only have runtime component indices,
+ we use thus a limited version of {!pos}. *)
+ type coerce_pos =
+ | Item of int
+ | InArg
+ | InBody
+
+ let either f x g y = match f x with
+ | None -> g y
+ | Some _ as v -> v
+
+ type change =
+ | Transposition of int * int
+ | Primitive_coercion of string
+ | Alias_coercion of Path.t
+
+ (** We extract a small change from a full coercion. *)
+ let rec first_change_under path (coerc:Typedtree.module_coercion) =
+ match coerc with
+ | Tcoerce_structure(c,_) ->
+ either
+ (first_item_transposition path 0) c
+ (first_non_id path 0) c
+ | Tcoerce_functor(arg,res) ->
+ either
+ (first_change_under (InArg::path)) arg
+ (first_change_under (InBody::path)) res
+ | Tcoerce_none -> None
+ | Tcoerce_alias _ | Tcoerce_primitive _ -> None
+
+ (* we search the first point which is not invariant at the current level *)
+ and first_item_transposition path pos = function
+ | [] -> None
+ | (n, _) :: q ->
+ if n < 0 || n = pos then
+ (* when n < 0, this is not a transposition but a kind coercion,
+ which will be covered in the first_non_id case *)
+ first_item_transposition path (pos+1) q
+ else
+ Some(List.rev path, Transposition (pos, n))
+ (* we search the first item with a non-identity inner coercion *)
+ and first_non_id path pos = function
+ | [] -> None
+ | (_, Typedtree.Tcoerce_none) :: q -> first_non_id path (pos + 1) q
+ | (_, Typedtree.Tcoerce_alias (_,p,_)) :: _ ->
+ Some (List.rev path, Alias_coercion p)
+ | (_, Typedtree.Tcoerce_primitive p) :: _ ->
+ let name = Primitive.byte_name p.pc_desc in
+ Some (List.rev path, Primitive_coercion name)
+ | (_,c) :: q ->
+ either
+ (first_change_under (Item pos :: path)) c
+ (first_non_id path (pos + 1)) q
+
+ let first_change c = first_change_under [] c
+
+ let rec runtime_item k = function
+ | [] -> raise Not_found
+ | item :: q ->
+ if not(Includemod.is_runtime_component item) then
+ runtime_item k q
+ else if k = 0 then
+ item
+ else
+ runtime_item (k-1) q
+
+ (* Find module type at position [path] and convert the [coerce_pos] path to
+ a [pos] path *)
+ let rec find env ctx path (mt:Types.module_type) = match mt, path with
+ | (Mty_ident p | Mty_alias p), _ ->
+ begin match (Env.find_modtype p env).mtd_type with
+ | None -> raise Not_found
+ | Some mt -> find env ctx path mt
+ end
+ | Mty_signature s , [] -> List.rev ctx, s
+ | Mty_signature s, Item k :: q ->
+ begin match runtime_item k s with
+ | Sig_module (id, _, md,_,_) ->
+ find env (Context.Module id :: ctx) q md.md_type
+ | _ -> raise Not_found
+ end
+ | Mty_functor(Named (_,mt) as arg,_), InArg :: q ->
+ find env (Context.Arg arg :: ctx) q mt
+ | Mty_functor(arg, mt), InBody :: q ->
+ find env (Context.Body arg :: ctx) q mt
+ | _ -> raise Not_found
+
+ let find env path mt = find env [] path mt
+ let item mt k = Includemod.item_ident_name (runtime_item k mt)
+
+ let pp_item ppf (id,_,kind) =
+ Fmt.fprintf ppf "%s %a"
+ (Includemod.kind_of_field_desc kind)
+ Style.inline_code (Ident.name id)
+
+ let illegal_permutation ctx_printer env ppf (mty,c) =
+ match first_change c with
+ | None | Some (_, (Primitive_coercion _ | Alias_coercion _)) ->
+ (* those kind coercions are not inversible, and raise an error earlier
+ when checking for module type equivalence *)
+ assert false
+ | Some (path, Transposition (k,l)) ->
+ try
+ let ctx, mt = find env path mty in
+ Fmt.fprintf ppf
+ "@[<hv 2>Illegal permutation of runtime components in a module type.@ \
+ @[For example%a,@]@ @[the %a@ and the %a are not in the same order@ \
+ in the expected and actual module types.@]@]"
+ ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
+ with Not_found -> (* this should not happen *)
+ Fmt.fprintf ppf
+ "Illegal permutation of runtime components in a module type."
+
+ let in_package_subtype ctx_printer env mty c ppf =
+ match first_change c with
+ | None ->
+ (* The coercion looks like the identity but was not simplified to
+ [Tcoerce_none], this only happens when the two first-class module
+ types differ by runtime size *)
+ Fmt.fprintf ppf
+ "The two first-class module types differ by their runtime size."
+ | Some (path, c) ->
+ try
+ let ctx, mt = find env path mty in
+ match c with
+ | Primitive_coercion prim_name ->
+ Fmt.fprintf ppf
+ "@[The two first-class module types differ by a coercion of@ \
+ the primitive %a@ to a value%a.@]"
+ Style.inline_code prim_name
+ ctx_printer ctx
+ | Alias_coercion path ->
+ Fmt.fprintf ppf
+ "@[The two first-class module types differ by a coercion of@ \
+ a module alias %a@ to a module%a.@]"
+ (Style.as_inline_code Printtyp.path) path
+ ctx_printer ctx
+ | Transposition (k,l) ->
+ Fmt.fprintf ppf
+ "@[@[The two first-class module types do not share@ \
+ the same positions for runtime components.@]@ \
+ @[For example,%a@ the %a@ occurs at the expected position of@ \
+ the %a.@]@]"
+ ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
+ with Not_found ->
+ Fmt.fprintf ppf
+ "@[The two packages types do not share@ \
+ the@ same@ positions@ for@ runtime@ components.@]"
+
+end
+
+
+
+module Err = Includemod.Error
+
+let buffer = ref Bytes.empty
+let is_big obj =
+ let size = !Clflags.error_size in
+ size > 0 &&
+ begin
+ if Bytes.length !buffer < size then buffer := Bytes.create size;
+ try ignore (Marshal.to_buffer !buffer 0 size obj []); false
+ with _ -> true
+ end
+
+let show_loc msg ppf loc =
+ let pos = loc.Location.loc_start in
+ if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
+ else Fmt.fprintf ppf "@\n@[<2>%a:@ %s@]" Location.Doc.loc loc msg
+
+let show_locs ppf (loc1, loc2) =
+ show_loc "Expected declaration" ppf loc2;
+ show_loc "Actual declaration" ppf loc1
+
+
+let dmodtype mty =
+ let tmty = Out_type.tree_of_modtype mty in
+ Fmt.dprintf "%a" !Oprint.out_module_type tmty
+
+let space ppf () = Fmt.fprintf ppf "@ "
+
+(**
+ In order to display a list of functor arguments in a compact format,
+ we introduce a notion of shorthand for functor arguments.
+ The aim is to first present the lists of actual and expected types with
+ shorthands:
+
+ (X: $S1) (Y: $S2) (Z: An_existing_module_type) ...
+ does not match
+ (X: $T1) (Y: A_real_path) (Z: $T3) ...
+
+ and delay the full display of the module types corresponding to $S1, $S2,
+ $T1, and $T3 to the suberror message.
+
+*)
+module With_shorthand = struct
+
+ (** A item with a potential shorthand name *)
+ type 'a named = {
+ item: 'a;
+ name : string;
+ }
+
+ type 'a t =
+ | Original of 'a (** The shorthand has been discarded *)
+ | Synthetic of 'a named
+ (** The shorthand is potentially useful *)
+
+ type functor_param =
+ | Unit
+ | Named of (Ident.t option * Types.module_type t)
+
+ (** Shorthand generation *)
+ type kind =
+ | Got
+ | Expected
+ | Unneeded
+
+ type variant =
+ | App
+ | Inclusion
+
+ let elide_if_app ctx s = match ctx with
+ | App -> Unneeded
+ | Inclusion -> s
+
+ let make side pos =
+ match side with
+ | Got -> Fmt.asprintf "$S%d" pos
+ | Expected -> Fmt.asprintf "$T%d" pos
+ | Unneeded -> "..."
+
+ (** Add shorthands to a patch *)
+ open Diffing
+ let patch ctx p =
+ let add_shorthand side pos mty =
+ {name = (make side pos); item = mty }
+ in
+ let aux i d =
+ let pos = i + 1 in
+ let d = match d with
+ | Insert mty ->
+ Insert (add_shorthand Expected pos mty)
+ | Delete mty ->
+ Delete (add_shorthand (elide_if_app ctx Got) pos mty)
+ | Change (g, e, p) ->
+ Change
+ (add_shorthand Got pos g,
+ add_shorthand Expected pos e, p)
+ | Keep (g, e, p) ->
+ Keep (add_shorthand Got pos g,
+ add_shorthand (elide_if_app ctx Expected) pos e, p)
+ in
+ pos, d
+ in
+ List.mapi aux p
+
+ (** Shorthand computation from named item *)
+ let modtype (r : _ named) = match r.item with
+ | Types.Mty_ident _
+ | Types.Mty_alias _
+ | Types.Mty_signature []
+ -> Original r.item
+ | Types.Mty_signature _ | Types.Mty_functor _
+ -> Synthetic r
+
+ let functor_param (ua : _ named) = match ua.item with
+ | Types.Unit -> Unit
+ | Types.Named (from, mty) ->
+ Named (from, modtype { ua with item = mty })
+
+ (** Printing of arguments with shorthands *)
+ let pp ppx = function
+ | Original x -> ppx x
+ | Synthetic s -> Fmt.dprintf "%s" s.name
+
+ let pp_orig ppx = function
+ | Original x | Synthetic { item=x; _ } -> ppx x
+
+ let definition x = match functor_param x with
+ | Unit -> Fmt.dprintf "()"
+ | Named(_,short_mty) ->
+ match short_mty with
+ | Original mty -> dmodtype mty
+ | Synthetic {name; item = mty} ->
+ Fmt.dprintf
+ "%s@ =@ %t" name (dmodtype mty)
+
+ let param x = match functor_param x with
+ | Unit -> Fmt.dprintf "()"
+ | Named (_, short_mty) ->
+ pp dmodtype short_mty
+
+ let qualified_param x = match functor_param x with
+ | Unit -> Fmt.dprintf "()"
+ | Named (None, Original (Mty_signature []) ) ->
+ Fmt.dprintf "(sig end)"
+ | Named (None, short_mty) ->
+ pp dmodtype short_mty
+ | Named (Some p, short_mty) ->
+ Fmt.dprintf "(%s : %t)"
+ (Ident.name p) (pp dmodtype short_mty)
+
+ let definition_of_argument ua =
+ let arg, mty = ua.item in
+ match (arg: Err.functor_arg_descr) with
+ | Unit -> Fmt.dprintf "()"
+ | Empty_struct -> Fmt.dprintf "(struct end)"
+ | Named p ->
+ let mty = modtype { ua with item = mty } in
+ Fmt.dprintf
+ "%a@ :@ %t"
+ Printtyp.path p
+ (pp_orig dmodtype mty)
+ | Anonymous ->
+ let short_mty = modtype { ua with item = mty } in
+ begin match short_mty with
+ | Original mty -> dmodtype mty
+ | Synthetic {name; item=mty} ->
+ Fmt.dprintf "%s@ :@ %t" name (dmodtype mty)
+ end
+
+ let arg ua =
+ let arg, mty = ua.item in
+ match (arg: Err.functor_arg_descr) with
+ | Unit -> Fmt.dprintf "()"
+ | Empty_struct -> Fmt.dprintf "(struct end)"
+ | Named p -> fun ppf -> Printtyp.path ppf p
+ | Anonymous ->
+ let short_mty = modtype { ua with item=mty } in
+ pp dmodtype short_mty
+
+end
+
+
+module Functor_suberror = struct
+ open Err
+
+ let param_id x = match x.With_shorthand.item with
+ | Types.Named (Some _ as x,_) -> x
+ | Types.(Unit | Named(None,_)) -> None
+
+
+(** Print a list of functor parameters with style while adjusting the printing
+ environment for each functor argument.
+
+ Currently, we are disabling disambiguation for functor argument name to
+ avoid the need to track the moving association between identifiers and
+ syntactic names in situation like:
+
+ got: (X: sig module type T end) (Y:X.T) (X:sig module type T end) (Z:X.T)
+ expect: (_: sig end) (Y:X.T) (_:sig end) (Z:X.T)
+*)
+ let pretty_params sep proj printer patch =
+ let pp_param (x,param) =
+ let sty = Diffing.(style @@ classify x) in
+ Fmt.dprintf "%a%t%a"
+ Fmt.pp_open_stag (Style.Style sty)
+ (printer param)
+ Fmt.pp_close_stag ()
+ in
+ let rec pp_params = function
+ | [] -> ignore
+ | [_,param] -> pp_param param
+ | (id,param) :: q ->
+ Fmt.dprintf "%t%a%t"
+ (pp_param param) sep () (hide_id id q)
+ and hide_id id q =
+ match id with
+ | None -> pp_params q
+ | Some id -> Out_type.Ident_names.with_fuzzy id (fun () -> pp_params q)
+ in
+ let params = List.filter_map proj @@ List.map snd patch in
+ pp_params params
+
+ let expected d =
+ let extract: _ Diffing.change -> _ = function
+ | Insert mty
+ | Keep(_,mty,_)
+ | Change (_,mty,_) as x ->
+ Some (param_id mty,(x, mty))
+ | Delete _ -> None
+ in
+ pretty_params space extract With_shorthand.qualified_param d
+
+ let drop_inserted_suffix patch =
+ let rec drop = function
+ | Diffing.Insert _ :: q -> drop q
+ | rest -> List.rev rest in
+ drop (List.rev patch)
+
+ let prepare_patch ~drop ~ctx patch =
+ let drop_suffix x = if drop then drop_inserted_suffix x else x in
+ patch |> drop_suffix |> With_shorthand.patch ctx
+
+
+ module Inclusion = struct
+
+ let got d =
+ let extract: _ Diffing.change -> _ = function
+ | Delete mty
+ | Keep (mty,_,_)
+ | Change (mty,_,_) as x ->
+ Some (param_id mty,(x,mty))
+ | Insert _ -> None
+ in
+ pretty_params space extract With_shorthand.qualified_param d
+
+ let insert mty =
+ Fmt.dprintf
+ "An argument appears to be missing with module type@;<1 2>@[%t@]"
+ (With_shorthand.definition mty)
+
+ let delete mty =
+ Fmt.dprintf
+ "An extra argument is provided of module type@;<1 2>@[%t@]"
+ (With_shorthand.definition mty)
+
+ let ok x y =
+ Fmt.dprintf
+ "Module types %t and %t match"
+ (With_shorthand.param x)
+ (With_shorthand.param y)
+
+ let diff g e more =
+ let g = With_shorthand.definition g in
+ let e = With_shorthand.definition e in
+ Fmt.dprintf
+ "Module types do not match:@ @[%t@]@;<1 -2>does not include@ \
+ @[%t@]%t"
+ g e (more ())
+
+ let incompatible = function
+ | Types.Unit ->
+ Fmt.dprintf
+ "The functor was expected to be applicative at this position"
+ | Types.Named _ ->
+ Fmt.dprintf
+ "The functor was expected to be generative at this position"
+
+ let patch env got expected =
+ Includemod.Functor_inclusion_diff.diff env got expected
+ |> prepare_patch ~drop:false ~ctx:Inclusion
+
+ end
+
+ module App = struct
+
+ let patch env ~f ~args =
+ Includemod.Functor_app_diff.diff env ~f ~args
+ |> prepare_patch ~drop:true ~ctx:App
+
+ let got d =
+ let extract: _ Diffing.change -> _ = function
+ | Delete mty
+ | Keep (mty,_,_)
+ | Change (mty,_,_) as x ->
+ Some (None,(x,mty))
+ | Insert _ -> None
+ in
+ pretty_params space extract With_shorthand.arg d
+
+ let delete mty =
+ Fmt.dprintf
+ "The following extra argument is provided@;<1 2>@[%t@]"
+ (With_shorthand.definition_of_argument mty)
+
+ let insert = Inclusion.insert
+
+ let ok x y =
+ let pp_orig_name = match With_shorthand.functor_param y with
+ | With_shorthand.Named (_, Original mty) ->
+ Fmt.dprintf " %t" (dmodtype mty)
+ | _ -> ignore
+ in
+ Fmt.dprintf
+ "Module %t matches the expected module type%t"
+ (With_shorthand.arg x)
+ pp_orig_name
+
+ let diff g e more =
+ let g = With_shorthand.definition_of_argument g in
+ let e = With_shorthand.definition e in
+ Fmt.dprintf
+ "Modules do not match:@ @[%t@]@;<1 -2>\
+ is not included in@ @[%t@]%t"
+ g e (more ())
+
+ (** Specialized to avoid introducing shorthand names
+ for single change difference
+ *)
+ let single_diff g e more =
+ let _arg, mty = g.With_shorthand.item in
+ let e = match e.With_shorthand.item with
+ | Types.Unit -> Fmt.dprintf "()"
+ | Types.Named(_, mty) -> dmodtype mty
+ in
+ Fmt.dprintf
+ "Modules do not match:@ @[%t@]@;<1 -2>\
+ is not included in@ @[%t@]%t"
+ (dmodtype mty) e (more ())
+
+
+ let incompatible = function
+ | Unit ->
+ Fmt.dprintf
+ "The functor was expected to be applicative at this position"
+ | Named _ | Anonymous ->
+ Fmt.dprintf
+ "The functor was expected to be generative at this position"
+ | Empty_struct ->
+ (* an empty structure can be used in both applicative and generative
+ context *)
+ assert false
+ end
+
+ let subcase sub ~expansion_token env (pos, diff) =
+ Location.msg "%a%a%a%a@[<hv 2>%t@]%a"
+ Fmt.pp_print_tab ()
+ Fmt.pp_open_tbox ()
+ Diffing.prefix (pos, Diffing.classify diff)
+ Fmt.pp_set_tab ()
+ (Printtyp.wrap_printing_env env ~error:true
+ (fun () -> sub ~expansion_token env diff)
+ )
+ Fmt.pp_close_tbox ()
+
+ let onlycase sub ~expansion_token env (_, diff) =
+ Location.msg "%a@[<hv 2>%t@]"
+ Fmt.pp_print_tab ()
+ (Printtyp.wrap_printing_env env ~error:true
+ (fun () -> sub ~expansion_token env diff)
+ )
+
+ let params sub ~expansion_token env l =
+ let rec aux subcases = function
+ | [] -> subcases
+ | (_, Diffing.Keep _) as a :: q ->
+ aux (subcase sub ~expansion_token env a :: subcases) q
+ | a :: q ->
+ List.fold_left (fun acc x ->
+ (subcase sub ~expansion_token:false env x) :: acc
+ )
+ (subcase sub ~expansion_token env a :: subcases)
+ q
+ in
+ match l with
+ | [a] -> [onlycase sub ~expansion_token env a]
+ | l -> aux [] l
+end
+
+
+(** Construct a linear presentation of the error tree *)
+
+open Err
+
+(* Context helper functions *)
+let with_context ?loc ctx printer diff =
+ Location.msg ?loc "%a%a" Context.pp (List.rev ctx)
+ printer diff
+
+let dwith_context ?loc ctx printer =
+ Location.msg ?loc "%a%t" Context.pp (List.rev ctx) printer
+
+let dwith_context_and_elision ?loc ctx printer diff =
+ if is_big (diff.got,diff.expected) then
+ Location.msg ?loc "..."
+ else
+ dwith_context ?loc ctx (printer diff)
+
+(* Merge sub msgs into one printer *)
+let coalesce msgs =
+ match List.rev msgs with
+ | [] -> ignore
+ | before ->
+ let ctx ppf =
+ Fmt.pp_print_list ~pp_sep:space
+ (fun ppf x -> Fmt.pp_doc ppf x.Location.txt)
+ ppf before in
+ ctx
+
+let subcase_list l ppf = match l with
+ | [] -> ()
+ | _ :: _ ->
+ let pp_msg ppf lmsg = Fmt.pp_doc ppf lmsg.Location.txt in
+ Fmt.fprintf ppf "@;<1 -2>@[%a@]"
+ (Fmt.pp_print_list ~pp_sep:space pp_msg)
+ (List.rev l)
+
+(* Printers for leaves *)
+let core env id x =
+ match x with
+ | Err.Value_descriptions diff ->
+ Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
+ "Values do not match"
+ !Oprint.out_sig_item
+ (Out_type.tree_of_value_description id diff.got)
+ "is not included in"
+ !Oprint.out_sig_item
+ (Out_type.tree_of_value_description id diff.expected)
+ (Includecore.report_value_mismatch
+ "the first" "the second" env) diff.symptom
+ show_locs (diff.got.val_loc, diff.expected.val_loc)
+ | Err.Type_declarations diff ->
+ Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
+ "Type declarations do not match"
+ !Oprint.out_sig_item
+ (Out_type.tree_of_type_declaration id diff.got Trec_first)
+ "is not included in"
+ !Oprint.out_sig_item
+ (Out_type.tree_of_type_declaration id diff.expected Trec_first)
+ (Includecore.report_type_mismatch
+ "the first" "the second" "declaration" env) diff.symptom
+ show_locs (diff.got.type_loc, diff.expected.type_loc)
+ | Err.Extension_constructors diff ->
+ Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a@]"
+ "Extension declarations do not match"
+ !Oprint.out_sig_item
+ (Out_type.tree_of_extension_constructor id diff.got Text_first)
+ "is not included in"
+ !Oprint.out_sig_item
+ (Out_type.tree_of_extension_constructor id diff.expected Text_first)
+ (Includecore.report_extension_constructor_mismatch
+ "the first" "the second" "declaration" env) diff.symptom
+ show_locs (diff.got.ext_loc, diff.expected.ext_loc)
+ | Err.Class_type_declarations diff ->
+ Fmt.dprintf
+ "@[<hv 2>Class type declarations do not match:@ \
+ %a@;<1 -2>does not match@ %a@]@ %a"
+ !Oprint.out_sig_item
+ (Out_type.tree_of_cltype_declaration id diff.got Trec_first)
+ !Oprint.out_sig_item
+ (Out_type.tree_of_cltype_declaration id diff.expected Trec_first)
+ (Includeclass.report_error_doc Type_scheme) diff.symptom
+ | Err.Class_declarations {got;expected;symptom} ->
+ let t1 = Out_type.tree_of_class_declaration id got Trec_first in
+ let t2 = Out_type.tree_of_class_declaration id expected Trec_first in
+ Fmt.dprintf
+ "@[<hv 2>Class declarations do not match:@ \
+ %a@;<1 -2>does not match@ %a@]@ %a"
+ !Oprint.out_sig_item t1
+ !Oprint.out_sig_item t2
+ (Includeclass.report_error_doc Type_scheme) symptom
+
+let missing_field ppf item =
+ let id, loc, kind = Includemod.item_ident_name item in
+ Fmt.fprintf ppf "The %s %a is required but not provided%a"
+ (Includemod.kind_of_field_desc kind)
+ (Style.as_inline_code Printtyp.ident) id
+ (show_loc "Expected declaration") loc
+
+let module_types {Err.got=mty1; expected=mty2} =
+ Fmt.dprintf
+ "@[<hv 2>Modules do not match:@ \
+ %a@;<1 -2>is not included in@ %a@]"
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty1)
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty2)
+
+let eq_module_types {Err.got=mty1; expected=mty2} =
+ Fmt.dprintf
+ "@[<hv 2>Module types do not match:@ \
+ %a@;<1 -2>is not equal to@ %a@]"
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty1)
+ !Oprint.out_module_type (Out_type.tree_of_modtype mty2)
+
+let module_type_declarations id {Err.got=d1 ; expected=d2} =
+ Fmt.dprintf
+ "@[<hv 2>Module type declarations do not match:@ \
+ %a@;<1 -2>does not match@ %a@]"
+ !Oprint.out_sig_item (Out_type.tree_of_modtype_declaration id d1)
+ !Oprint.out_sig_item (Out_type.tree_of_modtype_declaration id d2)
+
+let interface_mismatch ppf (diff: _ Err.diff) =
+ Fmt.fprintf ppf
+ "The implementation %a@ does not match the interface %a:@ "
+ Style.inline_code diff.got Style.inline_code diff.expected
+
+let core_module_type_symptom (x:Err.core_module_type_symptom) =
+ match x with
+ | Not_an_alias | Not_an_identifier | Abstract_module_type
+ | Incompatible_aliases -> None
+ | Unbound_module_path path ->
+ Some(Fmt.dprintf "Unbound module %a"
+ (Style.as_inline_code Printtyp.path) path
+ )
+
+(* Construct a linearized error message from the error tree *)
+
+let rec module_type ~expansion_token ~eqmode ~env ~before ~ctx diff =
+ match diff.symptom with
+ | Invalid_module_alias _ (* the difference is non-informative here *)
+ | After_alias_expansion _ (* we print only the expanded module types *) ->
+ module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx
+ diff.symptom
+ | Functor Params d -> (* We jump directly to the functor param error *)
+ functor_params ~expansion_token ~env ~before ~ctx d
+ | _ ->
+ let inner = if eqmode then eq_module_types else module_types in
+ let next =
+ match diff.symptom with
+ | Mt_core _ ->
+ (* In those cases, the refined error messages for the current error
+ will at most add some minor comments on the current error.
+ It is thus better to avoid eliding the current error message.
+ *)
+ dwith_context ctx (inner diff)
+ | _ -> dwith_context_and_elision ctx inner diff
+ in
+ let before = next :: before in
+ module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx
+ diff.symptom
+
+and module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx = function
+ | Mt_core core ->
+ begin match core_module_type_symptom core with
+ | None -> before
+ | Some msg -> Location.msg "%t" msg :: before
+ end
+ | Signature s -> signature ~expansion_token ~env ~before ~ctx s
+ | Functor f -> functor_symptom ~expansion_token ~env ~before ~ctx f
+ | After_alias_expansion diff ->
+ module_type ~eqmode ~expansion_token ~env ~before ~ctx diff
+ | Invalid_module_alias path ->
+ let printer =
+ Fmt.dprintf "Module %a cannot be aliased"
+ (Style.as_inline_code Printtyp.path) path
+ in
+ dwith_context ctx printer :: before
+
+and functor_params ~expansion_token ~env ~before ~ctx {got;expected;_} =
+ let d = Functor_suberror.Inclusion.patch env got expected in
+ let actual = Functor_suberror.Inclusion.got d in
+ let expected = Functor_suberror.expected d in
+ let main =
+ Fmt.dprintf
+ "@[<hv 2>Modules do not match:@ \
+ @[%t@ -> ...@]@;<1 -2>is not included in@ \
+ @[%t@ -> ...@]@]"
+ actual expected
+ in
+ let msgs = dwith_context ctx main :: before in
+ let functor_suberrors =
+ if expansion_token then
+ Functor_suberror.params functor_arg_diff ~expansion_token env d
+ else []
+ in
+ functor_suberrors @ msgs
+
+and functor_symptom ~expansion_token ~env ~before ~ctx = function
+ | Result res ->
+ module_type ~expansion_token ~eqmode:false ~env ~before ~ctx res
+ | Params d -> functor_params ~expansion_token ~env ~before ~ctx d
+
+and signature ~expansion_token ~env:_ ~before ~ctx sgs =
+ Printtyp.wrap_printing_env ~error:true sgs.env (fun () ->
+ match sgs.missings, sgs.incompatibles with
+ | _ :: _ as missings, _ ->
+ if expansion_token then
+ let init_missings, last_missing = Misc.split_last missings in
+ List.map (Location.msg "%a" missing_field) init_missings
+ @ with_context ctx missing_field last_missing
+ :: before
+ else
+ before
+ | [], a :: _ -> sigitem ~expansion_token ~env:sgs.env ~before ~ctx a
+ | [], [] -> assert false
+ )
+and sigitem ~expansion_token ~env ~before ~ctx (name,s) = match s with
+ | Core c ->
+ dwith_context ctx (core env name c) :: before
+ | Module_type diff ->
+ module_type ~expansion_token ~eqmode:false ~env ~before
+ ~ctx:(Context.Module name :: ctx) diff
+ | Module_type_declaration diff ->
+ module_type_decl ~expansion_token ~env ~before ~ctx name diff
+and module_type_decl ~expansion_token ~env ~before ~ctx id diff =
+ let next =
+ dwith_context_and_elision ctx (module_type_declarations id) diff in
+ let before = next :: before in
+ match diff.symptom with
+ | Not_less_than mts ->
+ let before =
+ Location.msg "The first module type is not included in the second"
+ :: before
+ in
+ module_type ~expansion_token ~eqmode:true ~before ~env
+ ~ctx:(Context.Modtype id :: ctx) mts
+ | Not_greater_than mts ->
+ let before =
+ Location.msg "The second module type is not included in the first"
+ :: before in
+ module_type ~expansion_token ~eqmode:true ~before ~env
+ ~ctx:(Context.Modtype id :: ctx) mts
+ | Incomparable mts ->
+ module_type ~expansion_token ~eqmode:true ~env ~before
+ ~ctx:(Context.Modtype id :: ctx) mts.less_than
+ | Illegal_permutation c ->
+ begin match diff.got.Types.mtd_type with
+ | None -> assert false
+ | Some mty ->
+ with_context (Modtype id::ctx)
+ (Runtime_coercion.illegal_permutation Context.alt_pp env) (mty,c)
+ :: before
+ end
+
+and functor_arg_diff ~expansion_token env (patch: _ Diffing.change) =
+ match patch with
+ | Insert mty -> Functor_suberror.Inclusion.insert mty
+ | Delete mty -> Functor_suberror.Inclusion.delete mty
+ | Keep (x, y, _) -> Functor_suberror.Inclusion.ok x y
+ | Change (_, _, Err.Incompatible_params (i,_)) ->
+ Functor_suberror.Inclusion.incompatible i
+ | Change (g, e, Err.Mismatch mty_diff) ->
+ let more () =
+ subcase_list @@
+ module_type_symptom ~eqmode:false ~expansion_token ~env ~before:[]
+ ~ctx:[] mty_diff.symptom
+ in
+ Functor_suberror.Inclusion.diff g e more
+
+let functor_app_diff ~expansion_token env (patch: _ Diffing.change) =
+ match patch with
+ | Insert mty -> Functor_suberror.App.insert mty
+ | Delete mty -> Functor_suberror.App.delete mty
+ | Keep (x, y, _) -> Functor_suberror.App.ok x y
+ | Change (_, _, Err.Incompatible_params (i,_)) ->
+ Functor_suberror.App.incompatible i
+ | Change (g, e, Err.Mismatch mty_diff) ->
+ let more () =
+ subcase_list @@
+ module_type_symptom ~eqmode:false ~expansion_token ~env ~before:[]
+ ~ctx:[] mty_diff.symptom
+ in
+ Functor_suberror.App.diff g e more
+
+let module_type_subst ~env id diff =
+ match diff.symptom with
+ | Not_less_than mts ->
+ module_type ~expansion_token:true ~eqmode:true ~before:[] ~env
+ ~ctx:[Modtype id] mts
+ | Not_greater_than mts ->
+ module_type ~expansion_token:true ~eqmode:true ~before:[] ~env
+ ~ctx:[Modtype id] mts
+ | Incomparable mts ->
+ module_type ~expansion_token:true ~eqmode:true ~env ~before:[]
+ ~ctx:[Modtype id] mts.less_than
+ | Illegal_permutation c ->
+ let mty = diff.got in
+ let main =
+ with_context [Modtype id]
+ (Runtime_coercion.illegal_permutation Context.alt_pp env) (mty,c) in
+ [main]
+
+let all env = function
+ | In_Compilation_unit diff ->
+ let first = Location.msg "%a" interface_mismatch diff in
+ signature ~expansion_token:true ~env ~before:[first] ~ctx:[] diff.symptom
+ | In_Type_declaration (id,reason) ->
+ [Location.msg "%t" (core env id reason)]
+ | In_Module_type diff ->
+ module_type ~expansion_token:true ~eqmode:false ~before:[] ~env ~ctx:[]
+ diff
+ | In_Module_type_substitution (id,diff) ->
+ module_type_subst ~env id diff
+ | In_Signature diff ->
+ signature ~expansion_token:true ~before:[] ~env ~ctx:[] diff
+ | In_Expansion cmts ->
+ match core_module_type_symptom cmts with
+ | None -> assert false
+ | Some main -> [Location.msg "%t" main]
+
+(* General error reporting *)
+
+let err_msgs ppf (env, err) =
+ Printtyp.wrap_printing_env ~error:true env
+ (fun () -> (coalesce @@ all env err) ppf)
+
+let report_error_doc err =
+ Location.errorf
+ ~loc:Location.(in_file !input_name)
+ ~footnote:Out_type.Ident_conflicts.err_msg
+ "%a" err_msgs err
+
+let report_apply_error_doc ~loc env (app_name, mty_f, args) =
+ let footnote = Out_type.Ident_conflicts.err_msg in
+ let d = Functor_suberror.App.patch env ~f:mty_f ~args in
+ match d with
+ (* We specialize the one change and one argument case to remove the
+ presentation of the functor arguments *)
+ | [ _, Change (_, _, Err.Incompatible_params (i,_)) ] ->
+ Location.errorf ~loc ~footnote "%t" (Functor_suberror.App.incompatible i)
+ | [ _, Change (g, e, Err.Mismatch mty_diff) ] ->
+ let more () =
+ subcase_list @@
+ module_type_symptom ~eqmode:false ~expansion_token:true ~env ~before:[]
+ ~ctx:[] mty_diff.symptom
+ in
+ Location.errorf ~loc ~footnote "%t"
+ (Functor_suberror.App.single_diff g e more)
+ | _ ->
+ let not_functor =
+ List.for_all (function _, Diffing.Delete _ -> true | _ -> false) d
+ in
+ if not_functor then
+ match app_name with
+ | Includemod.Named_leftmost_functor lid ->
+ Location.errorf ~loc
+ "@[The module %a is not a functor, it cannot be applied.@]"
+ (Style.as_inline_code Printtyp.longident) lid
+ | Includemod.Anonymous_functor
+ | Includemod.Full_application_path _
+ (* The "non-functor application in term" case is directly handled in
+ [Env] and it is the only case where we have a full application
+ path at hand. Thus this case of the or-pattern is currently
+ unreachable and we don't try to specialize the corresponding error
+ message. *) ->
+ Location.errorf ~loc
+ "@[This module is not a functor, it cannot be applied.@]"
+ else
+ let intro ppf =
+ match app_name with
+ | Includemod.Anonymous_functor ->
+ Fmt.fprintf ppf "This functor application is ill-typed."
+ | Includemod.Full_application_path lid ->
+ Fmt.fprintf ppf "The functor application %a is ill-typed."
+ (Style.as_inline_code Printtyp.longident) lid
+ | Includemod.Named_leftmost_functor lid ->
+ Fmt.fprintf ppf
+ "This application of the functor %a is ill-typed."
+ (Style.as_inline_code Printtyp.longident) lid
+ in
+ let actual = Functor_suberror.App.got d in
+ let expected = Functor_suberror.expected d in
+ let sub =
+ List.rev @@
+ Functor_suberror.params functor_app_diff env ~expansion_token:true d
+ in
+ Location.errorf ~loc ~sub ~footnote
+ "@[<hv>%t@ \
+ These arguments:@;<1 2>@[%t@]@ \
+ do not match these parameters:@;<1 2>@[%t@ -> ...@]@]"
+ intro
+ actual expected
+
+let coercion_in_package_subtype env mty c =
+ Format_doc.doc_printf "%t" @@
+ Runtime_coercion.in_package_subtype Context.alt_pp env mty c
+
+let register () =
+ Location.register_error_of_exn
+ (function
+ | Includemod.Error err -> Some (report_error_doc err)
+ | Includemod.Apply_error {loc; env; app_name; mty_f; args} ->
+ Some (Printtyp.wrap_printing_env env ~error:true (fun () ->
+ report_apply_error_doc ~loc env (app_name, mty_f, args))
+ )
+ | _ -> None
+ )
diff --git a/upstream/ocaml_503/typing/includemod_errorprinter.mli b/upstream/ocaml_503/typing/includemod_errorprinter.mli
new file mode 100644
index 0000000000..0c7dda4e56
--- /dev/null
+++ b/upstream/ocaml_503/typing/includemod_errorprinter.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+val err_msgs: Includemod.explanation Format_doc.printer
+val coercion_in_package_subtype:
+ Env.t -> Types.module_type -> Typedtree.module_coercion -> Format_doc.doc
+val register: unit -> unit
diff --git a/upstream/ocaml_503/typing/mtype.ml b/upstream/ocaml_503/typing/mtype.ml
new file mode 100644
index 0000000000..499d85ca11
--- /dev/null
+++ b/upstream/ocaml_503/typing/mtype.ml
@@ -0,0 +1,569 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Operations on module types *)
+
+open Asttypes
+open Path
+open Types
+
+let rec scrape_lazy env mty =
+ let open Subst.Lazy in
+ match mty with
+ MtyL_ident p ->
+ begin try
+ scrape_lazy env (Env.find_modtype_expansion_lazy p env)
+ with Not_found ->
+ mty
+ end
+ | _ -> mty
+
+let scrape env mty =
+ match mty with
+ Mty_ident p ->
+ Subst.Lazy.force_modtype (scrape_lazy env (MtyL_ident p))
+ | _ -> mty
+
+let freshen ~scope mty =
+ Subst.modtype (Rescope scope) Subst.identity mty
+
+let rec strengthen_lazy ~aliasable env mty p =
+ let open Subst.Lazy in
+ match scrape_lazy env mty with
+ MtyL_signature sg ->
+ MtyL_signature(strengthen_lazy_sig ~aliasable env sg p)
+ | MtyL_functor(Named (Some param, arg), res)
+ when !Clflags.applicative_functors ->
+ let env =
+ Env.add_module_lazy ~update_summary:false param Mp_present arg env
+ in
+ MtyL_functor(Named (Some param, arg),
+ strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
+ | MtyL_functor(Named (None, arg), res)
+ when !Clflags.applicative_functors ->
+ let param = Ident.create_scoped ~scope:(Path.scope p) "Arg" in
+ MtyL_functor(Named (Some param, arg),
+ strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
+ | mty ->
+ mty
+
+and strengthen_lazy_sig' ~aliasable env sg p =
+ let open Subst.Lazy in
+ match sg with
+ [] -> []
+ | (SigL_value(_, _, _) as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+ | SigL_type(id, {type_kind=Type_abstract _}, _, _) :: rem
+ when Btype.is_row_name (Ident.name id) ->
+ strengthen_lazy_sig' ~aliasable env rem p
+ | SigL_type(id, decl, rs, vis) :: rem ->
+ let newdecl =
+ match decl.type_manifest, decl.type_private, decl.type_kind with
+ Some _, Public, _ -> decl
+ | Some _, Private, (Type_record _ | Type_variant _) -> decl
+ | _ ->
+ let manif =
+ Some(Btype.newgenty(Tconstr(Pdot(p, Ident.name id),
+ decl.type_params, ref Mnil))) in
+ if Btype.type_kind_is_abstract decl then
+ { decl with type_private = Public; type_manifest = manif }
+ else
+ { decl with type_manifest = manif }
+ in
+ SigL_type(id, newdecl, rs, vis) ::
+ strengthen_lazy_sig' ~aliasable env rem p
+ | (SigL_typext _ as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+ | SigL_module(id, pres, md, rs, vis) :: rem ->
+ let str =
+ strengthen_lazy_decl ~aliasable env md (Pdot(p, Ident.name id))
+ in
+ let env =
+ Env.add_module_declaration_lazy ~update_summary:false id pres md env in
+ SigL_module(id, pres, str, rs, vis)
+ :: strengthen_lazy_sig' ~aliasable env rem p
+ (* Need to add the module in case it defines manifest module types *)
+ | SigL_modtype(id, decl, vis) :: rem ->
+ let newdecl =
+ match decl.mtdl_type with
+ | Some _ when not aliasable ->
+ (* [not alisable] condition needed because of recursive modules.
+ See [Typemod.check_recmodule_inclusion]. *)
+ decl
+ | _ ->
+ {decl with mtdl_type = Some(MtyL_ident(Pdot(p,Ident.name id)))}
+ in
+ let env = Env.add_modtype_lazy ~update_summary:false id decl env in
+ SigL_modtype(id, newdecl, vis) ::
+ strengthen_lazy_sig' ~aliasable env rem p
+ (* Need to add the module type in case it is manifest *)
+ | (SigL_class _ as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+ | (SigL_class_type _ as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+
+and strengthen_lazy_sig ~aliasable env sg p =
+ let sg = Subst.Lazy.force_signature_once sg in
+ let sg = strengthen_lazy_sig' ~aliasable env sg p in
+ Subst.Lazy.of_signature_items sg
+
+and strengthen_lazy_decl ~aliasable env md p =
+ let open Subst.Lazy in
+ match md.mdl_type with
+ | MtyL_alias _ -> md
+ | _ when aliasable -> {md with mdl_type = MtyL_alias p}
+ | mty -> {md with mdl_type = strengthen_lazy ~aliasable env mty p}
+
+let () = Env.strengthen := strengthen_lazy
+
+let strengthen ~aliasable env mty p =
+ let mty = strengthen_lazy ~aliasable env (Subst.Lazy.of_modtype mty) p in
+ Subst.Lazy.force_modtype mty
+
+let strengthen_decl ~aliasable env md p =
+ let md = strengthen_lazy_decl ~aliasable env
+ (Subst.Lazy.of_module_decl md) p in
+ Subst.Lazy.force_module_decl md
+
+let rec make_aliases_absent pres mty =
+ match mty with
+ | Mty_alias _ -> Mp_absent, mty
+ | Mty_signature sg ->
+ pres, Mty_signature(make_aliases_absent_sig sg)
+ | Mty_functor(arg, res) ->
+ let _, res = make_aliases_absent Mp_present res in
+ pres, Mty_functor(arg, res)
+ | mty ->
+ pres, mty
+
+and make_aliases_absent_sig sg =
+ match sg with
+ [] -> []
+ | Sig_module(id, pres, md, rs, priv) :: rem ->
+ let pres, md_type = make_aliases_absent pres md.md_type in
+ let md = { md with md_type } in
+ Sig_module(id, pres, md, rs, priv) :: make_aliases_absent_sig rem
+ | sigelt :: rem ->
+ sigelt :: make_aliases_absent_sig rem
+
+let scrape_for_type_of env pres mty =
+ let rec loop env path mty =
+ match mty, path with
+ | Mty_alias path, _ -> begin
+ try
+ let md = Env.find_module path env in
+ loop env (Some path) md.md_type
+ with Not_found -> mty
+ end
+ | mty, Some path ->
+ strengthen ~aliasable:false env mty path
+ | _ -> mty
+ in
+ make_aliases_absent pres (loop env None mty)
+
+(* In nondep_supertype, env is only used for the type it assigns to id.
+ Hence there is no need to keep env up-to-date by adding the bindings
+ traversed. *)
+
+type variance = Co | Contra | Strict
+
+let rec nondep_mty_with_presence env va ids pres mty =
+ match mty with
+ Mty_ident p ->
+ begin match Path.find_free_opt ids p with
+ | Some id ->
+ let expansion =
+ try Env.find_modtype_expansion p env
+ with Not_found ->
+ raise (Ctype.Nondep_cannot_erase id)
+ in
+ nondep_mty_with_presence env va ids pres expansion
+ | None -> pres, mty
+ end
+ | Mty_alias p ->
+ begin match Path.find_free_opt ids p with
+ | Some id ->
+ let expansion =
+ try Env.find_module p env
+ with Not_found ->
+ raise (Ctype.Nondep_cannot_erase id)
+ in
+ nondep_mty_with_presence env va ids Mp_present expansion.md_type
+ | None -> pres, mty
+ end
+ | Mty_signature sg ->
+ let mty = Mty_signature(nondep_sig env va ids sg) in
+ pres, mty
+ | Mty_functor(Unit, res) ->
+ pres, Mty_functor(Unit, nondep_mty env va ids res)
+ | Mty_functor(Named (param, arg), res) ->
+ let var_inv =
+ match va with Co -> Contra | Contra -> Co | Strict -> Strict in
+ let res_env =
+ match param with
+ | None -> env
+ | Some param -> Env.add_module ~arg:true param Mp_present arg env
+ in
+ let mty =
+ Mty_functor(Named (param, nondep_mty env var_inv ids arg),
+ nondep_mty res_env va ids res)
+ in
+ pres, mty
+
+and nondep_mty env va ids mty =
+ snd (nondep_mty_with_presence env va ids Mp_present mty)
+
+and nondep_sig_item env va ids = function
+ | Sig_value(id, d, vis) ->
+ Sig_value(id,
+ {d with val_type = Ctype.nondep_type env ids d.val_type},
+ vis)
+ | Sig_type(id, d, rs, vis) ->
+ Sig_type(id, Ctype.nondep_type_decl env ids (va = Co) d, rs, vis)
+ | Sig_typext(id, ext, es, vis) ->
+ Sig_typext(id, Ctype.nondep_extension_constructor env ids ext, es, vis)
+ | Sig_module(id, pres, md, rs, vis) ->
+ let pres, mty = nondep_mty_with_presence env va ids pres md.md_type in
+ Sig_module(id, pres, {md with md_type = mty}, rs, vis)
+ | Sig_modtype(id, d, vis) ->
+ begin try
+ Sig_modtype(id, nondep_modtype_decl env ids d, vis)
+ with Ctype.Nondep_cannot_erase _ as exn ->
+ match va with
+ Co -> Sig_modtype(id, {mtd_type=None; mtd_loc=Location.none;
+ mtd_attributes=[]; mtd_uid = d.mtd_uid}, vis)
+ | _ -> raise exn
+ end
+ | Sig_class(id, d, rs, vis) ->
+ Sig_class(id, Ctype.nondep_class_declaration env ids d, rs, vis)
+ | Sig_class_type(id, d, rs, vis) ->
+ Sig_class_type(id, Ctype.nondep_cltype_declaration env ids d, rs, vis)
+
+and nondep_sig env va ids sg =
+ let scope = Ctype.create_scope () in
+ let sg, env = Env.enter_signature ~scope sg env in
+ List.map (nondep_sig_item env va ids) sg
+
+and nondep_modtype_decl env ids mtd =
+ {mtd with mtd_type = Option.map (nondep_mty env Strict ids) mtd.mtd_type}
+
+let nondep_supertype env ids = nondep_mty env Co ids
+let nondep_sig_item env ids = nondep_sig_item env Co ids
+
+let enrich_typedecl env p id decl =
+ match decl.type_manifest with
+ Some _ -> decl
+ | None ->
+ match Env.find_type p env with
+ | exception Not_found -> decl
+ (* Type which was not present in the signature, so we don't have
+ anything to do. *)
+ | orig_decl ->
+ if decl.type_arity <> orig_decl.type_arity then
+ decl
+ else begin
+ let orig_ty =
+ Ctype.reify_univars env
+ (Btype.newgenty(Tconstr(p, orig_decl.type_params, ref Mnil)))
+ in
+ let new_ty =
+ Ctype.reify_univars env
+ (Btype.newgenty(Tconstr(Pident id, decl.type_params, ref Mnil)))
+ in
+ let env = Env.add_type ~check:false id decl env in
+ match Ctype.mcomp env orig_ty new_ty with
+ | exception Ctype.Incompatible -> decl
+ (* The current declaration is not compatible with the one we got
+ from the signature. We should just fail now, but then, we could
+ also have failed if the arities of the two decls were
+ different, which we didn't. *)
+ | () ->
+ let orig_ty =
+ Btype.newgenty(Tconstr(p, decl.type_params, ref Mnil))
+ in
+ {decl with type_manifest = Some orig_ty}
+ end
+
+let rec enrich_modtype env p mty =
+ match mty with
+ Mty_signature sg ->
+ Mty_signature(List.map (enrich_item env p) sg)
+ | _ ->
+ mty
+
+and enrich_item env p = function
+ Sig_type(id, decl, rs, priv) ->
+ Sig_type(id,
+ enrich_typedecl env (Pdot(p, Ident.name id)) id decl, rs, priv)
+ | Sig_module(id, pres, md, rs, priv) ->
+ Sig_module(id, pres,
+ {md with
+ md_type = enrich_modtype env
+ (Pdot(p, Ident.name id)) md.md_type},
+ rs,
+ priv)
+ | item -> item
+
+let rec type_paths env p mty =
+ match scrape env mty with
+ Mty_ident _ -> []
+ | Mty_alias _ -> []
+ | Mty_signature sg -> type_paths_sig env p sg
+ | Mty_functor _ -> []
+
+and type_paths_sig env p sg =
+ match sg with
+ [] -> []
+ | Sig_type(id, _decl, _, _) :: rem ->
+ Pdot(p, Ident.name id) :: type_paths_sig env p rem
+ | Sig_module(id, pres, md, _, _) :: rem ->
+ type_paths env (Pdot(p, Ident.name id)) md.md_type @
+ type_paths_sig (Env.add_module_declaration ~check:false id pres md env)
+ p rem
+ | Sig_modtype(id, decl, _) :: rem ->
+ type_paths_sig (Env.add_modtype id decl env) p rem
+ | (Sig_value _ | Sig_typext _ | Sig_class _ | Sig_class_type _) :: rem ->
+ type_paths_sig env p rem
+
+
+let rec no_code_needed_mod env pres mty =
+ match pres with
+ | Mp_absent -> true
+ | Mp_present -> begin
+ match scrape env mty with
+ Mty_ident _ -> false
+ | Mty_signature sg -> no_code_needed_sig env sg
+ | Mty_functor _ -> false
+ | Mty_alias _ -> false
+ end
+
+and no_code_needed_sig env sg =
+ match sg with
+ [] -> true
+ | Sig_value(_id, decl, _) :: rem ->
+ begin match decl.val_kind with
+ | Val_prim _ -> no_code_needed_sig env rem
+ | _ -> false
+ end
+ | Sig_module(id, pres, md, _, _) :: rem ->
+ no_code_needed_mod env pres md.md_type &&
+ no_code_needed_sig
+ (Env.add_module_declaration ~check:false id pres md env) rem
+ | (Sig_type _ | Sig_modtype _ | Sig_class_type _) :: rem ->
+ no_code_needed_sig env rem
+ | (Sig_typext _ | Sig_class _) :: _ ->
+ false
+
+let no_code_needed env mty = no_code_needed_mod env Mp_present mty
+
+(* Check whether a module type may return types *)
+
+let rec contains_type env = function
+ Mty_ident path ->
+ begin try match (Env.find_modtype path env).mtd_type with
+ | None -> raise Exit (* PR#6427 *)
+ | Some mty -> contains_type env mty
+ with Not_found -> raise Exit
+ end
+ | Mty_signature sg ->
+ contains_type_sig env sg
+ | Mty_functor (_, body) ->
+ contains_type env body
+ | Mty_alias _ ->
+ ()
+
+and contains_type_sig env = List.iter (contains_type_item env)
+
+and contains_type_item env = function
+ Sig_type (_,({type_manifest = None} |
+ {type_kind = Type_abstract _; type_private = Private}),_, _)
+ | Sig_modtype _
+ | Sig_typext (_, {ext_args = Cstr_record _}, _, _) ->
+ (* We consider that extension constructors with an inlined
+ record create a type (the inlined record), even though
+ it would be technically safe to ignore that considering
+ the current constraints which guarantee that this type
+ is kept local to expressions. *)
+ raise Exit
+ | Sig_module (_, _, {md_type = mty}, _, _) ->
+ contains_type env mty
+ | Sig_value _
+ | Sig_type _
+ | Sig_typext _
+ | Sig_class _
+ | Sig_class_type _ ->
+ ()
+
+let contains_type env mty =
+ try contains_type env mty; false with Exit -> true
+
+
+(* Remove module aliases from a signature *)
+
+let rec get_prefixes = function
+ | Pident _ -> Path.Set.empty
+ | Pdot (p, _) | Papply (p, _) | Pextra_ty (p, _)
+ -> Path.Set.add p (get_prefixes p)
+
+let rec get_arg_paths = function
+ | Pident _ -> Path.Set.empty
+ | Pdot (p, _) | Pextra_ty (p, _) -> get_arg_paths p
+ | Papply (p1, p2) ->
+ Path.Set.add p2
+ (Path.Set.union (get_prefixes p2)
+ (Path.Set.union (get_arg_paths p1) (get_arg_paths p2)))
+
+let rec rollback_path subst p =
+ try Pident (Path.Map.find p subst)
+ with Not_found ->
+ match p with
+ Pident _ | Papply _ -> p
+ | Pdot (p1, s) ->
+ let p1' = rollback_path subst p1 in
+ if Path.same p1 p1' then p else rollback_path subst (Pdot (p1', s))
+ | Pextra_ty (p1, extra) ->
+ let p1' = rollback_path subst p1 in
+ if Path.same p1 p1' then p
+ else rollback_path subst (Pextra_ty (p1', extra))
+
+let rec collect_ids subst bindings p =
+ begin match rollback_path subst p with
+ Pident id ->
+ let ids =
+ try collect_ids subst bindings (Ident.find_same id bindings)
+ with Not_found -> Ident.Set.empty
+ in
+ Ident.Set.add id ids
+ | _ -> Ident.Set.empty
+ end
+
+let collect_arg_paths mty =
+ let open Btype in
+ let paths = ref Path.Set.empty
+ and subst = ref Path.Map.empty
+ and bindings = ref Ident.empty in
+ (* let rt = Ident.create "Root" in
+ and prefix = ref (Path.Pident rt) in *)
+ with_type_mark begin fun mark ->
+ let super = type_iterators mark in
+ let it_path p = paths := Path.Set.union (get_arg_paths p) !paths
+ and it_signature_item it si =
+ super.it_signature_item it si;
+ match si with
+ | Sig_module (id, _, {md_type=Mty_alias p}, _, _) ->
+ bindings := Ident.add id p !bindings
+ | Sig_module (id, _, {md_type=Mty_signature sg}, _, _) ->
+ List.iter
+ (function Sig_module (id', _, _, _, _) ->
+ subst :=
+ Path.Map.add (Pdot (Pident id, Ident.name id')) id' !subst
+ | _ -> ())
+ sg
+ | _ -> ()
+ in
+ let it = {super with it_path; it_signature_item} in
+ it.it_module_type it mty;
+ Path.Set.fold (fun p -> Ident.Set.union (collect_ids !subst !bindings p))
+ !paths Ident.Set.empty
+ end
+
+type remove_alias_args =
+ { mutable modified: bool;
+ exclude: Ident.t -> Path.t -> bool;
+ scrape: Env.t -> module_type -> module_type }
+
+let rec remove_aliases_mty env args pres mty =
+ let args' = {args with modified = false} in
+ let res =
+ match args.scrape env mty with
+ Mty_signature sg ->
+ Mp_present, Mty_signature (remove_aliases_sig env args' sg)
+ | Mty_alias _ ->
+ let mty' = Env.scrape_alias env mty in
+ if mty' = mty then begin
+ pres, mty
+ end else begin
+ args'.modified <- true;
+ remove_aliases_mty env args' Mp_present mty'
+ end
+ | mty ->
+ Mp_present, mty
+ in
+ if args'.modified then begin
+ args.modified <- true;
+ res
+ end else begin
+ pres, mty
+ end
+
+and remove_aliases_sig env args sg =
+ match sg with
+ [] -> []
+ | Sig_module(id, pres, md, rs, priv) :: rem ->
+ let pres, mty =
+ match md.md_type with
+ Mty_alias p when args.exclude id p ->
+ pres, md.md_type
+ | mty ->
+ remove_aliases_mty env args pres mty
+ in
+ Sig_module(id, pres, {md with md_type = mty} , rs, priv) ::
+ remove_aliases_sig (Env.add_module id pres mty env) args rem
+ | Sig_modtype(id, mtd, priv) :: rem ->
+ Sig_modtype(id, mtd, priv) ::
+ remove_aliases_sig (Env.add_modtype id mtd env) args rem
+ | it :: rem ->
+ it :: remove_aliases_sig env args rem
+
+let scrape_for_functor_arg env mty =
+ let exclude _id p =
+ try ignore (Env.find_module p env); true with Not_found -> false
+ in
+ let _, mty =
+ remove_aliases_mty env {modified=false; exclude; scrape} Mp_present mty
+ in
+ mty
+
+let scrape_for_type_of ~remove_aliases env mty =
+ if remove_aliases then begin
+ let excl = collect_arg_paths mty in
+ let exclude id _p = Ident.Set.mem id excl in
+ let scrape _ mty = mty in
+ let _, mty =
+ remove_aliases_mty env {modified=false; exclude; scrape} Mp_present mty
+ in
+ mty
+ end else begin
+ let _, mty = scrape_for_type_of env Mp_present mty in
+ mty
+ end
+
+(* Lower non-generalizable type variables *)
+
+let lower_nongen nglev mty =
+ let open Btype in
+ with_type_mark begin fun mark ->
+ let super = type_iterators mark in
+ let it_do_type_expr it ty =
+ match get_desc ty with
+ Tvar _ ->
+ let level = get_level ty in
+ if level < generic_level && level > nglev then set_level ty nglev
+ | _ ->
+ super.it_do_type_expr it ty
+ in
+ let it = {super with it_do_type_expr} in
+ it.it_module_type it mty
+ end
diff --git a/upstream/ocaml_503/typing/mtype.mli b/upstream/ocaml_503/typing/mtype.mli
new file mode 100644
index 0000000000..68d290b36f
--- /dev/null
+++ b/upstream/ocaml_503/typing/mtype.mli
@@ -0,0 +1,55 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Operations on module types *)
+
+open Types
+
+val scrape: Env.t -> module_type -> module_type
+ (* Expand toplevel module type abbreviations
+ till hitting a "hard" module type (signature, functor,
+ or abstract module type ident. *)
+val scrape_for_functor_arg: Env.t -> module_type -> module_type
+ (* Remove aliases in a functor argument type *)
+val scrape_for_type_of:
+ remove_aliases:bool -> Env.t -> module_type -> module_type
+ (* Process type for module type of *)
+val freshen: scope:int -> module_type -> module_type
+ (* Return an alpha-equivalent copy of the given module type
+ where bound identifiers are fresh. *)
+val strengthen: aliasable:bool -> Env.t -> module_type -> Path.t -> module_type
+ (* Strengthen abstract type components relative to the
+ given path. *)
+val strengthen_decl:
+ aliasable:bool -> Env.t -> module_declaration -> Path.t -> module_declaration
+val nondep_supertype: Env.t -> Ident.t list -> module_type -> module_type
+ (* Return the smallest supertype of the given type
+ in which none of the given idents appears.
+ @raise [Ctype.Nondep_cannot_erase] if no such type exists. *)
+val nondep_sig_item: Env.t -> Ident.t list -> signature_item -> signature_item
+ (* Returns the signature item with its type updated
+ to be the smallest supertype of its initial type
+ in which none of the given idents appears.
+ @raise [Ctype.Nondep_cannot_erase] if no such type exists. *)
+val no_code_needed: Env.t -> module_type -> bool
+val no_code_needed_sig: Env.t -> signature -> bool
+ (* Determine whether a module needs no implementation code,
+ i.e. consists only of type definitions. *)
+val enrich_modtype: Env.t -> Path.t -> module_type -> module_type
+val enrich_typedecl: Env.t -> Path.t -> Ident.t -> type_declaration ->
+ type_declaration
+val type_paths: Env.t -> Path.t -> module_type -> Path.t list
+val contains_type: Env.t -> module_type -> bool
+val lower_nongen: int -> module_type -> unit
diff --git a/upstream/ocaml_503/typing/oprint.ml b/upstream/ocaml_503/typing/oprint.ml
new file mode 100644
index 0000000000..b915fefa50
--- /dev/null
+++ b/upstream/ocaml_503/typing/oprint.ml
@@ -0,0 +1,861 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2002 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. *)
+(* *)
+(**************************************************************************)
+
+open Format_doc
+open Outcometree
+
+exception Ellipsis
+
+let cautious f ppf arg =
+ try f ppf arg with
+ Ellipsis -> fprintf ppf "..."
+
+let print_lident ppf = function
+ | "::" -> pp_print_string ppf "(::)"
+ | s when Lexer.is_keyword s -> fprintf ppf "\\#%s" s
+ | s -> pp_print_string ppf s
+
+let rec print_ident ppf =
+ function
+ Oide_ident s -> print_lident ppf s.printed_name
+ | Oide_dot (id, s) ->
+ print_ident ppf id; pp_print_char ppf '.'; print_lident ppf s
+ | Oide_apply (id1, id2) ->
+ fprintf ppf "%a(%a)" print_ident id1 print_ident id2
+
+let out_ident = ref print_ident
+
+let parenthesized_ident name =
+ (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
+ || not (Misc.Utf8_lexeme.is_valid_identifier name)
+
+let value_ident ppf name =
+ if parenthesized_ident name then
+ fprintf ppf "( %s )" name
+ else if Lexer.is_keyword name then
+ fprintf ppf "\\#%s" name
+ else
+ pp_print_string ppf name
+
+(* Values *)
+
+let valid_float_lexeme s =
+ let l = String.length s in
+ let rec loop i =
+ if i >= l then s ^ "." else
+ match s.[i] with
+ | '0' .. '9' | '-' -> loop (i+1)
+ | _ -> s
+ in loop 0
+
+let float_repres f =
+ match classify_float f with
+ FP_nan -> "nan"
+ | FP_infinite ->
+ if f < 0.0 then "neg_infinity" else "infinity"
+ | _ ->
+ let float_val =
+ let s1 = Printf.sprintf "%.12g" f in
+ if f = float_of_string s1 then s1 else
+ let s2 = Printf.sprintf "%.15g" f in
+ if f = float_of_string s2 then s2 else
+ Printf.sprintf "%.18g" f
+ in valid_float_lexeme float_val
+
+let parenthesize_if_neg ppf fmt v isneg =
+ if isneg then pp_print_char ppf '(';
+ fprintf ppf fmt v;
+ if isneg then pp_print_char ppf ')'
+
+let escape_string s =
+ (* Escape only C0 control characters (bytes <= 0x1F), DEL(0x7F), '\\'
+ and '"' *)
+ let n = ref 0 in
+ for i = 0 to String.length s - 1 do
+ n := !n +
+ (match String.unsafe_get s i with
+ | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
+ | '\x00' .. '\x1F'
+ | '\x7F' -> 4
+ | _ -> 1)
+ done;
+ if !n = String.length s then s else begin
+ let s' = Bytes.create !n in
+ n := 0;
+ for i = 0 to String.length s - 1 do
+ begin match String.unsafe_get s i with
+ | ('\"' | '\\') as c ->
+ Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
+ | '\n' ->
+ Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
+ | '\t' ->
+ Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
+ | '\r' ->
+ Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
+ | '\b' ->
+ Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
+ | '\x00' .. '\x1F' | '\x7F' as c ->
+ let a = Char.code c in
+ Bytes.unsafe_set s' !n '\\';
+ incr n;
+ Bytes.unsafe_set s' !n (Char.chr (48 + a / 100));
+ incr n;
+ Bytes.unsafe_set s' !n (Char.chr (48 + (a / 10) mod 10));
+ incr n;
+ Bytes.unsafe_set s' !n (Char.chr (48 + a mod 10));
+ | c -> Bytes.unsafe_set s' !n c
+ end;
+ incr n
+ done;
+ Bytes.to_string s'
+ end
+
+
+let print_out_string ppf s =
+ let not_escaped =
+ (* let the user dynamically choose if strings should be escaped: *)
+ match Sys.getenv_opt "OCAMLTOP_UTF_8" with
+ | None -> true
+ | Some x ->
+ match bool_of_string_opt x with
+ | None -> true
+ | Some f -> f in
+ if not_escaped then
+ fprintf ppf "\"%s\"" (escape_string s)
+ else
+ fprintf ppf "%S" s
+
+let print_constr ppf name =
+ match name with
+ | Oide_ident {printed_name = ("true" | "false") as c} ->
+ (* despite being keywords, these are constructor names
+ and should not be escaped *)
+ fprintf ppf "%s" c
+ | Oide_dot (id, ("true"|"false" as s)) ->
+ (* Similarly, M.true is invalid *)
+ fprintf ppf "%a.(%s)" print_ident id s
+ | _ -> print_ident ppf name
+
+let print_out_value ppf tree =
+ let rec print_tree_1 ppf =
+ function
+ | Oval_constr (name, [param]) ->
+ fprintf ppf "@[<1>%a@ %a@]" print_constr name print_constr_param param
+ | Oval_constr (name, (_ :: _ as params)) ->
+ fprintf ppf "@[<1>%a@ (%a)@]" print_constr name
+ (print_tree_list print_tree_1 ",") params
+ | Oval_variant (name, Some param) ->
+ fprintf ppf "@[<2>`%a@ %a@]" print_lident name print_constr_param param
+ | Oval_lazy param ->
+ fprintf ppf "@[<2>lazy@ %a@]" print_constr_param param
+ | tree -> print_simple_tree ppf tree
+ and print_constr_param ppf = function
+ | Oval_int i -> parenthesize_if_neg ppf "%i" i (i < 0)
+ | Oval_int32 i -> parenthesize_if_neg ppf "%lil" i (i < 0l)
+ | Oval_int64 i -> parenthesize_if_neg ppf "%LiL" i (i < 0L)
+ | Oval_nativeint i -> parenthesize_if_neg ppf "%nin" i (i < 0n)
+ | Oval_float f ->
+ parenthesize_if_neg ppf "%s" (float_repres f)
+ (f < 0.0 || 1. /. f = neg_infinity)
+ | Oval_string (_,_, Ostr_bytes) as tree ->
+ pp_print_char ppf '(';
+ print_simple_tree ppf tree;
+ pp_print_char ppf ')';
+ | tree -> print_simple_tree ppf tree
+ and print_simple_tree ppf =
+ function
+ Oval_int i -> fprintf ppf "%i" i
+ | Oval_int32 i -> fprintf ppf "%lil" i
+ | Oval_int64 i -> fprintf ppf "%LiL" i
+ | Oval_nativeint i -> fprintf ppf "%nin" i
+ | Oval_float f -> pp_print_string ppf (float_repres f)
+ | Oval_char c -> fprintf ppf "%C" c
+ | Oval_string (s, maxlen, kind) ->
+ begin try
+ let len = String.length s in
+ let maxlen = max maxlen 8 in (* always show a little prefix *)
+ let s = if len > maxlen then String.sub s 0 maxlen else s in
+ begin match kind with
+ | Ostr_bytes -> fprintf ppf "Bytes.of_string %S" s
+ | Ostr_string -> print_out_string ppf s
+ end;
+ (if len > maxlen then
+ fprintf ppf
+ "... (* string length %d; truncated *)" len
+ )
+ with
+ Invalid_argument _ (* "String.create" *)-> fprintf ppf "<huge string>"
+ end
+ | Oval_list tl ->
+ fprintf ppf "@[<1>[%a]@]" (print_tree_list print_tree_1 ";") tl
+ | Oval_array tl ->
+ fprintf ppf "@[<2>[|%a|]@]" (print_tree_list print_tree_1 ";") tl
+ | Oval_constr (name, []) -> print_constr ppf name
+ | Oval_variant (name, None) -> fprintf ppf "`%a" print_lident name
+ | Oval_stuff s -> pp_print_string ppf s
+ | Oval_record fel ->
+ fprintf ppf "@[<1>{%a}@]" (cautious (print_fields true)) fel
+ | Oval_ellipsis -> raise Ellipsis
+ | Oval_printer f -> f ppf
+ | Oval_tuple tree_list ->
+ fprintf ppf "@[<1>(%a)@]" (print_tree_list print_tree_1 ",") tree_list
+ | tree -> fprintf ppf "@[<1>(%a)@]" (cautious print_tree_1) tree
+ and print_fields first ppf =
+ function
+ [] -> ()
+ | (name, tree) :: fields ->
+ if not first then fprintf ppf ";@ ";
+ fprintf ppf "@[<1>%a@ =@ %a@]" print_ident name (cautious print_tree_1)
+ tree;
+ print_fields false ppf fields
+ and print_tree_list print_item sep ppf tree_list =
+ let rec print_list first ppf =
+ function
+ [] -> ()
+ | tree :: tree_list ->
+ if not first then fprintf ppf "%s@ " sep;
+ print_item ppf tree;
+ print_list false ppf tree_list
+ in
+ cautious (print_list true) ppf tree_list
+ in
+ cautious print_tree_1 ppf tree
+
+let out_value = ref (compat print_out_value)
+
+(* Types *)
+
+let rec print_list_init pr sep ppf =
+ function
+ [] -> ()
+ | a :: l -> sep ppf; pr ppf a; print_list_init pr sep ppf l
+
+let rec print_list pr sep ppf =
+ function
+ [] -> ()
+ | [a] -> pr ppf a
+ | a :: l -> pr ppf a; sep ppf; print_list pr sep ppf l
+
+let pr_present =
+ print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
+
+let pr_var = Pprintast.Doc.tyvar
+let ty_var ~non_gen ppf s =
+ pr_var ppf (if non_gen then "_" ^ s else s)
+
+let pr_vars =
+ print_list pr_var (fun ppf -> fprintf ppf "@ ")
+
+let print_arg_label ppf (lbl : Asttypes.arg_label) =
+ match lbl with
+ | Nolabel -> ()
+ | Labelled s -> fprintf ppf "%a:" print_lident s
+ | Optional s -> fprintf ppf "?%a:" print_lident s
+
+let rec print_out_type ppf =
+ function
+ | Otyp_alias {non_gen; aliased; alias } ->
+ fprintf ppf "@[%a@ as %a@]"
+ print_out_type aliased
+ (ty_var ~non_gen) alias
+ | Otyp_poly (sl, ty) ->
+ fprintf ppf "@[<hov 2>%a.@ %a@]"
+ pr_vars sl
+ print_out_type ty
+ | ty ->
+ print_out_type_1 ppf ty
+
+and print_out_type_1 ppf =
+ function
+ Otyp_arrow (lab, ty1, ty2) ->
+ pp_open_box ppf 0;
+ print_arg_label ppf lab;
+ print_out_type_2 ppf ty1;
+ pp_print_string ppf " ->";
+ pp_print_space ppf ();
+ print_out_type_1 ppf ty2;
+ pp_close_box ppf ()
+ | ty -> print_out_type_2 ppf ty
+and print_out_type_2 ppf =
+ function
+ Otyp_tuple tyl ->
+ fprintf ppf "@[<0>%a@]" (print_typlist print_simple_out_type " *") tyl
+ | ty -> print_simple_out_type ppf ty
+and print_simple_out_type ppf =
+ function
+ Otyp_class (id, tyl) ->
+ fprintf ppf "@[%a#%a@]" print_typargs tyl print_ident id
+ | Otyp_constr (id, tyl) ->
+ pp_open_box ppf 0;
+ print_typargs ppf tyl;
+ print_ident ppf id;
+ pp_close_box ppf ()
+ | Otyp_object {fields; open_row} ->
+ fprintf ppf "@[<2>< %a >@]" (print_fields open_row) fields
+ | Otyp_stuff s -> pp_print_string ppf s
+ | Otyp_var (non_gen, s) -> ty_var ~non_gen ppf s
+ | Otyp_variant (row_fields, closed, tags) ->
+ let print_present ppf =
+ function
+ None | Some [] -> ()
+ | Some l -> fprintf ppf "@;<1 -2>> @[<hov>%a@]" pr_present l
+ in
+ let print_fields ppf =
+ function
+ Ovar_fields fields ->
+ print_list print_row_field (fun ppf -> fprintf ppf "@;<1 -2>| ")
+ ppf fields
+ | Ovar_typ typ ->
+ print_simple_out_type ppf typ
+ in
+ fprintf ppf "@[<hov>[%s@[<hv>@[<hv>%a@]%a@]@ ]@]"
+ (if closed then if tags = None then " " else "< "
+ else if tags = None then "> " else "? ")
+ print_fields row_fields
+ print_present tags
+ | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
+ pp_open_box ppf 1;
+ pp_print_char ppf '(';
+ print_out_type ppf ty;
+ pp_print_char ppf ')';
+ pp_close_box ppf ()
+ | Otyp_abstract | Otyp_open
+ | Otyp_sum _ | Otyp_manifest (_, _) -> ()
+ | Otyp_record lbls -> print_record_decl ppf lbls
+ | Otyp_module (p, fl) ->
+ fprintf ppf "@[<1>(module %a" print_ident p;
+ let first = ref true in
+ List.iter
+ (fun (s, t) ->
+ let sep = if !first then (first := false; "with") else "and" in
+ fprintf ppf " %s type %s = %a" sep s print_out_type t
+ )
+ fl;
+ fprintf ppf ")@]"
+ | Otyp_attribute (t, attr) ->
+ fprintf ppf "@[<1>(%a [@@%s])@]" print_out_type t attr.oattr_name
+and print_record_decl ppf lbls =
+ fprintf ppf "{%a@;<1 -2>}"
+ (print_list_init print_out_label (fun ppf -> fprintf ppf "@ ")) lbls
+and print_fields open_row ppf =
+ function
+ [] ->
+ if open_row then fprintf ppf "..";
+ | [s, t] ->
+ fprintf ppf "%a : %a" print_lident s print_out_type t;
+ if open_row then fprintf ppf ";@ ";
+ print_fields open_row ppf []
+ | (s, t) :: l ->
+ fprintf ppf "%s : %a;@ %a" s print_out_type t (print_fields open_row) l
+and print_row_field ppf (l, opt_amp, tyl) =
+ let pr_of ppf =
+ if opt_amp then fprintf ppf " of@ &@ "
+ else if tyl <> [] then fprintf ppf " of@ "
+ else fprintf ppf ""
+ in
+ fprintf ppf "@[<hv 2>`%a%t%a@]" print_lident l pr_of
+ (print_typlist print_out_type " &")
+ tyl
+and print_typlist print_elem sep ppf =
+ function
+ [] -> ()
+ | [ty] -> print_elem ppf ty
+ | ty :: tyl ->
+ print_elem ppf ty;
+ pp_print_string ppf sep;
+ pp_print_space ppf ();
+ print_typlist print_elem sep ppf tyl
+and print_typargs ppf =
+ function
+ [] -> ()
+ | [ty1] -> print_simple_out_type ppf ty1; pp_print_space ppf ()
+ | tyl ->
+ pp_open_box ppf 1;
+ pp_print_char ppf '(';
+ print_typlist print_out_type "," ppf tyl;
+ pp_print_char ppf ')';
+ pp_close_box ppf ();
+ pp_print_space ppf ()
+and print_out_label ppf {olab_name; olab_mut; olab_type} =
+ fprintf ppf "@[<2>%s%a :@ %a@];"
+ (match olab_mut with
+ | Mutable -> "mutable "
+ | Immutable -> "")
+ print_lident olab_name
+ print_out_type olab_type
+
+let out_label = ref print_out_label
+
+let out_type = ref print_out_type
+
+let out_type_args = ref print_typargs
+
+(* Class types *)
+
+let print_type_parameter ?(non_gen=false) ppf s =
+ if s = "_" then fprintf ppf "_" else ty_var ~non_gen ppf s
+
+let type_parameter ppf {ot_non_gen=non_gen; ot_name=ty; ot_variance=var,inj} =
+ let open Asttypes in
+ fprintf ppf "%s%s%a"
+ (match var with Covariant -> "+" | Contravariant -> "-" | NoVariance -> "")
+ (match inj with Injective -> "!" | NoInjectivity -> "")
+ (print_type_parameter ~non_gen) ty
+
+let print_out_class_params ppf =
+ function
+ [] -> ()
+ | tyl ->
+ fprintf ppf "@[<1>[%a]@]@ "
+ (print_list type_parameter (fun ppf -> fprintf ppf ", "))
+ tyl
+
+let rec print_out_class_type ppf =
+ function
+ Octy_constr (id, tyl) ->
+ let pr_tyl ppf =
+ function
+ [] -> ()
+ | tyl ->
+ fprintf ppf "@[<1>[%a]@]@ " (print_typlist !out_type ",") tyl
+ in
+ fprintf ppf "@[%a%a@]" pr_tyl tyl print_ident id
+ | Octy_arrow (lab, ty, cty) ->
+ fprintf ppf "@[%a%a ->@ %a@]" print_arg_label lab
+ print_out_type_2 ty print_out_class_type cty
+ | Octy_signature (self_ty, csil) ->
+ let pr_param ppf =
+ function
+ Some ty -> fprintf ppf "@ @[(%a)@]" !out_type ty
+ | None -> ()
+ in
+ fprintf ppf "@[<hv 2>@[<2>object%a@]@ %a@;<1 -2>end@]" pr_param self_ty
+ (print_list print_out_class_sig_item (fun ppf -> fprintf ppf "@ "))
+ csil
+and print_out_class_sig_item ppf =
+ function
+ Ocsg_constraint (ty1, ty2) ->
+ fprintf ppf "@[<2>constraint %a =@ %a@]" !out_type ty1
+ !out_type ty2
+ | Ocsg_method (name, priv, virt, ty) ->
+ fprintf ppf "@[<2>method %s%s%a :@ %a@]"
+ (if priv then "private " else "") (if virt then "virtual " else "")
+ print_lident name !out_type ty
+ | Ocsg_value (name, mut, vr, ty) ->
+ fprintf ppf "@[<2>val %s%s%a :@ %a@]"
+ (if mut then "mutable " else "")
+ (if vr then "virtual " else "")
+ print_lident name !out_type ty
+
+let out_class_type = ref print_out_class_type
+
+(* Signature *)
+
+let out_module_type = ref (fun _ -> failwith "Oprint.out_module_type")
+let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item")
+let out_signature = ref (fun _ -> failwith "Oprint.out_signature")
+let out_type_extension = ref (fun _ -> failwith "Oprint.out_type_extension")
+let out_functor_parameters =
+ ref (fun _ -> failwith "Oprint.out_functor_parameters")
+
+(* For anonymous functor arguments, the logic to choose between
+ the long-form
+ functor (_ : S) -> ...
+ and the short-form
+ S -> ...
+ is as follows: if we are already printing long-form functor arguments,
+ we use the long form unless all remaining functor arguments can use
+ the short form. (Otherwise use the short form.)
+
+ For example,
+ functor (X : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end
+ will get printed as
+ functor (X : S1) (_ : S2) (Y : S3) -> S4 -> S5 -> sig end
+
+ but
+ functor (_ : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end
+ gets printed as
+ S1 -> S2 -> functor (Y : S3) -> S4 -> S5 -> sig end
+*)
+
+(* take a module type that may be a functor type,
+ and return the longest prefix list of arguments
+ that should be printed in long form. *)
+
+let rec collect_functor_args acc = function
+ | Omty_functor (param, mty_res) ->
+ collect_functor_args (param :: acc) mty_res
+ | non_functor -> (acc, non_functor)
+let collect_functor_args mty =
+ let l, rest = collect_functor_args [] mty in
+ List.rev l, rest
+
+let constructor_of_extension_constructor
+ (ext : out_extension_constructor) : out_constructor
+=
+ {
+ ocstr_name = ext.oext_name;
+ ocstr_args = ext.oext_args;
+ ocstr_return_type = ext.oext_ret_type;
+ }
+
+let split_anon_functor_arguments params =
+ let rec uncollect_anonymous_suffix acc rest = match acc with
+ | Some (None, mty_arg) :: acc ->
+ uncollect_anonymous_suffix acc
+ (Some (None, mty_arg) :: rest)
+ | _ :: _ | [] ->
+ (acc, rest)
+ in
+ let (acc, rest) = uncollect_anonymous_suffix (List.rev params) [] in
+ (List.rev acc, rest)
+
+let rec print_out_module_type ppf mty =
+ print_out_functor ppf mty
+
+and print_out_functor_parameters ppf l =
+ let print_nonanon_arg ppf = function
+ | None ->
+ fprintf ppf "()"
+ | Some (param, mty) ->
+ fprintf ppf "(%s : %a)"
+ (Option.value param ~default:"_")
+ print_out_module_type mty
+ in
+ let rec print_args ppf = function
+ | [] -> ()
+ | Some (None, mty_arg) :: l ->
+ fprintf ppf "%a ->@ %a"
+ print_simple_out_module_type mty_arg
+ print_args l
+ | _ :: _ as non_anonymous_functor ->
+ let args, anons = split_anon_functor_arguments non_anonymous_functor in
+ fprintf ppf "@[%a@]@ ->@ %a"
+ (pp_print_list ~pp_sep:pp_print_space print_nonanon_arg) args
+ print_args anons
+ in
+ print_args ppf l
+
+and print_out_functor ppf t =
+ let params, non_functor = collect_functor_args t in
+ fprintf ppf "@[<2>%a%a@]"
+ print_out_functor_parameters params
+ print_simple_out_module_type non_functor
+and print_simple_out_module_type ppf =
+ function
+ Omty_abstract -> ()
+ | Omty_ident id -> fprintf ppf "%a" print_ident id
+ | Omty_signature sg ->
+ begin match sg with
+ | [] -> fprintf ppf "sig end"
+ | sg ->
+ fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]" print_out_signature sg
+ end
+ | Omty_alias id -> fprintf ppf "(module %a)" print_ident id
+ | Omty_functor _ as non_simple ->
+ fprintf ppf "(%a)" print_out_module_type non_simple
+and print_out_signature ppf =
+ function
+ [] -> ()
+ | [item] -> !out_sig_item ppf item
+ | Osig_typext(ext, Oext_first) :: items ->
+ (* Gather together the extension constructors *)
+ let rec gather_extensions acc items =
+ match items with
+ Osig_typext(ext, Oext_next) :: items ->
+ gather_extensions
+ (constructor_of_extension_constructor ext :: acc)
+ items
+ | _ -> (List.rev acc, items)
+ in
+ let exts, items =
+ gather_extensions
+ [constructor_of_extension_constructor ext]
+ items
+ in
+ let te =
+ { otyext_name = ext.oext_type_name;
+ otyext_params = ext.oext_type_params;
+ otyext_constructors = exts;
+ otyext_private = ext.oext_private }
+ in
+ fprintf ppf "%a@ %a" !out_type_extension te print_out_signature items
+ | item :: items ->
+ fprintf ppf "%a@ %a" !out_sig_item item print_out_signature items
+and print_out_sig_item ppf =
+ function
+ Osig_class (vir_flag, name, params, clt, rs) ->
+ fprintf ppf "@[<2>%s%s@ %a%a@ :@ %a@]"
+ (if rs = Orec_next then "and" else "class")
+ (if vir_flag then " virtual" else "") print_out_class_params params
+ print_lident name !out_class_type clt
+ | Osig_class_type (vir_flag, name, params, clt, rs) ->
+ fprintf ppf "@[<2>%s%s@ %a%a@ =@ %a@]"
+ (if rs = Orec_next then "and" else "class type")
+ (if vir_flag then " virtual" else "") print_out_class_params params
+ print_lident name !out_class_type clt
+ | Osig_typext (ext, Oext_exception) ->
+ fprintf ppf "@[<2>exception %a@]"
+ print_out_constr (constructor_of_extension_constructor ext)
+ | Osig_typext (ext, _es) ->
+ print_out_extension_constructor ppf ext
+ | Osig_modtype (name, Omty_abstract) ->
+ fprintf ppf "@[<2>module type %s@]" name
+ | Osig_modtype (name, mty) ->
+ fprintf ppf "@[<2>module type %s =@ %a@]" name !out_module_type mty
+ | Osig_module (name, Omty_alias id, _) ->
+ fprintf ppf "@[<2>module %s =@ %a@]" name print_ident id
+ | Osig_module (name, mty, rs) ->
+ fprintf ppf "@[<2>%s %s :@ %a@]"
+ (match rs with Orec_not -> "module"
+ | Orec_first -> "module rec"
+ | Orec_next -> "and")
+ name !out_module_type mty
+ | Osig_type(td, rs) ->
+ print_out_type_decl
+ (match rs with
+ | Orec_not -> "type nonrec"
+ | Orec_first -> "type"
+ | Orec_next -> "and")
+ ppf td
+ | Osig_value vd ->
+ let kwd = if vd.oval_prims = [] then "val" else "external" in
+ let pr_prims ppf =
+ function
+ [] -> ()
+ | s :: sl ->
+ fprintf ppf "@ = \"%s\"" s;
+ List.iter (fun s -> fprintf ppf "@ \"%s\"" s) sl
+ in
+ fprintf ppf "@[<2>%s %a :@ %a%a%a@]" kwd value_ident vd.oval_name
+ !out_type vd.oval_type pr_prims vd.oval_prims
+ (fun ppf -> List.iter (fun a -> fprintf ppf "@ [@@@@%s]" a.oattr_name))
+ vd.oval_attributes
+ | Osig_ellipsis ->
+ fprintf ppf "..."
+
+and print_out_type_decl kwd ppf td =
+ let print_constraints ppf =
+ List.iter
+ (fun (ty1, ty2) ->
+ fprintf ppf "@ @[<2>constraint %a =@ %a@]" !out_type ty1
+ !out_type ty2)
+ td.otype_cstrs
+ in
+ let type_defined ppf =
+ match td.otype_params with
+ [] -> print_lident ppf td.otype_name
+ | [param] ->
+ fprintf ppf "@[%a@ %a@]" type_parameter param
+ print_lident td.otype_name
+ | _ ->
+ fprintf ppf "@[(@[%a)@]@ %a@]"
+ (print_list type_parameter (fun ppf -> fprintf ppf ",@ "))
+ td.otype_params
+ print_lident td.otype_name
+ in
+ let print_manifest ppf =
+ function
+ Otyp_manifest (ty, _) -> fprintf ppf " =@ %a" !out_type ty
+ | _ -> ()
+ in
+ let print_name_params ppf =
+ fprintf ppf "%s %t%a" kwd type_defined print_manifest td.otype_type
+ in
+ let ty =
+ match td.otype_type with
+ Otyp_manifest (_, ty) -> ty
+ | _ -> td.otype_type
+ in
+ let print_private ppf = function
+ Asttypes.Private -> fprintf ppf " private"
+ | Asttypes.Public -> ()
+ in
+ let print_immediate ppf =
+ match td.otype_immediate with
+ | Unknown -> ()
+ | Always -> fprintf ppf " [%@%@immediate]"
+ | Always_on_64bits -> fprintf ppf " [%@%@immediate64]"
+ in
+ let print_unboxed ppf =
+ if td.otype_unboxed then fprintf ppf " [%@%@unboxed]" else ()
+ in
+ let print_out_tkind ppf = function
+ | Otyp_abstract -> ()
+ | Otyp_record lbls ->
+ fprintf ppf " =%a %a"
+ print_private td.otype_private
+ print_record_decl lbls
+ | Otyp_sum constrs ->
+ let variants fmt constrs =
+ if constrs = [] then fprintf fmt "|" else
+ fprintf fmt "%a" (print_list print_out_constr
+ (fun ppf -> fprintf ppf "@ | ")) constrs in
+ fprintf ppf " =%a@;<1 2>%a"
+ print_private td.otype_private variants constrs
+ | Otyp_open ->
+ fprintf ppf " =%a .."
+ print_private td.otype_private
+ | ty ->
+ fprintf ppf " =%a@;<1 2>%a"
+ print_private td.otype_private
+ !out_type ty
+ in
+ fprintf ppf "@[<2>@[<hv 2>%t%a@]%t%t%t@]"
+ print_name_params
+ print_out_tkind ty
+ print_constraints
+ print_immediate
+ print_unboxed
+
+and print_out_constr ppf constr =
+ let {
+ ocstr_name = name;
+ ocstr_args = tyl;
+ ocstr_return_type = return_type;
+ } = constr in
+ let name =
+ match name with
+ | "::" -> "(::)" (* #7200 *)
+ | s -> s
+ in
+ match return_type with
+ | None ->
+ begin match tyl with
+ | [] ->
+ pp_print_string ppf name
+ | _ ->
+ fprintf ppf "@[<2>%s of@ %a@]" name
+ (print_typlist print_simple_out_type " *") tyl
+ end
+ | Some ret_type ->
+ begin match tyl with
+ | [] ->
+ fprintf ppf "@[<2>%s :@ %a@]" name print_simple_out_type ret_type
+ | _ ->
+ fprintf ppf "@[<2>%s :@ %a -> %a@]" name
+ (print_typlist print_simple_out_type " *")
+ tyl print_simple_out_type ret_type
+ end
+
+and print_out_extension_constructor ppf ext =
+ let print_extended_type ppf =
+ match ext.oext_type_params with
+ [] -> fprintf ppf "%a" print_lident ext.oext_type_name
+ | [ty_param] ->
+ fprintf ppf "@[%a@ %a@]"
+ (print_type_parameter ~non_gen:false)
+ ty_param
+ print_lident ext.oext_type_name
+ | _ ->
+ fprintf ppf "@[(@[%a)@]@ %a@]"
+ (print_list print_type_parameter (fun ppf -> fprintf ppf ",@ "))
+ ext.oext_type_params
+ print_lident ext.oext_type_name
+ in
+ fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
+ print_extended_type
+ (if ext.oext_private = Asttypes.Private then " private" else "")
+ print_out_constr
+ (constructor_of_extension_constructor ext)
+
+and print_out_type_extension ppf te =
+ let print_extended_type ppf =
+ match te.otyext_params with
+ [] -> fprintf ppf "%a" print_lident te.otyext_name
+ | [param] ->
+ fprintf ppf "@[%a@ %a@]"
+ (print_type_parameter ~non_gen:false) param
+ print_lident te.otyext_name
+ | _ ->
+ fprintf ppf "@[(@[%a)@]@ %a@]"
+ (print_list print_type_parameter (fun ppf -> fprintf ppf ",@ "))
+ te.otyext_params
+ print_lident te.otyext_name
+ in
+ fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
+ print_extended_type
+ (if te.otyext_private = Asttypes.Private then " private" else "")
+ (print_list print_out_constr (fun ppf -> fprintf ppf "@ | "))
+ te.otyext_constructors
+
+let out_constr = ref print_out_constr
+let _ = out_module_type := print_out_module_type
+let _ = out_signature := print_out_signature
+let _ = out_sig_item := print_out_sig_item
+let _ = out_type_extension := print_out_type_extension
+let _ = out_functor_parameters := print_out_functor_parameters
+
+(* Phrases *)
+
+open Format
+
+let print_out_exception ppf exn outv =
+ match exn with
+ Sys.Break -> fprintf ppf "Interrupted.@."
+ | Out_of_memory -> fprintf ppf "Out of memory during evaluation.@."
+ | Stack_overflow ->
+ fprintf ppf "Stack overflow during evaluation (looping recursion?).@."
+ | _ -> match Printexc.use_printers exn with
+ | None -> fprintf ppf "@[Exception:@ %a.@]@." !out_value outv
+ | Some s -> fprintf ppf "@[Exception:@ %s@]@." s
+
+let rec print_items ppf =
+ function
+ [] -> ()
+ | (Osig_typext(ext, Oext_first), None) :: items ->
+ (* Gather together extension constructors *)
+ let rec gather_extensions acc items =
+ match items with
+ (Osig_typext(ext, Oext_next), None) :: items ->
+ gather_extensions
+ (constructor_of_extension_constructor ext :: acc)
+ items
+ | _ -> (List.rev acc, items)
+ in
+ let exts, items =
+ gather_extensions
+ [constructor_of_extension_constructor ext]
+ items
+ in
+ let te =
+ { otyext_name = ext.oext_type_name;
+ otyext_params = ext.oext_type_params;
+ otyext_constructors = exts;
+ otyext_private = ext.oext_private }
+ in
+ fprintf ppf "@[%a@]" (Format_doc.compat !out_type_extension) te;
+ if items <> [] then fprintf ppf "@ %a" print_items items
+ | (tree, valopt) :: items ->
+ begin match valopt with
+ Some v ->
+ fprintf ppf "@[<2>%a =@ %a@]" (Format_doc.compat !out_sig_item) tree
+ !out_value v
+ | None -> fprintf ppf "@[%a@]" (Format_doc.compat !out_sig_item) tree
+ end;
+ if items <> [] then fprintf ppf "@ %a" print_items items
+
+let print_out_phrase ppf =
+ function
+ Ophr_eval (outv, ty) ->
+ fprintf ppf "@[- : %a@ =@ %a@]@." (compat !out_type) ty !out_value outv
+ | Ophr_signature [] -> ()
+ | Ophr_signature items -> fprintf ppf "@[<v>%a@]@." print_items items
+ | Ophr_exception (exn, outv) -> print_out_exception ppf exn outv
+
+let out_phrase = ref print_out_phrase
+
+type 'a printer = 'a Format_doc.printer ref
+type 'a toplevel_printer = (Format.formatter -> 'a -> unit) ref
diff --git a/upstream/ocaml_503/typing/oprint.mli b/upstream/ocaml_503/typing/oprint.mli
new file mode 100644
index 0000000000..8ce44f37ee
--- /dev/null
+++ b/upstream/ocaml_503/typing/oprint.mli
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2002 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. *)
+(* *)
+(**************************************************************************)
+
+open Outcometree
+
+type 'a printer = 'a Format_doc.printer ref
+type 'a toplevel_printer = (Format.formatter -> 'a -> unit) ref
+
+val out_ident: out_ident printer
+val out_value : out_value toplevel_printer
+val out_label : out_label printer
+val out_type : out_type printer
+val out_type_args : out_type list printer
+val out_constr : out_constructor printer
+val out_class_type : out_class_type printer
+val out_module_type : out_module_type printer
+val out_sig_item : out_sig_item printer
+val out_signature :out_sig_item list printer
+val out_functor_parameters :
+ (string option * Outcometree.out_module_type) option list printer
+val out_type_extension : out_type_extension printer
+val out_phrase : out_phrase toplevel_printer
+
+val parenthesized_ident : string -> bool
diff --git a/upstream/ocaml_503/typing/out_type.ml b/upstream/ocaml_503/typing/out_type.ml
new file mode 100644
index 0000000000..b3f3731ab4
--- /dev/null
+++ b/upstream/ocaml_503/typing/out_type.ml
@@ -0,0 +1,1969 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy and Jerome Vouillon, 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. *)
+(* *)
+(**************************************************************************)
+
+(* Compute a spanning tree representation of types *)
+
+open Misc
+open Ctype
+open Longident
+open Path
+open Asttypes
+open Types
+open Btype
+open Outcometree
+
+module String = Misc.Stdlib.String
+module Sig_component_kind = Shape.Sig_component_kind
+module Style = Misc.Style
+
+(* Print a long identifier *)
+
+module Fmt = Format_doc
+open Format_doc
+
+(* Print an identifier avoiding name collisions *)
+
+module Out_name = struct
+ let create x = { printed_name = x }
+ let print x = x.printed_name
+end
+
+(** Some identifiers may require hiding when printing *)
+type bound_ident = { hide:bool; ident:Ident.t }
+
+(* printing environment for path shortening and naming *)
+let printing_env = ref Env.empty
+
+(* When printing, it is important to only observe the
+ current printing environment, without reading any new
+ cmi present on the file system *)
+let in_printing_env f = Env.without_cmis f !printing_env
+
+ type namespace = Sig_component_kind.t =
+ | Value
+ | Type
+ | Constructor
+ | Label
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+
+module Namespace = struct
+
+ let id = function
+ | Type -> 0
+ | Module -> 1
+ | Module_type -> 2
+ | Class -> 3
+ | Class_type -> 4
+ | Extension_constructor | Value | Constructor | Label -> 5
+ (* we do not handle those component *)
+
+ let size = 1 + id Value
+
+
+ let pp ppf x =
+ Fmt.pp_print_string ppf (Shape.Sig_component_kind.to_string x)
+
+ (** The two functions below should never access the filesystem,
+ and thus use {!in_printing_env} rather than directly
+ accessing the printing environment *)
+ let lookup =
+ let to_lookup f lid = fst @@ in_printing_env (f (Lident lid)) in
+ function
+ | Some Type -> to_lookup Env.find_type_by_name
+ | Some Module -> to_lookup Env.find_module_by_name
+ | Some Module_type -> to_lookup Env.find_modtype_by_name
+ | Some Class -> to_lookup Env.find_class_by_name
+ | Some Class_type -> to_lookup Env.find_cltype_by_name
+ | None | Some(Value|Extension_constructor|Constructor|Label) ->
+ fun _ -> raise Not_found
+
+ let location namespace id =
+ let path = Path.Pident id in
+ try Some (
+ match namespace with
+ | Some Type -> (in_printing_env @@ Env.find_type path).type_loc
+ | Some Module -> (in_printing_env @@ Env.find_module path).md_loc
+ | Some Module_type -> (in_printing_env @@ Env.find_modtype path).mtd_loc
+ | Some Class -> (in_printing_env @@ Env.find_class path).cty_loc
+ | Some Class_type -> (in_printing_env @@ Env.find_cltype path).clty_loc
+ | Some (Extension_constructor|Value|Constructor|Label) | None ->
+ Location.none
+ ) with Not_found -> None
+
+ let best_class_namespace = function
+ | Papply _ | Pdot _ -> Some Module
+ | Pextra_ty _ -> assert false (* Only in type path *)
+ | Pident c ->
+ match location (Some Class) c with
+ | Some _ -> Some Class
+ | None -> Some Class_type
+
+end
+
+(** {2 Ident conflicts printing}
+
+ Ident conflicts arise when multiple {!Ident.t}s are attributed the same name.
+ The following module stores the global conflict references and provides the
+ printing functions for explaining the source of the conflicts.
+*)
+module Ident_conflicts = struct
+ module M = String.Map
+ type explanation =
+ { kind: namespace; name:string; root_name:string; location:Location.t}
+ let explanations = ref M.empty
+
+ let add namespace name id =
+ match Namespace.location (Some namespace) id with
+ | None -> ()
+ | Some location ->
+ let explanation =
+ { kind = namespace; location; name; root_name=Ident.name id}
+ in
+ explanations := M.add name explanation !explanations
+
+ let collect_explanation namespace id ~name =
+ let root_name = Ident.name id in
+ (* if [name] is of the form "root_name/%d", we register both
+ [id] and the identifier in scope for [root_name].
+ *)
+ if root_name <> name && not (M.mem name !explanations) then
+ begin
+ add namespace name id;
+ if not (M.mem root_name !explanations) then
+ (* lookup the identifier in scope with name [root_name] and
+ add it too
+ *)
+ match Namespace.lookup (Some namespace) root_name with
+ | Pident root_id -> add namespace root_name root_id
+ | exception Not_found | _ -> ()
+ end
+
+ let pp_explanation ppf r=
+ Fmt.fprintf ppf "@[<v 2>%a:@,Definition of %s %a@]"
+ Location.Doc.loc r.location (Sig_component_kind.to_string r.kind)
+ Style.inline_code r.name
+
+ let print_located_explanations ppf l =
+ Fmt.fprintf ppf "@[<v>%a@]"
+ (Fmt.pp_print_list pp_explanation) l
+
+ let reset () = explanations := M.empty
+ let list_explanations () =
+ let c = !explanations in
+ reset ();
+ c |> M.bindings |> List.map snd |> List.sort Stdlib.compare
+
+
+ let print_toplevel_hint ppf l =
+ let conj ppf () = Fmt.fprintf ppf " and@ " in
+ let pp_namespace_plural ppf n = Fmt.fprintf ppf "%as" Namespace.pp n in
+ let root_names = List.map (fun r -> r.kind, r.root_name) l in
+ let unique_root_names = List.sort_uniq Stdlib.compare root_names in
+ let submsgs = Array.make Namespace.size [] in
+ let () = List.iter (fun (n,_ as x) ->
+ submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
+ ) unique_root_names in
+ let pp_submsg ppf names =
+ match names with
+ | [] -> ()
+ | [namespace, a] ->
+ Fmt.fprintf ppf
+ "@,\
+ @[<2>@{<hint>Hint@}: The %a %a has been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
+ @ Did you try to redefine them?@]"
+ Namespace.pp namespace
+ Style.inline_code a Namespace.pp namespace
+ | (namespace, _) :: _ :: _ ->
+ Fmt.fprintf ppf
+ "@,\
+ @[<2>@{<hint>Hint@}: The %a %a have been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
+ @ Did you try to redefine them?@]"
+ pp_namespace_plural namespace
+ Fmt.(pp_print_list ~pp_sep:conj Style.inline_code)
+ (List.map snd names)
+ pp_namespace_plural namespace in
+ Array.iter (pp_submsg ppf) submsgs
+
+ let err_msg () =
+ let ltop, l =
+ (* isolate toplevel locations, since they are too imprecise *)
+ let from_toplevel a =
+ a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
+ List.partition from_toplevel (list_explanations ())
+ in
+ match l, ltop with
+ | [], [] -> None
+ | _ ->
+ Some
+ (Fmt.doc_printf "%a%a"
+ print_located_explanations l
+ print_toplevel_hint ltop
+ )
+ let err_print ppf = Option.iter Fmt.(fprintf ppf "@,%a" pp_doc) (err_msg ())
+
+ let exists () = M.cardinal !explanations >0
+end
+
+module Ident_names = struct
+
+module M = String.Map
+module S = String.Set
+
+let enabled = ref true
+let enable b = enabled := b
+
+(* Names bound in recursive definitions should be considered as bound
+ in the environment when printing identifiers but not when trying
+ to find shortest path.
+ For instance, if we define
+ [{
+ module Avoid__me = struct
+ type t = A
+ end
+ type t = X
+ type u = [` A of t * t ]
+ module M = struct
+ type t = A of [ u | `B ]
+ type r = Avoid__me.t
+ end
+ }]
+ It is is important that in the definition of [t] that the outer type [t] is
+ printed as [t/2] reserving the name [t] to the type being defined in the
+ current recursive definition.
+ Contrarily, in the definition of [r], one should not shorten the
+ path [Avoid__me.t] to [r] until the end of the definition of [r].
+ The [bound_in_recursion] bridges the gap between those two slightly different
+ notions of printing environment.
+*)
+let bound_in_recursion = ref M.empty
+
+(* When dealing with functor arguments, identity becomes fuzzy because the same
+ syntactic argument may be represented by different identifiers during the
+ error processing, we are thus disabling disambiguation on the argument name
+*)
+let fuzzy = ref S.empty
+let with_fuzzy id f =
+ protect_refs [ R(fuzzy, S.add (Ident.name id) !fuzzy) ] f
+let fuzzy_id namespace id = namespace = Module && S.mem (Ident.name id) !fuzzy
+
+let with_hidden ids f =
+ let update m id = M.add (Ident.name id.ident) id.ident m in
+ let updated = List.fold_left update !bound_in_recursion ids in
+ protect_refs [ R(bound_in_recursion, updated )] f
+
+let human_id id index =
+ (* The identifier with index [k] is the (k+1)-th most recent identifier in
+ the printing environment. We print them as [name/(k+1)] except for [k=0]
+ which is printed as [name] rather than [name/1].
+ *)
+ if index = 0 then
+ Ident.name id
+ else
+ let ordinal = index + 1 in
+ String.concat "/" [Ident.name id; string_of_int ordinal]
+
+let indexed_name namespace id =
+ let find namespace id env = match namespace with
+ | Type -> Env.find_type_index id env
+ | Module -> Env.find_module_index id env
+ | Module_type -> Env.find_modtype_index id env
+ | Class -> Env.find_class_index id env
+ | Class_type-> Env.find_cltype_index id env
+ | Value | Extension_constructor | Constructor | Label -> None
+ in
+ let index =
+ match M.find_opt (Ident.name id) !bound_in_recursion with
+ | Some rec_bound_id ->
+ (* the identifier name appears in the current group of recursive
+ definition *)
+ if Ident.same rec_bound_id id then
+ Some 0
+ else
+ (* the current recursive definition shadows one more time the
+ previously existing identifier with the same name *)
+ Option.map succ (in_printing_env (find namespace id))
+ | None ->
+ in_printing_env (find namespace id)
+ in
+ let index =
+ (* If [index] is [None] at this point, it might indicate that
+ the identifier id is not defined in the environment, while there
+ are other identifiers in scope that share the same name.
+ Currently, this kind of partially incoherent environment happens
+ within functor error messages where the left and right hand side
+ have a different views of the environment at the source level.
+ Printing the source-level by using a default index of `0`
+ seems like a reasonable compromise in this situation however.*)
+ Option.value index ~default:0
+ in
+ human_id id index
+
+let ident_name namespace id =
+ match namespace, !enabled with
+ | None, _ | _, false -> Out_name.create (Ident.name id)
+ | Some namespace, true ->
+ if fuzzy_id namespace id then Out_name.create (Ident.name id)
+ else
+ let name = indexed_name namespace id in
+ Ident_conflicts.collect_explanation namespace id ~name;
+ Out_name.create name
+end
+let ident_name = Ident_names.ident_name
+
+(* Print a path *)
+
+let ident_stdlib = Ident.create_persistent "Stdlib"
+
+let non_shadowed_stdlib namespace = function
+ | Pdot(Pident id, s) as path ->
+ Ident.same id ident_stdlib &&
+ (match Namespace.lookup namespace s with
+ | path' -> Path.same path path'
+ | exception Not_found -> true)
+ | _ -> false
+
+let find_double_underscore s =
+ let len = String.length s in
+ let rec loop i =
+ if i + 1 >= len then
+ None
+ else if s.[i] = '_' && s.[i + 1] = '_' then
+ Some i
+ else
+ loop (i + 1)
+ in
+ loop 0
+
+let rec module_path_is_an_alias_of env path ~alias_of =
+ match Env.find_module path env with
+ | { md_type = Mty_alias path'; _ } ->
+ Path.same path' alias_of ||
+ module_path_is_an_alias_of env path' ~alias_of
+ | _ -> false
+ | exception Not_found -> false
+
+(* Simple heuristic to print Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+ for Foo__bar. This pattern is used by the stdlib. *)
+let rec rewrite_double_underscore_paths env p =
+ match p with
+ | Pdot (p, s) ->
+ Pdot (rewrite_double_underscore_paths env p, s)
+ | Papply (a, b) ->
+ Papply (rewrite_double_underscore_paths env a,
+ rewrite_double_underscore_paths env b)
+ | Pextra_ty (p, extra) ->
+ Pextra_ty (rewrite_double_underscore_paths env p, extra)
+ | Pident id ->
+ let name = Ident.name id in
+ match find_double_underscore name with
+ | None -> p
+ | Some i ->
+ let better_lid =
+ Ldot
+ (Lident (String.sub name 0 i),
+ Unit_info.modulize
+ (String.sub name (i + 2) (String.length name - i - 2)))
+ in
+ match Env.find_module_by_name better_lid env with
+ | exception Not_found -> p
+ | p', _ ->
+ if module_path_is_an_alias_of env p' ~alias_of:p then
+ p'
+ else
+ p
+
+let rewrite_double_underscore_paths env p =
+ if env == Env.empty then
+ p
+ else
+ rewrite_double_underscore_paths env p
+
+let rec tree_of_path ?(disambiguation=true) namespace p =
+ let tree_of_path namespace p = tree_of_path ~disambiguation namespace p in
+ let namespace = if disambiguation then namespace else None in
+ match p with
+ | Pident id ->
+ Oide_ident (ident_name namespace id)
+ | Pdot(_, s) as path when non_shadowed_stdlib namespace path ->
+ Oide_ident (Out_name.create s)
+ | Pdot(p, s) ->
+ Oide_dot (tree_of_path (Some Module) p, s)
+ | Papply(p1, p2) ->
+ let t1 = tree_of_path (Some Module) p1 in
+ let t2 = tree_of_path (Some Module) p2 in
+ Oide_apply (t1, t2)
+ | Pextra_ty (p, extra) -> begin
+ (* inline record types are syntactically prevented from escaping their
+ binding scope, and are never shown to users. *)
+ match extra with
+ Pcstr_ty s ->
+ Oide_dot (tree_of_path (Some Type) p, s)
+ | Pext_ty ->
+ tree_of_path None p
+ end
+
+let tree_of_path ?disambiguation namespace p =
+ tree_of_path ?disambiguation namespace
+ (rewrite_double_underscore_paths !printing_env p)
+
+
+(* Print a recursive annotation *)
+
+let tree_of_rec = function
+ | Trec_not -> Orec_not
+ | Trec_first -> Orec_first
+ | Trec_next -> Orec_next
+
+(* Normalize paths *)
+
+type param_subst = Id | Nth of int | Map of int list
+
+let is_nth = function
+ Nth _ -> true
+ | _ -> false
+
+let compose l1 = function
+ | Id -> Map l1
+ | Map l2 -> Map (List.map (List.nth l1) l2)
+ | Nth n -> Nth (List.nth l1 n)
+
+let apply_subst s1 tyl =
+ if tyl = [] then []
+ (* cf. PR#7543: Typemod.type_package doesn't respect type constructor arity *)
+ else
+ match s1 with
+ Nth n1 -> [List.nth tyl n1]
+ | Map l1 -> List.map (List.nth tyl) l1
+ | Id -> tyl
+
+type best_path = Paths of Path.t list | Best of Path.t
+
+(** Short-paths cache: the five mutable variables below implement a one-slot
+ cache for short-paths
+ *)
+let printing_old = ref Env.empty
+let printing_pers = ref String.Set.empty
+(** {!printing_old} and {!printing_pers} are the keys of the one-slot cache *)
+
+let printing_depth = ref 0
+let printing_cont = ref ([] : Env.iter_cont list)
+let printing_map = ref Path.Map.empty
+(**
+ - {!printing_map} is the main value stored in the cache.
+ Note that it is evaluated lazily and its value is updated during printing.
+ - {!printing_dep} is the current exploration depth of the environment,
+ it is used to determine whenever the {!printing_map} should be evaluated
+ further before completing a request.
+ - {!printing_cont} is the list of continuations needed to evaluate
+ the {!printing_map} one level further (see also {!Env.run_iter_cont})
+*)
+
+let rec index l x =
+ match l with
+ [] -> raise Not_found
+ | a :: l -> if eq_type x a then 0 else 1 + index l x
+
+let rec uniq = function
+ [] -> true
+ | a :: l -> not (List.memq (a : int) l) && uniq l
+
+let rec normalize_type_path ?(cache=false) env p =
+ try
+ let (params, ty, _) = Env.find_type_expansion p env in
+ match get_desc ty with
+ Tconstr (p1, tyl, _) ->
+ if List.length params = List.length tyl
+ && List.for_all2 eq_type params tyl
+ then normalize_type_path ~cache env p1
+ else if cache || List.length params <= List.length tyl
+ || not (uniq (List.map get_id tyl)) then (p, Id)
+ else
+ let l1 = List.map (index params) tyl in
+ let (p2, s2) = normalize_type_path ~cache env p1 in
+ (p2, compose l1 s2)
+ | _ ->
+ (p, Nth (index params ty))
+ with
+ Not_found ->
+ (Env.normalize_type_path None env p, Id)
+
+let penalty s =
+ if s <> "" && s.[0] = '_' then
+ 10
+ else
+ match find_double_underscore s with
+ | None -> 1
+ | Some _ -> 10
+
+let rec path_size = function
+ Pident id ->
+ penalty (Ident.name id), -Ident.scope id
+ | Pdot (p, _) | Pextra_ty (p, Pcstr_ty _) ->
+ let (l, b) = path_size p in (1+l, b)
+ | Papply (p1, p2) ->
+ let (l, b) = path_size p1 in
+ (l + fst (path_size p2), b)
+ | Pextra_ty (p, _) -> path_size p
+
+let same_printing_env env =
+ let used_pers = Env.used_persistent () in
+ Env.same_types !printing_old env && String.Set.equal !printing_pers used_pers
+
+let set_printing_env env =
+ printing_env := env;
+ if !Clflags.real_paths ||
+ !printing_env == Env.empty ||
+ same_printing_env env then
+ ()
+ else begin
+ (* printf "Reset printing_map@."; *)
+ printing_old := env;
+ printing_pers := Env.used_persistent ();
+ printing_map := Path.Map.empty;
+ printing_depth := 0;
+ (* printf "Recompute printing_map.@."; *)
+ let cont =
+ Env.iter_types
+ (fun p (p', _decl) ->
+ let (p1, s1) = normalize_type_path env p' ~cache:true in
+ (* Format.eprintf "%a -> %a = %a@." path p path p' path p1 *)
+ if s1 = Id then
+ try
+ let r = Path.Map.find p1 !printing_map in
+ match !r with
+ Paths l -> r := Paths (p :: l)
+ | Best p' -> r := Paths [p; p'] (* assert false *)
+ with Not_found ->
+ printing_map := Path.Map.add p1 (ref (Paths [p])) !printing_map)
+ env in
+ printing_cont := [cont];
+ end
+
+let wrap_printing_env env f =
+ set_printing_env env;
+ try_finally f ~always:(fun () -> set_printing_env Env.empty)
+
+let wrap_printing_env ~error env f =
+ if error then Env.without_cmis (wrap_printing_env env) f
+ else wrap_printing_env env f
+
+let rec lid_of_path = function
+ Path.Pident id ->
+ Longident.Lident (Ident.name id)
+ | Path.Pdot (p1, s) | Path.Pextra_ty (p1, Pcstr_ty s) ->
+ Longident.Ldot (lid_of_path p1, s)
+ | Path.Papply (p1, p2) ->
+ Longident.Lapply (lid_of_path p1, lid_of_path p2)
+ | Path.Pextra_ty (p, Pext_ty) -> lid_of_path p
+
+let is_unambiguous path env =
+ let l = Env.find_shadowed_types path env in
+ List.exists (Path.same path) l || (* concrete paths are ok *)
+ match l with
+ [] -> true
+ | p :: rem ->
+ (* allow also coherent paths: *)
+ let normalize p = fst (normalize_type_path ~cache:true env p) in
+ let p' = normalize p in
+ List.for_all (fun p -> Path.same (normalize p) p') rem ||
+ (* also allow repeatedly defining and opening (for toplevel) *)
+ let id = lid_of_path p in
+ List.for_all (fun p -> lid_of_path p = id) rem &&
+ Path.same p (fst (Env.find_type_by_name id env))
+
+let rec get_best_path r =
+ match !r with
+ Best p' -> p'
+ | Paths [] -> raise Not_found
+ | Paths l ->
+ r := Paths [];
+ List.iter
+ (fun p ->
+ (* Format.eprintf "evaluating %a@." path p; *)
+ match !r with
+ Best p' when path_size p >= path_size p' -> ()
+ | _ -> if is_unambiguous p !printing_env then r := Best p)
+ (* else Format.eprintf "%a ignored as ambiguous@." path p *)
+ l;
+ get_best_path r
+
+let best_type_path p =
+ if !printing_env == Env.empty
+ then (p, Id)
+ else if !Clflags.real_paths
+ then (p, Id)
+ else
+ let (p', s) = normalize_type_path !printing_env p in
+ let get_path () = get_best_path (Path.Map.find p' !printing_map) in
+ while !printing_cont <> [] &&
+ try fst (path_size (get_path ())) > !printing_depth with Not_found -> true
+ do
+ printing_cont := List.map snd (Env.run_iter_cont !printing_cont);
+ incr printing_depth;
+ done;
+ let p'' = try get_path () with Not_found -> p' in
+ (* Format.eprintf "%a = %a -> %a@." path p path p' path p''; *)
+ (p'', s)
+
+(* When building a tree for a best type path, we should not disambiguate
+ identifiers whenever the short-path algorithm detected a better path than
+ the original one.*)
+let tree_of_best_type_path p p' =
+ if Path.same p p' then tree_of_path (Some Type) p'
+ else tree_of_path ~disambiguation:false None p'
+
+(* Print a type expression *)
+
+let proxy ty = Transient_expr.repr (proxy ty)
+
+(* When printing a type scheme, we print weak names. When printing a plain
+ type, we do not. This type controls that behavior *)
+type type_or_scheme = Type | Type_scheme
+
+let is_non_gen mode ty =
+ match mode with
+ | Type_scheme -> is_Tvar ty && get_level ty <> generic_level
+ | Type -> false
+
+let nameable_row row =
+ row_name row <> None &&
+ List.for_all
+ (fun (_, f) ->
+ match row_field_repr f with
+ | Reither(c, l, _) ->
+ row_closed row && if c then l = [] else List.length l = 1
+ | _ -> true)
+ (row_fields row)
+
+(* This specialized version of [Btype.iter_type_expr] normalizes and
+ short-circuits the traversal of the [type_expr], so that it covers only the
+ subterms that would be printed by the type printer. *)
+let printer_iter_type_expr f ty =
+ match get_desc ty with
+ | Tconstr(p, tyl, _) ->
+ let (_p', s) = best_type_path p in
+ List.iter f (apply_subst s tyl)
+ | Tvariant row -> begin
+ match row_name row with
+ | Some(_p, tyl) when nameable_row row ->
+ List.iter f tyl
+ | _ ->
+ iter_row f row
+ end
+ | Tobject (fi, nm) -> begin
+ match !nm with
+ | None ->
+ let fields, _ = flatten_fields fi in
+ List.iter
+ (fun (_, kind, ty) ->
+ if field_kind_repr kind = Fpublic then
+ f ty)
+ fields
+ | Some (_, l) ->
+ List.iter f (List.tl l)
+ end
+ | Tfield(_, kind, ty1, ty2) ->
+ if field_kind_repr kind = Fpublic then
+ f ty1;
+ f ty2
+ | _ ->
+ Btype.iter_type_expr f ty
+
+let quoted_ident ppf x =
+ Style.as_inline_code !Oprint.out_ident ppf x
+
+module Internal_names : sig
+
+ val reset : unit -> unit
+
+ val add : Path.t -> unit
+
+ val print_explanations : Env.t -> Fmt.formatter -> unit
+
+end = struct
+
+ let names = ref Ident.Set.empty
+
+ let reset () =
+ names := Ident.Set.empty
+
+ let add p =
+ match p with
+ | Pident id ->
+ let name = Ident.name id in
+ if String.length name > 0 && name.[0] = '$' then begin
+ names := Ident.Set.add id !names
+ end
+ | Pdot _ | Papply _ | Pextra_ty _ -> ()
+
+ let print_explanations env ppf =
+ let constrs =
+ Ident.Set.fold
+ (fun id acc ->
+ let p = Pident id in
+ match Env.find_type p env with
+ | exception Not_found -> acc
+ | decl ->
+ match type_origin decl with
+ | Existential constr ->
+ let prev = String.Map.find_opt constr acc in
+ let prev = Option.value ~default:[] prev in
+ String.Map.add constr (tree_of_path None p :: prev) acc
+ | Definition | Rec_check_regularity -> acc)
+ !names String.Map.empty
+ in
+ String.Map.iter
+ (fun constr out_idents ->
+ match out_idents with
+ | [] -> ()
+ | [out_ident] ->
+ fprintf ppf
+ "@ @[<2>@{<hint>Hint@}:@ %a@ is an existential type@ \
+ bound by the constructor@ %a.@]"
+ quoted_ident out_ident
+ Style.inline_code constr
+ | out_ident :: out_idents ->
+ fprintf ppf
+ "@ @[<2>@{<hint>Hint@}:@ %a@ and %a@ are existential types@ \
+ bound by the constructor@ %a.@]"
+ (Fmt.pp_print_list
+ ~pp_sep:(fun ppf () -> fprintf ppf ",@ ")
+ quoted_ident)
+ (List.rev out_idents)
+ quoted_ident out_ident
+ Style.inline_code constr)
+ constrs
+
+end
+
+module Variable_names : sig
+ val reset_names : unit -> unit
+
+ val add_subst : (type_expr * type_expr) list -> unit
+
+ val new_name : unit -> string
+ val new_var_name : non_gen:bool -> type_expr -> unit -> string
+
+ val name_of_type : (unit -> string) -> transient_expr -> string
+ val check_name_of_type : non_gen:bool -> transient_expr -> unit
+
+
+ val reserve: type_expr -> unit
+
+ val remove_names : transient_expr list -> unit
+
+ val with_local_names : (unit -> 'a) -> 'a
+
+ (* Refresh the weak variable map in the toplevel; for [print_items], which is
+ itself for the toplevel *)
+ val refresh_weak : unit -> unit
+end = struct
+ (* We map from types to names, but not directly; we also store a substitution,
+ which maps from types to types. The lookup process is
+ "type -> apply substitution -> find name". The substitution is presumed to
+ be one-shot. *)
+ let names = ref ([] : (transient_expr * string) list)
+ let name_subst = ref ([] : (transient_expr * transient_expr) list)
+ let name_counter = ref 0
+ let named_vars = ref ([] : string list)
+ let visited_for_named_vars = ref ([] : transient_expr list)
+
+ let weak_counter = ref 1
+ let weak_var_map = ref TypeMap.empty
+ let named_weak_vars = ref String.Set.empty
+
+ let reset_names () =
+ names := [];
+ name_subst := [];
+ name_counter := 0;
+ named_vars := [];
+ visited_for_named_vars := []
+
+ let add_named_var tty =
+ match tty.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ if List.mem name !named_vars then () else
+ named_vars := name :: !named_vars
+ | _ -> ()
+
+ let rec add_named_vars ty =
+ let tty = Transient_expr.repr ty in
+ let px = proxy ty in
+ if not (List.memq px !visited_for_named_vars) then begin
+ visited_for_named_vars := px :: !visited_for_named_vars;
+ match tty.desc with
+ | Tvar _ | Tunivar _ ->
+ add_named_var tty
+ | _ ->
+ printer_iter_type_expr add_named_vars ty
+ end
+
+ let substitute ty =
+ match List.assq ty !name_subst with
+ | ty' -> ty'
+ | exception Not_found -> ty
+
+ let add_subst subst =
+ name_subst :=
+ List.map (fun (t1,t2) -> Transient_expr.repr t1, Transient_expr.repr t2)
+ subst
+ @ !name_subst
+
+ let name_is_already_used name =
+ List.mem name !named_vars
+ || List.exists (fun (_, name') -> name = name') !names
+ || String.Set.mem name !named_weak_vars
+
+ let rec new_name () =
+ let name = Misc.letter_of_int !name_counter in
+ incr name_counter;
+ if name_is_already_used name then new_name () else name
+
+ let rec new_weak_name ty () =
+ let name = "weak" ^ Int.to_string !weak_counter in
+ incr weak_counter;
+ if name_is_already_used name then new_weak_name ty ()
+ else begin
+ named_weak_vars := String.Set.add name !named_weak_vars;
+ weak_var_map := TypeMap.add ty name !weak_var_map;
+ name
+ end
+
+ let new_var_name ~non_gen ty () =
+ if non_gen then new_weak_name ty ()
+ else new_name ()
+
+ let name_of_type name_generator t =
+ (* We've already been through repr at this stage, so t is our representative
+ of the union-find class. *)
+ let t = substitute t in
+ try List.assq t !names with Not_found ->
+ try TransientTypeMap.find t !weak_var_map with Not_found ->
+ let name =
+ match t.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ (* Some part of the type we've already printed has assigned another
+ * unification variable to that name. We want to keep the name, so
+ * try adding a number until we find a name that's not taken. *)
+ let available name =
+ List.for_all
+ (fun (_, name') -> name <> name')
+ !names
+ in
+ if available name then name
+ else
+ let suffixed i = name ^ Int.to_string i in
+ let i = Misc.find_first_mono (fun i -> available (suffixed i)) in
+ suffixed i
+ | _ ->
+ (* No name available, create a new one *)
+ name_generator ()
+ in
+ (* Exception for type declarations *)
+ if name <> "_" then names := (t, name) :: !names;
+ name
+
+ let check_name_of_type ~non_gen px =
+ let name_gen = new_var_name ~non_gen (Transient_expr.type_expr px) in
+ ignore(name_of_type name_gen px)
+
+ let remove_names tyl =
+ let tyl = List.map substitute tyl in
+ names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+
+ let with_local_names f =
+ let old_names = !names in
+ let old_subst = !name_subst in
+ names := [];
+ name_subst := [];
+ try_finally
+ ~always:(fun () ->
+ names := old_names;
+ name_subst := old_subst)
+ f
+
+ let refresh_weak () =
+ let refresh t name (m,s) =
+ if is_non_gen Type_scheme t then
+ begin
+ TypeMap.add t name m,
+ String.Set.add name s
+ end
+ else m, s in
+ let m, s =
+ TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
+ named_weak_vars := s;
+ weak_var_map := m
+
+ let reserve ty =
+ normalize_type ty;
+ add_named_vars ty
+end
+
+module Aliases = struct
+ let visited_objects = ref ([] : transient_expr list)
+ let aliased = ref ([] : transient_expr list)
+ let delayed = ref ([] : transient_expr list)
+ let printed_aliases = ref ([] : transient_expr list)
+
+(* [printed_aliases] is a subset of [aliased] that records only those aliased
+ types that have actually been printed; this allows us to avoid naming loops
+ that the user will never see. *)
+
+ let is_delayed t = List.memq t !delayed
+
+ let remove_delay t =
+ if is_delayed t then
+ delayed := List.filter ((!=) t) !delayed
+
+ let add_delayed t =
+ if not (is_delayed t) then delayed := t :: !delayed
+
+ let is_aliased_proxy px = List.memq px !aliased
+ let is_printed_proxy px = List.memq px !printed_aliases
+
+ let add_proxy px =
+ if not (is_aliased_proxy px) then
+ aliased := px :: !aliased
+
+ let add ty = add_proxy (proxy ty)
+
+ let add_printed_proxy ~non_gen px =
+ Variable_names.check_name_of_type ~non_gen px;
+ printed_aliases := px :: !printed_aliases
+
+ let mark_as_printed px =
+ if is_aliased_proxy px then (add_printed_proxy ~non_gen:false) px
+
+ let add_printed ty = add_printed_proxy (proxy ty)
+
+ let aliasable ty =
+ match get_desc ty with
+ Tvar _ | Tunivar _ | Tpoly _ -> false
+ | Tconstr (p, _, _) ->
+ not (is_nth (snd (best_type_path p)))
+ | _ -> true
+
+ let should_visit_object ty =
+ match get_desc ty with
+ | Tvariant row -> not (static_row row)
+ | Tobject _ -> opened_object ty
+ | _ -> false
+
+ let rec mark_loops_rec visited ty =
+ let px = proxy ty in
+ if List.memq px visited && aliasable ty then add_proxy px else
+ let tty = Transient_expr.repr ty in
+ let visited = px :: visited in
+ match tty.desc with
+ | Tvariant _ | Tobject _ ->
+ if List.memq px !visited_objects then add_proxy px else begin
+ if should_visit_object ty then
+ visited_objects := px :: !visited_objects;
+ printer_iter_type_expr (mark_loops_rec visited) ty
+ end
+ | Tpoly(ty, tyl) ->
+ List.iter add tyl;
+ mark_loops_rec visited ty
+ | _ ->
+ printer_iter_type_expr (mark_loops_rec visited) ty
+
+ let mark_loops ty =
+ mark_loops_rec [] ty
+
+ let reset () =
+ visited_objects := []; aliased := []; delayed := []; printed_aliases := []
+
+end
+
+let prepare_type ty =
+ Variable_names.reserve ty;
+ Aliases.mark_loops ty
+
+
+let reset_except_conflicts () =
+ Variable_names.reset_names (); Aliases.reset (); Internal_names.reset ()
+
+let reset () =
+ Ident_conflicts.reset ();
+ reset_except_conflicts ()
+
+let prepare_for_printing tyl =
+ reset_except_conflicts ();
+ List.iter prepare_type tyl
+
+let add_type_to_preparation = prepare_type
+
+(* Disabled in classic mode when printing an unification error *)
+let print_labels = ref true
+let with_labels b f = Misc.protect_refs [R (print_labels,b)] f
+
+let alias_nongen_row mode px ty =
+ match get_desc ty with
+ | Tvariant _ | Tobject _ ->
+ if is_non_gen mode (Transient_expr.type_expr px) then
+ Aliases.add_proxy px
+ | _ -> ()
+
+let rec tree_of_typexp mode ty =
+ let px = proxy ty in
+ if Aliases.is_printed_proxy px && not (Aliases.is_delayed px) then
+ let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+ let name = Variable_names.(name_of_type (new_var_name ~non_gen ty)) px in
+ Otyp_var (non_gen, name) else
+
+ let pr_typ () =
+ let tty = Transient_expr.repr ty in
+ match tty.desc with
+ | Tvar _ ->
+ let non_gen = is_non_gen mode ty in
+ let name_gen = Variable_names.new_var_name ~non_gen ty in
+ Otyp_var (non_gen, Variable_names.name_of_type name_gen tty)
+ | Tarrow(l, ty1, ty2, _) ->
+ let lab =
+ if !print_labels || is_optional l then l else Nolabel
+ in
+ let t1 =
+ if is_optional l then
+ match get_desc ty1 with
+ | Tconstr(path, [ty], _)
+ when Path.same path Predef.path_option ->
+ tree_of_typexp mode ty
+ | _ -> Otyp_stuff "<hidden>"
+ else tree_of_typexp mode ty1 in
+ Otyp_arrow (lab, t1, tree_of_typexp mode ty2)
+ | Ttuple tyl ->
+ Otyp_tuple (tree_of_typlist mode tyl)
+ | Tconstr(p, tyl, _abbrev) ->
+ let p', s = best_type_path p in
+ let tyl' = apply_subst s tyl in
+ if is_nth s && not (tyl'=[])
+ then tree_of_typexp mode (List.hd tyl')
+ else begin
+ Internal_names.add p';
+ Otyp_constr (tree_of_best_type_path p p', tree_of_typlist mode tyl')
+ end
+ | Tvariant row ->
+ let Row {fields; name; closed; _} = row_repr row in
+ let fields =
+ if closed then
+ List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
+ fields
+ else fields in
+ let present =
+ List.filter
+ (fun (_, f) ->
+ match row_field_repr f with
+ | Rpresent _ -> true
+ | _ -> false)
+ fields in
+ let all_present = List.length present = List.length fields in
+ begin match name with
+ | Some(p, tyl) when nameable_row row ->
+ let (p', s) = best_type_path p in
+ let id = tree_of_best_type_path p p' in
+ let args = tree_of_typlist mode (apply_subst s tyl) in
+ let out_variant =
+ if is_nth s then List.hd args else Otyp_constr (id, args) in
+ if closed && all_present then
+ out_variant
+ else
+ let tags =
+ if all_present then None else Some (List.map fst present) in
+ Otyp_variant (Ovar_typ out_variant, closed, tags)
+ | _ ->
+ let fields = List.map (tree_of_row_field mode) fields in
+ let tags =
+ if all_present then None else Some (List.map fst present) in
+ Otyp_variant (Ovar_fields fields, closed, tags)
+ end
+ | Tobject (fi, nm) ->
+ tree_of_typobject mode fi !nm
+ | Tnil | Tfield _ ->
+ tree_of_typobject mode ty None
+ | Tsubst _ ->
+ (* This case should only happen when debugging the compiler *)
+ Otyp_stuff "<Tsubst>"
+ | Tlink _ ->
+ fatal_error "Out_type.tree_of_typexp"
+ | Tpoly (ty, []) ->
+ tree_of_typexp mode ty
+ | Tpoly (ty, tyl) ->
+ (*let print_names () =
+ List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
+ prerr_string "; " in *)
+ if tyl = [] then tree_of_typexp mode ty else begin
+ let tyl = List.map Transient_expr.repr tyl in
+ let old_delayed = !Aliases.delayed in
+ (* Make the names delayed, so that the real type is
+ printed once when used as proxy *)
+ List.iter Aliases.add_delayed tyl;
+ let tl = List.map Variable_names.(name_of_type new_name) tyl in
+ let tr = Otyp_poly (tl, tree_of_typexp mode ty) in
+ (* Forget names when we leave scope *)
+ Variable_names.remove_names tyl;
+ Aliases.delayed := old_delayed; tr
+ end
+ | Tunivar _ ->
+ Otyp_var (false, Variable_names.(name_of_type new_name) tty)
+ | Tpackage (p, fl) ->
+ let fl =
+ List.map
+ (fun (li, ty) -> (
+ String.concat "." (Longident.flatten li),
+ tree_of_typexp mode ty
+ )) fl in
+ Otyp_module (tree_of_path (Some Module_type) p, fl)
+ in
+ Aliases.remove_delay px;
+ alias_nongen_row mode px ty;
+ if Aliases.(is_aliased_proxy px && aliasable ty) then begin
+ let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+ Aliases.add_printed_proxy ~non_gen px;
+ (* add_printed_alias chose a name, thus the name generator
+ doesn't matter.*)
+ let alias = Variable_names.(name_of_type (new_var_name ~non_gen ty)) px in
+ Otyp_alias {non_gen; aliased = pr_typ (); alias } end
+ else pr_typ ()
+
+and tree_of_row_field mode (l, f) =
+ match row_field_repr f with
+ | Rpresent None | Reither(true, [], _) -> (l, false, [])
+ | Rpresent(Some ty) -> (l, false, [tree_of_typexp mode ty])
+ | Reither(c, tyl, _) ->
+ if c (* contradiction: constant constructor with an argument *)
+ then (l, true, tree_of_typlist mode tyl)
+ else (l, false, tree_of_typlist mode tyl)
+ | Rabsent -> (l, false, [] (* actually, an error *))
+
+and tree_of_typlist mode tyl =
+ List.map (tree_of_typexp mode) tyl
+
+and tree_of_typobject mode fi nm =
+ begin match nm with
+ | None ->
+ let pr_fields fi =
+ let (fields, rest) = flatten_fields fi in
+ let present_fields =
+ List.fold_right
+ (fun (n, k, t) l ->
+ match field_kind_repr k with
+ | Fpublic -> (n, t) :: l
+ | _ -> l)
+ fields [] in
+ let sorted_fields =
+ List.sort
+ (fun (n, _) (n', _) -> String.compare n n') present_fields in
+ tree_of_typfields mode rest sorted_fields in
+ let (fields, open_row) = pr_fields fi in
+ Otyp_object {fields; open_row}
+ | Some (p, _ty :: tyl) ->
+ let args = tree_of_typlist mode tyl in
+ let (p', s) = best_type_path p in
+ assert (s = Id);
+ Otyp_class (tree_of_best_type_path p p', args)
+ | _ ->
+ fatal_error "Out_type.tree_of_typobject"
+ end
+
+and tree_of_typfields mode rest = function
+ | [] ->
+ let open_row =
+ match get_desc rest with
+ | Tvar _ | Tunivar _ | Tconstr _-> true
+ | Tnil -> false
+ | _ -> fatal_error "typfields (1)"
+ in
+ ([], open_row)
+ | (s, t) :: l ->
+ let field = (s, tree_of_typexp mode t) in
+ let (fields, rest) = tree_of_typfields mode rest l in
+ (field :: fields, rest)
+
+let typexp mode ppf ty =
+ !Oprint.out_type ppf (tree_of_typexp mode ty)
+
+let prepared_type_expr ppf ty = typexp Type ppf ty
+
+(* "Half-prepared" type expression: [ty] should have had its names reserved, but
+ should not have had its loops marked. *)
+let type_expr_with_reserved_names ppf ty =
+ Aliases.reset ();
+ Aliases.mark_loops ty;
+ prepared_type_expr ppf ty
+
+
+let prepared_type_scheme ppf ty = typexp Type_scheme ppf ty
+
+(* Print one type declaration *)
+
+let tree_of_constraints params =
+ List.fold_right
+ (fun ty list ->
+ let ty' = unalias ty in
+ if proxy ty != proxy ty' then
+ let tr = tree_of_typexp Type_scheme ty in
+ (tr, tree_of_typexp Type_scheme ty') :: list
+ else list)
+ params []
+
+let filter_params tyl =
+ let params =
+ List.fold_left
+ (fun tyl ty ->
+ if List.exists (eq_type ty) tyl
+ then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
+ else ty :: tyl)
+ (* Two parameters might be identical due to a constraint but we need to
+ print them differently in order to make the output syntactically valid.
+ We use [Ttuple [ty]] because it is printed as [ty]. *)
+ (* Replacing fold_left by fold_right does not work! *)
+ [] tyl
+ in List.rev params
+
+let prepare_type_constructor_arguments = function
+ | Cstr_tuple l -> List.iter prepare_type l
+ | Cstr_record l -> List.iter (fun l -> prepare_type l.ld_type) l
+
+let tree_of_label l =
+ {
+ olab_name = Ident.name l.ld_id;
+ olab_mut = l.ld_mutable;
+ olab_type = tree_of_typexp Type l.ld_type;
+ }
+
+let tree_of_constructor_arguments = function
+ | Cstr_tuple l -> tree_of_typlist Type l
+ | Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
+
+let tree_of_single_constructor cd =
+ let name = Ident.name cd.cd_id in
+ let ret = Option.map (tree_of_typexp Type) cd.cd_res in
+ let args = tree_of_constructor_arguments cd.cd_args in
+ {
+ ocstr_name = name;
+ ocstr_args = args;
+ ocstr_return_type = ret;
+ }
+
+(* When printing GADT constructor, we need to forget the naming decision we took
+ for the type parameters and constraints. Indeed, in
+ {[
+ type 'a t = X: 'a -> 'b t
+ ]}
+ It is fine to print both the type parameter ['a] and the existentially
+ quantified ['a] in the definition of the constructor X as ['a]
+ *)
+let tree_of_constructor_in_decl cd =
+ match cd.cd_res with
+ | None -> tree_of_single_constructor cd
+ | Some _ ->
+ Variable_names.with_local_names (fun () -> tree_of_single_constructor cd)
+
+let prepare_decl id decl =
+ let params = filter_params decl.type_params in
+ begin match decl.type_manifest with
+ | Some ty ->
+ let vars = free_variables ty in
+ List.iter
+ (fun ty ->
+ if get_desc ty = Tvar (Some "_") && List.exists (eq_type ty) vars
+ then set_type_desc ty (Tvar None))
+ params
+ | None -> ()
+ end;
+ List.iter Aliases.add params;
+ List.iter prepare_type params;
+ List.iter (Aliases.add_printed ~non_gen:false) params;
+ let ty_manifest =
+ match decl.type_manifest with
+ | None -> None
+ | Some ty ->
+ let ty =
+ (* Special hack to hide variant name *)
+ match get_desc ty with
+ Tvariant row ->
+ begin match row_name row with
+ Some (Pident id', _) when Ident.same id id' ->
+ newgenty (Tvariant (set_row_name row None))
+ | _ -> ty
+ end
+ | _ -> ty
+ in
+ prepare_type ty;
+ Some ty
+ in
+ begin match decl.type_kind with
+ | Type_abstract _ -> ()
+ | Type_variant (cstrs, _rep) ->
+ List.iter
+ (fun c ->
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res)
+ cstrs
+ | Type_record(l, _rep) ->
+ List.iter (fun l -> prepare_type l.ld_type) l
+ | Type_open -> ()
+ end;
+ ty_manifest, params
+
+let tree_of_type_decl id decl =
+ let ty_manifest, params = prepare_decl id decl in
+ let type_param ot_variance =
+ function
+ | Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+ | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+ in
+ let type_defined decl =
+ let abstr =
+ match decl.type_kind with
+ Type_abstract _ ->
+ decl.type_manifest = None || decl.type_private = Private
+ | Type_record _ ->
+ decl.type_private = Private
+ | Type_variant (tll, _rep) ->
+ decl.type_private = Private ||
+ List.exists (fun cd -> cd.cd_res <> None) tll
+ | Type_open ->
+ decl.type_manifest = None
+ in
+ let vari =
+ List.map2
+ (fun ty v ->
+ let is_var = is_Tvar ty in
+ if abstr || not is_var then
+ let inj =
+ type_kind_is_abstract decl && Variance.mem Inj v &&
+ match decl.type_manifest with
+ | None -> true
+ | Some ty -> (* only abstract or private row types *)
+ decl.type_private = Private &&
+ Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
+ and (co, cn) = Variance.get_upper v in
+ (if not cn then Covariant else
+ if not co then Contravariant else NoVariance),
+ (if inj then Injective else NoInjectivity)
+ else (NoVariance, NoInjectivity))
+ decl.type_params decl.type_variance
+ in
+ (Ident.name id,
+ List.map2 (fun ty cocn -> type_param cocn (tree_of_typexp Type ty))
+ params vari)
+ in
+ let tree_of_manifest ty1 =
+ match ty_manifest with
+ | None -> ty1
+ | Some ty -> Otyp_manifest (tree_of_typexp Type ty, ty1)
+ in
+ let (name, args) = type_defined decl in
+ let constraints = tree_of_constraints params in
+ let ty, priv, unboxed =
+ match decl.type_kind with
+ | Type_abstract _ ->
+ begin match ty_manifest with
+ | None -> (Otyp_abstract, Public, false)
+ | Some ty ->
+ tree_of_typexp Type ty, decl.type_private, false
+ end
+ | Type_variant (cstrs, rep) ->
+ tree_of_manifest
+ (Otyp_sum (List.map tree_of_constructor_in_decl cstrs)),
+ decl.type_private,
+ (rep = Variant_unboxed)
+ | Type_record(lbls, rep) ->
+ tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
+ decl.type_private,
+ (match rep with Record_unboxed _ -> true | _ -> false)
+ | Type_open ->
+ tree_of_manifest Otyp_open,
+ decl.type_private,
+ false
+ in
+ { otype_name = name;
+ otype_params = args;
+ otype_type = ty;
+ otype_private = priv;
+ otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
+ otype_unboxed = unboxed;
+ otype_cstrs = constraints }
+
+let add_type_decl_to_preparation id decl =
+ ignore @@ prepare_decl id decl
+
+let tree_of_prepared_type_decl id decl =
+ tree_of_type_decl id decl
+
+let tree_of_type_decl id decl =
+ reset_except_conflicts();
+ tree_of_type_decl id decl
+
+let add_constructor_to_preparation c =
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res
+
+let prepared_constructor ppf c =
+ !Oprint.out_constr ppf (tree_of_single_constructor c)
+
+
+let tree_of_type_declaration id decl rs =
+ Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
+
+let tree_of_prepared_type_declaration id decl rs =
+ Osig_type (tree_of_prepared_type_decl id decl, tree_of_rec rs)
+
+let add_type_declaration_to_preparation id decl =
+ add_type_decl_to_preparation id decl
+
+let prepared_type_declaration id ppf decl =
+ !Oprint.out_sig_item ppf
+ (tree_of_prepared_type_declaration id decl Trec_first)
+
+
+(* When printing extension constructor, it is important to ensure that
+after printing the constructor, we are still in the scope of the constructor.
+For GADT constructor, this can be done by printing the type parameters inside
+their own isolated scope. This ensures that in
+{[
+ type 'b t += A: 'b -> 'b any t
+]}
+the type parameter `'b` is not bound when printing the type variable `'b` from
+the constructor definition from the type parameter.
+
+Contrarily, for non-gadt constructor, we must keep the same scope for
+the type parameters and the constructor because a type constraint may
+have changed the name of the type parameter:
+{[
+type -'a t = .. constraint <x:'a. 'a t -> 'a> = 'a
+(* the universal 'a is here to steal the name 'a from the type parameter *)
+type 'a t = X of 'a
+]} *)
+let add_extension_constructor_to_preparation ext =
+ let ty_params = filter_params ext.ext_type_params in
+ List.iter Aliases.add ty_params;
+ List.iter prepare_type ty_params;
+ prepare_type_constructor_arguments ext.ext_args;
+ Option.iter prepare_type ext.ext_ret_type
+
+let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
+ let ret = Option.map (tree_of_typexp Type) ext_ret_type in
+ let args = tree_of_constructor_arguments ext_args in
+ (args, ret)
+
+let prepared_tree_of_extension_constructor
+ id ext es
+ =
+ let ty_name = Path.name ext.ext_type_path in
+ let ty_params = filter_params ext.ext_type_params in
+ let type_param =
+ function
+ | Otyp_var (_, id) -> id
+ | _ -> "?"
+ in
+ let param_scope f =
+ match ext.ext_ret_type with
+ | None ->
+ (* normal constructor: same scope for parameters and the constructor *)
+ f ()
+ | Some _ ->
+ (* gadt constructor: isolated scope for the type parameters *)
+ Variable_names.with_local_names f
+ in
+ let ty_params =
+ param_scope
+ (fun () ->
+ List.iter (Aliases.add_printed ~non_gen:false) ty_params;
+ List.map (fun ty -> type_param (tree_of_typexp Type ty)) ty_params
+ )
+ in
+ let name = Ident.name id in
+ let args, ret =
+ extension_constructor_args_and_ret_type_subtree
+ ext.ext_args
+ ext.ext_ret_type
+ in
+ let ext =
+ { oext_name = name;
+ oext_type_name = ty_name;
+ oext_type_params = ty_params;
+ oext_args = args;
+ oext_ret_type = ret;
+ oext_private = ext.ext_private }
+ in
+ let es =
+ match es with
+ Text_first -> Oext_first
+ | Text_next -> Oext_next
+ | Text_exception -> Oext_exception
+ in
+ Osig_typext (ext, es)
+
+let tree_of_extension_constructor id ext es =
+ reset_except_conflicts ();
+ add_extension_constructor_to_preparation ext;
+ prepared_tree_of_extension_constructor id ext es
+
+let prepared_extension_constructor id ppf ext =
+ !Oprint.out_sig_item ppf
+ (prepared_tree_of_extension_constructor id ext Text_first)
+
+(* Print a value declaration *)
+
+let tree_of_value_description id decl =
+ (* Format.eprintf "@[%a@]@." raw_type_expr decl.val_type; *)
+ let id = Ident.name id in
+ let () = prepare_for_printing [decl.val_type] in
+ let ty = tree_of_typexp Type_scheme decl.val_type in
+ let vd =
+ { oval_name = id;
+ oval_type = ty;
+ oval_prims = [];
+ oval_attributes = [] }
+ in
+ let vd =
+ match decl.val_kind with
+ | Val_prim p -> Primitive.print p vd
+ | _ -> vd
+ in
+ Osig_value vd
+
+(* Print a class type *)
+
+let method_type priv ty =
+ match priv, get_desc ty with
+ | Mpublic, Tpoly(ty, tyl) -> (ty, tyl)
+ | _ , _ -> (ty, [])
+
+let prepare_method _lab (priv, _virt, ty) =
+ let ty, _ = method_type priv ty in
+ prepare_type ty
+
+let tree_of_method mode (lab, priv, virt, ty) =
+ let (ty, tyl) = method_type priv ty in
+ let tty = tree_of_typexp mode ty in
+ Variable_names.remove_names (List.map Transient_expr.repr tyl);
+ let priv = priv <> Mpublic in
+ let virt = virt = Virtual in
+ Ocsg_method (lab, priv, virt, tty)
+
+let rec prepare_class_type params = function
+ | Cty_constr (_p, tyl, cty) ->
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !Aliases.visited_objects
+ || not (List.for_all is_Tvar params)
+ || List.exists (deep_occur row) tyl
+ then prepare_class_type params cty
+ else List.iter prepare_type tyl
+ | Cty_signature sign ->
+ (* Self may have a name *)
+ let px = proxy sign.csig_self_row in
+ if List.memq px !Aliases.visited_objects then Aliases.add_proxy px
+ else Aliases.(visited_objects := px :: !visited_objects);
+ Vars.iter (fun _ (_, _, ty) -> prepare_type ty) sign.csig_vars;
+ Meths.iter prepare_method sign.csig_meths
+ | Cty_arrow (_, ty, cty) ->
+ prepare_type ty;
+ prepare_class_type params cty
+
+let rec tree_of_class_type mode params =
+ function
+ | Cty_constr (p', tyl, cty) ->
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !Aliases.visited_objects
+ || not (List.for_all is_Tvar params)
+ then
+ tree_of_class_type mode params cty
+ else
+ let namespace = Namespace.best_class_namespace p' in
+ Octy_constr (tree_of_path namespace p', tree_of_typlist Type_scheme tyl)
+ | Cty_signature sign ->
+ let px = proxy sign.csig_self_row in
+ let self_ty =
+ if Aliases.is_aliased_proxy px then
+ Some
+ (Otyp_var (false, Variable_names.(name_of_type new_name) px))
+ else None
+ in
+ let csil = [] in
+ let csil =
+ List.fold_left
+ (fun csil (ty1, ty2) -> Ocsg_constraint (ty1, ty2) :: csil)
+ csil (tree_of_constraints params)
+ in
+ let all_vars =
+ Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.csig_vars []
+ in
+ (* Consequence of PR#3607: order of Map.fold has changed! *)
+ let all_vars = List.rev all_vars in
+ let csil =
+ List.fold_left
+ (fun csil (l, m, v, t) ->
+ Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp mode t)
+ :: csil)
+ csil all_vars
+ in
+ let all_meths =
+ Meths.fold
+ (fun l (p, v, t) all -> (l, p, v, t) :: all)
+ sign.csig_meths []
+ in
+ let all_meths = List.rev all_meths in
+ let csil =
+ List.fold_left
+ (fun csil meth -> tree_of_method mode meth :: csil)
+ csil all_meths
+ in
+ Octy_signature (self_ty, List.rev csil)
+ | Cty_arrow (l, ty, cty) ->
+ let lab =
+ if !print_labels || is_optional l then l else Nolabel
+ in
+ let tr =
+ if is_optional l then
+ match get_desc ty with
+ | Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
+ tree_of_typexp mode ty
+ | _ -> Otyp_stuff "<hidden>"
+ else tree_of_typexp mode ty in
+ Octy_arrow (lab, tr, tree_of_class_type mode params cty)
+
+
+let tree_of_class_param param variance =
+ let ot_variance =
+ if is_Tvar param then Asttypes.(NoVariance, NoInjectivity) else variance in
+ match tree_of_typexp Type_scheme param with
+ Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+ | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+
+let class_variance =
+ let open Variance in let open Asttypes in
+ List.map (fun v ->
+ (if not (mem May_pos v) then Contravariant else
+ if not (mem May_neg v) then Covariant else NoVariance),
+ NoInjectivity)
+
+let tree_of_class_declaration id cl rs =
+ let params = filter_params cl.cty_params in
+
+ reset_except_conflicts ();
+ List.iter Aliases.add params;
+ prepare_class_type params cl.cty_type;
+ let px = proxy (Btype.self_type_row cl.cty_type) in
+ List.iter prepare_type params;
+
+ List.iter (Aliases.add_printed ~non_gen:false) params;
+ if Aliases.is_aliased_proxy px then
+ Aliases.add_printed_proxy ~non_gen:false px;
+
+ let vir_flag = cl.cty_new = None in
+ Osig_class
+ (vir_flag, Ident.name id,
+ List.map2 tree_of_class_param params (class_variance cl.cty_variance),
+ tree_of_class_type Type_scheme params cl.cty_type,
+ tree_of_rec rs)
+
+let tree_of_cltype_declaration id cl rs =
+ let params = cl.clty_params in
+
+ reset_except_conflicts ();
+ List.iter Aliases.add params;
+ prepare_class_type params cl.clty_type;
+ let px = proxy (Btype.self_type_row cl.clty_type) in
+ List.iter prepare_type params;
+
+ List.iter (Aliases.add_printed ~non_gen:false) params;
+ Aliases.mark_as_printed px;
+
+ let sign = Btype.signature_of_class_type cl.clty_type in
+ let has_virtual_vars =
+ Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_vars false
+ in
+ let has_virtual_meths =
+ Meths.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_meths false
+ in
+ Osig_class_type
+ (has_virtual_vars || has_virtual_meths, Ident.name id,
+ List.map2 tree_of_class_param params (class_variance cl.clty_variance),
+ tree_of_class_type Type_scheme params cl.clty_type,
+ tree_of_rec rs)
+
+(* Print a module type *)
+
+let wrap_env fenv ftree arg =
+ (* We save the current value of the short-path cache *)
+ (* From keys *)
+ let env = !printing_env in
+ let old_pers = !printing_pers in
+ (* to data *)
+ let old_map = !printing_map in
+ let old_depth = !printing_depth in
+ let old_cont = !printing_cont in
+ set_printing_env (fenv env);
+ let tree = ftree arg in
+ if !Clflags.real_paths
+ || same_printing_env env then ()
+ (* our cached key is still live in the cache, and we want to keep all
+ progress made on the computation of the [printing_map] *)
+ else begin
+ (* we restore the snapshotted cache before calling set_printing_env *)
+ printing_old := env;
+ printing_pers := old_pers;
+ printing_depth := old_depth;
+ printing_cont := old_cont;
+ printing_map := old_map
+ end;
+ set_printing_env env;
+ tree
+
+let dummy =
+ {
+ type_params = [];
+ type_arity = 0;
+ type_kind = Type_abstract Definition;
+ type_private = Public;
+ type_manifest = None;
+ type_variance = [];
+ type_separability = [];
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = Location.none;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.internal_not_actually_unique;
+ }
+
+(** we hide items being defined from short-path to avoid shortening
+ [type t = Path.To.t] into [type t = t].
+*)
+
+let ident_sigitem = function
+ | Types.Sig_type(ident,_,_,_) -> {hide=true;ident}
+ | Types.Sig_class(ident,_,_,_)
+ | Types.Sig_class_type (ident,_,_,_)
+ | Types.Sig_module(ident,_, _,_,_)
+ | Types.Sig_value (ident,_,_)
+ | Types.Sig_modtype (ident,_,_)
+ | Types.Sig_typext (ident,_,_,_) -> {hide=false; ident }
+
+let hide ids env =
+ let hide_id id env =
+ (* Global idents cannot be renamed *)
+ if id.hide && not (Ident.global id.ident) then
+ Env.add_type ~check:false (Ident.rename id.ident) dummy env
+ else env
+ in
+ List.fold_right hide_id ids env
+
+let with_hidden_items ids f =
+ let with_hidden_in_printing_env ids f =
+ wrap_env (hide ids) (Ident_names.with_hidden ids) f
+ in
+ if not !Clflags.real_paths then
+ with_hidden_in_printing_env ids f
+ else
+ Ident_names.with_hidden ids f
+
+
+let add_sigitem env x =
+ Env.add_signature (Signature_group.flatten x) env
+
+let rec tree_of_modtype ?(ellipsis=false) = function
+ | Mty_ident p ->
+ Omty_ident (tree_of_path (Some Module_type) p)
+ | Mty_signature sg ->
+ Omty_signature (if ellipsis then [Osig_ellipsis]
+ else tree_of_signature sg)
+ | Mty_functor(param, ty_res) ->
+ let param, env =
+ tree_of_functor_parameter param
+ in
+ let res = wrap_env env (tree_of_modtype ~ellipsis) ty_res in
+ Omty_functor (param, res)
+ | Mty_alias p ->
+ Omty_alias (tree_of_path (Some Module) p)
+
+and tree_of_functor_parameter = function
+ | Unit ->
+ None, fun k -> k
+ | Named (param, ty_arg) ->
+ let name, env =
+ match param with
+ | None -> None, fun env -> env
+ | Some id ->
+ Some (Ident.name id),
+ Env.add_module ~arg:true id Mp_present ty_arg
+ in
+ Some (name, tree_of_modtype ~ellipsis:false ty_arg), env
+
+and tree_of_signature sg =
+ wrap_env (fun env -> env)(fun sg ->
+ let tree_groups = tree_of_signature_rec !printing_env sg in
+ List.concat_map (fun (_env,l) -> List.map snd l) tree_groups
+ ) sg
+
+and tree_of_signature_rec env' sg =
+ let structured = List.of_seq (Signature_group.seq sg) in
+ let collect_trees_of_rec_group group =
+ let env = !printing_env in
+ let env', group_trees =
+ trees_of_recursive_sigitem_group env group
+ in
+ set_printing_env env';
+ (env, group_trees) in
+ set_printing_env env';
+ List.map collect_trees_of_rec_group structured
+
+and trees_of_recursive_sigitem_group env
+ (syntactic_group: Signature_group.rec_group) =
+ let display (x:Signature_group.sig_item) = x.src, tree_of_sigitem x.src in
+ let env = Env.add_signature syntactic_group.pre_ghosts env in
+ match syntactic_group.group with
+ | Not_rec x -> add_sigitem env x, [display x]
+ | Rec_group items ->
+ let ids = List.map (fun x -> ident_sigitem x.Signature_group.src) items in
+ List.fold_left add_sigitem env items,
+ with_hidden_items ids (fun () -> List.map display items)
+
+and tree_of_sigitem = function
+ | Sig_value(id, decl, _) ->
+ tree_of_value_description id decl
+ | Sig_type(id, decl, rs, _) ->
+ tree_of_type_declaration id decl rs
+ | Sig_typext(id, ext, es, _) ->
+ tree_of_extension_constructor id ext es
+ | Sig_module(id, _, md, rs, _) ->
+ let ellipsis =
+ List.exists (function
+ | Parsetree.{attr_name = {txt="..."}; attr_payload = PStr []} -> true
+ | _ -> false)
+ md.md_attributes in
+ tree_of_module id md.md_type rs ~ellipsis
+ | Sig_modtype(id, decl, _) ->
+ tree_of_modtype_declaration id decl
+ | Sig_class(id, decl, rs, _) ->
+ tree_of_class_declaration id decl rs
+ | Sig_class_type(id, decl, rs, _) ->
+ tree_of_cltype_declaration id decl rs
+
+and tree_of_modtype_declaration id decl =
+ let mty =
+ match decl.mtd_type with
+ | None -> Omty_abstract
+ | Some mty -> tree_of_modtype mty
+ in
+ Osig_modtype (Ident.name id, mty)
+
+and tree_of_module id ?ellipsis mty rs =
+ Osig_module (Ident.name id, tree_of_modtype ?ellipsis mty, tree_of_rec rs)
+
+(* For the toplevel: merge with tree_of_signature? *)
+let print_items showval env x =
+ Variable_names.refresh_weak();
+ Ident_conflicts.reset ();
+ let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
+ let post_process (env,l) = List.map (extend_val env) l in
+ List.concat_map post_process @@ tree_of_signature_rec env x
+
+let same_path t t' =
+ let open Types in
+ eq_type t t' ||
+ match get_desc t, get_desc t' with
+ Tconstr(p,tl,_), Tconstr(p',tl',_) ->
+ let (p1, s1) = best_type_path p and (p2, s2) = best_type_path p' in
+ begin match s1, s2 with
+ Nth n1, Nth n2 when n1 = n2 -> true
+ | (Id | Map _), (Id | Map _) when Path.same p1 p2 ->
+ let tl = apply_subst s1 tl and tl' = apply_subst s2 tl' in
+ List.length tl = List.length tl' &&
+ List.for_all2 eq_type tl tl'
+ | _ -> false
+ end
+ | _ ->
+ false
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+
+let trees_of_type_expansion mode Errortrace.{ty = t; expanded = t'} =
+ Aliases.reset ();
+ Aliases.mark_loops t;
+ if same_path t t'
+ then begin Aliases.add_delayed (proxy t); Same (tree_of_typexp mode t) end
+ else begin
+ Aliases.mark_loops t';
+ let t' = if proxy t == proxy t' then unalias t' else t' in
+ (* beware order matter due to side effect,
+ e.g. when printing object types *)
+ let first = tree_of_typexp mode t in
+ let second = tree_of_typexp mode t' in
+ if first = second then Same first
+ else Diff(first,second)
+ end
+
+let pp_type ppf t =
+ Style.as_inline_code !Oprint.out_type ppf t
+
+let pp_type_expansion ppf = function
+ | Same t -> pp_type ppf t
+ | Diff(t,t') ->
+ fprintf ppf "@[<2>%a@ =@ %a@]"
+ pp_type t
+ pp_type t'
+
+(* Hide variant name and var, to force printing the expanded type *)
+let hide_variant_name t =
+ let open Types in
+ match get_desc t with
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ if name = None then t else
+ Btype.newty2 ~level:(get_level t)
+ (Tvariant
+ (create_row ~fields ~fixed ~closed ~name:None
+ ~more:(Ctype.newvar2 (get_level more))))
+ | _ -> t
+
+let prepare_expansion Errortrace.{ty; expanded} =
+ let expanded = hide_variant_name expanded in
+ Variable_names.reserve ty;
+ if not (same_path ty expanded) then Variable_names.reserve expanded;
+ Errortrace.{ty; expanded}
+
+
+(* Adapt functions to exposed interface *)
+let namespaced_tree_of_path n = tree_of_path (Some n)
+let tree_of_path ?disambiguation p = tree_of_path ?disambiguation None p
+let tree_of_modtype = tree_of_modtype ~ellipsis:false
+let tree_of_type_declaration ident td rs =
+ with_hidden_items [{hide=true; ident}]
+ (fun () -> tree_of_type_declaration ident td rs)
+
+let tree_of_class_type kind cty = tree_of_class_type kind [] cty
+let prepare_class_type cty = prepare_class_type [] cty
+
+let tree_of_type_path p =
+ let (p', s) = best_type_path p in
+ let p'' = if (s = Id) then p' else p in
+ tree_of_best_type_path p p''
diff --git a/upstream/ocaml_503/typing/out_type.mli b/upstream/ocaml_503/typing/out_type.mli
new file mode 100644
index 0000000000..b134fa1196
--- /dev/null
+++ b/upstream/ocaml_503/typing/out_type.mli
@@ -0,0 +1,259 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Functions for representing type expressions and module types as outcometree
+ (with [as 'a] aliases for cycles) and printing them. All functions below
+ depends on global contexts that keep track of
+
+- If labels are disabled
+- Current printing environment
+- Shortest equivalent paths
+
+- Conflicts for identifier names
+- Names chosen for type variables
+- Aliases used for representing cycles or row variables
+- Uses of internal names
+
+Whenever possible, it is advised to use the simpler functions available in
+{!Printtyp} which take care of setting up this naming context. The functions
+below are needed when one needs to share a common naming context (or part of it)
+between different calls to printing functions (or in order to implement
+{!Printtyp}).
+*)
+
+open Format_doc
+open Types
+open Outcometree
+
+(** {1 Wrapping functions}*)
+
+val wrap_printing_env: error:bool -> Env.t -> (unit -> 'a) -> 'a
+(** Call the function using the environment for type path shortening
+ This affects all the printing and tree cration functions functions below
+ Also, if [~error:true], then disable the loading of cmis *)
+
+
+(** [with_labels false] disable labels in function types *)
+val with_labels: bool -> (unit -> 'a) -> 'a
+
+(** {1 Printing idents and paths } *)
+
+val ident_name: Shape.Sig_component_kind.t option -> Ident.t -> out_name
+val tree_of_path: ?disambiguation:bool -> Path.t -> out_ident
+val namespaced_tree_of_path: Shape.Sig_component_kind.t -> Path.t -> out_ident
+val tree_of_type_path: Path.t -> out_ident
+(** Specialized functions for printing types with [short-paths] *)
+
+(** [same_path ty ty2] is true when there is an equation [ty]=[ty2] in the
+ short-path scope*)
+val same_path: type_expr -> type_expr -> bool
+
+(** Simple heuristic to rewrite Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+ for Foo__bar. This pattern is used by the stdlib. *)
+val rewrite_double_underscore_paths: Env.t -> Path.t -> Path.t
+
+(** {1 Printing type expressions} *)
+
+(** Printing type expressions requires to translate the internal graph based
+ representation into to an {!Outcometree} closer to the source syntax. In
+ order to do so, the printing is generally split in three phase:
+ - A preparation phase which in particular
+ - marks cycles
+ - chooses user-facing names for type variables
+ - An outcometree generation phase, where we emit an outcometree as a
+ ready-for-printing representation of trees (represented by the various
+ [tree_of_*] functions)
+ - Printing proper
+*)
+
+(** [prepare_for_printing] resets the global naming environment, a la
+ {!reset_except_conflicts}, and prepares the types for printing by reserving
+ variable names and marking cycles. Any type variables that are shared
+ between multiple types in the input list will be given the same name when
+ printed with {!prepared_type_expr}. *)
+val prepare_for_printing: type_expr list -> unit
+
+(** [add_type_to_preparation ty] extend a previous type expression preparation
+ to the type expression [ty]
+*)
+val add_type_to_preparation: type_expr -> unit
+
+(** In [Type_scheme] mode, non-generic types variables are printed as weakly
+ polymorphic type variables. *)
+type type_or_scheme = Type | Type_scheme
+val tree_of_typexp: type_or_scheme -> type_expr -> out_type
+(** [tree_of_typexp] generate the [outcometree] for a prepared type
+ expression.*)
+
+val prepared_type_scheme: type_expr printer
+val prepared_type_expr: type_expr printer
+(** The printers [prepared_type_expr] and [prepared_type_scheme] should only be
+ used on prepared types. Types can be prepared by initially calling
+ {!prepare_for_printing} or adding them later to the preparation with
+ {!add_type_to_preparation}.
+
+ Calling this function on non-prepared types may cause a stack overflow (see
+ #8860) due to cycles in the printed types.
+
+ See {!Printtyp.type_expr} for a safer but less flexible printer. *)
+
+(** [type_expr_with_reserved_names] can print "half-prepared" type expression. A
+ "half-prepared" type expression should have had its names reserved (with
+ {!Variable_names.reserve}), but should not have had its cycles marked. *)
+val type_expr_with_reserved_names: type_expr printer
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+val trees_of_type_expansion:
+ type_or_scheme -> Errortrace.expanded_type -> out_type diff
+val prepare_expansion: Errortrace.expanded_type -> Errortrace.expanded_type
+val pp_type_expansion: out_type diff printer
+val hide_variant_name: Types.type_expr -> Types.type_expr
+
+
+(** {1: Label and constructors }*)
+val prepare_type_constructor_arguments: constructor_arguments -> unit
+val tree_of_constructor_arguments: constructor_arguments -> out_type list
+
+val tree_of_label: label_declaration -> out_label
+
+val add_constructor_to_preparation : constructor_declaration -> unit
+val prepared_constructor : constructor_declaration printer
+
+val tree_of_extension_constructor:
+ Ident.t -> extension_constructor -> ext_status -> out_sig_item
+val extension_constructor_args_and_ret_type_subtree:
+ constructor_arguments -> type_expr option -> out_type list * out_type option
+val add_extension_constructor_to_preparation :
+ extension_constructor -> unit
+val prepared_extension_constructor:
+ Ident.t -> extension_constructor printer
+
+
+(** {1 Declarations }*)
+
+val tree_of_type_declaration:
+ Ident.t -> type_declaration -> rec_status -> out_sig_item
+val add_type_declaration_to_preparation :
+ Ident.t -> type_declaration -> unit
+val prepared_type_declaration: Ident.t -> type_declaration printer
+
+val tree_of_value_description: Ident.t -> value_description -> out_sig_item
+val tree_of_modtype_declaration:
+ Ident.t -> modtype_declaration -> out_sig_item
+val tree_of_class_declaration:
+ Ident.t -> class_declaration -> rec_status -> out_sig_item
+val tree_of_cltype_declaration:
+ Ident.t -> class_type_declaration -> rec_status -> out_sig_item
+
+(** {1 Module types }*)
+
+val tree_of_module:
+ Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item
+val tree_of_modtype: module_type -> out_module_type
+val tree_of_signature: Types.signature -> out_sig_item list
+
+val tree_of_class_type: type_or_scheme -> class_type -> out_class_type
+val prepare_class_type: class_type -> unit
+
+(** {1 Toplevel printing} *)
+val print_items: (Env.t -> signature_item -> 'a option) ->
+ Env.t -> signature_item list -> (out_sig_item * 'a option) list
+
+(** {1 Naming contexts }*)
+
+(** Path name, which were mutable at some point *)
+module Out_name: sig
+ val create: string -> out_name
+ val print: out_name -> string
+end
+
+(** Disambiguation for identifiers, e.g. the two type constructors named [t]
+in the type of [f] in
+{[
+ type t = A
+ module M = struct
+ type t = B
+ let f A = B
+ end
+]}
+should be disambiguated to [t/2->t] *)
+module Ident_names: sig
+ val enable: bool -> unit
+ (** When contextual names are enabled, the mapping between identifiers
+ and names is ensured to be one-to-one. *)
+
+ (** [with_fuzzy id f] locally disable ident disambiguation for [id] within
+ [f] *)
+ val with_fuzzy: Ident.t -> (unit -> 'a) -> 'a
+end
+
+(** The [Ident_conflicts] module keeps track of conflicts arising when
+ attributing names to identifiers and provides functions that can print
+ explanations for these conflict in error messages *)
+module Ident_conflicts: sig
+ val exists: unit -> bool
+ (** [exists()] returns true if the current naming context renamed
+ an identifier to avoid a name collision *)
+
+ type explanation =
+ { kind: Shape.Sig_component_kind.t;
+ name:string;
+ root_name:string;
+ location:Location.t
+ }
+
+ val list_explanations: unit -> explanation list
+(** [list_explanations()] return the list of conflict explanations
+ collected up to this point, and reset the list of collected
+ explanations *)
+
+ val print_located_explanations: explanation list printer
+
+ val err_print: formatter -> unit
+ val err_msg: unit -> doc option
+ (** [err_msg ()] return an error message if there are pending conflict
+ explanations at this point. It is often important to check for conflicts
+ after all printing is done, thus the delayed nature of [err_msg]*)
+
+ val reset: unit -> unit
+end
+
+(** Naming choice for type variable names (['a], ['b], ...), for instance the
+ two classes of distinct type variables in
+ {[let repeat x y = x, y, y, x]}
+ should be printed printed as ['a -> 'b -> 'a * 'b * 'b * 'a].
+*)
+module Variable_names: sig
+
+ (** Add external type equalities*)
+ val add_subst: (type_expr * type_expr) list -> unit
+
+ (** [reserve ty] registers the variable names appearing in [ty] *)
+ val reserve: type_expr -> unit
+end
+
+(** Register internal typechecker names ([$0],[$a]) appearing in the
+ [outcometree] *)
+module Internal_names: sig
+ val add: Path.t -> unit
+ val reset: unit -> unit
+ val print_explanations: Env.t -> formatter -> unit
+end
+
+(** Reset all contexts *)
+val reset: unit -> unit
+
+(** Reset all contexts except for conflicts *)
+val reset_except_conflicts: unit -> unit
diff --git a/upstream/ocaml_503/typing/outcometree.mli b/upstream/ocaml_503/typing/outcometree.mli
new file mode 100644
index 0000000000..f4b89630b0
--- /dev/null
+++ b/upstream/ocaml_503/typing/outcometree.mli
@@ -0,0 +1,166 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2001 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. *)
+(* *)
+(**************************************************************************)
+
+(* Module [Outcometree]: results displayed by the toplevel *)
+
+(* These types represent messages that the toplevel displays as normal
+ results or errors. The real displaying is customisable using the hooks:
+ [Toploop.print_out_value]
+ [Toploop.print_out_type]
+ [Toploop.print_out_sig_item]
+ [Toploop.print_out_phrase] *)
+
+(** An [out_name] is a string representation of an identifier which can be
+ rewritten on the fly to avoid name collisions *)
+type out_name = { mutable printed_name: string }
+
+type out_ident =
+ | Oide_apply of out_ident * out_ident
+ | Oide_dot of out_ident * string
+ | Oide_ident of out_name
+
+type out_string =
+ | Ostr_string
+ | Ostr_bytes
+
+type out_attribute =
+ { oattr_name: string }
+
+type out_value =
+ | Oval_array of out_value list
+ | Oval_char of char
+ | Oval_constr of out_ident * out_value list
+ | Oval_ellipsis
+ | Oval_float of float
+ | Oval_int of int
+ | Oval_int32 of int32
+ | Oval_int64 of int64
+ | Oval_nativeint of nativeint
+ | Oval_list of out_value list
+ | Oval_printer of (Format_doc.formatter -> unit)
+ | Oval_record of (out_ident * out_value) list
+ | Oval_string of string * int * out_string (* string, size-to-print, kind *)
+ | Oval_stuff of string
+ | Oval_tuple of out_value list
+ | Oval_variant of string * out_value option
+ | Oval_lazy of out_value
+
+type out_type_param = {
+ ot_non_gen: bool;
+ ot_name: string;
+ ot_variance: Asttypes.variance * Asttypes.injectivity
+}
+
+type out_type =
+ | Otyp_abstract
+ | Otyp_open
+ | Otyp_alias of {non_gen:bool; aliased:out_type; alias:string}
+ | Otyp_arrow of Asttypes.arg_label * out_type * out_type
+ | Otyp_class of out_ident * out_type list
+ | Otyp_constr of out_ident * out_type list
+ | Otyp_manifest of out_type * out_type
+ | Otyp_object of { fields: (string * out_type) list; open_row:bool}
+ | Otyp_record of out_label list
+ | Otyp_stuff of string
+ | Otyp_sum of out_constructor list
+ | Otyp_tuple of out_type list
+ | Otyp_var of bool * string
+ | Otyp_variant of out_variant * bool * (string list) option
+ | Otyp_poly of string list * out_type
+ | Otyp_module of out_ident * (string * out_type) list
+ | Otyp_attribute of out_type * out_attribute
+
+and out_label = {
+ olab_name: string;
+ olab_mut: Asttypes.mutable_flag;
+ olab_type: out_type;
+}
+
+and out_constructor = {
+ ocstr_name: string;
+ ocstr_args: out_type list;
+ ocstr_return_type: out_type option;
+}
+
+and out_variant =
+ | Ovar_fields of (string * bool * out_type list) list
+ | Ovar_typ of out_type
+
+type out_class_type =
+ | Octy_constr of out_ident * out_type list
+ | Octy_arrow of Asttypes.arg_label * out_type * out_class_type
+ | Octy_signature of out_type option * out_class_sig_item list
+and out_class_sig_item =
+ | Ocsg_constraint of out_type * out_type
+ | Ocsg_method of string * bool * bool * out_type
+ | Ocsg_value of string * bool * bool * out_type
+
+type out_module_type =
+ | Omty_abstract
+ | Omty_functor of (string option * out_module_type) option * out_module_type
+ | Omty_ident of out_ident
+ | Omty_signature of out_sig_item list
+ | Omty_alias of out_ident
+and out_sig_item =
+ | Osig_class of
+ bool * string * out_type_param list * out_class_type *
+ out_rec_status
+ | Osig_class_type of
+ bool * string * out_type_param list * out_class_type *
+ out_rec_status
+ | Osig_typext of out_extension_constructor * out_ext_status
+ | Osig_modtype of string * out_module_type
+ | Osig_module of string * out_module_type * out_rec_status
+ | Osig_type of out_type_decl * out_rec_status
+ | Osig_value of out_val_decl
+ | Osig_ellipsis
+and out_type_decl =
+ { otype_name: string;
+ otype_params: out_type_param list;
+ otype_type: out_type;
+ otype_private: Asttypes.private_flag;
+ otype_immediate: Type_immediacy.t;
+ otype_unboxed: bool;
+ otype_cstrs: (out_type * out_type) list }
+and out_extension_constructor =
+ { oext_name: string;
+ oext_type_name: string;
+ oext_type_params: string list;
+ oext_args: out_type list;
+ oext_ret_type: out_type option;
+ oext_private: Asttypes.private_flag }
+and out_type_extension =
+ { otyext_name: string;
+ otyext_params: string list;
+ otyext_constructors: out_constructor list;
+ otyext_private: Asttypes.private_flag }
+and out_val_decl =
+ { oval_name: string;
+ oval_type: out_type;
+ oval_prims: string list;
+ oval_attributes: out_attribute list }
+and out_rec_status =
+ | Orec_not
+ | Orec_first
+ | Orec_next
+and out_ext_status =
+ | Oext_first
+ | Oext_next
+ | Oext_exception
+
+type out_phrase =
+ | Ophr_eval of out_value * out_type
+ | Ophr_signature of (out_sig_item * out_value option) list
+ | Ophr_exception of (exn * out_value)
diff --git a/upstream/ocaml_503/typing/parmatch.ml b/upstream/ocaml_503/typing/parmatch.ml
new file mode 100644
index 0000000000..c1cc84e3a6
--- /dev/null
+++ b/upstream/ocaml_503/typing/parmatch.ml
@@ -0,0 +1,2363 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Detection of partial matches and unused match cases. *)
+
+open Misc
+open Asttypes
+open Types
+open Typedtree
+
+type 'pattern parmatch_case =
+ { pattern : 'pattern;
+ has_guard : bool;
+ needs_refute : bool;
+ }
+
+let typed_case { c_lhs; c_guard; c_rhs } =
+ { pattern = c_lhs;
+ has_guard = Option.is_some c_guard;
+ needs_refute = (c_rhs.exp_desc = Texp_unreachable);
+ }
+
+let untyped_case { Parsetree.pc_lhs; pc_guard; pc_rhs } =
+ { pattern = pc_lhs;
+ has_guard = Option.is_some pc_guard;
+ needs_refute = (pc_rhs.pexp_desc = Parsetree.Pexp_unreachable);
+ }
+
+(*************************************)
+(* Utilities for building patterns *)
+(*************************************)
+
+let make_pat desc ty tenv =
+ {pat_desc = desc; pat_loc = Location.none; pat_extra = [];
+ pat_type = ty ; pat_env = tenv;
+ pat_attributes = [];
+ }
+
+let omega = Patterns.omega
+let omegas = Patterns.omegas
+let omega_list = Patterns.omega_list
+
+let extra_pat =
+ make_pat
+ (Tpat_var (Ident.create_local "+", mknoloc "+",
+ Uid.internal_not_actually_unique))
+ Ctype.none Env.empty
+
+
+(*******************)
+(* Coherence check *)
+(*******************)
+
+(* For some of the operations we do in this module, we would like (because it
+ simplifies matters) to assume that patterns appearing on a given column in a
+ pattern matrix are /coherent/ (think "of the same type").
+ Unfortunately that is not always true.
+
+ Consider the following (well-typed) example:
+ {[
+ type _ t = S : string t | U : unit t
+
+ let f (type a) (t1 : a t) (t2 : a t) (a : a) =
+ match t1, t2, a with
+ | U, _, () -> ()
+ | _, S, "" -> ()
+ ]}
+
+ Clearly the 3rd column contains incoherent patterns.
+
+ On the example above, most of the algorithms will explore the pattern matrix
+ as illustrated by the following tree:
+
+ {v
+ S
+ -------> | "" |
+ U | S, "" | __/ | () |
+ --------> | _, () | \ not S
+ | U, _, () | __/ -------> | () |
+ | _, S, "" | \
+ ---------> | S, "" | ----------> | "" |
+ not U S
+ v}
+
+ where following an edge labelled by a pattern P means "assuming the value I
+ am matching on is filtered by [P] on the column I am currently looking at,
+ then the following submatrix is still reachable".
+
+ Notice that at any point of that tree, if the first column of a matrix is
+ incoherent, then the branch leading to it can only be taken if the scrutinee
+ is ill-typed.
+ In the example above the only case where we have a matrix with an incoherent
+ first column is when we consider [t1, t2, a] to be [U, S, ...]. However such
+ a value would be ill-typed, so we can never actually get there.
+
+ Checking the first column at each step of the recursion and making the
+ conscious decision of "aborting" the algorithm whenever the first column
+ becomes incoherent, allows us to retain the initial assumption in later
+ stages of the algorithms.
+
+ ---
+
+ N.B. two patterns can be considered coherent even though they might not be of
+ the same type.
+
+ That's in part because we only care about the "head" of patterns and leave
+ checking coherence of subpatterns for the next steps of the algorithm:
+ ('a', 'b') and (1, ()) will be deemed coherent because they are both a tuples
+ of arity 2 (we'll notice at a later stage the incoherence of 'a' and 1).
+
+ But also because it can be hard/costly to determine exactly whether two
+ patterns are of the same type or not (eg. in the example above with _ and S,
+ but see also the module [Coherence_illustration] in
+ testsuite/tests/basic-more/robustmatch.ml).
+
+ For the moment our weak, loosely-syntactic, coherence check seems to be
+ enough and we leave it to each user to consider (and document!) what happens
+ when an "incoherence" is not detected by this check.
+*)
+
+(* Given the first column of a simplified matrix, this function first looks for
+ a "discriminating" pattern on that column (i.e. a non-omega one) and then
+ check that every other head pattern in the column is coherent with that one.
+*)
+let all_coherent column =
+ let open Patterns.Head in
+ let coherent_heads hp1 hp2 =
+ match hp1.pat_desc, hp2.pat_desc with
+ | Construct c, Construct c' ->
+ c.cstr_consts = c'.cstr_consts
+ && c.cstr_nonconsts = c'.cstr_nonconsts
+ | Constant c1, Constant c2 -> begin
+ match c1, c2 with
+ | Const_char _, Const_char _
+ | Const_int _, Const_int _
+ | Const_int32 _, Const_int32 _
+ | Const_int64 _, Const_int64 _
+ | Const_nativeint _, Const_nativeint _
+ | Const_float _, Const_float _
+ | Const_string _, Const_string _ -> true
+ | ( Const_char _
+ | Const_int _
+ | Const_int32 _
+ | Const_int64 _
+ | Const_nativeint _
+ | Const_float _
+ | Const_string _), _ -> false
+ end
+ | Tuple l1, Tuple l2 -> l1 = l2
+ | Record (lbl1 :: _), Record (lbl2 :: _) ->
+ Array.length lbl1.lbl_all = Array.length lbl2.lbl_all
+ | Any, _
+ | _, Any
+ | Record [], Record []
+ | Variant _, Variant _
+ | Array _, Array _
+ | Lazy, Lazy -> true
+ | _, _ -> false
+ in
+ match
+ List.find
+ (function
+ | { pat_desc = Any } -> false
+ | _ -> true)
+ column
+ with
+ | exception Not_found ->
+ (* only omegas on the column: the column is coherent. *)
+ true
+ | discr_pat ->
+ List.for_all (coherent_heads discr_pat) column
+
+let first_column simplified_matrix =
+ List.map (fun ((head, _args), _rest) -> head) simplified_matrix
+
+(***********************)
+(* Compatibility check *)
+(***********************)
+
+(* Patterns p and q compatible means:
+ there exists value V that matches both, However....
+
+ The case of extension types is dubious, as constructor rebind permits
+ that different constructors are the same (and are thus compatible).
+
+ Compilation must take this into account, consider:
+
+ type t = ..
+ type t += A|B
+ type t += C=A
+
+ let f x y = match x,y with
+ | true,A -> '1'
+ | _,C -> '2'
+ | false,A -> '3'
+ | _,_ -> '_'
+
+ As C is bound to A the value of f false A is '2' (and not '3' as it would
+ be in the absence of rebinding).
+
+ Not considering rebinding, patterns "false,A" and "_,C" are incompatible
+ and the compiler can swap the second and third clause, resulting in the
+ (more efficiently compiled) matching
+
+ match x,y with
+ | true,A -> '1'
+ | false,A -> '3'
+ | _,C -> '2'
+ | _,_ -> '_'
+
+ This is not correct: when C is bound to A, "f false A" returns '2' (not '3')
+
+
+ However, diagnostics do not take constructor rebinding into account.
+ Notice, that due to module abstraction constructor rebinding is hidden.
+
+ module X : sig type t = .. type t += A|B end = struct
+ type t = ..
+ type t += A
+ type t += B=A
+ end
+
+ open X
+
+ let f x = match x with
+ | A -> '1'
+ | B -> '2'
+ | _ -> '_'
+
+ The second clause above will NOT (and cannot) be flagged as useless.
+
+ Finally, there are two compatibility functions:
+ compat p q ---> 'syntactic compatibility, used for diagnostics.
+ may_compat p q ---> a safe approximation of possible compat,
+ for compilation
+
+*)
+
+
+let is_absent tag row = row_field_repr (get_row_field tag !row) = Rabsent
+
+let is_absent_pat d =
+ match d.pat_desc with
+ | Patterns.Head.Variant { tag; cstr_row; _ } -> is_absent tag cstr_row
+ | _ -> false
+
+let const_compare x y =
+ match x,y with
+ | Const_float f1, Const_float f2 ->
+ Stdlib.compare (float_of_string f1) (float_of_string f2)
+ | Const_string (s1, _, _), Const_string (s2, _, _) ->
+ String.compare s1 s2
+ | (Const_int _
+ |Const_char _
+ |Const_string (_, _, _)
+ |Const_float _
+ |Const_int32 _
+ |Const_int64 _
+ |Const_nativeint _
+ ), _ -> Stdlib.compare x y
+
+let records_args l1 l2 =
+ (* Invariant: fields are already sorted by Typecore.type_label_a_list *)
+ let rec combine r1 r2 l1 l2 = match l1,l2 with
+ | [],[] -> List.rev r1, List.rev r2
+ | [],(_,_,p2)::rem2 -> combine (omega::r1) (p2::r2) [] rem2
+ | (_,_,p1)::rem1,[] -> combine (p1::r1) (omega::r2) rem1 []
+ | (_,lbl1,p1)::rem1, ( _,lbl2,p2)::rem2 ->
+ if lbl1.lbl_pos < lbl2.lbl_pos then
+ combine (p1::r1) (omega::r2) rem1 l2
+ else if lbl1.lbl_pos > lbl2.lbl_pos then
+ combine (omega::r1) (p2::r2) l1 rem2
+ else (* same label on both sides *)
+ combine (p1::r1) (p2::r2) rem1 rem2 in
+ combine [] [] l1 l2
+
+
+
+module Compat
+ (Constr:sig
+ val equal :
+ Types.constructor_description ->
+ Types.constructor_description ->
+ bool
+ end) = struct
+
+ let rec compat p q = match p.pat_desc,q.pat_desc with
+(* Variables match any value *)
+ | ((Tpat_any|Tpat_var _),_)
+ | (_,(Tpat_any|Tpat_var _)) -> true
+(* Structural induction *)
+ | Tpat_alias (p,_,_,_),_ -> compat p q
+ | _,Tpat_alias (q,_,_,_) -> compat p q
+ | Tpat_or (p1,p2,_),_ ->
+ (compat p1 q || compat p2 q)
+ | _,Tpat_or (q1,q2,_) ->
+ (compat p q1 || compat p q2)
+(* Constructors, with special case for extension *)
+ | Tpat_construct (_, c1, ps1, _), Tpat_construct (_, c2, ps2, _) ->
+ Constr.equal c1 c2 && compats ps1 ps2
+(* More standard stuff *)
+ | Tpat_variant(l1,op1, _), Tpat_variant(l2,op2,_) ->
+ l1=l2 && ocompat op1 op2
+ | Tpat_constant c1, Tpat_constant c2 ->
+ const_compare c1 c2 = 0
+ | Tpat_tuple ps, Tpat_tuple qs -> compats ps qs
+ | Tpat_lazy p, Tpat_lazy q -> compat p q
+ | Tpat_record (l1,_),Tpat_record (l2,_) ->
+ let ps,qs = records_args l1 l2 in
+ compats ps qs
+ | Tpat_array ps, Tpat_array qs ->
+ List.length ps = List.length qs &&
+ compats ps qs
+ | _,_ -> false
+
+ and ocompat op oq = match op,oq with
+ | None,None -> true
+ | Some p,Some q -> compat p q
+ | (None,Some _)|(Some _,None) -> false
+
+ and compats ps qs = match ps,qs with
+ | [], [] -> true
+ | p::ps, q::qs -> compat p q && compats ps qs
+ | _,_ -> false
+
+end
+
+module SyntacticCompat =
+ Compat
+ (struct
+ let equal c1 c2 = Types.equal_tag c1.cstr_tag c2.cstr_tag
+ end)
+
+let compat = SyntacticCompat.compat
+and compats = SyntacticCompat.compats
+
+(* Due to (potential) rebinding, two extension constructors
+ of the same arity type may equal *)
+
+exception Empty (* Empty pattern *)
+
+(****************************************)
+(* Utilities for retrieving type paths *)
+(****************************************)
+
+(* May need a clean copy, cf. PR#4745 *)
+let clean_copy ty =
+ if get_level ty = Btype.generic_level then ty
+ else Subst.type_expr Subst.identity ty
+
+let get_constructor_type_path ty tenv =
+ let ty = Ctype.expand_head tenv (clean_copy ty) in
+ match get_desc ty with
+ | Tconstr (path,_,_) -> path
+ | _ -> assert false
+
+(****************************)
+(* Utilities for matching *)
+(****************************)
+
+(* Check top matching *)
+let simple_match d h =
+ let open Patterns.Head in
+ match d.pat_desc, h.pat_desc with
+ | Construct c1, Construct c2 ->
+ Types.equal_tag c1.cstr_tag c2.cstr_tag
+ | Variant { tag = t1; _ }, Variant { tag = t2 } ->
+ t1 = t2
+ | Constant c1, Constant c2 -> const_compare c1 c2 = 0
+ | Lazy, Lazy -> true
+ | Record _, Record _ -> true
+ | Tuple len1, Tuple len2
+ | Array len1, Array len2 -> len1 = len2
+ | _, Any -> true
+ | _, _ -> false
+
+
+
+(* extract record fields as a whole *)
+let record_arg ph =
+ let open Patterns.Head in
+ match ph.pat_desc with
+ | Any -> []
+ | Record args -> args
+ | _ -> fatal_error "Parmatch.as_record"
+
+
+let extract_fields lbls arg =
+ let get_field pos arg =
+ match List.find (fun (lbl,_) -> pos = lbl.lbl_pos) arg with
+ | _, p -> p
+ | exception Not_found -> omega
+ in
+ List.map (fun lbl -> get_field lbl.lbl_pos arg) lbls
+
+(* Build argument list when p2 >= p1, where p1 is a simple pattern *)
+let simple_match_args discr head args =
+ let open Patterns.Head in
+ match head.pat_desc with
+ | Constant _ -> []
+ | Construct _
+ | Variant _
+ | Tuple _
+ | Array _
+ | Lazy -> args
+ | Record lbls -> extract_fields (record_arg discr) (List.combine lbls args)
+ | Any ->
+ begin match discr.pat_desc with
+ | Construct cstr -> Patterns.omegas cstr.cstr_arity
+ | Variant { has_arg = true }
+ | Lazy -> [Patterns.omega]
+ | Record lbls -> omega_list lbls
+ | Array len
+ | Tuple len -> Patterns.omegas len
+ | Variant { has_arg = false }
+ | Any
+ | Constant _ -> []
+ end
+
+(* Consider a pattern matrix whose first column has been simplified to contain
+ only _ or a head constructor
+ | p1, r1...
+ | p2, r2...
+ | p3, r3...
+ | ...
+
+ We build a normalized /discriminating/ pattern from a pattern [q] by folding
+ over the first column of the matrix, "refining" [q] as we go:
+
+ - when we encounter a row starting with [Tuple] or [Lazy] then we
+ can stop and return that head, as we cannot refine any further. Indeed,
+ these constructors are alone in their signature, so they will subsume
+ whatever other head we might find, as well as the head we're threading
+ along.
+
+ - when we find a [Record] then it is a bit more involved: it is also alone
+ in its signature, however it might only be matching a subset of the
+ record fields. We use these fields to refine our accumulator and keep going
+ as another row might match on different fields.
+
+ - rows starting with a wildcard do not bring any information, so we ignore
+ them and keep going
+
+ - if we encounter anything else (i.e. any other constructor), then we just
+ stop and return our accumulator.
+*)
+let discr_pat q pss =
+ let open Patterns.Head in
+ let rec refine_pat acc = function
+ | [] -> acc
+ | ((head, _), _) :: rows ->
+ match head.pat_desc with
+ | Any -> refine_pat acc rows
+ | Tuple _ | Lazy -> head
+ | Record lbls ->
+ (* N.B. we could make this case "simpler" by refining the record case
+ using [all_record_args].
+ In which case we wouldn't need to fold over the first column for
+ records.
+ However it makes the witness we generate for the exhaustivity warning
+ less pretty. *)
+ let fields =
+ List.fold_right (fun lbl r ->
+ if List.exists (fun l -> l.lbl_pos = lbl.lbl_pos) r then
+ r
+ else
+ lbl :: r
+ ) lbls (record_arg acc)
+ in
+ let d = { head with pat_desc = Record fields } in
+ refine_pat d rows
+ | _ -> acc
+ in
+ let q, _ = deconstruct q in
+ match q.pat_desc with
+ (* short-circuiting: clearly if we have anything other than [Record] or
+ [Any] to start with, we're not going to be able refine at all. So
+ there's no point going over the matrix. *)
+ | Any | Record _ -> refine_pat q pss
+ | _ -> q
+
+(*
+ In case a matching value is found, set actual arguments
+ of the matching pattern.
+*)
+
+let rec read_args xs r = match xs,r with
+| [],_ -> [],r
+| _::xs, arg::rest ->
+ let args,rest = read_args xs rest in
+ arg::args,rest
+| _,_ ->
+ fatal_error "Parmatch.read_args"
+
+let set_args q r = match q with
+| {pat_desc = Tpat_tuple omegas} ->
+ let args,rest = read_args omegas r in
+ make_pat (Tpat_tuple args) q.pat_type q.pat_env::rest
+| {pat_desc = Tpat_record (omegas,closed)} ->
+ let args,rest = read_args omegas r in
+ let args =
+ List.map2 (fun (lid, lbl, _) arg -> (lid, lbl, arg)) omegas args in
+ make_pat (Tpat_record (args, closed)) q.pat_type q.pat_env :: rest
+| {pat_desc = Tpat_construct (lid, c, omegas, _)} ->
+ let args,rest = read_args omegas r in
+ make_pat
+ (Tpat_construct (lid, c, args, None))
+ q.pat_type q.pat_env::
+ rest
+| {pat_desc = Tpat_variant (l, omega, row)} ->
+ let arg, rest =
+ match omega, r with
+ Some _, a::r -> Some a, r
+ | None, r -> None, r
+ | _ -> assert false
+ in
+ make_pat
+ (Tpat_variant (l, arg, row)) q.pat_type q.pat_env::
+ rest
+| {pat_desc = Tpat_lazy _omega} ->
+ begin match r with
+ arg::rest ->
+ make_pat (Tpat_lazy arg) q.pat_type q.pat_env::rest
+ | _ -> fatal_error "Parmatch.do_set_args (lazy)"
+ end
+| {pat_desc = Tpat_array omegas} ->
+ let args,rest = read_args omegas r in
+ make_pat
+ (Tpat_array args) q.pat_type q.pat_env::
+ rest
+| {pat_desc=Tpat_constant _|Tpat_any} ->
+ q::r (* case any is used in matching.ml *)
+| {pat_desc = (Tpat_var _ | Tpat_alias _ | Tpat_or _); _} ->
+ fatal_error "Parmatch.set_args"
+
+(* Given a matrix of non-empty rows
+ p1 :: r1...
+ p2 :: r2...
+ p3 :: r3...
+
+ Simplify the first column [p1 p2 p3] by splitting all or-patterns.
+ The result is a list of pairs
+ ((pattern head, arguments), rest of row)
+
+ For example,
+ x :: r1
+ (Some _) as y :: r2
+ (None as x) as y :: r3
+ (Some x | (None as x)) :: r4
+ becomes
+ (( _ , [ ] ), r1)
+ (( Some, [_] ), r2)
+ (( None, [ ] ), r3)
+ (( Some, [x] ), r4)
+ (( None, [ ] ), r4)
+ *)
+let simplify_head_pat ~add_column p ps k =
+ let rec simplify_head_pat p ps k =
+ match Patterns.General.(view p |> strip_vars).pat_desc with
+ | `Or (p1,p2,_) -> simplify_head_pat p1 ps (simplify_head_pat p2 ps k)
+ | #Patterns.Simple.view as view ->
+ add_column (Patterns.Head.deconstruct { p with pat_desc = view }) ps k
+ in simplify_head_pat p ps k
+
+let rec simplify_first_col = function
+ | [] -> []
+ | [] :: _ -> assert false (* the rows are non-empty! *)
+ | (p::ps) :: rows ->
+ let add_column p ps k = (p, ps) :: k in
+ simplify_head_pat ~add_column p ps (simplify_first_col rows)
+
+
+(* Builds the specialized matrix of [pss] according to the discriminating
+ pattern head [d].
+ See section 3.1 of http://moscova.inria.fr/~maranget/papers/warn/warn.pdf
+
+ NOTES:
+ - we are polymorphic on the type of matrices we work on, in particular a row
+ might not simply be a [pattern list]. That's why we have the [extend_row]
+ parameter.
+*)
+let build_specialized_submatrix ~extend_row discr pss =
+ let rec filter_rec = function
+ | ((head, args), ps) :: pss ->
+ if simple_match discr head
+ then extend_row (simple_match_args discr head args) ps :: filter_rec pss
+ else filter_rec pss
+ | _ -> [] in
+ filter_rec pss
+
+(* The "default" and "specialized" matrices of a given matrix.
+ See section 3.1 of http://moscova.inria.fr/~maranget/papers/warn/warn.pdf .
+*)
+type 'matrix specialized_matrices = {
+ default : 'matrix;
+ constrs : (Patterns.Head.t * 'matrix) list;
+}
+
+(* Consider a pattern matrix whose first column has been simplified
+ to contain only _ or a head constructor
+ | p1, r1...
+ | p2, r2...
+ | p3, r3...
+ | ...
+
+ We split this matrix into a list of /specialized/ sub-matrices, one for
+ each head constructor appearing in the first column. For each row whose
+ first column starts with a head constructor, remove this head
+ column, prepend one column for each argument of the constructor,
+ and add the resulting row in the sub-matrix corresponding to this
+ head constructor.
+
+ Rows whose left column is omega (the Any pattern _) may match any
+ head constructor, so they are added to all sub-matrices.
+
+ In the case where all the rows in the matrix have an omega on their first
+ column, then there is only one /specialized/ sub-matrix, formed of all these
+ omega rows.
+ This matrix is also called the /default/ matrix.
+
+ See the documentation of [build_specialized_submatrix] for an explanation of
+ the [extend_row] parameter.
+*)
+let build_specialized_submatrices ~extend_row discr rows =
+ let extend_group discr p args r rs =
+ let r = extend_row (simple_match_args discr p args) r in
+ (discr, r :: rs)
+ in
+
+ (* insert a row of head [p] and rest [r] into the right group
+
+ Note: with this implementation, the order of the groups
+ is the order of their first row in the source order.
+ This is a nice property to get exhaustivity counter-examples
+ in source order.
+ *)
+ let rec insert_constr head args r = function
+ | [] ->
+ (* if no group matched this row, it has a head constructor that
+ was never seen before; add a new sub-matrix for this head *)
+ [extend_group head head args r []]
+ | (q0,rs) as bd::env ->
+ if simple_match q0 head
+ then extend_group q0 head args r rs :: env
+ else bd :: insert_constr head args r env
+ in
+
+ (* insert a row of head omega into all groups *)
+ let insert_omega r env =
+ List.map (fun (q0,rs) -> extend_group q0 Patterns.Head.omega [] r rs) env
+ in
+
+ let rec form_groups constr_groups omega_tails = function
+ | [] -> (constr_groups, omega_tails)
+ | ((head, args), tail) :: rest ->
+ match head.pat_desc with
+ | Patterns.Head.Any ->
+ (* note that calling insert_omega here would be wrong
+ as some groups may not have been formed yet, if the
+ first row with this head pattern comes after in the list *)
+ form_groups constr_groups (tail :: omega_tails) rest
+ | _ ->
+ form_groups
+ (insert_constr head args tail constr_groups) omega_tails rest
+ in
+
+ let constr_groups, omega_tails =
+ let initial_constr_group =
+ let open Patterns.Head in
+ match discr.pat_desc with
+ | Record _ | Tuple _ | Lazy ->
+ (* [discr] comes from [discr_pat], and in this case subsumes any of the
+ patterns we could find on the first column of [rows]. So it is better
+ to use it for our initial environment than any of the normalized
+ pattern we might obtain from the first column. *)
+ [discr,[]]
+ | _ -> []
+ in
+ form_groups initial_constr_group [] rows
+ in
+
+ (* groups are accumulated in reverse order;
+ we restore the order of rows in the source code *)
+ let default = List.rev omega_tails in
+ let constrs =
+ List.fold_right insert_omega omega_tails constr_groups
+ |> List.map (fun (discr, rs) -> (discr, List.rev rs))
+ in
+ { default; constrs; }
+
+(* Variant related functions *)
+
+let set_last a =
+ let rec loop = function
+ | [] -> assert false
+ | [_] -> [Patterns.General.erase a]
+ | x::l -> x :: loop l
+ in
+ function
+ | (_, []) -> (Patterns.Head.deconstruct a, [])
+ | (first, row) -> (first, loop row)
+
+(* mark constructor lines for failure when they are incomplete *)
+let mark_partial =
+ let zero = make_pat (`Constant (Const_int 0)) Ctype.none Env.empty in
+ List.map (fun ((hp, _), _ as ps) ->
+ match hp.pat_desc with
+ | Patterns.Head.Any -> ps
+ | _ -> set_last zero ps
+ )
+
+let close_variant env row =
+ let Row {fields; more; name=orig_name; closed; fixed} = row_repr row in
+ let name, static =
+ List.fold_left
+ (fun (nm, static) (_tag,f) ->
+ match row_field_repr f with
+ | Reither(_, _, false) ->
+ (* fixed=false means that this tag is not explicitly matched *)
+ link_row_field_ext ~inside:f rf_absent;
+ (None, static)
+ | Reither (_, _, true) -> (nm, false)
+ | Rabsent | Rpresent _ -> (nm, static))
+ (orig_name, true) fields in
+ if not closed || name != orig_name then begin
+ let more' = if static then Btype.newgenty Tnil else Btype.newgenvar () in
+ (* this unification cannot fail *)
+ Ctype.unify env more
+ (Btype.newgenty
+ (Tvariant
+ (create_row ~fields:[] ~more:more'
+ ~closed:true ~name ~fixed)))
+ end
+
+(*
+ Check whether the first column of env makes up a complete signature or
+ not. We work on the discriminating pattern heads of each sub-matrix: they
+ are not omega/Any.
+*)
+let full_match closing env = match env with
+| [] -> false
+| (discr, _) :: _ ->
+ let open Patterns.Head in
+ match discr.pat_desc with
+ | Any -> assert false
+ | Construct { cstr_tag = Cstr_extension _ ; _ } -> false
+ | Construct c -> List.length env = c.cstr_consts + c.cstr_nonconsts
+ | Variant { type_row; _ } ->
+ let fields =
+ List.map
+ (fun (d, _) ->
+ match d.pat_desc with
+ | Variant { tag } -> tag
+ | _ -> assert false)
+ env
+ in
+ let row = type_row () in
+ if closing && not (Btype.has_fixed_explanation row) then
+ (* closing=true, we are considering the variant as closed *)
+ List.for_all
+ (fun (tag,f) ->
+ match row_field_repr f with
+ Rabsent | Reither(_, _, false) -> true
+ | Reither (_, _, true)
+ (* m=true, do not discard matched tags, rather warn *)
+ | Rpresent _ -> List.mem tag fields)
+ (row_fields row)
+ else
+ row_closed row &&
+ List.for_all
+ (fun (tag,f) ->
+ row_field_repr f = Rabsent || List.mem tag fields)
+ (row_fields row)
+ | Constant Const_char _ ->
+ List.length env = 256
+ | Constant _
+ | Array _ -> false
+ | Tuple _
+ | Record _
+ | Lazy -> true
+
+(* Written as a non-fragile matching, PR#7451 originated from a fragile matching
+ below. *)
+let should_extend ext env = match ext with
+| None -> false
+| Some ext -> begin match env with
+ | [] -> assert false
+ | (p,_)::_ ->
+ let open Patterns.Head in
+ begin match p.pat_desc with
+ | Construct {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)} ->
+ let path = get_constructor_type_path p.pat_type p.pat_env in
+ Path.same path ext
+ | Construct {cstr_tag=(Cstr_extension _)} -> false
+ | Constant _ | Tuple _ | Variant _ | Record _ | Array _ | Lazy -> false
+ | Any -> assert false
+ end
+end
+
+(* build a pattern from a constructor description *)
+let pat_of_constr ex_pat cstr =
+ {ex_pat with pat_desc =
+ Tpat_construct (mknoloc (Longident.Lident cstr.cstr_name),
+ cstr, omegas cstr.cstr_arity, None)}
+
+let orify x y = make_pat (Tpat_or (x, y, None)) x.pat_type x.pat_env
+
+let rec orify_many = function
+| [] -> assert false
+| [x] -> x
+| x :: xs -> orify x (orify_many xs)
+
+(* build an or-pattern from a constructor list *)
+let pat_of_constrs ex_pat cstrs =
+ let ex_pat = Patterns.Head.to_omega_pattern ex_pat in
+ if cstrs = [] then raise Empty else
+ orify_many (List.map (pat_of_constr ex_pat) cstrs)
+
+let pats_of_type env ty =
+ match Ctype.extract_concrete_typedecl env ty with
+ | Typedecl (_, path, {type_kind = Type_variant _ | Type_record _}) ->
+ begin match Env.find_type_descrs path env with
+ | Type_variant (cstrs,_) when List.length cstrs <= 1 ||
+ (* Only explode when all constructors are GADTs *)
+ List.for_all (fun cd -> cd.cstr_generalized) cstrs ->
+ List.map (pat_of_constr (make_pat Tpat_any ty env)) cstrs
+ | Type_record (labels, _) ->
+ let fields =
+ List.map (fun ld ->
+ mknoloc (Longident.Lident ld.lbl_name), ld, omega)
+ labels
+ in
+ [make_pat (Tpat_record (fields, Closed)) ty env]
+ | _ -> [omega]
+ end
+ | Has_no_typedecl ->
+ begin match get_desc (Ctype.expand_head env ty) with
+ Ttuple tl ->
+ [make_pat (Tpat_tuple (omegas (List.length tl))) ty env]
+ | _ -> [omega]
+ end
+ | Typedecl (_, _, {type_kind = Type_abstract _ | Type_open})
+ | May_have_typedecl -> [omega]
+
+let get_variant_constructors env ty =
+ match Ctype.extract_concrete_typedecl env ty with
+ | Typedecl (_, path, {type_kind = Type_variant _}) ->
+ begin match Env.find_type_descrs path env with
+ | Type_variant (cstrs,_) -> cstrs
+ | _ -> fatal_error "Parmatch.get_variant_constructors"
+ end
+ | _ -> fatal_error "Parmatch.get_variant_constructors"
+
+module ConstructorSet = Set.Make(struct
+ type t = constructor_description
+ let compare c1 c2 = String.compare c1.cstr_name c2.cstr_name
+end)
+
+(* Sends back a pattern that complements the given constructors used_constrs *)
+let complete_constrs constr used_constrs =
+ let c = constr.pat_desc in
+ let constrs = get_variant_constructors constr.pat_env c.cstr_res in
+ let used_constrs = ConstructorSet.of_list used_constrs in
+ let others =
+ List.filter
+ (fun cnstr -> not (ConstructorSet.mem cnstr used_constrs))
+ constrs in
+ (* Split constructors to put constant ones first *)
+ let const, nonconst =
+ List.partition (fun cnstr -> cnstr.cstr_arity = 0) others in
+ const @ nonconst
+
+let build_other_constrs env p =
+ let open Patterns.Head in
+ match p.pat_desc with
+ | Construct ({ cstr_tag = Cstr_extension _ }) -> extra_pat
+ | Construct
+ ({ cstr_tag = Cstr_constant _ | Cstr_block _ | Cstr_unboxed } as c) ->
+ let constr = { p with pat_desc = c } in
+ let get_constr q =
+ match q.pat_desc with
+ | Construct c -> c
+ | _ -> fatal_error "Parmatch.get_constr" in
+ let used_constrs = List.map (fun (p,_) -> get_constr p) env in
+ pat_of_constrs p (complete_constrs constr used_constrs)
+ | _ -> extra_pat
+
+(* Auxiliary for build_other *)
+
+let build_other_constant proj make first next p env =
+ let all = List.map (fun (p, _) -> proj p.pat_desc) env in
+ let rec try_const i =
+ if List.mem i all
+ then try_const (next i)
+ else make_pat (make i) p.pat_type p.pat_env
+ in try_const first
+
+(*
+ Builds a pattern that is incompatible with all patterns in
+ the first column of env
+*)
+
+let some_private_tag = "<some private tag>"
+
+let build_other ext env =
+ match env with
+ | [] -> omega
+ | (d, _) :: _ ->
+ let open Patterns.Head in
+ match d.pat_desc with
+ | Construct { cstr_tag = Cstr_extension _ } ->
+ (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
+ make_pat
+ (Tpat_var (Ident.create_local "*extension*",
+ {txt="*extension*"; loc = d.pat_loc},
+ Uid.internal_not_actually_unique))
+ Ctype.none Env.empty
+ | Construct _ ->
+ begin match ext with
+ | Some ext ->
+ if Path.same ext (get_constructor_type_path d.pat_type d.pat_env)
+ then
+ extra_pat
+ else
+ build_other_constrs env d
+ | _ ->
+ build_other_constrs env d
+ end
+ | Variant { cstr_row; type_row } ->
+ let tags =
+ List.map
+ (fun (d, _) ->
+ match d.pat_desc with
+ | Variant { tag } -> tag
+ | _ -> assert false)
+ env
+ in
+ let make_other_pat tag const =
+ let arg = if const then None else Some Patterns.omega in
+ make_pat (Tpat_variant(tag, arg, cstr_row)) d.pat_type d.pat_env
+ in
+ let row = type_row () in
+ begin match
+ List.fold_left
+ (fun others (tag,f) ->
+ if List.mem tag tags then others else
+ match row_field_repr f with
+ Rabsent (* | Reither _ *) -> others
+ (* This one is called after erasing pattern info *)
+ | Reither (c, _, _) -> make_other_pat tag c :: others
+ | Rpresent arg -> make_other_pat tag (arg = None) :: others)
+ [] (row_fields row)
+ with
+ [] ->
+ let tag =
+ if Btype.has_fixed_explanation row then some_private_tag else
+ let rec mktag tag =
+ if List.mem tag tags then mktag (tag ^ "'") else tag in
+ mktag "AnyOtherTag"
+ in make_other_pat tag true
+ | pat::other_pats ->
+ List.fold_left
+ (fun p_res pat ->
+ make_pat (Tpat_or (pat, p_res, None)) d.pat_type d.pat_env)
+ pat other_pats
+ end
+ | Constant Const_char _ ->
+ let all_chars =
+ List.map
+ (fun (p,_) -> match p.pat_desc with
+ | Constant (Const_char c) -> c
+ | _ -> assert false)
+ env
+ in
+ let rec find_other i imax =
+ if i > imax then raise Not_found
+ else
+ let ci = Char.chr i in
+ if List.mem ci all_chars then
+ find_other (i+1) imax
+ else
+ make_pat (Tpat_constant (Const_char ci)) d.pat_type d.pat_env
+ in
+ let rec try_chars = function
+ | [] -> Patterns.omega
+ | (c1,c2) :: rest ->
+ try
+ find_other (Char.code c1) (Char.code c2)
+ with
+ | Not_found -> try_chars rest
+ in
+ try_chars
+ [ 'a', 'z' ; 'A', 'Z' ; '0', '9' ;
+ ' ', '~' ; Char.chr 0 , Char.chr 255]
+ | Constant Const_int _ ->
+ build_other_constant
+ (function Constant(Const_int i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_int i))
+ 0 succ d env
+ | Constant Const_int32 _ ->
+ build_other_constant
+ (function Constant(Const_int32 i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_int32 i))
+ 0l Int32.succ d env
+ | Constant Const_int64 _ ->
+ build_other_constant
+ (function Constant(Const_int64 i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_int64 i))
+ 0L Int64.succ d env
+ | Constant Const_nativeint _ ->
+ build_other_constant
+ (function Constant(Const_nativeint i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_nativeint i))
+ 0n Nativeint.succ d env
+ | Constant Const_string _ ->
+ build_other_constant
+ (function Constant(Const_string (s, _, _)) -> String.length s
+ | _ -> assert false)
+ (function i ->
+ Tpat_constant
+ (Const_string(String.make i '*',Location.none,None)))
+ 0 succ d env
+ | Constant Const_float _ ->
+ build_other_constant
+ (function Constant(Const_float f) -> float_of_string f
+ | _ -> assert false)
+ (function f -> Tpat_constant(Const_float (string_of_float f)))
+ 0.0 (fun f -> f +. 1.0) d env
+ | Array _ ->
+ let all_lengths =
+ List.map
+ (fun (p,_) -> match p.pat_desc with
+ | Array len -> len
+ | _ -> assert false)
+ env in
+ let rec try_arrays l =
+ if List.mem l all_lengths then try_arrays (l+1)
+ else
+ make_pat (Tpat_array (omegas l)) d.pat_type d.pat_env in
+ try_arrays 0
+ | _ -> Patterns.omega
+
+let rec has_instance p = match p.pat_desc with
+ | Tpat_variant (l,_,r) when is_absent l r -> false
+ | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true
+ | Tpat_alias (p,_,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
+ | Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2
+ | Tpat_construct (_,_,ps,_) | Tpat_tuple ps | Tpat_array ps ->
+ has_instances ps
+ | Tpat_record (lps,_) -> has_instances (List.map (fun (_,_,x) -> x) lps)
+ | Tpat_lazy p
+ -> has_instance p
+
+and has_instances = function
+ | [] -> true
+ | q::rem -> has_instance q && has_instances rem
+
+(*
+ Core function :
+ Is the last row of pattern matrix pss + qs satisfiable ?
+ That is :
+ Does there exists at least one value vector, es such that :
+ 1- for all ps in pss ps # es (ps and es are not compatible)
+ 2- qs <= es (es matches qs)
+
+ ---
+
+ In two places in the following function, we check the coherence of the first
+ column of (pss + qs).
+ If it is incoherent, then we exit early saying that (pss + qs) is not
+ satisfiable (which is equivalent to saying "oh, we shouldn't have considered
+ that branch, no good result came come from here").
+
+ But what happens if we have a coherent but ill-typed column?
+ - we might end up returning [false], which is equivalent to noticing the
+ incompatibility: clearly this is fine.
+ - if we end up returning [true] then we're saying that [qs] is useful while
+ it is not. This is sad but not the end of the world, we're just allowing dead
+ code to survive.
+*)
+let rec satisfiable pss qs = match pss with
+| [] -> has_instances qs
+| _ ->
+ match qs with
+ | [] -> false
+ | q::qs ->
+ match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Or(q1,q2,_) ->
+ satisfiable pss (q1::qs) || satisfiable pss (q2::qs)
+ | `Any ->
+ let pss = simplify_first_col pss in
+ if not (all_coherent (first_column pss)) then
+ false
+ else begin
+ let { default; constrs } =
+ let q0 = discr_pat Patterns.Simple.omega pss in
+ build_specialized_submatrices ~extend_row:(@) q0 pss in
+ if not (full_match false constrs) then
+ satisfiable default qs
+ else
+ List.exists
+ (fun (p,pss) ->
+ not (is_absent_pat p) &&
+ satisfiable pss
+ (simple_match_args p Patterns.Head.omega [] @ qs))
+ constrs
+ end
+ | `Variant (l,_,r) when is_absent l r -> false
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ let pss = simplify_first_col pss in
+ let hq, qargs = Patterns.Head.deconstruct q in
+ if not (all_coherent (hq :: first_column pss)) then
+ false
+ else begin
+ let q0 = discr_pat q pss in
+ satisfiable (build_specialized_submatrix ~extend_row:(@) q0 pss)
+ (simple_match_args q0 hq qargs @ qs)
+ end
+
+(* While [satisfiable] only checks whether the last row of [pss + qs] is
+ satisfiable, this function returns the (possibly empty) list of vectors [es]
+ which verify:
+ 1- for all ps in pss, ps # es (ps and es are not compatible)
+ 2- qs <= es (es matches qs)
+
+ This is done to enable GADT handling
+
+ For considerations regarding the coherence check, see the comment on
+ [satisfiable] above. *)
+let rec list_satisfying_vectors pss qs =
+ match pss with
+ | [] -> if has_instances qs then [qs] else []
+ | _ ->
+ match qs with
+ | [] -> []
+ | q :: qs ->
+ match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Or(q1,q2,_) ->
+ list_satisfying_vectors pss (q1::qs) @
+ list_satisfying_vectors pss (q2::qs)
+ | `Any ->
+ let pss = simplify_first_col pss in
+ if not (all_coherent (first_column pss)) then
+ []
+ else begin
+ let q0 = discr_pat Patterns.Simple.omega pss in
+ let wild default_matrix p =
+ List.map (fun qs -> p::qs)
+ (list_satisfying_vectors default_matrix qs)
+ in
+ match build_specialized_submatrices ~extend_row:(@) q0 pss with
+ | { default; constrs = [] } ->
+ (* first column of pss is made of variables only *)
+ wild default omega
+ | { default; constrs = ((p,_)::_ as constrs) } ->
+ let for_constrs () =
+ List.flatten (
+ List.map (fun (p,pss) ->
+ if is_absent_pat p then
+ []
+ else
+ let witnesses =
+ list_satisfying_vectors pss
+ (simple_match_args p Patterns.Head.omega [] @ qs)
+ in
+ let p = Patterns.Head.to_omega_pattern p in
+ List.map (set_args p) witnesses
+ ) constrs
+ )
+ in
+ if full_match false constrs then for_constrs () else
+ begin match p.pat_desc with
+ | Construct _ ->
+ (* activate this code
+ for checking non-gadt constructors *)
+ wild default (build_other_constrs constrs p)
+ @ for_constrs ()
+ | _ ->
+ wild default Patterns.omega
+ end
+ end
+ | `Variant (l, _, r) when is_absent l r -> []
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ let hq, qargs = Patterns.Head.deconstruct q in
+ let pss = simplify_first_col pss in
+ if not (all_coherent (hq :: first_column pss)) then
+ []
+ else begin
+ let q0 = discr_pat q pss in
+ List.map (set_args (Patterns.Head.to_omega_pattern q0))
+ (list_satisfying_vectors
+ (build_specialized_submatrix ~extend_row:(@) q0 pss)
+ (simple_match_args q0 hq qargs @ qs))
+ end
+
+(******************************************)
+(* Look for a row that matches some value *)
+(******************************************)
+
+(*
+ Useful for seeing if the example of
+ non-matched value can indeed be matched
+ (by a guarded clause)
+*)
+
+let rec do_match pss qs = match qs with
+| [] ->
+ begin match pss with
+ | []::_ -> true
+ | _ -> false
+ end
+| q::qs -> match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Or (q1,q2,_) ->
+ do_match pss (q1::qs) || do_match pss (q2::qs)
+ | `Any ->
+ let rec remove_first_column = function
+ | (_::ps)::rem -> ps::remove_first_column rem
+ | _ -> []
+ in
+ do_match (remove_first_column pss) qs
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ let q0, qargs = Patterns.Head.deconstruct q in
+ let pss = simplify_first_col pss in
+ (* [pss] will (or won't) match [q0 :: qs] regardless of the coherence of
+ its first column. *)
+ do_match
+ (build_specialized_submatrix ~extend_row:(@) q0 pss)
+ (qargs @ qs)
+
+(*
+let print_pat pat =
+ let rec string_of_pat pat =
+ match pat.pat_desc with
+ Tpat_var _ -> "v"
+ | Tpat_any -> "_"
+ | Tpat_alias (p, x) -> Printf.sprintf "(%s) as ?" (string_of_pat p)
+ | Tpat_constant n -> "0"
+ | Tpat_construct (_, lid, _) ->
+ Printf.sprintf "%s" (String.concat "." (Longident.flatten lid.txt))
+ | Tpat_lazy p ->
+ Printf.sprintf "(lazy %s)" (string_of_pat p)
+ | Tpat_or (p1,p2,_) ->
+ Printf.sprintf "(%s | %s)" (string_of_pat p1) (string_of_pat p2)
+ | Tpat_tuple list ->
+ Printf.sprintf "(%s)" (String.concat "," (List.map string_of_pat list))
+ | Tpat_variant (_, _, _) -> "variant"
+ | Tpat_record (_, _) -> "record"
+ | Tpat_array _ -> "array"
+ in
+ Printf.fprintf stderr "PAT[%s]\n%!" (string_of_pat pat)
+*)
+
+(*
+ Now another satisfiable function that additionally
+ supplies an example of a matching value.
+
+ This function should be called for exhaustiveness check only.
+*)
+let rec exhaust (ext:Path.t option) pss n = match pss with
+| [] -> Seq.return (omegas n)
+| []::_ -> Seq.empty
+| [(p :: ps)] -> exhaust_single_row ext p ps n
+| pss -> specialize_and_exhaust ext pss n
+
+and exhaust_single_row ext p ps n =
+ (* Shortcut: in the single-row case p :: ps we know that all
+ counter-examples are either of the form
+ counter-example(p) :: omegas
+ or
+ p :: counter-examples(ps)
+
+ This is very interesting in the case where p contains
+ or-patterns, as the non-shortcut path below would do a separate
+ search for each constructor of the or-pattern, which can lead to
+ an exponential blowup on examples such as
+
+ | (A|B), (A|B), (A|B), (A|B) -> foo
+
+ Note that this shortcut also applies to examples such as
+
+ | A, A, A, A -> foo | (A|B), (A|B), (A|B), (A|B) -> bar
+
+ thanks to the [get_mins] preprocessing step which will drop the
+ first row (subsumed by the second). Code with this shape does
+ occur naturally when people want to avoid fragile pattern
+ matches: if A and B are the only two constructors, this is the
+ best way to make a non-fragile distinction between "all As" and
+ "at least one B".
+ *)
+ List.to_seq [Some p; None] |> Seq.flat_map
+ (function
+ | Some p ->
+ let sub_witnesses = exhaust ext [ps] (n - 1) in
+ Seq.map (fun row -> p :: row) sub_witnesses
+ | None ->
+ (* note: calling [exhaust] recursively of p would
+ result in an infinite loop in the case n=1 *)
+ let p_witnesses = specialize_and_exhaust ext [[p]] 1 in
+ Seq.map (fun p_row -> p_row @ omegas (n - 1)) p_witnesses
+ )
+
+and specialize_and_exhaust ext pss n =
+ let pss = simplify_first_col pss in
+ if not (all_coherent (first_column pss)) then
+ (* We're considering an ill-typed branch, we won't actually be able to
+ produce a well typed value taking that branch. *)
+ Seq.empty
+ else begin
+ (* Assuming the first column is ill-typed but considered coherent, we
+ might end up producing an ill-typed witness of non-exhaustivity
+ corresponding to the current branch.
+
+ If [exhaust] has been called by [do_check_partial], then the witnesses
+ produced get typechecked and the ill-typed ones are discarded.
+
+ If [exhaust] has been called by [do_check_fragile], then it is possible
+ we might fail to warn the user that the matching is fragile. See for
+ example testsuite/tests/warnings/w04_failure.ml. *)
+ let q0 = discr_pat Patterns.Simple.omega pss in
+ match build_specialized_submatrices ~extend_row:(@) q0 pss with
+ | { default; constrs = [] } ->
+ (* first column of pss is made of variables only *)
+ let sub_witnesses = exhaust ext default (n-1) in
+ let q0 = Patterns.Head.to_omega_pattern q0 in
+ Seq.map (fun row -> q0::row) sub_witnesses
+ | { default; constrs } ->
+ let try_non_omega (p,pss) =
+ if is_absent_pat p then
+ Seq.empty
+ else
+ let sub_witnesses =
+ exhaust
+ ext pss
+ (List.length (simple_match_args p Patterns.Head.omega [])
+ + n - 1)
+ in
+ let p = Patterns.Head.to_omega_pattern p in
+ Seq.map (set_args p) sub_witnesses
+ in
+ let try_omega () =
+ if full_match false constrs && not (should_extend ext constrs) then
+ Seq.empty
+ else
+ let sub_witnesses = exhaust ext default (n-1) in
+ match build_other ext constrs with
+ | exception Empty ->
+ (* cannot occur, since constructors don't make
+ a full signature *)
+ fatal_error "Parmatch.exhaust"
+ | p ->
+ Seq.map (fun tail -> p :: tail) sub_witnesses
+ in
+ (* Lazily compute witnesses for all constructor submatrices
+ (Some constr_mat) then the wildcard/default submatrix (None).
+ Note that the call to [try_omega ()] is delayed to after
+ all constructor matrices have been traversed. *)
+ List.map (fun constr_mat -> Some constr_mat) constrs @ [None]
+ |> List.to_seq
+ |> Seq.flat_map
+ (function
+ | Some constr_mat -> try_non_omega constr_mat
+ | None -> try_omega ())
+ end
+
+let exhaust ext pss n =
+ exhaust ext pss n
+ |> Seq.map (function
+ | [x] -> x
+ | _ -> assert false)
+
+(*
+ Another exhaustiveness check, enforcing variant typing.
+ Note that it does not check exact exhaustiveness, but whether a
+ matching could be made exhaustive by closing all variant types.
+ When this is true of all other columns, the current column is left
+ open (even if it means that the whole matching is not exhaustive as
+ a result).
+ When this is false for the matrix minus the current column, and the
+ current column is composed of variant tags, we close the variant
+ (even if it doesn't help in making the matching exhaustive).
+*)
+
+let rec pressure_variants tdefs = function
+ | [] -> false
+ | []::_ -> true
+ | pss ->
+ let pss = simplify_first_col pss in
+ if not (all_coherent (first_column pss)) then
+ true
+ else begin
+ let q0 = discr_pat Patterns.Simple.omega pss in
+ match build_specialized_submatrices ~extend_row:(@) q0 pss with
+ | { default; constrs = [] } -> pressure_variants tdefs default
+ | { default; constrs } ->
+ let rec try_non_omega = function
+ | (_p,pss) :: rem ->
+ let ok = pressure_variants tdefs pss in
+ (* The order below matters : we want [pressure_variants] to be
+ called on all the specialized submatrices because we might
+ close some variant in any of them regardless of whether [ok]
+ is true for [pss] or not *)
+ try_non_omega rem && ok
+ | [] -> true
+ in
+ if full_match (tdefs=None) constrs then
+ try_non_omega constrs
+ else if tdefs = None then
+ pressure_variants None default
+ else
+ let full = full_match true constrs in
+ let ok =
+ if full then
+ try_non_omega constrs
+ else begin
+ let { constrs = partial_constrs; _ } =
+ build_specialized_submatrices ~extend_row:(@) q0
+ (mark_partial pss)
+ in
+ try_non_omega partial_constrs
+ end
+ in
+ begin match constrs, tdefs with
+ | [], _
+ | _, None -> ()
+ | (d, _) :: _, Some env ->
+ match d.pat_desc with
+ | Variant { type_row; _ } ->
+ let row = type_row () in
+ if Btype.has_fixed_explanation row
+ || pressure_variants None default then ()
+ else close_variant env row
+ | _ -> ()
+ end;
+ ok
+ end
+
+
+(* Yet another satisfiable function *)
+
+(*
+ This time every_satisfiable pss qs checks the
+ utility of every expansion of qs.
+ Expansion means expansion of or-patterns inside qs
+*)
+
+type answer =
+ | Used (* Useful pattern *)
+ | Unused (* Useless pattern *)
+ | Upartial of Typedtree.pattern list (* Mixed, with list of useless ones *)
+
+
+
+(* this row type enable column processing inside the matrix
+ - left -> elements not to be processed,
+ - right -> elements to be processed
+*)
+type usefulness_row =
+ {no_ors : pattern list ; ors : pattern list ; active : pattern list}
+
+(*
+let pretty_row {ors=ors ; no_ors=no_ors; active=active} =
+ pretty_line ors ; prerr_string " *" ;
+ pretty_line no_ors ; prerr_string " *" ;
+ pretty_line active
+
+let pretty_rows rs =
+ prerr_endline "begin matrix" ;
+ List.iter
+ (fun r ->
+ pretty_row r ;
+ prerr_endline "")
+ rs ;
+ prerr_endline "end matrix"
+*)
+
+(* Initial build *)
+let make_row ps = {ors=[] ; no_ors=[]; active=ps}
+
+let make_rows pss = List.map make_row pss
+
+
+(* Useful to detect and expand or pats inside as pats *)
+let is_var p = match Patterns.General.(view p |> strip_vars).pat_desc with
+| `Any -> true
+| _ -> false
+
+let is_var_column rs =
+ List.for_all
+ (fun r -> match r.active with
+ | p::_ -> is_var p
+ | [] -> assert false)
+ rs
+
+(* Standard or-args for left-to-right matching *)
+let rec or_args p = match p.pat_desc with
+| Tpat_or (p1,p2,_) -> p1,p2
+| Tpat_alias (p,_,_,_) -> or_args p
+| _ -> assert false
+
+(* Just remove current column *)
+let remove r = match r.active with
+| _::rem -> {r with active=rem}
+| [] -> assert false
+
+let remove_column rs = List.map remove rs
+
+(* Current column has been processed *)
+let push_no_or r = match r.active with
+| p::rem -> { r with no_ors = p::r.no_ors ; active=rem}
+| [] -> assert false
+
+let push_or r = match r.active with
+| p::rem -> { r with ors = p::r.ors ; active=rem}
+| [] -> assert false
+
+let push_or_column rs = List.map push_or rs
+and push_no_or_column rs = List.map push_no_or rs
+
+let rec simplify_first_usefulness_col = function
+ | [] -> []
+ | row :: rows ->
+ match row.active with
+ | [] -> assert false (* the rows are non-empty! *)
+ | p :: ps ->
+ let add_column p ps k =
+ (p, { row with active = ps }) :: k in
+ simplify_head_pat ~add_column p ps
+ (simplify_first_usefulness_col rows)
+
+(* Back to normal matrices *)
+let make_vector r = List.rev r.no_ors
+
+let make_matrix rs = List.map make_vector rs
+
+
+(* Standard union on answers *)
+let union_res r1 r2 = match r1, r2 with
+| (Unused,_)
+| (_, Unused) -> Unused
+| Used,_ -> r2
+| _, Used -> r1
+| Upartial u1, Upartial u2 -> Upartial (u1@u2)
+
+(* propose or pats for expansion *)
+let extract_elements qs =
+ let rec do_rec seen = function
+ | [] -> []
+ | q::rem ->
+ {no_ors= List.rev_append seen rem @ qs.no_ors ;
+ ors=[] ;
+ active = [q]}::
+ do_rec (q::seen) rem in
+ do_rec [] qs.ors
+
+(* idem for matrices *)
+let transpose rs = match rs with
+| [] -> assert false
+| r::rem ->
+ let i = List.map (fun x -> [x]) r in
+ List.fold_left
+ (List.map2 (fun r x -> x::r))
+ i rem
+
+let extract_columns pss qs = match pss with
+| [] -> List.map (fun _ -> []) qs.ors
+| _ ->
+ let rows = List.map extract_elements pss in
+ transpose rows
+
+(* Core function
+ The idea is to first look for or patterns (recursive case), then
+ check or-patterns argument usefulness (terminal case)
+*)
+
+let rec every_satisfiables pss qs = match qs.active with
+| [] ->
+ (* qs is now partitioned, check usefulness *)
+ begin match qs.ors with
+ | [] -> (* no or-patterns *)
+ if satisfiable (make_matrix pss) (make_vector qs) then
+ Used
+ else
+ Unused
+ | _ -> (* n or-patterns -> 2n expansions *)
+ List.fold_right2
+ (fun pss qs r -> match r with
+ | Unused -> Unused
+ | _ ->
+ match qs.active with
+ | [q] ->
+ let q1,q2 = or_args q in
+ let r_loc = every_both pss qs q1 q2 in
+ union_res r r_loc
+ | _ -> assert false)
+ (extract_columns pss qs) (extract_elements qs)
+ Used
+ end
+| q::rem ->
+ begin match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Any ->
+ if is_var_column pss then
+ (* forget about ``all-variable'' columns now *)
+ every_satisfiables (remove_column pss) (remove qs)
+ else
+ (* otherwise this is direct food for satisfiable *)
+ every_satisfiables (push_no_or_column pss) (push_no_or qs)
+ | `Or (q1,q2,_) ->
+ if
+ q1.pat_loc.Location.loc_ghost &&
+ q2.pat_loc.Location.loc_ghost
+ then
+ (* syntactically generated or-pats should not be expanded *)
+ every_satisfiables (push_no_or_column pss) (push_no_or qs)
+ else
+ (* this is a real or-pattern *)
+ every_satisfiables (push_or_column pss) (push_or qs)
+ | `Variant (l,_,r) when is_absent l r -> (* Ah Jacques... *)
+ Unused
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ (* standard case, filter matrix *)
+ let pss = simplify_first_usefulness_col pss in
+ let hq, args = Patterns.Head.deconstruct q in
+ (* The handling of incoherent matrices is kept in line with
+ [satisfiable] *)
+ if not (all_coherent (hq :: first_column pss)) then
+ Unused
+ else begin
+ let q0 = discr_pat q pss in
+ every_satisfiables
+ (build_specialized_submatrix q0 pss
+ ~extend_row:(fun ps r -> { r with active = ps @ r.active }))
+ {qs with active=simple_match_args q0 hq args @ rem}
+ end
+ end
+
+(*
+ This function ``every_both'' performs the usefulness check
+ of or-pat q1|q2.
+ The trick is to call every_satisfied twice with
+ current active columns restricted to q1 and q2,
+ That way,
+ - others orpats in qs.ors will not get expanded.
+ - all matching work performed on qs.no_ors is not performed again.
+ *)
+and every_both pss qs q1 q2 =
+ let qs1 = {qs with active=[q1]}
+ and qs2 = {qs with active=[q2]} in
+ let r1 = every_satisfiables pss qs1
+ and r2 = every_satisfiables (if compat q1 q2 then qs1::pss else pss) qs2 in
+ match r1 with
+ | Unused ->
+ begin match r2 with
+ | Unused -> Unused
+ | Used -> Upartial [q1]
+ | Upartial u2 -> Upartial (q1::u2)
+ end
+ | Used ->
+ begin match r2 with
+ | Unused -> Upartial [q2]
+ | _ -> r2
+ end
+ | Upartial u1 ->
+ begin match r2 with
+ | Unused -> Upartial (u1@[q2])
+ | Used -> r1
+ | Upartial u2 -> Upartial (u1 @ u2)
+ end
+
+
+
+
+(* le_pat p q means, forall V, V matches q implies V matches p *)
+let rec le_pat p q =
+ match (p.pat_desc, q.pat_desc) with
+ | (Tpat_var _|Tpat_any),_ -> true
+ | Tpat_alias(p,_,_,_), _ -> le_pat p q
+ | _, Tpat_alias(q,_,_,_) -> le_pat p q
+ | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
+ | Tpat_construct(_,c1,ps,_), Tpat_construct(_,c2,qs,_) ->
+ Types.equal_tag c1.cstr_tag c2.cstr_tag && le_pats ps qs
+ | Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) ->
+ (l1 = l2 && le_pat p1 p2)
+ | Tpat_variant(l1,None,_r1), Tpat_variant(l2,None,_) ->
+ l1 = l2
+ | Tpat_variant(_,_,_), Tpat_variant(_,_,_) -> false
+ | Tpat_tuple(ps), Tpat_tuple(qs) -> le_pats ps qs
+ | Tpat_lazy p, Tpat_lazy q -> le_pat p q
+ | Tpat_record (l1,_), Tpat_record (l2,_) ->
+ let ps,qs = records_args l1 l2 in
+ le_pats ps qs
+ | Tpat_array(ps), Tpat_array(qs) ->
+ List.length ps = List.length qs && le_pats ps qs
+(* In all other cases, enumeration is performed *)
+ | _,_ -> not (satisfiable [[p]] [q])
+
+and le_pats ps qs =
+ match ps,qs with
+ p::ps, q::qs -> le_pat p q && le_pats ps qs
+ | _, _ -> true
+
+let get_mins le ps =
+ let rec select_rec r = function
+ [] -> r
+ | p::ps ->
+ if List.exists (fun p0 -> le p0 p) ps
+ then select_rec r ps
+ else select_rec (p::r) ps in
+ (* [select_rec] removes the elements that are followed by a smaller element.
+ An element that is preceded by a smaller element may stay in the list.
+ We thus do two passes on the list, which is returned reversed
+ the first time. *)
+ select_rec [] (select_rec [] ps)
+
+(*
+ lub p q is a pattern that matches all values matched by p and q
+ may raise Empty, when p and q are not compatible
+*)
+
+let rec lub p q = match p.pat_desc,q.pat_desc with
+| Tpat_alias (p,_,_,_),_ -> lub p q
+| _,Tpat_alias (q,_,_,_) -> lub p q
+| (Tpat_any|Tpat_var _),_ -> q
+| _,(Tpat_any|Tpat_var _) -> p
+| Tpat_or (p1,p2,_),_ -> orlub p1 p2 q
+| _,Tpat_or (q1,q2,_) -> orlub q1 q2 p (* Thanks god, lub is commutative *)
+| Tpat_constant c1, Tpat_constant c2 when const_compare c1 c2 = 0 -> p
+| Tpat_tuple ps, Tpat_tuple qs ->
+ let rs = lubs ps qs in
+ make_pat (Tpat_tuple rs) p.pat_type p.pat_env
+| Tpat_lazy p, Tpat_lazy q ->
+ let r = lub p q in
+ make_pat (Tpat_lazy r) p.pat_type p.pat_env
+| Tpat_construct (lid,c1,ps1,_), Tpat_construct (_,c2,ps2,_)
+ when Types.equal_tag c1.cstr_tag c2.cstr_tag ->
+ let rs = lubs ps1 ps2 in
+ make_pat (Tpat_construct (lid, c1, rs, None))
+ p.pat_type p.pat_env
+| Tpat_variant(l1,Some p1,row), Tpat_variant(l2,Some p2,_)
+ when l1=l2 ->
+ let r=lub p1 p2 in
+ make_pat (Tpat_variant (l1,Some r,row)) p.pat_type p.pat_env
+| Tpat_variant (l1,None,_row), Tpat_variant(l2,None,_)
+ when l1 = l2 -> p
+| Tpat_record (l1,closed),Tpat_record (l2,_) ->
+ let rs = record_lubs l1 l2 in
+ make_pat (Tpat_record (rs, closed)) p.pat_type p.pat_env
+| Tpat_array ps, Tpat_array qs
+ when List.length ps = List.length qs ->
+ let rs = lubs ps qs in
+ make_pat (Tpat_array rs) p.pat_type p.pat_env
+| _,_ ->
+ raise Empty
+
+and orlub p1 p2 q =
+ try
+ let r1 = lub p1 q in
+ try
+ {q with pat_desc=(Tpat_or (r1,lub p2 q,None))}
+ with
+ | Empty -> r1
+with
+| Empty -> lub p2 q
+
+and record_lubs l1 l2 =
+ let rec lub_rec l1 l2 = match l1,l2 with
+ | [],_ -> l2
+ | _,[] -> l1
+ | (lid1, lbl1,p1)::rem1, (lid2, lbl2,p2)::rem2 ->
+ if lbl1.lbl_pos < lbl2.lbl_pos then
+ (lid1, lbl1,p1)::lub_rec rem1 l2
+ else if lbl2.lbl_pos < lbl1.lbl_pos then
+ (lid2, lbl2,p2)::lub_rec l1 rem2
+ else
+ (lid1, lbl1,lub p1 p2)::lub_rec rem1 rem2 in
+ lub_rec l1 l2
+
+and lubs ps qs = match ps,qs with
+| p::ps, q::qs -> lub p q :: lubs ps qs
+| _,_ -> []
+
+
+(******************************)
+(* Exported variant closing *)
+(******************************)
+
+(* Apply pressure to variants *)
+
+let pressure_variants tdefs patl =
+ ignore (pressure_variants
+ (Some tdefs)
+ (List.map (fun p -> [p; omega]) patl))
+
+let pressure_variants_in_computation_pattern tdefs patl =
+ let add_row pss p_opt =
+ match p_opt with
+ | None -> pss
+ | Some p -> p :: pss
+ in
+ let val_pss, exn_pss =
+ List.fold_right (fun pat (vpss, epss)->
+ let (vp, ep) = split_pattern pat in
+ add_row vpss vp, add_row epss ep
+ ) patl ([], [])
+ in
+ pressure_variants tdefs val_pss;
+ pressure_variants tdefs exn_pss
+
+(*****************************)
+(* Utilities for diagnostics *)
+(*****************************)
+
+(*
+ Build up a working pattern matrix by forgetting
+ about guarded patterns
+*)
+
+let rec initial_matrix = function
+ [] -> []
+ | {has_guard=true} :: rem -> initial_matrix rem
+ | {has_guard=false; pattern=p} :: rem -> [p] :: initial_matrix rem
+
+(*
+ Build up a working pattern matrix by keeping
+ only the patterns which are guarded
+*)
+let rec initial_only_guarded = function
+ | [] -> []
+ | { has_guard = false; _} :: rem ->
+ initial_only_guarded rem
+ | { pattern = pat; _ } :: rem ->
+ [pat] :: initial_only_guarded rem
+
+
+(************************)
+(* Exhaustiveness check *)
+(************************)
+
+(* Whether the counter-example contains an extension pattern *)
+let contains_extension pat =
+ exists_pattern
+ (function
+ | {pat_desc=Tpat_var (_, {txt="*extension*"}, _)} -> true
+ | _ -> false)
+ pat
+
+let do_check_partial ~pred loc casel pss = match pss with
+| [] ->
+ (*
+ This can occur
+ - For empty matches generated by ocamlp4 (no warning)
+ - when all patterns have guards (then, casel <> [])
+ (specific warning)
+ Then match MUST be considered non-exhaustive,
+ otherwise compilation of PM is broken.
+ *)
+ begin match casel with
+ | [] -> ()
+ | _ ->
+ if Warnings.is_active Warnings.All_clauses_guarded then
+ Location.prerr_warning loc Warnings.All_clauses_guarded
+ end ;
+ Partial
+| ps::_ ->
+ let counter_examples =
+ exhaust None pss (List.length ps) |> Seq.filter_map pred in
+ match counter_examples () with
+ | Seq.Nil -> Total
+ | Seq.Cons (v, _rest) ->
+ if Warnings.is_active (Warnings.Partial_match "") then begin
+ let errmsg =
+ let doc = ref Format_doc.Doc.empty in
+ let fmt = Format_doc.formatter doc in
+ Format_doc.fprintf fmt "@[<v>%a" Printpat.top_pretty v;
+ if do_match (initial_only_guarded casel) [v] then
+ Format_doc.fprintf fmt
+ "@,(However, some guarded clause may match this value.)";
+ if contains_extension v then
+ Format_doc.fprintf fmt
+ "@,@[Matching over values of extensible variant types \
+ (the *extension* above)@,\
+ must include a wild card pattern@ in order to be exhaustive.@]"
+ ;
+ Format_doc.fprintf fmt "@]";
+ Format_doc.(asprintf "%a" pp_doc) !doc
+ in
+ Location.prerr_warning loc (Warnings.Partial_match errmsg)
+ end;
+ Partial
+
+(*****************)
+(* Fragile check *)
+(*****************)
+
+(* Collect all data types in a pattern *)
+
+let rec add_path path = function
+ | [] -> [path]
+ | x::rem as paths ->
+ if Path.same path x then paths
+ else x::add_path path rem
+
+let extendable_path path =
+ not
+ (Path.same path Predef.path_bool ||
+ Path.same path Predef.path_list ||
+ Path.same path Predef.path_unit ||
+ Path.same path Predef.path_option)
+
+let rec collect_paths_from_pat r p = match p.pat_desc with
+| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)},
+ ps, _) ->
+ let path = get_constructor_type_path p.pat_type p.pat_env in
+ List.fold_left
+ collect_paths_from_pat
+ (if extendable_path path then add_path path r else r)
+ ps
+| Tpat_any|Tpat_var _|Tpat_constant _| Tpat_variant (_,None,_) -> r
+| Tpat_tuple ps | Tpat_array ps
+| Tpat_construct (_, {cstr_tag=Cstr_extension _}, ps, _)->
+ List.fold_left collect_paths_from_pat r ps
+| Tpat_record (lps,_) ->
+ List.fold_left
+ (fun r (_, _, p) -> collect_paths_from_pat r p)
+ r lps
+| Tpat_variant (_, Some p, _) | Tpat_alias (p,_,_,_) ->
+ collect_paths_from_pat r p
+| Tpat_or (p1,p2,_) ->
+ collect_paths_from_pat (collect_paths_from_pat r p1) p2
+| Tpat_lazy p
+ ->
+ collect_paths_from_pat r p
+
+
+(*
+ Actual fragile check
+ 1. Collect data types in the patterns of the match.
+ 2. One exhaustivity check per datatype, considering that
+ the type is extended.
+*)
+
+let do_check_fragile loc casel pss =
+ let exts =
+ List.fold_left
+ (fun r c -> collect_paths_from_pat r c.pattern)
+ [] casel in
+ match exts with
+ | [] -> ()
+ | _ -> match pss with
+ | [] -> ()
+ | ps::_ ->
+ List.iter
+ (fun ext ->
+ let witnesses = exhaust (Some ext) pss (List.length ps) in
+ match witnesses () with
+ | Seq.Nil ->
+ Location.prerr_warning
+ loc
+ (Warnings.Fragile_match (Path.name ext))
+ | Seq.Cons _ -> ())
+ exts
+
+(********************************)
+(* Exported unused clause check *)
+(********************************)
+
+let check_unused pred casel =
+ if Warnings.is_active Warnings.Redundant_case
+ || List.exists (fun vc -> vc.needs_refute) casel then
+ let rec do_rec pref = function
+ | [] -> ()
+ | {pattern=q; has_guard; needs_refute=refute} :: rem ->
+ let qs = [q] in
+ begin try
+ let pss =
+ (* prev was accumulated in reverse order;
+ restore source order to get ordered counter-examples *)
+ List.rev pref
+ |> List.filter (compats qs)
+ |> get_mins le_pats in
+ (* First look for redundant or partially redundant patterns *)
+ let r = every_satisfiables (make_rows pss) (make_row qs) in
+ (* Do not warn for unused [pat -> .] *)
+ if r = Unused && refute then () else
+ let r =
+ (* Do not refine if either:
+ - we already know the clause is unused
+ - the clause under consideration is not a refutation clause
+ and either:
+ + there are no other lines
+ + we do not care whether the types prevent this clause to
+ be reached.
+ If the clause under consideration *is* a refutation clause
+ then we do need to check more carefully whether it can be
+ refuted or not. *)
+ let skip =
+ r = Unused || (not refute && pref = []) ||
+ not(refute || Warnings.is_active Warnings.Unreachable_case) in
+ if skip then r else
+ (* Then look for empty patterns *)
+ let sfs = list_satisfying_vectors pss qs in
+ if sfs = [] then Unused else
+ let sfs =
+ List.map (function [u] -> u | _ -> assert false) sfs in
+ let u = orify_many sfs in
+ (*Format.eprintf "%a@." pretty_val u;*)
+ let pattern = {u with pat_loc = q.pat_loc} in
+ match pred refute pattern with
+ None when not refute ->
+ Location.prerr_warning q.pat_loc Warnings.Unreachable_case;
+ Used
+ | _ -> r
+ in
+ match r with
+ | Unused ->
+ Location.prerr_warning
+ q.pat_loc Warnings.Redundant_case
+ | Upartial ps ->
+ List.iter
+ (fun p ->
+ Location.prerr_warning
+ p.pat_loc Warnings.Redundant_subpat)
+ ps
+ | Used -> ()
+ with Empty | Not_found -> assert false
+ end ;
+
+ if has_guard then
+ do_rec pref rem
+ else
+ do_rec ([q]::pref) rem in
+
+ do_rec [] casel
+
+(*********************************)
+(* Exported irrefutability tests *)
+(*********************************)
+
+let irrefutable pat = le_pat pat omega
+
+let inactive ~partial pat =
+ match partial with
+ | Partial -> false
+ | Total -> begin
+ let rec loop pat =
+ match pat.pat_desc with
+ | Tpat_lazy _ | Tpat_array _ ->
+ false
+ | Tpat_any | Tpat_var _ | Tpat_variant (_, None, _) ->
+ true
+ | Tpat_constant c -> begin
+ match c with
+ | Const_string _
+ | Const_int _ | Const_char _ | Const_float _
+ | Const_int32 _ | Const_int64 _ | Const_nativeint _ -> true
+ end
+ | Tpat_tuple ps | Tpat_construct (_, _, ps, _) ->
+ List.for_all (fun p -> loop p) ps
+ | Tpat_alias (p,_,_,_) | Tpat_variant (_, Some p, _) ->
+ loop p
+ | Tpat_record (ldps,_) ->
+ List.for_all
+ (fun (_, lbl, p) -> lbl.lbl_mut = Immutable && loop p)
+ ldps
+ | Tpat_or (p,q,_) ->
+ loop p && loop q
+ in
+ loop pat
+ end
+
+
+
+
+
+
+
+(*********************************)
+(* Exported exhaustiveness check *)
+(*********************************)
+
+(*
+ Fragile check is performed when required and
+ on exhaustive matches only.
+*)
+
+let check_partial pred loc casel =
+ let pss = initial_matrix casel in
+ let pss = get_mins le_pats pss in
+ let total = do_check_partial ~pred loc casel pss in
+ if
+ total = Total && Warnings.is_active (Warnings.Fragile_match "")
+ then begin
+ do_check_fragile loc casel pss
+ end ;
+ total
+
+(*************************************)
+(* Ambiguous variable in or-patterns *)
+(*************************************)
+
+(* Specification: ambiguous variables in or-patterns.
+
+ The semantics of or-patterns in OCaml is specified with
+ a left-to-right bias: a value [v] matches the pattern [p | q] if it
+ matches [p] or [q], but if it matches both, the environment
+ captured by the match is the environment captured by [p], never the
+ one captured by [q].
+
+ While this property is generally well-understood, one specific case
+ where users expect a different semantics is when a pattern is
+ followed by a when-guard: [| p when g -> e]. Consider for example:
+
+ | ((Const x, _) | (_, Const x)) when is_neutral x -> branch
+
+ The semantics is clear: match the scrutinee against the pattern, if
+ it matches, test the guard, and if the guard passes, take the
+ branch.
+
+ However, consider the input [(Const a, Const b)], where [a] fails
+ the test [is_neutral f], while [b] passes the test [is_neutral
+ b]. With the left-to-right semantics, the clause above is *not*
+ taken by its input: matching [(Const a, Const b)] against the
+ or-pattern succeeds in the left branch, it returns the environment
+ [x -> a], and then the guard [is_neutral a] is tested and fails,
+ the branch is not taken. Most users, however, intuitively expect
+ that any pair that has one side passing the test will take the
+ branch. They assume it is equivalent to the following:
+
+ | (Const x, _) when is_neutral x -> branch
+ | (_, Const x) when is_neutral x -> branch
+
+ while it is not.
+
+ The code below is dedicated to finding these confusing cases: the
+ cases where a guard uses "ambiguous" variables, that are bound to
+ different parts of the scrutinees by different sides of
+ a or-pattern. In other words, it finds the cases where the
+ specified left-to-right semantics is not equivalent to
+ a non-deterministic semantics (any branch can be taken) relatively
+ to a specific guard.
+*)
+
+let pattern_vars p = Ident.Set.of_list (Typedtree.pat_bound_idents p)
+
+(* Row for ambiguous variable search,
+ row is the traditional pattern row,
+ varsets contain a list of head variable sets (varsets)
+
+ A given varset contains all the variables that appeared at the head
+ of a pattern in the row at some point during traversal: they would
+ all be bound to the same value at matching time. On the contrary,
+ two variables of different varsets appeared at different places in
+ the pattern and may be bound to distinct sub-parts of the matched
+ value.
+
+ All rows of a (sub)matrix have rows of the same length,
+ but also varsets of the same length.
+
+ Varsets are populated when simplifying the first column
+ -- the variables of the head pattern are collected in a new varset.
+ For example,
+ { row = x :: r1; varsets = s1 }
+ { row = (Some _) as y :: r2; varsets = s2 }
+ { row = (None as x) as y :: r3; varsets = s3 }
+ { row = (Some x | (None as x)) :: r4 with varsets = s4 }
+ becomes
+ (_, { row = r1; varsets = {x} :: s1 })
+ (Some _, { row = r2; varsets = {y} :: s2 })
+ (None, { row = r3; varsets = {x, y} :: s3 })
+ (Some x, { row = r4; varsets = {} :: s4 })
+ (None, { row = r4; varsets = {x} :: s4 })
+*)
+type amb_row = { row : pattern list ; varsets : Ident.Set.t list; }
+
+let simplify_head_amb_pat head_bound_variables varsets ~add_column p ps k =
+ let rec simpl head_bound_variables varsets p ps k =
+ match (Patterns.General.view p).pat_desc with
+ | `Alias (p,x,_,_) ->
+ simpl (Ident.Set.add x head_bound_variables) varsets p ps k
+ | `Var (x,_,_) ->
+ simpl (Ident.Set.add x head_bound_variables) varsets Patterns.omega ps k
+ | `Or (p1,p2,_) ->
+ simpl head_bound_variables varsets p1 ps
+ (simpl head_bound_variables varsets p2 ps k)
+ | #Patterns.Simple.view as view ->
+ add_column (Patterns.Head.deconstruct { p with pat_desc = view })
+ { row = ps; varsets = head_bound_variables :: varsets; } k
+ in simpl head_bound_variables varsets p ps k
+
+(*
+ To accurately report ambiguous variables, one must consider
+ that previous clauses have already matched some values.
+ Consider for example:
+
+ | (Foo x, Foo y) -> ...
+ | ((Foo x, _) | (_, Foo x)) when bar x -> ...
+
+ The second line taken in isolation uses an unstable variable,
+ but the discriminating values, of the shape [(Foo v1, Foo v2)],
+ would all be filtered by the line above.
+
+ To track this information, the matrices we analyze contain both
+ *positive* rows, that describe the rows currently being analyzed
+ (of type Varsets.row, so that their varsets are tracked) and
+ *negative rows*, that describe the cases already matched against.
+
+ The values matched by a signed matrix are the values matched by
+ some of the positive rows but none of the negative rows. In
+ particular, a variable is stable if, for any value not matched by
+ any of the negative rows, the environment captured by any of the
+ matching positive rows is identical.
+*)
+type ('a, 'b) signed = Positive of 'a | Negative of 'b
+
+let rec simplify_first_amb_col = function
+ | [] -> []
+ | (Negative [] | Positive { row = []; _ }) :: _ -> assert false
+ | Negative (n :: ns) :: rem ->
+ let add_column n ns k = (n, Negative ns) :: k in
+ simplify_head_pat
+ ~add_column n ns (simplify_first_amb_col rem)
+ | Positive { row = p::ps; varsets; }::rem ->
+ let add_column p ps k = (p, Positive ps) :: k in
+ simplify_head_amb_pat
+ Ident.Set.empty varsets
+ ~add_column p ps (simplify_first_amb_col rem)
+
+(* Compute stable bindings *)
+
+type stable_vars =
+ | All
+ | Vars of Ident.Set.t
+
+let stable_inter sv1 sv2 = match sv1, sv2 with
+ | All, sv | sv, All -> sv
+ | Vars s1, Vars s2 -> Vars (Ident.Set.inter s1 s2)
+
+let reduce f = function
+| [] -> invalid_arg "reduce"
+| x::xs -> List.fold_left f x xs
+
+let rec matrix_stable_vars m = match m with
+ | [] -> All
+ | ((Positive {row = []; _} | Negative []) :: _) as empty_rows ->
+ let exception Negative_empty_row in
+ (* if at least one empty row is negative, the matrix matches no value *)
+ let get_varsets = function
+ | Negative n ->
+ (* All rows have the same number of columns;
+ if the first row is empty, they all are. *)
+ assert (n = []);
+ raise Negative_empty_row
+ | Positive p ->
+ assert (p.row = []);
+ p.varsets in
+ begin match List.map get_varsets empty_rows with
+ | exception Negative_empty_row -> All
+ | rows_varsets ->
+ let stables_in_varsets =
+ reduce (List.map2 Ident.Set.inter) rows_varsets in
+ (* The stable variables are those stable at any position *)
+ Vars
+ (List.fold_left Ident.Set.union Ident.Set.empty stables_in_varsets)
+ end
+ | m ->
+ let is_negative = function
+ | Negative _ -> true
+ | Positive _ -> false in
+ if List.for_all is_negative m then
+ (* optimization: quit early if there are no positive rows.
+ This may happen often when the initial matrix has many
+ negative cases and few positive cases (a small guarded
+ clause after a long list of clauses) *)
+ All
+ else begin
+ let m = simplify_first_amb_col m in
+ if not (all_coherent (first_column m)) then
+ All
+ else begin
+ (* If the column is ill-typed but deemed coherent, we might
+ spuriously warn about some variables being unstable.
+ As sad as that might be, the warning can be silenced by
+ splitting the or-pattern... *)
+ let submatrices =
+ let extend_row columns = function
+ | Negative r -> Negative (columns @ r)
+ | Positive r -> Positive { r with row = columns @ r.row } in
+ let q0 = discr_pat Patterns.Simple.omega m in
+ let { default; constrs } =
+ build_specialized_submatrices ~extend_row q0 m in
+ let non_default = List.map snd constrs in
+ if full_match false constrs
+ then non_default
+ else default :: non_default in
+ (* A stable variable must be stable in each submatrix. *)
+ let submat_stable = List.map matrix_stable_vars submatrices in
+ List.fold_left stable_inter All submat_stable
+ end
+ end
+
+let pattern_stable_vars ns p =
+ matrix_stable_vars
+ (List.fold_left (fun m n -> Negative n :: m)
+ [Positive {varsets = []; row = [p]}] ns)
+
+(* All identifier paths that appear in an expression that occurs
+ as a clause right hand side or guard.
+*)
+
+let all_rhs_idents exp =
+ let ids = ref Ident.Set.empty in
+ let open Tast_iterator in
+ let expr_iter iter exp =
+ match exp.exp_desc with
+ | Texp_ident (path, _lid, _descr) ->
+ List.iter (fun id -> ids := Ident.Set.add id !ids) (Path.heads path)
+ (* Use default iterator methods for rest of match.*)
+ | _ -> Tast_iterator.default_iterator.expr iter exp
+ in
+ let iterator = {Tast_iterator.default_iterator with expr = expr_iter} in
+ iterator.expr iterator exp;
+ !ids
+
+let check_ambiguous_bindings =
+ let open Warnings in
+ let warn0 = Ambiguous_var_in_pattern_guard [] in
+ fun cases ->
+ if is_active warn0 then
+ let check_case ns case = match case with
+ | { c_lhs = p; c_guard=None ; _} -> [p]::ns
+ | { c_lhs = p; c_guard=Some g; _} ->
+ let all =
+ Ident.Set.inter (pattern_vars p) (all_rhs_idents g) in
+ if not (Ident.Set.is_empty all) then begin
+ match pattern_stable_vars ns p with
+ | All -> ()
+ | Vars stable ->
+ let ambiguous = Ident.Set.diff all stable in
+ if not (Ident.Set.is_empty ambiguous) then begin
+ let pps =
+ Ident.Set.elements ambiguous |> List.map Ident.name in
+ let warn = Ambiguous_var_in_pattern_guard pps in
+ Location.prerr_warning p.pat_loc warn
+ end
+ end;
+ ns
+ in
+ ignore (List.fold_left check_case [] cases)
diff --git a/upstream/ocaml_503/typing/parmatch.mli b/upstream/ocaml_503/typing/parmatch.mli
new file mode 100644
index 0000000000..7e40dd29cd
--- /dev/null
+++ b/upstream/ocaml_503/typing/parmatch.mli
@@ -0,0 +1,135 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Detection of partial matches and unused match cases. *)
+
+open Asttypes
+open Typedtree
+open Types
+
+(** Most checks in this file need not access all information about a case,
+ and just need a few pieces of information. [parmatch_case] is those
+ few pieces of information.
+*)
+type 'pattern parmatch_case =
+ { pattern : 'pattern;
+ has_guard : bool;
+ needs_refute : bool;
+ (** true if the program text claims the case is unreachable, a la
+ [function _ -> .]
+ *)
+ }
+
+type 'category typed_case := 'category general_pattern parmatch_case
+
+val typed_case : 'category case -> 'category typed_case
+val untyped_case : Parsetree.case -> Parsetree.pattern parmatch_case
+
+val const_compare : constant -> constant -> int
+(** [const_compare c1 c2] compares the actual values represented by [c1] and
+ [c2], while simply using [Stdlib.compare] would compare the
+ representations.
+
+ cf. MPR#5758 *)
+
+val le_pat : pattern -> pattern -> bool
+(** [le_pat p q] means: forall V, V matches q implies V matches p *)
+
+val le_pats : pattern list -> pattern list -> bool
+(** [le_pats (p1 .. pm) (q1 .. qn)] means: forall i <= m, [le_pat pi qi] *)
+
+(** Exported compatibility functor, abstracted over constructor equality *)
+module Compat :
+ functor
+ (_ : sig
+ val equal :
+ Types.constructor_description ->
+ Types.constructor_description ->
+ bool
+ end) -> sig
+ val compat : pattern -> pattern -> bool
+ val compats : pattern list -> pattern list -> bool
+ end
+
+exception Empty
+
+val lub : pattern -> pattern -> pattern
+(** [lub p q] is a pattern that matches all values matched by [p] and [q].
+ May raise [Empty], when [p] and [q] are not compatible. *)
+
+val lubs : pattern list -> pattern list -> pattern list
+(** [lubs [p1; ...; pn] [q1; ...; qk]], where [n < k], is
+ [[lub p1 q1; ...; lub pk qk]]. *)
+
+val get_mins : ('a -> 'a -> bool) -> 'a list -> 'a list
+
+(** This function recombines one pattern and its arguments:
+ For instance:
+ (_,_)::p1::p2::rem -> (p1, p2)::rem
+*)
+val set_args : pattern -> pattern list -> pattern list
+
+val pat_of_constr : pattern -> constructor_description -> pattern
+val complete_constrs :
+ constructor_description pattern_data ->
+ constructor_description list ->
+ constructor_description list
+
+(** [pats_of_type] builds a list of patterns from a given expected type,
+ for explosion of wildcard patterns in Typecore.type_pat.
+
+ There are four interesting cases:
+ - the type is empty ([])
+ - no further explosion is necessary ([Pat_any])
+ - a single pattern is generated, from a record or tuple type
+ or a single-variant type ([tp])
+ - a list of patterns, in the case that all branches
+ are GADT constructors ([tp1; ..; tpn]).
+ *)
+val pats_of_type : Env.t -> type_expr -> pattern list
+
+val pressure_variants:
+ Env.t -> pattern list -> unit
+val pressure_variants_in_computation_pattern:
+ Env.t -> computation general_pattern list -> unit
+
+(** [check_partial pred loc caselist] and [check_unused refute pred caselist]
+ are called with a function [pred] which will be given counter-example
+ candidates: they may be partially ill-typed, and have to be type-checked
+ to extract a valid counter-example.
+ [pred] returns a valid counter-example or [None].
+ [refute] indicates that [check_unused] was called on a refutation clause.
+ *)
+val check_partial:
+ (pattern -> pattern option) -> Location.t -> value typed_case list
+ -> partial
+
+val check_unused:
+ (bool -> pattern -> pattern option) -> value typed_case list -> unit
+
+(* Irrefutability tests *)
+val irrefutable : pattern -> bool
+
+(** An inactive pattern is a pattern, matching against which can be duplicated,
+ erased or delayed without change in observable behavior of the program.
+ Patterns containing (lazy _) subpatterns or reads of mutable fields are
+ active. *)
+val inactive : partial:partial -> pattern -> bool
+
+(* Ambiguous bindings. *)
+val check_ambiguous_bindings : value case list -> unit
+
+(* The tag used for open polymorphic variant types with an abstract row *)
+val some_private_tag : label
diff --git a/upstream/ocaml_503/typing/path.ml b/upstream/ocaml_503/typing/path.ml
new file mode 100644
index 0000000000..038ae48f88
--- /dev/null
+++ b/upstream/ocaml_503/typing/path.ml
@@ -0,0 +1,148 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+type t =
+ Pident of Ident.t
+ | Pdot of t * string
+ | Papply of t * t
+ | Pextra_ty of t * extra_ty
+and extra_ty =
+ | Pcstr_ty of string
+ | Pext_ty
+
+let rec same p1 p2 =
+ p1 == p2
+ || match (p1, p2) with
+ (Pident id1, Pident id2) -> Ident.same id1 id2
+ | (Pdot(p1, s1), Pdot(p2, s2)) ->
+ s1 = s2 && same p1 p2
+ | (Papply(fun1, arg1), Papply(fun2, arg2)) ->
+ same fun1 fun2 && same arg1 arg2
+ | (Pextra_ty (p1, t1), Pextra_ty (p2, t2)) ->
+ let same_extra = match t1, t2 with
+ | (Pcstr_ty s1, Pcstr_ty s2) -> s1 = s2
+ | (Pext_ty, Pext_ty) -> true
+ | ((Pcstr_ty _ | Pext_ty), _) -> false
+ in same_extra && same p1 p2
+ | (_, _) -> false
+
+let rec compare p1 p2 =
+ if p1 == p2 then 0
+ else match (p1, p2) with
+ (Pident id1, Pident id2) -> Ident.compare id1 id2
+ | (Pdot(p1, s1), Pdot(p2, s2)) ->
+ let h = compare p1 p2 in
+ if h <> 0 then h else String.compare s1 s2
+ | (Papply(fun1, arg1), Papply(fun2, arg2)) ->
+ let h = compare fun1 fun2 in
+ if h <> 0 then h else compare arg1 arg2
+ | (Pextra_ty (p1, t1), Pextra_ty (p2, t2)) ->
+ let h = compare_extra t1 t2 in
+ if h <> 0 then h else compare p1 p2
+ | (Pident _, (Pdot _ | Papply _ | Pextra_ty _))
+ | (Pdot _, (Papply _ | Pextra_ty _))
+ | (Papply _, Pextra_ty _)
+ -> -1
+ | ((Pextra_ty _ | Papply _ | Pdot _), Pident _)
+ | ((Pextra_ty _ | Papply _) , Pdot _)
+ | (Pextra_ty _, Papply _)
+ -> 1
+and compare_extra t1 t2 =
+ match (t1, t2) with
+ Pcstr_ty s1, Pcstr_ty s2 -> String.compare s1 s2
+ | (Pext_ty, Pext_ty)
+ -> 0
+ | (Pcstr_ty _, Pext_ty)
+ -> -1
+ | (Pext_ty, Pcstr_ty _)
+ -> 1
+
+let rec find_free_opt ids = function
+ Pident id -> List.find_opt (Ident.same id) ids
+ | Pdot(p, _) | Pextra_ty (p, _) -> find_free_opt ids p
+ | Papply(p1, p2) -> begin
+ match find_free_opt ids p1 with
+ | None -> find_free_opt ids p2
+ | Some _ as res -> res
+ end
+
+let exists_free ids p =
+ match find_free_opt ids p with
+ | None -> false
+ | _ -> true
+
+let rec scope = function
+ Pident id -> Ident.scope id
+ | Pdot(p, _) | Pextra_ty (p, _) -> scope p
+ | Papply(p1, p2) -> Int.max (scope p1) (scope p2)
+
+let kfalse _ = false
+
+let maybe_escape s =
+ if Lexer.is_keyword s then "\\#" ^ s else s
+
+let rec name ?(paren=kfalse) = function
+ Pident id -> maybe_escape (Ident.name id)
+ | Pdot(p, s) | Pextra_ty (p, Pcstr_ty s) ->
+ let s = maybe_escape s in
+ name ~paren p ^ if paren s then ".( " ^ s ^ " )" else "." ^ s
+ | Papply(p1, p2) -> name ~paren p1 ^ "(" ^ name ~paren p2 ^ ")"
+ | Pextra_ty (p, Pext_ty) -> name ~paren p
+
+let rec print ppf = function
+ | Pident id -> Ident.print_with_scope ppf id
+ | Pdot(p, s) | Pextra_ty (p, Pcstr_ty s) ->
+ Format_doc.fprintf ppf "%a.%s" print p s
+ | Papply(p1, p2) -> Format_doc.fprintf ppf "%a(%a)" print p1 print p2
+ | Pextra_ty (p, Pext_ty) -> print ppf p
+
+let rec head = function
+ Pident id -> id
+ | Pdot(p, _) | Pextra_ty (p, _) -> head p
+ | Papply _ -> assert false
+
+let flatten =
+ let rec flatten acc = function
+ | Pident id -> `Ok (id, acc)
+ | Pdot (p, s) | Pextra_ty (p, Pcstr_ty s) -> flatten (s :: acc) p
+ | Papply _ -> `Contains_apply
+ | Pextra_ty (p, Pext_ty) -> flatten acc p
+ in
+ fun t -> flatten [] t
+
+let heads p =
+ let rec heads p acc = match p with
+ | Pident id -> id :: acc
+ | Pdot (p, _) | Pextra_ty (p, _) -> heads p acc
+ | Papply(p1, p2) ->
+ heads p1 (heads p2 acc)
+ in heads p []
+
+let rec last = function
+ | Pident id -> Ident.name id
+ | Pdot(_, s) | Pextra_ty (_, Pcstr_ty s) -> s
+ | Papply(_, p) | Pextra_ty (p, Pext_ty) -> last p
+
+let is_constructor_typath p =
+ match p with
+ | Pident _ | Pdot _ | Papply _ -> false
+ | Pextra_ty _ -> true
+
+module T = struct
+ type nonrec t = t
+ let compare = compare
+end
+module Set = Set.Make(T)
+module Map = Map.Make(T)
diff --git a/upstream/ocaml_503/typing/path.mli b/upstream/ocaml_503/typing/path.mli
new file mode 100644
index 0000000000..034be0042e
--- /dev/null
+++ b/upstream/ocaml_503/typing/path.mli
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Access paths *)
+
+type t =
+ | Pident of Ident.t
+ (** Examples: x, List, int *)
+ | Pdot of t * string
+ (** Examples: List.map, Float.Array *)
+ | Papply of t * t
+ (** Examples: Set.Make(Int), Map.Make(Set.Make(Int)) *)
+ | Pextra_ty of t * extra_ty
+ (** [Pextra_ty (p, extra)] are additional paths of types
+ introduced by specific OCaml constructs. See below.
+ *)
+and extra_ty =
+ | Pcstr_ty of string
+ (** [Pextra_ty (p, Pcstr_ty c)] is the type of the inline record for
+ constructor [c] inside type [p].
+
+ For example, in
+ {[
+ type 'a t = Nil | Cons of {hd : 'a; tl : 'a t}
+ ]}
+
+ The inline record type [{hd : 'a; tl : 'a t}] cannot
+ be named by the user in the surface syntax, but internally
+ it has the path
+ [Pextra_ty (Pident `t`, Pcstr_ty "Cons")].
+ *)
+ | Pext_ty
+ (** [Pextra_ty (p, Pext_ty)] is the type of the inline record for
+ the extension constructor [p].
+
+ For example, in
+ {[
+ type exn += Error of {loc : loc; msg : string}
+ ]}
+
+ The inline record type [{loc : loc; msg : string}] cannot
+ be named by the user in the surface syntax, but internally
+ it has the path
+ [Pextra_ty (Pident `Error`, Pext_ty)].
+ *)
+
+val same: t -> t -> bool
+val compare: t -> t -> int
+val compare_extra: extra_ty -> extra_ty -> int
+val find_free_opt: Ident.t list -> t -> Ident.t option
+val exists_free: Ident.t list -> t -> bool
+val scope: t -> int
+val flatten : t -> [ `Contains_apply | `Ok of Ident.t * string list ]
+
+val name: ?paren:(string -> bool) -> t -> string
+ (* [paren] tells whether a path suffix needs parentheses *)
+val head: t -> Ident.t
+
+val print: t Format_doc.printer
+
+val heads: t -> Ident.t list
+
+val last: t -> string
+
+val is_constructor_typath: t -> bool
+
+module Map : Map.S with type key = t
+module Set : Set.S with type elt = t
diff --git a/upstream/ocaml_503/typing/patterns.ml b/upstream/ocaml_503/typing/patterns.ml
new file mode 100644
index 0000000000..456f8dff33
--- /dev/null
+++ b/upstream/ocaml_503/typing/patterns.ml
@@ -0,0 +1,254 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)
+(* Thomas Refis, Jane Street Europe *)
+(* *)
+(* Copyright 2019 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Types
+open Typedtree
+
+(* useful pattern auxiliary functions *)
+
+let omega = {
+ pat_desc = Tpat_any;
+ pat_loc = Location.none;
+ pat_extra = [];
+ pat_type = Ctype.none;
+ pat_env = Env.empty;
+ pat_attributes = [];
+}
+
+let rec omegas i =
+ if i <= 0 then [] else omega :: omegas (i-1)
+
+let omega_list l = List.map (fun _ -> omega) l
+
+module Non_empty_row = struct
+ type 'a t = 'a * Typedtree.pattern list
+
+ let of_initial = function
+ | [] -> assert false
+ | pat :: patl -> (pat, patl)
+
+ let map_first f (p, patl) = (f p, patl)
+end
+
+(* "views" on patterns are polymorphic variants
+ that allow to restrict the set of pattern constructors
+ statically allowed at a particular place *)
+
+module Simple = struct
+ type view = [
+ | `Any
+ | `Constant of constant
+ | `Tuple of pattern list
+ | `Construct of
+ Longident.t loc * constructor_description * pattern list
+ | `Variant of label * pattern option * row_desc ref
+ | `Record of
+ (Longident.t loc * label_description * pattern) list * closed_flag
+ | `Array of pattern list
+ | `Lazy of pattern
+ ]
+
+ type pattern = view pattern_data
+
+ let omega = { omega with pat_desc = `Any }
+end
+
+module Half_simple = struct
+ type view = [
+ | Simple.view
+ | `Or of pattern * pattern * row_desc option
+ ]
+
+ type pattern = view pattern_data
+end
+
+module General = struct
+ type view = [
+ | Half_simple.view
+ | `Var of Ident.t * string loc * Uid.t
+ | `Alias of pattern * Ident.t * string loc * Uid.t
+ ]
+ type pattern = view pattern_data
+
+ let view_desc = function
+ | Tpat_any ->
+ `Any
+ | Tpat_var (id, str, uid) ->
+ `Var (id, str, uid)
+ | Tpat_alias (p, id, str, uid) ->
+ `Alias (p, id, str, uid)
+ | Tpat_constant cst ->
+ `Constant cst
+ | Tpat_tuple ps ->
+ `Tuple ps
+ | Tpat_construct (cstr, cstr_descr, args, _) ->
+ `Construct (cstr, cstr_descr, args)
+ | Tpat_variant (cstr, arg, row_desc) ->
+ `Variant (cstr, arg, row_desc)
+ | Tpat_record (fields, closed) ->
+ `Record (fields, closed)
+ | Tpat_array ps -> `Array ps
+ | Tpat_or (p, q, row_desc) -> `Or (p, q, row_desc)
+ | Tpat_lazy p -> `Lazy p
+
+ let view p : pattern =
+ { p with pat_desc = view_desc p.pat_desc }
+
+ let erase_desc = function
+ | `Any -> Tpat_any
+ | `Var (id, str, uid) -> Tpat_var (id, str, uid)
+ | `Alias (p, id, str, uid) -> Tpat_alias (p, id, str, uid)
+ | `Constant cst -> Tpat_constant cst
+ | `Tuple ps -> Tpat_tuple ps
+ | `Construct (cstr, cst_descr, args) ->
+ Tpat_construct (cstr, cst_descr, args, None)
+ | `Variant (cstr, arg, row_desc) ->
+ Tpat_variant (cstr, arg, row_desc)
+ | `Record (fields, closed) ->
+ Tpat_record (fields, closed)
+ | `Array ps -> Tpat_array ps
+ | `Or (p, q, row_desc) -> Tpat_or (p, q, row_desc)
+ | `Lazy p -> Tpat_lazy p
+
+ let erase p : Typedtree.pattern =
+ { p with pat_desc = erase_desc p.pat_desc }
+
+ let rec strip_vars (p : pattern) : Half_simple.pattern =
+ match p.pat_desc with
+ | `Alias (p, _, _, _) -> strip_vars (view p)
+ | `Var _ -> { p with pat_desc = `Any }
+ | #Half_simple.view as view -> { p with pat_desc = view }
+end
+
+(* the head constructor of a simple pattern *)
+
+module Head : sig
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label; has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row : unit -> row_desc; }
+ | Array of int
+ | Lazy
+
+ type t = desc pattern_data
+
+ val arity : t -> int
+
+ (** [deconstruct p] returns the head of [p] and the list of sub patterns. *)
+ val deconstruct : Simple.pattern -> t * pattern list
+
+ (** reconstructs a pattern, putting wildcards as sub-patterns. *)
+ val to_omega_pattern : t -> pattern
+
+ val omega : t
+end = struct
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label; has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row : unit -> row_desc; }
+ (* the row of the type may evolve if [close_variant] is called,
+ hence the (unit -> ...) delay *)
+ | Array of int
+ | Lazy
+
+ type t = desc pattern_data
+
+ let deconstruct (q : Simple.pattern) =
+ let deconstruct_desc = function
+ | `Any -> Any, []
+ | `Constant c -> Constant c, []
+ | `Tuple args ->
+ Tuple (List.length args), args
+ | `Construct (_, c, args) ->
+ Construct c, args
+ | `Variant (tag, arg, cstr_row) ->
+ let has_arg, pats =
+ match arg with
+ | None -> false, []
+ | Some a -> true, [a]
+ in
+ let type_row () =
+ match get_desc (Ctype.expand_head q.pat_env q.pat_type) with
+ | Tvariant type_row -> type_row
+ | _ -> assert false
+ in
+ Variant {tag; has_arg; cstr_row; type_row}, pats
+ | `Array args ->
+ Array (List.length args), args
+ | `Record (largs, _) ->
+ let lbls = List.map (fun (_,lbl,_) -> lbl) largs in
+ let pats = List.map (fun (_,_,pat) -> pat) largs in
+ Record lbls, pats
+ | `Lazy p ->
+ Lazy, [p]
+ in
+ let desc, pats = deconstruct_desc q.pat_desc in
+ { q with pat_desc = desc }, pats
+
+ let arity t =
+ match t.pat_desc with
+ | Any -> 0
+ | Constant _ -> 0
+ | Construct c -> c.cstr_arity
+ | Tuple n | Array n -> n
+ | Record l -> List.length l
+ | Variant { has_arg; _ } -> if has_arg then 1 else 0
+ | Lazy -> 1
+
+ let to_omega_pattern t =
+ let pat_desc =
+ let mkloc x = Location.mkloc x t.pat_loc in
+ match t.pat_desc with
+ | Any -> Tpat_any
+ | Lazy -> Tpat_lazy omega
+ | Constant c -> Tpat_constant c
+ | Tuple n -> Tpat_tuple (omegas n)
+ | Array n -> Tpat_array (omegas n)
+ | Construct c ->
+ let lid_loc = mkloc (Longident.Lident c.cstr_name) in
+ Tpat_construct (lid_loc, c, omegas c.cstr_arity, None)
+ | Variant { tag; has_arg; cstr_row } ->
+ let arg_opt = if has_arg then Some omega else None in
+ Tpat_variant (tag, arg_opt, cstr_row)
+ | Record lbls ->
+ let lst =
+ List.map (fun lbl ->
+ let lid_loc = mkloc (Longident.Lident lbl.lbl_name) in
+ (lid_loc, lbl, omega)
+ ) lbls
+ in
+ Tpat_record (lst, Closed)
+ in
+ { t with
+ pat_desc;
+ pat_extra = [];
+ }
+
+ let omega = { omega with pat_desc = Any }
+end
diff --git a/upstream/ocaml_503/typing/patterns.mli b/upstream/ocaml_503/typing/patterns.mli
new file mode 100644
index 0000000000..2ad645b0d0
--- /dev/null
+++ b/upstream/ocaml_503/typing/patterns.mli
@@ -0,0 +1,109 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)
+(* Thomas Refis, Jane Street Europe *)
+(* *)
+(* Copyright 2019 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+open Types
+
+val omega : pattern
+(** aka. "Tpat_any" or "_" *)
+
+val omegas : int -> pattern list
+(** [List.init (fun _ -> omega)] *)
+
+val omega_list : 'a list -> pattern list
+(** [List.map (fun _ -> omega)] *)
+
+module Non_empty_row : sig
+ type 'a t = 'a * Typedtree.pattern list
+
+ val of_initial : Typedtree.pattern list -> Typedtree.pattern t
+ (** 'assert false' on empty rows *)
+
+ val map_first : ('a -> 'b) -> 'a t -> 'b t
+end
+
+module Simple : sig
+ type view = [
+ | `Any
+ | `Constant of constant
+ | `Tuple of pattern list
+ | `Construct of
+ Longident.t loc * constructor_description * pattern list
+ | `Variant of label * pattern option * row_desc ref
+ | `Record of
+ (Longident.t loc * label_description * pattern) list * closed_flag
+ | `Array of pattern list
+ | `Lazy of pattern
+ ]
+ type pattern = view pattern_data
+
+ val omega : [> view ] pattern_data
+end
+
+module Half_simple : sig
+ type view = [
+ | Simple.view
+ | `Or of pattern * pattern * row_desc option
+ ]
+ type pattern = view pattern_data
+end
+
+module General : sig
+ type view = [
+ | Half_simple.view
+ | `Var of Ident.t * string loc * Uid.t
+ | `Alias of pattern * Ident.t * string loc * Uid.t
+ ]
+ type pattern = view pattern_data
+
+ val view : Typedtree.pattern -> pattern
+ val erase : [< view ] pattern_data -> Typedtree.pattern
+
+ val strip_vars : pattern -> Half_simple.pattern
+end
+
+module Head : sig
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label; has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row : unit -> row_desc; }
+ (* the row of the type may evolve if [close_variant] is called,
+ hence the (unit -> ...) delay *)
+ | Array of int
+ | Lazy
+
+ type t = desc pattern_data
+
+ val arity : t -> int
+
+ (** [deconstruct p] returns the head of [p] and the list of sub patterns.
+
+ @raise [Invalid_arg _] if [p] is an or- or an exception-pattern. *)
+ val deconstruct : Simple.pattern -> t * pattern list
+
+ (** reconstructs a pattern, putting wildcards as sub-patterns. *)
+ val to_omega_pattern : t -> pattern
+
+ val omega : t
+
+end
diff --git a/upstream/ocaml_503/typing/persistent_env.ml b/upstream/ocaml_503/typing/persistent_env.ml
new file mode 100644
index 0000000000..bb70525734
--- /dev/null
+++ b/upstream/ocaml_503/typing/persistent_env.ml
@@ -0,0 +1,384 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* *)
+(* Copyright 2019 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. *)
+(* *)
+(**************************************************************************)
+
+(* Persistent structure descriptions *)
+
+open Misc
+open Cmi_format
+
+module Consistbl = Consistbl.Make (Misc.Stdlib.String)
+
+let add_delayed_check_forward = ref (fun _ -> assert false)
+
+type error =
+ | Illegal_renaming of modname * modname * filepath
+ | Inconsistent_import of modname * filepath * filepath
+ | Need_recursive_types of modname
+
+exception Error of error
+let error err = raise (Error err)
+
+module Persistent_signature = struct
+ type t =
+ { filename : string;
+ cmi : Cmi_format.cmi_infos;
+ visibility : Load_path.visibility }
+
+ let load = ref (fun ~allow_hidden ~unit_name ->
+ match Load_path.find_normalized_with_visibility (unit_name ^ ".cmi") with
+ | filename, visibility when allow_hidden ->
+ Some { filename; cmi = read_cmi filename; visibility}
+ | filename, Visible ->
+ Some { filename; cmi = read_cmi filename; visibility = Visible}
+ | _, Hidden
+ | exception Not_found -> None)
+end
+
+type can_load_cmis =
+ | Can_load_cmis
+ | Cannot_load_cmis of Lazy_backtrack.log
+
+type pers_struct = {
+ ps_name: string;
+ ps_crcs: (string * Digest.t option) list;
+ ps_filename: string;
+ ps_flags: pers_flags list;
+ ps_visibility: Load_path.visibility;
+}
+
+module String = Misc.Stdlib.String
+
+(* If a .cmi file is missing (or invalid), we
+ store it as Missing in the cache. *)
+type 'a pers_struct_info =
+ | Missing
+ | Found of pers_struct * 'a
+
+type 'a t = {
+ persistent_structures : (string, 'a pers_struct_info) Hashtbl.t;
+ imported_units: String.Set.t ref;
+ imported_opaque_units: String.Set.t ref;
+ crc_units: Consistbl.t;
+ can_load_cmis: can_load_cmis ref;
+}
+
+let empty () = {
+ persistent_structures = Hashtbl.create 17;
+ imported_units = ref String.Set.empty;
+ imported_opaque_units = ref String.Set.empty;
+ crc_units = Consistbl.create ();
+ can_load_cmis = ref Can_load_cmis;
+}
+
+let clear penv =
+ let {
+ persistent_structures;
+ imported_units;
+ imported_opaque_units;
+ crc_units;
+ can_load_cmis;
+ } = penv in
+ Hashtbl.clear persistent_structures;
+ imported_units := String.Set.empty;
+ imported_opaque_units := String.Set.empty;
+ Consistbl.clear crc_units;
+ can_load_cmis := Can_load_cmis;
+ ()
+
+let clear_missing {persistent_structures; _} =
+ let missing_entries =
+ Hashtbl.fold
+ (fun name r acc -> if r = Missing then name :: acc else acc)
+ persistent_structures []
+ in
+ List.iter (Hashtbl.remove persistent_structures) missing_entries
+
+let add_import {imported_units; _} s =
+ imported_units := String.Set.add s !imported_units
+
+let register_import_as_opaque {imported_opaque_units; _} s =
+ imported_opaque_units := String.Set.add s !imported_opaque_units
+
+let find_in_cache {persistent_structures; _} s =
+ match Hashtbl.find persistent_structures s with
+ | exception Not_found -> None
+ | Missing -> None
+ | Found (_ps, pm) -> Some pm
+
+let import_crcs penv ~source crcs =
+ let {crc_units; _} = penv in
+ let import_crc (name, crco) =
+ match crco with
+ | None -> ()
+ | Some crc ->
+ add_import penv name;
+ Consistbl.check crc_units name crc source
+ in List.iter import_crc crcs
+
+let check_consistency penv ps =
+ try import_crcs penv ~source:ps.ps_filename ps.ps_crcs
+ with Consistbl.Inconsistency {
+ unit_name = name;
+ inconsistent_source = source;
+ original_source = auth;
+ } ->
+ error (Inconsistent_import(name, auth, source))
+
+let can_load_cmis penv =
+ !(penv.can_load_cmis)
+let set_can_load_cmis penv setting =
+ penv.can_load_cmis := setting
+
+let without_cmis penv f x =
+ let log = Lazy_backtrack.log () in
+ let res =
+ Misc.(protect_refs
+ [R (penv.can_load_cmis, Cannot_load_cmis log)]
+ (fun () -> f x))
+ in
+ Lazy_backtrack.backtrack log;
+ res
+
+let fold {persistent_structures; _} f x =
+ Hashtbl.fold (fun modname pso x -> match pso with
+ | Missing -> x
+ | Found (_, pm) -> f modname pm x)
+ persistent_structures x
+
+(* Reading persistent structures from .cmi files *)
+
+let save_pers_struct penv crc ps pm =
+ let {persistent_structures; crc_units; _} = penv in
+ let modname = ps.ps_name in
+ Hashtbl.add persistent_structures modname (Found (ps, pm));
+ List.iter
+ (function
+ | Rectypes -> ()
+ | Alerts _ -> ()
+ | Opaque -> register_import_as_opaque penv modname)
+ ps.ps_flags;
+ Consistbl.check crc_units modname crc ps.ps_filename;
+ add_import penv modname
+
+let acknowledge_pers_struct penv check modname pers_sig pm =
+ let { Persistent_signature.filename; cmi; visibility } = pers_sig in
+ let name = cmi.cmi_name in
+ let crcs = cmi.cmi_crcs in
+ let flags = cmi.cmi_flags in
+ let ps = { ps_name = name;
+ ps_crcs = crcs;
+ ps_filename = filename;
+ ps_flags = flags;
+ ps_visibility = visibility;
+ } in
+ if ps.ps_name <> modname then
+ error (Illegal_renaming(modname, ps.ps_name, filename));
+ List.iter
+ (function
+ | Rectypes ->
+ if not !Clflags.recursive_types then
+ error (Need_recursive_types(ps.ps_name))
+ | Alerts _ -> ()
+ | Opaque -> register_import_as_opaque penv modname)
+ ps.ps_flags;
+ if check then check_consistency penv ps;
+ let {persistent_structures; _} = penv in
+ Hashtbl.add persistent_structures modname (Found (ps, pm));
+ ps
+
+let read_pers_struct penv val_of_pers_sig check cmi =
+ let modname = Unit_info.Artifact.modname cmi in
+ let filename = Unit_info.Artifact.filename cmi in
+ add_import penv modname;
+ let cmi = read_cmi filename in
+ let pers_sig = { Persistent_signature.filename; cmi; visibility = Visible } in
+ let pm = val_of_pers_sig pers_sig in
+ let ps = acknowledge_pers_struct penv check modname pers_sig pm in
+ (ps, pm)
+
+let find_pers_struct ~allow_hidden penv val_of_pers_sig check name =
+ let {persistent_structures; _} = penv in
+ if name = "*predef*" then raise Not_found;
+ match Hashtbl.find persistent_structures name with
+ | Found (ps, pm) when allow_hidden || ps.ps_visibility = Load_path.Visible ->
+ (ps, pm)
+ | Found _ -> raise Not_found
+ | Missing -> raise Not_found
+ | exception Not_found ->
+ match can_load_cmis penv with
+ | Cannot_load_cmis _ -> raise Not_found
+ | Can_load_cmis ->
+ let psig =
+ match !Persistent_signature.load ~allow_hidden ~unit_name:name with
+ | Some psig -> psig
+ | None ->
+ if allow_hidden then Hashtbl.add persistent_structures name Missing;
+ raise Not_found
+ in
+ add_import penv name;
+ let pm = val_of_pers_sig psig in
+ let ps = acknowledge_pers_struct penv check name psig pm in
+ (ps, pm)
+
+module Style = Misc.Style
+(* Emits a warning if there is no valid cmi for name *)
+let check_pers_struct ~allow_hidden penv f ~loc name =
+ try
+ ignore (find_pers_struct ~allow_hidden penv f false name)
+ with
+ | Not_found ->
+ let warn = Warnings.No_cmi_file(name, None) in
+ Location.prerr_warning loc warn
+ | Cmi_format.Error err ->
+ let msg = Format.asprintf "%a"
+ Cmi_format.report_error err in
+ let warn = Warnings.No_cmi_file(name, Some msg) in
+ Location.prerr_warning loc warn
+ | Error err ->
+ let msg =
+ match err with
+ | Illegal_renaming(name, ps_name, filename) ->
+ Format_doc.doc_printf
+ " %a@ contains the compiled interface for @ \
+ %a when %a was expected"
+ Location.Doc.quoted_filename filename
+ Style.inline_code ps_name
+ Style.inline_code name
+ | Inconsistent_import _ -> assert false
+ | Need_recursive_types name ->
+ Format_doc.doc_printf
+ "%a uses recursive types"
+ Style.inline_code name
+ in
+ let msg = Format_doc.(asprintf "%a" pp_doc) msg in
+ let warn = Warnings.No_cmi_file(name, Some msg) in
+ Location.prerr_warning loc warn
+
+let read penv f a =
+ snd (read_pers_struct penv f true a)
+
+let find ~allow_hidden penv f name =
+ snd (find_pers_struct ~allow_hidden penv f true name)
+
+let check ~allow_hidden penv f ~loc name =
+ let {persistent_structures; _} = penv in
+ if not (Hashtbl.mem persistent_structures name) then begin
+ (* PR#6843: record the weak dependency ([add_import]) regardless of
+ whether the check succeeds, to help make builds more
+ deterministic. *)
+ add_import penv name;
+ if (Warnings.is_active (Warnings.No_cmi_file("", None))) then
+ !add_delayed_check_forward
+ (fun () -> check_pers_struct ~allow_hidden penv f ~loc name)
+ end
+
+let crc_of_unit penv f name =
+ let (ps, _pm) = find_pers_struct ~allow_hidden:true penv f true name in
+ let crco =
+ try
+ List.assoc name ps.ps_crcs
+ with Not_found ->
+ assert false
+ in
+ match crco with
+ None -> assert false
+ | Some crc -> crc
+
+let imports {imported_units; crc_units; _} =
+ Consistbl.extract (String.Set.elements !imported_units) crc_units
+
+let looked_up {persistent_structures; _} modname =
+ Hashtbl.mem persistent_structures modname
+
+let is_imported {imported_units; _} s =
+ String.Set.mem s !imported_units
+
+let is_imported_opaque {imported_opaque_units; _} s =
+ String.Set.mem s !imported_opaque_units
+
+let make_cmi penv modname sign alerts =
+ let flags =
+ List.concat [
+ if !Clflags.recursive_types then [Cmi_format.Rectypes] else [];
+ if !Clflags.opaque then [Cmi_format.Opaque] else [];
+ [Alerts alerts];
+ ]
+ in
+ let crcs = imports penv in
+ {
+ cmi_name = modname;
+ cmi_sign = sign;
+ cmi_crcs = crcs;
+ cmi_flags = flags
+ }
+
+let save_cmi penv psig pm =
+ let { Persistent_signature.filename; cmi; visibility } = psig in
+ Misc.try_finally (fun () ->
+ let {
+ cmi_name = modname;
+ cmi_sign = _;
+ cmi_crcs = imports;
+ cmi_flags = flags;
+ } = cmi in
+ let crc =
+ output_to_file_via_temporary (* see MPR#7472, MPR#4991 *)
+ ~mode: [Open_binary] filename
+ (fun temp_filename oc -> output_cmi temp_filename oc cmi) in
+ (* Enter signature in persistent table so that imports()
+ will also return its crc *)
+ let ps =
+ { ps_name = modname;
+ ps_crcs = (cmi.cmi_name, Some crc) :: imports;
+ ps_filename = filename;
+ ps_flags = flags;
+ ps_visibility = visibility
+ } in
+ save_pers_struct penv crc ps pm
+ )
+ ~exceptionally:(fun () -> remove_file filename)
+
+let report_error_doc ppf =
+ let open Format_doc in
+ function
+ | Illegal_renaming(modname, ps_name, filename) -> fprintf ppf
+ "Wrong file naming: %a@ contains the compiled interface for@ \
+ %a when %a was expected"
+ Location.Doc.quoted_filename filename
+ Style.inline_code ps_name
+ Style.inline_code modname
+ | Inconsistent_import(name, source1, source2) -> fprintf ppf
+ "@[<hov>The files %a@ and %a@ \
+ make inconsistent assumptions@ over interface %a@]"
+ Location.Doc.quoted_filename source1
+ Location.Doc.quoted_filename source2
+ Style.inline_code name
+ | Need_recursive_types(import) ->
+ fprintf ppf
+ "@[<hov>Invalid import of %a, which uses recursive types.@ \
+ The compilation flag %a is required@]"
+ Style.inline_code import
+ Style.inline_code "-rectypes"
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err ->
+ Some (Location.error_of_printer_file report_error_doc err)
+ | _ -> None
+ )
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/upstream/ocaml_503/typing/persistent_env.mli b/upstream/ocaml_503/typing/persistent_env.mli
new file mode 100644
index 0000000000..6cbdfc81c7
--- /dev/null
+++ b/upstream/ocaml_503/typing/persistent_env.mli
@@ -0,0 +1,106 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* *)
+(* Copyright 2019 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. *)
+(* *)
+(**************************************************************************)
+
+open Misc
+
+module Consistbl : module type of struct
+ include Consistbl.Make (Misc.Stdlib.String)
+end
+
+type error =
+ | Illegal_renaming of modname * modname * filepath
+ | Inconsistent_import of modname * filepath * filepath
+ | Need_recursive_types of modname
+
+exception Error of error
+
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
+
+module Persistent_signature : sig
+ type t =
+ { filename : string; (** Name of the file containing the signature. *)
+ cmi : Cmi_format.cmi_infos;
+ visibility : Load_path.visibility
+ }
+
+ (** Function used to load a persistent signature. The default is to look for
+ the .cmi file in the load path. This function can be overridden to load
+ it from memory, for instance to build a self-contained toplevel. *)
+ val load : (allow_hidden:bool -> unit_name:string -> t option) ref
+end
+
+type can_load_cmis =
+ | Can_load_cmis
+ | Cannot_load_cmis of Lazy_backtrack.log
+
+type 'a t
+
+val empty : unit -> 'a t
+
+val clear : 'a t -> unit
+val clear_missing : 'a t -> unit
+
+val fold : 'a t -> (modname -> 'a -> 'b -> 'b) -> 'b -> 'b
+
+val read : 'a t -> (Persistent_signature.t -> 'a) -> Unit_info.Artifact.t -> 'a
+val find : allow_hidden:bool -> 'a t -> (Persistent_signature.t -> 'a)
+ -> modname -> 'a
+
+val find_in_cache : 'a t -> modname -> 'a option
+
+val check : allow_hidden:bool -> 'a t -> (Persistent_signature.t -> 'a)
+ -> loc:Location.t -> modname -> unit
+
+(* [looked_up penv md] checks if one has already tried
+ to read the signature for [md] in the environment
+ [penv] (it may have failed) *)
+val looked_up : 'a t -> modname -> bool
+
+(* [is_imported penv md] checks if [md] has been successfully
+ imported in the environment [penv] *)
+val is_imported : 'a t -> modname -> bool
+
+(* [is_imported_opaque penv md] checks if [md] has been imported
+ in [penv] as an opaque module *)
+val is_imported_opaque : 'a t -> modname -> bool
+
+(* [register_import_as_opaque penv md] registers [md] in [penv] as an
+ opaque module *)
+val register_import_as_opaque : 'a t -> modname -> unit
+
+val make_cmi : 'a t -> modname -> Types.signature -> alerts
+ -> Cmi_format.cmi_infos
+
+val save_cmi : 'a t -> Persistent_signature.t -> 'a -> unit
+
+val can_load_cmis : 'a t -> can_load_cmis
+val set_can_load_cmis : 'a t -> can_load_cmis -> unit
+val without_cmis : 'a t -> ('b -> 'c) -> 'b -> 'c
+(* [without_cmis penv f arg] applies [f] to [arg], but does not
+ allow [penv] to openi cmis during its execution *)
+
+(* may raise Consistbl.Inconsistency *)
+val import_crcs : 'a t -> source:filepath -> crcs -> unit
+
+(* Return the set of compilation units imported, with their CRC *)
+val imports : 'a t -> crcs
+
+(* Return the CRC of the interface of the given compilation unit *)
+val crc_of_unit: 'a t -> (Persistent_signature.t -> 'a) -> modname -> Digest.t
+
+(* Forward declaration to break mutual recursion with Typecore. *)
+val add_delayed_check_forward: ((unit -> unit) -> unit) ref
diff --git a/upstream/ocaml_503/typing/predef.ml b/upstream/ocaml_503/typing/predef.ml
new file mode 100644
index 0000000000..e7b24bd8fe
--- /dev/null
+++ b/upstream/ocaml_503/typing/predef.ml
@@ -0,0 +1,290 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Predefined type constructors (with special typing rules in typecore) *)
+
+open Path
+open Types
+open Btype
+
+let builtin_idents = ref []
+
+let wrap create s =
+ let id = create s in
+ builtin_idents := (s, id) :: !builtin_idents;
+ id
+
+let ident_create = wrap Ident.create_predef
+
+let ident_int = ident_create "int"
+and ident_char = ident_create "char"
+and ident_bytes = ident_create "bytes"
+and ident_float = ident_create "float"
+and ident_bool = ident_create "bool"
+and ident_unit = ident_create "unit"
+and ident_exn = ident_create "exn"
+and ident_eff = ident_create "eff"
+and ident_continuation = ident_create "continuation"
+and ident_array = ident_create "array"
+and ident_list = ident_create "list"
+and ident_option = ident_create "option"
+and ident_nativeint = ident_create "nativeint"
+and ident_int32 = ident_create "int32"
+and ident_int64 = ident_create "int64"
+and ident_lazy_t = ident_create "lazy_t"
+and ident_string = ident_create "string"
+and ident_extension_constructor = ident_create "extension_constructor"
+and ident_floatarray = ident_create "floatarray"
+
+let path_int = Pident ident_int
+and path_char = Pident ident_char
+and path_bytes = Pident ident_bytes
+and path_float = Pident ident_float
+and path_bool = Pident ident_bool
+and path_unit = Pident ident_unit
+and path_exn = Pident ident_exn
+and path_eff = Pident ident_eff
+and path_continuation = Pident ident_continuation
+and path_array = Pident ident_array
+and path_list = Pident ident_list
+and path_option = Pident ident_option
+and path_nativeint = Pident ident_nativeint
+and path_int32 = Pident ident_int32
+and path_int64 = Pident ident_int64
+and path_lazy_t = Pident ident_lazy_t
+and path_string = Pident ident_string
+and path_extension_constructor = Pident ident_extension_constructor
+and path_floatarray = Pident ident_floatarray
+
+let type_int = newgenty (Tconstr(path_int, [], ref Mnil))
+and type_char = newgenty (Tconstr(path_char, [], ref Mnil))
+and type_bytes = newgenty (Tconstr(path_bytes, [], ref Mnil))
+and type_float = newgenty (Tconstr(path_float, [], ref Mnil))
+and type_bool = newgenty (Tconstr(path_bool, [], ref Mnil))
+and type_unit = newgenty (Tconstr(path_unit, [], ref Mnil))
+and type_exn = newgenty (Tconstr(path_exn, [], ref Mnil))
+and type_eff t = newgenty (Tconstr(path_eff, [t], ref Mnil))
+and type_continuation t1 t2 =
+ newgenty (Tconstr(path_continuation, [t1; t2], ref Mnil))
+and type_array t = newgenty (Tconstr(path_array, [t], ref Mnil))
+and type_list t = newgenty (Tconstr(path_list, [t], ref Mnil))
+and type_option t = newgenty (Tconstr(path_option, [t], ref Mnil))
+and type_nativeint = newgenty (Tconstr(path_nativeint, [], ref Mnil))
+and type_int32 = newgenty (Tconstr(path_int32, [], ref Mnil))
+and type_int64 = newgenty (Tconstr(path_int64, [], ref Mnil))
+and type_lazy_t t = newgenty (Tconstr(path_lazy_t, [t], ref Mnil))
+and type_string = newgenty (Tconstr(path_string, [], ref Mnil))
+and type_extension_constructor =
+ newgenty (Tconstr(path_extension_constructor, [], ref Mnil))
+and type_floatarray = newgenty (Tconstr(path_floatarray, [], ref Mnil))
+
+let ident_match_failure = ident_create "Match_failure"
+and ident_out_of_memory = ident_create "Out_of_memory"
+and ident_invalid_argument = ident_create "Invalid_argument"
+and ident_failure = ident_create "Failure"
+and ident_not_found = ident_create "Not_found"
+and ident_sys_error = ident_create "Sys_error"
+and ident_end_of_file = ident_create "End_of_file"
+and ident_division_by_zero = ident_create "Division_by_zero"
+and ident_stack_overflow = ident_create "Stack_overflow"
+and ident_sys_blocked_io = ident_create "Sys_blocked_io"
+and ident_assert_failure = ident_create "Assert_failure"
+and ident_undefined_recursive_module =
+ ident_create "Undefined_recursive_module"
+and ident_continuation_already_taken = ident_create "Continuation_already_taken"
+
+
+let all_predef_exns = [
+ ident_match_failure;
+ ident_out_of_memory;
+ ident_invalid_argument;
+ ident_failure;
+ ident_not_found;
+ ident_sys_error;
+ ident_end_of_file;
+ ident_division_by_zero;
+ ident_stack_overflow;
+ ident_sys_blocked_io;
+ ident_assert_failure;
+ ident_undefined_recursive_module;
+ ident_continuation_already_taken;
+]
+
+let path_match_failure = Pident ident_match_failure
+and path_assert_failure = Pident ident_assert_failure
+and path_undefined_recursive_module = Pident ident_undefined_recursive_module
+
+let cstr id args =
+ {
+ cd_id = id;
+ cd_args = Cstr_tuple args;
+ cd_res = None;
+ cd_loc = Location.none;
+ cd_attributes = [];
+ cd_uid = Uid.of_predef_id id;
+ }
+
+let ident_false = ident_create "false"
+and ident_true = ident_create "true"
+and ident_void = ident_create "()"
+and ident_nil = ident_create "[]"
+and ident_cons = ident_create "::"
+and ident_none = ident_create "None"
+and ident_some = ident_create "Some"
+
+let mk_add_type add_type type_ident ?manifest
+ ?(immediate=Type_immediacy.Unknown) ?(kind=Type_abstract Definition) env =
+ let decl =
+ {type_params = [];
+ type_arity = 0;
+ type_kind = kind;
+ type_loc = Location.none;
+ type_private = Asttypes.Public;
+ type_manifest = manifest;
+ type_variance = [];
+ type_separability = [];
+ type_is_newtype = false;
+ type_expansion_scope = lowest_level;
+ type_attributes = [];
+ type_immediate = immediate;
+ type_unboxed_default = false;
+ type_uid = Uid.of_predef_id type_ident;
+ }
+ in
+ add_type type_ident decl env
+
+let build_initial_env add_type add_extension empty_env =
+ let add_type = mk_add_type add_type
+ and add_type1 type_ident
+ ~variance ~separability ?(kind=fun _ -> Type_abstract Definition) env =
+ let param = newgenvar () in
+ let decl =
+ {type_params = [param];
+ type_arity = 1;
+ type_kind = kind param;
+ type_loc = Location.none;
+ type_private = Asttypes.Public;
+ type_manifest = None;
+ type_variance = [variance];
+ type_separability = [separability];
+ type_is_newtype = false;
+ type_expansion_scope = lowest_level;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.of_predef_id type_ident;
+ }
+ in
+ add_type type_ident decl env
+ and add_continuation type_ident env =
+ let tvar1 = newgenvar() in
+ let tvar2 = newgenvar() in
+ let arity = 2 in
+ let decl =
+ {type_params = [tvar1; tvar2];
+ type_arity = arity;
+ type_kind = Type_abstract Definition;
+ type_loc = Location.none;
+ type_private = Asttypes.Public;
+ type_manifest = None;
+ type_variance = [Variance.contravariant; Variance.covariant];
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = lowest_level;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.of_predef_id type_ident;
+ }
+ in
+ add_type type_ident decl env
+ in
+ let add_extension id l =
+ add_extension id
+ { ext_type_path = path_exn;
+ ext_type_params = [];
+ ext_args = Cstr_tuple l;
+ ext_ret_type = None;
+ ext_private = Asttypes.Public;
+ ext_loc = Location.none;
+ ext_attributes = [Ast_helper.Attr.mk
+ (Location.mknoloc "ocaml.warn_on_literal_pattern")
+ (Parsetree.PStr [])];
+ ext_uid = Uid.of_predef_id id;
+ }
+ in
+ let variant constrs = Type_variant (constrs, Variant_regular) in
+ empty_env
+ (* Predefined types - alphabetical order *)
+ |> add_type1 ident_array
+ ~variance:Variance.full
+ ~separability:Separability.Ind
+ |> add_type ident_bool
+ ~immediate:Always
+ ~kind:(variant [cstr ident_false []; cstr ident_true []])
+ |> add_type ident_char ~immediate:Always
+ |> add_type ident_exn ~kind:Type_open
+ |> add_type1 ident_eff
+ ~variance:Variance.full
+ ~separability:Separability.Ind
+ ~kind:(fun _ -> Type_open)
+ |> add_continuation ident_continuation
+ |> add_type ident_extension_constructor
+ |> add_type ident_float
+ |> add_type ident_floatarray
+ |> add_type ident_int ~immediate:Always
+ |> add_type ident_int32
+ |> add_type ident_int64
+ |> add_type1 ident_lazy_t
+ ~variance:Variance.covariant
+ ~separability:Separability.Ind
+ |> add_type1 ident_list
+ ~variance:Variance.covariant
+ ~separability:Separability.Ind
+ ~kind:(fun tvar ->
+ variant [cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]])
+ |> add_type ident_nativeint
+ |> add_type1 ident_option
+ ~variance:Variance.covariant
+ ~separability:Separability.Ind
+ ~kind:(fun tvar ->
+ variant [cstr ident_none []; cstr ident_some [tvar]])
+ |> add_type ident_string
+ |> add_type ident_bytes
+ |> add_type ident_unit
+ ~immediate:Always
+ ~kind:(variant [cstr ident_void []])
+ (* Predefined exceptions - alphabetical order *)
+ |> add_extension ident_assert_failure
+ [newgenty (Ttuple[type_string; type_int; type_int])]
+ |> add_extension ident_division_by_zero []
+ |> add_extension ident_end_of_file []
+ |> add_extension ident_failure [type_string]
+ |> add_extension ident_invalid_argument [type_string]
+ |> add_extension ident_match_failure
+ [newgenty (Ttuple[type_string; type_int; type_int])]
+ |> add_extension ident_not_found []
+ |> add_extension ident_out_of_memory []
+ |> add_extension ident_stack_overflow []
+ |> add_extension ident_sys_blocked_io []
+ |> add_extension ident_sys_error [type_string]
+ |> add_extension ident_undefined_recursive_module
+ [newgenty (Ttuple[type_string; type_int; type_int])]
+ |> add_extension ident_continuation_already_taken []
+
+let builtin_values =
+ List.map (fun id -> (Ident.name id, id)) all_predef_exns
+
+let builtin_idents = List.rev !builtin_idents
diff --git a/upstream/ocaml_503/typing/predef.mli b/upstream/ocaml_503/typing/predef.mli
new file mode 100644
index 0000000000..4653514337
--- /dev/null
+++ b/upstream/ocaml_503/typing/predef.mli
@@ -0,0 +1,91 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Predefined type constructors (with special typing rules in typecore) *)
+
+open Types
+
+val type_int: type_expr
+val type_char: type_expr
+val type_string: type_expr
+val type_bytes: type_expr
+val type_float: type_expr
+val type_bool: type_expr
+val type_unit: type_expr
+val type_exn: type_expr
+val type_eff: type_expr -> type_expr
+val type_continuation: type_expr -> type_expr -> type_expr
+val type_array: type_expr -> type_expr
+val type_list: type_expr -> type_expr
+val type_option: type_expr -> type_expr
+val type_nativeint: type_expr
+val type_int32: type_expr
+val type_int64: type_expr
+val type_lazy_t: type_expr -> type_expr
+val type_extension_constructor:type_expr
+val type_floatarray:type_expr
+
+val path_int: Path.t
+val path_char: Path.t
+val path_string: Path.t
+val path_bytes: Path.t
+val path_float: Path.t
+val path_bool: Path.t
+val path_unit: Path.t
+val path_exn: Path.t
+val path_eff: Path.t
+val path_array: Path.t
+val path_list: Path.t
+val path_option: Path.t
+val path_nativeint: Path.t
+val path_int32: Path.t
+val path_int64: Path.t
+val path_lazy_t: Path.t
+val path_extension_constructor: Path.t
+val path_floatarray: Path.t
+val path_continuation: Path.t
+
+val path_match_failure: Path.t
+val path_assert_failure : Path.t
+val path_undefined_recursive_module : Path.t
+
+val ident_false : Ident.t
+val ident_true : Ident.t
+val ident_void : Ident.t
+val ident_nil : Ident.t
+val ident_cons : Ident.t
+val ident_none : Ident.t
+val ident_some : Ident.t
+
+(* To build the initial environment. Since there is a nasty mutual
+ recursion between predef and env, we break it by parameterizing
+ over Env.t, Env.add_type and Env.add_extension. *)
+
+val build_initial_env:
+ (Ident.t -> type_declaration -> 'a -> 'a) ->
+ (Ident.t -> extension_constructor -> 'a -> 'a) ->
+ 'a -> 'a
+
+(* To initialize linker tables *)
+
+val builtin_values: (string * Ident.t) list
+val builtin_idents: (string * Ident.t) list
+
+(** All predefined exceptions, exposed as [Ident.t] for flambda (for
+ building value approximations).
+ The [Ident.t] for division by zero is also exported explicitly
+ so flambda can generate code to raise it. *)
+val ident_division_by_zero: Ident.t
+val all_predef_exns : Ident.t list
diff --git a/upstream/ocaml_503/typing/primitive.ml b/upstream/ocaml_503/typing/primitive.ml
new file mode 100644
index 0000000000..a0cb5d712b
--- /dev/null
+++ b/upstream/ocaml_503/typing/primitive.ml
@@ -0,0 +1,257 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Description of primitive functions *)
+
+open Misc
+open Parsetree
+
+type boxed_integer = Pnativeint | Pint32 | Pint64
+
+type native_repr =
+ | Same_as_ocaml_repr
+ | Unboxed_float
+ | Unboxed_integer of boxed_integer
+ | Untagged_immediate
+
+type description =
+ { prim_name: string; (* Name of primitive or C function *)
+ prim_arity: int; (* Number of arguments *)
+ prim_alloc: bool; (* Does it allocates or raise? *)
+ prim_native_name: string; (* Name of C function for the nat. code gen. *)
+ prim_native_repr_args: native_repr list;
+ prim_native_repr_res: native_repr }
+
+type error =
+ | Old_style_float_with_native_repr_attribute
+ | Old_style_noalloc_with_noalloc_attribute
+ | No_native_primitive_with_repr_attribute
+
+exception Error of Location.t * error
+
+let is_ocaml_repr = function
+ | Same_as_ocaml_repr -> true
+ | Unboxed_float
+ | Unboxed_integer _
+ | Untagged_immediate -> false
+
+let is_unboxed = function
+ | Same_as_ocaml_repr
+ | Untagged_immediate -> false
+ | Unboxed_float
+ | Unboxed_integer _ -> true
+
+let is_untagged = function
+ | Untagged_immediate -> true
+ | Same_as_ocaml_repr
+ | Unboxed_float
+ | Unboxed_integer _ -> false
+
+let rec make_native_repr_args arity x =
+ if arity = 0 then
+ []
+ else
+ x :: make_native_repr_args (arity - 1) x
+
+let simple ~name ~arity ~alloc =
+ {prim_name = name;
+ prim_arity = arity;
+ prim_alloc = alloc;
+ prim_native_name = "";
+ prim_native_repr_args = make_native_repr_args arity Same_as_ocaml_repr;
+ prim_native_repr_res = Same_as_ocaml_repr}
+
+let make ~name ~alloc ~native_name ~native_repr_args ~native_repr_res =
+ {prim_name = name;
+ prim_arity = List.length native_repr_args;
+ prim_alloc = alloc;
+ prim_native_name = native_name;
+ prim_native_repr_args = native_repr_args;
+ prim_native_repr_res = native_repr_res}
+
+let parse_declaration valdecl ~native_repr_args ~native_repr_res =
+ let arity = List.length native_repr_args in
+ let name, native_name, old_style_noalloc, old_style_float =
+ match valdecl.pval_prim with
+ | name :: "noalloc" :: name2 :: "float" :: _ -> (name, name2, true, true)
+ | name :: "noalloc" :: name2 :: _ -> (name, name2, true, false)
+ | name :: name2 :: "float" :: _ -> (name, name2, false, true)
+ | name :: "noalloc" :: _ -> (name, "", true, false)
+ | name :: name2 :: _ -> (name, name2, false, false)
+ | name :: _ -> (name, "", false, false)
+ | [] ->
+ fatal_error "Primitive.parse_declaration"
+ in
+ let noalloc_attribute =
+ Attr_helper.has_no_payload_attribute "noalloc" valdecl.pval_attributes
+ in
+ if old_style_float &&
+ not (List.for_all is_ocaml_repr native_repr_args &&
+ is_ocaml_repr native_repr_res) then
+ raise (Error (valdecl.pval_loc,
+ Old_style_float_with_native_repr_attribute));
+ if old_style_noalloc && noalloc_attribute then
+ raise (Error (valdecl.pval_loc,
+ Old_style_noalloc_with_noalloc_attribute));
+ (* The compiler used to assume "noalloc" with "float", we just make this
+ explicit now (GPR#167): *)
+ let old_style_noalloc = old_style_noalloc || old_style_float in
+ if old_style_float then
+ Location.deprecated valdecl.pval_loc
+ "[@@unboxed] + [@@noalloc] should be used\n\
+ instead of \"float\""
+ else if old_style_noalloc then
+ Location.deprecated valdecl.pval_loc
+ "[@@noalloc] should be used instead of \"noalloc\"";
+ if native_name = "" &&
+ not (List.for_all is_ocaml_repr native_repr_args &&
+ is_ocaml_repr native_repr_res) then
+ raise (Error (valdecl.pval_loc,
+ No_native_primitive_with_repr_attribute));
+ let noalloc = old_style_noalloc || noalloc_attribute in
+ let native_repr_args, native_repr_res =
+ if old_style_float then
+ (make_native_repr_args arity Unboxed_float, Unboxed_float)
+ else
+ (native_repr_args, native_repr_res)
+ in
+ {prim_name = name;
+ prim_arity = arity;
+ prim_alloc = not noalloc;
+ prim_native_name = native_name;
+ prim_native_repr_args = native_repr_args;
+ prim_native_repr_res = native_repr_res}
+
+open Outcometree
+
+let rec add_native_repr_attributes ty attrs =
+ match ty, attrs with
+ | Otyp_arrow (label, a, b), attr_opt :: rest ->
+ let b = add_native_repr_attributes b rest in
+ let a =
+ match attr_opt with
+ | None -> a
+ | Some attr -> Otyp_attribute (a, attr)
+ in
+ Otyp_arrow (label, a, b)
+ | _, [Some attr] -> Otyp_attribute (ty, attr)
+ | _ ->
+ assert (List.for_all (fun x -> x = None) attrs);
+ ty
+
+let oattr_unboxed = { oattr_name = "unboxed" }
+let oattr_untagged = { oattr_name = "untagged" }
+let oattr_noalloc = { oattr_name = "noalloc" }
+
+let print p osig_val_decl =
+ let prims =
+ if p.prim_native_name <> "" then
+ [p.prim_name; p.prim_native_name]
+ else
+ [p.prim_name]
+ in
+ let for_all f =
+ List.for_all f p.prim_native_repr_args && f p.prim_native_repr_res
+ in
+ let all_unboxed = for_all is_unboxed in
+ let all_untagged = for_all is_untagged in
+ let attrs = if p.prim_alloc then [] else [oattr_noalloc] in
+ let attrs =
+ if all_unboxed then
+ oattr_unboxed :: attrs
+ else if all_untagged then
+ oattr_untagged :: attrs
+ else
+ attrs
+ in
+ let attr_of_native_repr = function
+ | Same_as_ocaml_repr -> None
+ | Unboxed_float
+ | Unboxed_integer _ -> if all_unboxed then None else Some oattr_unboxed
+ | Untagged_immediate -> if all_untagged then None else Some oattr_untagged
+ in
+ let type_attrs =
+ List.map attr_of_native_repr p.prim_native_repr_args @
+ [attr_of_native_repr p.prim_native_repr_res]
+ in
+ { osig_val_decl with
+ oval_prims = prims;
+ oval_type = add_native_repr_attributes osig_val_decl.oval_type type_attrs;
+ oval_attributes = attrs }
+
+let native_name p =
+ if p.prim_native_name <> ""
+ then p.prim_native_name
+ else p.prim_name
+
+let byte_name p =
+ p.prim_name
+
+let equal_boxed_integer bi1 bi2 =
+ match bi1, bi2 with
+ | Pnativeint, Pnativeint
+ | Pint32, Pint32
+ | Pint64, Pint64 ->
+ true
+ | (Pnativeint | Pint32 | Pint64), _ ->
+ false
+
+let equal_native_repr nr1 nr2 =
+ match nr1, nr2 with
+ | Same_as_ocaml_repr, Same_as_ocaml_repr -> true
+ | Same_as_ocaml_repr,
+ (Unboxed_float | Unboxed_integer _ | Untagged_immediate) -> false
+ | Unboxed_float, Unboxed_float -> true
+ | Unboxed_float,
+ (Same_as_ocaml_repr | Unboxed_integer _ | Untagged_immediate) -> false
+ | Unboxed_integer bi1, Unboxed_integer bi2 -> equal_boxed_integer bi1 bi2
+ | Unboxed_integer _,
+ (Same_as_ocaml_repr | Unboxed_float | Untagged_immediate) -> false
+ | Untagged_immediate, Untagged_immediate -> true
+ | Untagged_immediate,
+ (Same_as_ocaml_repr | Unboxed_float | Unboxed_integer _) -> false
+
+let native_name_is_external p =
+ let nat_name = native_name p in
+ nat_name <> "" && nat_name.[0] <> '%'
+
+module Style = Misc.Style
+
+let report_error ppf err =
+ match err with
+ | Old_style_float_with_native_repr_attribute ->
+ Format_doc.fprintf ppf "Cannot use %a in conjunction with %a/%a."
+ Style.inline_code "float"
+ Style.inline_code "[@unboxed]"
+ Style.inline_code "[@untagged]"
+ | Old_style_noalloc_with_noalloc_attribute ->
+ Format_doc.fprintf ppf "Cannot use %a in conjunction with %a."
+ Style.inline_code "noalloc"
+ Style.inline_code "[@@noalloc]"
+ | No_native_primitive_with_repr_attribute ->
+ Format_doc.fprintf ppf
+ "@[The native code version of the primitive is mandatory@ \
+ when attributes %a or %a are present.@]"
+ Style.inline_code "[@untagged]"
+ Style.inline_code "[@unboxed]"
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc, err) ->
+ Some (Location.error_of_printer ~loc report_error err)
+ | _ ->
+ None
+ )
diff --git a/upstream/ocaml_503/typing/primitive.mli b/upstream/ocaml_503/typing/primitive.mli
new file mode 100644
index 0000000000..3d3ae8854c
--- /dev/null
+++ b/upstream/ocaml_503/typing/primitive.mli
@@ -0,0 +1,79 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Description of primitive functions *)
+
+type boxed_integer = Pnativeint | Pint32 | Pint64
+
+(* Representation of arguments/result for the native code version
+ of a primitive *)
+type native_repr =
+ | Same_as_ocaml_repr
+ | Unboxed_float
+ | Unboxed_integer of boxed_integer
+ | Untagged_immediate
+
+type description = private
+ { prim_name: string; (* Name of primitive or C function *)
+ prim_arity: int; (* Number of arguments *)
+ prim_alloc: bool; (* Does it allocates or raise? *)
+ prim_native_name: string; (* Name of C function for the nat. code gen. *)
+ prim_native_repr_args: native_repr list;
+ prim_native_repr_res: native_repr }
+
+(* Invariant [List.length d.prim_native_repr_args = d.prim_arity] *)
+
+val simple
+ : name:string
+ -> arity:int
+ -> alloc:bool
+ -> description
+
+val make
+ : name:string
+ -> alloc:bool
+ -> native_name:string
+ -> native_repr_args: native_repr list
+ -> native_repr_res: native_repr
+ -> description
+
+val parse_declaration
+ : Parsetree.value_description
+ -> native_repr_args:native_repr list
+ -> native_repr_res:native_repr
+ -> description
+
+val print
+ : description
+ -> Outcometree.out_val_decl
+ -> Outcometree.out_val_decl
+
+val native_name: description -> string
+val byte_name: description -> string
+
+val equal_boxed_integer : boxed_integer -> boxed_integer -> bool
+val equal_native_repr : native_repr -> native_repr -> bool
+
+(** [native_name_is_externa] returns [true] iff the [native_name] for the
+ given primitive identifies that the primitive is not implemented in the
+ compiler itself. *)
+val native_name_is_external : description -> bool
+
+type error =
+ | Old_style_float_with_native_repr_attribute
+ | Old_style_noalloc_with_noalloc_attribute
+ | No_native_primitive_with_repr_attribute
+
+exception Error of Location.t * error
diff --git a/upstream/ocaml_503/typing/printpat.ml b/upstream/ocaml_503/typing/printpat.ml
new file mode 100644
index 0000000000..d4897294d0
--- /dev/null
+++ b/upstream/ocaml_503/typing/printpat.ml
@@ -0,0 +1,173 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Values as patterns pretty printer *)
+
+open Asttypes
+open Typedtree
+open Types
+open Format_doc
+
+let is_cons = function
+| {cstr_name = "::"} -> true
+| _ -> false
+
+let pretty_const c = match c with
+| Const_int i -> Printf.sprintf "%d" i
+| Const_char c -> Printf.sprintf "%C" c
+| Const_string (s, _, _) -> Printf.sprintf "%S" s
+| Const_float f -> Printf.sprintf "%s" f
+| Const_int32 i -> Printf.sprintf "%ldl" i
+| Const_int64 i -> Printf.sprintf "%LdL" i
+| Const_nativeint i -> Printf.sprintf "%ndn" i
+
+let pretty_extra ppf (cstr, _loc, _attrs) pretty_rest rest =
+ match cstr with
+ | Tpat_unpack ->
+ fprintf ppf "@[(module %a)@]" pretty_rest rest
+ | Tpat_constraint _ ->
+ fprintf ppf "@[(%a : _)@]" pretty_rest rest
+ | Tpat_type _ ->
+ fprintf ppf "@[(# %a)@]" pretty_rest rest
+ | Tpat_open _ ->
+ fprintf ppf "@[(# %a)@]" pretty_rest rest
+
+let rec pretty_val : type k . _ -> k general_pattern -> _ = fun ppf v ->
+ match v.pat_extra with
+ | extra :: rem ->
+ pretty_extra ppf extra
+ pretty_val { v with pat_extra = rem }
+ | [] ->
+ match v.pat_desc with
+ | Tpat_any -> fprintf ppf "_"
+ | Tpat_var (x,_,_) -> fprintf ppf "%s" (Ident.name x)
+ | Tpat_constant c -> fprintf ppf "%s" (pretty_const c)
+ | Tpat_tuple vs ->
+ fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
+ | Tpat_construct (_, cstr, [], _) ->
+ fprintf ppf "%s" cstr.cstr_name
+ | Tpat_construct (_, cstr, [w], None) ->
+ fprintf ppf "@[<2>%s@ %a@]" cstr.cstr_name pretty_arg w
+ | Tpat_construct (_, cstr, vs, vto) ->
+ let name = cstr.cstr_name in
+ begin match (name, vs, vto) with
+ ("::", [v1;v2], None) ->
+ fprintf ppf "@[%a::@,%a@]" pretty_car v1 pretty_cdr v2
+ | (_, _, None) ->
+ fprintf ppf "@[<2>%s@ @[(%a)@]@]" name (pretty_vals ",") vs
+ | (_, _, Some ([], _t)) ->
+ fprintf ppf "@[<2>%s@ @[(%a : _)@]@]" name (pretty_vals ",") vs
+ | (_, _, Some (vl, _t)) ->
+ let vars = List.map (fun x -> Ident.name x.txt) vl in
+ fprintf ppf "@[<2>%s@ (type %s)@ @[(%a : _)@]@]"
+ name (String.concat " " vars) (pretty_vals ",") vs
+ end
+ | Tpat_variant (l, None, _) ->
+ fprintf ppf "`%s" l
+ | Tpat_variant (l, Some w, _) ->
+ fprintf ppf "@[<2>`%s@ %a@]" l pretty_arg w
+ | Tpat_record (lvs,_) ->
+ let filtered_lvs = List.filter
+ (function
+ | (_,_,{pat_desc=Tpat_any}) -> false (* do not show lbl=_ *)
+ | _ -> true) lvs in
+ begin match filtered_lvs with
+ | [] -> fprintf ppf "{ _ }"
+ | (_, lbl, _) :: q ->
+ let elision_mark ppf =
+ (* we assume that there is no label repetitions here *)
+ if Array.length lbl.lbl_all > 1 + List.length q then
+ fprintf ppf ";@ _@ "
+ else () in
+ fprintf ppf "@[{%a%t}@]"
+ pretty_lvals filtered_lvs elision_mark
+ end
+ | Tpat_array vs ->
+ fprintf ppf "@[[| %a |]@]" (pretty_vals " ;") vs
+ | Tpat_lazy v ->
+ fprintf ppf "@[<2>lazy@ %a@]" pretty_arg v
+ | Tpat_alias (v, x,_,_) ->
+ fprintf ppf "@[(%a@ as %a)@]" pretty_val v Ident.doc_print x
+ | Tpat_value v ->
+ fprintf ppf "%a" pretty_val (v :> pattern)
+ | Tpat_exception v ->
+ fprintf ppf "@[<2>exception@ %a@]" pretty_arg v
+ | Tpat_or _ ->
+ fprintf ppf "@[(%a)@]" pretty_or v
+
+and pretty_car ppf v = match v.pat_desc with
+| Tpat_construct (_,cstr, [_ ; _], None)
+ when is_cons cstr ->
+ fprintf ppf "(%a)" pretty_val v
+| _ -> pretty_val ppf v
+
+and pretty_cdr ppf v = match v.pat_desc with
+| Tpat_construct (_,cstr, [v1 ; v2], None)
+ when is_cons cstr ->
+ fprintf ppf "%a::@,%a" pretty_car v1 pretty_cdr v2
+| _ -> pretty_val ppf v
+
+and pretty_arg ppf v = match v.pat_desc with
+| Tpat_construct (_,_,_::_,None)
+| Tpat_variant (_, Some _, _) -> fprintf ppf "(%a)" pretty_val v
+| _ -> pretty_val ppf v
+
+and pretty_or : type k . _ -> k general_pattern -> _ = fun ppf v ->
+ match v.pat_desc with
+ | Tpat_or (v,w,_) ->
+ fprintf ppf "%a|@,%a" pretty_or v pretty_or w
+ | _ -> pretty_val ppf v
+
+and pretty_vals sep ppf = function
+ | [] -> ()
+ | [v] -> pretty_val ppf v
+ | v::vs ->
+ fprintf ppf "%a%s@ %a" pretty_val v sep (pretty_vals sep) vs
+
+and pretty_lvals ppf = function
+ | [] -> ()
+ | [_,lbl,v] ->
+ fprintf ppf "%s=%a" lbl.lbl_name pretty_val v
+ | (_, lbl,v)::rest ->
+ fprintf ppf "%s=%a;@ %a"
+ lbl.lbl_name pretty_val v pretty_lvals rest
+
+let top_pretty ppf v =
+ fprintf ppf "@[%a@]" pretty_val v
+
+let pretty_pat ppf p =
+ top_pretty ppf p ;
+ pp_print_flush ppf ()
+
+type 'k matrix = 'k general_pattern list list
+
+let pretty_line ppf line =
+ fprintf ppf "@[";
+ List.iter (fun p ->
+ fprintf ppf "<%a>@ "
+ pretty_val p
+ ) line;
+ fprintf ppf "@]"
+
+let pretty_matrix ppf (pss : 'k matrix) =
+ fprintf ppf "@[<v 2> %a@]"
+ (pp_print_list ~pp_sep:pp_print_cut pretty_line)
+ pss
+
+module Compat = struct
+ let pretty_pat ppf x = compat pretty_pat ppf x
+ let pretty_line ppf x = compat pretty_line ppf x
+ let pretty_matrix ppf x = compat pretty_matrix ppf x
+end
diff --git a/upstream/ocaml_503/typing/printpat.mli b/upstream/ocaml_503/typing/printpat.mli
new file mode 100644
index 0000000000..2d9a93ce6d
--- /dev/null
+++ b/upstream/ocaml_503/typing/printpat.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+
+
+val pretty_const
+ : Asttypes.constant -> string
+
+val top_pretty: 'k Typedtree.general_pattern Format_doc.printer
+
+module Compat: sig
+ val pretty_pat: Format.formatter -> 'k Typedtree.general_pattern -> unit
+ val pretty_line: Format.formatter -> 'k Typedtree.general_pattern list -> unit
+ val pretty_matrix:
+ Format.formatter -> 'k Typedtree.general_pattern list list -> unit
+end
diff --git a/upstream/ocaml_503/typing/printtyp.ml b/upstream/ocaml_503/typing/printtyp.ml
new file mode 100644
index 0000000000..649f4b94ce
--- /dev/null
+++ b/upstream/ocaml_503/typing/printtyp.ml
@@ -0,0 +1,174 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+open Out_type
+module Fmt = Format_doc
+
+let namespaced_ident namespace id =
+ Out_name.print (ident_name (Some namespace) id)
+
+module Doc = struct
+ let wrap_printing_env = wrap_printing_env
+
+ let longident = Pprintast.Doc.longident
+
+ let ident ppf id = Fmt.pp_print_string ppf
+ (Out_name.print (ident_name None id))
+
+
+
+ let typexp mode ppf ty =
+ !Oprint.out_type ppf (tree_of_typexp mode ty)
+
+ let type_expansion k ppf e =
+ pp_type_expansion ppf (trees_of_type_expansion k e)
+
+ let type_declaration id ppf decl =
+ !Oprint.out_sig_item ppf (tree_of_type_declaration id decl Trec_first)
+
+ let type_expr ppf ty =
+ (* [type_expr] is used directly by error message printers,
+ we mark eventual loops ourself to avoid any misuse and stack overflow *)
+ prepare_for_printing [ty];
+ prepared_type_expr ppf ty
+
+ let shared_type_scheme ppf ty =
+ add_type_to_preparation ty;
+ typexp Type_scheme ppf ty
+
+ let type_scheme ppf ty =
+ prepare_for_printing [ty];
+ prepared_type_scheme ppf ty
+
+ let path ppf p =
+ !Oprint.out_ident ppf (tree_of_path ~disambiguation:false p)
+
+ let () = Env.print_path := path
+
+ let type_path ppf p = !Oprint.out_ident ppf (tree_of_type_path p)
+
+ let value_description id ppf decl =
+ !Oprint.out_sig_item ppf (tree_of_value_description id decl)
+
+ let class_type ppf cty =
+ reset ();
+ prepare_class_type cty;
+ !Oprint.out_class_type ppf (tree_of_class_type Type cty)
+
+ let class_declaration id ppf cl =
+ !Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
+
+ let cltype_declaration id ppf cl =
+ !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl Trec_first)
+
+ let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
+ let modtype_declaration id ppf decl =
+ !Oprint.out_sig_item ppf (tree_of_modtype_declaration id decl)
+
+ let constructor ppf c =
+ reset_except_conflicts ();
+ add_constructor_to_preparation c;
+ prepared_constructor ppf c
+
+ let constructor_arguments ppf a =
+ let tys = tree_of_constructor_arguments a in
+ !Oprint.out_type ppf (Otyp_tuple tys)
+
+ let label ppf l =
+ prepare_for_printing [l.Types.ld_type];
+ !Oprint.out_label ppf (tree_of_label l)
+
+ let extension_constructor id ppf ext =
+ !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
+
+ (* Print an extension declaration *)
+
+
+
+ let extension_only_constructor id ppf (ext:Types.extension_constructor) =
+ reset_except_conflicts ();
+ prepare_type_constructor_arguments ext.ext_args;
+ Option.iter add_type_to_preparation ext.ext_ret_type;
+ let name = Ident.name id in
+ let args, ret =
+ extension_constructor_args_and_ret_type_subtree
+ ext.ext_args
+ ext.ext_ret_type
+ in
+ Fmt.fprintf ppf "@[<hv>%a@]"
+ !Oprint.out_constr {
+ Outcometree.ocstr_name = name;
+ ocstr_args = args;
+ ocstr_return_type = ret;
+ }
+
+ (* Print a signature body (used by -i when compiling a .ml) *)
+
+ let print_signature ppf tree =
+ Fmt.fprintf ppf "@[<v>%a@]" !Oprint.out_signature tree
+
+ let signature ppf sg =
+ Fmt.fprintf ppf "%a" print_signature (tree_of_signature sg)
+
+end
+open Doc
+let string_of_path p = Fmt.asprintf "%a" path p
+
+let strings_of_paths namespace p =
+ let trees = List.map (namespaced_tree_of_path namespace) p in
+ List.map (Fmt.asprintf "%a" !Oprint.out_ident) trees
+
+let wrap_printing_env = wrap_printing_env
+let ident = Fmt.compat ident
+let longident = Fmt.compat longident
+let path = Fmt.compat path
+let type_path = Fmt.compat type_path
+let type_expr = Fmt.compat type_expr
+let type_scheme = Fmt.compat type_scheme
+let shared_type_scheme = Fmt.compat shared_type_scheme
+
+let type_declaration = Fmt.compat1 type_declaration
+let type_expansion = Fmt.compat1 type_expansion
+let value_description = Fmt.compat1 value_description
+let label = Fmt.compat label
+let constructor = Fmt.compat constructor
+let constructor_arguments = Fmt.compat constructor_arguments
+let extension_constructor = Fmt.compat1 extension_constructor
+let extension_only_constructor = Fmt.compat1 extension_only_constructor
+
+let modtype = Fmt.compat modtype
+let modtype_declaration = Fmt.compat1 modtype_declaration
+let signature = Fmt.compat signature
+
+let class_declaration = Fmt.compat1 class_declaration
+let class_type = Fmt.compat class_type
+let cltype_declaration = Fmt.compat1 cltype_declaration
+
+
+(* Print a signature body (used by -i when compiling a .ml) *)
+let printed_signature sourcefile ppf sg =
+ (* we are tracking any collision event for warning 63 *)
+ Ident_conflicts.reset ();
+ let t = tree_of_signature sg in
+ if Warnings.(is_active @@ Erroneous_printed_signature "") then
+ begin match Ident_conflicts.err_msg () with
+ | None -> ()
+ | Some msg ->
+ let conflicts = Fmt.asprintf "%a" Fmt.pp_doc msg in
+ Location.prerr_warning (Location.in_file sourcefile)
+ (Warnings.Erroneous_printed_signature conflicts);
+ Warnings.check_fatal ()
+ end;
+ Fmt.compat print_signature ppf t
diff --git a/upstream/ocaml_503/typing/printtyp.mli b/upstream/ocaml_503/typing/printtyp.mli
new file mode 100644
index 0000000000..75955f4268
--- /dev/null
+++ b/upstream/ocaml_503/typing/printtyp.mli
@@ -0,0 +1,103 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+(** Printing functions *)
+
+
+open Types
+
+type namespace := Shape.Sig_component_kind.t
+
+val namespaced_ident: namespace -> Ident.t -> string
+val string_of_path: Path.t -> string
+val strings_of_paths: namespace -> Path.t list -> string list
+(** Print a list of paths, using the same naming context to
+ avoid name collisions *)
+
+(** [printed_signature sourcefile ppf sg] print the signature [sg] of
+ [sourcefile] with potential warnings for name collisions *)
+val printed_signature: string -> Format.formatter -> signature -> unit
+
+module type Printers := sig
+
+ val wrap_printing_env: error:bool -> Env.t -> (unit -> 'a) -> 'a
+ (** Call the function using the environment for type path shortening This
+ affects all the printing functions below Also, if [~error:true], then
+ disable the loading of cmis *)
+
+ type 'a printer
+ val longident: Longident.t printer
+ val ident: Ident.t printer
+ val path: Path.t printer
+ val type_path: Path.t printer
+ (** Print a type path taking account of [-short-paths].
+ Calls should be within [wrap_printing_env]. *)
+
+
+ (** Print out a type. This will pick names for type variables, and will not
+ reuse names for common type variables shared across multiple type
+ expressions. (It will also reset the printing state, which matters for
+ other type formatters such as [prepared_type_expr].) If you want
+ multiple types to use common names for type variables, see
+ {!Out_type.prepare_for_printing} and {!Out_type.prepared_type_expr}. *)
+ val type_expr: type_expr printer
+
+ val type_scheme: type_expr printer
+
+ val shared_type_scheme: type_expr printer
+ (** [shared_type_scheme] is very similar to [type_scheme], but does not
+ reset the printing context first. This is intended to be used in cases
+ where the printing should have a particularly wide context, such as
+ documentation generators; most use cases, such as error messages, have
+ narrower contexts for which [type_scheme] is better suited. *)
+
+ val type_expansion:
+ Out_type.type_or_scheme -> Errortrace.expanded_type printer
+
+ val label : label_declaration printer
+
+ val constructor : constructor_declaration printer
+ val constructor_arguments: constructor_arguments printer
+
+ val extension_constructor:
+ Ident.t -> extension_constructor printer
+ (** Prints extension constructor with the type signature:
+ type ('a, 'b) bar += A of float
+ *)
+
+ val extension_only_constructor:
+ Ident.t -> extension_constructor printer
+ (** Prints only extension constructor without type signature:
+ A of float
+ *)
+
+
+ val value_description: Ident.t -> value_description printer
+ val type_declaration: Ident.t -> type_declaration printer
+ val modtype_declaration: Ident.t -> modtype_declaration printer
+ val class_declaration: Ident.t -> class_declaration printer
+ val cltype_declaration: Ident.t -> class_type_declaration printer
+
+
+ val modtype: module_type printer
+ val signature: signature printer
+ val class_type: class_type printer
+
+ end
+
+module Doc : Printers with type 'a printer := 'a Format_doc.printer
+
+(** For compatibility with Format printers *)
+include Printers with type 'a printer := 'a Format_doc.format_printer
diff --git a/upstream/ocaml_503/typing/printtyped.ml b/upstream/ocaml_503/typing/printtyped.ml
new file mode 100644
index 0000000000..c68c7a6c37
--- /dev/null
+++ b/upstream/ocaml_503/typing/printtyped.ml
@@ -0,0 +1,1003 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 1999 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Format
+open Lexing
+open Location
+open Typedtree
+
+let fmt_position f l =
+ if l.pos_lnum = -1
+ then fprintf f "%s[%d]" l.pos_fname l.pos_cnum
+ else fprintf f "%s[%d,%d+%d]" l.pos_fname l.pos_lnum l.pos_bol
+ (l.pos_cnum - l.pos_bol)
+
+let fmt_location f loc =
+ if not !Clflags.locations then ()
+ else begin
+ fprintf f "(%a..%a)" fmt_position loc.loc_start fmt_position loc.loc_end;
+ if loc.loc_ghost then fprintf f " ghost";
+ end
+
+let rec fmt_longident_aux f x =
+ match x with
+ | Longident.Lident (s) -> fprintf f "%s" s;
+ | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s;
+ | Longident.Lapply (y, z) ->
+ fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z
+
+let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x.txt
+
+let fmt_ident = Ident.print
+
+let fmt_modname f = function
+ | None -> fprintf f "_";
+ | Some id -> Ident.print f id
+
+let rec fmt_path_aux f x =
+ match x with
+ | Path.Pident (s) -> fprintf f "%a" fmt_ident s
+ | Path.Pdot (y, s) | Path.(Pextra_ty (y, Pcstr_ty s)) ->
+ fprintf f "%a.%s" fmt_path_aux y s
+ | Path.Papply (y, z) ->
+ fprintf f "%a(%a)" fmt_path_aux y fmt_path_aux z
+ | Path.Pextra_ty (y, Pext_ty) -> fmt_path_aux f y
+
+let fmt_path f x = fprintf f "\"%a\"" fmt_path_aux x
+
+let fmt_constant f x =
+ match x with
+ | Const_int (i) -> fprintf f "Const_int %d" i
+ | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c)
+ | Const_string (s, strloc, None) ->
+ fprintf f "Const_string(%S,%a,None)" s fmt_location strloc
+ | Const_string (s, strloc, Some delim) ->
+ fprintf f "Const_string (%S,%a,Some %S)" s fmt_location strloc delim
+ | Const_float (s) -> fprintf f "Const_float %s" s
+ | Const_int32 (i) -> fprintf f "Const_int32 %ld" i
+ | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i
+ | Const_nativeint (i) -> fprintf f "Const_nativeint %nd" i
+
+let fmt_mutable_flag f x =
+ match x with
+ | Immutable -> fprintf f "Immutable"
+ | Mutable -> fprintf f "Mutable"
+
+let fmt_virtual_flag f x =
+ match x with
+ | Virtual -> fprintf f "Virtual"
+ | Concrete -> fprintf f "Concrete"
+
+let fmt_override_flag f x =
+ match x with
+ | Override -> fprintf f "Override"
+ | Fresh -> fprintf f "Fresh"
+
+let fmt_closed_flag f x =
+ match x with
+ | Closed -> fprintf f "Closed"
+ | Open -> fprintf f "Open"
+
+let fmt_rec_flag f x =
+ match x with
+ | Nonrecursive -> fprintf f "Nonrec"
+ | Recursive -> fprintf f "Rec"
+
+let fmt_direction_flag f x =
+ match x with
+ | Upto -> fprintf f "Up"
+ | Downto -> fprintf f "Down"
+
+let fmt_private_flag f x =
+ match x with
+ | Public -> fprintf f "Public"
+ | Private -> fprintf f "Private"
+
+let fmt_partiality f x =
+ match x with
+ | Total -> ()
+ | Partial -> fprintf f " (Partial)"
+
+let line i f s (*...*) =
+ fprintf f "%s" (String.make (2*i) ' ');
+ fprintf f s (*...*)
+
+let list i f ppf l =
+ match l with
+ | [] -> line i ppf "[]\n"
+ | _ :: _ ->
+ line i ppf "[\n";
+ List.iter (f (i+1) ppf) l;
+ line i ppf "]\n"
+
+let array i f ppf a =
+ if Array.length a = 0 then
+ line i ppf "[]\n"
+ else begin
+ line i ppf "[\n";
+ Array.iter (f (i+1) ppf) a;
+ line i ppf "]\n"
+ end
+
+let option i f ppf x =
+ match x with
+ | None -> line i ppf "None\n"
+ | Some x ->
+ line i ppf "Some\n";
+ f (i+1) ppf x
+
+let longident i ppf li = line i ppf "%a\n" fmt_longident li
+let string i ppf s = line i ppf "\"%s\"\n" s
+let arg_label i ppf = function
+ | Nolabel -> line i ppf "Nolabel\n"
+ | Optional s -> line i ppf "Optional \"%s\"\n" s
+ | Labelled s -> line i ppf "Labelled \"%s\"\n" s
+
+let typevars ppf vs =
+ List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt) vs
+
+let record_representation i ppf = let open Types in function
+ | Record_regular -> line i ppf "Record_regular\n"
+ | Record_float -> line i ppf "Record_float\n"
+ | Record_unboxed b -> line i ppf "Record_unboxed %b\n" b
+ | Record_inlined i -> line i ppf "Record_inlined %d\n" i
+ | Record_extension p -> line i ppf "Record_extension %a\n" fmt_path p
+
+let attribute i ppf k a =
+ line i ppf "%s \"%s\"\n" k a.Parsetree.attr_name.txt;
+ Printast.payload i ppf a.Parsetree.attr_payload
+
+let attributes i ppf l =
+ let i = i + 1 in
+ List.iter (fun a ->
+ line i ppf "attribute \"%s\"\n" a.Parsetree.attr_name.txt;
+ Printast.payload (i + 1) ppf a.Parsetree.attr_payload
+ ) l
+
+let rec core_type i ppf x =
+ line i ppf "core_type %a\n" fmt_location x.ctyp_loc;
+ attributes i ppf x.ctyp_attributes;
+ let i = i+1 in
+ match x.ctyp_desc with
+ | Ttyp_any -> line i ppf "Ttyp_any\n";
+ | Ttyp_var (s) -> line i ppf "Ttyp_var %s\n" s;
+ | Ttyp_arrow (l, ct1, ct2) ->
+ line i ppf "Ttyp_arrow\n";
+ arg_label i ppf l;
+ core_type i ppf ct1;
+ core_type i ppf ct2;
+ | Ttyp_tuple l ->
+ line i ppf "Ttyp_tuple\n";
+ list i core_type ppf l;
+ | Ttyp_constr (li, _, l) ->
+ line i ppf "Ttyp_constr %a\n" fmt_path li;
+ list i core_type ppf l;
+ | Ttyp_variant (l, closed, low) ->
+ line i ppf "Ttyp_variant closed=%a\n" fmt_closed_flag closed;
+ list i label_x_bool_x_core_type_list ppf l;
+ option i (fun i -> list i string) ppf low
+ | Ttyp_object (l, c) ->
+ line i ppf "Ttyp_object %a\n" fmt_closed_flag c;
+ let i = i + 1 in
+ List.iter (fun {of_desc; of_attributes; _} ->
+ match of_desc with
+ | OTtag (s, t) ->
+ line i ppf "method %s\n" s.txt;
+ attributes i ppf of_attributes;
+ core_type (i + 1) ppf t
+ | OTinherit ct ->
+ line i ppf "OTinherit\n";
+ core_type (i + 1) ppf ct
+ ) l
+ | Ttyp_class (li, _, l) ->
+ line i ppf "Ttyp_class %a\n" fmt_path li;
+ list i core_type ppf l;
+ | Ttyp_alias (ct, s) ->
+ line i ppf "Ttyp_alias \"%s\"\n" s.txt;
+ core_type i ppf ct;
+ | Ttyp_poly (sl, ct) ->
+ line i ppf "Ttyp_poly%a\n"
+ (fun ppf -> List.iter (fun x -> fprintf ppf " '%s" x)) sl;
+ core_type i ppf ct;
+ | Ttyp_package { pack_path = s; pack_fields = l } ->
+ line i ppf "Ttyp_package %a\n" fmt_path s;
+ list i package_with ppf l;
+ | Ttyp_open (path, _mod_ident, t) ->
+ line i ppf "Ttyp_open %a\n" fmt_path path;
+ core_type i ppf t
+
+and package_with i ppf (s, t) =
+ line i ppf "with type %a\n" fmt_longident s;
+ core_type i ppf t
+
+and pattern : type k . _ -> _ -> k general_pattern -> unit = fun i ppf x ->
+ line i ppf "pattern %a\n" fmt_location x.pat_loc;
+ attributes i ppf x.pat_attributes;
+ let i = i+1 in
+ begin match x.pat_extra with
+ | [] -> ()
+ | extra ->
+ line i ppf "extra\n";
+ List.iter (pattern_extra (i+1) ppf) extra;
+ end;
+ match x.pat_desc with
+ | Tpat_any -> line i ppf "Tpat_any\n";
+ | Tpat_var (s,_,_) -> line i ppf "Tpat_var \"%a\"\n" fmt_ident s;
+ | Tpat_alias (p, s,_,_) ->
+ line i ppf "Tpat_alias \"%a\"\n" fmt_ident s;
+ pattern i ppf p;
+ | Tpat_constant (c) -> line i ppf "Tpat_constant %a\n" fmt_constant c;
+ | Tpat_tuple (l) ->
+ line i ppf "Tpat_tuple\n";
+ list i pattern ppf l;
+ | Tpat_construct (li, _, po, vto) ->
+ line i ppf "Tpat_construct %a\n" fmt_longident li;
+ list i pattern ppf po;
+ option i
+ (fun i ppf (vl,ct) ->
+ let names = List.map (fun {txt} -> "\""^Ident.name txt^"\"") vl in
+ line i ppf "[%s]\n" (String.concat "; " names);
+ core_type i ppf ct)
+ ppf vto
+ | Tpat_variant (l, po, _) ->
+ line i ppf "Tpat_variant \"%s\"\n" l;
+ option i pattern ppf po;
+ | Tpat_record (l, _c) ->
+ line i ppf "Tpat_record\n";
+ list i longident_x_pattern ppf l;
+ | Tpat_array (l) ->
+ line i ppf "Tpat_array\n";
+ list i pattern ppf l;
+ | Tpat_lazy p ->
+ line i ppf "Tpat_lazy\n";
+ pattern i ppf p;
+ | Tpat_exception p ->
+ line i ppf "Tpat_exception\n";
+ pattern i ppf p;
+ | Tpat_value p ->
+ line i ppf "Tpat_value\n";
+ pattern i ppf (p :> pattern);
+ | Tpat_or (p1, p2, _) ->
+ line i ppf "Tpat_or\n";
+ pattern i ppf p1;
+ pattern i ppf p2;
+
+and pattern_extra i ppf (extra_pat, _, attrs) =
+ match extra_pat with
+ | Tpat_unpack ->
+ line i ppf "Tpat_extra_unpack\n";
+ attributes i ppf attrs;
+ | Tpat_constraint cty ->
+ line i ppf "Tpat_extra_constraint\n";
+ attributes i ppf attrs;
+ core_type i ppf cty;
+ | Tpat_type (id, _) ->
+ line i ppf "Tpat_extra_type %a\n" fmt_path id;
+ attributes i ppf attrs;
+ | Tpat_open (id,_,_) ->
+ line i ppf "Tpat_extra_open %a\n" fmt_path id;
+ attributes i ppf attrs;
+
+and function_body i ppf (body : function_body) =
+ match[@warning "+9"] body with
+ | Tfunction_body e ->
+ line i ppf "Tfunction_body\n";
+ expression (i+1) ppf e
+ | Tfunction_cases
+ { cases; loc; exp_extra; attributes = attrs; param = _; partial }
+ ->
+ line i ppf "Tfunction_cases%a %a\n"
+ fmt_partiality partial
+ fmt_location loc;
+ attributes (i+1) ppf attrs;
+ Option.iter (fun e -> expression_extra (i+1) ppf e []) exp_extra;
+ list (i+1) case ppf cases
+
+and expression_extra i ppf x attrs =
+ match x with
+ | Texp_constraint ct ->
+ line i ppf "Texp_constraint\n";
+ attributes i ppf attrs;
+ core_type i ppf ct;
+ | Texp_coerce (cto1, cto2) ->
+ line i ppf "Texp_coerce\n";
+ attributes i ppf attrs;
+ option i core_type ppf cto1;
+ core_type i ppf cto2;
+ | Texp_poly cto ->
+ line i ppf "Texp_poly\n";
+ attributes i ppf attrs;
+ option i core_type ppf cto;
+ | Texp_newtype s ->
+ line i ppf "Texp_newtype \"%s\"\n" s;
+ attributes i ppf attrs;
+
+and expression i ppf x =
+ line i ppf "expression %a\n" fmt_location x.exp_loc;
+ attributes i ppf x.exp_attributes;
+ let i = i+1 in
+ begin match x.exp_extra with
+ | [] -> ()
+ | extra ->
+ line i ppf "extra\n";
+ List.iter (fun (x, _, attrs) -> expression_extra (i+1) ppf x attrs) extra;
+ end;
+ match x.exp_desc with
+ | Texp_ident (li,_,_) -> line i ppf "Texp_ident %a\n" fmt_path li;
+ | Texp_instvar (_, li,_) -> line i ppf "Texp_instvar %a\n" fmt_path li;
+ | Texp_constant (c) -> line i ppf "Texp_constant %a\n" fmt_constant c;
+ | Texp_let (rf, l, e) ->
+ line i ppf "Texp_let %a\n" fmt_rec_flag rf;
+ list i (value_binding rf) ppf l;
+ expression i ppf e;
+ | Texp_function (params, body) ->
+ line i ppf "Texp_function\n";
+ list i function_param ppf params;
+ function_body i ppf body;
+ | Texp_apply (e, l) ->
+ line i ppf "Texp_apply\n";
+ expression i ppf e;
+ list i label_x_expression ppf l;
+ | Texp_match (e, l1, l2, partial) ->
+ line i ppf "Texp_match%a\n" fmt_partiality partial;
+ expression i ppf e;
+ list i case ppf l1;
+ list i case ppf l2;
+ | Texp_try (e, l1, l2) ->
+ line i ppf "Texp_try\n";
+ expression i ppf e;
+ list i case ppf l1;
+ list i case ppf l2;
+ | Texp_tuple (l) ->
+ line i ppf "Texp_tuple\n";
+ list i expression ppf l;
+ | Texp_construct (li, _, eo) ->
+ line i ppf "Texp_construct %a\n" fmt_longident li;
+ list i expression ppf eo;
+ | Texp_variant (l, eo) ->
+ line i ppf "Texp_variant \"%s\"\n" l;
+ option i expression ppf eo;
+ | Texp_record { fields; representation; extended_expression } ->
+ line i ppf "Texp_record\n";
+ let i = i+1 in
+ line i ppf "fields =\n";
+ array (i+1) record_field ppf fields;
+ line i ppf "representation =\n";
+ record_representation (i+1) ppf representation;
+ line i ppf "extended_expression =\n";
+ option (i+1) expression ppf extended_expression;
+ | Texp_field (e, li, _) ->
+ line i ppf "Texp_field\n";
+ expression i ppf e;
+ longident i ppf li;
+ | Texp_setfield (e1, li, _, e2) ->
+ line i ppf "Texp_setfield\n";
+ expression i ppf e1;
+ longident i ppf li;
+ expression i ppf e2;
+ | Texp_array (l) ->
+ line i ppf "Texp_array\n";
+ list i expression ppf l;
+ | Texp_ifthenelse (e1, e2, eo) ->
+ line i ppf "Texp_ifthenelse\n";
+ expression i ppf e1;
+ expression i ppf e2;
+ option i expression ppf eo;
+ | Texp_sequence (e1, e2) ->
+ line i ppf "Texp_sequence\n";
+ expression i ppf e1;
+ expression i ppf e2;
+ | Texp_while (e1, e2) ->
+ line i ppf "Texp_while\n";
+ expression i ppf e1;
+ expression i ppf e2;
+ | Texp_for (s, _, e1, e2, df, e3) ->
+ line i ppf "Texp_for \"%a\" %a\n" fmt_ident s fmt_direction_flag df;
+ expression i ppf e1;
+ expression i ppf e2;
+ expression i ppf e3;
+ | Texp_send (e, Tmeth_name s) ->
+ line i ppf "Texp_send \"%s\"\n" s;
+ expression i ppf e
+ | Texp_send (e, Tmeth_val s) ->
+ line i ppf "Texp_send \"%a\"\n" fmt_ident s;
+ expression i ppf e
+ | Texp_send (e, Tmeth_ancestor(s, _)) ->
+ line i ppf "Texp_send \"%a\"\n" fmt_ident s;
+ expression i ppf e
+ | Texp_new (li, _, _) -> line i ppf "Texp_new %a\n" fmt_path li;
+ | Texp_setinstvar (_, s, _, e) ->
+ line i ppf "Texp_setinstvar %a\n" fmt_path s;
+ expression i ppf e;
+ | Texp_override (_, l) ->
+ line i ppf "Texp_override\n";
+ list i string_x_expression ppf l;
+ | Texp_letmodule (s, _, _, me, e) ->
+ line i ppf "Texp_letmodule \"%a\"\n" fmt_modname s;
+ module_expr i ppf me;
+ expression i ppf e;
+ | Texp_letexception (cd, e) ->
+ line i ppf "Texp_letexception\n";
+ extension_constructor i ppf cd;
+ expression i ppf e;
+ | Texp_assert (e, _) ->
+ line i ppf "Texp_assert";
+ expression i ppf e;
+ | Texp_lazy (e) ->
+ line i ppf "Texp_lazy";
+ expression i ppf e;
+ | Texp_object (s, _) ->
+ line i ppf "Texp_object";
+ class_structure i ppf s
+ | Texp_pack me ->
+ line i ppf "Texp_pack";
+ module_expr i ppf me
+ | Texp_letop {let_; ands; param = _; body; partial } ->
+ line i ppf "Texp_letop%a"
+ fmt_partiality partial;
+ binding_op (i+1) ppf let_;
+ list (i+1) binding_op ppf ands;
+ case i ppf body
+ | Texp_unreachable ->
+ line i ppf "Texp_unreachable"
+ | Texp_extension_constructor (li, _) ->
+ line i ppf "Texp_extension_constructor %a" fmt_longident li
+ | Texp_open (o, e) ->
+ line i ppf "Texp_open %a\n"
+ fmt_override_flag o.open_override;
+ module_expr i ppf o.open_expr;
+ attributes i ppf o.open_attributes;
+ expression i ppf e;
+
+and value_description i ppf x =
+ line i ppf "value_description %a %a\n" fmt_ident x.val_id fmt_location
+ x.val_loc;
+ attributes i ppf x.val_attributes;
+ core_type (i+1) ppf x.val_desc;
+ list (i+1) string ppf x.val_prim;
+
+and binding_op i ppf x =
+ line i ppf "binding_op %a %a\n" fmt_path x.bop_op_path
+ fmt_location x.bop_loc;
+ expression i ppf x.bop_exp
+
+and function_param i ppf x =
+ let p = x.fp_arg_label in
+ arg_label i ppf p;
+ match x.fp_kind with
+ | Tparam_pat pat ->
+ line i ppf "Param_pat%a\n"
+ fmt_partiality x.fp_partial;
+ pattern (i+1) ppf pat
+ | Tparam_optional_default (pat, expr) ->
+ line i ppf "Param_optional_default%a\n"
+ fmt_partiality x.fp_partial;
+ pattern (i+1) ppf pat;
+ expression (i+1) ppf expr
+
+and type_parameter i ppf (x, _variance) = core_type i ppf x
+
+and type_declaration i ppf x =
+ line i ppf "type_declaration %a %a\n" fmt_ident x.typ_id fmt_location
+ x.typ_loc;
+ attributes i ppf x.typ_attributes;
+ let i = i+1 in
+ line i ppf "ptype_params =\n";
+ list (i+1) type_parameter ppf x.typ_params;
+ line i ppf "ptype_cstrs =\n";
+ list (i+1) core_type_x_core_type_x_location ppf x.typ_cstrs;
+ line i ppf "ptype_kind =\n";
+ type_kind (i+1) ppf x.typ_kind;
+ line i ppf "ptype_private = %a\n" fmt_private_flag x.typ_private;
+ line i ppf "ptype_manifest =\n";
+ option (i+1) core_type ppf x.typ_manifest;
+
+and type_kind i ppf x =
+ match x with
+ | Ttype_abstract ->
+ line i ppf "Ttype_abstract\n"
+ | Ttype_variant l ->
+ line i ppf "Ttype_variant\n";
+ list (i+1) constructor_decl ppf l;
+ | Ttype_record l ->
+ line i ppf "Ttype_record\n";
+ list (i+1) label_decl ppf l;
+ | Ttype_open ->
+ line i ppf "Ttype_open\n"
+
+and type_extension i ppf x =
+ line i ppf "type_extension\n";
+ attributes i ppf x.tyext_attributes;
+ let i = i+1 in
+ line i ppf "ptyext_path = %a\n" fmt_path x.tyext_path;
+ line i ppf "ptyext_params =\n";
+ list (i+1) type_parameter ppf x.tyext_params;
+ line i ppf "ptyext_constructors =\n";
+ list (i+1) extension_constructor ppf x.tyext_constructors;
+ line i ppf "ptyext_private = %a\n" fmt_private_flag x.tyext_private;
+
+and type_exception i ppf x =
+ line i ppf "type_exception\n";
+ attributes i ppf x.tyexn_attributes;
+ let i = i+1 in
+ line i ppf "ptyext_constructor =\n";
+ let i = i+1 in
+ extension_constructor i ppf x.tyexn_constructor
+
+and extension_constructor i ppf x =
+ line i ppf "extension_constructor %a\n" fmt_location x.ext_loc;
+ attributes i ppf x.ext_attributes;
+ let i = i + 1 in
+ line i ppf "pext_name = \"%a\"\n" fmt_ident x.ext_id;
+ line i ppf "pext_kind =\n";
+ extension_constructor_kind (i + 1) ppf x.ext_kind;
+
+and extension_constructor_kind i ppf x =
+ match x with
+ Text_decl(v, a, r) ->
+ line i ppf "Text_decl\n";
+ if v <> [] then line (i+1) ppf "vars%a\n" typevars v;
+ constructor_arguments (i+1) ppf a;
+ option (i+1) core_type ppf r;
+ | Text_rebind(p, _) ->
+ line i ppf "Text_rebind\n";
+ line (i+1) ppf "%a\n" fmt_path p;
+
+and class_type i ppf x =
+ line i ppf "class_type %a\n" fmt_location x.cltyp_loc;
+ attributes i ppf x.cltyp_attributes;
+ let i = i+1 in
+ match x.cltyp_desc with
+ | Tcty_constr (li, _, l) ->
+ line i ppf "Tcty_constr %a\n" fmt_path li;
+ list i core_type ppf l;
+ | Tcty_signature (cs) ->
+ line i ppf "Tcty_signature\n";
+ class_signature i ppf cs;
+ | Tcty_arrow (l, co, cl) ->
+ line i ppf "Tcty_arrow\n";
+ arg_label i ppf l;
+ core_type i ppf co;
+ class_type i ppf cl;
+ | Tcty_open (o, e) ->
+ line i ppf "Tcty_open %a %a\n"
+ fmt_override_flag o.open_override
+ fmt_path (fst o.open_expr);
+ class_type i ppf e
+
+and class_signature i ppf { csig_self = ct; csig_fields = l } =
+ line i ppf "class_signature\n";
+ core_type (i+1) ppf ct;
+ list (i+1) class_type_field ppf l;
+
+and class_type_field i ppf x =
+ line i ppf "class_type_field %a\n" fmt_location x.ctf_loc;
+ let i = i+1 in
+ attributes i ppf x.ctf_attributes;
+ match x.ctf_desc with
+ | Tctf_inherit (ct) ->
+ line i ppf "Tctf_inherit\n";
+ class_type i ppf ct;
+ | Tctf_val (s, mf, vf, ct) ->
+ line i ppf "Tctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf
+ fmt_virtual_flag vf;
+ core_type (i+1) ppf ct;
+ | Tctf_method (s, pf, vf, ct) ->
+ line i ppf "Tctf_method \"%s\" %a %a\n" s fmt_private_flag pf
+ fmt_virtual_flag vf;
+ core_type (i+1) ppf ct;
+ | Tctf_constraint (ct1, ct2) ->
+ line i ppf "Tctf_constraint\n";
+ core_type (i+1) ppf ct1;
+ core_type (i+1) ppf ct2;
+ | Tctf_attribute a ->
+ attribute i ppf "Tctf_attribute" a
+
+and class_description i ppf x =
+ line i ppf "class_description %a\n" fmt_location x.ci_loc;
+ attributes i ppf x.ci_attributes;
+ let i = i+1 in
+ line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+ line i ppf "pci_params =\n";
+ list (i+1) type_parameter ppf x.ci_params;
+ line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+ line i ppf "pci_expr =\n";
+ class_type (i+1) ppf x.ci_expr;
+
+and class_type_declaration i ppf x =
+ line i ppf "class_type_declaration %a\n" fmt_location x.ci_loc;
+ let i = i+1 in
+ line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+ line i ppf "pci_params =\n";
+ list (i+1) type_parameter ppf x.ci_params;
+ line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+ line i ppf "pci_expr =\n";
+ class_type (i+1) ppf x.ci_expr;
+
+and class_expr i ppf x =
+ line i ppf "class_expr %a\n" fmt_location x.cl_loc;
+ attributes i ppf x.cl_attributes;
+ let i = i+1 in
+ match x.cl_desc with
+ | Tcl_ident (li, _, l) ->
+ line i ppf "Tcl_ident %a\n" fmt_path li;
+ list i core_type ppf l;
+ | Tcl_structure (cs) ->
+ line i ppf "Tcl_structure\n";
+ class_structure i ppf cs;
+ | Tcl_fun (l, p, _, ce, _) ->
+ line i ppf "Tcl_fun\n";
+ arg_label i ppf l;
+ pattern i ppf p;
+ class_expr i ppf ce
+ | Tcl_apply (ce, l) ->
+ line i ppf "Tcl_apply\n";
+ class_expr i ppf ce;
+ list i label_x_expression ppf l;
+ | Tcl_let (rf, l1, l2, ce) ->
+ line i ppf "Tcl_let %a\n" fmt_rec_flag rf;
+ list i (value_binding rf) ppf l1;
+ list i ident_x_expression_def ppf l2;
+ class_expr i ppf ce;
+ | Tcl_constraint (ce, Some ct, _, _, _) ->
+ line i ppf "Tcl_constraint\n";
+ class_expr i ppf ce;
+ class_type i ppf ct
+ | Tcl_constraint (ce, None, _, _, _) -> class_expr i ppf ce
+ | Tcl_open (o, e) ->
+ line i ppf "Tcl_open %a %a\n"
+ fmt_override_flag o.open_override
+ fmt_path (fst o.open_expr);
+ class_expr i ppf e
+
+and class_structure i ppf { cstr_self = p; cstr_fields = l } =
+ line i ppf "class_structure\n";
+ pattern (i+1) ppf p;
+ list (i+1) class_field ppf l;
+
+and class_field i ppf x =
+ line i ppf "class_field %a\n" fmt_location x.cf_loc;
+ let i = i + 1 in
+ attributes i ppf x.cf_attributes;
+ match x.cf_desc with
+ | Tcf_inherit (ovf, ce, so, _, _) ->
+ line i ppf "Tcf_inherit %a\n" fmt_override_flag ovf;
+ class_expr (i+1) ppf ce;
+ option (i+1) string ppf so;
+ | Tcf_val (s, mf, _, k, _) ->
+ line i ppf "Tcf_val \"%s\" %a\n" s.txt fmt_mutable_flag mf;
+ class_field_kind (i+1) ppf k
+ | Tcf_method (s, pf, k) ->
+ line i ppf "Tcf_method \"%s\" %a\n" s.txt fmt_private_flag pf;
+ class_field_kind (i+1) ppf k
+ | Tcf_constraint (ct1, ct2) ->
+ line i ppf "Tcf_constraint\n";
+ core_type (i+1) ppf ct1;
+ core_type (i+1) ppf ct2;
+ | Tcf_initializer (e) ->
+ line i ppf "Tcf_initializer\n";
+ expression (i+1) ppf e;
+ | Tcf_attribute a ->
+ attribute i ppf "Tcf_attribute" a
+
+and class_field_kind i ppf = function
+ | Tcfk_concrete (o, e) ->
+ line i ppf "Concrete %a\n" fmt_override_flag o;
+ expression i ppf e
+ | Tcfk_virtual t ->
+ line i ppf "Virtual\n";
+ core_type i ppf t
+
+and class_declaration i ppf x =
+ line i ppf "class_declaration %a\n" fmt_location x.ci_loc;
+ let i = i+1 in
+ line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+ line i ppf "pci_params =\n";
+ list (i+1) type_parameter ppf x.ci_params;
+ line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+ line i ppf "pci_expr =\n";
+ class_expr (i+1) ppf x.ci_expr;
+
+and module_type i ppf x =
+ line i ppf "module_type %a\n" fmt_location x.mty_loc;
+ attributes i ppf x.mty_attributes;
+ let i = i+1 in
+ match x.mty_desc with
+ | Tmty_ident (li,_) -> line i ppf "Tmty_ident %a\n" fmt_path li;
+ | Tmty_alias (li,_) -> line i ppf "Tmty_alias %a\n" fmt_path li;
+ | Tmty_signature (s) ->
+ line i ppf "Tmty_signature\n";
+ signature i ppf s;
+ | Tmty_functor (Unit, mt2) ->
+ line i ppf "Tmty_functor ()\n";
+ module_type i ppf mt2;
+ | Tmty_functor (Named (s, _, mt1), mt2) ->
+ line i ppf "Tmty_functor \"%a\"\n" fmt_modname s;
+ module_type i ppf mt1;
+ module_type i ppf mt2;
+ | Tmty_with (mt, l) ->
+ line i ppf "Tmty_with\n";
+ module_type i ppf mt;
+ list i longident_x_with_constraint ppf l;
+ | Tmty_typeof m ->
+ line i ppf "Tmty_typeof\n";
+ module_expr i ppf m;
+
+and signature i ppf x = list i signature_item ppf x.sig_items
+
+and signature_item i ppf x =
+ line i ppf "signature_item %a\n" fmt_location x.sig_loc;
+ let i = i+1 in
+ match x.sig_desc with
+ | Tsig_value vd ->
+ line i ppf "Tsig_value\n";
+ value_description i ppf vd;
+ | Tsig_type (rf, l) ->
+ line i ppf "Tsig_type %a\n" fmt_rec_flag rf;
+ list i type_declaration ppf l;
+ | Tsig_typesubst l ->
+ line i ppf "Tsig_typesubst\n";
+ list i type_declaration ppf l;
+ | Tsig_typext e ->
+ line i ppf "Tsig_typext\n";
+ type_extension i ppf e;
+ | Tsig_exception ext ->
+ line i ppf "Tsig_exception\n";
+ type_exception i ppf ext
+ | Tsig_module md ->
+ line i ppf "Tsig_module \"%a\"\n" fmt_modname md.md_id;
+ attributes i ppf md.md_attributes;
+ module_type i ppf md.md_type
+ | Tsig_modsubst ms ->
+ line i ppf "Tsig_modsubst \"%a\" = %a\n"
+ fmt_ident ms.ms_id fmt_path ms.ms_manifest;
+ attributes i ppf ms.ms_attributes;
+ | Tsig_recmodule decls ->
+ line i ppf "Tsig_recmodule\n";
+ list i module_declaration ppf decls;
+ | Tsig_modtype x ->
+ line i ppf "Tsig_modtype \"%a\"\n" fmt_ident x.mtd_id;
+ attributes i ppf x.mtd_attributes;
+ modtype_declaration i ppf x.mtd_type
+ | Tsig_modtypesubst x ->
+ line i ppf "Tsig_modtypesubst \"%a\"\n" fmt_ident x.mtd_id;
+ attributes i ppf x.mtd_attributes;
+ modtype_declaration i ppf x.mtd_type
+ | Tsig_open od ->
+ line i ppf "Tsig_open %a %a\n"
+ fmt_override_flag od.open_override
+ fmt_path (fst od.open_expr);
+ attributes i ppf od.open_attributes
+ | Tsig_include incl ->
+ line i ppf "Tsig_include\n";
+ attributes i ppf incl.incl_attributes;
+ module_type i ppf incl.incl_mod
+ | Tsig_class (l) ->
+ line i ppf "Tsig_class\n";
+ list i class_description ppf l;
+ | Tsig_class_type (l) ->
+ line i ppf "Tsig_class_type\n";
+ list i class_type_declaration ppf l;
+ | Tsig_attribute a ->
+ attribute i ppf "Tsig_attribute" a
+
+and module_declaration i ppf md =
+ line i ppf "%a" fmt_modname md.md_id;
+ attributes i ppf md.md_attributes;
+ module_type (i+1) ppf md.md_type;
+
+and module_binding i ppf x =
+ line i ppf "%a\n" fmt_modname x.mb_id;
+ attributes i ppf x.mb_attributes;
+ module_expr (i+1) ppf x.mb_expr
+
+and modtype_declaration i ppf = function
+ | None -> line i ppf "#abstract"
+ | Some mt -> module_type (i + 1) ppf mt
+
+and with_constraint i ppf x =
+ match x with
+ | Twith_type (td) ->
+ line i ppf "Twith_type\n";
+ type_declaration (i+1) ppf td;
+ | Twith_typesubst (td) ->
+ line i ppf "Twith_typesubst\n";
+ type_declaration (i+1) ppf td;
+ | Twith_module (li,_) -> line i ppf "Twith_module %a\n" fmt_path li;
+ | Twith_modsubst (li,_) -> line i ppf "Twith_modsubst %a\n" fmt_path li;
+ | Twith_modtype mty ->
+ line i ppf "Twith_modtype\n";
+ module_type (i+1) ppf mty
+ | Twith_modtypesubst mty ->
+ line i ppf "Twith_modtype\n";
+ module_type (i+1) ppf mty
+
+and module_expr i ppf x =
+ line i ppf "module_expr %a\n" fmt_location x.mod_loc;
+ attributes i ppf x.mod_attributes;
+ let i = i+1 in
+ match x.mod_desc with
+ | Tmod_ident (li,_) -> line i ppf "Tmod_ident %a\n" fmt_path li;
+ | Tmod_structure (s) ->
+ line i ppf "Tmod_structure\n";
+ structure i ppf s;
+ | Tmod_functor (Unit, me) ->
+ line i ppf "Tmod_functor ()\n";
+ module_expr i ppf me;
+ | Tmod_functor (Named (s, _, mt), me) ->
+ line i ppf "Tmod_functor \"%a\"\n" fmt_modname s;
+ module_type i ppf mt;
+ module_expr i ppf me;
+ | Tmod_apply (me1, me2, _) ->
+ line i ppf "Tmod_apply\n";
+ module_expr i ppf me1;
+ module_expr i ppf me2;
+ | Tmod_apply_unit me1 ->
+ line i ppf "Tmod_apply_unit\n";
+ module_expr i ppf me1;
+ | Tmod_constraint (me, _, Tmodtype_explicit mt, _) ->
+ line i ppf "Tmod_constraint\n";
+ module_expr i ppf me;
+ module_type i ppf mt;
+ | Tmod_constraint (me, _, Tmodtype_implicit, _) -> module_expr i ppf me
+ | Tmod_unpack (e, _) ->
+ line i ppf "Tmod_unpack\n";
+ expression i ppf e;
+
+and structure i ppf x = list i structure_item ppf x.str_items
+
+and structure_item i ppf x =
+ line i ppf "structure_item %a\n" fmt_location x.str_loc;
+ let i = i+1 in
+ match x.str_desc with
+ | Tstr_eval (e, attrs) ->
+ line i ppf "Tstr_eval\n";
+ attributes i ppf attrs;
+ expression i ppf e;
+ | Tstr_value (rf, l) ->
+ line i ppf "Tstr_value %a\n" fmt_rec_flag rf;
+ list i (value_binding rf) ppf l;
+ | Tstr_primitive vd ->
+ line i ppf "Tstr_primitive\n";
+ value_description i ppf vd;
+ | Tstr_type (rf, l) ->
+ line i ppf "Tstr_type %a\n" fmt_rec_flag rf;
+ list i type_declaration ppf l;
+ | Tstr_typext te ->
+ line i ppf "Tstr_typext\n";
+ type_extension i ppf te
+ | Tstr_exception ext ->
+ line i ppf "Tstr_exception\n";
+ type_exception i ppf ext;
+ | Tstr_module x ->
+ line i ppf "Tstr_module\n";
+ module_binding i ppf x
+ | Tstr_recmodule bindings ->
+ line i ppf "Tstr_recmodule\n";
+ list i module_binding ppf bindings
+ | Tstr_modtype x ->
+ line i ppf "Tstr_modtype \"%a\"\n" fmt_ident x.mtd_id;
+ attributes i ppf x.mtd_attributes;
+ modtype_declaration i ppf x.mtd_type
+ | Tstr_open od ->
+ line i ppf "Tstr_open %a\n"
+ fmt_override_flag od.open_override;
+ module_expr i ppf od.open_expr;
+ attributes i ppf od.open_attributes
+ | Tstr_class (l) ->
+ line i ppf "Tstr_class\n";
+ list i class_declaration ppf (List.map (fun (cl, _) -> cl) l);
+ | Tstr_class_type (l) ->
+ line i ppf "Tstr_class_type\n";
+ list i class_type_declaration ppf (List.map (fun (_, _, cl) -> cl) l);
+ | Tstr_include incl ->
+ line i ppf "Tstr_include";
+ attributes i ppf incl.incl_attributes;
+ module_expr i ppf incl.incl_mod;
+ | Tstr_attribute a ->
+ attribute i ppf "Tstr_attribute" a
+
+and longident_x_with_constraint i ppf (li, _, wc) =
+ line i ppf "%a\n" fmt_path li;
+ with_constraint (i+1) ppf wc;
+
+and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
+ line i ppf "<constraint> %a\n" fmt_location l;
+ core_type (i+1) ppf ct1;
+ core_type (i+1) ppf ct2;
+
+and constructor_decl i ppf {cd_id; cd_name = _; cd_vars;
+ cd_args; cd_res; cd_loc; cd_attributes} =
+ line i ppf "%a\n" fmt_location cd_loc;
+ line (i+1) ppf "%a\n" fmt_ident cd_id;
+ if cd_vars <> [] then line (i+1) ppf "cd_vars =%a\n" typevars cd_vars;
+ attributes i ppf cd_attributes;
+ constructor_arguments (i+1) ppf cd_args;
+ option (i+1) core_type ppf cd_res
+
+and constructor_arguments i ppf = function
+ | Cstr_tuple l -> list i core_type ppf l
+ | Cstr_record l -> list i label_decl ppf l
+
+and label_decl i ppf {ld_id; ld_name = _; ld_mutable; ld_type; ld_loc;
+ ld_attributes} =
+ line i ppf "%a\n" fmt_location ld_loc;
+ attributes i ppf ld_attributes;
+ line (i+1) ppf "%a\n" fmt_mutable_flag ld_mutable;
+ line (i+1) ppf "%a" fmt_ident ld_id;
+ core_type (i+1) ppf ld_type
+
+and longident_x_pattern i ppf (li, _, p) =
+ line i ppf "%a\n" fmt_longident li;
+ pattern (i+1) ppf p;
+
+and case
+ : type k . _ -> _ -> k case -> unit
+ = fun i ppf {c_lhs; c_guard; c_rhs} ->
+ line i ppf "<case>\n";
+ pattern (i+1) ppf c_lhs;
+ begin match c_guard with
+ | None -> ()
+ | Some g -> line (i+1) ppf "<when>\n"; expression (i + 2) ppf g
+ end;
+ expression (i+1) ppf c_rhs;
+
+and value_binding rec_flag i ppf x =
+ begin match rec_flag, x.vb_rec_kind with
+ | Nonrecursive, _ -> line i ppf "<def>\n"
+ | Recursive, Static -> line i ppf "<def_rec>\n"
+ | Recursive, Dynamic -> line i ppf "<def_rec_dynamic>\n"
+ end;
+ attributes (i+1) ppf x.vb_attributes;
+ pattern (i+1) ppf x.vb_pat;
+ expression (i+1) ppf x.vb_expr
+
+and string_x_expression i ppf (s, _, e) =
+ line i ppf "<override> \"%a\"\n" fmt_ident s;
+ expression (i+1) ppf e;
+
+and record_field i ppf = function
+ | _, Overridden (li, e) ->
+ line i ppf "%a\n" fmt_longident li;
+ expression (i+1) ppf e;
+ | _, Kept _ ->
+ line i ppf "<kept>"
+
+and label_x_expression i ppf (l, e) =
+ line i ppf "<arg>\n";
+ arg_label (i+1) ppf l;
+ (match e with None -> () | Some e -> expression (i+1) ppf e)
+
+and ident_x_expression_def i ppf (l, e) =
+ line i ppf "<def> \"%a\"\n" fmt_ident l;
+ expression (i+1) ppf e;
+
+and label_x_bool_x_core_type_list i ppf x =
+ match x.rf_desc with
+ | Ttag (l, b, ctl) ->
+ line i ppf "Ttag \"%s\" %s\n" l.txt (string_of_bool b);
+ attributes (i+1) ppf x.rf_attributes;
+ list (i+1) core_type ppf ctl
+ | Tinherit (ct) ->
+ line i ppf "Tinherit\n";
+ core_type (i+1) ppf ct
+
+let interface ppf x = list 0 signature_item ppf x.sig_items
+
+let implementation ppf x = list 0 structure_item ppf x.str_items
+
+let implementation_with_coercion ppf Typedtree.{structure; _} =
+ implementation ppf structure
diff --git a/upstream/ocaml_503/typing/printtyped.mli b/upstream/ocaml_503/typing/printtyped.mli
new file mode 100644
index 0000000000..43539ead9d
--- /dev/null
+++ b/upstream/ocaml_503/typing/printtyped.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Para, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1999 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. *)
+(* *)
+(**************************************************************************)
+
+open Typedtree
+open Format
+
+val interface : formatter -> signature -> unit
+val implementation : formatter -> structure -> unit
+
+val implementation_with_coercion :
+ formatter -> Typedtree.implementation -> unit
diff --git a/upstream/ocaml_503/typing/rawprinttyp.ml b/upstream/ocaml_503/typing/rawprinttyp.ml
new file mode 100644
index 0000000000..00d94fc24f
--- /dev/null
+++ b/upstream/ocaml_503/typing/rawprinttyp.ml
@@ -0,0 +1,147 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jacques Garrigue, Graduate School of Mathematics, Nagoya University *)
+(* *)
+(* Copyright 2003 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. *)
+(* *)
+(**************************************************************************)
+
+
+(* Print a raw type expression, with sharing *)
+
+open Format
+open Types
+open Asttypes
+let longident = Pprintast.longident
+
+let raw_list pr ppf = function
+ [] -> fprintf ppf "[]"
+ | a :: l ->
+ fprintf ppf "@[<1>[%a%t]@]" pr a
+ (fun ppf -> List.iter (fun x -> fprintf ppf ";@,%a" pr x) l)
+
+let kind_vars = ref []
+let kind_count = ref 0
+
+let string_of_field_kind v =
+ match field_kind_repr v with
+ | Fpublic -> "Fpublic"
+ | Fabsent -> "Fabsent"
+ | Fprivate -> "Fprivate"
+
+let rec safe_repr v t =
+ match Transient_expr.coerce t with
+ {desc = Tlink t} when not (List.memq t v) ->
+ safe_repr (t::v) t
+ | t' -> t'
+
+let rec list_of_memo = function
+ Mnil -> []
+ | Mcons (_priv, p, _t1, _t2, rem) -> p :: list_of_memo rem
+ | Mlink rem -> list_of_memo !rem
+
+let print_name ppf = function
+ None -> fprintf ppf "None"
+ | Some name -> fprintf ppf "\"%s\"" name
+
+let path = Format_doc.compat Path.print
+
+let visited = ref []
+let rec raw_type ppf ty =
+ let ty = safe_repr [] ty in
+ if List.memq ty !visited then fprintf ppf "{id=%d}" ty.id else begin
+ visited := ty :: !visited;
+ fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;marks=%x;desc=@,%a}@]"
+ ty.id ty.level
+ (Transient_expr.get_scope ty) (Transient_expr.get_marks ty)
+ raw_type_desc ty.desc
+ end
+and raw_type_list tl = raw_list raw_type tl
+and raw_lid_type_list tl =
+ raw_list (fun ppf (lid, typ) ->
+ fprintf ppf "(@,%a,@,%a)" longident lid raw_type typ)
+ tl
+and raw_type_desc ppf = function
+ Tvar name -> fprintf ppf "Tvar %a" print_name name
+ | Tarrow(l,t1,t2,c) ->
+ fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
+ (string_of_label l) raw_type t1 raw_type t2
+ (if is_commu_ok c then "Cok" else "Cunknown")
+ | Ttuple tl ->
+ fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
+ | Tconstr (p, tl, abbrev) ->
+ fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p
+ raw_type_list tl
+ (raw_list path) (list_of_memo !abbrev)
+ | Tobject (t, nm) ->
+ fprintf ppf "@[<hov1>Tobject(@,%a,@,@[<1>ref%t@])@]" raw_type t
+ (fun ppf ->
+ match !nm with None -> fprintf ppf " None"
+ | Some(p,tl) ->
+ fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
+ | Tfield (f, k, t1, t2) ->
+ fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
+ (string_of_field_kind k)
+ raw_type t1 raw_type t2
+ | Tnil -> fprintf ppf "Tnil"
+ | Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
+ | Tsubst (t, None) -> fprintf ppf "@[<1>Tsubst@,(%a,None)@]" raw_type t
+ | Tsubst (t, Some t') ->
+ fprintf ppf "@[<1>Tsubst@,(%a,@ Some%a)@]" raw_type t raw_type t'
+ | Tunivar name -> fprintf ppf "Tunivar %a" print_name name
+ | Tpoly (t, tl) ->
+ fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
+ raw_type t
+ raw_type_list tl
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ fprintf ppf
+ "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
+ "row_fields="
+ (raw_list (fun ppf (l, f) ->
+ fprintf ppf "@[%s,@ %a@]" l raw_field f))
+ fields
+ "row_more=" raw_type more
+ "row_closed=" closed
+ "row_fixed=" raw_row_fixed fixed
+ "row_name="
+ (fun ppf ->
+ match name with None -> fprintf ppf "None"
+ | Some(p,tl) ->
+ fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
+ | Tpackage (p, fl) ->
+ fprintf ppf "@[<hov1>Tpackage(@,%a,@,%a)@]" path p raw_lid_type_list fl
+and raw_row_fixed ppf = function
+| None -> fprintf ppf "None"
+| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private"
+| Some Types.Rigid -> fprintf ppf "Some Rigid"
+| Some Types.Univar t -> fprintf ppf "Some(Univar(%a))" raw_type t
+| Some Types.Reified p -> fprintf ppf "Some(Reified(%a))" path p
+
+and raw_field ppf rf =
+ match_row_field
+ ~absent:(fun _ -> fprintf ppf "RFabsent")
+ ~present:(function
+ | None ->
+ fprintf ppf "RFpresent None"
+ | Some t ->
+ fprintf ppf "@[<1>RFpresent(Some@,%a)@]" raw_type t)
+ ~either:(fun c tl m (_,e) ->
+ fprintf ppf "@[<hov1>RFeither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
+ raw_type_list tl m
+ (fun ppf ->
+ match e with None -> fprintf ppf " RFnone"
+ | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f))
+ rf
+
+let type_expr ppf t =
+ visited := []; kind_vars := []; kind_count := 0;
+ raw_type ppf t;
+ visited := []; kind_vars := []
diff --git a/upstream/ocaml_503/typing/rawprinttyp.mli b/upstream/ocaml_503/typing/rawprinttyp.mli
new file mode 100644
index 0000000000..205bf299e5
--- /dev/null
+++ b/upstream/ocaml_503/typing/rawprinttyp.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jacques Garrigue, Graduate School of Mathematics, Nagoya University *)
+(* *)
+(* Copyright 2003 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. *)
+(* *)
+(**************************************************************************)
+
+(** This module provides function(s) for printing the internal representation of
+ type expressions. It is targetted at internal use when debbuging the
+ compiler itself. *)
+
+val type_expr: Format.formatter -> Types.type_expr -> unit
diff --git a/upstream/ocaml_503/typing/shape.ml b/upstream/ocaml_503/typing/shape.ml
new file mode 100644
index 0000000000..67e6b7a19b
--- /dev/null
+++ b/upstream/ocaml_503/typing/shape.ml
@@ -0,0 +1,368 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Ulysse Gérard, Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+module Uid = struct
+ type t =
+ | Compilation_unit of string
+ | Item of { comp_unit: string; id: int; from: Unit_info.intf_or_impl }
+ | Internal
+ | Predef of string
+
+ include Identifiable.Make(struct
+ type nonrec t = t
+
+ let equal (x : t) y = x = y
+ let compare (x : t) y = compare x y
+ let hash (x : t) = Hashtbl.hash x
+
+ let pp_intf_or_impl fmt = function
+ | Unit_info.Intf -> Format.pp_print_string fmt "[intf]"
+ | Unit_info.Impl -> ()
+
+ let print fmt = function
+ | Internal -> Format.pp_print_string fmt "<internal>"
+ | Predef name -> Format.fprintf fmt "<predef:%s>" name
+ | Compilation_unit s -> Format.pp_print_string fmt s
+ | Item { comp_unit; id; from } ->
+ Format.fprintf fmt "%a%s.%d" pp_intf_or_impl from comp_unit id
+
+ let output oc t =
+ let fmt = Format.formatter_of_out_channel oc in
+ print fmt t
+ end)
+
+ let id = ref (-1)
+
+ let reinit () = id := (-1)
+
+ let mk ~current_unit =
+ let comp_unit, from =
+ let open Unit_info in
+ match current_unit with
+ | None -> "", Impl
+ | Some ui -> modname ui, kind ui
+ in
+ incr id;
+ Item { comp_unit; id = !id; from }
+
+ let of_compilation_unit_id id =
+ if not (Ident.persistent id) then
+ Misc.fatal_errorf "Types.Uid.of_compilation_unit_id %S" (Ident.name id);
+ Compilation_unit (Ident.name id)
+
+ let of_predef_id id =
+ if not (Ident.is_predef id) then
+ Misc.fatal_errorf "Types.Uid.of_predef_id %S" (Ident.name id);
+ Predef (Ident.name id)
+
+ let internal_not_actually_unique = Internal
+
+ let for_actual_declaration = function
+ | Item _ -> true
+ | _ -> false
+end
+
+module Sig_component_kind = struct
+ type t =
+ | Value
+ | Type
+ | Constructor
+ | Label
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+ let to_string = function
+ | Value -> "value"
+ | Type -> "type"
+ | Constructor -> "constructor"
+ | Label -> "label"
+ | Module -> "module"
+ | Module_type -> "module type"
+ | Extension_constructor -> "extension constructor"
+ | Class -> "class"
+ | Class_type -> "class type"
+
+ let can_appear_in_types = function
+ | Value
+ | Extension_constructor ->
+ false
+ | Type
+ | Constructor
+ | Label
+ | Module
+ | Module_type
+ | Class
+ | Class_type ->
+ true
+end
+
+module Item = struct
+ module T = struct
+ type t = string * Sig_component_kind.t
+ let compare = compare
+
+ let name (name, _) = name
+ let kind (_, kind) = kind
+
+ let make str ns = str, ns
+
+ let value id = Ident.name id, Sig_component_kind.Value
+ let type_ id = Ident.name id, Sig_component_kind.Type
+ let constr id = Ident.name id, Sig_component_kind.Constructor
+ let label id = Ident.name id, Sig_component_kind.Label
+ let module_ id = Ident.name id, Sig_component_kind.Module
+ let module_type id = Ident.name id, Sig_component_kind.Module_type
+ let extension_constructor id =
+ Ident.name id, Sig_component_kind.Extension_constructor
+ let class_ id =
+ Ident.name id, Sig_component_kind.Class
+ let class_type id =
+ Ident.name id, Sig_component_kind.Class_type
+
+ let print fmt (name, ns) =
+ Format.fprintf fmt "%S[%s]"
+ name
+ (Sig_component_kind.to_string ns)
+ end
+
+ include T
+
+ module Map = Map.Make(T)
+end
+
+type var = Ident.t
+type t = { uid: Uid.t option; desc: desc; approximated: bool }
+and desc =
+ | Var of var
+ | Abs of var * t
+ | App of t * t
+ | Struct of t Item.Map.t
+ | Alias of t
+ | Leaf
+ | Proj of t * Item.t
+ | Comp_unit of string
+ | Error of string
+
+let print fmt t =
+ let print_uid_opt =
+ Format.pp_print_option (fun fmt -> Format.fprintf fmt "<%a>" Uid.print)
+ in
+ let rec aux fmt { uid; desc } =
+ match desc with
+ | Var id ->
+ Format.fprintf fmt "%s%a" (Ident.name id) print_uid_opt uid
+ | Abs (id, t) ->
+ let rec collect_idents = function
+ | { uid = None; desc = Abs(id, t) } ->
+ let (ids, body) = collect_idents t in
+ id :: ids, body
+ | body ->
+ ([], body)
+ in
+ let (other_idents, body) = collect_idents t in
+ let pp_idents fmt idents =
+ let idents_names = List.map Ident.name idents in
+ let pp_sep fmt () = Format.fprintf fmt ",@ " in
+ Format.pp_print_list ~pp_sep Format.pp_print_string fmt idents_names
+ in
+ Format.fprintf fmt "Abs@[%a@,(@[%a,@ @[%a@]@])@]"
+ print_uid_opt uid pp_idents (id :: other_idents) aux body
+ | App (t1, t2) ->
+ Format.fprintf fmt "@[%a(@,%a)%a@]" aux t1 aux t2
+ print_uid_opt uid
+ | Leaf ->
+ Format.fprintf fmt "<%a>" (Format.pp_print_option Uid.print) uid
+ | Proj (t, item) ->
+ begin match uid with
+ | None ->
+ Format.fprintf fmt "@[%a@ .@ %a@]"
+ aux t
+ Item.print item
+ | Some uid ->
+ Format.fprintf fmt "@[(%a@ .@ %a)<%a>@]"
+ aux t
+ Item.print item
+ Uid.print uid
+ end
+ | Comp_unit name -> Format.fprintf fmt "CU %s" name
+ | Struct map ->
+ let print_map fmt =
+ Item.Map.iter (fun item t ->
+ Format.fprintf fmt "@[<hv 2>%a ->@ %a;@]@,"
+ Item.print item
+ aux t
+ )
+ in
+ if Item.Map.is_empty map then
+ Format.fprintf fmt "@[<hv>{%a}@]" print_uid_opt uid
+ else
+ Format.fprintf fmt "{@[<v>%a@,%a@]}" print_uid_opt uid print_map map
+ | Alias t ->
+ Format.fprintf fmt "Alias@[(@[<v>%a@,%a@])@]" print_uid_opt uid aux t
+ | Error s ->
+ Format.fprintf fmt "Error %s" s
+ in
+ if t.approximated then
+ Format.fprintf fmt "@[(approx)@ %a@]@;" aux t
+ else
+ Format.fprintf fmt "@[%a@]@;" aux t
+
+let rec strip_head_aliases = function
+ | { desc = Alias t; _ } -> strip_head_aliases t
+ | t -> t
+
+let fresh_var ?(name="shape-var") uid =
+ let var = Ident.create_local name in
+ var, { uid = Some uid; desc = Var var; approximated = false }
+
+let for_unnamed_functor_param = Ident.create_local "()"
+
+let var uid id =
+ { uid = Some uid; desc = Var id; approximated = false }
+
+let abs ?uid var body =
+ { uid; desc = Abs (var, body); approximated = false }
+
+let str ?uid map =
+ { uid; desc = Struct map; approximated = false }
+
+let alias ?uid t =
+ { uid; desc = Alias t; approximated = false}
+
+let leaf uid =
+ { uid = Some uid; desc = Leaf; approximated = false }
+
+let approx t = { t with approximated = true}
+
+let proj ?uid t item =
+ match t.desc with
+ | Leaf ->
+ (* When stuck projecting in a leaf we propagate the leaf
+ as a best effort *)
+ approx t
+ | Struct map ->
+ begin try Item.Map.find item map
+ with Not_found -> approx t (* ill-typed program *)
+ end
+ | _ ->
+ { uid; desc = Proj (t, item); approximated = false }
+
+let app ?uid f ~arg =
+ { uid; desc = App (f, arg); approximated = false }
+
+let decompose_abs t =
+ match t.desc with
+ | Abs (x, t) -> Some (x, t)
+ | _ -> None
+
+let dummy_mod =
+ { uid = None; desc = Struct Item.Map.empty; approximated = false }
+
+let of_path ~find_shape ~namespace path =
+ (* We need to handle the following cases:
+ Path of constructor:
+ M.t.C
+ Path of label:
+ M.t.lbl
+ Path of label of inline record:
+ M.t.C.lbl *)
+ let rec aux : Sig_component_kind.t -> Path.t -> t = fun ns -> function
+ | Pident id -> find_shape ns id
+ | Pdot (path, name) ->
+ let namespace : Sig_component_kind.t =
+ match (ns : Sig_component_kind.t) with
+ | Constructor -> Type
+ | Label -> Type
+ | _ -> Module
+ in
+ proj (aux namespace path) (name, ns)
+ | Papply (p1, p2) -> app (aux Module p1) ~arg:(aux Module p2)
+ | Pextra_ty (path, extra) -> begin
+ match extra with
+ Pcstr_ty name -> proj (aux Type path) (name, Constructor)
+ | Pext_ty -> aux Extension_constructor path
+ end
+ in
+ aux namespace path
+
+let for_persistent_unit s =
+ { uid = Some (Uid.of_compilation_unit_id (Ident.create_persistent s));
+ desc = Comp_unit s; approximated = false }
+
+let leaf_for_unpack = { uid = None; desc = Leaf; approximated = false }
+
+let set_uid_if_none t uid =
+ match t.uid with
+ | None -> { t with uid = Some uid }
+ | _ -> t
+
+module Map = struct
+ type shape = t
+ type nonrec t = t Item.Map.t
+
+ let empty = Item.Map.empty
+
+ let add t item shape = Item.Map.add item shape t
+
+ let add_value t id uid = Item.Map.add (Item.value id) (leaf uid) t
+ let add_value_proj t id shape =
+ let item = Item.value id in
+ Item.Map.add item (proj shape item) t
+
+ let add_type t id shape = Item.Map.add (Item.type_ id) shape t
+ let add_type_proj t id shape =
+ let item = Item.type_ id in
+ Item.Map.add item (proj shape item) t
+
+ let add_constr t id shape = Item.Map.add (Item.constr id) shape t
+ let add_constr_proj t id shape =
+ let item = Item.constr id in
+ Item.Map.add item (proj shape item) t
+
+ let add_label t id uid = Item.Map.add (Item.label id) (leaf uid) t
+ let add_label_proj t id shape =
+ let item = Item.label id in
+ Item.Map.add item (proj shape item) t
+
+ let add_module t id shape = Item.Map.add (Item.module_ id) shape t
+ let add_module_proj t id shape =
+ let item = Item.module_ id in
+ Item.Map.add item (proj shape item) t
+
+ let add_module_type t id uid =
+ Item.Map.add (Item.module_type id) (leaf uid) t
+ let add_module_type_proj t id shape =
+ let item = Item.module_type id in
+ Item.Map.add item (proj shape item) t
+
+ let add_extcons t id shape =
+ Item.Map.add (Item.extension_constructor id) shape t
+ let add_extcons_proj t id shape =
+ let item = Item.extension_constructor id in
+ Item.Map.add item (proj shape item) t
+
+ let add_class t id uid = Item.Map.add (Item.class_ id) (leaf uid) t
+ let add_class_proj t id shape =
+ let item = Item.class_ id in
+ Item.Map.add item (proj shape item) t
+
+ let add_class_type t id uid = Item.Map.add (Item.class_type id) (leaf uid) t
+ let add_class_type_proj t id shape =
+ let item = Item.class_type id in
+ Item.Map.add item (proj shape item) t
+end
diff --git a/upstream/ocaml_503/typing/shape.mli b/upstream/ocaml_503/typing/shape.mli
new file mode 100644
index 0000000000..8da909fb76
--- /dev/null
+++ b/upstream/ocaml_503/typing/shape.mli
@@ -0,0 +1,201 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Ulysse Gérard, Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+(** Shapes are an abstract representation of modules' implementations which
+ allow the tracking of definitions through functor applications and other
+ module-level operations.
+
+ The Shape of a compilation unit is elaborated during typing, partially
+ reduced (without loading external shapes) and written to the [cmt] file.
+
+ External tools can retrieve the definition of any value (or type, or module,
+ etc) by following this procedure:
+
+ - Build the Shape corresponding to the value's path:
+ [let shape = Env.shape_of_path ~namespace env path]
+
+ - Instantiate the [Shape_reduce.Make] functor with a way to load shapes from
+ external units and to looks for shapes in the environment (usually using
+ [Env.shape_of_path]).
+
+ - Completely reduce the shape:
+ [let shape = My_reduce.(weak_)reduce env shape]
+
+ - The [Uid.t] stored in the reduced shape should be the one of the
+ definition. However, if the [approximate] field of the reduced shape is
+ [true] then the [Uid.t] will not correspond to the definition, but to the
+ closest parent module's uid. This happens when Shape reduction gets stuck,
+ for example when hitting first-class modules.
+
+ - The location of the definition can be easily found with the
+ [cmt_format.cmt_uid_to_decl] table of the corresponding compilation unit.
+
+ See:
+ - {{:https://icfp22.sigplan.org/details/mlfamilyworkshop-2022-papers/10/Module-Shapes-for-Modern-Tooling}
+ the design document}
+ - {{:https://www.lix.polytechnique.fr/Labo/Gabriel.Scherer/research/shapes/2022-ml-workshop-shapes-talk.pdf}
+ a talk about the reduction strategy
+*)
+
+(** A [Uid.t] is associated to every declaration in signatures and
+ implementations. They uniquely identify bindings in the program. When
+ associated with these bindings' locations they are useful to external tools
+ when trying to jump to an identifier's declaration or definition. They are
+ stored to that effect in the [uid_to_decl] table of cmt files. *)
+module Uid : sig
+ type t = private
+ | Compilation_unit of string
+ | Item of { comp_unit: string; id: int; from: Unit_info.intf_or_impl }
+ | Internal
+ | Predef of string
+
+ val reinit : unit -> unit
+
+ val mk : current_unit:(Unit_info.t option) -> t
+ val of_compilation_unit_id : Ident.t -> t
+ val of_predef_id : Ident.t -> t
+ val internal_not_actually_unique : t
+
+ val for_actual_declaration : t -> bool
+
+ include Identifiable.S with type t := t
+end
+
+module Sig_component_kind : sig
+ type t =
+ | Value
+ | Type
+ | Constructor
+ | Label
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+ val to_string : t -> string
+
+ (** Whether the name of a component of that kind can appear in a type. *)
+ val can_appear_in_types : t -> bool
+end
+
+(** Shape's items are elements of a structure or, in the case of constructors
+ and labels, elements of a record or variants definition seen as a structure.
+ These structures model module components and nested types' constructors and
+ labels. *)
+module Item : sig
+ type t = string * Sig_component_kind.t
+ val name : t -> string
+ val kind : t -> Sig_component_kind.t
+
+ val make : string -> Sig_component_kind.t -> t
+
+ val value : Ident.t -> t
+ val type_ : Ident.t -> t
+ val constr : Ident.t -> t
+ val label : Ident.t -> t
+ val module_ : Ident.t -> t
+ val module_type : Ident.t -> t
+ val extension_constructor : Ident.t -> t
+ val class_ : Ident.t -> t
+ val class_type : Ident.t -> t
+
+ val print : Format.formatter -> t -> unit
+
+ module Map : Map.S with type key = t
+end
+
+type var = Ident.t
+type t = { uid: Uid.t option; desc: desc; approximated: bool }
+and desc =
+ | Var of var
+ | Abs of var * t
+ | App of t * t
+ | Struct of t Item.Map.t
+ | Alias of t
+ | Leaf
+ | Proj of t * Item.t
+ | Comp_unit of string
+ | Error of string
+
+val print : Format.formatter -> t -> unit
+
+val strip_head_aliases : t -> t
+
+(* Smart constructors *)
+
+val for_unnamed_functor_param : var
+val fresh_var : ?name:string -> Uid.t -> var * t
+
+val var : Uid.t -> Ident.t -> t
+val abs : ?uid:Uid.t -> var -> t -> t
+val app : ?uid:Uid.t -> t -> arg:t -> t
+val str : ?uid:Uid.t -> t Item.Map.t -> t
+val alias : ?uid:Uid.t -> t -> t
+val proj : ?uid:Uid.t -> t -> Item.t -> t
+val leaf : Uid.t -> t
+
+val decompose_abs : t -> (var * t) option
+
+val for_persistent_unit : string -> t
+val leaf_for_unpack : t
+
+module Map : sig
+ type shape = t
+ type nonrec t = t Item.Map.t
+
+ val empty : t
+
+ val add : t -> Item.t -> shape -> t
+
+ val add_value : t -> Ident.t -> Uid.t -> t
+ val add_value_proj : t -> Ident.t -> shape -> t
+
+ val add_type : t -> Ident.t -> shape -> t
+ val add_type_proj : t -> Ident.t -> shape -> t
+
+ val add_constr : t -> Ident.t -> shape -> t
+ val add_constr_proj : t -> Ident.t -> shape -> t
+
+ val add_label : t -> Ident.t -> Uid.t -> t
+ val add_label_proj : t -> Ident.t -> shape -> t
+
+ val add_module : t -> Ident.t -> shape -> t
+ val add_module_proj : t -> Ident.t -> shape -> t
+
+ val add_module_type : t -> Ident.t -> Uid.t -> t
+ val add_module_type_proj : t -> Ident.t -> shape -> t
+
+ val add_extcons : t -> Ident.t -> shape -> t
+ val add_extcons_proj : t -> Ident.t -> shape -> t
+
+ val add_class : t -> Ident.t -> Uid.t -> t
+ val add_class_proj : t -> Ident.t -> shape -> t
+
+ val add_class_type : t -> Ident.t -> Uid.t -> t
+ val add_class_type_proj : t -> Ident.t -> shape -> t
+end
+
+val dummy_mod : t
+
+(** This function returns the shape corresponding to a given path. It requires a
+ callback to find shapes in the environment. It is generally more useful to
+ rely directly on the [Env.shape_of_path] function to get the shape
+ associated with a given path. *)
+val of_path :
+ find_shape:(Sig_component_kind.t -> Ident.t -> t) ->
+ namespace:Sig_component_kind.t -> Path.t -> t
+
+val set_uid_if_none : t -> Uid.t -> t
diff --git a/upstream/ocaml_503/typing/shape_reduce.ml b/upstream/ocaml_503/typing/shape_reduce.ml
new file mode 100644
index 0000000000..9f793e7b82
--- /dev/null
+++ b/upstream/ocaml_503/typing/shape_reduce.ml
@@ -0,0 +1,342 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Ulysse Gérard, Thomas Refis, Tarides *)
+(* Nathanaëlle Courant, OCamlPro *)
+(* Gabriel Scherer, projet Picube, INRIA Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+open Shape
+
+type result =
+ | Resolved of Uid.t
+ | Resolved_alias of Uid.t * result
+ | Unresolved of t
+ | Approximated of Uid.t option
+ | Internal_error_missing_uid
+
+let rec print_result fmt result =
+ match result with
+ | Resolved uid ->
+ Format.fprintf fmt "@[Resolved: %a@]@;" Uid.print uid
+ | Resolved_alias (uid, r) ->
+ Format.fprintf fmt "@[Alias: %a -> %a@]@;"
+ Uid.print uid print_result r
+ | Unresolved shape ->
+ Format.fprintf fmt "@[Unresolved: %a@]@;" print shape
+ | Approximated (Some uid) ->
+ Format.fprintf fmt "@[Approximated: %a@]@;" Uid.print uid
+ | Approximated None ->
+ Format.fprintf fmt "@[Approximated: No uid@]@;"
+ | Internal_error_missing_uid ->
+ Format.fprintf fmt "@[Missing uid@]@;"
+
+
+let find_shape env id =
+ let namespace = Shape.Sig_component_kind.Module in
+ Env.shape_of_path ~namespace env (Pident id)
+
+module Make(Params : sig
+ val fuel : int
+ val read_unit_shape : unit_name:string -> t option
+end) = struct
+ (* We implement a strong call-by-need reduction, following an
+ evaluator from Nathanaelle Courant. *)
+
+ type nf = { uid: Uid.t option; desc: nf_desc; approximated: bool }
+ and nf_desc =
+ | NVar of var
+ | NApp of nf * nf
+ | NAbs of local_env * var * t * delayed_nf
+ | NStruct of delayed_nf Item.Map.t
+ | NAlias of delayed_nf
+ | NProj of nf * Item.t
+ | NLeaf
+ | NComp_unit of string
+ | NError of string
+
+ (* A type of normal forms for strong call-by-need evaluation.
+ The normal form of an abstraction
+ Abs(x, t)
+ is a closure
+ NAbs(env, x, t, dnf)
+ when [env] is the local environment, and [dnf] is a delayed
+ normal form of [t].
+
+ A "delayed normal form" is morally equivalent to (nf Lazy.t), but
+ we use a different representation that is compatible with
+ memoization (lazy values are not hashable/comparable by default
+ comparison functions): we represent a delayed normal form as
+ just a not-yet-computed pair [local_env * t] of a term in a
+ local environment -- we could also see this as a term under
+ an explicit substitution. This delayed thunked is "forced"
+ by calling the normalization function as usual, but duplicate
+ computations are precisely avoided by memoization.
+ *)
+ and delayed_nf = Thunk of local_env * t
+
+ and local_env = delayed_nf option Ident.Map.t
+ (* When reducing in the body of an abstraction [Abs(x, body)], we
+ bind [x] to [None] in the environment. [Some v] is used for
+ actual substitutions, for example in [App(Abs(x, body), t)], when
+ [v] is a thunk that will evaluate to the normal form of [t]. *)
+
+ let approx_nf nf = { nf with approximated = true }
+
+ let in_memo_table memo_table memo_key f arg =
+ match Hashtbl.find memo_table memo_key with
+ | res -> res
+ | exception Not_found ->
+ let res = f arg in
+ Hashtbl.replace memo_table memo_key res;
+ res
+
+ type env = {
+ fuel: int ref;
+ global_env: Env.t;
+ local_env: local_env;
+ reduce_memo_table: (local_env * t, nf) Hashtbl.t;
+ read_back_memo_table: (nf, t) Hashtbl.t;
+ }
+
+ let bind env var shape =
+ { env with local_env = Ident.Map.add var shape env.local_env }
+
+ let rec reduce_ env t =
+ let local_env = env.local_env in
+ let memo_key = (local_env, t) in
+ in_memo_table env.reduce_memo_table memo_key (reduce__ env) t
+ (* Memoization is absolutely essential for performance on this
+ problem, because the normal forms we build can in some real-world
+ cases contain an exponential amount of redundancy. Memoization
+ can avoid the repeated evaluation of identical subterms,
+ providing a large speedup, but even more importantly it
+ implicitly shares the memory of the repeated results, providing
+ much smaller normal forms (that blow up again if printed back
+ as trees). A functor-heavy file from Irmin has its shape normal
+ form decrease from 100Mio to 2.5Mio when memoization is enabled.
+
+ Note: the local environment is part of the memoization key, while
+ it is defined using a type Ident.Map.t of non-canonical balanced
+ trees: two maps could have exactly the same items, but be
+ balanced differently and therefore hash differently, reducing
+ the effectivenss of memoization.
+ This could in theory happen, say, with the two programs
+ (fun x -> fun y -> ...)
+ and
+ (fun y -> fun x -> ...)
+ having "the same" local environments, with additions done in
+ a different order, giving non-structurally-equal trees. Should we
+ define our own hash functions to provide robust hashing on
+ environments?
+
+ We believe that the answer is "no": this problem does not occur
+ in practice. We can assume that identifiers are unique on valid
+ typedtree fragments (identifier "stamps" distinguish
+ binding positions); in particular the two program fragments above
+ in fact bind *distinct* identifiers x (with different stamps) and
+ different identifiers y, so the environments are distinct. If two
+ environments are structurally the same, they must correspond to
+ the evaluation evnrionments of two sub-terms that are under
+ exactly the same scope of binders. So the two environments were
+ obtained by the same term traversal, adding binders in the same
+ order, giving the same balanced trees: the environments have the
+ same hash.
+ *)
+
+ and force env (Thunk (local_env, t)) =
+ reduce_ { env with local_env } t
+
+ and reduce__
+ ({fuel; global_env; local_env; _} as env) (t : t) =
+ let reduce env t = reduce_ env t in
+ let delay_reduce env t = Thunk (env.local_env, t) in
+ let return desc = { uid = t.uid; desc; approximated = t.approximated } in
+ let rec force_aliases nf = match nf.desc with
+ | NAlias delayed_nf ->
+ let nf = force env delayed_nf in
+ force_aliases nf
+ | _ -> nf
+ in
+ let reset_uid_if_new_binding t' =
+ match t.uid with
+ | None -> t'
+ | Some _ as uid -> { t' with uid }
+ in
+ if !fuel < 0 then approx_nf (return (NError "NoFuelLeft"))
+ else
+ match t.desc with
+ | Comp_unit unit_name ->
+ begin match Params.read_unit_shape ~unit_name with
+ | Some t -> reduce env t
+ | None -> return (NComp_unit unit_name)
+ end
+ | App(f, arg) ->
+ let f = reduce env f |> force_aliases in
+ begin match f.desc with
+ | NAbs(clos_env, var, body, _body_nf) ->
+ let arg = delay_reduce env arg in
+ let env = bind { env with local_env = clos_env } var (Some arg) in
+ reduce env body |> reset_uid_if_new_binding
+ | _ ->
+ let arg = reduce env arg in
+ return (NApp(f, arg))
+ end
+ | Proj(str, item) ->
+ let str = reduce env str |> force_aliases in
+ let nored () = return (NProj(str, item)) in
+ begin match str.desc with
+ | NStruct (items) ->
+ begin match Item.Map.find item items with
+ | exception Not_found -> nored ()
+ | nf -> force env nf |> reset_uid_if_new_binding
+ end
+ | _ ->
+ nored ()
+ end
+ | Abs(var, body) ->
+ let body_nf = delay_reduce (bind env var None) body in
+ return (NAbs(local_env, var, body, body_nf))
+ | Var id ->
+ begin match Ident.Map.find id local_env with
+ (* Note: instead of binding abstraction-bound variables to
+ [None], we could unify it with the [Some v] case by
+ binding the bound variable [x] to [NVar x].
+
+ One reason to distinguish the situations is that we can
+ provide a different [Uid.t] location; for bound
+ variables, we use the [Uid.t] of the bound occurrence
+ (not the binding site), whereas for bound values we use
+ their binding-time [Uid.t]. *)
+ | None -> return (NVar id)
+ | Some def ->
+ begin match force env def with
+ | { uid = Some _; _ } as nf -> nf
+ (* This var already has a binding uid *)
+ | { uid = None; _ } as nf -> { nf with uid = t.uid }
+ (* Set the var's binding uid *)
+ end
+ | exception Not_found ->
+ match find_shape global_env id with
+ | exception Not_found -> return (NVar id)
+ | res when res = t -> return (NVar id)
+ | res ->
+ decr fuel;
+ reduce env res
+ end
+ | Leaf -> return NLeaf
+ | Struct m ->
+ let mnf = Item.Map.map (delay_reduce env) m in
+ return (NStruct mnf)
+ | Alias t -> return (NAlias (delay_reduce env t))
+ | Error s -> approx_nf (return (NError s))
+
+ and read_back env (nf : nf) : t =
+ in_memo_table env.read_back_memo_table nf (read_back_ env) nf
+ (* The [nf] normal form we receive may contain a lot of internal
+ sharing due to the use of memoization in the evaluator. We have
+ to memoize here again, otherwise the sharing is lost by mapping
+ over the term as a tree. *)
+
+ and read_back_ env (nf : nf) : t =
+ { uid = nf.uid ;
+ desc = read_back_desc env nf.desc;
+ approximated = nf.approximated }
+
+ and read_back_desc env desc =
+ let read_back nf = read_back env nf in
+ let read_back_force dnf = read_back (force env dnf) in
+ match desc with
+ | NVar v ->
+ Var v
+ | NApp (nft, nfu) ->
+ App(read_back nft, read_back nfu)
+ | NAbs (_env, x, _t, nf) ->
+ Abs(x, read_back_force nf)
+ | NStruct nstr ->
+ Struct (Item.Map.map read_back_force nstr)
+ | NAlias nf -> Alias (read_back_force nf)
+ | NProj (nf, item) ->
+ Proj (read_back nf, item)
+ | NLeaf -> Leaf
+ | NComp_unit s -> Comp_unit s
+ | NError s -> Error s
+
+ (* Sharing the memo tables is safe at the level of a compilation unit since
+ idents should be unique *)
+ let reduce_memo_table = Local_store.s_table Hashtbl.create 42
+ let read_back_memo_table = Local_store.s_table Hashtbl.create 42
+
+ let reduce global_env t =
+ let fuel = ref Params.fuel in
+ let local_env = Ident.Map.empty in
+ let env = {
+ fuel;
+ global_env;
+ reduce_memo_table = !reduce_memo_table;
+ read_back_memo_table = !read_back_memo_table;
+ local_env;
+ } in
+ reduce_ env t |> read_back env
+
+ let rec is_stuck_on_comp_unit (nf : nf) =
+ match nf.desc with
+ | NVar _ ->
+ (* This should not happen if we only reduce closed terms *)
+ false
+ | NApp (nf, _) | NProj (nf, _) -> is_stuck_on_comp_unit nf
+ | NStruct _ | NAbs _ -> false
+ | NAlias _ -> false
+ | NComp_unit _ -> true
+ | NError _ -> false
+ | NLeaf -> false
+
+ let rec reduce_aliases_for_uid env (nf : nf) =
+ match nf with
+ | { uid = Some uid; desc = NAlias dnf; approximated = false; _ } ->
+ let result = reduce_aliases_for_uid env (force env dnf) in
+ Resolved_alias (uid, result)
+ | { uid = Some uid; approximated = false; _ } -> Resolved uid
+ | { uid; approximated = true } -> Approximated uid
+ | { uid = None; approximated = false; _ } ->
+ (* A missing Uid after a complete reduction means the Uid was first
+ missing in the shape which is a code error. Having the
+ [Missing_uid] reported will allow Merlin (or another tool working
+ with the index) to ask users to report the issue if it does happen.
+ *)
+ Internal_error_missing_uid
+
+ let reduce_for_uid global_env t =
+ let fuel = ref Params.fuel in
+ let local_env = Ident.Map.empty in
+ let env = {
+ fuel;
+ global_env;
+ reduce_memo_table = !reduce_memo_table;
+ read_back_memo_table = !read_back_memo_table;
+ local_env;
+ } in
+ let nf = reduce_ env t in
+ if is_stuck_on_comp_unit nf then
+ Unresolved (read_back env nf)
+ else
+ reduce_aliases_for_uid env nf
+end
+
+module Local_reduce =
+ Make(struct
+ let fuel = 10
+ let read_unit_shape ~unit_name:_ = None
+ end)
+
+let local_reduce = Local_reduce.reduce
+let local_reduce_for_uid = Local_reduce.reduce_for_uid
diff --git a/upstream/ocaml_503/typing/shape_reduce.mli b/upstream/ocaml_503/typing/shape_reduce.mli
new file mode 100644
index 0000000000..307bc7683f
--- /dev/null
+++ b/upstream/ocaml_503/typing/shape_reduce.mli
@@ -0,0 +1,62 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Ulysse Gérard, Thomas Refis, Tarides *)
+(* Nathanaëlle Courant, OCamlPro *)
+(* Gabriel Scherer, projet Picube, INRIA Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+(** The result of reducing a shape and looking for its uid *)
+type result =
+ | Resolved of Shape.Uid.t (** Shape reduction succeeded and a uid was found *)
+ | Resolved_alias of Shape.Uid.t * result (** Reduction led to an alias *)
+ | Unresolved of Shape.t (** Result still contains [Comp_unit] terms *)
+ | Approximated of Shape.Uid.t option
+ (** Reduction failed: it can arrive with first-class modules for example *)
+ | Internal_error_missing_uid
+ (** Reduction succeeded but no uid was found, this should never happen *)
+
+val print_result : Format.formatter -> result -> unit
+
+(** The [Make] functor is used to generate a reduction function for
+ shapes.
+
+ It is parametrized by:
+ - a function to load the shape of an external compilation unit
+ - some fuel, which is used to bound recursion when dealing with recursive
+ shapes introduced by recursive modules. (FTR: merlin currently uses a
+ fuel of 10, which seems to be enough for most practical examples)
+
+ Usage warning: To ensure good performances, every reduction made with the
+ same instance of that functor share the same ident-based memoization tables.
+ Such an instance should only be used to perform reduction inside a unique
+ compilation unit to prevent conflicting entries in these memoization tables.
+*)
+module Make(_ : sig
+ val fuel : int
+
+ val read_unit_shape : unit_name:string -> Shape.t option
+ end) : sig
+ val reduce : Env.t -> Shape.t -> Shape.t
+
+ (** Perform weak reduction and return the head's uid if any. If reduction was
+ incomplete the partially reduced shape is returned. *)
+ val reduce_for_uid : Env.t -> Shape.t -> result
+end
+
+(** [local_reduce] will not reduce shapes that require loading external
+ compilation units. *)
+val local_reduce : Env.t -> Shape.t -> Shape.t
+
+(** [local_reduce_for_uid] will not reduce shapes that require loading external
+ compilation units. *)
+val local_reduce_for_uid : Env.t -> Shape.t -> result
diff --git a/upstream/ocaml_503/typing/signature_group.ml b/upstream/ocaml_503/typing/signature_group.ml
new file mode 100644
index 0000000000..b98a9eb67f
--- /dev/null
+++ b/upstream/ocaml_503/typing/signature_group.ml
@@ -0,0 +1,155 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+(** Fold on a signature by syntactic group of items *)
+
+(** Classes and class types generate ghosts signature items, we group them
+ together before printing *)
+type sig_item =
+ {
+ src: Types.signature_item;
+ post_ghosts: Types.signature_item list
+ (** ghost classes types are post-declared *);
+ }
+let flatten x = x.src :: x.post_ghosts
+
+type core_rec_group =
+ | Not_rec of sig_item
+ | Rec_group of sig_item list
+
+let rec_items = function
+ | Not_rec x -> [x]
+ | Rec_group x -> x
+
+(** Private row types are manifested as a sequence of definitions
+ preceding a recursive group, we collect them and separate them from the
+ syntactic recursive group. *)
+type rec_group =
+ { pre_ghosts: Types.signature_item list; group:core_rec_group }
+
+let next_group = function
+ | [] -> None
+ | src :: q ->
+ let ghosts, q =
+ match src with
+ | Types.Sig_class _ ->
+ (* a class declaration for [c] is followed by the ghost
+ declarations of class type [c], and type [c] *)
+ begin match q with
+ | ct::t::q -> [ct;t], q
+ | _ -> assert false
+ end
+ | Types.Sig_class_type _ ->
+ (* a class type declaration for [ct] is followed by the ghost
+ declaration of type [ct] *)
+ begin match q with
+ | t::q -> [t], q
+ | _ -> assert false
+ end
+ | Types.(Sig_module _ | Sig_value _ | Sig_type _ | Sig_typext _
+ | Sig_modtype _) ->
+ [],q
+ in
+ Some({src; post_ghosts=ghosts}, q)
+
+let recursive_sigitem = function
+ | Types.Sig_type(ident, _, rs, _)
+ | Types.Sig_class(ident,_,rs,_)
+ | Types.Sig_class_type (ident,_,rs,_)
+ | Types.Sig_module(ident, _, _, rs, _) -> Some (ident,rs)
+ | Types.(Sig_value _ | Sig_modtype _ | Sig_typext _ ) -> None
+
+let next x =
+ let cons_group pre group q =
+ let group = Rec_group (List.rev group) in
+ Some({ pre_ghosts=List.rev pre; group },q)
+ in
+ let rec not_in_group pre l = match next_group l with
+ | None ->
+ assert (pre=[]);
+ None
+ | Some(elt, q) ->
+ match recursive_sigitem elt.src with
+ | Some (id, _) when Btype.is_row_name (Ident.name id) ->
+ not_in_group (elt.src::pre) q
+ | None | Some (_, Types.Trec_not) ->
+ let sgroup = { pre_ghosts=List.rev pre; group=Not_rec elt } in
+ Some (sgroup,q)
+ | Some (id, Types.(Trec_first | Trec_next) ) ->
+ in_group ~pre ~ids:[id] ~group:[elt] q
+ and in_group ~pre ~ids ~group rem = match next_group rem with
+ | None -> cons_group pre group []
+ | Some (elt,next) ->
+ match recursive_sigitem elt.src with
+ | Some (id, Types.Trec_next) ->
+ in_group ~pre ~ids:(id::ids) ~group:(elt::group) next
+ | None | Some (_, Types.(Trec_not|Trec_first)) ->
+ cons_group pre group rem
+ in
+ not_in_group [] x
+
+let seq l = Seq.unfold next l
+let iter f l = Seq.iter f (seq l)
+let fold f acc l = Seq.fold_left f acc (seq l)
+
+let update_rec_next rs rem =
+ match rs with
+ | Types.Trec_next -> rem
+ | Types.(Trec_first | Trec_not) ->
+ match rem with
+ | Types.Sig_type (id, decl, Trec_next, priv) :: rem ->
+ Types.Sig_type (id, decl, rs, priv) :: rem
+ | Types.Sig_module (id, pres, mty, Trec_next, priv) :: rem ->
+ Types.Sig_module (id, pres, mty, rs, priv) :: rem
+ | _ -> rem
+
+type in_place_patch = {
+ ghosts: Types.signature;
+ replace_by: Types.signature_item option;
+}
+
+
+let replace_in_place f sg =
+ let rec next_group f before signature =
+ match next signature with
+ | None -> None
+ | Some(item,sg) ->
+ core_group f ~before ~ghosts:item.pre_ghosts ~before_group:[]
+ (rec_items item.group) ~sg
+ and core_group f ~before ~ghosts ~before_group current ~sg =
+ let commit ghosts = before_group @ List.rev_append ghosts before in
+ match current with
+ | [] -> next_group f (commit ghosts) sg
+ | a :: q ->
+ match f ~ghosts a.src with
+ | Some (info, {ghosts; replace_by}) ->
+ let after = List.concat_map flatten q @ sg in
+ let after = match recursive_sigitem a.src, replace_by with
+ | None, _ | _, Some _ -> after
+ | Some (_,rs), None -> update_rec_next rs after
+ in
+ let before = match replace_by with
+ | None -> commit ghosts
+ | Some x -> x :: commit ghosts
+ in
+ let sg = List.rev_append before after in
+ Some(info, sg)
+ | None ->
+ let before_group =
+ List.rev_append a.post_ghosts (a.src :: before_group)
+ in
+ core_group f ~before ~ghosts ~before_group q ~sg
+ in
+ next_group f [] sg
diff --git a/upstream/ocaml_503/typing/signature_group.mli b/upstream/ocaml_503/typing/signature_group.mli
new file mode 100644
index 0000000000..a84925db3b
--- /dev/null
+++ b/upstream/ocaml_503/typing/signature_group.mli
@@ -0,0 +1,83 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+(** Iterate on signature by syntactic group of items
+
+ Classes, class types and private row types adds ghost components to
+ the signature where they are defined.
+
+ When editing or printing a signature it is therefore important to
+ identify those ghost components.
+
+ This module provides type grouping together ghost components
+ with the corresponding core item (or recursive group) and
+ the corresponding iterators.
+*)
+
+(** Classes and class types generate ghosts signature items, we group them
+ together before printing *)
+type sig_item =
+ {
+ src: Types.signature_item (** the syntactic item *)
+;
+ post_ghosts: Types.signature_item list
+ (** ghost classes types are post-declared *);
+ }
+
+(** [flatten sig_item] is [x.src :: x.post_ghosts] *)
+val flatten: sig_item -> Types.signature
+
+(** A group of mutually recursive definition *)
+type core_rec_group =
+ | Not_rec of sig_item
+ | Rec_group of sig_item list
+
+(** [rec_items group] is the list of sig_items in the group *)
+val rec_items: core_rec_group -> sig_item list
+
+(** Private #row types are manifested as a sequence of definitions
+ preceding a recursive group, we collect them and separate them from the
+ syntactic recursive group. *)
+type rec_group =
+ { pre_ghosts: Types.signature_item list; group:core_rec_group }
+
+(** The sequence [seq signature] iterates over [signature] {!rec_group} by
+ {!rec_group}.
+ The second element of the tuple in the {!full_seq} case is the not-yet
+ traversed part of the signature.
+*)
+val next: Types.signature -> (rec_group * Types.signature) option
+val seq: Types.signature -> rec_group Seq.t
+
+val iter: (rec_group -> unit) -> Types.signature -> unit
+val fold: ('acc -> rec_group -> 'acc) -> 'acc -> Types.signature -> 'acc
+
+(** Describe how to amend one element of a signature *)
+type in_place_patch = {
+ ghosts: Types.signature; (** updated list of ghost items *)
+ replace_by: Types.signature_item option;
+ (** replacement for the selected item *)
+}
+
+(**
+ [!replace_in_place patch sg] replaces the first element of the signature
+ for which [patch ~ghosts component] returns [Some (value,patch)].
+ The [ghosts] list is the current prefix of ghost components associated to
+ [component]
+*)
+val replace_in_place:
+ ( ghosts:Types.signature -> Types.signature_item
+ -> ('a * in_place_patch) option )
+ -> Types.signature -> ('a * Types.signature) option
diff --git a/upstream/ocaml_503/typing/stypes.ml b/upstream/ocaml_503/typing/stypes.ml
new file mode 100644
index 0000000000..400b2a84b6
--- /dev/null
+++ b/upstream/ocaml_503/typing/stypes.ml
@@ -0,0 +1,197 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Moscova, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2003 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. *)
+(* *)
+(**************************************************************************)
+
+(* Recording and dumping (partial) type information *)
+
+(*
+ We record all types in a list as they are created.
+ This means we can dump type information even if type inference fails,
+ which is extremely important, since type information is most
+ interesting in case of errors.
+*)
+
+open Annot
+open Lexing
+open Location
+open Typedtree
+
+let output_int oc i = output_string oc (Int.to_string i)
+
+type annotation =
+ | Ti_pat : 'k pattern_category * 'k general_pattern -> annotation
+ | Ti_expr of expression
+ | Ti_class of class_expr
+ | Ti_mod of module_expr
+ | An_call of Location.t * Annot.call
+ | An_ident of Location.t * string * Annot.ident
+
+let get_location ti =
+ match ti with
+ | Ti_pat (_, p) -> p.pat_loc
+ | Ti_expr e -> e.exp_loc
+ | Ti_class c -> c.cl_loc
+ | Ti_mod m -> m.mod_loc
+ | An_call (l, _k) -> l
+ | An_ident (l, _s, _k) -> l
+
+let annotations = ref ([] : annotation list)
+let phrases = ref ([] : Location.t list)
+
+let record ti =
+ if !Clflags.annotations && not (get_location ti).Location.loc_ghost then
+ annotations := ti :: !annotations
+
+let record_phrase loc =
+ if !Clflags.annotations then phrases := loc :: !phrases
+
+(* comparison order:
+ the intervals are sorted by order of increasing upper bound
+ same upper bound -> sorted by decreasing lower bound
+*)
+let cmp_loc_inner_first loc1 loc2 =
+ match compare loc1.loc_end.pos_cnum loc2.loc_end.pos_cnum with
+ | 0 -> compare loc2.loc_start.pos_cnum loc1.loc_start.pos_cnum
+ | x -> x
+
+let cmp_ti_inner_first ti1 ti2 =
+ cmp_loc_inner_first (get_location ti1) (get_location ti2)
+
+let print_position pp pos =
+ if pos = dummy_pos then
+ output_string pp "--"
+ else begin
+ output_char pp '\"';
+ output_string pp (String.escaped pos.pos_fname);
+ output_string pp "\" ";
+ output_int pp pos.pos_lnum;
+ output_char pp ' ';
+ output_int pp pos.pos_bol;
+ output_char pp ' ';
+ output_int pp pos.pos_cnum;
+ end
+
+let print_location pp loc =
+ print_position pp loc.loc_start;
+ output_char pp ' ';
+ print_position pp loc.loc_end
+
+let sort_filter_phrases () =
+ let ph = List.sort (fun x y -> cmp_loc_inner_first y x) !phrases in
+ let rec loop accu cur l =
+ match l with
+ | [] -> accu
+ | loc :: t ->
+ if cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum
+ && cur.loc_end.pos_cnum >= loc.loc_end.pos_cnum
+ then loop accu cur t
+ else loop (loc :: accu) loc t
+ in
+ phrases := loop [] Location.none ph
+
+let rec printtyp_reset_maybe loc =
+ match !phrases with
+ | cur :: t when cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum ->
+ Out_type.reset ();
+ phrases := t;
+ printtyp_reset_maybe loc;
+ | _ -> ()
+
+let call_kind_string k =
+ match k with
+ | Tail -> "tail"
+ | Stack -> "stack"
+ | Inline -> "inline"
+
+let print_ident_annot pp str k =
+ match k with
+ | Idef l ->
+ output_string pp "def ";
+ output_string pp str;
+ output_char pp ' ';
+ print_location pp l;
+ output_char pp '\n'
+ | Iref_internal l ->
+ output_string pp "int_ref ";
+ output_string pp str;
+ output_char pp ' ';
+ print_location pp l;
+ output_char pp '\n'
+ | Iref_external ->
+ output_string pp "ext_ref ";
+ output_string pp str;
+ output_char pp '\n'
+
+(* The format of the annotation file is documented in emacs/caml-types.el. *)
+
+let print_info pp prev_loc ti =
+ match ti with
+ | Ti_class _ | Ti_mod _ -> prev_loc
+ | Ti_pat (_, {pat_loc = loc; pat_type = typ; pat_env = env})
+ | Ti_expr {exp_loc = loc; exp_type = typ; exp_env = env} ->
+ if loc <> prev_loc then begin
+ print_location pp loc;
+ output_char pp '\n'
+ end;
+ output_string pp "type(\n";
+ printtyp_reset_maybe loc;
+ Format.pp_print_string Format.str_formatter " ";
+ Printtyp.wrap_printing_env ~error:false env
+ (fun () ->
+ Printtyp.shared_type_scheme Format.str_formatter typ
+ );
+ Format.pp_print_newline Format.str_formatter ();
+ let s = Format.flush_str_formatter () in
+ output_string pp s;
+ output_string pp ")\n";
+ loc
+ | An_call (loc, k) ->
+ if loc <> prev_loc then begin
+ print_location pp loc;
+ output_char pp '\n'
+ end;
+ output_string pp "call(\n ";
+ output_string pp (call_kind_string k);
+ output_string pp "\n)\n";
+ loc
+ | An_ident (loc, str, k) ->
+ if loc <> prev_loc then begin
+ print_location pp loc;
+ output_char pp '\n'
+ end;
+ output_string pp "ident(\n ";
+ print_ident_annot pp str k;
+ output_string pp ")\n";
+ loc
+
+let get_info () =
+ let info = List.fast_sort cmp_ti_inner_first !annotations in
+ annotations := [];
+ info
+
+let dump filename =
+ if !Clflags.annotations then begin
+ let do_dump _temp_filename pp =
+ let info = get_info () in
+ sort_filter_phrases ();
+ ignore (List.fold_left (print_info pp) Location.none info) in
+ begin match filename with
+ | None -> do_dump "" stdout
+ | Some filename ->
+ Misc.output_to_file_via_temporary ~mode:[Open_text] filename do_dump
+ end;
+ phrases := [];
+ end else begin
+ annotations := [];
+ end
diff --git a/upstream/ocaml_503/typing/stypes.mli b/upstream/ocaml_503/typing/stypes.mli
new file mode 100644
index 0000000000..3a86d27a57
--- /dev/null
+++ b/upstream/ocaml_503/typing/stypes.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Moscova, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2003 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. *)
+(* *)
+(**************************************************************************)
+
+(* Recording and dumping (partial) type information *)
+
+(* Clflags.save_types must be true *)
+
+open Typedtree
+
+type annotation =
+ | Ti_pat : 'k pattern_category * 'k general_pattern -> annotation
+ | Ti_expr of expression
+ | Ti_class of class_expr
+ | Ti_mod of module_expr
+ | An_call of Location.t * Annot.call
+ | An_ident of Location.t * string * Annot.ident
+
+val record : annotation -> unit
+val record_phrase : Location.t -> unit
+val dump : string option -> unit
+
+val get_location : annotation -> Location.t
+val get_info : unit -> annotation list
diff --git a/upstream/ocaml_503/typing/subst.ml b/upstream/ocaml_503/typing/subst.ml
new file mode 100644
index 0000000000..2fb4fe14f7
--- /dev/null
+++ b/upstream/ocaml_503/typing/subst.ml
@@ -0,0 +1,864 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Substitutions *)
+
+open Misc
+open Path
+open Types
+open Btype
+
+open Local_store
+
+type type_replacement =
+ | Path of Path.t
+ | Type_function of { params : type_expr list; body : type_expr }
+
+type s =
+ { types: type_replacement Path.Map.t;
+ modules: Path.t Path.Map.t;
+ modtypes: module_type Path.Map.t;
+ for_saving: bool;
+ loc: Location.t option;
+ }
+
+type 'a subst = s
+type safe = [`Safe]
+type unsafe = [`Unsafe]
+type t = safe subst
+exception Module_type_path_substituted_away of Path.t * Types.module_type
+
+let identity =
+ { types = Path.Map.empty;
+ modules = Path.Map.empty;
+ modtypes = Path.Map.empty;
+ for_saving = false;
+ loc = None;
+ }
+
+let unsafe x = x
+
+let add_type id p s =
+ { s with types = Path.Map.add (Pident id) (Path p) s.types }
+
+let add_module id p s =
+ { s with modules = Path.Map.add (Pident id) p s.modules }
+
+let add_modtype_gen p ty s = { s with modtypes = Path.Map.add p ty s.modtypes }
+let add_modtype_path p p' s = add_modtype_gen p (Mty_ident p') s
+let add_modtype id p s = add_modtype_path (Pident id) p s
+
+let for_saving s = { s with for_saving = true }
+
+let change_locs s loc = { s with loc = Some loc }
+
+let loc s x =
+ match s.loc with
+ | Some l -> l
+ | None ->
+ if s.for_saving && not !Clflags.keep_locs then Location.none else x
+
+let remove_loc =
+ let open Ast_mapper in
+ {default_mapper with location = (fun _this _loc -> Location.none)}
+
+let is_not_doc = function
+ | {Parsetree.attr_name = {Location.txt = "ocaml.doc"}; _} -> false
+ | {Parsetree.attr_name = {Location.txt = "ocaml.text"}; _} -> false
+ | {Parsetree.attr_name = {Location.txt = "doc"}; _} -> false
+ | {Parsetree.attr_name = {Location.txt = "text"}; _} -> false
+ | _ -> true
+
+let attrs s x =
+ let x =
+ if s.for_saving && not !Clflags.keep_docs then
+ List.filter is_not_doc x
+ else x
+ in
+ if s.for_saving && not !Clflags.keep_locs
+ then remove_loc.Ast_mapper.attributes remove_loc x
+ else x
+
+let rec module_path s path =
+ try Path.Map.find path s.modules
+ with Not_found ->
+ match path with
+ | Pident _ -> path
+ | Pdot(p, n) ->
+ Pdot(module_path s p, n)
+ | Papply(p1, p2) ->
+ Papply(module_path s p1, module_path s p2)
+ | Pextra_ty _ ->
+ fatal_error "Subst.module_path"
+
+let modtype_path s path =
+ match Path.Map.find path s.modtypes with
+ | Mty_ident p -> p
+ | Mty_alias _ | Mty_signature _ | Mty_functor _ as mty ->
+ raise (Module_type_path_substituted_away (path,mty))
+ | exception Not_found ->
+ match path with
+ | Pdot(p, n) ->
+ Pdot(module_path s p, n)
+ | Papply _ | Pextra_ty _ ->
+ fatal_error "Subst.modtype_path"
+ | Pident _ -> path
+
+(* For values, extension constructors, classes and class types *)
+let value_path s path =
+ match path with
+ | Pident _ -> path
+ | Pdot(p, n) -> Pdot(module_path s p, n)
+ | Papply _ | Pextra_ty _ -> fatal_error "Subst.value_path"
+
+let rec type_path s path =
+ match Path.Map.find path s.types with
+ | Path p -> p
+ | Type_function _ -> assert false
+ | exception Not_found ->
+ match path with
+ | Pident _ -> path
+ | Pdot(p, n) ->
+ Pdot(module_path s p, n)
+ | Papply _ ->
+ fatal_error "Subst.type_path"
+ | Pextra_ty (p, extra) ->
+ match extra with
+ | Pcstr_ty _ -> Pextra_ty (type_path s p, extra)
+ | Pext_ty -> Pextra_ty (value_path s p, extra)
+
+let to_subst_by_type_function s p =
+ match Path.Map.find p s.types with
+ | Path _ -> false
+ | Type_function _ -> true
+ | exception Not_found -> false
+
+(* Special type ids for saved signatures *)
+
+let new_id = s_ref (-1)
+let reset_for_saving () = new_id := -1
+
+let newpersty desc =
+ decr new_id;
+ create_expr
+ desc ~level:generic_level ~scope:Btype.lowest_level ~id:!new_id
+
+(* ensure that all occurrences of 'Tvar None' are physically shared *)
+let tvar_none = Tvar None
+let tunivar_none = Tunivar None
+let norm = function
+ | Tvar None -> tvar_none
+ | Tunivar None -> tunivar_none
+ | d -> d
+
+let apply_type_function params args body =
+ For_copy.with_scope (fun copy_scope ->
+ List.iter2
+ (fun param arg ->
+ For_copy.redirect_desc copy_scope param (Tsubst (arg, None)))
+ params args;
+ let rec copy ty =
+ assert (get_level ty = generic_level);
+ match get_desc ty with
+ | Tsubst (ty, _) -> ty
+ | Tvariant row ->
+ let t = newgenstub ~scope:(get_scope ty) in
+ For_copy.redirect_desc copy_scope ty (Tsubst (t, None));
+ let more = row_more row in
+ assert (get_level more = generic_level);
+ let mored = get_desc more in
+ (* We must substitute in a subtle way *)
+ (* Tsubst takes a tuple containing the row var and the variant *)
+ let desc' =
+ match mored with
+ | Tsubst (_, Some ty2) ->
+ (* This variant type has been already copied *)
+ (* Change the stub to avoid Tlink in the new type *)
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty2, None));
+ Tlink ty2
+ | _ ->
+ let more' =
+ match mored with
+ Tsubst (ty, None) -> ty
+ (* TODO: is this case possible?
+ possibly an interaction with (copy more) below? *)
+ | Tconstr _ | Tnil ->
+ copy more
+ | Tvar _ | Tunivar _ ->
+ newgenty mored
+ | _ -> assert false
+ in
+ let row =
+ match get_desc more' with (* PR#6163 *)
+ Tconstr (x,_,_) when not (is_fixed row) ->
+ let Row {fields; more; closed; name} = row_repr row in
+ create_row ~fields ~more ~closed ~name
+ ~fixed:(Some (Reified x))
+ | _ -> row
+ in
+ (* Register new type first for recursion *)
+ For_copy.redirect_desc copy_scope more
+ (Tsubst(more', Some t));
+ (* Return a new copy *)
+ Tvariant (copy_row copy true row false more')
+ in
+ Transient_expr.set_stub_desc t desc';
+ t
+ | desc ->
+ let t = newgenstub ~scope:(get_scope ty) in
+ For_copy.redirect_desc copy_scope ty (Tsubst (t, None));
+ let desc' = copy_type_desc copy desc in
+ Transient_expr.set_stub_desc t desc';
+ t
+ in
+ copy body)
+
+
+(* Similar to [Ctype.nondep_type_rec]. *)
+let rec typexp copy_scope s ty =
+ let desc = get_desc ty in
+ match desc with
+ Tvar _ | Tunivar _ ->
+ if s.for_saving || get_id ty < 0 then
+ let ty' =
+ if s.for_saving then newpersty (norm desc)
+ else newty2 ~level:(get_level ty) desc
+ in
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty', None));
+ ty'
+ else ty
+ | Tsubst (ty, _) ->
+ ty
+ | Tfield (m, k, _t1, _t2) when not s.for_saving && m = dummy_method
+ && field_kind_repr k <> Fabsent && get_level ty < generic_level ->
+ (* do not copy the type of self when it is not generalized *)
+ ty
+(* cannot do it, since it would omit substitution
+ | Tvariant row when not (static_row row) ->
+ ty
+*)
+ | _ ->
+ let tm = row_of_type ty in
+ let has_fixed_row =
+ not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm in
+ (* Make a stub *)
+ let ty' =
+ if s.for_saving then newpersty (Tvar None)
+ else newgenstub ~scope:(get_scope ty)
+ in
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty', None));
+ let desc =
+ if has_fixed_row then
+ match get_desc tm with (* PR#7348 *)
+ Tconstr (Pdot(m,i), tl, _abbrev) ->
+ let i' = String.sub i 0 (String.length i - 4) in
+ Tconstr(type_path s (Pdot(m,i')), tl, ref Mnil)
+ | _ -> assert false
+ else match desc with
+ | Tconstr (p, args, _abbrev) ->
+ let args = List.map (typexp copy_scope s) args in
+ begin match Path.Map.find p s.types with
+ | exception Not_found -> Tconstr(type_path s p, args, ref Mnil)
+ | Path _ -> Tconstr(type_path s p, args, ref Mnil)
+ | Type_function { params; body } ->
+ Tlink (apply_type_function params args body)
+ end
+ | Tpackage(p, fl) ->
+ Tpackage(modtype_path s p,
+ List.map (fun (n, ty) -> (n, typexp copy_scope s ty)) fl)
+ | Tobject (t1, name) ->
+ let t1' = typexp copy_scope s t1 in
+ let name' =
+ match !name with
+ | None -> None
+ | Some (p, tl) ->
+ if to_subst_by_type_function s p
+ then None
+ else Some (type_path s p, List.map (typexp copy_scope s) tl)
+ in
+ Tobject (t1', ref name')
+ | Tvariant row ->
+ let more = row_more row in
+ let mored = get_desc more in
+ (* We must substitute in a subtle way *)
+ (* Tsubst takes a tuple containing the row var and the variant *)
+ begin match mored with
+ Tsubst (_, Some ty2) ->
+ (* This variant type has been already copied *)
+ (* Change the stub to avoid Tlink in the new type *)
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty2, None));
+ Tlink ty2
+ | _ ->
+ let dup =
+ s.for_saving || get_level more = generic_level ||
+ static_row row || is_Tconstr more in
+ (* Various cases for the row variable *)
+ let more' =
+ match mored with
+ Tsubst (ty, None) -> ty
+ | Tconstr _ | Tnil -> typexp copy_scope s more
+ | Tunivar _ | Tvar _ ->
+ if s.for_saving then newpersty (norm mored)
+ else if dup && is_Tvar more then newgenty mored
+ else more
+ | _ -> assert false
+ in
+ (* Register new type first for recursion *)
+ For_copy.redirect_desc copy_scope more
+ (Tsubst (more', Some ty'));
+ (* TODO: check if more' can be eliminated *)
+ (* Return a new copy *)
+ let row =
+ copy_row (typexp copy_scope s) true row (not dup) more' in
+ match row_name row with
+ | Some (p, tl) ->
+ let name =
+ if to_subst_by_type_function s p then None
+ else Some (type_path s p, tl)
+ in
+ Tvariant (set_row_name row name)
+ | None ->
+ Tvariant row
+ end
+ | Tfield(_label, kind, _t1, t2) when field_kind_repr kind = Fabsent ->
+ Tlink (typexp copy_scope s t2)
+ | _ -> copy_type_desc (typexp copy_scope s) desc
+ in
+ Transient_expr.set_stub_desc ty' desc;
+ ty'
+
+(*
+ Always make a copy of the type. If this is not done, type levels
+ might not be correct.
+*)
+let type_expr s ty =
+ For_copy.with_scope (fun copy_scope -> typexp copy_scope s ty)
+
+let label_declaration copy_scope s l =
+ {
+ ld_id = l.ld_id;
+ ld_mutable = l.ld_mutable;
+ ld_type = typexp copy_scope s l.ld_type;
+ ld_loc = loc s l.ld_loc;
+ ld_attributes = attrs s l.ld_attributes;
+ ld_uid = l.ld_uid;
+ }
+
+let constructor_arguments copy_scope s = function
+ | Cstr_tuple l ->
+ Cstr_tuple (List.map (typexp copy_scope s) l)
+ | Cstr_record l ->
+ Cstr_record (List.map (label_declaration copy_scope s) l)
+
+let constructor_declaration copy_scope s c =
+ {
+ cd_id = c.cd_id;
+ cd_args = constructor_arguments copy_scope s c.cd_args;
+ cd_res = Option.map (typexp copy_scope s) c.cd_res;
+ cd_loc = loc s c.cd_loc;
+ cd_attributes = attrs s c.cd_attributes;
+ cd_uid = c.cd_uid;
+ }
+
+let type_declaration' copy_scope s decl =
+ { type_params = List.map (typexp copy_scope s) decl.type_params;
+ type_arity = decl.type_arity;
+ type_kind =
+ begin match decl.type_kind with
+ Type_abstract r -> Type_abstract r
+ | Type_variant (cstrs, rep) ->
+ Type_variant (List.map (constructor_declaration copy_scope s) cstrs,
+ rep)
+ | Type_record(lbls, rep) ->
+ Type_record (List.map (label_declaration copy_scope s) lbls, rep)
+ | Type_open -> Type_open
+ end;
+ type_manifest =
+ begin
+ match decl.type_manifest with
+ None -> None
+ | Some ty -> Some(typexp copy_scope s ty)
+ end;
+ type_private = decl.type_private;
+ type_variance = decl.type_variance;
+ type_separability = decl.type_separability;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = loc s decl.type_loc;
+ type_attributes = attrs s decl.type_attributes;
+ type_immediate = decl.type_immediate;
+ type_unboxed_default = decl.type_unboxed_default;
+ type_uid = decl.type_uid;
+ }
+
+let type_declaration s decl =
+ For_copy.with_scope (fun copy_scope -> type_declaration' copy_scope s decl)
+
+let class_signature copy_scope s sign =
+ { csig_self = typexp copy_scope s sign.csig_self;
+ csig_self_row = typexp copy_scope s sign.csig_self_row;
+ csig_vars =
+ Vars.map
+ (function (m, v, t) -> (m, v, typexp copy_scope s t))
+ sign.csig_vars;
+ csig_meths =
+ Meths.map
+ (function (p, v, t) -> (p, v, typexp copy_scope s t))
+ sign.csig_meths;
+ }
+
+let rec class_type copy_scope s = function
+ | Cty_constr (p, tyl, cty) ->
+ let p' = type_path s p in
+ let tyl' = List.map (typexp copy_scope s) tyl in
+ let cty' = class_type copy_scope s cty in
+ Cty_constr (p', tyl', cty')
+ | Cty_signature sign ->
+ Cty_signature (class_signature copy_scope s sign)
+ | Cty_arrow (l, ty, cty) ->
+ Cty_arrow (l, typexp copy_scope s ty, class_type copy_scope s cty)
+
+let class_declaration' copy_scope s decl =
+ { cty_params = List.map (typexp copy_scope s) decl.cty_params;
+ cty_variance = decl.cty_variance;
+ cty_type = class_type copy_scope s decl.cty_type;
+ cty_path = type_path s decl.cty_path;
+ cty_new =
+ begin match decl.cty_new with
+ | None -> None
+ | Some ty -> Some (typexp copy_scope s ty)
+ end;
+ cty_loc = loc s decl.cty_loc;
+ cty_attributes = attrs s decl.cty_attributes;
+ cty_uid = decl.cty_uid;
+ }
+
+let class_declaration s decl =
+ For_copy.with_scope (fun copy_scope -> class_declaration' copy_scope s decl)
+
+let cltype_declaration' copy_scope s decl =
+ { clty_params = List.map (typexp copy_scope s) decl.clty_params;
+ clty_variance = decl.clty_variance;
+ clty_type = class_type copy_scope s decl.clty_type;
+ clty_path = type_path s decl.clty_path;
+ clty_hash_type = type_declaration' copy_scope s decl.clty_hash_type ;
+ clty_loc = loc s decl.clty_loc;
+ clty_attributes = attrs s decl.clty_attributes;
+ clty_uid = decl.clty_uid;
+ }
+
+let cltype_declaration s decl =
+ For_copy.with_scope (fun copy_scope -> cltype_declaration' copy_scope s decl)
+
+let class_type s cty =
+ For_copy.with_scope (fun copy_scope -> class_type copy_scope s cty)
+
+let value_description' copy_scope s descr =
+ { val_type = typexp copy_scope s descr.val_type;
+ val_kind = descr.val_kind;
+ val_loc = loc s descr.val_loc;
+ val_attributes = attrs s descr.val_attributes;
+ val_uid = descr.val_uid;
+ }
+
+let value_description s descr =
+ For_copy.with_scope (fun copy_scope -> value_description' copy_scope s descr)
+
+let extension_constructor' copy_scope s ext =
+ { ext_type_path = type_path s ext.ext_type_path;
+ ext_type_params = List.map (typexp copy_scope s) ext.ext_type_params;
+ ext_args = constructor_arguments copy_scope s ext.ext_args;
+ ext_ret_type = Option.map (typexp copy_scope s) ext.ext_ret_type;
+ ext_private = ext.ext_private;
+ ext_attributes = attrs s ext.ext_attributes;
+ ext_loc = if s.for_saving then Location.none else ext.ext_loc;
+ ext_uid = ext.ext_uid;
+ }
+
+let extension_constructor s ext =
+ For_copy.with_scope
+ (fun copy_scope -> extension_constructor' copy_scope s ext)
+
+
+(* For every binding k |-> d of m1, add k |-> f d to m2
+ and return resulting merged map. *)
+
+let merge_path_maps f m1 m2 =
+ Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
+
+let keep_latest_loc l1 l2 =
+ match l2 with
+ | None -> l1
+ | Some _ -> l2
+
+let type_replacement s = function
+ | Path p -> Path (type_path s p)
+ | Type_function { params; body } ->
+ For_copy.with_scope (fun copy_scope ->
+ let params = List.map (typexp copy_scope s) params in
+ let body = typexp copy_scope s body in
+ Type_function { params; body })
+
+type scoping =
+ | Keep
+ | Make_local
+ | Rescope of int
+
+module Lazy_types = struct
+
+ type module_decl =
+ {
+ mdl_type: modtype;
+ mdl_attributes: Parsetree.attributes;
+ mdl_loc: Location.t;
+ mdl_uid: Uid.t;
+ }
+
+ and modtype =
+ | MtyL_ident of Path.t
+ | MtyL_signature of signature
+ | MtyL_functor of functor_parameter * modtype
+ | MtyL_alias of Path.t
+
+ and modtype_declaration =
+ {
+ mtdl_type: modtype option;
+ mtdl_attributes: Parsetree.attributes;
+ mtdl_loc: Location.t;
+ mtdl_uid: Uid.t;
+ }
+
+ and signature' =
+ | S_eager of Types.signature
+ | S_lazy of signature_item list
+
+ and signature =
+ (scoping * t * signature', signature') Lazy_backtrack.t
+
+ and signature_item =
+ SigL_value of Ident.t * value_description * visibility
+ | SigL_type of Ident.t * type_declaration * rec_status * visibility
+ | SigL_typext of Ident.t * extension_constructor * ext_status * visibility
+ | SigL_module of
+ Ident.t * module_presence * module_decl * rec_status * visibility
+ | SigL_modtype of Ident.t * modtype_declaration * visibility
+ | SigL_class of Ident.t * class_declaration * rec_status * visibility
+ | SigL_class_type of Ident.t * class_type_declaration *
+ rec_status * visibility
+
+ and functor_parameter =
+ | Unit
+ | Named of Ident.t option * modtype
+
+end
+open Lazy_types
+
+let rename_bound_idents scoping s sg =
+ let rename =
+ let open Ident in
+ match scoping with
+ | Keep -> (fun id -> create_scoped ~scope:(scope id) (name id))
+ | Make_local -> Ident.rename
+ | Rescope scope -> (fun id -> create_scoped ~scope (name id))
+ in
+ let rec rename_bound_idents s sg = function
+ | [] -> sg, s
+ | SigL_type(id, td, rs, vis) :: rest ->
+ let id' = rename id in
+ rename_bound_idents
+ (add_type id (Pident id') s)
+ (SigL_type(id', td, rs, vis) :: sg)
+ rest
+ | SigL_module(id, pres, md, rs, vis) :: rest ->
+ let id' = rename id in
+ rename_bound_idents
+ (add_module id (Pident id') s)
+ (SigL_module (id', pres, md, rs, vis) :: sg)
+ rest
+ | SigL_modtype(id, mtd, vis) :: rest ->
+ let id' = rename id in
+ rename_bound_idents
+ (add_modtype id (Pident id') s)
+ (SigL_modtype(id', mtd, vis) :: sg)
+ rest
+ | SigL_class(id, cd, rs, vis) :: rest ->
+ (* cheat and pretend they are types cf. PR#6650 *)
+ let id' = rename id in
+ rename_bound_idents
+ (add_type id (Pident id') s)
+ (SigL_class(id', cd, rs, vis) :: sg)
+ rest
+ | SigL_class_type(id, ctd, rs, vis) :: rest ->
+ (* cheat and pretend they are types cf. PR#6650 *)
+ let id' = rename id in
+ rename_bound_idents
+ (add_type id (Pident id') s)
+ (SigL_class_type(id', ctd, rs, vis) :: sg)
+ rest
+ | SigL_value(id, vd, vis) :: rest ->
+ (* scope doesn't matter for value identifiers. *)
+ let id' = Ident.rename id in
+ rename_bound_idents s (SigL_value(id', vd, vis) :: sg) rest
+ | SigL_typext(id, ec, es, vis) :: rest ->
+ let id' = rename id in
+ rename_bound_idents s (SigL_typext(id',ec,es,vis) :: sg) rest
+ in
+ rename_bound_idents s [] sg
+
+let rec lazy_module_decl md =
+ { mdl_type = lazy_modtype md.md_type;
+ mdl_attributes = md.md_attributes;
+ mdl_loc = md.md_loc;
+ mdl_uid = md.md_uid }
+
+and subst_lazy_module_decl scoping s md =
+ let mdl_type = subst_lazy_modtype scoping s md.mdl_type in
+ { mdl_type;
+ mdl_attributes = attrs s md.mdl_attributes;
+ mdl_loc = loc s md.mdl_loc;
+ mdl_uid = md.mdl_uid }
+
+and force_module_decl md =
+ let md_type = force_modtype md.mdl_type in
+ { md_type;
+ md_attributes = md.mdl_attributes;
+ md_loc = md.mdl_loc;
+ md_uid = md.mdl_uid }
+
+and lazy_modtype = function
+ | Mty_ident p -> MtyL_ident p
+ | Mty_signature sg ->
+ MtyL_signature (Lazy_backtrack.create_forced (S_eager sg))
+ | Mty_functor (Unit, mty) -> MtyL_functor (Unit, lazy_modtype mty)
+ | Mty_functor (Named (id, arg), res) ->
+ MtyL_functor (Named (id, lazy_modtype arg), lazy_modtype res)
+ | Mty_alias p -> MtyL_alias p
+
+and subst_lazy_modtype scoping s = function
+ | MtyL_ident p ->
+ begin match Path.Map.find p s.modtypes with
+ | mty -> lazy_modtype mty
+ | exception Not_found ->
+ begin match p with
+ | Pident _ -> MtyL_ident p
+ | Pdot(p, n) ->
+ MtyL_ident(Pdot(module_path s p, n))
+ | Papply _ | Pextra_ty _ ->
+ fatal_error "Subst.modtype"
+ end
+ end
+ | MtyL_signature sg ->
+ MtyL_signature(subst_lazy_signature scoping s sg)
+ | MtyL_functor(Unit, res) ->
+ MtyL_functor(Unit, subst_lazy_modtype scoping s res)
+ | MtyL_functor(Named (None, arg), res) ->
+ MtyL_functor(Named (None, (subst_lazy_modtype scoping s) arg),
+ subst_lazy_modtype scoping s res)
+ | MtyL_functor(Named (Some id, arg), res) ->
+ let id' = Ident.rename id in
+ MtyL_functor(Named (Some id', (subst_lazy_modtype scoping s) arg),
+ subst_lazy_modtype scoping (add_module id (Pident id') s) res)
+ | MtyL_alias p ->
+ MtyL_alias (module_path s p)
+
+and force_modtype = function
+ | MtyL_ident p -> Mty_ident p
+ | MtyL_signature sg -> Mty_signature (force_signature sg)
+ | MtyL_functor (param, res) ->
+ let param : Types.functor_parameter =
+ match param with
+ | Unit -> Unit
+ | Named (id, mty) -> Named (id, force_modtype mty) in
+ Mty_functor (param, force_modtype res)
+ | MtyL_alias p -> Mty_alias p
+
+and lazy_modtype_decl mtd =
+ let mtdl_type = Option.map lazy_modtype mtd.mtd_type in
+ { mtdl_type;
+ mtdl_attributes = mtd.mtd_attributes;
+ mtdl_loc = mtd.mtd_loc;
+ mtdl_uid = mtd.mtd_uid }
+
+and subst_lazy_modtype_decl scoping s mtd =
+ { mtdl_type = Option.map (subst_lazy_modtype scoping s) mtd.mtdl_type;
+ mtdl_attributes = attrs s mtd.mtdl_attributes;
+ mtdl_loc = loc s mtd.mtdl_loc;
+ mtdl_uid = mtd.mtdl_uid }
+
+and force_modtype_decl mtd =
+ let mtd_type = Option.map force_modtype mtd.mtdl_type in
+ { mtd_type;
+ mtd_attributes = mtd.mtdl_attributes;
+ mtd_loc = mtd.mtdl_loc;
+ mtd_uid = mtd.mtdl_uid }
+
+and subst_lazy_signature scoping s sg =
+ match Lazy_backtrack.get_contents sg with
+ | Left (scoping', s', sg) ->
+ let scoping =
+ match scoping', scoping with
+ | sc, Keep -> sc
+ | _, (Make_local|Rescope _) -> scoping
+ in
+ let s = compose s' s in
+ Lazy_backtrack.create (scoping, s, sg)
+ | Right sg ->
+ Lazy_backtrack.create (scoping, s, sg)
+
+and force_signature sg =
+ List.map force_signature_item (force_signature_once sg)
+
+and force_signature_once sg =
+ lazy_signature' (Lazy_backtrack.force force_signature_once' sg)
+
+and lazy_signature' = function
+ | S_lazy sg -> sg
+ | S_eager sg -> List.map lazy_signature_item sg
+
+and force_signature_once' (scoping, s, sg) =
+ let sg = lazy_signature' sg in
+ (* Components of signature may be mutually recursive (e.g. type declarations
+ or class and type declarations), so first build global renaming
+ substitution... *)
+ let (sg', s') = rename_bound_idents scoping s sg in
+ (* ... then apply it to each signature component in turn *)
+ For_copy.with_scope (fun copy_scope ->
+ S_lazy (List.rev_map (subst_lazy_signature_item' copy_scope scoping s') sg')
+ )
+
+and lazy_signature_item = function
+ | Sig_value(id, d, vis) ->
+ SigL_value(id, d, vis)
+ | Sig_type(id, d, rs, vis) ->
+ SigL_type(id, d, rs, vis)
+ | Sig_typext(id, ext, es, vis) ->
+ SigL_typext(id, ext, es, vis)
+ | Sig_module(id, res, d, rs, vis) ->
+ SigL_module(id, res, lazy_module_decl d, rs, vis)
+ | Sig_modtype(id, d, vis) ->
+ SigL_modtype(id, lazy_modtype_decl d, vis)
+ | Sig_class(id, d, rs, vis) ->
+ SigL_class(id, d, rs, vis)
+ | Sig_class_type(id, d, rs, vis) ->
+ SigL_class_type(id, d, rs, vis)
+
+and subst_lazy_signature_item' copy_scope scoping s comp =
+ match comp with
+ SigL_value(id, d, vis) ->
+ SigL_value(id, value_description' copy_scope s d, vis)
+ | SigL_type(id, d, rs, vis) ->
+ SigL_type(id, type_declaration' copy_scope s d, rs, vis)
+ | SigL_typext(id, ext, es, vis) ->
+ SigL_typext(id, extension_constructor' copy_scope s ext, es, vis)
+ | SigL_module(id, pres, d, rs, vis) ->
+ SigL_module(id, pres, subst_lazy_module_decl scoping s d, rs, vis)
+ | SigL_modtype(id, d, vis) ->
+ SigL_modtype(id, subst_lazy_modtype_decl scoping s d, vis)
+ | SigL_class(id, d, rs, vis) ->
+ SigL_class(id, class_declaration' copy_scope s d, rs, vis)
+ | SigL_class_type(id, d, rs, vis) ->
+ SigL_class_type(id, cltype_declaration' copy_scope s d, rs, vis)
+
+and force_signature_item = function
+ | SigL_value(id, vd, vis) -> Sig_value(id, vd, vis)
+ | SigL_type(id, d, rs, vis) -> Sig_type(id, d, rs, vis)
+ | SigL_typext(id, ext, es, vis) -> Sig_typext(id, ext, es, vis)
+ | SigL_module(id, pres, d, rs, vis) ->
+ Sig_module(id, pres, force_module_decl d, rs, vis)
+ | SigL_modtype(id, d, vis) ->
+ Sig_modtype (id, force_modtype_decl d, vis)
+ | SigL_class(id, d, rs, vis) -> Sig_class(id, d, rs, vis)
+ | SigL_class_type(id, d, rs, vis) -> Sig_class_type(id, d, rs, vis)
+
+and modtype scoping s t =
+ t |> lazy_modtype |> subst_lazy_modtype scoping s |> force_modtype
+
+(* Composition of substitutions:
+ apply (compose s1 s2) x = apply s2 (apply s1 x) *)
+
+and compose s1 s2 =
+ if s1 == identity then s2 else
+ if s2 == identity then s1 else
+ { types = merge_path_maps (type_replacement s2) s1.types s2.types;
+ modules = merge_path_maps (module_path s2) s1.modules s2.modules;
+ modtypes = merge_path_maps (modtype Keep s2) s1.modtypes s2.modtypes;
+ for_saving = s1.for_saving || s2.for_saving;
+ loc = keep_latest_loc s1.loc s2.loc;
+ }
+
+
+let subst_lazy_signature_item scoping s comp =
+ For_copy.with_scope
+ (fun copy_scope -> subst_lazy_signature_item' copy_scope scoping s comp)
+
+module Lazy = struct
+ include Lazy_types
+
+ let of_module_decl = lazy_module_decl
+ let of_modtype = lazy_modtype
+ let of_modtype_decl = lazy_modtype_decl
+ let of_signature sg = Lazy_backtrack.create_forced (S_eager sg)
+ let of_signature_items sg = Lazy_backtrack.create_forced (S_lazy sg)
+ let of_signature_item = lazy_signature_item
+
+ let module_decl = subst_lazy_module_decl
+ let modtype = subst_lazy_modtype
+ let modtype_decl = subst_lazy_modtype_decl
+ let signature = subst_lazy_signature
+ let signature_item = subst_lazy_signature_item
+
+ let force_module_decl = force_module_decl
+ let force_modtype = force_modtype
+ let force_modtype_decl = force_modtype_decl
+ let force_signature = force_signature
+ let force_signature_once = force_signature_once
+ let force_signature_item = force_signature_item
+end
+
+let signature sc s sg =
+ Lazy.(sg |> of_signature |> signature sc s |> force_signature)
+
+let signature_item sc s comp =
+ Lazy.(comp|> of_signature_item |> signature_item sc s |> force_signature_item)
+
+let modtype_declaration sc s decl =
+ Lazy.(decl |> of_modtype_decl |> modtype_decl sc s |> force_modtype_decl)
+
+let module_declaration scoping s decl =
+ Lazy.(decl |> of_module_decl |> module_decl scoping s |> force_module_decl)
+
+module Unsafe = struct
+
+ type t = unsafe subst
+ type error = Fcm_type_substituted_away of Path.t * Types.module_type
+
+ let add_modtype_path = add_modtype_gen
+ let add_modtype id mty s = add_modtype_path (Pident id) mty s
+ let add_type_path id p s = { s with types = Path.Map.add id (Path p) s.types }
+ let add_type_function id ~params ~body s =
+ { s with types = Path.Map.add id (Type_function { params; body }) s.types }
+ let add_module_path id p s = { s with modules = Path.Map.add id p s.modules }
+
+ let wrap f = match f () with
+ | x -> Ok x
+ | exception Module_type_path_substituted_away (p,mty) ->
+ Error (Fcm_type_substituted_away (p,mty))
+
+ let signature_item sc s comp = wrap (fun () -> signature_item sc s comp)
+ let signature sc s comp = wrap (fun () -> signature sc s comp )
+ let compose s1 s2 = wrap (fun () -> compose s1 s2)
+ let type_declaration s t = wrap (fun () -> type_declaration s t)
+
+end
diff --git a/upstream/ocaml_503/typing/subst.mli b/upstream/ocaml_503/typing/subst.mli
new file mode 100644
index 0000000000..b218803d75
--- /dev/null
+++ b/upstream/ocaml_503/typing/subst.mli
@@ -0,0 +1,190 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Substitutions *)
+
+open Types
+
+
+(**
+ Substitutions are used to translate a type from one context to
+ another. This requires substituting paths for identifiers, and
+ possibly also lowering the level of non-generic variables so that
+ they are inferior to the maximum level of the new context.
+
+ Substitutions can also be used to create a "clean" copy of a type.
+ Indeed, non-variable node of a type are duplicated, with their
+ levels set to generic level. That way, the resulting type is
+ well-formed (decreasing levels), even if the original one was not.
+
+ In the presence of local substitutions for module types, a substitution for a
+ type expression may fail to produce a well-formed type. In order to confine
+ this issue to local substitutions, the type of substitutions is split into a
+ safe and unsafe variant. Only unsafe substitutions may expand a module type
+ path into a generic module type. *)
+
+(** Type familly for substitutions *)
+type +'k subst
+
+type safe = [`Safe]
+type unsafe = [`Unsafe]
+
+type t = safe subst
+(** Standard substitution*)
+
+val identity: 'a subst
+val unsafe: t -> unsafe subst
+
+val add_type: Ident.t -> Path.t -> 'k subst -> 'k subst
+val add_module: Ident.t -> Path.t -> 'k subst -> 'k subst
+val add_modtype: Ident.t -> Path.t -> 'k subst -> 'k subst
+
+val for_saving: t -> t
+val reset_for_saving: unit -> unit
+val change_locs: 'k subst -> Location.t -> 'k subst
+
+val module_path: t -> Path.t -> Path.t
+val type_path: t -> Path.t -> Path.t
+val modtype_path: t -> Path.t -> Path.t
+
+val type_expr: t -> type_expr -> type_expr
+val class_type: t -> class_type -> class_type
+val value_description: t -> value_description -> value_description
+val type_declaration: t -> type_declaration -> type_declaration
+val extension_constructor:
+ t -> extension_constructor -> extension_constructor
+val class_declaration: t -> class_declaration -> class_declaration
+val cltype_declaration: t -> class_type_declaration -> class_type_declaration
+
+(**
+ When applied to a signature item, a substitution not only modifies the types
+ present in its declaration, but also refreshes the identifier of the item.
+ Effectively this creates new declarations, and so one should decide what the
+ scope of this new declaration should be.
+
+ This is decided by the [scoping] argument passed to the following functions.
+*)
+
+type scoping =
+ | Keep
+ | Make_local
+ | Rescope of int
+
+val modtype: scoping -> t -> module_type -> module_type
+val signature: scoping -> t -> signature -> signature
+val signature_item: scoping -> t -> signature_item -> signature_item
+val modtype_declaration:
+ scoping -> t -> modtype_declaration -> modtype_declaration
+val module_declaration: scoping -> t -> module_declaration -> module_declaration
+
+(** Composition of substitutions:
+ apply (compose s1 s2) x = apply s2 (apply s1 x) **)
+val compose: t -> t -> t
+
+module Unsafe: sig
+
+ type t = unsafe subst
+ (** Unsafe substitutions introduced by [with] constraints, local substitutions
+ ([type t := int * int]) or recursive module check. *)
+
+(** Replacing a module type name S by a non-path signature is unsafe as the
+ packed module type [(module S)] becomes ill-formed. *)
+ val add_modtype: Ident.t -> module_type -> 'any subst -> t
+ val add_modtype_path: Path.t -> module_type -> 'any subst -> t
+
+ (** Deep editing inside a module type require to retypecheck the module, for
+ applicative functors in path and module aliases. *)
+ val add_type_path: Path.t -> Path.t -> t -> t
+ val add_type_function:
+ Path.t -> params:type_expr list -> body:type_expr -> t -> t
+ val add_module_path: Path.t -> Path.t -> t -> t
+
+ type error =
+ | Fcm_type_substituted_away of Path.t * Types.module_type
+
+ type 'a res := ('a, error) result
+
+ val type_declaration: t -> type_declaration -> type_declaration res
+ val signature_item: scoping -> t -> signature_item -> signature_item res
+ val signature: scoping -> t -> signature -> signature res
+
+ val compose: t -> t -> t res
+ (** Composition of substitutions is eager and fails when the two substitution
+ are incompatible, for example [ module type t := sig end] is not
+ compatible with [module type s := sig type t=(module t) end]*)
+
+end
+
+module Lazy : sig
+ type module_decl =
+ {
+ mdl_type: modtype;
+ mdl_attributes: Parsetree.attributes;
+ mdl_loc: Location.t;
+ mdl_uid: Uid.t;
+ }
+
+ and modtype =
+ | MtyL_ident of Path.t
+ | MtyL_signature of signature
+ | MtyL_functor of functor_parameter * modtype
+ | MtyL_alias of Path.t
+
+ and modtype_declaration =
+ {
+ mtdl_type: modtype option; (* Note: abstract *)
+ mtdl_attributes: Parsetree.attributes;
+ mtdl_loc: Location.t;
+ mtdl_uid: Uid.t;
+ }
+
+ and signature
+
+ and signature_item =
+ SigL_value of Ident.t * value_description * visibility
+ | SigL_type of Ident.t * type_declaration * rec_status * visibility
+ | SigL_typext of Ident.t * extension_constructor * ext_status * visibility
+ | SigL_module of
+ Ident.t * module_presence * module_decl * rec_status * visibility
+ | SigL_modtype of Ident.t * modtype_declaration * visibility
+ | SigL_class of Ident.t * class_declaration * rec_status * visibility
+ | SigL_class_type of Ident.t * class_type_declaration *
+ rec_status * visibility
+
+ and functor_parameter =
+ | Unit
+ | Named of Ident.t option * modtype
+
+
+ val of_module_decl : Types.module_declaration -> module_decl
+ val of_modtype : Types.module_type -> modtype
+ val of_modtype_decl : Types.modtype_declaration -> modtype_declaration
+ val of_signature : Types.signature -> signature
+ val of_signature_items : signature_item list -> signature
+ val of_signature_item : Types.signature_item -> signature_item
+
+ val module_decl : scoping -> t -> module_decl -> module_decl
+ val modtype : scoping -> t -> modtype -> modtype
+ val modtype_decl : scoping -> t -> modtype_declaration -> modtype_declaration
+ val signature : scoping -> t -> signature -> signature
+ val signature_item : scoping -> t -> signature_item -> signature_item
+
+ val force_module_decl : module_decl -> Types.module_declaration
+ val force_modtype : modtype -> Types.module_type
+ val force_modtype_decl : modtype_declaration -> Types.modtype_declaration
+ val force_signature : signature -> Types.signature
+ val force_signature_once : signature -> signature_item list
+ val force_signature_item : signature_item -> Types.signature_item
+end
diff --git a/upstream/ocaml_503/typing/tast_iterator.ml b/upstream/ocaml_503/typing/tast_iterator.ml
new file mode 100644
index 0000000000..6ec345d5b2
--- /dev/null
+++ b/upstream/ocaml_503/typing/tast_iterator.ml
@@ -0,0 +1,695 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Isaac "Izzy" Avram *)
+(* *)
+(* Copyright 2019 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+
+type iterator =
+ {
+ attribute: iterator -> attribute -> unit;
+ attributes: iterator -> attributes -> unit;
+ binding_op: iterator -> binding_op -> unit;
+ case: 'k . iterator -> 'k case -> unit;
+ class_declaration: iterator -> class_declaration -> unit;
+ class_description: iterator -> class_description -> unit;
+ class_expr: iterator -> class_expr -> unit;
+ class_field: iterator -> class_field -> unit;
+ class_signature: iterator -> class_signature -> unit;
+ class_structure: iterator -> class_structure -> unit;
+ class_type: iterator -> class_type -> unit;
+ class_type_declaration: iterator -> class_type_declaration -> unit;
+ class_type_field: iterator -> class_type_field -> unit;
+ env: iterator -> Env.t -> unit;
+ expr: iterator -> expression -> unit;
+ extension_constructor: iterator -> extension_constructor -> unit;
+ location: iterator -> Location.t -> unit;
+ module_binding: iterator -> module_binding -> unit;
+ module_coercion: iterator -> module_coercion -> unit;
+ module_declaration: iterator -> module_declaration -> unit;
+ module_substitution: iterator -> module_substitution -> unit;
+ module_expr: iterator -> module_expr -> unit;
+ module_type: iterator -> module_type -> unit;
+ module_type_declaration: iterator -> module_type_declaration -> unit;
+ package_type: iterator -> package_type -> unit;
+ pat: 'k . iterator -> 'k general_pattern -> unit;
+ row_field: iterator -> row_field -> unit;
+ object_field: iterator -> object_field -> unit;
+ open_declaration: iterator -> open_declaration -> unit;
+ open_description: iterator -> open_description -> unit;
+ signature: iterator -> signature -> unit;
+ signature_item: iterator -> signature_item -> unit;
+ structure: iterator -> structure -> unit;
+ structure_item: iterator -> structure_item -> unit;
+ typ: iterator -> core_type -> unit;
+ type_declaration: iterator -> type_declaration -> unit;
+ type_declarations: iterator -> (rec_flag * type_declaration list) -> unit;
+ type_extension: iterator -> type_extension -> unit;
+ type_exception: iterator -> type_exception -> unit;
+ type_kind: iterator -> type_kind -> unit;
+ value_binding: iterator -> value_binding -> unit;
+ value_bindings: iterator -> (rec_flag * value_binding list) -> unit;
+ value_description: iterator -> value_description -> unit;
+ with_constraint: iterator -> with_constraint -> unit;
+ item_declaration: iterator -> item_declaration -> unit;
+ }
+
+let iter_snd f (_, y) = f y
+let iter_loc sub {loc; _} = sub.location sub loc
+
+let location _sub _l = ()
+
+let attribute sub x =
+ let iterator = {
+ Ast_iterator.default_iterator
+ with location = fun _this x -> sub.location sub x
+ } in
+ iter_loc sub x.Parsetree.attr_name;
+ iterator.payload iterator x.Parsetree.attr_payload;
+ sub.location sub x.Parsetree.attr_loc
+
+let attributes sub l = List.iter (attribute sub) l
+
+let structure sub {str_items; str_final_env; _} =
+ List.iter (sub.structure_item sub) str_items;
+ sub.env sub str_final_env
+
+let class_infos sub f x =
+ sub.location sub x.ci_loc;
+ sub.attributes sub x.ci_attributes;
+ iter_loc sub x.ci_id_name;
+ List.iter (fun (ct, _) -> sub.typ sub ct) x.ci_params;
+ f x.ci_expr
+
+let module_type_declaration sub x =
+ sub.item_declaration sub (Module_type x);
+ sub.location sub x.mtd_loc;
+ sub.attributes sub x.mtd_attributes;
+ iter_loc sub x.mtd_name;
+ Option.iter (sub.module_type sub) x.mtd_type
+
+let module_declaration sub md =
+ let {md_loc; md_name; md_type; md_attributes; _} = md in
+ sub.item_declaration sub (Module md);
+ sub.location sub md_loc;
+ sub.attributes sub md_attributes;
+ iter_loc sub md_name;
+ sub.module_type sub md_type
+
+let module_substitution sub ms =
+ let {ms_loc; ms_name; ms_txt; ms_attributes; _} = ms in
+ sub.item_declaration sub (Module_substitution ms);
+ sub.location sub ms_loc;
+ sub.attributes sub ms_attributes;
+ iter_loc sub ms_name;
+ iter_loc sub ms_txt
+
+let include_infos sub f {incl_loc; incl_mod; incl_attributes; _} =
+ sub.location sub incl_loc;
+ sub.attributes sub incl_attributes;
+ f incl_mod
+
+let class_type_declaration sub x =
+ sub.item_declaration sub (Class_type x);
+ class_infos sub (sub.class_type sub) x
+
+let class_declaration sub x =
+ sub.item_declaration sub (Class x);
+ class_infos sub (sub.class_expr sub) x
+
+let structure_item sub {str_loc; str_desc; str_env; _} =
+ sub.location sub str_loc;
+ sub.env sub str_env;
+ match str_desc with
+ | Tstr_eval (exp, attrs) -> sub.expr sub exp; sub.attributes sub attrs
+ | Tstr_value (rec_flag, list) -> sub.value_bindings sub (rec_flag, list)
+ | Tstr_primitive v -> sub.value_description sub v
+ | Tstr_type (rec_flag, list) -> sub.type_declarations sub (rec_flag, list)
+ | Tstr_typext te -> sub.type_extension sub te
+ | Tstr_exception ext -> sub.type_exception sub ext
+ | Tstr_module mb -> sub.module_binding sub mb
+ | Tstr_recmodule list -> List.iter (sub.module_binding sub) list
+ | Tstr_modtype x -> sub.module_type_declaration sub x
+ | Tstr_class list ->
+ List.iter (fun (cls,_) -> sub.class_declaration sub cls) list
+ | Tstr_class_type list ->
+ List.iter (fun (_, s, cltd) ->
+ iter_loc sub s; sub.class_type_declaration sub cltd) list
+ | Tstr_include incl -> include_infos sub (sub.module_expr sub) incl
+ | Tstr_open od -> sub.open_declaration sub od
+ | Tstr_attribute attr -> sub.attribute sub attr
+
+let value_description sub x =
+ sub.item_declaration sub (Value x);
+ sub.location sub x.val_loc;
+ sub.attributes sub x.val_attributes;
+ iter_loc sub x.val_name;
+ sub.typ sub x.val_desc
+
+let label_decl sub ({ld_loc; ld_name; ld_type; ld_attributes; _} as ld) =
+ sub.item_declaration sub (Label ld);
+ sub.location sub ld_loc;
+ sub.attributes sub ld_attributes;
+ iter_loc sub ld_name;
+ sub.typ sub ld_type
+
+let constructor_args sub = function
+ | Cstr_tuple l -> List.iter (sub.typ sub) l
+ | Cstr_record l -> List.iter (label_decl sub) l
+
+let constructor_decl sub x =
+ sub.item_declaration sub (Constructor x);
+ sub.location sub x.cd_loc;
+ sub.attributes sub x.cd_attributes;
+ iter_loc sub x.cd_name;
+ List.iter (iter_loc sub) x.cd_vars;
+ constructor_args sub x.cd_args;
+ Option.iter (sub.typ sub) x.cd_res
+
+let type_kind sub = function
+ | Ttype_abstract -> ()
+ | Ttype_variant list -> List.iter (constructor_decl sub) list
+ | Ttype_record list -> List.iter (label_decl sub) list
+ | Ttype_open -> ()
+
+let type_declaration sub x =
+ sub.item_declaration sub (Type x);
+ sub.location sub x.typ_loc;
+ sub.attributes sub x.typ_attributes;
+ iter_loc sub x.typ_name;
+ List.iter
+ (fun (c1, c2, loc) ->
+ sub.typ sub c1;
+ sub.typ sub c2;
+ sub.location sub loc)
+ x.typ_cstrs;
+ sub.type_kind sub x.typ_kind;
+ Option.iter (sub.typ sub) x.typ_manifest;
+ List.iter (fun (c, _) -> sub.typ sub c) x.typ_params
+
+let type_declarations sub (_, list) = List.iter (sub.type_declaration sub) list
+
+let type_extension sub x =
+ sub.location sub x.tyext_loc;
+ sub.attributes sub x.tyext_attributes;
+ iter_loc sub x.tyext_txt;
+ List.iter (fun (c, _) -> sub.typ sub c) x.tyext_params;
+ List.iter (sub.extension_constructor sub) x.tyext_constructors
+
+let type_exception sub {tyexn_loc; tyexn_constructor; tyexn_attributes; _} =
+ sub.location sub tyexn_loc;
+ sub.attributes sub tyexn_attributes;
+ sub.extension_constructor sub tyexn_constructor
+
+let extension_constructor sub ec =
+ let {ext_loc; ext_name; ext_kind; ext_attributes; _} = ec in
+ sub.item_declaration sub (Extension_constructor ec);
+ sub.location sub ext_loc;
+ sub.attributes sub ext_attributes;
+ iter_loc sub ext_name;
+ match ext_kind with
+ | Text_decl (ids, ctl, cto) ->
+ List.iter (iter_loc sub) ids;
+ constructor_args sub ctl;
+ Option.iter (sub.typ sub) cto
+ | Text_rebind (_, lid) -> iter_loc sub lid
+
+let pat_extra sub (e, loc, attrs) =
+ sub.location sub loc;
+ sub.attributes sub attrs;
+ match e with
+ | Tpat_type (_, lid) -> iter_loc sub lid
+ | Tpat_unpack -> ()
+ | Tpat_open (_, lid, env) -> iter_loc sub lid; sub.env sub env
+ | Tpat_constraint ct -> sub.typ sub ct
+
+let pat
+ : type k . iterator -> k general_pattern -> unit
+ = fun sub {pat_loc; pat_extra=extra; pat_desc; pat_env; pat_attributes; _} ->
+ sub.location sub pat_loc;
+ sub.attributes sub pat_attributes;
+ sub.env sub pat_env;
+ List.iter (pat_extra sub) extra;
+ match pat_desc with
+ | Tpat_any -> ()
+ | Tpat_var (_, s, _) -> iter_loc sub s
+ | Tpat_constant _ -> ()
+ | Tpat_tuple l -> List.iter (sub.pat sub) l
+ | Tpat_construct (lid, _, l, vto) ->
+ iter_loc sub lid;
+ List.iter (sub.pat sub) l;
+ Option.iter (fun (ids, ct) ->
+ List.iter (iter_loc sub) ids; sub.typ sub ct) vto
+ | Tpat_variant (_, po, _) -> Option.iter (sub.pat sub) po
+ | Tpat_record (l, _) ->
+ List.iter (fun (lid, _, i) -> iter_loc sub lid; sub.pat sub i) l
+ | Tpat_array l -> List.iter (sub.pat sub) l
+ | Tpat_alias (p, _, s, _) -> sub.pat sub p; iter_loc sub s
+ | Tpat_lazy p -> sub.pat sub p
+ | Tpat_value p -> sub.pat sub (p :> pattern)
+ | Tpat_exception p -> sub.pat sub p
+ | Tpat_or (p1, p2, _) ->
+ sub.pat sub p1;
+ sub.pat sub p2
+
+let extra sub = function
+ | Texp_constraint cty -> sub.typ sub cty
+ | Texp_coerce (cty1, cty2) ->
+ Option.iter (sub.typ sub) cty1;
+ sub.typ sub cty2
+ | Texp_newtype _ -> ()
+ | Texp_poly cto -> Option.iter (sub.typ sub) cto
+
+let function_param sub fp =
+ sub.location sub fp.fp_loc;
+ match fp.fp_kind with
+ | Tparam_pat pat -> sub.pat sub pat
+ | Tparam_optional_default (pat, default_arg) ->
+ sub.pat sub pat;
+ sub.expr sub default_arg
+
+let function_body sub body =
+ match[@warning "+9"] body with
+ | Tfunction_body body ->
+ sub.expr sub body
+ | Tfunction_cases
+ { cases; loc; exp_extra; attributes; partial = _; param = _ }
+ ->
+ List.iter (sub.case sub) cases;
+ sub.location sub loc;
+ Option.iter (extra sub) exp_extra;
+ sub.attributes sub attributes
+
+let expr sub {exp_loc; exp_extra; exp_desc; exp_env; exp_attributes; _} =
+ let extra x = extra sub x in
+ sub.location sub exp_loc;
+ sub.attributes sub exp_attributes;
+ List.iter (fun (e, loc, _) -> extra e; sub.location sub loc) exp_extra;
+ sub.env sub exp_env;
+ match exp_desc with
+ | Texp_ident (_, lid, _) -> iter_loc sub lid
+ | Texp_constant _ -> ()
+ | Texp_let (rec_flag, list, exp) ->
+ sub.value_bindings sub (rec_flag, list);
+ sub.expr sub exp
+ | Texp_function (params, body) ->
+ List.iter (function_param sub) params;
+ function_body sub body
+ | Texp_apply (exp, list) ->
+ sub.expr sub exp;
+ List.iter (fun (_, o) -> Option.iter (sub.expr sub) o) list
+ | Texp_match (exp, cases, effs, _) ->
+ sub.expr sub exp;
+ List.iter (sub.case sub) cases;
+ List.iter (sub.case sub) effs
+ | Texp_try (exp, cases, effs) ->
+ sub.expr sub exp;
+ List.iter (sub.case sub) cases;
+ List.iter (sub.case sub) effs
+ | Texp_tuple list -> List.iter (sub.expr sub) list
+ | Texp_construct (lid, _, args) ->
+ iter_loc sub lid;
+ List.iter (sub.expr sub) args
+ | Texp_variant (_, expo) -> Option.iter (sub.expr sub) expo
+ | Texp_record { fields; extended_expression; _} ->
+ Array.iter (function
+ | _, Kept _ -> ()
+ | _, Overridden (lid, exp) -> iter_loc sub lid; sub.expr sub exp)
+ fields;
+ Option.iter (sub.expr sub) extended_expression;
+ | Texp_field (exp, lid, _) ->
+ iter_loc sub lid;
+ sub.expr sub exp
+ | Texp_setfield (exp1, lid, _, exp2) ->
+ iter_loc sub lid;
+ sub.expr sub exp1;
+ sub.expr sub exp2
+ | Texp_array list -> List.iter (sub.expr sub) list
+ | Texp_ifthenelse (exp1, exp2, expo) ->
+ sub.expr sub exp1;
+ sub.expr sub exp2;
+ Option.iter (sub.expr sub) expo
+ | Texp_sequence (exp1, exp2) ->
+ sub.expr sub exp1;
+ sub.expr sub exp2
+ | Texp_while (exp1, exp2) ->
+ sub.expr sub exp1;
+ sub.expr sub exp2
+ | Texp_for (_, _, exp1, exp2, _, exp3) ->
+ sub.expr sub exp1;
+ sub.expr sub exp2;
+ sub.expr sub exp3
+ | Texp_send (exp, _) ->
+ sub.expr sub exp
+ | Texp_new (_, lid, _) -> iter_loc sub lid
+ | Texp_instvar (_, _, s) -> iter_loc sub s
+ | Texp_setinstvar (_, _, s, exp) ->
+ iter_loc sub s;
+ sub.expr sub exp
+ | Texp_override (_, list) ->
+ List.iter (fun (_, s, e) -> iter_loc sub s; sub.expr sub e) list
+ | Texp_letmodule (_, s, _, mexpr, exp) ->
+ iter_loc sub s;
+ sub.module_expr sub mexpr;
+ sub.expr sub exp
+ | Texp_letexception (cd, exp) ->
+ sub.extension_constructor sub cd;
+ sub.expr sub exp
+ | Texp_assert (exp, _) -> sub.expr sub exp
+ | Texp_lazy exp -> sub.expr sub exp
+ | Texp_object (cl, _) -> sub.class_structure sub cl
+ | Texp_pack mexpr -> sub.module_expr sub mexpr
+ | Texp_letop {let_ = l; ands; body; _} ->
+ sub.binding_op sub l;
+ List.iter (sub.binding_op sub) ands;
+ sub.case sub body
+ | Texp_unreachable -> ()
+ | Texp_extension_constructor (lid, _) -> iter_loc sub lid
+ | Texp_open (od, e) ->
+ sub.open_declaration sub od;
+ sub.expr sub e
+
+
+let package_type sub {pack_fields; pack_txt; _} =
+ List.iter (fun (lid, p) -> iter_loc sub lid; sub.typ sub p) pack_fields;
+ iter_loc sub pack_txt
+
+let binding_op sub {bop_loc; bop_op_name; bop_exp; _} =
+ sub.location sub bop_loc;
+ iter_loc sub bop_op_name;
+ sub.expr sub bop_exp
+
+let signature sub {sig_items; sig_final_env; _} =
+ sub.env sub sig_final_env;
+ List.iter (sub.signature_item sub) sig_items
+
+let signature_item sub {sig_loc; sig_desc; sig_env; _} =
+ sub.location sub sig_loc;
+ sub.env sub sig_env;
+ match sig_desc with
+ | Tsig_value v -> sub.value_description sub v
+ | Tsig_type (rf, tdl) -> sub.type_declarations sub (rf, tdl)
+ | Tsig_typesubst list -> sub.type_declarations sub (Nonrecursive, list)
+ | Tsig_typext te -> sub.type_extension sub te
+ | Tsig_exception ext -> sub.type_exception sub ext
+ | Tsig_module x -> sub.module_declaration sub x
+ | Tsig_modsubst x -> sub.module_substitution sub x
+ | Tsig_recmodule list -> List.iter (sub.module_declaration sub) list
+ | Tsig_modtype x -> sub.module_type_declaration sub x
+ | Tsig_modtypesubst x -> sub.module_type_declaration sub x
+ | Tsig_include incl -> include_infos sub (sub.module_type sub) incl
+ | Tsig_class list -> List.iter (sub.class_description sub) list
+ | Tsig_class_type list -> List.iter (sub.class_type_declaration sub) list
+ | Tsig_open od -> sub.open_description sub od
+ | Tsig_attribute _ -> ()
+
+let class_description sub x =
+ sub.item_declaration sub (Class_type x);
+ class_infos sub (sub.class_type sub) x
+
+let functor_parameter sub = function
+ | Unit -> ()
+ | Named (_, s, mtype) -> iter_loc sub s; sub.module_type sub mtype
+
+let module_type sub {mty_loc; mty_desc; mty_env; mty_attributes; _} =
+ sub.location sub mty_loc;
+ sub.attributes sub mty_attributes;
+ sub.env sub mty_env;
+ match mty_desc with
+ | Tmty_ident (_, lid) -> iter_loc sub lid
+ | Tmty_alias (_, lid) -> iter_loc sub lid
+ | Tmty_signature sg -> sub.signature sub sg
+ | Tmty_functor (arg, mtype2) ->
+ functor_parameter sub arg;
+ sub.module_type sub mtype2
+ | Tmty_with (mtype, list) ->
+ sub.module_type sub mtype;
+ List.iter (fun (_, lid, e) ->
+ iter_loc sub lid; sub.with_constraint sub e) list
+ | Tmty_typeof mexpr -> sub.module_expr sub mexpr
+
+let with_constraint sub = function
+ | Twith_type decl -> sub.type_declaration sub decl
+ | Twith_typesubst decl -> sub.type_declaration sub decl
+ | Twith_module (_, lid) -> iter_loc sub lid
+ | Twith_modsubst (_, lid) -> iter_loc sub lid
+ | Twith_modtype mty -> sub.module_type sub mty
+ | Twith_modtypesubst mty -> sub.module_type sub mty
+
+
+let open_description sub {open_loc; open_expr; open_env; open_attributes; _} =
+ sub.location sub open_loc;
+ sub.attributes sub open_attributes;
+ iter_snd (iter_loc sub) open_expr;
+ sub.env sub open_env
+
+let open_declaration sub {open_loc; open_expr; open_env; open_attributes; _} =
+ sub.location sub open_loc;
+ sub.attributes sub open_attributes;
+ sub.module_expr sub open_expr;
+ sub.env sub open_env
+
+let module_coercion sub = function
+ | Tcoerce_none -> ()
+ | Tcoerce_functor (c1,c2) ->
+ sub.module_coercion sub c1;
+ sub.module_coercion sub c2
+ | Tcoerce_alias (env, _, c1) ->
+ sub.env sub env;
+ sub.module_coercion sub c1
+ | Tcoerce_structure (l1, l2) ->
+ List.iter (fun (_, c) -> sub.module_coercion sub c) l1;
+ List.iter (fun (_, _ ,c) -> sub.module_coercion sub c) l2
+ | Tcoerce_primitive {pc_loc; pc_env; _} ->
+ sub.location sub pc_loc;
+ sub.env sub pc_env
+
+let module_expr sub {mod_loc; mod_desc; mod_env; mod_attributes; _} =
+ sub.location sub mod_loc;
+ sub.attributes sub mod_attributes;
+ sub.env sub mod_env;
+ match mod_desc with
+ | Tmod_ident (_, lid) -> iter_loc sub lid
+ | Tmod_structure st -> sub.structure sub st
+ | Tmod_functor (arg, mexpr) ->
+ functor_parameter sub arg;
+ sub.module_expr sub mexpr
+ | Tmod_apply (mexp1, mexp2, c) ->
+ sub.module_expr sub mexp1;
+ sub.module_expr sub mexp2;
+ sub.module_coercion sub c
+ | Tmod_apply_unit mexp1 ->
+ sub.module_expr sub mexp1;
+ | Tmod_constraint (mexpr, _, Tmodtype_implicit, c) ->
+ sub.module_expr sub mexpr;
+ sub.module_coercion sub c
+ | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, c) ->
+ sub.module_expr sub mexpr;
+ sub.module_type sub mtype;
+ sub.module_coercion sub c
+ | Tmod_unpack (exp, _) -> sub.expr sub exp
+
+let module_binding sub ({mb_loc; mb_name; mb_expr; mb_attributes; _} as mb) =
+ sub.item_declaration sub (Module_binding mb);
+ sub.location sub mb_loc;
+ sub.attributes sub mb_attributes;
+ iter_loc sub mb_name;
+ sub.module_expr sub mb_expr
+
+let class_expr sub {cl_loc; cl_desc; cl_env; cl_attributes; _} =
+ sub.location sub cl_loc;
+ sub.attributes sub cl_attributes;
+ sub.env sub cl_env;
+ match cl_desc with
+ | Tcl_constraint (cl, clty, _, _, _) ->
+ sub.class_expr sub cl;
+ Option.iter (sub.class_type sub) clty
+ | Tcl_structure clstr -> sub.class_structure sub clstr
+ | Tcl_fun (_, pat, priv, cl, _) ->
+ sub.pat sub pat;
+ List.iter (fun (_, e) -> sub.expr sub e) priv;
+ sub.class_expr sub cl
+ | Tcl_apply (cl, args) ->
+ sub.class_expr sub cl;
+ List.iter (fun (_, e) -> Option.iter (sub.expr sub) e) args
+ | Tcl_let (rec_flag, value_bindings, ivars, cl) ->
+ sub.value_bindings sub (rec_flag, value_bindings);
+ List.iter (fun (_, e) -> sub.expr sub e) ivars;
+ sub.class_expr sub cl
+ | Tcl_ident (_, lid, tyl) ->
+ iter_loc sub lid;
+ List.iter (sub.typ sub) tyl
+ | Tcl_open (od, e) ->
+ sub.open_description sub od;
+ sub.class_expr sub e
+
+let class_type sub {cltyp_loc; cltyp_desc; cltyp_env; cltyp_attributes; _} =
+ sub.location sub cltyp_loc;
+ sub.attributes sub cltyp_attributes;
+ sub.env sub cltyp_env;
+ match cltyp_desc with
+ | Tcty_signature csg -> sub.class_signature sub csg
+ | Tcty_constr (_, lid, list) ->
+ iter_loc sub lid;
+ List.iter (sub.typ sub) list
+ | Tcty_arrow (_, ct, cl) ->
+ sub.typ sub ct;
+ sub.class_type sub cl
+ | Tcty_open (od, e) ->
+ sub.open_description sub od;
+ sub.class_type sub e
+
+let class_signature sub {csig_self; csig_fields; _} =
+ sub.typ sub csig_self;
+ List.iter (sub.class_type_field sub) csig_fields
+
+let class_type_field sub {ctf_loc; ctf_desc; ctf_attributes; _} =
+ sub.location sub ctf_loc;
+ sub.attributes sub ctf_attributes;
+ match ctf_desc with
+ | Tctf_inherit ct -> sub.class_type sub ct
+ | Tctf_val (_, _, _, ct) -> sub.typ sub ct
+ | Tctf_method (_, _, _, ct) -> sub.typ sub ct
+ | Tctf_constraint (ct1, ct2) ->
+ sub.typ sub ct1;
+ sub.typ sub ct2
+ | Tctf_attribute attr -> sub.attribute sub attr
+
+let typ sub {ctyp_loc; ctyp_desc; ctyp_env; ctyp_attributes; _} =
+ sub.location sub ctyp_loc;
+ sub.attributes sub ctyp_attributes;
+ sub.env sub ctyp_env;
+ match ctyp_desc with
+ | Ttyp_any -> ()
+ | Ttyp_var _ -> ()
+ | Ttyp_arrow (_, ct1, ct2) ->
+ sub.typ sub ct1;
+ sub.typ sub ct2
+ | Ttyp_tuple list -> List.iter (sub.typ sub) list
+ | Ttyp_constr (_, lid, list) ->
+ iter_loc sub lid;
+ List.iter (sub.typ sub) list
+ | Ttyp_object (list, _) -> List.iter (sub.object_field sub) list
+ | Ttyp_class (_, lid, list) ->
+ iter_loc sub lid;
+ List.iter (sub.typ sub) list
+ | Ttyp_alias (ct, _) -> sub.typ sub ct
+ | Ttyp_variant (list, _, _) -> List.iter (sub.row_field sub) list
+ | Ttyp_poly (_, ct) -> sub.typ sub ct
+ | Ttyp_package pack -> sub.package_type sub pack
+ | Ttyp_open (_, mod_ident, t) ->
+ iter_loc sub mod_ident;
+ sub.typ sub t
+
+let class_structure sub {cstr_self; cstr_fields; _} =
+ sub.pat sub cstr_self;
+ List.iter (sub.class_field sub) cstr_fields
+
+let row_field sub {rf_loc; rf_desc; rf_attributes; _} =
+ sub.location sub rf_loc;
+ sub.attributes sub rf_attributes;
+ match rf_desc with
+ | Ttag (s, _, list) -> iter_loc sub s; List.iter (sub.typ sub) list
+ | Tinherit ct -> sub.typ sub ct
+
+let object_field sub {of_loc; of_desc; of_attributes; _} =
+ sub.location sub of_loc;
+ sub.attributes sub of_attributes;
+ match of_desc with
+ | OTtag (s, ct) -> iter_loc sub s; sub.typ sub ct
+ | OTinherit ct -> sub.typ sub ct
+
+let class_field_kind sub = function
+ | Tcfk_virtual ct -> sub.typ sub ct
+ | Tcfk_concrete (_, e) -> sub.expr sub e
+
+let class_field sub {cf_loc; cf_desc; cf_attributes; _} =
+ sub.location sub cf_loc;
+ sub.attributes sub cf_attributes;
+ match cf_desc with
+ | Tcf_inherit (_, cl, _, _, _) -> sub.class_expr sub cl
+ | Tcf_constraint (cty1, cty2) ->
+ sub.typ sub cty1;
+ sub.typ sub cty2
+ | Tcf_val (s, _, _, k, _) -> iter_loc sub s; class_field_kind sub k
+ | Tcf_method (s, _, k) -> iter_loc sub s;class_field_kind sub k
+ | Tcf_initializer exp -> sub.expr sub exp
+ | Tcf_attribute attr -> sub.attribute sub attr
+
+let value_bindings sub (_, list) = List.iter (sub.value_binding sub) list
+
+let case sub {c_lhs; c_guard; c_rhs} =
+ sub.pat sub c_lhs;
+ Option.iter (sub.expr sub) c_guard;
+ sub.expr sub c_rhs
+
+let value_binding sub ({vb_loc; vb_pat; vb_expr; vb_attributes; _} as vb) =
+ sub.item_declaration sub (Value_binding vb);
+ sub.location sub vb_loc;
+ sub.attributes sub vb_attributes;
+ sub.pat sub vb_pat;
+ sub.expr sub vb_expr
+
+let env _sub _ = ()
+
+let item_declaration _sub _ = ()
+
+let default_iterator =
+ {
+ attribute;
+ attributes;
+ binding_op;
+ case;
+ class_declaration;
+ class_description;
+ class_expr;
+ class_field;
+ class_signature;
+ class_structure;
+ class_type;
+ class_type_declaration;
+ class_type_field;
+ env;
+ expr;
+ extension_constructor;
+ location;
+ module_binding;
+ module_coercion;
+ module_declaration;
+ module_substitution;
+ module_expr;
+ module_type;
+ module_type_declaration;
+ package_type;
+ pat;
+ row_field;
+ object_field;
+ open_declaration;
+ open_description;
+ signature;
+ signature_item;
+ structure;
+ structure_item;
+ typ;
+ type_declaration;
+ type_declarations;
+ type_extension;
+ type_exception;
+ type_kind;
+ value_binding;
+ value_bindings;
+ value_description;
+ with_constraint;
+ item_declaration;
+ }
diff --git a/upstream/ocaml_503/typing/tast_iterator.mli b/upstream/ocaml_503/typing/tast_iterator.mli
new file mode 100644
index 0000000000..38cd4eac94
--- /dev/null
+++ b/upstream/ocaml_503/typing/tast_iterator.mli
@@ -0,0 +1,72 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Isaac "Izzy" Avram *)
+(* *)
+(* Copyright 2019 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. *)
+(* *)
+(**************************************************************************)
+
+(**
+Allows the implementation of typed tree inspection using open recursion
+*)
+
+open Asttypes
+open Typedtree
+
+type iterator =
+ {
+ attribute: iterator -> attribute -> unit;
+ attributes: iterator -> attributes -> unit;
+ binding_op: iterator -> binding_op -> unit;
+ case: 'k . iterator -> 'k case -> unit;
+ class_declaration: iterator -> class_declaration -> unit;
+ class_description: iterator -> class_description -> unit;
+ class_expr: iterator -> class_expr -> unit;
+ class_field: iterator -> class_field -> unit;
+ class_signature: iterator -> class_signature -> unit;
+ class_structure: iterator -> class_structure -> unit;
+ class_type: iterator -> class_type -> unit;
+ class_type_declaration: iterator -> class_type_declaration -> unit;
+ class_type_field: iterator -> class_type_field -> unit;
+ env: iterator -> Env.t -> unit;
+ expr: iterator -> expression -> unit;
+ extension_constructor: iterator -> extension_constructor -> unit;
+ location: iterator -> Location.t -> unit;
+ module_binding: iterator -> module_binding -> unit;
+ module_coercion: iterator -> module_coercion -> unit;
+ module_declaration: iterator -> module_declaration -> unit;
+ module_substitution: iterator -> module_substitution -> unit;
+ module_expr: iterator -> module_expr -> unit;
+ module_type: iterator -> module_type -> unit;
+ module_type_declaration: iterator -> module_type_declaration -> unit;
+ package_type: iterator -> package_type -> unit;
+ pat: 'k . iterator -> 'k general_pattern -> unit;
+ row_field: iterator -> row_field -> unit;
+ object_field: iterator -> object_field -> unit;
+ open_declaration: iterator -> open_declaration -> unit;
+ open_description: iterator -> open_description -> unit;
+ signature: iterator -> signature -> unit;
+ signature_item: iterator -> signature_item -> unit;
+ structure: iterator -> structure -> unit;
+ structure_item: iterator -> structure_item -> unit;
+ typ: iterator -> core_type -> unit;
+ type_declaration: iterator -> type_declaration -> unit;
+ type_declarations: iterator -> (rec_flag * type_declaration list) -> unit;
+ type_extension: iterator -> type_extension -> unit;
+ type_exception: iterator -> type_exception -> unit;
+ type_kind: iterator -> type_kind -> unit;
+ value_binding: iterator -> value_binding -> unit;
+ value_bindings: iterator -> (rec_flag * value_binding list) -> unit;
+ value_description: iterator -> value_description -> unit;
+ with_constraint: iterator -> with_constraint -> unit;
+ item_declaration: iterator -> item_declaration -> unit;
+ }
+
+val default_iterator: iterator
diff --git a/upstream/ocaml_503/typing/tast_mapper.ml b/upstream/ocaml_503/typing/tast_mapper.ml
new file mode 100644
index 0000000000..05b7a66ce8
--- /dev/null
+++ b/upstream/ocaml_503/typing/tast_mapper.ml
@@ -0,0 +1,912 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2015 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+
+(* TODO: add 'methods' for extension,
+ include_declaration, include_description *)
+
+type mapper =
+ {
+ attribute : mapper -> attribute -> attribute;
+ attributes : mapper -> attributes -> attributes;
+ binding_op: mapper -> binding_op -> binding_op;
+ case: 'k . mapper -> 'k case -> 'k case;
+ class_declaration: mapper -> class_declaration -> class_declaration;
+ class_description: mapper -> class_description -> class_description;
+ class_expr: mapper -> class_expr -> class_expr;
+ class_field: mapper -> class_field -> class_field;
+ class_signature: mapper -> class_signature -> class_signature;
+ class_structure: mapper -> class_structure -> class_structure;
+ class_type: mapper -> class_type -> class_type;
+ class_type_declaration: mapper -> class_type_declaration ->
+ class_type_declaration;
+ class_type_field: mapper -> class_type_field -> class_type_field;
+ env: mapper -> Env.t -> Env.t;
+ expr: mapper -> expression -> expression;
+ extension_constructor: mapper -> extension_constructor ->
+ extension_constructor;
+ location: mapper -> Location.t -> Location.t;
+ module_binding: mapper -> module_binding -> module_binding;
+ module_coercion: mapper -> module_coercion -> module_coercion;
+ module_declaration: mapper -> module_declaration -> module_declaration;
+ module_substitution: mapper -> module_substitution -> module_substitution;
+ module_expr: mapper -> module_expr -> module_expr;
+ module_type: mapper -> module_type -> module_type;
+ module_type_declaration:
+ mapper -> module_type_declaration -> module_type_declaration;
+ package_type: mapper -> package_type -> package_type;
+ pat: 'k . mapper -> 'k general_pattern -> 'k general_pattern;
+ row_field: mapper -> row_field -> row_field;
+ object_field: mapper -> object_field -> object_field;
+ open_declaration: mapper -> open_declaration -> open_declaration;
+ open_description: mapper -> open_description -> open_description;
+ signature: mapper -> signature -> signature;
+ signature_item: mapper -> signature_item -> signature_item;
+ structure: mapper -> structure -> structure;
+ structure_item: mapper -> structure_item -> structure_item;
+ typ: mapper -> core_type -> core_type;
+ type_declaration: mapper -> type_declaration -> type_declaration;
+ type_declarations: mapper -> (rec_flag * type_declaration list)
+ -> (rec_flag * type_declaration list);
+ type_extension: mapper -> type_extension -> type_extension;
+ type_exception: mapper -> type_exception -> type_exception;
+ type_kind: mapper -> type_kind -> type_kind;
+ value_binding: mapper -> value_binding -> value_binding;
+ value_bindings: mapper -> (rec_flag * value_binding list) ->
+ (rec_flag * value_binding list);
+ value_description: mapper -> value_description -> value_description;
+ with_constraint: mapper -> with_constraint -> with_constraint;
+ }
+
+let id x = x
+let tuple2 f1 f2 (x, y) = (f1 x, f2 y)
+let tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
+let map_loc sub {loc; txt} = {loc=sub.location sub loc; txt}
+
+let location _sub l = l
+
+let attribute sub x =
+ let mapper = {
+ Ast_mapper.default_mapper
+ with location = fun _this x -> sub.location sub x
+ } in
+ Parsetree.{
+ attr_name = map_loc sub x.attr_name;
+ attr_payload = mapper.payload mapper x.attr_payload;
+ attr_loc = sub.location sub x.attr_loc
+ }
+
+let attributes sub l = List.map (attribute sub) l
+
+let structure sub {str_items; str_type; str_final_env} =
+ {
+ str_items = List.map (sub.structure_item sub) str_items;
+ str_final_env = sub.env sub str_final_env;
+ str_type;
+ }
+
+let class_infos sub f x =
+ {x with
+ ci_loc = sub.location sub x.ci_loc;
+ ci_id_name = map_loc sub x.ci_id_name;
+ ci_params = List.map (tuple2 (sub.typ sub) id) x.ci_params;
+ ci_expr = f x.ci_expr;
+ ci_attributes = sub.attributes sub x.ci_attributes;
+ }
+
+let module_type_declaration sub x =
+ let mtd_loc = sub.location sub x.mtd_loc in
+ let mtd_name = map_loc sub x.mtd_name in
+ let mtd_type = Option.map (sub.module_type sub) x.mtd_type in
+ let mtd_attributes = sub.attributes sub x.mtd_attributes in
+ {x with mtd_loc; mtd_name; mtd_type; mtd_attributes}
+
+let module_declaration sub x =
+ let md_loc = sub.location sub x.md_loc in
+ let md_name = map_loc sub x.md_name in
+ let md_type = sub.module_type sub x.md_type in
+ let md_attributes = sub.attributes sub x.md_attributes in
+ {x with md_loc; md_name; md_type; md_attributes}
+
+let module_substitution sub x =
+ let ms_loc = sub.location sub x.ms_loc in
+ let ms_name = map_loc sub x.ms_name in
+ let ms_txt = map_loc sub x.ms_txt in
+ let ms_attributes = sub.attributes sub x.ms_attributes in
+ {x with ms_loc; ms_name; ms_txt; ms_attributes}
+
+let include_infos sub f x =
+ let incl_loc = sub.location sub x.incl_loc in
+ let incl_attributes = sub.attributes sub x.incl_attributes in
+ {x with incl_loc; incl_attributes; incl_mod = f x.incl_mod}
+
+let class_type_declaration sub x =
+ class_infos sub (sub.class_type sub) x
+
+let class_declaration sub x =
+ class_infos sub (sub.class_expr sub) x
+
+let structure_item sub {str_loc; str_desc; str_env} =
+ let str_loc = sub.location sub str_loc in
+ let str_env = sub.env sub str_env in
+ let str_desc =
+ match str_desc with
+ | Tstr_eval (exp, attrs) ->
+ Tstr_eval (sub.expr sub exp, sub.attributes sub attrs)
+ | Tstr_value (rec_flag, list) ->
+ let (rec_flag, list) = sub.value_bindings sub (rec_flag, list) in
+ Tstr_value (rec_flag, list)
+ | Tstr_primitive v -> Tstr_primitive (sub.value_description sub v)
+ | Tstr_type (rec_flag, list) ->
+ let (rec_flag, list) = sub.type_declarations sub (rec_flag, list) in
+ Tstr_type (rec_flag, list)
+ | Tstr_typext te -> Tstr_typext (sub.type_extension sub te)
+ | Tstr_exception ext -> Tstr_exception (sub.type_exception sub ext)
+ | Tstr_module mb -> Tstr_module (sub.module_binding sub mb)
+ | Tstr_recmodule list ->
+ Tstr_recmodule (List.map (sub.module_binding sub) list)
+ | Tstr_modtype x -> Tstr_modtype (sub.module_type_declaration sub x)
+ | Tstr_class list ->
+ Tstr_class
+ (List.map (tuple2 (sub.class_declaration sub) id) list)
+ | Tstr_class_type list ->
+ Tstr_class_type
+ (List.map (tuple3
+ id (map_loc sub) (sub.class_type_declaration sub)) list)
+ | Tstr_include incl ->
+ Tstr_include (include_infos sub (sub.module_expr sub) incl)
+ | Tstr_open od -> Tstr_open (sub.open_declaration sub od)
+ | Tstr_attribute attr -> Tstr_attribute (sub.attribute sub attr)
+ in
+ {str_desc; str_env; str_loc}
+
+let value_description sub x =
+ let val_loc = sub.location sub x.val_loc in
+ let val_name = map_loc sub x.val_name in
+ let val_desc = sub.typ sub x.val_desc in
+ let val_attributes = sub.attributes sub x.val_attributes in
+ {x with val_loc; val_name; val_desc; val_attributes}
+
+let label_decl sub x =
+ let ld_loc = sub.location sub x.ld_loc in
+ let ld_name = map_loc sub x.ld_name in
+ let ld_type = sub.typ sub x.ld_type in
+ let ld_attributes = sub.attributes sub x.ld_attributes in
+ {x with ld_loc; ld_name; ld_type; ld_attributes}
+
+let constructor_args sub = function
+ | Cstr_tuple l -> Cstr_tuple (List.map (sub.typ sub) l)
+ | Cstr_record l -> Cstr_record (List.map (label_decl sub) l)
+
+let constructor_decl sub cd =
+ let cd_loc = sub.location sub cd.cd_loc in
+ let cd_name = map_loc sub cd.cd_name in
+ let cd_vars = List.map (map_loc sub) cd.cd_vars in
+ let cd_args = constructor_args sub cd.cd_args in
+ let cd_res = Option.map (sub.typ sub) cd.cd_res in
+ let cd_attributes = sub.attributes sub cd.cd_attributes in
+ {cd with cd_loc; cd_name; cd_vars; cd_args; cd_res; cd_attributes}
+
+let type_kind sub = function
+ | Ttype_abstract -> Ttype_abstract
+ | Ttype_variant list -> Ttype_variant (List.map (constructor_decl sub) list)
+ | Ttype_record list -> Ttype_record (List.map (label_decl sub) list)
+ | Ttype_open -> Ttype_open
+
+let type_declaration sub x =
+ let typ_loc = sub.location sub x.typ_loc in
+ let typ_name = map_loc sub x.typ_name in
+ let typ_cstrs =
+ List.map
+ (tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub))
+ x.typ_cstrs
+ in
+ let typ_kind = sub.type_kind sub x.typ_kind in
+ let typ_manifest = Option.map (sub.typ sub) x.typ_manifest in
+ let typ_params = List.map (tuple2 (sub.typ sub) id) x.typ_params in
+ let typ_attributes = sub.attributes sub x.typ_attributes in
+ {x with typ_loc; typ_name; typ_cstrs; typ_kind; typ_manifest; typ_params;
+ typ_attributes}
+
+let type_declarations sub (rec_flag, list) =
+ (rec_flag, List.map (sub.type_declaration sub) list)
+
+let type_extension sub x =
+ let tyext_loc = sub.location sub x.tyext_loc in
+ let tyext_txt = map_loc sub x.tyext_txt in
+ let tyext_params = List.map (tuple2 (sub.typ sub) id) x.tyext_params in
+ let tyext_constructors =
+ List.map (sub.extension_constructor sub) x.tyext_constructors
+ in
+ let tyext_attributes = sub.attributes sub x.tyext_attributes in
+ {x with tyext_loc; tyext_txt; tyext_constructors; tyext_params;
+ tyext_attributes}
+
+let type_exception sub x =
+ let tyexn_loc = sub.location sub x.tyexn_loc in
+ let tyexn_constructor =
+ sub.extension_constructor sub x.tyexn_constructor
+ in
+ let tyexn_attributes = sub.attributes sub x.tyexn_attributes in
+ {tyexn_loc; tyexn_constructor; tyexn_attributes}
+
+let extension_constructor sub x =
+ let ext_loc = sub.location sub x.ext_loc in
+ let ext_name = map_loc sub x.ext_name in
+ let ext_kind =
+ match x.ext_kind with
+ Text_decl(ids, ctl, cto) ->
+ Text_decl(
+ List.map (map_loc sub) ids,
+ constructor_args sub ctl,
+ Option.map (sub.typ sub) cto
+ )
+ | Text_rebind (path, lid) ->
+ Text_rebind (path, map_loc sub lid)
+ in
+ let ext_attributes = sub.attributes sub x.ext_attributes in
+ {x with ext_loc; ext_name; ext_kind; ext_attributes}
+
+let pat_extra sub = function
+ | Tpat_unpack as d -> d
+ | Tpat_type (path,loc) -> Tpat_type (path, map_loc sub loc)
+ | Tpat_open (path,loc,env) ->
+ Tpat_open (path, map_loc sub loc, sub.env sub env)
+ | Tpat_constraint ct -> Tpat_constraint (sub.typ sub ct)
+
+let pat
+ : type k . mapper -> k general_pattern -> k general_pattern
+ = fun sub x ->
+ let pat_loc = sub.location sub x.pat_loc in
+ let pat_env = sub.env sub x.pat_env in
+ let pat_extra =
+ List.map (tuple3 (pat_extra sub) id (sub.attributes sub)) x.pat_extra in
+ let pat_desc : k pattern_desc =
+ match x.pat_desc with
+ | Tpat_any
+ | Tpat_constant _ -> x.pat_desc
+ | Tpat_var (id, s, uid) -> Tpat_var (id, map_loc sub s, uid)
+ | Tpat_tuple l -> Tpat_tuple (List.map (sub.pat sub) l)
+ | Tpat_construct (loc, cd, l, vto) ->
+ let vto = Option.map (fun (vl,cty) ->
+ List.map (map_loc sub) vl, sub.typ sub cty) vto in
+ Tpat_construct (map_loc sub loc, cd, List.map (sub.pat sub) l, vto)
+ | Tpat_variant (l, po, rd) ->
+ Tpat_variant (l, Option.map (sub.pat sub) po, rd)
+ | Tpat_record (l, closed) ->
+ Tpat_record (List.map (tuple3 (map_loc sub) id (sub.pat sub)) l, closed)
+ | Tpat_array l -> Tpat_array (List.map (sub.pat sub) l)
+ | Tpat_alias (p, id, s, uid) ->
+ Tpat_alias (sub.pat sub p, id, map_loc sub s, uid)
+ | Tpat_lazy p -> Tpat_lazy (sub.pat sub p)
+ | Tpat_value p ->
+ (as_computation_pattern (sub.pat sub (p :> pattern))).pat_desc
+ | Tpat_exception p ->
+ Tpat_exception (sub.pat sub p)
+ | Tpat_or (p1, p2, rd) ->
+ Tpat_or (sub.pat sub p1, sub.pat sub p2, rd)
+ in
+ let pat_attributes = sub.attributes sub x.pat_attributes in
+ {x with pat_loc; pat_extra; pat_desc; pat_env; pat_attributes}
+
+let function_param sub fp =
+ let fp_kind =
+ match fp.fp_kind with
+ | Tparam_pat pat -> Tparam_pat (sub.pat sub pat)
+ | Tparam_optional_default (pat, expr) ->
+ let pat = sub.pat sub pat in
+ let expr = sub.expr sub expr in
+ Tparam_optional_default (pat, expr)
+ in
+ let fp_loc = sub.location sub fp.fp_loc in
+ { fp_kind;
+ fp_param = fp.fp_param;
+ fp_arg_label = fp.fp_arg_label;
+ fp_partial = fp.fp_partial;
+ fp_newtypes = fp.fp_newtypes;
+ fp_loc;
+ }
+
+let extra sub = function
+ | Texp_constraint cty ->
+ Texp_constraint (sub.typ sub cty)
+ | Texp_coerce (cty1, cty2) ->
+ Texp_coerce (Option.map (sub.typ sub) cty1, sub.typ sub cty2)
+ | Texp_newtype _ as d -> d
+ | Texp_poly cto -> Texp_poly (Option.map (sub.typ sub) cto)
+
+let function_body sub body =
+ match body with
+ | Tfunction_body body ->
+ Tfunction_body (sub.expr sub body)
+ | Tfunction_cases { cases; partial; param; loc; exp_extra; attributes } ->
+ let loc = sub.location sub loc in
+ let cases = List.map (sub.case sub) cases in
+ let exp_extra = Option.map (extra sub) exp_extra in
+ let attributes = sub.attributes sub attributes in
+ Tfunction_cases { cases; partial; param; loc; exp_extra; attributes }
+
+let expr sub x =
+ let extra x = extra sub x in
+ let exp_loc = sub.location sub x.exp_loc in
+ let exp_extra = List.map (tuple3 extra (sub.location sub) id) x.exp_extra in
+ let exp_env = sub.env sub x.exp_env in
+ let exp_desc =
+ match x.exp_desc with
+ | Texp_ident (path, lid, vd) ->
+ Texp_ident (path, map_loc sub lid, vd)
+ | Texp_constant _ as d -> d
+ | Texp_let (rec_flag, list, exp) ->
+ let (rec_flag, list) = sub.value_bindings sub (rec_flag, list) in
+ Texp_let (rec_flag, list, sub.expr sub exp)
+ | Texp_function (params, body) ->
+ let params = List.map (function_param sub) params in
+ let body = function_body sub body in
+ Texp_function (params, body)
+ | Texp_apply (exp, list) ->
+ Texp_apply (
+ sub.expr sub exp,
+ List.map (tuple2 id (Option.map (sub.expr sub))) list
+ )
+ | Texp_match (exp, cases, eff_cases, p) ->
+ Texp_match (
+ sub.expr sub exp,
+ List.map (sub.case sub) cases,
+ List.map (sub.case sub) eff_cases,
+ p
+ )
+ | Texp_try (exp, exn_cases, eff_cases) ->
+ Texp_try (
+ sub.expr sub exp,
+ List.map (sub.case sub) exn_cases,
+ List.map (sub.case sub) eff_cases
+ )
+ | Texp_tuple list ->
+ Texp_tuple (List.map (sub.expr sub) list)
+ | Texp_construct (lid, cd, args) ->
+ Texp_construct (map_loc sub lid, cd, List.map (sub.expr sub) args)
+ | Texp_variant (l, expo) ->
+ Texp_variant (l, Option.map (sub.expr sub) expo)
+ | Texp_record { fields; representation; extended_expression } ->
+ let fields = Array.map (function
+ | label, Kept (t, mut) -> label, Kept (t, mut)
+ | label, Overridden (lid, exp) ->
+ label, Overridden (map_loc sub lid, sub.expr sub exp))
+ fields
+ in
+ Texp_record {
+ fields; representation;
+ extended_expression = Option.map (sub.expr sub) extended_expression;
+ }
+ | Texp_field (exp, lid, ld) ->
+ Texp_field (sub.expr sub exp, map_loc sub lid, ld)
+ | Texp_setfield (exp1, lid, ld, exp2) ->
+ Texp_setfield (
+ sub.expr sub exp1,
+ map_loc sub lid,
+ ld,
+ sub.expr sub exp2
+ )
+ | Texp_array list ->
+ Texp_array (List.map (sub.expr sub) list)
+ | Texp_ifthenelse (exp1, exp2, expo) ->
+ Texp_ifthenelse (
+ sub.expr sub exp1,
+ sub.expr sub exp2,
+ Option.map (sub.expr sub) expo
+ )
+ | Texp_sequence (exp1, exp2) ->
+ Texp_sequence (
+ sub.expr sub exp1,
+ sub.expr sub exp2
+ )
+ | Texp_while (exp1, exp2) ->
+ Texp_while (
+ sub.expr sub exp1,
+ sub.expr sub exp2
+ )
+ | Texp_for (id, p, exp1, exp2, dir, exp3) ->
+ Texp_for (
+ id,
+ p,
+ sub.expr sub exp1,
+ sub.expr sub exp2,
+ dir,
+ sub.expr sub exp3
+ )
+ | Texp_send (exp, meth) ->
+ Texp_send
+ (
+ sub.expr sub exp,
+ meth
+ )
+ | Texp_new (path, lid, cd) ->
+ Texp_new (
+ path,
+ map_loc sub lid,
+ cd
+ )
+ | Texp_instvar (path1, path2, id) ->
+ Texp_instvar (
+ path1,
+ path2,
+ map_loc sub id
+ )
+ | Texp_setinstvar (path1, path2, id, exp) ->
+ Texp_setinstvar (
+ path1,
+ path2,
+ map_loc sub id,
+ sub.expr sub exp
+ )
+ | Texp_override (path, list) ->
+ Texp_override (
+ path,
+ List.map (tuple3 id (map_loc sub) (sub.expr sub)) list
+ )
+ | Texp_letmodule (id, s, pres, mexpr, exp) ->
+ Texp_letmodule (
+ id,
+ map_loc sub s,
+ pres,
+ sub.module_expr sub mexpr,
+ sub.expr sub exp
+ )
+ | Texp_letexception (cd, exp) ->
+ Texp_letexception (
+ sub.extension_constructor sub cd,
+ sub.expr sub exp
+ )
+ | Texp_assert (exp, loc) ->
+ Texp_assert (sub.expr sub exp, loc)
+ | Texp_lazy exp ->
+ Texp_lazy (sub.expr sub exp)
+ | Texp_object (cl, sl) ->
+ Texp_object (sub.class_structure sub cl, sl)
+ | Texp_pack mexpr ->
+ Texp_pack (sub.module_expr sub mexpr)
+ | Texp_letop {let_; ands; param; body; partial} ->
+ Texp_letop{
+ let_ = sub.binding_op sub let_;
+ ands = List.map (sub.binding_op sub) ands;
+ param;
+ body = sub.case sub body;
+ partial;
+ }
+ | Texp_unreachable ->
+ Texp_unreachable
+ | Texp_extension_constructor (lid, path) ->
+ Texp_extension_constructor (map_loc sub lid, path)
+ | Texp_open (od, e) ->
+ Texp_open (sub.open_declaration sub od, sub.expr sub e)
+ in
+ let exp_attributes = sub.attributes sub x.exp_attributes in
+ {x with exp_loc; exp_extra; exp_desc; exp_env; exp_attributes}
+
+
+let package_type sub x =
+ let pack_txt = map_loc sub x.pack_txt in
+ let pack_fields = List.map
+ (tuple2 (map_loc sub) (sub.typ sub)) x.pack_fields in
+ {x with pack_txt; pack_fields}
+
+let binding_op sub x =
+ let bop_loc = sub.location sub x.bop_loc in
+ let bop_op_name = map_loc sub x.bop_op_name in
+ { x with bop_loc; bop_op_name; bop_exp = sub.expr sub x.bop_exp }
+
+let signature sub x =
+ let sig_final_env = sub.env sub x.sig_final_env in
+ let sig_items = List.map (sub.signature_item sub) x.sig_items in
+ {x with sig_items; sig_final_env}
+
+let signature_item sub x =
+ let sig_loc = sub.location sub x.sig_loc in
+ let sig_env = sub.env sub x.sig_env in
+ let sig_desc =
+ match x.sig_desc with
+ | Tsig_value v ->
+ Tsig_value (sub.value_description sub v)
+ | Tsig_type (rec_flag, list) ->
+ let (rec_flag, list) = sub.type_declarations sub (rec_flag, list) in
+ Tsig_type (rec_flag, list)
+ | Tsig_typesubst list ->
+ let (_, list) = sub.type_declarations sub (Nonrecursive, list) in
+ Tsig_typesubst list
+ | Tsig_typext te ->
+ Tsig_typext (sub.type_extension sub te)
+ | Tsig_exception ext ->
+ Tsig_exception (sub.type_exception sub ext)
+ | Tsig_module x ->
+ Tsig_module (sub.module_declaration sub x)
+ | Tsig_modsubst x ->
+ Tsig_modsubst (sub.module_substitution sub x)
+ | Tsig_recmodule list ->
+ Tsig_recmodule (List.map (sub.module_declaration sub) list)
+ | Tsig_modtype x ->
+ Tsig_modtype (sub.module_type_declaration sub x)
+ | Tsig_modtypesubst x ->
+ Tsig_modtypesubst (sub.module_type_declaration sub x)
+ | Tsig_include incl ->
+ Tsig_include (include_infos sub (sub.module_type sub) incl)
+ | Tsig_class list ->
+ Tsig_class (List.map (sub.class_description sub) list)
+ | Tsig_class_type list ->
+ Tsig_class_type
+ (List.map (sub.class_type_declaration sub) list)
+ | Tsig_open od -> Tsig_open (sub.open_description sub od)
+ | Tsig_attribute attr -> Tsig_attribute (sub.attribute sub attr)
+ in
+ {sig_loc; sig_desc; sig_env}
+
+let class_description sub x =
+ class_infos sub (sub.class_type sub) x
+
+let functor_parameter sub = function
+ | Unit -> Unit
+ | Named (id, s, mtype) -> Named (id, map_loc sub s, sub.module_type sub mtype)
+
+let module_type sub x =
+ let mty_loc = sub.location sub x.mty_loc in
+ let mty_env = sub.env sub x.mty_env in
+ let mty_desc =
+ match x.mty_desc with
+ | Tmty_ident (path, lid) -> Tmty_ident (path, map_loc sub lid)
+ | Tmty_alias (path, lid) -> Tmty_alias (path, map_loc sub lid)
+ | Tmty_signature sg -> Tmty_signature (sub.signature sub sg)
+ | Tmty_functor (arg, mtype2) ->
+ Tmty_functor (functor_parameter sub arg, sub.module_type sub mtype2)
+ | Tmty_with (mtype, list) ->
+ Tmty_with (
+ sub.module_type sub mtype,
+ List.map (tuple3 id (map_loc sub) (sub.with_constraint sub)) list
+ )
+ | Tmty_typeof mexpr ->
+ Tmty_typeof (sub.module_expr sub mexpr)
+ in
+ let mty_attributes = sub.attributes sub x.mty_attributes in
+ {x with mty_loc; mty_desc; mty_env; mty_attributes}
+
+let with_constraint sub = function
+ | Twith_type decl -> Twith_type (sub.type_declaration sub decl)
+ | Twith_typesubst decl -> Twith_typesubst (sub.type_declaration sub decl)
+ | Twith_modtype mty -> Twith_modtype (sub.module_type sub mty)
+ | Twith_modtypesubst mty -> Twith_modtypesubst (sub.module_type sub mty)
+ | Twith_module (path, lid) -> Twith_module (path, map_loc sub lid)
+ | Twith_modsubst (path, lid) -> Twith_modsubst (path, map_loc sub lid)
+
+let open_description sub od =
+ {od with open_loc = sub.location sub od.open_loc;
+ open_expr = tuple2 id (map_loc sub) od.open_expr;
+ open_env = sub.env sub od.open_env;
+ open_attributes = sub.attributes sub od.open_attributes}
+
+let open_declaration sub od =
+ {od with open_loc = sub.location sub od.open_loc;
+ open_expr = sub.module_expr sub od.open_expr;
+ open_env = sub.env sub od.open_env;
+ open_attributes = sub.attributes sub od.open_attributes}
+
+let module_coercion sub = function
+ | Tcoerce_none -> Tcoerce_none
+ | Tcoerce_functor (c1,c2) ->
+ Tcoerce_functor (sub.module_coercion sub c1, sub.module_coercion sub c2)
+ | Tcoerce_alias (env, p, c1) ->
+ Tcoerce_alias (sub.env sub env, p, sub.module_coercion sub c1)
+ | Tcoerce_structure (l1, l2) ->
+ let l1' = List.map (fun (i,c) -> i, sub.module_coercion sub c) l1 in
+ let l2' =
+ List.map (fun (id,i,c) -> id, i, sub.module_coercion sub c) l2
+ in
+ Tcoerce_structure (l1', l2')
+ | Tcoerce_primitive pc ->
+ Tcoerce_primitive {pc with pc_loc = sub.location sub pc.pc_loc;
+ pc_env = sub.env sub pc.pc_env}
+
+let module_expr sub x =
+ let mod_loc = sub.location sub x.mod_loc in
+ let mod_env = sub.env sub x.mod_env in
+ let mod_desc =
+ match x.mod_desc with
+ | Tmod_ident (path, lid) -> Tmod_ident (path, map_loc sub lid)
+ | Tmod_structure st -> Tmod_structure (sub.structure sub st)
+ | Tmod_functor (arg, mexpr) ->
+ Tmod_functor (functor_parameter sub arg, sub.module_expr sub mexpr)
+ | Tmod_apply (mexp1, mexp2, c) ->
+ Tmod_apply (
+ sub.module_expr sub mexp1,
+ sub.module_expr sub mexp2,
+ sub.module_coercion sub c
+ )
+ | Tmod_apply_unit mexp1 ->
+ Tmod_apply_unit (sub.module_expr sub mexp1)
+ | Tmod_constraint (mexpr, mt, Tmodtype_implicit, c) ->
+ Tmod_constraint (sub.module_expr sub mexpr, mt, Tmodtype_implicit,
+ sub.module_coercion sub c)
+ | Tmod_constraint (mexpr, mt, Tmodtype_explicit mtype, c) ->
+ Tmod_constraint (
+ sub.module_expr sub mexpr,
+ mt,
+ Tmodtype_explicit (sub.module_type sub mtype),
+ sub.module_coercion sub c
+ )
+ | Tmod_unpack (exp, mty) ->
+ Tmod_unpack
+ (
+ sub.expr sub exp,
+ mty
+ )
+ in
+ let mod_attributes = sub.attributes sub x.mod_attributes in
+ {x with mod_loc; mod_desc; mod_env; mod_attributes}
+
+let module_binding sub x =
+ let mb_loc = sub.location sub x.mb_loc in
+ let mb_name = map_loc sub x.mb_name in
+ let mb_expr = sub.module_expr sub x.mb_expr in
+ let mb_attributes = sub.attributes sub x.mb_attributes in
+ {x with mb_loc; mb_name; mb_expr; mb_attributes}
+
+let class_expr sub x =
+ let cl_loc = sub.location sub x.cl_loc in
+ let cl_env = sub.env sub x.cl_env in
+ let cl_desc =
+ match x.cl_desc with
+ | Tcl_constraint (cl, clty, vals, meths, concrs) ->
+ Tcl_constraint (
+ sub.class_expr sub cl,
+ Option.map (sub.class_type sub) clty,
+ vals,
+ meths,
+ concrs
+ )
+ | Tcl_structure clstr ->
+ Tcl_structure (sub.class_structure sub clstr)
+ | Tcl_fun (label, pat, priv, cl, partial) ->
+ Tcl_fun (
+ label,
+ sub.pat sub pat,
+ List.map (tuple2 id (sub.expr sub)) priv,
+ sub.class_expr sub cl,
+ partial
+ )
+ | Tcl_apply (cl, args) ->
+ Tcl_apply (
+ sub.class_expr sub cl,
+ List.map (tuple2 id (Option.map (sub.expr sub))) args
+ )
+ | Tcl_let (rec_flag, value_bindings, ivars, cl) ->
+ let (rec_flag, value_bindings) =
+ sub.value_bindings sub (rec_flag, value_bindings)
+ in
+ Tcl_let (
+ rec_flag,
+ value_bindings,
+ List.map (tuple2 id (sub.expr sub)) ivars,
+ sub.class_expr sub cl
+ )
+ | Tcl_ident (path, lid, tyl) ->
+ Tcl_ident (path, map_loc sub lid, List.map (sub.typ sub) tyl)
+ | Tcl_open (od, e) ->
+ Tcl_open (sub.open_description sub od, sub.class_expr sub e)
+ in
+ let cl_attributes = sub.attributes sub x.cl_attributes in
+ {x with cl_loc; cl_desc; cl_env; cl_attributes}
+
+let class_type sub x =
+ let cltyp_loc = sub.location sub x.cltyp_loc in
+ let cltyp_env = sub.env sub x.cltyp_env in
+ let cltyp_desc =
+ match x.cltyp_desc with
+ | Tcty_signature csg -> Tcty_signature (sub.class_signature sub csg)
+ | Tcty_constr (path, lid, list) ->
+ Tcty_constr (
+ path,
+ map_loc sub lid,
+ List.map (sub.typ sub) list
+ )
+ | Tcty_arrow (label, ct, cl) ->
+ Tcty_arrow
+ (label,
+ sub.typ sub ct,
+ sub.class_type sub cl
+ )
+ | Tcty_open (od, e) ->
+ Tcty_open (sub.open_description sub od, sub.class_type sub e)
+ in
+ let cltyp_attributes = sub.attributes sub x.cltyp_attributes in
+ {x with cltyp_loc; cltyp_desc; cltyp_env; cltyp_attributes}
+
+let class_signature sub x =
+ let csig_self = sub.typ sub x.csig_self in
+ let csig_fields = List.map (sub.class_type_field sub) x.csig_fields in
+ {x with csig_self; csig_fields}
+
+let class_type_field sub x =
+ let ctf_loc = sub.location sub x.ctf_loc in
+ let ctf_desc =
+ match x.ctf_desc with
+ | Tctf_inherit ct ->
+ Tctf_inherit (sub.class_type sub ct)
+ | Tctf_val (s, mut, virt, ct) ->
+ Tctf_val (s, mut, virt, sub.typ sub ct)
+ | Tctf_method (s, priv, virt, ct) ->
+ Tctf_method (s, priv, virt, sub.typ sub ct)
+ | Tctf_constraint (ct1, ct2) ->
+ Tctf_constraint (sub.typ sub ct1, sub.typ sub ct2)
+ | Tctf_attribute attr ->
+ Tctf_attribute (sub.attribute sub attr)
+ in
+ let ctf_attributes = sub.attributes sub x.ctf_attributes in
+ {ctf_loc; ctf_desc; ctf_attributes}
+
+let typ sub x =
+ let ctyp_loc = sub.location sub x.ctyp_loc in
+ let ctyp_env = sub.env sub x.ctyp_env in
+ let ctyp_desc =
+ match x.ctyp_desc with
+ | Ttyp_any
+ | Ttyp_var _ as d -> d
+ | Ttyp_arrow (label, ct1, ct2) ->
+ Ttyp_arrow (label, sub.typ sub ct1, sub.typ sub ct2)
+ | Ttyp_tuple list -> Ttyp_tuple (List.map (sub.typ sub) list)
+ | Ttyp_constr (path, lid, list) ->
+ Ttyp_constr (path, map_loc sub lid, List.map (sub.typ sub) list)
+ | Ttyp_object (list, closed) ->
+ Ttyp_object ((List.map (sub.object_field sub) list), closed)
+ | Ttyp_class (path, lid, list) ->
+ Ttyp_class
+ (path,
+ map_loc sub lid,
+ List.map (sub.typ sub) list
+ )
+ | Ttyp_alias (ct, s) ->
+ Ttyp_alias (sub.typ sub ct, s)
+ | Ttyp_variant (list, closed, labels) ->
+ Ttyp_variant (List.map (sub.row_field sub) list, closed, labels)
+ | Ttyp_poly (sl, ct) ->
+ Ttyp_poly (sl, sub.typ sub ct)
+ | Ttyp_package pack ->
+ Ttyp_package (sub.package_type sub pack)
+ | Ttyp_open (path, mod_ident, t) ->
+ Ttyp_open (path, map_loc sub mod_ident, sub.typ sub t)
+ in
+ let ctyp_attributes = sub.attributes sub x.ctyp_attributes in
+ {x with ctyp_loc; ctyp_desc; ctyp_env; ctyp_attributes}
+
+let class_structure sub x =
+ let cstr_self = sub.pat sub x.cstr_self in
+ let cstr_fields = List.map (sub.class_field sub) x.cstr_fields in
+ {x with cstr_self; cstr_fields}
+
+let row_field sub x =
+ let rf_loc = sub.location sub x.rf_loc in
+ let rf_desc = match x.rf_desc with
+ | Ttag (label, b, list) ->
+ Ttag (map_loc sub label, b, List.map (sub.typ sub) list)
+ | Tinherit ct -> Tinherit (sub.typ sub ct)
+ in
+ let rf_attributes = sub.attributes sub x.rf_attributes in
+ {rf_loc; rf_desc; rf_attributes}
+
+let object_field sub x =
+ let of_loc = sub.location sub x.of_loc in
+ let of_desc = match x.of_desc with
+ | OTtag (label, ct) ->
+ OTtag (map_loc sub label, (sub.typ sub ct))
+ | OTinherit ct -> OTinherit (sub.typ sub ct)
+ in
+ let of_attributes = sub.attributes sub x.of_attributes in
+ {of_loc; of_desc; of_attributes}
+
+let class_field_kind sub = function
+ | Tcfk_virtual ct -> Tcfk_virtual (sub.typ sub ct)
+ | Tcfk_concrete (ovf, e) -> Tcfk_concrete (ovf, sub.expr sub e)
+
+let class_field sub x =
+ let cf_loc = sub.location sub x.cf_loc in
+ let cf_desc =
+ match x.cf_desc with
+ | Tcf_inherit (ovf, cl, super, vals, meths) ->
+ Tcf_inherit (ovf, sub.class_expr sub cl, super, vals, meths)
+ | Tcf_constraint (cty, cty') ->
+ Tcf_constraint (
+ sub.typ sub cty,
+ sub.typ sub cty'
+ )
+ | Tcf_val (s, mf, id, k, b) ->
+ Tcf_val (map_loc sub s, mf, id, class_field_kind sub k, b)
+ | Tcf_method (s, priv, k) ->
+ Tcf_method (map_loc sub s, priv, class_field_kind sub k)
+ | Tcf_initializer exp ->
+ Tcf_initializer (sub.expr sub exp)
+ | Tcf_attribute attr ->
+ Tcf_attribute (sub.attribute sub attr)
+ in
+ let cf_attributes = sub.attributes sub x.cf_attributes in
+ {cf_loc; cf_desc; cf_attributes}
+
+let value_bindings sub (rec_flag, list) =
+ (rec_flag, List.map (sub.value_binding sub) list)
+
+let case
+ : type k . mapper -> k case -> k case
+ = fun sub {c_lhs; c_guard; c_rhs; c_cont} ->
+ {
+ c_lhs = sub.pat sub c_lhs;
+ c_guard = Option.map (sub.expr sub) c_guard;
+ c_rhs = sub.expr sub c_rhs;
+ c_cont
+ }
+
+let value_binding sub x =
+ let vb_loc = sub.location sub x.vb_loc in
+ let vb_pat = sub.pat sub x.vb_pat in
+ let vb_expr = sub.expr sub x.vb_expr in
+ let vb_attributes = sub.attributes sub x.vb_attributes in
+ let vb_rec_kind = x.vb_rec_kind in
+ {vb_loc; vb_pat; vb_expr; vb_attributes; vb_rec_kind}
+
+let env _sub x = x
+
+let default =
+ {
+ attribute;
+ attributes;
+ binding_op;
+ case;
+ class_declaration;
+ class_description;
+ class_expr;
+ class_field;
+ class_signature;
+ class_structure;
+ class_type;
+ class_type_declaration;
+ class_type_field;
+ env;
+ expr;
+ extension_constructor;
+ location;
+ module_binding;
+ module_coercion;
+ module_declaration;
+ module_substitution;
+ module_expr;
+ module_type;
+ module_type_declaration;
+ package_type;
+ pat;
+ row_field;
+ object_field;
+ open_declaration;
+ open_description;
+ signature;
+ signature_item;
+ structure;
+ structure_item;
+ typ;
+ type_declaration;
+ type_declarations;
+ type_extension;
+ type_exception;
+ type_kind;
+ value_binding;
+ value_bindings;
+ value_description;
+ with_constraint;
+ }
diff --git a/upstream/ocaml_503/typing/tast_mapper.mli b/upstream/ocaml_503/typing/tast_mapper.mli
new file mode 100644
index 0000000000..f54cef2b06
--- /dev/null
+++ b/upstream/ocaml_503/typing/tast_mapper.mli
@@ -0,0 +1,75 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Alain Frisch, LexiFi *)
+(* *)
+(* Copyright 2015 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+
+(** {1 A generic Typedtree mapper} *)
+
+type mapper =
+ {
+ attribute : mapper -> attribute -> attribute;
+ attributes : mapper -> attributes -> attributes;
+ binding_op: mapper -> binding_op -> binding_op;
+ case: 'k . mapper -> 'k case -> 'k case;
+ class_declaration: mapper -> class_declaration -> class_declaration;
+ class_description: mapper -> class_description -> class_description;
+ class_expr: mapper -> class_expr -> class_expr;
+ class_field: mapper -> class_field -> class_field;
+ class_signature: mapper -> class_signature -> class_signature;
+ class_structure: mapper -> class_structure -> class_structure;
+ class_type: mapper -> class_type -> class_type;
+ class_type_declaration: mapper -> class_type_declaration ->
+ class_type_declaration;
+ class_type_field: mapper -> class_type_field -> class_type_field;
+ env: mapper -> Env.t -> Env.t;
+ expr: mapper -> expression -> expression;
+ extension_constructor: mapper -> extension_constructor ->
+ extension_constructor;
+ location: mapper -> Location.t -> Location.t;
+ module_binding: mapper -> module_binding -> module_binding;
+ module_coercion: mapper -> module_coercion -> module_coercion;
+ module_declaration: mapper -> module_declaration -> module_declaration;
+ module_substitution: mapper -> module_substitution -> module_substitution;
+ module_expr: mapper -> module_expr -> module_expr;
+ module_type: mapper -> module_type -> module_type;
+ module_type_declaration:
+ mapper -> module_type_declaration -> module_type_declaration;
+ package_type: mapper -> package_type -> package_type;
+ pat: 'k . mapper -> 'k general_pattern -> 'k general_pattern;
+ row_field: mapper -> row_field -> row_field;
+ object_field: mapper -> object_field -> object_field;
+ open_declaration: mapper -> open_declaration -> open_declaration;
+ open_description: mapper -> open_description -> open_description;
+ signature: mapper -> signature -> signature;
+ signature_item: mapper -> signature_item -> signature_item;
+ structure: mapper -> structure -> structure;
+ structure_item: mapper -> structure_item -> structure_item;
+ typ: mapper -> core_type -> core_type;
+ type_declaration: mapper -> type_declaration -> type_declaration;
+ type_declarations: mapper -> (rec_flag * type_declaration list)
+ -> (rec_flag * type_declaration list);
+ type_extension: mapper -> type_extension -> type_extension;
+ type_exception: mapper -> type_exception -> type_exception;
+ type_kind: mapper -> type_kind -> type_kind;
+ value_binding: mapper -> value_binding -> value_binding;
+ value_bindings: mapper -> (rec_flag * value_binding list) ->
+ (rec_flag * value_binding list);
+ value_description: mapper -> value_description -> value_description;
+ with_constraint: mapper -> with_constraint -> with_constraint;
+ }
+
+
+val default: mapper
diff --git a/upstream/ocaml_503/typing/type_immediacy.ml b/upstream/ocaml_503/typing/type_immediacy.ml
new file mode 100644
index 0000000000..557ed4271a
--- /dev/null
+++ b/upstream/ocaml_503/typing/type_immediacy.ml
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2019 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+type t =
+ | Unknown
+ | Always
+ | Always_on_64bits
+
+module Violation = struct
+ type t =
+ | Not_always_immediate
+ | Not_always_immediate_on_64bits
+end
+
+let coerce t ~as_ =
+ match t, as_ with
+ | _, Unknown
+ | Always, Always
+ | (Always | Always_on_64bits), Always_on_64bits -> Ok ()
+ | (Unknown | Always_on_64bits), Always ->
+ Error Violation.Not_always_immediate
+ | Unknown, Always_on_64bits ->
+ Error Violation.Not_always_immediate_on_64bits
+
+let of_attributes attrs =
+ match
+ Builtin_attributes.immediate attrs,
+ Builtin_attributes.immediate64 attrs
+ with
+ | true, _ -> Always
+ | false, true -> Always_on_64bits
+ | false, false -> Unknown
diff --git a/upstream/ocaml_503/typing/type_immediacy.mli b/upstream/ocaml_503/typing/type_immediacy.mli
new file mode 100644
index 0000000000..3fc2e3b4f9
--- /dev/null
+++ b/upstream/ocaml_503/typing/type_immediacy.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2019 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Immediacy status of a type *)
+
+type t =
+ | Unknown
+ (** We don't know anything *)
+ | Always
+ (** We know for sure that values of this type are always immediate *)
+ | Always_on_64bits
+ (** We know for sure that values of this type are always immediate
+ on 64 bit platforms. For other platforms, we know nothing. *)
+
+module Violation : sig
+ type t =
+ | Not_always_immediate
+ | Not_always_immediate_on_64bits
+end
+
+(** [coerce t ~as_] returns [Ok ()] iff [t] can be seen as type
+ immediacy [as_]. For instance, [Always] can be seen as
+ [Always_on_64bits] but the opposite is not true. Return [Error _]
+ if the coercion is not possible. *)
+val coerce : t -> as_:t -> (unit, Violation.t) result
+
+(** Return the immediateness of a type as indicated by the user via
+ attributes *)
+val of_attributes : Parsetree.attributes -> t
diff --git a/upstream/ocaml_503/typing/typeclass.ml b/upstream/ocaml_503/typing/typeclass.ml
new file mode 100644
index 0000000000..043b9e908d
--- /dev/null
+++ b/upstream/ocaml_503/typing/typeclass.ml
@@ -0,0 +1,2197 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jerome Vouillon, 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. *)
+(* *)
+(**************************************************************************)
+
+open Parsetree
+open Asttypes
+open Path
+open Types
+open Typecore
+open Typetexp
+
+
+type 'a class_info = {
+ cls_id : Ident.t;
+ cls_id_loc : string loc;
+ cls_decl : class_declaration;
+ cls_ty_id : Ident.t;
+ cls_ty_decl : class_type_declaration;
+ cls_obj_id : Ident.t;
+ cls_obj_abbr : type_declaration;
+ cls_abbr : type_declaration;
+ cls_arity : int;
+ cls_pub_methods : string list;
+ cls_info : 'a;
+}
+
+type class_type_info = {
+ clsty_ty_id : Ident.t;
+ clsty_id_loc : string loc;
+ clsty_ty_decl : class_type_declaration;
+ clsty_obj_id : Ident.t;
+ clsty_obj_abbr : type_declaration;
+ clsty_abbr : type_declaration;
+ clsty_info : Typedtree.class_type_declaration;
+}
+
+type 'a full_class = {
+ id : Ident.t;
+ id_loc : string loc;
+ clty: class_declaration;
+ ty_id: Ident.t;
+ cltydef: class_type_declaration;
+ obj_id: Ident.t;
+ obj_abbr: type_declaration;
+ arity: int;
+ pub_meths: string list;
+ coe: Warnings.loc list;
+ req: 'a Typedtree.class_infos;
+}
+
+type kind =
+ | Object
+ | Class
+ | Class_type
+
+type final =
+ | Final
+ | Not_final
+
+let kind_of_final = function
+ | Final -> Object
+ | Not_final -> Class
+
+type error =
+ | Unconsistent_constraint of Errortrace.unification_error
+ | Field_type_mismatch of string * string * Errortrace.unification_error
+ | Unexpected_field of type_expr * string
+ | Structure_expected of class_type
+ | Cannot_apply of class_type
+ | Apply_wrong_label of arg_label
+ | Pattern_type_clash of type_expr
+ | Repeated_parameter
+ | Unbound_class_2 of Longident.t
+ | Unbound_class_type_2 of Longident.t
+ | Abbrev_type_clash of type_expr * type_expr * type_expr
+ | Constructor_type_mismatch of string * Errortrace.unification_error
+ | Virtual_class of kind * string list * string list
+ | Undeclared_methods of kind * string list
+ | Parameter_arity_mismatch of Longident.t * int * int
+ | Parameter_mismatch of Errortrace.unification_error
+ | Bad_parameters of Ident.t * type_expr list * type_expr list
+ | Bad_class_type_parameters of Ident.t * type_expr list * type_expr list
+ | Class_match_failure of Ctype.class_match_failure list
+ | Unbound_val of string
+ | Unbound_type_var of Format_doc.t * Ctype.closed_class_failure
+ | Non_generalizable_class of
+ { id : Ident.t
+ ; clty : Types.class_declaration
+ ; nongen_vars : type_expr list
+ }
+ | Cannot_coerce_self of type_expr
+ | Non_collapsable_conjunction of
+ Ident.t * Types.class_declaration * Errortrace.unification_error
+ | Self_clash of Errortrace.unification_error
+ | Mutability_mismatch of string * mutable_flag
+ | No_overriding of string * string
+ | Duplicate of string * string
+ | Closing_self_type of class_signature
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+open Typedtree
+
+let type_open_descr :
+ (?used_slot:bool ref -> Env.t -> Parsetree.open_description
+ -> open_description * Env.t) ref =
+ ref (fun ?used_slot:_ _ -> assert false)
+
+let ctyp desc typ env loc =
+ { ctyp_desc = desc; ctyp_type = typ; ctyp_loc = loc; ctyp_env = env;
+ ctyp_attributes = [] }
+
+(*
+ Path associated to the temporary class type of a class being typed
+ (its constructor is not available).
+*)
+let unbound_class =
+ Path.Pident (Ident.create_local "*undef*")
+
+
+ (************************************)
+ (* Some operations on class types *)
+ (************************************)
+
+let extract_constraints cty =
+ let sign = Btype.signature_of_class_type cty in
+ (Btype.instance_vars sign,
+ Btype.methods sign,
+ Btype.concrete_methods sign)
+
+(* Record a class type *)
+let rc node =
+ Cmt_format.add_saved_type (Cmt_format.Partial_class_expr node);
+ node
+
+let update_class_signature loc env ~warn_implicit_public virt kind sign =
+ let implicit_public, implicit_declared =
+ Ctype.update_class_signature env sign
+ in
+ if implicit_declared <> [] then begin
+ match virt with
+ | Virtual -> () (* Should perhaps emit warning 17 here *)
+ | Concrete ->
+ raise (Error(loc, env, Undeclared_methods(kind, implicit_declared)))
+ end;
+ if warn_implicit_public && implicit_public <> [] then begin
+ Location.prerr_warning
+ loc (Warnings.Implicit_public_methods implicit_public)
+ end
+
+let complete_class_signature loc env virt kind sign =
+ update_class_signature loc env ~warn_implicit_public:false virt kind sign;
+ Ctype.hide_private_methods env sign
+
+let complete_class_type loc env virt kind typ =
+ let sign = Btype.signature_of_class_type typ in
+ complete_class_signature loc env virt kind sign
+
+let check_virtual loc env virt kind sign =
+ match virt with
+ | Virtual -> ()
+ | Concrete ->
+ match Btype.virtual_methods sign, Btype.virtual_instance_vars sign with
+ | [], [] -> ()
+ | meths, vars ->
+ raise(Error(loc, env, Virtual_class(kind, meths, vars)))
+
+let rec check_virtual_clty loc env virt kind clty =
+ match clty with
+ | Cty_constr(_, _, clty) | Cty_arrow(_, _, clty) ->
+ check_virtual_clty loc env virt kind clty
+ | Cty_signature sign ->
+ check_virtual loc env virt kind sign
+
+(* Return the constructor type associated to a class type *)
+let rec constructor_type constr cty =
+ match cty with
+ Cty_constr (_, _, cty) ->
+ constructor_type constr cty
+ | Cty_signature _ ->
+ constr
+ | Cty_arrow (l, ty, cty) ->
+ Ctype.newty (Tarrow (l, ty, constructor_type constr cty, commu_ok))
+
+ (***********************************)
+ (* Primitives for typing classes *)
+ (***********************************)
+
+let raise_add_method_failure loc env label sign failure =
+ match (failure : Ctype.add_method_failure) with
+ | Ctype.Unexpected_method ->
+ raise(Error(loc, env, Unexpected_field (sign.Types.csig_self, label)))
+ | Ctype.Type_mismatch trace ->
+ raise(Error(loc, env, Field_type_mismatch ("method", label, trace)))
+
+let raise_add_instance_variable_failure loc env label failure =
+ match (failure : Ctype.add_instance_variable_failure) with
+ | Ctype.Mutability_mismatch mut ->
+ raise (Error(loc, env, Mutability_mismatch(label, mut)))
+ | Ctype.Type_mismatch trace ->
+ raise (Error(loc, env,
+ Field_type_mismatch("instance variable", label, trace)))
+
+let raise_inherit_class_signature_failure loc env sign = function
+ | Ctype.Self_type_mismatch trace ->
+ raise(Error(loc, env, Self_clash trace))
+ | Ctype.Method(label, failure) ->
+ raise_add_method_failure loc env label sign failure
+ | Ctype.Instance_variable(label, failure) ->
+ raise_add_instance_variable_failure loc env label failure
+
+let add_method loc env label priv virt ty sign =
+ match Ctype.add_method env label priv virt ty sign with
+ | () -> ()
+ | exception Ctype.Add_method_failed failure ->
+ raise_add_method_failure loc env label sign failure
+
+let add_instance_variable ~strict loc env label mut virt ty sign =
+ match Ctype.add_instance_variable ~strict env label mut virt ty sign with
+ | () -> ()
+ | exception Ctype.Add_instance_variable_failed failure ->
+ raise_add_instance_variable_failure loc env label failure
+
+let inherit_class_signature ~strict loc env sign1 sign2 =
+ match Ctype.inherit_class_signature ~strict env sign1 sign2 with
+ | () -> ()
+ | exception Ctype.Inherit_class_signature_failed failure ->
+ raise_inherit_class_signature_failure loc env sign1 failure
+
+let inherit_class_type ~strict loc env sign1 cty2 =
+ let sign2 =
+ match Btype.scrape_class_type cty2 with
+ | Cty_signature sign2 -> sign2
+ | _ ->
+ raise(Error(loc, env, Structure_expected cty2))
+ in
+ inherit_class_signature ~strict loc env sign1 sign2
+
+let unify_delayed_method_type loc env label ty expected_ty=
+ match Ctype.unify env ty expected_ty with
+ | () -> ()
+ | exception Ctype.Unify trace ->
+ raise(Error(loc, env, Field_type_mismatch ("method", label, trace)))
+
+let type_constraint val_env sty sty' loc =
+ let cty = transl_simple_type val_env ~closed:false sty in
+ let ty = cty.ctyp_type in
+ let cty' = transl_simple_type val_env ~closed:false sty' in
+ let ty' = cty'.ctyp_type in
+ begin
+ try Ctype.unify val_env ty ty' with Ctype.Unify err ->
+ raise(Error(loc, val_env, Unconsistent_constraint err));
+ end;
+ (cty, cty')
+
+let make_method loc cl_num expr =
+ let open Ast_helper in
+ let mkid s = mkloc s loc in
+ let pat =
+ Pat.alias ~loc (Pat.var ~loc (mkid "self-*")) (mkid ("self-" ^ cl_num))
+ in
+ Exp.function_ ~loc:expr.pexp_loc
+ [ { pparam_desc = Pparam_val (Nolabel, None, pat);
+ pparam_loc = pat.ppat_loc;
+ }
+ ]
+ None (Pfunction_body expr)
+
+(*******************************)
+
+let delayed_meth_specs = ref []
+
+let rec class_type_field env sign self_scope ctf =
+ let loc = ctf.pctf_loc in
+ let mkctf desc =
+ { ctf_desc = desc; ctf_loc = loc; ctf_attributes = ctf.pctf_attributes }
+ in
+ let mkctf_with_attrs f =
+ Builtin_attributes.warning_scope ctf.pctf_attributes
+ (fun () -> mkctf (f ()))
+ in
+ match ctf.pctf_desc with
+ | Pctf_inherit sparent ->
+ mkctf_with_attrs
+ (fun () ->
+ let parent = class_type env Virtual self_scope sparent in
+ complete_class_type parent.cltyp_loc
+ env Virtual Class_type parent.cltyp_type;
+ inherit_class_type ~strict:false loc env sign parent.cltyp_type;
+ Tctf_inherit parent)
+ | Pctf_val ({txt=lab}, mut, virt, sty) ->
+ mkctf_with_attrs
+ (fun () ->
+ let cty = transl_simple_type env ~closed:false sty in
+ let ty = cty.ctyp_type in
+ add_instance_variable ~strict:false loc env lab mut virt ty sign;
+ Tctf_val (lab, mut, virt, cty))
+
+ | Pctf_method ({txt=lab}, priv, virt, sty) ->
+ mkctf_with_attrs
+ (fun () ->
+ let sty = Ast_helper.Typ.force_poly sty in
+ match sty.ptyp_desc, priv with
+ | Ptyp_poly ([],sty'), Public ->
+ let expected_ty = Ctype.newvar () in
+ add_method loc env lab priv virt expected_ty sign;
+ let returned_cty = ctyp Ttyp_any (Ctype.newty Tnil) env loc in
+ delayed_meth_specs :=
+ Warnings.mk_lazy (fun () ->
+ let cty = transl_simple_type_univars env sty' in
+ let ty = cty.ctyp_type in
+ unify_delayed_method_type loc env lab ty expected_ty;
+ returned_cty.ctyp_desc <- Ttyp_poly ([], cty);
+ returned_cty.ctyp_type <- ty;
+ ) :: !delayed_meth_specs;
+ Tctf_method (lab, priv, virt, returned_cty)
+ | _ ->
+ let cty = transl_simple_type env ~closed:false sty in
+ let ty = cty.ctyp_type in
+ add_method loc env lab priv virt ty sign;
+ Tctf_method (lab, priv, virt, cty))
+
+ | Pctf_constraint (sty, sty') ->
+ mkctf_with_attrs
+ (fun () ->
+ let (cty, cty') = type_constraint env sty sty' ctf.pctf_loc in
+ Tctf_constraint (cty, cty'))
+
+ | Pctf_attribute x ->
+ Builtin_attributes.warning_attribute x;
+ mkctf (Tctf_attribute x)
+
+ | Pctf_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and class_signature virt env pcsig self_scope loc =
+ let {pcsig_self=sty; pcsig_fields=psign} = pcsig in
+ let sign = Ctype.new_class_signature () in
+ (* Introduce a dummy method preventing self type from being closed. *)
+ Ctype.add_dummy_method env ~scope:self_scope sign;
+
+ let self_cty = transl_simple_type env ~closed:false sty in
+ let self_type = self_cty.ctyp_type in
+ begin try
+ Ctype.unify env self_type sign.csig_self
+ with Ctype.Unify _ ->
+ raise(Error(sty.ptyp_loc, env, Pattern_type_clash self_type))
+ end;
+
+ (* Class type fields *)
+ let fields =
+ Builtin_attributes.warning_scope []
+ (fun () -> List.map (class_type_field env sign self_scope) psign)
+ in
+ check_virtual loc env virt Class_type sign;
+ { csig_self = self_cty;
+ csig_fields = fields;
+ csig_type = sign; }
+
+and class_type env virt self_scope scty =
+ Builtin_attributes.warning_scope scty.pcty_attributes
+ (fun () -> class_type_aux env virt self_scope scty)
+
+and class_type_aux env virt self_scope scty =
+ let cltyp desc typ =
+ {
+ cltyp_desc = desc;
+ cltyp_type = typ;
+ cltyp_loc = scty.pcty_loc;
+ cltyp_env = env;
+ cltyp_attributes = scty.pcty_attributes;
+ }
+ in
+ match scty.pcty_desc with
+ | Pcty_constr (lid, styl) ->
+ let (path, decl) = Env.lookup_cltype ~loc:scty.pcty_loc lid.txt env in
+ if Path.same decl.clty_path unbound_class then
+ raise(Error(scty.pcty_loc, env, Unbound_class_type_2 lid.txt));
+ let (params, clty) =
+ Ctype.instance_class decl.clty_params decl.clty_type
+ in
+ (* Adding a dummy method to the self type prevents it from being closed /
+ escaping. *)
+ Ctype.add_dummy_method env ~scope:self_scope
+ (Btype.signature_of_class_type clty);
+ if List.length params <> List.length styl then
+ raise(Error(scty.pcty_loc, env,
+ Parameter_arity_mismatch (lid.txt, List.length params,
+ List.length styl)));
+ let ctys = List.map2
+ (fun sty ty ->
+ let cty' = transl_simple_type env ~closed:false sty in
+ let ty' = cty'.ctyp_type in
+ begin
+ try Ctype.unify env ty' ty with Ctype.Unify err ->
+ raise(Error(sty.ptyp_loc, env, Parameter_mismatch err))
+ end;
+ cty'
+ ) styl params
+ in
+ let typ = Cty_constr (path, params, clty) in
+ (* Check for unexpected virtual methods *)
+ check_virtual_clty scty.pcty_loc env virt Class_type typ;
+ cltyp (Tcty_constr ( path, lid , ctys)) typ
+
+ | Pcty_signature pcsig ->
+ let clsig = class_signature virt env pcsig self_scope scty.pcty_loc in
+ let typ = Cty_signature clsig.csig_type in
+ cltyp (Tcty_signature clsig) typ
+
+ | Pcty_arrow (l, sty, scty) ->
+ let cty = transl_simple_type env ~closed:false sty in
+ let ty = cty.ctyp_type in
+ let ty =
+ if Btype.is_optional l
+ then Ctype.newty (Tconstr(Predef.path_option,[ty], ref Mnil))
+ else ty in
+ let clty = class_type env virt self_scope scty in
+ let typ = Cty_arrow (l, ty, clty.cltyp_type) in
+ cltyp (Tcty_arrow (l, cty, clty)) typ
+
+ | Pcty_open (od, e) ->
+ let (od, newenv) = !type_open_descr env od in
+ let clty = class_type newenv virt self_scope e in
+ cltyp (Tcty_open (od, clty)) clty.cltyp_type
+
+ | Pcty_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+let class_type env virt self_scope scty =
+ delayed_meth_specs := [];
+ let cty = class_type env virt self_scope scty in
+ List.iter Lazy.force (List.rev !delayed_meth_specs);
+ delayed_meth_specs := [];
+ cty
+
+(*******************************)
+
+let enter_ancestor_val name val_env =
+ Env.enter_unbound_value name Val_unbound_ancestor val_env
+
+let enter_self_val name val_env =
+ Env.enter_unbound_value name Val_unbound_self val_env
+
+let enter_instance_var_val name val_env =
+ Env.enter_unbound_value name Val_unbound_instance_variable val_env
+
+let enter_ancestor_met ~loc name ~sign ~meths ~cl_num ~ty ~attrs met_env =
+ let check s = Warnings.Unused_ancestor s in
+ let kind = Val_anc (sign, meths, cl_num) in
+ let desc =
+ { val_type = ty; val_kind = kind;
+ val_attributes = attrs;
+ Types.val_loc = loc;
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
+ in
+ Env.enter_value ~check name desc met_env
+
+let add_self_met loc id sign self_var_kind vars cl_num
+ as_var ty attrs met_env =
+ let check =
+ if as_var then (fun s -> Warnings.Unused_var s)
+ else (fun s -> Warnings.Unused_var_strict s)
+ in
+ let kind = Val_self (sign, self_var_kind, vars, cl_num) in
+ let desc =
+ { val_type = ty; val_kind = kind;
+ val_attributes = attrs;
+ Types.val_loc = loc;
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
+ in
+ Env.add_value ~check id desc met_env
+
+let add_instance_var_met loc label id sign cl_num attrs met_env =
+ let mut, ty =
+ match Vars.find label sign.csig_vars with
+ | (mut, _, ty) -> mut, ty
+ | exception Not_found -> assert false
+ in
+ let kind = Val_ivar (mut, cl_num) in
+ let desc =
+ { val_type = ty; val_kind = kind;
+ val_attributes = attrs;
+ Types.val_loc = loc;
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
+ in
+ Env.add_value id desc met_env
+
+let add_instance_vars_met loc vars sign cl_num met_env =
+ List.fold_left
+ (fun met_env (label, id) ->
+ add_instance_var_met loc label id sign cl_num [] met_env)
+ met_env vars
+
+type intermediate_class_field =
+ | Inherit of
+ { override : override_flag;
+ parent : class_expr;
+ super : string option;
+ inherited_vars : (string * Ident.t) list;
+ super_meths : (string * Ident.t) list;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Virtual_val of
+ { label : string loc;
+ mut : mutable_flag;
+ id : Ident.t;
+ cty : core_type;
+ already_declared : bool;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Concrete_val of
+ { label : string loc;
+ mut : mutable_flag;
+ id : Ident.t;
+ override : override_flag;
+ definition : expression;
+ already_declared : bool;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Virtual_method of
+ { label : string loc;
+ priv : private_flag;
+ cty : core_type;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Concrete_method of
+ { label : string loc;
+ priv : private_flag;
+ override : override_flag;
+ sdefinition : Parsetree.expression;
+ warning_state : Warnings.state;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Constraint of
+ { cty1 : core_type;
+ cty2 : core_type;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Initializer of
+ { sexpr : Parsetree.expression;
+ warning_state : Warnings.state;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Attribute of
+ { attribute : attribute;
+ loc : Location.t;
+ attributes : attribute list; }
+
+type first_pass_accummulater =
+ { rev_fields : intermediate_class_field list;
+ val_env : Env.t;
+ par_env : Env.t;
+ concrete_meths : MethSet.t;
+ concrete_vals : VarSet.t;
+ local_meths : MethSet.t;
+ local_vals : VarSet.t;
+ vars : Ident.t Vars.t; }
+
+let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
+ let { rev_fields; val_env; par_env; concrete_meths; concrete_vals;
+ local_meths; local_vals; vars } = acc
+ in
+ let loc = cf.pcf_loc in
+ let attributes = cf.pcf_attributes in
+ let with_attrs f = Builtin_attributes.warning_scope attributes f in
+ match cf.pcf_desc with
+ | Pcf_inherit (override, sparent, super) ->
+ with_attrs
+ (fun () ->
+ let parent =
+ class_expr cl_num val_env par_env
+ Virtual self_scope sparent
+ in
+ complete_class_type parent.cl_loc
+ par_env Virtual Class parent.cl_type;
+ inherit_class_type ~strict:true loc val_env sign parent.cl_type;
+ let parent_sign = Btype.signature_of_class_type parent.cl_type in
+ let new_concrete_meths = Btype.concrete_methods parent_sign in
+ let new_concrete_vals = Btype.concrete_instance_vars parent_sign in
+ let over_meths = MethSet.inter new_concrete_meths concrete_meths in
+ let over_vals = VarSet.inter new_concrete_vals concrete_vals in
+ begin match override with
+ | Fresh ->
+ let cname =
+ match parent.cl_type with
+ | Cty_constr (p, _, _) -> Path.name p
+ | _ -> "inherited"
+ in
+ if not (MethSet.is_empty over_meths) then
+ Location.prerr_warning loc
+ (Warnings.Method_override
+ (cname :: MethSet.elements over_meths));
+ if not (VarSet.is_empty over_vals) then
+ Location.prerr_warning loc
+ (Warnings.Instance_variable_override
+ (cname :: VarSet.elements over_vals));
+ | Override ->
+ if MethSet.is_empty over_meths && VarSet.is_empty over_vals then
+ raise (Error(loc, val_env, No_overriding ("","")))
+ end;
+ let concrete_vals = VarSet.union new_concrete_vals concrete_vals in
+ let concrete_meths =
+ MethSet.union new_concrete_meths concrete_meths
+ in
+ let val_env, par_env, inherited_vars, vars =
+ Vars.fold
+ (fun label _ (val_env, par_env, inherited_vars, vars) ->
+ let val_env = enter_instance_var_val label val_env in
+ let par_env = enter_instance_var_val label par_env in
+ let id = Ident.create_local label in
+ let inherited_vars = (label, id) :: inherited_vars in
+ let vars = Vars.add label id vars in
+ (val_env, par_env, inherited_vars, vars))
+ parent_sign.csig_vars (val_env, par_env, [], vars)
+ in
+ (* Methods available through super *)
+ let super_meths =
+ MethSet.fold
+ (fun label acc -> (label, Ident.create_local label) :: acc)
+ new_concrete_meths []
+ in
+ (* Super *)
+ let (val_env, par_env, super) =
+ match super with
+ | None -> (val_env, par_env, None)
+ | Some {txt=name} ->
+ let val_env = enter_ancestor_val name val_env in
+ let par_env = enter_ancestor_val name par_env in
+ (val_env, par_env, Some name)
+ in
+ let field =
+ Inherit
+ { override; parent; super; inherited_vars;
+ super_meths; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields; val_env; par_env;
+ concrete_meths; concrete_vals; vars })
+ | Pcf_val (label, mut, Cfk_virtual styp) ->
+ with_attrs
+ (fun () ->
+ let cty =
+ Ctype.with_local_level_generalize_structure_if_principal
+ (fun () -> Typetexp.transl_simple_type val_env
+ ~closed:false styp)
+ in
+ add_instance_variable ~strict:true loc val_env
+ label.txt mut Virtual cty.ctyp_type sign;
+ let already_declared, val_env, par_env, id, vars =
+ match Vars.find label.txt vars with
+ | id -> true, val_env, par_env, id, vars
+ | exception Not_found ->
+ let name = label.txt in
+ let val_env = enter_instance_var_val name val_env in
+ let par_env = enter_instance_var_val name par_env in
+ let id = Ident.create_local name in
+ let vars = Vars.add label.txt id vars in
+ false, val_env, par_env, id, vars
+ in
+ let field =
+ Virtual_val
+ { label; mut; id; cty; already_declared; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields; val_env; par_env; vars })
+ | Pcf_val (label, mut, Cfk_concrete (override, sdefinition)) ->
+ with_attrs
+ (fun () ->
+ if VarSet.mem label.txt local_vals then
+ raise(Error(loc, val_env,
+ Duplicate ("instance variable", label.txt)));
+ if VarSet.mem label.txt concrete_vals then begin
+ if override = Fresh then
+ Location.prerr_warning label.loc
+ (Warnings.Instance_variable_override[label.txt])
+ end else begin
+ if override = Override then
+ raise(Error(loc, val_env,
+ No_overriding ("instance variable", label.txt)))
+ end;
+ let definition =
+ Ctype.with_local_level_generalize_structure_if_principal
+ (fun () -> type_exp val_env sdefinition)
+ in
+ add_instance_variable ~strict:true loc val_env
+ label.txt mut Concrete definition.exp_type sign;
+ let already_declared, val_env, par_env, id, vars =
+ match Vars.find label.txt vars with
+ | id -> true, val_env, par_env, id, vars
+ | exception Not_found ->
+ let name = label.txt in
+ let val_env = enter_instance_var_val name val_env in
+ let par_env = enter_instance_var_val name par_env in
+ let id = Ident.create_local name in
+ let vars = Vars.add label.txt id vars in
+ false, val_env, par_env, id, vars
+ in
+ let field =
+ Concrete_val
+ { label; mut; id; override; definition;
+ already_declared; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ let concrete_vals = VarSet.add label.txt concrete_vals in
+ let local_vals = VarSet.add label.txt local_vals in
+ { acc with rev_fields; val_env; par_env;
+ concrete_vals; local_vals; vars })
+
+ | Pcf_method (label, priv, Cfk_virtual sty) ->
+ with_attrs
+ (fun () ->
+ let sty = Ast_helper.Typ.force_poly sty in
+ let cty = transl_simple_type val_env ~closed:false sty in
+ let ty = cty.ctyp_type in
+ add_method loc val_env label.txt priv Virtual ty sign;
+ let field =
+ Virtual_method { label; priv; cty; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields })
+
+ | Pcf_method (label, priv, Cfk_concrete (override, expr)) ->
+ with_attrs
+ (fun () ->
+ if MethSet.mem label.txt local_meths then
+ raise(Error(loc, val_env, Duplicate ("method", label.txt)));
+ if MethSet.mem label.txt concrete_meths then begin
+ if override = Fresh then begin
+ Location.prerr_warning loc
+ (Warnings.Method_override [label.txt])
+ end
+ end else begin
+ if override = Override then begin
+ raise(Error(loc, val_env, No_overriding("method", label.txt)))
+ end
+ end;
+ let expr =
+ match expr.pexp_desc with
+ | Pexp_poly _ -> expr
+ | _ -> Ast_helper.Exp.poly ~loc:expr.pexp_loc expr None
+ in
+ let sbody, sty =
+ match expr.pexp_desc with
+ | Pexp_poly (sbody, sty) -> sbody, sty
+ | _ -> assert false
+ in
+ let ty =
+ match sty with
+ | None -> Ctype.newvar ()
+ | Some sty ->
+ let sty = Ast_helper.Typ.force_poly sty in
+ let cty' =
+ Typetexp.transl_simple_type val_env ~closed:false sty
+ in
+ cty'.ctyp_type
+ in
+ add_method loc val_env label.txt priv Concrete ty sign;
+ begin
+ try
+ match get_desc ty with
+ | Tvar _ ->
+ let ty' = Ctype.newvar () in
+ Ctype.unify val_env (Ctype.newty (Tpoly (ty', []))) ty;
+ Ctype.unify val_env (type_approx val_env sbody) ty'
+ | Tpoly (ty1, tl) ->
+ let _, ty1' = Ctype.instance_poly ~fixed:false tl ty1 in
+ let ty2 = type_approx val_env sbody in
+ Ctype.unify val_env ty2 ty1'
+ | _ -> assert false
+ with Ctype.Unify err ->
+ raise(Error(loc, val_env,
+ Field_type_mismatch ("method", label.txt, err)))
+ end;
+ let sdefinition = make_method self_loc cl_num expr in
+ let warning_state = Warnings.backup () in
+ let field =
+ Concrete_method
+ { label; priv; override; sdefinition;
+ warning_state; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ let concrete_meths = MethSet.add label.txt concrete_meths in
+ let local_meths = MethSet.add label.txt local_meths in
+ { acc with rev_fields; concrete_meths; local_meths })
+
+ | Pcf_constraint (sty1, sty2) ->
+ with_attrs
+ (fun () ->
+ let (cty1, cty2) = type_constraint val_env sty1 sty2 loc in
+ let field =
+ Constraint { cty1; cty2; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields })
+
+ | Pcf_initializer sexpr ->
+ with_attrs
+ (fun () ->
+ let sexpr = make_method self_loc cl_num sexpr in
+ let warning_state = Warnings.backup () in
+ let field =
+ Initializer { sexpr; warning_state; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields })
+ | Pcf_attribute attribute ->
+ Builtin_attributes.warning_attribute attribute;
+ let field = Attribute { attribute; loc; attributes } in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields }
+ | Pcf_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and class_fields_first_pass self_loc cl_num sign self_scope
+ val_env par_env cfs =
+ let rev_fields = [] in
+ let concrete_meths = MethSet.empty in
+ let concrete_vals = VarSet.empty in
+ let local_meths = MethSet.empty in
+ let local_vals = VarSet.empty in
+ let vars = Vars.empty in
+ let init_acc =
+ { rev_fields; val_env; par_env;
+ concrete_meths; concrete_vals;
+ local_meths; local_vals; vars }
+ in
+ let acc =
+ Builtin_attributes.warning_scope []
+ (fun () ->
+ List.fold_left
+ (class_field_first_pass self_loc cl_num sign self_scope)
+ init_acc cfs)
+ in
+ List.rev acc.rev_fields, acc.vars
+
+and class_field_second_pass cl_num sign met_env field =
+ let mkcf desc loc attrs =
+ { cf_desc = desc; cf_loc = loc; cf_attributes = attrs }
+ in
+ match field with
+ | Inherit { override; parent; super;
+ inherited_vars; super_meths; loc; attributes } ->
+ let met_env =
+ add_instance_vars_met loc inherited_vars sign cl_num met_env
+ in
+ let met_env =
+ match super with
+ | None -> met_env
+ | Some name ->
+ let meths =
+ List.fold_left
+ (fun acc (label, id) -> Meths.add label id acc)
+ Meths.empty super_meths
+ in
+ let ty = Btype.self_type parent.cl_type in
+ let attrs = [] in
+ let _id, met_env =
+ enter_ancestor_met ~loc name ~sign ~meths
+ ~cl_num ~ty ~attrs met_env
+ in
+ met_env
+ in
+ let desc =
+ Tcf_inherit(override, parent, super, inherited_vars, super_meths)
+ in
+ met_env, mkcf desc loc attributes
+ | Virtual_val { label; mut; id; cty; already_declared; loc; attributes } ->
+ let met_env =
+ if already_declared then met_env
+ else begin
+ add_instance_var_met loc label.txt id sign cl_num attributes met_env
+ end
+ in
+ let kind = Tcfk_virtual cty in
+ let desc = Tcf_val(label, mut, id, kind, already_declared) in
+ met_env, mkcf desc loc attributes
+ | Concrete_val { label; mut; id; override;
+ definition; already_declared; loc; attributes } ->
+ let met_env =
+ if already_declared then met_env
+ else begin
+ add_instance_var_met loc label.txt id sign cl_num attributes met_env
+ end
+ in
+ let kind = Tcfk_concrete(override, definition) in
+ let desc = Tcf_val(label, mut, id, kind, already_declared) in
+ met_env, mkcf desc loc attributes
+ | Virtual_method { label; priv; cty; loc; attributes } ->
+ let kind = Tcfk_virtual cty in
+ let desc = Tcf_method(label, priv, kind) in
+ met_env, mkcf desc loc attributes
+ | Concrete_method { label; priv; override;
+ sdefinition; warning_state; loc; attributes } ->
+ Warnings.with_state warning_state
+ (fun () ->
+ let ty = Btype.method_type label.txt sign in
+ let self_type = sign.Types.csig_self in
+ let meth_type =
+ mk_expected
+ (Btype.newgenty (Tarrow(Nolabel, self_type, ty, commu_ok)))
+ in
+ let texp =
+ Ctype.with_raised_nongen_level
+ (fun () -> type_expect met_env sdefinition meth_type) in
+ let kind = Tcfk_concrete (override, texp) in
+ let desc = Tcf_method(label, priv, kind) in
+ met_env, mkcf desc loc attributes)
+ | Constraint { cty1; cty2; loc; attributes } ->
+ let desc = Tcf_constraint(cty1, cty2) in
+ met_env, mkcf desc loc attributes
+ | Initializer { sexpr; warning_state; loc; attributes } ->
+ Warnings.with_state warning_state
+ (fun () ->
+ let unit_type = Ctype.instance Predef.type_unit in
+ let self_type = sign.Types.csig_self in
+ let meth_type =
+ mk_expected
+ (Ctype.newty (Tarrow (Nolabel, self_type, unit_type, commu_ok)))
+ in
+ let texp =
+ Ctype.with_raised_nongen_level
+ (fun () -> type_expect met_env sexpr meth_type) in
+ let desc = Tcf_initializer texp in
+ met_env, mkcf desc loc attributes)
+ | Attribute { attribute; loc; attributes; } ->
+ let desc = Tcf_attribute attribute in
+ met_env, mkcf desc loc attributes
+
+and class_fields_second_pass cl_num sign met_env fields =
+ let _, rev_cfs =
+ List.fold_left
+ (fun (met_env, cfs) field ->
+ let met_env, cf =
+ class_field_second_pass cl_num sign met_env field
+ in
+ met_env, cf :: cfs)
+ (met_env, []) fields
+ in
+ List.rev rev_cfs
+
+(* N.B. the self type of a final object type doesn't contain a dummy method in
+ the beginning.
+ We only explicitly add a dummy method to class definitions (and class (type)
+ declarations)), which are later removed (made absent) by [final_decl].
+
+ If we ever find a dummy method in a final object self type, it means that
+ somehow we've unified the self type of the object with the self type of a not
+ yet finished class.
+ When this happens, we cannot close the object type and must error. *)
+and class_structure cl_num virt self_scope final val_env met_env loc
+ { pcstr_self = spat; pcstr_fields = str } =
+ (* Environment for substructures *)
+ let par_env = met_env in
+
+ (* Location of self. Used for locations of self arguments *)
+ let self_loc = {spat.ppat_loc with Location.loc_ghost = true} in
+
+ let sign = Ctype.new_class_signature () in
+
+ (* Adding a dummy method to the signature prevents it from being closed /
+ escaping. That isn't needed for objects though. *)
+ begin match final with
+ | Not_final -> Ctype.add_dummy_method val_env ~scope:self_scope sign;
+ | Final -> ()
+ end;
+
+ (* Self binder *)
+ let (self_pat, self_pat_vars) = type_self_pattern val_env spat in
+ let val_env, par_env =
+ List.fold_right
+ (fun {pv_id; _} (val_env, par_env) ->
+ let name = Ident.name pv_id in
+ let val_env = enter_self_val name val_env in
+ let par_env = enter_self_val name par_env in
+ val_env, par_env)
+ self_pat_vars (val_env, par_env)
+ in
+
+ (* Check that the binder has a correct type *)
+ begin try Ctype.unify val_env self_pat.pat_type sign.csig_self with
+ Ctype.Unify _ ->
+ raise(Error(spat.ppat_loc, val_env,
+ Pattern_type_clash self_pat.pat_type))
+ end;
+
+ (* Typing of class fields *)
+ let (fields, vars) =
+ class_fields_first_pass self_loc cl_num sign self_scope
+ val_env par_env str
+ in
+ let kind = kind_of_final final in
+
+ (* Check for unexpected virtual methods *)
+ check_virtual loc val_env virt kind sign;
+
+ (* Update the class signature *)
+ update_class_signature loc val_env
+ ~warn_implicit_public:false virt kind sign;
+
+ let meths =
+ Meths.fold
+ (fun label _ meths ->
+ Meths.add label (Ident.create_local label) meths)
+ sign.csig_meths Meths.empty
+ in
+
+ (* Close the signature if it is final *)
+ begin match final with
+ | Not_final -> ()
+ | Final ->
+ if not (Ctype.close_class_signature val_env sign) then
+ raise(Error(loc, val_env, Closing_self_type sign));
+ end;
+ (* Typing of method bodies *)
+ Ctype.generalize_class_signature_spine sign;
+ let self_var_kind =
+ match virt with
+ | Virtual -> Self_virtual(ref meths)
+ | Concrete -> Self_concrete meths
+ in
+ let met_env =
+ List.fold_right
+ (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes} met_env ->
+ add_self_met pv_loc pv_id sign self_var_kind vars
+ cl_num (pv_kind=As_var) pv_type pv_attributes met_env)
+ self_pat_vars met_env
+ in
+ let fields =
+ class_fields_second_pass cl_num sign met_env fields
+ in
+
+ (* Update the class signature and warn about public methods made private *)
+ update_class_signature loc val_env
+ ~warn_implicit_public:true virt kind sign;
+
+ let meths =
+ match self_var_kind with
+ | Self_virtual meths_ref -> !meths_ref
+ | Self_concrete meths -> meths
+ in
+ { cstr_self = self_pat;
+ cstr_fields = fields;
+ cstr_type = sign;
+ cstr_meths = meths; }
+
+and class_expr cl_num val_env met_env virt self_scope scl =
+ Builtin_attributes.warning_scope scl.pcl_attributes
+ (fun () -> class_expr_aux cl_num val_env met_env virt self_scope scl)
+
+and class_expr_aux cl_num val_env met_env virt self_scope scl =
+ match scl.pcl_desc with
+ | Pcl_constr (lid, styl) ->
+ let (path, decl) = Env.lookup_class ~loc:scl.pcl_loc lid.txt val_env in
+ if Path.same decl.cty_path unbound_class then
+ raise(Error(scl.pcl_loc, val_env, Unbound_class_2 lid.txt));
+ let tyl = List.map
+ (fun sty -> transl_simple_type val_env ~closed:false sty)
+ styl
+ in
+ let (params, clty) =
+ Ctype.instance_class decl.cty_params decl.cty_type
+ in
+ let clty' = Btype.abbreviate_class_type path params clty in
+ (* Adding a dummy method to the self type prevents it from being closed /
+ escaping. *)
+ Ctype.add_dummy_method val_env ~scope:self_scope
+ (Btype.signature_of_class_type clty');
+ if List.length params <> List.length tyl then
+ raise(Error(scl.pcl_loc, val_env,
+ Parameter_arity_mismatch (lid.txt, List.length params,
+ List.length tyl)));
+ List.iter2
+ (fun cty' ty ->
+ let ty' = cty'.ctyp_type in
+ try Ctype.unify val_env ty' ty with Ctype.Unify err ->
+ raise(Error(cty'.ctyp_loc, val_env, Parameter_mismatch err)))
+ tyl params;
+ (* Check for unexpected virtual methods *)
+ check_virtual_clty scl.pcl_loc val_env virt Class clty';
+ let cl =
+ rc {cl_desc = Tcl_ident (path, lid, tyl);
+ cl_loc = scl.pcl_loc;
+ cl_type = clty';
+ cl_env = val_env;
+ cl_attributes = scl.pcl_attributes;
+ }
+ in
+ let (vals, meths, concrs) = extract_constraints clty in
+ rc {cl_desc = Tcl_constraint (cl, None, vals, meths, concrs);
+ cl_loc = scl.pcl_loc;
+ cl_type = clty';
+ cl_env = val_env;
+ cl_attributes = []; (* attributes are kept on the inner cl node *)
+ }
+ | Pcl_structure cl_str ->
+ let desc =
+ class_structure cl_num virt self_scope Not_final
+ val_env met_env scl.pcl_loc cl_str
+ in
+ rc {cl_desc = Tcl_structure desc;
+ cl_loc = scl.pcl_loc;
+ cl_type = Cty_signature desc.cstr_type;
+ cl_env = val_env;
+ cl_attributes = scl.pcl_attributes;
+ }
+ | Pcl_fun (l, Some default, spat, sbody) ->
+ let loc = default.pexp_loc in
+ let open Ast_helper in
+ let scases = [
+ Exp.case
+ (Pat.construct ~loc
+ (mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))))
+ (Some ([], Pat.var ~loc (mknoloc "*sth*"))))
+ (Exp.ident ~loc (mknoloc (Longident.Lident "*sth*")));
+
+ Exp.case
+ (Pat.construct ~loc
+ (mknoloc (Longident.(Ldot (Lident "*predef*", "None"))))
+ None)
+ default;
+ ]
+ in
+ let smatch =
+ Exp.match_ ~loc (Exp.ident ~loc (mknoloc (Longident.Lident "*opt*")))
+ scases
+ in
+ let sfun =
+ Cl.fun_ ~loc:scl.pcl_loc
+ l None
+ (Pat.var ~loc (mknoloc "*opt*"))
+ (Cl.let_ ~loc:scl.pcl_loc Nonrecursive [Vb.mk spat smatch] sbody)
+ (* Note: we don't put the '#default' attribute, as it
+ is not detected for class-level let bindings. See #5975.*)
+ in
+ class_expr cl_num val_env met_env virt self_scope sfun
+ | Pcl_fun (l, None, spat, scl') ->
+ let (pat, pv, val_env', met_env) =
+ Ctype.with_local_level_generalize_structure_if_principal
+ (fun () ->
+ Typecore.type_class_arg_pattern cl_num val_env met_env l spat)
+ in
+ let pv =
+ List.map
+ begin fun (id, id', _ty) ->
+ let path = Pident id' in
+ (* do not mark the value as being used *)
+ let vd = Env.find_value path val_env' in
+ (id,
+ {exp_desc =
+ Texp_ident(path, mknoloc (Longident.Lident (Ident.name id)), vd);
+ exp_loc = Location.none; exp_extra = [];
+ exp_type = Ctype.instance vd.val_type;
+ exp_attributes = []; (* check *)
+ exp_env = val_env'})
+ end
+ pv
+ in
+ let rec not_nolabel_function = function
+ | Cty_arrow(Nolabel, _, _) -> false
+ | Cty_arrow(_, _, cty) -> not_nolabel_function cty
+ | _ -> true
+ in
+ let partial =
+ let dummy = type_exp val_env (Ast_helper.Exp.unreachable ()) in
+ Typecore.check_partial val_env pat.pat_type pat.pat_loc
+ [{c_lhs = pat; c_cont = None; c_guard = None; c_rhs = dummy}]
+ in
+ let cl =
+ Ctype.with_raised_nongen_level
+ (fun () -> class_expr cl_num val_env' met_env virt self_scope scl') in
+ if Btype.is_optional l && not_nolabel_function cl.cl_type then
+ Location.prerr_warning pat.pat_loc
+ Warnings.Unerasable_optional_argument;
+ rc {cl_desc = Tcl_fun (l, pat, pv, cl, partial);
+ cl_loc = scl.pcl_loc;
+ cl_type = Cty_arrow
+ (l, Ctype.instance pat.pat_type, cl.cl_type);
+ cl_env = val_env;
+ cl_attributes = scl.pcl_attributes;
+ }
+ | Pcl_apply (scl', sargs) ->
+ assert (sargs <> []);
+ let cl =
+ Ctype.with_local_level_generalize_structure_if_principal
+ (fun () -> class_expr cl_num val_env met_env virt self_scope scl')
+ in
+ let rec nonopt_labels ls ty_fun =
+ match ty_fun with
+ | Cty_arrow (l, _, ty_res) ->
+ if Btype.is_optional l then nonopt_labels ls ty_res
+ else nonopt_labels (l::ls) ty_res
+ | _ -> ls
+ in
+ let ignore_labels =
+ !Clflags.classic ||
+ let labels = nonopt_labels [] cl.cl_type in
+ List.length labels = List.length sargs &&
+ List.for_all (fun (l,_) -> l = Nolabel) sargs &&
+ List.exists (fun l -> l <> Nolabel) labels &&
+ begin
+ Location.prerr_warning
+ cl.cl_loc
+ (Warnings.Labels_omitted
+ (List.map Asttypes.string_of_label
+ (List.filter ((<>) Nolabel) labels)));
+ true
+ end
+ in
+ let rec type_args args omitted ty_fun ty_fun0 sargs =
+ match ty_fun, ty_fun0 with
+ | Cty_arrow (l, ty, ty_fun), Cty_arrow (_, ty0, ty_fun0)
+ when sargs <> [] ->
+ let name = Btype.label_name l
+ and optional = Btype.is_optional l in
+ let use_arg sarg l' =
+ Some (
+ if not optional || Btype.is_optional l' then
+ type_argument val_env sarg ty ty0
+ else
+ let ty' = extract_option_type val_env ty
+ and ty0' = extract_option_type val_env ty0 in
+ let arg = type_argument val_env sarg ty' ty0' in
+ option_some val_env arg
+ )
+ in
+ let eliminate_optional_arg () =
+ Some (option_none val_env ty0 Location.none)
+ in
+ let remaining_sargs, arg =
+ if ignore_labels then begin
+ match sargs with
+ | [] -> assert false
+ | (l', sarg) :: remaining_sargs ->
+ if name = Btype.label_name l' ||
+ (not optional && l' = Nolabel)
+ then
+ (remaining_sargs, use_arg sarg l')
+ else if
+ optional &&
+ not (List.exists (fun (l, _) -> name = Btype.label_name l)
+ remaining_sargs)
+ then
+ (sargs, eliminate_optional_arg ())
+ else
+ raise(Error(sarg.pexp_loc, val_env, Apply_wrong_label l'))
+ end else
+ match Btype.extract_label name sargs with
+ | Some (l', sarg, _, remaining_sargs) ->
+ if not optional && Btype.is_optional l' then
+ Location.prerr_warning sarg.pexp_loc
+ (Warnings.Nonoptional_label
+ (Asttypes.string_of_label l));
+ remaining_sargs, use_arg sarg l'
+ | None ->
+ sargs,
+ if Btype.is_optional l && List.mem_assoc Nolabel sargs then
+ eliminate_optional_arg ()
+ else
+ None
+ in
+ let omitted = if arg = None then (l,ty0) :: omitted else omitted in
+ type_args ((l,arg)::args) omitted ty_fun ty_fun0 remaining_sargs
+ | _ ->
+ match sargs with
+ (l, sarg0)::_ ->
+ if omitted <> [] then
+ raise(Error(sarg0.pexp_loc, val_env, Apply_wrong_label l))
+ else
+ raise(Error(cl.cl_loc, val_env, Cannot_apply cl.cl_type))
+ | [] ->
+ (List.rev args,
+ List.fold_left
+ (fun ty_fun (l,ty) -> Cty_arrow(l,ty,ty_fun))
+ ty_fun0 omitted)
+ in
+ let (args, cty) =
+ let (_, ty_fun0) = Ctype.instance_class [] cl.cl_type in
+ type_args [] [] cl.cl_type ty_fun0 sargs
+ in
+ rc {cl_desc = Tcl_apply (cl, args);
+ cl_loc = scl.pcl_loc;
+ cl_type = cty;
+ cl_env = val_env;
+ cl_attributes = scl.pcl_attributes;
+ }
+ | Pcl_let (rec_flag, sdefs, scl') ->
+ let (defs, val_env) =
+ Typecore.type_let In_class_def val_env rec_flag sdefs in
+ let (vals, met_env) =
+ List.fold_right
+ (fun (id, _id_loc, _typ, _uid) (vals, met_env) ->
+ let path = Pident id in
+ (* do not mark the value as used *)
+ let vd = Env.find_value path val_env in
+ let ty =
+ Ctype.with_local_level_generalize
+ (fun () -> Ctype.instance vd.val_type)
+ in
+ let expr =
+ {exp_desc =
+ Texp_ident(path, mknoloc(Longident.Lident (Ident.name id)),vd);
+ exp_loc = Location.none; exp_extra = [];
+ exp_type = ty;
+ exp_attributes = [];
+ exp_env = val_env;
+ }
+ in
+ let desc =
+ {val_type = expr.exp_type;
+ val_kind = Val_ivar (Immutable, cl_num);
+ val_attributes = [];
+ Types.val_loc = vd.Types.val_loc;
+ val_uid = vd.val_uid;
+ }
+ in
+ let id' = Ident.create_local (Ident.name id) in
+ ((id', expr)
+ :: vals,
+ Env.add_value id' desc met_env))
+ (let_bound_idents_full defs)
+ ([], met_env)
+ in
+ let cl = class_expr cl_num val_env met_env virt self_scope scl' in
+ let defs = match rec_flag with
+ | Recursive -> annotate_recursive_bindings val_env defs
+ | Nonrecursive -> defs
+ in
+ rc {cl_desc = Tcl_let (rec_flag, defs, vals, cl);
+ cl_loc = scl.pcl_loc;
+ cl_type = cl.cl_type;
+ cl_env = val_env;
+ cl_attributes = scl.pcl_attributes;
+ }
+ | Pcl_constraint (scl', scty) ->
+ let cl, clty =
+ Ctype.with_local_level_for_class begin fun () ->
+ let cl =
+ Typetexp.TyVarEnv.with_local_scope begin fun () ->
+ let cl = class_expr cl_num val_env met_env virt self_scope scl' in
+ complete_class_type cl.cl_loc val_env virt Class_type cl.cl_type;
+ cl
+ end
+ and clty =
+ Typetexp.TyVarEnv.with_local_scope begin fun () ->
+ let clty = class_type val_env virt self_scope scty in
+ complete_class_type
+ clty.cltyp_loc val_env virt Class clty.cltyp_type;
+ clty
+ end
+ in
+ cl, clty
+ end
+ ~post: begin fun ({cl_type=cl}, {cltyp_type=clty}) ->
+ Ctype.limited_generalize_class_type
+ (Btype.self_type_row cl) ~inside:cl;
+ Ctype.limited_generalize_class_type
+ (Btype.self_type_row clty) ~inside:clty;
+ end
+ in
+ begin match
+ Includeclass.class_types val_env cl.cl_type clty.cltyp_type
+ with
+ [] -> ()
+ | error -> raise(Error(cl.cl_loc, val_env, Class_match_failure error))
+ end;
+ let (vals, meths, concrs) = extract_constraints clty.cltyp_type in
+ let ty = snd (Ctype.instance_class [] clty.cltyp_type) in
+ (* Adding a dummy method to the self type prevents it from being closed /
+ escaping. *)
+ Ctype.add_dummy_method val_env ~scope:self_scope
+ (Btype.signature_of_class_type ty);
+ rc {cl_desc = Tcl_constraint (cl, Some clty, vals, meths, concrs);
+ cl_loc = scl.pcl_loc;
+ cl_type = ty;
+ cl_env = val_env;
+ cl_attributes = scl.pcl_attributes;
+ }
+ | Pcl_open (pod, e) ->
+ let used_slot = ref false in
+ let (od, new_val_env) = !type_open_descr ~used_slot val_env pod in
+ let ( _, new_met_env) = !type_open_descr ~used_slot met_env pod in
+ let cl = class_expr cl_num new_val_env new_met_env virt self_scope e in
+ rc {cl_desc = Tcl_open (od, cl);
+ cl_loc = scl.pcl_loc;
+ cl_type = cl.cl_type;
+ cl_env = val_env;
+ cl_attributes = scl.pcl_attributes;
+ }
+ | Pcl_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+(*******************************)
+
+(* Approximate the type of the constructor to allow recursive use *)
+(* of optional parameters *)
+
+let var_option = Predef.type_option (Btype.newgenvar ())
+
+let rec approx_declaration cl =
+ match cl.pcl_desc with
+ Pcl_fun (l, _, _, cl) ->
+ let arg =
+ if Btype.is_optional l then Ctype.instance var_option
+ else Ctype.newvar () in
+ Ctype.newty (Tarrow (l, arg, approx_declaration cl, commu_ok))
+ | Pcl_let (_, _, cl) ->
+ approx_declaration cl
+ | Pcl_constraint (cl, _) ->
+ approx_declaration cl
+ | _ -> Ctype.newvar ()
+
+let rec approx_description ct =
+ match ct.pcty_desc with
+ Pcty_arrow (l, _, ct) ->
+ let arg =
+ if Btype.is_optional l then Ctype.instance var_option
+ else Ctype.newvar () in
+ Ctype.newty (Tarrow (l, arg, approx_description ct, commu_ok))
+ | _ -> Ctype.newvar ()
+
+(*******************************)
+
+let temp_abbrev loc arity uid =
+ let params = ref [] in
+ for _i = 1 to arity do
+ params := Ctype.newvar () :: !params
+ done;
+ let ty = Ctype.newobj (Ctype.newvar ()) in
+ let ty_td =
+ {type_params = !params;
+ type_arity = arity;
+ type_kind = Type_abstract Definition;
+ type_private = Public;
+ type_manifest = Some ty;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = loc;
+ type_attributes = []; (* or keep attrs from the class decl? *)
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = uid;
+ }
+ in
+ (!params, ty, ty_td)
+
+let initial_env define_class approx
+ (res, env) (cl, id, ty_id, obj_id, uid) =
+ (* Temporary abbreviations *)
+ let arity = List.length cl.pci_params in
+ let (obj_params, obj_ty, obj_td) = temp_abbrev cl.pci_loc arity uid in
+ let env = Env.add_type ~check:true obj_id obj_td env in
+ let (cl_params, cl_ty, cl_td) = temp_abbrev cl.pci_loc arity uid in
+
+ (* Temporary type for the class constructor *)
+ let constr_type =
+ Ctype.with_local_level_generalize_structure_if_principal
+ (fun () -> approx cl.pci_expr)
+ in
+ let dummy_cty = Cty_signature (Ctype.new_class_signature ()) in
+ let dummy_class =
+ {Types.cty_params = []; (* Dummy value *)
+ cty_variance = [];
+ cty_type = dummy_cty; (* Dummy value *)
+ cty_path = unbound_class;
+ cty_new =
+ begin match cl.pci_virt with
+ | Virtual -> None
+ | Concrete -> Some constr_type
+ end;
+ cty_loc = Location.none;
+ cty_attributes = [];
+ cty_uid = uid;
+ }
+ in
+ let env =
+ Env.add_cltype ty_id
+ {clty_params = []; (* Dummy value *)
+ clty_variance = [];
+ clty_type = dummy_cty; (* Dummy value *)
+ clty_path = unbound_class;
+ clty_hash_type = cl_td; (* Dummy value *)
+ clty_loc = Location.none;
+ clty_attributes = [];
+ clty_uid = uid;
+ }
+ (
+ if define_class then
+ Env.add_class id dummy_class env
+ else
+ env
+ )
+ in
+ ((cl, id, ty_id,
+ obj_id, obj_params, obj_ty,
+ cl_params, cl_ty, cl_td,
+ constr_type,
+ dummy_class)::res,
+ env)
+
+let class_infos define_class kind
+ (cl, id, ty_id,
+ obj_id, obj_params, obj_ty,
+ cl_params, cl_ty, cl_td,
+ constr_type,
+ dummy_class)
+ (res, env) =
+
+ let ci_params, params, coercion_locs, expr, typ, sign =
+ Ctype.with_local_level_for_class begin fun () ->
+ TyVarEnv.reset ();
+ (* Introduce class parameters *)
+ let ci_params =
+ let make_param (sty, v) =
+ try
+ (transl_type_param env sty, v)
+ with Already_bound ->
+ raise(Error(sty.ptyp_loc, env, Repeated_parameter))
+ in
+ List.map make_param cl.pci_params
+ in
+ let params = List.map (fun (cty, _) -> cty.ctyp_type) ci_params in
+
+ (* Allow self coercions (only for class declarations) *)
+ let coercion_locs = ref [] in
+
+ (* Type the class expression *)
+ let (expr, typ) =
+ try
+ Typecore.self_coercion :=
+ (Path.Pident obj_id, coercion_locs) :: !Typecore.self_coercion;
+ let res = kind env cl.pci_virt cl.pci_expr in
+ Typecore.self_coercion := List.tl !Typecore.self_coercion;
+ res
+ with exn ->
+ Typecore.self_coercion := []; raise exn
+ in
+ let sign = Btype.signature_of_class_type typ in
+ (ci_params, params, coercion_locs, expr, typ, sign)
+ end
+ ~post: begin fun (_, params, _, _, typ, sign) ->
+ (* Generalize the row variable *)
+ List.iter
+ (fun inside -> Ctype.limited_generalize sign.csig_self_row ~inside)
+ params;
+ Ctype.limited_generalize_class_type sign.csig_self_row ~inside:typ;
+ end
+ in
+ (* Check the abbreviation for the object type *)
+ let (obj_params', obj_type) = Ctype.instance_class params typ in
+ let constr = Ctype.newconstr (Path.Pident obj_id) obj_params in
+ begin
+ let row = Btype.self_type_row obj_type in
+ Ctype.unify env row (Ctype.newty Tnil);
+ begin try
+ List.iter2 (Ctype.unify env) obj_params obj_params'
+ with Ctype.Unify _ ->
+ raise(Error(cl.pci_loc, env,
+ Bad_parameters (obj_id, obj_params, obj_params')))
+ end;
+ let ty = Btype.self_type obj_type in
+ begin try
+ Ctype.unify env ty constr
+ with Ctype.Unify _ ->
+ raise(Error(cl.pci_loc, env,
+ Abbrev_type_clash (constr, ty, Ctype.expand_head env constr)))
+ end
+ end;
+
+ Ctype.set_object_name obj_id params (Btype.self_type typ);
+
+ (* Check the other temporary abbreviation (#-type) *)
+ begin
+ let (cl_params', cl_type) = Ctype.instance_class params typ in
+ let ty = Btype.self_type cl_type in
+ begin try
+ List.iter2 (Ctype.unify env) cl_params cl_params'
+ with Ctype.Unify _ ->
+ raise(Error(cl.pci_loc, env,
+ Bad_class_type_parameters (ty_id, cl_params, cl_params')))
+ end;
+ begin try
+ Ctype.unify env ty cl_ty
+ with Ctype.Unify _ ->
+ let ty_expanded = Ctype.object_fields ty in
+ raise(Error(cl.pci_loc, env, Abbrev_type_clash (ty, ty_expanded, cl_ty)))
+ end
+ end;
+
+ (* Type of the class constructor *)
+ begin try
+ Ctype.unify env
+ (constructor_type constr obj_type)
+ (Ctype.instance constr_type)
+ with Ctype.Unify err ->
+ raise(Error(cl.pci_loc, env,
+ Constructor_type_mismatch (cl.pci_name.txt, err)))
+ end;
+
+ (* Class and class type temporary definitions *)
+ let cty_variance =
+ Variance.unknown_signature ~injective:false ~arity:(List.length params) in
+ let cltydef =
+ {clty_params = params; clty_type = Btype.class_body typ;
+ clty_variance = cty_variance;
+ clty_path = Path.Pident obj_id;
+ clty_hash_type = cl_td;
+ clty_loc = cl.pci_loc;
+ clty_attributes = cl.pci_attributes;
+ clty_uid = dummy_class.cty_uid;
+ }
+ and clty =
+ {cty_params = params; cty_type = typ;
+ cty_variance = cty_variance;
+ cty_path = Path.Pident obj_id;
+ cty_new =
+ begin match cl.pci_virt with
+ | Virtual -> None
+ | Concrete -> Some constr_type
+ end;
+ cty_loc = cl.pci_loc;
+ cty_attributes = cl.pci_attributes;
+ cty_uid = dummy_class.cty_uid;
+ }
+ in
+ dummy_class.cty_type <- typ;
+ let env =
+ Env.add_cltype ty_id cltydef (
+ if define_class then Env.add_class id clty env else env)
+ in
+
+ (* Misc. *)
+ let arity = Btype.class_type_arity typ in
+ let pub_meths = Btype.public_methods sign in
+
+ (* Final definitions *)
+ let (params', typ') = Ctype.instance_class params typ in
+ let clty =
+ {cty_params = params'; cty_type = typ';
+ cty_variance = cty_variance;
+ cty_path = Path.Pident obj_id;
+ cty_new =
+ begin match cl.pci_virt with
+ | Virtual -> None
+ | Concrete -> Some (Ctype.instance constr_type)
+ end;
+ cty_loc = cl.pci_loc;
+ cty_attributes = cl.pci_attributes;
+ cty_uid = dummy_class.cty_uid;
+ }
+ in
+ let obj_abbr =
+ let arity = List.length obj_params in
+ {
+ type_params = obj_params;
+ type_arity = arity;
+ type_kind = Type_abstract Definition;
+ type_private = Public;
+ type_manifest = Some obj_ty;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = cl.pci_loc;
+ type_attributes = []; (* or keep attrs from cl? *)
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = dummy_class.cty_uid;
+ }
+ in
+ let (cl_params, cl_ty) =
+ Ctype.instance_parameterized_type params (Btype.self_type typ)
+ in
+ Ctype.set_object_name obj_id cl_params cl_ty;
+ let cl_abbr =
+ { cl_td with
+ type_params = cl_params;
+ type_manifest = Some cl_ty
+ }
+ in
+ let cltydef =
+ {clty_params = params'; clty_type = Btype.class_body typ';
+ clty_variance = cty_variance;
+ clty_path = Path.Pident obj_id;
+ clty_hash_type = cl_abbr;
+ clty_loc = cl.pci_loc;
+ clty_attributes = cl.pci_attributes;
+ clty_uid = dummy_class.cty_uid;
+ }
+ in
+ ((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, ci_params,
+ arity, pub_meths, List.rev !coercion_locs, expr) :: res,
+ env)
+
+let collapse_conj_class_params env (cl, id, clty, _, _, _, _, _, _, _, _, _) =
+ try Ctype.collapse_conj_params env clty.cty_params
+ with Ctype.Unify err ->
+ raise(Error(cl.pci_loc, env, Non_collapsable_conjunction (id, clty, err)))
+
+let final_decl env define_class
+ (cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, ci_params,
+ arity, pub_meths, coe, expr) =
+ Ctype.nongen_vars_in_class_declaration clty
+ |> Option.iter (fun vars ->
+ let nongen_vars = Btype.TypeSet.elements vars in
+ raise(Error(cl.pci_loc, env
+ , Non_generalizable_class { id; clty; nongen_vars }));
+ );
+ begin match
+ Ctype.closed_class clty.cty_params
+ (Btype.signature_of_class_type clty.cty_type)
+ with
+ None -> ()
+ | Some reason ->
+ let printer =
+ if define_class
+ then
+ Format_doc.doc_printf "%a" (Printtyp.Doc.class_declaration id) clty
+ else
+ Format_doc.doc_printf "%a"
+ (Printtyp.Doc.cltype_declaration id) cltydef
+ in
+ raise(Error(cl.pci_loc, env, Unbound_type_var(printer, reason)))
+ end;
+ { id; clty; ty_id; cltydef; obj_id; obj_abbr; arity;
+ pub_meths; coe;
+ id_loc = cl.pci_name;
+ req = { ci_loc = cl.pci_loc;
+ ci_virt = cl.pci_virt;
+ ci_params = ci_params;
+ (* TODO : check that we have the correct use of identifiers *)
+ ci_id_name = cl.pci_name;
+ ci_id_class = id;
+ ci_id_class_type = ty_id;
+ ci_id_object = obj_id;
+ ci_expr = expr;
+ ci_decl = clty;
+ ci_type_decl = cltydef;
+ ci_attributes = cl.pci_attributes;
+ }
+ }
+(* (cl.pci_variance, cl.pci_loc)) *)
+
+let class_infos define_class kind
+ (cl, id, ty_id,
+ obj_id, obj_params, obj_ty,
+ cl_params, cl_ty, cl_td,
+ constr_type,
+ dummy_class)
+ (res, env) =
+ Builtin_attributes.warning_scope cl.pci_attributes
+ (fun () ->
+ class_infos define_class kind
+ (cl, id, ty_id,
+ obj_id, obj_params, obj_ty,
+ cl_params, cl_ty, cl_td,
+ constr_type,
+ dummy_class)
+ (res, env)
+ )
+
+let extract_type_decls { clty; cltydef; obj_id; obj_abbr; req} decls =
+ (obj_id, obj_abbr, clty, cltydef, req) :: decls
+
+let merge_type_decls decl (obj_abbr, clty, cltydef) =
+ {decl with obj_abbr; clty; cltydef}
+
+let final_env define_class env { id; clty; ty_id; cltydef; obj_id; obj_abbr; } =
+ (* Add definitions after cleaning them *)
+ Env.add_type ~check:true obj_id
+ (Subst.type_declaration Subst.identity obj_abbr) (
+ Env.add_cltype ty_id (Subst.cltype_declaration Subst.identity cltydef) (
+ if define_class then
+ Env.add_class id (Subst.class_declaration Subst.identity clty) env
+ else env))
+
+(* Check that #c is coercible to c if there is a self-coercion *)
+let check_coercions env { id; id_loc; clty; ty_id; cltydef; obj_id; obj_abbr;
+ arity; pub_meths; coe; req } =
+ let cl_abbr = cltydef.clty_hash_type in
+ begin match coe with [] -> ()
+ | loc :: _ ->
+ let cl_ty, obj_ty =
+ match cl_abbr.type_manifest, obj_abbr.type_manifest with
+ Some cl_ab, Some obj_ab ->
+ let cl_params, cl_ty =
+ Ctype.instance_parameterized_type cl_abbr.type_params cl_ab
+ and obj_params, obj_ty =
+ Ctype.instance_parameterized_type obj_abbr.type_params obj_ab
+ in
+ List.iter2 (Ctype.unify env) cl_params obj_params;
+ cl_ty, obj_ty
+ | _ -> assert false
+ in
+ begin try Ctype.subtype env cl_ty obj_ty ()
+ with Ctype.Subtype err ->
+ raise(Typecore.Error(loc, env, Typecore.Not_subtype err))
+ end;
+ if not (Ctype.opened_object cl_ty) then
+ raise(Error(loc, env, Cannot_coerce_self obj_ty))
+ end;
+ {cls_id = id;
+ cls_id_loc = id_loc;
+ cls_decl = clty;
+ cls_ty_id = ty_id;
+ cls_ty_decl = cltydef;
+ cls_obj_id = obj_id;
+ cls_obj_abbr = obj_abbr;
+ cls_abbr = cl_abbr;
+ cls_arity = arity;
+ cls_pub_methods = pub_meths;
+ cls_info=req}
+
+(*******************************)
+
+let type_classes define_class approx kind env cls =
+ let scope = Ctype.create_scope () in
+ let cls =
+ List.map
+ (function cl ->
+ (cl,
+ Ident.create_scoped ~scope cl.pci_name.txt,
+ Ident.create_scoped ~scope cl.pci_name.txt,
+ Ident.create_scoped ~scope cl.pci_name.txt,
+ Uid.mk ~current_unit:(Env.get_current_unit ())
+ ))
+ cls
+ in
+ let res, env =
+ Ctype.with_local_level_generalize_for_class begin fun () ->
+ let (res, env) =
+ List.fold_left (initial_env define_class approx) ([], env) cls
+ in
+ let (res, env) =
+ List.fold_right (class_infos define_class kind) res ([], env)
+ in
+ List.iter (collapse_conj_class_params env) res;
+ res, env
+ end
+ in
+ let res = List.rev_map (final_decl env define_class) res in
+ let decls = List.fold_right extract_type_decls res [] in
+ let decls =
+ try Typedecl_variance.update_class_decls env decls
+ with Typedecl_variance.Error(loc, err) ->
+ raise (Typedecl.Error(loc, Typedecl.Variance err))
+ in
+ let res = List.map2 merge_type_decls res decls in
+ let env = List.fold_left (final_env define_class) env res in
+ let res = List.map (check_coercions env) res in
+ (res, env)
+
+let class_num = ref 0
+let class_declaration env virt sexpr =
+ incr class_num;
+ let self_scope = Ctype.get_current_level () in
+ let expr =
+ class_expr (Int.to_string !class_num) env env virt self_scope sexpr
+ in
+ complete_class_type expr.cl_loc env virt Class expr.cl_type;
+ (expr, expr.cl_type)
+
+let class_description env virt sexpr =
+ let self_scope = Ctype.get_current_level () in
+ let expr = class_type env virt self_scope sexpr in
+ complete_class_type expr.cltyp_loc env virt Class_type expr.cltyp_type;
+ (expr, expr.cltyp_type)
+
+let class_declarations env cls =
+ let info, env =
+ type_classes true approx_declaration class_declaration env cls
+ in
+ let ids, exprs =
+ List.split
+ (List.map
+ (fun ci -> ci.cls_id, ci.cls_info.ci_expr)
+ info)
+ in
+ check_recursive_class_bindings env ids exprs;
+ info, env
+
+let class_descriptions env cls =
+ type_classes true approx_description class_description env cls
+
+let class_type_declarations env cls =
+ let (decls, env) =
+ type_classes false approx_description class_description env cls
+ in
+ (List.map
+ (fun decl ->
+ {clsty_ty_id = decl.cls_ty_id;
+ clsty_id_loc = decl.cls_id_loc;
+ clsty_ty_decl = decl.cls_ty_decl;
+ clsty_obj_id = decl.cls_obj_id;
+ clsty_obj_abbr = decl.cls_obj_abbr;
+ clsty_abbr = decl.cls_abbr;
+ clsty_info = decl.cls_info})
+ decls,
+ env)
+
+let type_object env loc s =
+ incr class_num;
+ let desc =
+ class_structure (Int.to_string !class_num)
+ Concrete Btype.lowest_level Final env env loc s
+ in
+ complete_class_signature loc env Concrete Object desc.cstr_type;
+ let meths = Btype.public_methods desc.cstr_type in
+ (desc, meths)
+
+let () =
+ Typecore.type_object := type_object
+
+(*******************************)
+
+(* Check that there is no references through recursive modules (GPR#6491) *)
+let rec check_recmod_class_type env cty =
+ match cty.pcty_desc with
+ | Pcty_constr(lid, _) ->
+ ignore (Env.lookup_cltype ~use:false ~loc:lid.loc lid.txt env)
+ | Pcty_extension _ -> ()
+ | Pcty_arrow(_, _, cty) ->
+ check_recmod_class_type env cty
+ | Pcty_open(od, cty) ->
+ let _, env = !type_open_descr env od in
+ check_recmod_class_type env cty
+ | Pcty_signature csig ->
+ check_recmod_class_sig env csig
+
+and check_recmod_class_sig env csig =
+ List.iter
+ (fun ctf ->
+ match ctf.pctf_desc with
+ | Pctf_inherit cty -> check_recmod_class_type env cty
+ | Pctf_val _ | Pctf_method _
+ | Pctf_constraint _ | Pctf_attribute _ | Pctf_extension _ -> ())
+ csig.pcsig_fields
+
+let check_recmod_decl env sdecl =
+ check_recmod_class_type env sdecl.pci_expr
+
+(* Approximate the class declaration as class ['params] id = object end *)
+let approx_class sdecl =
+ let open Ast_helper in
+ let self' = Typ.any () in
+ let clty' = Cty.signature ~loc:sdecl.pci_expr.pcty_loc (Csig.mk self' []) in
+ { sdecl with pci_expr = clty' }
+
+let approx_class_declarations env sdecls =
+ let decls, env = class_type_declarations env (List.map approx_class sdecls) in
+ List.iter (check_recmod_decl env) sdecls;
+ decls, env
+
+(*******************************)
+
+(* Error report *)
+
+open Format_doc
+
+let non_virtual_string_of_kind : kind -> string = function
+ | Object -> "object"
+ | Class -> "non-virtual class"
+ | Class_type -> "non-virtual class type"
+
+module Style=Misc.Style
+module Printtyp = Printtyp.Doc
+
+let out_type ppf t = Style.as_inline_code !Oprint.out_type ppf t
+let quoted_type ppf t = Style.as_inline_code Printtyp.type_expr ppf t
+
+let report_error_doc env ppf =
+ let pp_args ppf args =
+ let args = List.map (Out_type.tree_of_typexp Type) args in
+ Style.as_inline_code !Oprint.out_type_args ppf args
+ in
+ function
+ | Repeated_parameter ->
+ fprintf ppf "A type parameter occurs several times"
+ | Unconsistent_constraint err ->
+ let msg = Format_doc.Doc.msg in
+ fprintf ppf "@[<v>The class constraints are not consistent.@ ";
+ Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "is not compatible with type");
+ fprintf ppf "@]"
+ | Field_type_mismatch (k, m, err) ->
+ let msg = Format_doc.doc_printf in
+ Errortrace_report.unification ppf env err
+ (msg "The %s %a@ has type" k Style.inline_code m)
+ (msg "but is expected to have type")
+ | Unexpected_field (ty, lab) ->
+ fprintf ppf
+ "@[@[<2>This object is expected to have type :@ %a@]\
+ @ This type does not have a method %a."
+ quoted_type ty
+ Style.inline_code lab
+ | Structure_expected clty ->
+ fprintf ppf
+ "@[This class expression is not a class structure; it has type@ %a@]"
+ (Style.as_inline_code Printtyp.class_type) clty
+ | Cannot_apply _ ->
+ fprintf ppf
+ "This class expression is not a class function, it cannot be applied"
+ | Apply_wrong_label l ->
+ let mark_label ppf = function
+ | Nolabel -> fprintf ppf "without label"
+ | l -> fprintf ppf "with label %a"
+ Style.inline_code (Btype.prefixed_label_name l)
+ in
+ fprintf ppf "This argument cannot be applied %a" mark_label l
+ | Pattern_type_clash ty ->
+ (* XXX Trace *)
+ (* XXX Revoir message d'erreur | Improve error message *)
+ fprintf ppf "@[%s@ %a@]"
+ "This pattern cannot match self: it only matches values of type"
+ quoted_type ty
+ | Unbound_class_2 cl ->
+ fprintf ppf "@[The class@ %a@ is not yet completely defined@]"
+ (Style.as_inline_code Printtyp.longident) cl
+ | Unbound_class_type_2 cl ->
+ fprintf ppf "@[The class type@ %a@ is not yet completely defined@]"
+ (Style.as_inline_code Printtyp.longident) cl
+ | Abbrev_type_clash (abbrev, actual, expected) ->
+ (* XXX Afficher une trace ? | Print a trace? *)
+ Out_type.prepare_for_printing [abbrev; actual; expected];
+ fprintf ppf "@[The abbreviation@ %a@ expands to type@ %a@ \
+ but is used with type@ %a@]"
+ out_type (Out_type.tree_of_typexp Type abbrev)
+ out_type (Out_type.tree_of_typexp Type actual)
+ out_type (Out_type.tree_of_typexp Type expected)
+ | Constructor_type_mismatch (c, err) ->
+ let msg = Format_doc.doc_printf in
+ Errortrace_report.unification ppf env err
+ (msg "The expression %a has type"
+ Style.inline_code ("new " ^ c)
+ )
+ (msg "but is used with type")
+ | Virtual_class (kind, mets, vals) ->
+ let kind = non_virtual_string_of_kind kind in
+ let missings =
+ match mets, vals with
+ [], _ -> "variables"
+ | _, [] -> "methods"
+ | _ -> "methods and variables"
+ in
+ fprintf ppf
+ "@[This %s has virtual %s.@ \
+ @[<2>The following %s are virtual : %a@]@]"
+ kind missings missings
+ (pp_print_list ~pp_sep:pp_print_space Style.inline_code) (mets @ vals)
+ | Undeclared_methods(kind, mets) ->
+ let kind = non_virtual_string_of_kind kind in
+ fprintf ppf
+ "@[This %s has undeclared virtual methods.@ \
+ @[<2>The following methods were not declared : %a@]@]"
+ kind (pp_print_list ~pp_sep:pp_print_space Style.inline_code) mets
+ | Parameter_arity_mismatch(lid, expected, provided) ->
+ fprintf ppf
+ "@[The class constructor %a@ expects %i type argument(s),@ \
+ but is here applied to %i type argument(s)@]"
+ (Style.as_inline_code Printtyp.longident) lid expected provided
+ | Parameter_mismatch err ->
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf env err
+ (msg "The type parameter")
+ (msg "does not meet its constraint: it should be")
+ | Bad_parameters (id, params, cstrs) ->
+ Out_type.prepare_for_printing (params @ cstrs);
+ fprintf ppf
+ "@[The abbreviation %a@ is used with parameter(s)@ %a@ \
+ which are incompatible with constraint(s)@ %a@]"
+ (Style.as_inline_code Printtyp.ident) id
+ pp_args params
+ pp_args cstrs
+ | Bad_class_type_parameters (id, params, cstrs) ->
+ let pp_hash ppf id = fprintf ppf "#%a" Printtyp.ident id in
+ Out_type.prepare_for_printing (params @ cstrs);
+ fprintf ppf
+ "@[The class type %a@ is used with parameter(s)@ %a,@ \
+ whereas the class type definition@ constrains@ \
+ those parameters to be@ %a@]"
+ (Style.as_inline_code pp_hash) id
+ pp_args params
+ pp_args cstrs
+ | Class_match_failure error ->
+ Includeclass.report_error_doc Type ppf error
+ | Unbound_val lab ->
+ fprintf ppf "Unbound instance variable %a" Style.inline_code lab
+ | Unbound_type_var (msg, reason) ->
+ let print_reason ppf { Ctype.free_variable; meth; meth_ty; } =
+ let (ty0, kind) = free_variable in
+ let ty1 =
+ match kind with
+ | Type_variable -> ty0
+ | Row_variable -> Btype.newgenty(Tobject(ty0, ref None))
+ in
+ Out_type.add_type_to_preparation meth_ty;
+ Out_type.add_type_to_preparation ty1;
+ fprintf ppf
+ "The method %a@ has type@;<1 2>%a@ where@ %a@ is unbound"
+ Style.inline_code meth
+ out_type (Out_type.tree_of_typexp Type meth_ty)
+ out_type (Out_type.tree_of_typexp Type ty0)
+ in
+ fprintf ppf
+ "@[<v>@[Some type variables are unbound in this type:@;<1 2>%a@]@ \
+ @[%a@]@]"
+ pp_doc msg print_reason reason
+ | Non_generalizable_class {id; clty; nongen_vars } ->
+ let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2] in
+ Out_type.prepare_for_printing nongen_vars;
+ fprintf ppf
+ "@[The type of this class,@ %a,@ \
+ contains the non-generalizable type variable(s): %a.@ %a@]"
+ (Style.as_inline_code @@ Printtyp.class_declaration id) clty
+ (pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
+ (Style.as_inline_code Out_type.prepared_type_scheme)
+ ) nongen_vars
+ Misc.print_see_manual manual_ref
+
+ | Cannot_coerce_self ty ->
+ fprintf ppf
+ "@[The type of self cannot be coerced to@ \
+ the type of the current class:@ %a.@.\
+ Some occurrences are contravariant@]"
+ (Style.as_inline_code Printtyp.type_scheme) ty
+ | Non_collapsable_conjunction (id, clty, err) ->
+ let msg = Format_doc.Doc.msg in
+ fprintf ppf
+ "@[The type of this class,@ %a,@ \
+ contains non-collapsible conjunctive types in constraints.@ %t@]"
+ (Style.as_inline_code @@ Printtyp.class_declaration id) clty
+ (fun ppf -> Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "is not compatible with type")
+ )
+ | Self_clash err ->
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf env err
+ (msg "This object is expected to have type")
+ (msg "but actually has type")
+ | Mutability_mismatch (_lab, mut) ->
+ let mut1, mut2 =
+ if mut = Immutable then "mutable", "immutable"
+ else "immutable", "mutable" in
+ fprintf ppf
+ "@[The instance variable is %s;@ it cannot be redefined as %s@]"
+ mut1 mut2
+ | No_overriding (_, "") ->
+ fprintf ppf
+ "@[This inheritance does not override any methods@ \
+ or instance variables@ but is explicitly marked as@ \
+ overriding with %a.@]"
+ Style.inline_code "!"
+ | No_overriding (kind, name) ->
+ fprintf ppf "@[The %s %a@ has no previous definition@]" kind
+ Style.inline_code name
+ | Duplicate (kind, name) ->
+ fprintf ppf "@[The %s %a@ has multiple definitions in this object@]"
+ kind Style.inline_code name
+ | Closing_self_type sign ->
+ fprintf ppf
+ "@[Cannot close type of object literal:@ %a@,\
+ it has been unified with the self type of a class that is not yet@ \
+ completely defined.@]"
+ (Style.as_inline_code Printtyp.type_scheme) sign.csig_self
+
+let report_error_doc env ppf err =
+ Printtyp.wrap_printing_env ~error:true
+ env (fun () -> report_error_doc env ppf err)
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc, env, err) ->
+ Some (Location.error_of_printer ~loc (report_error_doc env) err)
+ | Error_forward err ->
+ Some err
+ | _ ->
+ None
+ )
+
+let report_error = Format_doc.compat1 report_error_doc
diff --git a/upstream/ocaml_503/typing/typeclass.mli b/upstream/ocaml_503/typing/typeclass.mli
new file mode 100644
index 0000000000..89e230d14d
--- /dev/null
+++ b/upstream/ocaml_503/typing/typeclass.mli
@@ -0,0 +1,137 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jerome Vouillon, 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Types
+type 'a class_info = {
+ cls_id : Ident.t;
+ cls_id_loc : string loc;
+ cls_decl : class_declaration;
+ cls_ty_id : Ident.t;
+ cls_ty_decl : class_type_declaration;
+ cls_obj_id : Ident.t;
+ cls_obj_abbr : type_declaration;
+ cls_abbr : type_declaration;
+ cls_arity : int;
+ cls_pub_methods : string list;
+ cls_info : 'a;
+}
+
+type class_type_info = {
+ clsty_ty_id : Ident.t;
+ clsty_id_loc : string loc;
+ clsty_ty_decl : class_type_declaration;
+ clsty_obj_id : Ident.t;
+ clsty_obj_abbr : type_declaration;
+ clsty_abbr : type_declaration;
+ clsty_info : Typedtree.class_type_declaration;
+}
+
+val class_declarations:
+ Env.t -> Parsetree.class_declaration list ->
+ Typedtree.class_declaration class_info list * Env.t
+
+(*
+and class_declaration =
+ (class_expr, Types.class_declaration) class_infos
+*)
+
+val class_descriptions:
+ Env.t -> Parsetree.class_description list ->
+ Typedtree.class_description class_info list * Env.t
+
+(*
+and class_description =
+ (class_type, unit) class_infos
+*)
+
+val class_type_declarations:
+ Env.t -> Parsetree.class_description list -> class_type_info list * Env.t
+
+(*
+and class_type_declaration =
+ (class_type, Types.class_type_declaration) class_infos
+*)
+
+val approx_class_declarations:
+ Env.t -> Parsetree.class_description list -> class_type_info list * Env.t
+
+(*
+val type_classes :
+ bool ->
+ ('a -> Types.type_expr) ->
+ (Env.t -> 'a -> 'b * Types.class_type) ->
+ Env.t ->
+ 'a Parsetree.class_infos list ->
+ ( Ident.t * Types.class_declaration *
+ Ident.t * Types.class_type_declaration *
+ Ident.t * Types.type_declaration *
+ Ident.t * Types.type_declaration *
+ int * string list * 'b * 'b Typedtree.class_infos)
+ list * Env.t
+*)
+
+type kind =
+ | Object
+ | Class
+ | Class_type
+
+type error =
+ | Unconsistent_constraint of Errortrace.unification_error
+ | Field_type_mismatch of string * string * Errortrace.unification_error
+ | Unexpected_field of type_expr * string
+ | Structure_expected of class_type
+ | Cannot_apply of class_type
+ | Apply_wrong_label of arg_label
+ | Pattern_type_clash of type_expr
+ | Repeated_parameter
+ | Unbound_class_2 of Longident.t
+ | Unbound_class_type_2 of Longident.t
+ | Abbrev_type_clash of type_expr * type_expr * type_expr
+ | Constructor_type_mismatch of string * Errortrace.unification_error
+ | Virtual_class of kind * string list * string list
+ | Undeclared_methods of kind * string list
+ | Parameter_arity_mismatch of Longident.t * int * int
+ | Parameter_mismatch of Errortrace.unification_error
+ | Bad_parameters of Ident.t * type_expr list * type_expr list
+ | Bad_class_type_parameters of Ident.t * type_expr list * type_expr list
+ | Class_match_failure of Ctype.class_match_failure list
+ | Unbound_val of string
+ | Unbound_type_var of Format_doc.t * Ctype.closed_class_failure
+ | Non_generalizable_class of
+ { id : Ident.t
+ ; clty : Types.class_declaration
+ ; nongen_vars : type_expr list
+ }
+ | Cannot_coerce_self of type_expr
+ | Non_collapsable_conjunction of
+ Ident.t * Types.class_declaration * Errortrace.unification_error
+ | Self_clash of Errortrace.unification_error
+ | Mutability_mismatch of string * mutable_flag
+ | No_overriding of string * string
+ | Duplicate of string * string
+ | Closing_self_type of class_signature
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+val report_error : Env.t -> Format.formatter -> error -> unit
+val report_error_doc : Env.t -> error Format_doc.printer
+
+(* Forward decl filled in by Typemod.type_open_descr *)
+val type_open_descr :
+ (?used_slot:bool ref ->
+ Env.t -> Parsetree.open_description -> Typedtree.open_description * Env.t)
+ ref
diff --git a/upstream/ocaml_503/typing/typecore.ml b/upstream/ocaml_503/typing/typecore.ml
new file mode 100644
index 0000000000..efa97077c3
--- /dev/null
+++ b/upstream/ocaml_503/typing/typecore.ml
@@ -0,0 +1,7092 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Typechecking for the core language *)
+
+[@@@ocaml.warning "-60"] module Str = Ast_helper.Str (* For ocamldep *)
+[@@@ocaml.warning "+60"]
+
+open Misc
+open Asttypes
+open Parsetree
+open Types
+open Typedtree
+open Btype
+open Ctype
+
+module Style = Misc.Style
+
+type type_forcing_context =
+ | If_conditional
+ | If_no_else_branch
+ | While_loop_conditional
+ | While_loop_body
+ | For_loop_start_index
+ | For_loop_stop_index
+ | For_loop_body
+ | Assert_condition
+ | Sequence_left_hand_side
+ | When_guard
+
+type type_expected = {
+ ty: type_expr;
+ explanation: type_forcing_context option;
+}
+
+module Datatype_kind = struct
+ type t = Record | Variant
+
+ let type_name = function
+ | Record -> "record"
+ | Variant -> "variant"
+
+ let label_name = function
+ | Record -> "field"
+ | Variant -> "constructor"
+end
+
+type wrong_name = {
+ type_path: Path.t;
+ kind: Datatype_kind.t;
+ name: string loc;
+ valid_names: string list;
+}
+
+type wrong_kind_context =
+ | Pattern
+ | Expression of type_forcing_context option
+
+type wrong_kind_sort =
+ | Constructor
+ | Record
+ | Boolean
+ | List
+ | Unit
+
+type contains_gadt =
+ | Contains_gadt
+ | No_gadt
+
+let wrong_kind_sort_of_constructor (lid : Longident.t) =
+ match lid with
+ | Lident "true" | Lident "false" | Ldot(_, "true") | Ldot(_, "false") ->
+ Boolean
+ | Lident "[]" | Lident "::" | Ldot(_, "[]") | Ldot(_, "::") -> List
+ | Lident "()" | Ldot(_, "()") -> Unit
+ | _ -> Constructor
+
+type existential_restriction =
+ | At_toplevel (** no existential types at the toplevel *)
+ | In_group (** nor with let ... and ... *)
+ | In_rec (** or recursive definition *)
+ | With_attributes (** or let[@any_attribute] = ... *)
+ | In_class_args (** or in class arguments *)
+ | In_class_def (** or in [class c = let ... in ...] *)
+ | In_self_pattern (** or in self pattern *)
+
+type existential_binding =
+ | Bind_already_bound
+ | Bind_not_in_scope
+ | Bind_non_locally_abstract
+
+type error =
+ | Constructor_arity_mismatch of Longident.t * int * int
+ | Label_mismatch of Longident.t * Errortrace.unification_error
+ | Pattern_type_clash :
+ Errortrace.unification_error * Parsetree.pattern_desc option -> error
+ | Or_pattern_type_clash of Ident.t * Errortrace.unification_error
+ | Multiply_bound_variable of string
+ | Orpat_vars of Ident.t * Ident.t list
+ | Expr_type_clash of
+ Errortrace.unification_error * type_forcing_context option
+ * Parsetree.expression option
+ | Function_arity_type_clash of
+ { syntactic_arity : int;
+ type_constraint : type_expr;
+ trace : Errortrace.unification_error;
+ }
+ (* [Function_arity_type_clash { syntactic_arity = n; type_constraint; trace }]
+ is the type error for the specific case where an n-ary function is
+ constrained at a type with an arity less than n, e.g.:
+ {[
+ type (_, _) eq = Eq : ('a, 'a) eq
+ let bad : type a. ?opt:(a, int -> int) eq -> unit -> a =
+ fun ?opt:(Eq = assert false) () x -> x + 1
+ ]}
+
+ [type_constraint] is the user-written polymorphic type (in this example
+ [?opt:(a, int -> int) eq -> unit -> a]) that causes this type clash, and
+ [trace] is the unification error that signaled the issue.
+ *)
+ | Apply_non_function of {
+ funct : Typedtree.expression;
+ func_ty : type_expr;
+ res_ty : type_expr;
+ previous_arg_loc : Location.t;
+ extra_arg_loc : Location.t;
+ }
+ | Apply_wrong_label of arg_label * type_expr * bool
+ | Label_multiply_defined of string
+ | Label_missing of Ident.t list
+ | Label_not_mutable of Longident.t
+ | Wrong_name of string * type_expected * wrong_name
+ | Name_type_mismatch of
+ Datatype_kind.t * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
+ | Invalid_format of string
+ | Not_an_object of type_expr * type_forcing_context option
+ | Undefined_method of type_expr * string * string list option
+ | Undefined_self_method of string * string list
+ | Virtual_class of Longident.t
+ | Private_type of type_expr
+ | Private_label of Longident.t * type_expr
+ | Private_constructor of constructor_description * type_expr
+ | Unbound_instance_variable of string * string list
+ | Instance_variable_not_mutable of string
+ | Not_subtype of Errortrace.Subtype.error
+ | Outside_class
+ | Value_multiply_overridden of string
+ | Coercion_failure of
+ Errortrace.expanded_type * Errortrace.unification_error * bool
+ | Not_a_function of type_expr * type_forcing_context option
+ | Too_many_arguments of type_expr * type_forcing_context option
+ | Abstract_wrong_label of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ ; explanation : type_forcing_context option
+ }
+ | Scoping_let_module of string * type_expr
+ | Not_a_polymorphic_variant_type of Longident.t
+ | Incoherent_label_order
+ | Less_general of string * Errortrace.unification_error
+ | Modules_not_allowed
+ | Cannot_infer_signature
+ | Not_a_packed_module of type_expr
+ | Unexpected_existential of existential_restriction * string
+ | Invalid_interval
+ | Invalid_for_loop_index
+ | No_value_clauses
+ | Exception_pattern_disallowed
+ | Mixed_value_and_exception_patterns_under_guard
+ | Effect_pattern_below_toplevel
+ | Invalid_continuation_pattern
+ | Inlined_record_escape
+ | Inlined_record_expected
+ | Unrefuted_pattern of pattern
+ | Invalid_extension_constructor_payload
+ | Not_an_extension_constructor
+ | Literal_overflow of string
+ | Unknown_literal of string * char
+ | Illegal_letrec_pat
+ | Illegal_letrec_expr
+ | Illegal_class_expr
+ | Letop_type_clash of string * Errortrace.unification_error
+ | Andop_type_clash of string * Errortrace.unification_error
+ | Bindings_type_clash of Errortrace.unification_error
+ | Unbound_existential of Ident.t list * type_expr
+ | Bind_existential of existential_binding * Ident.t * type_expr
+ | Missing_type_constraint
+ | Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
+ | Expr_not_a_record_type of type_expr
+
+
+let not_principal fmt =
+ Format_doc.Doc.kmsg (fun x -> Warnings.Not_principal x) fmt
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+(* Forward declaration, to be filled in by Typemod.type_module *)
+
+let type_module =
+ ref ((fun _env _md -> assert false) :
+ Env.t -> Parsetree.module_expr -> Typedtree.module_expr * Shape.t)
+
+(* Forward declaration, to be filled in by Typemod.type_open *)
+
+let type_open :
+ (?used_slot:bool ref -> override_flag -> Env.t -> Location.t ->
+ Longident.t loc -> Path.t * Env.t)
+ ref =
+ ref (fun ?used_slot:_ _ -> assert false)
+
+let type_open_decl :
+ (?used_slot:bool ref -> Env.t -> Parsetree.open_declaration
+ -> open_declaration * Types.signature * Env.t)
+ ref =
+ ref (fun ?used_slot:_ _ -> assert false)
+
+(* Forward declaration, to be filled in by Typemod.type_package *)
+
+let type_package =
+ ref (fun _ -> assert false)
+
+(* Forward declaration, to be filled in by Typeclass.class_structure *)
+let type_object =
+ ref (fun _env _s -> assert false :
+ Env.t -> Location.t -> Parsetree.class_structure ->
+ Typedtree.class_structure * string list)
+
+(*
+ Saving and outputting type information.
+ We keep these function names short, because they have to be
+ called each time we create a record of type [Typedtree.expression]
+ or [Typedtree.pattern] that will end up in the typed AST.
+*)
+let re node =
+ Cmt_format.add_saved_type (Cmt_format.Partial_expression node);
+ node
+
+let rp node =
+ Cmt_format.add_saved_type (Cmt_format.Partial_pattern (Value, node));
+ node
+
+let rcp node =
+ Cmt_format.add_saved_type (Cmt_format.Partial_pattern (Computation, node));
+ node
+
+
+(* Context for inline record arguments; see [type_ident] *)
+
+type recarg =
+ | Allowed
+ | Required
+ | Rejected
+
+let mk_expected ?explanation ty = { ty; explanation; }
+
+let case lhs rhs =
+ {c_lhs = lhs; c_cont = None; c_guard = None; c_rhs = rhs}
+
+(* Typing of constants *)
+
+let type_constant = function
+ Const_int _ -> instance Predef.type_int
+ | Const_char _ -> instance Predef.type_char
+ | Const_string _ -> instance Predef.type_string
+ | Const_float _ -> instance Predef.type_float
+ | Const_int32 _ -> instance Predef.type_int32
+ | Const_int64 _ -> instance Predef.type_int64
+ | Const_nativeint _ -> instance Predef.type_nativeint
+
+let constant_desc
+ : Parsetree.constant_desc -> (Asttypes.constant, error) result =
+ function
+ | Pconst_integer (i,None) ->
+ begin
+ try Ok (Const_int (Misc.Int_literal_converter.int i))
+ with Failure _ -> Error (Literal_overflow "int")
+ end
+ | Pconst_integer (i,Some 'l') ->
+ begin
+ try Ok (Const_int32 (Misc.Int_literal_converter.int32 i))
+ with Failure _ -> Error (Literal_overflow "int32")
+ end
+ | Pconst_integer (i,Some 'L') ->
+ begin
+ try Ok (Const_int64 (Misc.Int_literal_converter.int64 i))
+ with Failure _ -> Error (Literal_overflow "int64")
+ end
+ | Pconst_integer (i,Some 'n') ->
+ begin
+ try Ok (Const_nativeint (Misc.Int_literal_converter.nativeint i))
+ with Failure _ -> Error (Literal_overflow "nativeint")
+ end
+ | Pconst_integer (i,Some c) -> Error (Unknown_literal (i, c))
+ | Pconst_char c -> Ok (Const_char c)
+ | Pconst_string (s,loc,d) -> Ok (Const_string (s,loc,d))
+ | Pconst_float (f,None)-> Ok (Const_float f)
+ | Pconst_float (f,Some c) -> Error (Unknown_literal (f, c))
+
+let constant const = constant_desc const.pconst_desc
+
+let constant_or_raise env loc cst =
+ match constant cst with
+ | Ok c -> c
+ | Error err -> raise (Error (loc, env, err))
+
+(* Specific version of type_option, using newty rather than newgenty *)
+
+let type_option ty =
+ newty (Tconstr(Predef.path_option,[ty], ref Mnil))
+
+let mkexp exp_desc exp_type exp_loc exp_env =
+ { exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] }
+
+let option_none env ty loc =
+ let lid = Longident.Lident "None" in
+ let cnone = Env.find_ident_constructor Predef.ident_none env in
+ mkexp (Texp_construct(mknoloc lid, cnone, [])) ty loc env
+
+let option_some env texp =
+ let lid = Longident.Lident "Some" in
+ let csome = Env.find_ident_constructor Predef.ident_some env in
+ mkexp ( Texp_construct(mknoloc lid , csome, [texp]) )
+ (type_option texp.exp_type) texp.exp_loc texp.exp_env
+
+let extract_option_type env ty =
+ match get_desc (expand_head env ty) with
+ Tconstr(path, [ty], _) when Path.same path Predef.path_option -> ty
+ | _ -> assert false
+
+let protect_expansion env ty =
+ if Env.has_local_constraints env then generic_instance ty else ty
+
+type record_extraction_result =
+ | Record_type of Path.t * Path.t * Types.label_declaration list
+ | Not_a_record_type
+ | Maybe_a_record_type
+
+let extract_concrete_typedecl_protected env ty =
+ extract_concrete_typedecl env (protect_expansion env ty)
+
+let extract_concrete_record env ty =
+ match extract_concrete_typedecl_protected env ty with
+ | Typedecl(p0, p, {type_kind=Type_record (fields, _)}) ->
+ Record_type (p0, p, fields)
+ | Has_no_typedecl | Typedecl(_, _, _) -> Not_a_record_type
+ | May_have_typedecl -> Maybe_a_record_type
+
+type variant_extraction_result =
+ | Variant_type of Path.t * Path.t * Types.constructor_declaration list
+ | Not_a_variant_type
+ | Maybe_a_variant_type
+
+let extract_concrete_variant env ty =
+ match extract_concrete_typedecl_protected env ty with
+ | Typedecl(p0, p, {type_kind=Type_variant (cstrs, _)}) ->
+ Variant_type (p0, p, cstrs)
+ | Typedecl(p0, p, {type_kind=Type_open}) ->
+ Variant_type (p0, p, [])
+ | Has_no_typedecl | Typedecl(_, _, _) -> Not_a_variant_type
+ | May_have_typedecl -> Maybe_a_variant_type
+
+let extract_label_names env ty =
+ match extract_concrete_record env ty with
+ | Record_type (_, _,fields) -> List.map (fun l -> l.Types.ld_id) fields
+ | Not_a_record_type | Maybe_a_record_type -> assert false
+
+let is_principal ty =
+ not !Clflags.principal || get_level ty = generic_level
+
+(* Typing of patterns *)
+
+(* Simplified patterns for effect continuations *)
+let type_continuation_pat env expected_ty sp =
+ let loc = sp.ppat_loc in
+ match sp.ppat_desc with
+ | Ppat_any -> None
+ | Ppat_var name ->
+ let id = Ident.create_local name.txt in
+ let desc =
+ { val_type = expected_ty; val_kind = Val_reg;
+ Types.val_loc = loc; val_attributes = [];
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()); }
+ in
+ Some (id, desc)
+ | Ppat_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+ | _ -> raise (Error (loc, env, Invalid_continuation_pattern))
+
+(* unification inside type_exp and type_expect *)
+let unify_exp_types loc env ty expected_ty =
+ (* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type
+ Printtyp.raw_type_expr expected_ty; *)
+ try
+ unify env ty expected_ty
+ with
+ Unify err ->
+ raise(Error(loc, env, Expr_type_clash(err, None, None)))
+ | Tags(l1,l2) ->
+ raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2)))
+
+(* helper notation for Pattern_env.t *)
+let (!!) (penv : Pattern_env.t) = penv.env
+
+(* Unification inside type_pat *)
+let unify_pat_types loc env ty ty' =
+ try unify env ty ty' with
+ | Unify err ->
+ raise(Error(loc, env, Pattern_type_clash(err, None)))
+ | Tags(l1,l2) ->
+ raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2)))
+
+(* GADT unification inside solve_Ppat_construct and check_counter_example_pat *)
+let nothing_equated = TypePairs.create 0
+let unify_pat_types_return_equated_pairs ~refine loc penv ty ty' =
+ try
+ if refine then unify_gadt penv ty ty'
+ else (unify !!penv ty ty'; nothing_equated)
+ with
+ | Unify err ->
+ raise(Error(loc, !!penv, Pattern_type_clash(err, None)))
+ | Tags(l1,l2) ->
+ raise(Typetexp.Error(loc, !!penv, Typetexp.Variant_tags (l1, l2)))
+
+let unify_pat_types_refine ~refine loc penv ty ty' =
+ (* [refine=true] only in calls originating from [check_counter_example_pat],
+ which in turn may contain only non-leaking type variables *)
+ ignore (unify_pat_types_return_equated_pairs ~refine loc penv ty ty')
+
+(** [sdesc_for_hint] is used by error messages to report literals in their
+ original formatting *)
+let unify_pat ?sdesc_for_hint env pat expected_ty =
+ try unify_pat_types pat.pat_loc env pat.pat_type expected_ty
+ with Error (loc, env, Pattern_type_clash(err, None)) ->
+ raise(Error(loc, env, Pattern_type_clash(err, sdesc_for_hint)))
+
+(* unification of a type with a Tconstr with freshly created arguments *)
+let unify_head_only ~refine loc penv ty constr =
+ let path = cstr_type_path constr in
+ let decl = Env.find_type path !!penv in
+ let ty' = Ctype.newconstr path (Ctype.instance_list decl.type_params) in
+ unify_pat_types_refine ~refine loc penv ty' ty
+
+(* Creating new conjunctive types is not allowed when typing patterns *)
+(* make all Reither present in open variants *)
+let finalize_variant pat tag opat r =
+ let row =
+ match get_desc (expand_head pat.pat_env pat.pat_type) with
+ Tvariant row -> r := row; row
+ | _ -> assert false
+ in
+ let f = get_row_field tag row in
+ begin match row_field_repr f with
+ | Rabsent -> () (* assert false *)
+ | Reither (true, [], _) when not (row_closed row) ->
+ link_row_field_ext ~inside:f (rf_present None)
+ | Reither (false, ty::tl, _) when not (row_closed row) ->
+ link_row_field_ext ~inside:f (rf_present (Some ty));
+ begin match opat with None -> assert false
+ | Some pat -> List.iter (unify_pat pat.pat_env pat) (ty::tl)
+ end
+ | Reither (c, _l, true) when not (has_fixed_explanation row) ->
+ link_row_field_ext ~inside:f (rf_either [] ~no_arg:c ~matched:false)
+ | _ -> ()
+ end
+ (* Force check of well-formedness WHY? *)
+ (* unify_pat pat.pat_env pat
+ (newty(Tvariant{row_fields=[]; row_more=newvar(); row_closed=false;
+ row_bound=(); row_fixed=false; row_name=None})); *)
+
+let has_variants p =
+ exists_general_pattern
+ { f = fun (type k) (p : k general_pattern) -> match p.pat_desc with
+ | (Tpat_variant _) -> true
+ | _ -> false } p
+
+let finalize_variants p =
+ iter_general_pattern
+ { f = fun (type k) (p : k general_pattern) -> match p.pat_desc with
+ | Tpat_variant(tag, opat, r) ->
+ finalize_variant p tag opat r
+ | _ -> () } p
+
+(* [type_pat_state] and related types for pattern environment;
+ these should not be confused with Pattern_env.t, which is a part of the
+ interface to unification functions in [Ctype] *)
+type pattern_variable_kind =
+ | Std_var
+ | As_var
+ | Continuation_var
+
+type pattern_variable =
+ {
+ pv_id: Ident.t;
+ pv_type: type_expr;
+ pv_loc: Location.t;
+ pv_kind: pattern_variable_kind;
+ pv_attributes: attributes;
+ pv_uid : Uid.t;
+ }
+
+type module_variable =
+ {
+ mv_id: Ident.t;
+ mv_name: string Location.loc;
+ mv_loc: Location.t;
+ mv_uid: Uid.t
+ }
+
+(* Whether or not patterns of the form (module M) are accepted. (If they are,
+ the idents will be created at the provided scope.) When module patterns are
+ allowed, the caller should take care to check that the introduced module
+ bindings' types don't escape their scope; see the callsites in [type_let]
+ and [type_cases] for examples.
+ [Modules_ignored] indicates that the typing of patterns should not accumulate
+ a list of module patterns to unpack. It's no different than using
+ [Modules_allowed] and then ignoring the accumulated [module_variables] list,
+ but signals more clearly that the module patterns aren't used in an
+ interesting way.
+*)
+type module_patterns_restriction =
+ | Modules_allowed of { scope: int }
+ | Modules_rejected
+ | Modules_ignored
+
+(* A parallel type to [module_patterns_restriction], though also
+ tracking the module variables encountered.
+*)
+type module_variables =
+ | Modvars_allowed of
+ { scope: int;
+ module_variables: module_variable list;
+ }
+ | Modvars_rejected
+ | Modvars_ignored
+
+type type_pat_state =
+ { mutable tps_pattern_variables: pattern_variable list;
+ mutable tps_pattern_force: (unit -> unit) list;
+ mutable tps_module_variables: module_variables;
+ (* Mutation will not change the constructor of [tps_module_variables], just
+ the contained [module_variables] list. [module_variables] could be made
+ mutable instead, but we felt this made the code more awkward.
+ *)
+ }
+
+let continuation_variable = function
+ | None -> []
+ | Some (id, (desc:Types.value_description)) ->
+ [{pv_id = id;
+ pv_type = desc.val_type;
+ pv_loc = desc.val_loc;
+ pv_kind = Continuation_var;
+ pv_attributes = desc.val_attributes;
+ pv_uid= desc.val_uid}]
+
+let create_type_pat_state ?cont allow_modules =
+ let tps_module_variables =
+ match allow_modules with
+ | Modules_allowed { scope } ->
+ Modvars_allowed { scope; module_variables = [] }
+ | Modules_ignored -> Modvars_ignored
+ | Modules_rejected -> Modvars_rejected
+ in
+ { tps_pattern_variables = continuation_variable cont;
+ tps_module_variables;
+ tps_pattern_force = [];
+ }
+
+(* Copy mutable fields. Used in typechecking or-patterns. *)
+let copy_type_pat_state
+ { tps_pattern_variables;
+ tps_module_variables;
+ tps_pattern_force;
+ }
+ =
+ { tps_pattern_variables;
+ tps_module_variables;
+ tps_pattern_force;
+ }
+
+let blit_type_pat_state ~src ~dst =
+ dst.tps_pattern_variables <- src.tps_pattern_variables;
+ dst.tps_module_variables <- src.tps_module_variables;
+ dst.tps_pattern_force <- src.tps_pattern_force;
+;;
+
+let maybe_add_pattern_variables_ghost loc_let env pv =
+ List.fold_right
+ (fun {pv_id; _} env ->
+ let name = Ident.name pv_id in
+ if Env.bound_value name env then env
+ else begin
+ Env.enter_unbound_value name
+ (Val_unbound_ghost_recursive loc_let) env
+ end
+ ) pv env
+
+let enter_variable ?(is_module=false) ?(is_as_variable=false) tps loc name ty
+ attrs =
+ if List.exists (fun {pv_id; _} -> Ident.name pv_id = name.txt)
+ tps.tps_pattern_variables
+ then raise(Error(loc, Env.empty, Multiply_bound_variable name.txt));
+ let id =
+ if is_module then begin
+ (* Unpack patterns result in both a module declaration and a value
+ variable of the same name being entered into the environment. (The
+ module is via [tps_module_variables], and the variable is via
+ [tps_pattern_variables].) *)
+ match tps.tps_module_variables with
+ | Modvars_ignored -> Ident.create_local name.txt
+ | Modvars_rejected ->
+ raise (Error (loc, Env.empty, Modules_not_allowed));
+ | Modvars_allowed { scope; module_variables } ->
+ let id = Ident.create_scoped name.txt ~scope in
+ let module_variables =
+ { mv_id = id;
+ mv_name = name;
+ mv_loc = loc;
+ mv_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ } :: module_variables
+ in
+ tps.tps_module_variables <-
+ Modvars_allowed { scope; module_variables; };
+ id
+ end else
+ Ident.create_local name.txt
+ in
+ let pv_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
+ tps.tps_pattern_variables <-
+ {pv_id = id;
+ pv_type = ty;
+ pv_loc = loc;
+ pv_kind = if is_as_variable then As_var else Std_var;
+ pv_attributes = attrs;
+ pv_uid} :: tps.tps_pattern_variables;
+ id, pv_uid
+
+let sort_pattern_variables vs =
+ List.sort
+ (fun {pv_id = x; _} {pv_id = y; _} ->
+ Stdlib.compare (Ident.name x) (Ident.name y))
+ vs
+
+let enter_orpat_variables loc env p1_vs p2_vs =
+ (* unify_vars operate on sorted lists *)
+
+ let p1_vs = sort_pattern_variables p1_vs
+ and p2_vs = sort_pattern_variables p2_vs in
+
+ let rec unify_vars p1_vs p2_vs =
+ let vars vs = List.map (fun {pv_id; _} -> pv_id) vs in
+ match p1_vs, p2_vs with
+ | {pv_id = x1; pv_type = t1; _}::rem1, {pv_id = x2; pv_type = t2; _}::rem2
+ when Ident.equal x1 x2 ->
+ if x1==x2 then
+ unify_vars rem1 rem2
+ else begin
+ begin try
+ unify_var env (newvar ()) t1;
+ unify env t1 t2
+ with
+ | Unify err ->
+ raise(Error(loc, env, Or_pattern_type_clash(x1, err)))
+ end;
+ (x2,x1)::unify_vars rem1 rem2
+ end
+ | [],[] -> []
+ | {pv_id; _}::_, [] | [],{pv_id; _}::_ ->
+ raise (Error (loc, env, Orpat_vars (pv_id, [])))
+ | {pv_id = x; _}::_, {pv_id = y; _}::_ ->
+ let err =
+ if Ident.name x < Ident.name y
+ then Orpat_vars (x, vars p2_vs)
+ else Orpat_vars (y, vars p1_vs) in
+ raise (Error (loc, env, err)) in
+ unify_vars p1_vs p2_vs
+
+let rec build_as_type (env : Env.t) p =
+ build_as_type_extra env p p.pat_extra
+
+and build_as_type_extra env p = function
+ | [] -> build_as_type_aux env p
+ | ((Tpat_type _ | Tpat_open _ | Tpat_unpack), _, _) :: rest ->
+ build_as_type_extra env p rest
+ | (Tpat_constraint {ctyp_type = ty; _}, _, _) :: rest ->
+ (* If the type constraint is ground, then this is the best type
+ we can return, so just return an instance (cf. #12313) *)
+ if closed_type_expr ty then instance ty else
+ (* Otherwise we combine the inferred type for the pattern with
+ then non-ground constraint in a non-ambivalent way *)
+ let as_ty = build_as_type_extra env p rest in
+ (* [generic_instance] can only be used if the variables of the original
+ type ([cty.ctyp_type] here) are not at [generic_level], which they are
+ here.
+ If we used [generic_instance] we would lose the sharing between
+ [instance ty] and [ty]. *)
+ let ty =
+ with_local_level_generalize_structure (fun () -> instance ty)
+ in
+ (* This call to unify may only fail due to missing GADT equations *)
+ unify_pat_types p.pat_loc env (instance as_ty) (instance ty);
+ ty
+
+and build_as_type_aux (env : Env.t) p =
+ match p.pat_desc with
+ Tpat_alias(p1,_, _, _) -> build_as_type env p1
+ | Tpat_tuple pl ->
+ let tyl = List.map (build_as_type env) pl in
+ newty (Ttuple tyl)
+ | Tpat_construct(_, cstr, pl, vto) ->
+ let keep =
+ cstr.cstr_private = Private || cstr.cstr_existentials <> [] ||
+ vto <> None (* be lazy and keep the type for node constraints *) in
+ if keep then p.pat_type else
+ let tyl = List.map (build_as_type env) pl in
+ let ty_args, ty_res, _ =
+ instance_constructor Keep_existentials_flexible cstr
+ in
+ List.iter2 (fun (p,ty) -> unify_pat env {p with pat_type = ty})
+ (List.combine pl tyl) ty_args;
+ ty_res
+ | Tpat_variant(l, p', _) ->
+ let ty = Option.map (build_as_type env) p' in
+ let fields = [l, rf_present ty] in
+ newty (Tvariant (create_row ~fields ~more:(newvar())
+ ~name:None ~fixed:None ~closed:false))
+ | Tpat_record (lpl,_) ->
+ let lbl = snd3 (List.hd lpl) in
+ if lbl.lbl_private = Private then p.pat_type else
+ let ty = newvar () in
+ let ppl = List.map (fun (_, l, p) -> l.lbl_pos, p) lpl in
+ let do_label lbl =
+ let _, ty_arg, ty_res = instance_label ~fixed:false lbl in
+ unify_pat env {p with pat_type = ty} ty_res;
+ let refinable =
+ lbl.lbl_mut = Immutable && List.mem_assoc lbl.lbl_pos ppl &&
+ match get_desc lbl.lbl_arg with Tpoly _ -> false | _ -> true in
+ if refinable then begin
+ let arg = List.assoc lbl.lbl_pos ppl in
+ unify_pat env {arg with pat_type = build_as_type env arg} ty_arg
+ end else begin
+ let _, ty_arg', ty_res' = instance_label ~fixed:false lbl in
+ unify_pat_types p.pat_loc env ty_arg ty_arg';
+ unify_pat env p ty_res'
+ end in
+ Array.iter do_label lbl.lbl_all;
+ ty
+ | Tpat_or(p1, p2, row) ->
+ begin match row with
+ None ->
+ let ty1 = build_as_type env p1 and ty2 = build_as_type env p2 in
+ unify_pat env {p2 with pat_type = ty2} ty1;
+ ty1
+ | Some row ->
+ let Row {fields; fixed; name} = row_repr row in
+ newty (Tvariant (create_row ~fields ~fixed ~name
+ ~closed:false ~more:(newvar())))
+ end
+ | Tpat_any | Tpat_var _ | Tpat_constant _
+ | Tpat_array _ | Tpat_lazy _ -> p.pat_type
+
+(* Constraint solving during typing of patterns *)
+
+let solve_Ppat_poly_constraint tps env loc sty expected_ty =
+ let cty, ty, force = Typetexp.transl_simple_type_delayed env sty in
+ unify_pat_types loc env ty (instance expected_ty);
+ tps.tps_pattern_force <- force :: tps.tps_pattern_force;
+ match get_desc ty with
+ | Tpoly (body, tyl) ->
+ let _, ty' =
+ with_level ~level:generic_level
+ (fun () -> instance_poly ~keep_names:true ~fixed:false tyl body)
+ in
+ (cty, ty, ty')
+ | _ -> assert false
+
+let solve_Ppat_alias env pat =
+ with_local_level_generalize (fun () -> build_as_type env pat)
+
+let solve_Ppat_tuple (type a) ~refine loc env (args : a list) expected_ty =
+ let vars = List.map (fun _ -> newgenvar ()) args in
+ let ty = newgenty (Ttuple vars) in
+ let expected_ty = generic_instance expected_ty in
+ unify_pat_types_refine ~refine loc env ty expected_ty;
+ vars
+
+let solve_constructor_annotation
+ tps (penv : Pattern_env.t) name_list sty ty_args ty_ex unify_res =
+ let expansion_scope = penv.equations_scope in
+ (* Introduce fresh type names that expand to type variables.
+ They should eventually be bound to ground types. *)
+ let ids_decls =
+ List.map
+ (fun name ->
+ let tv = newvar () in
+ let decl =
+ new_local_type ~loc:name.loc Definition
+ ~manifest_and_scope:(tv, Ident.lowest_scope) in
+ let (id, new_env) =
+ Env.enter_type ~scope:expansion_scope name.txt decl !!penv in
+ Pattern_env.set_env penv new_env;
+ ({name with txt = id}, (decl, tv)))
+ name_list
+ in
+ (* Translate the type annotation using these type names. *)
+ let cty, ty, force =
+ with_local_level_generalize_structure
+ (fun () -> Typetexp.transl_simple_type_delayed !!penv sty)
+ in
+ tps.tps_pattern_force <- force :: tps.tps_pattern_force;
+ (* Only unify the return type after generating the ids *)
+ unify_res ();
+ let ty_args =
+ let ty1 = instance ty and ty2 = instance ty in
+ match ty_args with
+ [] -> assert false
+ | [ty_arg] ->
+ unify_pat_types cty.ctyp_loc !!penv ty1 ty_arg;
+ [ty2]
+ | _ ->
+ unify_pat_types cty.ctyp_loc !!penv ty1 (newty (Ttuple ty_args));
+ match get_desc (expand_head !!penv ty2) with
+ Ttuple tyl -> tyl
+ | _ -> assert false
+ in
+ if ids_decls <> [] then begin
+ let ids_decls = List.map (fun (x,dm) -> (x.txt,dm)) ids_decls in
+ let ids = List.map fst ids_decls in
+ let rem =
+ (* First process the existentials introduced by this constructor.
+ Just need to make their definitions abstract. *)
+ List.fold_left
+ (fun rem tv ->
+ match get_desc tv with
+ Tconstr(Path.Pident id, [], _) when List.mem_assoc id rem ->
+ let decl, tv' = List.assoc id ids_decls in
+ let env =
+ Env.add_type ~check:false id
+ {decl with type_manifest = None} !!penv
+ in
+ Pattern_env.set_env penv env;
+ (* We have changed the definition, so clean up *)
+ Btype.cleanup_abbrev ();
+ (* Since id is now abstract, this does not create a cycle *)
+ unify_pat_types cty.ctyp_loc env tv tv';
+ List.remove_assoc id rem
+ | _ ->
+ raise (Error (cty.ctyp_loc, !!penv,
+ Unbound_existential (ids, ty))))
+ ids_decls ty_ex
+ in
+ (* The other type names should be bound to newly introduced existentials. *)
+ let bound_ids = ref ids in
+ List.iter
+ (fun (id, (decl, tv')) ->
+ let tv' = expand_head !!penv tv' in
+ begin match get_desc tv' with
+ | Tconstr (Path.Pident id', [], _) ->
+ if List.exists (Ident.same id') !bound_ids then
+ raise (Error (cty.ctyp_loc, !!penv,
+ Bind_existential (Bind_already_bound, id, tv')));
+ (* Both id and id' are Scoped identifiers, so their stamps grow *)
+ if Ident.scope id' <> penv.equations_scope
+ || Ident.compare_stamp id id' > 0 then
+ raise (Error (cty.ctyp_loc, !!penv,
+ Bind_existential (Bind_not_in_scope, id, tv')));
+ bound_ids := id' :: !bound_ids
+ | _ ->
+ raise (Error (cty.ctyp_loc, !!penv,
+ Bind_existential
+ (Bind_non_locally_abstract, id, tv')));
+ end;
+ let env =
+ Env.add_type ~check:false id
+ {decl with type_manifest = Some (duplicate_type tv')} !!penv
+ in
+ Pattern_env.set_env penv env)
+ rem;
+ if rem <> [] then Btype.cleanup_abbrev ();
+ end;
+ ty_args, Some (List.map fst ids_decls, cty)
+
+let solve_Ppat_construct ~refine tps penv loc constr no_existentials
+ existential_styp expected_ty =
+ (* if constructor is gadt, we must verify that the expected type has the
+ correct head *)
+ if constr.cstr_generalized then
+ unify_head_only ~refine loc penv (instance expected_ty) constr;
+
+ (* PR#7214: do not use gadt unification for toplevel lets *)
+ let unify_res ty_res expected_ty =
+ let refine =
+ refine || constr.cstr_generalized && no_existentials = None in
+ (* Here [ty_res] contains only fresh (non-leaking) type variables,
+ so the requirement of [unify_gadt] is fulfilled. *)
+ unify_pat_types_return_equated_pairs ~refine loc penv ty_res expected_ty
+ in
+
+ let ty_args, equated_types, existential_ctyp =
+ with_local_level_generalize_structure begin fun () ->
+ let expected_ty = instance expected_ty in
+ let ty_args, ty_res, equated_types, existential_ctyp =
+ match existential_styp with
+ None ->
+ let ty_args, ty_res, _ =
+ instance_constructor (Make_existentials_abstract penv) constr
+ in
+ ty_args, ty_res, unify_res ty_res expected_ty, None
+ | Some (name_list, sty) ->
+ let existential_treatment =
+ if name_list = [] then
+ Make_existentials_abstract penv
+ else
+ (* we will unify them (in solve_constructor_annotation) with the
+ local types provided by the user *)
+ Keep_existentials_flexible
+ in
+ let ty_args, ty_res, ty_ex =
+ instance_constructor existential_treatment constr
+ in
+ let equated_types = lazy (unify_res ty_res expected_ty) in
+ let ty_args, existential_ctyp =
+ solve_constructor_annotation tps penv name_list sty ty_args ty_ex
+ (fun () -> ignore (Lazy.force equated_types))
+ in
+ ty_args, ty_res, Lazy.force equated_types, existential_ctyp
+ in
+ if constr.cstr_existentials <> [] then
+ lower_variables_only !!penv penv.Pattern_env.equations_scope ty_res;
+ (ty_args, equated_types, existential_ctyp)
+ end
+ in
+ if !Clflags.principal && not refine then begin
+ (* Do not warn for counter-examples *)
+ let exception Warn_only_once in
+ try
+ TypePairs.iter
+ (fun (t1, t2) ->
+ if not (fully_generic t1 && fully_generic t2) then
+ let msg =
+ Format_doc.doc_printf
+ "typing this pattern requires considering@ %a@ and@ %a@ as \
+ equal.@,\
+ But the knowledge of these types"
+ Printtyp.Doc.type_expr t1
+ Printtyp.Doc.type_expr t2
+ in
+ Location.prerr_warning loc (Warnings.Not_principal msg);
+ raise Warn_only_once)
+ equated_types
+ with Warn_only_once -> ()
+ end;
+ (ty_args, existential_ctyp)
+
+let solve_Ppat_record_field ~refine loc penv label label_lid record_ty =
+ with_local_level_generalize_structure begin fun () ->
+ let (_, ty_arg, ty_res) = instance_label ~fixed:false label in
+ begin try
+ unify_pat_types_refine ~refine loc penv ty_res (instance record_ty)
+ with Error(_loc, _env, Pattern_type_clash(err, _)) ->
+ raise(Error(label_lid.loc, !!penv,
+ Label_mismatch(label_lid.txt, err)))
+ end;
+ ty_arg
+ end
+
+let solve_Ppat_array ~refine loc env expected_ty =
+ let ty_elt = newgenvar() in
+ let expected_ty = generic_instance expected_ty in
+ unify_pat_types_refine ~refine
+ loc env (Predef.type_array ty_elt) expected_ty;
+ ty_elt
+
+let solve_Ppat_lazy ~refine loc env expected_ty =
+ let nv = newgenvar () in
+ unify_pat_types_refine ~refine loc env (Predef.type_lazy_t nv)
+ (generic_instance expected_ty);
+ nv
+
+let solve_Ppat_constraint tps loc env sty expected_ty =
+ let cty, ty, force =
+ with_local_level_generalize_structure
+ (fun () -> Typetexp.transl_simple_type_delayed env sty)
+ in
+ tps.tps_pattern_force <- force :: tps.tps_pattern_force;
+ let ty, expected_ty' = instance ty, ty in
+ unify_pat_types loc env ty (instance expected_ty);
+ (cty, ty, expected_ty')
+
+let solve_Ppat_variant ~refine loc env tag no_arg expected_ty =
+ let arg_type = if no_arg then [] else [newgenvar()] in
+ let fields = [tag, rf_either ~no_arg arg_type ~matched:true] in
+ let make_row more =
+ create_row ~fields ~closed:false ~more ~fixed:None ~name:None
+ in
+ let row = make_row (newgenvar ()) in
+ let expected_ty = generic_instance expected_ty in
+ (* PR#7404: allow some_private_tag blindly, as it would not unify with
+ the abstract row variable *)
+ if tag <> Parmatch.some_private_tag then
+ unify_pat_types_refine ~refine loc env (newgenty(Tvariant row)) expected_ty;
+ (arg_type, make_row (newvar ()), instance expected_ty)
+
+(* Building the or-pattern corresponding to a polymorphic variant type *)
+let build_or_pat env loc lid =
+ let path, decl = Env.lookup_type ~loc:lid.loc lid.txt env in
+ let tyl = List.map (fun _ -> newvar()) decl.type_params in
+ let row0 =
+ let ty = expand_head env (newty(Tconstr(path, tyl, ref Mnil))) in
+ match get_desc ty with
+ Tvariant row when static_row row -> row
+ | _ -> raise(Error(lid.loc, env, Not_a_polymorphic_variant_type lid.txt))
+ in
+ let pats, fields =
+ List.fold_left
+ (fun (pats,fields) (l,f) ->
+ match row_field_repr f with
+ Rpresent None ->
+ let f = rf_either [] ~no_arg:true ~matched:true in
+ (l,None) :: pats,
+ (l, f) :: fields
+ | Rpresent (Some ty) ->
+ let f = rf_either [ty] ~no_arg:false ~matched:true in
+ (l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env;
+ pat_type=ty; pat_extra=[]; pat_attributes=[]})
+ :: pats,
+ (l, f) :: fields
+ | _ -> pats, fields)
+ ([],[]) (row_fields row0) in
+ let fields = List.rev fields in
+ let name = Some (path, tyl) in
+ let make_row more =
+ create_row ~fields ~more ~closed:false ~fixed:None ~name in
+ let ty = newty (Tvariant (make_row (newvar()))) in
+ let gloc = {loc with Location.loc_ghost=true} in
+ let row' = ref (make_row (newvar())) in
+ let pats =
+ List.map
+ (fun (l,p) ->
+ {pat_desc=Tpat_variant(l,p,row'); pat_loc=gloc;
+ pat_env=env; pat_type=ty; pat_extra=[]; pat_attributes=[]})
+ pats
+ in
+ match pats with
+ [] ->
+ (* empty polymorphic variants: not possible with the concrete language
+ but valid at the ast level *)
+ raise(Error(lid.loc, env, Not_a_polymorphic_variant_type lid.txt))
+ | pat :: pats ->
+ let r =
+ List.fold_left
+ (fun pat pat0 ->
+ {pat_desc=Tpat_or(pat0,pat,Some row0); pat_extra=[];
+ pat_loc=gloc; pat_env=env; pat_type=ty; pat_attributes=[]})
+ pat pats in
+ (path, rp { r with pat_loc = loc })
+
+(* Type paths *)
+
+let rec expand_path env p =
+ let decl =
+ try Some (Env.find_type p env) with Not_found -> None
+ in
+ match decl with
+ Some {type_manifest = Some ty} ->
+ begin match get_desc ty with
+ Tconstr(p,_,_) -> expand_path env p
+ | _ -> assert false
+ end
+ | _ ->
+ let p' = Env.normalize_type_path None env p in
+ if Path.same p p' then p else expand_path env p'
+
+let compare_type_path env tpath1 tpath2 =
+ Path.same (expand_path env tpath1) (expand_path env tpath2)
+
+(* Records *)
+exception Wrong_name_disambiguation of Env.t * wrong_name
+
+let get_constr_type_path ty =
+ match get_desc ty with
+ | Tconstr(p, _, _) -> p
+ | _ -> assert false
+
+module NameChoice(Name : sig
+ type t
+ type usage
+ val kind: Datatype_kind.t
+ val get_name: t -> string
+ val get_type: t -> type_expr
+ val lookup_all_from_type:
+ Location.t -> usage -> Path.t -> Env.t -> (t * (unit -> unit)) list
+
+ (** Some names (for example the fields of inline records) are not
+ in the typing environment -- they behave as structural labels
+ rather than nominal labels.*)
+ val in_env: t -> bool
+end) = struct
+ open Name
+
+ let get_type_path d = get_constr_type_path (get_type d)
+
+ let lookup_from_type env type_path usage lid =
+ let descrs = lookup_all_from_type lid.loc usage type_path env in
+ match lid.txt with
+ | Longident.Lident name -> begin
+ match
+ List.find (fun (nd, _) -> get_name nd = name) descrs
+ with
+ | descr, use ->
+ use ();
+ descr
+ | exception Not_found ->
+ let valid_names = List.map (fun (nd, _) -> get_name nd) descrs in
+ raise (Wrong_name_disambiguation (env, {
+ type_path;
+ name = { lid with txt = name };
+ kind;
+ valid_names;
+ }))
+ end
+ | _ -> raise Not_found
+
+ let rec unique eq acc = function
+ [] -> List.rev acc
+ | x :: rem ->
+ if List.exists (eq x) acc then unique eq acc rem
+ else unique eq (x :: acc) rem
+
+ let ambiguous_types env lbl others =
+ let tpath = get_type_path lbl in
+ let others =
+ List.map (fun (lbl, _) -> get_type_path lbl) others in
+ let tpaths = unique (compare_type_path env) [tpath] others in
+ match tpaths with
+ [_] -> []
+ | _ -> let open Printtyp in
+ wrap_printing_env ~error:true env (fun () ->
+ Out_type.reset(); strings_of_paths Type tpaths)
+
+ let disambiguate_by_type env tpath lbls =
+ match lbls with
+ | (Error _ : _ result) -> raise Not_found
+ | Ok lbls ->
+ let check_type (lbl, _) =
+ let lbl_tpath = get_type_path lbl in
+ compare_type_path env tpath lbl_tpath
+ in
+ List.find check_type lbls
+
+ (* warn if there are several distinct candidates in scope *)
+ let warn_if_ambiguous warn lid env lbl rest =
+ if Warnings.is_active (Ambiguous_name ([],[],false,"")) then begin
+ Out_type.Ident_conflicts.reset ();
+ let paths = ambiguous_types env lbl rest in
+ let expansion = match Out_type.Ident_conflicts.err_msg () with
+ | None -> ""
+ | Some msg -> Format_doc.(asprintf "%a" pp_doc) msg
+ in
+ if paths <> [] then
+ warn lid.loc
+ (Warnings.Ambiguous_name ([Longident.last lid.txt],
+ paths, false, expansion))
+ end
+
+ (* a non-principal type was used for disambiguation *)
+ let warn_non_principal warn lid =
+ let name = Datatype_kind.label_name kind in
+ warn lid.loc
+ (not_principal "this type-based %s disambiguation" name)
+
+ (* we selected a name out of the lexical scope *)
+ let warn_out_of_scope warn lid env tpath =
+ if Warnings.is_active (Name_out_of_scope ("",[],false)) then begin
+ let path_s =
+ Printtyp.wrap_printing_env ~error:true env
+ (fun () -> Format_doc.asprintf "%a" Printtyp.Doc.type_path tpath)
+ in
+ warn lid.loc
+ (Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
+ end
+
+ (* warn if the selected name is not the last introduced in scope
+ -- in these cases the resolution is different from pre-disambiguation OCaml
+ (this warning is not enabled by default, it is specifically for people
+ wishing to write backward-compatible code).
+ *)
+ let warn_if_disambiguated_name warn lid lbl scope =
+ match scope with
+ | Ok ((lab1,_) :: _) when lab1 == lbl -> ()
+ | _ ->
+ warn lid.loc
+ (Warnings.Disambiguated_name (get_name lbl))
+
+ let force_error : ('a, _) result -> 'a = function
+ | Ok lbls -> lbls
+ | Error (loc', env', err) ->
+ Env.lookup_error loc' env' err
+
+ type candidate = t * (unit -> unit)
+ type nonempty_candidate_filter =
+ candidate list -> (candidate list, candidate list) result
+ (** This type is used for candidate filtering functions.
+ Filtering typically proceeds in several passes, filtering
+ candidates through increasingly precise conditions.
+
+ We assume that the input list is non-empty, and the output is one of
+ - [Ok result] for a non-empty list [result] of valid candidates
+ - [Error candidates] with there are no valid candidates,
+ and [candidates] is a non-empty subset of the input, typically
+ the result of the last non-empty filtering step.
+ *)
+
+ (** [disambiguate] selects a concrete description for [lid] using
+ some contextual information:
+ - An optional [expected_type].
+ - A list of candidates labels in the current lexical scope,
+ [candidates_in_scope], that is actually at the type
+ [(label_descr list, lookup_error) result] so that the
+ lookup error is only raised when necessary.
+ - A filtering criterion on candidates in scope [filter_candidates],
+ representing extra contextual information that can help
+ candidate selection (see [disambiguate_label_by_ids]).
+ *)
+ let disambiguate
+ ?(warn=Location.prerr_warning)
+ ?(filter : nonempty_candidate_filter = Result.ok)
+ usage lid env
+ expected_type
+ candidates_in_scope =
+ let lbl = match expected_type with
+ | None ->
+ (* no expected type => no disambiguation *)
+ begin match filter (force_error candidates_in_scope) with
+ | Ok [] | Error [] -> assert false
+ | Error((lbl, _use) :: _rest) -> lbl (* will fail later *)
+ | Ok((lbl, use) :: rest) ->
+ use ();
+ warn_if_ambiguous warn lid env lbl rest;
+ lbl
+ end
+ | Some(tpath0, tpath, principal) ->
+ (* If [expected_type] is available, the candidate selected
+ will correspond to the type-based resolution.
+ There are two reasons to still check the lexical scope:
+ - for warning purposes
+ - for extension types, the type environment does not contain
+ a list of constructors, so using only type-based selection
+ would fail.
+ *)
+ (* note that [disambiguate_by_type] does not
+ force [candidates_in_scope]: we just skip this case if there
+ are no candidates in scope *)
+ begin match disambiguate_by_type env tpath candidates_in_scope with
+ | lbl, use ->
+ use ();
+ if not principal then begin
+ (* Check if non-principal type is affecting result *)
+ match (candidates_in_scope : _ result) with
+ | Error _ -> warn_non_principal warn lid
+ | Ok lbls ->
+ match filter lbls with
+ | Error _ -> warn_non_principal warn lid
+ | Ok [] -> assert false
+ | Ok ((lbl', _use') :: rest) ->
+ let lbl_tpath = get_type_path lbl' in
+ (* no principality warning if the non-principal
+ type-based selection corresponds to the last
+ definition in scope *)
+ if not (compare_type_path env tpath lbl_tpath)
+ then warn_non_principal warn lid
+ else warn_if_ambiguous warn lid env lbl rest;
+ end;
+ lbl
+ | exception Not_found ->
+ (* look outside the lexical scope *)
+ match lookup_from_type env tpath usage lid with
+ | lbl ->
+ (* warn only on nominal labels;
+ structural labels cannot be qualified anyway *)
+ if in_env lbl then warn_out_of_scope warn lid env tpath;
+ if not principal then warn_non_principal warn lid;
+ lbl
+ | exception Not_found ->
+ match filter (force_error candidates_in_scope) with
+ | Ok lbls | Error lbls ->
+ let tp = (tpath0, expand_path env tpath) in
+ let tpl =
+ List.map
+ (fun (lbl, _) ->
+ let tp0 = get_type_path lbl in
+ let tp = expand_path env tp0 in
+ (tp0, tp))
+ lbls
+ in
+ raise (Error (lid.loc, env,
+ Name_type_mismatch (kind, lid.txt, tp, tpl)));
+ end
+ in
+ (* warn only on nominal labels *)
+ if in_env lbl then
+ warn_if_disambiguated_name warn lid lbl candidates_in_scope;
+ lbl
+end
+
+let wrap_disambiguate msg ty f x =
+ try f x with
+ | Wrong_name_disambiguation (env, wrong_name) ->
+ raise (Error (wrong_name.name.loc, env, Wrong_name (msg, ty, wrong_name)))
+
+module Label = NameChoice (struct
+ type t = label_description
+ type usage = Env.label_usage
+ let kind = Datatype_kind.Record
+ let get_name lbl = lbl.lbl_name
+ let get_type lbl = lbl.lbl_res
+ let lookup_all_from_type loc usage path env =
+ Env.lookup_all_labels_from_type ~loc usage path env
+ let in_env lbl =
+ match lbl.lbl_repres with
+ | Record_regular | Record_float | Record_unboxed false -> true
+ | Record_unboxed true | Record_inlined _ | Record_extension _ -> false
+end)
+
+(* In record-construction expressions and patterns, we have many labels
+ at once; find a candidate type in the intersection of the candidates
+ of each label. In the [closed] expression case, this candidate must
+ contain exactly all the labels.
+
+ If our successive refinements result in an empty list,
+ return [Error] with the last non-empty list of candidates
+ for use in error messages.
+*)
+let disambiguate_label_by_ids closed ids labels : (_, _) result =
+ let check_ids (lbl, _) =
+ let lbls = Hashtbl.create 8 in
+ Array.iter (fun lbl -> Hashtbl.add lbls lbl.lbl_name ()) lbl.lbl_all;
+ List.for_all (Hashtbl.mem lbls) ids
+ and check_closed (lbl, _) =
+ (not closed || List.length ids = Array.length lbl.lbl_all)
+ in
+ match List.filter check_ids labels with
+ | [] -> Error labels
+ | labels ->
+ match List.filter check_closed labels with
+ | [] -> Error labels
+ | labels ->
+ Ok labels
+
+(* Only issue warnings once per record constructor/pattern *)
+let disambiguate_lid_a_list loc closed env usage expected_type lid_a_list =
+ let ids = List.map (fun (lid, _) -> Longident.last lid.txt) lid_a_list in
+ let w_pr = ref false and w_amb = ref []
+ and w_scope = ref [] and w_scope_ty = ref "" in
+ let warn loc msg =
+ let open Warnings in
+ match msg with
+ | Not_principal _ -> w_pr := true
+ | Ambiguous_name([s], l, _, ex) -> w_amb := (s, l, ex) :: !w_amb
+ | Name_out_of_scope(ty, [s], _) ->
+ w_scope := s :: !w_scope; w_scope_ty := ty
+ | _ -> Location.prerr_warning loc msg
+ in
+ let process_label lid =
+ let scope = Env.lookup_all_labels ~loc:lid.loc usage lid.txt env in
+ let filter : Label.nonempty_candidate_filter =
+ disambiguate_label_by_ids closed ids in
+ Label.disambiguate ~warn ~filter usage lid env expected_type scope in
+ let lbl_a_list =
+ (* If one label is qualified [{ foo = ...; M.bar = ... }],
+ we will disambiguate all labels using one of the qualifying modules,
+ as if the user had written [{ M.foo = ...; M.bar = ... }].
+
+ #11630: It is important to process first the
+ user-qualified labels, instead of processing all labels in
+ order, so that error messages coming from the lookup of
+ M (maybe no such module/path exists) are shown to the user
+ in context of a qualified field [M.bar] they wrote
+ themselves, instead of the "ghost" qualification [M.foo]
+ that does not come from the source program. *)
+ let lbl_list =
+ List.map (fun (lid, _) ->
+ match lid.txt with
+ | Longident.Ldot _ -> Some (process_label lid)
+ | _ -> None
+ ) lid_a_list
+ in
+ (* Find a module prefix (if any) to qualify unqualified labels *)
+ let qual =
+ List.find_map (function
+ | {txt = Longident.Ldot (modname, _); _}, _ -> Some modname
+ | _ -> None
+ ) lid_a_list
+ in
+ (* Prefix unqualified labels with [qual] and resolve them.
+
+ Prefixing unqualified labels does not change the final
+ disambiguation result, it restricts the set of candidates
+ without removing any valid choice.
+ It matters if users activated warnings for ambiguous or
+ out-of-scope resolutions -- they get less warnings by
+ qualifying at least one of the fields. *)
+ List.map2 (fun lid_a lbl ->
+ match lbl, lid_a with
+ | Some lbl, (lid, a) -> lid, lbl, a
+ | None, (lid, a) ->
+ let qual_lid =
+ match qual, lid.txt with
+ | Some modname, Longident.Lident s ->
+ {lid with txt = Longident.Ldot (modname, s)}
+ | _ -> lid
+ in
+ lid, process_label qual_lid, a
+ ) lid_a_list lbl_list
+ in
+ if !w_pr then
+ Location.prerr_warning loc
+ (not_principal "this type-based record disambiguation")
+ else begin
+ match List.rev !w_amb with
+ (_,types,ex)::_ as amb ->
+ let paths =
+ List.map (fun (_,lbl,_) -> Label.get_type_path lbl) lbl_a_list in
+ let path = List.hd paths in
+ let fst3 (x,_,_) = x in
+ if List.for_all (compare_type_path env path) (List.tl paths) then
+ Location.prerr_warning loc
+ (Warnings.Ambiguous_name (List.map fst3 amb, types, true, ex))
+ else
+ List.iter
+ (fun (s,l,ex) -> Location.prerr_warning loc
+ (Warnings.Ambiguous_name ([s],l,false, ex)))
+ amb
+ | _ -> ()
+ end;
+ if !w_scope <> [] then
+ Location.prerr_warning loc
+ (Warnings.Name_out_of_scope (!w_scope_ty, List.rev !w_scope, true));
+ lbl_a_list
+
+let map_fold_cont f xs k =
+ List.fold_right (fun x k ys -> f x (fun y -> k (y :: ys)))
+ xs (fun ys -> k (List.rev ys)) []
+
+let type_label_a_list loc closed env usage type_lbl_a expected_type lid_a_list =
+ let lbl_a_list =
+ disambiguate_lid_a_list loc closed env usage expected_type lid_a_list
+ in
+ (* Invariant: records are sorted in the typed tree *)
+ let lbl_a_list =
+ List.sort
+ (fun (_,lbl1,_) (_,lbl2,_) -> compare lbl1.lbl_pos lbl2.lbl_pos)
+ lbl_a_list
+ in
+ List.map type_lbl_a lbl_a_list
+
+(* Checks over the labels mentioned in a record pattern:
+ no duplicate definitions (error); properly closed (warning) *)
+
+let check_recordpat_labels loc lbl_pat_list closed =
+ match lbl_pat_list with
+ | [] -> () (* should not happen *)
+ | (_, label1, _) :: _ ->
+ let all = label1.lbl_all in
+ let defined = Array.make (Array.length all) false in
+ let check_defined (_, label, _) =
+ if defined.(label.lbl_pos)
+ then raise(Error(loc, Env.empty, Label_multiply_defined label.lbl_name))
+ else defined.(label.lbl_pos) <- true in
+ List.iter check_defined lbl_pat_list;
+ if closed = Closed
+ && Warnings.is_active (Warnings.Missing_record_field_pattern "")
+ then begin
+ let undefined = ref [] in
+ for i = 0 to Array.length all - 1 do
+ if not defined.(i) then undefined := all.(i).lbl_name :: !undefined
+ done;
+ if !undefined <> [] then begin
+ let u = String.concat ", " (List.rev !undefined) in
+ Location.prerr_warning loc (Warnings.Missing_record_field_pattern u)
+ end
+ end
+
+(* Constructors *)
+
+module Constructor = NameChoice (struct
+ type t = constructor_description
+ type usage = Env.constructor_usage
+ let kind = Datatype_kind.Variant
+ let get_name cstr = cstr.cstr_name
+ let get_type cstr = cstr.cstr_res
+ let lookup_all_from_type loc usage path env =
+ match Env.lookup_all_constructors_from_type ~loc usage path env with
+ | _ :: _ as x -> x
+ | [] ->
+ match (Env.find_type path env).type_kind with
+ | Type_open ->
+ (* Extension constructors cannot be found by looking at the type
+ declaration.
+ We scan the whole environment to get an accurate spellchecking
+ hint in the subsequent error message *)
+ let filter lbl =
+ compare_type_path env
+ path (get_constr_type_path @@ get_type lbl) in
+ let add_valid x acc = if filter x then (x,ignore)::acc else acc in
+ Env.fold_constructors add_valid None env []
+ | _ -> []
+ let in_env _ = true
+end)
+
+(* Typing of patterns *)
+
+(* "untyped" cases are prior to checking the pattern. *)
+type untyped_case = Parsetree.pattern Parmatch.parmatch_case
+
+(* "half typed" cases are produced in [map_half_typed_cases] when we've just
+ typechecked the pattern but haven't type-checked the body yet. At this point
+ we might have added some type equalities to the environment, but haven't yet
+ added identifiers bound by the pattern. *)
+type ('case_pattern, 'case_data) half_typed_case =
+ { typed_pat: 'case_pattern;
+ pat_type_for_unif: type_expr;
+ untyped_case : untyped_case;
+ case_data : 'case_data;
+ branch_env: Env.t;
+ pat_vars: pattern_variable list;
+ module_vars: module_variables;
+ contains_gadt: bool; }
+
+(* Used to split patterns into value cases and exception cases. *)
+let split_half_typed_cases env zipped_cases =
+ let add_case lst htc data = function
+ | None -> lst
+ | Some split_pat ->
+ ({ htc.untyped_case with pattern = split_pat }, data) :: lst
+ in
+ List.fold_right (fun (htc, data) (vals, exns) ->
+ let pat = htc.typed_pat in
+ match split_pattern pat with
+ | Some _, Some _ when htc.untyped_case.has_guard ->
+ raise (Error (pat.pat_loc, env,
+ Mixed_value_and_exception_patterns_under_guard))
+ | vp, ep -> add_case vals htc data vp, add_case exns htc data ep
+ ) zipped_cases ([], [])
+
+let rec has_literal_pattern p = match p.ppat_desc with
+ | Ppat_constant _
+ | Ppat_interval _ ->
+ true
+ | Ppat_any
+ | Ppat_variant (_, None)
+ | Ppat_construct (_, None)
+ | Ppat_type _
+ | Ppat_var _
+ | Ppat_unpack _
+ | Ppat_extension _ ->
+ false
+ | Ppat_exception p
+ | Ppat_variant (_, Some p)
+ | Ppat_construct (_, Some (_, p))
+ | Ppat_constraint (p, _)
+ | Ppat_alias (p, _)
+ | Ppat_lazy p
+ | Ppat_open (_, p) ->
+ has_literal_pattern p
+ | Ppat_tuple ps
+ | Ppat_array ps ->
+ List.exists has_literal_pattern ps
+ | Ppat_record (ps, _) ->
+ List.exists (fun (_,p) -> has_literal_pattern p) ps
+ | Ppat_effect (p, q)
+ | Ppat_or (p, q) ->
+ has_literal_pattern p || has_literal_pattern q
+
+let check_scope_escape loc env level ty =
+ try Ctype.check_scope_escape env level ty
+ with Escape esc ->
+ (* We don't expand the type here because if we do, we might expand to the
+ type that escaped, leading to confusing error messages. *)
+ let trace = Errortrace.[Escape (map_escape trivial_expansion esc)] in
+ raise (Error(loc,
+ env,
+ Pattern_type_clash(Errortrace.unification_error ~trace, None)))
+
+
+(** The typedtree has two distinct syntactic categories for patterns,
+ "value" patterns, matching on values, and "computation" patterns
+ that match on the effect of a computation -- typically, exception
+ patterns (exception p).
+
+ On the other hand, the parsetree has an unstructured representation
+ where all categories of patterns are mixed together. The
+ decomposition according to the value/computation structure has to
+ happen during type-checking.
+
+ We don't want to duplicate the type-checking logic in two different
+ functions, depending on the kind of pattern to be produced. In
+ particular, there are both value and computation or-patterns, and
+ the type-checking logic for or-patterns is horribly complex; having
+ it in two different places would be twice as horirble.
+
+ The solution is to pass a GADT tag to [type_pat] to indicate whether
+ a value or computation pattern is expected. This way, there is a single
+ place where [Ppat_or] nodes are type-checked, the checking logic is shared,
+ and only at the end do we inspect the tag to decide to produce a value
+ or computation pattern.
+*)
+let pure
+ : type k . k pattern_category -> value general_pattern -> k general_pattern
+ = fun category pat ->
+ match category with
+ | Value -> pat
+ | Computation -> as_computation_pattern pat
+
+let only_impure
+ : type k . k pattern_category ->
+ computation general_pattern -> k general_pattern
+ = fun category pat ->
+ match category with
+ | Value ->
+ (* LATER: this exception could be renamed/generalized *)
+ raise (Error (pat.pat_loc, pat.pat_env,
+ Exception_pattern_disallowed))
+ | Computation -> pat
+
+let as_comp_pattern
+ : type k . k pattern_category ->
+ k general_pattern -> computation general_pattern
+ = fun category pat ->
+ match category with
+ | Value -> as_computation_pattern pat
+ | Computation -> pat
+
+(** [type_pat] propagates the expected type, and
+ unification may update the typing environment. *)
+let rec type_pat
+ : type k . type_pat_state -> k pattern_category ->
+ no_existentials: existential_restriction option ->
+ penv: Pattern_env.t -> Parsetree.pattern -> type_expr ->
+ k general_pattern
+ = fun tps category ~no_existentials ~penv sp expected_ty ->
+ Builtin_attributes.warning_scope sp.ppat_attributes
+ (fun () ->
+ type_pat_aux tps category ~no_existentials ~penv sp expected_ty
+ )
+
+and type_pat_aux
+ : type k . type_pat_state -> k pattern_category -> no_existentials:_ ->
+ penv:Pattern_env.t -> _ -> _ -> k general_pattern
+ = fun tps category ~no_existentials ~penv sp expected_ty ->
+ let type_pat tps category ?(penv=penv) =
+ type_pat tps category ~no_existentials ~penv
+ in
+ let loc = sp.ppat_loc in
+ let solve_expected (x : pattern) : pattern =
+ unify_pat ~sdesc_for_hint:sp.ppat_desc !!penv x (instance expected_ty);
+ x
+ in
+ let crp (x : k general_pattern) : k general_pattern =
+ match category with
+ | Value -> rp x
+ | Computation -> rcp x
+ in
+ (* record {general,value,computation} pattern *)
+ let rp = crp
+ and rvp x = crp (pure category x)
+ and rcp x = crp (only_impure category x) in
+ match sp.ppat_desc with
+ Ppat_any ->
+ rvp {
+ pat_desc = Tpat_any;
+ pat_loc = loc; pat_extra=[];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_var name ->
+ let ty = instance expected_ty in
+ let id, uid = enter_variable tps loc name ty sp.ppat_attributes in
+ rvp {
+ pat_desc = Tpat_var (id, name, uid);
+ pat_loc = loc; pat_extra=[];
+ pat_type = ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_unpack name ->
+ let t = instance expected_ty in
+ begin match name.txt with
+ | None ->
+ rvp {
+ pat_desc = Tpat_any;
+ pat_loc = sp.ppat_loc;
+ pat_extra=[Tpat_unpack, name.loc, sp.ppat_attributes];
+ pat_type = t;
+ pat_attributes = [];
+ pat_env = !!penv }
+ | Some s ->
+ let v = { name with txt = s } in
+ (* We're able to pass ~is_module:true here without an error because
+ [Ppat_unpack] is a case identified by [may_contain_modules]. See
+ the comment on [may_contain_modules]. *)
+ let id, uid =
+ enter_variable tps loc v t ~is_module:true sp.ppat_attributes
+ in
+ rvp {
+ pat_desc = Tpat_var (id, v, uid);
+ pat_loc = sp.ppat_loc;
+ pat_extra=[Tpat_unpack, loc, sp.ppat_attributes];
+ pat_type = t;
+ pat_attributes = [];
+ pat_env = !!penv }
+ end
+ | Ppat_constraint(
+ {ppat_desc=Ppat_var name; ppat_loc=lloc; ppat_attributes = attrs},
+ ({ptyp_desc=Ptyp_poly _} as sty)) ->
+ (* explicitly polymorphic type *)
+ let cty, ty, ty' =
+ solve_Ppat_poly_constraint tps !!penv lloc sty expected_ty in
+ let id, uid = enter_variable tps lloc name ty' attrs in
+ rvp { pat_desc = Tpat_var (id, name, uid);
+ pat_loc = lloc;
+ pat_extra = [Tpat_constraint cty, loc, sp.ppat_attributes];
+ pat_type = ty;
+ pat_attributes = [];
+ pat_env = !!penv }
+ | Ppat_alias(sq, name) ->
+ let q = type_pat tps Value sq expected_ty in
+ let ty_var = solve_Ppat_alias !!penv q in
+ let id, uid =
+ enter_variable
+ ~is_as_variable:true tps name.loc name ty_var sp.ppat_attributes
+ in
+ rvp { pat_desc = Tpat_alias(q, id, name, uid);
+ pat_loc = loc; pat_extra=[];
+ pat_type = q.pat_type;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_constant cst ->
+ let cst = constant_or_raise !!penv loc cst in
+ rvp @@ solve_expected {
+ pat_desc = Tpat_constant cst;
+ pat_loc = loc; pat_extra=[];
+ pat_type = type_constant cst;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_interval (c1, c2) ->
+ let open Ast_helper in
+ let get_bound = function
+ | {pconst_desc = Pconst_char c; _} -> c
+ | {pconst_loc = loc; _} ->
+ raise (Error (loc, !!penv, Invalid_interval))
+ in
+ let c1 = get_bound c1 in
+ let c2 = get_bound c2 in
+ let gloc = {loc with Location.loc_ghost=true} in
+ let rec loop c1 c2 =
+ if c1 = c2 then Pat.constant ~loc:gloc (Const.char ~loc:gloc c1)
+ else
+ Pat.or_ ~loc:gloc
+ (Pat.constant ~loc:gloc (Const.char ~loc:gloc c1))
+ (loop (Char.chr(Char.code c1 + 1)) c2)
+ in
+ let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
+ let p = {p with ppat_loc=loc} in
+ type_pat tps category p expected_ty
+ (* TODO: record 'extra' to remember about interval *)
+ | Ppat_tuple spl ->
+ assert (List.length spl >= 2);
+ let expected_tys =
+ solve_Ppat_tuple ~refine:false loc penv spl expected_ty in
+ let pl = List.map2 (type_pat tps Value) spl expected_tys in
+ rvp {
+ pat_desc = Tpat_tuple pl;
+ pat_loc = loc; pat_extra=[];
+ pat_type = newty (Ttuple(List.map (fun p -> p.pat_type) pl));
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_construct(lid, sarg) ->
+ let expected_type =
+ match extract_concrete_variant !!penv expected_ty with
+ | Variant_type(p0, p, _) ->
+ Some (p0, p, is_principal expected_ty)
+ | Maybe_a_variant_type -> None
+ | Not_a_variant_type ->
+ let srt = wrong_kind_sort_of_constructor lid.txt in
+ let error = Wrong_expected_kind(srt, Pattern, expected_ty) in
+ raise (Error (loc, !!penv, error))
+ in
+ let constr =
+ let candidates =
+ Env.lookup_all_constructors Env.Pattern ~loc:lid.loc lid.txt !!penv in
+ wrap_disambiguate "This variant pattern is expected to have"
+ (mk_expected expected_ty)
+ (Constructor.disambiguate Env.Pattern lid !!penv expected_type)
+ candidates
+ in
+ begin match no_existentials, constr.cstr_existentials with
+ | None, _ | _, [] -> ()
+ | Some r, (_ :: _) ->
+ let name = constr.cstr_name in
+ raise (Error (loc, !!penv, Unexpected_existential (r, name)))
+ end;
+ let sarg', existential_styp =
+ match sarg with
+ None -> None, None
+ | Some (vl, {ppat_desc = Ppat_constraint (sp, sty)})
+ when vl <> [] || constr.cstr_arity > 1 ->
+ Some sp, Some (vl, sty)
+ | Some ([], sp) ->
+ Some sp, None
+ | Some (_, sp) ->
+ raise (Error (sp.ppat_loc, !!penv, Missing_type_constraint))
+ in
+ let sargs =
+ match sarg' with
+ None -> []
+ | Some {ppat_desc = Ppat_tuple spl} when
+ constr.cstr_arity > 1 ||
+ Builtin_attributes.explicit_arity sp.ppat_attributes
+ -> spl
+ | Some({ppat_desc = Ppat_any} as sp) when
+ constr.cstr_arity = 0 && existential_styp = None
+ ->
+ Location.prerr_warning sp.ppat_loc
+ Warnings.Wildcard_arg_to_constant_constr;
+ []
+ | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity > 1 ->
+ replicate_list sp constr.cstr_arity
+ | Some sp -> [sp] in
+ if Builtin_attributes.warn_on_literal_pattern constr.cstr_attributes then
+ begin match List.filter has_literal_pattern sargs with
+ | sp :: _ ->
+ Location.prerr_warning sp.ppat_loc Warnings.Fragile_literal_pattern
+ | _ -> ()
+ end;
+ if List.length sargs <> constr.cstr_arity then
+ raise(Error(loc, !!penv, Constructor_arity_mismatch(lid.txt,
+ constr.cstr_arity, List.length sargs)));
+
+ let (ty_args, existential_ctyp) =
+ solve_Ppat_construct ~refine:false tps penv loc constr no_existentials
+ existential_styp expected_ty
+ in
+
+ let rec check_non_escaping p =
+ match p.ppat_desc with
+ | Ppat_or (p1, p2) ->
+ check_non_escaping p1;
+ check_non_escaping p2
+ | Ppat_alias (p, _) ->
+ check_non_escaping p
+ | Ppat_constraint _ ->
+ raise (Error (p.ppat_loc, !!penv, Inlined_record_escape))
+ | _ ->
+ ()
+ in
+ if constr.cstr_inlined <> None then begin
+ List.iter check_non_escaping sargs;
+ Option.iter (fun (_, sarg) -> check_non_escaping sarg) sarg
+ end;
+
+ let args = List.map2 (type_pat tps Value) sargs ty_args in
+ rvp { pat_desc=Tpat_construct(lid, constr, args, existential_ctyp);
+ pat_loc = loc; pat_extra=[];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_variant(tag, sarg) ->
+ assert (tag <> Parmatch.some_private_tag);
+ let constant = (sarg = None) in
+ let arg_type, row, pat_type =
+ solve_Ppat_variant ~refine:false loc penv tag constant expected_ty in
+ let arg =
+ (* PR#6235: propagate type information *)
+ match sarg, arg_type with
+ Some sp, [ty] -> Some (type_pat tps Value sp ty)
+ | _ -> None
+ in
+ rvp {
+ pat_desc = Tpat_variant(tag, arg, ref row);
+ pat_loc = loc; pat_extra = [];
+ pat_type = pat_type;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_record(lid_sp_list, closed) ->
+ assert (lid_sp_list <> []);
+ let expected_type, record_ty =
+ match extract_concrete_record !!penv expected_ty with
+ | Record_type(p0, p, _) ->
+ let ty = generic_instance expected_ty in
+ Some (p0, p, is_principal expected_ty), ty
+ | Maybe_a_record_type -> None, newvar ()
+ | Not_a_record_type ->
+ let error = Wrong_expected_kind(Record, Pattern, expected_ty) in
+ raise (Error (loc, !!penv, error))
+ in
+ let type_label_pat (label_lid, label, sarg) =
+ let ty_arg =
+ solve_Ppat_record_field ~refine:false loc penv label label_lid
+ record_ty in
+ (label_lid, label, type_pat tps Value sarg ty_arg)
+ in
+ let make_record_pat lbl_pat_list =
+ check_recordpat_labels loc lbl_pat_list closed;
+ {
+ pat_desc = Tpat_record (lbl_pat_list, closed);
+ pat_loc = loc; pat_extra=[];
+ pat_type = instance record_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv;
+ }
+ in
+ let lbl_a_list =
+ wrap_disambiguate "This record pattern is expected to have"
+ (mk_expected expected_ty)
+ (type_label_a_list loc false !!penv Env.Projection
+ type_label_pat expected_type)
+ lid_sp_list
+ in
+ rvp @@ solve_expected (make_record_pat lbl_a_list)
+ | Ppat_array spl ->
+ let ty_elt = solve_Ppat_array ~refine:false loc penv expected_ty in
+ let pl = List.map (fun p -> type_pat tps Value p ty_elt) spl in
+ rvp {
+ pat_desc = Tpat_array pl;
+ pat_loc = loc; pat_extra=[];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_or(sp1, sp2) ->
+ (* Reset pattern forces for just [tps2] because later we append [tps1] and
+ [tps2]'s pattern forces, and we don't want to duplicate [tps]'s pattern
+ forces. *)
+ let tps1 = copy_type_pat_state tps in
+ let tps2 = {(copy_type_pat_state tps) with tps_pattern_force = []} in
+ (* Introduce a new level to avoid keeping nodes at intermediate levels *)
+ let pat_desc = with_local_level_generalize begin fun () ->
+ (* Introduce a new scope using with_local_level without generalizations *)
+ let env1, p1, env2, p2 =
+ with_local_level begin fun () ->
+ let type_pat_rec tps penv sp =
+ type_pat tps category sp expected_ty ~penv
+ in
+ let penv1 =
+ Pattern_env.copy ~equations_scope:(get_current_level ()) penv in
+ let penv2 = Pattern_env.copy penv1 in
+ let p1 = type_pat_rec tps1 penv1 sp1 in
+ let p2 = type_pat_rec tps2 penv2 sp2 in
+ (penv1.env, p1, penv2.env, p2)
+ end
+ in
+ let p1_variables = tps1.tps_pattern_variables in
+ let p2_variables = tps2.tps_pattern_variables in
+ (* Make sure no variable with an ambiguous type gets added to the
+ environment. *)
+ let outer_lev = get_current_level () in
+ List.iter (fun { pv_type; pv_loc; _ } ->
+ check_scope_escape pv_loc env1 outer_lev pv_type
+ ) p1_variables;
+ List.iter (fun { pv_type; pv_loc; _ } ->
+ check_scope_escape pv_loc env2 outer_lev pv_type
+ ) p2_variables;
+ let alpha_env =
+ enter_orpat_variables loc !!penv p1_variables p2_variables in
+ (* Propagate the outcome of checking the or-pattern back to
+ the type_pat_state that the caller passed in.
+ *)
+ blit_type_pat_state
+ ~src:
+ { tps_pattern_variables = tps1.tps_pattern_variables;
+ (* We want to propagate all pattern forces, regardless of
+ which branch they were found in.
+ *)
+ tps_pattern_force =
+ tps2.tps_pattern_force @ tps1.tps_pattern_force;
+ tps_module_variables = tps1.tps_module_variables;
+ }
+ ~dst:tps;
+ let p2 = alpha_pat alpha_env p2 in
+ Tpat_or (p1, p2, None)
+ end
+ in
+ rp { pat_desc = pat_desc;
+ pat_loc = loc; pat_extra = [];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_lazy sp1 ->
+ let nv = solve_Ppat_lazy ~refine:false loc penv expected_ty in
+ let p1 = type_pat tps Value sp1 nv in
+ rvp {
+ pat_desc = Tpat_lazy p1;
+ pat_loc = loc; pat_extra=[];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !!penv }
+ | Ppat_constraint(sp, sty) ->
+ (* Pretend separate = true *)
+ let cty, ty, expected_ty' =
+ solve_Ppat_constraint tps loc !!penv sty expected_ty in
+ let p = type_pat tps category sp expected_ty' in
+ let extra = (Tpat_constraint cty, loc, sp.ppat_attributes) in
+ begin match category, (p : k general_pattern) with
+ | Value, {pat_desc = Tpat_var (id,s,uid); _} ->
+ { p with
+ pat_type = ty;
+ pat_desc =
+ Tpat_alias
+ ({p with pat_desc = Tpat_any; pat_attributes = []}, id,s, uid);
+ pat_extra = [extra];
+ }
+ | _, p ->
+ { p with pat_type = ty; pat_extra = extra::p.pat_extra }
+ end
+ | Ppat_type lid ->
+ let (path, p) = build_or_pat !!penv loc lid in
+ pure category @@ solve_expected
+ { p with pat_extra = (Tpat_type (path, lid), loc, sp.ppat_attributes)
+ :: p.pat_extra }
+ | Ppat_open (lid,p) ->
+ let path, new_env =
+ !type_open Asttypes.Fresh !!penv sp.ppat_loc lid in
+ Pattern_env.set_env penv new_env;
+ let p = type_pat tps category ~penv p expected_ty in
+ let new_env = !!penv in
+ begin match Env.remove_last_open path new_env with
+ | None -> assert false
+ | Some closed_env -> Pattern_env.set_env penv closed_env
+ end;
+ { p with pat_extra = (Tpat_open (path,lid,new_env),
+ loc, sp.ppat_attributes) :: p.pat_extra }
+ | Ppat_exception p ->
+ let p_exn = type_pat tps Value p Predef.type_exn in
+ rcp {
+ pat_desc = Tpat_exception p_exn;
+ pat_loc = sp.ppat_loc;
+ pat_extra = [];
+ pat_type = expected_ty;
+ pat_env = !!penv;
+ pat_attributes = sp.ppat_attributes;
+ }
+ | Ppat_effect _ ->
+ raise (Error (loc, !!penv, Effect_pattern_below_toplevel))
+ | Ppat_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+let iter_pattern_variables_type f : pattern_variable list -> unit =
+ List.iter (fun {pv_type; _} -> f pv_type)
+
+let add_pattern_variables ?check ?check_as env pv =
+ List.fold_right
+ (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes; pv_uid} env ->
+ let check = if pv_kind=As_var then check_as else check in
+ Env.add_value ?check pv_id
+ {val_type = pv_type; val_kind = Val_reg; Types.val_loc = pv_loc;
+ val_attributes = pv_attributes;
+ val_uid = pv_uid;
+ } env
+ )
+ pv env
+
+let add_module_variables env module_variables =
+ let module_variables_as_list =
+ match module_variables with
+ | Modvars_allowed mvs -> mvs.module_variables
+ | Modvars_ignored | Modvars_rejected -> []
+ in
+ List.fold_left (fun env { mv_id; mv_loc; mv_name; mv_uid } ->
+ Typetexp.TyVarEnv.with_local_scope begin fun () ->
+ (* This code is parallel to the typing of Pexp_letmodule. However we
+ omit the call to [Mtype.lower_nongen] as it's not necessary here.
+ For Pexp_letmodule, the call to [type_module] is done in a raised
+ level and so needs to be modified to have the correct, outer level.
+ Here, on the other hand, we're calling [type_module] outside the
+ raised level, so there's no extra step to take.
+ *)
+ let modl, md_shape =
+ !type_module env
+ Ast_helper.(
+ Mod.unpack ~loc:mv_loc
+ (Exp.ident ~loc:mv_name.loc
+ (mkloc (Longident.Lident mv_name.txt)
+ mv_name.loc)))
+ in
+ let pres =
+ match modl.mod_type with
+ | Mty_alias _ -> Mp_absent
+ | _ -> Mp_present
+ in
+ let md =
+ { md_type = modl.mod_type; md_attributes = [];
+ md_loc = mv_name.loc;
+ md_uid = mv_uid; }
+ in
+ Env.add_module_declaration ~shape:md_shape ~check:true mv_id pres md env
+ end
+ ) env module_variables_as_list
+
+let type_pat tps category ?no_existentials penv =
+ type_pat tps category ~no_existentials ~penv
+
+let type_pattern category ~lev env spat expected_ty ?cont allow_modules =
+ let tps = create_type_pat_state ?cont allow_modules in
+ let new_penv = Pattern_env.make env
+ ~equations_scope:lev ~allow_recursive_equations:false in
+ let pat = type_pat tps category new_penv spat expected_ty in
+ let { tps_pattern_variables = pvs;
+ tps_module_variables = mvs;
+ tps_pattern_force = pattern_forces;
+ } = tps in
+ (pat, !!new_penv, pattern_forces, pvs, mvs)
+
+let type_pattern_list
+ category no_existentials env spatl expected_tys allow_modules
+ =
+ let tps = create_type_pat_state allow_modules in
+ let equations_scope = get_current_level () in
+ let new_penv = Pattern_env.make env
+ ~equations_scope ~allow_recursive_equations:false in
+ let type_pat (attrs, pat) ty =
+ Builtin_attributes.warning_scope ~ppwarning:false attrs
+ (fun () ->
+ type_pat tps category ~no_existentials new_penv pat ty
+ )
+ in
+ let patl = List.map2 type_pat spatl expected_tys in
+ let { tps_pattern_variables = pvs;
+ tps_module_variables = mvs;
+ tps_pattern_force = pattern_forces;
+ } = tps in
+ (patl, !!new_penv, pattern_forces, pvs, mvs)
+
+let type_class_arg_pattern cl_num val_env met_env l spat =
+ let tps = create_type_pat_state Modules_rejected in
+ let nv = newvar () in
+ let equations_scope = get_current_level () in
+ let new_penv = Pattern_env.make val_env
+ ~equations_scope ~allow_recursive_equations:false in
+ let pat =
+ type_pat tps Value ~no_existentials:In_class_args new_penv spat nv in
+ if has_variants pat then begin
+ Parmatch.pressure_variants val_env [pat];
+ finalize_variants pat;
+ end;
+ List.iter (fun f -> f()) tps.tps_pattern_force;
+ if is_optional l then unify_pat val_env pat (type_option (newvar ()));
+ let (pv, val_env, met_env) =
+ List.fold_right
+ (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes}
+ (pv, val_env, met_env) ->
+ let check s =
+ if pv_kind = As_var then Warnings.Unused_var s
+ else Warnings.Unused_var_strict s in
+ let id' = Ident.rename pv_id in
+ let val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
+ let val_env =
+ Env.add_value pv_id
+ { val_type = pv_type
+ ; val_kind = Val_reg
+ ; val_attributes = pv_attributes
+ ; val_loc = pv_loc
+ ; val_uid
+ }
+ val_env
+ in
+ let met_env =
+ Env.add_value id' ~check
+ { val_type = pv_type
+ ; val_kind = Val_ivar (Immutable, cl_num)
+ ; val_attributes = pv_attributes
+ ; val_loc = pv_loc
+ ; val_uid
+ }
+ met_env
+ in
+ ((id', pv_id, pv_type)::pv, val_env, met_env))
+ tps.tps_pattern_variables ([], val_env, met_env)
+ in
+ (pat, pv, val_env, met_env)
+
+let type_self_pattern env spat =
+ let open Ast_helper in
+ let spat = Pat.mk(Ppat_alias (spat, mknoloc "selfpat-*")) in
+ let tps = create_type_pat_state Modules_rejected in
+ let nv = newvar() in
+ let equations_scope = get_current_level () in
+ let new_penv = Pattern_env.make env
+ ~equations_scope ~allow_recursive_equations:false in
+ let pat =
+ type_pat tps Value ~no_existentials:In_self_pattern new_penv spat nv in
+ List.iter (fun f -> f()) tps.tps_pattern_force;
+ pat, tps.tps_pattern_variables
+
+
+(** In [check_counter_example_pat], we will check a counter-example candidate
+ produced by Parmatch. This is a pattern that represents a set of values by
+ using or-patterns (p_1 | ... | p_n) to enumerate all alternatives in the
+ counter-example search. These or-patterns occur at every choice point,
+ possibly deep inside the pattern.
+
+ Parmatch does not use type information, so this pattern may
+ exhibit two issues:
+ - some parts of the pattern may be ill-typed due to GADTs, and
+ - some wildcard patterns may not match any values: their type is
+ empty.
+
+ The aim of [check_counter_example_pat] is to refine this untyped pattern
+ into a well-typed pattern, and ensure that it matches at least one
+ concrete value.
+ - It filters ill-typed branches of or-patterns.
+ (see {!splitting_mode} below)
+ - It tries to check that wildcard patterns are non-empty.
+ (see {!explosion_fuel})
+ *)
+
+type counter_example_checking_info = {
+ explosion_fuel: int;
+ splitting_mode: splitting_mode;
+ }
+(**
+ [explosion_fuel] controls the checking of wildcard patterns. We
+ eliminate potentially-empty wildcard patterns by exploding them
+ into concrete sub-patterns, for example (K1 _ | K2 _) or
+ { l1: _; l2: _ }. [explosion_fuel] is the depth limit on wildcard
+ explosion. Such depth limit is required to avoid non-termination
+ and compilation-time blowups.
+
+ [splitting_mode] controls the handling of or-patterns. In
+ [Counter_example] mode, we only need to select one branch that
+ leads to a well-typed pattern. Checking all branches is expensive,
+ we use different search strategies (see {!splitting_mode}) to
+ reduce the number of explored alternatives.
+ *)
+
+(** Due to GADT constraints, an or-pattern produced within
+ a counter-example may have ill-typed branches. Consider for example
+
+ {[
+ type _ tag = Int : int tag | Bool : bool tag
+ ]}
+
+ then [Parmatch] will propose the or-pattern [Int | Bool] whenever
+ a pattern of type [tag] is required to form a counter-example. For
+ example, a function expects a (int tag option) and only [None] is
+ handled by the user-written pattern. [Some (Int | Bool)] is not
+ well-typed in this context, only the sub-pattern [Some Int] is.
+ In this example, the expected type coming from the context
+ suffices to know which or-pattern branch must be chosen.
+
+ In the general case, choosing a branch can have non-local effects
+ on the typability of the term. For example, consider a tuple type
+ ['a tag * ...'a...], where the first component is a GADT. All
+ constructor choices for this GADT lead to a well-typed branch in
+ isolation (['a] is unconstrained), but choosing one of them adds
+ a constraint on ['a] that may make the other tuple elements
+ ill-typed.
+
+ In general, after choosing each possible branch of the or-pattern,
+ [check_counter_example_pat] has to check the rest of the pattern to
+ tell if this choice leads to a well-typed term. This may lead to an
+ explosion of typing/search work -- the rest of the term may in turn
+ contain alternatives.
+
+ We use careful strategies to try to limit counterexample-checking
+ time; [splitting_mode] represents those strategies.
+*)
+and splitting_mode =
+ | Backtrack_or
+ (** Always backtrack in or-patterns.
+
+ [Backtrack_or] selects a single alternative from an or-pattern
+ by using backtracking, trying to choose each branch in turn, and
+ to complete it into a valid sub-pattern. We call this
+ "splitting" the or-pattern.
+
+ We use this mode when looking for unused patterns or sub-patterns,
+ in particular to check a refutation clause (p -> .).
+ *)
+ | Refine_or of { inside_nonsplit_or: bool; }
+ (** Only backtrack when needed.
+
+ [Refine_or] tries another approach for refining or-pattern.
+
+ Instead of always splitting each or-pattern, It first attempts to
+ find branches that do not introduce new constraints (because they
+ do not contain GADT constructors). Those branches are such that,
+ if they fail, all other branches will fail.
+
+ If we find one such branch, we attempt to complete the subpattern
+ (checking what's outside the or-pattern), ignoring other
+ branches -- we never consider another branch choice again. If all
+ branches are constrained, it falls back to splitting the
+ or-pattern.
+
+ We use this mode when checking exhaustivity of pattern matching.
+ *)
+
+(** This exception is only used internally within [check_counter_example_pat],
+ to jump back to the parent or-pattern in the [Refine_or] strategy.
+
+ Such a parent exists precisely when [inside_nonsplit_or = true];
+ it's an invariant that we always setup an exception handler for
+ [Need_backtrack] when we set this flag. *)
+exception Need_backtrack
+
+(** This exception is only used internally within [check_counter_example_pat].
+ We use it to discard counter-example candidates that do not match any
+ value. *)
+exception Empty_branch
+
+type abort_reason = Adds_constraints | Empty
+
+(** Remember current typing state for backtracking.
+ No variable information, as we only backtrack on
+ patterns without variables (cf. assert statements).
+ In the GADT mode, [env] may be extended by unification,
+ and therefore it needs to be saved along with a [snapshot]. *)
+type unification_state =
+ { snapshot: snapshot;
+ env: Env.t; }
+let save_state penv =
+ { snapshot = Btype.snapshot ();
+ env = !!penv; }
+let set_state s penv =
+ Btype.backtrack s.snapshot;
+ Pattern_env.set_env penv s.env
+
+(** Find the first alternative in the tree of or-patterns for which
+ [f] does not raise an error. If all fail, the last error is
+ propagated *)
+let rec find_valid_alternative f pat =
+ match pat.pat_desc with
+ | Tpat_or(p1,p2,_) ->
+ (try find_valid_alternative f p1 with
+ | Empty_branch | Error _ -> find_valid_alternative f p2
+ )
+ | _ -> f pat
+
+let no_explosion info = { info with explosion_fuel = 0 }
+
+let enter_nonsplit_or info =
+ let splitting_mode = match info.splitting_mode with
+ | Backtrack_or ->
+ (* in Backtrack_or mode, or-patterns are always split *)
+ assert false
+ | Refine_or _ ->
+ Refine_or {inside_nonsplit_or = true}
+ in { info with splitting_mode }
+
+let rec check_counter_example_pat
+ ~info ~(penv : Pattern_env.t) type_pat_state tp expected_ty k =
+ let check_rec ?(info=info) ?(penv=penv) =
+ check_counter_example_pat ~info ~penv type_pat_state in
+ let loc = tp.pat_loc in
+ let refine = true in
+ let solve_expected (x : pattern) : pattern =
+ unify_pat_types_refine ~refine x.pat_loc penv x.pat_type
+ (instance expected_ty);
+ x
+ in
+ (* "make pattern" and "make pattern then continue" *)
+ let mp ?(pat_type = expected_ty) desc =
+ { pat_desc = desc; pat_loc = loc; pat_extra=[];
+ pat_type = instance pat_type; pat_attributes = []; pat_env = !!penv } in
+ let mkp k ?pat_type desc = k (mp ?pat_type desc) in
+ let must_backtrack_on_gadt =
+ match info.splitting_mode with
+ | Backtrack_or -> false
+ | Refine_or {inside_nonsplit_or} -> inside_nonsplit_or
+ in
+ match tp.pat_desc with
+ Tpat_any | Tpat_var _ ->
+ let k' () = mkp k tp.pat_desc in
+ if info.explosion_fuel <= 0 then k' () else
+ let decrease n = {info with explosion_fuel = info.explosion_fuel - n} in
+ begin match Parmatch.pats_of_type !!penv expected_ty with
+ | [] -> raise Empty_branch
+ | [{pat_desc = Tpat_any}] -> k' ()
+ | [tp] -> check_rec ~info:(decrease 1) tp expected_ty k
+ | tp :: tpl ->
+ if must_backtrack_on_gadt then raise Need_backtrack;
+ let tp =
+ List.fold_left
+ (fun tp tp' -> {tp with pat_desc = Tpat_or (tp, tp', None)})
+ tp tpl
+ in
+ check_rec ~info:(decrease 5) tp expected_ty k
+ end
+ | Tpat_alias (p, _, _, _) -> check_rec ~info p expected_ty k
+ | Tpat_constant cst ->
+ let cst = constant_or_raise !!penv loc (Untypeast.constant cst) in
+ k @@ solve_expected (mp (Tpat_constant cst) ~pat_type:(type_constant cst))
+ | Tpat_tuple tpl ->
+ assert (List.length tpl >= 2);
+ let expected_tys = solve_Ppat_tuple ~refine loc penv tpl expected_ty in
+ let tpl_ann = List.combine tpl expected_tys in
+ map_fold_cont (fun (p,t) -> check_rec p t) tpl_ann (fun pl ->
+ mkp k (Tpat_tuple pl)
+ ~pat_type:(newty (Ttuple(List.map (fun p -> p.pat_type) pl))))
+ | Tpat_construct(cstr_lid, constr, targs, _) ->
+ if constr.cstr_generalized && must_backtrack_on_gadt then
+ raise Need_backtrack;
+ let (ty_args, existential_ctyp) =
+ solve_Ppat_construct
+ ~refine type_pat_state penv loc constr None None expected_ty
+ in
+ map_fold_cont
+ (fun (p,t) -> check_rec p t)
+ (List.combine targs ty_args)
+ (fun args ->
+ mkp k (Tpat_construct(cstr_lid, constr, args, existential_ctyp)))
+ | Tpat_variant(tag, targ, _) ->
+ let constant = (targ = None) in
+ let arg_type, row, pat_type =
+ solve_Ppat_variant ~refine loc penv tag constant expected_ty in
+ let k arg =
+ mkp k ~pat_type (Tpat_variant(tag, arg, ref row))
+ in begin
+ (* PR#6235: propagate type information *)
+ match targ, arg_type with
+ Some p, [ty] -> check_rec p ty (fun p -> k (Some p))
+ | _ -> k None
+ end
+ | Tpat_record(fields, closed) ->
+ let record_ty = generic_instance expected_ty in
+ let type_label_pat (label_lid, label, targ) k =
+ let ty_arg =
+ solve_Ppat_record_field ~refine loc penv label label_lid record_ty in
+ check_rec targ ty_arg (fun arg -> k (label_lid, label, arg))
+ in
+ map_fold_cont type_label_pat fields
+ (fun fields -> mkp k (Tpat_record (fields, closed)))
+ | Tpat_array tpl ->
+ let ty_elt = solve_Ppat_array ~refine loc penv expected_ty in
+ map_fold_cont (fun p -> check_rec p ty_elt) tpl
+ (fun pl -> mkp k (Tpat_array pl))
+ | Tpat_or(tp1, tp2, _) ->
+ (* We are in counter-example mode, but try to avoid backtracking *)
+ let must_split =
+ match info.splitting_mode with
+ | Backtrack_or -> true
+ | Refine_or _ -> false in
+ let state = save_state penv in
+ let split_or tp =
+ let type_alternative pat =
+ set_state state penv; check_rec pat expected_ty k in
+ find_valid_alternative type_alternative tp
+ in
+ if must_split then split_or tp else
+ let check_rec_result penv tp : (_, abort_reason) result =
+ let info = enter_nonsplit_or info in
+ match check_rec ~info tp expected_ty ~penv (fun x -> x) with
+ | res -> Ok res
+ | exception Need_backtrack -> Error Adds_constraints
+ | exception Empty_branch -> Error Empty
+ in
+ let p1 = check_rec_result (Pattern_env.copy penv) tp1 in
+ let p2 = check_rec_result (Pattern_env.copy penv) tp2 in
+ begin match p1, p2 with
+ | Error Empty, Error Empty ->
+ raise Empty_branch
+ | Error Adds_constraints, Error _
+ | Error _, Error Adds_constraints ->
+ let inside_nonsplit_or =
+ match info.splitting_mode with
+ | Backtrack_or -> false
+ | Refine_or {inside_nonsplit_or} -> inside_nonsplit_or in
+ if inside_nonsplit_or
+ then raise Need_backtrack
+ else split_or tp
+ | Ok p, Error _
+ | Error _, Ok p ->
+ k p
+ | Ok p1, Ok p2 ->
+ mkp k (Tpat_or (p1, p2, None))
+ end
+ | Tpat_lazy tp1 ->
+ let nv = solve_Ppat_lazy ~refine loc penv expected_ty in
+ (* do not explode under lazy: PR#7421 *)
+ check_rec ~info:(no_explosion info) tp1 nv
+ (fun p1 -> mkp k (Tpat_lazy p1))
+
+let check_counter_example_pat ~counter_example_args penv tp expected_ty =
+ (* [check_counter_example_pat] doesn't use [type_pat_state] in an interesting
+ way -- one of the functions it calls writes an entry into
+ [tps_pattern_forces] -- so we can just ignore module patterns. *)
+ let type_pat_state = create_type_pat_state Modules_ignored in
+ wrap_trace_gadt_instances ~force:true !!penv
+ (check_counter_example_pat ~info:counter_example_args ~penv
+ type_pat_state tp expected_ty)
+ (fun x -> x)
+
+(* this function is passed to Partial.parmatch
+ to type check gadt nonexhaustiveness *)
+let partial_pred ~lev ~splitting_mode ?(explode=0) env expected_ty p =
+ let penv = Pattern_env.make env
+ ~equations_scope:lev ~allow_recursive_equations:true in
+ let state = save_state penv in
+ let counter_example_args =
+ {
+ splitting_mode;
+ explosion_fuel = explode;
+ } in
+ try
+ let typed_p =
+ check_counter_example_pat ~counter_example_args penv p expected_ty
+ in
+ set_state state penv;
+ (* types are invalidated but we don't need them here *)
+ Some typed_p
+ with Error _ | Empty_branch ->
+ set_state state penv;
+ None
+
+let check_partial
+ ?(lev=get_current_level ()) env expected_ty loc cases
+ =
+ let explode = match cases with [_] -> 5 | _ -> 0 in
+ let splitting_mode = Refine_or {inside_nonsplit_or = false} in
+ Parmatch.check_partial
+ (partial_pred ~lev ~splitting_mode ~explode env expected_ty)
+ loc cases
+
+let check_unused
+ ?(lev=get_current_level ()) env expected_ty cases
+ =
+ Parmatch.check_unused
+ (fun refute pat ->
+ match
+ partial_pred ~lev ~splitting_mode:Backtrack_or ~explode:5
+ env expected_ty pat
+ with
+ Some pat' when refute ->
+ raise (Error (pat.pat_loc, env, Unrefuted_pattern pat'))
+ | r -> r)
+ cases
+
+(** Some delayed checks, to be executed after typing the whole
+ compilation unit or toplevel phrase *)
+let delayed_checks = ref []
+let reset_delayed_checks () = delayed_checks := []
+let add_delayed_check f =
+ delayed_checks := (f, Warnings.backup ()) :: !delayed_checks
+
+let force_delayed_checks () =
+ (* checks may change type levels *)
+ let snap = Btype.snapshot () in
+ let w_old = Warnings.backup () in
+ List.iter
+ (fun (f, w) -> Warnings.restore w; f ())
+ (List.rev !delayed_checks);
+ Warnings.restore w_old;
+ reset_delayed_checks ();
+ Btype.backtrack snap
+
+let rec final_subexpression exp =
+ match exp.exp_desc with
+ Texp_let (_, _, e)
+ | Texp_sequence (_, e)
+ | Texp_try (e, _, _)
+ | Texp_ifthenelse (_, e, _)
+ | Texp_match (_, {c_rhs=e} :: _, _, _)
+ | Texp_letmodule (_, _, _, _, e)
+ | Texp_letexception (_, e)
+ | Texp_open (_, e)
+ -> final_subexpression e
+ | _ -> exp
+
+(* Generalization criterion for expressions *)
+
+let rec is_nonexpansive exp =
+ match exp.exp_desc with
+ | Texp_ident _
+ | Texp_constant _
+ | Texp_unreachable
+ | Texp_function _
+ | Texp_array [] -> true
+ | Texp_let(_rec_flag, pat_exp_list, body) ->
+ List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list &&
+ is_nonexpansive body
+ | Texp_apply(e, (_,None)::el) ->
+ is_nonexpansive e && List.for_all is_nonexpansive_opt (List.map snd el)
+ | Texp_match(e, cases, _, _) ->
+ (* Not sure this is necessary, if [e] is nonexpansive then we shouldn't
+ care if there are exception patterns. But the previous version enforced
+ that there be none, so... *)
+ let contains_exception_pat pat =
+ exists_general_pattern { f = fun (type k) (p : k general_pattern) ->
+ match p.pat_desc with
+ | Tpat_exception _ -> true
+ | _ -> false } pat
+ in
+ is_nonexpansive e &&
+ List.for_all
+ (fun {c_lhs; c_guard; c_rhs} ->
+ is_nonexpansive_opt c_guard && is_nonexpansive c_rhs
+ && not (contains_exception_pat c_lhs)
+ ) cases
+ | Texp_tuple el ->
+ List.for_all is_nonexpansive el
+ | Texp_construct( _, _, el) ->
+ List.for_all is_nonexpansive el
+ | Texp_variant(_, arg) -> is_nonexpansive_opt arg
+ | Texp_record { fields; extended_expression } ->
+ Array.for_all
+ (fun (lbl, definition) ->
+ match definition with
+ | Overridden (_, exp) ->
+ lbl.lbl_mut = Immutable && is_nonexpansive exp
+ | Kept _ -> true)
+ fields
+ && is_nonexpansive_opt extended_expression
+ | Texp_field(exp, _, _) -> is_nonexpansive exp
+ | Texp_ifthenelse(_cond, ifso, ifnot) ->
+ is_nonexpansive ifso && is_nonexpansive_opt ifnot
+ | Texp_sequence (_e1, e2) -> is_nonexpansive e2 (* PR#4354 *)
+ | Texp_new (_, _, cl_decl) -> Btype.class_type_arity cl_decl.cty_type > 0
+ (* Note: nonexpansive only means no _observable_ side effects *)
+ | Texp_lazy e -> is_nonexpansive e
+ | Texp_object ({cstr_fields=fields; cstr_type = { csig_vars=vars}}, _) ->
+ let count = ref 0 in
+ List.for_all
+ (fun field -> match field.cf_desc with
+ Tcf_method _ -> true
+ | Tcf_val (_, _, _, Tcfk_concrete (_, e), _) ->
+ incr count; is_nonexpansive e
+ | Tcf_val (_, _, _, Tcfk_virtual _, _) ->
+ incr count; true
+ | Tcf_initializer e -> is_nonexpansive e
+ | Tcf_constraint _ -> true
+ | Tcf_inherit _ -> false
+ | Tcf_attribute _ -> true)
+ fields &&
+ Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
+ vars true &&
+ !count = 0
+ | Texp_letmodule (_, _, _, mexp, e)
+ | Texp_open ({ open_expr = mexp; _}, e) ->
+ is_nonexpansive_mod mexp && is_nonexpansive e
+ | Texp_pack mexp ->
+ is_nonexpansive_mod mexp
+ (* Computations which raise exceptions are nonexpansive, since (raise e) is
+ equivalent to (raise e; diverge), and a nonexpansive "diverge" can be
+ produced using lazy values or the relaxed value restriction.
+ See GPR#1142 *)
+ | Texp_assert (exp, _) ->
+ is_nonexpansive exp
+ | Texp_apply (
+ { exp_desc = Texp_ident (_, _, {val_kind =
+ Val_prim {Primitive.prim_name =
+ ("%raise" | "%reraise" | "%raise_notrace")}}) },
+ [Nolabel, Some e]) ->
+ is_nonexpansive e
+ | Texp_array (_ :: _)
+ | Texp_apply _
+ | Texp_try _
+ | Texp_setfield _
+ | Texp_while _
+ | Texp_for _
+ | Texp_send _
+ | Texp_instvar _
+ | Texp_setinstvar _
+ | Texp_override _
+ | Texp_letexception _
+ | Texp_letop _
+ | Texp_extension_constructor _ ->
+ false
+
+and is_nonexpansive_mod mexp =
+ match mexp.mod_desc with
+ | Tmod_ident _
+ | Tmod_functor _ -> true
+ | Tmod_unpack (e, _) -> is_nonexpansive e
+ | Tmod_constraint (m, _, _, _) -> is_nonexpansive_mod m
+ | Tmod_structure str ->
+ List.for_all
+ (fun item -> match item.str_desc with
+ | Tstr_eval _ | Tstr_primitive _ | Tstr_type _
+ | Tstr_modtype _ | Tstr_class_type _ -> true
+ | Tstr_value (_, pat_exp_list) ->
+ List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list
+ | Tstr_module {mb_expr=m;_}
+ | Tstr_open {open_expr=m;_}
+ | Tstr_include {incl_mod=m;_} -> is_nonexpansive_mod m
+ | Tstr_recmodule id_mod_list ->
+ List.for_all (fun {mb_expr=m;_} -> is_nonexpansive_mod m)
+ id_mod_list
+ | Tstr_exception {tyexn_constructor = {ext_kind = Text_decl _}} ->
+ false (* true would be unsound *)
+ | Tstr_exception {tyexn_constructor = {ext_kind = Text_rebind _}} ->
+ true
+ | Tstr_typext te ->
+ List.for_all
+ (function {ext_kind = Text_decl _} -> false
+ | {ext_kind = Text_rebind _} -> true)
+ te.tyext_constructors
+ | Tstr_class _ -> false (* could be more precise *)
+ | Tstr_attribute _ -> true
+ )
+ str.str_items
+ | Tmod_apply _ | Tmod_apply_unit _ -> false
+
+and is_nonexpansive_opt = function
+ | None -> true
+ | Some e -> is_nonexpansive e
+
+let maybe_expansive e = not (is_nonexpansive e)
+
+let annotate_recursive_bindings env valbinds =
+ let ids = let_bound_idents valbinds in
+ List.map
+ (fun {vb_pat; vb_expr; vb_rec_kind = _; vb_attributes; vb_loc} ->
+ match (Value_rec_check.is_valid_recursive_expression ids vb_expr) with
+ | None ->
+ raise(Error(vb_expr.exp_loc, env, Illegal_letrec_expr))
+ | Some vb_rec_kind ->
+ { vb_pat; vb_expr; vb_rec_kind; vb_attributes; vb_loc})
+ valbinds
+
+let check_recursive_class_bindings env ids exprs =
+ List.iter
+ (fun expr ->
+ if not (Value_rec_check.is_valid_class_expr ids expr) then
+ raise(Error(expr.cl_loc, env, Illegal_class_expr)))
+ exprs
+
+let is_prim ~name funct =
+ match funct.exp_desc with
+ | Texp_ident (_, _, {val_kind=Val_prim{Primitive.prim_name; _}}) ->
+ prim_name = name
+ | _ -> false
+(* Approximate the type of an expression, for better recursion *)
+
+let rec approx_type env sty =
+ match sty.ptyp_desc with
+ Ptyp_arrow (p, _, sty) ->
+ let ty1 = if is_optional p then type_option (newvar ()) else newvar () in
+ newty (Tarrow (p, ty1, approx_type env sty, commu_ok))
+ | Ptyp_tuple args ->
+ newty (Ttuple (List.map (approx_type env) args))
+ | Ptyp_constr (lid, ctl) ->
+ let path, decl = Env.lookup_type ~use:false ~loc:lid.loc lid.txt env in
+ if List.length ctl <> decl.type_arity then newvar ()
+ else begin
+ let tyl = List.map (approx_type env) ctl in
+ newconstr path tyl
+ end
+ | Ptyp_poly (_, sty) ->
+ approx_type env sty
+ | _ -> newvar ()
+
+let type_pattern_approx env spat =
+ match spat.ppat_desc with
+ | Ppat_constraint (_, sty) -> approx_type env sty
+ | _ -> newvar ()
+
+let type_approx_fun env label default spat ret_ty =
+ let ty = type_pattern_approx env spat in
+ let ty =
+ match label, default with
+ | (Nolabel | Labelled _), _ -> ty
+ | Optional _, None ->
+ unify_pat_types spat.ppat_loc env ty (type_option (newvar ()));
+ ty
+ | Optional _, Some _ ->
+ type_option ty
+ in
+ newty (Tarrow (label, ty, ret_ty, commu_ok))
+
+let type_approx_constraint env ty constraint_ ~loc =
+ match constraint_ with
+ | Pconstraint constrain ->
+ let ty_constrain = approx_type env constrain in
+ begin try unify env ty ty_constrain with Unify err ->
+ raise (Error (loc, env, Expr_type_clash (err, None, None)))
+ end;
+ ty_constrain
+ | Pcoerce (constrain, coerce) ->
+ let approx_ty_opt = function
+ | None -> newvar ()
+ | Some sty -> approx_type env sty
+ in
+ let ty_constrain = approx_ty_opt constrain
+ and ty_coerce = approx_type env coerce in
+ begin try unify env ty ty_constrain with Unify err ->
+ raise (Error (loc, env, Expr_type_clash (err, None, None)))
+ end;
+ ty_coerce
+
+let type_approx_constraint_opt env ty constraint_ ~loc =
+ match constraint_ with
+ | None -> ty
+ | Some constraint_ -> type_approx_constraint env ty constraint_ ~loc
+
+let rec type_approx env sexp =
+ let loc = sexp.pexp_loc in
+ match sexp.pexp_desc with
+ Pexp_let (_, _, e) -> type_approx env e
+ | Pexp_function (params, c, body) ->
+ type_approx_function env params c body ~loc
+ | Pexp_match (_, {pc_rhs=e}::_) -> type_approx env e
+ | Pexp_try (e, _) -> type_approx env e
+ | Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l))
+ | Pexp_ifthenelse (_,e,_) -> type_approx env e
+ | Pexp_sequence (_,e) -> type_approx env e
+ | Pexp_constraint (e, sty) ->
+ let ty = type_approx env e in
+ type_approx_constraint env ty (Pconstraint sty) ~loc
+ | Pexp_coerce (e, sty1, sty2) ->
+ let ty = type_approx env e in
+ type_approx_constraint env ty (Pcoerce (sty1, sty2)) ~loc
+ | _ -> newvar ()
+
+and type_approx_function env params c body ~loc =
+ (* We can approximate types up to the first newtype parameter, whereupon
+ we give up.
+ *)
+ match params with
+ | { pparam_desc = Pparam_val (label, default, pat) } :: params ->
+ type_approx_fun env label default pat
+ (type_approx_function env params c body ~loc)
+ | { pparam_desc = Pparam_newtype _ } :: _ ->
+ newvar ()
+ | [] ->
+ let body_ty =
+ match body with
+ | Pfunction_body body ->
+ type_approx env body
+ | Pfunction_cases ({pc_rhs = e} :: _, _, _) ->
+ newty (Tarrow (Nolabel, newvar (), type_approx env e, commu_ok))
+ | Pfunction_cases ([], _, _) ->
+ newvar ()
+ in
+ type_approx_constraint_opt env body_ty c ~loc
+
+(* List labels in a function type, and whether return type is a variable *)
+let rec list_labels_aux env visited ls ty_fun =
+ let ty = expand_head env ty_fun in
+ if TypeSet.mem ty visited then
+ List.rev ls, false
+ else match get_desc ty with
+ Tarrow (l, _, ty_res, _) ->
+ list_labels_aux env (TypeSet.add ty visited) (l::ls) ty_res
+ | _ ->
+ List.rev ls, is_Tvar ty
+
+let list_labels env ty =
+ let snap = Btype.snapshot () in
+ let result =
+ wrap_trace_gadt_instances env (list_labels_aux env TypeSet.empty []) ty
+ in
+ Btype.backtrack snap;
+ result
+
+(* Check that all univars are safe in a type. Both exp.exp_type and
+ ty_expected should already be generalized. *)
+let check_univars env kind exp ty_expected vars =
+ let pty = instance ty_expected in
+ let exp_ty, vars =
+ with_local_level_generalize begin fun () ->
+ match get_desc pty with
+ Tpoly (body, tl) ->
+ (* Enforce scoping for type_let:
+ since body is not generic, instance_poly only makes
+ copies of nodes that have a Tunivar as descendant *)
+ let _, ty' = instance_poly ~fixed:true tl body in
+ let vars, exp_ty = instance_parameterized_type vars exp.exp_type in
+ unify_exp_types exp.exp_loc env exp_ty ty';
+ (exp_ty, vars)
+ | _ -> assert false
+ end
+ in
+ let ty, complete = polyfy env exp_ty vars in
+ if not complete then
+ let ty_expected = instance ty_expected in
+ raise (Error(exp.exp_loc,
+ env,
+ Less_general(kind,
+ Errortrace.unification_error
+ ~trace:[Ctype.expanded_diff env
+ ~got:ty ~expected:ty_expected])))
+
+(* [check_statement] implements the [non-unit-statement] check.
+
+ This check is called in contexts where the value of the expression is known
+ to be discarded (eg. the lhs of a sequence). We check that [exp] has type
+ unit, or has an explicit type annotation; otherwise we raise the
+ [non-unit-statement] warning. *)
+
+let check_statement exp =
+ let ty = get_desc (expand_head exp.exp_env exp.exp_type) in
+ match ty with
+ | Tconstr (p, _, _) when Path.same p Predef.path_unit -> ()
+ | Tvar _ -> ()
+ | _ ->
+ let rec loop {exp_loc; exp_desc; exp_extra; _} =
+ match exp_desc with
+ | Texp_let (_, _, e)
+ | Texp_sequence (_, e)
+ | Texp_letexception (_, e)
+ | Texp_letmodule (_, _, _, _, e) ->
+ loop e
+ | _ ->
+ let loc =
+ match List.find_opt (function
+ | (Texp_constraint _, _, _) -> true
+ | _ -> false) exp_extra
+ with
+ | Some (_, loc, _) -> loc
+ | None -> exp_loc
+ in
+ Location.prerr_warning loc Warnings.Non_unit_statement
+ in
+ loop exp
+
+
+(* [check_partial_application] implements the [ignored-partial-application]
+ warning (and if [statement] is [true], also [non-unit-statement]).
+
+ If [exp] has a function type, we check that it is not syntactically the
+ result of a function application, as this is often a bug in certain contexts
+ (eg the rhs of a let-binding or in the argument of [ignore]). For example,
+ [ignore (List.map print_int)] written by mistake instead of [ignore (List.map
+ print_int li)].
+
+ The check can be disabled by explicitly annotating the expression with a type
+ constraint, eg [(e : _ -> _)].
+
+ If [statement] is [true] and the [ignored-partial-application] is {em not}
+ triggered, then the [non-unit-statement] check is performed (see
+ [check_statement]).
+
+ If the type of [exp] is not known at the time this function is called, the
+ check is retried again after typechecking. *)
+
+let check_partial_application ~statement exp =
+ let check_statement () = if statement then check_statement exp in
+ let doit () =
+ let ty = get_desc (expand_head exp.exp_env exp.exp_type) in
+ match ty with
+ | Tarrow _ ->
+ let rec check {exp_desc; exp_loc; exp_extra; _} =
+ if List.exists (function
+ | (Texp_constraint _, _, _) -> true
+ | _ -> false) exp_extra then check_statement ()
+ else begin
+ match exp_desc with
+ | Texp_ident _ | Texp_constant _ | Texp_tuple _
+ | Texp_construct _ | Texp_variant _ | Texp_record _
+ | Texp_field _ | Texp_setfield _ | Texp_array _
+ | Texp_while _ | Texp_for _ | Texp_instvar _
+ | Texp_setinstvar _ | Texp_override _ | Texp_assert _
+ | Texp_lazy _ | Texp_object _ | Texp_pack _ | Texp_unreachable
+ | Texp_extension_constructor _ | Texp_ifthenelse (_, _, None)
+ | Texp_function _ ->
+ check_statement ()
+ | Texp_match (_, cases, eff_cases, _) ->
+ List.iter (fun {c_rhs; _} -> check c_rhs) cases;
+ List.iter (fun {c_rhs; _} -> check c_rhs) eff_cases
+ | Texp_try (e, cases, eff_cases) ->
+ check e;
+ List.iter (fun {c_rhs; _} -> check c_rhs) cases;
+ List.iter (fun {c_rhs; _} -> check c_rhs) eff_cases
+ | Texp_ifthenelse (_, e1, Some e2) ->
+ check e1; check e2
+ | Texp_let (_, _, e) | Texp_sequence (_, e) | Texp_open (_, e)
+ | Texp_letexception (_, e) | Texp_letmodule (_, _, _, _, e) ->
+ check e
+ | Texp_apply _ | Texp_send _ | Texp_new _ | Texp_letop _ ->
+ Location.prerr_warning exp_loc
+ Warnings.Ignored_partial_application
+ end
+ in
+ check exp
+ | _ ->
+ check_statement ()
+ in
+ let ty = get_desc (expand_head exp.exp_env exp.exp_type) in
+ match ty with
+ | Tvar _ ->
+ (* The type of [exp] is not known. Delay the check until after
+ typechecking in order to give a chance for the type to become known
+ through unification. *)
+ add_delayed_check doit
+ | _ ->
+ doit ()
+
+let pattern_needs_partial_application_check p =
+ let rec check : type a. a general_pattern -> bool = fun p ->
+ not (List.exists (function (Tpat_constraint _, _, _) -> true | _ -> false)
+ p.pat_extra) &&
+ match p.pat_desc with
+ | Tpat_any -> true
+ | Tpat_exception _ -> true
+ | Tpat_or (p1, p2, _) -> check p1 && check p2
+ | Tpat_value p -> check (p :> value general_pattern)
+ | _ -> false
+ in
+ check p
+
+(* Check that a type is generalizable at some level *)
+let generalizable level ty =
+ with_type_mark begin fun mark ->
+ let rec check ty =
+ if try_mark_node mark ty then
+ if get_level ty <= level then raise Exit else iter_type_expr check ty
+ in
+ try check ty; true with Exit -> false
+ end
+
+(* Hack to allow coercion of self. Will clean-up later. *)
+let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
+
+(* Helpers for type_cases *)
+
+let contains_variant_either ty =
+ with_type_mark begin fun mark ->
+ let rec loop ty =
+ if try_mark_node mark ty then
+ begin match get_desc ty with
+ Tvariant row ->
+ if not (is_fixed row) then
+ List.iter
+ (fun (_,f) ->
+ match row_field_repr f with Reither _ -> raise Exit | _ -> ())
+ (row_fields row);
+ iter_row loop row
+ | _ ->
+ iter_type_expr loop ty
+ end
+ in
+ try loop ty; false with Exit -> true
+ end
+
+let shallow_iter_ppat f p =
+ match p.ppat_desc with
+ | Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_interval _
+ | Ppat_construct (_, None)
+ | Ppat_extension _
+ | Ppat_type _ | Ppat_unpack _ -> ()
+ | Ppat_array pats -> List.iter f pats
+ | Ppat_or (p1,p2)
+ | Ppat_effect(p1, p2) -> f p1; f p2
+ | Ppat_variant (_, arg) -> Option.iter f arg
+ | Ppat_tuple lst -> List.iter f lst
+ | Ppat_construct (_, Some (_, p))
+ | Ppat_exception p | Ppat_alias (p,_)
+ | Ppat_open (_,p)
+ | Ppat_constraint (p,_) | Ppat_lazy p -> f p
+ | Ppat_record (args, _flag) -> List.iter (fun (_,p) -> f p) args
+
+let exists_ppat f p =
+ let exception Found in
+ let rec loop p =
+ if f p then raise Found else ();
+ shallow_iter_ppat loop p in
+ match loop p with
+ | exception Found -> true
+ | () -> false
+
+let contains_polymorphic_variant p =
+ exists_ppat
+ (function
+ | {ppat_desc = (Ppat_variant _ | Ppat_type _)} -> true
+ | _ -> false)
+ p
+
+let contains_gadt p =
+ exists_general_pattern { f = fun (type k) (p : k general_pattern) ->
+ match p.pat_desc with
+ | Tpat_construct (_, cd, _, _) when cd.cstr_generalized -> true
+ | _ -> false } p
+
+(* There are various things that we need to do in presence of GADT constructors
+ that aren't required if there are none.
+ However, because of disambiguation, we can't know for sure whether the
+ patterns contain some GADT constructors. So we conservatively assume that
+ any constructor might be a GADT constructor. *)
+let may_contain_gadts p =
+ exists_ppat
+ (function
+ | {ppat_desc = Ppat_construct _} -> true
+ | _ -> false)
+ p
+
+(* There are various things that we need to do in presence of module patterns
+ that aren't required if there are none. Most notably, we need to ensure the
+ modules are entered at the appropriate scope. The caller should use
+ [may_contain_modules] as an indication to set up the proper scope handling
+ code (via [allow_modules]) to permit module patterns.
+ The class of patterns identified here should stay in sync with the patterns
+ whose typing involves [enter_variable ~is_module:true], as these calls
+ will error if the scope handling isn't set up.
+*)
+let may_contain_modules p =
+ exists_ppat
+ (function
+ | {ppat_desc = Ppat_unpack _} -> true
+ | _ -> false)
+ p
+
+let check_absent_variant env =
+ iter_general_pattern { f = fun (type k) (pat : k general_pattern) ->
+ match pat.pat_desc with
+ | Tpat_variant (s, arg, row) ->
+ let row = !row in
+ if List.exists (fun (s',fi) -> s = s' && row_field_repr fi <> Rabsent)
+ (row_fields row)
+ || not (is_fixed row) && not (static_row row) (* same as Ctype.poly *)
+ then () else
+ let ty_arg =
+ match arg with None -> [] | Some p -> [duplicate_type p.pat_type] in
+ let fields = [s, rf_either ty_arg ~no_arg:(arg=None) ~matched:true] in
+ let row' =
+ create_row ~fields
+ ~more:(newvar ()) ~closed:false ~fixed:None ~name:None in
+ (* Should fail *)
+ unify_pat env {pat with pat_type = newty (Tvariant row')}
+ (duplicate_type pat.pat_type)
+ | _ -> () }
+
+(* Getting proper location of already typed expressions.
+
+ Used to avoid confusing locations on type error messages in presence of
+ type constraints.
+ For example:
+
+ (* Before patch *)
+ # let x : string = (5 : int);;
+ ^
+ (* After patch *)
+ # let x : string = (5 : int);;
+ ^^^^^^^^^
+*)
+let proper_exp_loc exp =
+ let rec aux = function
+ | [] -> exp.exp_loc
+ | ((Texp_constraint _ | Texp_coerce _), loc, _) :: _ -> loc
+ | _ :: rest -> aux rest
+ in
+ aux exp.exp_extra
+
+(* To find reasonable names for let-bound and lambda-bound idents *)
+
+let rec name_pattern default = function
+ [] -> Ident.create_local default
+ | p :: rem ->
+ match p.pat_desc with
+ Tpat_var (id, _, _) -> id
+ | Tpat_alias(_, id, _, _) -> id
+ | _ -> name_pattern default rem
+
+let name_cases default lst =
+ name_pattern default (List.map (fun c -> c.c_lhs) lst)
+
+(* Typing of expressions *)
+
+(** [sexp_for_hint] is used by error messages to report literals in their
+ original formatting *)
+let unify_exp ~sexp env exp expected_ty =
+ let loc = proper_exp_loc exp in
+ try
+ unify_exp_types loc env exp.exp_type expected_ty
+ with Error(loc, env, Expr_type_clash(err, tfc, None)) ->
+ raise (Error(loc, env, Expr_type_clash(err, tfc, Some sexp)))
+
+(* If [is_inferred e] is true, [e] will be typechecked without using
+ the "expected type" provided by the context. *)
+
+let rec is_inferred sexp =
+ match sexp.pexp_desc with
+ | Pexp_ident _ | Pexp_apply _ | Pexp_field _ | Pexp_constraint _
+ | Pexp_coerce _ | Pexp_send _ | Pexp_new _ -> true
+ | Pexp_sequence (_, e) | Pexp_open (_, e) -> is_inferred e
+ | Pexp_ifthenelse (_, e1, Some e2) -> is_inferred e1 && is_inferred e2
+ | _ -> false
+
+(* check if the type of %apply or %revapply matches the type expected by
+ the specialized typing rule for those primitives.
+*)
+type apply_prim =
+ | Apply
+ | Revapply
+let check_apply_prim_type prim typ =
+ match get_desc typ with
+ | Tarrow (Nolabel,a,b,_) ->
+ begin match get_desc b with
+ | Tarrow(Nolabel,c,d,_) ->
+ let f, x, res =
+ match prim with
+ | Apply -> a, c, d
+ | Revapply -> c, a, d
+ in
+ begin match get_desc f with
+ | Tarrow(Nolabel,fl,fr,_) ->
+ is_Tvar fl && is_Tvar fr && is_Tvar x && is_Tvar res
+ && Types.eq_type fl x && Types.eq_type fr res
+ | _ -> false
+ end
+ | _ -> false
+ end
+ | _ -> false
+
+(* Merge explanation to type clash error *)
+
+let with_explanation explanation f =
+ match explanation with
+ | None -> f ()
+ | Some explanation ->
+ try f ()
+ with Error (loc', env', Expr_type_clash(err', None, exp'))
+ when not loc'.Location.loc_ghost ->
+ let err = Expr_type_clash(err', Some explanation, exp') in
+ raise (Error (loc', env', err))
+
+(* Generalize expressions *)
+let may_lower_contravariant env exp =
+ if maybe_expansive exp then lower_contravariant env exp.exp_type
+
+(* value binding elaboration *)
+
+let vb_exp_constraint {pvb_expr=expr; pvb_pat=pat; pvb_constraint=ct; _ } =
+ let open Ast_helper in
+ match ct with
+ | None -> expr
+ | Some (Pvc_constraint { locally_abstract_univars=[]; typ }) ->
+ begin match typ.ptyp_desc with
+ | Ptyp_poly _ -> expr
+ | _ ->
+ let loc = { expr.pexp_loc with Location.loc_ghost = true } in
+ Exp.constraint_ ~loc expr typ
+ end
+ | Some (Pvc_coercion { ground; coercion}) ->
+ let loc = { expr.pexp_loc with Location.loc_ghost = true } in
+ Exp.coerce ~loc expr ground coercion
+ | Some (Pvc_constraint { locally_abstract_univars=vars;typ}) ->
+ let loc_start = pat.ppat_loc.Location.loc_start in
+ let loc = { expr.pexp_loc with loc_start; loc_ghost=true } in
+ let expr = Exp.constraint_ ~loc expr typ in
+ List.fold_right (Exp.newtype ~loc) vars expr
+
+let vb_pat_constraint ({pvb_pat=pat; pvb_expr = exp; _ } as vb) =
+ vb.pvb_attributes,
+ let open Ast_helper in
+ match vb.pvb_constraint, pat.ppat_desc, exp.pexp_desc with
+ | Some (Pvc_constraint {locally_abstract_univars=[]; typ}
+ | Pvc_coercion { coercion=typ; _ }),
+ _, _ ->
+ Pat.constraint_ ~loc:{pat.ppat_loc with Location.loc_ghost=true} pat typ
+ | Some (Pvc_constraint {locally_abstract_univars=vars; typ }), _, _ ->
+ let varified = Typ.varify_constructors vars typ in
+ let t = Typ.poly ~loc:typ.ptyp_loc vars varified in
+ let loc_end = typ.ptyp_loc.Location.loc_end in
+ let loc = { pat.ppat_loc with loc_end; loc_ghost=true } in
+ Pat.constraint_ ~loc pat t
+ | None, (Ppat_any | Ppat_constraint _), _ -> pat
+ | None, _, Pexp_coerce (_, _, sty)
+ | None, _, Pexp_constraint (_, sty) when !Clflags.principal ->
+ (* propagate type annotation to pattern,
+ to allow it to be generalized in -principal mode *)
+ Pat.constraint_ ~loc:{pat.ppat_loc with Location.loc_ghost=true} pat sty
+ | _ -> pat
+
+(** The body of a constraint or coercion. The "body" may be either an expression
+ or a list of function cases. This type is polymorphic in the data returned
+ out of typing so that typing an expression body can return an expression
+ and typing a function cases body can return the cases.
+*)
+type 'ret constraint_arg =
+ { type_without_constraint: Env.t -> 'ret * type_expr;
+ (** [type_without_constraint] types a body (e :> t) where there is no
+ constraint.
+ *)
+ type_with_constraint: Env.t -> type_expr -> 'ret;
+ (** [type_with_constraint] types a body (e : t) or (e : t :> t') in
+ the presence of a constraint.
+ *)
+ is_self: 'ret -> bool;
+ (** Whether the thing being constrained is a [Val_self] ident. *)
+ }
+
+let rec type_exp ?recarg env sexp =
+ (* We now delegate everything to type_expect *)
+ type_expect ?recarg env sexp (mk_expected (newvar ()))
+
+(* Typing of an expression with an expected type.
+ This provide better error messages, and allows controlled
+ propagation of return type information.
+ In the principal case, structural nodes of [type_expected_explained] may be
+ at [generic_level] (but its variables no higher than [!current_level]).
+ *)
+
+and type_expect ?recarg env sexp ty_expected_explained =
+ let previous_saved_types = Cmt_format.get_saved_types () in
+ let exp =
+ Builtin_attributes.warning_scope sexp.pexp_attributes
+ (fun () ->
+ type_expect_ ?recarg env sexp ty_expected_explained
+ )
+ in
+ Cmt_format.set_saved_types
+ (Cmt_format.Partial_expression exp :: previous_saved_types);
+ exp
+
+and type_expect_
+ ?(recarg=Rejected)
+ env sexp ty_expected_explained =
+ let { ty = ty_expected; explanation } = ty_expected_explained in
+ let loc = sexp.pexp_loc in
+ (* Record the expression type before unifying it with the expected type *)
+ let with_explanation = with_explanation explanation in
+ (* Unify the result with [ty_expected], enforcing the current level *)
+ let rue exp =
+ with_explanation (fun () ->
+ unify_exp ~sexp env (re exp) (instance ty_expected));
+ exp
+ in
+ match sexp.pexp_desc with
+ | Pexp_ident lid ->
+ let path, desc = type_ident env ~recarg lid in
+ let exp_desc =
+ match desc.val_kind with
+ | Val_ivar (_, cl_num) ->
+ let (self_path, _) =
+ Env.find_value_by_name
+ (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ Texp_instvar(self_path, path,
+ match lid.txt with
+ Longident.Lident txt -> { txt; loc = lid.loc }
+ | _ -> assert false)
+ | Val_self (_, _, _, cl_num) ->
+ let (path, _) =
+ Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ Texp_ident(path, lid, desc)
+ | _ ->
+ Texp_ident(path, lid, desc)
+ in
+ rue {
+ exp_desc; exp_loc = loc; exp_extra = [];
+ exp_type = instance desc.val_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_constant({pconst_desc = Pconst_string (str, _, _); _} as cst) -> (
+ let cst = constant_or_raise env loc cst in
+ (* Terrible hack for format strings *)
+ let ty_exp = expand_head env (protect_expansion env ty_expected) in
+ let fmt6_path =
+ Path.(Pdot (Pident (Ident.create_persistent "CamlinternalFormatBasics"),
+ "format6"))
+ in
+ let is_format = match get_desc ty_exp with
+ | Tconstr(path, _, _) when Path.same path fmt6_path ->
+ if !Clflags.principal && get_level ty_exp <> generic_level then
+ Location.prerr_warning loc
+ (not_principal "this coercion to format6");
+ true
+ | _ -> false
+ in
+ if is_format then
+ let format_parsetree =
+ { (type_format loc str env) with pexp_loc = sexp.pexp_loc } in
+ type_expect env format_parsetree ty_expected_explained
+ else
+ rue {
+ exp_desc = Texp_constant cst;
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance Predef.type_string;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ )
+ | Pexp_constant cst ->
+ let cst = constant_or_raise env loc cst in
+ rue {
+ exp_desc = Texp_constant cst;
+ exp_loc = loc; exp_extra = [];
+ exp_type = type_constant cst;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_let(Nonrecursive,
+ [{pvb_pat=spat; pvb_attributes=[]; _ } as vb], sbody)
+ when may_contain_gadts spat ->
+ (* TODO: allow non-empty attributes? *)
+ let sval = vb_exp_constraint vb in
+ type_expect env
+ {sexp with
+ pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody])}
+ ty_expected_explained
+ | Pexp_let(rec_flag, spat_sexp_list, sbody) ->
+ let existential_context =
+ if rec_flag = Recursive then In_rec
+ else if List.compare_length_with spat_sexp_list 1 > 0 then In_group
+ else With_attributes in
+ let may_contain_modules =
+ List.exists (fun pvb -> may_contain_modules pvb.pvb_pat) spat_sexp_list
+ in
+ let outer_level = get_current_level () in
+ let (pat_exp_list, body, _new_env) =
+ (* If the patterns contain module unpacks, there is a possibility that
+ the types of the let body or bound expressions mention types
+ introduced by those unpacks. The below code checks for scope escape
+ via both of these pathways (body, bound expressions).
+ *)
+ with_local_level_generalize_if may_contain_modules begin fun () ->
+ let allow_modules =
+ if may_contain_modules
+ then
+ let scope = create_scope () in
+ Modules_allowed { scope }
+ else Modules_rejected
+ in
+ let (pat_exp_list, new_env) =
+ type_let existential_context env rec_flag spat_sexp_list
+ allow_modules
+ in
+ let body = type_expect new_env sbody ty_expected_explained in
+ let pat_exp_list = match rec_flag with
+ | Recursive -> annotate_recursive_bindings env pat_exp_list
+ | Nonrecursive -> pat_exp_list
+ in
+ (* The "bound expressions" component of the scope escape check.
+
+ This kind of scope escape is relevant only for recursive
+ module definitions.
+ *)
+ if rec_flag = Recursive && may_contain_modules then begin
+ List.iter
+ (fun vb ->
+ (* [type_let] already generalized bound expressions' types
+ in-place. We first take an instance before checking scope
+ escape at the outer level to avoid losing generality of
+ types added to [new_env].
+ *)
+ let bound_exp = vb.vb_expr in
+ let bound_exp_type = Ctype.instance bound_exp.exp_type in
+ let loc = proper_exp_loc bound_exp in
+ let outer_var = newvar2 outer_level in
+ (* Checking unification within an environment extended with the
+ module bindings allows us to correctly accept more programs.
+ This environment allows unification to identify more cases
+ where a type introduced by the module is equal to a type
+ introduced at an outer scope. *)
+ unify_exp_types loc new_env bound_exp_type outer_var)
+ pat_exp_list
+ end;
+ (pat_exp_list, body, new_env)
+ end
+ ~before_generalize:(fun (_pat_exp_list, body, new_env) ->
+ (* The "body" component of the scope escape check. *)
+ unify_exp ~sexp new_env body (newvar ()))
+ in
+ re {
+ exp_desc = Texp_let(rec_flag, pat_exp_list, body);
+ exp_loc = loc; exp_extra = [];
+ exp_type = body.exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_function (params, body_constraint, body) ->
+ let in_function = ty_expected_explained, loc in
+ let exp_type, params, body, newtypes, contains_gadt =
+ type_function env params body_constraint body ty_expected ~in_function
+ ~first:true
+ in
+ (* Require that the n-ary function is known to have at least n arrows
+ in the type. This prevents GADT equations introduced by the parameters
+ from hiding arrows from the resulting type.
+
+ Performance hack: Only do this check when any of [params] contains a
+ GADT, as this is the only opportunity for arrows to be hidden from the
+ resulting type.
+ *)
+ begin match contains_gadt with
+ | No_gadt -> ()
+ | Contains_gadt ->
+ let ty_function =
+ List.fold_right
+ (fun param rest_ty ->
+ newty
+ (Tarrow (param.fp_arg_label, newvar (), rest_ty, commu_ok)))
+ params
+ (match body with
+ | Tfunction_body _ -> newvar ()
+ | Tfunction_cases _ ->
+ newty (Tarrow (Nolabel, newvar (), newvar (), commu_ok)))
+ in
+ try unify env ty_function exp_type
+ with Unify trace ->
+ let syntactic_arity =
+ List.length params +
+ (match body with
+ | Tfunction_body _ -> 0
+ | Tfunction_cases _ -> 1)
+ in
+ let err =
+ Function_arity_type_clash
+ { syntactic_arity;
+ type_constraint = exp_type;
+ trace;
+ }
+ in
+ raise (Error (loc, env, err))
+ end;
+ re
+ { exp_desc = Texp_function (params, body);
+ exp_loc = loc;
+ exp_extra =
+ List.map (fun { txt; loc } -> Texp_newtype txt, loc, []) newtypes;
+ exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env;
+ }
+ | Pexp_apply(sfunct, sargs) ->
+ assert (sargs <> []);
+ let outer_level = get_current_level () in
+ let rec lower_args seen ty_fun =
+ let ty = expand_head env ty_fun in
+ if TypeSet.mem ty seen then () else
+ match get_desc ty with
+ Tarrow (_l, ty_arg, ty_fun, _com) ->
+ (try Ctype.unify_var env (newvar2 outer_level) ty_arg
+ with Unify _ -> assert false);
+ lower_args (TypeSet.add ty seen) ty_fun
+ | _ -> ()
+ in
+ (* one more level for warning on non-returning functions *)
+ with_local_level_generalize begin fun () ->
+ let type_sfunct sfunct =
+ let funct =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> type_exp env sfunct)
+ in
+ let ty = instance funct.exp_type in
+ wrap_trace_gadt_instances env (lower_args TypeSet.empty) ty;
+ funct
+ in
+ let funct, sargs =
+ let funct = type_sfunct sfunct in
+ match funct.exp_desc, sargs with
+ | Texp_ident (_, _,
+ {val_kind = Val_prim {prim_name="%revapply"}; val_type}),
+ [Nolabel, sarg; Nolabel, actual_sfunct]
+ when is_inferred actual_sfunct
+ && check_apply_prim_type Revapply val_type ->
+ type_sfunct actual_sfunct, [Nolabel, sarg]
+ | Texp_ident (_, _,
+ {val_kind = Val_prim {prim_name="%apply"}; val_type}),
+ [Nolabel, actual_sfunct; Nolabel, sarg]
+ when check_apply_prim_type Apply val_type ->
+ type_sfunct actual_sfunct, [Nolabel, sarg]
+ | _ ->
+ funct, sargs
+ in
+ let (args, ty_res) = type_application env funct sargs in
+ rue {
+ exp_desc = Texp_apply(funct, args);
+ exp_loc = loc; exp_extra = [];
+ exp_type = ty_res;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ end
+ | Pexp_match(sarg, caselist) ->
+ let arg =
+ with_local_level_generalize (fun () -> type_exp env sarg)
+ ~before_generalize:(may_lower_contravariant env)
+ in
+ let rec split_cases valc effc conts = function
+ | [] -> List.rev valc, List.rev effc, List.rev conts
+ | {pc_lhs = {ppat_desc=Ppat_effect(p1, p2)}} as c :: rest ->
+ split_cases valc
+ (({c with pc_lhs = p1}) :: effc) (p2 :: conts) rest
+ | c :: rest ->
+ split_cases (c :: valc) effc conts rest
+ in
+ let val_caselist, eff_caselist, eff_conts =
+ split_cases [] [] [] caselist
+ in
+ if val_caselist = [] && eff_caselist <> [] then
+ raise (Error (loc, env, No_value_clauses));
+ let val_cases, partial =
+ type_cases Computation env arg.exp_type ty_expected_explained
+ ~check_if_total:true loc val_caselist
+ in
+ let eff_cases =
+ match eff_caselist with
+ | [] -> []
+ | eff_caselist ->
+ type_effect_cases Value env ty_expected_explained loc eff_caselist
+ eff_conts
+ in
+ if
+ List.for_all (fun c -> pattern_needs_partial_application_check c.c_lhs)
+ val_cases
+ then check_partial_application ~statement:false arg;
+ re {
+ exp_desc = Texp_match(arg, val_cases, eff_cases, partial);
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance ty_expected;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_try(sbody, caselist) ->
+ let body = type_expect env sbody ty_expected_explained in
+ let rec split_cases exnc effc conts = function
+ | [] -> List.rev exnc, List.rev effc, List.rev conts
+ | {pc_lhs = {ppat_desc=Ppat_effect(p1, p2)}} as c :: rest ->
+ split_cases exnc
+ (({c with pc_lhs = p1}) :: effc) (p2 :: conts) rest
+ | c :: rest ->
+ split_cases (c :: exnc) effc conts rest
+ in
+ let exn_caselist, eff_caselist, eff_conts =
+ split_cases [] [] [] caselist
+ in
+ let exn_cases, _ =
+ type_cases Value env Predef.type_exn ty_expected_explained
+ ~check_if_total:false loc exn_caselist
+ in
+ let eff_cases =
+ match eff_caselist with
+ | [] -> []
+ | eff_caselist ->
+ type_effect_cases Value env ty_expected_explained loc eff_caselist
+ eff_conts
+ in
+ re {
+ exp_desc = Texp_try(body, exn_cases, eff_cases);
+ exp_loc = loc; exp_extra = [];
+ exp_type = body.exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_tuple sexpl ->
+ assert (List.length sexpl >= 2);
+ let subtypes = List.map (fun _ -> newgenvar ()) sexpl in
+ let to_unify = newgenty (Ttuple subtypes) in
+ with_explanation (fun () ->
+ unify_exp_types loc env to_unify (generic_instance ty_expected));
+ let expl =
+ List.map2 (fun body ty -> type_expect env body (mk_expected ty))
+ sexpl subtypes
+ in
+ re {
+ exp_desc = Texp_tuple expl;
+ exp_loc = loc; exp_extra = [];
+ (* Keep sharing *)
+ exp_type = newty (Ttuple (List.map (fun e -> e.exp_type) expl));
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_construct(lid, sarg) ->
+ type_construct env ~sexp lid sarg ty_expected_explained
+ | Pexp_variant(l, sarg) ->
+ (* Keep sharing *)
+ let ty_expected1 = protect_expansion env ty_expected in
+ let ty_expected0 = instance ty_expected in
+ begin try match
+ sarg, get_desc (expand_head env ty_expected1),
+ get_desc (expand_head env ty_expected0)
+ with
+ | Some sarg, Tvariant row, Tvariant row0 ->
+ begin match
+ row_field_repr (get_row_field l row),
+ row_field_repr (get_row_field l row0)
+ with
+ Rpresent (Some ty), Rpresent (Some ty0) ->
+ let arg = type_argument env sarg ty ty0 in
+ re { exp_desc = Texp_variant(l, Some arg);
+ exp_loc = loc; exp_extra = [];
+ exp_type = ty_expected0;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | _ -> raise Exit
+ end
+ | _ -> raise Exit
+ with Exit ->
+ let arg = Option.map (type_exp env) sarg in
+ let arg_type = Option.map (fun arg -> arg.exp_type) arg in
+ let row =
+ create_row
+ ~fields: [l, rf_present arg_type]
+ ~more: (newvar ())
+ ~closed: false
+ ~fixed: None
+ ~name: None
+ in
+ rue {
+ exp_desc = Texp_variant(l, arg);
+ exp_loc = loc; exp_extra = [];
+ exp_type = newty (Tvariant row);
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ end
+ | Pexp_record(lid_sexp_list, opt_sexp) ->
+ assert (lid_sexp_list <> []);
+ let opt_exp =
+ match opt_sexp with
+ None -> None
+ | Some sexp ->
+ let exp =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> type_exp ~recarg env sexp)
+ in
+ Some exp
+ in
+ let ty_record, expected_type =
+ let expected_opath =
+ match extract_concrete_record env ty_expected with
+ | Record_type (p0, p, _) -> Some (p0, p, is_principal ty_expected)
+ | Maybe_a_record_type -> None
+ | Not_a_record_type ->
+ let error =
+ Wrong_expected_kind(Record, Expression explanation, ty_expected)
+ in
+ raise (Error (loc, env, error))
+ in
+ let opt_exp_opath =
+ match opt_exp with
+ | None -> None
+ | Some exp ->
+ match extract_concrete_record env exp.exp_type with
+ | Record_type (p0, p, _) -> Some (p0, p, is_principal exp.exp_type)
+ | Maybe_a_record_type -> None
+ | Not_a_record_type ->
+ let error = Expr_not_a_record_type exp.exp_type in
+ raise (Error (exp.exp_loc, env, error))
+ in
+ match expected_opath, opt_exp_opath with
+ | None, None -> newvar (), None
+ | Some _, None -> ty_expected, expected_opath
+ | Some(_, _, true), Some _ -> ty_expected, expected_opath
+ | (None | Some (_, _, false)), Some (_, p', _) ->
+ let decl = Env.find_type p' env in
+ let ty =
+ with_local_level_generalize_structure
+ (fun () -> newconstr p' (instance_list decl.type_params))
+ in
+ ty, opt_exp_opath
+ in
+ let closed = (opt_sexp = None) in
+ let lbl_exp_list =
+ wrap_disambiguate "This record expression is expected to have"
+ (mk_expected ty_record)
+ (type_label_a_list loc closed env Env.Construct
+ (type_label_exp true env loc ty_record)
+ expected_type)
+ lid_sexp_list
+ in
+ with_explanation (fun () ->
+ unify_exp_types loc env (instance ty_record) (instance ty_expected));
+
+ (* type_label_a_list returns a list of labels sorted by lbl_pos *)
+ (* note: check_duplicates would better be implemented in
+ type_label_a_list directly *)
+ let rec check_duplicates = function
+ | (_, lbl1, _) :: (_, lbl2, _) :: _ when lbl1.lbl_pos = lbl2.lbl_pos ->
+ raise(Error(loc, env, Label_multiply_defined lbl1.lbl_name))
+ | _ :: rem ->
+ check_duplicates rem
+ | [] -> ()
+ in
+ check_duplicates lbl_exp_list;
+ let opt_exp, label_definitions =
+ let (_lid, lbl, _lbl_exp) = List.hd lbl_exp_list in
+ let matching_label lbl =
+ List.find
+ (fun (_, lbl',_) -> lbl'.lbl_pos = lbl.lbl_pos)
+ lbl_exp_list
+ in
+ match opt_exp with
+ None ->
+ let label_definitions =
+ Array.map (fun lbl ->
+ match matching_label lbl with
+ | (lid, _lbl, lbl_exp) ->
+ Overridden (lid, lbl_exp)
+ | exception Not_found ->
+ let present_indices =
+ List.map (fun (_, lbl, _) -> lbl.lbl_pos) lbl_exp_list
+ in
+ let label_names = extract_label_names env ty_expected in
+ let rec missing_labels n = function
+ [] -> []
+ | lbl :: rem ->
+ if List.mem n present_indices
+ then missing_labels (n + 1) rem
+ else lbl :: missing_labels (n + 1) rem
+ in
+ let missing = missing_labels 0 label_names in
+ raise(Error(loc, env, Label_missing missing)))
+ lbl.lbl_all
+ in
+ None, label_definitions
+ | Some exp ->
+ let ty_exp = instance exp.exp_type in
+ let unify_kept lbl =
+ let _, ty_arg1, ty_res1 = instance_label ~fixed:false lbl in
+ unify_exp_types exp.exp_loc env ty_exp ty_res1;
+ match matching_label lbl with
+ | lid, _lbl, lbl_exp ->
+ (* do not connect result types for overridden labels *)
+ Overridden (lid, lbl_exp)
+ | exception Not_found -> begin
+ let _, ty_arg2, ty_res2 = instance_label ~fixed:false lbl in
+ unify_exp_types loc env ty_arg1 ty_arg2;
+ with_explanation (fun () ->
+ unify_exp_types loc env (instance ty_expected) ty_res2);
+ Kept (ty_arg1, lbl.lbl_mut)
+ end
+ in
+ let label_definitions = Array.map unify_kept lbl.lbl_all in
+ Some {exp with exp_type = ty_exp}, label_definitions
+ in
+ let num_fields =
+ match lbl_exp_list with [] -> assert false
+ | (_, lbl,_)::_ -> Array.length lbl.lbl_all in
+ if opt_sexp <> None && List.length lid_sexp_list = num_fields then
+ Location.prerr_warning loc Warnings.Useless_record_with;
+ let label_descriptions, representation =
+ let (_, { lbl_all; lbl_repres }, _) = List.hd lbl_exp_list in
+ lbl_all, lbl_repres
+ in
+ let fields =
+ Array.map2 (fun descr def -> descr, def)
+ label_descriptions label_definitions
+ in
+ re {
+ exp_desc = Texp_record {
+ fields; representation;
+ extended_expression = opt_exp
+ };
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance ty_expected;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_field(srecord, lid) ->
+ let (record, label, _) =
+ type_label_access env srecord Env.Projection lid
+ in
+ let (_, ty_arg, ty_res) = instance_label ~fixed:false label in
+ unify_exp ~sexp env record ty_res;
+ rue {
+ exp_desc = Texp_field(record, lid, label);
+ exp_loc = loc; exp_extra = [];
+ exp_type = ty_arg;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_setfield(srecord, lid, snewval) ->
+ let (record, label, expected_type) =
+ type_label_access env srecord Env.Mutation lid in
+ let ty_record =
+ if expected_type = None then newvar () else record.exp_type in
+ let (label_loc, label, newval) =
+ type_label_exp false env loc ty_record (lid, label, snewval) in
+ unify_exp ~sexp env record ty_record;
+ if label.lbl_mut = Immutable then
+ raise(Error(loc, env, Label_not_mutable lid.txt));
+ rue {
+ exp_desc = Texp_setfield(record, label_loc, label, newval);
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance Predef.type_unit;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_array(sargl) ->
+ let ty = newgenvar() in
+ let to_unify = Predef.type_array ty in
+ with_explanation (fun () ->
+ unify_exp_types loc env to_unify (generic_instance ty_expected));
+ let argl =
+ List.map (fun sarg -> type_expect env sarg (mk_expected ty)) sargl in
+ re {
+ exp_desc = Texp_array argl;
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance ty_expected;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_ifthenelse(scond, sifso, sifnot) ->
+ let cond = type_expect env scond
+ (mk_expected ~explanation:If_conditional Predef.type_bool) in
+ begin match sifnot with
+ None ->
+ let ifso = type_expect env sifso
+ (mk_expected ~explanation:If_no_else_branch Predef.type_unit) in
+ rue {
+ exp_desc = Texp_ifthenelse(cond, ifso, None);
+ exp_loc = loc; exp_extra = [];
+ exp_type = ifso.exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Some sifnot ->
+ let ifso = type_expect env sifso ty_expected_explained in
+ let ifnot = type_expect env sifnot ty_expected_explained in
+ (* Keep sharing *)
+ unify_exp ~sexp env ifnot ifso.exp_type;
+ re {
+ exp_desc = Texp_ifthenelse(cond, ifso, Some ifnot);
+ exp_loc = loc; exp_extra = [];
+ exp_type = ifso.exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ end
+ | Pexp_sequence(sexp1, sexp2) ->
+ let exp1 = type_statement ~explanation:Sequence_left_hand_side
+ env sexp1 in
+ let exp2 = type_expect env sexp2 ty_expected_explained in
+ re {
+ exp_desc = Texp_sequence(exp1, exp2);
+ exp_loc = loc; exp_extra = [];
+ exp_type = exp2.exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_while(scond, sbody) ->
+ let cond = type_expect env scond
+ (mk_expected ~explanation:While_loop_conditional Predef.type_bool) in
+ let exp_type =
+ match cond.exp_desc with
+ | Texp_construct(_, {cstr_name="true"}, _) -> instance ty_expected
+ | _ -> instance Predef.type_unit
+ in
+ let body = type_statement ~explanation:While_loop_body env sbody in
+ rue {
+ exp_desc = Texp_while(cond, body);
+ exp_loc = loc; exp_extra = [];
+ exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_for(param, slow, shigh, dir, sbody) ->
+ let low = type_expect env slow
+ (mk_expected ~explanation:For_loop_start_index Predef.type_int) in
+ let high = type_expect env shigh
+ (mk_expected ~explanation:For_loop_stop_index Predef.type_int) in
+ let id, new_env =
+ match param.ppat_desc with
+ | Ppat_any -> Ident.create_local "_for", env
+ | Ppat_var {txt} ->
+ Env.enter_value txt
+ {val_type = instance Predef.type_int;
+ val_attributes = [];
+ val_kind = Val_reg;
+ val_loc = loc;
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ } env
+ ~check:(fun s -> Warnings.Unused_for_index s)
+ | _ ->
+ raise (Error (param.ppat_loc, env, Invalid_for_loop_index))
+ in
+ let body = type_statement ~explanation:For_loop_body new_env sbody in
+ rue {
+ exp_desc = Texp_for(id, param, low, high, dir, body);
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance Predef.type_unit;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_constraint (sarg, sty) ->
+ let (ty, exp_extra) = type_constraint env sty in
+ let arg = type_argument env sarg ty (instance ty) in
+ rue {
+ exp_desc = arg.exp_desc;
+ exp_loc = arg.exp_loc;
+ exp_type = instance ty;
+ exp_attributes = arg.exp_attributes;
+ exp_env = env;
+ exp_extra = (exp_extra, loc, sexp.pexp_attributes) :: arg.exp_extra;
+ }
+ | Pexp_coerce(sarg, sty, sty') ->
+ let arg, ty', exp_extra =
+ type_coerce (expression_constraint sarg) env loc sty sty'
+ ~loc_arg:sarg.pexp_loc
+ in
+ rue {
+ exp_desc = arg.exp_desc;
+ exp_loc = arg.exp_loc;
+ exp_type = ty';
+ exp_attributes = arg.exp_attributes;
+ exp_env = env;
+ exp_extra = (exp_extra, loc, sexp.pexp_attributes) :: arg.exp_extra;
+ }
+ | Pexp_send (e, {txt=met}) ->
+ let (obj,meth,typ) =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> type_send env loc explanation e met)
+ in
+ let typ =
+ match get_desc typ with
+ | Tpoly (ty, []) ->
+ instance ty
+ | Tpoly (ty, tl) ->
+ if !Clflags.principal && get_level typ <> generic_level then
+ Location.prerr_warning loc
+ (not_principal "this use of a polymorphic method");
+ snd (instance_poly ~fixed:false tl ty)
+ | Tvar _ ->
+ let ty' = newvar () in
+ unify env (instance typ) (newty(Tpoly(ty',[])));
+ (* if not !Clflags.nolabels then
+ Location.prerr_warning loc (Warnings.Unknown_method met); *)
+ ty'
+ | _ ->
+ assert false
+ in
+ rue {
+ exp_desc = Texp_send(obj, meth);
+ exp_loc = loc; exp_extra = [];
+ exp_type = typ;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_new cl ->
+ let (cl_path, cl_decl) = Env.lookup_class ~loc:cl.loc cl.txt env in
+ begin match cl_decl.cty_new with
+ None ->
+ raise(Error(loc, env, Virtual_class cl.txt))
+ | Some ty ->
+ rue {
+ exp_desc = Texp_new (cl_path, cl, cl_decl);
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance ty;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ end
+ | Pexp_setinstvar (lab, snewval) -> begin
+ let (path, mut, cl_num, ty) =
+ Env.lookup_instance_variable ~loc lab.txt env
+ in
+ match mut with
+ | Mutable ->
+ let newval =
+ type_expect env snewval (mk_expected (instance ty))
+ in
+ let (path_self, _) =
+ Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ rue {
+ exp_desc = Texp_setinstvar(path_self, path, lab, newval);
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance Predef.type_unit;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | _ ->
+ raise(Error(loc, env, Instance_variable_not_mutable lab.txt))
+ end
+ | Pexp_override lst ->
+ let _ =
+ List.fold_right
+ (fun (lab, _) l ->
+ if List.exists (fun l -> l.txt = lab.txt) l then
+ raise(Error(loc, env,
+ Value_multiply_overridden lab.txt));
+ lab::l)
+ lst
+ [] in
+ begin match
+ try
+ Env.find_value_by_name (Longident.Lident "selfpat-*") env,
+ Env.find_value_by_name (Longident.Lident "self-*") env
+ with Not_found ->
+ raise(Error(loc, env, Outside_class))
+ with
+ (_, {val_type = self_ty; val_kind = Val_self (sign, _, vars, _)}),
+ (path_self, _) ->
+ let type_override (lab, snewval) =
+ begin try
+ let id = Vars.find lab.txt vars in
+ let ty = Btype.instance_variable_type lab.txt sign in
+ (id, lab, type_expect env snewval (mk_expected (instance ty)))
+ with
+ Not_found ->
+ let vars = Vars.fold (fun var _ li -> var::li) vars [] in
+ raise(Error(loc, env,
+ Unbound_instance_variable (lab.txt, vars)))
+ end
+ in
+ let modifs = List.map type_override lst in
+ rue {
+ exp_desc = Texp_override(path_self, modifs);
+ exp_loc = loc; exp_extra = [];
+ exp_type = self_ty;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | _ ->
+ assert false
+ end
+ | Pexp_letmodule(name, smodl, sbody) ->
+ let lv = get_current_level () in
+ let (id, pres, modl, _, body) =
+ with_local_level_generalize begin fun () ->
+ let modl, pres, id, new_env =
+ Typetexp.TyVarEnv.with_local_scope begin fun () ->
+ let modl, md_shape = !type_module env smodl in
+ Mtype.lower_nongen lv modl.mod_type;
+ let pres =
+ match modl.mod_type with
+ | Mty_alias _ -> Mp_absent
+ | _ -> Mp_present
+ in
+ let scope = create_scope () in
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
+ let md_shape = Shape.set_uid_if_none md_shape md_uid in
+ let md =
+ { md_type = modl.mod_type; md_attributes = [];
+ md_loc = name.loc;
+ md_uid; }
+ in
+ let (id, new_env) =
+ match name.txt with
+ | None -> None, env
+ | Some name ->
+ let id, env =
+ Env.enter_module_declaration
+ ~scope ~shape:md_shape name pres md env
+ in
+ Some id, env
+ in
+ modl, pres, id, new_env
+ end
+ in
+ (* Ideally, we should catch Expr_type_clash errors
+ in type_expect triggered by escaping identifiers
+ from the local module and refine them into
+ Scoping_let_module errors
+ *)
+ let body = type_expect new_env sbody ty_expected_explained in
+ (id, pres, modl, new_env, body)
+ end
+ ~before_generalize: begin fun (_id, _pres, _modl, new_env, body) ->
+ (* Ensure that local definitions do not leak. *)
+ (* required for implicit unpack *)
+ enforce_current_level new_env body.exp_type
+ end
+ in
+ re {
+ exp_desc = Texp_letmodule(id, name, pres, modl, body);
+ exp_loc = loc; exp_extra = [];
+ exp_type = body.exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_letexception(cd, sbody) ->
+ let (cd, newenv, _shape) = Typedecl.transl_exception env cd in
+ let body = type_expect newenv sbody ty_expected_explained in
+ re {
+ exp_desc = Texp_letexception(cd, body);
+ exp_loc = loc; exp_extra = [];
+ exp_type = body.exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+
+ | Pexp_assert (e) ->
+ let cond = type_expect env e
+ (mk_expected ~explanation:Assert_condition Predef.type_bool) in
+ let exp_type =
+ match cond.exp_desc with
+ | Texp_construct(_, {cstr_name="false"}, _) ->
+ instance ty_expected
+ | _ ->
+ instance Predef.type_unit
+ in
+ let rec innermost_location loc_stack =
+ match loc_stack with
+ | [] -> loc
+ | [l] -> l
+ | _ :: s -> innermost_location s
+ in
+ rue {
+ exp_desc = Texp_assert (cond, innermost_location sexp.pexp_loc_stack);
+ exp_loc = loc; exp_extra = [];
+ exp_type;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env;
+ }
+ | Pexp_lazy e ->
+ let ty = newgenvar () in
+ let to_unify = Predef.type_lazy_t ty in
+ with_explanation (fun () ->
+ unify_exp_types loc env to_unify (generic_instance ty_expected));
+ let arg = type_expect env e (mk_expected ty) in
+ re {
+ exp_desc = Texp_lazy arg;
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance ty_expected;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env;
+ }
+ | Pexp_object s ->
+ let desc, meths = !type_object env loc s in
+ rue {
+ exp_desc = Texp_object (desc, meths);
+ exp_loc = loc; exp_extra = [];
+ exp_type = desc.cstr_type.csig_self;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env;
+ }
+ | Pexp_poly(sbody, sty) ->
+ let ty, cty =
+ with_local_level_generalize_structure_if_principal
+ begin fun () ->
+ match sty with None -> protect_expansion env ty_expected, None
+ | Some sty ->
+ let sty = Ast_helper.Typ.force_poly sty in
+ let cty = Typetexp.transl_simple_type env ~closed:false sty in
+ cty.ctyp_type, Some cty
+ end
+ in
+ if sty <> None then
+ with_explanation (fun () ->
+ unify_exp_types loc env (instance ty) (instance ty_expected));
+ let exp =
+ match get_desc (expand_head env ty) with
+ Tpoly (ty', []) ->
+ let exp = type_expect env sbody (mk_expected ty') in
+ { exp with exp_type = instance ty }
+ | Tpoly (ty', tl) ->
+ (* One more level to generalize locally *)
+ let (exp, vars) =
+ with_local_level_generalize begin fun () ->
+ let vars, ty'' =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> instance_poly ~fixed:true tl ty')
+ in
+ let exp = type_expect env sbody (mk_expected ty'') in
+ (exp, vars)
+ end
+ in
+ check_univars env "method" exp ty_expected vars;
+ { exp with exp_type = instance ty }
+ | Tvar _ ->
+ let exp = type_exp env sbody in
+ let exp = {exp with exp_type = newty (Tpoly (exp.exp_type, []))} in
+ unify_exp ~sexp env exp ty;
+ exp
+ | _ -> assert false
+ in
+ re { exp with exp_extra =
+ (Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra }
+ | Pexp_newtype(name, sbody) ->
+ let body, ety = type_newtype env name (fun env ->
+ let expr = type_exp env sbody in
+ expr, expr.exp_type)
+ in
+ (* non-expansive if the body is non-expansive, so we don't introduce
+ any new extra node in the typed AST. *)
+ rue { body with exp_loc = loc; exp_type = ety;
+ exp_extra =
+ (Texp_newtype name.txt, loc, sexp.pexp_attributes) :: body.exp_extra
+ }
+ | Pexp_pack m ->
+ let (p, fl) =
+ match get_desc (Ctype.expand_head env (instance ty_expected)) with
+ Tpackage (p, fl) ->
+ if !Clflags.principal &&
+ get_level (Ctype.expand_head env
+ (protect_expansion env ty_expected))
+ < Btype.generic_level
+ then
+ Location.prerr_warning loc
+ (not_principal "this module packing");
+ (p, fl)
+ | Tvar _ ->
+ raise (Error (loc, env, Cannot_infer_signature))
+ | _ ->
+ raise (Error (loc, env, Not_a_packed_module ty_expected))
+ in
+ let (modl, fl') = !type_package env m p fl in
+ rue {
+ exp_desc = Texp_pack modl;
+ exp_loc = loc; exp_extra = [];
+ exp_type = newty (Tpackage (p, fl'));
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | Pexp_open (od, e) ->
+ let tv = newvar () in
+ let (od, _, newenv) = !type_open_decl env od in
+ let exp = type_expect newenv e ty_expected_explained in
+ (* Force the return type to be well-formed in the original
+ environment. *)
+ unify_var newenv tv exp.exp_type;
+ re {
+ exp_desc = Texp_open (od, exp);
+ exp_type = exp.exp_type;
+ exp_loc = loc;
+ exp_extra = [];
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env;
+ }
+ | Pexp_letop{ let_ = slet; ands = sands; body = sbody } ->
+ let rec loop spat_acc ty_acc sands =
+ match sands with
+ | [] -> spat_acc, ty_acc
+ | { pbop_pat = spat; _} :: rest ->
+ let ty = newvar () in
+ let loc = { slet.pbop_op.loc with Location.loc_ghost = true } in
+ let spat_acc = Ast_helper.Pat.tuple ~loc [spat_acc; spat] in
+ let ty_acc = newty (Ttuple [ty_acc; ty]) in
+ loop spat_acc ty_acc rest
+ in
+ let op_path, op_desc, op_type, spat_params, ty_params,
+ ty_func_result, ty_result, ty_andops =
+ with_local_level_generalize_structure_if_principal begin fun () ->
+ let let_loc = slet.pbop_op.loc in
+ let op_path, op_desc = type_binding_op_ident env slet.pbop_op in
+ let op_type = instance op_desc.val_type in
+ let spat_params, ty_params = loop slet.pbop_pat (newvar ()) sands in
+ let ty_func_result = newvar () in
+ let ty_func =
+ newty (Tarrow(Nolabel, ty_params, ty_func_result, commu_ok)) in
+ let ty_result = newvar () in
+ let ty_andops = newvar () in
+ let ty_op =
+ newty (Tarrow(Nolabel, ty_andops,
+ newty (Tarrow(Nolabel, ty_func, ty_result, commu_ok)), commu_ok))
+ in
+ begin try
+ unify env op_type ty_op
+ with Unify err ->
+ raise(Error(let_loc, env, Letop_type_clash(slet.pbop_op.txt, err)))
+ end;
+ (op_path, op_desc, op_type, spat_params, ty_params,
+ ty_func_result, ty_result, ty_andops)
+ end
+ in
+ let exp, ands = type_andops env slet.pbop_exp sands ty_andops in
+ let scase = Ast_helper.Exp.case spat_params sbody in
+ let cases, partial =
+ type_cases Value env
+ ty_params (mk_expected ty_func_result)
+ ~check_if_total:true loc [scase]
+ in
+ let body =
+ match cases with
+ | [case] -> case
+ | _ -> assert false
+ in
+ let param = name_cases "param" cases in
+ let let_ =
+ { bop_op_name = slet.pbop_op;
+ bop_op_path = op_path;
+ bop_op_val = op_desc;
+ bop_op_type = op_type;
+ bop_exp = exp;
+ bop_loc = slet.pbop_loc; }
+ in
+ let desc =
+ Texp_letop{let_; ands; param; body; partial}
+ in
+ rue { exp_desc = desc;
+ exp_loc = sexp.pexp_loc;
+ exp_extra = [];
+ exp_type = instance ty_result;
+ exp_env = env;
+ exp_attributes = sexp.pexp_attributes; }
+
+ | Pexp_extension ({ txt = ("ocaml.extension_constructor"
+ |"extension_constructor"); _ },
+ payload) ->
+ begin match payload with
+ | PStr [ { pstr_desc =
+ Pstr_eval ({ pexp_desc = Pexp_construct (lid, None); _ }, _)
+ } ] ->
+ let path =
+ let cd =
+ Env.lookup_constructor Env.Positive ~loc:lid.loc lid.txt env
+ in
+ match cd.cstr_tag with
+ | Cstr_extension (path, _) -> path
+ | _ -> raise (Error (lid.loc, env, Not_an_extension_constructor))
+ in
+ rue {
+ exp_desc = Texp_extension_constructor (lid, path);
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance Predef.type_extension_constructor;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | _ ->
+ raise (Error (loc, env, Invalid_extension_constructor_payload))
+ end
+ | Pexp_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+ | Pexp_unreachable ->
+ re { exp_desc = Texp_unreachable;
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance ty_expected;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+
+and expression_constraint pexp =
+ { type_without_constraint = (fun env ->
+ let expr = type_exp env pexp in
+ expr, expr.exp_type);
+ type_with_constraint =
+ (fun env ty -> type_argument env pexp ty (instance ty));
+ is_self =
+ (fun expr ->
+ match expr.exp_desc with
+ | Texp_ident (_, _, { val_kind = Val_self _ }) -> true
+ | _ -> false);
+ }
+
+(** Types a body in the scope of a coercion (with an optional constraint)
+ and returns the inferred type. See the comment on {!constraint_arg} for
+ an explanation of how this typechecking is polymorphic in the body.
+*)
+and type_coerce
+ : type a. a constraint_arg -> _ -> _ -> _ -> _ -> loc_arg:_
+ -> a * type_expr * exp_extra =
+ fun constraint_arg env loc sty sty' ~loc_arg ->
+ (* Pretend separate = true, 1% slowdown for lablgtk *)
+ (* Also see PR#7199 for a problem with the following:
+ let separate = !Clflags.principal || Env.has_local_constraints env in*)
+ let { is_self; type_with_constraint; type_without_constraint } =
+ constraint_arg
+ in
+ match sty with
+ | None ->
+ let (cty', ty', force) =
+ Typetexp.transl_simple_type_delayed env sty'
+ in
+ let arg, arg_type, gen =
+ let lv = get_current_level () in
+ with_local_level_generalize begin fun () ->
+ let arg, arg_type = type_without_constraint env in
+ arg, arg_type, generalizable lv arg_type
+ end
+ ~before_generalize:
+ (fun (_, arg_type, _) -> enforce_current_level env arg_type)
+ in
+ begin match !self_coercion, get_desc ty' with
+ | ((path, r) :: _, Tconstr (path', _, _))
+ when is_self arg && Path.same path path' ->
+ (* prerr_endline "self coercion"; *)
+ r := loc :: !r;
+ force ()
+ | _ when closed_type_expr ~env arg_type
+ && closed_type_expr ~env ty' ->
+ if not gen && (* first try a single coercion *)
+ let snap = snapshot () in
+ let ty, _b = enlarge_type env ty' in
+ try
+ force (); Ctype.unify env arg_type ty; true
+ with Unify _ ->
+ backtrack snap; false
+ then ()
+ else begin try
+ let force' = subtype env arg_type ty' in
+ force (); force' ();
+ if not gen && !Clflags.principal then
+ Location.prerr_warning loc
+ (not_principal "this ground coercion");
+ with Subtype err ->
+ (* prerr_endline "coercion failed"; *)
+ raise (Error (loc, env, Not_subtype err))
+ end;
+ | _ ->
+ let ty, b = enlarge_type env ty' in
+ force ();
+ begin try Ctype.unify env arg_type ty with Unify err ->
+ let expanded = full_expand ~may_forget_scope:true env ty' in
+ raise(Error(loc_arg, env,
+ Coercion_failure ({ ty = ty'; expanded }, err, b)))
+ end
+ end;
+ (arg, ty', Texp_coerce (None, cty'))
+ | Some sty ->
+ let cty, ty, force, cty', ty', force' =
+ with_local_level_generalize_structure begin fun () ->
+ let (cty, ty, force) =
+ Typetexp.transl_simple_type_delayed env sty
+ and (cty', ty', force') =
+ Typetexp.transl_simple_type_delayed env sty'
+ in
+ (cty, ty, force, cty', ty', force')
+ end
+ in
+ begin try
+ let force'' = subtype env (instance ty) (instance ty') in
+ force (); force' (); force'' ()
+ with Subtype err ->
+ raise (Error (loc, env, Not_subtype err))
+ end;
+ (type_with_constraint env ty,
+ instance ty', Texp_coerce (Some cty, cty'))
+
+and type_constraint env sty =
+ (* Pretend separate = true, 1% slowdown for lablgtk *)
+ let cty =
+ with_local_level_generalize_structure begin fun () ->
+ Typetexp.transl_simple_type env ~closed:false sty
+ end
+ in
+ cty.ctyp_type, Texp_constraint cty
+
+(** Types a body in the scope of a coercion (:>) or a constraint (:), and
+ unifies the inferred type with the expected type.
+
+ @param loc the location of the overall constraint
+ @param loc_arg the location of the thing being constrained
+*)
+and type_constraint_expect
+ : type a. a constraint_arg -> _ -> _ -> loc_arg:_ -> _ -> _ -> a * _ * _ =
+ fun constraint_arg env loc ~loc_arg constraint_ ty_expected ->
+ let ret, ty, exp_extra =
+ match constraint_ with
+ | Pcoerce (ty_constrain, ty_coerce) ->
+ type_coerce constraint_arg env loc ty_constrain ty_coerce ~loc_arg
+ | Pconstraint ty_constrain ->
+ let ty, exp_extra = type_constraint env ty_constrain in
+ constraint_arg.type_with_constraint env ty, ty, exp_extra
+ in
+ unify_exp_types loc env ty (instance ty_expected);
+ ret, ty, exp_extra
+
+(** Typecheck the body of a newtype. The "body" of a newtype may be:
+ - an expression
+ - a suffix of function parameters together with a function body
+ That's why this function is polymorphic over the body.
+
+ @param type_body A function that produces a type for the body given the
+ environment. When typechecking an expression, this is [type_exp].
+ @return The type returned by [type_body] but with the Tconstr
+ nodes for the newtype properly linked.
+*)
+and type_newtype
+ : type a. _ -> _ -> (Env.t -> a * type_expr) -> a * type_expr =
+ fun env { txt = name; loc = name_loc } type_body ->
+ let ty =
+ if Typetexp.valid_tyvar_name name then
+ newvar ~name ()
+ else
+ newvar ()
+ in
+ (* Use [with_local_level_generalize] just for scoping *)
+ with_local_level_generalize begin fun () ->
+ (* Create a fake abstract type declaration for [name]. *)
+ let decl = new_local_type ~loc:name_loc Definition in
+ let scope = create_scope () in
+ let (id, new_env) = Env.enter_type ~scope name decl env in
+
+ let result, exp_type = type_body new_env in
+ (* Replace every instance of this type constructor in the resulting
+ type. *)
+ let seen = Hashtbl.create 8 in
+ let rec replace t =
+ if Hashtbl.mem seen (get_id t) then ()
+ else begin
+ Hashtbl.add seen (get_id t) ();
+ match get_desc t with
+ | Tconstr (Path.Pident id', _, _) when id == id' -> link_type t ty
+ | _ -> Btype.iter_type_expr replace t
+ end
+ in
+ let ety = Subst.type_expr Subst.identity exp_type in
+ replace ety;
+ (result, ety)
+ end
+ ~before_generalize:(fun (_,ety) -> enforce_current_level env ety)
+
+and type_ident env ?(recarg=Rejected) lid =
+ let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in
+ let is_recarg =
+ match get_desc desc.val_type with
+ | Tconstr(p, _, _) -> Path.is_constructor_typath p
+ | _ -> false
+ in
+ begin match is_recarg, recarg, get_desc desc.val_type with
+ | _, Allowed, _
+ | true, Required, _
+ | false, Rejected, _ -> ()
+ | true, Rejected, _
+ | false, Required, (Tvar _ | Tconstr _) ->
+ raise (Error (lid.loc, env, Inlined_record_escape))
+ | false, Required, _ -> () (* will fail later *)
+ end;
+ path, desc
+
+and type_binding_op_ident env s =
+ let loc = s.loc in
+ let lid = Location.mkloc (Longident.Lident s.txt) loc in
+ let path, desc = type_ident env lid in
+ let path =
+ match desc.val_kind with
+ | Val_ivar _ ->
+ fatal_error "Illegal name for instance variable"
+ | Val_self (_, _, _, cl_num) ->
+ let path, _ =
+ Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ path
+ | _ -> path
+ in
+ path, desc
+
+(** Returns the argument type and then the return type.
+
+ @param first Whether the parameter corresponding to the argument of
+ [ty_expected] is the first parameter to the (n-ary) function. This only
+ affects error messages.
+ @param in_function Information about the [Pexp_function] node that's in the
+ process of being typechecked (its overall type and its location). Again,
+ this is only used to improve error messages.
+*)
+and split_function_ty env ty_expected ~arg_label ~first ~in_function =
+ let { ty = ty_fun; explanation }, loc = in_function in
+ let separate = !Clflags.principal || Env.has_local_constraints env in
+ with_local_level_generalize_structure_if separate begin fun () ->
+ let ty_arg, ty_res =
+ try filter_arrow env (instance ty_expected) arg_label
+ with Filter_arrow_failed err ->
+ let err = match err with
+ | Unification_error unif_err ->
+ Expr_type_clash (unif_err, explanation, None)
+ | Label_mismatch { got; expected; expected_type } ->
+ Abstract_wrong_label { got; expected; expected_type; explanation }
+ | Not_a_function ->
+ if first
+ then Not_a_function (ty_fun, explanation)
+ else Too_many_arguments (ty_fun, explanation)
+ in
+ raise (Error(loc, env, err))
+ in
+ let ty_arg =
+ if is_optional arg_label then
+ let tv = newvar () in
+ begin
+ try unify env ty_arg (type_option tv)
+ with Unify _ -> assert false
+ end;
+ type_option tv
+ else ty_arg
+ in
+ (ty_arg, ty_res)
+ end
+
+(* Typecheck parameters one at a time followed by the body. Later parameters
+ are checked in the scope of earlier ones. That's necessary to support
+ constructs like [fun (type a) (x : a) -> ...] and
+ [fun (module M : S) (x : M.t) -> ...].
+
+ Operates like [type_expect] in that it unifies the "type of the remaining
+ function params + body" with [ty_expected], and returns out the inferred
+ type.
+
+ See [split_function_ty] for the meaning of [first] and [in_function].
+
+ Returns (inferred_ty, params, body, newtypes, contains_gadt), where:
+ - [newtypes] are the newtypes immediately bound by the prefix of function
+ parameters. These should be added to an [exp_extra] node.
+ - [contains_gadt] is whether any of [params] contains a GADT. Note
+ this does not indicate whether [body] contains a GADT (if it's
+ [Tfunction_cases]).
+*)
+and type_function
+ env params_suffix body_constraint body ty_expected ~first ~in_function
+ =
+ let ty_fun, (loc_function : Location.t) = in_function in
+ (* The "rest of the function" extends from the start of the first parameter
+ to the end of the overall function. The parser does not construct such
+ a location so we forge one for type errors.
+ *)
+ let loc : Location.t =
+ match params_suffix, body with
+ | param :: _, _ ->
+ { loc_start = param.pparam_loc.loc_start;
+ loc_end = loc_function.loc_end;
+ loc_ghost = true;
+ }
+ | [], Pfunction_body pexp -> pexp.pexp_loc
+ | [], Pfunction_cases (_, loc_cases, _) -> loc_cases
+ in
+ match params_suffix with
+ | { pparam_desc = Pparam_newtype newtype; pparam_loc = _ } :: rest ->
+ (* Check everything else in the scope of (type a). *)
+ let (params, body, newtypes, contains_gadt), exp_type =
+ type_newtype env newtype (fun env ->
+ let exp_type, params, body, newtypes, contains_gadt =
+ (* mimic the typing of Pexp_newtype by minting a new type var,
+ like [type_exp].
+ *)
+ type_function env rest body_constraint body (newvar ())
+ ~first:false ~in_function
+ in
+ (params, body, newtypes, contains_gadt), exp_type)
+ in
+ with_explanation ty_fun.explanation (fun () ->
+ unify_exp_types loc env exp_type (instance ty_expected));
+ exp_type, params, body, newtype :: newtypes, contains_gadt
+ | { pparam_desc = Pparam_val (arg_label, default_arg, pat); pparam_loc }
+ :: rest
+ ->
+ let ty_arg, ty_res =
+ split_function_ty env ty_expected ~arg_label ~first ~in_function
+ in
+ (* [ty_arg_internal] is the type of the parameter viewed internally
+ to the function. This is different than [ty_arg] exactly for
+ optional arguments with defaults, where the external [ty_arg]
+ is optional and the internal view is not optional.
+ *)
+ let ty_arg_internal, default_arg =
+ match default_arg with
+ | None -> ty_arg, None
+ | Some default ->
+ assert (is_optional arg_label);
+ let ty_default = newvar () in
+ begin
+ try unify env (type_option ty_default) ty_arg
+ with Unify _ -> assert false;
+ end;
+ (* Issue#12668: Retain type-directed disambiguation of
+ ?x:(y : Variant.t = Constr)
+ *)
+ let default =
+ match pat.ppat_desc with
+ | Ppat_constraint (_, sty) ->
+ let gloc = { default.pexp_loc with loc_ghost = true } in
+ Ast_helper.Exp.constraint_ default sty ~loc:gloc
+ | _ -> default
+ in
+ let default = type_expect env default (mk_expected ty_default) in
+ ty_default, Some default
+ in
+ let (pat, params, body, newtypes, contains_gadt), partial =
+ (* Check everything else in the scope of the parameter. *)
+ map_half_typed_cases Value env ty_arg_internal ty_res pat.ppat_loc
+ ~check_if_total:true
+ (* We don't make use of [case_data] here so we pass unit. *)
+ [ { pattern = pat; has_guard = false; needs_refute = false }, () ]
+ ~type_body:begin
+ fun () pat ~when_env:_ ~ext_env ~cont:_ ~ty_expected ~ty_infer:_
+ ~contains_gadt:param_contains_gadt ->
+ let _, params, body, newtypes, suffix_contains_gadt =
+ type_function ext_env rest body_constraint body
+ ty_expected ~first:false ~in_function
+ in
+ let contains_gadt =
+ if param_contains_gadt then
+ Contains_gadt
+ else
+ suffix_contains_gadt
+ in
+ (pat, params, body, newtypes, contains_gadt)
+ end
+ |> function
+ (* The result must be a singleton because we passed a singleton
+ list above. *)
+ | [ result ], partial -> result, partial
+ | ([] | _ :: _ :: _), _ -> assert false
+ in
+ let exp_type =
+ instance (newgenty (Tarrow (arg_label, ty_arg, ty_res, commu_ok)))
+ in
+ (* This is quadratic, as it operates over the entire tail of the
+ type for each new parameter. Now that functions are n-ary, we
+ could possibly run this once.
+ *)
+ with_explanation ty_fun.explanation (fun () ->
+ unify_exp_types loc env exp_type (instance ty_expected));
+ (* This is quadratic, as it extracts all of the parameters from an arrow
+ type for each parameter that's added. Now that functions are n-ary,
+ there might be an opportunity to improve this.
+ *)
+ let not_nolabel_function ty =
+ let ls, tvar = list_labels env ty in
+ List.for_all (( <> ) Nolabel) ls && not tvar
+ in
+ if is_optional arg_label && not_nolabel_function ty_res
+ then
+ Location.prerr_warning
+ pat.pat_loc
+ Warnings.Unerasable_optional_argument;
+ let fp_kind, fp_param =
+ match default_arg with
+ | None ->
+ let param = name_pattern "param" [ pat ] in
+ Tparam_pat pat, param
+ | Some default_arg ->
+ let param = Ident.create_local "*opt*" in
+ Tparam_optional_default (pat, default_arg), param
+ in
+ let param =
+ { fp_kind;
+ fp_arg_label = arg_label;
+ fp_param;
+ fp_partial = partial;
+ fp_newtypes = newtypes;
+ fp_loc = pparam_loc;
+ }
+ in
+ exp_type, param :: params, body, [], contains_gadt
+ | [] ->
+ let exp_type, body =
+ match body with
+ | Pfunction_body body ->
+ let body =
+ match body_constraint with
+ | None -> type_expect env body (mk_expected ty_expected)
+ | Some constraint_ ->
+ let body_loc = body.pexp_loc in
+ let body, exp_type, exp_extra =
+ type_constraint_expect (expression_constraint body)
+ env body_loc ~loc_arg:body_loc constraint_ ty_expected
+ in
+ { body with
+ exp_extra = (exp_extra, body_loc, []) :: body.exp_extra;
+ exp_type;
+ }
+ in
+ body.exp_type, Tfunction_body body
+ | Pfunction_cases (cases, _, attributes) ->
+ let type_cases_expect env ty_expected =
+ type_function_cases_expect
+ env ty_expected loc cases attributes ~first ~in_function
+ in
+ let (cases, partial, exp_type), exp_extra =
+ match body_constraint with
+ | None -> type_cases_expect env ty_expected, None
+ | Some constraint_ ->
+ (* The typing of function case coercions/constraints is
+ analogous to the typing of expression coercions/constraints.
+
+ - [type_with_constraint]: If there is a constraint, then call
+ [type_argument] on the cases, and discard the cases'
+ inferred type in favor of the constrained type. (Function
+ cases aren't inferred, so [type_argument] would just call
+ [type_expect] straight away, so we do the same here.)
+ - [type_without_constraint]: If there is just a coercion and
+ no constraint, call [type_exp] on the cases and surface the
+ cases' inferred type to [type_constraint_expect]. *)
+ let function_cases_constraint_arg =
+ { is_self = (fun _ -> false);
+ type_with_constraint = (fun env ty ->
+ let cases, partial, _ = type_cases_expect env ty in
+ cases, partial);
+ type_without_constraint = (fun env ->
+ let cases, partial, ty_fun =
+ (* The analogy to [type_exp] for expressions. *)
+ type_cases_expect env (newvar ())
+ in
+ (cases, partial), ty_fun);
+ }
+ in
+ let (cases, partial), exp_type, exp_extra =
+ type_constraint_expect function_cases_constraint_arg
+ env loc constraint_ ty_expected ~loc_arg:loc
+ in
+ (cases, partial, exp_type), Some exp_extra
+ in
+ let param = name_cases "param" cases in
+ let body =
+ Tfunction_cases
+ { cases; partial; param; loc; exp_extra; attributes }
+ in
+ exp_type, body
+ in
+ (* [No_gadt] is fine because this return value is only meant to indicate
+ whether [params] (here, the empty list) contains any GADT, not whether
+ the body is a [Tfunction_cases] whose patterns include a GADT.
+ *)
+ exp_type, [], body, [], No_gadt
+
+
+and type_label_access env srecord usage lid =
+ let record =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> type_exp ~recarg:Allowed env srecord)
+ in
+ let ty_exp = record.exp_type in
+ let expected_type =
+ match extract_concrete_record env ty_exp with
+ | Record_type(p0, p, _) ->
+ Some(p0, p, is_principal ty_exp)
+ | Maybe_a_record_type -> None
+ | Not_a_record_type ->
+ let error = Expr_not_a_record_type ty_exp in
+ raise (Error (record.exp_loc, env, error))
+ in
+ let labels = Env.lookup_all_labels ~loc:lid.loc usage lid.txt env in
+ let label =
+ wrap_disambiguate "This expression has" (mk_expected ty_exp)
+ (Label.disambiguate usage lid env expected_type) labels in
+ (record, label, expected_type)
+
+(* Typing format strings for printing or reading.
+ These formats are used by functions in modules Printf, Format, and Scanf.
+ (Handling of * modifiers contributed by Thorsten Ohl.) *)
+
+and type_format loc str env =
+ let loc = {loc with Location.loc_ghost = true} in
+ try
+ CamlinternalFormatBasics.(CamlinternalFormat.(
+ let mk_exp_loc pexp_desc = {
+ pexp_desc = pexp_desc;
+ pexp_loc = loc;
+ pexp_loc_stack = [];
+ pexp_attributes = [];
+ } and mk_lid_loc lid = {
+ txt = lid;
+ loc = loc;
+ } in
+ let mk_constr name args =
+ let lid = Longident.(Ldot(Lident "CamlinternalFormatBasics", name)) in
+ let arg = match args with
+ | [] -> None
+ | [ e ] -> Some e
+ | _ :: _ :: _ -> Some (mk_exp_loc (Pexp_tuple args)) in
+ mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg)) in
+ let mk_cst cst =
+ mk_exp_loc (Pexp_constant {pconst_desc = cst; pconst_loc = loc})
+ in
+ let mk_int n = mk_cst (Pconst_integer (Int.to_string n, None))
+ and mk_string str = mk_cst (Pconst_string (str, loc, None))
+ and mk_char chr = mk_cst (Pconst_char chr) in
+ let rec mk_formatting_lit fmting = match fmting with
+ | Close_box ->
+ mk_constr "Close_box" []
+ | Close_tag ->
+ mk_constr "Close_tag" []
+ | Break (org, ns, ni) ->
+ mk_constr "Break" [ mk_string org; mk_int ns; mk_int ni ]
+ | FFlush ->
+ mk_constr "FFlush" []
+ | Force_newline ->
+ mk_constr "Force_newline" []
+ | Flush_newline ->
+ mk_constr "Flush_newline" []
+ | Magic_size (org, sz) ->
+ mk_constr "Magic_size" [ mk_string org; mk_int sz ]
+ | Escaped_at ->
+ mk_constr "Escaped_at" []
+ | Escaped_percent ->
+ mk_constr "Escaped_percent" []
+ | Scan_indic c ->
+ mk_constr "Scan_indic" [ mk_char c ]
+ and mk_formatting_gen : type a b c d e f .
+ (a, b, c, d, e, f) formatting_gen -> Parsetree.expression =
+ fun fmting -> match fmting with
+ | Open_tag (Format (fmt', str')) ->
+ mk_constr "Open_tag" [ mk_format fmt' str' ]
+ | Open_box (Format (fmt', str')) ->
+ mk_constr "Open_box" [ mk_format fmt' str' ]
+ and mk_format : type a b c d e f .
+ (a, b, c, d, e, f) CamlinternalFormatBasics.fmt -> string ->
+ Parsetree.expression = fun fmt str ->
+ mk_constr "Format" [ mk_fmt fmt; mk_string str ]
+ and mk_side side = match side with
+ | Left -> mk_constr "Left" []
+ | Right -> mk_constr "Right" []
+ | Zeros -> mk_constr "Zeros" []
+ and mk_iconv iconv = match iconv with
+ | Int_d -> mk_constr "Int_d" [] | Int_pd -> mk_constr "Int_pd" []
+ | Int_sd -> mk_constr "Int_sd" [] | Int_i -> mk_constr "Int_i" []
+ | Int_pi -> mk_constr "Int_pi" [] | Int_si -> mk_constr "Int_si" []
+ | Int_x -> mk_constr "Int_x" [] | Int_Cx -> mk_constr "Int_Cx" []
+ | Int_X -> mk_constr "Int_X" [] | Int_CX -> mk_constr "Int_CX" []
+ | Int_o -> mk_constr "Int_o" [] | Int_Co -> mk_constr "Int_Co" []
+ | Int_u -> mk_constr "Int_u" [] | Int_Cd -> mk_constr "Int_Cd" []
+ | Int_Ci -> mk_constr "Int_Ci" [] | Int_Cu -> mk_constr "Int_Cu" []
+ and mk_fconv fconv =
+ let flag = match fst fconv with
+ | Float_flag_ -> mk_constr "Float_flag_" []
+ | Float_flag_p -> mk_constr "Float_flag_p" []
+ | Float_flag_s -> mk_constr "Float_flag_s" [] in
+ let kind = match snd fconv with
+ | Float_f -> mk_constr "Float_f" []
+ | Float_e -> mk_constr "Float_e" []
+ | Float_E -> mk_constr "Float_E" []
+ | Float_g -> mk_constr "Float_g" []
+ | Float_G -> mk_constr "Float_G" []
+ | Float_h -> mk_constr "Float_h" []
+ | Float_H -> mk_constr "Float_H" []
+ | Float_F -> mk_constr "Float_F" []
+ | Float_CF -> mk_constr "Float_CF" [] in
+ mk_exp_loc (Pexp_tuple [flag; kind])
+ and mk_counter cnt = match cnt with
+ | Line_counter -> mk_constr "Line_counter" []
+ | Char_counter -> mk_constr "Char_counter" []
+ | Token_counter -> mk_constr "Token_counter" []
+ and mk_int_opt n_opt = match n_opt with
+ | None ->
+ let lid_loc = mk_lid_loc (Longident.Lident "None") in
+ mk_exp_loc (Pexp_construct (lid_loc, None))
+ | Some n ->
+ let lid_loc = mk_lid_loc (Longident.Lident "Some") in
+ mk_exp_loc (Pexp_construct (lid_loc, Some (mk_int n)))
+ and mk_fmtty : type a b c d e f g h i j k l .
+ (a, b, c, d, e, f, g, h, i, j, k, l) fmtty_rel -> Parsetree.expression
+ =
+ fun fmtty -> match fmtty with
+ | Char_ty rest -> mk_constr "Char_ty" [ mk_fmtty rest ]
+ | String_ty rest -> mk_constr "String_ty" [ mk_fmtty rest ]
+ | Int_ty rest -> mk_constr "Int_ty" [ mk_fmtty rest ]
+ | Int32_ty rest -> mk_constr "Int32_ty" [ mk_fmtty rest ]
+ | Nativeint_ty rest -> mk_constr "Nativeint_ty" [ mk_fmtty rest ]
+ | Int64_ty rest -> mk_constr "Int64_ty" [ mk_fmtty rest ]
+ | Float_ty rest -> mk_constr "Float_ty" [ mk_fmtty rest ]
+ | Bool_ty rest -> mk_constr "Bool_ty" [ mk_fmtty rest ]
+ | Alpha_ty rest -> mk_constr "Alpha_ty" [ mk_fmtty rest ]
+ | Theta_ty rest -> mk_constr "Theta_ty" [ mk_fmtty rest ]
+ | Any_ty rest -> mk_constr "Any_ty" [ mk_fmtty rest ]
+ | Reader_ty rest -> mk_constr "Reader_ty" [ mk_fmtty rest ]
+ | Ignored_reader_ty rest ->
+ mk_constr "Ignored_reader_ty" [ mk_fmtty rest ]
+ | Format_arg_ty (sub_fmtty, rest) ->
+ mk_constr "Format_arg_ty" [ mk_fmtty sub_fmtty; mk_fmtty rest ]
+ | Format_subst_ty (sub_fmtty1, sub_fmtty2, rest) ->
+ mk_constr "Format_subst_ty"
+ [ mk_fmtty sub_fmtty1; mk_fmtty sub_fmtty2; mk_fmtty rest ]
+ | End_of_fmtty -> mk_constr "End_of_fmtty" []
+ and mk_ignored : type a b c d e f .
+ (a, b, c, d, e, f) ignored -> Parsetree.expression =
+ fun ign -> match ign with
+ | Ignored_char ->
+ mk_constr "Ignored_char" []
+ | Ignored_caml_char ->
+ mk_constr "Ignored_caml_char" []
+ | Ignored_string pad_opt ->
+ mk_constr "Ignored_string" [ mk_int_opt pad_opt ]
+ | Ignored_caml_string pad_opt ->
+ mk_constr "Ignored_caml_string" [ mk_int_opt pad_opt ]
+ | Ignored_int (iconv, pad_opt) ->
+ mk_constr "Ignored_int" [ mk_iconv iconv; mk_int_opt pad_opt ]
+ | Ignored_int32 (iconv, pad_opt) ->
+ mk_constr "Ignored_int32" [ mk_iconv iconv; mk_int_opt pad_opt ]
+ | Ignored_nativeint (iconv, pad_opt) ->
+ mk_constr "Ignored_nativeint" [ mk_iconv iconv; mk_int_opt pad_opt ]
+ | Ignored_int64 (iconv, pad_opt) ->
+ mk_constr "Ignored_int64" [ mk_iconv iconv; mk_int_opt pad_opt ]
+ | Ignored_float (pad_opt, prec_opt) ->
+ mk_constr "Ignored_float" [ mk_int_opt pad_opt; mk_int_opt prec_opt ]
+ | Ignored_bool pad_opt ->
+ mk_constr "Ignored_bool" [ mk_int_opt pad_opt ]
+ | Ignored_format_arg (pad_opt, fmtty) ->
+ mk_constr "Ignored_format_arg" [ mk_int_opt pad_opt; mk_fmtty fmtty ]
+ | Ignored_format_subst (pad_opt, fmtty) ->
+ mk_constr "Ignored_format_subst" [
+ mk_int_opt pad_opt; mk_fmtty fmtty ]
+ | Ignored_reader ->
+ mk_constr "Ignored_reader" []
+ | Ignored_scan_char_set (width_opt, char_set) ->
+ mk_constr "Ignored_scan_char_set" [
+ mk_int_opt width_opt; mk_string char_set ]
+ | Ignored_scan_get_counter counter ->
+ mk_constr "Ignored_scan_get_counter" [
+ mk_counter counter
+ ]
+ | Ignored_scan_next_char ->
+ mk_constr "Ignored_scan_next_char" []
+ and mk_padding : type x y . (x, y) padding -> Parsetree.expression =
+ fun pad -> match pad with
+ | No_padding -> mk_constr "No_padding" []
+ | Lit_padding (s, w) -> mk_constr "Lit_padding" [ mk_side s; mk_int w ]
+ | Arg_padding s -> mk_constr "Arg_padding" [ mk_side s ]
+ and mk_precision : type x y . (x, y) precision -> Parsetree.expression =
+ fun prec -> match prec with
+ | No_precision -> mk_constr "No_precision" []
+ | Lit_precision w -> mk_constr "Lit_precision" [ mk_int w ]
+ | Arg_precision -> mk_constr "Arg_precision" []
+ and mk_fmt : type a b c d e f .
+ (a, b, c, d, e, f) fmt -> Parsetree.expression =
+ fun fmt -> match fmt with
+ | Char rest ->
+ mk_constr "Char" [ mk_fmt rest ]
+ | Caml_char rest ->
+ mk_constr "Caml_char" [ mk_fmt rest ]
+ | String (pad, rest) ->
+ mk_constr "String" [ mk_padding pad; mk_fmt rest ]
+ | Caml_string (pad, rest) ->
+ mk_constr "Caml_string" [ mk_padding pad; mk_fmt rest ]
+ | Int (iconv, pad, prec, rest) ->
+ mk_constr "Int" [
+ mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+ | Int32 (iconv, pad, prec, rest) ->
+ mk_constr "Int32" [
+ mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+ | Nativeint (iconv, pad, prec, rest) ->
+ mk_constr "Nativeint" [
+ mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+ | Int64 (iconv, pad, prec, rest) ->
+ mk_constr "Int64" [
+ mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+ | Float (fconv, pad, prec, rest) ->
+ mk_constr "Float" [
+ mk_fconv fconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+ | Bool (pad, rest) ->
+ mk_constr "Bool" [ mk_padding pad; mk_fmt rest ]
+ | Flush rest ->
+ mk_constr "Flush" [ mk_fmt rest ]
+ | String_literal (s, rest) ->
+ mk_constr "String_literal" [ mk_string s; mk_fmt rest ]
+ | Char_literal (c, rest) ->
+ mk_constr "Char_literal" [ mk_char c; mk_fmt rest ]
+ | Format_arg (pad_opt, fmtty, rest) ->
+ mk_constr "Format_arg" [
+ mk_int_opt pad_opt; mk_fmtty fmtty; mk_fmt rest ]
+ | Format_subst (pad_opt, fmtty, rest) ->
+ mk_constr "Format_subst" [
+ mk_int_opt pad_opt; mk_fmtty fmtty; mk_fmt rest ]
+ | Alpha rest ->
+ mk_constr "Alpha" [ mk_fmt rest ]
+ | Theta rest ->
+ mk_constr "Theta" [ mk_fmt rest ]
+ | Formatting_lit (fmting, rest) ->
+ mk_constr "Formatting_lit" [ mk_formatting_lit fmting; mk_fmt rest ]
+ | Formatting_gen (fmting, rest) ->
+ mk_constr "Formatting_gen" [ mk_formatting_gen fmting; mk_fmt rest ]
+ | Reader rest ->
+ mk_constr "Reader" [ mk_fmt rest ]
+ | Scan_char_set (width_opt, char_set, rest) ->
+ mk_constr "Scan_char_set" [
+ mk_int_opt width_opt; mk_string char_set; mk_fmt rest ]
+ | Scan_get_counter (cnt, rest) ->
+ mk_constr "Scan_get_counter" [ mk_counter cnt; mk_fmt rest ]
+ | Scan_next_char rest ->
+ mk_constr "Scan_next_char" [ mk_fmt rest ]
+ | Ignored_param (ign, rest) ->
+ mk_constr "Ignored_param" [ mk_ignored ign; mk_fmt rest ]
+ | End_of_format ->
+ mk_constr "End_of_format" []
+ | Custom _ ->
+ (* Custom formatters have no syntax so they will never appear
+ in formats parsed from strings. *)
+ assert false
+ in
+ let legacy_behavior = not !Clflags.strict_formats in
+ let Fmt_EBB fmt = fmt_ebb_of_string ~legacy_behavior str in
+ mk_constr "Format" [ mk_fmt fmt; mk_string str ]
+ ))
+ with Failure msg ->
+ raise (Error (loc, env, Invalid_format msg))
+
+and type_label_exp create env loc ty_expected
+ (lid, label, sarg) =
+ (* Here also ty_expected may be at generic_level *)
+ let separate = !Clflags.principal || Env.has_local_constraints env in
+ let is_poly = label_is_poly label in
+ let (vars, arg) =
+ (* raise level to check univars *)
+ with_local_level_generalize_if is_poly begin fun () ->
+ let (vars, ty_arg) =
+ with_local_level_generalize_structure_if separate begin fun () ->
+ let (vars, ty_arg, ty_res) =
+ with_local_level_generalize_structure_if separate
+ (fun () -> instance_label ~fixed:true label)
+ in
+ begin try
+ unify env (instance ty_res) (instance ty_expected)
+ with Unify err ->
+ raise (Error(lid.loc, env, Label_mismatch(lid.txt, err)))
+ end;
+ (* Instantiate so that we can generalize internal nodes *)
+ let ty_arg = instance ty_arg in
+ (vars, ty_arg)
+ end
+ in
+
+ if label.lbl_private = Private then
+ if create then
+ raise (Error(loc, env, Private_type ty_expected))
+ else
+ raise (Error(lid.loc, env, Private_label(lid.txt, ty_expected)));
+ (vars, type_argument env sarg ty_arg (instance ty_arg))
+ end
+ ~before_generalize:(fun (_,arg) -> may_lower_contravariant env arg)
+ in
+ if is_poly then check_univars env "field value" arg label.lbl_arg vars;
+ (lid, label, {arg with exp_type = instance arg.exp_type})
+
+and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
+ (* ty_expected' may be generic *)
+ let no_labels ty =
+ let ls, tvar = list_labels env ty in
+ not tvar && List.for_all ((=) Nolabel) ls
+ in
+ let may_coerce =
+ if not (is_inferred sarg) then None else
+ let work () =
+ let te = expand_head env ty_expected' in
+ match get_desc te with
+ Tarrow(Nolabel,_,ty_res0,_) ->
+ Some (no_labels ty_res0, get_level te)
+ | _ -> None
+ in
+ (* Need to be careful not to expand local constraints here *)
+ if Env.has_local_constraints env then
+ let snap = Btype.snapshot () in
+ try_finally ~always:(fun () -> Btype.backtrack snap) work
+ else work ()
+ in
+ match may_coerce with
+ Some (safe_expect, lv) ->
+ (* apply optional arguments when expected type is "" *)
+ (* we must be very careful about not breaking the semantics *)
+ let texp =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> type_exp env sarg)
+ in
+ let rec make_args args ty_fun =
+ match get_desc (expand_head env ty_fun) with
+ | Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
+ let ty = option_none env (instance ty_arg) sarg.pexp_loc in
+ make_args ((l, Some ty) :: args) ty_fun
+ | Tarrow (l,_,ty_res',_) when l = Nolabel || !Clflags.classic ->
+ List.rev args, ty_fun, no_labels ty_res'
+ | Tvar _ -> List.rev args, ty_fun, false
+ | _ -> [], texp.exp_type, false
+ in
+ let args, ty_fun', simple_res = make_args [] texp.exp_type
+ and texp = {texp with exp_type = instance texp.exp_type} in
+ if not (simple_res || safe_expect) then begin
+ unify_exp ~sexp:sarg env texp ty_expected;
+ texp
+ end else begin
+ let warn = !Clflags.principal &&
+ (lv <> generic_level || get_level ty_fun' <> generic_level)
+ and ty_fun = instance ty_fun' in
+ let ty_arg, ty_res =
+ match get_desc (expand_head env ty_expected) with
+ Tarrow(Nolabel,ty_arg,ty_res,_) -> ty_arg, ty_res
+ | _ -> assert false
+ in
+ unify_exp ~sexp:sarg env {texp with exp_type = ty_fun} ty_expected;
+ if args = [] then texp else
+ (* eta-expand to avoid side effects *)
+ let var_pair name ty =
+ let id = Ident.create_local name in
+ let desc =
+ { val_type = ty; val_kind = Val_reg;
+ val_attributes = [];
+ val_loc = Location.none;
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ let exp_env = Env.add_value id desc env in
+ {pat_desc =
+ Tpat_var (id, mknoloc name, desc.val_uid);
+ pat_type = ty;
+ pat_extra=[];
+ pat_attributes = [];
+ pat_loc = Location.none; pat_env = env},
+ {exp_type = ty; exp_loc = Location.none; exp_env = exp_env;
+ exp_extra = []; exp_attributes = [];
+ exp_desc =
+ Texp_ident(Path.Pident id, mknoloc (Longident.Lident name), desc)}
+ in
+ let eta_pat, eta_var = var_pair "eta" ty_arg in
+ let func texp =
+ let e =
+ {texp with exp_type = ty_res; exp_desc =
+ Texp_apply
+ (texp,
+ args @ [Nolabel, Some eta_var])}
+ in
+ let cases = [ case eta_pat e ] in
+ let cases_loc = { texp.exp_loc with loc_ghost = true } in
+ let param = name_cases "param" cases in
+ { texp with exp_type = ty_fun; exp_desc =
+ Texp_function ([],
+ Tfunction_cases
+ { cases; partial = Total; param; loc = cases_loc;
+ exp_extra = None; attributes = [];
+ })
+ }
+ in
+ Location.prerr_warning texp.exp_loc
+ (Warnings.Eliminated_optional_arguments
+ (List.map (fun (l, _) -> Asttypes.string_of_label l) args));
+ if warn then Location.prerr_warning texp.exp_loc
+ (Warnings.Non_principal_labels "eliminated optional argument");
+ (* let-expand to have side effects *)
+ let let_pat, let_var = var_pair "arg" texp.exp_type in
+ re { texp with exp_type = ty_fun; exp_desc =
+ Texp_let (Nonrecursive,
+ [{vb_pat=let_pat; vb_expr=texp; vb_attributes=[];
+ vb_loc=Location.none; vb_rec_kind = Dynamic;
+ }],
+ func let_var) }
+ end
+ | None ->
+ let texp = type_expect ?recarg env sarg
+ (mk_expected ?explanation ty_expected') in
+ unify_exp ~sexp:sarg env texp ty_expected;
+ texp
+
+and type_application env funct sargs =
+ (* funct.exp_type may be generic *)
+ let result_type omitted ty_fun =
+ List.fold_left
+ (fun ty_fun (l,ty,lv) -> newty2 ~level:lv (Tarrow(l,ty,ty_fun,commu_ok)))
+ ty_fun omitted
+ in
+ let has_label l ty_fun =
+ let ls, tvar = list_labels env ty_fun in
+ tvar || List.mem l ls
+ in
+ let eliminated_optional_arguments = ref [] in
+ let omitted_parameters = ref [] in
+ let type_unknown_arg (ty_fun, typed_args) (lbl, sarg) =
+ let (ty_arg, ty_res) =
+ let ty_fun = expand_head env ty_fun in
+ match get_desc ty_fun with
+ | Tvar _ ->
+ let t1 = newvar () and t2 = newvar () in
+ if get_level ty_fun >= get_level t1 &&
+ not (is_prim ~name:"%identity" funct)
+ then
+ Location.prerr_warning sarg.pexp_loc
+ Warnings.Ignored_extra_argument;
+ unify env ty_fun (newty (Tarrow(lbl,t1,t2,commu_var ())));
+ (t1, t2)
+ | Tarrow (l,t1,t2,_) when l = lbl
+ || !Clflags.classic && lbl = Nolabel && not (is_optional l) ->
+ (t1, t2)
+ | td ->
+ let ty_fun = match td with Tarrow _ -> newty td | _ -> ty_fun in
+ let ty_res =
+ result_type (!omitted_parameters @ !eliminated_optional_arguments)
+ ty_fun
+ in
+ match get_desc ty_res with
+ | Tarrow _ ->
+ if !Clflags.classic || not (has_label lbl ty_fun) then
+ raise (Error(sarg.pexp_loc, env,
+ Apply_wrong_label(lbl, ty_res, false)))
+ else
+ raise (Error(funct.exp_loc, env, Incoherent_label_order))
+ | _ ->
+ let previous_arg_loc =
+ (* [typed_args] is the arguments typed until now, in reverse
+ order of appearance. Not all arguments have a location
+ attached (eg. an optional argument that is not passed). *)
+ typed_args
+ |> List.find_map
+ (function (_, Some (_, loc)) -> loc | _ -> None)
+ |> Option.value ~default:funct.exp_loc
+ in
+ raise(Error(funct.exp_loc, env, Apply_non_function {
+ funct;
+ func_ty = expand_head env funct.exp_type;
+ res_ty = expand_head env ty_res;
+ previous_arg_loc;
+ extra_arg_loc = sarg.pexp_loc; }))
+ in
+ let arg () =
+ let arg = type_expect env sarg (mk_expected ty_arg) in
+ if is_optional lbl then
+ unify_exp ~sexp:sarg env arg (type_option(newvar()));
+ arg
+ in
+ (ty_res, (lbl, Some (arg, Some sarg.pexp_loc)) :: typed_args)
+ in
+ let ignore_labels =
+ !Clflags.classic ||
+ begin
+ let ls, tvar = list_labels env funct.exp_type in
+ not tvar &&
+ let labels = List.filter (fun l -> not (is_optional l)) ls in
+ List.length labels = List.length sargs &&
+ List.for_all (fun (l,_) -> l = Nolabel) sargs &&
+ List.exists (fun l -> l <> Nolabel) labels &&
+ (Location.prerr_warning
+ funct.exp_loc
+ (Warnings.Labels_omitted
+ (List.map Asttypes.string_of_label
+ (List.filter ((<>) Nolabel) labels)));
+ true)
+ end
+ in
+ let warned = ref false in
+ (* [args] remember the location of each argument in sources. *)
+ let rec type_args args ty_fun ty_fun0 sargs =
+ let type_unknown_args () =
+ (* We're not looking at a *known* function type anymore, or there are no
+ arguments left. *)
+ let ty_fun, typed_args =
+ List.fold_left type_unknown_arg (ty_fun0, args) sargs
+ in
+ let args =
+ (* Force typing of arguments.
+ Careful: the order matters here. Using [List.rev_map] would be
+ incorrect. *)
+ List.map
+ (function
+ | l, None -> l, None
+ | l, Some (f, _loc) -> l, Some (f ()))
+ (List.rev typed_args)
+ in
+ let result_ty = instance (result_type !omitted_parameters ty_fun) in
+ args, result_ty
+ in
+ if sargs = [] then type_unknown_args () else
+ let ty_fun' = expand_head env ty_fun in
+ match get_desc ty_fun', get_desc (expand_head env ty_fun0) with
+ | Tarrow (l, ty, ty_fun, com), Tarrow (_, ty0, ty_fun0, _)
+ when is_commu_ok com ->
+ let lv = get_level ty_fun' in
+ let may_warn loc w =
+ if not !warned && !Clflags.principal && lv <> generic_level
+ then begin
+ warned := true;
+ Location.prerr_warning loc w
+ end
+ in
+ let name = label_name l
+ and optional = is_optional l in
+ let use_arg sarg l' =
+ if not optional || is_optional l' then
+ (fun () -> type_argument env sarg ty ty0)
+ else begin
+ may_warn sarg.pexp_loc
+ (not_principal "using an optional argument here");
+ (fun () -> option_some env (type_argument env sarg
+ (extract_option_type env ty)
+ (extract_option_type env ty0)))
+ end
+ in
+ let eliminate_optional_arg () =
+ may_warn funct.exp_loc
+ (Warnings.Non_principal_labels "eliminated optional argument");
+ eliminated_optional_arguments :=
+ (l,ty,lv) :: !eliminated_optional_arguments;
+ (fun () -> option_none env (instance ty) Location.none)
+ in
+ let remaining_sargs, arg =
+ if ignore_labels then begin
+ (* No reordering is allowed, process arguments in order *)
+ match sargs with
+ | [] -> assert false
+ | (l', sarg) :: remaining_sargs ->
+ if name = label_name l' || (not optional && l' = Nolabel) then
+ (remaining_sargs, Some (use_arg sarg l', Some sarg.pexp_loc))
+ else if
+ optional &&
+ not (List.exists (fun (l, _) -> name = label_name l)
+ remaining_sargs) &&
+ List.exists (function (Nolabel, _) -> true | _ -> false)
+ sargs
+ then
+ (sargs, Some (eliminate_optional_arg (), Some sarg.pexp_loc))
+ else
+ raise(Error(sarg.pexp_loc, env,
+ Apply_wrong_label(l', ty_fun', optional)))
+ end else
+ (* Arguments can be commuted, try to fetch the argument
+ corresponding to the first parameter. *)
+ match extract_label name sargs with
+ | Some (l', sarg, commuted, remaining_sargs) ->
+ if commuted then begin
+ may_warn sarg.pexp_loc
+ (not_principal "commuting this argument")
+ end;
+ if not optional && is_optional l' then
+ Location.prerr_warning sarg.pexp_loc
+ (Warnings.Nonoptional_label (Asttypes.string_of_label l));
+ remaining_sargs, Some (use_arg sarg l', Some sarg.pexp_loc)
+ | None ->
+ sargs,
+ if optional && List.mem_assoc Nolabel sargs then
+ Some (eliminate_optional_arg (), None)
+ else begin
+ (* No argument was given for this parameter, we abstract over
+ it. *)
+ may_warn funct.exp_loc
+ (Warnings.Non_principal_labels "commuted an argument");
+ omitted_parameters := (l,ty,lv) :: !omitted_parameters;
+ None
+ end
+ in
+ type_args ((l,arg)::args) ty_fun ty_fun0 remaining_sargs
+ | _ ->
+ type_unknown_args ()
+ in
+ let is_ignore funct =
+ is_prim ~name:"%ignore" funct &&
+ (try ignore (filter_arrow env (instance funct.exp_type) Nolabel); true
+ with Filter_arrow_failed _ -> false)
+ in
+ match sargs with
+ | (* Special case for ignore: avoid discarding warning *)
+ [Nolabel, sarg] when is_ignore funct ->
+ let ty_arg, ty_res =
+ filter_arrow env (instance funct.exp_type) Nolabel in
+ let exp = type_expect env sarg (mk_expected ty_arg) in
+ check_partial_application ~statement:false exp;
+ ([Nolabel, Some exp], ty_res)
+ | _ ->
+ let ty = funct.exp_type in
+ type_args [] ty (instance ty) sargs
+
+and type_construct env ~sexp lid sarg ty_expected_explained =
+ let { ty = ty_expected; explanation } = ty_expected_explained in
+ let expected_type =
+ match extract_concrete_variant env ty_expected with
+ | Variant_type(p0, p,_) ->
+ Some(p0, p, is_principal ty_expected)
+ | Maybe_a_variant_type -> None
+ | Not_a_variant_type ->
+ let srt = wrong_kind_sort_of_constructor lid.txt in
+ let ctx = Expression explanation in
+ let error = Wrong_expected_kind(srt, ctx, ty_expected) in
+ raise (Error (sexp.pexp_loc, env, error))
+ in
+ let constrs =
+ Env.lookup_all_constructors ~loc:lid.loc Env.Positive lid.txt env
+ in
+ let constr =
+ wrap_disambiguate "This variant expression is expected to have"
+ ty_expected_explained
+ (Constructor.disambiguate Env.Positive lid env expected_type) constrs
+ in
+ let sargs =
+ match sarg with
+ None -> []
+ | Some {pexp_desc = Pexp_tuple sel} when
+ constr.cstr_arity > 1
+ || Builtin_attributes.explicit_arity sexp.pexp_attributes
+ -> sel
+ | Some se -> [se] in
+ if List.length sargs <> constr.cstr_arity then
+ raise(Error(sexp.pexp_loc, env,
+ Constructor_arity_mismatch
+ (lid.txt, constr.cstr_arity, List.length sargs)));
+ let separate = !Clflags.principal || Env.has_local_constraints env in
+ let ty_args, ty_res, texp =
+ with_local_level_generalize_structure_if separate begin fun () ->
+ let ty_args, ty_res, texp =
+ with_local_level_generalize_structure_if separate begin fun () ->
+ let (ty_args, ty_res, _) =
+ instance_constructor Keep_existentials_flexible constr
+ in
+ let texp =
+ re {
+ exp_desc = Texp_construct(lid, constr, []);
+ exp_loc = sexp.pexp_loc; exp_extra = [];
+ exp_type = ty_res;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env } in
+ (ty_args, ty_res, texp)
+ end
+ in
+ with_explanation explanation (fun () ->
+ unify_exp ~sexp env {texp with exp_type = instance ty_res}
+ (instance ty_expected));
+ (ty_args, ty_res, texp)
+ end
+ in
+ let ty_args0, ty_res =
+ match instance_list (ty_res :: ty_args) with
+ t :: tl -> tl, t
+ | _ -> assert false
+ in
+ let texp = {texp with exp_type = ty_res} in
+ if not separate then unify_exp ~sexp env texp (instance ty_expected);
+ let recarg =
+ match constr.cstr_inlined with
+ | None -> Rejected
+ | Some _ ->
+ begin match sargs with
+ | [{pexp_desc =
+ Pexp_ident _ |
+ Pexp_record (_, (Some {pexp_desc = Pexp_ident _}| None))}] ->
+ Required
+ | _ ->
+ raise (Error(sexp.pexp_loc, env, Inlined_record_expected))
+ end
+ in
+ let args =
+ List.map2 (fun e (t,t0) -> type_argument ~recarg env e t t0) sargs
+ (List.combine ty_args ty_args0) in
+ if constr.cstr_private = Private then
+ begin match constr.cstr_tag with
+ | Cstr_extension _ ->
+ raise(Error(sexp.pexp_loc, env, Private_constructor (constr, ty_res)))
+ | Cstr_constant _ | Cstr_block _ | Cstr_unboxed ->
+ raise (Error(sexp.pexp_loc, env, Private_type ty_res));
+ end;
+ (* NOTE: shouldn't we call "re" on this final expression? -- AF *)
+ { texp with
+ exp_desc = Texp_construct(lid, constr, args) }
+
+(* Typing of statements (expressions whose values are discarded) *)
+
+and type_statement ?explanation env sexp =
+ (* OCaml 5.2.0 changed the type of 'while' to give 'while true do e done'
+ a polymorphic type. The change has the potential to trigger a
+ nonreturning-statement warning in existing code that follows
+ 'while true' with some other statement, e.g.
+
+ while true do e done; assert false
+
+ To avoid this issue, we disable the warning in this particular case.
+ We might consider re-enabling it at a point when most users have
+ migrated to OCaml 5.2.0 or later. *)
+ let allow_polymorphic e = match e.exp_desc with
+ | Texp_while _ -> true
+ | _ -> false
+ in
+ (* Raise the current level to detect non-returning functions *)
+ with_local_level_generalize (fun () -> type_exp env sexp)
+ ~before_generalize: begin fun exp ->
+ let subexp = final_subexpression exp in
+ let ty = expand_head env exp.exp_type in
+ if is_Tvar ty
+ && get_level ty > get_current_level ()
+ && not (allow_polymorphic subexp) then
+ Location.prerr_warning
+ subexp.exp_loc
+ Warnings.Nonreturning_statement;
+ if !Clflags.strict_sequence then
+ let expected_ty = instance Predef.type_unit in
+ with_explanation explanation (fun () ->
+ unify_exp ~sexp env exp expected_ty)
+ else begin
+ check_partial_application ~statement:true exp;
+ enforce_current_level env ty
+ end
+ end
+
+(* Most of the arguments are the same as [type_cases].
+
+ Takes a callback which is responsible for typing the body of the case.
+ The arguments are documented inline in the type signature.
+
+ It takes a callback rather than returning the half-typed cases directly
+ because the typing of the body must take place at an increased level.
+
+ The overall function returns:
+ - The data returned by the callback
+ - Whether the cases' patterns are partial or total
+*)
+and map_half_typed_cases
+ : type k ret case_data.
+ ?additional_checks_for_split_cases:((_ * ret) list -> unit) -> ?conts:_
+ -> k pattern_category -> _ -> _ -> _ -> _
+ -> (untyped_case * case_data) list
+ -> type_body:(
+ case_data
+ -> k general_pattern (* the typed pattern *)
+ -> when_env:_ (* environment with module/pattern variables *)
+ -> ext_env:_ (* when_env + continuation var*)
+ -> cont:_
+ -> ty_expected:_ (* type to check body in scope of *)
+ -> ty_infer:_ (* type to infer for body *)
+ -> contains_gadt:_ (* whether the pattern contains a GADT *)
+ -> ret)
+ -> check_if_total:bool (* if false, assume Partial right away *)
+ -> ret list * partial
+ = fun ?additional_checks_for_split_cases ?conts
+ category env ty_arg ty_res loc caselist ~type_body ~check_if_total ->
+ (* ty_arg is _fully_ generalized *)
+ let patterns = List.map (fun ((x : untyped_case), _) -> x.pattern) caselist in
+ let contains_polyvars = List.exists contains_polymorphic_variant patterns in
+ let erase_either = contains_polyvars && contains_variant_either ty_arg in
+ let may_contain_gadts = List.exists may_contain_gadts patterns in
+ let may_contain_modules = List.exists may_contain_modules patterns in
+ let create_inner_level = may_contain_gadts || may_contain_modules in
+ let ty_arg =
+ if (may_contain_gadts || erase_either) && not !Clflags.principal
+ then duplicate_type ty_arg else ty_arg
+ in
+ let rec is_var spat =
+ match spat.ppat_desc with
+ Ppat_any | Ppat_var _ -> true
+ | Ppat_alias (spat, _) -> is_var spat
+ | _ -> false in
+ let needs_exhaust_check =
+ match caselist with
+ [ ({ needs_refute = true }, _) ] -> true
+ | [ ({ pattern }, _) ] when is_var pattern -> false
+ | _ -> true
+ in
+ let outer_level = get_current_level () in
+ with_local_level_iter_if create_inner_level begin fun () ->
+ let lev = get_current_level () in
+ let allow_modules =
+ if may_contain_modules
+ then
+ (* The corresponding check for scope escape is done together with
+ the check for GADT-induced existentials by
+ [with_local_level_iter_if create_inner_level].
+ *)
+ Modules_allowed { scope = lev }
+ else Modules_rejected
+ in
+ let take_partial_instance =
+ if erase_either
+ then Some false else None
+ in
+ let map_conts f conts caselist = match conts with
+ | None -> List.map (fun c -> f c None) caselist
+ | Some conts -> List.map2 f caselist conts
+ in
+ let half_typed_cases, ty_res, do_copy_types, ty_arg' =
+ (* propagation of the argument *)
+ with_local_level_generalize begin fun () ->
+ let pattern_force = ref [] in
+ (* Format.printf "@[%i %i@ %a@]@." lev (get_current_level())
+ Printtyp.raw_type_expr ty_arg; *)
+ let half_typed_cases =
+ map_conts
+ (fun ({ Parmatch.pattern; _ } as untyped_case, case_data) cont ->
+ let htc =
+ with_local_level_generalize_structure_if_principal begin fun () ->
+ let ty_arg =
+ (* propagation of pattern *)
+ with_local_level_generalize_structure
+ (fun () -> instance ?partial:take_partial_instance ty_arg)
+ in
+ let (pat, ext_env, force, pvs, mvs) =
+ type_pattern ?cont category ~lev env pattern ty_arg
+ allow_modules
+ in
+ pattern_force := force @ !pattern_force;
+ { typed_pat = pat;
+ pat_type_for_unif = ty_arg;
+ untyped_case;
+ case_data;
+ branch_env = ext_env;
+ pat_vars = pvs;
+ module_vars = mvs;
+ contains_gadt = contains_gadt (as_comp_pattern category pat);
+ }
+ end
+ in
+ (* Ensure that no ambivalent pattern type escapes its branch *)
+ check_scope_escape htc.typed_pat.pat_loc env outer_level
+ htc.pat_type_for_unif;
+ let pat = htc.typed_pat in
+ {htc with typed_pat = { pat with pat_type = instance pat.pat_type }}
+ )
+ conts caselist in
+ let patl =
+ List.map (fun { typed_pat; _ } -> typed_pat) half_typed_cases in
+ let does_contain_gadt =
+ List.exists (fun { contains_gadt; _ } -> contains_gadt) half_typed_cases
+ in
+ let ty_res, do_copy_types =
+ if does_contain_gadt && not !Clflags.principal then
+ duplicate_type ty_res, Env.make_copy_of_types env
+ else ty_res, (fun env -> env)
+ in
+ (* Unify all cases (delayed to keep it order-free) *)
+ let ty_arg' = newvar () in
+ let unify_pats ty =
+ List.iter (fun { typed_pat = pat; pat_type_for_unif = pat_ty; _ } ->
+ unify_pat_types pat.pat_loc env pat_ty ty
+ ) half_typed_cases
+ in
+ unify_pats ty_arg';
+ (* Check for polymorphic variants to close *)
+ if List.exists has_variants patl then begin
+ Parmatch.pressure_variants_in_computation_pattern env
+ (List.map (as_comp_pattern category) patl);
+ List.iter finalize_variants patl
+ end;
+ (* `Contaminating' unifications start here *)
+ List.iter (fun f -> f()) !pattern_force;
+ (* Post-processing and generalization *)
+ if take_partial_instance <> None then unify_pats (instance ty_arg);
+ List.iter (fun { pat_vars; _ } ->
+ iter_pattern_variables_type (enforce_current_level env) pat_vars
+ ) half_typed_cases;
+ (half_typed_cases, ty_res, do_copy_types, ty_arg')
+ end
+ in
+ (* type bodies *)
+ let ty_res' = instance ty_res in
+ (* Why is it needed to keep the level of result raised ? *)
+ let result = with_local_level_if_principal ~post:ignore begin fun () ->
+ map_conts
+ (fun { typed_pat = pat; branch_env = ext_env;
+ pat_vars = pvs; module_vars = mvs;
+ case_data; contains_gadt; _ } cont
+ ->
+ let ext_env =
+ if contains_gadt then
+ do_copy_types ext_env
+ else
+ ext_env
+ in
+ (* Before handing off the cases to the callback, first set up the the
+ branch environments by adding the variables (and module variables)
+ from the patterns.
+ *)
+ let cont_vars, pvs =
+ List.partition (fun pv -> pv.pv_kind = Continuation_var) pvs in
+ let add_pattern_vars = add_pattern_variables
+ ~check:(fun s -> Warnings.Unused_var_strict s)
+ ~check_as:(fun s -> Warnings.Unused_var s)
+ in
+ let when_env = add_pattern_vars ext_env pvs in
+ let when_env = add_module_variables when_env mvs in
+ let ext_env = add_pattern_vars when_env cont_vars in
+ let ty_expected =
+ if contains_gadt && not !Clflags.principal then
+ (* Take a generic copy of [ty_res] again to allow propagation of
+ type information from preceding branches *)
+ duplicate_type ty_res
+ else ty_res in
+ type_body case_data pat ~when_env ~ext_env ~cont ~ty_expected
+ ~ty_infer:ty_res' ~contains_gadt)
+ conts half_typed_cases
+ end in
+ let do_init = may_contain_gadts || needs_exhaust_check in
+ let ty_arg_check =
+ if do_init then
+ (* Hack: use for_saving to copy variables too *)
+ Subst.type_expr (Subst.for_saving Subst.identity) ty_arg'
+ else ty_arg'
+ in
+ (* Split the cases into val and exn cases so we can do the appropriate checks
+ for exhaustivity and unused variables.
+
+ The caller of this function can define custom checks. For some of these
+ checks, the half-typed case doesn't provide enough info on its own -- for
+ instance, the check for ambiguous bindings in when guards needs to know the
+ case body's expression -- so the code pairs each case with its
+ corresponding element in [result] before handing it off to the caller's
+ custom checks.
+ *)
+ let val_cases_with_result, exn_cases_with_result =
+ match category with
+ | Value ->
+ let val_cases =
+ List.map2
+ (fun htc res ->
+ { htc.untyped_case with pattern = htc.typed_pat }, res)
+ half_typed_cases
+ result
+ in
+ (val_cases : (pattern Parmatch.parmatch_case * ret) list), []
+ | Computation ->
+ split_half_typed_cases env (List.combine half_typed_cases result)
+ in
+ let val_cases = List.map fst val_cases_with_result in
+ let exn_cases = List.map fst exn_cases_with_result in
+ if val_cases = [] && exn_cases <> [] then
+ raise (Error (loc, env, No_value_clauses));
+ let partial =
+ if check_if_total then
+ check_partial ~lev env ty_arg_check loc val_cases
+ else
+ Partial
+ in
+ let unused_check delayed =
+ List.iter (fun { typed_pat; branch_env; _ } ->
+ check_absent_variant branch_env (as_comp_pattern category typed_pat)
+ ) half_typed_cases;
+ with_level_if delayed ~level:lev begin fun () ->
+ check_unused ~lev env ty_arg_check val_cases ;
+ check_unused ~lev env Predef.type_exn exn_cases ;
+ end;
+ in
+ if contains_polyvars then
+ add_delayed_check (fun () -> unused_check true)
+ else
+ (* Check for unused cases, do not delay because of gadts *)
+ unused_check false;
+ begin
+ match additional_checks_for_split_cases with
+ | None -> ()
+ | Some check ->
+ check val_cases_with_result;
+ check exn_cases_with_result;
+ end;
+ (result, partial), [ty_res']
+ end
+ (* Ensure that existential types do not escape *)
+ ~post:(fun ty_res' -> unify_exp_types loc env ty_res' (newvar ()))
+
+(* Typing of match cases *)
+and type_cases
+ : type k . k pattern_category -> _ -> _ -> _ -> ?conts:_ ->
+ check_if_total:bool -> _ -> Parsetree.case list ->
+ k case list * partial
+ = fun category env
+ ty_arg ty_res_explained ?conts ~check_if_total loc caselist ->
+ let { ty = ty_res; explanation } = ty_res_explained in
+ let caselist =
+ List.map (fun case -> Parmatch.untyped_case case, case) caselist
+ in
+ (* Most of the work is done by [map_half_typed_cases]. All that's left
+ is to typecheck the guards and the cases, and then to check for some
+ warnings that can fire in the presence of guards.
+ *)
+ map_half_typed_cases ?conts category env ty_arg ty_res loc caselist
+ ~check_if_total
+ ~type_body:begin
+ fun { pc_guard; pc_rhs } pat ~when_env ~ext_env ~cont ~ty_expected
+ ~ty_infer ~contains_gadt:_ ->
+ let cont = Option.map (fun (id,_) -> id) cont in
+ let guard =
+ match pc_guard with
+ | None -> None
+ | Some scond ->
+ (* It is crucial that the continuation is not used in the
+ `when' expression as the extent of the continuation is
+ yet to be determined. We make the continuation
+ inaccessible by typing the `when' expression using the
+ environment `ext_env' which does not bind the
+ continuation variable. *)
+ Some
+ (type_expect when_env scond
+ (mk_expected ~explanation:When_guard Predef.type_bool))
+ in
+ let exp =
+ type_expect ext_env pc_rhs (mk_expected ?explanation ty_expected)
+ in
+ {
+ c_lhs = pat;
+ c_cont = cont;
+ c_guard = guard;
+ c_rhs = {exp with exp_type = ty_infer}
+ }
+ end
+ ~additional_checks_for_split_cases:(fun cases ->
+ let cases =
+ List.map
+ (fun (case_with_pat, case) ->
+ { case with c_lhs = case_with_pat.Parmatch.pattern }) cases
+ in
+ Parmatch.check_ambiguous_bindings cases)
+
+
+(** A version of [type_expect], but that operates over function cases instead
+ of expressions. The input type is like the [ty_expected] argument to
+ [type_expect], and the returned type is like the [exp_type] of the
+ expression returned by [type_expect].
+
+ See [split_function_ty] for the meaning of [first] and [in_function].
+*)
+and type_function_cases_expect
+ env ty_expected loc cases attrs ~first ~in_function =
+ Builtin_attributes.warning_scope attrs begin fun () ->
+ let ty_arg, ty_res =
+ split_function_ty env ty_expected ~arg_label:Nolabel ~first ~in_function
+ in
+ let cases, partial =
+ type_cases Value env ty_arg (mk_expected ty_res)
+ ~check_if_total:true loc cases
+ in
+ let ty_fun =
+ instance (newgenty (Tarrow (Nolabel, ty_arg, ty_res, commu_ok)))
+ in
+ unify_exp_types loc env ty_fun (instance ty_expected);
+ cases, partial, ty_fun
+ end
+
+and type_effect_cases
+ : type k . k pattern_category -> _ -> _ -> _ -> Parsetree.case list -> _
+ -> k case list
+ = fun category env ty_res_explained loc caselist conts ->
+ let { ty = ty_res; explanation = _ } = ty_res_explained in
+ let _ = newvar () in
+ (* remember original level *)
+ with_local_level begin fun () ->
+ (* Create a locally type abstract type for effect type. *)
+ let new_env, ty_arg, ty_cont =
+ let decl = Ctype.new_local_type ~loc Definition in
+ let scope = create_scope () in
+ let name = Ctype.get_new_abstract_name env "%eff" in
+ let id = Ident.create_scoped ~scope name in
+ let new_env = Env.add_type ~check:false id decl env in
+ let ty_eff = newgenty (Tconstr (Path.Pident id,[],ref Mnil)) in
+ new_env,
+ Predef.type_eff ty_eff,
+ Predef.type_continuation ty_eff ty_res
+ in
+ let conts = List.map (type_continuation_pat env ty_cont) conts in
+ let cases, _ = type_cases category new_env ty_arg
+ ty_res_explained ~conts ~check_if_total:false loc caselist
+ in
+ cases
+ end
+
+(* Typing of let bindings *)
+
+and type_let ?check ?check_strict
+ existential_context env rec_flag spat_sexp_list allow_modules =
+ let spatl = List.map vb_pat_constraint spat_sexp_list in
+ let attrs_list = List.map fst spatl in
+ let is_recursive = (rec_flag = Recursive) in
+
+ let (pat_list, exp_list, new_env, mvs) =
+ with_local_level_generalize begin fun () ->
+ if existential_context = At_toplevel then Typetexp.TyVarEnv.reset ();
+ let (pat_list, new_env, force, pvs, mvs) =
+ with_local_level_generalize_structure_if_principal begin fun () ->
+ let nvs = List.map (fun _ -> newvar ()) spatl in
+ let (pat_list, _new_env, _force, _pvs, _mvs as res) =
+ type_pattern_list
+ Value existential_context env spatl nvs allow_modules in
+ (* If recursive, first unify with an approximation of the
+ expression *)
+ if is_recursive then
+ List.iter2
+ (fun pat binding ->
+ let pat =
+ match get_desc pat.pat_type with
+ | Tpoly (ty, tl) ->
+ {pat with pat_type =
+ snd (instance_poly ~keep_names:true ~fixed:false tl ty)}
+ | _ -> pat
+ in
+ let bound_expr = vb_exp_constraint binding in
+ unify_pat env pat (type_approx env bound_expr))
+ pat_list spat_sexp_list;
+ (* Polymorphic variant processing *)
+ List.iter
+ (fun pat ->
+ if has_variants pat then begin
+ Parmatch.pressure_variants env [pat];
+ finalize_variants pat
+ end)
+ pat_list;
+ res
+ end
+ in
+ (* Note [add_module_variables after checking expressions]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ Don't call [add_module_variables] here, because its use of
+ [type_module] will fail until after we have type-checked the expression
+ of the let. Example: [let m : (module S) = ... in let (module M) = m in
+ ...] We learn the signature [S] from the type of [m] in the RHS of the
+ second let, and we need that knowledge for [type_module] to succeed. If
+ we type-checked expressions before patterns, then we could call
+ [add_module_variables] here.
+ *)
+ let new_env = add_pattern_variables new_env pvs in
+ let pat_list =
+ List.map
+ (fun pat -> {pat with pat_type = instance pat.pat_type})
+ pat_list
+ in
+ (* Only bind pattern variables after generalizing *)
+ List.iter (fun f -> f()) force;
+
+ let exp_list =
+ (* See Note [add_module_variables after checking expressions]
+ We can't defer type-checking module variables with recursive
+ definitions, so things like [let rec (module M) = m in ...] always
+ fail, even if the type of [m] is known.
+ *)
+ let exp_env =
+ if is_recursive then add_module_variables new_env mvs else env
+ in
+ type_let_def_wrap_warnings ?check ?check_strict ~is_recursive
+ ~exp_env ~new_env ~spat_sexp_list ~attrs_list ~pat_list ~pvs
+ (fun exp_env ({pvb_attributes; _} as vb) pat ->
+ let sexp = vb_exp_constraint vb in
+ match get_desc pat.pat_type with
+ | Tpoly (ty, tl) ->
+ let vars, ty' =
+ with_local_level_generalize_structure_if_principal
+ (fun () -> instance_poly ~keep_names:true ~fixed:true tl ty)
+ in
+ let exp =
+ Builtin_attributes.warning_scope pvb_attributes (fun () ->
+ type_expect exp_env sexp (mk_expected ty'))
+ in
+ exp, Some vars
+ | _ ->
+ let exp =
+ Builtin_attributes.warning_scope pvb_attributes (fun () ->
+ type_expect exp_env sexp (mk_expected pat.pat_type))
+ in
+ exp, None)
+ in
+ List.iter2
+ (fun pat (attrs, exp) ->
+ Builtin_attributes.warning_scope ~ppwarning:false attrs
+ (fun () ->
+ let case = Parmatch.typed_case (case pat exp) in
+ ignore(check_partial env pat.pat_type pat.pat_loc
+ [case] : Typedtree.partial)
+ )
+ )
+ pat_list
+ (List.map2 (fun (attrs, _) (e, _) -> attrs, e) spatl exp_list);
+ (pat_list, exp_list, new_env, mvs)
+ end
+ ~before_generalize: begin fun (pat_list, exp_list, _, _) ->
+ List.iter2 (fun pat (exp, vars) ->
+ if maybe_expansive exp then begin
+ lower_contravariant env pat.pat_type;
+ if vars <> None then lower_contravariant env exp.exp_type
+ end)
+ pat_list exp_list
+ end
+ in
+ List.iter2
+ (fun pat (exp, vars) ->
+ Option.iter (check_univars env "definition" exp pat.pat_type) vars)
+ pat_list exp_list;
+ let l = List.combine pat_list exp_list in
+ let l =
+ List.map2
+ (fun (p, (e, _)) pvb ->
+ (* vb_rec_kind will be computed later for recursive bindings *)
+ {vb_pat=p; vb_expr=e; vb_attributes=pvb.pvb_attributes;
+ vb_loc=pvb.pvb_loc; vb_rec_kind = Dynamic;
+ })
+ l spat_sexp_list
+ in
+ if is_recursive then
+ List.iter
+ (fun {vb_pat=pat} -> match pat.pat_desc with
+ Tpat_var _ -> ()
+ | Tpat_alias ({pat_desc=Tpat_any}, _, _, _) -> ()
+ | _ -> raise(Error(pat.pat_loc, env, Illegal_letrec_pat)))
+ l;
+ List.iter (fun vb ->
+ if pattern_needs_partial_application_check vb.vb_pat then
+ check_partial_application ~statement:false vb.vb_expr
+ ) l;
+ (* See Note [add_module_variables after checking expressions] *)
+ let new_env = add_module_variables new_env mvs in
+ (l, new_env)
+
+and type_let_def_wrap_warnings
+ ?(check = fun s -> Warnings.Unused_var s)
+ ?(check_strict = fun s -> Warnings.Unused_var_strict s)
+ ~is_recursive ~exp_env ~new_env ~spat_sexp_list ~attrs_list ~pat_list ~pvs
+ type_def =
+ let is_fake_let =
+ match spat_sexp_list with
+ | [{pvb_expr={pexp_desc=Pexp_match(
+ {pexp_desc=Pexp_ident({ txt = Longident.Lident "*opt*"})},_)}}] ->
+ true (* the fake let-declaration introduced by fun ?(x = e) -> ... *)
+ | _ ->
+ false
+ in
+ let check = if is_fake_let then check_strict else check in
+ let warn_about_unused_bindings =
+ List.exists
+ (fun attrs ->
+ Builtin_attributes.warning_scope ~ppwarning:false attrs (fun () ->
+ Warnings.is_active (check "") || Warnings.is_active (check_strict "")
+ || (is_recursive && (Warnings.is_active Warnings.Unused_rec_flag))))
+ attrs_list
+ in
+ let sexp_is_fun { pvb_expr = sexp; _ } =
+ match sexp.pexp_desc with
+ | Pexp_function _ -> true
+ | _ -> false
+ in
+ let exp_env =
+ if not is_recursive && List.for_all sexp_is_fun spat_sexp_list then begin
+ (* Add ghost bindings to help detecting missing "rec" keywords.
+
+ We only add those if the body of the definition is obviously a
+ function. The rationale is that, in other cases, the hint is probably
+ wrong (and the user is using "advanced features" anyway (lazy,
+ recursive values...)).
+
+ [pvb_loc] (below) is the location of the first let-binding (in case of
+ a let .. and ..), and is where the missing "rec" hint suggests to add a
+ "rec" keyword. *)
+ match spat_sexp_list with
+ | {pvb_loc; _} :: _ ->
+ maybe_add_pattern_variables_ghost pvb_loc exp_env pvs
+ | _ -> assert false
+ end
+ else exp_env
+ in
+ (* Algorithm to detect unused declarations in recursive bindings:
+ - During type checking of the definitions, we capture the 'value_used'
+ events on the bound identifiers and record them in a slot corresponding
+ to the current definition (!current_slot).
+ In effect, this creates a dependency graph between definitions.
+
+ - After type checking the definition (!current_slot = None),
+ when one of the bound identifier is effectively used, we trigger
+ again all the events recorded in the corresponding slot.
+ The effect is to traverse the transitive closure of the graph created
+ in the first step.
+
+ We also keep track of whether *all* variables in a given pattern
+ are unused. If this is the case, for local declarations, the issued
+ warning is 26, not 27.
+ *)
+ let current_slot = ref None in
+ let rec_needed = ref false in
+ let pat_slot_list =
+ List.map2
+ (fun attrs pat ->
+ Builtin_attributes.warning_scope ~ppwarning:false attrs (fun () ->
+ if not warn_about_unused_bindings then pat, None
+ else
+ let some_used = ref false in
+ (* has one of the identifier of this pattern been used? *)
+ let slot = ref [] in
+ List.iter
+ (fun id ->
+ let vd = Env.find_value (Path.Pident id) new_env in
+ (* note: Env.find_value does not trigger the value_used
+ event *)
+ let name = Ident.name id in
+ let used = ref false in
+ if not (name = "" || name.[0] = '_' || name.[0] = '#') then
+ add_delayed_check
+ (fun () ->
+ if not !used then
+ Location.prerr_warning vd.Types.val_loc
+ ((if !some_used then check_strict else check) name)
+ );
+ Env.set_value_used_callback
+ vd
+ (fun () ->
+ match !current_slot with
+ | Some slot ->
+ slot := vd.val_uid :: !slot; rec_needed := true
+ | None ->
+ List.iter Env.mark_value_used (get_ref slot);
+ used := true;
+ some_used := true
+ )
+ )
+ (Typedtree.pat_bound_idents pat);
+ pat, Some slot
+ ))
+ attrs_list
+ pat_list
+ in
+ let exp_list =
+ List.map2
+ (fun case (pat, slot) ->
+ if is_recursive then current_slot := slot;
+ type_def exp_env case pat)
+ spat_sexp_list pat_slot_list
+ in
+ current_slot := None;
+ if is_recursive && not !rec_needed then begin
+ let {pvb_pat; pvb_attributes} = List.hd spat_sexp_list in
+ (* See PR#6677 *)
+ Builtin_attributes.warning_scope ~ppwarning:false pvb_attributes
+ (fun () ->
+ Location.prerr_warning pvb_pat.ppat_loc Warnings.Unused_rec_flag
+ )
+ end;
+ exp_list
+
+and type_andops env sarg sands expected_ty =
+ let rec loop env let_sarg rev_sands expected_ty =
+ match rev_sands with
+ | [] -> type_expect env let_sarg (mk_expected expected_ty), []
+ | { pbop_op = sop; pbop_exp = sexp; pbop_loc = loc; _ } :: rest ->
+ let op_path, op_desc, op_type, ty_arg, ty_rest, ty_result =
+ with_local_level_generalize_structure_if_principal begin fun () ->
+ let op_path, op_desc = type_binding_op_ident env sop in
+ let op_type = instance op_desc.val_type in
+ let ty_arg = newvar () in
+ let ty_rest = newvar () in
+ let ty_result = newvar() in
+ let ty_rest_fun =
+ newty (Tarrow(Nolabel, ty_arg, ty_result, commu_ok)) in
+ let ty_op =
+ newty (Tarrow(Nolabel, ty_rest, ty_rest_fun, commu_ok)) in
+ begin try
+ unify env op_type ty_op
+ with Unify err ->
+ raise(Error(sop.loc, env, Andop_type_clash(sop.txt, err)))
+ end;
+ (op_path, op_desc, op_type, ty_arg, ty_rest, ty_result)
+ end
+ in
+ let let_arg, rest = loop env let_sarg rest ty_rest in
+ let exp = type_expect env sexp (mk_expected ty_arg) in
+ begin try
+ unify env (instance ty_result) (instance expected_ty)
+ with Unify err ->
+ raise(Error(loc, env, Bindings_type_clash(err)))
+ end;
+ let andop =
+ { bop_op_name = sop;
+ bop_op_path = op_path;
+ bop_op_val = op_desc;
+ bop_op_type = op_type;
+ bop_exp = exp;
+ bop_loc = loc }
+ in
+ let_arg, andop :: rest
+ in
+ let let_arg, rev_ands = loop env sarg (List.rev sands) expected_ty in
+ let_arg, List.rev rev_ands
+
+(* Typing of method call *)
+and type_send env loc explanation e met =
+ let obj = type_exp env e in
+ let (meth, typ) =
+ match obj.exp_desc with
+ | Texp_ident(_, _, {val_kind = Val_self(sign, meths, _, _)}) ->
+ let id, typ =
+ match meths with
+ | Self_concrete meths ->
+ let id =
+ match Meths.find met meths with
+ | id -> id
+ | exception Not_found ->
+ let valid_methods =
+ Meths.fold (fun lab _ acc -> lab :: acc) meths []
+ in
+ raise (Error(e.pexp_loc, env,
+ Undefined_self_method (met, valid_methods)))
+ in
+ let typ = Btype.method_type met sign in
+ id, typ
+ | Self_virtual meths_ref -> begin
+ match Meths.find met !meths_ref with
+ | id -> id, Btype.method_type met sign
+ | exception Not_found ->
+ let id = Ident.create_local met in
+ let ty = newvar () in
+ meths_ref := Meths.add met id !meths_ref;
+ add_method env met Private Virtual ty sign;
+ Location.prerr_warning loc
+ (Warnings.Undeclared_virtual_method met);
+ id, ty
+ end
+ in
+ Tmeth_val id, typ
+ | Texp_ident(_, _, {val_kind = Val_anc (sign, meths, cl_num)}) ->
+ let id =
+ match Meths.find met meths with
+ | id -> id
+ | exception Not_found ->
+ let valid_methods =
+ Meths.fold (fun lab _ acc -> lab :: acc) meths []
+ in
+ raise (Error(e.pexp_loc, env,
+ Undefined_self_method (met, valid_methods)))
+ in
+ let typ = Btype.method_type met sign in
+ let (self_path, _) =
+ Env.find_value_by_name
+ (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ Tmeth_ancestor(id, self_path), typ
+ | _ ->
+ let ty =
+ match filter_method env met obj.exp_type with
+ | ty -> ty
+ | exception Filter_method_failed err ->
+ let error =
+ match err with
+ | Unification_error err ->
+ Expr_type_clash(err, explanation, None)
+ | Not_an_object ty ->
+ Not_an_object(ty, explanation)
+ | Not_a_method ->
+ let valid_methods =
+ match get_desc (expand_head env obj.exp_type) with
+ | Tobject (fields, _) ->
+ let (fields, _) = Ctype.flatten_fields fields in
+ let collect_fields li (meth, meth_kind, _meth_ty) =
+ if field_kind_repr meth_kind = Fpublic
+ then meth::li else li
+ in
+ Some (List.fold_left collect_fields [] fields)
+ | _ -> None
+ in
+ Undefined_method(obj.exp_type, met, valid_methods)
+ in
+ raise (Error(e.pexp_loc, env, error))
+ in
+ Tmeth_name met, ty
+ in
+ (obj,meth,typ)
+
+(* Typing of toplevel bindings *)
+
+let type_binding env rec_flag spat_sexp_list =
+ let (pat_exp_list, new_env) =
+ type_let
+ ~check:(fun s -> Warnings.Unused_value_declaration s)
+ ~check_strict:(fun s -> Warnings.Unused_value_declaration s)
+ At_toplevel
+ env rec_flag spat_sexp_list Modules_rejected
+ in
+ (pat_exp_list, new_env)
+
+let type_let existential_ctx env rec_flag spat_sexp_list =
+ let (pat_exp_list, new_env) =
+ type_let existential_ctx env rec_flag spat_sexp_list Modules_rejected in
+ (pat_exp_list, new_env)
+
+(* Typing of toplevel expressions *)
+
+let type_expression env sexp =
+ let exp =
+ with_local_level_generalize begin fun () ->
+ Typetexp.TyVarEnv.reset();
+ type_exp env sexp
+ end
+ ~before_generalize:(may_lower_contravariant env)
+ in
+ match sexp.pexp_desc with
+ Pexp_ident lid ->
+ let loc = sexp.pexp_loc in
+ (* Special case for keeping type variables when looking-up a variable *)
+ let (_path, desc) = Env.lookup_value ~use:false ~loc lid.txt env in
+ {exp with exp_type = desc.val_type}
+ | _ -> exp
+
+(* Error report *)
+
+let spellcheck ppf unbound_name valid_names =
+ Misc.did_you_mean ppf (fun () ->
+ Misc.spellcheck valid_names unbound_name
+ )
+
+let spellcheck_idents ppf unbound valid_idents =
+ spellcheck ppf (Ident.name unbound) (List.map Ident.name valid_idents)
+
+open Format_doc
+module Fmt = Format_doc
+module Printtyp = Printtyp.Doc
+
+let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
+(* Returns the first diff of the trace *)
+let type_clash_of_trace trace =
+ Errortrace.(explain trace (fun ~prev:_ -> function
+ | Diff diff -> Some diff
+ | _ -> None
+ ))
+
+(** More precise denomination for type errors. Used by messages:
+
+ - [This <denom> ...]
+ - [The <denom> "foo" ...] *)
+let pp_exp_denom ppf pexp =
+ let d = pp_print_string ppf in
+ let d_expression = fprintf ppf "%a expression" Style.inline_code in
+ match pexp.pexp_desc with
+ | Pexp_constant _ -> d "constant"
+ | Pexp_ident _ -> d "value"
+ | Pexp_construct _ | Pexp_variant _ -> d "constructor"
+ | Pexp_field _ -> d "field access"
+ | Pexp_send _ -> d "method call"
+ | Pexp_while _ -> d_expression "while"
+ | Pexp_for _ -> d_expression "for"
+ | Pexp_ifthenelse _ -> d_expression "if-then-else"
+ | Pexp_match _ -> d_expression "match"
+ | Pexp_try _ -> d_expression "try-with"
+ | _ -> d "expression"
+
+(** Implements the "This expression" message, printing the expression if it
+ should be according to {!Parsetree.Doc.nominal_exp}. *)
+let report_this_pexp_has_type denom ppf exp =
+ let denom ppf =
+ match denom, exp with
+ | Some d, _ -> fprintf ppf "%s" d
+ | None, Some exp -> pp_exp_denom ppf exp
+ | None, None -> fprintf ppf "expression"
+ in
+ let nexp = Option.bind exp Pprintast.Doc.nominal_exp in
+ match nexp with
+ | Some nexp ->
+ fprintf ppf "The %t %a has type" denom (Style.as_inline_code pp_doc) nexp
+ | _ -> fprintf ppf "This %t has type" denom
+
+let report_this_texp_has_type denom ppf texp =
+ report_this_pexp_has_type denom ppf (Some (Untypeast.untype_expression texp))
+
+(* Hint on type error on integer literals
+ To avoid confusion, it is disabled on float literals
+ and when the expected type is `int` *)
+let report_literal_type_constraint expected_type const =
+ let const_str = match const.pconst_desc with
+ | Pconst_integer (s, _) -> Some s
+ | _ -> None
+ in
+ let suffix =
+ if Path.same expected_type Predef.path_int32 then
+ Some 'l'
+ else if Path.same expected_type Predef.path_int64 then
+ Some 'L'
+ else if Path.same expected_type Predef.path_nativeint then
+ Some 'n'
+ else if Path.same expected_type Predef.path_float then
+ Some '.'
+ else None
+ in
+ let pp_const ppf (c,s) = Fmt.fprintf ppf "%s%c" c s in
+ match const_str, suffix with
+ | Some c, Some s -> [
+ Location.msg
+ "@[@{<hint>Hint@}: Did you mean %a?@]"
+ (Style.as_inline_code pp_const) (c,s)
+ ]
+ | _, _ -> []
+
+let report_literal_type_constraint const = function
+ | Some tr ->
+ begin match get_desc Errortrace.(tr.expected.ty) with
+ Tconstr (typ, [], _) ->
+ report_literal_type_constraint typ const
+ | _ -> []
+ end
+ | None -> []
+
+let report_partial_application = function
+ | Some tr -> begin
+ match get_desc tr.Errortrace.got.Errortrace.expanded with
+ | Tarrow _ ->
+ [ Location.msg
+ "@[@{<hint>Hint@}: This function application is partial,@ \
+ maybe some arguments are missing.@]" ]
+ | _ -> []
+ end
+ | None -> []
+
+let report_expr_type_clash_hints exp diff =
+ match exp with
+ | Some exp -> begin
+ match exp.pexp_desc with
+ | Pexp_constant const -> report_literal_type_constraint const diff
+ | Pexp_apply _ -> report_partial_application diff
+ | _ -> []
+ end
+ | None -> []
+
+let report_pattern_type_clash_hints pat diff =
+ match pat with
+ | Some (Ppat_constant const) -> report_literal_type_constraint const diff
+ | _ -> []
+
+let report_type_expected_explanation expl =
+ let because expl_str = doc_printf "@ because it is in %s" expl_str in
+ match expl with
+ | If_conditional ->
+ because "the condition of an if-statement"
+ | If_no_else_branch ->
+ because "the result of a conditional with no else branch"
+ | While_loop_conditional ->
+ because "the condition of a while-loop"
+ | While_loop_body ->
+ because "the body of a while-loop"
+ | For_loop_start_index ->
+ because "a for-loop start index"
+ | For_loop_stop_index ->
+ because "a for-loop stop index"
+ | For_loop_body ->
+ because "the body of a for-loop"
+ | Assert_condition ->
+ because "the condition of an assertion"
+ | Sequence_left_hand_side ->
+ because "the left-hand side of a sequence"
+ | When_guard ->
+ because "a when-guard"
+
+let report_type_expected_explanation_opt expl =
+ match expl with
+ | None -> Format_doc.Doc.empty
+ | Some expl -> report_type_expected_explanation expl
+
+let report_unification_error ~loc ?sub env err
+ ?type_expected_explanation txt1 txt2 =
+ Location.error_of_printer ~loc ?sub (fun ppf () ->
+ Errortrace_report.unification ppf env err
+ ?type_expected_explanation txt1 txt2
+ ) ()
+
+let report_too_many_arg_error ~funct ~func_ty ~previous_arg_loc
+ ~extra_arg_loc ~returns_unit loc =
+ let open Location in
+ let cnum_offset off (pos : Lexing.position) =
+ { pos with pos_cnum = pos.pos_cnum + off }
+ in
+ let app_loc =
+ (* Span the application, including the extra argument. *)
+ { loc_start = loc.loc_start;
+ loc_end = extra_arg_loc.loc_end;
+ loc_ghost = false }
+ and tail_loc =
+ (* Possible location for a ';'. The location is widened to overlap the end
+ of the argument. *)
+ let arg_end = previous_arg_loc.loc_end in
+ { loc_start = cnum_offset ~-1 arg_end;
+ loc_end = cnum_offset ~+1 arg_end;
+ loc_ghost = false }
+ in
+ let hint_semicolon = if returns_unit then [
+ msg ~loc:tail_loc "@{<hint>Hint@}: Did you forget a ';'?";
+ ] else [] in
+ let sub = hint_semicolon @ [
+ msg ~loc:extra_arg_loc "This extra argument is not expected.";
+ ] in
+ errorf ~loc:app_loc ~sub
+ "@[<v>@[<2>%a@ %a@]\
+ @ It is applied to too many arguments@]"
+ (report_this_texp_has_type (Some "function")) funct
+ Printtyp.type_expr func_ty
+
+let msg = Fmt.doc_printf
+
+let report_error ~loc env = function
+ | Constructor_arity_mismatch(lid, expected, provided) ->
+ Location.errorf ~loc
+ "@[The constructor %a@ expects %i argument(s),@ \
+ but is applied here to %i argument(s)@]"
+ quoted_constr lid expected provided
+ | Label_mismatch(lid, err) ->
+ report_unification_error ~loc env err
+ (msg "The record field %a@ belongs to the type" quoted_longident lid)
+ (msg "but is mixed here with fields of type")
+ | Pattern_type_clash (err, pat) ->
+ let diff = type_clash_of_trace err.trace in
+ let sub = report_pattern_type_clash_hints pat diff in
+ report_unification_error ~loc ~sub env err
+ (msg "This pattern matches values of type")
+ (msg "but a pattern was expected which matches values of type");
+ | Or_pattern_type_clash (id, err) ->
+ report_unification_error ~loc env err
+ (msg "The variable %a on the left-hand side of this \
+ or-pattern has type" Style.inline_code (Ident.name id))
+ (msg "but on the right-hand side it has type")
+ | Multiply_bound_variable name ->
+ Location.errorf ~loc
+ "Variable %a is bound several times in this matching"
+ Style.inline_code name
+ | Orpat_vars (id, valid_idents) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ fprintf ppf
+ "Variable %a must occur on both sides of this %a pattern"
+ Style.inline_code (Ident.name id)
+ Style.inline_code "|"
+ ;
+ spellcheck_idents ppf id valid_idents
+ ) ()
+ | Expr_type_clash (err, explanation, exp) ->
+ let diff = type_clash_of_trace err.trace in
+ let sub = report_expr_type_clash_hints exp diff in
+ report_unification_error ~loc ~sub env err
+ ~type_expected_explanation:
+ (report_type_expected_explanation_opt explanation)
+ (msg "%a" (report_this_pexp_has_type None) exp)
+ (msg "but an expression was expected of type");
+ | Function_arity_type_clash {
+ syntactic_arity; type_constraint; trace = { trace };
+ } ->
+ (* The last diff's expected type will be the locally-abstract type
+ that the GADT pattern introduced an equation on.
+ *)
+ let type_with_local_equation =
+ let last_diff =
+ List.find_map
+ (function Errortrace.Diff diff -> Some diff | _ -> None)
+ (List.rev trace)
+ in
+ match last_diff with
+ | None -> None
+ | Some diff -> Some diff.expected.ty
+ in
+ (* [syntactic_arity>1] for this error, so "arguments" is always plural. *)
+ Location.errorf ~loc
+ "@[\
+ @[\
+ The syntactic arity of the function doesn't match the type constraint:@ \
+ @[<2>\
+ This function has %d syntactic arguments, but its type is constrained \
+ to@ %a.\
+ @]@ \
+ @]@ \
+ @[\
+ @[<2>@{<hint>Hint@}: \
+ consider splitting the function definition into@ %a@ \
+ where %a is the pattern with the GADT constructor that@ \
+ introduces the local type equation%t.\
+ @]"
+ syntactic_arity
+ (Style.as_inline_code Printtyp.type_expr) type_constraint
+ Style.inline_code "fun ... gadt_pat -> fun ..."
+ Style.inline_code "gadt_pat"
+ (fun ppf ->
+ Option.iter
+ (fprintf ppf " on %a" (Style.as_inline_code Printtyp.type_expr))
+ type_with_local_equation)
+ | Apply_non_function {
+ funct; func_ty; res_ty; previous_arg_loc; extra_arg_loc
+ } ->
+ begin match get_desc func_ty with
+ Tarrow _ ->
+ let returns_unit = match get_desc res_ty with
+ | Tconstr (p, _, _) -> Path.same p Predef.path_unit
+ | _ -> false
+ in
+ report_too_many_arg_error ~funct ~func_ty ~previous_arg_loc
+ ~extra_arg_loc ~returns_unit loc
+ | _ ->
+ Location.errorf ~loc "@[<v>@[<2>This expression has type@ %a@]@ %s@]"
+ (Style.as_inline_code Printtyp.type_expr) func_ty
+ "This is not a function; it cannot be applied."
+ end
+ | Apply_wrong_label (l, ty, extra_info) ->
+ let print_label ppf = function
+ | Nolabel -> fprintf ppf "without label"
+ | l ->
+ fprintf ppf "with label %a"
+ Style.inline_code (prefixed_label_name l)
+ in
+ let extra_info =
+ if not extra_info then
+ []
+ else
+ [ Location.msg
+ "Since OCaml 4.11, optional arguments do not commute when \
+ -nolabels is given" ]
+ in
+ Location.errorf ~loc ~sub:extra_info
+ "@[<v>@[<2>The function applied to this argument has type@ %a@]@.\
+ This argument cannot be applied %a@]"
+ Printtyp.type_expr ty print_label l
+ | Label_multiply_defined s ->
+ Location.errorf ~loc "The record field label %s is defined several times"
+ s
+ | Label_missing labels ->
+ let print_label ppf lbl = Style.inline_code ppf (Ident.name lbl) in
+ let print_labels ppf = List.iter (fprintf ppf "@ %a" print_label) in
+ Location.errorf ~loc "@[<hov>Some record fields are undefined:%a@]"
+ print_labels labels
+ | Label_not_mutable lid ->
+ Location.errorf ~loc "The record field %a is not mutable"
+ quoted_longident lid
+ | Wrong_name (eorp, ty_expected, { type_path; kind; name; valid_names; }) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ Printtyp.wrap_printing_env ~error:true env (fun () ->
+ let { ty; explanation } = ty_expected in
+ if Path.is_constructor_typath type_path then begin
+ fprintf ppf
+ "@[The field %a is not part of the record \
+ argument for the %a constructor@]"
+ Style.inline_code name.txt
+ (Style.as_inline_code Printtyp.type_path) type_path;
+ end else begin
+ fprintf ppf
+ "@[@[<2>%s type@ %a%a@]@ \
+ There is no %s %a within type %a@]"
+ eorp (Style.as_inline_code Printtyp.type_expr) ty
+ pp_doc (report_type_expected_explanation_opt explanation)
+ (Datatype_kind.label_name kind)
+ Style.inline_code name.txt
+ (Style.as_inline_code Printtyp.type_path) type_path;
+ end;
+ spellcheck ppf name.txt valid_names
+ )) ()
+ | Name_type_mismatch (kind, lid, tp, tpl) ->
+ let type_name = Datatype_kind.type_name kind in
+ let name = Datatype_kind.label_name kind in
+ let pr = match kind with
+ | Datatype_kind.Record -> quoted_longident
+ | Datatype_kind.Variant -> quoted_constr
+ in
+ Location.error_of_printer ~loc (fun ppf () ->
+ Errortrace_report.ambiguous_type ppf env tp tpl
+ (msg "The %s %a@ belongs to the %s type"
+ name pr lid type_name)
+ (msg "The %s %a@ belongs to one of the following %s types:"
+ name pr lid type_name)
+ (msg "but a %s was expected belonging to the %s type"
+ name type_name)
+ ) ()
+ | Invalid_format msg ->
+ Location.errorf ~loc "%s" msg
+ | Not_an_object (ty, explanation) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ fprintf ppf "This expression is not an object;@ \
+ it has type %a"
+ (Style.as_inline_code Printtyp.type_expr) ty;
+ pp_doc ppf @@ report_type_expected_explanation_opt explanation
+ ) ()
+ | Undefined_method (ty, me, valid_methods) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ Printtyp.wrap_printing_env ~error:true env (fun () ->
+ fprintf ppf
+ "@[<v>@[This expression has type@;<1 2>%a@]@,\
+ It has no method %a@]"
+ (Style.as_inline_code Printtyp.type_expr) ty
+ Style.inline_code me;
+ begin match valid_methods with
+ | None -> ()
+ | Some valid_methods -> spellcheck ppf me valid_methods
+ end
+ )) ()
+ | Undefined_self_method (me, valid_methods) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ fprintf ppf "This expression has no method %a" Style.inline_code me;
+ spellcheck ppf me valid_methods;
+ ) ()
+ | Virtual_class cl ->
+ Location.errorf ~loc "Cannot instantiate the virtual class %a"
+ quoted_longident cl
+ | Unbound_instance_variable (var, valid_vars) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ fprintf ppf "Unbound instance variable %a" Style.inline_code var;
+ spellcheck ppf var valid_vars;
+ ) ()
+ | Instance_variable_not_mutable v ->
+ Location.errorf ~loc "The instance variable %a is not mutable"
+ Style.inline_code v
+ | Not_subtype err ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ Errortrace_report.subtype ppf env err "is not a subtype of"
+ ) ()
+ | Outside_class ->
+ Location.errorf ~loc
+ "This object duplication occurs outside a method definition"
+ | Value_multiply_overridden v ->
+ Location.errorf ~loc
+ "The instance variable %a is overridden several times"
+ Style.inline_code v
+ | Coercion_failure (ty_exp, err, b) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ let intro =
+ let ty_exp = Out_type.prepare_expansion ty_exp in
+ doc_printf "This expression cannot be coerced to type@;<1 2>%a;@ \
+ it has type"
+ (Style.as_inline_code @@ Printtyp.type_expansion Type) ty_exp
+ in
+ Errortrace_report.unification ppf env err
+ intro
+ (Fmt.doc_printf "but is here used with type");
+ if b then
+ fprintf ppf
+ ".@.@[<hov>This simple coercion was not fully general.@ \
+ @{<hint>Hint@}: Consider using a fully explicit coercion@ \
+ of the form: %a@]"
+ Style.inline_code "(foo : ty1 :> ty2)"
+ ) ()
+ | Not_a_function (ty, explanation) ->
+ Location.errorf ~loc
+ "This expression should not be a function,@ \
+ the expected type is@ %a%a"
+ (Style.as_inline_code Printtyp.type_expr) ty
+ pp_doc (report_type_expected_explanation_opt explanation)
+ | Too_many_arguments (ty, explanation) ->
+ Location.errorf ~loc
+ "This function expects too many arguments,@ \
+ it should have type@ %a%a"
+ (Style.as_inline_code Printtyp.type_expr) ty
+ pp_doc (report_type_expected_explanation_opt explanation)
+ | Abstract_wrong_label {got; expected; expected_type; explanation} ->
+ let label ~long ppf = function
+ | Nolabel -> fprintf ppf "unlabeled"
+ | l ->
+ if long then
+ fprintf ppf "labeled %a" Style.inline_code (prefixed_label_name l)
+ else
+ Style.inline_code ppf (prefixed_label_name l)
+ in
+ let second_long = match got, expected with
+ | Nolabel, _ | _, Nolabel -> true
+ | _ -> false
+ in
+ Location.errorf ~loc
+ "@[<v>@[<2>This function should have type@ %a%a@]@,\
+ @[but its first argument is %a@ instead of %s%a@]@]"
+ (Style.as_inline_code Printtyp.type_expr) expected_type
+ pp_doc (report_type_expected_explanation_opt explanation)
+ (label ~long:true) got
+ (if second_long then "being " else "")
+ (label ~long:second_long) expected
+ | Scoping_let_module(id, ty) ->
+ Location.errorf ~loc
+ "This %a expression has type@ %a@ \
+ In this type, the locally bound module name %a escapes its scope"
+ Style.inline_code "let module"
+ (Style.as_inline_code Printtyp.type_expr) ty
+ Style.inline_code id
+ | Private_type ty ->
+ Location.errorf ~loc "Cannot create values of the private type %a"
+ (Style.as_inline_code Printtyp.type_expr) ty
+ | Private_label (lid, ty) ->
+ Location.errorf ~loc "Cannot assign field %a of the private type %a"
+ quoted_longident lid
+ (Style.as_inline_code Printtyp.type_expr) ty
+ | Private_constructor (constr, ty) ->
+ Location.errorf ~loc
+ "Cannot use private constructor %a to create values of type %a"
+ Style.inline_code constr.cstr_name
+ (Style.as_inline_code Printtyp.type_expr) ty
+ | Not_a_polymorphic_variant_type lid ->
+ Location.errorf ~loc "The type %a@ is not a variant type"
+ quoted_longident lid
+ | Incoherent_label_order ->
+ Location.errorf ~loc
+ "This function is applied to arguments@ \
+ in an order different from other calls.@ \
+ This is only allowed when the real type is known."
+ | Less_general (kind, err) ->
+ report_unification_error ~loc env err
+ (Fmt.doc_printf "This %s has type" kind)
+ (Fmt.doc_printf "which is less general than")
+ | Modules_not_allowed ->
+ Location.errorf ~loc "Modules are not allowed in this pattern."
+ | Cannot_infer_signature ->
+ Location.errorf ~loc
+ "The signature for this packaged module couldn't be inferred."
+ | Not_a_packed_module ty ->
+ Location.errorf ~loc
+ "This expression is packed module, but the expected type is@ %a"
+ (Style.as_inline_code Printtyp.type_expr) ty
+ | Unexpected_existential (reason, name) ->
+ let reason_str =
+ match reason with
+ | In_class_args ->
+ dprintf "Existential types are not allowed in class arguments"
+ | In_class_def ->
+ dprintf "Existential types are not allowed in bindings inside \
+ class definition"
+ | In_self_pattern ->
+ dprintf "Existential types are not allowed in self patterns"
+ | At_toplevel ->
+ dprintf "Existential types are not allowed in toplevel bindings"
+ | In_group ->
+ dprintf "Existential types are not allowed in %a bindings"
+ Style.inline_code "let ... and ..."
+ | In_rec ->
+ dprintf "Existential types are not allowed in recursive bindings"
+ | With_attributes ->
+ dprintf
+ "Existential types are not allowed in presence of attributes"
+ in
+ Location.errorf ~loc
+ "%t,@ but the constructor %a introduces existential types."
+ reason_str Style.inline_code name
+ | Invalid_interval ->
+ Location.errorf ~loc
+ "@[Only character intervals are supported in patterns.@]"
+ | Invalid_for_loop_index ->
+ Location.errorf ~loc
+ "@[Invalid for-loop index: only variables and %a are allowed.@]"
+ Style.inline_code "_"
+ | No_value_clauses ->
+ Location.errorf ~loc
+ "None of the patterns in this %a expression match values."
+ Style.inline_code "match"
+ | Exception_pattern_disallowed ->
+ Location.errorf ~loc
+ "@[Exception patterns are not allowed in this position.@]"
+ | Mixed_value_and_exception_patterns_under_guard ->
+ Location.errorf ~loc
+ "@[Mixing value and exception patterns under when-guards is not \
+ supported.@]"
+ | Effect_pattern_below_toplevel ->
+ Location.errorf ~loc
+ "@[Effect patterns must be at the top level of a match case.@]"
+ | Invalid_continuation_pattern ->
+ Location.errorf ~loc
+ "@[Invalid continuation pattern: only variables and _ are allowed .@]"
+ | Inlined_record_escape ->
+ Location.errorf ~loc
+ "@[This form is not allowed as the type of the inlined record could \
+ escape.@]"
+ | Inlined_record_expected ->
+ Location.errorf ~loc
+ "@[This constructor expects an inlined record argument.@]"
+ | Unrefuted_pattern pat ->
+ Location.errorf ~loc
+ "@[%s@ %s@ @[%a@]@]"
+ "This match case could not be refuted."
+ "Here is an example of a value that would reach it:"
+ (Style.as_inline_code Printpat.top_pretty) pat
+ | Invalid_extension_constructor_payload ->
+ Location.errorf ~loc
+ "Invalid %a payload, a constructor is expected."
+ Style.inline_code "[%extension_constructor]"
+ | Not_an_extension_constructor ->
+ Location.errorf ~loc
+ "This constructor is not an extension constructor."
+ | Literal_overflow ty ->
+ Location.errorf ~loc
+ "Integer literal exceeds the range of representable integers of type %a"
+ Style.inline_code ty
+ | Unknown_literal (n, m) ->
+ let pp_lit ppf (n,m) = fprintf ppf "%s%c" n m in
+ Location.errorf ~loc "Unknown modifier %a for literal %a"
+ (Style.as_inline_code pp_print_char) m
+ (Style.as_inline_code pp_lit) (n,m)
+ | Illegal_letrec_pat ->
+ Location.errorf ~loc
+ "Only variables are allowed as left-hand side of %a"
+ Style.inline_code "let rec"
+ | Illegal_letrec_expr ->
+ Location.errorf ~loc
+ "This kind of expression is not allowed as right-hand side of %a"
+ Style.inline_code "let rec"
+ | Illegal_class_expr ->
+ Location.errorf ~loc
+ "This kind of recursive class expression is not allowed"
+ | Letop_type_clash(name, err) ->
+ report_unification_error ~loc env err
+ (msg "The operator %a has type" Style.inline_code name)
+ (msg "but it was expected to have type")
+ | Andop_type_clash(name, err) ->
+ report_unification_error ~loc env err
+ (msg "The operator %a has type" Style.inline_code name)
+ (msg "but it was expected to have type")
+ | Bindings_type_clash(err) ->
+ report_unification_error ~loc env err
+ (Fmt.doc_printf "These bindings have type")
+ (Fmt.doc_printf "but bindings were expected of type")
+ | Unbound_existential (ids, ty) ->
+ let pp_ident ppf id = pp_print_string ppf (Ident.name id) in
+ let pp_type ppf (ids,ty)=
+ fprintf ppf "@[type %a.@ %a@]@]"
+ (pp_print_list ~pp_sep:pp_print_space pp_ident) ids
+ Printtyp.type_expr ty
+ in
+ Location.errorf ~loc
+ "@[<2>%s:@ %a@]"
+ "This type does not bind all existentials in the constructor"
+ (Style.as_inline_code pp_type) (ids, ty)
+ | Bind_existential (reason, id, ty) ->
+ let reason1, reason2 = match reason with
+ | Bind_already_bound -> "the name", "that is already bound"
+ | Bind_not_in_scope -> "the name", "that was defined before"
+ | Bind_non_locally_abstract -> "the type",
+ "that is not a locally abstract type"
+ in
+ Location.errorf ~loc
+ "@[<hov0>The local name@ %a@ %s@ %s.@ %s@ %s@ %a@ %s.@]"
+ (Style.as_inline_code Printtyp.ident) id
+ "can only be given to an existential variable"
+ "introduced by this GADT constructor"
+ "The type annotation tries to bind it to"
+ reason1 (Style.as_inline_code Printtyp.type_expr) ty reason2
+ | Missing_type_constraint ->
+ Location.errorf ~loc
+ "@[%s@ %s@]"
+ "Existential types introduced in a constructor pattern"
+ "must be bound by a type constraint on the argument."
+ | Wrong_expected_kind(sort, ctx, ty) ->
+ let ctx, explanation =
+ match ctx with
+ | Expression explanation -> "expression", explanation
+ | Pattern -> "pattern", None
+ in
+ let sort =
+ match sort with
+ | Constructor -> "constructor"
+ | Boolean -> "boolean literal"
+ | List -> "list literal"
+ | Unit -> "unit literal"
+ | Record -> "record"
+ in
+ Location.errorf ~loc
+ "This %s should not be a %s,@ \
+ the expected type is@ %a%a"
+ ctx sort (Style.as_inline_code Printtyp.type_expr) ty
+ pp_doc (report_type_expected_explanation_opt explanation)
+ | Expr_not_a_record_type ty ->
+ Location.errorf ~loc
+ "This expression has type %a@ \
+ which is not a record type."
+ (Style.as_inline_code Printtyp.type_expr) ty
+
+let report_error ~loc env err =
+ Printtyp.wrap_printing_env ~error:true env
+ (fun () -> report_error ~loc env err)
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc, env, err) ->
+ Some (report_error ~loc env err)
+ | Error_forward err ->
+ Some err
+ | _ ->
+ None
+ )
+
+let () =
+ Persistent_env.add_delayed_check_forward := add_delayed_check;
+ Env.add_delayed_check_forward := add_delayed_check;
+ ()
+
+(* drop the need to call [Parmatch.typed_case] from the external API *)
+let check_partial ?lev a b c cases =
+ check_partial ?lev a b c (List.map Parmatch.typed_case cases)
+
+(* drop ?recarg argument from the external API *)
+let type_expect env e ty = type_expect env e ty
+let type_exp env e = type_exp env e
+let type_argument env e t1 t2 = type_argument env e t1 t2
diff --git a/upstream/ocaml_503/typing/typecore.mli b/upstream/ocaml_503/typing/typecore.mli
new file mode 100644
index 0000000000..1b89ddd68e
--- /dev/null
+++ b/upstream/ocaml_503/typing/typecore.mli
@@ -0,0 +1,275 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Type inference for the core language *)
+
+open Asttypes
+open Types
+
+(* This variant is used to print improved error messages, and does not affect
+ the behavior of the typechecker itself.
+
+ It describes possible explanation for types enforced by a keyword of the
+ language; e.g. "if" requires the condition to be of type bool, and the
+ then-branch to be of type unit if there is no else branch; "for" requires
+ indices to be of type int, and the body to be of type unit.
+*)
+type type_forcing_context =
+ | If_conditional
+ | If_no_else_branch
+ | While_loop_conditional
+ | While_loop_body
+ | For_loop_start_index
+ | For_loop_stop_index
+ | For_loop_body
+ | Assert_condition
+ | Sequence_left_hand_side
+ | When_guard
+
+(* The combination of a type and a "type forcing context". The intent is that it
+ describes a type that is "expected" (required) by the context. If unifying
+ with such a type fails, then the "explanation" field explains why it was
+ required, in order to display a more enlightening error message.
+*)
+type type_expected = private {
+ ty: type_expr;
+ explanation: type_forcing_context option;
+}
+
+(* Variables in patterns *)
+type pattern_variable_kind =
+ | Std_var
+ | As_var
+ | Continuation_var
+
+type pattern_variable =
+ {
+ pv_id: Ident.t;
+ pv_type: type_expr;
+ pv_loc: Location.t;
+ pv_kind: pattern_variable_kind;
+ pv_attributes: Typedtree.attributes;
+ pv_uid : Uid.t;
+ }
+
+val mk_expected:
+ ?explanation:type_forcing_context ->
+ type_expr ->
+ type_expected
+
+val is_nonexpansive: Typedtree.expression -> bool
+
+module Datatype_kind : sig
+ type t = Record | Variant
+ val type_name : t -> string
+ val label_name : t -> string
+end
+
+type wrong_name = {
+ type_path: Path.t;
+ kind: Datatype_kind.t;
+ name: string loc;
+ valid_names: string list;
+}
+
+type wrong_kind_context =
+ | Pattern
+ | Expression of type_forcing_context option
+
+type wrong_kind_sort =
+ | Constructor
+ | Record
+ | Boolean
+ | List
+ | Unit
+
+type existential_restriction =
+ | At_toplevel (** no existential types at the toplevel *)
+ | In_group (** nor with [let ... and ...] *)
+ | In_rec (** or recursive definition *)
+ | With_attributes (** or [let[@any_attribute] = ...] *)
+ | In_class_args (** or in class arguments [class c (...) = ...] *)
+ | In_class_def (** or in [class c = let ... in ...] *)
+ | In_self_pattern (** or in self pattern *)
+
+val type_binding:
+ Env.t -> rec_flag ->
+ Parsetree.value_binding list ->
+ Typedtree.value_binding list * Env.t
+val type_let:
+ existential_restriction -> Env.t -> rec_flag ->
+ Parsetree.value_binding list ->
+ Typedtree.value_binding list * Env.t
+val type_expression:
+ Env.t -> Parsetree.expression -> Typedtree.expression
+val type_class_arg_pattern:
+ string -> Env.t -> Env.t -> arg_label -> Parsetree.pattern ->
+ Typedtree.pattern *
+ (Ident.t * Ident.t * type_expr) list *
+ Env.t * Env.t
+val type_self_pattern:
+ Env.t -> Parsetree.pattern ->
+ Typedtree.pattern * pattern_variable list
+val check_partial:
+ ?lev:int -> Env.t -> type_expr ->
+ Location.t -> Typedtree.value Typedtree.case list -> Typedtree.partial
+val type_expect:
+ Env.t -> Parsetree.expression -> type_expected -> Typedtree.expression
+val type_exp:
+ Env.t -> Parsetree.expression -> Typedtree.expression
+val type_approx:
+ Env.t -> Parsetree.expression -> type_expr
+val type_argument:
+ Env.t -> Parsetree.expression ->
+ type_expr -> type_expr -> Typedtree.expression
+
+val option_some: Env.t -> Typedtree.expression -> Typedtree.expression
+val option_none: Env.t -> type_expr -> Location.t -> Typedtree.expression
+val extract_option_type: Env.t -> type_expr -> type_expr
+val generalizable: int -> type_expr -> bool
+val reset_delayed_checks: unit -> unit
+val force_delayed_checks: unit -> unit
+
+val name_pattern : string -> Typedtree.pattern list -> Ident.t
+val name_cases : string -> Typedtree.value Typedtree.case list -> Ident.t
+
+val self_coercion : (Path.t * Location.t list ref) list ref
+
+type existential_binding =
+ | Bind_already_bound
+ | Bind_not_in_scope
+ | Bind_non_locally_abstract
+
+type error =
+ | Constructor_arity_mismatch of Longident.t * int * int
+ | Label_mismatch of Longident.t * Errortrace.unification_error
+ | Pattern_type_clash :
+ Errortrace.unification_error * Parsetree.pattern_desc option
+ -> error
+ | Or_pattern_type_clash of Ident.t * Errortrace.unification_error
+ | Multiply_bound_variable of string
+ | Orpat_vars of Ident.t * Ident.t list
+ | Expr_type_clash of
+ Errortrace.unification_error * type_forcing_context option
+ * Parsetree.expression option
+ | Function_arity_type_clash of
+ { syntactic_arity : int;
+ type_constraint : type_expr;
+ trace : Errortrace.unification_error;
+ }
+ | Apply_non_function of {
+ funct : Typedtree.expression;
+ func_ty : type_expr;
+ res_ty : type_expr;
+ previous_arg_loc : Location.t;
+ extra_arg_loc : Location.t;
+ }
+ | Apply_wrong_label of arg_label * type_expr * bool
+ | Label_multiply_defined of string
+ | Label_missing of Ident.t list
+ | Label_not_mutable of Longident.t
+ | Wrong_name of string * type_expected * wrong_name
+ | Name_type_mismatch of
+ Datatype_kind.t * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
+ | Invalid_format of string
+ | Not_an_object of type_expr * type_forcing_context option
+ | Undefined_method of type_expr * string * string list option
+ | Undefined_self_method of string * string list
+ | Virtual_class of Longident.t
+ | Private_type of type_expr
+ | Private_label of Longident.t * type_expr
+ | Private_constructor of constructor_description * type_expr
+ | Unbound_instance_variable of string * string list
+ | Instance_variable_not_mutable of string
+ | Not_subtype of Errortrace.Subtype.error
+ | Outside_class
+ | Value_multiply_overridden of string
+ | Coercion_failure of
+ Errortrace.expanded_type * Errortrace.unification_error * bool
+ | Not_a_function of type_expr * type_forcing_context option
+ | Too_many_arguments of type_expr * type_forcing_context option
+ | Abstract_wrong_label of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ ; explanation : type_forcing_context option
+ }
+ | Scoping_let_module of string * type_expr
+ | Not_a_polymorphic_variant_type of Longident.t
+ | Incoherent_label_order
+ | Less_general of string * Errortrace.unification_error
+ | Modules_not_allowed
+ | Cannot_infer_signature
+ | Not_a_packed_module of type_expr
+ | Unexpected_existential of existential_restriction * string
+ | Invalid_interval
+ | Invalid_for_loop_index
+ | No_value_clauses
+ | Exception_pattern_disallowed
+ | Mixed_value_and_exception_patterns_under_guard
+ | Effect_pattern_below_toplevel
+ | Invalid_continuation_pattern
+ | Inlined_record_escape
+ | Inlined_record_expected
+ | Unrefuted_pattern of Typedtree.pattern
+ | Invalid_extension_constructor_payload
+ | Not_an_extension_constructor
+ | Literal_overflow of string
+ | Unknown_literal of string * char
+ | Illegal_letrec_pat
+ | Illegal_letrec_expr
+ | Illegal_class_expr
+ | Letop_type_clash of string * Errortrace.unification_error
+ | Andop_type_clash of string * Errortrace.unification_error
+ | Bindings_type_clash of Errortrace.unification_error
+ | Unbound_existential of Ident.t list * type_expr
+ | Bind_existential of existential_binding * Ident.t * type_expr
+ | Missing_type_constraint
+ | Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
+ | Expr_not_a_record_type of type_expr
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+val report_error: loc:Location.t -> Env.t -> error -> Location.error
+ (** @deprecated. Use {!Location.error_of_exn}, {!Location.print_report}. *)
+
+(* Forward declaration, to be filled in by Typemod.type_module *)
+val type_module:
+ (Env.t -> Parsetree.module_expr -> Typedtree.module_expr * Shape.t) ref
+(* Forward declaration, to be filled in by Typemod.type_open *)
+val type_open:
+ (?used_slot:bool ref -> override_flag -> Env.t -> Location.t ->
+ Longident.t loc -> Path.t * Env.t)
+ ref
+(* Forward declaration, to be filled in by Typemod.type_open_decl *)
+val type_open_decl:
+ (?used_slot:bool ref -> Env.t -> Parsetree.open_declaration ->
+ Typedtree.open_declaration * Types.signature * Env.t)
+ ref
+(* Forward declaration, to be filled in by Typeclass.class_structure *)
+val type_object:
+ (Env.t -> Location.t -> Parsetree.class_structure ->
+ Typedtree.class_structure * string list) ref
+val type_package:
+ (Env.t -> Parsetree.module_expr -> Path.t -> (Longident.t * type_expr) list ->
+ Typedtree.module_expr * (Longident.t * type_expr) list) ref
+
+val constant: Parsetree.constant -> (Asttypes.constant, error) result
+
+val annotate_recursive_bindings :
+ Env.t -> Typedtree.value_binding list -> Typedtree.value_binding list
+val check_recursive_class_bindings :
+ Env.t -> Ident.t list -> Typedtree.class_expr list -> unit
diff --git a/upstream/ocaml_503/typing/typedecl.ml b/upstream/ocaml_503/typing/typedecl.ml
new file mode 100644
index 0000000000..60bc6b9371
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl.ml
@@ -0,0 +1,2305 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy and Jerome Vouillon, 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. *)
+(* *)
+(**************************************************************************)
+
+(**** Typing of type definitions ****)
+
+open Misc
+open Asttypes
+open Parsetree
+open Primitive
+open Types
+open Typetexp
+
+module String = Misc.Stdlib.String
+
+type native_repr_kind = Unboxed | Untagged
+
+(* Our static analyses explore the set of type expressions "reachable"
+ from a type declaration, by expansion of definitions or by the
+ subterm relation (a type expression is syntactically contained
+ in another). *)
+type reaching_type_path = reaching_type_step list
+and reaching_type_step =
+ | Expands_to of type_expr * type_expr
+ | Contains of type_expr * type_expr
+
+type error =
+ Repeated_parameter
+ | Duplicate_constructor of string
+ | Too_many_constructors
+ | Duplicate_label of string
+ | Recursive_abbrev of string * Env.t * reaching_type_path
+ | Cycle_in_def of string * Env.t * reaching_type_path
+ | Definition_mismatch of type_expr * Env.t * Includecore.type_mismatch option
+ | Constraint_failed of Env.t * Errortrace.unification_error
+ | Inconsistent_constraint of Env.t * Errortrace.unification_error
+ | Type_clash of Env.t * Errortrace.unification_error
+ | Non_regular of {
+ definition: Path.t;
+ used_as: type_expr;
+ defined_as: type_expr;
+ reaching_path: reaching_type_path;
+ }
+ | Null_arity_external
+ | Missing_native_external
+ | Unbound_type_var of type_expr * type_declaration
+ | Cannot_extend_private_type of Path.t
+ | Not_extensible_type of Path.t
+ | Extension_mismatch of Path.t * Env.t * Includecore.type_mismatch
+ | Rebind_wrong_type of
+ Longident.t * Env.t * Errortrace.unification_error
+ | Rebind_mismatch of Longident.t * Path.t * Path.t
+ | Rebind_private of Longident.t
+ | Variance of Typedecl_variance.error
+ | Unavailable_type_constructor of Path.t
+ | Unbound_type_var_ext of type_expr * extension_constructor
+ | Val_in_structure
+ | Multiple_native_repr_attributes
+ | Cannot_unbox_or_untag_type of native_repr_kind
+ | Deep_unbox_or_untag_attribute of native_repr_kind
+ | Immediacy of Typedecl_immediacy.error
+ | Separability of Typedecl_separability.error
+ | Bad_unboxed_attribute of string
+ | Boxed_and_unboxed
+ | Nonrec_gadt
+ | Invalid_private_row_declaration of type_expr
+
+open Typedtree
+
+exception Error of Location.t * error
+
+let get_unboxed_from_attributes sdecl =
+ let unboxed = Builtin_attributes.has_unboxed sdecl.ptype_attributes in
+ let boxed = Builtin_attributes.has_boxed sdecl.ptype_attributes in
+ match boxed, unboxed with
+ | true, true -> raise (Error(sdecl.ptype_loc, Boxed_and_unboxed))
+ | true, false -> Some false
+ | false, true -> Some true
+ | false, false -> None
+
+(* Enter all declared types in the environment as abstract types *)
+
+let add_type ~check ?shape id decl env =
+ Builtin_attributes.warning_scope ~ppwarning:false decl.type_attributes
+ (fun () -> Env.add_type ~check ?shape id decl env)
+
+(* Add a dummy type declaration to the environment, with the given arity.
+ The [type_kind] is [Type_abstract], but there is a generic [type_manifest]
+ for abbreviations, to allow polymorphic expansion, except if
+ [abstract_abbrevs] is given along with a reason for not allowing expansion.
+ This function is only used in [transl_type_decl]. *)
+let enter_type ?abstract_abbrevs rec_flag env sdecl (id, uid) =
+ let needed =
+ match rec_flag with
+ | Asttypes.Nonrecursive ->
+ begin match sdecl.ptype_kind with
+ | Ptype_variant scds ->
+ List.iter (fun cd ->
+ if cd.pcd_res <> None then raise (Error(cd.pcd_loc, Nonrec_gadt)))
+ scds
+ | _ -> ()
+ end;
+ Btype.is_row_name (Ident.name id)
+ | Asttypes.Recursive -> true
+ in
+ let arity = List.length sdecl.ptype_params in
+ if not needed then env else
+ let abstract_source, type_manifest =
+ match sdecl.ptype_manifest, abstract_abbrevs with
+ | None, _ -> Definition, None
+ | Some _, None -> Definition, Some (Ctype.newvar ())
+ | Some _, Some reason -> reason, None
+ in
+ let decl =
+ { type_params =
+ List.map (fun _ -> Btype.newgenvar ()) sdecl.ptype_params;
+ type_arity = arity;
+ type_kind = Type_abstract abstract_source;
+ type_private = sdecl.ptype_private;
+ type_manifest = type_manifest;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = sdecl.ptype_loc;
+ type_attributes = sdecl.ptype_attributes;
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = uid;
+ }
+ in
+ add_type ~check:true id decl env
+
+(* Determine if a type's values are represented by floats at run-time. *)
+let is_float env ty =
+ match Typedecl_unboxed.get_unboxed_type_representation env ty with
+ Some ty' ->
+ begin match get_desc ty' with
+ Tconstr(p, _, _) -> Path.same p Predef.path_float
+ | _ -> false
+ end
+ | _ -> false
+
+(* Determine if a type definition defines a fixed type. (PW) *)
+let is_fixed_type sd =
+ let rec has_row_var sty =
+ match sty.ptyp_desc with
+ Ptyp_alias (sty, _) -> has_row_var sty
+ | Ptyp_class _
+ | Ptyp_object (_, Open)
+ | Ptyp_variant (_, Open, _)
+ | Ptyp_variant (_, Closed, Some _) -> true
+ | _ -> false
+ in
+ match sd.ptype_manifest with
+ None -> false
+ | Some sty ->
+ sd.ptype_kind = Ptype_abstract &&
+ sd.ptype_private = Private &&
+ has_row_var sty
+
+(* Set the row variable to a fixed type in a private row type declaration.
+ (e.g. [ type t = private [< `A | `B ] ] or [type u = private < .. > ])
+ Require [is_fixed_type decl] as a precondition
+*)
+let set_private_row env loc p decl =
+ let tm =
+ match decl.type_manifest with
+ None -> assert false
+ | Some t -> Ctype.expand_head env t
+ in
+ let rv =
+ match get_desc tm with
+ Tvariant row ->
+ let Row {fields; more; closed; name} = row_repr row in
+ set_type_desc tm
+ (Tvariant (create_row ~fields ~more ~closed ~name
+ ~fixed:(Some Fixed_private)));
+ if Btype.static_row row then
+ (* the syntax hinted at the existence of a row variable,
+ but there is in fact no row variable to make private, e.g.
+ [ type t = private [< `A > `A] ] *)
+ raise (Error(loc, Invalid_private_row_declaration tm))
+ else more
+ | Tobject (ty, _) ->
+ let r = snd (Ctype.flatten_fields ty) in
+ if not (Btype.is_Tvar r) then
+ (* a syntactically open object was closed by a constraint *)
+ raise (Error(loc, Invalid_private_row_declaration tm));
+ r
+ | _ -> assert false
+ in
+ set_type_desc rv (Tconstr (p, decl.type_params, ref Mnil))
+
+(* Translate one type declaration *)
+
+let make_params env params =
+ let make_param (sty, v) =
+ try
+ (transl_type_param env sty, v)
+ with Already_bound ->
+ raise(Error(sty.ptyp_loc, Repeated_parameter))
+ in
+ List.map make_param params
+
+let transl_labels env univars closed lbls =
+ assert (lbls <> []);
+ let all_labels = ref String.Set.empty in
+ List.iter
+ (fun {pld_name = {txt=name; loc}} ->
+ if String.Set.mem name !all_labels then
+ raise(Error(loc, Duplicate_label name));
+ all_labels := String.Set.add name !all_labels)
+ lbls;
+ let mk {pld_name=name;pld_mutable=mut;pld_type=arg;pld_loc=loc;
+ pld_attributes=attrs} =
+ Builtin_attributes.warning_scope attrs
+ (fun () ->
+ let arg = Ast_helper.Typ.force_poly arg in
+ let cty = transl_simple_type env ?univars ~closed arg in
+ {ld_id = Ident.create_local name.txt;
+ ld_name = name;
+ ld_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ ld_mutable = mut;
+ ld_type = cty; ld_loc = loc; ld_attributes = attrs}
+ )
+ in
+ let lbls = List.map mk lbls in
+ let lbls' =
+ List.map
+ (fun ld ->
+ let ty = ld.ld_type.ctyp_type in
+ let ty = match get_desc ty with Tpoly(t,[]) -> t | _ -> ty in
+ {Types.ld_id = ld.ld_id;
+ ld_mutable = ld.ld_mutable;
+ ld_type = ty;
+ ld_loc = ld.ld_loc;
+ ld_attributes = ld.ld_attributes;
+ ld_uid = ld.ld_uid;
+ }
+ )
+ lbls in
+ lbls, lbls'
+
+let transl_constructor_arguments env univars closed = function
+ | Pcstr_tuple l ->
+ let l = List.map (transl_simple_type env ?univars ~closed) l in
+ Types.Cstr_tuple (List.map (fun t -> t.ctyp_type) l),
+ Cstr_tuple l
+ | Pcstr_record l ->
+ let lbls, lbls' = transl_labels env univars closed l in
+ Types.Cstr_record lbls',
+ Cstr_record lbls
+
+let make_constructor env loc type_path type_params svars sargs sret_type =
+ match sret_type with
+ | None ->
+ let args, targs =
+ transl_constructor_arguments env None true sargs
+ in
+ targs, None, args, None
+ | Some sret_type ->
+ (* if it's a generalized constructor we must first narrow and
+ then widen so as to not introduce any new constraints *)
+ (* narrow and widen are now invoked through wrap_type_variable_scope *)
+ TyVarEnv.with_local_scope begin fun () ->
+ let closed = svars <> [] in
+ let targs, tret_type, args, ret_type, univars =
+ Ctype.with_local_level_generalize_if closed begin fun () ->
+ TyVarEnv.reset ();
+ let univar_list =
+ TyVarEnv.make_poly_univars (List.map (fun v -> v.txt) svars) in
+ let univars = if closed then Some univar_list else None in
+ let args, targs =
+ transl_constructor_arguments env univars closed sargs
+ in
+ let tret_type =
+ transl_simple_type env ?univars ~closed sret_type in
+ let ret_type = tret_type.ctyp_type in
+ (* TODO add back type_path as a parameter ? *)
+ begin match get_desc ret_type with
+ | Tconstr (p', _, _) when Path.same type_path p' -> ()
+ | _ ->
+ let trace =
+ (* Expansion is not helpful here -- the restriction on GADT
+ return types is purely syntactic. (In the worst case,
+ expansion produces gibberish.) *)
+ [Ctype.unexpanded_diff
+ ~got:ret_type
+ ~expected:(Ctype.newconstr type_path type_params)]
+ in
+ raise (Error(sret_type.ptyp_loc,
+ Constraint_failed(
+ env, Errortrace.unification_error ~trace)))
+ end;
+ (targs, tret_type, args, ret_type, univar_list)
+ end
+ in
+ if closed then begin
+ ignore (TyVarEnv.instance_poly_univars env loc univars);
+ let set_level t = Ctype.enforce_current_level env t in
+ Btype.iter_type_expr_cstr_args set_level args;
+ set_level ret_type
+ end;
+ targs, Some tret_type, args, Some ret_type
+ end
+
+
+let shape_map_labels =
+ List.fold_left (fun map { ld_id; ld_uid; _} ->
+ Shape.Map.add_label map ld_id ld_uid)
+ Shape.Map.empty
+
+let shape_map_cstrs =
+ List.fold_left (fun map { cd_id; cd_uid; cd_args; _ } ->
+ let cstr_shape_map =
+ let label_decls =
+ match cd_args with
+ | Cstr_tuple _ -> []
+ | Cstr_record ldecls -> ldecls
+ in
+ shape_map_labels label_decls
+ in
+ Shape.Map.add_constr map cd_id
+ @@ Shape.str ~uid:cd_uid cstr_shape_map)
+ (Shape.Map.empty)
+
+
+let transl_declaration env sdecl (id, uid) =
+ (* Bind type parameters *)
+ TyVarEnv.reset();
+ let tparams = make_params env sdecl.ptype_params in
+ let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
+ let cstrs = List.map
+ (fun (sty, sty', loc) ->
+ transl_simple_type env ~closed:false sty,
+ transl_simple_type env ~closed:false sty', loc)
+ sdecl.ptype_cstrs
+ in
+ let unboxed_attr = get_unboxed_from_attributes sdecl in
+ begin match unboxed_attr with
+ | (None | Some false) -> ()
+ | Some true ->
+ let bad msg = raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute msg)) in
+ match sdecl.ptype_kind with
+ | Ptype_abstract -> bad "it is abstract"
+ | Ptype_open -> bad "extensible variant types cannot be unboxed"
+ | Ptype_record fields -> begin match fields with
+ | [] -> bad "it has no fields"
+ | _::_::_ -> bad "it has more than one field"
+ | [{pld_mutable = Mutable}] -> bad "it is mutable"
+ | [{pld_mutable = Immutable}] -> ()
+ end
+ | Ptype_variant constructors -> begin match constructors with
+ | [] -> bad "it has no constructor"
+ | (_::_::_) -> bad "it has more than one constructor"
+ | [c] -> begin match c.pcd_args with
+ | Pcstr_tuple [] ->
+ bad "its constructor has no argument"
+ | Pcstr_tuple (_::_::_) ->
+ bad "its constructor has more than one argument"
+ | Pcstr_tuple [_] ->
+ ()
+ | Pcstr_record [] ->
+ bad "its constructor has no fields"
+ | Pcstr_record (_::_::_) ->
+ bad "its constructor has more than one field"
+ | Pcstr_record [{pld_mutable = Mutable}] ->
+ bad "it is mutable"
+ | Pcstr_record [{pld_mutable = Immutable}] ->
+ ()
+ end
+ end
+ end;
+ let unbox, unboxed_default =
+ match sdecl.ptype_kind with
+ | Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}]
+ | Ptype_variant [{pcd_args = Pcstr_record [{pld_mutable=Immutable; _}]; _}]
+ | Ptype_record [{pld_mutable=Immutable; _}] ->
+ Option.value unboxed_attr ~default:!Clflags.unboxed_types,
+ Option.is_none unboxed_attr
+ | _ -> false, false (* Not unboxable, mark as boxed *)
+ in
+ let (tkind, kind) =
+ match sdecl.ptype_kind with
+ | Ptype_abstract -> Ttype_abstract, Type_abstract Definition
+ | Ptype_variant scstrs ->
+ if List.exists (fun cstr -> cstr.pcd_res <> None) scstrs then begin
+ match cstrs with
+ [] -> ()
+ | (_,_,loc)::_ ->
+ Location.prerr_warning loc Warnings.Constraint_on_gadt
+ end;
+ let all_constrs = ref String.Set.empty in
+ List.iter
+ (fun {pcd_name = {txt = name}} ->
+ if String.Set.mem name !all_constrs then
+ raise(Error(sdecl.ptype_loc, Duplicate_constructor name));
+ all_constrs := String.Set.add name !all_constrs)
+ scstrs;
+ if List.length
+ (List.filter (fun cd -> cd.pcd_args <> Pcstr_tuple []) scstrs)
+ > (Config.max_tag + 1) then
+ raise(Error(sdecl.ptype_loc, Too_many_constructors));
+ let make_cstr scstr =
+ let name = Ident.create_local scstr.pcd_name.txt in
+ let targs, tret_type, args, ret_type =
+ make_constructor env scstr.pcd_loc (Path.Pident id) params
+ scstr.pcd_vars scstr.pcd_args scstr.pcd_res
+ in
+ let tcstr =
+ { cd_id = name;
+ cd_name = scstr.pcd_name;
+ cd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ cd_vars = scstr.pcd_vars;
+ cd_args = targs;
+ cd_res = tret_type;
+ cd_loc = scstr.pcd_loc;
+ cd_attributes = scstr.pcd_attributes }
+ in
+ let cstr =
+ { Types.cd_id = name;
+ cd_args = args;
+ cd_res = ret_type;
+ cd_loc = scstr.pcd_loc;
+ cd_attributes = scstr.pcd_attributes;
+ cd_uid = tcstr.cd_uid }
+ in
+ tcstr, cstr
+ in
+ let make_cstr scstr =
+ Builtin_attributes.warning_scope scstr.pcd_attributes
+ (fun () -> make_cstr scstr)
+ in
+ let rep = if unbox then Variant_unboxed else Variant_regular in
+ let tcstrs, cstrs = List.split (List.map make_cstr scstrs) in
+ Ttype_variant tcstrs, Type_variant (cstrs, rep)
+ | Ptype_record lbls ->
+ let lbls, lbls' = transl_labels env None true lbls in
+ let rep =
+ if unbox then Record_unboxed false
+ else if List.for_all (fun l -> is_float env l.Types.ld_type) lbls'
+ then Record_float
+ else Record_regular
+ in
+ Ttype_record lbls, Type_record(lbls', rep)
+ | Ptype_open -> Ttype_open, Type_open
+ in
+ begin
+ let (tman, man) = match sdecl.ptype_manifest with
+ None -> None, None
+ | Some sty ->
+ let no_row = not (is_fixed_type sdecl) in
+ let cty = transl_simple_type env ~closed:no_row sty in
+ Some cty, Some cty.ctyp_type
+ in
+ let arity = List.length params in
+ let decl =
+ { type_params = params;
+ type_arity = arity;
+ type_kind = kind;
+ type_private = sdecl.ptype_private;
+ type_manifest = man;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = sdecl.ptype_loc;
+ type_attributes = sdecl.ptype_attributes;
+ type_immediate = Unknown;
+ type_unboxed_default = unboxed_default;
+ type_uid = uid;
+ } in
+
+ (* Check constraints *)
+ List.iter
+ (fun (cty, cty', loc) ->
+ let ty = cty.ctyp_type in
+ let ty' = cty'.ctyp_type in
+ try Ctype.unify env ty ty' with Ctype.Unify err ->
+ raise(Error(loc, Inconsistent_constraint (env, err))))
+ cstrs;
+ (* Add abstract row *)
+ if is_fixed_type sdecl then begin
+ let p, _ =
+ try Env.find_type_by_name
+ (Longident.Lident(Ident.name id ^ "#row")) env
+ with Not_found -> assert false
+ in
+ set_private_row env sdecl.ptype_loc p decl
+ end;
+ let decl =
+ {
+ typ_id = id;
+ typ_name = sdecl.ptype_name;
+ typ_params = tparams;
+ typ_type = decl;
+ typ_cstrs = cstrs;
+ typ_loc = sdecl.ptype_loc;
+ typ_manifest = tman;
+ typ_kind = tkind;
+ typ_private = sdecl.ptype_private;
+ typ_attributes = sdecl.ptype_attributes;
+ }
+ in
+ let typ_shape =
+ let uid = decl.typ_type.type_uid in
+ match decl.typ_kind with
+ | Ttype_variant cstrs -> Shape.str ~uid (shape_map_cstrs cstrs)
+ | Ttype_record labels -> Shape.str ~uid (shape_map_labels labels)
+ | Ttype_abstract | Ttype_open -> Shape.leaf uid
+ in
+ decl, typ_shape
+ end
+
+(* Check that all constraints are enforced *)
+
+module TypeSet = Btype.TypeSet
+module TypeMap = Btype.TypeMap
+
+let rec check_constraints_rec env loc visited ty =
+ if TypeSet.mem ty !visited then () else begin
+ visited := TypeSet.add ty !visited;
+ match get_desc ty with
+ | Tconstr (path, args, _) ->
+ let decl =
+ try Env.find_type path env
+ with Not_found ->
+ raise (Error(loc, Unavailable_type_constructor path)) in
+ let ty' = Ctype.newconstr path (Ctype.instance_list decl.type_params) in
+ begin
+ (* We don't expand the error trace because that produces types that
+ *already* violate the constraints -- we need to report a problem with
+ the unexpanded types, or we get errors that talk about the same type
+ twice. This is generally true for constraint errors. *)
+ try Ctype.matches ~expand_error_trace:false env ty ty'
+ with Ctype.Matches_failure (env, err) ->
+ raise (Error(loc, Constraint_failed (env, err)))
+ end;
+ List.iter (check_constraints_rec env loc visited) args
+ | Tpoly (ty, tl) ->
+ let _, ty = Ctype.instance_poly ~fixed:false tl ty in
+ check_constraints_rec env loc visited ty
+ | _ ->
+ Btype.iter_type_expr (check_constraints_rec env loc visited) ty
+ end
+
+let check_constraints_labels env visited l pl =
+ let rec get_loc name = function
+ [] -> assert false
+ | pld :: tl ->
+ if name = pld.pld_name.txt then pld.pld_type.ptyp_loc
+ else get_loc name tl
+ in
+ List.iter
+ (fun {Types.ld_id=name; ld_type=ty} ->
+ check_constraints_rec env (get_loc (Ident.name name) pl) visited ty)
+ l
+
+let check_constraints env sdecl (_, decl) =
+ let visited = ref TypeSet.empty in
+ List.iter2
+ (fun (sty, _) ty -> check_constraints_rec env sty.ptyp_loc visited ty)
+ sdecl.ptype_params decl.type_params;
+ begin match decl.type_kind with
+ | Type_abstract _ -> ()
+ | Type_variant (l, _rep) ->
+ let find_pl = function
+ Ptype_variant pl -> pl
+ | Ptype_record _ | Ptype_abstract | Ptype_open -> assert false
+ in
+ let pl = find_pl sdecl.ptype_kind in
+ let pl_index =
+ let foldf acc x =
+ String.Map.add x.pcd_name.txt x acc
+ in
+ List.fold_left foldf String.Map.empty pl
+ in
+ List.iter
+ (fun {Types.cd_id=name; cd_args; cd_res} ->
+ let {pcd_args; pcd_res; _} =
+ try String.Map.find (Ident.name name) pl_index
+ with Not_found -> assert false in
+ begin match cd_args, pcd_args with
+ | Cstr_tuple tyl, Pcstr_tuple styl ->
+ List.iter2
+ (fun sty ty ->
+ check_constraints_rec env sty.ptyp_loc visited ty)
+ styl tyl
+ | Cstr_record tyl, Pcstr_record styl ->
+ check_constraints_labels env visited tyl styl
+ | _ -> assert false
+ end;
+ match pcd_res, cd_res with
+ | Some sr, Some r ->
+ check_constraints_rec env sr.ptyp_loc visited r
+ | _ ->
+ () )
+ l
+ | Type_record (l, _) ->
+ let find_pl = function
+ Ptype_record pl -> pl
+ | Ptype_variant _ | Ptype_abstract | Ptype_open -> assert false
+ in
+ let pl = find_pl sdecl.ptype_kind in
+ check_constraints_labels env visited l pl
+ | Type_open -> ()
+ end;
+ begin match decl.type_manifest with
+ | None -> ()
+ | Some ty ->
+ let sty =
+ match sdecl.ptype_manifest with Some sty -> sty | _ -> assert false
+ in
+ check_constraints_rec env sty.ptyp_loc visited ty
+ end
+
+(*
+ If both a variant/record definition and a type equation are given,
+ need to check that the equation refers to a type of the same kind
+ with the same constructors and labels.
+*)
+let check_coherence env loc dpath decl =
+ match decl with
+ { type_kind = (Type_variant _ | Type_record _| Type_open);
+ type_manifest = Some ty } ->
+ begin match get_desc ty with
+ Tconstr(path, args, _) ->
+ begin try
+ let decl' = Env.find_type path env in
+ let err =
+ if List.length args <> List.length decl.type_params
+ then Some Includecore.Arity
+ else begin
+ match Ctype.equal env false args decl.type_params with
+ | exception Ctype.Equality err ->
+ Some (Includecore.Constraint err)
+ | () ->
+ let subst =
+ Subst.Unsafe.add_type_path dpath path Subst.identity in
+ let decl =
+ match Subst.Unsafe.type_declaration subst decl with
+ | Ok decl -> decl
+ | Error (Fcm_type_substituted_away _) ->
+ (* no module type substitution in [subst] *)
+ assert false
+ in
+ Includecore.type_declarations ~loc ~equality:true env
+ ~mark:true
+ (Path.last path)
+ decl'
+ dpath
+ decl
+ end
+ in
+ if err <> None then
+ raise(Error(loc, Definition_mismatch (ty, env, err)))
+ with Not_found ->
+ raise(Error(loc, Unavailable_type_constructor path))
+ end
+ | _ -> raise(Error(loc, Definition_mismatch (ty, env, None)))
+ end
+ | _ -> ()
+
+let check_abbrev env sdecl (id, decl) =
+ check_coherence env sdecl.ptype_loc (Path.Pident id) decl
+
+
+(* Note: Well-foundedness for OCaml types
+
+ We want to guarantee that all cycles within OCaml types are
+ "guarded".
+
+ More precisely, we consider a reachability relation
+ "[t] is reachable [guarded|unguarded] from [u]"
+ defined as follows:
+
+ - [t1, t2...] are reachable guarded from object types
+ [< m1 : t1; m2 : t2; ... >]
+ or polymorphic variants
+ [[`A of t1 | `B of t2 | ...]].
+
+ - [t1, t2...] are reachable rectypes-guarded from
+ [t1 -> t2], [t1 * t2 * ...], and all other built-in
+ contractive type constructors.
+
+ (By rectypes-guarded we mean: guarded if -rectypes is set,
+ unguarded if it is not set.)
+
+ - If [(t1, t2...) c] is a datatype (variant or record),
+ then [t1, t2...] are reachable rectypes-guarded from it.
+
+ - If [(t1, t2...) c] is an abstract type,
+ then [t1, t2...] are reachable unguarded from it.
+
+ - If [(t1, t2...) c] is an (expandable) abbreviation,
+ then its expansion is reachable unguarded from it.
+ Note that we do not define [t1, t2...] as reachable.
+
+ - The relation is transitive and guardedness of a composition
+ is the disjunction of each guardedness:
+ if t1 is reachable from t2 and t2 is reachable from t3;
+ then t1 is reachable guarded from t3 if t1 is guarded in t2
+ or t2 is guarded in t3, and reachable unguarded otherwise.
+
+ A type [t] is not well-founded if and only if [t] is reachable
+ unguarded in [t].
+
+ Notice that, in the case of datatypes, the arguments of
+ a parametrized datatype are reachable (they must not contain
+ recursive occurrences of the type), but the definition of the
+ datatype is not defined as reachable.
+
+ (* well-founded *)
+ type t = Foo of u
+ and u = t
+
+ (* ill-founded *)
+ type 'a t = Foo of 'a
+ and u = u t
+ > Error: The type abbreviation u is cyclic
+
+ Indeed, in the second example [u] is reachable unguarded in [u t]
+ -- its own definition.
+*)
+
+(* Note: Forms of ill-foundedness
+
+ Several OCaml language constructs could introduce ill-founded
+ types, and there are several distinct checks that forbid different
+ sources of ill-foundedness.
+
+ 1. Type aliases.
+
+ (* well-founded *)
+ type t = < x : 'a > as 'a
+
+ (* ill-founded, unless -rectypes is used *)
+ type t = (int * 'a) as 'a
+ > Error: This alias is bound to type int * 'a
+ > but is used as an instance of type 'a
+ > The type variable 'a occurs inside int * 'a
+
+ Ill-foundedness coming from type aliases is detected by the "occur check"
+ used by our type unification algorithm. See typetexp.ml.
+
+ 2. Type abbreviations.
+
+ (* well-founded *)
+ type t = < x : t >
+
+ (* ill-founded, unless -rectypes is used *)
+ type t = (int * t)
+ > Error: The type abbreviation t is cyclic
+
+ Ill-foundedness coming from type abbreviations is detected by
+ [check_well_founded] below.
+
+ 3. Recursive modules.
+
+ (* well-founded *)
+ module rec M : sig type t = < x : M.t > end = M
+
+ (* ill-founded, unless -rectypes is used *)
+ module rec M : sig type t = int * M.t end = M
+ > Error: The definition of M.t contains a cycle:
+ > int * M.t
+
+ This is also checked by [check_well_founded] below,
+ as called from [check_recmod_typedecl].
+
+ 4. Functor application
+
+ A special case of (3) is that a type can be abstract
+ in a functor definition, and be instantiated with
+ an abbreviation in an application of the functor.
+ This can introduce ill-foundedness, so functor applications
+ must be checked by re-checking the type declarations of their result.
+
+ module type T = sig type t end
+ module Fix(F:(T -> T)) = struct
+ (* this recursive definition is well-founded
+ as F(Fixed).t contains no reachable type expression. *)
+ module rec Fixed : T with type t = F(Fixed).t = F(Fixed)
+ end
+
+ (* well-founded *)
+ Module M = Fix(functor (M:T) -> struct type t = < x : M.t > end)
+
+ (* ill-founded *)
+ module M = Fix(functor (M:T) -> struct type t = int * M.t end);;
+ > Error: In the signature of this functor application:
+ > The definition of Fixed.t contains a cycle:
+ > F(Fixed).t
+*)
+
+(* Check that a type expression is well-founded:
+ - if -rectypes is used, we must prevent non-contractive fixpoints
+ ('a as 'a)
+ - if -rectypes is not used, we only allow cycles in the type graph
+ if they go through an object or polymorphic variant type *)
+
+let check_well_founded ~abs_env env loc path to_check visited ty0 =
+ let rec check parents trace ty =
+ if TypeSet.mem ty parents then begin
+ (*Format.eprintf "@[%a@]@." Printtyp.raw_type_expr ty;*)
+ let err =
+ let reaching_path, rec_abbrev =
+ (* The reaching trace is accumulated in reverse order, we
+ reverse it to get a reaching path. *)
+ match trace with
+ | [] -> assert false
+ | Expands_to (ty1, _) :: trace when (match get_desc ty1 with
+ Tconstr (p,_,_) -> Path.same p path | _ -> false) ->
+ List.rev trace, true
+ | trace -> List.rev trace, false
+ in
+ if rec_abbrev
+ then Recursive_abbrev (Path.name path, abs_env, reaching_path)
+ else Cycle_in_def (Path.name path, abs_env, reaching_path)
+ in raise (Error (loc, err))
+ end;
+ let (fini, parents) =
+ try
+ (* Map each node to the set of its already checked parents *)
+ let prev = TypeMap.find ty !visited in
+ if TypeSet.subset parents prev then (true, parents) else
+ let parents = TypeSet.union parents prev in
+ visited := TypeMap.add ty parents !visited;
+ (false, parents)
+ with Not_found ->
+ visited := TypeMap.add ty parents !visited;
+ (false, parents)
+ in
+ if fini then () else
+ let rec_ok =
+ match get_desc ty with
+ | Tconstr(p,_,_) ->
+ !Clflags.recursive_types && Ctype.is_contractive env p
+ | Tobject _ | Tvariant _ -> true
+ | _ -> !Clflags.recursive_types
+ in
+ if rec_ok then () else
+ let parents = TypeSet.add ty parents in
+ match get_desc ty with
+ | Tconstr(p, tyl, _) ->
+ let to_check = to_check p in
+ if to_check then List.iter (check_subtype parents trace ty) tyl;
+ begin match Ctype.try_expand_once_opt env ty with
+ | ty' -> check parents (Expands_to (ty, ty') :: trace) ty'
+ | exception Ctype.Cannot_expand ->
+ if not to_check then List.iter (check_subtype parents trace ty) tyl
+ end
+ | _ ->
+ Btype.iter_type_expr (check_subtype parents trace ty) ty
+ and check_subtype parents trace outer_ty inner_ty =
+ check parents (Contains (outer_ty, inner_ty) :: trace) inner_ty
+ in
+ let snap = Btype.snapshot () in
+ try Ctype.wrap_trace_gadt_instances env (check TypeSet.empty []) ty0
+ with Ctype.Escape _ ->
+ (* Will be detected by check_regularity *)
+ Btype.backtrack snap
+
+let check_well_founded_manifest ~abs_env env loc path decl =
+ if decl.type_manifest = None then () else
+ let args = List.map (fun _ -> Ctype.newvar()) decl.type_params in
+ let visited = ref TypeMap.empty in
+ check_well_founded ~abs_env env loc path (Path.same path) visited
+ (Ctype.newconstr path args)
+
+(* Given a new type declaration [type t = ...] (potentially mutually-recursive),
+ we check that accepting the declaration does not introduce ill-founded types.
+
+ Note: we check that the types at the toplevel of the declaration
+ are not reachable unguarded from themselves, that is, we check that
+ there is no cycle going through the "root" of the declaration. But
+ we *also* check that all the type sub-expressions reachable from
+ the root even those that are guarded, are themselves
+ well-founded. (So we check the absence of cycles, even for cycles
+ going through inner type subexpressions but not the root.
+
+ We are not actually sure that this "deep check" is necessary
+ (we don't have an example at hand where it is necessary), but we
+ are doing it anyway out of caution.
+*)
+let check_well_founded_decl ~abs_env env loc path decl to_check =
+ let open Btype in
+ (* We iterate on all subexpressions of the declaration to check
+ "in depth" that no ill-founded type exists. *)
+ with_type_mark begin fun mark ->
+ let super = type_iterators mark in
+ let visited =
+ (* [visited] remembers the inner visits performed by
+ [check_well_founded] on each type expression reachable from
+ this declaration. This avoids unnecessary duplication of
+ [check_well_founded] work when invoked on two parts of the
+ type declaration that have common subexpressions. *)
+ ref TypeMap.empty in
+ let it =
+ {super with it_do_type_expr =
+ (fun self ty ->
+ check_well_founded ~abs_env env loc path to_check visited ty;
+ super.it_do_type_expr self ty
+ )} in
+ it.it_type_declaration it (Ctype.generic_instance_declaration decl)
+ end
+
+(* Check for non-regular abbreviations; an abbreviation
+ [type 'a t = ...] is non-regular if the expansion of [...]
+ contains instances [ty t] where [ty] is not equal to ['a].
+
+ Note: in the case of a constrained type definition
+ [type 'a t = ... constraint 'a = ...], we require
+ that all instances in [...] be equal to the constrained type.
+*)
+
+let check_regularity ~abs_env env loc path decl to_check =
+ (* to_check is true for potentially mutually recursive paths.
+ (path, decl) is the type declaration to be checked. *)
+
+ if decl.type_params = [] then () else
+
+ let visited = ref TypeSet.empty in
+
+ let rec check_regular cpath args prev_exp trace ty =
+ if not (TypeSet.mem ty !visited) then begin
+ visited := TypeSet.add ty !visited;
+ match get_desc ty with
+ | Tconstr(path', args', _) ->
+ if Path.same path path' then begin
+ if not (Ctype.is_equal abs_env false args args') then
+ raise (Error(loc,
+ Non_regular {
+ definition=path;
+ used_as=ty;
+ defined_as=Ctype.newconstr path args;
+ reaching_path=List.rev trace;
+ }))
+ end
+ (* Attempt to expand a type abbreviation if:
+ 1- [to_check path'] holds
+ (otherwise the expansion cannot involve [path]);
+ 2- we haven't expanded this type constructor before
+ (otherwise we could loop if [path'] is itself
+ a non-regular abbreviation). *)
+ else if to_check path' && not (List.mem path' prev_exp) then begin
+ try
+ (* Attempt expansion *)
+ let (params0, body0, _) = Env.find_type_expansion path' env in
+ let (params, body) =
+ Ctype.instance_parameterized_type params0 body0 in
+ begin
+ try List.iter2 (Ctype.unify abs_env) args' params
+ with Ctype.Unify err ->
+ raise (Error(loc, Constraint_failed (abs_env, err)));
+ end;
+ check_regular path' args
+ (path' :: prev_exp) (Expands_to (ty,body) :: trace)
+ body
+ with Not_found -> ()
+ end;
+ List.iter (check_subtype cpath args prev_exp trace ty) args'
+ | Tpoly (ty, tl) ->
+ let (_, ty) =
+ Ctype.instance_poly ~keep_names:true ~fixed:false tl ty in
+ check_regular cpath args prev_exp trace ty
+ | _ ->
+ Btype.iter_type_expr
+ (check_subtype cpath args prev_exp trace ty) ty
+ end
+ and check_subtype cpath args prev_exp trace outer_ty inner_ty =
+ let trace = Contains (outer_ty, inner_ty) :: trace in
+ check_regular cpath args prev_exp trace inner_ty
+ in
+
+ Option.iter
+ (fun body ->
+ let (args, body) =
+ Ctype.instance_parameterized_type
+ ~keep_names:true decl.type_params body in
+ List.iter (check_regular path args [] []) args;
+ check_regular path args [] [] body)
+ decl.type_manifest
+
+let check_abbrev_regularity ~abs_env env id_loc_list to_check tdecl =
+ let decl = tdecl.typ_type in
+ let id = tdecl.typ_id in
+ check_regularity ~abs_env env (List.assoc id id_loc_list) (Path.Pident id)
+ decl to_check
+
+let check_duplicates sdecl_list =
+ let labels = Hashtbl.create 7 and constrs = Hashtbl.create 7 in
+ List.iter
+ (fun sdecl -> match sdecl.ptype_kind with
+ Ptype_variant cl ->
+ List.iter
+ (fun pcd ->
+ try
+ let name' = Hashtbl.find constrs pcd.pcd_name.txt in
+ Location.prerr_warning pcd.pcd_loc
+ (Warnings.Duplicate_definitions
+ ("constructor", pcd.pcd_name.txt, name',
+ sdecl.ptype_name.txt))
+ with Not_found ->
+ Hashtbl.add constrs pcd.pcd_name.txt sdecl.ptype_name.txt)
+ cl
+ | Ptype_record fl ->
+ List.iter
+ (fun {pld_name=cname;pld_loc=loc} ->
+ try
+ let name' = Hashtbl.find labels cname.txt in
+ Location.prerr_warning loc
+ (Warnings.Duplicate_definitions
+ ("label", cname.txt, name', sdecl.ptype_name.txt))
+ with Not_found -> Hashtbl.add labels cname.txt sdecl.ptype_name.txt)
+ fl
+ | Ptype_abstract -> ()
+ | Ptype_open -> ())
+ sdecl_list
+
+(* Force recursion to go through id for private types*)
+let name_recursion sdecl id decl =
+ match decl with
+ | { type_kind = Type_abstract _;
+ type_manifest = Some ty;
+ type_private = Private; } when is_fixed_type sdecl ->
+ let ty' = Btype.newty2 ~level:(get_level ty) (get_desc ty) in
+ if Ctype.deep_occur ty ty' then
+ let td = Tconstr(Path.Pident id, decl.type_params, ref Mnil) in
+ link_type ty (Btype.newty2 ~level:(get_level ty) td);
+ {decl with type_manifest = Some ty'}
+ else decl
+ | _ -> decl
+
+let name_recursion_decls sdecls decls =
+ List.map2 (fun sdecl (id, decl) -> (id, name_recursion sdecl id decl))
+ sdecls decls
+
+(* Warn on definitions of type "type foo = ()" which redefine a different unit
+ type and are likely a mistake. *)
+let check_redefined_unit (td: Parsetree.type_declaration) =
+ let open Parsetree in
+ let is_unit_constructor cd = cd.pcd_name.txt = "()" in
+ match td with
+ | { ptype_name = { txt = name };
+ ptype_manifest = None;
+ ptype_kind = Ptype_variant [ cd ] }
+ when is_unit_constructor cd ->
+ Location.prerr_warning td.ptype_loc (Warnings.Redefining_unit name)
+ | _ ->
+ ()
+
+(* Update a temporary definition to share recursion *)
+let update_type temp_env env id loc =
+ let path = Path.Pident id in
+ let decl = Env.find_type path temp_env in
+ match decl.type_manifest with None -> ()
+ | Some ty ->
+ (* Since this function is called after generalizing declarations,
+ ty is at the generic level. Since we need to keep possible
+ sharings in recursive type definitions, unify without instantiating,
+ but generalize again after unification. *)
+ Ctype.with_local_level_generalize begin fun () ->
+ let params = List.map (fun _ -> Ctype.newvar ()) decl.type_params in
+ try Ctype.unify env (Ctype.newconstr path params) ty
+ with Ctype.Unify err ->
+ raise (Error(loc, Type_clash (env, err)))
+ end
+
+let add_types_to_env decls shapes env =
+ List.fold_right2
+ (fun (id, decl) shape env ->
+ add_type ~check:true ~shape id decl env)
+ decls shapes env
+
+(* Translate a set of type declarations, mutually recursive or not *)
+let transl_type_decl env rec_flag sdecl_list =
+ List.iter check_redefined_unit sdecl_list;
+ (* Add dummy types for fixed rows *)
+ let fixed_types = List.filter is_fixed_type sdecl_list in
+ let sdecl_list =
+ List.map
+ (fun sdecl ->
+ let ptype_name =
+ let loc = { sdecl.ptype_name.loc with Location.loc_ghost = true } in
+ mkloc (sdecl.ptype_name.txt ^"#row") loc
+ in
+ let ptype_kind = Ptype_abstract in
+ let ptype_manifest = None in
+ let ptype_loc = { sdecl.ptype_loc with Location.loc_ghost = true } in
+ {sdecl with
+ ptype_name; ptype_kind; ptype_manifest; ptype_loc })
+ fixed_types
+ @ sdecl_list
+ in
+
+ (* Create identifiers. *)
+ let scope = Ctype.create_scope () in
+ let ids_list =
+ List.map (fun sdecl ->
+ Ident.create_scoped ~scope sdecl.ptype_name.txt,
+ Uid.mk ~current_unit:(Env.get_current_unit ())
+ ) sdecl_list
+ in
+ (* Translate declarations, using a temporary environment where abbreviations
+ expand to a generic type variable. After that, we check the coherence of
+ the translated declarations in the resulting new environment. *)
+ let tdecls, decls, shapes, temp_env, new_env =
+ Ctype.with_local_level_generalize begin fun () ->
+ (* Enter types. *)
+ let temp_env =
+ List.fold_left2 (enter_type rec_flag) env sdecl_list ids_list in
+ (* Translate each declaration. *)
+ let current_slot = ref None in
+ let warn_unused =
+ Warnings.is_active (Warnings.Unused_type_declaration "") in
+ let ids_slots (id, _uid as ids) =
+ match rec_flag with
+ | Asttypes.Recursive when warn_unused ->
+ (* See typecore.ml for a description of the algorithm used to
+ detect unused declarations in a set of recursive definitions. *)
+ let slot = ref [] in
+ let td = Env.find_type (Path.Pident id) temp_env in
+ Env.set_type_used_callback
+ td
+ (fun old_callback ->
+ match !current_slot with
+ | Some slot -> slot := td.type_uid :: !slot
+ | None ->
+ List.iter Env.mark_type_used (get_ref slot);
+ old_callback ()
+ );
+ ids, Some slot
+ | Asttypes.Recursive | Asttypes.Nonrecursive ->
+ ids, None
+ in
+ let transl_declaration name_sdecl (id, slot) =
+ current_slot := slot;
+ Builtin_attributes.warning_scope
+ name_sdecl.ptype_attributes
+ (fun () -> transl_declaration temp_env name_sdecl id)
+ in
+ let tdecls =
+ List.map2 transl_declaration sdecl_list (List.map ids_slots ids_list) in
+ let decls, shapes =
+ List.map (fun (tdecl, shape) ->
+ (tdecl.typ_id, tdecl.typ_type), shape) tdecls
+ |> List.split
+ in
+ current_slot := None;
+ (* Check for duplicates *)
+ check_duplicates sdecl_list;
+ (* Build the final env. *)
+ let new_env = add_types_to_env decls shapes env in
+ (tdecls, decls, shapes, temp_env, new_env)
+ end
+ in
+ (* Check for ill-formed abbrevs *)
+ let id_loc_list =
+ List.map2 (fun (id, _) sdecl -> (id, sdecl.ptype_loc))
+ ids_list sdecl_list
+ in
+ (* [check_abbrev_regularity] and error messages cannot use the new
+ environment, as this might result in non-termination. Instead we use a
+ completely abstract version of the temporary environment, giving a reason
+ for why abbreviations cannot be expanded (#12334, #12368) *)
+ let abs_env =
+ List.fold_left2
+ (enter_type ~abstract_abbrevs:Rec_check_regularity rec_flag)
+ env sdecl_list ids_list in
+ List.iter (fun (id, decl) ->
+ check_well_founded_manifest ~abs_env new_env (List.assoc id id_loc_list)
+ (Path.Pident id) decl)
+ decls;
+ let to_check =
+ function Path.Pident id -> List.mem_assoc id id_loc_list | _ -> false in
+ List.iter (fun (id, decl) ->
+ check_well_founded_decl ~abs_env new_env (List.assoc id id_loc_list)
+ (Path.Pident id)
+ decl to_check)
+ decls;
+ List.iter (fun (tdecl, _shape) ->
+ check_abbrev_regularity ~abs_env new_env id_loc_list to_check tdecl)
+ tdecls;
+ (* Update temporary definitions (for well-founded recursive types) *)
+ begin match rec_flag with
+ | Asttypes.Nonrecursive -> ()
+ | Asttypes.Recursive ->
+ List.iter2
+ (fun (id, _) sdecl ->
+ update_type temp_env new_env id sdecl.ptype_loc)
+ ids_list sdecl_list
+ end;
+ (* Check that all type variables are closed *)
+ List.iter2
+ (fun sdecl (tdecl, _shape) ->
+ let decl = tdecl.typ_type in
+ match Ctype.closed_type_decl decl with
+ Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
+ | None -> ())
+ sdecl_list tdecls;
+ (* Check that constraints are enforced *)
+ List.iter2 (check_constraints new_env) sdecl_list decls;
+ (* Add type properties to declarations *)
+ let decls =
+ try
+ decls
+ |> name_recursion_decls sdecl_list
+ |> Typedecl_variance.update_decls env sdecl_list
+ |> Typedecl_immediacy.update_decls env
+ |> Typedecl_separability.update_decls env
+ with
+ | Typedecl_variance.Error (loc, err) ->
+ raise (Error (loc, Variance err))
+ | Typedecl_immediacy.Error (loc, err) ->
+ raise (Error (loc, Immediacy err))
+ | Typedecl_separability.Error (loc, err) ->
+ raise (Error (loc, Separability err))
+ in
+ (* Compute the final environment with variance and immediacy *)
+ let final_env = add_types_to_env decls shapes env in
+ (* Check re-exportation *)
+ List.iter2 (check_abbrev final_env) sdecl_list decls;
+ (* Keep original declaration *)
+ let final_decls =
+ List.map2
+ (fun (tdecl, _shape) (_id2, decl) ->
+ { tdecl with typ_type = decl }
+ ) tdecls decls
+ in
+ (* Done *)
+ (final_decls, final_env, shapes)
+
+(* Translating type extensions *)
+
+let transl_extension_constructor ~scope env type_path type_params
+ typext_params priv sext =
+ let id = Ident.create_scoped ~scope sext.pext_name.txt in
+ let args, ret_type, kind =
+ match sext.pext_kind with
+ Pext_decl(svars, sargs, sret_type) ->
+ let targs, tret_type, args, ret_type =
+ make_constructor env sext.pext_loc type_path typext_params
+ svars sargs sret_type
+ in
+ args, ret_type, Text_decl(svars, targs, tret_type)
+ | Pext_rebind lid ->
+ let usage : Env.constructor_usage =
+ if priv = Public then Env.Exported else Env.Exported_private
+ in
+ let cdescr = Env.lookup_constructor ~loc:lid.loc usage lid.txt env in
+ let (args, cstr_res, _ex) =
+ Ctype.instance_constructor Keep_existentials_flexible cdescr
+ in
+ let res, ret_type =
+ if cdescr.cstr_generalized then
+ let params = Ctype.instance_list type_params in
+ let res = Ctype.newconstr type_path params in
+ let ret_type = Some (Ctype.newconstr type_path params) in
+ res, ret_type
+ else (Ctype.newconstr type_path typext_params), None
+ in
+ begin
+ try
+ Ctype.unify env cstr_res res
+ with Ctype.Unify err ->
+ raise (Error(lid.loc,
+ Rebind_wrong_type(lid.txt, env, err)))
+ end;
+ (* Remove "_" names from parameters used in the constructor *)
+ if not cdescr.cstr_generalized then begin
+ let vars =
+ Ctype.free_variables (Btype.newgenty (Ttuple args))
+ in
+ List.iter
+ (fun ty ->
+ if get_desc ty = Tvar (Some "_")
+ && List.exists (eq_type ty) vars
+ then set_type_desc ty (Tvar None))
+ typext_params
+ end;
+ (* Ensure that constructor's type matches the type being extended *)
+ let cstr_type_path = Btype.cstr_type_path cdescr in
+ let cstr_type_params = (Env.find_type cstr_type_path env).type_params in
+ let cstr_types =
+ (Btype.newgenty
+ (Tconstr(cstr_type_path, cstr_type_params, ref Mnil)))
+ :: cstr_type_params
+ in
+ let ext_types =
+ (Btype.newgenty
+ (Tconstr(type_path, type_params, ref Mnil)))
+ :: type_params
+ in
+ if not (Ctype.is_equal env true cstr_types ext_types) then
+ raise (Error(lid.loc,
+ Rebind_mismatch(lid.txt, cstr_type_path, type_path)));
+ (* Disallow rebinding private constructors to non-private *)
+ begin
+ match cdescr.cstr_private, priv with
+ Private, Public ->
+ raise (Error(lid.loc, Rebind_private lid.txt))
+ | _ -> ()
+ end;
+ let path =
+ match cdescr.cstr_tag with
+ Cstr_extension(path, _) -> path
+ | _ -> assert false
+ in
+ let args =
+ match cdescr.cstr_inlined with
+ | None ->
+ Types.Cstr_tuple args
+ | Some decl ->
+ let tl =
+ match List.map get_desc args with
+ | [ Tconstr(_, tl, _) ] -> tl
+ | _ -> assert false
+ in
+ let decl = Ctype.instance_declaration decl in
+ assert (List.length decl.type_params = List.length tl);
+ List.iter2 (Ctype.unify env) decl.type_params tl;
+ let lbls =
+ match decl.type_kind with
+ | Type_record (lbls, Record_extension _) -> lbls
+ | _ -> assert false
+ in
+ Types.Cstr_record lbls
+ in
+ args, ret_type, Text_rebind(path, lid)
+ in
+ let ext =
+ { ext_type_path = type_path;
+ ext_type_params = typext_params;
+ ext_args = args;
+ ext_ret_type = ret_type;
+ ext_private = priv;
+ Types.ext_loc = sext.pext_loc;
+ Types.ext_attributes = sext.pext_attributes;
+ ext_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ let ext_cstrs =
+ { ext_id = id;
+ ext_name = sext.pext_name;
+ ext_type = ext;
+ ext_kind = kind;
+ Typedtree.ext_loc = sext.pext_loc;
+ Typedtree.ext_attributes = sext.pext_attributes; }
+ in
+ let shape =
+ let map = match ext_cstrs.ext_kind with
+ | Text_decl (_, Cstr_record lbls, _) -> shape_map_labels lbls
+ | _ -> Shape.Map.empty
+ in
+ Shape.str ~uid:ext_cstrs.ext_type.ext_uid map
+ in
+ ext_cstrs, shape
+
+let transl_extension_constructor ~scope env type_path type_params
+ typext_params priv sext =
+ Builtin_attributes.warning_scope sext.pext_attributes
+ (fun () -> transl_extension_constructor ~scope env type_path type_params
+ typext_params priv sext)
+
+let is_rebind ext =
+ match ext.ext_kind with
+ | Text_rebind _ -> true
+ | Text_decl _ -> false
+
+let transl_type_extension extend env loc styext =
+ let type_path, type_decl =
+ let lid = styext.ptyext_path in
+ Env.lookup_type ~loc:lid.loc lid.txt env
+ in
+ begin
+ match type_decl.type_kind with
+ | Type_open -> begin
+ match type_decl.type_private with
+ | Private when extend -> begin
+ match
+ List.find
+ (function {pext_kind = Pext_decl _} -> true
+ | {pext_kind = Pext_rebind _} -> false)
+ styext.ptyext_constructors
+ with
+ | {pext_loc} ->
+ raise (Error(pext_loc, Cannot_extend_private_type type_path))
+ | exception Not_found -> ()
+ end
+ | _ -> ()
+ end
+ | _ ->
+ raise (Error(loc, Not_extensible_type type_path))
+ end;
+ let type_variance =
+ List.map (fun v ->
+ let (co, cn) = Variance.get_upper v in
+ (not cn, not co, false))
+ type_decl.type_variance
+ in
+ let err =
+ if type_decl.type_arity <> List.length styext.ptyext_params then
+ Some Includecore.Arity
+ else
+ if List.for_all2
+ (fun (c1, n1, _) (c2, n2, _) -> (not c2 || c1) && (not n2 || n1))
+ type_variance
+ (Typedecl_variance.variance_of_params styext.ptyext_params)
+ then None else Some Includecore.Variance
+ in
+ begin match err with
+ | None -> ()
+ | Some err -> raise (Error(loc, Extension_mismatch (type_path, env, err)))
+ end;
+ let ttype_params, _type_params, constructors =
+ (* Note: it would be incorrect to call [create_scope] *after*
+ [TyVarEnv.reset] or after [with_local_level] (see #10010). *)
+ let scope = Ctype.create_scope () in
+ Ctype.with_local_level_generalize begin fun () ->
+ TyVarEnv.reset();
+ let ttype_params = make_params env styext.ptyext_params in
+ let type_params = List.map (fun (cty, _) -> cty.ctyp_type) ttype_params in
+ List.iter2 (Ctype.unify_var env)
+ (Ctype.instance_list type_decl.type_params)
+ type_params;
+ let constructors =
+ List.map (transl_extension_constructor ~scope env type_path
+ type_decl.type_params type_params styext.ptyext_private)
+ styext.ptyext_constructors
+ in
+ (ttype_params, type_params, constructors)
+ end
+ in
+ (* Check that all type variables are closed *)
+ List.iter
+ (fun (ext, _shape) ->
+ match Ctype.closed_extension_constructor ext.ext_type with
+ Some ty ->
+ raise(Error(ext.ext_loc, Unbound_type_var_ext(ty, ext.ext_type)))
+ | None -> ())
+ constructors;
+ (* Check variances are correct *)
+ List.iter
+ (fun (ext, _shape) ->
+ (* Note that [loc] here is distinct from [type_decl.type_loc], which
+ makes the [loc] parameter to this function useful. [loc] is the
+ location of the extension, while [type_decl] points to the original
+ type declaration being extended. *)
+ try Typedecl_variance.check_variance_extension
+ env type_decl ext (type_variance, loc)
+ with Typedecl_variance.Error (loc, err) ->
+ raise (Error (loc, Variance err)))
+ constructors;
+ (* Add extension constructors to the environment *)
+ let newenv =
+ List.fold_left
+ (fun env (ext, shape) ->
+ let rebind = is_rebind ext in
+ Env.add_extension ~check:true ~shape ~rebind
+ ext.ext_id ext.ext_type env)
+ env constructors
+ in
+ let constructors, shapes = List.split constructors in
+ let tyext =
+ { tyext_path = type_path;
+ tyext_txt = styext.ptyext_path;
+ tyext_params = ttype_params;
+ tyext_constructors = constructors;
+ tyext_private = styext.ptyext_private;
+ tyext_loc = styext.ptyext_loc;
+ tyext_attributes = styext.ptyext_attributes; }
+ in
+ (tyext, newenv, shapes)
+
+let transl_type_extension extend env loc styext =
+ Builtin_attributes.warning_scope styext.ptyext_attributes
+ (fun () -> transl_type_extension extend env loc styext)
+
+let transl_exception env sext =
+ let ext, shape =
+ let scope = Ctype.create_scope () in
+ Ctype.with_local_level_generalize
+ (fun () ->
+ TyVarEnv.reset();
+ transl_extension_constructor ~scope env
+ Predef.path_exn [] [] Asttypes.Public sext)
+ in
+ (* Check that all type variables are closed *)
+ begin match Ctype.closed_extension_constructor ext.ext_type with
+ Some ty ->
+ raise (Error(ext.ext_loc, Unbound_type_var_ext(ty, ext.ext_type)))
+ | None -> ()
+ end;
+ let rebind = is_rebind ext in
+ let newenv =
+ Env.add_extension ~check:true ~shape ~rebind ext.ext_id ext.ext_type env
+ in
+ ext, newenv, shape
+
+let transl_type_exception env t =
+ let contructor, newenv, shape =
+ Builtin_attributes.warning_scope t.ptyexn_attributes
+ (fun () ->
+ transl_exception env t.ptyexn_constructor
+ )
+ in
+ {tyexn_constructor = contructor;
+ tyexn_loc = t.ptyexn_loc;
+ tyexn_attributes = t.ptyexn_attributes}, newenv, shape
+
+
+type native_repr_attribute =
+ | Native_repr_attr_absent
+ | Native_repr_attr_present of native_repr_kind
+
+let get_native_repr_attribute attrs ~global_repr =
+ match
+ Attr_helper.get_no_payload_attribute "unboxed" attrs,
+ Attr_helper.get_no_payload_attribute "untagged" attrs,
+ global_repr
+ with
+ | None, None, None -> Native_repr_attr_absent
+ | None, None, Some repr -> Native_repr_attr_present repr
+ | Some _, None, None -> Native_repr_attr_present Unboxed
+ | None, Some _, None -> Native_repr_attr_present Untagged
+ | Some { Location.loc }, _, _
+ | _, Some { Location.loc }, _ ->
+ raise (Error (loc, Multiple_native_repr_attributes))
+
+let native_repr_of_type env kind ty =
+ match kind, get_desc (Ctype.expand_head_opt env ty) with
+ | Untagged, Tconstr (_, _, _) when
+ Typeopt.maybe_pointer_type env ty = Lambda.Immediate ->
+ Some Untagged_immediate
+ | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_float ->
+ Some Unboxed_float
+ | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_int32 ->
+ Some (Unboxed_integer Pint32)
+ | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_int64 ->
+ Some (Unboxed_integer Pint64)
+ | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_nativeint ->
+ Some (Unboxed_integer Pnativeint)
+ | _ ->
+ None
+
+(* Raises an error when [core_type] contains an [@unboxed] or [@untagged]
+ attribute in a strict sub-term. *)
+let error_if_has_deep_native_repr_attributes core_type =
+ let open Ast_iterator in
+ let this_iterator =
+ { default_iterator with typ = fun iterator core_type ->
+ begin
+ match
+ get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None
+ with
+ | Native_repr_attr_present kind ->
+ raise (Error (core_type.ptyp_loc,
+ Deep_unbox_or_untag_attribute kind))
+ | Native_repr_attr_absent -> ()
+ end;
+ default_iterator.typ iterator core_type }
+ in
+ default_iterator.typ this_iterator core_type
+
+let make_native_repr env core_type ty ~global_repr =
+ error_if_has_deep_native_repr_attributes core_type;
+ match get_native_repr_attribute core_type.ptyp_attributes ~global_repr with
+ | Native_repr_attr_absent ->
+ Same_as_ocaml_repr
+ | Native_repr_attr_present kind ->
+ begin match native_repr_of_type env kind ty with
+ | None ->
+ raise (Error (core_type.ptyp_loc, Cannot_unbox_or_untag_type kind))
+ | Some repr -> repr
+ end
+
+let rec parse_native_repr_attributes env core_type ty ~global_repr =
+ match core_type.ptyp_desc, get_desc ty,
+ get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None
+ with
+ | Ptyp_arrow _, Tarrow _, Native_repr_attr_present kind ->
+ raise (Error (core_type.ptyp_loc, Cannot_unbox_or_untag_type kind))
+ | Ptyp_arrow (_, ct1, ct2), Tarrow (_, t1, t2, _), _ ->
+ let repr_arg = make_native_repr env ct1 t1 ~global_repr in
+ let repr_args, repr_res =
+ parse_native_repr_attributes env ct2 t2 ~global_repr
+ in
+ (repr_arg :: repr_args, repr_res)
+ | (Ptyp_poly (_, t) | Ptyp_alias (t, _)), _, _ ->
+ parse_native_repr_attributes env t ty ~global_repr
+ | Ptyp_arrow _, _, _ | _, Tarrow _, _ -> assert false
+ | _ -> ([], make_native_repr env core_type ty ~global_repr)
+
+
+let check_unboxable env loc ty =
+ let check_type acc ty : Path.Set.t =
+ let ty = Ctype.expand_head_opt env ty in
+ try match get_desc ty with
+ | Tconstr (p, _, _) ->
+ let tydecl = Env.find_type p env in
+ if tydecl.type_unboxed_default then
+ Path.Set.add p acc
+ else acc
+ | _ -> acc
+ with Not_found -> acc
+ in
+ let all_unboxable_types = Btype.fold_type_expr check_type Path.Set.empty ty in
+ Path.Set.fold
+ (fun p () ->
+ Location.prerr_warning loc
+ (Warnings.Unboxable_type_in_prim_decl (Path.name p))
+ )
+ all_unboxable_types
+ ()
+
+(* Translate a value declaration *)
+let transl_value_decl env loc valdecl =
+ let cty = Typetexp.transl_type_scheme env valdecl.pval_type in
+ let ty = cty.ctyp_type in
+ let v =
+ match valdecl.pval_prim with
+ [] when Env.is_in_signature env ->
+ { val_type = ty; val_kind = Val_reg; Types.val_loc = loc;
+ val_attributes = valdecl.pval_attributes;
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ | [] ->
+ raise (Error(valdecl.pval_loc, Val_in_structure))
+ | _ ->
+ let global_repr =
+ match
+ get_native_repr_attribute valdecl.pval_attributes ~global_repr:None
+ with
+ | Native_repr_attr_present repr -> Some repr
+ | Native_repr_attr_absent -> None
+ in
+ let native_repr_args, native_repr_res =
+ parse_native_repr_attributes env valdecl.pval_type ty ~global_repr
+ in
+ let prim =
+ Primitive.parse_declaration valdecl
+ ~native_repr_args
+ ~native_repr_res
+ in
+ if prim.prim_arity = 0 &&
+ (prim.prim_name = "" || prim.prim_name.[0] <> '%') then
+ raise(Error(valdecl.pval_type.ptyp_loc, Null_arity_external));
+ if !Clflags.native_code
+ && prim.prim_arity > 5
+ && prim.prim_native_name = ""
+ then raise(Error(valdecl.pval_type.ptyp_loc, Missing_native_external));
+ check_unboxable env loc ty;
+ { val_type = ty; val_kind = Val_prim prim; Types.val_loc = loc;
+ val_attributes = valdecl.pval_attributes;
+ val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ let (id, newenv) =
+ Env.enter_value valdecl.pval_name.txt v env
+ ~check:(fun s -> Warnings.Unused_value_declaration s)
+ in
+ let desc =
+ {
+ val_id = id;
+ val_name = valdecl.pval_name;
+ val_desc = cty; val_val = v;
+ val_prim = valdecl.pval_prim;
+ val_loc = valdecl.pval_loc;
+ val_attributes = valdecl.pval_attributes;
+ }
+ in
+ desc, newenv
+
+let transl_value_decl env loc valdecl =
+ Builtin_attributes.warning_scope valdecl.pval_attributes
+ (fun () -> transl_value_decl env loc valdecl)
+
+(* Translate a "with" constraint -- much simplified version of
+ transl_type_decl. For a constraint [Sig with t = sdecl],
+ there are two declarations of interest in two environments:
+ - [sig_decl] is the declaration of [t] in [Sig],
+ in the environment [sig_env] (containing the declarations
+ of [Sig] before [t])
+ - [sdecl] is the new syntactic declaration, to be type-checked
+ in the current, outer environment [with_env].
+
+ In particular, note that [sig_env] is an extension of
+ [outer_env].
+*)
+let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
+ sdecl =
+ Env.mark_type_used sig_decl.type_uid;
+ Ctype.with_local_level_generalize begin fun () ->
+ TyVarEnv.reset();
+ (* In the first part of this function, we typecheck the syntactic
+ declaration [sdecl] in the outer environment [outer_env]. *)
+ let env = outer_env in
+ let loc = sdecl.ptype_loc in
+ let tparams = make_params env sdecl.ptype_params in
+ let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
+ let arity = List.length params in
+ let constraints =
+ List.map (fun (ty, ty', loc) ->
+ let cty = transl_simple_type env ~closed:false ty in
+ let cty' = transl_simple_type env ~closed:false ty' in
+ (* Note: We delay the unification of those constraints
+ after the unification of parameters, so that clashing
+ constraints report an error on the constraint location
+ rather than the parameter location. *)
+ (cty, cty', loc)
+ ) sdecl.ptype_cstrs
+ in
+ let no_row = not (is_fixed_type sdecl) in
+ let (tman, man) = match sdecl.ptype_manifest with
+ None -> Misc.fatal_error "Typedecl.transl_with_constraint: no manifest"
+ | Some sty ->
+ let cty = transl_simple_type env ~closed:no_row sty in
+ cty, cty.ctyp_type
+ in
+ (* In the second part, we check the consistency between the two
+ declarations and compute a "merged" declaration; we now need to
+ work in the larger signature environment [sig_env], because
+ [sig_decl.type_params] and [sig_decl.type_kind] are only valid
+ there. *)
+ let env = sig_env in
+ let sig_decl = Ctype.instance_declaration sig_decl in
+ let arity_ok = arity = sig_decl.type_arity in
+ if arity_ok then
+ List.iter2 (fun (cty, _) tparam ->
+ try Ctype.unify_var env cty.ctyp_type tparam
+ with Ctype.Unify err ->
+ raise(Error(cty.ctyp_loc, Inconsistent_constraint (env, err)))
+ ) tparams sig_decl.type_params;
+ List.iter (fun (cty, cty', loc) ->
+ (* Note: constraints must also be enforced in [sig_env] because
+ they may contain parameter variables from [tparams]
+ that have now be unified in [sig_env]. *)
+ try Ctype.unify env cty.ctyp_type cty'.ctyp_type
+ with Ctype.Unify err ->
+ raise(Error(loc, Inconsistent_constraint (env, err)))
+ ) constraints;
+ let sig_decl_abstract = Btype.type_kind_is_abstract sig_decl in
+ let priv =
+ if sdecl.ptype_private = Private then Private else
+ if arity_ok && not sig_decl_abstract
+ then sig_decl.type_private else sdecl.ptype_private
+ in
+ if arity_ok && not sig_decl_abstract
+ && sdecl.ptype_private = Private then
+ Location.deprecated loc "spurious use of private";
+ let type_kind, type_unboxed_default =
+ if arity_ok then
+ sig_decl.type_kind, sig_decl.type_unboxed_default
+ else
+ Type_abstract Definition, false
+ in
+ let new_sig_decl =
+ { type_params = params;
+ type_arity = arity;
+ type_kind;
+ type_private = priv;
+ type_manifest = Some man;
+ type_variance = [];
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = loc;
+ type_attributes = sdecl.ptype_attributes;
+ type_immediate = Unknown;
+ type_unboxed_default;
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ Option.iter (fun p -> set_private_row env sdecl.ptype_loc p new_sig_decl)
+ fixed_row_path;
+ begin match Ctype.closed_type_decl new_sig_decl with None -> ()
+ | Some ty -> raise(Error(loc, Unbound_type_var(ty, new_sig_decl)))
+ end;
+ let new_sig_decl = name_recursion sdecl id new_sig_decl in
+ let new_type_variance =
+ let required = Typedecl_variance.variance_of_sdecl sdecl in
+ try
+ Typedecl_variance.compute_decl env ~check:(Some id) new_sig_decl required
+ with Typedecl_variance.Error (loc, err) ->
+ raise (Error (loc, Variance err)) in
+ let new_type_immediate =
+ (* Typedecl_immediacy.compute_decl never raises *)
+ Typedecl_immediacy.compute_decl env new_sig_decl in
+ let new_type_separability =
+ try Typedecl_separability.compute_decl env new_sig_decl
+ with Typedecl_separability.Error (loc, err) ->
+ raise (Error (loc, Separability err)) in
+ let new_sig_decl =
+ (* we intentionally write this without a fragile { decl with ... }
+ to ensure that people adding new fields to type declarations
+ consider whether they need to recompute it here; for an example
+ of bug caused by the previous approach, see #9607 *)
+ {
+ type_params = new_sig_decl.type_params;
+ type_arity = new_sig_decl.type_arity;
+ type_kind = new_sig_decl.type_kind;
+ type_private = new_sig_decl.type_private;
+ type_manifest = new_sig_decl.type_manifest;
+ type_unboxed_default = new_sig_decl.type_unboxed_default;
+ type_is_newtype = new_sig_decl.type_is_newtype;
+ type_expansion_scope = new_sig_decl.type_expansion_scope;
+ type_loc = new_sig_decl.type_loc;
+ type_attributes = new_sig_decl.type_attributes;
+ type_uid = new_sig_decl.type_uid;
+
+ type_variance = new_type_variance;
+ type_immediate = new_type_immediate;
+ type_separability = new_type_separability;
+ } in
+ {
+ typ_id = id;
+ typ_name = sdecl.ptype_name;
+ typ_params = tparams;
+ typ_type = new_sig_decl;
+ typ_cstrs = constraints;
+ typ_loc = loc;
+ typ_manifest = Some tman;
+ typ_kind = Ttype_abstract;
+ typ_private = sdecl.ptype_private;
+ typ_attributes = sdecl.ptype_attributes;
+ }
+ end
+
+(* A simplified version of [transl_with_constraint], for the case of packages.
+ Package constraints are much simpler than normal with type constraints (e.g.,
+ they can not have parameters and can only update abstract types.) *)
+let transl_package_constraint ~loc env ty =
+ let new_sig_decl =
+ { type_params = [];
+ type_arity = 0;
+ type_kind = Type_abstract Definition;
+ type_private = Public;
+ type_manifest = Some ty;
+ type_variance = [];
+ type_separability = [];
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = loc;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ())
+ }
+ in
+ let new_type_immediate =
+ (* Typedecl_immediacy.compute_decl never raises *)
+ Typedecl_immediacy.compute_decl env new_sig_decl
+ in
+ { new_sig_decl with type_immediate = new_type_immediate }
+
+(* Approximate a type declaration: just make all types abstract *)
+
+let abstract_type_decl ~injective arity =
+ let rec make_params n =
+ if n <= 0 then [] else Ctype.newvar() :: make_params (n-1) in
+ Ctype.with_local_level_generalize begin fun () ->
+ { type_params = make_params arity;
+ type_arity = arity;
+ type_kind = Type_abstract Definition;
+ type_private = Public;
+ type_manifest = None;
+ type_variance = Variance.unknown_signature ~injective ~arity;
+ type_separability = Types.Separability.default_signature ~arity;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_loc = Location.none;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.internal_not_actually_unique;
+ }
+ end
+
+let approx_type_decl sdecl_list =
+ let scope = Ctype.create_scope () in
+ List.map
+ (fun sdecl ->
+ let injective = sdecl.ptype_kind <> Ptype_abstract in
+ (Ident.create_scoped ~scope sdecl.ptype_name.txt,
+ abstract_type_decl ~injective (List.length sdecl.ptype_params)))
+ sdecl_list
+
+(* Check the well-formedness conditions on type abbreviations defined
+ within recursive modules. *)
+
+let check_recmod_typedecl env loc recmod_ids path decl =
+ (* recmod_ids is the list of recursively-defined module idents.
+ (path, decl) is the type declaration to be checked. *)
+ let to_check path = Path.exists_free recmod_ids path in
+ check_well_founded_decl ~abs_env:env env loc path decl to_check;
+ check_regularity ~abs_env:env env loc path decl to_check;
+ (* additional coherence check, as one might build an incoherent signature,
+ and use it to build an incoherent module, cf. #7851 *)
+ check_coherence env loc path decl
+
+
+(**** Error report ****)
+
+open Format_doc
+module Style = Misc.Style
+module Printtyp = Printtyp.Doc
+
+let explain_unbound_gen ppf tv tl typ kwd pr =
+ try
+ let ti = List.find (fun ti -> Ctype.deep_occur tv (typ ti)) tl in
+ let ty0 = (* Hack to force aliasing when needed *)
+ Btype.newgenty (Tobject(tv, ref None)) in
+ Out_type.prepare_for_printing [typ ti; ty0];
+ fprintf ppf
+ ".@ @[<hov2>In %s@ %a@;<1 -2>the variable %a is unbound@]"
+ kwd (Style.as_inline_code pr) ti
+ (Style.as_inline_code Out_type.prepared_type_expr) tv
+ with Not_found -> ()
+
+let explain_unbound ppf tv tl typ kwd lab =
+ explain_unbound_gen ppf tv tl typ kwd
+ (fun ppf ti ->
+ fprintf ppf "%s%a" (lab ti) Out_type.prepared_type_expr (typ ti)
+ )
+
+let explain_unbound_single ppf tv ty =
+ let trivial ty =
+ explain_unbound ppf tv [ty] (fun t -> t) "type" (fun _ -> "") in
+ match get_desc ty with
+ Tobject(fi,_) ->
+ let (tl, rv) = Ctype.flatten_fields fi in
+ if eq_type rv tv then trivial ty else
+ explain_unbound ppf tv tl (fun (_,_,t) -> t)
+ "method" (fun (lab,_,_) -> lab ^ ": ")
+ | Tvariant row ->
+ if eq_type (row_more row) tv then trivial ty else
+ explain_unbound ppf tv (row_fields row)
+ (fun (_l,f) -> match row_field_repr f with
+ Rpresent (Some t) -> t
+ | Reither (_,[t],_) -> t
+ | Reither (_,tl,_) -> Btype.newgenty (Ttuple tl)
+ | _ -> Btype.newgenty (Ttuple[]))
+ "case" (fun (lab,_) -> "`" ^ lab ^ " of ")
+ | _ -> trivial ty
+
+
+let tys_of_constr_args = function
+ | Types.Cstr_tuple tl -> tl
+ | Types.Cstr_record lbls -> List.map (fun l -> l.Types.ld_type) lbls
+
+module Reaching_path = struct
+ type t = reaching_type_path
+
+ (* Simplify a reaching path before showing it in error messages. *)
+ let simplify path =
+ let rec simplify : t -> t = function
+ | Contains (ty1, _ty2) :: Contains (_ty2', ty3) :: rest ->
+ (* If t1 contains t2 and t2 contains t3, then t1 contains t3
+ and we don't need to show t2. *)
+ simplify (Contains (ty1, ty3) :: rest)
+ | hd :: rest -> hd :: simplify rest
+ | [] -> []
+ in simplify path
+
+ (* See Out_type.add_type_to_preparation.
+
+ Note: it is better to call this after [simplify], otherwise some
+ type variable names may be used for types that are removed
+ by simplification and never actually shown to the user.
+ *)
+ let add_to_preparation path =
+ List.iter (function
+ | Contains (ty1, ty2) | Expands_to (ty1, ty2) ->
+ List.iter Out_type.add_type_to_preparation [ty1; ty2]
+ ) path
+
+ module Fmt = Format_doc
+
+ let pp ppf reaching_path =
+ let pp_step ppf = function
+ | Expands_to (ty, body) ->
+ Fmt.fprintf ppf "%a = %a"
+ (Style.as_inline_code Out_type.prepared_type_expr) ty
+ (Style.as_inline_code Out_type.prepared_type_expr) body
+ | Contains (outer, inner) ->
+ Fmt.fprintf ppf "%a contains %a"
+ (Style.as_inline_code Out_type.prepared_type_expr) outer
+ (Style.as_inline_code Out_type.prepared_type_expr) inner
+ in
+ Fmt.(pp_print_list ~pp_sep:comma) pp_step ppf reaching_path
+
+ let pp_colon ppf path =
+ Fmt.fprintf ppf ":@;<1 2>@[<v>%a@]" pp path
+end
+
+let quoted_out_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
+let quoted_type ppf ty = Style.as_inline_code Printtyp.type_expr ppf ty
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
+let report_error_doc ppf = function
+ | Repeated_parameter ->
+ fprintf ppf "A type parameter occurs several times"
+ | Duplicate_constructor s ->
+ fprintf ppf "Two constructors are named %a" Style.inline_code s
+ | Too_many_constructors ->
+ fprintf ppf
+ "@[Too many non-constant constructors@ -- maximum is %i %s@]"
+ (Config.max_tag + 1) "non-constant constructors"
+ | Duplicate_label s ->
+ fprintf ppf "Two labels are named %a" Style.inline_code s
+ | Recursive_abbrev (s, env, reaching_path) ->
+ let reaching_path = Reaching_path.simplify reaching_path in
+ Printtyp.wrap_printing_env ~error:true env @@ fun () ->
+ Out_type.reset ();
+ Reaching_path.add_to_preparation reaching_path;
+ fprintf ppf "@[<v>The type abbreviation %a is cyclic%a@]"
+ Style.inline_code s
+ Reaching_path.pp_colon reaching_path
+ | Cycle_in_def (s, env, reaching_path) ->
+ let reaching_path = Reaching_path.simplify reaching_path in
+ Printtyp.wrap_printing_env ~error:true env @@ fun () ->
+ Out_type.reset ();
+ Reaching_path.add_to_preparation reaching_path;
+ fprintf ppf "@[<v>The definition of %a contains a cycle%a@]"
+ Style.inline_code s
+ Reaching_path.pp_colon reaching_path
+ | Definition_mismatch (ty, _env, None) ->
+ fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]@]"
+ "This variant or record definition" "does not match that of type"
+ quoted_type ty
+ | Definition_mismatch (ty, env, Some err) ->
+ fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]%a@]"
+ "This variant or record definition" "does not match that of type"
+ quoted_type ty
+ (Includecore.report_type_mismatch
+ "the original" "this" "definition" env)
+ err
+ | Constraint_failed (env, err) ->
+ let msg = Format_doc.Doc.msg in
+ fprintf ppf "@[<v>Constraints are not satisfied in this type.@ ";
+ Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "should be an instance of");
+ fprintf ppf "@]"
+ | Non_regular { definition; used_as; defined_as; reaching_path } ->
+ let reaching_path = Reaching_path.simplify reaching_path in
+ Out_type.prepare_for_printing [used_as; defined_as];
+ Reaching_path.add_to_preparation reaching_path;
+ fprintf ppf
+ "@[<hv>This recursive type is not regular.@ \
+ The type constructor %a is defined as@;<1 2>type %a@ \
+ but it is used as@;<1 2>%a%t\
+ All uses need to match the definition for the recursive type \
+ to be regular.@]"
+ Style.inline_code (Path.name definition)
+ quoted_out_type (Out_type.tree_of_typexp Type defined_as)
+ quoted_out_type (Out_type.tree_of_typexp Type used_as)
+ (fun pp ->
+ let is_expansion = function Expands_to _ -> true | _ -> false in
+ if List.exists is_expansion reaching_path then
+ fprintf pp "@ after the following expansion(s)%a@ "
+ Reaching_path.pp_colon reaching_path
+ else fprintf pp ".@ ")
+ | Inconsistent_constraint (env, err) ->
+ let msg = Format_doc.Doc.msg in
+ fprintf ppf "@[<v>The type constraints are not consistent.@ ";
+ Errortrace_report.unification ppf env err
+ (msg "Type")
+ (msg "is not compatible with type");
+ fprintf ppf "@]"
+ | Type_clash (env, err) ->
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf env err
+ (msg "This type constructor expands to type")
+ (msg "but is used here with type")
+ | Null_arity_external ->
+ fprintf ppf "External identifiers must be functions"
+ | Missing_native_external ->
+ fprintf ppf "@[<hv>An external function with more than 5 arguments \
+ requires a second stub function@ \
+ for native-code compilation@]"
+ | Unbound_type_var (ty, decl) ->
+ fprintf ppf "@[A type variable is unbound in this type declaration";
+ begin match decl.type_kind, decl.type_manifest with
+ | Type_variant (tl, _rep), _ ->
+ explain_unbound_gen ppf ty tl (fun c ->
+ let tl = tys_of_constr_args c.Types.cd_args in
+ Btype.newgenty (Ttuple tl)
+ )
+ "case" (fun ppf c ->
+ fprintf ppf
+ "%a of %a" Printtyp.ident c.Types.cd_id
+ Printtyp.constructor_arguments c.Types.cd_args)
+ | Type_record (tl, _), _ ->
+ explain_unbound ppf ty tl (fun l -> l.Types.ld_type)
+ "field" (fun l -> Ident.name l.Types.ld_id ^ ": ")
+ | Type_abstract _, Some ty' ->
+ explain_unbound_single ppf ty ty'
+ | _ -> ()
+ end;
+ fprintf ppf "@]"
+ | Unbound_type_var_ext (ty, ext) ->
+ fprintf ppf "@[A type variable is unbound in this extension constructor";
+ let args = tys_of_constr_args ext.ext_args in
+ explain_unbound ppf ty args (fun c -> c) "type" (fun _ -> "");
+ fprintf ppf "@]"
+ | Cannot_extend_private_type path ->
+ fprintf ppf "@[%s@ %a@]"
+ "Cannot extend private type definition"
+ Printtyp.path path
+ | Not_extensible_type path ->
+ fprintf ppf "@[%s@ %a@ %s@]"
+ "Type definition"
+ (Style.as_inline_code Printtyp.path) path
+ "is not extensible"
+ | Extension_mismatch (path, env, err) ->
+ fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]%a@]"
+ "This extension" "does not match the definition of type"
+ Style.inline_code (Path.name path)
+ (Includecore.report_type_mismatch
+ "the type" "this extension" "definition" env)
+ err
+ | Rebind_wrong_type (lid, env, err) ->
+ let msg = Format_doc.doc_printf in
+ Errortrace_report.unification ppf env err
+ (msg "The constructor %a@ has type"
+ quoted_constr lid)
+ (msg "but was expected to be of type")
+ | Rebind_mismatch (lid, p, p') ->
+ fprintf ppf
+ "@[%s@ %a@ %s@ %a@ %s@ %s@ %a@]"
+ "The constructor"
+ quoted_constr lid
+ "extends type" Style.inline_code (Path.name p)
+ "whose declaration does not match"
+ "the declaration of type" Style.inline_code (Path.name p')
+ | Rebind_private lid ->
+ fprintf ppf "@[%s@ %a@ %s@]"
+ "The constructor"
+ quoted_constr lid
+ "is private"
+ | Variance (Typedecl_variance.Bad_variance (n, v1, v2)) ->
+ let variance (p,n,i) =
+ let inj = if i then "injective " else "" in
+ match p, n with
+ true, true -> inj ^ "invariant"
+ | true, false -> inj ^ "covariant"
+ | false, true -> inj ^ "contravariant"
+ | false, false -> if inj = "" then "unrestricted" else inj
+ in
+ (match n with
+ | Variance_variable_error { error; variable; context } ->
+ Out_type.prepare_for_printing [ variable ];
+ begin match context with
+ | Type_declaration (id, decl) ->
+ Out_type.add_type_declaration_to_preparation id decl;
+ fprintf ppf "@[<v>%s@;<1 2>%a@;"
+ "In the definition"
+ (Style.as_inline_code @@ Out_type.prepared_type_declaration id)
+ decl
+ | Gadt_constructor c ->
+ Out_type.add_constructor_to_preparation c;
+ fprintf ppf "@[<v>%s@;<1 2>%a@;"
+ "In the GADT constructor"
+ (Style.as_inline_code Out_type.prepared_constructor)
+ c
+ | Extension_constructor (id, e) ->
+ Out_type.add_extension_constructor_to_preparation e;
+ fprintf ppf "@[<v>%s@;<1 2>%a@;"
+ "In the extension constructor"
+ (Out_type.prepared_extension_constructor id)
+ e
+ end;
+ begin match error with
+ | Variance_not_reflected ->
+ fprintf ppf "@[%s@ %a@ %s@ %s@ It"
+ "the type variable"
+ (Style.as_inline_code Out_type.prepared_type_expr) variable
+ "has a variance that"
+ "is not reflected by its occurrence in type parameters."
+ | No_variable ->
+ fprintf ppf "@[%s@ %a@ %s@ %s@]@]"
+ "the type variable"
+ (Style.as_inline_code Out_type.prepared_type_expr) variable
+ "cannot be deduced"
+ "from the type parameters."
+ | Variance_not_deducible ->
+ fprintf ppf "@[%s@ %a@ %s@ %s@ It"
+ "the type variable"
+ (Style.as_inline_code Out_type.prepared_type_expr) variable
+ "has a variance that"
+ "cannot be deduced from the type parameters."
+ end
+ | Variance_not_satisfied n ->
+ fprintf ppf "@[@[%s@ %s@ The %d%s type parameter"
+ "In this definition, expected parameter"
+ "variances are not satisfied."
+ n (Misc.ordinal_suffix n));
+ (match n with
+ | Variance_variable_error { error = No_variable; _ } -> ()
+ | _ ->
+ fprintf ppf " was expected to be %s,@ but it is %s.@]@]"
+ (variance v2) (variance v1))
+ | Unavailable_type_constructor p ->
+ fprintf ppf "The definition of type %a@ is unavailable"
+ (Style.as_inline_code Printtyp.path) p
+ | Variance Typedecl_variance.Varying_anonymous ->
+ fprintf ppf "@[%s@ %s@ %s@]"
+ "In this GADT definition," "the variance of some parameter"
+ "cannot be checked"
+ | Val_in_structure ->
+ fprintf ppf "Value declarations are only allowed in signatures"
+ | Multiple_native_repr_attributes ->
+ fprintf ppf "Too many %a/%a attributes"
+ Style.inline_code "[@@unboxed]"
+ Style.inline_code "[@@untagged]"
+ | Cannot_unbox_or_untag_type Unboxed ->
+ fprintf ppf "@[Don't know how to unbox this type.@ \
+ Only %a, %a, %a, and %a can be unboxed.@]"
+ Style.inline_code "float"
+ Style.inline_code "int32"
+ Style.inline_code "int64"
+ Style.inline_code "nativeint"
+ | Cannot_unbox_or_untag_type Untagged ->
+ fprintf ppf "@[Don't know how to untag this type. Only %a@ \
+ and other immediate types can be untagged.@]"
+ Style.inline_code "int"
+ | Deep_unbox_or_untag_attribute kind ->
+ fprintf ppf
+ "@[The attribute %a should be attached to@ \
+ a direct argument or result of the primitive,@ \
+ it should not occur deeply into its type.@]"
+ Style.inline_code
+ (match kind with Unboxed -> "@unboxed" | Untagged -> "@untagged")
+ | Immediacy (Typedecl_immediacy.Bad_immediacy_attribute violation) ->
+ (match violation with
+ | Type_immediacy.Violation.Not_always_immediate ->
+ fprintf ppf
+ "@[Types@ marked@ with@ the@ immediate@ attribute@ must@ be@ \
+ non-pointer@ types@ like@ %a@ or@ %a.@]"
+ Style.inline_code "int"
+ Style.inline_code "bool"
+ | Type_immediacy.Violation.Not_always_immediate_on_64bits ->
+ fprintf ppf
+ "@[Types@ marked@ with@ the@ %a@ attribute@ must@ be@ \
+ produced@ using@ the@ %a@ functor.@]"
+ Style.inline_code "immediate64"
+ Style.inline_code "Stdlib.Sys.Immediate64.Make"
+ )
+ | Bad_unboxed_attribute msg ->
+ fprintf ppf "@[This type cannot be unboxed because@ %s.@]" msg
+ | Separability (Typedecl_separability.Non_separable_evar evar) ->
+ let pp_evar ppf = function
+ | None ->
+ fprintf ppf "an unnamed existential variable"
+ | Some str ->
+ fprintf ppf "the existential variable %a"
+ (Style.as_inline_code Pprintast.Doc.tyvar) str in
+ fprintf ppf "@[This type cannot be unboxed because@ \
+ it might contain both float and non-float values,@ \
+ depending on the instantiation of %a.@ \
+ You should annotate it with %a.@]"
+ pp_evar evar
+ Style.inline_code "[@@ocaml.boxed]"
+ | Boxed_and_unboxed ->
+ fprintf ppf "@[A type cannot be boxed and unboxed at the same time.@]"
+ | Nonrec_gadt ->
+ fprintf ppf
+ "@[GADT case syntax cannot be used in a %a block.@]"
+ Style.inline_code "nonrec"
+ | Invalid_private_row_declaration ty ->
+ let pp_private ppf ty = fprintf ppf "private %a" Printtyp.type_expr ty in
+ fprintf ppf
+ "@[<hv>This private row type declaration is invalid.@ \
+ The type expression on the right-hand side reduces to@;<1 2>%a@ \
+ which does not have a free row type variable.@]@,\
+ @[<hv>@[@{<hint>Hint@}: If you intended to define a private \
+ type abbreviation,@ \
+ write explicitly@]@;<1 2>%a@]"
+ (Style.as_inline_code Printtyp.type_expr) ty
+ (Style.as_inline_code pp_private) ty
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc, err) ->
+ Some (Location.error_of_printer ~loc report_error_doc err)
+ | _ ->
+ None
+ )
+
+let report_error = Format_doc.compat report_error_doc
diff --git a/upstream/ocaml_503/typing/typedecl.mli b/upstream/ocaml_503/typing/typedecl.mli
new file mode 100644
index 0000000000..38c00487ed
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl.mli
@@ -0,0 +1,113 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Typing of type definitions and primitive definitions *)
+
+open Types
+val transl_type_decl:
+ Env.t -> Asttypes.rec_flag -> Parsetree.type_declaration list ->
+ Typedtree.type_declaration list * Env.t * Shape.t list
+
+val transl_exception:
+ Env.t -> Parsetree.extension_constructor ->
+ Typedtree.extension_constructor * Env.t * Shape.t
+
+val transl_type_exception:
+ Env.t ->
+ Parsetree.type_exception -> Typedtree.type_exception * Env.t * Shape.t
+
+val transl_type_extension:
+ bool -> Env.t -> Location.t -> Parsetree.type_extension ->
+ Typedtree.type_extension * Env.t * Shape.t list
+
+val transl_value_decl:
+ Env.t -> Location.t ->
+ Parsetree.value_description -> Typedtree.value_description * Env.t
+
+(* If the [fixed_row_path] optional argument is provided,
+ the [Parsetree.type_declaration] argument should satisfy [is_fixed_type] *)
+val transl_with_constraint:
+ Ident.t -> ?fixed_row_path:Path.t ->
+ sig_env:Env.t -> sig_decl:Types.type_declaration ->
+ outer_env:Env.t -> Parsetree.type_declaration ->
+ Typedtree.type_declaration
+
+val transl_package_constraint:
+ loc:Location.t -> Env.t -> type_expr -> Types.type_declaration
+
+val abstract_type_decl: injective:bool -> int -> type_declaration
+val approx_type_decl:
+ Parsetree.type_declaration list ->
+ (Ident.t * type_declaration) list
+val check_recmod_typedecl:
+ Env.t -> Location.t -> Ident.t list -> Path.t -> type_declaration -> unit
+val check_coherence:
+ Env.t -> Location.t -> Path.t -> type_declaration -> unit
+
+(* for fixed types *)
+val is_fixed_type : Parsetree.type_declaration -> bool
+
+type native_repr_kind = Unboxed | Untagged
+
+type reaching_type_path = reaching_type_step list
+and reaching_type_step =
+ | Expands_to of type_expr * type_expr
+ | Contains of type_expr * type_expr
+
+type error =
+ Repeated_parameter
+ | Duplicate_constructor of string
+ | Too_many_constructors
+ | Duplicate_label of string
+ | Recursive_abbrev of string * Env.t * reaching_type_path
+ | Cycle_in_def of string * Env.t * reaching_type_path
+ | Definition_mismatch of type_expr * Env.t * Includecore.type_mismatch option
+ | Constraint_failed of Env.t * Errortrace.unification_error
+ | Inconsistent_constraint of Env.t * Errortrace.unification_error
+ | Type_clash of Env.t * Errortrace.unification_error
+ | Non_regular of {
+ definition: Path.t;
+ used_as: type_expr;
+ defined_as: type_expr;
+ reaching_path: reaching_type_path;
+ }
+ | Null_arity_external
+ | Missing_native_external
+ | Unbound_type_var of type_expr * type_declaration
+ | Cannot_extend_private_type of Path.t
+ | Not_extensible_type of Path.t
+ | Extension_mismatch of Path.t * Env.t * Includecore.type_mismatch
+ | Rebind_wrong_type of
+ Longident.t * Env.t * Errortrace.unification_error
+ | Rebind_mismatch of Longident.t * Path.t * Path.t
+ | Rebind_private of Longident.t
+ | Variance of Typedecl_variance.error
+ | Unavailable_type_constructor of Path.t
+ | Unbound_type_var_ext of type_expr * extension_constructor
+ | Val_in_structure
+ | Multiple_native_repr_attributes
+ | Cannot_unbox_or_untag_type of native_repr_kind
+ | Deep_unbox_or_untag_attribute of native_repr_kind
+ | Immediacy of Typedecl_immediacy.error
+ | Separability of Typedecl_separability.error
+ | Bad_unboxed_attribute of string
+ | Boxed_and_unboxed
+ | Nonrec_gadt
+ | Invalid_private_row_declaration of type_expr
+
+exception Error of Location.t * error
+
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
diff --git a/upstream/ocaml_503/typing/typedecl_immediacy.ml b/upstream/ocaml_503/typing/typedecl_immediacy.ml
new file mode 100644
index 0000000000..71e49a10be
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_immediacy.ml
@@ -0,0 +1,68 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+open Types
+
+type error = Bad_immediacy_attribute of Type_immediacy.Violation.t
+exception Error of Location.t * error
+
+let compute_decl env tdecl =
+ match (tdecl.type_kind, tdecl.type_manifest) with
+ | (Type_variant ([{cd_args = Cstr_tuple [arg]
+ | Cstr_record [{ld_type = arg; _}]; _}],
+ Variant_unboxed)
+ | Type_record ([{ld_type = arg; _}], Record_unboxed _)), _ ->
+ begin match Typedecl_unboxed.get_unboxed_type_representation env arg with
+ | None -> Type_immediacy.Unknown
+ | Some argrepr -> Ctype.immediacy env argrepr
+ end
+ | (Type_variant (cstrs, _), _) ->
+ if not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs)
+ then
+ Type_immediacy.Always
+ else
+ Type_immediacy.Unknown
+ | (Type_abstract _, Some(typ)) -> Ctype.immediacy env typ
+ | (Type_abstract _, None) ->
+ Type_immediacy.of_attributes tdecl.type_attributes
+ | _ -> Type_immediacy.Unknown
+
+let property : (Type_immediacy.t, unit) Typedecl_properties.property =
+ let open Typedecl_properties in
+ let eq = (=) in
+ let merge ~prop:_ ~new_prop = new_prop in
+ let default _decl = Type_immediacy.Unknown in
+ let compute env decl () = compute_decl env decl in
+ let update_decl decl immediacy = { decl with type_immediate = immediacy } in
+ let check _env _id decl () =
+ let written_by_user = Type_immediacy.of_attributes decl.type_attributes in
+ match Type_immediacy.coerce decl.type_immediate ~as_:written_by_user with
+ | Ok () -> ()
+ | Error violation ->
+ raise (Error (decl.type_loc,
+ Bad_immediacy_attribute violation))
+ in
+ {
+ eq;
+ merge;
+ default;
+ compute;
+ update_decl;
+ check;
+ }
+
+let update_decls env decls =
+ Typedecl_properties.compute_property_noreq property env decls
diff --git a/upstream/ocaml_503/typing/typedecl_immediacy.mli b/upstream/ocaml_503/typing/typedecl_immediacy.mli
new file mode 100644
index 0000000000..17fb985c80
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_immediacy.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+type error = Bad_immediacy_attribute of Type_immediacy.Violation.t
+exception Error of Location.t * error
+
+val compute_decl : Env.t -> Types.type_declaration -> Type_immediacy.t
+
+val property : (Type_immediacy.t, unit) Typedecl_properties.property
+
+val update_decls :
+ Env.t ->
+ (Ident.t * Typedecl_properties.decl) list ->
+ (Ident.t * Typedecl_properties.decl) list
diff --git a/upstream/ocaml_503/typing/typedecl_properties.ml b/upstream/ocaml_503/typing/typedecl_properties.ml
new file mode 100644
index 0000000000..28a1bb6673
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_properties.ml
@@ -0,0 +1,73 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+type decl = Types.type_declaration
+
+type ('prop, 'req) property = {
+ eq : 'prop -> 'prop -> bool;
+ merge : prop:'prop -> new_prop:'prop -> 'prop;
+
+ default : decl -> 'prop;
+ compute : Env.t -> decl -> 'req -> 'prop;
+ update_decl : decl -> 'prop -> decl;
+
+ check : Env.t -> Ident.t -> decl -> 'req -> unit;
+}
+
+let add_type ~check id decl env =
+ let open Types in
+ Builtin_attributes.warning_scope ~ppwarning:false decl.type_attributes
+ (fun () -> Env.add_type ~check id decl env)
+
+let add_types_to_env decls env =
+ List.fold_right
+ (fun (id, decl) env -> add_type ~check:true id decl env)
+ decls env
+
+let compute_property
+: ('prop, 'req) property -> Env.t ->
+ (Ident.t * decl) list -> 'req list -> (Ident.t * decl) list
+= fun property env decls required ->
+ (* [decls] and [required] must be lists of the same size,
+ with [required] containing the requirement for the corresponding
+ declaration in [decls]. *)
+ let props = List.map (fun (_id, decl) -> property.default decl) decls in
+ let rec compute_fixpoint props =
+ let new_decls =
+ List.map2 (fun (id, decl) prop ->
+ (id, property.update_decl decl prop))
+ decls props in
+ let new_env = add_types_to_env new_decls env in
+ let new_props =
+ List.map2
+ (fun (_id, decl) (prop, req) ->
+ let new_prop = property.compute new_env decl req in
+ property.merge ~prop ~new_prop)
+ new_decls (List.combine props required) in
+ if not (List.for_all2 property.eq props new_props)
+ then compute_fixpoint new_props
+ else begin
+ List.iter2
+ (fun (id, decl) req -> property.check new_env id decl req)
+ new_decls required;
+ new_decls
+ end
+ in
+ compute_fixpoint props
+
+let compute_property_noreq property env decls =
+ let req = List.map (fun _ -> ()) decls in
+ compute_property property env decls req
diff --git a/upstream/ocaml_503/typing/typedecl_properties.mli b/upstream/ocaml_503/typing/typedecl_properties.mli
new file mode 100644
index 0000000000..153c3f719c
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_properties.mli
@@ -0,0 +1,55 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+type decl = Types.type_declaration
+
+(** An abstract interface for properties of type definitions, such as
+ variance and immediacy, that are computed by a fixpoint on
+ mutually-recursive type declarations. This interface contains all
+ the operations needed to initialize and run the fixpoint
+ computation, and then (optionally) check that the result is
+ consistent with the declaration or user expectations. *)
+
+type ('prop, 'req) property = {
+ eq : 'prop -> 'prop -> bool;
+ merge : prop:'prop -> new_prop:'prop -> 'prop;
+
+ default : decl -> 'prop;
+ compute : Env.t -> decl -> 'req -> 'prop;
+ update_decl : decl -> 'prop -> decl;
+
+ check : Env.t -> Ident.t -> decl -> 'req -> unit;
+}
+(** ['prop] represents the type of property values
+ ({!Types.Variance.t}, just 'bool' for immediacy, etc).
+
+ ['req] represents the property value required by the author of the
+ declaration, if they gave an expectation: [type +'a t = ...].
+
+ Some properties have no natural notion of user requirement, or
+ their requirement is global, or already stored in
+ [type_declaration]; they can just use [unit] as ['req] parameter. *)
+
+
+(** [compute_property prop env decls req] performs a fixpoint computation
+ to determine the final values of a property on a set of mutually-recursive
+ type declarations. The [req] argument must be a list of the same size as
+ [decls], providing the user requirement for each declaration. *)
+val compute_property : ('prop, 'req) property -> Env.t ->
+ (Ident.t * decl) list -> 'req list -> (Ident.t * decl) list
+
+val compute_property_noreq : ('prop, unit) property -> Env.t ->
+ (Ident.t * decl) list -> (Ident.t * decl) list
diff --git a/upstream/ocaml_503/typing/typedecl_separability.ml b/upstream/ocaml_503/typing/typedecl_separability.ml
new file mode 100644
index 0000000000..c8f2f3b171
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_separability.ml
@@ -0,0 +1,668 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+open Types
+
+type type_definition = type_declaration
+(* We should use 'declaration' for interfaces, and 'definition' for
+ implementations. The name type_declaration in types.ml is improper
+ for our usage -- although for OCaml types the declaration and
+ definition languages are the same. *)
+
+(** assuming that a datatype has a single constructor/label with
+ a single argument, [argument_to_unbox] represents the
+ information we need to check the argument for separability. *)
+type argument_to_unbox = {
+ argument_type: type_expr;
+ result_type_parameter_instances: type_expr list;
+ (** result_type_parameter_instances represents the domain of the
+ constructor; usually it is just a list of the datatype parameter
+ ('a, 'b, ...), but when using GADTs or constraints it could
+ contain arbitrary type expressions.
+
+ For example, [type 'a t = 'b constraint 'a = 'b * int] has
+ [['b * int]] as [result_type_parameter_instances], and so does
+ [type _ t = T : 'b -> ('b * int) t]. *)
+}
+
+(** Summarize the right-hand-side of a type declaration,
+ for separability-checking purposes. See {!structure} below. *)
+type type_structure =
+ | Synonym of type_expr
+ | Abstract
+ | Open
+ | Algebraic
+ | Unboxed of argument_to_unbox
+
+let structure : type_definition -> type_structure = fun def ->
+ match def.type_kind with
+ | Type_open -> Open
+ | Type_abstract _ ->
+ begin match def.type_manifest with
+ | None -> Abstract
+ | Some type_expr -> Synonym type_expr
+ end
+
+ | ( Type_record ([{ld_type = ty; _}], Record_unboxed _)
+ | Type_variant ([{cd_args = Cstr_tuple [ty]; _}], Variant_unboxed)
+ | Type_variant ([{cd_args = Cstr_record [{ld_type = ty; _}]; _}],
+ Variant_unboxed)) ->
+ let params =
+ match def.type_kind with
+ | Type_variant ([{cd_res = Some ret_type}], _) ->
+ begin match get_desc ret_type with
+ | Tconstr (_, tyl, _) -> tyl
+ | _ -> assert false
+ end
+ | _ -> def.type_params
+ in
+ Unboxed { argument_type = ty; result_type_parameter_instances = params }
+
+ | Type_record _ | Type_variant _ -> Algebraic
+
+type error =
+ | Non_separable_evar of string option
+
+exception Error of Location.t * error
+
+(* see the .mli file for explanations on the modes *)
+module Sep = Types.Separability
+type mode = Sep.t = Ind | Sep | Deepsep
+
+let rank = Sep.rank
+let max_mode = Sep.max
+
+(** If the type context [e(_)] imposes the mode [m] on its hole [_],
+ and the type context [e'(_)] imposes the mode [m'] on its hole [_],
+ then the mode on [_] imposed by the context composition [e(e'(_))]
+ is [compose m m'].
+
+ This operation differs from [max_mode]: [max_mode Ind Sep] is [Sep],
+ but [compose Ind Sep] is [Ind]. *)
+let compose
+ : mode -> mode -> mode
+ = fun m1 m2 ->
+ match m1 with
+ | Deepsep -> Deepsep
+ | Sep -> m2
+ | Ind -> Ind
+
+type type_var = {
+ text: string option; (** the user name of the type variable, None for '_' *)
+ id: int; (** the identifier of the type node (type_expr.id) of the variable *)
+}
+
+module TVarMap = Map.Make(struct
+ type t = type_var
+ let compare v1 v2 = compare v1.id v2.id
+ end)
+type context = mode TVarMap.t
+let (++) = TVarMap.union (fun _ m1 m2 -> Some(max_mode m1 m2))
+let empty = TVarMap.empty
+
+
+(** [immediate_subtypes ty] returns the list of all the
+ immediate sub-type-expressions of [ty]. They represent the biggest
+ sub-components that may be extracted using a constraint. For
+ example, the immediate sub-type-expressions of [int * (bool * 'a)]
+ are [int] and [bool * 'a].
+
+ Smaller components are extracted recursively in [check_type]. *)
+let rec immediate_subtypes : type_expr -> type_expr list = fun ty ->
+ (* Note: Btype.fold_type_expr is not suitable here:
+ - it does not do the right thing on Tpoly, iterating on type
+ parameters as well as the subtype
+ - it performs a shallow traversal of object types,
+ while our implementation collects all method types *)
+ match get_desc ty with
+ (* these are the important cases,
+ on which immediate_subtypes is called from [check_type] *)
+ | Tarrow(_,ty1,ty2,_) ->
+ [ty1; ty2]
+ | Ttuple(tys) -> tys
+ | Tpackage(_, fl) -> (snd (List.split fl))
+ | Tobject(row,class_ty) ->
+ let class_subtys =
+ match !class_ty with
+ | None -> []
+ | Some(_,tys) -> tys
+ in
+ immediate_subtypes_object_row class_subtys row
+ | Tvariant(row) ->
+ immediate_subtypes_variant_row [] row
+
+ (* the cases below are not called from [check_type],
+ they are here for completeness *)
+ | Tnil | Tfield _ ->
+ (* these should only occur under Tobject and not at the toplevel,
+ but "better safe than sorry" *)
+ immediate_subtypes_object_row [] ty
+ | Tlink _ | Tsubst _ -> assert false (* impossible due to Ctype.repr *)
+ | Tvar _ | Tunivar _ -> []
+ | Tpoly (pty, _) -> [pty]
+ | Tconstr (_path, tys, _) -> tys
+
+and immediate_subtypes_object_row acc ty = match get_desc ty with
+ | Tnil -> acc
+ | Tfield (_label, _kind, ty, rest) ->
+ let acc = ty :: acc in
+ immediate_subtypes_object_row acc rest
+ | _ -> ty :: acc
+
+and immediate_subtypes_variant_row acc desc =
+ let add_subtypes acc =
+ let add_subtype acc (_l, rf) =
+ immediate_subtypes_variant_row_field acc rf in
+ List.fold_left add_subtype acc (row_fields desc) in
+ let add_row acc =
+ let row = row_more desc in
+ match get_desc row with
+ | Tvariant more -> immediate_subtypes_variant_row acc more
+ | _ -> row :: acc
+ in
+ add_row (add_subtypes acc)
+
+and immediate_subtypes_variant_row_field acc f =
+ match row_field_repr f with
+ | Rpresent(None)
+ | Rabsent -> acc
+ | Rpresent(Some(ty)) -> ty :: acc
+ | Reither(_,field_types,_) ->
+ List.rev_append field_types acc
+
+let free_variables ty =
+ Ctype.free_variables ty
+ |> List.map (fun ty ->
+ match get_desc ty with
+ Tvar text -> {text; id = get_id ty}
+ | _ ->
+ (* Ctype.free_variables only returns Tvar nodes *)
+ assert false)
+
+(** Coinductive hypotheses to handle equi-recursive types
+
+ OCaml allows infinite/cyclic types, such as
+ (int * 'a) as 'a
+ whose infinite unfolding is (int * (int * (int * (int * ...)))).
+
+ Remark: this specific type is only accepted if the -rectypes option
+ is passed, but such "equi-recursive types" are accepted by
+ default if the cycle goes through an object type or polymorphic
+ variant type:
+ [ `int | `other of 'a ] as 'a
+ < head : int; rest : 'a > as 'a
+
+ We have to take those infinite types in account in our
+ separability-checking program: a naive implementation would loop
+ infinitely when trying to prove that one of them is Deepsep.
+
+ After type-checking, the cycle-introducing form (... as 'a) does
+ not appear explicitly in the syntax of types: types are graphs/trees
+ with cycles in them, and we have to use the type_expr.id field,
+ an identifier for each node in the graph/tree, to detect cycles.
+
+ We avoid looping by remembering the set of separability queries
+ that we have already asked ourselves (in the current
+ search branch). For example, if we are asked to check
+
+ (int * 'a) : Deepsep
+
+ our algorithm will check both (int : Deepsep) and ('a : Deepsep),
+ but it will remember in these sub-checks that it is in the process
+ of checking (int * 'a) : Deepsep, adding it to a list of "active
+ goals", or "coinductive hypotheses".
+
+ Each new sub-query will start by checking whether the query
+ already appears as a coinductive hypothesis; in our example, this
+ can happen if 'a and (int * 'a) are in fact the same node in the
+ cyclic tree. In that case, we return immediately (instead of looping):
+ we reason that, assuming that 'a is indeed Deepsep, then it is
+ the case that (int * 'a) is also Deepsep.
+
+ This kind of cyclic reasoning can be dangerous: it would be wrong
+ to argue that an arbitrary 'a type is Deepsep by saying:
+ "assuming that 'a is Deepsep, then it is the case that 'a is
+ also Deepsep". In the first case, we made an assumption on 'a,
+ and used it on a type (int * 'a) which has 'a as a strict sub-component;
+ in the second, we use it on the same type 'a directly, which is invalid.
+
+ Now consider a type of the form (('a t) as 'a): while 'a is a sub-component
+ of ('a t), it may still be wrong to reason coinductively about it,
+ as ('a t) may be defined as (type 'a t = 'a).
+
+ When moving from (int * 'a) to a subcomponent (int) or ('a), we
+ say that the coinductive hypothesis on (int * 'a : m) is "safe":
+ it can be used immediately to prove the subcomponents, because we
+ made progress moving to a strict subcomponent (we are guarded
+ under a computational type constructor). On the other hand, when
+ moving from ('a t) to ('a), we say that the coinductive hypothesis
+ ('a t : m) is "unsafe" for the subgoal, as we don't know whether
+ we have made strict progress. In the general case, we keep track
+ of a set of safe and unsafe hypotheses made in the past, and we
+ use them to terminate checking if we encounter them again,
+ ensuring termination.
+
+ If we encounter a (ty : m) goal that is exactly a safe hypothesis,
+ we terminate with a success. In fact, we can use mode subtyping here:
+ if (ty : m') appears as a hypothesis with (m' >= m), then we would
+ succeed for (ty : m'), so (ty : m) should succeed as well.
+
+ On the other hand, if we encounter a (ty : m) goal that is an
+ *unsafe* hypothesis, we terminate the check with a failure. In this case,
+ we cannot work modulo mode subtyping: if (ty : m') appears with
+ (m' >= m), then the check (ty : m') would have failed, but it is still
+ possible that the weaker current query (ty : m) would succeed.
+
+ In usual coinductive-reasoning systems, unsafe hypotheses are turned
+ into safe hypotheses each time strict progress is made (for each
+ guarded sub-goal). Consider ((int * 'a) t as 'a : deepsep) for example:
+ the idea is that the ((int * 'a) t : deepsep) hypothesis would be
+ unsafe when checking ((int * 'a) : deepsep), but that the progress
+ step from (int * 'a : deepsep) to ('a : deepsep) would turn all
+ past unsafe hypotheses into safe hypotheses. There is a problem
+ with this, though, due to constraints: what if (_ t) is defined as
+
+ type 'b t = 'a constraint 'b = (int * 'a)
+
+ ?
+
+ In that case, then 'a is precisely the one-step unfolding
+ of the ((int * 'a) t) definition, and it would be an invalid,
+ cyclic reasoning to prove ('a : deepsep) from the now-safe
+ hypothesis ((int * 'a) t : deepsep).
+
+ Surprisingly-fortunately, we have exactly the information we need
+ to know whether (_ t) may or may not pull a constraint trick of
+ this nature: we can look at its mode signature, where constraints
+ are marked by a Deepsep mode. If we see Deepsep, we know that a
+ constraint exists, but we don't know what the constraint is:
+ we cannot tell at which point, when decomposing the parameter type,
+ a sub-component can be considered safe again. To model this,
+ we add a third category of co-inductive hypotheses: to "safe" and
+ "unsafe" we add the category of "poison" hypotheses, which remain
+ poisonous during the remaining of the type decomposition,
+ even in presence of safe, computational types constructors:
+
+ - when going under a computational constructor,
+ "unsafe" hypotheses become "safe"
+ - when going under a constraining type (more precisely, under
+ a type parameter that is marked Deepsep in the mode signature),
+ "unsafe" hypotheses become "poison"
+
+ The mode signature tells us even a bit more: if a parameter
+ is marked "Ind", we know that the type constructor cannot unfold
+ to this parameter (otherwise it would be Sep), so going under
+ this parameter can be considered a safe/guarded move: if
+ we have to check (foo t : m) with ((_ : Ind) t) in the signature,
+ we can recursively check (foo : Ind) with (foo t : m) marked
+ as "safe", rather than "unsafe".
+*)
+module TypeMap = Btype.TypeMap
+module ModeSet = Set.Make(Types.Separability)
+
+type coinductive_hyps = {
+ safe: ModeSet.t TypeMap.t;
+ unsafe: ModeSet.t TypeMap.t;
+ poison: ModeSet.t TypeMap.t;
+}
+
+module Hyps : sig
+ type t = coinductive_hyps
+ val empty : t
+ val add : type_expr -> mode -> t -> t
+ val guard : t -> t
+ val poison : t -> t
+ val safe : type_expr -> mode -> t -> bool
+ val unsafe : type_expr -> mode -> t -> bool
+end = struct
+ type t = coinductive_hyps
+
+ let empty = {
+ safe = TypeMap.empty;
+ unsafe = TypeMap.empty;
+ poison = TypeMap.empty;
+ }
+
+ let of_opt = function
+ | Some ms -> ms
+ | None -> ModeSet.empty
+
+ let merge map1 map2 =
+ TypeMap.merge (fun _k ms1 ms2 ->
+ Some (ModeSet.union (of_opt ms1) (of_opt ms2))
+ ) map1 map2
+
+ let guard {safe; unsafe; poison;} = {
+ safe = merge safe unsafe;
+ unsafe = TypeMap.empty;
+ poison;
+ }
+
+ let poison {safe; unsafe; poison;} = {
+ safe;
+ unsafe = TypeMap.empty;
+ poison = merge poison unsafe;
+ }
+
+ let add ty m hyps =
+ let m_map = TypeMap.singleton ty (ModeSet.singleton m) in
+ { hyps with unsafe = merge m_map hyps.unsafe; }
+
+ let find ty map = try TypeMap.find ty map with Not_found -> ModeSet.empty
+
+ let safe ty m hyps =
+ match ModeSet.max_elt_opt (find ty hyps.safe) with
+ | None -> false
+ | Some best_safe -> rank best_safe >= rank m
+
+ let unsafe ty m {safe = _; unsafe; poison} =
+ let in_map s = ModeSet.mem m (find ty s) in
+ List.exists in_map [unsafe; poison]
+end
+
+(** For a type expression [ty] (without constraints and existentials),
+ any mode checking [ty : m] is satisfied in the "worse case" context
+ that maps all free variables of [ty] to the most demanding mode,
+ Deepsep. *)
+let worst_case ty =
+ let add ctx tvar = TVarMap.add tvar Deepsep ctx in
+ List.fold_left add TVarMap.empty (free_variables ty)
+
+
+(** [check_type env sigma ty m] returns the most permissive context [gamma]
+ such that [ty] is separable at mode [m] in [gamma], under
+ the signature [sigma]. *)
+let check_type
+ : Env.t -> type_expr -> mode -> context
+ = fun env ty m ->
+ let rec check_type hyps ty m =
+ if Hyps.safe ty m hyps then empty
+ else if Hyps.unsafe ty m hyps then worst_case ty
+ else
+ let hyps = Hyps.add ty m hyps in
+ match (get_desc ty, m) with
+ (* Impossible case due to the call to [Ctype.repr]. *)
+ | (Tlink _ , _ ) -> assert false
+ (* Impossible case (according to comment in [typing/types.mli]. *)
+ | (Tsubst(_) , _ ) -> assert false
+ (* "Indifferent" case, the empty context is sufficient. *)
+ | (_ , Ind ) -> empty
+ (* Variable case, add constraint. *)
+ | (Tvar(alpha) , m ) ->
+ TVarMap.singleton {text = alpha; id = get_id ty} m
+ (* "Separable" case for constructors with known memory representation. *)
+ | (Tarrow _ , Sep )
+ | (Ttuple _ , Sep )
+ | (Tvariant(_) , Sep )
+ | (Tobject(_,_) , Sep )
+ | ((Tnil | Tfield _) , Sep )
+ | (Tpackage(_,_) , Sep ) -> empty
+ (* "Deeply separable" case for these same constructors. *)
+ | (Tarrow _ , Deepsep)
+ | (Ttuple _ , Deepsep)
+ | (Tvariant(_) , Deepsep)
+ | (Tobject(_,_) , Deepsep)
+ | ((Tnil | Tfield _) , Deepsep)
+ | (Tpackage(_,_) , Deepsep) ->
+ let tys = immediate_subtypes ty in
+ let on_subtype context ty =
+ context ++ check_type (Hyps.guard hyps) ty Deepsep in
+ List.fold_left on_subtype empty tys
+ (* Polymorphic type, and corresponding polymorphic variable.
+
+ In theory, [Tpoly] (forall alpha. tau) would add a new variable
+ (alpha) in scope, check its body (tau) recursively, and then
+ remove the new variable from the resulting context. Because the
+ rule accepts any mode for this variable, the removal never
+ fails.
+
+ In practice the implementation is simplified by ignoring the
+ new variable, and always returning the [empty] context
+ (instead of (alpha : m) in the [Tunivar] case: the constraint
+ on the variable is removed/ignored at the variable occurrence
+ site, rather than at the variable-introduction site. *)
+ (* Note: that we are semantically incomplete in the Deepsep case
+ (following the syntactic typing rules): the semantics only
+ requires that *closed* sub-type-expressions be (deeply)
+ separable; sub-type-expressions containing the quantified
+ variable cannot be extracted by constraints (this would be
+ a scope violation), so they could be ignored if they occur
+ under a separating type constructor. *)
+ | (Tpoly(pty,_) , m ) ->
+ check_type hyps pty m
+ | (Tunivar(_) , _ ) -> empty
+ (* Type constructor case. *)
+ | (Tconstr(path,tys,_), m ) ->
+ let msig = (Env.find_type path env).type_separability in
+ let on_param context (ty, m_param) =
+ let hyps = match m_param with
+ | Ind -> Hyps.guard hyps
+ | Sep -> hyps
+ | Deepsep -> Hyps.poison hyps in
+ context ++ check_type hyps ty (compose m m_param) in
+ List.fold_left on_param empty (List.combine tys msig)
+ in
+ check_type Hyps.empty ty m
+
+let best_msig decl = List.map (fun _ -> Ind) decl.type_params
+let worst_msig decl = List.map (fun _ -> Deepsep) decl.type_params
+
+(** [msig_of_external_type decl] infers the mode signature of an
+ abstract/external type. We must assume the worst, namely that this
+ type may be defined as an unboxed algebraic datatype imposing deep
+ separability of its parameters.
+
+ One exception is when the type is marked "immediate", which
+ guarantees that its representation is only integers. Immediate
+ types are always separable, so [Ind] suffices for their
+ parameters.
+
+ Note: this differs from {!Types.Separability.default_signature},
+ which does not have access to the declaration and its immediacy. *)
+let msig_of_external_type decl =
+ match decl.type_immediate with
+ | Always | Always_on_64bits -> best_msig decl
+ | Unknown -> worst_msig decl
+
+(** [msig_of_context ~decl_loc constructor context] returns the
+ separability signature of a single-constructor type whose
+ definition is valid in the mode context [context].
+
+ Note: A GADT constructor introduces existential type variables, and
+ may also introduce some equalities between its return type
+ parameters and type expressions containing universal and
+ existential variables. In other words, it introduces new type
+ variables in scope, and restricts existing variables by adding
+ equality constraints.
+
+ [msig_of_context] performs the reverse transformation: the context
+ [ctx] computed from the argument of the constructor mentions
+ existential variables, and the function returns a context over the
+ (universal) type parameters only. (Type constraints do not
+ introduce existential variables, but they do introduce equalities;
+ they are handled as GADTs equalities by this function.)
+
+ The transformation is separability-preserving in the following
+ sense: for any valid instance of the result mode signature
+ (replacing the universal type parameters with ground types
+ respecting the variable's separability mode), any possible
+ extension of this context instance with ground instances for the
+ existential variables of [parameter] that respects the equation
+ constraints will validate the separability requirements of the
+ modes in the input context [ctx].
+
+ Sometimes no such universal context exists, as an existential type
+ cannot be safely introduced, then this function raises an [Error]
+ exception with a [Non_separable_evar] payload. *)
+let msig_of_context : decl_loc:Location.t -> parameters:type_expr list
+ -> context -> Sep.signature =
+ fun ~decl_loc ~parameters context ->
+ let handle_equation (acc, context) param_instance =
+ (* In the theory, GADT equations are of the form
+ ('a = <ty>)
+ for each type parameter 'a of the type constructor. For each
+ such equation, we should "strengthen" the current context in
+ the following way:
+ - if <ty> is another variable 'b,
+ the mode of 'a is set to the mode of 'b,
+ and 'b is set to Ind
+ - if <ty> is a type expression whose variables are all Ind,
+ set 'a to Ind and discard the equation
+ - otherwise (one of the variable of 'b is not Ind),
+ set 'a to Deepsep and set all variables of <ty> to Ind
+
+ In practice, type parameters are determined by their position
+ in a list, they do not necessarily have a corresponding type variable.
+ Instead of "setting 'a" in the context as in the description above,
+ we build a list of modes by repeated consing into
+ an accumulator variable [acc], setting existential variables
+ to Ind as we go. *)
+ let get context var =
+ try TVarMap.find var context with Not_found -> Ind in
+ let set_ind context var =
+ TVarMap.add var Ind context in
+ let is_ind context var = match get context var with
+ | Ind -> true
+ | Sep | Deepsep -> false in
+ match get_desc param_instance with
+ | Tvar text ->
+ let var = {text; id = get_id param_instance} in
+ (get context var) :: acc, (set_ind context var)
+ | _ ->
+ let instance_exis = free_variables param_instance in
+ if List.for_all (is_ind context) instance_exis then
+ Ind :: acc, context
+ else
+ Deepsep :: acc, List.fold_left set_ind context instance_exis
+ in
+ let mode_signature, context =
+ let (mode_signature_rev, ctx) =
+ List.fold_left handle_equation ([], context) parameters in
+ (* Note: our inference system is not principal, because the
+ inference result depends on the order in which those
+ equations are processed. (To our knowledge this is the only
+ source of non-principality.) If two parameters ('a, 'b) are
+ forced to be equal to each other, and also separable, then
+ either modes (Sep, Ind) and (Ind, Sep) are correct, allow
+ more declarations than (Sep, Sep), but (Ind, Ind) would be
+ unsound.
+
+ Such a non-principal example is the following:
+
+ type ('a, 'b) almost_eq =
+ | Almost_refl : 'c -> ('c, 'c) almost_eq
+
+ (This example looks strange: GADT equations are typically
+ either on only one parameter, or on two parameters that are
+ not used to classify constructor arguments. Indeed, we have
+ not found non-principal declarations in real-world code.)
+
+ In a non-principal system, it is important the our choice of
+ non-unique solution be at least predictable. We find it more
+ natural, when either ('a : Sep, 'b : Ind) and ('a : Ind,
+ 'b : Sep) are correct because 'a = 'b, to choose to make the
+ first/leftmost parameter more constrained. We read this as
+ saying that 'a must be Sep, and 'b = 'a so 'b can be
+ Ind. (We define the second parameter as equal of the first,
+ already-seen parameter; instead of saying that the first
+ parameter is equal to the not-yet-seen second one.)
+
+ This is achieved by processing the equations from left to
+ right with List.fold_left, instead of using
+ List.fold_right. The code is slightly more awkward as it
+ needs a List.rev on the accumulated modes, but it gives
+ a more predictable/natural (non-principal) behavior.
+ *)
+ (List.rev mode_signature_rev, ctx) in
+ (* After all variables determined by the parameters have been set to Ind
+ by [handle_equation], all variables remaining in the context are
+ purely existential and should not require a stronger mode than Ind. *)
+ let check_existential evar mode =
+ if rank mode > rank Ind then
+ raise (Error (decl_loc, Non_separable_evar evar.text))
+ in
+ TVarMap.iter check_existential context;
+ mode_signature
+
+(** [check_def env def] returns the signature required
+ for the type definition [def] in the typing environment [env].
+
+ The exception [Error] is raised if we discover that
+ no such signature exists -- the definition will always be invalid.
+ This only happens when the definition is marked to be unboxed. *)
+
+let check_def
+ : Env.t -> type_definition -> Sep.signature
+ = fun env def ->
+ match structure def with
+ | Abstract ->
+ msig_of_external_type def
+ | Synonym type_expr ->
+ check_type env type_expr Sep
+ |> msig_of_context ~decl_loc:def.type_loc ~parameters:def.type_params
+ | Open | Algebraic ->
+ best_msig def
+ | Unboxed constructor ->
+ check_type env constructor.argument_type Sep
+ |> msig_of_context ~decl_loc:def.type_loc
+ ~parameters:constructor.result_type_parameter_instances
+
+let compute_decl env decl =
+ if Config.flat_float_array then check_def env decl
+ else
+ (* Hack: in -no-flat-float-array mode, instead of always returning
+ [best_msig], we first compute the separability signature --
+ falling back to [best_msig] if it fails.
+
+ This discipline is conservative: it never
+ rejects -no-flat-float-array programs. At the same time it
+ guarantees that, for any program that is also accepted
+ in -flat-float-array mode, the same separability will be
+ inferred in the two modes. In particular, the same .cmi files
+ and digests will be produced.
+
+ Before we introduced this hack, the production of different
+ .cmi files would break the build system of the compiler itself,
+ when trying to build a -no-flat-float-array system from
+ a bootstrap compiler itself using -flat-float-array. See #9291.
+ *)
+ try check_def env decl with
+ | Error _ ->
+ (* It could be nice to emit a warning here, so that users know
+ that their definition would be rejected in -flat-float-array mode *)
+ best_msig decl
+
+(** Separability as a generic property *)
+type prop = Types.Separability.signature
+
+let property : (prop, unit) Typedecl_properties.property =
+ let open Typedecl_properties in
+ let eq ts1 ts2 =
+ List.length ts1 = List.length ts2
+ && List.for_all2 Sep.eq ts1 ts2 in
+ let merge ~prop:_ ~new_prop =
+ (* the update function is monotonous: ~new_prop is always
+ more informative than ~prop, which can be ignored *)
+ new_prop in
+ let default decl = best_msig decl in
+ let compute env decl () = compute_decl env decl in
+ let update_decl decl type_separability = { decl with type_separability } in
+ let check _env _id _decl () = () in (* FIXME run final check? *)
+ { eq; merge; default; compute; update_decl; check; }
+
+(* Definition using the fixpoint infrastructure. *)
+let update_decls env decls =
+ Typedecl_properties.compute_property_noreq property env decls
diff --git a/upstream/ocaml_503/typing/typedecl_separability.mli b/upstream/ocaml_503/typing/typedecl_separability.mli
new file mode 100644
index 0000000000..079e640807
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_separability.mli
@@ -0,0 +1,132 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+(** The OCaml runtime assumes for type-directed optimizations that all types
+ are "separable". A type is "separable" if either all its inhabitants
+ (the values of this type) are floating-point numbers, or none of them are.
+
+ (Note: This assumption is required for the dynamic float array optimization;
+ it is only made if Config.flat_float_array is set,
+ otherwise the code in this module becomes trivial
+ -- see {!compute_decl}.)
+
+ This soundness requirement could be broken by type declarations mixing
+ existentials and the "[@@unboxed]" annotation. Consider the declaration
+
+ {[
+ type any = Any : 'a -> any [@@unboxed]
+ ]}
+
+ which corresponds to the existential type "exists a. a". If this type is
+ allowed to be unboxed, then it is inhabited by both [float] values
+ and non-[float] values. On the contrary, if unboxing is disallowed, the
+ inhabitants are all blocks with the [Any] constructors pointing to its
+ parameter: they may point to a float, but they are not floats.
+
+ The present module contains a static analysis ensuring that declarations
+ annotated with "[@@unboxed]" can be safely unboxed. The idea is to check
+ the "separability" (in the above sense) of the argument type that would
+ be unboxed, and reject the unboxed declaration if it would create a
+ non-separable type.
+
+ Checking mutually-recursive type declarations is a bit subtle.
+ Consider, for example, the following declarations.
+
+ {[
+ type foo = Foo : 'a t -> foo [@@unboxed]
+ and 'a t = ...
+ ]}
+
+ Deciding whether the type [foo] should be accepted requires inspecting
+ the declaration of ['a t], which may itself refer to [foo] in turn.
+ In general, the analysis performs a fixpoint computation. It is somewhat
+ similar to what is done for inferring the variance of type parameters.
+
+ Our analysis is defined using inference rules for our judgment
+ [Def; Gamma |- t : m], in which a type expression [t] is checked
+ against a "mode" [m]. This "mode" describes the separability
+ requirement on the type expression (see below for
+ more details). The mode [Gamma] maps type variables to modes and
+ [Def] records the "mode signature" of the mutually-recursive type
+ declarations that are being checked.
+
+ The "mode signature" of a type with parameters [('a, 'b) t] is of the
+ form [('a : m1, 'b : m2) t], where [m1] and [m2] are modes. Its meaning
+ is the following: a concrete instance [(foo, bar) t] of the type is
+ separable if [foo] has mode [m1] and [bar] has mode [m2]. *)
+
+type error =
+ | Non_separable_evar of string option
+exception Error of Location.t * error
+(** Exception raised when a type declaration is not separable, or when its
+ separability cannot be established. *)
+
+type mode = Types.Separability.t = Ind | Sep | Deepsep
+(** The mode [Sep] ("separable") characterizes types that are indeed separable:
+ either they only contain floating-point values, or none of the values
+ at this type are floating-point values.
+ On a type parameter, it indicates that this parameter must be
+ separable for the whole type definition to be separable. For
+ example, the mode signature for the type declaration [type 'a
+ t = 'a] is [('a : Sep) t]. For the right-hand side to be
+ separable, the parameter ['a] must be separable.
+
+ The mode [Ind] ("indifferent") characterizes any type -- separable
+ or not.
+ On a type parameter, it indicates that this parameter needs not be
+ separable for the whole type definition to be separable. For
+ example, [type 'a t = 'a * bool] does not require its parameter
+ ['a] to be separable as ['a * bool] can never contain [float]
+ values. Its mode signature is thus [('a : Ind) t].
+
+ Finally, the mode [Deepsep] ("deeply separable") characterizes
+ types that are separable, and whose type sub-expressions are also
+ separable. This advanced feature is only used in the presence of
+ constraints.
+ For example, [type 'a t = 'b constraint 'a = 'b * bool]
+ may not be separable even if ['a] is (its separately depends on 'b,
+ a fragment of 'a), so its mode signature is [('a : Deepsep) t].
+
+ The different modes are ordered as [Ind < Sep < Deepsep] (from the least
+ demanding to the most demanding). *)
+
+val compute_decl : Env.t -> Types.type_declaration -> mode list
+(** [compute_decl env def] returns the signature required
+ for the type definition [def] in the typing environment [env]
+ -- including signatures for the current recursive block.
+
+ The {!Error} exception is raised if no such signature exists
+ -- the definition will always be invalid. This only happens
+ when the definition is marked to be unboxed.
+
+ Variant (or record) declarations that are not marked with the
+ "[@@unboxed]" annotation, including those that contain several variants
+ (or labels), are always separable. In particular, their mode signatures
+ do not require anything of their type parameters, which are marked [Ind].
+
+ Finally, if {!Config.flat_float_array} is not set, then separability
+ is not required anymore; we just use [Ind] as the mode of each parameter
+ without any check.
+*)
+
+(** Property interface (see {!Typedecl_properties}). These functions
+ rely on {!compute_decl} and raise the {!Error} exception on error. *)
+type prop = Types.Separability.signature
+val property : (prop, unit) Typedecl_properties.property
+val update_decls :
+ Env.t ->
+ (Ident.t * Typedecl_properties.decl) list ->
+ (Ident.t * Typedecl_properties.decl) list
diff --git a/upstream/ocaml_503/typing/typedecl_unboxed.ml b/upstream/ocaml_503/typing/typedecl_unboxed.ml
new file mode 100644
index 0000000000..16290f0fbb
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_unboxed.ml
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+open Types
+
+(* We use the Ctype.expand_head_opt version of expand_head to get access
+ to the manifest type of private abbreviations. *)
+let rec get_unboxed_type_representation env ty fuel =
+ if fuel < 0 then None else
+ let ty = Ctype.expand_head_opt env ty in
+ match get_desc ty with
+ | Tconstr (p, args, _) ->
+ begin match Env.find_type p env with
+ | exception Not_found -> Some ty
+ | {type_params; type_kind =
+ Type_record ([{ld_type = ty2; _}], Record_unboxed _)
+ | Type_variant ([{cd_args = Cstr_tuple [ty2]; _}], Variant_unboxed)
+ | Type_variant ([{cd_args = Cstr_record [{ld_type = ty2; _}]; _}],
+ Variant_unboxed)}
+ ->
+ let ty2 = match get_desc ty2 with Tpoly (t, _) -> t | _ -> ty2 in
+ get_unboxed_type_representation env
+ (Ctype.apply env type_params ty2 args) (fuel - 1)
+ | _ -> Some ty
+ end
+ | _ -> Some ty
+
+let get_unboxed_type_representation env ty =
+ (* Do not give too much fuel: PR#7424 *)
+ get_unboxed_type_representation env ty 100
diff --git a/upstream/ocaml_503/typing/typedecl_unboxed.mli b/upstream/ocaml_503/typing/typedecl_unboxed.mli
new file mode 100644
index 0000000000..9e860dc128
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_unboxed.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+open Types
+
+(* for typeopt.ml *)
+val get_unboxed_type_representation: Env.t -> type_expr -> type_expr option
diff --git a/upstream/ocaml_503/typing/typedecl_variance.ml b/upstream/ocaml_503/typing/typedecl_variance.ml
new file mode 100644
index 0000000000..c384e8c467
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_variance.ml
@@ -0,0 +1,437 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Types
+
+module TypeSet = Btype.TypeSet
+module TypeMap = Btype.TypeMap
+
+type surface_variance = bool * bool * bool
+
+type variance_variable_context =
+ | Type_declaration of Ident.t * type_declaration
+ | Gadt_constructor of constructor_declaration
+ | Extension_constructor of Ident.t * extension_constructor
+
+type variance_variable_error =
+ | No_variable
+ | Variance_not_reflected
+ | Variance_not_deducible
+
+type variance_error =
+ | Variance_not_satisfied of int
+ | Variance_variable_error of {
+ error : variance_variable_error;
+ context : variance_variable_context;
+ variable : type_expr
+ }
+
+type error =
+ | Bad_variance of variance_error * surface_variance * surface_variance
+ | Varying_anonymous
+
+
+exception Error of Location.t * error
+
+(* Compute variance *)
+
+let get_variance ty visited =
+ try TypeMap.find ty !visited with Not_found -> Variance.null
+
+let compute_variance env visited vari ty =
+ let rec compute_variance_rec vari ty =
+ (* Format.eprintf "%a: %x@." Printtyp.type_expr ty (Obj.magic vari); *)
+ let vari' = get_variance ty visited in
+ if Variance.subset vari vari' then () else
+ let vari = Variance.union vari vari' in
+ visited := TypeMap.add ty vari !visited;
+ let compute_same = compute_variance_rec vari in
+ match get_desc ty with
+ Tarrow (_, ty1, ty2, _) ->
+ compute_variance_rec (Variance.conjugate vari) ty1;
+ compute_same ty2
+ | Ttuple tl ->
+ List.iter compute_same tl
+ | Tconstr (path, tl, _) ->
+ let open Variance in
+ if tl = [] then () else begin
+ try
+ let decl = Env.find_type path env in
+ List.iter2
+ (fun ty v -> compute_variance_rec (compose vari v) ty)
+ tl decl.type_variance
+ with Not_found ->
+ List.iter (compute_variance_rec unknown) tl
+ end
+ | Tobject (ty, _) ->
+ compute_same ty
+ | Tfield (_, _, ty1, ty2) ->
+ compute_same ty1;
+ compute_same ty2
+ | Tsubst _ ->
+ assert false
+ | Tvariant row ->
+ List.iter
+ (fun (_,f) ->
+ match row_field_repr f with
+ Rpresent (Some ty) ->
+ compute_same ty
+ | Reither (_, tyl, _) ->
+ let v = Variance.(inter vari unknown) in (* cf PR#7269 *)
+ List.iter (compute_variance_rec v) tyl
+ | _ -> ())
+ (row_fields row);
+ compute_same (row_more row)
+ | Tpoly (ty, _) ->
+ compute_same ty
+ | Tvar _ | Tnil | Tlink _ | Tunivar _ -> ()
+ | Tpackage (_, fl) ->
+ let v = Variance.(compose vari full) in
+ List.iter (fun (_, ty) -> compute_variance_rec v ty) fl
+ in
+ compute_variance_rec vari ty
+
+let make p n i =
+ let open Variance in
+ set_if p May_pos (set_if n May_neg (set_if i Inj null))
+
+let injective = Variance.(set Inj null)
+
+let compute_variance_type env ~check (required, loc) decl tyl =
+ (* Requirements *)
+ let check_injectivity = Btype.type_kind_is_abstract decl in
+ let required =
+ List.map
+ (fun (c,n,i) ->
+ let i = if check_injectivity then i else false in
+ if c || n then (c,n,i) else (true,true,i))
+ required
+ in
+ (* Prepare *)
+ let params = decl.type_params in
+ let tvl = ref TypeMap.empty in
+ (* Compute occurrences in the body *)
+ let open Variance in
+ List.iter
+ (fun (cn,ty) ->
+ compute_variance env tvl (if cn then full else covariant) ty)
+ tyl;
+ (* Infer injectivity of constrained parameters *)
+ if check_injectivity then
+ List.iter
+ (fun ty ->
+ if Btype.is_Tvar ty || mem Inj (get_variance ty tvl) then () else
+ let visited = ref TypeSet.empty in
+ let rec check ty =
+ if TypeSet.mem ty !visited then () else begin
+ visited := TypeSet.add ty !visited;
+ if mem Inj (get_variance ty tvl) then () else
+ match get_desc ty with
+ | Tvar _ -> raise Exit
+ | Tconstr _ ->
+ let old = !visited in
+ begin try
+ Btype.iter_type_expr check ty
+ with Exit ->
+ visited := old;
+ let ty' = Ctype.expand_head_opt env ty in
+ if eq_type ty ty' then raise Exit else check ty'
+ end
+ | _ -> Btype.iter_type_expr check ty
+ end
+ in
+ try check ty; compute_variance env tvl injective ty
+ with Exit -> ())
+ params;
+ begin match check with
+ | None -> ()
+ | Some context ->
+ (* Check variance of parameters *)
+ let pos = ref 0 in
+ List.iter2
+ (fun ty (c, n, i) ->
+ incr pos;
+ let var = get_variance ty tvl in
+ let (co,cn) = get_upper var and ij = mem Inj var in
+ if Btype.is_Tvar ty && (co && not c || cn && not n) || not ij && i
+ then raise (Error(loc, Bad_variance
+ (Variance_not_satisfied !pos,
+ (co,cn,ij),
+ (c,n,i)))))
+ params required;
+ (* Check propagation from constrained parameters *)
+ let args = Btype.newgenty (Ttuple params) in
+ let fvl = Ctype.free_variables args in
+ let fvl =
+ List.filter (fun v -> not (List.exists (eq_type v) params)) fvl in
+ (* If there are no extra variables there is nothing to do *)
+ if fvl = [] then () else
+ let tvl2 = ref TypeMap.empty in
+ List.iter2
+ (fun ty (p,n,_) ->
+ if Btype.is_Tvar ty then () else
+ let v =
+ if p then if n then full else covariant else conjugate covariant in
+ compute_variance env tvl2 v ty)
+ params required;
+ let visited = ref TypeSet.empty in
+ let rec check ty =
+ if TypeSet.mem ty !visited then () else
+ let visited' = TypeSet.add ty !visited in
+ visited := visited';
+ let v1 = get_variance ty tvl in
+ let snap = Btype.snapshot () in
+ let v2 =
+ TypeMap.fold
+ (fun t vt v ->
+ if Ctype.is_equal env false [ty] [t] then union vt v else v)
+ !tvl2 null in
+ Btype.backtrack snap;
+ let (c1,n1) = get_upper v1 and (c2,n2,i2) = get_lower v2 in
+ if c1 && not c2 || n1 && not n2 then begin
+ match List.find_opt (eq_type ty) fvl with
+ | Some variable ->
+ let error =
+ if not i2 then
+ No_variable
+ else if c2 || n2 then
+ Variance_not_reflected
+ else
+ Variance_not_deducible
+ in
+ let variance_error =
+ Variance_variable_error { error; context; variable }
+ in
+ raise
+ (Error (loc
+ , Bad_variance ( variance_error
+ , (c1,n1,false)
+ , (c2,n2,false))))
+ | None ->
+ Btype.iter_type_expr check ty
+ end
+ in
+ List.iter (fun (_,ty) -> check ty) tyl;
+ end;
+ List.map2
+ (fun ty (p, n, _i) ->
+ let v = get_variance ty tvl in
+ let tr = decl.type_private in
+ (* Use required variance where relevant *)
+ let concr = not (Btype.type_kind_is_abstract decl) in
+ let (p, n) =
+ if tr = Private || not (Btype.is_Tvar ty) then (p, n) (* set *)
+ else (false, false) (* only check *)
+ and i = concr in
+ let v = union v (make p n i) in
+ if not concr || Btype.is_Tvar ty then v else
+ union v
+ (if p then if n then full else covariant else conjugate covariant))
+ params required
+
+let add_false = List.map (fun ty -> false, ty)
+
+(* A parameter is constrained if it is either instantiated,
+ or it is a variable appearing in another parameter *)
+let constrained vars ty =
+ match get_desc ty with
+ | Tvar _ -> List.exists (List.exists (eq_type ty)) vars
+ | _ -> true
+
+let for_constr = function
+ | Types.Cstr_tuple l -> add_false l
+ | Types.Cstr_record l ->
+ List.map
+ (fun {Types.ld_mutable; ld_type} -> (ld_mutable = Mutable, ld_type))
+ l
+
+let compute_variance_gadt env ~check (required, loc as rloc) decl
+ (tl, ret_type_opt) =
+ match ret_type_opt with
+ | None ->
+ compute_variance_type env ~check rloc {decl with type_private = Private}
+ (for_constr tl)
+ | Some ret_type ->
+ match get_desc ret_type with
+ | Tconstr (_, tyl, _) ->
+ (* let tyl = List.map (Ctype.expand_head env) tyl in *)
+ let fvl = List.map (Ctype.free_variables ?env:None) tyl in
+ let _ =
+ List.fold_left2
+ (fun (fv1,fv2) ty (c,n,_) ->
+ match fv2 with [] -> assert false
+ | fv :: fv2 ->
+ (* fv1 @ fv2 = free_variables of other parameters *)
+ if (c||n) && constrained (fv1 @ fv2) ty then
+ raise (Error(loc, Varying_anonymous));
+ (fv :: fv1, fv2))
+ ([], fvl) tyl required
+ in
+ compute_variance_type env ~check rloc
+ {decl with type_params = tyl; type_private = Private}
+ (for_constr tl)
+ | _ -> assert false
+
+let compute_variance_extension env decl ext rloc =
+ let check =
+ Some (Extension_constructor (ext.Typedtree.ext_id, ext.Typedtree.ext_type))
+ in
+ let ext = ext.Typedtree.ext_type in
+ compute_variance_gadt env ~check rloc
+ {decl with type_params = ext.ext_type_params}
+ (ext.ext_args, ext.ext_ret_type)
+
+let compute_variance_gadt_constructor env ~check rloc decl tl =
+ let check =
+ match check with
+ | Some _ -> Some (Gadt_constructor tl)
+ | None -> None
+ in
+ compute_variance_gadt env ~check rloc decl
+ (tl.Types.cd_args, tl.Types.cd_res)
+
+let compute_variance_decl env ~check decl (required, _ as rloc) =
+ let check =
+ Option.map (fun id -> Type_declaration (id, decl)) check
+ in
+ let abstract = Btype.type_kind_is_abstract decl in
+ if (abstract || decl.type_kind = Type_open) && decl.type_manifest = None then
+ List.map
+ (fun (c, n, i) -> make (not n) (not c) (not abstract || i))
+ required
+ else begin
+ let mn =
+ match decl.type_manifest with
+ None -> []
+ | Some ty -> [ false, ty ]
+ in
+ let vari =
+ match decl.type_kind with
+ Type_abstract _ | Type_open ->
+ compute_variance_type env ~check rloc decl mn
+ | Type_variant (tll,_rep) ->
+ if List.for_all (fun c -> c.Types.cd_res = None) tll then
+ compute_variance_type env ~check rloc decl
+ (mn @ List.flatten (List.map (fun c -> for_constr c.Types.cd_args)
+ tll))
+ else begin
+ let vari =
+ List.map
+ (fun ty ->
+ compute_variance_type env ~check rloc
+ {decl with type_private = Private}
+ (add_false [ ty ])
+ )
+ (Option.to_list decl.type_manifest)
+ in
+ let constructor_variance =
+ List.map
+ (compute_variance_gadt_constructor env ~check rloc decl)
+ tll
+ in
+ match List.append vari constructor_variance with
+ | vari :: rem ->
+ List.fold_left (List.map2 Variance.union) vari rem
+ | _ -> assert false
+ end
+ | Type_record (ftl, _) ->
+ compute_variance_type env ~check rloc decl
+ (mn @ List.map (fun {Types.ld_mutable; ld_type} ->
+ (ld_mutable = Mutable, ld_type)) ftl)
+ in
+ if mn = [] || not abstract then
+ List.map Variance.strengthen vari
+ else vari
+ end
+
+let is_hash id =
+ let s = Ident.name id in
+ String.length s > 0 && s.[0] = '#'
+
+let check_variance_extension env decl ext rloc =
+ (* TODO: refactorize compute_variance_extension *)
+ ignore (compute_variance_extension env decl ext rloc)
+
+let compute_decl env ~check decl req =
+ compute_variance_decl env ~check decl (req, decl.type_loc)
+
+let check_decl env id decl req =
+ ignore (compute_variance_decl env ~check:(Some id) decl (req, decl.type_loc))
+
+type prop = Variance.t list
+type req = surface_variance list
+let property : (prop, req) Typedecl_properties.property =
+ let open Typedecl_properties in
+ let eq li1 li2 =
+ try List.for_all2 Variance.eq li1 li2 with _ -> false in
+ let merge ~prop ~new_prop =
+ List.map2 Variance.union prop new_prop in
+ let default decl =
+ List.map (fun _ -> Variance.null) decl.type_params in
+ let compute env decl req =
+ compute_decl env ~check:None decl req in
+ let update_decl decl variance =
+ { decl with type_variance = variance } in
+ let check env id decl req =
+ if is_hash id then () else check_decl env id decl req in
+ {
+ eq;
+ merge;
+ default;
+ compute;
+ update_decl;
+ check;
+ }
+
+let transl_variance (v, i) =
+ let co, cn =
+ match v with
+ | Covariant -> (true, false)
+ | Contravariant -> (false, true)
+ | NoVariance -> (false, false)
+ in
+ (co, cn, match i with Injective -> true | NoInjectivity -> false)
+
+let variance_of_params ptype_params =
+ List.map transl_variance (List.map snd ptype_params)
+
+let variance_of_sdecl sdecl =
+ variance_of_params sdecl.Parsetree.ptype_params
+
+let update_decls env sdecls decls =
+ let required = List.map variance_of_sdecl sdecls in
+ Typedecl_properties.compute_property property env decls required
+
+let update_class_decls env cldecls =
+ let decls, required =
+ List.fold_right
+ (fun (obj_id, obj_abbr, _clty, _cltydef, ci) (decls, req) ->
+ (obj_id, obj_abbr) :: decls,
+ variance_of_params ci.Typedtree.ci_params :: req)
+ cldecls ([],[])
+ in
+ let decls =
+ Typedecl_properties.compute_property property env decls required in
+ List.map2
+ (fun (_,decl) (_, _, clty, cltydef, _) ->
+ let variance = decl.type_variance in
+ (decl, {clty with cty_variance = variance},
+ {cltydef with
+ clty_variance = variance;
+ clty_hash_type = {cltydef.clty_hash_type with type_variance = variance}
+ }))
+ decls cldecls
diff --git a/upstream/ocaml_503/typing/typedecl_variance.mli b/upstream/ocaml_503/typing/typedecl_variance.mli
new file mode 100644
index 0000000000..6392e61dd1
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedecl_variance.mli
@@ -0,0 +1,75 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 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. *)
+(* *)
+(**************************************************************************)
+
+open Types
+open Typedecl_properties
+
+type surface_variance = bool * bool * bool
+
+val variance_of_params :
+ (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list ->
+ surface_variance list
+val variance_of_sdecl :
+ Parsetree.type_declaration -> surface_variance list
+
+type prop = Variance.t list
+type req = surface_variance list
+val property : (Variance.t list, req) property
+
+type variance_variable_context =
+ | Type_declaration of Ident.t * type_declaration
+ | Gadt_constructor of constructor_declaration
+ | Extension_constructor of Ident.t * extension_constructor
+
+type variance_variable_error =
+ | No_variable
+ | Variance_not_reflected
+ | Variance_not_deducible
+
+type variance_error =
+ | Variance_not_satisfied of int
+ | Variance_variable_error of {
+ error : variance_variable_error;
+ context : variance_variable_context;
+ variable : type_expr
+ }
+
+type error =
+ | Bad_variance of variance_error * surface_variance * surface_variance
+ | Varying_anonymous
+
+exception Error of Location.t * error
+
+val check_variance_extension :
+ Env.t -> type_declaration ->
+ Typedtree.extension_constructor -> req * Location.t -> unit
+
+val compute_decl :
+ Env.t -> check:Ident.t option -> type_declaration -> req -> prop
+
+val update_decls :
+ Env.t -> Parsetree.type_declaration list ->
+ (Ident.t * type_declaration) list ->
+ (Ident.t * type_declaration) list
+
+val update_class_decls :
+ Env.t ->
+ (Ident.t * Typedecl_properties.decl *
+ Types.class_declaration * Types.class_type_declaration *
+ 'a Typedtree.class_infos) list ->
+ (Typedecl_properties.decl *
+ Types.class_declaration * Types.class_type_declaration) list
+(* FIXME: improve this horrible interface *)
diff --git a/upstream/ocaml_503/typing/typedtree.ml b/upstream/ocaml_503/typing/typedtree.ml
new file mode 100644
index 0000000000..ff0060e135
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedtree.ml
@@ -0,0 +1,895 @@
+(**************************************************************************)
+(* *)
+(* 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 after typing *)
+
+open Asttypes
+open Types
+
+module Uid = Shape.Uid
+
+(* Value expressions for the core language *)
+
+type partial = Partial | Total
+
+type attribute = Parsetree.attribute
+type attributes = attribute list
+
+type value = Value_pattern
+type computation = Computation_pattern
+
+type _ pattern_category =
+| Value : value pattern_category
+| Computation : computation pattern_category
+
+type pattern = value general_pattern
+and 'k general_pattern = 'k pattern_desc pattern_data
+
+and 'a pattern_data =
+ { pat_desc: 'a;
+ pat_loc: Location.t;
+ pat_extra : (pat_extra * Location.t * attribute list) list;
+ pat_type: type_expr;
+ pat_env: Env.t;
+ pat_attributes: attribute list;
+ }
+
+and pat_extra =
+ | Tpat_constraint of core_type
+ | Tpat_type of Path.t * Longident.t loc
+ | Tpat_open of Path.t * Longident.t loc * Env.t
+ | Tpat_unpack
+
+and 'k pattern_desc =
+ (* value patterns *)
+ | Tpat_any : value pattern_desc
+ | Tpat_var : Ident.t * string loc * Uid.t -> value pattern_desc
+ | Tpat_alias :
+ value general_pattern * Ident.t * string loc * Uid.t -> value pattern_desc
+ | Tpat_constant : constant -> value pattern_desc
+ | Tpat_tuple : value general_pattern list -> value pattern_desc
+ | Tpat_construct :
+ Longident.t loc * constructor_description * value general_pattern list
+ * (Ident.t loc list * core_type) option ->
+ value pattern_desc
+ | Tpat_variant :
+ label * value general_pattern option * row_desc ref ->
+ value pattern_desc
+ | Tpat_record :
+ (Longident.t loc * label_description * value general_pattern) list *
+ closed_flag ->
+ value pattern_desc
+ | Tpat_array : value general_pattern list -> value pattern_desc
+ | Tpat_lazy : value general_pattern -> value pattern_desc
+ (* computation patterns *)
+ | Tpat_value : tpat_value_argument -> computation pattern_desc
+ | Tpat_exception : value general_pattern -> computation pattern_desc
+ (* generic constructions *)
+ | Tpat_or :
+ 'k general_pattern * 'k general_pattern * row_desc option ->
+ 'k pattern_desc
+
+and tpat_value_argument = value general_pattern
+
+and expression =
+ { exp_desc: expression_desc;
+ exp_loc: Location.t;
+ exp_extra: (exp_extra * Location.t * attribute list) list;
+ exp_type: type_expr;
+ exp_env: Env.t;
+ exp_attributes: attribute list;
+ }
+
+and exp_extra =
+ | Texp_constraint of core_type
+ | Texp_coerce of core_type option * core_type
+ | Texp_poly of core_type option
+ | Texp_newtype of string
+
+and expression_desc =
+ Texp_ident of Path.t * Longident.t loc * Types.value_description
+ | Texp_constant of constant
+ | Texp_let of rec_flag * value_binding list * expression
+ | Texp_function of function_param list * function_body
+ | Texp_apply of expression * (arg_label * expression option) list
+ | Texp_match of expression * computation case list * value case list * partial
+ | Texp_try of expression * value case list * value case list
+ | Texp_tuple of expression list
+ | Texp_construct of
+ Longident.t loc * constructor_description * expression list
+ | Texp_variant of label * expression option
+ | Texp_record of {
+ fields : ( Types.label_description * record_label_definition ) array;
+ representation : Types.record_representation;
+ extended_expression : expression option;
+ }
+ | Texp_field of expression * Longident.t loc * label_description
+ | Texp_setfield of
+ expression * Longident.t loc * label_description * expression
+ | Texp_array of expression list
+ | Texp_ifthenelse of expression * expression * expression option
+ | Texp_sequence of expression * expression
+ | Texp_while of expression * expression
+ | Texp_for of
+ Ident.t * Parsetree.pattern * expression * expression * direction_flag *
+ expression
+ | Texp_send of expression * meth
+ | Texp_new of Path.t * Longident.t loc * Types.class_declaration
+ | Texp_instvar of Path.t * Path.t * string loc
+ | Texp_setinstvar of Path.t * Path.t * string loc * expression
+ | Texp_override of Path.t * (Ident.t * string loc * expression) list
+ | Texp_letmodule of
+ Ident.t option * string option loc * Types.module_presence * module_expr *
+ expression
+ | Texp_letexception of extension_constructor * expression
+ | Texp_assert of expression * Location.t
+ | Texp_lazy of expression
+ | Texp_object of class_structure * string list
+ | Texp_pack of module_expr
+ | Texp_letop of {
+ let_ : binding_op;
+ ands : binding_op list;
+ param : Ident.t;
+ body : value case;
+ partial : partial;
+ }
+ | Texp_unreachable
+ | Texp_extension_constructor of Longident.t loc * Path.t
+ | Texp_open of open_declaration * expression
+
+and meth =
+ | Tmeth_name of string
+ | Tmeth_val of Ident.t
+ | Tmeth_ancestor of Ident.t * Path.t
+
+and 'k case =
+ {
+ c_lhs: 'k general_pattern;
+ c_cont: Ident.t option;
+ c_guard: expression option;
+ c_rhs: expression;
+ }
+
+and function_param =
+ {
+ fp_arg_label: arg_label;
+ fp_param: Ident.t;
+ fp_partial: partial;
+ fp_kind: function_param_kind;
+ fp_newtypes: string loc list;
+ fp_loc : Location.t;
+ }
+
+and function_param_kind =
+ | Tparam_pat of pattern
+ | Tparam_optional_default of pattern * expression
+
+and function_body =
+ | Tfunction_body of expression
+ | Tfunction_cases of
+ { cases: value case list;
+ partial: partial;
+ param: Ident.t;
+ loc: Location.t;
+ exp_extra: exp_extra option;
+ attributes: attributes;
+ }
+
+and record_label_definition =
+ | Kept of Types.type_expr * mutable_flag
+ | Overridden of Longident.t loc * expression
+
+and binding_op =
+ {
+ bop_op_path : Path.t;
+ bop_op_name : string loc;
+ bop_op_val : Types.value_description;
+ bop_op_type : Types.type_expr;
+ bop_exp : expression;
+ bop_loc : Location.t;
+ }
+
+(* Value expressions for the class language *)
+
+and class_expr =
+ {
+ cl_desc: class_expr_desc;
+ cl_loc: Location.t;
+ cl_type: Types.class_type;
+ cl_env: Env.t;
+ cl_attributes: attribute list;
+ }
+
+and class_expr_desc =
+ Tcl_ident of Path.t * Longident.t loc * core_type list
+ | Tcl_structure of class_structure
+ | Tcl_fun of
+ arg_label * pattern * (Ident.t * expression) list
+ * class_expr * partial
+ | Tcl_apply of class_expr * (arg_label * expression option) list
+ | Tcl_let of rec_flag * value_binding list *
+ (Ident.t * expression) list * class_expr
+ | Tcl_constraint of
+ class_expr * class_type option * string list * string list * MethSet.t
+ (* Visible instance variables, methods and concrete methods *)
+ | Tcl_open of open_description * class_expr
+
+and class_structure =
+ {
+ cstr_self: pattern;
+ cstr_fields: class_field list;
+ cstr_type: Types.class_signature;
+ cstr_meths: Ident.t Meths.t;
+ }
+
+and class_field =
+ {
+ cf_desc: class_field_desc;
+ cf_loc: Location.t;
+ cf_attributes: attribute list;
+ }
+
+and class_field_kind =
+ | Tcfk_virtual of core_type
+ | Tcfk_concrete of override_flag * expression
+
+and class_field_desc =
+ Tcf_inherit of
+ override_flag * class_expr * string option * (string * Ident.t) list *
+ (string * Ident.t) list
+ (* Inherited instance variables and concrete methods *)
+ | Tcf_val of string loc * mutable_flag * Ident.t * class_field_kind * bool
+ | Tcf_method of string loc * private_flag * class_field_kind
+ | Tcf_constraint of core_type * core_type
+ | Tcf_initializer of expression
+ | Tcf_attribute of attribute
+
+(* Value expressions for the module language *)
+
+and module_expr =
+ { mod_desc: module_expr_desc;
+ mod_loc: Location.t;
+ mod_type: Types.module_type;
+ mod_env: Env.t;
+ mod_attributes: attribute list;
+ }
+
+and module_type_constraint =
+ Tmodtype_implicit
+| Tmodtype_explicit of module_type
+
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * string option loc * module_type
+
+and module_expr_desc =
+ Tmod_ident of Path.t * Longident.t loc
+ | Tmod_structure of structure
+ | Tmod_functor of functor_parameter * module_expr
+ | Tmod_apply of module_expr * module_expr * module_coercion
+ | Tmod_apply_unit of module_expr
+ | Tmod_constraint of
+ module_expr * Types.module_type * module_type_constraint * module_coercion
+ | Tmod_unpack of expression * Types.module_type
+
+and structure = {
+ str_items : structure_item list;
+ str_type : Types.signature;
+ str_final_env : Env.t;
+}
+
+and structure_item =
+ { str_desc : structure_item_desc;
+ str_loc : Location.t;
+ str_env : Env.t
+ }
+
+and structure_item_desc =
+ Tstr_eval of expression * attributes
+ | Tstr_value of rec_flag * value_binding list
+ | Tstr_primitive of value_description
+ | Tstr_type of rec_flag * type_declaration list
+ | Tstr_typext of type_extension
+ | Tstr_exception of type_exception
+ | Tstr_module of module_binding
+ | Tstr_recmodule of module_binding list
+ | Tstr_modtype of module_type_declaration
+ | Tstr_open of open_declaration
+ | Tstr_class of (class_declaration * string list) list
+ | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
+ | Tstr_include of include_declaration
+ | Tstr_attribute of attribute
+
+and module_binding =
+ {
+ mb_id: Ident.t option;
+ mb_name: string option loc;
+ mb_uid: Uid.t;
+ mb_presence: module_presence;
+ mb_expr: module_expr;
+ mb_attributes: attribute list;
+ mb_loc: Location.t;
+ }
+
+and value_binding =
+ {
+ vb_pat: pattern;
+ vb_expr: expression;
+ vb_rec_kind: Value_rec_types.recursive_binding_kind;
+ vb_attributes: attributes;
+ vb_loc: Location.t;
+ }
+
+and module_coercion =
+ Tcoerce_none
+ | Tcoerce_structure of (int * module_coercion) list *
+ (Ident.t * int * module_coercion) list
+ | Tcoerce_functor of module_coercion * module_coercion
+ | Tcoerce_primitive of primitive_coercion
+ | Tcoerce_alias of Env.t * Path.t * module_coercion
+
+and module_type =
+ { mty_desc: module_type_desc;
+ mty_type : Types.module_type;
+ mty_env : Env.t;
+ mty_loc: Location.t;
+ mty_attributes: attribute list;
+ }
+
+and module_type_desc =
+ Tmty_ident of Path.t * Longident.t loc
+ | Tmty_signature of signature
+ | Tmty_functor of functor_parameter * module_type
+ | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
+ | Tmty_typeof of module_expr
+ | Tmty_alias of Path.t * Longident.t loc
+
+(* Keep primitive type information for type-based lambda-code specialization *)
+and primitive_coercion =
+ {
+ pc_desc: Primitive.description;
+ pc_type: type_expr;
+ pc_env: Env.t;
+ pc_loc : Location.t;
+ }
+
+and signature = {
+ sig_items : signature_item list;
+ sig_type : Types.signature;
+ sig_final_env : Env.t;
+}
+
+and signature_item =
+ { sig_desc: signature_item_desc;
+ sig_env : Env.t; (* BINANNOT ADDED *)
+ sig_loc: Location.t }
+
+and signature_item_desc =
+ Tsig_value of value_description
+ | Tsig_type of rec_flag * type_declaration list
+ | Tsig_typesubst of type_declaration list
+ | Tsig_typext of type_extension
+ | Tsig_exception of type_exception
+ | Tsig_module of module_declaration
+ | Tsig_modsubst of module_substitution
+ | Tsig_recmodule of module_declaration list
+ | Tsig_modtype of module_type_declaration
+ | Tsig_modtypesubst of module_type_declaration
+ | Tsig_open of open_description
+ | Tsig_include of include_description
+ | Tsig_class of class_description list
+ | Tsig_class_type of class_type_declaration list
+ | Tsig_attribute of attribute
+
+and module_declaration =
+ {
+ md_id: Ident.t option;
+ md_name: string option loc;
+ md_uid: Uid.t;
+ md_presence: module_presence;
+ md_type: module_type;
+ md_attributes: attribute list;
+ md_loc: Location.t;
+ }
+
+and module_substitution =
+ {
+ ms_id: Ident.t;
+ ms_name: string loc;
+ ms_uid: Uid.t;
+ ms_manifest: Path.t;
+ ms_txt: Longident.t loc;
+ ms_attributes: attributes;
+ ms_loc: Location.t;
+ }
+
+and module_type_declaration =
+ {
+ mtd_id: Ident.t;
+ mtd_name: string loc;
+ mtd_uid: Uid.t;
+ mtd_type: module_type option;
+ mtd_attributes: attribute list;
+ mtd_loc: Location.t;
+ }
+
+and 'a open_infos =
+ {
+ open_expr: 'a;
+ open_bound_items: Types.signature;
+ open_override: override_flag;
+ open_env: Env.t;
+ open_loc: Location.t;
+ open_attributes: attribute list;
+ }
+
+and open_description = (Path.t * Longident.t loc) open_infos
+
+and open_declaration = module_expr open_infos
+
+and 'a include_infos =
+ {
+ incl_mod: 'a;
+ incl_type: Types.signature;
+ incl_loc: Location.t;
+ incl_attributes: attribute list;
+ }
+
+and include_description = module_type include_infos
+
+and include_declaration = module_expr include_infos
+
+and with_constraint =
+ Twith_type of type_declaration
+ | Twith_module of Path.t * Longident.t loc
+ | Twith_modtype of module_type
+ | Twith_typesubst of type_declaration
+ | Twith_modsubst of Path.t * Longident.t loc
+ | Twith_modtypesubst of module_type
+
+
+and core_type =
+(* mutable because of [Typeclass.declare_method] *)
+ { mutable ctyp_desc : core_type_desc;
+ mutable ctyp_type : type_expr;
+ ctyp_env : Env.t; (* BINANNOT ADDED *)
+ ctyp_loc : Location.t;
+ ctyp_attributes: attribute list;
+ }
+
+and core_type_desc =
+ Ttyp_any
+ | Ttyp_var of string
+ | Ttyp_arrow of arg_label * core_type * core_type
+ | Ttyp_tuple of core_type list
+ | Ttyp_constr of Path.t * Longident.t loc * core_type list
+ | Ttyp_object of object_field list * closed_flag
+ | Ttyp_class of Path.t * Longident.t loc * core_type list
+ | Ttyp_alias of core_type * string loc
+ | Ttyp_variant of row_field list * closed_flag * label list option
+ | Ttyp_poly of string list * core_type
+ | Ttyp_package of package_type
+ | Ttyp_open of Path.t * Longident.t loc * core_type
+
+and package_type = {
+ pack_path : Path.t;
+ pack_fields : (Longident.t loc * core_type) list;
+ pack_type : Types.module_type;
+ pack_txt : Longident.t loc;
+}
+
+and row_field = {
+ rf_desc : row_field_desc;
+ rf_loc : Location.t;
+ rf_attributes : attributes;
+}
+
+and row_field_desc =
+ Ttag of string loc * bool * core_type list
+ | Tinherit of core_type
+
+and object_field = {
+ of_desc : object_field_desc;
+ of_loc : Location.t;
+ of_attributes : attributes;
+}
+
+and object_field_desc =
+ | OTtag of string loc * core_type
+ | OTinherit of core_type
+
+and value_description =
+ { val_id: Ident.t;
+ val_name: string loc;
+ val_desc: core_type;
+ val_val: Types.value_description;
+ val_prim: string list;
+ val_loc: Location.t;
+ val_attributes: attribute list;
+ }
+
+and type_declaration =
+ { typ_id: Ident.t;
+ typ_name: string loc;
+ typ_params: (core_type * (variance * injectivity)) list;
+ typ_type: Types.type_declaration;
+ typ_cstrs: (core_type * core_type * Location.t) list;
+ typ_kind: type_kind;
+ typ_private: private_flag;
+ typ_manifest: core_type option;
+ typ_loc: Location.t;
+ typ_attributes: attribute list;
+ }
+
+and type_kind =
+ Ttype_abstract
+ | Ttype_variant of constructor_declaration list
+ | Ttype_record of label_declaration list
+ | Ttype_open
+
+and label_declaration =
+ {
+ ld_id: Ident.t;
+ ld_name: string loc;
+ ld_uid: Uid.t;
+ ld_mutable: mutable_flag;
+ ld_type: core_type;
+ ld_loc: Location.t;
+ ld_attributes: attribute list;
+ }
+
+and constructor_declaration =
+ {
+ cd_id: Ident.t;
+ cd_name: string loc;
+ cd_uid: Uid.t;
+ cd_vars: string loc list;
+ cd_args: constructor_arguments;
+ cd_res: core_type option;
+ cd_loc: Location.t;
+ cd_attributes: attribute list;
+ }
+
+and constructor_arguments =
+ | Cstr_tuple of core_type list
+ | Cstr_record of label_declaration list
+
+and type_extension =
+ {
+ tyext_path: Path.t;
+ tyext_txt: Longident.t loc;
+ tyext_params: (core_type * (variance * injectivity)) list;
+ tyext_constructors: extension_constructor list;
+ tyext_private: private_flag;
+ tyext_loc: Location.t;
+ tyext_attributes: attribute list;
+ }
+
+and type_exception =
+ {
+ tyexn_constructor: extension_constructor;
+ tyexn_loc: Location.t;
+ tyexn_attributes: attribute list;
+ }
+
+and extension_constructor =
+ {
+ ext_id: Ident.t;
+ ext_name: string loc;
+ ext_type: Types.extension_constructor;
+ ext_kind: extension_constructor_kind;
+ ext_loc: Location.t;
+ ext_attributes: attribute list;
+ }
+
+and extension_constructor_kind =
+ Text_decl of string loc list * constructor_arguments * core_type option
+ | Text_rebind of Path.t * Longident.t loc
+
+and class_type =
+ {
+ cltyp_desc: class_type_desc;
+ cltyp_type: Types.class_type;
+ cltyp_env: Env.t;
+ cltyp_loc: Location.t;
+ cltyp_attributes: attribute list;
+ }
+
+and class_type_desc =
+ Tcty_constr of Path.t * Longident.t loc * core_type list
+ | Tcty_signature of class_signature
+ | Tcty_arrow of arg_label * core_type * class_type
+ | Tcty_open of open_description * class_type
+
+and class_signature = {
+ csig_self: core_type;
+ csig_fields: class_type_field list;
+ csig_type: Types.class_signature;
+ }
+
+and class_type_field = {
+ ctf_desc: class_type_field_desc;
+ ctf_loc: Location.t;
+ ctf_attributes: attribute list;
+ }
+
+and class_type_field_desc =
+ | Tctf_inherit of class_type
+ | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
+ | Tctf_method of (string * private_flag * virtual_flag * core_type)
+ | Tctf_constraint of (core_type * core_type)
+ | Tctf_attribute of attribute
+
+and class_declaration =
+ class_expr class_infos
+
+and class_description =
+ class_type class_infos
+
+and class_type_declaration =
+ class_type class_infos
+
+and 'a class_infos =
+ { ci_virt: virtual_flag;
+ ci_params: (core_type * (variance * injectivity)) list;
+ ci_id_name: string loc;
+ ci_id_class: Ident.t;
+ ci_id_class_type: Ident.t;
+ ci_id_object: Ident.t;
+ ci_expr: 'a;
+ ci_decl: Types.class_declaration;
+ ci_type_decl: Types.class_type_declaration;
+ ci_loc: Location.t;
+ ci_attributes: attribute list;
+ }
+
+type implementation = {
+ structure: structure;
+ coercion: module_coercion;
+ signature: Types.signature;
+ shape: Shape.t;
+}
+
+type item_declaration =
+ | Value of value_description
+ | Value_binding of value_binding
+ | Type of type_declaration
+ | Constructor of constructor_declaration
+ | Extension_constructor of extension_constructor
+ | Label of label_declaration
+ | Module of module_declaration
+ | Module_substitution of module_substitution
+ | Module_binding of module_binding
+ | Module_type of module_type_declaration
+ | Class of class_declaration
+ | Class_type of class_type_declaration
+
+(* Auxiliary functions over the a.s.t. *)
+
+let as_computation_pattern (p : pattern) : computation general_pattern =
+ {
+ pat_desc = Tpat_value p;
+ pat_loc = p.pat_loc;
+ pat_extra = [];
+ pat_type = p.pat_type;
+ pat_env = p.pat_env;
+ pat_attributes = [];
+ }
+
+let rec classify_pattern_desc : type k . k pattern_desc -> k pattern_category =
+ function
+ | Tpat_alias _ -> Value
+ | Tpat_tuple _ -> Value
+ | Tpat_construct _ -> Value
+ | Tpat_variant _ -> Value
+ | Tpat_record _ -> Value
+ | Tpat_array _ -> Value
+ | Tpat_lazy _ -> Value
+ | Tpat_any -> Value
+ | Tpat_var _ -> Value
+ | Tpat_constant _ -> Value
+
+ | Tpat_value _ -> Computation
+ | Tpat_exception _ -> Computation
+
+ | Tpat_or(p1, p2, _) ->
+ begin match classify_pattern p1, classify_pattern p2 with
+ | Value, Value -> Value
+ | Computation, Computation -> Computation
+ end
+
+and classify_pattern
+ : type k . k general_pattern -> k pattern_category
+ = fun pat ->
+ classify_pattern_desc pat.pat_desc
+
+type pattern_action =
+ { f : 'k . 'k general_pattern -> unit }
+let shallow_iter_pattern_desc
+ : type k . pattern_action -> k pattern_desc -> unit
+ = fun f -> function
+ | Tpat_alias(p, _, _, _) -> f.f p
+ | Tpat_tuple patl -> List.iter f.f patl
+ | Tpat_construct(_, _, patl, _) -> List.iter f.f patl
+ | Tpat_variant(_, pat, _) -> Option.iter f.f pat
+ | Tpat_record (lbl_pat_list, _) ->
+ List.iter (fun (_, _, pat) -> f.f pat) lbl_pat_list
+ | Tpat_array patl -> List.iter f.f patl
+ | Tpat_lazy p -> f.f p
+ | Tpat_any
+ | Tpat_var _
+ | Tpat_constant _ -> ()
+ | Tpat_value p -> f.f p
+ | Tpat_exception p -> f.f p
+ | Tpat_or(p1, p2, _) -> f.f p1; f.f p2
+
+type pattern_transformation =
+ { f : 'k . 'k general_pattern -> 'k general_pattern }
+let shallow_map_pattern_desc
+ : type k . pattern_transformation -> k pattern_desc -> k pattern_desc
+ = fun f d -> match d with
+ | Tpat_alias (p1, id, s, uid) ->
+ Tpat_alias (f.f p1, id, s, uid)
+ | Tpat_tuple pats ->
+ Tpat_tuple (List.map f.f pats)
+ | Tpat_record (lpats, closed) ->
+ Tpat_record (List.map (fun (lid, l,p) -> lid, l, f.f p) lpats, closed)
+ | Tpat_construct (lid, c, pats, ty) ->
+ Tpat_construct (lid, c, List.map f.f pats, ty)
+ | Tpat_array pats ->
+ Tpat_array (List.map f.f pats)
+ | Tpat_lazy p1 -> Tpat_lazy (f.f p1)
+ | Tpat_variant (x1, Some p1, x2) ->
+ Tpat_variant (x1, Some (f.f p1), x2)
+ | Tpat_var _
+ | Tpat_constant _
+ | Tpat_any
+ | Tpat_variant (_,None,_) -> d
+ | Tpat_value p -> Tpat_value (f.f p)
+ | Tpat_exception p -> Tpat_exception (f.f p)
+ | Tpat_or (p1,p2,path) ->
+ Tpat_or (f.f p1, f.f p2, path)
+
+let rec iter_general_pattern
+ : type k . pattern_action -> k general_pattern -> unit
+ = fun f p ->
+ f.f p;
+ shallow_iter_pattern_desc
+ { f = fun p -> iter_general_pattern f p }
+ p.pat_desc
+
+let iter_pattern (f : pattern -> unit) =
+ iter_general_pattern
+ { f = fun (type k) (p : k general_pattern) ->
+ match classify_pattern p with
+ | Value -> f p
+ | Computation -> () }
+
+type pattern_predicate = { f : 'k . 'k general_pattern -> bool }
+let exists_general_pattern (f : pattern_predicate) p =
+ let exception Found in
+ match
+ iter_general_pattern
+ { f = fun p -> if f.f p then raise Found else () }
+ p
+ with
+ | exception Found -> true
+ | () -> false
+
+let exists_pattern (f : pattern -> bool) =
+ exists_general_pattern
+ { f = fun (type k) (p : k general_pattern) ->
+ match classify_pattern p with
+ | Value -> f p
+ | Computation -> false }
+
+
+(* List the identifiers bound by a pattern or a let *)
+
+let rec iter_bound_idents
+ : type k . _ -> k general_pattern -> _
+ = fun f pat ->
+ match pat.pat_desc with
+ | Tpat_var (id, s, uid) ->
+ f (id,s,pat.pat_type, uid)
+ | Tpat_alias(p, id, s, uid) ->
+ iter_bound_idents f p;
+ f (id,s,pat.pat_type, uid)
+ | Tpat_or(p1, _, _) ->
+ (* Invariant : both arguments bind the same variables *)
+ iter_bound_idents f p1
+ | d ->
+ shallow_iter_pattern_desc
+ { f = fun p -> iter_bound_idents f p }
+ d
+
+let rev_pat_bound_idents_full pat =
+ let idents_full = ref [] in
+ let add id_full = idents_full := id_full :: !idents_full in
+ iter_bound_idents add pat;
+ !idents_full
+
+let rev_only_idents idents_full =
+ List.rev_map (fun (id,_,_,_) -> id) idents_full
+
+let pat_bound_idents_full pat =
+ List.rev (rev_pat_bound_idents_full pat)
+let pat_bound_idents pat =
+ rev_only_idents (rev_pat_bound_idents_full pat)
+
+let rev_let_bound_idents_full bindings =
+ let idents_full = ref [] in
+ let add id_full = idents_full := id_full :: !idents_full in
+ List.iter (fun vb -> iter_bound_idents add vb.vb_pat) bindings;
+ !idents_full
+
+let let_bound_idents_full bindings =
+ List.rev (rev_let_bound_idents_full bindings)
+let let_bound_idents pat =
+ rev_only_idents (rev_let_bound_idents_full pat)
+
+let alpha_var env id = List.assoc id env
+
+let rec alpha_pat
+ : type k . _ -> k general_pattern -> k general_pattern
+ = fun env p -> match p.pat_desc with
+ | Tpat_var (id, s, uid) -> (* note the ``Not_found'' case *)
+ {p with pat_desc =
+ try Tpat_var (alpha_var env id, s, uid) with
+ | Not_found -> Tpat_any}
+ | Tpat_alias (p1, id, s, uid) ->
+ let new_p = alpha_pat env p1 in
+ begin try
+ {p with pat_desc = Tpat_alias (new_p, alpha_var env id, s, uid)}
+ with
+ | Not_found -> new_p
+ end
+ | d ->
+ let pat_desc =
+ shallow_map_pattern_desc { f = fun p -> alpha_pat env p } d in
+ {p with pat_desc}
+
+let mkloc = Location.mkloc
+let mknoloc = Location.mknoloc
+
+let split_pattern pat =
+ let combine_opts merge p1 p2 =
+ match p1, p2 with
+ | None, None -> None
+ | Some p, None
+ | None, Some p ->
+ Some p
+ | Some p1, Some p2 ->
+ Some (merge p1 p2)
+ in
+ let into pat p1 p2 =
+ (* The third parameter of [Tpat_or] is [Some _] only for "#typ"
+ patterns, which we do *not* expand. Hence we can put [None] here. *)
+ { pat with pat_desc = Tpat_or (p1, p2, None) } in
+ let rec split_pattern cpat =
+ match cpat.pat_desc with
+ | Tpat_value p ->
+ Some p, None
+ | Tpat_exception p ->
+ None, Some p
+ | Tpat_or (cp1, cp2, _) ->
+ let vals1, exns1 = split_pattern cp1 in
+ let vals2, exns2 = split_pattern cp2 in
+ combine_opts (into cpat) vals1 vals2,
+ (* We could change the pattern type for exception patterns to
+ [Predef.exn], but it doesn't really matter. *)
+ combine_opts (into cpat) exns1 exns2
+ in
+ split_pattern pat
diff --git a/upstream/ocaml_503/typing/typedtree.mli b/upstream/ocaml_503/typing/typedtree.mli
new file mode 100644
index 0000000000..7dd2ed7a8d
--- /dev/null
+++ b/upstream/ocaml_503/typing/typedtree.mli
@@ -0,0 +1,921 @@
+(**************************************************************************)
+(* *)
+(* 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 after typing *)
+
+
+(** By comparison with {!Parsetree}:
+ - Every {!Longindent.t} is accompanied by a resolved {!Path.t}.
+
+*)
+
+open Asttypes
+module Uid = Shape.Uid
+
+(* Value expressions for the core language *)
+
+type partial = Partial | Total
+
+(** {1 Extension points} *)
+
+type attribute = Parsetree.attribute
+type attributes = attribute list
+
+(** {1 Core language} *)
+
+type value = Value_pattern
+type computation = Computation_pattern
+
+type _ pattern_category =
+| Value : value pattern_category
+| Computation : computation pattern_category
+
+type pattern = value general_pattern
+and 'k general_pattern = 'k pattern_desc pattern_data
+
+and 'a pattern_data =
+ { pat_desc: 'a;
+ pat_loc: Location.t;
+ pat_extra : (pat_extra * Location.t * attributes) list;
+ pat_type: Types.type_expr;
+ pat_env: Env.t;
+ pat_attributes: attributes;
+ }
+
+and pat_extra =
+ | Tpat_constraint of core_type
+ (** P : T { pat_desc = P
+ ; pat_extra = (Tpat_constraint T, _, _) :: ... }
+ *)
+ | Tpat_type of Path.t * Longident.t loc
+ (** #tconst { pat_desc = disjunction
+ ; pat_extra = (Tpat_type (P, "tconst"), _, _) :: ...}
+
+ where [disjunction] is a [Tpat_or _] representing the
+ branches of [tconst].
+ *)
+ | Tpat_open of Path.t * Longident.t loc * Env.t
+ | Tpat_unpack
+ (** (module P) { pat_desc = Tpat_var "P"
+ ; pat_extra = (Tpat_unpack, _, _) :: ... }
+ (module _) { pat_desc = Tpat_any
+ ; pat_extra = (Tpat_unpack, _, _) :: ... }
+ *)
+
+and 'k pattern_desc =
+ (* value patterns *)
+ | Tpat_any : value pattern_desc
+ (** _ *)
+ | Tpat_var : Ident.t * string loc * Uid.t -> value pattern_desc
+ (** x *)
+ | Tpat_alias :
+ value general_pattern * Ident.t * string loc * Uid.t -> value pattern_desc
+ (** P as a *)
+ | Tpat_constant : constant -> value pattern_desc
+ (** 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+ | Tpat_tuple : value general_pattern list -> value pattern_desc
+ (** (P1, ..., Pn)
+
+ Invariant: n >= 2
+ *)
+ | Tpat_construct :
+ Longident.t loc * Types.constructor_description *
+ value general_pattern list * (Ident.t loc list * core_type) option ->
+ value pattern_desc
+ (** C ([], None)
+ C P ([P], None)
+ C (P1, ..., Pn) ([P1; ...; Pn], None)
+ C (P : t) ([P], Some ([], t))
+ C (P1, ..., Pn : t) ([P1; ...; Pn], Some ([], t))
+ C (type a) (P : t) ([P], Some ([a], t))
+ C (type a) (P1, ..., Pn : t) ([P1; ...; Pn], Some ([a], t))
+ *)
+ | Tpat_variant :
+ label * value general_pattern option * Types.row_desc ref ->
+ value pattern_desc
+ (** `A (None)
+ `A P (Some P)
+
+ See {!Types.row_desc} for an explanation of the last parameter.
+ *)
+ | Tpat_record :
+ (Longident.t loc * Types.label_description * value general_pattern) list *
+ closed_flag ->
+ value pattern_desc
+ (** { l1=P1; ...; ln=Pn } (flag = Closed)
+ { l1=P1; ...; ln=Pn; _} (flag = Open)
+
+ Invariant: n > 0
+ *)
+ | Tpat_array : value general_pattern list -> value pattern_desc
+ (** [| P1; ...; Pn |] *)
+ | Tpat_lazy : value general_pattern -> value pattern_desc
+ (** lazy P *)
+ (* computation patterns *)
+ | Tpat_value : tpat_value_argument -> computation pattern_desc
+ (** P
+
+ Invariant: Tpat_value pattern should not carry
+ pat_attributes or pat_extra metadata coming from user
+ syntax, which must be on the inner pattern node -- to
+ facilitate searching for a certain value pattern
+ constructor with a specific attributed.
+
+ To enforce this restriction, we made the argument of
+ the Tpat_value constructor a private synonym of [pattern],
+ requiring you to use the [as_computation_pattern] function
+ below instead of using the [Tpat_value] constructor directly.
+ *)
+ | Tpat_exception : value general_pattern -> computation pattern_desc
+ (** exception P *)
+ (* generic constructions *)
+ | Tpat_or :
+ 'k general_pattern * 'k general_pattern * Types.row_desc option ->
+ 'k pattern_desc
+ (** P1 | P2
+
+ [row_desc] = [Some _] when translating [Ppat_type _],
+ [None] otherwise.
+ *)
+
+and tpat_value_argument = private value general_pattern
+
+and expression =
+ { exp_desc: expression_desc;
+ exp_loc: Location.t;
+ exp_extra: (exp_extra * Location.t * attributes) list;
+ exp_type: Types.type_expr;
+ exp_env: Env.t;
+ exp_attributes: attributes;
+ }
+
+and exp_extra =
+ | Texp_constraint of core_type
+ (** E : T *)
+ | Texp_coerce of core_type option * core_type
+ (** E :> T [Texp_coerce (None, T)]
+ E : T0 :> T [Texp_coerce (Some T0, T)]
+ *)
+ | Texp_poly of core_type option
+ (** Used for method bodies. *)
+ | Texp_newtype of string
+ (** fun (type t) -> *)
+
+and expression_desc =
+ Texp_ident of Path.t * Longident.t loc * Types.value_description
+ (** x
+ M.x
+ *)
+ | Texp_constant of constant
+ (** 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+ | Texp_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)
+ *)
+ | Texp_function of function_param list * function_body
+ (** fun P0 P1 -> function p1 -> e1 | p2 -> e2 (body = Tfunction_cases _)
+ fun P0 P1 -> E (body = Tfunction_body _)
+
+ This construct has the same arity as the originating
+ {{!Parsetree.expression_desc.Pexp_function}[Pexp_function]}.
+ Arity determines when side-effects for effectful parameters are run
+ (e.g. optional argument defaults, matching against lazy patterns).
+ Parameters' effects are run left-to-right when an n-ary function is
+ saturated with n arguments.
+ *)
+ | Texp_apply of expression * (arg_label * expression option) list
+ (** E0 ~l1:E1 ... ~ln:En
+
+ The expression can be None if the expression is abstracted over
+ this argument. It currently appears when a label is applied.
+
+ For example:
+ let f x ~y = x + y in
+ f ~y:3
+
+ The resulting typedtree for the application is:
+ Texp_apply (Texp_ident "f/1037",
+ [(Nolabel, None);
+ (Labelled "y", Some (Texp_constant Const_int 3))
+ ])
+ *)
+ | Texp_match of expression * computation case list * value case list * partial
+ (** match E0 with
+ | P1 -> E1
+ | P2 | exception P3 -> E2
+ | exception P4 -> E3
+ | effect P4 k -> E4
+
+ [Texp_match (E0, [(P1, E1); (P2 | exception P3, E2);
+ (exception P4, E3)], [(P4, E4)], _)]
+ *)
+ | Texp_try of expression * value case list * value case list
+ (** try E with
+ | P1 -> E1
+ | effect P2 k -> E2
+ [Texp_try (E, [(P1, E1)], [(P2, E2)])]
+ *)
+ | Texp_tuple of expression list
+ (** (E1, ..., EN) *)
+ | Texp_construct of
+ Longident.t loc * Types.constructor_description * expression list
+ (** C []
+ C E [E]
+ C (E1, ..., En) [E1;...;En]
+ *)
+ | Texp_variant of label * expression option
+ | Texp_record of {
+ fields : ( Types.label_description * record_label_definition ) array;
+ representation : Types.record_representation;
+ extended_expression : expression option;
+ }
+ (** { l1=P1; ...; ln=Pn } (extended_expression = None)
+ { E0 with l1=P1; ...; ln=Pn } (extended_expression = Some E0)
+
+ Invariant: n > 0
+
+ If the type is { l1: t1; l2: t2 }, the expression
+ { E0 with t2=P2 } is represented as
+ Texp_record
+ { fields = [| l1, Kept t1; l2 Override P2 |]; representation;
+ extended_expression = Some E0 }
+ *)
+ | Texp_field of expression * Longident.t loc * Types.label_description
+ | Texp_setfield of
+ expression * Longident.t loc * Types.label_description * expression
+ | Texp_array of expression list
+ | Texp_ifthenelse of expression * expression * expression option
+ | Texp_sequence of expression * expression
+ | Texp_while of expression * expression
+ | Texp_for of
+ Ident.t * Parsetree.pattern * expression * expression * direction_flag *
+ expression
+ | Texp_send of expression * meth
+ | Texp_new of Path.t * Longident.t loc * Types.class_declaration
+ | Texp_instvar of Path.t * Path.t * string loc
+ | Texp_setinstvar of Path.t * Path.t * string loc * expression
+ | Texp_override of Path.t * (Ident.t * string loc * expression) list
+ | Texp_letmodule of
+ Ident.t option * string option loc * Types.module_presence * module_expr *
+ expression
+ | Texp_letexception of extension_constructor * expression
+ | Texp_assert of expression * Location.t
+ | Texp_lazy of expression
+ | Texp_object of class_structure * string list
+ | Texp_pack of module_expr
+ | Texp_letop of {
+ let_ : binding_op;
+ ands : binding_op list;
+ param : Ident.t;
+ body : value case;
+ partial : partial;
+ }
+ | Texp_unreachable
+ | Texp_extension_constructor of Longident.t loc * Path.t
+ | Texp_open of open_declaration * expression
+ (** let open[!] M in e *)
+
+and meth =
+ Tmeth_name of string
+ | Tmeth_val of Ident.t
+ | Tmeth_ancestor of Ident.t * Path.t
+
+and 'k case =
+ {
+ c_lhs: 'k general_pattern;
+ c_cont: Ident.t option;
+ c_guard: expression option;
+ c_rhs: expression;
+ }
+
+and function_param =
+ {
+ fp_arg_label: arg_label;
+ fp_param: Ident.t;
+ (** [fp_param] is the identifier that is to be used to name the
+ parameter of the function.
+ *)
+ fp_partial: partial;
+ (**
+ [fp_partial] =
+ [Partial] if the pattern match is partial
+ [Total] otherwise.
+ *)
+ fp_kind: function_param_kind;
+ fp_newtypes: string loc list;
+ (** [fp_newtypes] are the new type declarations that come *after* that
+ parameter. The newtypes that come before the first parameter are
+ placed as exp_extras on the Texp_function node. This is just used in
+ {!Untypeast}. *)
+ fp_loc: Location.t;
+ (** [fp_loc] is the location of the entire value parameter, not including
+ the [fp_newtypes].
+ *)
+ }
+
+and function_param_kind =
+ | Tparam_pat of pattern
+ (** [Tparam_pat p] is a non-optional argument with pattern [p]. *)
+ | Tparam_optional_default of pattern * expression
+ (** [Tparam_optional_default (p, e)] is an optional argument [p] with default
+ value [e], i.e. [?x:(p = e)]. If the parameter is of type [a option], the
+ pattern and expression are of type [a]. *)
+
+and function_body =
+ | Tfunction_body of expression
+ | Tfunction_cases of
+ { cases: value case list;
+ partial: partial;
+ param: Ident.t;
+ loc: Location.t;
+ exp_extra: exp_extra option;
+ attributes: attributes;
+ (** [attributes] is just used in untypeast. *)
+ }
+(** The function body binds a final argument in [Tfunction_cases],
+ and this argument is pattern-matched against the cases.
+*)
+
+and record_label_definition =
+ | Kept of Types.type_expr * mutable_flag
+ | Overridden of Longident.t loc * expression
+
+and binding_op =
+ {
+ bop_op_path : Path.t;
+ bop_op_name : string loc;
+ bop_op_val : Types.value_description;
+ bop_op_type : Types.type_expr;
+ (* This is the type at which the operator was used.
+ It is always an instance of [bop_op_val.val_type] *)
+ bop_exp : expression;
+ bop_loc : Location.t;
+ }
+
+(* Value expressions for the class language *)
+
+and class_expr =
+ {
+ cl_desc: class_expr_desc;
+ cl_loc: Location.t;
+ cl_type: Types.class_type;
+ cl_env: Env.t;
+ cl_attributes: attributes;
+ }
+
+and class_expr_desc =
+ Tcl_ident of Path.t * Longident.t loc * core_type list
+ | Tcl_structure of class_structure
+ | Tcl_fun of
+ arg_label * pattern * (Ident.t * expression) list
+ * class_expr * partial
+ | Tcl_apply of class_expr * (arg_label * expression option) list
+ | Tcl_let of rec_flag * value_binding list *
+ (Ident.t * expression) list * class_expr
+ | Tcl_constraint of
+ class_expr * class_type option * string list * string list
+ * Types.MethSet.t
+ (* Visible instance variables, methods and concrete methods *)
+ | Tcl_open of open_description * class_expr
+
+and class_structure =
+ {
+ cstr_self: pattern;
+ cstr_fields: class_field list;
+ cstr_type: Types.class_signature;
+ cstr_meths: Ident.t Types.Meths.t;
+ }
+
+and class_field =
+ {
+ cf_desc: class_field_desc;
+ cf_loc: Location.t;
+ cf_attributes: attributes;
+ }
+
+and class_field_kind =
+ | Tcfk_virtual of core_type
+ | Tcfk_concrete of override_flag * expression
+
+and class_field_desc =
+ Tcf_inherit of
+ override_flag * class_expr * string option * (string * Ident.t) list *
+ (string * Ident.t) list
+ (* Inherited instance variables and concrete methods *)
+ | Tcf_val of string loc * mutable_flag * Ident.t * class_field_kind * bool
+ | Tcf_method of string loc * private_flag * class_field_kind
+ | Tcf_constraint of core_type * core_type
+ | Tcf_initializer of expression
+ | Tcf_attribute of attribute
+
+(* Value expressions for the module language *)
+
+and module_expr =
+ { mod_desc: module_expr_desc;
+ mod_loc: Location.t;
+ mod_type: Types.module_type;
+ mod_env: Env.t;
+ mod_attributes: attributes;
+ }
+
+(** Annotations for [Tmod_constraint]. *)
+and module_type_constraint =
+ | Tmodtype_implicit
+ (** The module type constraint has been synthesized during typechecking. *)
+ | Tmodtype_explicit of module_type
+ (** The module type was in the source file. *)
+
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * string option loc * module_type
+
+and module_expr_desc =
+ Tmod_ident of Path.t * Longident.t loc
+ | Tmod_structure of structure
+ | Tmod_functor of functor_parameter * module_expr
+ | Tmod_apply of module_expr * module_expr * module_coercion
+ | Tmod_apply_unit of module_expr
+ | Tmod_constraint of
+ module_expr * Types.module_type * module_type_constraint * module_coercion
+ (** ME (constraint = Tmodtype_implicit)
+ (ME : MT) (constraint = Tmodtype_explicit MT)
+ *)
+ | Tmod_unpack of expression * Types.module_type
+
+and structure = {
+ str_items : structure_item list;
+ str_type : Types.signature;
+ str_final_env : Env.t;
+}
+
+and structure_item =
+ { str_desc : structure_item_desc;
+ str_loc : Location.t;
+ str_env : Env.t
+ }
+
+and structure_item_desc =
+ Tstr_eval of expression * attributes
+ | Tstr_value of rec_flag * value_binding list
+ | Tstr_primitive of value_description
+ | Tstr_type of rec_flag * type_declaration list
+ | Tstr_typext of type_extension
+ | Tstr_exception of type_exception
+ | Tstr_module of module_binding
+ | Tstr_recmodule of module_binding list
+ | Tstr_modtype of module_type_declaration
+ | Tstr_open of open_declaration
+ | Tstr_class of (class_declaration * string list) list
+ | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
+ | Tstr_include of include_declaration
+ | Tstr_attribute of attribute
+
+and module_binding =
+ {
+ mb_id: Ident.t option; (** [None] for [module _ = struct ... end] *)
+ mb_name: string option loc;
+ mb_uid: Uid.t;
+ mb_presence: Types.module_presence;
+ mb_expr: module_expr;
+ mb_attributes: attributes;
+ mb_loc: Location.t;
+ }
+
+and value_binding =
+ {
+ vb_pat: pattern;
+ vb_expr: expression;
+ vb_rec_kind: Value_rec_types.recursive_binding_kind;
+ vb_attributes: attributes;
+ vb_loc: Location.t;
+ }
+
+and module_coercion =
+ Tcoerce_none
+ | Tcoerce_structure of (int * module_coercion) list *
+ (Ident.t * int * module_coercion) list
+ | Tcoerce_functor of module_coercion * module_coercion
+ | Tcoerce_primitive of primitive_coercion
+ (** External declaration coerced to a regular value.
+ {[
+ module M : sig val ext : a -> b end =
+ struct external ext : a -> b = "my_c_function" end
+ ]}
+ Only occurs inside a [Tcoerce_structure] coercion. *)
+ | Tcoerce_alias of Env.t * Path.t * module_coercion
+ (** Module alias coerced to a regular module.
+ {[
+ module M : sig module Sub : T end =
+ struct module Sub = Some_alias end
+ ]}
+ Only occurs inside a [Tcoerce_structure] coercion. *)
+
+and module_type =
+ { mty_desc: module_type_desc;
+ mty_type : Types.module_type;
+ mty_env : Env.t;
+ mty_loc: Location.t;
+ mty_attributes: attributes;
+ }
+
+and module_type_desc =
+ Tmty_ident of Path.t * Longident.t loc
+ | Tmty_signature of signature
+ | Tmty_functor of functor_parameter * module_type
+ | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
+ | Tmty_typeof of module_expr
+ | Tmty_alias of Path.t * Longident.t loc
+
+and primitive_coercion =
+ {
+ pc_desc: Primitive.description;
+ pc_type: Types.type_expr;
+ pc_env: Env.t;
+ pc_loc : Location.t;
+ }
+
+and signature = {
+ sig_items : signature_item list;
+ sig_type : Types.signature;
+ sig_final_env : Env.t;
+}
+
+and signature_item =
+ { sig_desc: signature_item_desc;
+ sig_env : Env.t; (* BINANNOT ADDED *)
+ sig_loc: Location.t }
+
+and signature_item_desc =
+ Tsig_value of value_description
+ | Tsig_type of rec_flag * type_declaration list
+ | Tsig_typesubst of type_declaration list
+ | Tsig_typext of type_extension
+ | Tsig_exception of type_exception
+ | Tsig_module of module_declaration
+ | Tsig_modsubst of module_substitution
+ | Tsig_recmodule of module_declaration list
+ | Tsig_modtype of module_type_declaration
+ | Tsig_modtypesubst of module_type_declaration
+ | Tsig_open of open_description
+ | Tsig_include of include_description
+ | Tsig_class of class_description list
+ | Tsig_class_type of class_type_declaration list
+ | Tsig_attribute of attribute
+
+and module_declaration =
+ {
+ md_id: Ident.t option;
+ md_name: string option loc;
+ md_uid: Uid.t;
+ md_presence: Types.module_presence;
+ md_type: module_type;
+ md_attributes: attributes;
+ md_loc: Location.t;
+ }
+
+and module_substitution =
+ {
+ ms_id: Ident.t;
+ ms_name: string loc;
+ ms_uid: Uid.t;
+ ms_manifest: Path.t;
+ ms_txt: Longident.t loc;
+ ms_attributes: attributes;
+ ms_loc: Location.t;
+ }
+
+and module_type_declaration =
+ {
+ mtd_id: Ident.t;
+ mtd_name: string loc;
+ mtd_uid: Uid.t;
+ mtd_type: module_type option;
+ mtd_attributes: attributes;
+ mtd_loc: Location.t;
+ }
+
+and 'a open_infos =
+ {
+ open_expr: 'a;
+ open_bound_items: Types.signature;
+ open_override: override_flag;
+ open_env: Env.t;
+ open_loc: Location.t;
+ open_attributes: attribute list;
+ }
+
+and open_description = (Path.t * Longident.t loc) open_infos
+
+and open_declaration = module_expr open_infos
+
+
+and 'a include_infos =
+ {
+ incl_mod: 'a;
+ incl_type: Types.signature;
+ incl_loc: Location.t;
+ incl_attributes: attribute list;
+ }
+
+and include_description = module_type include_infos
+
+and include_declaration = module_expr include_infos
+
+and with_constraint =
+ Twith_type of type_declaration
+ | Twith_module of Path.t * Longident.t loc
+ | Twith_modtype of module_type
+ | Twith_typesubst of type_declaration
+ | Twith_modsubst of Path.t * Longident.t loc
+ | Twith_modtypesubst of module_type
+
+and core_type =
+ { mutable ctyp_desc : core_type_desc;
+ (** mutable because of [Typeclass.declare_method] *)
+ mutable ctyp_type : Types.type_expr;
+ (** mutable because of [Typeclass.declare_method] *)
+ ctyp_env : Env.t; (* BINANNOT ADDED *)
+ ctyp_loc : Location.t;
+ ctyp_attributes: attributes;
+ }
+
+and core_type_desc =
+ Ttyp_any
+ | Ttyp_var of string
+ | Ttyp_arrow of arg_label * core_type * core_type
+ | Ttyp_tuple of core_type list
+ | Ttyp_constr of Path.t * Longident.t loc * core_type list
+ | Ttyp_object of object_field list * closed_flag
+ | Ttyp_class of Path.t * Longident.t loc * core_type list
+ | Ttyp_alias of core_type * string loc
+ | Ttyp_variant of row_field list * closed_flag * label list option
+ | Ttyp_poly of string list * core_type
+ | Ttyp_package of package_type
+ | Ttyp_open of Path.t * Longident.t loc * core_type
+
+and package_type = {
+ pack_path : Path.t;
+ pack_fields : (Longident.t loc * core_type) list;
+ pack_type : Types.module_type;
+ pack_txt : Longident.t loc;
+}
+
+and row_field = {
+ rf_desc : row_field_desc;
+ rf_loc : Location.t;
+ rf_attributes : attributes;
+}
+
+and row_field_desc =
+ Ttag of string loc * bool * core_type list
+ | Tinherit of core_type
+
+and object_field = {
+ of_desc : object_field_desc;
+ of_loc : Location.t;
+ of_attributes : attributes;
+}
+
+and object_field_desc =
+ | OTtag of string loc * core_type
+ | OTinherit of core_type
+
+and value_description =
+ { val_id: Ident.t;
+ val_name: string loc;
+ val_desc: core_type;
+ val_val: Types.value_description;
+ val_prim: string list;
+ val_loc: Location.t;
+ val_attributes: attributes;
+ }
+
+and type_declaration =
+ {
+ typ_id: Ident.t;
+ typ_name: string loc;
+ typ_params: (core_type * (variance * injectivity)) list;
+ typ_type: Types.type_declaration;
+ typ_cstrs: (core_type * core_type * Location.t) list;
+ typ_kind: type_kind;
+ typ_private: private_flag;
+ typ_manifest: core_type option;
+ typ_loc: Location.t;
+ typ_attributes: attributes;
+ }
+
+and type_kind =
+ Ttype_abstract
+ | Ttype_variant of constructor_declaration list
+ | Ttype_record of label_declaration list
+ | Ttype_open
+
+and label_declaration =
+ {
+ ld_id: Ident.t;
+ ld_name: string loc;
+ ld_uid: Uid.t;
+ ld_mutable: mutable_flag;
+ ld_type: core_type;
+ ld_loc: Location.t;
+ ld_attributes: attributes;
+ }
+
+and constructor_declaration =
+ {
+ cd_id: Ident.t;
+ cd_name: string loc;
+ cd_uid: Uid.t;
+ cd_vars: string loc list;
+ cd_args: constructor_arguments;
+ cd_res: core_type option;
+ cd_loc: Location.t;
+ cd_attributes: attributes;
+ }
+
+and constructor_arguments =
+ | Cstr_tuple of core_type list
+ | Cstr_record of label_declaration list
+
+and type_extension =
+ {
+ tyext_path: Path.t;
+ tyext_txt: Longident.t loc;
+ tyext_params: (core_type * (variance * injectivity)) list;
+ tyext_constructors: extension_constructor list;
+ tyext_private: private_flag;
+ tyext_loc: Location.t;
+ tyext_attributes: attributes;
+ }
+
+and type_exception =
+ {
+ tyexn_constructor: extension_constructor;
+ tyexn_loc: Location.t;
+ tyexn_attributes: attribute list;
+ }
+
+and extension_constructor =
+ {
+ ext_id: Ident.t;
+ ext_name: string loc;
+ ext_type : Types.extension_constructor;
+ ext_kind : extension_constructor_kind;
+ ext_loc : Location.t;
+ ext_attributes: attributes;
+ }
+
+and extension_constructor_kind =
+ Text_decl of string loc list * constructor_arguments * core_type option
+ | Text_rebind of Path.t * Longident.t loc
+
+and class_type =
+ {
+ cltyp_desc: class_type_desc;
+ cltyp_type: Types.class_type;
+ cltyp_env: Env.t;
+ cltyp_loc: Location.t;
+ cltyp_attributes: attributes;
+ }
+
+and class_type_desc =
+ Tcty_constr of Path.t * Longident.t loc * core_type list
+ | Tcty_signature of class_signature
+ | Tcty_arrow of arg_label * core_type * class_type
+ | Tcty_open of open_description * class_type
+
+and class_signature = {
+ csig_self : core_type;
+ csig_fields : class_type_field list;
+ csig_type : Types.class_signature;
+ }
+
+and class_type_field = {
+ ctf_desc: class_type_field_desc;
+ ctf_loc: Location.t;
+ ctf_attributes: attributes;
+ }
+
+and class_type_field_desc =
+ | Tctf_inherit of class_type
+ | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
+ | Tctf_method of (string * private_flag * virtual_flag * core_type)
+ | Tctf_constraint of (core_type * core_type)
+ | Tctf_attribute of attribute
+
+and class_declaration =
+ class_expr class_infos
+
+and class_description =
+ class_type class_infos
+
+and class_type_declaration =
+ class_type class_infos
+
+and 'a class_infos =
+ { ci_virt: virtual_flag;
+ ci_params: (core_type * (variance * injectivity)) list;
+ ci_id_name : string loc;
+ ci_id_class: Ident.t;
+ ci_id_class_type : Ident.t;
+ ci_id_object : Ident.t;
+ ci_expr: 'a;
+ ci_decl: Types.class_declaration;
+ ci_type_decl : Types.class_type_declaration;
+ ci_loc: Location.t;
+ ci_attributes: attributes;
+ }
+
+type implementation = {
+ structure: structure;
+ coercion: module_coercion;
+ signature: Types.signature;
+ shape: Shape.t;
+}
+(** A typechecked implementation including its module structure, its exported
+ signature, and a coercion of the module against that signature.
+
+ If an .mli file is present, the signature will come from that file and be
+ the exported signature of the module.
+
+ If there isn't one, the signature will be inferred from the module
+ structure.
+*)
+
+type item_declaration =
+ | Value of value_description
+ | Value_binding of value_binding
+ | Type of type_declaration
+ | Constructor of constructor_declaration
+ | Extension_constructor of extension_constructor
+ | Label of label_declaration
+ | Module of module_declaration
+ | Module_substitution of module_substitution
+ | Module_binding of module_binding
+ | Module_type of module_type_declaration
+ | Class of class_declaration
+ | Class_type of class_type_declaration
+(** [item_declaration] groups together items that correspond to the syntactic
+ category of "declarations" which include types, values, modules, etc.
+ declarations in signatures and their definitions in implementations. *)
+
+(* Auxiliary functions over the a.s.t. *)
+
+(** [as_computation_pattern p] is a computation pattern with description
+ [Tpat_value p], which enforces a correct placement of pat_attributes
+ and pat_extra metadata (on the inner value pattern, rather than on
+ the computation pattern). *)
+val as_computation_pattern: pattern -> computation general_pattern
+
+val classify_pattern_desc: 'k pattern_desc -> 'k pattern_category
+val classify_pattern: 'k general_pattern -> 'k pattern_category
+
+type pattern_action =
+ { f : 'k . 'k general_pattern -> unit }
+val shallow_iter_pattern_desc:
+ pattern_action -> 'k pattern_desc -> unit
+
+type pattern_transformation =
+ { f : 'k . 'k general_pattern -> 'k general_pattern }
+val shallow_map_pattern_desc:
+ pattern_transformation -> 'k pattern_desc -> 'k pattern_desc
+
+val iter_general_pattern: pattern_action -> 'k general_pattern -> unit
+val iter_pattern: (pattern -> unit) -> pattern -> unit
+
+type pattern_predicate = { f : 'k . 'k general_pattern -> bool }
+val exists_general_pattern: pattern_predicate -> 'k general_pattern -> bool
+val exists_pattern: (pattern -> bool) -> pattern -> bool
+
+val let_bound_idents: value_binding list -> Ident.t list
+val let_bound_idents_full:
+ value_binding list ->
+ (Ident.t * string loc * Types.type_expr * Types.Uid.t) list
+
+(** Alpha conversion of patterns *)
+val alpha_pat:
+ (Ident.t * Ident.t) list -> 'k general_pattern -> 'k general_pattern
+
+val mknoloc: 'a -> 'a Asttypes.loc
+val mkloc: 'a -> Location.t -> 'a Asttypes.loc
+
+val pat_bound_idents: 'k general_pattern -> Ident.t list
+val pat_bound_idents_full:
+ 'k general_pattern ->
+ (Ident.t * string loc * Types.type_expr * Types.Uid.t) list
+
+(** Splits an or pattern into its value (left) and exception (right) parts. *)
+val split_pattern:
+ computation general_pattern -> pattern option * pattern option
diff --git a/upstream/ocaml_503/typing/typemod.ml b/upstream/ocaml_503/typing/typemod.ml
new file mode 100644
index 0000000000..0ff6c75bcf
--- /dev/null
+++ b/upstream/ocaml_503/typing/typemod.ml
@@ -0,0 +1,3471 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Misc
+open Longident
+open Path
+open Asttypes
+open Parsetree
+open Types
+open Format_doc
+
+module Style = Misc.Style
+
+let () = Includemod_errorprinter.register ()
+
+module Sig_component_kind = Shape.Sig_component_kind
+module String = Misc.Stdlib.String
+
+type hiding_error =
+ | Illegal_shadowing of {
+ shadowed_item_id: Ident.t;
+ shadowed_item_kind: Sig_component_kind.t;
+ shadowed_item_loc: Location.t;
+ shadower_id: Ident.t;
+ user_id: Ident.t;
+ user_kind: Sig_component_kind.t;
+ user_loc: Location.t;
+ }
+ | Appears_in_signature of {
+ opened_item_id: Ident.t;
+ opened_item_kind: Sig_component_kind.t;
+ user_id: Ident.t;
+ user_kind: Sig_component_kind.t;
+ user_loc: Location.t;
+ }
+
+type error =
+ Cannot_apply of module_type
+ | Not_included of Includemod.explanation
+ | Cannot_eliminate_dependency of module_type
+ | Signature_expected
+ | Structure_expected of module_type
+ | With_no_component of Longident.t
+ | With_mismatch of Longident.t * Includemod.explanation
+ | With_makes_applicative_functor_ill_typed of
+ Longident.t * Path.t * Includemod.explanation
+ | With_changes_module_alias of Longident.t * Ident.t * Path.t
+ | With_cannot_remove_constrained_type
+ | With_package_manifest of Longident.t * type_expr
+ | Repeated_name of Sig_component_kind.t * string
+ | Non_generalizable of { vars : type_expr list; expression : type_expr }
+ | Non_generalizable_module of
+ { vars : type_expr list; item : value_description; mty : module_type }
+ | Implementation_is_required of string
+ | Interface_not_compiled of string
+ | Not_allowed_in_functor_body
+ | Not_a_packed_module of type_expr
+ | Incomplete_packed_module of type_expr
+ | Scoping_pack of Longident.t * type_expr
+ | Recursive_module_require_explicit_type
+ | Apply_generative
+ | Cannot_scrape_alias of Path.t
+ | Cannot_scrape_package_type of Path.t
+ | Badly_formed_signature of string * Typedecl.error
+ | Cannot_hide_id of hiding_error
+ | Invalid_type_subst_rhs
+ | Non_packable_local_modtype_subst of Path.t
+ | With_cannot_remove_packed_modtype of Path.t * module_type
+ | Cannot_alias of Path.t
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+open Typedtree
+
+let rec path_concat head p =
+ match p with
+ Pident tail -> Pdot (Pident head, Ident.name tail)
+ | Pdot (pre, s) -> Pdot (path_concat head pre, s)
+ | Papply _ -> assert false
+ | Pextra_ty (p, extra) -> Pextra_ty (path_concat head p, extra)
+
+(* Extract a signature from a module type *)
+
+let extract_sig env loc mty =
+ match Env.scrape_alias env mty with
+ Mty_signature sg -> sg
+ | Mty_alias path ->
+ raise(Error(loc, env, Cannot_scrape_alias path))
+ | _ -> raise(Error(loc, env, Signature_expected))
+
+let extract_sig_open env loc mty =
+ match Env.scrape_alias env mty with
+ Mty_signature sg -> sg
+ | Mty_alias path ->
+ raise(Error(loc, env, Cannot_scrape_alias path))
+ | mty -> raise(Error(loc, env, Structure_expected mty))
+
+(* Compute the environment after opening a module *)
+
+let type_open_ ?used_slot ?toplevel ovf env loc lid =
+ let path = Env.lookup_module_path ~load:true ~loc:lid.loc lid.txt env in
+ match Env.open_signature ~loc ?used_slot ?toplevel ovf path env with
+ | Ok env -> path, env
+ | Error _ ->
+ let md = Env.find_module path env in
+ ignore (extract_sig_open env lid.loc md.md_type);
+ assert false
+
+let initial_env ~loc ~initially_opened_module
+ ~open_implicit_modules =
+ let env = Env.initial in
+ let open_module env m =
+ let open Asttypes in
+ let lexbuf = Lexing.from_string m in
+ let txt =
+ Location.init lexbuf (Printf.sprintf "command line argument: -open %S" m);
+ Parse.simple_module_path lexbuf in
+ snd (type_open_ Override env loc {txt;loc})
+ in
+ let add_units env units =
+ String.Set.fold
+ (fun name env ->
+ Env.add_persistent_structure (Ident.create_persistent name) env)
+ units
+ env
+ in
+ let units =
+ List.map Env.persistent_structures_of_dir (Load_path.get_visible ())
+ in
+ let env, units =
+ match initially_opened_module with
+ | None -> (env, units)
+ | Some m ->
+ (* Locate the directory that contains [m], adds the units it
+ contains to the environment and open [m] in the resulting
+ environment. *)
+ let rec loop before after =
+ match after with
+ | [] -> None
+ | units :: after ->
+ if String.Set.mem m units then
+ Some (units, List.rev_append before after)
+ else
+ loop (units :: before) after
+ in
+ let env, units =
+ match loop [] units with
+ | None ->
+ (env, units)
+ | Some (units_containing_m, other_units) ->
+ (add_units env units_containing_m, other_units)
+ in
+ (open_module env m, units)
+ in
+ let env = List.fold_left add_units env units in
+ List.fold_left open_module env open_implicit_modules
+
+let type_open_descr ?used_slot ?toplevel env sod =
+ let (path, newenv) =
+ Builtin_attributes.warning_scope sod.popen_attributes
+ (fun () ->
+ type_open_ ?used_slot ?toplevel sod.popen_override env sod.popen_loc
+ sod.popen_expr
+ )
+ in
+ let od =
+ {
+ open_expr = (path, sod.popen_expr);
+ open_bound_items = [];
+ open_override = sod.popen_override;
+ open_env = newenv;
+ open_attributes = sod.popen_attributes;
+ open_loc = sod.popen_loc;
+ }
+ in
+ (od, newenv)
+
+(* Forward declaration, to be filled in by type_module_type_of *)
+let type_module_type_of_fwd :
+ (Env.t -> Parsetree.module_expr ->
+ Typedtree.module_expr * Types.module_type) ref
+ = ref (fun _env _m -> assert false)
+
+(* Additional validity checks on type definitions arising from
+ recursive modules *)
+
+let check_recmod_typedecls env decls =
+ let recmod_ids = List.map fst decls in
+ List.iter
+ (fun (id, md) ->
+ List.iter
+ (fun path ->
+ Typedecl.check_recmod_typedecl env md.Types.md_loc recmod_ids
+ path (Env.find_type path env))
+ (Mtype.type_paths env (Pident id) md.Types.md_type))
+ decls
+
+(* Merge one "with" constraint in a signature *)
+
+let check_type_decl env sg loc id row_id newdecl decl =
+ let fresh_id = Ident.rename id in
+ let path = Pident fresh_id in
+ let sub = Subst.add_type id path Subst.identity in
+ let fresh_row_id, sub =
+ match row_id with
+ | None -> None, sub
+ | Some id ->
+ let fresh_row_id = Some (Ident.rename id) in
+ let sub = Subst.add_type id (Pident fresh_id) sub in
+ fresh_row_id, sub
+ in
+ let newdecl = Subst.type_declaration sub newdecl in
+ let decl = Subst.type_declaration sub decl in
+ let sg = List.map (Subst.signature_item Keep sub) sg in
+ let env = Env.add_type ~check:false fresh_id newdecl env in
+ let env =
+ match fresh_row_id with
+ | None -> env
+ | Some fresh_row_id -> Env.add_type ~check:false fresh_row_id newdecl env
+ in
+ let env = Env.add_signature sg env in
+ Includemod.type_declarations ~mark:true ~loc env fresh_id newdecl decl;
+ Typedecl.check_coherence env loc path newdecl
+
+let make_variance p n i =
+ let open Variance in
+ set_if p May_pos (set_if n May_neg (set_if i Inj null))
+
+let rec iter_path_apply p ~f =
+ match p with
+ | Pident _ -> ()
+ | Pdot (p, _) -> iter_path_apply p ~f
+ | Papply (p1, p2) ->
+ iter_path_apply p1 ~f;
+ iter_path_apply p2 ~f;
+ f p1 p2 (* after recursing, so we know both paths are well typed *)
+ | Pextra_ty _ -> assert false
+
+let path_is_strict_prefix =
+ let rec list_is_strict_prefix l ~prefix =
+ match l, prefix with
+ | [], [] -> false
+ | _ :: _, [] -> true
+ | [], _ :: _ -> false
+ | s1 :: t1, s2 :: t2 ->
+ String.equal s1 s2 && list_is_strict_prefix t1 ~prefix:t2
+ in
+ fun path ~prefix ->
+ match Path.flatten path, Path.flatten prefix with
+ | `Contains_apply, _ | _, `Contains_apply -> false
+ | `Ok (ident1, l1), `Ok (ident2, l2) ->
+ Ident.same ident1 ident2
+ && list_is_strict_prefix l1 ~prefix:l2
+
+let iterator_with_env super env =
+ let env = ref (lazy env) in
+ env, { super with
+ Btype.it_signature = (fun self sg ->
+ (* add all items to the env before recursing down, to handle recursive
+ definitions *)
+ let env_before = !env in
+ env := lazy (Env.add_signature sg (Lazy.force env_before));
+ super.Btype.it_signature self sg;
+ env := env_before
+ );
+ Btype.it_module_type = (fun self -> function
+ | Mty_functor (param, mty_body) ->
+ let env_before = !env in
+ begin match param with
+ | Unit -> ()
+ | Named (param, mty_arg) ->
+ self.Btype.it_module_type self mty_arg;
+ match param with
+ | None -> ()
+ | Some id ->
+ env := lazy (Env.add_module ~arg:true id Mp_present
+ mty_arg (Lazy.force env_before))
+ end;
+ self.Btype.it_module_type self mty_body;
+ env := env_before;
+ | mty ->
+ super.Btype.it_module_type self mty
+ )
+ }
+
+let retype_applicative_functor_type ~loc env funct arg =
+ let mty_functor = (Env.find_module funct env).md_type in
+ let mty_arg = (Env.find_module arg env).md_type in
+ let mty_param =
+ match Env.scrape_alias env mty_functor with
+ | Mty_functor (Named (_, mty_param), _) -> mty_param
+ | _ -> assert false (* could trigger due to MPR#7611 *)
+ in
+ Includemod.check_modtype_inclusion ~loc env mty_arg arg mty_param
+
+(* When doing a deep destructive substitution with type M.N.t := .., we change M
+ and M.N and so we have to check that uses of the modules other than just
+ extracting components from them still make sense. There are only two such
+ kinds of uses:
+ - applicative functor types: F(M).t might not be well typed anymore
+ - aliases: module A = M still makes sense but it doesn't mean the same thing
+ anymore, so it's forbidden until it's clear what we should do with it.
+ This function would be called with M.N.t and N.t to check for these uses. *)
+let check_usage_of_path_of_substituted_item paths ~loc ~lid env super =
+ { super with
+ Btype.it_signature_item = (fun self -> function
+ | Sig_module (id, _, { md_type = Mty_alias aliased_path; _ }, _, _)
+ when List.exists
+ (fun path -> path_is_strict_prefix path ~prefix:aliased_path)
+ paths
+ ->
+ let e = With_changes_module_alias (lid.txt, id, aliased_path) in
+ raise(Error(loc, Lazy.force !env, e))
+ | sig_item ->
+ super.Btype.it_signature_item self sig_item
+ );
+ Btype.it_path = (fun referenced_path ->
+ iter_path_apply referenced_path ~f:(fun funct arg ->
+ if List.exists
+ (fun path -> path_is_strict_prefix path ~prefix:arg)
+ paths
+ then
+ let env = Lazy.force !env in
+ match retype_applicative_functor_type ~loc env funct arg with
+ | None -> ()
+ | Some explanation ->
+ raise(Error(loc, env,
+ With_makes_applicative_functor_ill_typed
+ (lid.txt, referenced_path, explanation)))
+ )
+ );
+ }
+
+let do_check_after_substitution env ~loc ~lid paths sg =
+ with_type_mark begin fun mark ->
+ let env, iterator = iterator_with_env (Btype.type_iterators mark) env in
+ let last, rest = match List.rev paths with
+ | [] -> assert false
+ | last :: rest -> last, rest
+ in
+ (* The last item is the one that's removed. We don't need to check how
+ it's used since it's replaced by a more specific type/module. *)
+ assert (match last with Pident _ -> true | _ -> false);
+ let iterator = match rest with
+ | [] -> iterator
+ | _ :: _ ->
+ check_usage_of_path_of_substituted_item rest ~loc ~lid env iterator
+ in
+ iterator.Btype.it_signature iterator sg
+ end
+
+let check_usage_after_substitution env ~loc ~lid paths sg =
+ match paths with
+ | [_] -> ()
+ | _ -> do_check_after_substitution env ~loc ~lid paths sg
+
+(* After substitution one also needs to re-check the well-foundedness
+ of type declarations in recursive modules *)
+let rec extract_next_modules = function
+ | Sig_module (id, _, mty, Trec_next, _) :: rem ->
+ let (id_mty_l, rem) = extract_next_modules rem in
+ ((id, mty) :: id_mty_l, rem)
+ | sg -> ([], sg)
+
+let check_well_formed_module env loc context mty =
+ (* Format.eprintf "@[check_well_formed_module@ %a@]@."
+ Printtyp.modtype mty; *)
+ let open Btype in
+ let iterator =
+ let rec check_signature env = function
+ | [] -> ()
+ | Sig_module (id, _, mty, Trec_first, _) :: rem ->
+ let (id_mty_l, rem) = extract_next_modules rem in
+ begin try
+ check_recmod_typedecls (Lazy.force env) ((id, mty) :: id_mty_l)
+ with Typedecl.Error (_, err) ->
+ raise (Error (loc, Lazy.force env,
+ Badly_formed_signature(context, err)))
+ end;
+ check_signature env rem
+ | _ :: rem ->
+ check_signature env rem
+ in
+ let env, super =
+ iterator_with_env Btype.type_iterators_without_type_expr env in
+ { super with
+ it_signature = (fun self sg ->
+ let env_before = !env in
+ let env = lazy (Env.add_signature sg (Lazy.force env_before)) in
+ check_signature env sg;
+ super.it_signature self sg);
+ }
+ in
+ iterator.it_module_type iterator mty
+
+let () = Env.check_well_formed_module := check_well_formed_module
+
+let type_decl_is_alias sdecl = (* assuming no explicit constraint *)
+ match sdecl.ptype_manifest with
+ | Some {ptyp_desc = Ptyp_constr (lid, stl)}
+ when List.length stl = List.length sdecl.ptype_params ->
+ begin
+ match
+ List.iter2 (fun x (y, _) ->
+ match x, y with
+ {ptyp_desc=Ptyp_var sx}, {ptyp_desc=Ptyp_var sy}
+ when sx = sy -> ()
+ | _, _ -> raise Exit)
+ stl sdecl.ptype_params;
+ with
+ | exception Exit -> None
+ | () -> Some lid
+ end
+ | _ -> None
+
+let params_are_constrained =
+ let rec loop = function
+ | [] -> false
+ | hd :: tl ->
+ match get_desc hd with
+ | Tvar _ -> List.memq hd tl || loop tl
+ | _ -> true
+ in
+ loop
+
+type with_info =
+ | With_type of Parsetree.type_declaration
+ | With_typesubst of Parsetree.type_declaration
+ | With_module of {
+ lid:Longident.t loc;
+ path:Path.t;
+ md:Types.module_declaration;
+ remove_aliases:bool
+ }
+ | With_modsubst of Longident.t loc * Path.t * Types.module_declaration
+ | With_modtype of Typedtree.module_type
+ | With_modtypesubst of Typedtree.module_type
+ | With_type_package of Typedtree.core_type
+ (* Package with type constraints only use this last case. Normal module
+ with constraints never use it. *)
+
+let merge_constraint initial_env loc sg lid constr =
+ let destructive_substitution =
+ match constr with
+ | With_type _ | With_module _ | With_modtype _
+ | With_type_package _ -> false
+ | With_typesubst _ | With_modsubst _ | With_modtypesubst _ -> true
+ in
+ let real_ids = ref [] in
+ let split_row_id s ghosts =
+ let srow = s ^ "#row" in
+ let rec split before = function
+ | Sig_type(id,_,_,_) :: rest when Ident.name id = srow ->
+ before, Some id, rest
+ | a :: rest -> split (a::before) rest
+ | [] -> before, None, []
+ in
+ split [] ghosts
+ in
+ let unsafe_signature_subst sub sg =
+ (* This signature will not be used directly, it will always be freshened
+ by the caller. So what we do with the scope doesn't really matter. But
+ making it local makes it unlikely that we will ever use the result of
+ this function unfreshened without issue. *)
+ match Subst.Unsafe.signature Make_local sub sg with
+ | Ok x -> x
+ | Error (Fcm_type_substituted_away (p,mty)) ->
+ let error = With_cannot_remove_packed_modtype(p,mty) in
+ raise (Error(loc,initial_env,error))
+ in
+ let rec patch_item constr namelist outer_sig_env sg_for_env ~ghosts item =
+ let return ?(ghosts=ghosts) ~replace_by info =
+ Some (info, {Signature_group.ghosts; replace_by})
+ in
+ match item, namelist, constr with
+ | Sig_type(id, decl, rs, priv), [s],
+ With_type ({ptype_kind = Ptype_abstract} as sdecl)
+ when Ident.name id = s && Typedecl.is_fixed_type sdecl ->
+ let decl_row =
+ let arity = List.length sdecl.ptype_params in
+ {
+ type_params =
+ List.map (fun _ -> Btype.newgenvar()) sdecl.ptype_params;
+ type_arity = arity;
+ type_kind = Type_abstract Definition;
+ type_private = Private;
+ type_manifest = None;
+ type_variance =
+ List.map
+ (fun (_, (v, i)) ->
+ let (c, n) =
+ match v with
+ | Covariant -> true, false
+ | Contravariant -> false, true
+ | NoVariance -> false, false
+ in
+ make_variance (not n) (not c) (i = Injective)
+ )
+ sdecl.ptype_params;
+ type_separability =
+ Types.Separability.default_signature ~arity;
+ type_loc = sdecl.ptype_loc;
+ type_is_newtype = false;
+ type_expansion_scope = Btype.lowest_level;
+ type_attributes = [];
+ type_immediate = Unknown;
+ type_unboxed_default = false;
+ type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ and id_row = Ident.create_local (s^"#row") in
+ let initial_env =
+ Env.add_type ~check:false id_row decl_row initial_env
+ in
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
+ let tdecl =
+ Typedecl.transl_with_constraint id ~fixed_row_path:(Pident id_row)
+ ~sig_env ~sig_decl:decl ~outer_env:initial_env sdecl in
+ let newdecl = tdecl.typ_type in
+ let before_ghosts, row_id, after_ghosts = split_row_id s ghosts in
+ check_type_decl outer_sig_env sg_for_env sdecl.ptype_loc
+ id row_id newdecl decl;
+ let decl_row = {decl_row with type_params = newdecl.type_params} in
+ let rs' = if rs = Trec_first then Trec_not else rs in
+ let ghosts =
+ List.rev_append before_ghosts
+ (Sig_type(id_row, decl_row, rs', priv)::after_ghosts)
+ in
+ return ~ghosts
+ ~replace_by:(Some (Sig_type(id, newdecl, rs, priv)))
+ (Pident id, lid, Some (Twith_type tdecl))
+ | Sig_type(id, sig_decl, rs, priv) , [s],
+ (With_type sdecl | With_typesubst sdecl as constr)
+ when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
+ let tdecl =
+ Typedecl.transl_with_constraint id
+ ~sig_env ~sig_decl ~outer_env:initial_env sdecl in
+ let newdecl = tdecl.typ_type and loc = sdecl.ptype_loc in
+ let before_ghosts, row_id, after_ghosts = split_row_id s ghosts in
+ let ghosts = List.rev_append before_ghosts after_ghosts in
+ check_type_decl outer_sig_env sg_for_env loc
+ id row_id newdecl sig_decl;
+ begin match constr with
+ With_type _ ->
+ return ~ghosts
+ ~replace_by:(Some(Sig_type(id, newdecl, rs, priv)))
+ (Pident id, lid, Some (Twith_type tdecl))
+ | (* With_typesubst *) _ ->
+ real_ids := [Pident id];
+ return ~ghosts ~replace_by:None
+ (Pident id, lid, Some (Twith_typesubst tdecl))
+ end
+ | Sig_type(id, sig_decl, rs, priv), [s], With_type_package cty
+ when Ident.name id = s ->
+ begin match sig_decl.type_manifest with
+ | None -> ()
+ | Some ty ->
+ raise (Error(loc, outer_sig_env, With_package_manifest (lid.txt, ty)))
+ end;
+ let tdecl =
+ Typedecl.transl_package_constraint ~loc outer_sig_env cty.ctyp_type
+ in
+ check_type_decl outer_sig_env sg_for_env loc id None tdecl sig_decl;
+ let tdecl = { tdecl with type_manifest = None } in
+ return ~ghosts ~replace_by:(Some(Sig_type(id, tdecl, rs, priv)))
+ (Pident id, lid, None)
+ | Sig_modtype(id, mtd, priv), [s],
+ (With_modtype mty | With_modtypesubst mty)
+ when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
+ let () = match mtd.mtd_type with
+ | None -> ()
+ | Some previous_mty ->
+ Includemod.check_modtype_equiv ~loc sig_env
+ id previous_mty mty.mty_type
+ in
+ if not destructive_substitution then
+ let mtd': modtype_declaration =
+ {
+ mtd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ mtd_type = Some mty.mty_type;
+ mtd_attributes = [];
+ mtd_loc = loc;
+ }
+ in
+ return
+ ~replace_by:(Some(Sig_modtype(id, mtd', priv)))
+ (Pident id, lid, Some (Twith_modtype mty))
+ else begin
+ let path = Pident id in
+ real_ids := [path];
+ return ~replace_by:None
+ (Pident id, lid, Some (Twith_modtypesubst mty))
+ end
+ | Sig_module(id, pres, md, rs, priv), [s],
+ With_module {lid=lid'; md=md'; path; remove_aliases}
+ when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
+ let mty = md'.md_type in
+ let mty = Mtype.scrape_for_type_of ~remove_aliases sig_env mty in
+ let md'' = { md' with md_type = mty } in
+ let newmd = Mtype.strengthen_decl ~aliasable:false sig_env md'' path in
+ ignore(Includemod.modtypes ~mark:true ~loc sig_env
+ newmd.md_type md.md_type);
+ return
+ ~replace_by:(Some(Sig_module(id, pres, newmd, rs, priv)))
+ (Pident id, lid, Some (Twith_module (path, lid')))
+ | Sig_module(id, _, md, _rs, _), [s], With_modsubst (lid',path,md')
+ when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
+ let aliasable = not (Env.is_functor_arg path sig_env) in
+ ignore
+ (Includemod.strengthened_module_decl ~loc ~mark:true
+ ~aliasable sig_env md' path md);
+ real_ids := [Pident id];
+ return ~replace_by:None
+ (Pident id, lid, Some (Twith_modsubst (path, lid')))
+ | Sig_module(id, _, md, rs, priv) as item, s :: namelist, constr
+ when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
+ let sg = extract_sig sig_env loc md.md_type in
+ let ((path, _, tcstr), newsg) = merge_signature sig_env sg namelist in
+ let path = path_concat id path in
+ real_ids := path :: !real_ids;
+ let item =
+ match md.md_type, constr with
+ Mty_alias _, (With_module _ | With_type _) ->
+ (* A module alias cannot be refined, so keep it
+ and just check that the constraint is correct *)
+ item
+ | _ ->
+ let newmd = {md with md_type = Mty_signature newsg} in
+ Sig_module(id, Mp_present, newmd, rs, priv)
+ in
+ return ~replace_by:(Some item) (path, lid, tcstr)
+ | _ -> None
+ and merge_signature env sg namelist =
+ match
+ Signature_group.replace_in_place (patch_item constr namelist env sg) sg
+ with
+ | Some (x,sg) -> x, sg
+ | None -> raise(Error(loc, env, With_no_component lid.txt))
+ in
+ try
+ let names = Longident.flatten lid.txt in
+ let (tcstr, sg) = merge_signature initial_env sg names in
+ if destructive_substitution then
+ check_usage_after_substitution ~loc ~lid initial_env !real_ids sg;
+ let sg =
+ match tcstr with
+ | (_, _, Some (Twith_typesubst tdecl)) ->
+ let how_to_extend_subst =
+ let sdecl =
+ match constr with
+ | With_typesubst sdecl -> sdecl
+ | _ -> assert false
+ in
+ match type_decl_is_alias sdecl with
+ | Some lid ->
+ let replacement, _ =
+ try Env.find_type_by_name lid.txt initial_env
+ with Not_found -> assert false
+ in
+ fun s path -> Subst.Unsafe.add_type_path path replacement s
+ | None ->
+ let body = Option.get tdecl.typ_type.type_manifest in
+ let params = tdecl.typ_type.type_params in
+ if params_are_constrained params
+ then raise(Error(loc, initial_env,
+ With_cannot_remove_constrained_type));
+ fun s path -> Subst.Unsafe.add_type_function path ~params ~body s
+ in
+ let sub = Subst.change_locs Subst.identity loc in
+ let sub = List.fold_left how_to_extend_subst sub !real_ids in
+ unsafe_signature_subst sub sg
+ | (_, _, Some (Twith_modsubst (real_path, _))) ->
+ let sub = Subst.change_locs Subst.identity loc in
+ let sub =
+ List.fold_left
+ (fun s path -> Subst.Unsafe.add_module_path path real_path s)
+ sub
+ !real_ids
+ in
+ unsafe_signature_subst sub sg
+ | (_, _, Some (Twith_modtypesubst tmty)) ->
+ let add s p = Subst.Unsafe.add_modtype_path p tmty.mty_type s in
+ let sub = Subst.change_locs Subst.identity loc in
+ let sub = List.fold_left add sub !real_ids in
+ unsafe_signature_subst sub sg
+ | _ ->
+ sg
+ in
+ check_well_formed_module initial_env loc "this instantiated signature"
+ (Mty_signature sg);
+ (tcstr, sg)
+ with Includemod.Error explanation ->
+ raise(Error(loc, initial_env, With_mismatch(lid.txt, explanation)))
+
+let merge_package_constraint initial_env loc sg lid cty =
+ let _, s = merge_constraint initial_env loc sg lid (With_type_package cty) in
+ s
+
+let check_package_with_type_constraints loc env mty constraints =
+ let sg = extract_sig env loc mty in
+ let sg =
+ List.fold_left
+ (fun sg (lid, cty) ->
+ merge_package_constraint env loc sg lid cty)
+ sg constraints
+ in
+ let scope = Ctype.create_scope () in
+ Mtype.freshen ~scope (Mty_signature sg)
+
+let () =
+ Typetexp.check_package_with_type_constraints :=
+ check_package_with_type_constraints
+
+(* Add recursion flags on declarations arising from a mutually recursive
+ block. *)
+
+let map_rec fn decls rem =
+ match decls with
+ | [] -> rem
+ | d1 :: dl -> fn Trec_first d1 :: map_end (fn Trec_next) dl rem
+
+let map_rec_type ~rec_flag fn decls rem =
+ match decls with
+ | [] -> rem
+ | d1 :: dl ->
+ let first =
+ match rec_flag with
+ | Recursive -> Trec_first
+ | Nonrecursive -> Trec_not
+ in
+ fn first d1 :: map_end (fn Trec_next) dl rem
+
+let rec map_rec_type_with_row_types ~rec_flag fn decls rem =
+ match decls with
+ | [] -> rem
+ | d1 :: dl ->
+ if Btype.is_row_name (Ident.name d1.typ_id) then
+ fn Trec_not d1 :: map_rec_type_with_row_types ~rec_flag fn dl rem
+ else
+ map_rec_type ~rec_flag fn decls rem
+
+(* Add type extension flags to extension constructors *)
+let map_ext fn exts rem =
+ match exts with
+ | [] -> rem
+ | d1 :: dl -> fn Text_first d1 :: map_end (fn Text_next) dl rem
+
+(* Auxiliary for translating recursively-defined module types.
+ Return a module type that approximates the shape of the given module
+ type AST. Retain only module, type, and module type
+ components of signatures. For types, retain only their arity,
+ making them abstract otherwise. *)
+
+let rec approx_modtype env smty =
+ match smty.pmty_desc with
+ Pmty_ident lid ->
+ let path =
+ Env.lookup_modtype_path ~use:false ~loc:smty.pmty_loc lid.txt env
+ in
+ Mty_ident path
+ | Pmty_alias lid ->
+ let path =
+ Env.lookup_module_path ~use:false ~load:false
+ ~loc:smty.pmty_loc lid.txt env
+ in
+ Mty_alias(path)
+ | Pmty_signature ssg ->
+ Mty_signature(approx_sig env ssg)
+ | Pmty_functor(param, sres) ->
+ let (param, newenv) =
+ match param with
+ | Unit -> Types.Unit, env
+ | Named (param, sarg) ->
+ let arg = approx_modtype env sarg in
+ match param.txt with
+ | None -> Types.Named (None, arg), env
+ | Some name ->
+ let rarg = Mtype.scrape_for_functor_arg env arg in
+ let scope = Ctype.create_scope () in
+ let (id, newenv) =
+ Env.enter_module ~scope ~arg:true name Mp_present rarg env
+ in
+ Types.Named (Some id, arg), newenv
+ in
+ let res = approx_modtype newenv sres in
+ Mty_functor(param, res)
+ | Pmty_with(sbody, constraints) ->
+ let body = approx_modtype env sbody in
+ List.iter
+ (fun sdecl ->
+ match sdecl with
+ | Pwith_type _
+ | Pwith_typesubst _
+ | Pwith_modtype _
+ | Pwith_modtypesubst _ -> ()
+ | Pwith_module (_, lid') ->
+ (* Lookup the module to make sure that it is not recursive.
+ (GPR#1626) *)
+ ignore (Env.lookup_module_path ~use:false ~load:false
+ ~loc:lid'.loc lid'.txt env)
+ | Pwith_modsubst (_, lid') ->
+ ignore (Env.lookup_module_path ~use:false ~load:false
+ ~loc:lid'.loc lid'.txt env))
+ constraints;
+ body
+ | Pmty_typeof smod ->
+ let (_, mty) = !type_module_type_of_fwd env smod in
+ mty
+ | Pmty_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and approx_module_declaration env pmd =
+ {
+ Types.md_type = approx_modtype env pmd.pmd_type;
+ md_attributes = pmd.pmd_attributes;
+ md_loc = pmd.pmd_loc;
+ md_uid = Uid.internal_not_actually_unique;
+ }
+
+and approx_sig env ssg =
+ match ssg with
+ [] -> []
+ | item :: srem ->
+ match item.psig_desc with
+ | Psig_type (rec_flag, sdecls) ->
+ let decls = Typedecl.approx_type_decl sdecls in
+ let rem = approx_sig env srem in
+ map_rec_type ~rec_flag
+ (fun rs (id, info) -> Sig_type(id, info, rs, Exported)) decls rem
+ | Psig_typesubst _ -> approx_sig env srem
+ | Psig_module { pmd_name = { txt = None; _ }; _ } ->
+ approx_sig env srem
+ | Psig_module pmd ->
+ let scope = Ctype.create_scope () in
+ let md = approx_module_declaration env pmd in
+ let pres =
+ match md.Types.md_type with
+ | Mty_alias _ -> Mp_absent
+ | _ -> Mp_present
+ in
+ let id, newenv =
+ Env.enter_module_declaration ~scope (Option.get pmd.pmd_name.txt)
+ pres md env
+ in
+ Sig_module(id, pres, md, Trec_not, Exported) :: approx_sig newenv srem
+ | Psig_modsubst pms ->
+ let scope = Ctype.create_scope () in
+ let _, md =
+ Env.lookup_module ~use:false ~loc:pms.pms_manifest.loc
+ pms.pms_manifest.txt env
+ in
+ let pres =
+ match md.Types.md_type with
+ | Mty_alias _ -> Mp_absent
+ | _ -> Mp_present
+ in
+ let _, newenv =
+ Env.enter_module_declaration ~scope pms.pms_name.txt pres md env
+ in
+ approx_sig newenv srem
+ | Psig_recmodule sdecls ->
+ let scope = Ctype.create_scope () in
+ let decls =
+ List.filter_map
+ (fun pmd ->
+ Option.map (fun name ->
+ Ident.create_scoped ~scope name,
+ approx_module_declaration env pmd
+ ) pmd.pmd_name.txt
+ )
+ sdecls
+ in
+ let newenv =
+ List.fold_left
+ (fun env (id, md) -> Env.add_module_declaration ~check:false
+ id Mp_present md env)
+ env decls
+ in
+ map_rec
+ (fun rs (id, md) -> Sig_module(id, Mp_present, md, rs, Exported))
+ decls
+ (approx_sig newenv srem)
+ | Psig_modtype d ->
+ let info = approx_modtype_info env d in
+ let scope = Ctype.create_scope () in
+ let (id, newenv) =
+ Env.enter_modtype ~scope d.pmtd_name.txt info env
+ in
+ Sig_modtype(id, info, Exported) :: approx_sig newenv srem
+ | Psig_modtypesubst d ->
+ let info = approx_modtype_info env d in
+ let scope = Ctype.create_scope () in
+ let (_id, newenv) =
+ Env.enter_modtype ~scope d.pmtd_name.txt info env
+ in
+ approx_sig newenv srem
+ | Psig_open sod ->
+ let _, env = type_open_descr env sod in
+ approx_sig env srem
+ | Psig_include sincl ->
+ let smty = sincl.pincl_mod in
+ let mty = approx_modtype env smty in
+ let scope = Ctype.create_scope () in
+ let sg, newenv = Env.enter_signature ~scope
+ (extract_sig env smty.pmty_loc mty) env in
+ sg @ approx_sig newenv srem
+ | Psig_class sdecls | Psig_class_type sdecls ->
+ let decls, env = Typeclass.approx_class_declarations env sdecls in
+ let rem = approx_sig env srem in
+ map_rec (fun rs decl ->
+ let open Typeclass in [
+ Sig_class_type(decl.clsty_ty_id, decl.clsty_ty_decl, rs,
+ Exported);
+ Sig_type(decl.clsty_obj_id, decl.clsty_obj_abbr, rs, Exported);
+ ]
+ ) decls [rem]
+ |> List.flatten
+ | _ ->
+ approx_sig env srem
+
+and approx_modtype_info env sinfo =
+ {
+ mtd_type = Option.map (approx_modtype env) sinfo.pmtd_type;
+ mtd_attributes = sinfo.pmtd_attributes;
+ mtd_loc = sinfo.pmtd_loc;
+ mtd_uid = Uid.internal_not_actually_unique;
+ }
+
+let approx_modtype env smty =
+ Warnings.without_warnings
+ (fun () -> approx_modtype env smty)
+
+(* Auxiliaries for checking the validity of name shadowing in signatures and
+ structures.
+ If a shadowing is valid, we also record some information (its ident,
+ location where it first appears, etc) about the item that gets shadowed. *)
+module Signature_names : sig
+ type t
+
+ type shadowable =
+ {
+ self: Ident.t;
+ group: Ident.t list;
+ (** group includes the element itself and all elements
+ that should be removed at the same time
+ *)
+ loc:Location.t;
+ }
+
+ type info = [
+ | `Exported
+ | `From_open
+ | `Shadowable of shadowable
+ | `Substituted_away of Subst.Unsafe.t
+ ]
+
+ val create : unit -> t
+
+ val check_value : ?info:info -> t -> Location.t -> Ident.t -> unit
+ val check_type : ?info:info -> t -> Location.t -> Ident.t -> unit
+ val check_typext : ?info:info -> t -> Location.t -> Ident.t -> unit
+ val check_module : ?info:info -> t -> Location.t -> Ident.t -> unit
+ val check_modtype : ?info:info -> t -> Location.t -> Ident.t -> unit
+ val check_class : ?info:info -> t -> Location.t -> Ident.t -> unit
+ val check_class_type: ?info:info -> t -> Location.t -> Ident.t -> unit
+
+ val check_sig_item:
+ ?info:info -> t -> Location.t -> Signature_group.rec_group -> unit
+
+ val simplify: Env.t -> t -> Types.signature -> Types.signature
+end = struct
+
+ type shadowable =
+ {
+ self: Ident.t;
+ group: Ident.t list;
+ (** group includes the element itself and all elements
+ that should be removed at the same time
+ *)
+ loc:Location.t;
+ }
+
+ type bound_info = [
+ | `Exported
+ | `Shadowable of shadowable
+ ]
+
+ type info = [
+ | `From_open
+ | `Substituted_away of Subst.Unsafe.t
+ | bound_info
+ ]
+
+ type hide_reason =
+ | From_open
+ | Shadowed_by of Ident.t * Location.t
+
+ type to_be_removed = {
+ mutable subst: Subst.Unsafe.t;
+ mutable hide: (Sig_component_kind.t * Location.t * hide_reason) Ident.Map.t;
+ }
+
+ type names_infos = (string, bound_info) Hashtbl.t
+
+ type names = {
+ values: names_infos;
+ types: names_infos;
+ modules: names_infos;
+ modtypes: names_infos;
+ typexts: names_infos;
+ classes: names_infos;
+ class_types: names_infos;
+ }
+
+ let new_names () = {
+ values = Hashtbl.create 16;
+ types = Hashtbl.create 16;
+ modules = Hashtbl.create 16;
+ modtypes = Hashtbl.create 16;
+ typexts = Hashtbl.create 16;
+ classes = Hashtbl.create 16;
+ class_types = Hashtbl.create 16;
+ }
+
+ type t = {
+ bound: names;
+ to_be_removed: to_be_removed;
+ }
+
+ let create () = {
+ bound = new_names ();
+ to_be_removed = {
+ subst = Subst.identity;
+ hide = Ident.Map.empty;
+ };
+ }
+
+ let table_for component names =
+ let open Sig_component_kind in
+ match component with
+ | Value -> names.values
+ | Type | Label | Constructor -> names.types
+ | Module -> names.modules
+ | Module_type -> names.modtypes
+ | Extension_constructor -> names.typexts
+ | Class -> names.classes
+ | Class_type -> names.class_types
+
+ let check_unsafe_subst loc env: _ result -> _ = function
+ | Ok x -> x
+ | Error (Subst.Unsafe.Fcm_type_substituted_away (p,_)) ->
+ raise (Error (loc, env, Non_packable_local_modtype_subst p))
+
+ let check cl t loc id (info : info) =
+ let to_be_removed = t.to_be_removed in
+ match info with
+ | `Substituted_away s ->
+ let subst =
+ check_unsafe_subst loc Env.empty @@
+ Subst.Unsafe.compose s to_be_removed.subst
+ in
+ to_be_removed.subst <- subst;
+ | `From_open ->
+ to_be_removed.hide <-
+ Ident.Map.add id (cl, loc, From_open) to_be_removed.hide
+ | #bound_info as bound_info ->
+ let tbl = table_for cl t.bound in
+ let name = Ident.name id in
+ match Hashtbl.find_opt tbl name with
+ | None -> Hashtbl.add tbl name bound_info
+ | Some (`Shadowable s) ->
+ Hashtbl.replace tbl name bound_info;
+ let reason = Shadowed_by (id, loc) in
+ List.iter (fun shadowed_id ->
+ to_be_removed.hide <-
+ Ident.Map.add shadowed_id (cl, s.loc, reason)
+ to_be_removed.hide
+ ) s.group
+ | Some `Exported ->
+ raise(Error(loc, Env.empty, Repeated_name(cl, name)))
+
+ let check_value ?info t loc id =
+ let info =
+ match info with
+ | Some i -> i
+ | None -> `Shadowable {self=id; group=[id]; loc}
+ in
+ check Sig_component_kind.Value t loc id info
+ let check_type ?(info=`Exported) t loc id =
+ check Sig_component_kind.Type t loc id info
+ let check_module ?(info=`Exported) t loc id =
+ check Sig_component_kind.Module t loc id info
+ let check_modtype ?(info=`Exported) t loc id =
+ check Sig_component_kind.Module_type t loc id info
+ let check_typext ?(info=`Exported) t loc id =
+ check Sig_component_kind.Extension_constructor t loc id info
+ let check_class ?(info=`Exported) t loc id =
+ check Sig_component_kind.Class t loc id info
+ let check_class_type ?(info=`Exported) t loc id =
+ check Sig_component_kind.Class_type t loc id info
+
+ let classify =
+ let open Sig_component_kind in
+ function
+ | Sig_type(id, _, _, _) -> Type, id
+ | Sig_module(id, _, _, _, _) -> Module, id
+ | Sig_modtype(id, _, _) -> Module_type, id
+ | Sig_typext(id, _, _, _) -> Extension_constructor, id
+ | Sig_value (id, _, _) -> Value, id
+ | Sig_class (id, _, _, _) -> Class, id
+ | Sig_class_type (id, _, _, _) -> Class_type, id
+
+ let check_item ?info names loc kind id ids =
+ let info =
+ match info with
+ | None -> `Shadowable {self=id; group=ids; loc}
+ | Some i -> i
+ in
+ check kind names loc id info
+
+ let check_sig_item ?info names loc (item:Signature_group.rec_group) =
+ let check ?info names loc item =
+ let all = List.map classify (Signature_group.flatten item) in
+ let group = List.map snd all in
+ List.iter (fun (kind,id) -> check_item ?info names loc kind id group)
+ all
+ in
+ (* we can ignore x.pre_ghosts: they are eliminated by strengthening, and
+ thus never appear in includes *)
+ List.iter (check ?info names loc) (Signature_group.rec_items item.group)
+
+ (* We usually require name uniqueness of signature components (e.g. types,
+ modules, etc), however in some situation reusing the name is allowed: if
+ the component is a value or an extension, or if the name is introduced by
+ an include.
+ When there are multiple specifications of a component with the same name,
+ we try to keep only the last (rightmost) one, removing all references to
+ the previous ones from the signature.
+ If some reference cannot be removed, then we error out with
+ [Cannot_hide_id].
+ *)
+ let simplify env t sg =
+ let to_remove = t.to_be_removed in
+ let ids_to_remove =
+ Ident.Map.fold (fun id (kind, _, _) lst ->
+ if Sig_component_kind.can_appear_in_types kind then
+ id :: lst
+ else
+ lst
+ ) to_remove.hide []
+ in
+ let simplify_item (component: Types.signature_item) =
+ let user_kind, user_id, user_loc =
+ let open Sig_component_kind in
+ match component with
+ | Sig_value(id, v, _) -> Value, id, v.val_loc
+ | Sig_type (id, td, _, _) -> Type, id, td.type_loc
+ | Sig_typext (id, te, _, _) -> Extension_constructor, id, te.ext_loc
+ | Sig_module (id, _, md, _, _) -> Module, id, md.md_loc
+ | Sig_modtype (id, mtd, _) -> Module_type, id, mtd.mtd_loc
+ | Sig_class (id, c, _, _) -> Class, id, c.cty_loc
+ | Sig_class_type (id, ct, _, _) -> Class_type, id, ct.clty_loc
+ in
+ if Ident.Map.mem user_id to_remove.hide then
+ None
+ else begin
+ let component =
+ if to_remove.subst == Subst.identity then
+ component
+ else
+ check_unsafe_subst user_loc env @@
+ Subst.Unsafe.signature_item Keep to_remove.subst component
+ in
+ let component =
+ match ids_to_remove with
+ | [] -> component
+ | ids ->
+ try Mtype.nondep_sig_item env ids component with
+ | Ctype.Nondep_cannot_erase removed_item_id ->
+ let (removed_item_kind, removed_item_loc, reason) =
+ Ident.Map.find removed_item_id to_remove.hide
+ in
+ let err_loc, hiding_error =
+ match reason with
+ | From_open ->
+ removed_item_loc,
+ Appears_in_signature {
+ opened_item_kind = removed_item_kind;
+ opened_item_id = removed_item_id;
+ user_id;
+ user_kind;
+ user_loc;
+ }
+ | Shadowed_by (shadower_id, shadower_loc) ->
+ shadower_loc,
+ Illegal_shadowing {
+ shadowed_item_kind = removed_item_kind;
+ shadowed_item_id = removed_item_id;
+ shadowed_item_loc = removed_item_loc;
+ shadower_id;
+ user_id;
+ user_kind;
+ user_loc;
+ }
+ in
+ raise (Error(err_loc, env, Cannot_hide_id hiding_error))
+ in
+ Some component
+ end
+ in
+ List.filter_map simplify_item sg
+end
+
+let has_remove_aliases_attribute attr =
+ let remove_aliases =
+ Attr_helper.get_no_payload_attribute "remove_aliases" attr
+ in
+ match remove_aliases with
+ | None -> false
+ | Some _ -> true
+
+(* Check and translate a module type expression *)
+
+let transl_modtype_longident loc env lid =
+ Env.lookup_modtype_path ~loc lid env
+
+let transl_module_alias loc env lid =
+ Env.lookup_module_path ~load:false ~loc lid env
+
+let mkmty desc typ env loc attrs =
+ let mty = {
+ mty_desc = desc;
+ mty_type = typ;
+ mty_loc = loc;
+ mty_env = env;
+ mty_attributes = attrs;
+ } in
+ Cmt_format.add_saved_type (Cmt_format.Partial_module_type mty);
+ mty
+
+let mksig desc env loc =
+ let sg = { sig_desc = desc; sig_loc = loc; sig_env = env } in
+ Cmt_format.add_saved_type (Cmt_format.Partial_signature_item sg);
+ sg
+
+(* let signature sg = List.map (fun item -> item.sig_type) sg *)
+
+let rec transl_modtype env smty =
+ Builtin_attributes.warning_scope smty.pmty_attributes
+ (fun () -> transl_modtype_aux env smty)
+
+and transl_modtype_functor_arg env sarg =
+ let mty = transl_modtype env sarg in
+ {mty with mty_type = Mtype.scrape_for_functor_arg env mty.mty_type}
+
+and transl_modtype_aux env smty =
+ let loc = smty.pmty_loc in
+ match smty.pmty_desc with
+ Pmty_ident lid ->
+ let path = transl_modtype_longident loc env lid.txt in
+ mkmty (Tmty_ident (path, lid)) (Mty_ident path) env loc
+ smty.pmty_attributes
+ | Pmty_alias lid ->
+ let path = transl_module_alias loc env lid.txt in
+ mkmty (Tmty_alias (path, lid)) (Mty_alias path) env loc
+ smty.pmty_attributes
+ | Pmty_signature ssg ->
+ let sg = transl_signature env ssg in
+ mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc
+ smty.pmty_attributes
+ | Pmty_functor(sarg_opt, sres) ->
+ let t_arg, ty_arg, newenv =
+ match sarg_opt with
+ | Unit -> Unit, Types.Unit, env
+ | Named (param, sarg) ->
+ let arg = transl_modtype_functor_arg env sarg in
+ let (id, newenv) =
+ match param.txt with
+ | None -> None, env
+ | Some name ->
+ let scope = Ctype.create_scope () in
+ let id, newenv =
+ let arg_md =
+ { md_type = arg.mty_type;
+ md_attributes = [];
+ md_loc = param.loc;
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ Env.enter_module_declaration ~scope ~arg:true name Mp_present
+ arg_md env
+ in
+ Some id, newenv
+ in
+ Named (id, param, arg), Types.Named (id, arg.mty_type), newenv
+ in
+ let res = transl_modtype newenv sres in
+ mkmty (Tmty_functor (t_arg, res))
+ (Mty_functor(ty_arg, res.mty_type)) env loc
+ smty.pmty_attributes
+ | Pmty_with(sbody, constraints) ->
+ let body = transl_modtype env sbody in
+ let init_sg = extract_sig env sbody.pmty_loc body.mty_type in
+ let remove_aliases = has_remove_aliases_attribute smty.pmty_attributes in
+ let (rev_tcstrs, final_sg) =
+ List.fold_left (transl_with ~loc:smty.pmty_loc env remove_aliases)
+ ([],init_sg) constraints in
+ let scope = Ctype.create_scope () in
+ mkmty (Tmty_with ( body, List.rev rev_tcstrs))
+ (Mtype.freshen ~scope (Mty_signature final_sg)) env loc
+ smty.pmty_attributes
+ | Pmty_typeof smod ->
+ let env = Env.in_signature false env in
+ let tmty, mty = !type_module_type_of_fwd env smod in
+ mkmty (Tmty_typeof tmty) mty env loc smty.pmty_attributes
+ | Pmty_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and transl_with ~loc env remove_aliases (rev_tcstrs,sg) constr =
+ let lid, with_info = match constr with
+ | Pwith_type (l,decl) ->l , With_type decl
+ | Pwith_typesubst (l,decl) ->l , With_typesubst decl
+ | Pwith_module (l,l') ->
+ let path, md = Env.lookup_module ~loc l'.txt env in
+ l , With_module {lid=l';path;md; remove_aliases}
+ | Pwith_modsubst (l,l') ->
+ let path, md' = Env.lookup_module ~loc l'.txt env in
+ l , With_modsubst (l',path,md')
+ | Pwith_modtype (l,smty) ->
+ let mty = transl_modtype env smty in
+ l, With_modtype mty
+ | Pwith_modtypesubst (l,smty) ->
+ let mty = transl_modtype env smty in
+ l, With_modtypesubst mty
+ in
+ let ((path, lid, tcstr), sg) = merge_constraint env loc sg lid with_info in
+ (* Only package with constraints result in None here. *)
+ let tcstr = Option.get tcstr in
+ ((path, lid, tcstr) :: rev_tcstrs, sg)
+
+
+
+and transl_signature env sg =
+ let names = Signature_names.create () in
+ let rec transl_sig env sg =
+ match sg with
+ [] -> [], [], env
+ | item :: srem ->
+ let loc = item.psig_loc in
+ match item.psig_desc with
+ | Psig_value sdesc ->
+ let (tdesc, newenv) =
+ Typedecl.transl_value_decl env item.psig_loc sdesc
+ in
+ Signature_names.check_value names tdesc.val_loc tdesc.val_id;
+ let (trem,rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_value tdesc) env loc :: trem,
+ Sig_value(tdesc.val_id, tdesc.val_val, Exported) :: rem,
+ final_env
+ | Psig_type (rec_flag, sdecls) ->
+ let (decls, newenv, _) =
+ Typedecl.transl_type_decl env rec_flag sdecls
+ in
+ List.iter (fun td ->
+ Signature_names.check_type names td.typ_loc td.typ_id;
+ ) decls;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ let sg =
+ map_rec_type_with_row_types ~rec_flag
+ (fun rs td -> Sig_type(td.typ_id, td.typ_type, rs, Exported))
+ decls rem
+ in
+ mksig (Tsig_type (rec_flag, decls)) env loc :: trem,
+ sg,
+ final_env
+ | Psig_typesubst sdecls ->
+ let (decls, newenv, _) =
+ Typedecl.transl_type_decl env Nonrecursive sdecls
+ in
+ List.iter (fun td ->
+ if td.typ_kind <> Ttype_abstract || td.typ_manifest = None ||
+ td.typ_private = Private
+ then
+ raise (Error (td.typ_loc, env, Invalid_type_subst_rhs));
+ let params = td.typ_type.type_params in
+ if params_are_constrained params
+ then raise(Error(loc, env, With_cannot_remove_constrained_type));
+ let info =
+ let subst =
+ Subst.Unsafe.add_type_function (Pident td.typ_id)
+ ~params
+ ~body:(Option.get td.typ_type.type_manifest)
+ Subst.identity
+ in
+ Some (`Substituted_away subst)
+ in
+ Signature_names.check_type ?info names td.typ_loc td.typ_id
+ ) decls;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ let sg = rem
+ in
+ mksig (Tsig_typesubst decls) env loc :: trem,
+ sg,
+ final_env
+ | Psig_typext styext ->
+ let (tyext, newenv, _shapes) =
+ Typedecl.transl_type_extension false env item.psig_loc styext
+ in
+ let constructors = tyext.tyext_constructors in
+ List.iter (fun ext ->
+ Signature_names.check_typext names ext.ext_loc ext.ext_id
+ ) constructors;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_typext tyext) env loc :: trem,
+ map_ext (fun es ext ->
+ Sig_typext(ext.ext_id, ext.ext_type, es, Exported)
+ ) constructors rem,
+ final_env
+ | Psig_exception sext ->
+ let (ext, newenv, _s) = Typedecl.transl_type_exception env sext in
+ let constructor = ext.tyexn_constructor in
+ Signature_names.check_typext names constructor.ext_loc
+ constructor.ext_id;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_exception ext) env loc :: trem,
+ Sig_typext(constructor.ext_id,
+ constructor.ext_type,
+ Text_exception,
+ Exported) :: rem,
+ final_env
+ | Psig_module pmd ->
+ let scope = Ctype.create_scope () in
+ let tmty =
+ Builtin_attributes.warning_scope pmd.pmd_attributes
+ (fun () -> transl_modtype env pmd.pmd_type)
+ in
+ let pres =
+ match tmty.mty_type with
+ | Mty_alias p ->
+ if Env.is_functor_arg p env then
+ raise (Error (pmd.pmd_loc, env, Cannot_alias p));
+ Mp_absent
+ | _ -> Mp_present
+ in
+ let md = {
+ md_type=tmty.mty_type;
+ md_attributes=pmd.pmd_attributes;
+ md_loc=pmd.pmd_loc;
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ let id, newenv =
+ match pmd.pmd_name.txt with
+ | None -> None, env
+ | Some name ->
+ let id, newenv =
+ Env.enter_module_declaration ~scope name pres md env
+ in
+ Signature_names.check_module names pmd.pmd_name.loc id;
+ Some id, newenv
+ in
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_module {md_id=id; md_name=pmd.pmd_name;
+ md_uid=md.md_uid; md_presence=pres;
+ md_type=tmty; md_loc=pmd.pmd_loc;
+ md_attributes=pmd.pmd_attributes})
+ env loc :: trem,
+ (match id with
+ | None -> rem
+ | Some id -> Sig_module(id, pres, md, Trec_not, Exported) :: rem),
+ final_env
+ | Psig_modsubst pms ->
+ let scope = Ctype.create_scope () in
+ let path, md =
+ Env.lookup_module ~loc:pms.pms_manifest.loc
+ pms.pms_manifest.txt env
+ in
+ let aliasable = not (Env.is_functor_arg path env) in
+ let md =
+ if not aliasable then
+ md
+ else
+ { md_type = Mty_alias path;
+ md_attributes = pms.pms_attributes;
+ md_loc = pms.pms_loc;
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ let pres =
+ match md.md_type with
+ | Mty_alias _ -> Mp_absent
+ | _ -> Mp_present
+ in
+ let id, newenv =
+ Env.enter_module_declaration ~scope pms.pms_name.txt pres md env
+ in
+ let info =
+ `Substituted_away (Subst.add_module id path Subst.identity)
+ in
+ Signature_names.check_module ~info names pms.pms_name.loc id;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_modsubst {ms_id=id; ms_name=pms.pms_name;
+ ms_uid=md.md_uid; ms_manifest=path;
+ ms_txt=pms.pms_manifest; ms_loc=pms.pms_loc;
+ ms_attributes=pms.pms_attributes})
+ env loc :: trem,
+ rem,
+ final_env
+ | Psig_recmodule sdecls ->
+ let (tdecls, newenv) =
+ transl_recmodule_modtypes env sdecls in
+ let decls =
+ List.filter_map (fun (md, uid, _) ->
+ match md.md_id with
+ | None -> None
+ | Some id -> Some (id, md, uid)
+ ) tdecls
+ in
+ List.iter (fun (id, md, _uid) ->
+ Signature_names.check_module names md.md_loc id;
+ ) decls;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_recmodule (List.map (fun (md, _, _) -> md) tdecls))
+ env loc :: trem,
+ map_rec (fun rs (id, md, uid) ->
+ let d = {Types.md_type = md.md_type.mty_type;
+ md_attributes = md.md_attributes;
+ md_loc = md.md_loc;
+ md_uid = uid;
+ } in
+ Sig_module(id, Mp_present, d, rs, Exported))
+ decls rem,
+ final_env
+ | Psig_modtype pmtd ->
+ let newenv, mtd, decl = transl_modtype_decl env pmtd in
+ Signature_names.check_modtype names pmtd.pmtd_loc mtd.mtd_id;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_modtype mtd) env loc :: trem,
+ Sig_modtype (mtd.mtd_id, decl, Exported) :: rem,
+ final_env
+ | Psig_modtypesubst pmtd ->
+ let newenv, mtd, _decl = transl_modtype_decl env pmtd in
+ let info =
+ let mty = match mtd.mtd_type with
+ | Some tmty -> tmty.mty_type
+ | None ->
+ (* parsetree invariant, see Ast_invariants *)
+ assert false
+ in
+ let subst =
+ Subst.Unsafe.add_modtype mtd.mtd_id mty Subst.identity in
+ `Substituted_away subst
+ in
+ Signature_names.check_modtype ~info names pmtd.pmtd_loc mtd.mtd_id;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_modtypesubst mtd) env loc :: trem,
+ rem,
+ final_env
+ | Psig_open sod ->
+ let (od, newenv) = type_open_descr env sod in
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_open od) env loc :: trem,
+ rem, final_env
+ | Psig_include sincl ->
+ let smty = sincl.pincl_mod in
+ let tmty =
+ Builtin_attributes.warning_scope sincl.pincl_attributes
+ (fun () -> transl_modtype env smty)
+ in
+ let mty = tmty.mty_type in
+ let scope = Ctype.create_scope () in
+ let sg, newenv = Env.enter_signature ~scope
+ (extract_sig env smty.pmty_loc mty) env in
+ Signature_group.iter
+ (Signature_names.check_sig_item names item.psig_loc)
+ sg;
+ let incl =
+ { incl_mod = tmty;
+ incl_type = sg;
+ incl_attributes = sincl.pincl_attributes;
+ incl_loc = sincl.pincl_loc;
+ }
+ in
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_include incl) env loc :: trem,
+ sg @ rem,
+ final_env
+ | Psig_class cl ->
+ let (classes, newenv) = Typeclass.class_descriptions env cl in
+ List.iter (fun cls ->
+ let open Typeclass in
+ let loc = cls.cls_id_loc.Location.loc in
+ Signature_names.check_type names loc cls.cls_obj_id;
+ Signature_names.check_class names loc cls.cls_id;
+ Signature_names.check_class_type names loc cls.cls_ty_id;
+ ) classes;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ let sg =
+ map_rec (fun rs cls ->
+ let open Typeclass in
+ [Sig_class(cls.cls_id, cls.cls_decl, rs, Exported);
+ Sig_class_type(cls.cls_ty_id, cls.cls_ty_decl, rs, Exported);
+ Sig_type(cls.cls_obj_id, cls.cls_obj_abbr, rs, Exported)
+ ]
+ ) classes [rem]
+ |> List.flatten
+ in
+ let typedtree =
+ mksig (Tsig_class
+ (List.map (fun decr ->
+ decr.Typeclass.cls_info) classes)) env loc
+ :: trem
+ in
+ typedtree, sg, final_env
+ | Psig_class_type cl ->
+ let (classes, newenv) = Typeclass.class_type_declarations env cl in
+ List.iter (fun decl ->
+ let open Typeclass in
+ let loc = decl.clsty_id_loc.Location.loc in
+ Signature_names.check_class_type names loc decl.clsty_ty_id;
+ Signature_names.check_type names loc decl.clsty_obj_id;
+ ) classes;
+ let (trem,rem, final_env) = transl_sig newenv srem in
+ let sg =
+ map_rec (fun rs decl ->
+ let open Typeclass in
+ [Sig_class_type(decl.clsty_ty_id, decl.clsty_ty_decl, rs,
+ Exported);
+ Sig_type(decl.clsty_obj_id, decl.clsty_obj_abbr, rs, Exported);
+ ]
+ ) classes [rem]
+ |> List.flatten
+ in
+ let typedtree =
+ mksig
+ (Tsig_class_type
+ (List.map (fun decl -> decl.Typeclass.clsty_info) classes))
+ env loc
+ :: trem
+ in
+ typedtree, sg, final_env
+ | Psig_attribute x ->
+ Builtin_attributes.warning_attribute x;
+ let (trem,rem, final_env) = transl_sig env srem in
+ mksig (Tsig_attribute x) env loc :: trem, rem, final_env
+ | Psig_extension (ext, _attrs) ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+ in
+ let previous_saved_types = Cmt_format.get_saved_types () in
+ Builtin_attributes.warning_scope []
+ (fun () ->
+ let (trem, rem, final_env) = transl_sig (Env.in_signature true env) sg in
+ let rem = Signature_names.simplify final_env names rem in
+ let sg =
+ { sig_items = trem; sig_type = rem; sig_final_env = final_env }
+ in
+ Cmt_format.set_saved_types
+ ((Cmt_format.Partial_signature sg) :: previous_saved_types);
+ sg
+ )
+
+and transl_modtype_decl env pmtd =
+ Builtin_attributes.warning_scope pmtd.pmtd_attributes
+ (fun () -> transl_modtype_decl_aux env pmtd)
+
+and transl_modtype_decl_aux env
+ {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} =
+ let tmty =
+ Option.map (transl_modtype (Env.in_signature true env)) pmtd_type
+ in
+ let decl =
+ {
+ Types.mtd_type=Option.map (fun t -> t.mty_type) tmty;
+ mtd_attributes=pmtd_attributes;
+ mtd_loc=pmtd_loc;
+ mtd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ let scope = Ctype.create_scope () in
+ let (id, newenv) = Env.enter_modtype ~scope pmtd_name.txt decl env in
+ let mtd =
+ {
+ mtd_id=id;
+ mtd_name=pmtd_name;
+ mtd_uid=decl.mtd_uid;
+ mtd_type=tmty;
+ mtd_attributes=pmtd_attributes;
+ mtd_loc=pmtd_loc;
+ }
+ in
+ newenv, mtd, decl
+
+and transl_recmodule_modtypes env sdecls =
+ let make_env curr =
+ List.fold_left (fun env (id_shape, _, md, _) ->
+ Option.fold ~none:env ~some:(fun (id, shape) ->
+ Env.add_module_declaration ~check:true ~shape ~arg:true
+ id Mp_present md env
+ ) id_shape
+ ) env curr
+ in
+ let transition env_c curr =
+ List.map2
+ (fun pmd (id_shape, id_loc, md, _) ->
+ let tmty =
+ Builtin_attributes.warning_scope pmd.pmd_attributes
+ (fun () -> transl_modtype env_c pmd.pmd_type)
+ in
+ let md = { md with Types.md_type = tmty.mty_type } in
+ (id_shape, id_loc, md, tmty))
+ sdecls curr in
+ let map_mtys curr =
+ List.filter_map
+ (fun (id_shape, _, md, _) ->
+ Option.map (fun (id, _) -> (id, md)) id_shape)
+ curr
+ in
+ let scope = Ctype.create_scope () in
+ let ids =
+ List.map (fun x -> Option.map (Ident.create_scoped ~scope) x.pmd_name.txt)
+ sdecls
+ in
+ let approx_env =
+ List.fold_left
+ (fun env ->
+ Option.fold ~none:env ~some:(fun id -> (* cf #5965 *)
+ Env.enter_unbound_module (Ident.name id)
+ Mod_unbound_illegal_recursion env
+ ))
+ env ids
+ in
+ let init =
+ List.map2
+ (fun id pmd ->
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
+ let md =
+ { md_type = approx_modtype approx_env pmd.pmd_type;
+ md_loc = pmd.pmd_loc;
+ md_attributes = pmd.pmd_attributes;
+ md_uid }
+ in
+ let id_shape =
+ Option.map (fun id -> id, Shape.var md_uid id) id
+ in
+ (id_shape, pmd.pmd_name, md, ()))
+ ids sdecls
+ in
+ let env0 = make_env init in
+ let dcl1 =
+ Warnings.without_warnings
+ (fun () -> transition env0 init)
+ in
+ let env1 = make_env dcl1 in
+ check_recmod_typedecls env1 (map_mtys dcl1);
+ let dcl2 = transition env1 dcl1 in
+(*
+ List.iter
+ (fun (id, mty) ->
+ Format.printf "%a: %a@." Printtyp.ident id Printtyp.modtype mty)
+ dcl2;
+*)
+ let env2 = make_env dcl2 in
+ check_recmod_typedecls env2 (map_mtys dcl2);
+ let dcl2 =
+ List.map2 (fun pmd (id_shape, id_loc, md, mty) ->
+ let tmd =
+ {md_id=Option.map fst id_shape; md_name=id_loc; md_type=mty;
+ md_uid=md.Types.md_uid; md_presence=Mp_present;
+ md_loc=pmd.pmd_loc;
+ md_attributes=pmd.pmd_attributes}
+ in
+ tmd, md.Types.md_uid, Option.map snd id_shape
+ ) sdecls dcl2
+ in
+ (dcl2, env2)
+
+(* Try to convert a module expression to a module path. *)
+
+exception Not_a_path
+
+let rec path_of_module mexp =
+ match mexp.mod_desc with
+ | Tmod_ident (p,_) -> p
+ | Tmod_apply(funct, arg, _coercion) when !Clflags.applicative_functors ->
+ Papply(path_of_module funct, path_of_module arg)
+ | Tmod_constraint (mexp, _, _, _) ->
+ path_of_module mexp
+ | (Tmod_structure _ | Tmod_functor _ | Tmod_apply_unit _ | Tmod_unpack _ |
+ Tmod_apply _) ->
+ raise Not_a_path
+
+let path_of_module mexp =
+ try Some (path_of_module mexp) with Not_a_path -> None
+
+(* Check that all core type schemes in a structure
+ do not contain non-generalized type variable *)
+
+let rec nongen_modtype env = function
+ Mty_ident _ -> None
+ | Mty_alias _ -> None
+ | Mty_signature sg ->
+ let env = Env.add_signature sg env in
+ List.find_map (nongen_signature_item env) sg
+ | Mty_functor(arg_opt, body) ->
+ let env =
+ match arg_opt with
+ | Unit
+ | Named (None, _) -> env
+ | Named (Some id, param) ->
+ Env.add_module ~arg:true id Mp_present param env
+ in
+ nongen_modtype env body
+
+and nongen_signature_item env = function
+ | Sig_value(_id, desc, _) ->
+ Ctype.nongen_vars_in_schema env desc.val_type
+ |> Option.map (fun vars -> (vars, desc))
+ | Sig_module(_id, _, md, _, _) -> nongen_modtype env md.md_type
+ | _ -> None
+
+let check_nongen_modtype env loc mty =
+ nongen_modtype env mty
+ |> Option.iter (fun (vars, item) ->
+ let vars = Btype.TypeSet.elements vars in
+ let error =
+ Non_generalizable_module { vars; item; mty }
+ in
+ raise(Error(loc, env, error))
+ )
+
+let check_nongen_signature_item env sig_item =
+ match sig_item with
+ Sig_value(_id, vd, _) ->
+ Ctype.nongen_vars_in_schema env vd.val_type
+ |> Option.iter (fun vars ->
+ let vars = Btype.TypeSet.elements vars in
+ let error =
+ Non_generalizable { vars; expression = vd.val_type }
+ in
+ raise (Error (vd.val_loc, env, error))
+ )
+ | Sig_module (_id, _, md, _, _) ->
+ check_nongen_modtype env md.md_loc md.md_type
+ | _ -> ()
+
+let check_nongen_signature env sg =
+ List.iter (check_nongen_signature_item env) sg
+
+(* Helpers for typing recursive modules *)
+
+let anchor_submodule name anchor =
+ match anchor, name with
+ | None, _
+ | _, None ->
+ None
+ | Some p, Some name ->
+ Some(Pdot(p, name))
+
+let anchor_recmodule = Option.map (fun id -> Pident id)
+
+let enrich_type_decls anchor decls oldenv newenv =
+ match anchor with
+ None -> newenv
+ | Some p ->
+ List.fold_left
+ (fun e info ->
+ let id = info.typ_id in
+ let info' =
+ Mtype.enrich_typedecl oldenv (Pdot(p, Ident.name id))
+ id info.typ_type
+ in
+ Env.add_type ~check:true id info' e)
+ oldenv decls
+
+let enrich_module_type anchor name mty env =
+ match anchor, name with
+ | None, _
+ | _, None ->
+ mty
+ | Some p, Some name ->
+ Mtype.enrich_modtype env (Pdot(p, name)) mty
+
+let check_recmodule_inclusion env bindings =
+ (* PR#4450, PR#4470: consider
+ module rec X : DECL = MOD where MOD has inferred type ACTUAL
+ The "natural" typing condition
+ E, X: ACTUAL |- ACTUAL <: DECL
+ leads to circularities through manifest types.
+ Instead, we "unroll away" the potential circularities a finite number
+ of times. The (weaker) condition we implement is:
+ E, X: DECL,
+ X1: ACTUAL,
+ X2: ACTUAL{X <- X1}/X1
+ ...
+ Xn: ACTUAL{X <- X(n-1)}/X(n-1)
+ |- ACTUAL{X <- Xn}/Xn <: DECL{X <- Xn}
+ so that manifest types rooted at X(n+1) are expanded in terms of X(n),
+ avoiding circularities. The strengthenings ensure that
+ Xn.t = X(n-1).t = ... = X2.t = X1.t.
+ N can be chosen arbitrarily; larger values of N result in more
+ recursive definitions being accepted. A good choice appears to be
+ the number of mutually recursive declarations. *)
+
+ let subst_and_strengthen env scope s id mty =
+ let mty = Subst.modtype (Rescope scope) s mty in
+ match id with
+ | None -> mty
+ | Some id ->
+ Mtype.strengthen ~aliasable:false env mty
+ (Subst.module_path s (Pident id))
+ in
+
+ let rec check_incl first_time n env s =
+ let scope = Ctype.create_scope () in
+ if n > 0 then begin
+ (* Generate fresh names Y_i for the rec. bound module idents X_i *)
+ let bindings1 =
+ List.map
+ (fun (id, _name, _mty_decl, _modl,
+ mty_actual, _attrs, _loc, shape, _uid) ->
+ let ids =
+ Option.map
+ (fun id -> (id, Ident.create_scoped ~scope (Ident.name id))) id
+ in
+ (ids, mty_actual, shape))
+ bindings in
+ (* Enter the Y_i in the environment with their actual types substituted
+ by the input substitution s *)
+ let env' =
+ List.fold_left
+ (fun env (ids, mty_actual, shape) ->
+ match ids with
+ | None -> env
+ | Some (id, id') ->
+ let mty_actual' =
+ if first_time
+ then mty_actual
+ else subst_and_strengthen env scope s (Some id) mty_actual
+ in
+ Env.add_module ~arg:false ~shape id' Mp_present mty_actual' env)
+ env bindings1 in
+ (* Build the output substitution Y_i <- X_i *)
+ let s' =
+ List.fold_left
+ (fun s (ids, _mty_actual, _shape) ->
+ match ids with
+ | None -> s
+ | Some (id, id') -> Subst.add_module id (Pident id') s)
+ Subst.identity bindings1 in
+ (* Recurse with env' and s' *)
+ check_incl false (n-1) env' s'
+ end else begin
+ (* Base case: check inclusion of s(mty_actual) in s(mty_decl)
+ and insert coercion if needed *)
+ let check_inclusion
+ (id, name, mty_decl, modl, mty_actual, attrs, loc, shape, uid) =
+ let mty_decl' = Subst.modtype (Rescope scope) s mty_decl.mty_type
+ and mty_actual' = subst_and_strengthen env scope s id mty_actual in
+ let coercion, shape =
+ try
+ Includemod.modtypes_with_shape ~shape
+ ~loc:modl.mod_loc ~mark:true
+ env mty_actual' mty_decl'
+ with Includemod.Error msg ->
+ raise(Error(modl.mod_loc, env, Not_included msg)) in
+ let modl' =
+ { mod_desc = Tmod_constraint(modl, mty_decl.mty_type,
+ Tmodtype_explicit mty_decl, coercion);
+ mod_type = mty_decl.mty_type;
+ mod_env = env;
+ mod_loc = modl.mod_loc;
+ mod_attributes = [];
+ } in
+ let mb =
+ {
+ mb_id = id;
+ mb_name = name;
+ mb_uid = uid;
+ mb_presence = Mp_present;
+ mb_expr = modl';
+ mb_attributes = attrs;
+ mb_loc = loc;
+ }
+ in
+ mb, shape, uid
+ in
+ List.map check_inclusion bindings
+ end
+ in check_incl true (List.length bindings) env Subst.identity
+
+(* Helper for unpack *)
+
+let rec package_constraints_sig env loc sg constrs =
+ List.map
+ (function
+ | Sig_type (id, ({type_params=[]} as td), rs, priv)
+ when List.mem_assoc [Ident.name id] constrs ->
+ let ty = List.assoc [Ident.name id] constrs in
+ let td = {td with type_manifest = Some ty} in
+ let type_immediate = Typedecl_immediacy.compute_decl env td in
+ Sig_type (id, {td with type_immediate}, rs, priv)
+ | Sig_module (id, pres, md, rs, priv) ->
+ let rec aux = function
+ | (m :: ((_ :: _) as l), t) :: rest when m = Ident.name id ->
+ (l, t) :: aux rest
+ | _ :: rest -> aux rest
+ | [] -> []
+ in
+ let md =
+ {md with
+ md_type = package_constraints env loc md.md_type (aux constrs)
+ }
+ in
+ Sig_module (id, pres, md, rs, priv)
+ | item -> item
+ )
+ sg
+
+and package_constraints env loc mty constrs =
+ if constrs = [] then mty
+ else begin
+ match Mtype.scrape env mty with
+ | Mty_signature sg ->
+ Mty_signature (package_constraints_sig env loc sg constrs)
+ | Mty_functor _ | Mty_alias _ -> assert false
+ | Mty_ident p -> raise(Error(loc, env, Cannot_scrape_package_type p))
+ end
+
+let modtype_of_package env loc p fl =
+ (* We call Ctype.duplicate_type to ensure that the types being added to the
+ module type are at generic_level. *)
+ let mty =
+ package_constraints env loc (Mty_ident p)
+ (List.map (fun (n, t) -> Longident.flatten n, Ctype.duplicate_type t) fl)
+ in
+ Subst.modtype Keep Subst.identity mty
+
+let package_subtype env p1 fl1 p2 fl2 =
+ let mkmty p fl =
+ let fl =
+ List.filter (fun (_n,t) -> Ctype.closed_type_expr t) fl in
+ modtype_of_package env Location.none p fl
+ in
+ match mkmty p1 fl1, mkmty p2 fl2 with
+ | exception Error(_, _, Cannot_scrape_package_type r) ->
+ Result.Error (Errortrace.Package_cannot_scrape r)
+ | mty1, mty2 ->
+ let loc = Location.none in
+ match Includemod.modtypes ~loc ~mark:true env mty1 mty2 with
+ | Tcoerce_none -> Ok ()
+ | c ->
+ let msg =
+ Includemod_errorprinter.coercion_in_package_subtype env mty1 c
+ in
+ Result.Error (Errortrace.Package_coercion msg)
+ | exception Includemod.Error e ->
+ let msg = doc_printf "%a" Includemod_errorprinter.err_msgs e in
+ Result.Error (Errortrace.Package_inclusion msg)
+
+let () = Ctype.package_subtype := package_subtype
+
+let wrap_constraint_package env mark arg mty explicit =
+ let mty1 = Subst.modtype Keep Subst.identity arg.mod_type in
+ let mty2 = Subst.modtype Keep Subst.identity mty in
+ let coercion =
+ try
+ Includemod.modtypes ~loc:arg.mod_loc env ~mark mty1 mty2
+ with Includemod.Error msg ->
+ raise(Error(arg.mod_loc, env, Not_included msg)) in
+ { mod_desc = Tmod_constraint(arg, mty, explicit, coercion);
+ mod_type = mty;
+ mod_env = env;
+ mod_attributes = [];
+ mod_loc = arg.mod_loc }
+
+let wrap_constraint_with_shape env mark arg mty
+ shape explicit =
+ let coercion, shape =
+ try
+ Includemod.modtypes_with_shape ~shape ~loc:arg.mod_loc env ~mark
+ arg.mod_type mty
+ with Includemod.Error msg ->
+ raise(Error(arg.mod_loc, env, Not_included msg)) in
+ { mod_desc = Tmod_constraint(arg, mty, explicit, coercion);
+ mod_type = mty;
+ mod_env = env;
+ mod_attributes = [];
+ mod_loc = arg.mod_loc }, shape
+
+(* Type a module value expression *)
+
+
+(* These describe the X in [F(X)] (which might be missing, for [F ()]) *)
+type argument_summary = {
+ is_syntactic_unit: bool;
+ arg: Typedtree.module_expr;
+ path: Path.t option;
+ shape: Shape.t
+}
+
+type application_summary = {
+ loc: Location.t;
+ attributes: attributes;
+ f_loc: Location.t; (* loc for F *)
+ arg: argument_summary option (* None for () *)
+}
+
+let simplify_app_summary app_view = match app_view.arg with
+ | None ->
+ Includemod.Error.Unit, Mty_signature []
+ | Some arg ->
+ let mty = arg.arg.mod_type in
+ match arg.is_syntactic_unit , arg.path with
+ | true , _ -> Includemod.Error.Empty_struct, mty
+ | false, Some p -> Includemod.Error.Named p, mty
+ | false, None -> Includemod.Error.Anonymous, mty
+
+let not_principal msg = Warnings.Not_principal (Format_doc.Doc.msg msg)
+
+let rec type_module ?(alias=false) sttn funct_body anchor env smod =
+ Builtin_attributes.warning_scope smod.pmod_attributes
+ (fun () -> type_module_aux ~alias sttn funct_body anchor env smod)
+
+and type_module_aux ~alias sttn funct_body anchor env smod =
+ match smod.pmod_desc with
+ Pmod_ident lid ->
+ let path =
+ Env.lookup_module_path ~load:(not alias) ~loc:smod.pmod_loc lid.txt env
+ in
+ let md = { mod_desc = Tmod_ident (path, lid);
+ mod_type = Mty_alias path;
+ mod_env = env;
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc } in
+ let aliasable = not (Env.is_functor_arg path env) in
+ let shape =
+ Env.shape_of_path ~namespace:Shape.Sig_component_kind.Module env path
+ in
+ let shape = if alias && aliasable then Shape.alias shape else shape in
+ let md =
+ if alias && aliasable then
+ (Env.add_required_global (Path.head path); md)
+ else begin
+ let mty =
+ if sttn then
+ Env.find_strengthened_module ~aliasable path env
+ else
+ (Env.find_module path env).md_type
+ in
+ match mty with
+ | Mty_alias p1 when not alias ->
+ let p1 = Env.normalize_module_path (Some smod.pmod_loc) env p1 in
+ let mty = Includemod.expand_module_alias
+ ~strengthen:sttn env p1 in
+ { md with
+ mod_desc =
+ Tmod_constraint (md, mty, Tmodtype_implicit,
+ Tcoerce_alias (env, path, Tcoerce_none));
+ mod_type = mty }
+ | mty ->
+ { md with mod_type = mty }
+ end
+ in
+ md, shape
+ | Pmod_structure sstr ->
+ let (str, sg, names, shape, _finalenv) =
+ type_structure funct_body anchor env sstr in
+ let md =
+ { mod_desc = Tmod_structure str;
+ mod_type = Mty_signature sg;
+ mod_env = env;
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc }
+ in
+ let sg' = Signature_names.simplify _finalenv names sg in
+ if List.length sg' = List.length sg then md, shape else
+ wrap_constraint_with_shape env false md
+ (Mty_signature sg') shape Tmodtype_implicit
+ | Pmod_functor(arg_opt, sbody) ->
+ let t_arg, ty_arg, newenv, funct_shape_param, funct_body =
+ match arg_opt with
+ | Unit ->
+ Unit, Types.Unit, env, Shape.for_unnamed_functor_param, false
+ | Named (param, smty) ->
+ let mty = transl_modtype_functor_arg env smty in
+ let scope = Ctype.create_scope () in
+ let (id, newenv, var) =
+ match param.txt with
+ | None -> None, env, Shape.for_unnamed_functor_param
+ | Some name ->
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
+ let arg_md =
+ { md_type = mty.mty_type;
+ md_attributes = [];
+ md_loc = param.loc;
+ md_uid;
+ }
+ in
+ let id = Ident.create_scoped ~scope name in
+ let shape = Shape.var md_uid id in
+ let newenv = Env.add_module_declaration
+ ~shape ~arg:true ~check:true id Mp_present arg_md env
+ in
+ Some id, newenv, id
+ in
+ Named (id, param, mty), Types.Named (id, mty.mty_type), newenv,
+ var, true
+ in
+ let body, body_shape = type_module true funct_body None newenv sbody in
+ { mod_desc = Tmod_functor(t_arg, body);
+ mod_type = Mty_functor(ty_arg, body.mod_type);
+ mod_env = env;
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc },
+ Shape.abs funct_shape_param body_shape
+ | Pmod_apply _ | Pmod_apply_unit _ ->
+ type_application smod.pmod_loc sttn funct_body env smod
+ | Pmod_constraint(sarg, smty) ->
+ let arg, arg_shape = type_module ~alias true funct_body anchor env sarg in
+ let mty = transl_modtype env smty in
+ let md, final_shape =
+ wrap_constraint_with_shape env true arg mty.mty_type arg_shape
+ (Tmodtype_explicit mty)
+ in
+ { md with
+ mod_loc = smod.pmod_loc;
+ mod_attributes = smod.pmod_attributes;
+ },
+ final_shape
+ | Pmod_unpack sexp ->
+ let exp =
+ Ctype.with_local_level_generalize_structure_if_principal
+ (fun () -> Typecore.type_exp env sexp)
+ in
+ let mty =
+ match get_desc (Ctype.expand_head env exp.exp_type) with
+ Tpackage (p, fl) ->
+ if List.exists (fun (_n, t) -> not (Ctype.closed_type_expr t)) fl
+ then
+ raise (Error (smod.pmod_loc, env,
+ Incomplete_packed_module exp.exp_type));
+ if !Clflags.principal &&
+ not (Typecore.generalizable (Btype.generic_level-1) exp.exp_type)
+ then
+ Location.prerr_warning smod.pmod_loc
+ (not_principal "this module unpacking");
+ modtype_of_package env smod.pmod_loc p fl
+ | Tvar _ ->
+ raise (Typecore.Error
+ (smod.pmod_loc, env, Typecore.Cannot_infer_signature))
+ | _ ->
+ raise (Error(smod.pmod_loc, env, Not_a_packed_module exp.exp_type))
+ in
+ if funct_body && Mtype.contains_type env mty then
+ raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
+ { mod_desc = Tmod_unpack(exp, mty);
+ mod_type = mty;
+ mod_env = env;
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc },
+ Shape.leaf_for_unpack
+ | Pmod_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and type_application loc strengthen funct_body env smod =
+ let rec extract_application funct_body env sargs smod =
+ match smod.pmod_desc with
+ | Pmod_apply (f, sarg) ->
+ let arg, shape = type_module true funct_body None env sarg in
+ let summary = {
+ loc = smod.pmod_loc;
+ attributes = smod.pmod_attributes;
+ f_loc = f.pmod_loc;
+ arg = Some {
+ is_syntactic_unit = sarg.pmod_desc = Pmod_structure [];
+ arg;
+ path = path_of_module arg;
+ shape;
+ }
+ } in
+ extract_application funct_body env (summary::sargs) f
+ | Pmod_apply_unit f ->
+ let summary = {
+ loc = smod.pmod_loc;
+ attributes = smod.pmod_attributes;
+ f_loc = f.pmod_loc;
+ arg = None
+ } in
+ extract_application funct_body env (summary::sargs) f
+ | _ -> smod, sargs
+ in
+ let sfunct, args = extract_application funct_body env [] smod in
+ let funct, funct_shape =
+ let has_path { arg } = match arg with
+ | None | Some { path = None } -> false
+ | Some { path = Some _ } -> true
+ in
+ let strengthen = strengthen && List.for_all has_path args in
+ type_module strengthen funct_body None env sfunct
+ in
+ List.fold_left
+ (type_one_application ~ctx:(loc, sfunct, funct, args) funct_body env)
+ (funct, funct_shape) args
+
+and type_one_application ~ctx:(apply_loc,sfunct,md_f,args)
+ funct_body env (funct, funct_shape) app_view =
+ match Env.scrape_alias env funct.mod_type with
+ | Mty_functor (Unit, mty_res) ->
+ begin match app_view.arg with
+ | None -> ()
+ | Some arg ->
+ if arg.is_syntactic_unit then
+ (* this call to warning_scope allows e.g.
+ [ F (struct end [@warning "-73"]) ]
+ not to warn; useful when generating code that must
+ work over multiple versions of OCaml *)
+ Builtin_attributes.warning_scope arg.arg.mod_attributes @@ fun () ->
+ Location.prerr_warning arg.arg.mod_loc
+ Warnings.Generative_application_expects_unit
+ else
+ raise (Error (app_view.f_loc, env, Apply_generative));
+ end;
+ if funct_body && Mtype.contains_type env funct.mod_type then
+ raise (Error (apply_loc, env, Not_allowed_in_functor_body));
+ { mod_desc = Tmod_apply_unit funct;
+ mod_type = mty_res;
+ mod_env = env;
+ mod_attributes = app_view.attributes;
+ mod_loc = funct.mod_loc },
+ Shape.app funct_shape ~arg:Shape.dummy_mod
+ | Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
+ let apply_error () =
+ let args = List.map simplify_app_summary args in
+ let mty_f = md_f.mod_type in
+ let app_name = match sfunct.pmod_desc with
+ | Pmod_ident l -> Includemod.Named_leftmost_functor l.txt
+ | _ -> Includemod.Anonymous_functor
+ in
+ raise(Includemod.Apply_error {loc=apply_loc;env;app_name;mty_f;args})
+ in
+ begin match app_view with
+ | { arg = None; _ } -> apply_error ()
+ | { loc = app_loc; attributes = app_attributes;
+ arg = Some { shape = arg_shape; path = arg_path; arg } } ->
+ let coercion =
+ try Includemod.modtypes ~loc:arg.mod_loc ~mark:true env
+ arg.mod_type mty_param
+ with Includemod.Error _ -> apply_error ()
+ in
+ let mty_appl =
+ match arg_path with
+ | Some path ->
+ let scope = Ctype.create_scope () in
+ let subst =
+ match param with
+ | None -> Subst.identity
+ | Some p -> Subst.add_module p path Subst.identity
+ in
+ Subst.modtype (Rescope scope) subst mty_res
+ | None ->
+ let env, nondep_mty =
+ match param with
+ | None -> env, mty_res
+ | Some param ->
+ let env =
+ Env.add_module ~arg:true param Mp_present arg.mod_type env
+ in
+ check_well_formed_module env app_loc
+ "the signature of this functor application" mty_res;
+ try env, Mtype.nondep_supertype env [param] mty_res
+ with Ctype.Nondep_cannot_erase _ ->
+ let error = Cannot_eliminate_dependency mty_functor in
+ raise (Error(app_loc, env, error))
+ in
+ begin match
+ Includemod.modtypes ~loc:app_loc ~mark:false env
+ mty_res nondep_mty
+ with
+ | Tcoerce_none -> ()
+ | _ ->
+ fatal_error
+ "unexpected coercion from original module type to \
+ nondep_supertype one"
+ | exception Includemod.Error _ ->
+ fatal_error
+ "nondep_supertype not included in original module type"
+ end;
+ nondep_mty
+ in
+ check_well_formed_module env apply_loc
+ "the signature of this functor application" mty_appl;
+ { mod_desc = Tmod_apply(funct, arg, coercion);
+ mod_type = mty_appl;
+ mod_env = env;
+ mod_attributes = app_attributes;
+ mod_loc = app_loc },
+ Shape.app ~arg:arg_shape funct_shape
+ end
+ | Mty_alias path ->
+ raise(Error(app_view.f_loc, env, Cannot_scrape_alias path))
+ | Mty_ident _ | Mty_signature _ ->
+ let args = List.map simplify_app_summary args in
+ let mty_f = md_f.mod_type in
+ let app_name = match sfunct.pmod_desc with
+ | Pmod_ident l -> Includemod.Named_leftmost_functor l.txt
+ | _ -> Includemod.Anonymous_functor
+ in
+ raise(Includemod.Apply_error {loc=apply_loc;env;app_name;mty_f;args})
+
+and type_open_decl ?used_slot ?toplevel funct_body names env sod =
+ Builtin_attributes.warning_scope sod.popen_attributes
+ (fun () ->
+ type_open_decl_aux ?used_slot ?toplevel funct_body names env sod
+ )
+
+and type_open_decl_aux ?used_slot ?toplevel funct_body names env od =
+ let loc = od.popen_loc in
+ match od.popen_expr.pmod_desc with
+ | Pmod_ident lid ->
+ let path, newenv =
+ type_open_ ?used_slot ?toplevel od.popen_override env loc lid
+ in
+ let md = { mod_desc = Tmod_ident (path, lid);
+ mod_type = Mty_alias path;
+ mod_env = env;
+ mod_attributes = od.popen_expr.pmod_attributes;
+ mod_loc = od.popen_expr.pmod_loc }
+ in
+ let open_descr = {
+ open_expr = md;
+ open_bound_items = [];
+ open_override = od.popen_override;
+ open_env = newenv;
+ open_loc = loc;
+ open_attributes = od.popen_attributes
+ } in
+ open_descr, [], newenv
+ | _ ->
+ let md, mod_shape = type_module true funct_body None env od.popen_expr in
+ let scope = Ctype.create_scope () in
+ let sg, newenv =
+ Env.enter_signature ~scope ~mod_shape
+ (extract_sig_open env md.mod_loc md.mod_type) env
+ in
+ let info, visibility =
+ match toplevel with
+ | Some false | None -> Some `From_open, Hidden
+ | Some true -> None, Exported
+ in
+ Signature_group.iter (Signature_names.check_sig_item ?info names loc) sg;
+ let sg =
+ List.map (function
+ | Sig_value(id, vd, _) -> Sig_value(id, vd, visibility)
+ | Sig_type(id, td, rs, _) -> Sig_type(id, td, rs, visibility)
+ | Sig_typext(id, ec, et, _) -> Sig_typext(id, ec, et, visibility)
+ | Sig_module(id, mp, md, rs, _) ->
+ Sig_module(id, mp, md, rs, visibility)
+ | Sig_modtype(id, mtd, _) -> Sig_modtype(id, mtd, visibility)
+ | Sig_class(id, cd, rs, _) -> Sig_class(id, cd, rs, visibility)
+ | Sig_class_type(id, ctd, rs, _) ->
+ Sig_class_type(id, ctd, rs, visibility)
+ ) sg
+ in
+ let open_descr = {
+ open_expr = md;
+ open_bound_items = sg;
+ open_override = od.popen_override;
+ open_env = newenv;
+ open_loc = loc;
+ open_attributes = od.popen_attributes
+ } in
+ open_descr, sg, newenv
+
+and type_structure ?(toplevel = false) funct_body anchor env sstr =
+ let names = Signature_names.create () in
+
+ let type_str_item env shape_map {pstr_loc = loc; pstr_desc = desc} =
+ match desc with
+ | Pstr_eval (sexpr, attrs) ->
+ let expr =
+ Builtin_attributes.warning_scope attrs
+ (fun () -> Typecore.type_expression env sexpr)
+ in
+ Tstr_eval (expr, attrs), [], shape_map, env
+ | Pstr_value(rec_flag, sdefs) ->
+ let (defs, newenv) =
+ Typecore.type_binding env rec_flag sdefs in
+ let defs = match rec_flag with
+ | Recursive -> Typecore.annotate_recursive_bindings env defs
+ | Nonrecursive -> defs
+ in
+ (* Note: Env.find_value does not trigger the value_used event. Values
+ will be marked as being used during the signature inclusion test. *)
+ let items, shape_map =
+ List.fold_left
+ (fun (acc, shape_map) (id, { Asttypes.loc; _ }, _typ, _uid)->
+ Signature_names.check_value names loc id;
+ let vd = Env.find_value (Pident id) newenv in
+ Sig_value(id, vd, Exported) :: acc,
+ Shape.Map.add_value shape_map id vd.val_uid
+ )
+ ([], shape_map)
+ (let_bound_idents_full defs)
+ in
+ Tstr_value(rec_flag, defs),
+ List.rev items,
+ shape_map,
+ newenv
+ | Pstr_primitive sdesc ->
+ let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
+ Signature_names.check_value names desc.val_loc desc.val_id;
+ Tstr_primitive desc,
+ [Sig_value(desc.val_id, desc.val_val, Exported)],
+ Shape.Map.add_value shape_map desc.val_id desc.val_val.val_uid,
+ newenv
+ | Pstr_type (rec_flag, sdecls) ->
+ let (decls, newenv, shapes) =
+ Typedecl.transl_type_decl env rec_flag sdecls
+ in
+ List.iter
+ Signature_names.(fun td -> check_type names td.typ_loc td.typ_id)
+ decls;
+ let items = map_rec_type_with_row_types ~rec_flag
+ (fun rs info -> Sig_type(info.typ_id, info.typ_type, rs, Exported))
+ decls []
+ in
+ let shape_map = List.fold_left2
+ (fun map { typ_id; _} shape ->
+ Shape.Map.add_type map typ_id shape)
+ shape_map
+ decls
+ shapes
+ in
+ Tstr_type (rec_flag, decls),
+ items,
+ shape_map,
+ enrich_type_decls anchor decls env newenv
+ | Pstr_typext styext ->
+ let (tyext, newenv, shapes) =
+ Typedecl.transl_type_extension true env loc styext
+ in
+ let constructors = tyext.tyext_constructors in
+ let shape_map = List.fold_left2 (fun shape_map ext shape ->
+ Signature_names.check_typext names ext.ext_loc ext.ext_id;
+ Shape.Map.add_extcons shape_map ext.ext_id shape
+ ) shape_map constructors shapes
+ in
+ (Tstr_typext tyext,
+ map_ext
+ (fun es ext -> Sig_typext(ext.ext_id, ext.ext_type, es, Exported))
+ constructors [],
+ shape_map,
+ newenv)
+ | Pstr_exception sext ->
+ let (ext, newenv, shape) = Typedecl.transl_type_exception env sext in
+ let constructor = ext.tyexn_constructor in
+ Signature_names.check_typext names constructor.ext_loc
+ constructor.ext_id;
+ Tstr_exception ext,
+ [Sig_typext(constructor.ext_id,
+ constructor.ext_type,
+ Text_exception,
+ Exported)],
+ Shape.Map.add_extcons shape_map
+ constructor.ext_id
+ shape,
+ newenv
+ | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs;
+ pmb_loc;
+ } ->
+ let outer_scope = Ctype.get_current_level () in
+ let scope = Ctype.create_scope () in
+ let modl, md_shape =
+ Builtin_attributes.warning_scope attrs
+ (fun () ->
+ type_module ~alias:true true funct_body
+ (anchor_submodule name.txt anchor) env smodl
+ )
+ in
+ let pres =
+ match modl.mod_type with
+ | Mty_alias _ -> Mp_absent
+ | _ -> Mp_present
+ in
+ let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
+ let md =
+ { md_type = enrich_module_type anchor name.txt modl.mod_type env;
+ md_attributes = attrs;
+ md_loc = pmb_loc;
+ md_uid;
+ }
+ in
+ let md_shape = Shape.set_uid_if_none md_shape md_uid in
+ (*prerr_endline (Ident.unique_toplevel_name id);*)
+ Mtype.lower_nongen outer_scope md.md_type;
+ let id, newenv, sg =
+ match name.txt with
+ | None -> None, env, []
+ | Some name ->
+ let id, e = Env.enter_module_declaration
+ ~scope ~shape:md_shape name pres md env
+ in
+ Signature_names.check_module names pmb_loc id;
+ Some id, e,
+ [Sig_module(id, pres,
+ {md_type = modl.mod_type;
+ md_attributes = attrs;
+ md_loc = pmb_loc;
+ md_uid;
+ }, Trec_not, Exported)]
+ in
+ let shape_map = match id with
+ | Some id -> Shape.Map.add_module shape_map id md_shape
+ | None -> shape_map
+ in
+ Tstr_module {mb_id=id; mb_name=name; mb_uid = md.md_uid;
+ mb_expr=modl; mb_presence=pres; mb_attributes=attrs;
+ mb_loc=pmb_loc; },
+ sg,
+ shape_map,
+ newenv
+ | Pstr_recmodule sbind ->
+ let sbind =
+ List.map
+ (function
+ | {pmb_name = name;
+ pmb_expr = {pmod_desc=Pmod_constraint(expr, typ)};
+ pmb_attributes = attrs;
+ pmb_loc = loc;
+ } ->
+ name, typ, expr, attrs, loc
+ | mb ->
+ raise (Error (mb.pmb_expr.pmod_loc, env,
+ Recursive_module_require_explicit_type))
+ )
+ sbind
+ in
+ let (decls, newenv) =
+ transl_recmodule_modtypes env
+ (List.map (fun (name, smty, _smodl, attrs, loc) ->
+ {pmd_name=name; pmd_type=smty;
+ pmd_attributes=attrs; pmd_loc=loc}) sbind
+ ) in
+ List.iter
+ (fun (md, _, _) ->
+ Option.iter Signature_names.(check_module names md.md_loc) md.md_id
+ ) decls;
+ let bindings1 =
+ List.map2
+ (fun ({md_id=id; md_type=mty}, uid, _prev_shape)
+ (name, _, smodl, attrs, loc) ->
+ let modl, shape =
+ Builtin_attributes.warning_scope attrs
+ (fun () ->
+ type_module true funct_body (anchor_recmodule id)
+ newenv smodl
+ )
+ in
+ let mty' =
+ enrich_module_type anchor name.txt modl.mod_type newenv
+ in
+ Includemod.modtypes_consistency ~loc:modl.mod_loc newenv
+ mty' mty.mty_type;
+ (id, name, mty, modl, mty', attrs, loc, shape, uid))
+ decls sbind in
+ let newenv = (* allow aliasing recursive modules from outside *)
+ List.fold_left
+ (fun env (id_opt, _, mty, _, _, attrs, loc, shape, uid) ->
+ match id_opt with
+ | None -> env
+ | Some id ->
+ let mdecl =
+ {
+ md_type = mty.mty_type;
+ md_attributes = attrs;
+ md_loc = loc;
+ md_uid = uid;
+ }
+ in
+ Env.add_module_declaration ~check:true ~shape
+ id Mp_present mdecl env
+ )
+ env bindings1
+ in
+ let bindings2 =
+ check_recmodule_inclusion newenv bindings1 in
+ let mbs =
+ List.filter_map (fun (mb, shape, uid) ->
+ Option.map (fun id -> id, mb, uid, shape) mb.mb_id
+ ) bindings2
+ in
+ let shape_map =
+ List.fold_left (fun map (id, _mb, _uid, shape) ->
+ Shape.Map.add_module map id shape
+ ) shape_map mbs
+ in
+ Tstr_recmodule (List.map (fun (mb, _, _) -> mb) bindings2),
+ map_rec (fun rs (id, mb, uid, _shape) ->
+ Sig_module(id, Mp_present, {
+ md_type=mb.mb_expr.mod_type;
+ md_attributes=mb.mb_attributes;
+ md_loc=mb.mb_loc;
+ md_uid = uid;
+ }, rs, Exported))
+ mbs [],
+ shape_map,
+ newenv
+ | Pstr_modtype pmtd ->
+ (* check that it is non-abstract *)
+ let newenv, mtd, decl = transl_modtype_decl env pmtd in
+ Signature_names.check_modtype names pmtd.pmtd_loc mtd.mtd_id;
+ let id = mtd.mtd_id in
+ let map = Shape.Map.add_module_type shape_map id decl.mtd_uid in
+ Tstr_modtype mtd, [Sig_modtype (id, decl, Exported)], map, newenv
+ | Pstr_open sod ->
+ let (od, sg, newenv) =
+ type_open_decl ~toplevel funct_body names env sod
+ in
+ Tstr_open od, sg, shape_map, newenv
+ | Pstr_class cl ->
+ let (classes, new_env) = Typeclass.class_declarations env cl in
+ let shape_map = List.fold_left (fun acc cls ->
+ let open Typeclass in
+ let loc = cls.cls_id_loc.Location.loc in
+ Signature_names.check_class names loc cls.cls_id;
+ Signature_names.check_class_type names loc cls.cls_ty_id;
+ Signature_names.check_type names loc cls.cls_obj_id;
+ let uid = cls.cls_decl.cty_uid in
+ let map f id v acc = f acc id v in
+ map Shape.Map.add_class cls.cls_id uid acc
+ |> map Shape.Map.add_class_type cls.cls_ty_id uid
+ |> map Shape.Map.add_type cls.cls_obj_id (Shape.leaf uid)
+ ) shape_map classes
+ in
+ Tstr_class
+ (List.map (fun cls ->
+ (cls.Typeclass.cls_info,
+ cls.Typeclass.cls_pub_methods)) classes),
+ List.flatten
+ (map_rec
+ (fun rs cls ->
+ let open Typeclass in
+ [Sig_class(cls.cls_id, cls.cls_decl, rs, Exported);
+ Sig_class_type(cls.cls_ty_id, cls.cls_ty_decl, rs, Exported);
+ Sig_type(cls.cls_obj_id, cls.cls_obj_abbr, rs, Exported)
+ ])
+ classes []),
+ shape_map,
+ new_env
+ | Pstr_class_type cl ->
+ let (classes, new_env) = Typeclass.class_type_declarations env cl in
+ let shape_map = List.fold_left (fun acc decl ->
+ let open Typeclass in
+ let loc = decl.clsty_id_loc.Location.loc in
+ Signature_names.check_class_type names loc decl.clsty_ty_id;
+ Signature_names.check_type names loc decl.clsty_obj_id;
+ let uid = decl.clsty_ty_decl.clty_uid in
+ let map f id v acc = f acc id v in
+ map Shape.Map.add_class_type decl.clsty_ty_id uid acc
+ |> map Shape.Map.add_type decl.clsty_obj_id (Shape.leaf uid)
+ ) shape_map classes
+ in
+ Tstr_class_type
+ (List.map (fun cl ->
+ (cl.Typeclass.clsty_ty_id,
+ cl.Typeclass.clsty_id_loc,
+ cl.Typeclass.clsty_info)) classes),
+ List.flatten
+ (map_rec
+ (fun rs decl ->
+ let open Typeclass in
+ [Sig_class_type(decl.clsty_ty_id, decl.clsty_ty_decl, rs,
+ Exported);
+ Sig_type(decl.clsty_obj_id, decl.clsty_obj_abbr, rs, Exported);
+ ])
+ classes []),
+ shape_map,
+ new_env
+ | Pstr_include sincl ->
+ let smodl = sincl.pincl_mod in
+ let modl, modl_shape =
+ Builtin_attributes.warning_scope sincl.pincl_attributes
+ (fun () -> type_module true funct_body None env smodl)
+ in
+ let scope = Ctype.create_scope () in
+ (* Rename all identifiers bound by this signature to avoid clashes *)
+ let sg, shape, new_env =
+ Env.enter_signature_and_shape ~scope ~parent_shape:shape_map
+ modl_shape (extract_sig_open env smodl.pmod_loc modl.mod_type) env
+ in
+ Signature_group.iter (Signature_names.check_sig_item names loc) sg;
+ let incl =
+ { incl_mod = modl;
+ incl_type = sg;
+ incl_attributes = sincl.pincl_attributes;
+ incl_loc = sincl.pincl_loc;
+ }
+ in
+ Tstr_include incl, sg, shape, new_env
+ | Pstr_extension (ext, _attrs) ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+ | Pstr_attribute x ->
+ Builtin_attributes.warning_attribute x;
+ Tstr_attribute x, [], shape_map, env
+ in
+ let rec type_struct env shape_map sstr =
+ match sstr with
+ | [] -> ([], [], shape_map, env)
+ | pstr :: srem ->
+ let previous_saved_types = Cmt_format.get_saved_types () in
+ let desc, sg, shape_map, new_env = type_str_item env shape_map pstr in
+ let str = { str_desc = desc; str_loc = pstr.pstr_loc; str_env = env } in
+ Cmt_format.set_saved_types (Cmt_format.Partial_structure_item str
+ :: previous_saved_types);
+ let (str_rem, sig_rem, shape_map, final_env) =
+ type_struct new_env shape_map srem
+ in
+ (str :: str_rem, sg @ sig_rem, shape_map, final_env)
+ in
+ let previous_saved_types = Cmt_format.get_saved_types () in
+ let run () =
+ let (items, sg, shape_map, final_env) =
+ type_struct env Shape.Map.empty sstr
+ in
+ let str = { str_items = items; str_type = sg; str_final_env = final_env } in
+ Cmt_format.set_saved_types
+ (Cmt_format.Partial_structure str :: previous_saved_types);
+ str, sg, names, Shape.str shape_map, final_env
+ in
+ if toplevel then run ()
+ else Builtin_attributes.warning_scope [] run
+
+let type_toplevel_phrase env s =
+ Env.reset_required_globals ();
+ type_structure ~toplevel:true false None env s
+
+let type_module_alias = type_module ~alias:true true false None
+let type_module = type_module true false None
+let type_structure = type_structure false None
+
+(* Normalize types in a signature *)
+
+let rec normalize_modtype = function
+ Mty_ident _
+ | Mty_alias _ -> ()
+ | Mty_signature sg -> normalize_signature sg
+ | Mty_functor(_param, body) -> normalize_modtype body
+
+and normalize_signature sg = List.iter normalize_signature_item sg
+
+and normalize_signature_item = function
+ Sig_value(_id, desc, _) -> Ctype.normalize_type desc.val_type
+ | Sig_module(_id, _, md, _, _) -> normalize_modtype md.md_type
+ | _ -> ()
+
+(* Extract the module type of a module expression *)
+
+let type_module_type_of env smod =
+ let remove_aliases = has_remove_aliases_attribute smod.pmod_attributes in
+ let tmty =
+ match smod.pmod_desc with
+ | Pmod_ident lid -> (* turn off strengthening in this case *)
+ let path, md = Env.lookup_module ~loc:smod.pmod_loc lid.txt env in
+ { mod_desc = Tmod_ident (path, lid);
+ mod_type = md.md_type;
+ mod_env = env;
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc }
+ | _ ->
+ let me, _shape = type_module env smod in
+ me
+ in
+ let mty = Mtype.scrape_for_type_of ~remove_aliases env tmty.mod_type in
+ (* PR#5036: must not contain non-generalized type variables *)
+ check_nongen_modtype env smod.pmod_loc mty;
+ tmty, mty
+
+(* For Typecore *)
+
+(* Graft a longident onto a path *)
+let rec extend_path path =
+ fun lid ->
+ match lid with
+ | Lident name -> Pdot(path, name)
+ | Ldot(m, name) -> Pdot(extend_path path m, name)
+ | Lapply _ -> assert false
+
+(* Lookup a type's longident within a signature *)
+let lookup_type_in_sig sg =
+ let types, modules =
+ List.fold_left
+ (fun acc item ->
+ match item with
+ | Sig_type(id, _, _, _) ->
+ let types, modules = acc in
+ let types = String.Map.add (Ident.name id) id types in
+ types, modules
+ | Sig_module(id, _, _, _, _) ->
+ let types, modules = acc in
+ let modules = String.Map.add (Ident.name id) id modules in
+ types, modules
+ | _ -> acc)
+ (String.Map.empty, String.Map.empty) sg
+ in
+ let rec module_path = function
+ | Lident name -> Pident (String.Map.find name modules)
+ | Ldot(m, name) -> Pdot(module_path m, name)
+ | Lapply _ -> assert false
+ in
+ fun lid ->
+ match lid with
+ | Lident name -> Pident (String.Map.find name types)
+ | Ldot(m, name) -> Pdot(module_path m, name)
+ | Lapply _ -> assert false
+
+let type_package env m p fl =
+ (* Same as Pexp_letmodule *)
+ let modl, scope =
+ Typetexp.TyVarEnv.with_local_scope begin fun () ->
+ (* type the module and create a scope in a raised level *)
+ Ctype.with_local_level begin fun () ->
+ let modl, _mod_shape = type_module env m in
+ let scope = Ctype.create_scope () in
+ modl, scope
+ end
+ end
+ in
+ let fl', env =
+ match fl with
+ | [] -> [], env
+ | fl ->
+ let type_path, env =
+ match modl.mod_desc with
+ | Tmod_ident (mp,_)
+ | Tmod_constraint
+ ({mod_desc=Tmod_ident (mp,_)}, _, Tmodtype_implicit, _) ->
+ (* We special case these because interactions between
+ strengthening of module types and packages can cause
+ spurious escape errors. See examples from PR#6982 in the
+ testsuite. This can be removed when such issues are
+ fixed. *)
+ extend_path mp, env
+ | _ ->
+ let sg = extract_sig_open env modl.mod_loc modl.mod_type in
+ let sg, env = Env.enter_signature ~scope sg env in
+ lookup_type_in_sig sg, env
+ in
+ let fl' =
+ List.fold_right
+ (fun (lid, _t) fl ->
+ match type_path lid with
+ | exception Not_found -> fl
+ | path -> begin
+ match Env.find_type path env with
+ | exception Not_found -> fl
+ | decl ->
+ if decl.type_arity > 0 then begin
+ fl
+ end else begin
+ let t = Btype.newgenty (Tconstr (path,[],ref Mnil)) in
+ (lid, t) :: fl
+ end
+ end)
+ fl []
+ in
+ fl', env
+ in
+ let mty =
+ if fl = [] then (Mty_ident p)
+ else modtype_of_package env modl.mod_loc p fl'
+ in
+ List.iter
+ (fun (n, ty) ->
+ try Ctype.unify env ty (Ctype.newvar ())
+ with Ctype.Unify _ ->
+ raise (Error(modl.mod_loc, env, Scoping_pack (n,ty))))
+ fl';
+ let modl = wrap_constraint_package env true modl mty Tmodtype_implicit in
+ modl, fl'
+
+(* Fill in the forward declarations *)
+
+let type_open_decl ?used_slot env od =
+ type_open_decl ?used_slot ?toplevel:None false (Signature_names.create ()) env
+ od
+
+let type_open_descr ?used_slot env od =
+ type_open_descr ?used_slot ?toplevel:None env od
+
+let () =
+ Typecore.type_module := type_module_alias;
+ Typetexp.transl_modtype_longident := transl_modtype_longident;
+ Typetexp.transl_modtype := transl_modtype;
+ Typecore.type_open := type_open_ ?toplevel:None;
+ Typetexp.type_open := type_open_ ?toplevel:None;
+ Typecore.type_open_decl := type_open_decl;
+ Typecore.type_package := type_package;
+ Typeclass.type_open_descr := type_open_descr;
+ type_module_type_of_fwd := type_module_type_of
+
+
+(* Typecheck an implementation file *)
+
+let gen_annot target annots =
+ let annot = Unit_info.annot target in
+ Cmt2annot.gen_annot (Some (Unit_info.Artifact.filename annot))
+ ~sourcefile:(Unit_info.Artifact.source_file annot)
+ ~use_summaries:false
+ annots
+
+let type_implementation target initial_env ast =
+ let sourcefile = Unit_info.source_file target in
+ let save_cmt target annots initial_env cmi shape =
+ Cmt_format.save_cmt (Unit_info.cmt target)
+ annots initial_env cmi shape;
+ gen_annot target annots;
+ in
+ Cmt_format.clear ();
+ Misc.try_finally (fun () ->
+ Typecore.reset_delayed_checks ();
+ Env.reset_required_globals ();
+ if !Clflags.print_types then (* #7656 *)
+ ignore @@ Warnings.parse_options false "-32-34-37-38-60";
+ let (str, sg, names, shape, finalenv) =
+ type_structure initial_env ast in
+ let shape =
+ let id = Ident.create_persistent @@ Unit_info.modname target in
+ Shape.set_uid_if_none shape (Uid.of_compilation_unit_id id)
+ in
+ let simple_sg = Signature_names.simplify finalenv names sg in
+ if !Clflags.print_types then begin
+ Typecore.force_delayed_checks ();
+ let shape = Shape_reduce.local_reduce Env.empty shape in
+ Printtyp.wrap_printing_env ~error:false initial_env
+ Format.(fun () -> fprintf std_formatter "%a@."
+ (Printtyp.printed_signature @@ Unit_info.source_file target)
+ simple_sg
+ );
+ gen_annot target (Cmt_format.Implementation str);
+ { structure = str;
+ coercion = Tcoerce_none;
+ shape;
+ signature = simple_sg
+ } (* result is ignored by Compile.implementation *)
+ end else begin
+ let source_intf = Unit_info.mli_from_source target in
+ if !Clflags.cmi_file <> None
+ || Sys.file_exists source_intf then begin
+ let compiled_intf_file =
+ match !Clflags.cmi_file with
+ | Some cmi_file -> Unit_info.Artifact.from_filename cmi_file
+ | None ->
+ try Unit_info.find_normalized_cmi target with Not_found ->
+ raise(Error(Location.in_file sourcefile, Env.empty,
+ Interface_not_compiled source_intf))
+ in
+ let dclsig = Env.read_signature compiled_intf_file in
+ let coercion, shape =
+ Includemod.compunit initial_env ~mark:true
+ sourcefile sg source_intf
+ dclsig shape
+ in
+ Typecore.force_delayed_checks ();
+ (* It is important to run these checks after the inclusion test above,
+ so that value declarations which are not used internally but
+ exported are not reported as being unused. *)
+ let shape = Shape_reduce.local_reduce Env.empty shape in
+ let annots = Cmt_format.Implementation str in
+ save_cmt target annots initial_env None (Some shape);
+ { structure = str;
+ coercion;
+ shape;
+ signature = dclsig
+ }
+ end else begin
+ Location.prerr_warning
+ (Location.in_file (Unit_info.source_file target))
+ Warnings.Missing_mli;
+ let coercion, shape =
+ Includemod.compunit initial_env ~mark:true
+ sourcefile sg "(inferred signature)" simple_sg shape
+ in
+ check_nongen_signature finalenv simple_sg;
+ normalize_signature simple_sg;
+ Typecore.force_delayed_checks ();
+ (* See comment above. Here the target signature contains all
+ the values being exported. We can still capture unused
+ declarations like "let x = true;; let x = 1;;", because in this
+ case, the inferred signature contains only the last declaration. *)
+ let shape = Shape_reduce.local_reduce Env.empty shape in
+ let alerts = Builtin_attributes.alerts_of_str ~mark:true ast in
+ if not !Clflags.dont_write_files then begin
+ let cmi =
+ Env.save_signature ~alerts simple_sg (Unit_info.cmi target)
+ in
+ let annots = Cmt_format.Implementation str in
+ save_cmt target annots initial_env (Some cmi) (Some shape)
+ end;
+ { structure = str;
+ coercion;
+ shape;
+ signature = simple_sg
+ }
+ end
+ end
+ )
+ ~exceptionally:(fun () ->
+ let annots =
+ Cmt_format.Partial_implementation
+ (Array.of_list (Cmt_format.get_saved_types ()))
+ in
+ save_cmt target annots initial_env None None
+ )
+
+let save_signature target tsg initial_env cmi =
+ Cmt_format.save_cmt (Unit_info.cmti target)
+ (Cmt_format.Interface tsg) initial_env (Some cmi) None
+
+let type_interface env ast =
+ transl_signature env ast
+
+(* "Packaging" of several compilation units into one unit
+ having them as sub-modules. *)
+
+let package_signatures units =
+ let units_with_ids =
+ List.map
+ (fun (name, sg) ->
+ let oldid = Ident.create_persistent name in
+ let newid = Ident.create_local name in
+ (oldid, newid, sg))
+ units
+ in
+ let subst =
+ List.fold_left
+ (fun acc (oldid, newid, _) ->
+ Subst.add_module oldid (Pident newid) acc)
+ Subst.identity units_with_ids
+ in
+ List.map
+ (fun (_, newid, sg) ->
+ (* This signature won't be used for anything, it'll just be saved in a cmi
+ and cmt. *)
+ let sg = Subst.signature Make_local subst sg in
+ let md =
+ { md_type=Mty_signature sg;
+ md_attributes=[];
+ md_loc=Location.none;
+ md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
+ }
+ in
+ Sig_module(newid, Mp_present, md, Trec_not, Exported))
+ units_with_ids
+
+let package_units initial_env objfiles target_cmi =
+ (* Read the signatures of the units *)
+ let units =
+ List.map
+ (fun f ->
+ let artifact = Unit_info.Artifact.from_filename f in
+ let sg = Env.read_signature (Unit_info.companion_cmi artifact) in
+ if Unit_info.is_cmi artifact &&
+ not(Mtype.no_code_needed_sig Env.initial sg)
+ then raise(Error(Location.none, Env.empty,
+ Implementation_is_required f));
+ Unit_info.Artifact.modname artifact, sg)
+ objfiles in
+ (* Compute signature of packaged unit *)
+ Ident.reinit();
+ let sg = package_signatures units in
+ (* Compute the shape of the package *)
+ let prefix = Unit_info.Artifact.prefix target_cmi in
+ let pack_uid = Uid.of_compilation_unit_id (Ident.create_persistent prefix) in
+ let shape =
+ List.fold_left (fun map (name, _sg) ->
+ let id = Ident.create_persistent name in
+ Shape.Map.add_module map id (Shape.for_persistent_unit name)
+ ) Shape.Map.empty units
+ |> Shape.str ~uid:pack_uid
+ in
+ (* See if explicit interface is provided *)
+ let mli = Unit_info.mli_from_artifact target_cmi in
+ if Sys.file_exists mli then begin
+ if not (Sys.file_exists @@ Unit_info.Artifact.filename target_cmi) then
+ begin
+ raise(Error(Location.in_file mli, Env.empty,
+ Interface_not_compiled mli))
+ end;
+ let dclsig = Env.read_signature target_cmi in
+ let cc, _shape =
+ Includemod.compunit initial_env ~mark:true
+ "(obtained by packing)" sg mli dclsig shape
+ in
+ Cmt_format.save_cmt (Unit_info.companion_cmt target_cmi)
+ (Cmt_format.Packed (sg, objfiles)) initial_env None (Some shape);
+ cc
+ end else begin
+ (* Determine imports *)
+ let unit_names = List.map fst units in
+ let imports =
+ List.filter
+ (fun (name, _crc) -> not (List.mem name unit_names))
+ (Env.imports()) in
+ (* Write packaged signature *)
+ if not !Clflags.dont_write_files then begin
+ let cmi =
+ Env.save_signature_with_imports ~alerts:Misc.Stdlib.String.Map.empty
+ sg target_cmi imports
+ in
+ Cmt_format.save_cmt (Unit_info.companion_cmt target_cmi)
+ (Cmt_format.Packed (cmi.Cmi_format.cmi_sign, objfiles)) initial_env
+ (Some cmi) (Some shape);
+ end;
+ Tcoerce_none
+ end
+
+
+(* Error report *)
+open Printtyp.Doc
+
+let report_error ~loc _env = function
+ Cannot_apply mty ->
+ Location.errorf ~loc
+ "@[This module is not a functor; it has type@ %a@]"
+ (Style.as_inline_code modtype) mty
+ | Not_included errs ->
+ Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
+ "@[<v>Signature mismatch:@ %a@]"
+ Includemod_errorprinter.err_msgs errs
+ | Cannot_eliminate_dependency mty ->
+ Location.errorf ~loc
+ "@[This functor has type@ %a@ \
+ The parameter cannot be eliminated in the result type.@ \
+ Please bind the argument to a module identifier.@]"
+ (Style.as_inline_code modtype) mty
+ | Signature_expected ->
+ Location.errorf ~loc "This module type is not a signature"
+ | Structure_expected mty ->
+ Location.errorf ~loc
+ "@[This module is not a structure; it has type@ %a"
+ (Style.as_inline_code modtype) mty
+ | With_no_component lid ->
+ Location.errorf ~loc
+ "@[The signature constrained by %a has no component named %a@]"
+ Style.inline_code "with"
+ (Style.as_inline_code longident) lid
+ | With_mismatch(lid, explanation) ->
+ Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
+ "@[<v>\
+ @[In this %a constraint, the new definition of %a@ \
+ does not match its original definition@ \
+ in the constrained signature:@]@ \
+ %a@]"
+ Style.inline_code "with"
+ (Style.as_inline_code longident) lid
+ Includemod_errorprinter.err_msgs explanation
+ | With_makes_applicative_functor_ill_typed(lid, path, explanation) ->
+ Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
+ "@[<v>\
+ @[This %a constraint on %a makes the applicative functor @ \
+ type %a ill-typed in the constrained signature:@]@ \
+ %a@]"
+ Style.inline_code "with"
+ (Style.as_inline_code longident) lid
+ Style.inline_code (Path.name path)
+ Includemod_errorprinter.err_msgs explanation
+ | With_changes_module_alias(lid, id, path) ->
+ Location.errorf ~loc
+ "@[<v>\
+ @[This %a constraint on %a changes %a, which is aliased @ \
+ in the constrained signature (as %a)@].@]"
+ Style.inline_code "with"
+ (Style.as_inline_code longident) lid
+ Style.inline_code (Path.name path)
+ Style.inline_code (Ident.name id)
+ | With_cannot_remove_constrained_type ->
+ Location.errorf ~loc
+ "@[<v>Destructive substitutions are not supported for constrained @ \
+ types (other than when replacing a type constructor with @ \
+ a type constructor with the same arguments).@]"
+ | With_cannot_remove_packed_modtype (p,mty) ->
+ let[@manual.ref "ss:module-type-substitution"] manual_ref =
+ [ 12; 7; 3 ]
+ in
+ let pp_constraint ppf (p,mty) =
+ fprintf ppf "%s := %a" (Path.name p) modtype mty
+ in
+ Location.errorf ~loc
+ "This %a constraint@ %a@ makes a packed module ill-formed.@ %a"
+ Style.inline_code "with"
+ (Style.as_inline_code pp_constraint) (p,mty)
+ Misc.print_see_manual manual_ref
+ | With_package_manifest (lid, ty) ->
+ Location.errorf ~loc
+ "In the constrained signature, type %a is defined to be %a.@ \
+ Package %a constraints may only be used on abstract types."
+ (Style.as_inline_code longident) lid
+ (Style.as_inline_code type_expr) ty
+ Style.inline_code "with"
+ | Repeated_name(kind, name) ->
+ Location.errorf ~loc
+ "@[Multiple definition of the %s name %a.@ \
+ Names must be unique in a given structure or signature.@]"
+ (Sig_component_kind.to_string kind) Style.inline_code name
+ | Non_generalizable { vars; expression } ->
+ let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2 ] in
+ Out_type.prepare_for_printing vars;
+ Out_type.add_type_to_preparation expression;
+ Location.errorf ~loc
+ "@[The type of this expression,@ %a,@ \
+ contains the non-generalizable type variable(s): %a.@ %a@]"
+ (Style.as_inline_code Out_type.prepared_type_scheme) expression
+ (pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
+ (Style.as_inline_code Out_type.prepared_type_scheme)) vars
+ Misc.print_see_manual manual_ref
+ | Non_generalizable_module { vars; mty; item } ->
+ let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2 ] in
+ Out_type.prepare_for_printing vars;
+ Out_type.add_type_to_preparation item.val_type;
+ let sub =
+ [ Location.msg ~loc:item.val_loc
+ "The type of this value,@ %a,@ \
+ contains the non-generalizable type variable(s) %a."
+ (Style.as_inline_code Out_type.prepared_type_scheme)
+ item.val_type
+ (pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
+ @@ Style.as_inline_code Out_type.prepared_type_scheme) vars
+ ]
+ in
+ Location.errorf ~loc ~sub
+ "@[The type of this module,@ %a,@ \
+ contains non-generalizable type variable(s).@ %a@]"
+ modtype mty
+ Misc.print_see_manual manual_ref
+ | Implementation_is_required intf_name ->
+ Location.errorf ~loc
+ "@[The interface %a@ declares values, not just types.@ \
+ An implementation must be provided.@]"
+ Location.Doc.quoted_filename intf_name
+ | Interface_not_compiled intf_name ->
+ Location.errorf ~loc
+ "@[Could not find the .cmi file for interface@ %a.@]"
+ Location.Doc.quoted_filename intf_name
+ | Not_allowed_in_functor_body ->
+ Location.errorf ~loc
+ "@[This expression creates fresh types.@ %s@]"
+ "It is not allowed inside applicative functors."
+ | Not_a_packed_module ty ->
+ Location.errorf ~loc
+ "This expression is not a packed module. It has type@ %a"
+ (Style.as_inline_code type_expr) ty
+ | Incomplete_packed_module ty ->
+ Location.errorf ~loc
+ "The type of this packed module contains variables:@ %a"
+ (Style.as_inline_code type_expr) ty
+ | Scoping_pack (lid, ty) ->
+ Location.errorf ~loc
+ "The type %a in this module cannot be exported.@ \
+ Its type contains local dependencies:@ %a"
+ (Style.as_inline_code longident) lid
+ (Style.as_inline_code type_expr) ty
+ | Recursive_module_require_explicit_type ->
+ Location.errorf ~loc "Recursive modules require an explicit module type."
+ | Apply_generative ->
+ Location.errorf ~loc
+ "This is a generative functor. It can only be applied to %a"
+ Style.inline_code "()"
+ | Cannot_scrape_alias p ->
+ Location.errorf ~loc
+ "This is an alias for module %a, which is missing"
+ (Style.as_inline_code path) p
+ | Cannot_alias p ->
+ Location.errorf ~loc
+ "Functor arguments, such as %a, cannot be aliased"
+ (Style.as_inline_code path) p
+ | Cannot_scrape_package_type p ->
+ Location.errorf ~loc
+ "The type of this packed module refers to %a, which is missing"
+ (Style.as_inline_code path) p
+ | Badly_formed_signature (context, err) ->
+ Location.errorf ~loc "@[In %s:@ %a@]"
+ context
+ Typedecl.report_error_doc err
+ | Cannot_hide_id Illegal_shadowing
+ { shadowed_item_kind; shadowed_item_id; shadowed_item_loc;
+ shadower_id; user_id; user_kind; user_loc } ->
+ let shadowed =
+ Printtyp.namespaced_ident shadowed_item_kind shadowed_item_id
+ in
+ let shadower =
+ Printtyp.namespaced_ident shadowed_item_kind shadower_id
+ in
+ let shadowed_item_kind= Sig_component_kind.to_string shadowed_item_kind in
+ let shadowed_msg =
+ Location.msg ~loc:shadowed_item_loc
+ "@[%s %a came from this include.@]"
+ (String.capitalize_ascii shadowed_item_kind)
+ Style.inline_code shadowed
+ in
+ let user_msg =
+ Location.msg ~loc:user_loc
+ "@[The %s %a has no valid type@ if %a is shadowed.@]"
+ (Sig_component_kind.to_string user_kind)
+ Style.inline_code (Ident.name user_id)
+ Style.inline_code shadowed
+ in
+ Location.errorf ~loc ~sub:[shadowed_msg; user_msg]
+ "Illegal shadowing of included %s %a@ by %a."
+ shadowed_item_kind
+ Style.inline_code shadowed
+ Style.inline_code shadower
+ | Cannot_hide_id Appears_in_signature
+ { opened_item_kind; opened_item_id; user_id; user_kind; user_loc } ->
+ let opened_item_kind= Sig_component_kind.to_string opened_item_kind in
+ let opened_id = Ident.name opened_item_id in
+ let user_msg =
+ Location.msg ~loc:user_loc
+ "@[The %s %a has no valid type@ if %a is hidden.@]"
+ (Sig_component_kind.to_string user_kind)
+ Style.inline_code (Ident.name user_id)
+ Style.inline_code opened_id
+ in
+ Location.errorf ~loc ~sub:[user_msg]
+ "The %s %a introduced by this open appears in the signature."
+ opened_item_kind
+ Style.inline_code opened_id
+ | Invalid_type_subst_rhs ->
+ Location.errorf ~loc "Only type synonyms are allowed on the right of %a"
+ Style.inline_code ":="
+ | Non_packable_local_modtype_subst p ->
+ let[@manual.ref "ss:module-type-substitution"] manual_ref =
+ [ 12; 7; 3 ]
+ in
+ Location.errorf ~loc
+ "The module type@ %a@ is not a valid type for a packed module:@ \
+ it is defined as a local substitution (temporary name)@ \
+ for an anonymous module type.@ %a"
+ Style.inline_code (Path.name p)
+ Misc.print_see_manual manual_ref
+
+let report_error env ~loc err =
+ Printtyp.wrap_printing_env ~error:true env
+ (fun () -> report_error env ~loc err)
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc, env, err) ->
+ Some (report_error ~loc env err)
+ | Error_forward err ->
+ Some err
+ | _ ->
+ None
+ )
diff --git a/upstream/ocaml_503/typing/typemod.mli b/upstream/ocaml_503/typing/typemod.mli
new file mode 100644
index 0000000000..8833a8e9d7
--- /dev/null
+++ b/upstream/ocaml_503/typing/typemod.mli
@@ -0,0 +1,143 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Type-checking of the module language and typed ast hooks
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Types
+
+module Signature_names : sig
+ type t
+
+ val simplify: Env.t -> t -> signature -> signature
+end
+
+val type_module:
+ Env.t -> Parsetree.module_expr -> Typedtree.module_expr * Shape.t
+val type_structure:
+ Env.t -> Parsetree.structure ->
+ Typedtree.structure * Types.signature * Signature_names.t * Shape.t *
+ Env.t
+val type_toplevel_phrase:
+ Env.t -> Parsetree.structure ->
+ Typedtree.structure * Types.signature * Signature_names.t * Shape.t *
+ Env.t
+val type_implementation:
+ Unit_info.t -> Env.t -> Parsetree.structure ->
+ Typedtree.implementation
+val type_interface:
+ Env.t -> Parsetree.signature -> Typedtree.signature
+val check_nongen_signature:
+ Env.t -> Types.signature -> unit
+ (*
+val type_open_:
+ ?used_slot:bool ref -> ?toplevel:bool ->
+ Asttypes.override_flag ->
+ Env.t -> Location.t -> Longident.t Asttypes.loc -> Path.t * Env.t
+ *)
+val modtype_of_package:
+ Env.t -> Location.t ->
+ Path.t -> (Longident.t * type_expr) list -> module_type
+
+val path_of_module : Typedtree.module_expr -> Path.t option
+
+val save_signature:
+ Unit_info.t -> Typedtree.signature -> Env.t ->
+ Cmi_format.cmi_infos -> unit
+
+val package_units:
+ Env.t -> string list -> Unit_info.Artifact.t -> Typedtree.module_coercion
+
+(* Should be in Envaux, but it breaks the build of the debugger *)
+val initial_env:
+ loc:Location.t ->
+ initially_opened_module:string option ->
+ open_implicit_modules:string list -> Env.t
+
+module Sig_component_kind : sig
+ type t =
+ | Value
+ | Type
+ | Constructor
+ | Label
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+ val to_string : t -> string
+end
+
+type hiding_error =
+ | Illegal_shadowing of {
+ shadowed_item_id: Ident.t;
+ shadowed_item_kind: Sig_component_kind.t;
+ shadowed_item_loc: Location.t;
+ shadower_id: Ident.t;
+ user_id: Ident.t;
+ user_kind: Sig_component_kind.t;
+ user_loc: Location.t;
+ }
+ | Appears_in_signature of {
+ opened_item_id: Ident.t;
+ opened_item_kind: Sig_component_kind.t;
+ user_id: Ident.t;
+ user_kind: Sig_component_kind.t;
+ user_loc: Location.t;
+ }
+
+type error =
+ Cannot_apply of module_type
+ | Not_included of Includemod.explanation
+ | Cannot_eliminate_dependency of module_type
+ | Signature_expected
+ | Structure_expected of module_type
+ | With_no_component of Longident.t
+ | With_mismatch of Longident.t * Includemod.explanation
+ | With_makes_applicative_functor_ill_typed of
+ Longident.t * Path.t * Includemod.explanation
+ | With_changes_module_alias of Longident.t * Ident.t * Path.t
+ | With_cannot_remove_constrained_type
+ | With_package_manifest of Longident.t * type_expr
+ | Repeated_name of Sig_component_kind.t * string
+ | Non_generalizable of { vars : type_expr list; expression : type_expr }
+ | Non_generalizable_module of
+ { vars : type_expr list; item : value_description; mty : module_type }
+ | Implementation_is_required of string
+ | Interface_not_compiled of string
+ | Not_allowed_in_functor_body
+ | Not_a_packed_module of type_expr
+ | Incomplete_packed_module of type_expr
+ | Scoping_pack of Longident.t * type_expr
+ | Recursive_module_require_explicit_type
+ | Apply_generative
+ | Cannot_scrape_alias of Path.t
+ | Cannot_scrape_package_type of Path.t
+ | Badly_formed_signature of string * Typedecl.error
+ | Cannot_hide_id of hiding_error
+ | Invalid_type_subst_rhs
+ | Non_packable_local_modtype_subst of Path.t
+ | With_cannot_remove_packed_modtype of Path.t * module_type
+ | Cannot_alias of Path.t
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+val report_error: Env.t -> loc:Location.t -> error -> Location.error
diff --git a/upstream/ocaml_503/typing/typeopt.ml b/upstream/ocaml_503/typing/typeopt.ml
new file mode 100644
index 0000000000..2b8fd3e95d
--- /dev/null
+++ b/upstream/ocaml_503/typing/typeopt.ml
@@ -0,0 +1,227 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, 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. *)
+(* *)
+(**************************************************************************)
+
+(* Auxiliaries for type-based optimizations, e.g. array kinds *)
+
+open Path
+open Types
+open Asttypes
+open Typedtree
+open Lambda
+
+let scrape_ty env ty =
+ match get_desc ty with
+ | Tconstr _ ->
+ let ty = Ctype.expand_head_opt env ty in
+ begin match get_desc ty with
+ | Tconstr (p, _, _) ->
+ begin match Env.find_type p env with
+ | {type_kind = ( Type_variant (_, Variant_unboxed)
+ | Type_record (_, Record_unboxed _) ); _} -> begin
+ match Typedecl_unboxed.get_unboxed_type_representation env ty with
+ | None -> ty
+ | Some ty2 -> ty2
+ end
+ | _ -> ty
+ | exception Not_found -> ty
+ end
+ | _ ->
+ ty
+ end
+ | _ -> ty
+
+let scrape env ty =
+ get_desc (scrape_ty env ty)
+
+let scrape_poly env ty =
+ let ty = scrape_ty env ty in
+ match get_desc ty with
+ | Tpoly (ty, _) -> get_desc ty
+ | d -> d
+
+let is_function_type env ty =
+ match scrape env ty with
+ | Tarrow (_, lhs, rhs, _) -> Some (lhs, rhs)
+ | _ -> None
+
+let is_base_type env ty base_ty_path =
+ match scrape env ty with
+ | Tconstr(p, _, _) -> Path.same p base_ty_path
+ | _ -> false
+
+let is_immediate = function
+ | Type_immediacy.Unknown -> false
+ | Type_immediacy.Always -> true
+ | Type_immediacy.Always_on_64bits ->
+ (* In bytecode, we don't know at compile time whether we are
+ targeting 32 or 64 bits. *)
+ !Clflags.native_code && Sys.word_size = 64
+
+let maybe_pointer_type env ty =
+ let ty = scrape_ty env ty in
+ if is_immediate (Ctype.immediacy env ty) then Immediate
+ else Pointer
+
+let maybe_pointer exp = maybe_pointer_type exp.exp_env exp.exp_type
+
+type classification =
+ | Int
+ | Float
+ | Lazy
+ | Addr (* anything except a float or a lazy *)
+ | Any
+
+let classify env ty =
+ let ty = scrape_ty env ty in
+ if maybe_pointer_type env ty = Immediate then Int
+ else match get_desc ty with
+ | Tvar _ | Tunivar _ ->
+ Any
+ | Tconstr (p, _args, _abbrev) ->
+ if Path.same p Predef.path_float then Float
+ else if Path.same p Predef.path_lazy_t then Lazy
+ else if Path.same p Predef.path_string
+ || Path.same p Predef.path_bytes
+ || Path.same p Predef.path_array
+ || Path.same p Predef.path_nativeint
+ || Path.same p Predef.path_int32
+ || Path.same p Predef.path_int64 then Addr
+ else begin
+ try
+ match (Env.find_type p env).type_kind with
+ | Type_abstract _ ->
+ Any
+ | Type_record _ | Type_variant _ | Type_open ->
+ Addr
+ with Not_found ->
+ (* This can happen due to e.g. missing -I options,
+ causing some .cmi files to be unavailable.
+ Maybe we should emit a warning. *)
+ Any
+ end
+ | Tarrow _ | Ttuple _ | Tpackage _ | Tobject _ | Tnil | Tvariant _ ->
+ Addr
+ | Tlink _ | Tsubst _ | Tpoly _ | Tfield _ ->
+ assert false
+
+let array_type_kind env ty =
+ match scrape_poly env ty with
+ | Tconstr(p, [elt_ty], _) when Path.same p Predef.path_array ->
+ begin match classify env elt_ty with
+ | Any -> if Config.flat_float_array then Pgenarray else Paddrarray
+ | Float -> if Config.flat_float_array then Pfloatarray else Paddrarray
+ | Addr | Lazy -> Paddrarray
+ | Int -> Pintarray
+ end
+ | Tconstr(p, [], _) when Path.same p Predef.path_floatarray ->
+ Pfloatarray
+ | _ ->
+ (* This can happen with e.g. Obj.field *)
+ Pgenarray
+
+let array_kind exp = array_type_kind exp.exp_env exp.exp_type
+
+let array_pattern_kind pat = array_type_kind pat.pat_env pat.pat_type
+
+let bigarray_decode_type env ty tbl dfl =
+ match scrape env ty with
+ | Tconstr(Pdot(Pident mod_id, type_name), [], _)
+ when Ident.name mod_id = "Stdlib__Bigarray" ->
+ begin try List.assoc type_name tbl with Not_found -> dfl end
+ | _ ->
+ dfl
+
+let kind_table =
+ ["float16_elt", Pbigarray_float16;
+ "float32_elt", Pbigarray_float32;
+ "float64_elt", Pbigarray_float64;
+ "int8_signed_elt", Pbigarray_sint8;
+ "int8_unsigned_elt", Pbigarray_uint8;
+ "int16_signed_elt", Pbigarray_sint16;
+ "int16_unsigned_elt", Pbigarray_uint16;
+ "int32_elt", Pbigarray_int32;
+ "int64_elt", Pbigarray_int64;
+ "int_elt", Pbigarray_caml_int;
+ "nativeint_elt", Pbigarray_native_int;
+ "complex32_elt", Pbigarray_complex32;
+ "complex64_elt", Pbigarray_complex64]
+
+let layout_table =
+ ["c_layout", Pbigarray_c_layout;
+ "fortran_layout", Pbigarray_fortran_layout]
+
+let bigarray_type_kind_and_layout env typ =
+ match scrape env typ with
+ | Tconstr(_p, [_caml_type; elt_type; layout_type], _abbrev) ->
+ (bigarray_decode_type env elt_type kind_table Pbigarray_unknown,
+ bigarray_decode_type env layout_type layout_table
+ Pbigarray_unknown_layout)
+ | _ ->
+ (Pbigarray_unknown, Pbigarray_unknown_layout)
+
+let value_kind env ty =
+ let ty = scrape_ty env ty in
+ if is_immediate (Ctype.immediacy env ty) then Pintval
+ else begin
+ match get_desc ty with
+ | Tconstr(p, _, _) when Path.same p Predef.path_float ->
+ Pfloatval
+ | Tconstr(p, _, _) when Path.same p Predef.path_int32 ->
+ Pboxedintval Pint32
+ | Tconstr(p, _, _) when Path.same p Predef.path_int64 ->
+ Pboxedintval Pint64
+ | Tconstr(p, _, _) when Path.same p Predef.path_nativeint ->
+ Pboxedintval Pnativeint
+ | _ ->
+ Pgenval
+ end
+
+(** Whether a forward block is needed for a lazy thunk on a value, i.e.
+ if the value can be represented as a float/forward/lazy *)
+let lazy_val_requires_forward env ty =
+ match classify env ty with
+ | Any | Lazy -> true
+ | Float -> Config.flat_float_array
+ | Addr | Int -> false
+
+(** The compilation of the expression [lazy e] depends on the form of e:
+ constants, floats and identifiers are optimized. The optimization must be
+ taken into account when determining whether a recursive binding is safe. *)
+let classify_lazy_argument : Typedtree.expression ->
+ [`Constant_or_function
+ |`Float_that_cannot_be_shortcut
+ |`Identifier of [`Forward_value|`Other]
+ |`Other] =
+ fun e -> match e.exp_desc with
+ | Texp_constant
+ ( Const_int _ | Const_char _ | Const_string _
+ | Const_int32 _ | Const_int64 _ | Const_nativeint _ )
+ | Texp_function _
+ | Texp_construct (_, {cstr_arity = 0}, _) ->
+ `Constant_or_function
+ | Texp_constant(Const_float _) ->
+ if Config.flat_float_array
+ then `Float_that_cannot_be_shortcut
+ else `Constant_or_function
+ | Texp_ident _ when lazy_val_requires_forward e.exp_env e.exp_type ->
+ `Identifier `Forward_value
+ | Texp_ident _ ->
+ `Identifier `Other
+ | _ ->
+ `Other
+
+let value_kind_union k1 k2 =
+ if k1 = k2 then k1
+ else Pgenval
diff --git a/upstream/ocaml_503/typing/typeopt.mli b/upstream/ocaml_503/typing/typeopt.mli
new file mode 100644
index 0000000000..d1fcf41e7b
--- /dev/null
+++ b/upstream/ocaml_503/typing/typeopt.mli
@@ -0,0 +1,42 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, 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. *)
+(* *)
+(**************************************************************************)
+
+(* Auxiliaries for type-based optimizations, e.g. array kinds *)
+
+val is_function_type :
+ Env.t -> Types.type_expr -> (Types.type_expr * Types.type_expr) option
+val is_base_type : Env.t -> Types.type_expr -> Path.t -> bool
+
+val maybe_pointer_type : Env.t -> Types.type_expr
+ -> Lambda.immediate_or_pointer
+val maybe_pointer : Typedtree.expression -> Lambda.immediate_or_pointer
+
+val array_type_kind : Env.t -> Types.type_expr -> Lambda.array_kind
+val array_kind : Typedtree.expression -> Lambda.array_kind
+val array_pattern_kind : Typedtree.pattern -> Lambda.array_kind
+val bigarray_type_kind_and_layout :
+ Env.t -> Types.type_expr -> Lambda.bigarray_kind * Lambda.bigarray_layout
+val value_kind : Env.t -> Types.type_expr -> Lambda.value_kind
+
+val classify_lazy_argument : Typedtree.expression ->
+ [ `Constant_or_function
+ | `Float_that_cannot_be_shortcut
+ | `Identifier of [`Forward_value | `Other]
+ | `Other]
+
+val value_kind_union :
+ Lambda.value_kind -> Lambda.value_kind -> Lambda.value_kind
+ (** [value_kind_union k1 k2] is a value_kind at least as general as
+ [k1] and [k2] *)
diff --git a/upstream/ocaml_503/typing/types.ml b/upstream/ocaml_503/typing/types.ml
new file mode 100644
index 0000000000..c66c98eaa8
--- /dev/null
+++ b/upstream/ocaml_503/typing/types.ml
@@ -0,0 +1,961 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Representation of types and declarations *)
+
+open Asttypes
+
+(* Type expressions for the core language *)
+
+type transient_expr =
+ { mutable desc: type_desc;
+ mutable level: int;
+ mutable scope: scope_field;
+ id: int }
+
+and scope_field = int
+ (* bit field: 27 bits for scope (Ident.highest_scope = 100_000_000)
+ and at least 4 marks *)
+
+and type_expr = transient_expr
+
+and type_desc =
+ Tvar of string option
+ | Tarrow of arg_label * type_expr * type_expr * commutable
+ | Ttuple of type_expr list
+ | Tconstr of Path.t * type_expr list * abbrev_memo ref
+ | Tobject of type_expr * (Path.t * type_expr list) option ref
+ | Tfield of string * field_kind * type_expr * type_expr
+ | Tnil
+ | Tlink of type_expr
+ | Tsubst of type_expr * type_expr option
+ | Tvariant of row_desc
+ | Tunivar of string option
+ | Tpoly of type_expr * type_expr list
+ | Tpackage of Path.t * (Longident.t * type_expr) list
+
+and row_desc =
+ { row_fields: (label * row_field) list;
+ row_more: type_expr;
+ row_closed: bool;
+ row_fixed: fixed_explanation option;
+ row_name: (Path.t * type_expr list) option }
+and fixed_explanation =
+ | Univar of type_expr | Fixed_private | Reified of Path.t | Rigid
+and row_field = [`some] row_field_gen
+and row_field_cell = [`some | `none] row_field_gen ref
+and _ row_field_gen =
+ RFpresent : type_expr option -> [> `some] row_field_gen
+ | RFeither :
+ { no_arg: bool;
+ arg_type: type_expr list;
+ matched: bool;
+ ext: row_field_cell} -> [> `some] row_field_gen
+ | RFabsent : [> `some] row_field_gen
+ | RFnone : [> `none] row_field_gen
+
+and abbrev_memo =
+ Mnil
+ | Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
+ | Mlink of abbrev_memo ref
+
+and any = [`some | `none | `var]
+and field_kind = [`some|`var] field_kind_gen
+and _ field_kind_gen =
+ FKvar : {mutable field_kind: any field_kind_gen} -> [> `var] field_kind_gen
+ | FKprivate : [> `none] field_kind_gen (* private method; only under FKvar *)
+ | FKpublic : [> `some] field_kind_gen (* public method *)
+ | FKabsent : [> `some] field_kind_gen (* hidden private method *)
+
+and commutable = [`some|`var] commutable_gen
+and _ commutable_gen =
+ Cok : [> `some] commutable_gen
+ | Cunknown : [> `none] commutable_gen
+ | Cvar : {mutable commu: any commutable_gen} -> [> `var] commutable_gen
+
+module TransientTypeOps = struct
+ type t = type_expr
+ let compare t1 t2 = t1.id - t2.id
+ let hash t = t.id
+ let equal t1 t2 = t1 == t2
+end
+
+module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
+
+(* *)
+
+module Uid = Shape.Uid
+
+(* Maps of methods and instance variables *)
+
+module MethSet = Misc.Stdlib.String.Set
+module VarSet = Misc.Stdlib.String.Set
+
+module Meths = Misc.Stdlib.String.Map
+module Vars = Misc.Stdlib.String.Map
+
+
+(* Value descriptions *)
+
+type value_description =
+ { val_type: type_expr; (* Type of the value *)
+ val_kind: value_kind;
+ val_loc: Location.t;
+ val_attributes: Parsetree.attributes;
+ val_uid: Uid.t;
+ }
+
+and value_kind =
+ Val_reg (* Regular value *)
+ | Val_prim of Primitive.description (* Primitive *)
+ | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
+ | Val_self of
+ class_signature * self_meths * Ident.t Vars.t * string
+ (* Self *)
+ | Val_anc of class_signature * Ident.t Meths.t * string
+ (* Ancestor *)
+
+and self_meths =
+ | Self_concrete of Ident.t Meths.t
+ | Self_virtual of Ident.t Meths.t ref
+
+and class_signature =
+ { csig_self: type_expr;
+ mutable csig_self_row: type_expr;
+ mutable csig_vars: (mutable_flag * virtual_flag * type_expr) Vars.t;
+ mutable csig_meths: (method_privacy * virtual_flag * type_expr) Meths.t; }
+
+and method_privacy =
+ | Mpublic
+ | Mprivate of field_kind
+
+(* Variance *)
+(* Variance forms a product lattice of the following partial orders:
+ 0 <= may_pos <= pos
+ 0 <= may_weak <= may_neg <= neg
+ 0 <= inj
+ Additionally, the following implications are valid
+ pos => inj
+ neg => inj
+ Examples:
+ type 'a t : may_pos + may_neg + may_weak
+ type 'a t = 'a : pos
+ type 'a t = 'a -> unit : neg
+ type 'a t = ('a -> unit) -> unit : pos + may_weak
+ type 'a t = A of (('a -> unit) -> unit) : pos
+ type +'a p = .. : may_pos + inj
+ type +!'a t : may_pos + inj
+ type -!'a t : may_neg + inj
+ type 'a t = A : inj
+ *)
+
+module Variance = struct
+ type t = int
+ type f = May_pos | May_neg | May_weak | Inj | Pos | Neg | Inv
+ let single = function
+ | May_pos -> 1
+ | May_neg -> 2 + 4
+ | May_weak -> 4
+ | Inj -> 8
+ | Pos -> 16 + 8 + 1
+ | Neg -> 32 + 8 + 4 + 2
+ | Inv -> 63
+ let union v1 v2 = v1 lor v2
+ let inter v1 v2 = v1 land v2
+ let subset v1 v2 = (v1 land v2 = v1)
+ let eq (v1 : t) v2 = (v1 = v2)
+ let set x v = union v (single x)
+ let set_if b x v = if b then set x v else v
+ let mem x = subset (single x)
+ let null = 0
+ let unknown = 7
+ let full = single Inv
+ let covariant = single Pos
+ let contravariant = single Neg
+ let swap f1 f2 v v' =
+ set_if (mem f2 v) f1 (set_if (mem f1 v) f2 v')
+ let conjugate v =
+ let v' = inter v (union (single Inj) (single May_weak)) in
+ swap Pos Neg v (swap May_pos May_neg v v')
+ let compose v1 v2 =
+ if mem Inv v1 && mem Inj v2 then full else
+ let mp =
+ mem May_pos v1 && mem May_pos v2 || mem May_neg v1 && mem May_neg v2
+ and mn =
+ mem May_pos v1 && mem May_neg v2 || mem May_neg v1 && mem May_pos v2
+ and mw = mem May_weak v1 && v2 <> null || v1 <> null && mem May_weak v2
+ and inj = mem Inj v1 && mem Inj v2
+ and pos = mem Pos v1 && mem Pos v2 || mem Neg v1 && mem Neg v2
+ and neg = mem Pos v1 && mem Neg v2 || mem Neg v1 && mem Pos v2 in
+ List.fold_left (fun v (b,f) -> set_if b f v) null
+ [mp, May_pos; mn, May_neg; mw, May_weak; inj, Inj; pos, Pos; neg, Neg]
+ let strengthen v =
+ if mem May_neg v then v else v land (full - single May_weak)
+ let get_upper v = (mem May_pos v, mem May_neg v)
+ let get_lower v = (mem Pos v, mem Neg v, mem Inj v)
+ let unknown_signature ~injective ~arity =
+ let v = if injective then set Inj unknown else unknown in
+ Misc.replicate_list v arity
+end
+
+module Separability = struct
+ type t = Ind | Sep | Deepsep
+ type signature = t list
+ let eq (m1 : t) m2 = (m1 = m2)
+ let rank = function
+ | Ind -> 0
+ | Sep -> 1
+ | Deepsep -> 2
+ let compare m1 m2 = compare (rank m1) (rank m2)
+ let max m1 m2 = if rank m1 >= rank m2 then m1 else m2
+
+ let print ppf = function
+ | Ind -> Format.fprintf ppf "Ind"
+ | Sep -> Format.fprintf ppf "Sep"
+ | Deepsep -> Format.fprintf ppf "Deepsep"
+
+ let print_signature ppf modes =
+ let pp_sep ppf () = Format.fprintf ppf ",@," in
+ Format.fprintf ppf "@[(%a)@]"
+ (Format.pp_print_list ~pp_sep print) modes
+
+ let default_signature ~arity =
+ let default_mode = if Config.flat_float_array then Deepsep else Ind in
+ Misc.replicate_list default_mode arity
+end
+
+(* Type definitions *)
+
+type type_declaration =
+ { type_params: type_expr list;
+ type_arity: int;
+ type_kind: type_decl_kind;
+ type_private: private_flag;
+ type_manifest: type_expr option;
+ type_variance: Variance.t list;
+ type_separability: Separability.t list;
+ type_is_newtype: bool;
+ type_expansion_scope: int;
+ type_loc: Location.t;
+ type_attributes: Parsetree.attributes;
+ type_immediate: Type_immediacy.t;
+ type_unboxed_default: bool;
+ type_uid: Uid.t;
+ }
+
+and type_decl_kind = (label_declaration, constructor_declaration) type_kind
+
+and ('lbl, 'cstr) type_kind =
+ Type_abstract of type_origin
+ | Type_record of 'lbl list * record_representation
+ | Type_variant of 'cstr list * variant_representation
+ | Type_open
+
+and type_origin =
+ Definition
+ | Rec_check_regularity
+ | Existential of string
+
+and record_representation =
+ Record_regular (* All fields are boxed / tagged *)
+ | Record_float (* All fields are floats *)
+ | Record_unboxed of bool (* Unboxed single-field record, inlined or not *)
+ | Record_inlined of int (* Inlined record *)
+ | Record_extension of Path.t (* Inlined record under extension *)
+
+and variant_representation =
+ Variant_regular (* Constant or boxed constructors *)
+ | Variant_unboxed (* One unboxed single-field constructor *)
+
+and label_declaration =
+ {
+ ld_id: Ident.t;
+ ld_mutable: mutable_flag;
+ ld_type: type_expr;
+ ld_loc: Location.t;
+ ld_attributes: Parsetree.attributes;
+ ld_uid: Uid.t;
+ }
+
+and constructor_declaration =
+ {
+ cd_id: Ident.t;
+ cd_args: constructor_arguments;
+ cd_res: type_expr option;
+ cd_loc: Location.t;
+ cd_attributes: Parsetree.attributes;
+ cd_uid: Uid.t;
+ }
+
+and constructor_arguments =
+ | Cstr_tuple of type_expr list
+ | Cstr_record of label_declaration list
+
+type extension_constructor =
+ { ext_type_path: Path.t;
+ ext_type_params: type_expr list;
+ ext_args: constructor_arguments;
+ ext_ret_type: type_expr option;
+ ext_private: private_flag;
+ ext_loc: Location.t;
+ ext_attributes: Parsetree.attributes;
+ ext_uid: Uid.t;
+ }
+
+and type_transparence =
+ Type_public (* unrestricted expansion *)
+ | Type_new (* "new" type *)
+ | Type_private (* private type *)
+
+(* Type expressions for the class language *)
+
+type class_type =
+ Cty_constr of Path.t * type_expr list * class_type
+ | Cty_signature of class_signature
+ | Cty_arrow of arg_label * type_expr * class_type
+
+type class_declaration =
+ { cty_params: type_expr list;
+ mutable cty_type: class_type;
+ cty_path: Path.t;
+ cty_new: type_expr option;
+ cty_variance: Variance.t list;
+ cty_loc: Location.t;
+ cty_attributes: Parsetree.attributes;
+ cty_uid: Uid.t;
+ }
+
+type class_type_declaration =
+ { clty_params: type_expr list;
+ clty_type: class_type;
+ clty_path: Path.t;
+ clty_hash_type: type_declaration;
+ clty_variance: Variance.t list;
+ clty_loc: Location.t;
+ clty_attributes: Parsetree.attributes;
+ clty_uid: Uid.t;
+ }
+
+(* Type expressions for the module language *)
+
+type visibility =
+ | Exported
+ | Hidden
+
+type module_type =
+ Mty_ident of Path.t
+ | Mty_signature of signature
+ | Mty_functor of functor_parameter * module_type
+ | Mty_alias of Path.t
+
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * module_type
+
+and module_presence =
+ | Mp_present
+ | Mp_absent
+
+and signature = signature_item list
+
+and signature_item =
+ Sig_value of Ident.t * value_description * visibility
+ | Sig_type of Ident.t * type_declaration * rec_status * visibility
+ | Sig_typext of Ident.t * extension_constructor * ext_status * visibility
+ | Sig_module of
+ Ident.t * module_presence * module_declaration * rec_status * visibility
+ | Sig_modtype of Ident.t * modtype_declaration * visibility
+ | Sig_class of Ident.t * class_declaration * rec_status * visibility
+ | Sig_class_type of Ident.t * class_type_declaration * rec_status * visibility
+
+and module_declaration =
+ {
+ md_type: module_type;
+ md_attributes: Parsetree.attributes;
+ md_loc: Location.t;
+ md_uid: Uid.t;
+ }
+
+and modtype_declaration =
+ {
+ mtd_type: module_type option; (* Note: abstract *)
+ mtd_attributes: Parsetree.attributes;
+ mtd_loc: Location.t;
+ mtd_uid: Uid.t;
+ }
+
+and rec_status =
+ Trec_not (* first in a nonrecursive group *)
+ | Trec_first (* first in a recursive group *)
+ | Trec_next (* not first in a recursive/nonrecursive group *)
+
+and ext_status =
+ Text_first (* first constructor of an extension *)
+ | Text_next (* not first constructor of an extension *)
+ | Text_exception (* an exception *)
+
+
+(* Constructor and record label descriptions inserted held in typing
+ environments *)
+
+type constructor_description =
+ { cstr_name: string; (* Constructor name *)
+ cstr_res: type_expr; (* Type of the result *)
+ cstr_existentials: type_expr list; (* list of existentials *)
+ cstr_args: type_expr list; (* Type of the arguments *)
+ cstr_arity: int; (* Number of arguments *)
+ cstr_tag: constructor_tag; (* Tag for heap blocks *)
+ cstr_consts: int; (* Number of constant constructors *)
+ cstr_nonconsts: int; (* Number of non-const constructors *)
+ cstr_generalized: bool; (* Constrained return type? *)
+ cstr_private: private_flag; (* Read-only constructor? *)
+ cstr_loc: Location.t;
+ cstr_attributes: Parsetree.attributes;
+ cstr_inlined: type_declaration option;
+ cstr_uid: Uid.t;
+ }
+
+and constructor_tag =
+ Cstr_constant of int (* Constant constructor (an int) *)
+ | Cstr_block of int (* Regular constructor (a block) *)
+ | Cstr_unboxed (* Constructor of an unboxed type *)
+ | Cstr_extension of Path.t * bool (* Extension constructor
+ true if a constant false if a block*)
+
+let equal_tag t1 t2 =
+ match (t1, t2) with
+ | Cstr_constant i1, Cstr_constant i2 -> i2 = i1
+ | Cstr_block i1, Cstr_block i2 -> i2 = i1
+ | Cstr_unboxed, Cstr_unboxed -> true
+ | Cstr_extension (path1, b1), Cstr_extension (path2, b2) ->
+ Path.same path1 path2 && b1 = b2
+ | (Cstr_constant _|Cstr_block _|Cstr_unboxed|Cstr_extension _), _ -> false
+
+let may_equal_constr c1 c2 =
+ c1.cstr_arity = c2.cstr_arity
+ && (match c1.cstr_tag,c2.cstr_tag with
+ | Cstr_extension _,Cstr_extension _ ->
+ (* extension constructors may be rebindings of each other *)
+ true
+ | tag1, tag2 ->
+ equal_tag tag1 tag2)
+
+let item_visibility = function
+ | Sig_value (_, _, vis)
+ | Sig_type (_, _, _, vis)
+ | Sig_typext (_, _, _, vis)
+ | Sig_module (_, _, _, _, vis)
+ | Sig_modtype (_, _, vis)
+ | Sig_class (_, _, _, vis)
+ | Sig_class_type (_, _, _, vis) -> vis
+
+type label_description =
+ { lbl_name: string; (* Short name *)
+ lbl_res: type_expr; (* Type of the result *)
+ lbl_arg: type_expr; (* Type of the argument *)
+ lbl_mut: mutable_flag; (* Is this a mutable field? *)
+ lbl_pos: int; (* Position in block *)
+ lbl_all: label_description array; (* All the labels in this type *)
+ lbl_repres: record_representation; (* Representation for this record *)
+ lbl_private: private_flag; (* Read-only field? *)
+ lbl_loc: Location.t;
+ lbl_attributes: Parsetree.attributes;
+ lbl_uid: Uid.t;
+ }
+
+let rec bound_value_identifiers = function
+ [] -> []
+ | Sig_value(id, {val_kind = Val_reg}, _) :: rem ->
+ id :: bound_value_identifiers rem
+ | Sig_typext(id, _, _, _) :: rem -> id :: bound_value_identifiers rem
+ | Sig_module(id, Mp_present, _, _, _) :: rem ->
+ id :: bound_value_identifiers rem
+ | Sig_class(id, _, _, _) :: rem -> id :: bound_value_identifiers rem
+ | _ :: rem -> bound_value_identifiers rem
+
+let signature_item_id = function
+ | Sig_value (id, _, _)
+ | Sig_type (id, _, _, _)
+ | Sig_typext (id, _, _, _)
+ | Sig_module (id, _, _, _, _)
+ | Sig_modtype (id, _, _)
+ | Sig_class (id, _, _, _)
+ | Sig_class_type (id, _, _, _)
+ -> id
+
+(**** Definitions for backtracking ****)
+
+type change =
+ Ctype of type_expr * type_desc
+ | Ccompress of type_expr * type_desc * type_desc
+ | Clevel of type_expr * int
+ | Cscope of type_expr * int
+ | Cname of
+ (Path.t * type_expr list) option ref * (Path.t * type_expr list) option
+ | Crow of [`none|`some] row_field_gen ref
+ | Ckind of [`var] field_kind_gen
+ | Ccommu of [`var] commutable_gen
+ | Cuniv of type_expr option ref * type_expr option
+
+type changes =
+ Change of change * changes ref
+ | Unchanged
+ | Invalid
+
+let trail = Local_store.s_table ref Unchanged
+
+let log_change ch =
+ let r' = ref Unchanged in
+ !trail := Change (ch, r');
+ trail := r'
+
+(* constructor and accessors for [field_kind] *)
+
+type field_kind_view =
+ Fprivate
+ | Fpublic
+ | Fabsent
+
+let rec field_kind_internal_repr : field_kind -> field_kind = function
+ | FKvar {field_kind = FKvar _ | FKpublic | FKabsent as fk} ->
+ field_kind_internal_repr fk
+ | kind -> kind
+
+let field_kind_repr fk =
+ match field_kind_internal_repr fk with
+ | FKvar _ -> Fprivate
+ | FKpublic -> Fpublic
+ | FKabsent -> Fabsent
+
+let field_public = FKpublic
+let field_absent = FKabsent
+let field_private () = FKvar {field_kind=FKprivate}
+
+(* Constructor and accessors for [commutable] *)
+
+let rec is_commu_ok : type a. a commutable_gen -> bool = function
+ | Cvar {commu} -> is_commu_ok commu
+ | Cunknown -> false
+ | Cok -> true
+
+let commu_ok = Cok
+let commu_var () = Cvar {commu=Cunknown}
+
+(**** Representative of a type ****)
+
+let rec repr_link (t : type_expr) d : type_expr -> type_expr =
+ function
+ {desc = Tlink t' as d'} ->
+ repr_link t d' t'
+ | {desc = Tfield (_, k, _, t') as d'}
+ when field_kind_internal_repr k = FKabsent ->
+ repr_link t d' t'
+ | t' ->
+ log_change (Ccompress (t, t.desc, d));
+ t.desc <- d;
+ t'
+
+let repr_link1 t = function
+ {desc = Tlink t' as d'} ->
+ repr_link t d' t'
+ | {desc = Tfield (_, k, _, t') as d'}
+ when field_kind_internal_repr k = FKabsent ->
+ repr_link t d' t'
+ | t' -> t'
+
+let repr t =
+ match t.desc with
+ Tlink t' ->
+ repr_link1 t t'
+ | Tfield (_, k, _, t') when field_kind_internal_repr k = FKabsent ->
+ repr_link1 t t'
+ | _ -> t
+
+(* scope_field and marks *)
+
+let scope_mask = (1 lsl 27) - 1
+let marks_mask = (-1) lxor scope_mask
+let () = assert (Ident.highest_scope land marks_mask = 0)
+
+type type_mark =
+ | Mark of {mark: int; mutable marked: type_expr list}
+ | Hash of {visited: unit TransientTypeHash.t}
+let type_marks =
+ (* All the bits in marks_mask *)
+ List.init (Sys.int_size - 27) (fun x -> 1 lsl (x + 27))
+let available_marks = Local_store.s_ref type_marks
+let with_type_mark f =
+ match !available_marks with
+ | mark :: rem as old ->
+ available_marks := rem;
+ let mk = Mark {mark; marked = []} in
+ Misc.try_finally (fun () -> f mk) ~always: begin fun () ->
+ available_marks := old;
+ match mk with
+ | Mark {marked} ->
+ (* unmark marked type nodes *)
+ List.iter
+ (fun ty -> ty.scope <- ty.scope land ((-1) lxor mark))
+ marked
+ | Hash _ -> ()
+ end
+ | [] ->
+ (* When marks are exhausted, fall back to using a hash table *)
+ f (Hash {visited = TransientTypeHash.create 1})
+
+(* getters for type_expr *)
+
+let get_desc t = (repr t).desc
+let get_level t = (repr t).level
+let get_scope t = (repr t).scope land scope_mask
+let get_id t = (repr t).id
+let not_marked_node mark t =
+ match mark with
+ | Mark {mark} -> (repr t).scope land mark = 0
+ | Hash {visited} -> not (TransientTypeHash.mem visited (repr t))
+
+(* transient type_expr *)
+
+module Transient_expr = struct
+ let create desc ~level ~scope ~id = {desc; level; scope; id}
+ let set_desc ty d = ty.desc <- d
+ let set_stub_desc ty d = assert (ty.desc = Tvar None); ty.desc <- d
+ let set_level ty lv = ty.level <- lv
+ let get_scope ty = ty.scope land scope_mask
+ let get_marks ty = ty.scope lsr 27
+ let set_scope ty sc =
+ if (sc land marks_mask <> 0) then
+ invalid_arg "Types.Transient_expr.set_scope";
+ ty.scope <- (ty.scope land marks_mask) lor sc
+ let try_mark_node mark ty =
+ match mark with
+ | Mark ({mark} as mk) ->
+ (ty.scope land mark = 0) && (* mark type node when not marked *)
+ (ty.scope <- ty.scope lor mark; mk.marked <- ty :: mk.marked; true)
+ | Hash {visited} ->
+ not (TransientTypeHash.mem visited ty) &&
+ (TransientTypeHash.add visited ty (); true)
+ let coerce ty = ty
+ let repr = repr
+ let type_expr ty = ty
+end
+
+(* setting marks *)
+let try_mark_node mark t = Transient_expr.try_mark_node mark (repr t)
+
+(* Comparison for [type_expr]; cannot be used for functors *)
+
+let eq_type t1 t2 = t1 == t2 || repr t1 == repr t2
+let compare_type t1 t2 = compare (get_id t1) (get_id t2)
+
+(* Constructor and accessors for [row_desc] *)
+
+let create_row ~fields ~more ~closed ~fixed ~name =
+ { row_fields=fields; row_more=more;
+ row_closed=closed; row_fixed=fixed; row_name=name }
+
+(* [row_fields] subsumes the original [row_repr] *)
+let rec row_fields row =
+ match get_desc row.row_more with
+ | Tvariant row' ->
+ row.row_fields @ row_fields row'
+ | _ ->
+ row.row_fields
+
+let rec row_repr_no_fields row =
+ match get_desc row.row_more with
+ | Tvariant row' -> row_repr_no_fields row'
+ | _ -> row
+
+let row_more row = (row_repr_no_fields row).row_more
+let row_closed row = (row_repr_no_fields row).row_closed
+let row_fixed row = (row_repr_no_fields row).row_fixed
+let row_name row = (row_repr_no_fields row).row_name
+
+let rec get_row_field tag row =
+ let rec find = function
+ | (tag',f) :: fields ->
+ if tag = tag' then f else find fields
+ | [] ->
+ match get_desc row.row_more with
+ | Tvariant row' -> get_row_field tag row'
+ | _ -> RFabsent
+ in find row.row_fields
+
+let set_row_name row row_name =
+ let row_fields = row_fields row in
+ let row = row_repr_no_fields row in
+ {row with row_fields; row_name}
+
+type row_desc_repr =
+ Row of { fields: (label * row_field) list;
+ more:type_expr;
+ closed:bool;
+ fixed:fixed_explanation option;
+ name:(Path.t * type_expr list) option }
+
+let row_repr row =
+ let fields = row_fields row in
+ let row = row_repr_no_fields row in
+ Row { fields;
+ more = row.row_more;
+ closed = row.row_closed;
+ fixed = row.row_fixed;
+ name = row.row_name }
+
+type row_field_view =
+ Rpresent of type_expr option
+ | Reither of bool * type_expr list * bool
+ (* 1st true denotes a constant constructor *)
+ (* 2nd true denotes a tag in a pattern matching, and
+ is erased later *)
+ | Rabsent
+
+let rec row_field_repr_aux tl : row_field -> row_field = function
+ | RFeither ({ext = {contents = RFnone}} as r) ->
+ RFeither {r with arg_type = tl@r.arg_type}
+ | RFeither {arg_type;
+ ext = {contents = RFeither _ | RFpresent _ | RFabsent as rf}} ->
+ row_field_repr_aux (tl@arg_type) rf
+ | RFpresent (Some _) when tl <> [] ->
+ RFpresent (Some (List.hd tl))
+ | RFpresent _ as rf -> rf
+ | RFabsent -> RFabsent
+
+let row_field_repr fi =
+ match row_field_repr_aux [] fi with
+ | RFeither {no_arg; arg_type; matched} -> Reither (no_arg, arg_type, matched)
+ | RFpresent t -> Rpresent t
+ | RFabsent -> Rabsent
+
+let rec row_field_ext (fi : row_field) =
+ match fi with
+ | RFeither {ext = {contents = RFnone} as ext} -> ext
+ | RFeither {ext = {contents = RFeither _ | RFpresent _ | RFabsent as rf}} ->
+ row_field_ext rf
+ | _ -> Misc.fatal_error "Types.row_field_ext "
+
+let rf_present oty = RFpresent oty
+let rf_absent = RFabsent
+let rf_either ?use_ext_of ~no_arg arg_type ~matched =
+ let ext =
+ match use_ext_of with
+ Some rf -> row_field_ext rf
+ | None -> ref RFnone
+ in
+ RFeither {no_arg; arg_type; matched; ext}
+
+let rf_either_of = function
+ | None ->
+ RFeither {no_arg=true; arg_type=[]; matched=false; ext=ref RFnone}
+ | Some ty ->
+ RFeither {no_arg=false; arg_type=[ty]; matched=false; ext=ref RFnone}
+
+let eq_row_field_ext rf1 rf2 =
+ row_field_ext rf1 == row_field_ext rf2
+
+let changed_row_field_exts l f =
+ let exts = List.map row_field_ext l in
+ f ();
+ List.exists (fun r -> !r <> RFnone) exts
+
+let match_row_field ~present ~absent ~either (f : row_field) =
+ match f with
+ | RFabsent -> absent ()
+ | RFpresent t -> present t
+ | RFeither {no_arg; arg_type; matched; ext} ->
+ let e : row_field option =
+ match !ext with
+ | RFnone -> None
+ | RFeither _ | RFpresent _ | RFabsent as e -> Some e
+ in
+ either no_arg arg_type matched (ext,e)
+
+(**** Some type creators ****)
+
+let new_id = Local_store.s_ref (-1)
+
+let create_expr = Transient_expr.create
+
+let proto_newty3 ~level ~scope desc =
+ incr new_id;
+ create_expr desc ~level ~scope ~id:!new_id
+
+ (**********************************)
+ (* Utilities for backtracking *)
+ (**********************************)
+
+let undo_change = function
+ Ctype (ty, desc) -> Transient_expr.set_desc ty desc
+ | Ccompress (ty, desc, _) -> Transient_expr.set_desc ty desc
+ | Clevel (ty, level) -> Transient_expr.set_level ty level
+ | Cscope (ty, scope) -> Transient_expr.set_scope ty scope
+ | Cname (r, v) -> r := v
+ | Crow r -> r := RFnone
+ | Ckind (FKvar r) -> r.field_kind <- FKprivate
+ | Ccommu (Cvar r) -> r.commu <- Cunknown
+ | Cuniv (r, v) -> r := v
+
+type snapshot = changes ref * int
+let last_snapshot = Local_store.s_ref 0
+
+let log_type ty =
+ if ty.id <= !last_snapshot then log_change (Ctype (ty, ty.desc))
+let link_type ty ty' =
+ let ty = repr ty in
+ let ty' = repr ty' in
+ if ty == ty' then () else begin
+ log_type ty;
+ let desc = ty.desc in
+ Transient_expr.set_desc ty (Tlink ty');
+ (* Name is a user-supplied name for this unification variable (obtained
+ * through a type annotation for instance). *)
+ match desc, ty'.desc with
+ Tvar name, Tvar name' ->
+ begin match name, name' with
+ | Some _, None -> log_type ty'; Transient_expr.set_desc ty' (Tvar name)
+ | None, Some _ -> ()
+ | Some _, Some _ ->
+ if ty.level < ty'.level then
+ (log_type ty'; Transient_expr.set_desc ty' (Tvar name))
+ | None, None -> ()
+ end
+ | _ -> ()
+ end
+ (* ; assert (check_memorized_abbrevs ()) *)
+ (* ; check_expans [] ty' *)
+(* TODO: consider eliminating set_type_desc, replacing it with link types *)
+let set_type_desc ty td =
+ let ty = repr ty in
+ if td != ty.desc then begin
+ log_type ty;
+ Transient_expr.set_desc ty td
+ end
+(* TODO: separate set_level into two specific functions: *)
+(* set_lower_level and set_generic_level *)
+let set_level ty level =
+ let ty = repr ty in
+ if level <> ty.level then begin
+ if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
+ Transient_expr.set_level ty level
+ end
+
+(* TODO: introduce a guard and rename it to set_higher_scope? *)
+let set_scope ty scope =
+ let ty = repr ty in
+ let prev_scope = ty.scope land marks_mask in
+ if scope <> prev_scope then begin
+ if ty.id <= !last_snapshot then log_change (Cscope (ty, prev_scope));
+ Transient_expr.set_scope ty scope
+ end
+
+let set_univar rty ty =
+ log_change (Cuniv (rty, !rty)); rty := Some ty
+let set_name nm v =
+ log_change (Cname (nm, !nm)); nm := v
+
+let rec link_row_field_ext ~(inside : row_field) (v : row_field) =
+ match inside with
+ | RFeither {ext = {contents = RFnone} as e} ->
+ let RFeither _ | RFpresent _ | RFabsent as v = v in
+ log_change (Crow e); e := v
+ | RFeither {ext = {contents = RFeither _ | RFpresent _ | RFabsent as rf}} ->
+ link_row_field_ext ~inside:rf v
+ | _ -> invalid_arg "Types.link_row_field_ext"
+
+let rec link_kind ~(inside : field_kind) (k : field_kind) =
+ match inside with
+ | FKvar ({field_kind = FKprivate} as rk) as inside ->
+ (* prevent a loop by normalizing k and comparing it with inside *)
+ let FKvar _ | FKpublic | FKabsent as k = field_kind_internal_repr k in
+ if k != inside then begin
+ log_change (Ckind inside);
+ rk.field_kind <- k
+ end
+ | FKvar {field_kind = FKvar _ | FKpublic | FKabsent as inside} ->
+ link_kind ~inside k
+ | _ -> invalid_arg "Types.link_kind"
+
+let rec commu_repr : commutable -> commutable = function
+ | Cvar {commu = Cvar _ | Cok as commu} -> commu_repr commu
+ | c -> c
+
+let rec link_commu ~(inside : commutable) (c : commutable) =
+ match inside with
+ | Cvar ({commu = Cunknown} as rc) as inside ->
+ (* prevent a loop by normalizing c and comparing it with inside *)
+ let Cvar _ | Cok as c = commu_repr c in
+ if c != inside then begin
+ log_change (Ccommu inside);
+ rc.commu <- c
+ end
+ | Cvar {commu = Cvar _ | Cok as inside} ->
+ link_commu ~inside c
+ | _ -> invalid_arg "Types.link_commu"
+
+let set_commu_ok c = link_commu ~inside:c Cok
+
+let snapshot () =
+ let old = !last_snapshot in
+ last_snapshot := !new_id;
+ (!trail, old)
+
+let rec rev_log accu = function
+ Unchanged -> accu
+ | Invalid -> assert false
+ | Change (ch, next) ->
+ let d = !next in
+ next := Invalid;
+ rev_log (ch::accu) d
+
+let backtrack ~cleanup_abbrev (changes, old) =
+ match !changes with
+ Unchanged -> last_snapshot := old
+ | Invalid -> failwith "Types.backtrack"
+ | Change _ as change ->
+ cleanup_abbrev ();
+ let backlog = rev_log [] change in
+ List.iter undo_change backlog;
+ changes := Unchanged;
+ last_snapshot := old;
+ trail := changes
+
+let undo_first_change_after (changes, _) =
+ match !changes with
+ | Change (ch, _) ->
+ undo_change ch
+ | _ -> ()
+
+let rec rev_compress_log log r =
+ match !r with
+ Unchanged | Invalid ->
+ log
+ | Change (Ccompress _, next) ->
+ rev_compress_log (r::log) next
+ | Change (_, next) ->
+ rev_compress_log log next
+
+let undo_compress (changes, _old) =
+ match !changes with
+ Unchanged
+ | Invalid -> ()
+ | Change _ ->
+ let log = rev_compress_log [] changes in
+ List.iter
+ (fun r -> match !r with
+ Change (Ccompress (ty, desc, d), next) when ty.desc == d ->
+ Transient_expr.set_desc ty desc; r := !next
+ | _ -> ())
+ log
diff --git a/upstream/ocaml_503/typing/types.mli b/upstream/ocaml_503/typing/types.mli
new file mode 100644
index 0000000000..ca0cc6e061
--- /dev/null
+++ b/upstream/ocaml_503/typing/types.mli
@@ -0,0 +1,758 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** {0 Representation of types and declarations} *)
+
+(** [Types] defines the representation of types and declarations (that is, the
+ content of module signatures).
+
+ CMI files are made of marshalled types.
+*)
+
+(** Asttypes exposes basic definitions shared both by Parsetree and Types. *)
+open Asttypes
+
+(** Type expressions for the core language.
+
+ The [type_desc] variant defines all the possible type expressions one can
+ find in OCaml. [type_expr] wraps this with some annotations.
+
+ The [level] field tracks the level of polymorphism associated to a type,
+ guiding the generalization algorithm.
+ Put shortly, when referring to a type in a given environment, both the type
+ and the environment have a level. If the type has an higher level, then it
+ can be considered fully polymorphic (type variables will be printed as
+ ['a]), otherwise it'll be weakly polymorphic, or non generalized (type
+ variables printed as ['_a]).
+ See [http://okmij.org/ftp/ML/generalization.html] for more information.
+
+ Note about [type_declaration]: one should not make the confusion between
+ [type_expr] and [type_declaration].
+
+ [type_declaration] refers specifically to the [type] construct in OCaml
+ language, where you create and name a new type or type alias.
+
+ [type_expr] is used when you refer to existing types, e.g. when annotating
+ the expected type of a value.
+
+ Also, as the type system of OCaml is generative, a [type_declaration] can
+ have the side-effect of introducing a new type constructor, different from
+ all other known types.
+ Whereas [type_expr] is a pure construct which allows referring to existing
+ types.
+
+ Note on mutability: TBD.
+ *)
+type type_expr
+type row_desc
+type row_field
+type field_kind
+type commutable
+
+type type_desc =
+ | Tvar of string option
+ (** [Tvar (Some "a")] ==> ['a] or ['_a]
+ [Tvar None] ==> [_] *)
+
+ | Tarrow of arg_label * type_expr * type_expr * commutable
+ (** [Tarrow (Nolabel, e1, e2, c)] ==> [e1 -> e2]
+ [Tarrow (Labelled "l", e1, e2, c)] ==> [l:e1 -> e2]
+ [Tarrow (Optional "l", e1, e2, c)] ==> [?l:e1 -> e2]
+
+ See [commutable] for the last argument. *)
+
+ | Ttuple of type_expr list
+ (** [Ttuple [t1;...;tn]] ==> [(t1 * ... * tn)] *)
+
+ | Tconstr of Path.t * type_expr list * abbrev_memo ref
+ (** [Tconstr (`A.B.t', [t1;...;tn], _)] ==> [(t1,...,tn) A.B.t]
+ The last parameter keep tracks of known expansions, see [abbrev_memo]. *)
+
+ | Tobject of type_expr * (Path.t * type_expr list) option ref
+ (** [Tobject (`f1:t1;...;fn: tn', `None')] ==> [< f1: t1; ...; fn: tn >]
+ f1, fn are represented as a linked list of types using Tfield and Tnil
+ constructors.
+
+ [Tobject (_, `Some (`A.ct', [t1;...;tn]')] ==> [(t1, ..., tn) A.ct].
+ where A.ct is the type of some class.
+
+ There are also special cases for so-called "class-types", cf. [Typeclass]
+ and [Ctype.set_object_name]:
+
+ [Tobject (Tfield(_,_,...(Tfield(_,_,rv)...),
+ Some(`A.#ct`, [rv;t1;...;tn])]
+ ==> [(t1, ..., tn) #A.ct]
+ [Tobject (_, Some(`A.#ct`, [Tnil;t1;...;tn])] ==> [(t1, ..., tn) A.ct]
+
+ where [rv] is the hidden row variable.
+ *)
+
+ | Tfield of string * field_kind * type_expr * type_expr
+ (** [Tfield ("foo", field_public, t, ts)] ==> [<...; foo : t; ts>] *)
+
+ | Tnil
+ (** [Tnil] ==> [<...; >] *)
+
+ | Tlink of type_expr
+ (** Indirection used by unification engine. *)
+
+ | Tsubst of type_expr * type_expr option
+ (** [Tsubst] is used temporarily to store information in low-level
+ functions manipulating representation of types, such as
+ instantiation or copy.
+ The first argument contains a copy of the original node.
+ The second is available only when the first is the row variable of
+ a polymorphic variant. It then contains a copy of the whole variant.
+ This constructor should not appear outside of these cases. *)
+
+ | Tvariant of row_desc
+ (** Representation of polymorphic variants, see [row_desc]. *)
+
+ | Tunivar of string option
+ (** Occurrence of a type variable introduced by a
+ forall quantifier / [Tpoly]. *)
+
+ | Tpoly of type_expr * type_expr list
+ (** [Tpoly (ty,tyl)] ==> ['a1... 'an. ty],
+ where 'a1 ... 'an are names given to types in tyl
+ and occurrences of those types in ty. *)
+
+ | Tpackage of Path.t * (Longident.t * type_expr) list
+ (** Type of a first-class module (a.k.a package). *)
+
+and fixed_explanation =
+ | Univar of type_expr (** The row type was bound to an univar *)
+ | Fixed_private (** The row type is private *)
+ | Reified of Path.t (** The row was reified *)
+ | Rigid (** The row type was made rigid during constraint verification *)
+
+(** [abbrev_memo] allows one to keep track of different expansions of a type
+ alias. This is done for performance purposes.
+
+ For instance, when defining [type 'a pair = 'a * 'a], when one refers to an
+ ['a pair], it is just a shortcut for the ['a * 'a] type.
+ This expansion will be stored in the [abbrev_memo] of the corresponding
+ [Tconstr] node.
+
+ In practice, [abbrev_memo] behaves like list of expansions with a mutable
+ tail.
+
+ Note on marshalling: [abbrev_memo] must not appear in saved types.
+ [Btype], with [cleanup_abbrev] and [memo], takes care of tracking and
+ removing abbreviations.
+*)
+and abbrev_memo =
+ | Mnil (** No known abbreviation *)
+
+ | Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
+ (** Found one abbreviation.
+ A valid abbreviation should be at least as visible and reachable by the
+ same path.
+ The first expression is the abbreviation and the second the expansion. *)
+
+ | Mlink of abbrev_memo ref
+ (** Abbreviations can be found after this indirection *)
+
+(** [commutable] is a flag appended to every arrow type.
+
+ When typing an application, if the type of the functional is
+ known, its type is instantiated with [commu_ok] arrows, otherwise as
+ [commu_var ()].
+
+ When the type is not known, the application will be used to infer
+ the actual type. This is fragile in presence of labels where
+ there is no principal type.
+
+ Two incompatible applications must rely on [is_commu_ok] arrows,
+ otherwise they will trigger an error.
+
+ let f g =
+ g ~a:() ~b:();
+ g ~b:() ~a:();
+
+ Error: This function is applied to arguments
+ in an order different from other calls.
+ This is only allowed when the real type is known.
+*)
+
+val is_commu_ok: commutable -> bool
+val commu_ok: commutable
+val commu_var: unit -> commutable
+
+(** [field_kind] indicates the accessibility of a method.
+
+ An [Fprivate] field may become [Fpublic] or [Fabsent] during unification,
+ but not the other way round.
+
+ The same [field_kind] is kept shared when copying [Tfield] nodes
+ so that the copies of the self-type of a class share the same accessibility
+ (see also PR#10539).
+ *)
+
+type field_kind_view =
+ Fprivate
+ | Fpublic
+ | Fabsent
+
+val field_kind_repr: field_kind -> field_kind_view
+val field_public: field_kind
+val field_absent: field_kind
+val field_private: unit -> field_kind
+val field_kind_internal_repr: field_kind -> field_kind
+ (* Removes indirections in [field_kind].
+ Only needed for performance. *)
+
+(** Getters for type_expr; calls repr before answering a value *)
+
+val get_desc: type_expr -> type_desc
+val get_level: type_expr -> int
+val get_scope: type_expr -> int
+val get_id: type_expr -> int
+
+(** Access to marks. They are stored in the scope field. *)
+type type_mark
+val with_type_mark: (type_mark -> 'a) -> 'a
+ (* run a computation using exclusively an available type mark *)
+
+val not_marked_node: type_mark -> type_expr -> bool
+ (* Return true if a type node is not yet marked *)
+
+val try_mark_node: type_mark -> type_expr -> bool
+ (* Mark a type node if it is not yet marked.
+ Marks will be automatically removed when leaving the
+ scope of [with_type_mark].
+
+ Return false if it was already marked *)
+
+(** Transient [type_expr].
+ Should only be used immediately after [Transient_expr.repr] *)
+type transient_expr = private
+ { mutable desc: type_desc;
+ mutable level: int;
+ mutable scope: scope_field;
+ id: int }
+and scope_field (* abstract *)
+
+module Transient_expr : sig
+ (** Operations on [transient_expr] *)
+
+ val create: type_desc -> level: int -> scope: int -> id: int -> transient_expr
+ val get_scope: transient_expr -> int
+ val get_marks: transient_expr -> int
+ val set_desc: transient_expr -> type_desc -> unit
+ val set_level: transient_expr -> int -> unit
+ val set_scope: transient_expr -> int -> unit
+ val repr: type_expr -> transient_expr
+ val type_expr: transient_expr -> type_expr
+ val coerce: type_expr -> transient_expr
+ (** Coerce without normalizing with [repr] *)
+
+ val set_stub_desc: type_expr -> type_desc -> unit
+ (** Instantiate a not yet instantiated stub.
+ Fail if already instantiated. *)
+
+ val try_mark_node: type_mark -> transient_expr -> bool
+end
+
+val create_expr: type_desc -> level: int -> scope: int -> id: int -> type_expr
+
+(** Functions and definitions moved from Btype *)
+
+val proto_newty3: level:int -> scope:int -> type_desc -> transient_expr
+ (** Create a type with a fresh id *)
+
+module TransientTypeOps : sig
+ (** Comparisons for functors *)
+
+ type t = transient_expr
+ val compare : t -> t -> int
+ val equal : t -> t -> bool
+ val hash : t -> int
+end
+
+module TransientTypeHash : Hashtbl.S with type key = transient_expr
+
+(** Comparisons for [type_expr]; cannot be used for functors *)
+
+val eq_type: type_expr -> type_expr -> bool
+val compare_type: type_expr -> type_expr -> int
+
+(** Constructor and accessors for [row_desc] *)
+
+(** [ `X | `Y ] (row_closed = true)
+ [< `X | `Y ] (row_closed = true)
+ [> `X | `Y ] (row_closed = false)
+ [< `X | `Y > `X ] (row_closed = true)
+
+ type t = [> `X ] as 'a (row_more = Tvar a)
+ type t = private [> `X ] (row_more = Tconstr ("t#row", [], ref Mnil))
+
+ And for:
+
+ let f = function `X -> `X -> | `Y -> `X
+
+ the type of "f" will be a [Tarrow] whose lhs will (basically) be:
+
+ Tvariant { row_fields = [("X", _)];
+ row_more =
+ Tvariant { row_fields = [("Y", _)];
+ row_more =
+ Tvariant { row_fields = [];
+ row_more = _;
+ _ };
+ _ };
+ _
+ }
+
+*)
+
+val create_row:
+ fields:(label * row_field) list ->
+ more:type_expr ->
+ closed:bool ->
+ fixed:fixed_explanation option ->
+ name:(Path.t * type_expr list) option -> row_desc
+
+val row_fields: row_desc -> (label * row_field) list
+val row_more: row_desc -> type_expr
+val row_closed: row_desc -> bool
+val row_fixed: row_desc -> fixed_explanation option
+val row_name: row_desc -> (Path.t * type_expr list) option
+
+val set_row_name: row_desc -> (Path.t * type_expr list) option -> row_desc
+
+val get_row_field: label -> row_desc -> row_field
+
+(** get all fields at once; different from the old [row_repr] *)
+type row_desc_repr =
+ Row of { fields: (label * row_field) list;
+ more: type_expr;
+ closed: bool;
+ fixed: fixed_explanation option;
+ name: (Path.t * type_expr list) option }
+
+val row_repr: row_desc -> row_desc_repr
+
+(** Current contents of a row field *)
+type row_field_view =
+ Rpresent of type_expr option
+ | Reither of bool * type_expr list * bool
+ (* 1st true denotes a constant constructor *)
+ (* 2nd true denotes a tag in a pattern matching, and
+ is erased later *)
+ | Rabsent
+
+val row_field_repr: row_field -> row_field_view
+val rf_present: type_expr option -> row_field
+val rf_absent: row_field
+val rf_either:
+ ?use_ext_of:row_field ->
+ no_arg:bool -> type_expr list -> matched:bool -> row_field
+val rf_either_of: type_expr option -> row_field
+
+val eq_row_field_ext: row_field -> row_field -> bool
+val changed_row_field_exts: row_field list -> (unit -> unit) -> bool
+
+type row_field_cell
+val match_row_field:
+ present:(type_expr option -> 'a) ->
+ absent:(unit -> 'a) ->
+ either:(bool -> type_expr list -> bool ->
+ row_field_cell * row_field option ->'a) ->
+ row_field -> 'a
+
+
+(* *)
+
+module Uid = Shape.Uid
+
+(* Sets and maps of methods and instance variables *)
+
+module MethSet : Set.S with type elt = string
+module VarSet : Set.S with type elt = string
+
+module Meths : Map.S with type key = string
+module Vars : Map.S with type key = string
+
+(* Value descriptions *)
+
+type value_description =
+ { val_type: type_expr; (* Type of the value *)
+ val_kind: value_kind;
+ val_loc: Location.t;
+ val_attributes: Parsetree.attributes;
+ val_uid: Uid.t;
+ }
+
+and value_kind =
+ Val_reg (* Regular value *)
+ | Val_prim of Primitive.description (* Primitive *)
+ | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
+ | Val_self of class_signature * self_meths * Ident.t Vars.t * string
+ (* Self *)
+ | Val_anc of class_signature * Ident.t Meths.t * string
+ (* Ancestor *)
+
+and self_meths =
+ | Self_concrete of Ident.t Meths.t
+ | Self_virtual of Ident.t Meths.t ref
+
+and class_signature =
+ { csig_self: type_expr;
+ mutable csig_self_row: type_expr;
+ mutable csig_vars: (mutable_flag * virtual_flag * type_expr) Vars.t;
+ mutable csig_meths: (method_privacy * virtual_flag * type_expr) Meths.t; }
+
+and method_privacy =
+ | Mpublic
+ | Mprivate of field_kind
+ (* The [field_kind] is always [Fabsent] in a complete class type. *)
+
+(* Variance *)
+
+module Variance : sig
+ type t
+ type f =
+ May_pos (* allow positive occurrences *)
+ | May_neg (* allow negative occurrences *)
+ | May_weak (* allow occurrences under a negative position *)
+ | Inj (* type is injective in this parameter *)
+ | Pos (* there is a positive occurrence *)
+ | Neg (* there is a negative occurrence *)
+ | Inv (* both negative and positive occurrences *)
+ val null : t (* no occurrence *)
+ val full : t (* strictly invariant (all flags) *)
+ val covariant : t (* strictly covariant (May_pos, Pos and Inj) *)
+ val contravariant : t (* strictly contravariant *)
+ val unknown : t (* allow everything, guarantee nothing *)
+ val union : t -> t -> t
+ val inter : t -> t -> t
+ val subset : t -> t -> bool
+ val eq : t -> t -> bool
+ val set : f -> t -> t
+ val set_if : bool -> f -> t -> t
+ val mem : f -> t -> bool
+ val conjugate : t -> t (* exchange positive and negative *)
+ val compose : t -> t -> t
+ val strengthen : t -> t (* remove May_weak when possible *)
+ val get_upper : t -> bool * bool (* may_pos, may_neg *)
+ val get_lower : t -> bool * bool * bool (* pos, neg, inj *)
+ val unknown_signature : injective:bool -> arity:int -> t list
+ (** The most pessimistic variance for a completely unknown type. *)
+end
+
+module Separability : sig
+ (** see {!Typedecl_separability} for an explanation of separability
+ and separability modes.*)
+
+ type t = Ind | Sep | Deepsep
+ val eq : t -> t -> bool
+ val print : Format.formatter -> t -> unit
+
+ val rank : t -> int
+ (** Modes are ordered from the least to the most demanding:
+ Ind < Sep < Deepsep.
+ 'rank' maps them to integers in an order-respecting way:
+ m1 < m2 <=> rank m1 < rank m2 *)
+
+ val compare : t -> t -> int
+ (** Compare two mode according to their mode ordering. *)
+
+ val max : t -> t -> t
+ (** [max_mode m1 m2] returns the most demanding mode. It is used to
+ express the conjunction of two parameter mode constraints. *)
+
+ type signature = t list
+ (** The 'separability signature' of a type assigns a mode for
+ each of its parameters. [('a, 'b) t] has mode [(m1, m2)] if
+ [(t1, t2) t] is separable whenever [t1, t2] have mode [m1, m2]. *)
+
+ val print_signature : Format.formatter -> signature -> unit
+
+ val default_signature : arity:int -> signature
+ (** The most pessimistic separability for a completely unknown type. *)
+end
+
+(* Type definitions *)
+
+type type_declaration =
+ { type_params: type_expr list;
+ type_arity: int;
+ type_kind: type_decl_kind;
+ type_private: private_flag;
+ type_manifest: type_expr option;
+ type_variance: Variance.t list;
+ (* covariant, contravariant, weakly contravariant, injective *)
+ type_separability: Separability.t list;
+ type_is_newtype: bool;
+ type_expansion_scope: int;
+ type_loc: Location.t;
+ type_attributes: Parsetree.attributes;
+ type_immediate: Type_immediacy.t;
+ type_unboxed_default: bool;
+ (* true if the unboxed-ness of this type was chosen by a compiler flag *)
+ type_uid: Uid.t;
+ }
+
+and type_decl_kind = (label_declaration, constructor_declaration) type_kind
+
+and ('lbl, 'cstr) type_kind =
+ Type_abstract of type_origin
+ | Type_record of 'lbl list * record_representation
+ | Type_variant of 'cstr list * variant_representation
+ | Type_open
+
+and type_origin =
+ Definition
+ | Rec_check_regularity (* See Typedecl.transl_type_decl *)
+ | Existential of string
+
+and record_representation =
+ Record_regular (* All fields are boxed / tagged *)
+ | Record_float (* All fields are floats *)
+ | Record_unboxed of bool (* Unboxed single-field record, inlined or not *)
+ | Record_inlined of int (* Inlined record *)
+ | Record_extension of Path.t (* Inlined record under extension *)
+ (* The argument is the path of the extension *)
+
+and variant_representation =
+ Variant_regular (* Constant or boxed constructors *)
+ | Variant_unboxed (* One unboxed single-field constructor *)
+
+and label_declaration =
+ {
+ ld_id: Ident.t;
+ ld_mutable: mutable_flag;
+ ld_type: type_expr;
+ ld_loc: Location.t;
+ ld_attributes: Parsetree.attributes;
+ ld_uid: Uid.t;
+ }
+
+and constructor_declaration =
+ {
+ cd_id: Ident.t;
+ cd_args: constructor_arguments;
+ cd_res: type_expr option;
+ cd_loc: Location.t;
+ cd_attributes: Parsetree.attributes;
+ cd_uid: Uid.t;
+ }
+
+and constructor_arguments =
+ | Cstr_tuple of type_expr list
+ | Cstr_record of label_declaration list
+
+type extension_constructor =
+ {
+ ext_type_path: Path.t;
+ ext_type_params: type_expr list;
+ ext_args: constructor_arguments;
+ ext_ret_type: type_expr option;
+ ext_private: private_flag;
+ ext_loc: Location.t;
+ ext_attributes: Parsetree.attributes;
+ ext_uid: Uid.t;
+ }
+
+and type_transparence =
+ Type_public (* unrestricted expansion *)
+ | Type_new (* "new" type *)
+ | Type_private (* private type *)
+
+(* Type expressions for the class language *)
+
+type class_type =
+ Cty_constr of Path.t * type_expr list * class_type
+ | Cty_signature of class_signature
+ | Cty_arrow of arg_label * type_expr * class_type
+
+type class_declaration =
+ { cty_params: type_expr list;
+ mutable cty_type: class_type;
+ cty_path: Path.t;
+ cty_new: type_expr option;
+ cty_variance: Variance.t list;
+ cty_loc: Location.t;
+ cty_attributes: Parsetree.attributes;
+ cty_uid: Uid.t;
+ }
+
+type class_type_declaration =
+ { clty_params: type_expr list;
+ clty_type: class_type;
+ clty_path: Path.t;
+ clty_hash_type: type_declaration; (* object type with an open row *)
+ clty_variance: Variance.t list;
+ clty_loc: Location.t;
+ clty_attributes: Parsetree.attributes;
+ clty_uid: Uid.t;
+ }
+
+(* Type expressions for the module language *)
+
+type visibility =
+ | Exported
+ | Hidden
+
+type module_type =
+ Mty_ident of Path.t
+ | Mty_signature of signature
+ | Mty_functor of functor_parameter * module_type
+ | Mty_alias of Path.t
+
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * module_type
+
+and module_presence =
+ | Mp_present
+ | Mp_absent
+
+and signature = signature_item list
+
+and signature_item =
+ Sig_value of Ident.t * value_description * visibility
+ | Sig_type of Ident.t * type_declaration * rec_status * visibility
+ | Sig_typext of Ident.t * extension_constructor * ext_status * visibility
+ | Sig_module of
+ Ident.t * module_presence * module_declaration * rec_status * visibility
+ | Sig_modtype of Ident.t * modtype_declaration * visibility
+ | Sig_class of Ident.t * class_declaration * rec_status * visibility
+ | Sig_class_type of Ident.t * class_type_declaration * rec_status * visibility
+
+and module_declaration =
+ {
+ md_type: module_type;
+ md_attributes: Parsetree.attributes;
+ md_loc: Location.t;
+ md_uid: Uid.t;
+ }
+
+and modtype_declaration =
+ {
+ mtd_type: module_type option; (* None: abstract *)
+ mtd_attributes: Parsetree.attributes;
+ mtd_loc: Location.t;
+ mtd_uid: Uid.t;
+ }
+
+and rec_status =
+ Trec_not (* first in a nonrecursive group *)
+ | Trec_first (* first in a recursive group *)
+ | Trec_next (* not first in a recursive/nonrecursive group *)
+
+and ext_status =
+ Text_first (* first constructor in an extension *)
+ | Text_next (* not first constructor in an extension *)
+ | Text_exception
+
+val item_visibility : signature_item -> visibility
+
+(* Constructor and record label descriptions inserted held in typing
+ environments *)
+
+type constructor_description =
+ { cstr_name: string; (* Constructor name *)
+ cstr_res: type_expr; (* Type of the result *)
+ cstr_existentials: type_expr list; (* list of existentials *)
+ cstr_args: type_expr list; (* Type of the arguments *)
+ cstr_arity: int; (* Number of arguments *)
+ cstr_tag: constructor_tag; (* Tag for heap blocks *)
+ cstr_consts: int; (* Number of constant constructors *)
+ cstr_nonconsts: int; (* Number of non-const constructors *)
+ cstr_generalized: bool; (* Constrained return type? *)
+ cstr_private: private_flag; (* Read-only constructor? *)
+ cstr_loc: Location.t;
+ cstr_attributes: Parsetree.attributes;
+ cstr_inlined: type_declaration option;
+ cstr_uid: Uid.t;
+ }
+
+and constructor_tag =
+ Cstr_constant of int (* Constant constructor (an int) *)
+ | Cstr_block of int (* Regular constructor (a block) *)
+ | Cstr_unboxed (* Constructor of an unboxed type *)
+ | Cstr_extension of Path.t * bool (* Extension constructor
+ true if a constant false if a block*)
+
+(* Constructors are the same *)
+val equal_tag : constructor_tag -> constructor_tag -> bool
+
+(* Constructors may be the same, given potential rebinding *)
+val may_equal_constr :
+ constructor_description -> constructor_description -> bool
+
+type label_description =
+ { lbl_name: string; (* Short name *)
+ lbl_res: type_expr; (* Type of the result *)
+ lbl_arg: type_expr; (* Type of the argument *)
+ lbl_mut: mutable_flag; (* Is this a mutable field? *)
+ lbl_pos: int; (* Position in block *)
+ lbl_all: label_description array; (* All the labels in this type *)
+ lbl_repres: record_representation; (* Representation for this record *)
+ lbl_private: private_flag; (* Read-only field? *)
+ lbl_loc: Location.t;
+ lbl_attributes: Parsetree.attributes;
+ lbl_uid: Uid.t;
+ }
+
+(** Extracts the list of "value" identifiers bound by a signature.
+ "Value" identifiers are identifiers for signature components that
+ correspond to a run-time value: values, extensions, modules, classes.
+ Note: manifest primitives do not correspond to a run-time value! *)
+val bound_value_identifiers: signature -> Ident.t list
+
+val signature_item_id : signature_item -> Ident.t
+
+(**** Utilities for backtracking ****)
+
+type snapshot
+ (* A snapshot for backtracking *)
+val snapshot: unit -> snapshot
+ (* Make a snapshot for later backtracking. Costs nothing *)
+val backtrack: cleanup_abbrev:(unit -> unit) -> snapshot -> unit
+ (* Backtrack to a given snapshot. Only possible if you have
+ not already backtracked to a previous snapshot.
+ Calls [cleanup_abbrev] internally *)
+val undo_first_change_after: snapshot -> unit
+ (* Backtrack only the first change after a snapshot.
+ Does not update the list of changes *)
+val undo_compress: snapshot -> unit
+ (* Backtrack only path compression. Only meaningful if you have
+ not already backtracked to a previous snapshot.
+ Does not call [cleanup_abbrev] *)
+
+(** Functions to use when modifying a type (only Ctype?).
+ The old values are logged and reverted on backtracking.
+ *)
+
+val link_type: type_expr -> type_expr -> unit
+ (* Set the desc field of [t1] to [Tlink t2], logging the old
+ value if there is an active snapshot *)
+val set_type_desc: type_expr -> type_desc -> unit
+ (* Set directly the desc field, without sharing *)
+val set_level: type_expr -> int -> unit
+val set_scope: type_expr -> int -> unit
+val set_name:
+ (Path.t * type_expr list) option ref ->
+ (Path.t * type_expr list) option -> unit
+val link_row_field_ext: inside:row_field -> row_field -> unit
+ (* Extract the extension variable of [inside] and set it to the
+ second argument *)
+val set_univar: type_expr option ref -> type_expr -> unit
+val link_kind: inside:field_kind -> field_kind -> unit
+val link_commu: inside:commutable -> commutable -> unit
+val set_commu_ok: commutable -> unit
diff --git a/upstream/ocaml_503/typing/typetexp.ml b/upstream/ocaml_503/typing/typetexp.ml
new file mode 100644
index 0000000000..1be07aa3f5
--- /dev/null
+++ b/upstream/ocaml_503/typing/typetexp.ml
@@ -0,0 +1,972 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* typetexp.ml,v 1.34.4.9 2002/01/07 08:39:16 garrigue Exp *)
+
+(* Typechecking of type expressions for the core language *)
+
+open Asttypes
+open Misc
+open Parsetree
+open Typedtree
+open Types
+open Ctype
+
+exception Already_bound
+
+type error =
+ | Unbound_type_variable of string * string list
+ | No_type_wildcards
+ | Undefined_type_constructor of Path.t
+ | Type_arity_mismatch of Longident.t * int * int
+ | Bound_type_variable of string
+ | Recursive_type
+ | Type_mismatch of Errortrace.unification_error
+ | Alias_type_mismatch of Errortrace.unification_error
+ | Present_has_conjunction of string
+ | Present_has_no_type of string
+ | Constructor_mismatch of type_expr * type_expr
+ | Not_a_variant of type_expr
+ | Variant_tags of string * string
+ | Invalid_variable_name of string
+ | Cannot_quantify of string * type_expr
+ | Multiple_constraints_on_type of Longident.t
+ | Method_mismatch of string * type_expr * type_expr
+ | Opened_object of Path.t option
+ | Not_an_object of type_expr
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+module TyVarEnv : sig
+ val reset : unit -> unit
+ (* see mli file *)
+
+ val is_in_scope : string -> bool
+
+ val add : string -> type_expr -> unit
+ (* add a global type variable to the environment *)
+
+ val with_local_scope : (unit -> 'a) -> 'a
+ (* see mli file *)
+
+ type poly_univars
+ val with_univars : poly_univars -> (unit -> 'a) -> 'a
+ (* evaluate with a locally extended set of univars *)
+
+ val make_poly_univars : string list -> poly_univars
+ (* see mli file *)
+
+ val check_poly_univars : Env.t -> Location.t -> poly_univars -> type_expr list
+ (* see mli file *)
+
+ val instance_poly_univars :
+ Env.t -> Location.t -> poly_univars -> type_expr list
+ (* see mli file *)
+
+ type policy
+ val fixed_policy : policy (* no wildcards allowed *)
+ val extensible_policy : policy (* common case *)
+ val univars_policy : policy (* fresh variables are univars (in methods) *)
+ val new_any_var : Location.t -> Env.t -> policy -> type_expr
+ (* create a new variable to represent a _; fails for fixed_policy *)
+ val new_var : ?name:string -> policy -> type_expr
+ (* create a new variable according to the given policy *)
+
+ val add_pre_univar : type_expr -> policy -> unit
+ (* remember that a variable might become a univar if it isn't unified;
+ used for checking method types *)
+
+ val collect_univars : (unit -> 'a) -> 'a * type_expr list
+ (* collect univars during a computation; returns the univars.
+ The wrapped computation should use [univars_policy].
+ postcondition: the returned type_exprs are all Tunivar *)
+
+ val reset_locals : ?univars:poly_univars -> unit -> unit
+ (* clear out the local type variable env't; call this when starting
+ a new e.g. type signature. Optionally pass some univars that
+ are in scope. *)
+
+ val lookup_local :
+ row_context:type_expr option ref list -> string -> type_expr
+ (* look up a local type variable; throws Not_found if it isn't in scope *)
+
+ val remember_used : string -> type_expr -> Location.t -> unit
+ (* remember that a given name is bound to a given type *)
+
+ val globalize_used_variables : policy -> Env.t -> unit -> unit
+ (* after finishing with a type signature, used variables are unified to the
+ corresponding global type variables if they exist. Otherwise, in function
+ of the policy, fresh used variables are either
+ - added to the global type variable scope if they are not longer
+ variables under the {!fixed_policy}
+ - added to the global type variable scope under the {!extensible_policy}
+ - expected to be collected later by a call to `collect_univar` under the
+ {!universal_policy}
+ *)
+
+end = struct
+ (** Map indexed by type variable names. *)
+ module TyVarMap = Misc.Stdlib.String.Map
+
+ let not_generic v = get_level v <> Btype.generic_level
+
+ (* These are the "global" type variables: they were in scope before
+ we started processing the current type.
+ *)
+ let type_variables = ref (TyVarMap.empty : type_expr TyVarMap.t)
+
+ (* These are variables that have been used in the currently-being-checked
+ type.
+ *)
+ let used_variables =
+ ref (TyVarMap.empty : (type_expr * Location.t) TyVarMap.t)
+
+ (* These are variables we expect to become univars (they were introduced with
+ e.g. ['a .]), but we need to make sure they don't unify first. Why not
+ just birth them as univars? Because they might successfully unify with a
+ row variable in the ['a. < m : ty; .. > as 'a] idiom. They are like the
+ [used_variables], but will not be globalized in [globalize_used_variables].
+ *)
+ type pending_univar = {
+ univar: type_expr (** the univar itself *);
+ mutable associated: type_expr option ref list
+ (** associated references to row variables that we want to generalize
+ if possible *)
+ }
+
+ let univars = ref ([] : (string * pending_univar) list)
+ let assert_univars uvs =
+ assert (List.for_all (fun (_name, v) -> not_generic v.univar) uvs)
+
+ (* These are variables that will become univars when we're done with the
+ current type. Used to force free variables in method types to become
+ univars.
+ *)
+ let pre_univars = ref ([] : type_expr list)
+
+ let reset () =
+ reset_global_level ();
+ type_variables := TyVarMap.empty
+
+ let is_in_scope name =
+ TyVarMap.mem name !type_variables
+
+ let add name v =
+ assert (not_generic v);
+ type_variables := TyVarMap.add name v !type_variables
+
+ let narrow () =
+ (increase_global_level (), !type_variables)
+
+ let widen (gl, tv) =
+ restore_global_level gl;
+ type_variables := tv
+
+ let with_local_scope f =
+ let context = narrow () in
+ Fun.protect
+ f
+ ~finally:(fun () -> widen context)
+
+ (* throws Not_found if the variable is not in scope *)
+ let lookup_global_type_variable name =
+ TyVarMap.find name !type_variables
+
+ let get_in_scope_names () =
+ let add_name name _ l =
+ if name = "_" then l else Pprintast.tyvar_of_name name :: l
+ in
+ TyVarMap.fold add_name !type_variables []
+
+ (*****)
+ type poly_univars = (string * pending_univar) list
+
+ let with_univars new_ones f =
+ assert_univars new_ones;
+ let old_univars = !univars in
+ univars := new_ones @ !univars;
+ Fun.protect
+ f
+ ~finally:(fun () -> univars := old_univars)
+
+ let make_poly_univars vars =
+ let make name = { univar=newvar ~name (); associated = [] } in
+ List.map (fun name -> name, make name ) vars
+
+ let promote_generics_to_univars promoted vars =
+ List.fold_left
+ (fun acc v ->
+ match get_desc v with
+ | Tvar name when get_level v = Btype.generic_level ->
+ set_type_desc v (Tunivar name);
+ v :: acc
+ | _ -> acc
+ )
+ promoted vars
+
+ let check_poly_univars env loc vars =
+ let univars =
+ vars |> List.map (fun (name, {univar=ty1; _ }) ->
+ let v = Btype.proxy ty1 in
+ begin match get_desc v with
+ | Tvar name when get_level v = Btype.generic_level ->
+ set_type_desc v (Tunivar name)
+ | _ ->
+ raise (Error (loc, env, Cannot_quantify(name, v)))
+ end;
+ v)
+ in
+ (* Since we are promoting variables to univars in
+ {!promote_generics_to_univars}, even if a row variable is associated with
+ multiple univars we will promote it once, when checking the nearest
+ univar associated to this row variable.
+ *)
+ let promote_associated acc (_,v) =
+ let enclosed_rows = List.filter_map (!) v.associated in
+ promote_generics_to_univars acc enclosed_rows
+ in
+ List.fold_left promote_associated univars vars
+
+ let instance_poly_univars env loc vars =
+ let vs = check_poly_univars env loc vars in
+ vs |> List.iter (fun v ->
+ match get_desc v with
+ | Tunivar name ->
+ set_type_desc v (Tvar name)
+ | _ -> assert false);
+ vs
+
+ (*****)
+ let reset_locals ?univars:(uvs=[]) () =
+ assert_univars uvs;
+ univars := uvs;
+ used_variables := TyVarMap.empty
+
+ let associate row_context p =
+ let add l x = if List.memq x l then l else x :: l in
+ p.associated <- List.fold_left add row_context p.associated
+
+ (* throws Not_found if the variable is not in scope *)
+ let lookup_local ~row_context name =
+ try
+ let p = List.assoc name !univars in
+ associate row_context p;
+ p.univar
+ with Not_found ->
+ instance (fst (TyVarMap.find name !used_variables))
+ (* This call to instance might be redundant; all variables
+ inserted into [used_variables] are non-generic, but some
+ might get generalized. *)
+
+ let remember_used name v loc =
+ assert (not_generic v);
+ used_variables := TyVarMap.add name (v, loc) !used_variables
+
+
+ type flavor = Unification | Universal
+ type extensibility = Extensible | Fixed
+ type policy = { flavor : flavor; extensibility : extensibility }
+
+ let fixed_policy = { flavor = Unification; extensibility = Fixed }
+ let extensible_policy = { flavor = Unification; extensibility = Extensible }
+ let univars_policy = { flavor = Universal; extensibility = Extensible }
+
+ let add_pre_univar tv = function
+ | { flavor = Universal } ->
+ assert (not_generic tv);
+ pre_univars := tv :: !pre_univars
+ | _ -> ()
+
+ let collect_univars f =
+ pre_univars := [];
+ let result = f () in
+ let univs = promote_generics_to_univars [] !pre_univars in
+ result, univs
+
+ let new_var ?name policy =
+ let tv = Ctype.newvar ?name () in
+ add_pre_univar tv policy;
+ tv
+
+ let new_any_var loc env = function
+ | { extensibility = Fixed } -> raise(Error(loc, env, No_type_wildcards))
+ | policy -> new_var policy
+
+ let globalize_used_variables { flavor; extensibility } env =
+ let r = ref [] in
+ TyVarMap.iter
+ (fun name (ty, loc) ->
+ if flavor = Unification || is_in_scope name then
+ let v = new_global_var () in
+ let snap = Btype.snapshot () in
+ if try unify env v ty; true with _ -> Btype.backtrack snap; false
+ then try
+ r := (loc, v, lookup_global_type_variable name) :: !r
+ with Not_found ->
+ if extensibility = Fixed && Btype.is_Tvar ty then
+ raise(Error(loc, env,
+ Unbound_type_variable (Pprintast.tyvar_of_name name,
+ get_in_scope_names ())));
+ let v2 = new_global_var () in
+ r := (loc, v, v2) :: !r;
+ add name v2)
+ !used_variables;
+ used_variables := TyVarMap.empty;
+ fun () ->
+ List.iter
+ (function (loc, t1, t2) ->
+ try unify env t1 t2 with Unify err ->
+ raise (Error(loc, env, Type_mismatch err)))
+ !r
+end
+
+(* Support for first-class modules. *)
+
+let transl_modtype_longident = ref (fun _ -> assert false)
+let transl_modtype = ref (fun _ -> assert false)
+let check_package_with_type_constraints = ref (fun _ -> assert false)
+
+let sort_constraints_no_duplicates loc env l =
+ List.sort
+ (fun (s1, _t1) (s2, _t2) ->
+ if s1.txt = s2.txt then
+ raise (Error (loc, env, Multiple_constraints_on_type s1.txt));
+ compare s1.txt s2.txt)
+ l
+
+(* Translation of type expressions *)
+
+let strict_ident c = (c = '_' || c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z')
+
+let validate_name = function
+ None -> None
+ | Some name as s ->
+ if name <> "" && strict_ident name.[0] then s else None
+
+let new_global_var ?name () =
+ new_global_var ?name:(validate_name name) ()
+let newvar ?name () =
+ newvar ?name:(validate_name name) ()
+
+let valid_tyvar_name name =
+ name <> "" && name.[0] <> '_'
+
+let transl_type_param env styp =
+ let loc = styp.ptyp_loc in
+ match styp.ptyp_desc with
+ Ptyp_any ->
+ let ty = new_global_var ~name:"_" () in
+ { ctyp_desc = Ttyp_any; ctyp_type = ty; ctyp_env = env;
+ ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
+ | Ptyp_var name ->
+ let ty =
+ if not (valid_tyvar_name name) then
+ raise (Error (loc, Env.empty, Invalid_variable_name ("'" ^ name)));
+ if TyVarEnv.is_in_scope name then
+ raise Already_bound;
+ let v = new_global_var ~name () in
+ TyVarEnv.add name v;
+ v
+ in
+ { ctyp_desc = Ttyp_var name; ctyp_type = ty; ctyp_env = env;
+ ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
+ | _ -> assert false
+
+let transl_type_param env styp =
+ (* Currently useless, since type parameters cannot hold attributes
+ (but this could easily be lifted in the future). *)
+ Builtin_attributes.warning_scope styp.ptyp_attributes
+ (fun () -> transl_type_param env styp)
+
+(* Forward declaration (set in Typemod.type_open) *)
+
+let type_open :
+ (?used_slot:bool ref -> override_flag -> Env.t -> Location.t ->
+ Longident.t loc -> Path.t * Env.t)
+ ref =
+ ref (fun ?used_slot:_ _ -> assert false)
+
+let rec transl_type env ~policy ?(aliased=false) ~row_context styp =
+ Builtin_attributes.warning_scope styp.ptyp_attributes
+ (fun () -> transl_type_aux env ~policy ~aliased ~row_context styp)
+
+and transl_type_aux env ~row_context ~aliased ~policy styp =
+ let loc = styp.ptyp_loc in
+ let ctyp ctyp_desc ctyp_type =
+ { ctyp_desc; ctyp_type; ctyp_env = env;
+ ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes }
+ in
+ match styp.ptyp_desc with
+ Ptyp_any ->
+ let ty = TyVarEnv.new_any_var styp.ptyp_loc env policy in
+ ctyp Ttyp_any ty
+ | Ptyp_var name ->
+ let ty =
+ if not (valid_tyvar_name name) then
+ raise (Error (styp.ptyp_loc, env, Invalid_variable_name ("'" ^ name)));
+ begin try
+ TyVarEnv.lookup_local ~row_context:row_context name
+ with Not_found ->
+ let v = TyVarEnv.new_var ~name policy in
+ TyVarEnv.remember_used name v styp.ptyp_loc;
+ v
+ end
+ in
+ ctyp (Ttyp_var name) ty
+ | Ptyp_arrow(l, st1, st2) ->
+ let cty1 = transl_type env ~policy ~row_context st1 in
+ let cty2 = transl_type env ~policy ~row_context st2 in
+ let ty1 = cty1.ctyp_type in
+ let ty1 =
+ if Btype.is_optional l
+ then newty (Tconstr(Predef.path_option,[ty1], ref Mnil))
+ else ty1 in
+ let ty = newty (Tarrow(l, ty1, cty2.ctyp_type, commu_ok)) in
+ ctyp (Ttyp_arrow (l, cty1, cty2)) ty
+ | Ptyp_tuple stl ->
+ assert (List.length stl >= 2);
+ let ctys = List.map (transl_type env ~policy ~row_context) stl in
+ let ty = newty (Ttuple (List.map (fun ctyp -> ctyp.ctyp_type) ctys)) in
+ ctyp (Ttyp_tuple ctys) ty
+ | Ptyp_constr(lid, stl) ->
+ let (path, decl) = Env.lookup_type ~loc:lid.loc lid.txt env in
+ let stl =
+ match stl with
+ | [ {ptyp_desc=Ptyp_any} as t ] when decl.type_arity > 1 ->
+ List.map (fun _ -> t) decl.type_params
+ | _ -> stl
+ in
+ if List.length stl <> decl.type_arity then
+ raise(Error(styp.ptyp_loc, env,
+ Type_arity_mismatch(lid.txt, decl.type_arity,
+ List.length stl)));
+ let args = List.map (transl_type env ~policy ~row_context) stl in
+ let params = instance_list decl.type_params in
+ let unify_param =
+ match decl.type_manifest with
+ None -> unify_var
+ | Some ty ->
+ if get_level ty = Btype.generic_level then unify_var else unify
+ in
+ List.iter2
+ (fun (sty, cty) ty' ->
+ try unify_param env ty' cty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise (Error(sty.ptyp_loc, env, Type_mismatch err))
+ )
+ (List.combine stl args) params;
+ let constr =
+ newconstr path (List.map (fun ctyp -> ctyp.ctyp_type) args) in
+ ctyp (Ttyp_constr (path, lid, args)) constr
+ | Ptyp_object (fields, o) ->
+ let ty, fields = transl_fields env ~policy ~row_context o fields in
+ ctyp (Ttyp_object (fields, o)) (newobj ty)
+ | Ptyp_class(lid, stl) ->
+ let (path, decl) =
+ let path, decl = Env.lookup_cltype ~loc:lid.loc lid.txt env in
+ (path, decl.clty_hash_type)
+ in
+ if List.length stl <> decl.type_arity then
+ raise(Error(styp.ptyp_loc, env,
+ Type_arity_mismatch(lid.txt, decl.type_arity,
+ List.length stl)));
+ let args = List.map (transl_type env ~policy ~row_context) stl in
+ let body = Option.get decl.type_manifest in
+ let (params, body) = instance_parameterized_type decl.type_params body in
+ List.iter2
+ (fun (sty, cty) ty' ->
+ try unify_var env ty' cty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise (Error(sty.ptyp_loc, env, Type_mismatch err))
+ )
+ (List.combine stl args) params;
+ let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
+ let ty = Ctype.apply ~use_current_level:true env params body ty_args in
+ let ty = match get_desc ty with
+ | Tobject (fi, _) ->
+ let _, tv = flatten_fields fi in
+ TyVarEnv.add_pre_univar tv policy;
+ ty
+ | _ ->
+ assert false
+ in
+ ctyp (Ttyp_class (path, lid, args)) ty
+ | Ptyp_alias(st, alias) ->
+ let cty =
+ try
+ let t = TyVarEnv.lookup_local ~row_context alias.txt in
+ let ty = transl_type env ~policy ~aliased:true ~row_context st in
+ begin try unify_var env t ty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise(Error(alias.loc, env, Alias_type_mismatch err))
+ end;
+ ty
+ with Not_found ->
+ let t, ty =
+ with_local_level_generalize_structure_if_principal begin fun () ->
+ let t = newvar () in
+ (* Use the whole location, which is used by [Type_mismatch]. *)
+ TyVarEnv.remember_used alias.txt t styp.ptyp_loc;
+ let ty = transl_type env ~policy ~row_context st in
+ begin try unify_var env t ty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise(Error(alias.loc, env, Alias_type_mismatch err))
+ end;
+ (t, ty)
+ end
+ in
+ let t = instance t in
+ let px = Btype.proxy t in
+ begin match get_desc px with
+ | Tvar None -> set_type_desc px (Tvar (Some alias.txt))
+ | Tunivar None -> set_type_desc px (Tunivar (Some alias.txt))
+ | _ -> ()
+ end;
+ { ty with ctyp_type = t }
+ in
+ ctyp (Ttyp_alias (cty, alias)) cty.ctyp_type
+ | Ptyp_variant(fields, closed, present) ->
+ let name = ref None in
+ let mkfield l f =
+ newty (Tvariant (create_row ~fields:[l,f] ~more:(newvar())
+ ~closed:true ~fixed:None ~name:None)) in
+ let hfields = Hashtbl.create 17 in
+ let add_typed_field loc l f =
+ let h = Btype.hash_variant l in
+ try
+ let (l',f') = Hashtbl.find hfields h in
+ (* Check for tag conflicts *)
+ if l <> l' then raise(Error(styp.ptyp_loc, env, Variant_tags(l, l')));
+ let ty = mkfield l f and ty' = mkfield l f' in
+ if is_equal env false [ty] [ty'] then () else
+ try unify env ty ty'
+ with Unify _trace ->
+ raise(Error(loc, env, Constructor_mismatch (ty,ty')))
+ with Not_found ->
+ Hashtbl.add hfields h (l,f)
+ in
+ let add_field row_context field =
+ let rf_loc = field.prf_loc in
+ let rf_attributes = field.prf_attributes in
+ let rf_desc = match field.prf_desc with
+ | Rtag (l, c, stl) ->
+ name := None;
+ let tl =
+ Builtin_attributes.warning_scope rf_attributes
+ (fun () -> List.map (transl_type env ~policy ~row_context) stl)
+ in
+ let f = match present with
+ Some present when not (List.mem l.txt present) ->
+ let ty_tl = List.map (fun cty -> cty.ctyp_type) tl in
+ rf_either ty_tl ~no_arg:c ~matched:false
+ | _ ->
+ if List.length stl > 1 || c && stl <> [] then
+ raise(Error(styp.ptyp_loc, env,
+ Present_has_conjunction l.txt));
+ match tl with [] -> rf_present None
+ | st :: _ -> rf_present (Some st.ctyp_type)
+ in
+ add_typed_field styp.ptyp_loc l.txt f;
+ Ttag (l,c,tl)
+ | Rinherit sty ->
+ let cty = transl_type env ~policy ~row_context sty in
+ let ty = cty.ctyp_type in
+ let nm =
+ match get_desc cty.ctyp_type with
+ Tconstr(p, tl, _) -> Some(p, tl)
+ | _ -> None
+ in
+ name := if Hashtbl.length hfields <> 0 then None else nm;
+ let fl = match get_desc (expand_head env cty.ctyp_type), nm with
+ Tvariant row, _ when Btype.static_row row ->
+ row_fields row
+ | Tvar _, Some(p, _) ->
+ raise(Error(sty.ptyp_loc, env, Undefined_type_constructor p))
+ | _ ->
+ raise(Error(sty.ptyp_loc, env, Not_a_variant ty))
+ in
+ List.iter
+ (fun (l, f) ->
+ let f = match present with
+ Some present when not (List.mem l present) ->
+ begin match row_field_repr f with
+ Rpresent oty -> rf_either_of oty
+ | _ -> assert false
+ end
+ | _ -> f
+ in
+ add_typed_field sty.ptyp_loc l f)
+ fl;
+ Tinherit cty
+ in
+ { rf_desc; rf_loc; rf_attributes; }
+ in
+ let more_slot = ref None in
+ let row_context =
+ if aliased then row_context else more_slot :: row_context
+ in
+ let tfields = List.map (add_field row_context) fields in
+ let fields = List.rev (Hashtbl.fold (fun _ p l -> p :: l) hfields []) in
+ begin match present with None -> ()
+ | Some present ->
+ List.iter
+ (fun l -> if not (List.mem_assoc l fields) then
+ raise(Error(styp.ptyp_loc, env, Present_has_no_type l)))
+ present
+ end;
+ let name = !name in
+ let make_row more =
+ create_row ~fields ~more ~closed:(closed = Closed) ~fixed:None ~name
+ in
+ let more =
+ if Btype.static_row (make_row (newvar ())) then newty Tnil else
+ TyVarEnv.new_var policy
+ in
+ more_slot := Some more;
+ let ty = newty (Tvariant (make_row more)) in
+ ctyp (Ttyp_variant (tfields, closed, present)) ty
+ | Ptyp_poly(vars, st) ->
+ let vars = List.map (fun v -> v.txt) vars in
+ let new_univars, cty =
+ with_local_level_generalize begin fun () ->
+ let new_univars = TyVarEnv.make_poly_univars vars in
+ let cty = TyVarEnv.with_univars new_univars begin fun () ->
+ transl_type env ~policy ~row_context st
+ end in
+ (new_univars, cty)
+ end
+ in
+ let ty = cty.ctyp_type in
+ let ty_list = TyVarEnv.check_poly_univars env styp.ptyp_loc new_univars in
+ let ty_list = List.filter (fun v -> deep_occur v ty) ty_list in
+ let ty' = Btype.newgenty (Tpoly(ty, ty_list)) in
+ unify_var env (newvar()) ty';
+ ctyp (Ttyp_poly (vars, cty)) ty'
+ | Ptyp_package (p, l) ->
+ let loc = styp.ptyp_loc in
+ let l = sort_constraints_no_duplicates loc env l in
+ let mty = Ast_helper.Mty.mk ~loc (Pmty_ident p) in
+ let mty = TyVarEnv.with_local_scope (fun () -> !transl_modtype env mty) in
+ let ptys =
+ List.map (fun (s, pty) -> s, transl_type env ~policy ~row_context pty) l
+ in
+ let mty =
+ if ptys <> [] then
+ !check_package_with_type_constraints loc env mty.mty_type ptys
+ else mty.mty_type
+ in
+ let path = !transl_modtype_longident loc env p.txt in
+ let ty = newty (Tpackage (path,
+ List.map (fun (s, cty) -> (s.txt, cty.ctyp_type)) ptys))
+ in
+ ctyp (Ttyp_package {
+ pack_path = path;
+ pack_type = mty;
+ pack_fields = ptys;
+ pack_txt = p;
+ }) ty
+ | Ptyp_open (mod_ident, t) ->
+ let path, new_env =
+ !type_open Asttypes.Fresh env loc mod_ident
+ in
+ let cty = transl_type new_env ~policy ~row_context t in
+ ctyp (Ttyp_open (path, mod_ident, cty)) cty.ctyp_type
+ | Ptyp_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and transl_fields env ~policy ~row_context o fields =
+ let hfields = Hashtbl.create 17 in
+ let add_typed_field loc l ty =
+ try
+ let ty' = Hashtbl.find hfields l in
+ if is_equal env false [ty] [ty'] then () else
+ try unify env ty ty'
+ with Unify _trace ->
+ raise(Error(loc, env, Method_mismatch (l, ty, ty')))
+ with Not_found ->
+ Hashtbl.add hfields l ty in
+ let add_field {pof_desc; pof_loc; pof_attributes;} =
+ let of_loc = pof_loc in
+ let of_attributes = pof_attributes in
+ let of_desc = match pof_desc with
+ | Otag (s, ty1) -> begin
+ let ty1 =
+ Builtin_attributes.warning_scope of_attributes
+ (fun () -> transl_type env ~policy ~row_context
+ (Ast_helper.Typ.force_poly ty1))
+ in
+ let field = OTtag (s, ty1) in
+ add_typed_field ty1.ctyp_loc s.txt ty1.ctyp_type;
+ field
+ end
+ | Oinherit sty -> begin
+ let cty = transl_type env ~policy ~row_context sty in
+ let nm =
+ match get_desc cty.ctyp_type with
+ Tconstr(p, _, _) -> Some p
+ | _ -> None in
+ let t = expand_head env cty.ctyp_type in
+ match get_desc t, nm with
+ Tobject (tf, _), _
+ when (match get_desc tf with Tfield _ | Tnil -> true | _ -> false) ->
+ begin
+ if opened_object t then
+ raise (Error (sty.ptyp_loc, env, Opened_object nm));
+ let rec iter_add ty =
+ match get_desc ty with
+ | Tfield (s, _k, ty1, ty2) ->
+ add_typed_field sty.ptyp_loc s ty1;
+ iter_add ty2
+ | Tnil -> ()
+ | _ -> assert false
+ in
+ iter_add tf;
+ OTinherit cty
+ end
+ | Tvar _, Some p ->
+ raise (Error (sty.ptyp_loc, env, Undefined_type_constructor p))
+ | _ -> raise (Error (sty.ptyp_loc, env, Not_an_object t))
+ end in
+ { of_desc; of_loc; of_attributes; }
+ in
+ let object_fields = List.map add_field fields in
+ let fields = Hashtbl.fold (fun s ty l -> (s, ty) :: l) hfields [] in
+ let ty_init =
+ match o with
+ | Closed -> newty Tnil
+ | Open -> TyVarEnv.new_var policy
+ in
+ let ty = List.fold_left (fun ty (s, ty') ->
+ newty (Tfield (s, field_public, ty', ty))) ty_init fields in
+ ty, object_fields
+
+
+(* Make the rows "fixed" in this type, to make universal check easier *)
+let rec make_fixed_univars mark ty =
+ if try_mark_node mark ty then
+ begin match get_desc ty with
+ | Tvariant row ->
+ let Row {fields; more; name; closed} = row_repr row in
+ if Btype.is_Tunivar more then
+ let fields =
+ List.map
+ (fun (s,f as p) -> match row_field_repr f with
+ Reither (no_arg, tl, _m) ->
+ s, rf_either tl ~use_ext_of:f ~no_arg ~matched:true
+ | _ -> p)
+ fields
+ in
+ set_type_desc ty
+ (Tvariant
+ (create_row ~fields ~more ~name ~closed
+ ~fixed:(Some (Univar more))));
+ Btype.iter_row (make_fixed_univars mark) row
+ | _ ->
+ Btype.iter_type_expr (make_fixed_univars mark) ty
+ end
+
+let make_fixed_univars ty =
+ with_type_mark (fun mark -> make_fixed_univars mark ty)
+
+let transl_type env policy styp =
+ transl_type env ~policy ~row_context:[] styp
+
+let transl_simple_type env ?univars ~closed styp =
+ TyVarEnv.reset_locals ?univars ();
+ let policy = TyVarEnv.(if closed then fixed_policy else extensible_policy) in
+ let typ = transl_type env policy styp in
+ TyVarEnv.globalize_used_variables policy env ();
+ make_fixed_univars typ.ctyp_type;
+ typ
+
+let transl_simple_type_univars env styp =
+ TyVarEnv.reset_locals ();
+ let typ, univs =
+ TyVarEnv.collect_univars begin fun () ->
+ with_local_level_generalize begin fun () ->
+ let policy = TyVarEnv.univars_policy in
+ let typ = transl_type env policy styp in
+ TyVarEnv.globalize_used_variables policy env ();
+ typ
+ end
+ end in
+ make_fixed_univars typ.ctyp_type;
+ { typ with ctyp_type =
+ instance (Btype.newgenty (Tpoly (typ.ctyp_type, univs))) }
+
+let transl_simple_type_delayed env styp =
+ TyVarEnv.reset_locals ();
+ let typ, force =
+ with_local_level_generalize begin fun () ->
+ let policy = TyVarEnv.extensible_policy in
+ let typ = transl_type env policy styp in
+ make_fixed_univars typ.ctyp_type;
+ (* This brings the used variables to the global level, but doesn't link
+ them to their other occurrences just yet. This will be done when
+ [force] is called. *)
+ let force = TyVarEnv.globalize_used_variables policy env in
+ (typ, force)
+ end
+ in
+ (typ, instance typ.ctyp_type, force)
+
+let transl_type_scheme env styp =
+ match styp.ptyp_desc with
+ | Ptyp_poly (vars, st) ->
+ let vars = List.map (fun v -> v.txt) vars in
+ let univars, typ =
+ with_local_level_generalize begin fun () ->
+ TyVarEnv.reset ();
+ let univars = TyVarEnv.make_poly_univars vars in
+ let typ = transl_simple_type env ~univars ~closed:true st in
+ (univars, typ)
+ end
+ in
+ let _ = TyVarEnv.instance_poly_univars env styp.ptyp_loc univars in
+ { ctyp_desc = Ttyp_poly (vars, typ);
+ ctyp_type = typ.ctyp_type;
+ ctyp_env = env;
+ ctyp_loc = styp.ptyp_loc;
+ ctyp_attributes = styp.ptyp_attributes }
+ | _ ->
+ with_local_level_generalize
+ (fun () -> TyVarEnv.reset (); transl_simple_type env ~closed:false styp)
+
+
+(* Error report *)
+
+open Format_doc
+open Printtyp.Doc
+module Style = Misc.Style
+let pp_tag ppf t = fprintf ppf "`%s" t
+let pp_out_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
+let pp_type ppf ty = Style.as_inline_code Printtyp.Doc.type_expr ppf ty
+
+let report_error_doc env ppf = function
+ | Unbound_type_variable (name, in_scope_names) ->
+ fprintf ppf "The type variable %a is unbound in this type declaration.@ %a"
+ Style.inline_code name
+ did_you_mean (fun () -> Misc.spellcheck in_scope_names name )
+ | No_type_wildcards ->
+ fprintf ppf "A type wildcard %a is not allowed in this type declaration."
+ Style.inline_code "_"
+ | Undefined_type_constructor p ->
+ fprintf ppf "The type constructor@ %a@ is not yet completely defined"
+ (Style.as_inline_code path) p
+ | Type_arity_mismatch(lid, expected, provided) ->
+ fprintf ppf
+ "@[The type constructor %a@ expects %i argument(s),@ \
+ but is here applied to %i argument(s)@]"
+ (Style.as_inline_code longident) lid expected provided
+ | Bound_type_variable name ->
+ fprintf ppf "Already bound type parameter %a"
+ (Style.as_inline_code Pprintast.Doc.tyvar) name
+ | Recursive_type ->
+ fprintf ppf "This type is recursive"
+ | Type_mismatch trace ->
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf Env.empty trace
+ (msg "This type")
+ (msg "should be an instance of type")
+ | Alias_type_mismatch trace ->
+ let msg = Format_doc.Doc.msg in
+ Errortrace_report.unification ppf Env.empty trace
+ (msg "This alias is bound to type")
+ (msg "but is used as an instance of type")
+ | Present_has_conjunction l ->
+ fprintf ppf "The present constructor %a has a conjunctive type"
+ Style.inline_code l
+ | Present_has_no_type l ->
+ fprintf ppf
+ "@[<v>@[The constructor %a is missing from the upper bound@ \
+ (between %a@ and %a)@ of this polymorphic variant@ \
+ but is present in@ its lower bound (after %a).@]@,\
+ @[@{<hint>Hint@}: Either add %a in the upper bound,@ \
+ or remove it@ from the lower bound.@]@]"
+ (Style.as_inline_code pp_tag) l
+ Style.inline_code "<"
+ Style.inline_code ">"
+ Style.inline_code ">"
+ (Style.as_inline_code pp_tag) l
+ | Constructor_mismatch (ty, ty') ->
+ wrap_printing_env ~error:true env (fun () ->
+ Out_type.prepare_for_printing [ty; ty'];
+ fprintf ppf "@[<hov>%s %a@ %s@ %a@]"
+ "This variant type contains a constructor"
+ pp_out_type (Out_type.tree_of_typexp Type ty)
+ "which should be"
+ pp_out_type (Out_type.tree_of_typexp Type ty'))
+ | Not_a_variant ty ->
+ fprintf ppf
+ "@[The type %a@ does not expand to a polymorphic variant type@]"
+ pp_type ty;
+ begin match get_desc ty with
+ | Tvar (Some s) ->
+ (* PR#7012: help the user that wrote 'Foo instead of `Foo *)
+ Misc.did_you_mean ppf (fun () -> ["`" ^ s])
+ | _ -> ()
+ end
+ | Variant_tags (lab1, lab2) ->
+ fprintf ppf
+ "@[Variant tags %a@ and %a have the same hash value.@ %s@]"
+ (Style.as_inline_code pp_tag) lab1
+ (Style.as_inline_code pp_tag) lab2
+ "Change one of them."
+ | Invalid_variable_name name ->
+ fprintf ppf "The type variable name %a is not allowed in programs"
+ Style.inline_code name
+ | Cannot_quantify (name, v) ->
+ fprintf ppf
+ "@[<hov>The universal type variable %a cannot be generalized:@ "
+ (Style.as_inline_code Pprintast.Doc.tyvar) name;
+ if Btype.is_Tvar v then
+ fprintf ppf "it escapes its scope"
+ else if Btype.is_Tunivar v then
+ fprintf ppf "it is already bound to another variable"
+ else
+ fprintf ppf "it is bound to@ %a" pp_type v;
+ fprintf ppf ".@]";
+ | Multiple_constraints_on_type s ->
+ fprintf ppf "Multiple constraints for type %a"
+ (Style.as_inline_code longident) s
+ | Method_mismatch (l, ty, ty') ->
+ wrap_printing_env ~error:true env (fun () ->
+ fprintf ppf "@[<hov>Method %a has type %a,@ which should be %a@]"
+ Style.inline_code l
+ pp_type ty
+ pp_type ty')
+ | Opened_object nm ->
+ fprintf ppf
+ "Illegal open object type%a"
+ (fun ppf -> function
+ Some p -> fprintf ppf "@ %a" (Style.as_inline_code path) p
+ | None -> fprintf ppf "") nm
+ | Not_an_object ty ->
+ fprintf ppf "@[The type %a@ is not an object type@]"
+ pp_type ty
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc, env, err) ->
+ Some (Location.error_of_printer ~loc (report_error_doc env) err)
+ | Error_forward err ->
+ Some err
+ | _ ->
+ None
+ )
+
+let report_error = Format_doc.compat1 report_error_doc
diff --git a/upstream/ocaml_503/typing/typetexp.mli b/upstream/ocaml_503/typing/typetexp.mli
new file mode 100644
index 0000000000..bd03489f32
--- /dev/null
+++ b/upstream/ocaml_503/typing/typetexp.mli
@@ -0,0 +1,109 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Typechecking of type expressions for the core language *)
+
+open Types
+
+module TyVarEnv : sig
+ (* this is just the subset of [TyVarEnv] that is needed outside
+ of [Typetexp]. See the ml file for more. *)
+
+ val reset : unit -> unit
+ (** removes all type variables from scope *)
+
+ val with_local_scope : (unit -> 'a) -> 'a
+ (** Evaluate in a narrowed type-variable scope *)
+
+ type poly_univars
+ val make_poly_univars : string list -> poly_univars
+ (** remember that a list of strings connotes univars; this must
+ always be paired with a [check_poly_univars]. *)
+
+ val check_poly_univars :
+ Env.t -> Location.t -> poly_univars -> type_expr list
+ (** Verify that the given univars are universally quantified,
+ and return the list of variables. The type in which the
+ univars are used must be generalised *)
+
+ val instance_poly_univars :
+ Env.t -> Location.t -> poly_univars -> type_expr list
+ (** Same as [check_poly_univars], but instantiates the resulting
+ type scheme (i.e. variables become Tvar rather than Tunivar) *)
+
+end
+
+(* Forward declaration, to be filled in by Typemod.type_open *)
+val type_open:
+ (?used_slot:bool ref -> Asttypes.override_flag -> Env.t -> Location.t ->
+ Longident.t Asttypes.loc -> Path.t * Env.t)
+ ref
+
+val valid_tyvar_name : string -> bool
+
+val transl_simple_type:
+ Env.t -> ?univars:TyVarEnv.poly_univars -> closed:bool
+ -> Parsetree.core_type -> Typedtree.core_type
+val transl_simple_type_univars:
+ Env.t -> Parsetree.core_type -> Typedtree.core_type
+val transl_simple_type_delayed
+ : Env.t
+ -> Parsetree.core_type
+ -> Typedtree.core_type * type_expr * (unit -> unit)
+ (* Translate a type, but leave type variables unbound. Returns
+ the type, an instance of the corresponding type_expr, and a
+ function that binds the type variable. *)
+val transl_type_scheme:
+ Env.t -> Parsetree.core_type -> Typedtree.core_type
+val transl_type_param:
+ Env.t -> Parsetree.core_type -> Typedtree.core_type
+
+exception Already_bound
+
+type error =
+ | Unbound_type_variable of string * string list
+ | No_type_wildcards
+ | Undefined_type_constructor of Path.t
+ | Type_arity_mismatch of Longident.t * int * int
+ | Bound_type_variable of string
+ | Recursive_type
+ | Type_mismatch of Errortrace.unification_error
+ | Alias_type_mismatch of Errortrace.unification_error
+ | Present_has_conjunction of string
+ | Present_has_no_type of string
+ | Constructor_mismatch of type_expr * type_expr
+ | Not_a_variant of type_expr
+ | Variant_tags of string * string
+ | Invalid_variable_name of string
+ | Cannot_quantify of string * type_expr
+ | Multiple_constraints_on_type of Longident.t
+ | Method_mismatch of string * type_expr * type_expr
+ | Opened_object of Path.t option
+ | Not_an_object of type_expr
+
+exception Error of Location.t * Env.t * error
+
+val report_error: Env.t -> error Format_doc.format_printer
+val report_error_doc: Env.t -> error Format_doc.printer
+
+(* Support for first-class modules. *)
+val transl_modtype_longident: (* from Typemod *)
+ (Location.t -> Env.t -> Longident.t -> Path.t) ref
+val transl_modtype: (* from Typemod *)
+ (Env.t -> Parsetree.module_type -> Typedtree.module_type) ref
+val check_package_with_type_constraints: (* from Typemod *)
+ (Location.t -> Env.t -> Types.module_type ->
+ (Longident.t Asttypes.loc * Typedtree.core_type) list ->
+ Types.module_type) ref
diff --git a/upstream/ocaml_503/typing/untypeast.ml b/upstream/ocaml_503/typing/untypeast.ml
new file mode 100644
index 0000000000..07e4e86437
--- /dev/null
+++ b/upstream/ocaml_503/typing/untypeast.ml
@@ -0,0 +1,965 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay) *)
+(* *)
+(* Copyright 2007 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. *)
+(* *)
+(**************************************************************************)
+
+[@@@ocaml.warning "-60"] module Str = Ast_helper.Str (* For ocamldep *)
+[@@@ocaml.warning "+60"]
+
+open Asttypes
+open Parsetree
+open Ast_helper
+
+module T = Typedtree
+
+type mapper = {
+ attribute: mapper -> T.attribute -> attribute;
+ attributes: mapper -> T.attribute list -> attribute list;
+ binding_op: mapper -> T.binding_op -> T.pattern -> binding_op;
+ case: 'k . mapper -> 'k T.case -> case;
+ class_declaration: mapper -> T.class_declaration -> class_declaration;
+ class_description: mapper -> T.class_description -> class_description;
+ class_expr: mapper -> T.class_expr -> class_expr;
+ class_field: mapper -> T.class_field -> class_field;
+ class_signature: mapper -> T.class_signature -> class_signature;
+ class_structure: mapper -> T.class_structure -> class_structure;
+ class_type: mapper -> T.class_type -> class_type;
+ class_type_declaration: mapper -> T.class_type_declaration
+ -> class_type_declaration;
+ class_type_field: mapper -> T.class_type_field -> class_type_field;
+ constructor_declaration: mapper -> T.constructor_declaration
+ -> constructor_declaration;
+ expr: mapper -> T.expression -> expression;
+ extension_constructor: mapper -> T.extension_constructor
+ -> extension_constructor;
+ include_declaration: mapper -> T.include_declaration -> include_declaration;
+ include_description: mapper -> T.include_description -> include_description;
+ label_declaration: mapper -> T.label_declaration -> label_declaration;
+ location: mapper -> Location.t -> Location.t;
+ module_binding: mapper -> T.module_binding -> module_binding;
+ module_declaration: mapper -> T.module_declaration -> module_declaration;
+ module_substitution: mapper -> T.module_substitution -> module_substitution;
+ module_expr: mapper -> T.module_expr -> module_expr;
+ module_type: mapper -> T.module_type -> module_type;
+ module_type_declaration:
+ mapper -> T.module_type_declaration -> module_type_declaration;
+ package_type: mapper -> T.package_type -> package_type;
+ open_declaration: mapper -> T.open_declaration -> open_declaration;
+ open_description: mapper -> T.open_description -> open_description;
+ pat: 'k . mapper -> 'k T.general_pattern -> pattern;
+ row_field: mapper -> T.row_field -> row_field;
+ object_field: mapper -> T.object_field -> object_field;
+ signature: mapper -> T.signature -> signature;
+ signature_item: mapper -> T.signature_item -> signature_item;
+ structure: mapper -> T.structure -> structure;
+ structure_item: mapper -> T.structure_item -> structure_item;
+ typ: mapper -> T.core_type -> core_type;
+ type_declaration: mapper -> T.type_declaration -> type_declaration;
+ type_extension: mapper -> T.type_extension -> type_extension;
+ type_exception: mapper -> T.type_exception -> type_exception;
+ type_kind: mapper -> T.type_kind -> type_kind;
+ value_binding: mapper -> T.value_binding -> value_binding;
+ value_description: mapper -> T.value_description -> value_description;
+ with_constraint:
+ mapper -> (Path.t * Longident.t Location.loc * T.with_constraint)
+ -> with_constraint;
+}
+
+open T
+
+(*
+Some notes:
+
+ * For Pexp_apply, it is unclear whether arguments are reordered, especially
+ when there are optional arguments.
+
+*)
+
+
+(** Utility functions. *)
+
+let string_is_prefix sub str =
+ let sublen = String.length sub in
+ String.length str >= sublen && String.sub str 0 sublen = sub
+
+let rec lident_of_path = function
+ | Path.Pident id -> Longident.Lident (Ident.name id)
+ | Path.Papply (p1, p2) ->
+ Longident.Lapply (lident_of_path p1, lident_of_path p2)
+ | Path.Pdot (p, s) | Path.Pextra_ty (p, Pcstr_ty s) ->
+ Longident.Ldot (lident_of_path p, s)
+ | Path.Pextra_ty (p, _) -> lident_of_path p
+
+let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
+
+(** Extract the [n] patterns from the case of a letop *)
+let rec extract_letop_patterns n pat =
+ if n = 0 then pat, []
+ else begin
+ match pat.pat_desc with
+ | Tpat_tuple([first; rest]) ->
+ let next, others = extract_letop_patterns (n-1) rest in
+ first, next :: others
+ | _ ->
+ let rec anys n =
+ if n = 0 then []
+ else { pat with pat_desc = Tpat_any } :: anys (n-1)
+ in
+ { pat with pat_desc = Tpat_any }, anys (n-1)
+ end
+
+(** Mapping functions. *)
+
+let constant = function
+ | Const_char c -> Const.char c
+ | Const_string (s,loc,d) -> Const.string ?quotation_delimiter:d ~loc s
+ | Const_int i -> Const.integer (Int.to_string i)
+ | Const_int32 i -> Const.integer ~suffix:'l' (Int32.to_string i)
+ | Const_int64 i -> Const.integer ~suffix:'L' (Int64.to_string i)
+ | Const_nativeint i -> Const.integer ~suffix:'n' (Nativeint.to_string i)
+ | Const_float f -> Const.float f
+
+let attribute sub a = {
+ attr_name = map_loc sub a.attr_name;
+ attr_payload = a.attr_payload;
+ attr_loc = a.attr_loc
+ }
+
+let attributes sub l = List.map (sub.attribute sub) l
+
+let structure sub str =
+ List.map (sub.structure_item sub) str.str_items
+
+let open_description sub od =
+ let loc = sub.location sub od.open_loc in
+ let attrs = sub.attributes sub od.open_attributes in
+ Opn.mk ~loc ~attrs
+ ~override:od.open_override
+ (snd od.open_expr)
+
+let open_declaration sub od =
+ let loc = sub.location sub od.open_loc in
+ let attrs = sub.attributes sub od.open_attributes in
+ Opn.mk ~loc ~attrs
+ ~override:od.open_override
+ (sub.module_expr sub od.open_expr)
+
+let structure_item sub item =
+ let loc = sub.location sub item.str_loc in
+ let desc =
+ match item.str_desc with
+ Tstr_eval (exp, attrs) -> Pstr_eval (sub.expr sub exp, attrs)
+ | Tstr_value (rec_flag, list) ->
+ Pstr_value (rec_flag, List.map (sub.value_binding sub) list)
+ | Tstr_primitive vd ->
+ Pstr_primitive (sub.value_description sub vd)
+ | Tstr_type (rec_flag, list) ->
+ Pstr_type (rec_flag, List.map (sub.type_declaration sub) list)
+ | Tstr_typext tyext ->
+ Pstr_typext (sub.type_extension sub tyext)
+ | Tstr_exception ext ->
+ Pstr_exception (sub.type_exception sub ext)
+ | Tstr_module mb ->
+ Pstr_module (sub.module_binding sub mb)
+ | Tstr_recmodule list ->
+ Pstr_recmodule (List.map (sub.module_binding sub) list)
+ | Tstr_modtype mtd ->
+ Pstr_modtype (sub.module_type_declaration sub mtd)
+ | Tstr_open od ->
+ Pstr_open (sub.open_declaration sub od)
+ | Tstr_class list ->
+ Pstr_class
+ (List.map
+ (fun (ci, _) -> sub.class_declaration sub ci)
+ list)
+ | Tstr_class_type list ->
+ Pstr_class_type
+ (List.map
+ (fun (_id, _name, ct) -> sub.class_type_declaration sub ct)
+ list)
+ | Tstr_include incl ->
+ Pstr_include (sub.include_declaration sub incl)
+ | Tstr_attribute x ->
+ Pstr_attribute x
+ in
+ Str.mk ~loc desc
+
+let value_description sub v =
+ let loc = sub.location sub v.val_loc in
+ let attrs = sub.attributes sub v.val_attributes in
+ Val.mk ~loc ~attrs
+ ~prim:v.val_prim
+ (map_loc sub v.val_name)
+ (sub.typ sub v.val_desc)
+
+let module_binding sub mb =
+ let loc = sub.location sub mb.mb_loc in
+ let attrs = sub.attributes sub mb.mb_attributes in
+ Mb.mk ~loc ~attrs
+ (map_loc sub mb.mb_name)
+ (sub.module_expr sub mb.mb_expr)
+
+let type_parameter sub (ct, v) = (sub.typ sub ct, v)
+
+let type_declaration sub decl =
+ let loc = sub.location sub decl.typ_loc in
+ let attrs = sub.attributes sub decl.typ_attributes in
+ Type.mk ~loc ~attrs
+ ~params:(List.map (type_parameter sub) decl.typ_params)
+ ~cstrs:(
+ List.map
+ (fun (ct1, ct2, loc) ->
+ (sub.typ sub ct1, sub.typ sub ct2, sub.location sub loc))
+ decl.typ_cstrs)
+ ~kind:(sub.type_kind sub decl.typ_kind)
+ ~priv:decl.typ_private
+ ?manifest:(Option.map (sub.typ sub) decl.typ_manifest)
+ (map_loc sub decl.typ_name)
+
+let type_kind sub tk = match tk with
+ | Ttype_abstract -> Ptype_abstract
+ | Ttype_variant list ->
+ Ptype_variant (List.map (sub.constructor_declaration sub) list)
+ | Ttype_record list ->
+ Ptype_record (List.map (sub.label_declaration sub) list)
+ | Ttype_open -> Ptype_open
+
+let constructor_arguments sub = function
+ | Cstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l)
+ | Cstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l)
+
+let constructor_declaration sub cd =
+ let loc = sub.location sub cd.cd_loc in
+ let attrs = sub.attributes sub cd.cd_attributes in
+ Type.constructor ~loc ~attrs
+ ~vars:cd.cd_vars
+ ~args:(constructor_arguments sub cd.cd_args)
+ ?res:(Option.map (sub.typ sub) cd.cd_res)
+ (map_loc sub cd.cd_name)
+
+let label_declaration sub ld =
+ let loc = sub.location sub ld.ld_loc in
+ let attrs = sub.attributes sub ld.ld_attributes in
+ Type.field ~loc ~attrs
+ ~mut:ld.ld_mutable
+ (map_loc sub ld.ld_name)
+ (sub.typ sub ld.ld_type)
+
+let type_extension sub tyext =
+ let attrs = sub.attributes sub tyext.tyext_attributes in
+ Te.mk ~attrs
+ ~params:(List.map (type_parameter sub) tyext.tyext_params)
+ ~priv:tyext.tyext_private
+ (map_loc sub tyext.tyext_txt)
+ (List.map (sub.extension_constructor sub) tyext.tyext_constructors)
+
+let type_exception sub tyexn =
+ let attrs = sub.attributes sub tyexn.tyexn_attributes in
+ Te.mk_exception ~attrs
+ (sub.extension_constructor sub tyexn.tyexn_constructor)
+
+let extension_constructor sub ext =
+ let loc = sub.location sub ext.ext_loc in
+ let attrs = sub.attributes sub ext.ext_attributes in
+ Te.constructor ~loc ~attrs
+ (map_loc sub ext.ext_name)
+ (match ext.ext_kind with
+ | Text_decl (vs, args, ret) ->
+ Pext_decl (vs, constructor_arguments sub args,
+ Option.map (sub.typ sub) ret)
+ | Text_rebind (_p, lid) -> Pext_rebind (map_loc sub lid)
+ )
+
+let pattern : type k . _ -> k T.general_pattern -> _ = fun sub pat ->
+ let loc = sub.location sub pat.pat_loc in
+ (* todo: fix attributes on extras *)
+ let attrs = sub.attributes sub pat.pat_attributes in
+ let desc =
+ match pat with
+ { pat_extra=[Tpat_unpack, loc, _attrs]; pat_desc = Tpat_any; _ } ->
+ Ppat_unpack { txt = None; loc }
+ | { pat_extra=[Tpat_unpack, _, _attrs];
+ pat_desc = Tpat_var (_,name, _); _ } ->
+ Ppat_unpack { name with txt = Some name.txt }
+ | { pat_extra=[Tpat_type (_path, lid), _, _attrs]; _ } ->
+ Ppat_type (map_loc sub lid)
+ | { pat_extra= (Tpat_constraint ct, _, _attrs) :: rem; _ } ->
+ Ppat_constraint (sub.pat sub { pat with pat_extra=rem },
+ sub.typ sub ct)
+ | _ ->
+ match pat.pat_desc with
+ Tpat_any -> Ppat_any
+ | Tpat_var (id, name, _) ->
+ begin
+ match (Ident.name id).[0] with
+ 'A'..'Z' ->
+ Ppat_unpack { name with txt = Some name.txt}
+ | _ ->
+ Ppat_var name
+ end
+
+ (* We transform (_ as x) in x if _ and x have the same location.
+ The compiler transforms (x:t) into (_ as x : t).
+ This avoids transforming a warning 27 into a 26.
+ *)
+ | Tpat_alias ({pat_desc = Tpat_any; pat_loc}, _id, name, _)
+ when pat_loc = pat.pat_loc ->
+ Ppat_var name
+
+ | Tpat_alias (pat, _id, name, _) ->
+ Ppat_alias (sub.pat sub pat, name)
+ | Tpat_constant cst -> Ppat_constant (constant cst)
+ | Tpat_tuple list ->
+ Ppat_tuple (List.map (sub.pat sub) list)
+ | Tpat_construct (lid, _, args, vto) ->
+ let tyo =
+ match vto with
+ None -> None
+ | Some (vl, ty) ->
+ let vl =
+ List.map (fun x -> {x with txt = Ident.name x.txt}) vl
+ in
+ Some (vl, sub.typ sub ty)
+ in
+ let arg =
+ match args with
+ [] -> None
+ | [arg] -> Some (sub.pat sub arg)
+ | args -> Some (Pat.tuple ~loc (List.map (sub.pat sub) args))
+ in
+ Ppat_construct (map_loc sub lid,
+ match tyo, arg with
+ | Some (vl, ty), Some arg ->
+ Some (vl, Pat.mk ~loc (Ppat_constraint (arg, ty)))
+ | None, Some arg -> Some ([], arg)
+ | _, None -> None)
+ | Tpat_variant (label, pato, _) ->
+ Ppat_variant (label, Option.map (sub.pat sub) pato)
+ | Tpat_record (list, closed) ->
+ Ppat_record (List.map (fun (lid, _, pat) ->
+ map_loc sub lid, sub.pat sub pat) list, closed)
+ | Tpat_array list -> Ppat_array (List.map (sub.pat sub) list)
+ | Tpat_lazy p -> Ppat_lazy (sub.pat sub p)
+
+ | Tpat_exception p -> Ppat_exception (sub.pat sub p)
+ | Tpat_value p -> (sub.pat sub (p :> pattern)).ppat_desc
+ | Tpat_or (p1, p2, _) -> Ppat_or (sub.pat sub p1, sub.pat sub p2)
+ in
+ Pat.mk ~loc ~attrs desc
+
+let exp_extra sub (extra, loc, attrs) sexp =
+ let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
+ let desc =
+ match extra with
+ Texp_coerce (cty1, cty2) ->
+ Pexp_coerce (sexp,
+ Option.map (sub.typ sub) cty1,
+ sub.typ sub cty2)
+ | Texp_constraint cty ->
+ Pexp_constraint (sexp, sub.typ sub cty)
+ | Texp_poly cto -> Pexp_poly (sexp, Option.map (sub.typ sub) cto)
+ | Texp_newtype s -> Pexp_newtype (mkloc s loc, sexp)
+ in
+ Exp.mk ~loc ~attrs desc
+
+let case : type k . mapper -> k case -> _ = fun sub {c_lhs; c_guard; c_rhs} ->
+ {
+ pc_lhs = sub.pat sub c_lhs;
+ pc_guard = Option.map (sub.expr sub) c_guard;
+ pc_rhs = sub.expr sub c_rhs;
+ }
+
+let value_binding sub vb =
+ let loc = sub.location sub vb.vb_loc in
+ let attrs = sub.attributes sub vb.vb_attributes in
+ Vb.mk ~loc ~attrs
+ (sub.pat sub vb.vb_pat)
+ (sub.expr sub vb.vb_expr)
+
+let expression sub exp =
+ let loc = sub.location sub exp.exp_loc in
+ let attrs = sub.attributes sub exp.exp_attributes in
+ let desc =
+ match exp.exp_desc with
+ Texp_ident (_path, lid, _) -> Pexp_ident (map_loc sub lid)
+ | Texp_constant cst -> Pexp_constant (constant cst)
+ | Texp_let (rec_flag, list, exp) ->
+ Pexp_let (rec_flag,
+ List.map (sub.value_binding sub) list,
+ sub.expr sub exp)
+ | Texp_function (params, body) ->
+ let body, constraint_ =
+ match body with
+ | Tfunction_body body ->
+ (* Unlike function cases, the [exp_extra] is placed on the body
+ itself. *)
+ Pfunction_body (sub.expr sub body), None
+ | Tfunction_cases { cases; loc; exp_extra; attributes; _ } ->
+ let cases = List.map (sub.case sub) cases in
+ let constraint_ =
+ match exp_extra with
+ | Some (Texp_coerce (ty1, ty2)) ->
+ Some
+ (Pcoerce (Option.map (sub.typ sub) ty1, sub.typ sub ty2))
+ | Some (Texp_constraint ty) ->
+ Some (Pconstraint (sub.typ sub ty))
+ | Some (Texp_poly _ | Texp_newtype _) | None -> None
+ in
+ Pfunction_cases (cases, loc, attributes), constraint_
+ in
+ let params =
+ List.concat_map
+ (fun fp ->
+ let pat, default_arg =
+ match fp.fp_kind with
+ | Tparam_pat pat -> pat, None
+ | Tparam_optional_default (pat, expr) -> pat, Some expr
+ in
+ let pat = sub.pat sub pat in
+ let default_arg = Option.map (sub.expr sub) default_arg in
+ let newtypes =
+ List.map
+ (fun x ->
+ { pparam_desc = Pparam_newtype x;
+ pparam_loc = x.loc;
+ })
+ fp.fp_newtypes
+ in
+ let pparam_desc =
+ Pparam_val (fp.fp_arg_label, default_arg, pat)
+ in
+ { pparam_desc; pparam_loc = fp.fp_loc } :: newtypes)
+ params
+ in
+ Pexp_function (params, constraint_, body)
+ | Texp_apply (exp, list) ->
+ Pexp_apply (sub.expr sub exp,
+ List.fold_right (fun (label, expo) list ->
+ match expo with
+ None -> list
+ | Some exp -> (label, sub.expr sub exp) :: list
+ ) list [])
+ | Texp_match (exp, cases, eff_cases, _) ->
+ let merged_cases = List.map (sub.case sub) cases
+ @ List.map
+ (fun c ->
+ let uc = sub.case sub c in
+ let pat = { uc.pc_lhs
+ (* XXX KC: The 2nd argument of Ppat_effect is wrong *)
+ with ppat_desc = Ppat_effect (uc.pc_lhs, uc.pc_lhs) }
+ in
+ { uc with pc_lhs = pat })
+ eff_cases
+ in
+ Pexp_match (sub.expr sub exp, merged_cases)
+ | Texp_try (exp, exn_cases, eff_cases) ->
+ let merged_cases = List.map (sub.case sub) exn_cases
+ @ List.map
+ (fun c ->
+ let uc = sub.case sub c in
+ let pat = { uc.pc_lhs
+ (* XXX KC: The 2nd argument of Ppat_effect is wrong *)
+ with ppat_desc = Ppat_effect (uc.pc_lhs, uc.pc_lhs) }
+ in
+ { uc with pc_lhs = pat })
+ eff_cases
+ in
+ Pexp_try (sub.expr sub exp, merged_cases)
+ | Texp_tuple list ->
+ Pexp_tuple (List.map (sub.expr sub) list)
+ | Texp_construct (lid, _, args) ->
+ Pexp_construct (map_loc sub lid,
+ (match args with
+ [] -> None
+ | [ arg ] -> Some (sub.expr sub arg)
+ | args ->
+ Some
+ (Exp.tuple ~loc (List.map (sub.expr sub) args))
+ ))
+ | Texp_variant (label, expo) ->
+ Pexp_variant (label, Option.map (sub.expr sub) expo)
+ | Texp_record { fields; extended_expression; _ } ->
+ let list = Array.fold_left (fun l -> function
+ | _, Kept _ -> l
+ | _, Overridden (lid, exp) -> (lid, sub.expr sub exp) :: l)
+ [] fields
+ in
+ Pexp_record (list, Option.map (sub.expr sub) extended_expression)
+ | Texp_field (exp, lid, _label) ->
+ Pexp_field (sub.expr sub exp, map_loc sub lid)
+ | Texp_setfield (exp1, lid, _label, exp2) ->
+ Pexp_setfield (sub.expr sub exp1, map_loc sub lid,
+ sub.expr sub exp2)
+ | Texp_array list ->
+ Pexp_array (List.map (sub.expr sub) list)
+ | Texp_ifthenelse (exp1, exp2, expo) ->
+ Pexp_ifthenelse (sub.expr sub exp1,
+ sub.expr sub exp2,
+ Option.map (sub.expr sub) expo)
+ | Texp_sequence (exp1, exp2) ->
+ Pexp_sequence (sub.expr sub exp1, sub.expr sub exp2)
+ | Texp_while (exp1, exp2) ->
+ Pexp_while (sub.expr sub exp1, sub.expr sub exp2)
+ | Texp_for (_id, name, exp1, exp2, dir, exp3) ->
+ Pexp_for (name,
+ sub.expr sub exp1, sub.expr sub exp2,
+ dir, sub.expr sub exp3)
+ | Texp_send (exp, meth) ->
+ Pexp_send (sub.expr sub exp, match meth with
+ Tmeth_name name -> mkloc name loc
+ | Tmeth_val id -> mkloc (Ident.name id) loc
+ | Tmeth_ancestor(id, _) -> mkloc (Ident.name id) loc)
+ | Texp_new (_path, lid, _) -> Pexp_new (map_loc sub lid)
+ | Texp_instvar (_, path, name) ->
+ Pexp_ident ({loc = sub.location sub name.loc ; txt = lident_of_path path})
+ | Texp_setinstvar (_, _path, lid, exp) ->
+ Pexp_setinstvar (map_loc sub lid, sub.expr sub exp)
+ | Texp_override (_, list) ->
+ Pexp_override (List.map (fun (_path, lid, exp) ->
+ (map_loc sub lid, sub.expr sub exp)
+ ) list)
+ | Texp_letmodule (_id, name, _pres, mexpr, exp) ->
+ Pexp_letmodule (name, sub.module_expr sub mexpr,
+ sub.expr sub exp)
+ | Texp_letexception (ext, exp) ->
+ Pexp_letexception (sub.extension_constructor sub ext,
+ sub.expr sub exp)
+ | Texp_assert (exp, _) -> Pexp_assert (sub.expr sub exp)
+ | Texp_lazy exp -> Pexp_lazy (sub.expr sub exp)
+ | Texp_object (cl, _) ->
+ Pexp_object (sub.class_structure sub cl)
+ | Texp_pack (mexpr) ->
+ Pexp_pack (sub.module_expr sub mexpr)
+ | Texp_letop {let_; ands; body; _} ->
+ let pat, and_pats =
+ extract_letop_patterns (List.length ands) body.c_lhs
+ in
+ let let_ = sub.binding_op sub let_ pat in
+ let ands = List.map2 (sub.binding_op sub) ands and_pats in
+ let body = sub.expr sub body.c_rhs in
+ Pexp_letop {let_; ands; body }
+ | Texp_unreachable ->
+ Pexp_unreachable
+ | Texp_extension_constructor (lid, _) ->
+ Pexp_extension ({ txt = "ocaml.extension_constructor"; loc },
+ PStr [ Str.eval ~loc
+ (Exp.construct ~loc (map_loc sub lid) None)
+ ])
+ | Texp_open (od, exp) ->
+ Pexp_open (sub.open_declaration sub od, sub.expr sub exp)
+ in
+ List.fold_right (exp_extra sub) exp.exp_extra
+ (Exp.mk ~loc ~attrs desc)
+
+let binding_op sub bop pat =
+ let pbop_op = bop.bop_op_name in
+ let pbop_pat = sub.pat sub pat in
+ let pbop_exp = sub.expr sub bop.bop_exp in
+ let pbop_loc = bop.bop_loc in
+ {pbop_op; pbop_pat; pbop_exp; pbop_loc}
+
+let package_type sub pack =
+ (map_loc sub pack.pack_txt,
+ List.map (fun (s, ct) ->
+ (s, sub.typ sub ct)) pack.pack_fields)
+
+let module_type_declaration sub mtd =
+ let loc = sub.location sub mtd.mtd_loc in
+ let attrs = sub.attributes sub mtd.mtd_attributes in
+ Mtd.mk ~loc ~attrs
+ ?typ:(Option.map (sub.module_type sub) mtd.mtd_type)
+ (map_loc sub mtd.mtd_name)
+
+let signature sub sg =
+ List.map (sub.signature_item sub) sg.sig_items
+
+let signature_item sub item =
+ let loc = sub.location sub item.sig_loc in
+ let desc =
+ match item.sig_desc with
+ Tsig_value v ->
+ Psig_value (sub.value_description sub v)
+ | Tsig_type (rec_flag, list) ->
+ Psig_type (rec_flag, List.map (sub.type_declaration sub) list)
+ | Tsig_typesubst list ->
+ Psig_typesubst (List.map (sub.type_declaration sub) list)
+ | Tsig_typext tyext ->
+ Psig_typext (sub.type_extension sub tyext)
+ | Tsig_exception ext ->
+ Psig_exception (sub.type_exception sub ext)
+ | Tsig_module md ->
+ Psig_module (sub.module_declaration sub md)
+ | Tsig_modsubst ms ->
+ Psig_modsubst (sub.module_substitution sub ms)
+ | Tsig_recmodule list ->
+ Psig_recmodule (List.map (sub.module_declaration sub) list)
+ | Tsig_modtype mtd ->
+ Psig_modtype (sub.module_type_declaration sub mtd)
+ | Tsig_modtypesubst mtd ->
+ Psig_modtypesubst (sub.module_type_declaration sub mtd)
+ | Tsig_open od ->
+ Psig_open (sub.open_description sub od)
+ | Tsig_include incl ->
+ Psig_include (sub.include_description sub incl)
+ | Tsig_class list ->
+ Psig_class (List.map (sub.class_description sub) list)
+ | Tsig_class_type list ->
+ Psig_class_type (List.map (sub.class_type_declaration sub) list)
+ | Tsig_attribute x ->
+ Psig_attribute x
+ in
+ Sig.mk ~loc desc
+
+let module_declaration sub md =
+ let loc = sub.location sub md.md_loc in
+ let attrs = sub.attributes sub md.md_attributes in
+ Md.mk ~loc ~attrs
+ (map_loc sub md.md_name)
+ (sub.module_type sub md.md_type)
+
+let module_substitution sub ms =
+ let loc = sub.location sub ms.ms_loc in
+ let attrs = sub.attributes sub ms.ms_attributes in
+ Ms.mk ~loc ~attrs
+ (map_loc sub ms.ms_name)
+ (map_loc sub ms.ms_txt)
+
+let include_infos f sub incl =
+ let loc = sub.location sub incl.incl_loc in
+ let attrs = sub.attributes sub incl.incl_attributes in
+ Incl.mk ~loc ~attrs
+ (f sub incl.incl_mod)
+
+let include_declaration sub = include_infos sub.module_expr sub
+let include_description sub = include_infos sub.module_type sub
+
+let class_infos f sub ci =
+ let loc = sub.location sub ci.ci_loc in
+ let attrs = sub.attributes sub ci.ci_attributes in
+ Ci.mk ~loc ~attrs
+ ~virt:ci.ci_virt
+ ~params:(List.map (type_parameter sub) ci.ci_params)
+ (map_loc sub ci.ci_id_name)
+ (f sub ci.ci_expr)
+
+let class_declaration sub = class_infos sub.class_expr sub
+let class_description sub = class_infos sub.class_type sub
+let class_type_declaration sub = class_infos sub.class_type sub
+
+let functor_parameter sub : functor_parameter -> Parsetree.functor_parameter =
+ function
+ | Unit -> Unit
+ | Named (_, name, mtype) -> Named (name, sub.module_type sub mtype)
+
+let module_type (sub : mapper) mty =
+ let loc = sub.location sub mty.mty_loc in
+ let attrs = sub.attributes sub mty.mty_attributes in
+ let desc = match mty.mty_desc with
+ Tmty_ident (_path, lid) -> Pmty_ident (map_loc sub lid)
+ | Tmty_alias (_path, lid) -> Pmty_alias (map_loc sub lid)
+ | Tmty_signature sg -> Pmty_signature (sub.signature sub sg)
+ | Tmty_functor (arg, mtype2) ->
+ Pmty_functor (functor_parameter sub arg, sub.module_type sub mtype2)
+ | Tmty_with (mtype, list) ->
+ Pmty_with (sub.module_type sub mtype,
+ List.map (sub.with_constraint sub) list)
+ | Tmty_typeof mexpr ->
+ Pmty_typeof (sub.module_expr sub mexpr)
+ in
+ Mty.mk ~loc ~attrs desc
+
+let with_constraint sub (_path, lid, cstr) =
+ match cstr with
+ | Twith_type decl ->
+ Pwith_type (map_loc sub lid, sub.type_declaration sub decl)
+ | Twith_module (_path, lid2) ->
+ Pwith_module (map_loc sub lid, map_loc sub lid2)
+ | Twith_modtype mty ->
+ let mty = sub.module_type sub mty in
+ Pwith_modtype (map_loc sub lid,mty)
+ | Twith_typesubst decl ->
+ Pwith_typesubst (map_loc sub lid, sub.type_declaration sub decl)
+ | Twith_modsubst (_path, lid2) ->
+ Pwith_modsubst (map_loc sub lid, map_loc sub lid2)
+ | Twith_modtypesubst mty ->
+ let mty = sub.module_type sub mty in
+ Pwith_modtypesubst (map_loc sub lid, mty)
+
+let module_expr (sub : mapper) mexpr =
+ let loc = sub.location sub mexpr.mod_loc in
+ let attrs = sub.attributes sub mexpr.mod_attributes in
+ match mexpr.mod_desc with
+ Tmod_constraint (m, _, Tmodtype_implicit, _ ) ->
+ sub.module_expr sub m
+ | _ ->
+ let desc = match mexpr.mod_desc with
+ Tmod_ident (_p, lid) -> Pmod_ident (map_loc sub lid)
+ | Tmod_structure st -> Pmod_structure (sub.structure sub st)
+ | Tmod_functor (arg, mexpr) ->
+ Pmod_functor
+ (functor_parameter sub arg, sub.module_expr sub mexpr)
+ | Tmod_apply (mexp1, mexp2, _) ->
+ Pmod_apply (sub.module_expr sub mexp1,
+ sub.module_expr sub mexp2)
+ | Tmod_apply_unit mexp1 ->
+ Pmod_apply_unit (sub.module_expr sub mexp1)
+ | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
+ Pmod_constraint (sub.module_expr sub mexpr,
+ sub.module_type sub mtype)
+ | Tmod_constraint (_mexpr, _, Tmodtype_implicit, _) ->
+ assert false
+ | Tmod_unpack (exp, _pack) ->
+ Pmod_unpack (sub.expr sub exp)
+ (* TODO , sub.package_type sub pack) *)
+ in
+ Mod.mk ~loc ~attrs desc
+
+let class_expr sub cexpr =
+ let loc = sub.location sub cexpr.cl_loc in
+ let attrs = sub.attributes sub cexpr.cl_attributes in
+ let desc = match cexpr.cl_desc with
+ | Tcl_constraint ( { cl_desc = Tcl_ident (_path, lid, tyl); _ },
+ None, _, _, _ ) ->
+ Pcl_constr (map_loc sub lid,
+ List.map (sub.typ sub) tyl)
+ | Tcl_structure clstr -> Pcl_structure (sub.class_structure sub clstr)
+
+ | Tcl_fun (label, pat, _pv, cl, _partial) ->
+ Pcl_fun (label, None, sub.pat sub pat, sub.class_expr sub cl)
+
+ | Tcl_apply (cl, args) ->
+ Pcl_apply (sub.class_expr sub cl,
+ List.fold_right (fun (label, expo) list ->
+ match expo with
+ None -> list
+ | Some exp -> (label, sub.expr sub exp) :: list
+ ) args [])
+
+ | Tcl_let (rec_flat, bindings, _ivars, cl) ->
+ Pcl_let (rec_flat,
+ List.map (sub.value_binding sub) bindings,
+ sub.class_expr sub cl)
+
+ | Tcl_constraint (cl, Some clty, _vals, _meths, _concrs) ->
+ Pcl_constraint (sub.class_expr sub cl, sub.class_type sub clty)
+
+ | Tcl_open (od, e) ->
+ Pcl_open (sub.open_description sub od, sub.class_expr sub e)
+
+ | Tcl_ident _ -> assert false
+ | Tcl_constraint (_, None, _, _, _) -> assert false
+ in
+ Cl.mk ~loc ~attrs desc
+
+let class_type sub ct =
+ let loc = sub.location sub ct.cltyp_loc in
+ let attrs = sub.attributes sub ct.cltyp_attributes in
+ let desc = match ct.cltyp_desc with
+ Tcty_signature csg -> Pcty_signature (sub.class_signature sub csg)
+ | Tcty_constr (_path, lid, list) ->
+ Pcty_constr (map_loc sub lid, List.map (sub.typ sub) list)
+ | Tcty_arrow (label, ct, cl) ->
+ Pcty_arrow (label, sub.typ sub ct, sub.class_type sub cl)
+ | Tcty_open (od, e) ->
+ Pcty_open (sub.open_description sub od, sub.class_type sub e)
+ in
+ Cty.mk ~loc ~attrs desc
+
+let class_signature sub cs =
+ {
+ pcsig_self = sub.typ sub cs.csig_self;
+ pcsig_fields = List.map (sub.class_type_field sub) cs.csig_fields;
+ }
+
+let class_type_field sub ctf =
+ let loc = sub.location sub ctf.ctf_loc in
+ let attrs = sub.attributes sub ctf.ctf_attributes in
+ let desc = match ctf.ctf_desc with
+ Tctf_inherit ct -> Pctf_inherit (sub.class_type sub ct)
+ | Tctf_val (s, mut, virt, ct) ->
+ Pctf_val (mkloc s loc, mut, virt, sub.typ sub ct)
+ | Tctf_method (s, priv, virt, ct) ->
+ Pctf_method (mkloc s loc, priv, virt, sub.typ sub ct)
+ | Tctf_constraint (ct1, ct2) ->
+ Pctf_constraint (sub.typ sub ct1, sub.typ sub ct2)
+ | Tctf_attribute x -> Pctf_attribute x
+ in
+ Ctf.mk ~loc ~attrs desc
+
+let core_type sub ct =
+ let loc = sub.location sub ct.ctyp_loc in
+ let attrs = sub.attributes sub ct.ctyp_attributes in
+ let desc = match ct.ctyp_desc with
+ Ttyp_any -> Ptyp_any
+ | Ttyp_var s -> Ptyp_var s
+ | Ttyp_arrow (label, ct1, ct2) ->
+ Ptyp_arrow (label, sub.typ sub ct1, sub.typ sub ct2)
+ | Ttyp_tuple list -> Ptyp_tuple (List.map (sub.typ sub) list)
+ | Ttyp_constr (_path, lid, list) ->
+ Ptyp_constr (map_loc sub lid,
+ List.map (sub.typ sub) list)
+ | Ttyp_object (list, o) ->
+ Ptyp_object
+ (List.map (sub.object_field sub) list, o)
+ | Ttyp_class (_path, lid, list) ->
+ Ptyp_class (map_loc sub lid, List.map (sub.typ sub) list)
+ | Ttyp_alias (ct, s) ->
+ Ptyp_alias (sub.typ sub ct, s)
+ | Ttyp_variant (list, bool, labels) ->
+ Ptyp_variant (List.map (sub.row_field sub) list, bool, labels)
+ | Ttyp_poly (list, ct) ->
+ let list = List.map (fun v -> mkloc v loc) list in
+ Ptyp_poly (list, sub.typ sub ct)
+ | Ttyp_package pack -> Ptyp_package (sub.package_type sub pack)
+ | Ttyp_open (_path, mod_ident, t) -> Ptyp_open (mod_ident, sub.typ sub t)
+ in
+ Typ.mk ~loc ~attrs desc
+
+let class_structure sub cs =
+ let rec remove_self = function
+ | { pat_desc = Tpat_alias (p, id, _s, _) }
+ when string_is_prefix "selfpat-" (Ident.name id) ->
+ remove_self p
+ | p -> p
+ in
+ { pcstr_self = sub.pat sub (remove_self cs.cstr_self);
+ pcstr_fields = List.map (sub.class_field sub) cs.cstr_fields;
+ }
+
+let row_field sub {rf_loc; rf_desc; rf_attributes;} =
+ let loc = sub.location sub rf_loc in
+ let attrs = sub.attributes sub rf_attributes in
+ let desc = match rf_desc with
+ | Ttag (label, bool, list) ->
+ Rtag (label, bool, List.map (sub.typ sub) list)
+ | Tinherit ct -> Rinherit (sub.typ sub ct)
+ in
+ Rf.mk ~loc ~attrs desc
+
+let object_field sub {of_loc; of_desc; of_attributes;} =
+ let loc = sub.location sub of_loc in
+ let attrs = sub.attributes sub of_attributes in
+ let desc = match of_desc with
+ | OTtag (label, ct) ->
+ Otag (label, sub.typ sub ct)
+ | OTinherit ct -> Oinherit (sub.typ sub ct)
+ in
+ Of.mk ~loc ~attrs desc
+
+and is_self_pat = function
+ | { pat_desc = Tpat_alias(_pat, id, _, _) } ->
+ string_is_prefix "self-" (Ident.name id)
+ | _ -> false
+
+(* [Typeclass] adds a [self] parameter to initializers and methods that isn't
+ present in the source program.
+*)
+let remove_fun_self exp =
+ match exp with
+ | { exp_desc =
+ Texp_function
+ ({fp_arg_label = Nolabel; fp_kind = Tparam_pat pat} :: params, body)
+ }
+ when is_self_pat pat ->
+ (match params, body with
+ | [], Tfunction_body body -> body
+ | _, _ -> { exp with exp_desc = Texp_function (params, body) })
+ | e -> e
+
+let class_field sub cf =
+ let loc = sub.location sub cf.cf_loc in
+ let attrs = sub.attributes sub cf.cf_attributes in
+ let desc = match cf.cf_desc with
+ Tcf_inherit (ovf, cl, super, _vals, _meths) ->
+ Pcf_inherit (ovf, sub.class_expr sub cl,
+ Option.map (fun v -> mkloc v loc) super)
+ | Tcf_constraint (cty, cty') ->
+ Pcf_constraint (sub.typ sub cty, sub.typ sub cty')
+ | Tcf_val (lab, mut, _, Tcfk_virtual cty, _) ->
+ Pcf_val (lab, mut, Cfk_virtual (sub.typ sub cty))
+ | Tcf_val (lab, mut, _, Tcfk_concrete (o, exp), _) ->
+ Pcf_val (lab, mut, Cfk_concrete (o, sub.expr sub exp))
+ | Tcf_method (lab, priv, Tcfk_virtual cty) ->
+ Pcf_method (lab, priv, Cfk_virtual (sub.typ sub cty))
+ | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
+ let exp = remove_fun_self exp in
+ Pcf_method (lab, priv, Cfk_concrete (o, sub.expr sub exp))
+ | Tcf_initializer exp ->
+ let exp = remove_fun_self exp in
+ Pcf_initializer (sub.expr sub exp)
+ | Tcf_attribute x -> Pcf_attribute x
+ in
+ Cf.mk ~loc ~attrs desc
+
+let location _sub l = l
+
+let default_mapper =
+ {
+ attribute = attribute;
+ attributes = attributes;
+ binding_op = binding_op;
+ structure = structure;
+ structure_item = structure_item;
+ module_expr = module_expr;
+ signature = signature;
+ signature_item = signature_item;
+ module_type = module_type;
+ with_constraint = with_constraint;
+ class_declaration = class_declaration;
+ class_expr = class_expr;
+ class_field = class_field;
+ class_structure = class_structure;
+ class_type = class_type;
+ class_type_field = class_type_field;
+ class_signature = class_signature;
+ class_type_declaration = class_type_declaration;
+ class_description = class_description;
+ type_declaration = type_declaration;
+ type_kind = type_kind;
+ typ = core_type;
+ type_extension = type_extension;
+ type_exception = type_exception;
+ extension_constructor = extension_constructor;
+ value_description = value_description;
+ pat = pattern;
+ expr = expression;
+ module_declaration = module_declaration;
+ module_substitution = module_substitution;
+ module_type_declaration = module_type_declaration;
+ module_binding = module_binding;
+ package_type = package_type ;
+ open_declaration = open_declaration;
+ open_description = open_description;
+ include_description = include_description;
+ include_declaration = include_declaration;
+ value_binding = value_binding;
+ constructor_declaration = constructor_declaration;
+ label_declaration = label_declaration;
+ case = case;
+ location = location;
+ row_field = row_field ;
+ object_field = object_field ;
+ }
+
+let untype_structure ?(mapper : mapper = default_mapper) structure =
+ mapper.structure mapper structure
+
+let untype_signature ?(mapper : mapper = default_mapper) signature =
+ mapper.signature mapper signature
+
+let untype_expression ?(mapper=default_mapper) expression =
+ mapper.expr mapper expression
+
+let untype_pattern ?(mapper=default_mapper) pattern =
+ mapper.pat mapper pattern
diff --git a/upstream/ocaml_503/typing/untypeast.mli b/upstream/ocaml_503/typing/untypeast.mli
new file mode 100644
index 0000000000..809df9ad08
--- /dev/null
+++ b/upstream/ocaml_503/typing/untypeast.mli
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay) *)
+(* *)
+(* Copyright 2007 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. *)
+(* *)
+(**************************************************************************)
+
+open Parsetree
+
+val lident_of_path : Path.t -> Longident.t
+
+type mapper = {
+ attribute: mapper -> Typedtree.attribute -> attribute;
+ attributes: mapper -> Typedtree.attribute list -> attribute list;
+ binding_op:
+ mapper ->
+ Typedtree.binding_op -> Typedtree.pattern -> binding_op;
+ case: 'k . mapper -> 'k Typedtree.case -> case;
+ class_declaration: mapper -> Typedtree.class_declaration -> class_declaration;
+ class_description: mapper -> Typedtree.class_description -> class_description;
+ class_expr: mapper -> Typedtree.class_expr -> class_expr;
+ class_field: mapper -> Typedtree.class_field -> class_field;
+ class_signature: mapper -> Typedtree.class_signature -> class_signature;
+ class_structure: mapper -> Typedtree.class_structure -> class_structure;
+ class_type: mapper -> Typedtree.class_type -> class_type;
+ class_type_declaration: mapper -> Typedtree.class_type_declaration
+ -> class_type_declaration;
+ class_type_field: mapper -> Typedtree.class_type_field -> class_type_field;
+ constructor_declaration: mapper -> Typedtree.constructor_declaration
+ -> constructor_declaration;
+ expr: mapper -> Typedtree.expression -> expression;
+ extension_constructor: mapper -> Typedtree.extension_constructor
+ -> extension_constructor;
+ include_declaration:
+ mapper -> Typedtree.include_declaration -> include_declaration;
+ include_description:
+ mapper -> Typedtree.include_description -> include_description;
+ label_declaration:
+ mapper -> Typedtree.label_declaration -> label_declaration;
+ location: mapper -> Location.t -> Location.t;
+ module_binding: mapper -> Typedtree.module_binding -> module_binding;
+ module_declaration:
+ mapper -> Typedtree.module_declaration -> module_declaration;
+ module_substitution:
+ mapper -> Typedtree.module_substitution -> module_substitution;
+ module_expr: mapper -> Typedtree.module_expr -> module_expr;
+ module_type: mapper -> Typedtree.module_type -> module_type;
+ module_type_declaration:
+ mapper -> Typedtree.module_type_declaration -> module_type_declaration;
+ package_type: mapper -> Typedtree.package_type -> package_type;
+ open_declaration: mapper -> Typedtree.open_declaration -> open_declaration;
+ open_description: mapper -> Typedtree.open_description -> open_description;
+ pat: 'k . mapper -> 'k Typedtree.general_pattern -> pattern;
+ row_field: mapper -> Typedtree.row_field -> row_field;
+ object_field: mapper -> Typedtree.object_field -> object_field;
+ signature: mapper -> Typedtree.signature -> signature;
+ signature_item: mapper -> Typedtree.signature_item -> signature_item;
+ structure: mapper -> Typedtree.structure -> structure;
+ structure_item: mapper -> Typedtree.structure_item -> structure_item;
+ typ: mapper -> Typedtree.core_type -> core_type;
+ type_declaration: mapper -> Typedtree.type_declaration -> type_declaration;
+ type_extension: mapper -> Typedtree.type_extension -> type_extension;
+ type_exception: mapper -> Typedtree.type_exception -> type_exception;
+ type_kind: mapper -> Typedtree.type_kind -> type_kind;
+ value_binding: mapper -> Typedtree.value_binding -> value_binding;
+ value_description: mapper -> Typedtree.value_description -> value_description;
+ with_constraint:
+ mapper -> (Path.t * Longident.t Location.loc * Typedtree.with_constraint)
+ -> with_constraint;
+}
+
+val default_mapper : mapper
+
+val untype_structure : ?mapper:mapper -> Typedtree.structure -> structure
+val untype_signature : ?mapper:mapper -> Typedtree.signature -> signature
+val untype_expression : ?mapper:mapper -> Typedtree.expression -> expression
+val untype_pattern : ?mapper:mapper -> _ Typedtree.general_pattern -> pattern
+
+val constant : Asttypes.constant -> Parsetree.constant
diff --git a/upstream/ocaml_503/typing/value_rec_check.ml b/upstream/ocaml_503/typing/value_rec_check.ml
new file mode 100644
index 0000000000..4f4e4d052d
--- /dev/null
+++ b/upstream/ocaml_503/typing/value_rec_check.ml
@@ -0,0 +1,1421 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremy Yallop, University of Cambridge *)
+(* Gabriel Scherer, Project Parsifal, INRIA Saclay *)
+(* Alban Reynaud, ENS Lyon *)
+(* *)
+(* Copyright 2017 Jeremy Yallop *)
+(* Copyright 2018 Alban Reynaud *)
+(* Copyright 2018 INRIA *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Static checking of recursive declarations, as described in
+
+ A practical mode system for recursive definitions
+ Alban Reynaud, Gabriel Scherer and Jeremy Yallop
+ POPL 2021
+
+Some recursive definitions are meaningful
+{[
+ let rec factorial = function 0 -> 1 | n -> n * factorial (n - 1)
+ let rec infinite_list = 0 :: infinite_list
+]}
+but some other are meaningless
+{[
+ let rec x = x
+ let rec x = x+1
+]}
+
+Intuitively, a recursive definition makes sense when the body of the
+definition can be evaluated without fully knowing what the recursive
+name is yet.
+
+In the [factorial] example, the name [factorial] refers to a function,
+evaluating the function definition [function ...] can be done
+immediately and will not force a recursive call to [factorial] -- this
+will only happen later, when [factorial] is called with an argument.
+
+In the [infinite_list] example, we can evaluate [0 :: infinite_list]
+without knowing the full content of [infinite_list], but with just its
+address. This is a case of productive/guarded recursion.
+
+On the contrary, [let rec x = x] is unguarded recursion (the meaning
+is undetermined), and [let rec x = x+1] would need the value of [x]
+while evaluating its definition [x+1].
+
+This file implements a static check to decide which definitions are
+known to be meaningful, and which may be meaningless. In the general
+case, we handle a set of mutually-recursive definitions
+{[
+let rec x1 = e1
+and x2 = e2
+...
+and xn = en
+]}
+
+
+Our check (see function [is_valid_recursive_expression] is defined
+using two criteria:
+
+Usage of recursive variables: how does each of the [e1 .. en] use the
+ recursive variables [x1 .. xn]?
+
+Static or dynamic size: for which of the [ei] can we compute the
+ in-memory size of the value without evaluating [ei] (so that we can
+ pre-allocate it, and thus know its final address before evaluation).
+
+The "static or dynamic size" is decided by the classify_* functions below.
+
+The "variable usage" question is decided by a static analysis looking
+very much like a type system. The idea is to assign "access modes" to
+variables, where an "access mode" [m] is defined as either
+
+ m ::= Ignore (* the value is not used at all *)
+ | Delay (* the value is not needed at definition time *)
+ | Guard (* the value is stored under a data constructor *)
+ | Return (* the value result is directly returned *)
+ | Dereference (* full access and inspection of the value *)
+
+The access modes of an expression [e] are represented by a "context"
+[G], which is simply a mapping from variables (the variables used in
+[e]) to access modes.
+
+The core notion of the static check is a type-system-like judgment of
+the form [G |- e : m], which can be interpreted as meaning either of:
+
+- If we are allowed to use the variables of [e] at the modes in [G]
+ (but not more), then it is safe to use [e] at the mode [m].
+
+- If we want to use [e] at the mode [m], then its variables are
+ used at the modes in [G].
+
+In practice, for a given expression [e], our implementation takes the
+desired mode of use [m] as *input*, and returns a context [G] as
+*output*, which is (uniquely determined as) the most permissive choice
+of modes [G] for the variables of [e] such that [G |- e : m] holds.
+*)
+
+open Asttypes
+open Typedtree
+open Types
+
+(** {1 Static or dynamic size} *)
+
+type sd = Value_rec_types.recursive_binding_kind
+
+let is_ref : Types.value_description -> bool = function
+ | { Types.val_kind =
+ Types.Val_prim { Primitive.prim_name = "%makemutable";
+ prim_arity = 1 } } ->
+ true
+ | _ -> false
+
+(* See the note on abstracted arguments in the documentation for
+ Typedtree.Texp_apply *)
+let is_abstracted_arg : arg_label * expression option -> bool = function
+ | (_, None) -> true
+ | (_, Some _) -> false
+
+let classify_expression : Typedtree.expression -> sd =
+ (* We need to keep track of the size of expressions
+ bound by local declarations, to be able to predict
+ the size of variables. Compare:
+
+ let rec r =
+ let y = fun () -> r ()
+ in y
+
+ and
+
+ let rec r =
+ let y = if Random.bool () then ignore else fun () -> r ()
+ in y
+
+ In both cases the final address of `r` must be known before `y` is compiled,
+ and this is only possible if `r` has a statically-known size.
+
+ The first definition can be allowed (`y` has a statically-known
+ size) but the second one is unsound (`y` has no statically-known size).
+ *)
+ let rec classify_expression env e : sd =
+ match e.exp_desc with
+ (* binding and variable cases *)
+ | Texp_let (rec_flag, vb, e) ->
+ let env = classify_value_bindings rec_flag env vb in
+ classify_expression env e
+ | Texp_letmodule (Some mid, _, _, mexp, e) ->
+ (* Note on module presence:
+ For absent modules (i.e. module aliases), the module being bound
+ does not have a physical representation, but its size can still be
+ derived from the alias itself, so we can reuse the same code as
+ for modules that are present. *)
+ let size = classify_module_expression env mexp in
+ let env = Ident.add mid size env in
+ classify_expression env e
+ | Texp_ident (path, _, _) ->
+ classify_path env path
+
+ (* non-binding cases *)
+ | Texp_open (_, e)
+ | Texp_letmodule (None, _, _, _, e)
+ | Texp_sequence (_, e)
+ | Texp_letexception (_, e) ->
+ classify_expression env e
+
+ | Texp_construct (_, {cstr_tag = Cstr_unboxed}, [e]) ->
+ classify_expression env e
+ | Texp_construct _ ->
+ Static
+
+ | Texp_record { representation = Record_unboxed _;
+ fields = [| _, Overridden (_,e) |] } ->
+ classify_expression env e
+ | Texp_record _ ->
+ Static
+
+ | Texp_variant _
+ | Texp_tuple _
+ | Texp_extension_constructor _
+ | Texp_constant _ ->
+ Static
+
+ | Texp_for _
+ | Texp_setfield _
+ | Texp_while _
+ | Texp_setinstvar _ ->
+ (* Unit-returning expressions *)
+ Static
+
+ | Texp_unreachable ->
+ Static
+
+ | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, _)
+ when is_ref vd ->
+ Static
+ | Texp_apply (_,args)
+ when List.exists is_abstracted_arg args ->
+ Static
+ | Texp_apply _ ->
+ Dynamic
+
+ | Texp_array _ ->
+ Static
+ | Texp_pack mexp ->
+ classify_module_expression env mexp
+ | Texp_function _ ->
+ Static
+ | Texp_lazy e ->
+ (* The code below was copied (in part) from translcore.ml *)
+ begin match Typeopt.classify_lazy_argument e with
+ | `Constant_or_function ->
+ (* A constant expr (of type <> float if [Config.flat_float_array] is
+ true) gets compiled as itself. *)
+ classify_expression env e
+ | `Float_that_cannot_be_shortcut
+ | `Identifier `Forward_value ->
+ (* Forward blocks *)
+ Static
+ | `Identifier `Other ->
+ classify_expression env e
+ | `Other ->
+ (* other cases compile to a lazy block holding a function *)
+ Static
+ end
+
+ | Texp_new _
+ | Texp_instvar _
+ | Texp_object _
+ | Texp_match _
+ | Texp_ifthenelse _
+ | Texp_send _
+ | Texp_field _
+ | Texp_assert _
+ | Texp_try _
+ | Texp_override _
+ | Texp_letop _ ->
+ Dynamic
+ and classify_value_bindings rec_flag env bindings =
+ (* We use a non-recursive classification, classifying each
+ binding with respect to the old environment
+ (before all definitions), even if the bindings are recursive.
+
+ Note: computing a fixpoint in some way would be more
+ precise, as the following could be allowed:
+
+ let rec topdef =
+ let rec x = y and y = fun () -> topdef ()
+ in x
+ *)
+ ignore rec_flag;
+ let old_env = env in
+ let add_value_binding env vb =
+ match vb.vb_pat.pat_desc with
+ | Tpat_var (id, _loc, _uid) ->
+ let size = classify_expression old_env vb.vb_expr in
+ Ident.add id size env
+ | _ ->
+ (* Note: we don't try to compute any size for complex patterns *)
+ env
+ in
+ List.fold_left add_value_binding env bindings
+ and classify_path env : _ -> Value_rec_types.recursive_binding_kind = function
+ | Path.Pident x ->
+ begin
+ try Ident.find_same x env
+ with Not_found ->
+ (* an identifier will be missing from the map if either:
+ - it is a non-local identifier
+ (bound outside the letrec-binding we are analyzing)
+ - or it is bound by a complex (let p = e in ...) local binding
+ - or it is bound within a module (let module M = ... in ...)
+ that we are not traversing for size computation
+
+ For non-local identifiers it might be reasonable (although
+ not completely clear) to consider them Static (they have
+ already been evaluated), but for the others we must
+ under-approximate with Not_recursive.
+
+ This could be fixed by a more complete implementation.
+ *)
+ Dynamic
+ end
+ | Path.Pdot _ | Path.Papply _ | Path.Pextra_ty _ ->
+ (* local modules could have such paths to local definitions;
+ classify_expression could be extend to compute module
+ shapes more precisely *)
+ Dynamic
+ and classify_module_expression env mexp : sd =
+ match mexp.mod_desc with
+ | Tmod_ident (path, _) ->
+ classify_path env path
+ | Tmod_structure _ ->
+ Static
+ | Tmod_functor _ ->
+ Static
+ | Tmod_apply _ ->
+ Dynamic
+ | Tmod_apply_unit _ ->
+ Dynamic
+ | Tmod_constraint (mexp, _, _, coe) ->
+ begin match coe with
+ | Tcoerce_none ->
+ classify_module_expression env mexp
+ | Tcoerce_structure _ ->
+ Static
+ | Tcoerce_functor _ ->
+ Static
+ | Tcoerce_primitive _ ->
+ Misc.fatal_error "letrec: primitive coercion on a module"
+ | Tcoerce_alias _ ->
+ Misc.fatal_error "letrec: alias coercion on a module"
+ end
+ | Tmod_unpack (e, _) ->
+ classify_expression env e
+ in classify_expression Ident.empty
+
+
+(** {1 Usage of recursive variables} *)
+
+module Mode = struct
+ (** For an expression in a program, its "usage mode" represents
+ static information about how the value produced by the expression
+ will be used by the context around it. *)
+ type t =
+ | Ignore
+ (** [Ignore] is for subexpressions that are not used at all during
+ the evaluation of the whole program. This is the mode of
+ a variable in an expression in which it does not occur. *)
+
+ | Delay
+ (** A [Delay] context can be fully evaluated without evaluating its argument
+ , which will only be needed at a later point of program execution. For
+ example, [fun x -> ?] or [lazy ?] are [Delay] contexts. *)
+
+ | Guard
+ (** A [Guard] context returns the value as a member of a data structure,
+ for example a variant constructor or record. The value can safely be
+ defined mutually-recursively with their context, for example in
+ [let rec li = 1 :: li].
+ When these subexpressions participate in a cyclic definition,
+ this definition is productive/guarded.
+
+ The [Guard] mode is also used when a value is not dereferenced,
+ it is returned by a sub-expression, but the result of this
+ sub-expression is discarded instead of being returned.
+ For example, the subterm [?] is in a [Guard] context
+ in [let _ = ? in e] and in [?; e].
+ When these subexpressions participate in a cyclic definition,
+ they cannot create a self-loop.
+ *)
+
+ | Return
+ (** A [Return] context returns its value without further inspection.
+ This value cannot be defined mutually-recursively with its context,
+ as there is a risk of self-loop: in [let rec x = y and y = x], the
+ two definitions use a single variable in [Return] context. *)
+
+ | Dereference
+ (** A [Dereference] context consumes, inspects and uses the value
+ in arbitrary ways. Such a value must be fully defined at the point
+ of usage, it cannot be defined mutually-recursively with its context. *)
+
+ let equal = ((=) : t -> t -> bool)
+
+ (* Lower-ranked modes demand/use less of the variable/expression they qualify
+ -- so they allow more recursive definitions.
+
+ Ignore < Delay < Guard < Return < Dereference
+ *)
+ let rank = function
+ | Ignore -> 0
+ | Delay -> 1
+ | Guard -> 2
+ | Return -> 3
+ | Dereference -> 4
+
+ (* Returns the more conservative (highest-ranking) mode of the two
+ arguments.
+
+ In judgments we write (m + m') for (join m m').
+ *)
+ let join m m' =
+ if rank m >= rank m' then m else m'
+
+ (* If x is used with the mode m in e[x], and e[x] is used with mode
+ m' in e'[e[x]], then x is used with mode m'[m] (our notation for
+ "compose m' m") in e'[e[x]].
+
+ Return is neutral for composition: m[Return] = m = Return[m].
+
+ Composition is associative and [Ignore] is a zero/annihilator for
+ it: (compose Ignore m) and (compose m Ignore) are both Ignore. *)
+ let compose m' m = match m', m with
+ | Ignore, _ | _, Ignore -> Ignore
+ | Dereference, _ -> Dereference
+ | Delay, _ -> Delay
+ | Guard, Return -> Guard
+ | Guard, ((Dereference | Guard | Delay) as m) -> m
+ | Return, Return -> Return
+ | Return, ((Dereference | Guard | Delay) as m) -> m
+end
+
+type mode = Mode.t = Ignore | Delay | Guard | Return | Dereference
+
+module Env :
+sig
+ type t
+
+ val single : Ident.t -> Mode.t -> t
+ (** Create an environment with a single identifier used with a given mode.
+ *)
+
+ val empty : t
+ (** An environment with no used identifiers. *)
+
+ val find : Ident.t -> t -> Mode.t
+ (** Find the mode of an identifier in an environment. The default mode is
+ Ignore. *)
+
+ val unguarded : t -> Ident.t list -> Ident.t list
+ (** unguarded e l: the list of all identifiers in l that are dereferenced or
+ returned in the environment e. *)
+
+ val dependent : t -> Ident.t list -> Ident.t list
+ (** dependent e l: the list of all identifiers in l that are used in e
+ (not ignored). *)
+
+ val join : t -> t -> t
+ val join_list : t list -> t
+ (** Environments can be joined pointwise (variable per variable) *)
+
+ val compose : Mode.t -> t -> t
+ (** Environment composition m[G] extends mode composition m1[m2]
+ by composing each mode in G pointwise *)
+
+ val remove : Ident.t -> t -> t
+ (** Remove an identifier from an environment. *)
+
+ val take: Ident.t -> t -> Mode.t * t
+ (** Remove an identifier from an environment, and return its mode *)
+
+ val remove_list : Ident.t list -> t -> t
+ (** Remove all the identifiers of a list from an environment. *)
+
+ val equal : t -> t -> bool
+end = struct
+ module M = Map.Make(Ident)
+
+ (** A "t" maps each rec-bound variable to an access status *)
+ type t = Mode.t M.t
+
+ let equal = M.equal Mode.equal
+
+ let find (id: Ident.t) (tbl: t) =
+ try M.find id tbl with Not_found -> Ignore
+
+ let empty = M.empty
+
+ let join (x: t) (y: t) =
+ M.fold
+ (fun (id: Ident.t) (v: Mode.t) (tbl: t) ->
+ let v' = find id tbl in
+ M.add id (Mode.join v v') tbl)
+ x y
+
+ let join_list li = List.fold_left join empty li
+
+ let compose m env =
+ M.map (Mode.compose m) env
+
+ let single id mode = M.add id mode empty
+
+ let unguarded env li =
+ List.filter (fun id -> Mode.rank (find id env) > Mode.rank Guard) li
+
+ let dependent env li =
+ List.filter (fun id -> Mode.rank (find id env) > Mode.rank Ignore) li
+
+ let remove = M.remove
+
+ let take id env = (find id env, remove id env)
+
+ let remove_list l env =
+ List.fold_left (fun env id -> M.remove id env) env l
+end
+
+let remove_pat pat env =
+ Env.remove_list (pat_bound_idents pat) env
+
+let remove_patlist pats env =
+ List.fold_right remove_pat pats env
+
+(* Usage mode judgments.
+
+ There are two main groups of judgment functions:
+
+ - Judgments of the form "G |- ... : m"
+ compute the environment G of a subterm ... from its mode m, so
+ the corresponding function has type [... -> Mode.t -> Env.t].
+
+ We write [... -> term_judg] in this case.
+
+ - Judgments of the form "G |- ... : m -| G'"
+
+ correspond to binding constructs (for example "let x = e" in the
+ term "let x = e in body") that have both an exterior environment
+ G (the environment of the whole term "let x = e in body") and an
+ interior environment G' (the environment at the "in", after the
+ binding construct has introduced new names in scope).
+
+ For example, let-binding could be given the following rule:
+
+ G |- e : m + m'
+ -----------------------------------
+ G+G' |- (let x = e) : m -| x:m', G'
+
+ Checking the whole term composes this judgment
+ with the "G |- e : m" form for the let body:
+
+ G |- (let x = e) : m -| G'
+ G' |- body : m
+ -------------------------------
+ G |- let x = e in body : m
+
+ To this judgment "G |- e : m -| G'" our implementation gives the
+ type [... -> Mode.t -> Env.t -> Env.t]: it takes the mode and
+ interior environment as inputs, and returns the exterior
+ environment.
+
+ We write [... -> bind_judg] in this case.
+*)
+type term_judg = Mode.t -> Env.t
+type bind_judg = Mode.t -> Env.t -> Env.t
+
+let option : 'a. ('a -> term_judg) -> 'a option -> term_judg =
+ fun f o m -> match o with
+ | None -> Env.empty
+ | Some v -> f v m
+let list : 'a. ('a -> term_judg) -> 'a list -> term_judg =
+ fun f li m ->
+ List.fold_left (fun env item -> Env.join env (f item m)) Env.empty li
+let array : 'a. ('a -> term_judg) -> 'a array -> term_judg =
+ fun f ar m ->
+ Array.fold_left (fun env item -> Env.join env (f item m)) Env.empty ar
+
+let single : Ident.t -> term_judg = Env.single
+let remove_id : Ident.t -> term_judg -> term_judg =
+ fun id f m -> Env.remove id (f m)
+let remove_ids : Ident.t list -> term_judg -> term_judg =
+ fun ids f m -> Env.remove_list ids (f m)
+
+let join : term_judg list -> term_judg =
+ fun li m -> Env.join_list (List.map (fun f -> f m) li)
+
+let empty = fun _ -> Env.empty
+
+(* A judgment [judg] takes a mode from the context as input, and
+ returns an environment. The judgment [judg << m], given a mode [m']
+ from the context, evaluates [judg] in the composed mode [m'[m]]. *)
+let (<<) : term_judg -> Mode.t -> term_judg =
+ fun f inner_mode -> fun outer_mode -> f (Mode.compose outer_mode inner_mode)
+
+(* A binding judgment [binder] expects a mode and an inner environment,
+ and returns an outer environment. [binder >> judg] computes
+ the inner environment as the environment returned by [judg]
+ in the ambient mode. *)
+let (>>) : bind_judg -> term_judg -> term_judg =
+ fun binder term mode -> binder mode (term mode)
+
+(* Expression judgment:
+ G |- e : m
+ where (m) is an input of the code and (G) is an output;
+ in the Prolog mode notation, this is (+G |- -e : -m).
+*)
+let rec expression : Typedtree.expression -> term_judg =
+ fun exp -> match exp.exp_desc with
+ | Texp_ident (pth, _, _) ->
+ path pth
+ | Texp_let (rec_flag, bindings, body) ->
+ (*
+ G |- <bindings> : m -| G'
+ G' |- body : m
+ -------------------------------
+ G |- let <bindings> in body : m
+ *)
+ value_bindings rec_flag bindings >> expression body
+ | Texp_letmodule (x, _, _, mexp, e) ->
+ module_binding (x, mexp) >> expression e
+ | Texp_match (e, cases, eff_cases, _) ->
+ (* TODO: update comment below for eff_cases
+ (Gi; mi |- pi -> ei : m)^i
+ G |- e : sum(mi)^i
+ ----------------------------------------------
+ G + sum(Gi)^i |- match e with (pi -> ei)^i : m
+ *)
+ (fun mode ->
+ let pat_envs, pat_modes =
+ List.split (List.map (fun c -> case c mode) cases) in
+ let env_e = expression e (List.fold_left Mode.join Ignore pat_modes) in
+ let eff_envs, eff_modes =
+ List.split (List.map (fun c -> case c mode) eff_cases) in
+ let eff_e = expression e (List.fold_left Mode.join Ignore eff_modes) in
+ Env.join_list
+ ((Env.join_list (env_e :: pat_envs)) :: (eff_e :: eff_envs)))
+ | Texp_for (_, _, low, high, _, body) ->
+ (*
+ G1 |- low: m[Dereference]
+ G2 |- high: m[Dereference]
+ G3 |- body: m[Guard]
+ ---
+ G1 + G2 + G3 |- for _ = low to high do body done: m
+ *)
+ join [
+ expression low << Dereference;
+ expression high << Dereference;
+ expression body << Guard;
+ ]
+ | Texp_constant _ ->
+ empty
+ | Texp_new (pth, _, _) ->
+ (*
+ G |- c: m[Dereference]
+ -----------------------
+ G |- new c: m
+ *)
+ path pth << Dereference
+ | Texp_instvar (self_path, pth, _inst_var) ->
+ join [path self_path << Dereference; path pth]
+ | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, [_, Some arg])
+ when is_ref vd ->
+ (*
+ G |- e: m[Guard]
+ ------------------
+ G |- ref e: m
+ *)
+ expression arg << Guard
+ | Texp_apply (e, args) ->
+ (* [args] may contain omitted arguments, corresponding to labels in
+ the function's type that were not passed in the actual application.
+ The arguments before the first omitted argument are passed to the
+ function immediately, so they are dereferenced. The arguments after
+ the first omitted one are stored in a closure, so guarded.
+ The function itself is called immediately (dereferenced) if there
+ is at least one argument before the first omitted one.
+ On the other hand, if the first argument is omitted then the
+ function is stored in the closure without being called. *)
+ let rec split_args ~has_omitted_arg = function
+ | [] -> [], []
+ | (_, None) :: rest -> split_args ~has_omitted_arg:true rest
+ | (_, Some arg) :: rest ->
+ let applied, delayed = split_args ~has_omitted_arg rest in
+ if has_omitted_arg
+ then applied, arg :: delayed
+ else arg :: applied, delayed
+ in
+ let applied, delayed = split_args ~has_omitted_arg:false args in
+ let function_mode =
+ match applied with
+ | [] -> Guard
+ | _ :: _ -> Dereference
+ in
+ join [expression e << function_mode;
+ list expression applied << Dereference;
+ list expression delayed << Guard]
+ | Texp_tuple exprs ->
+ list expression exprs << Guard
+ | Texp_array exprs ->
+ let array_mode = match Typeopt.array_kind exp with
+ | Lambda.Pfloatarray ->
+ (* (flat) float arrays unbox their elements *)
+ Dereference
+ | Lambda.Pgenarray ->
+ (* This is counted as a use, because constructing a generic array
+ involves inspecting to decide whether to unbox (PR#6939). *)
+ Dereference
+ | Lambda.Paddrarray | Lambda.Pintarray ->
+ (* non-generic, non-float arrays act as constructors *)
+ Guard
+ in
+ list expression exprs << array_mode
+ | Texp_construct (_, desc, exprs) ->
+ let access_constructor =
+ match desc.cstr_tag with
+ | Cstr_extension (pth, _) ->
+ path pth << Dereference
+ | _ -> empty
+ in
+ let m' = match desc.cstr_tag with
+ | Cstr_unboxed ->
+ Return
+ | Cstr_constant _ | Cstr_block _ | Cstr_extension _ ->
+ Guard
+ in
+ join [
+ access_constructor;
+ list expression exprs << m'
+ ]
+ | Texp_variant (_, eo) ->
+ (*
+ G |- e: m[Guard]
+ ------------------ -----------
+ G |- `A e: m [] |- `A: m
+ *)
+ option expression eo << Guard
+ | Texp_record { fields = es; extended_expression = eo;
+ representation = rep } ->
+ let field_mode = match rep with
+ | Record_float -> Dereference
+ | Record_unboxed _ -> Return
+ | Record_regular | Record_inlined _
+ | Record_extension _ -> Guard
+ in
+ let field (_label, field_def) = match field_def with
+ Kept _ -> empty
+ | Overridden (_, e) -> expression e
+ in
+ join [
+ array field es << field_mode;
+ option expression eo << Dereference
+ ]
+ | Texp_ifthenelse (cond, ifso, ifnot) ->
+ (*
+ Gc |- c: m[Dereference]
+ G1 |- e1: m
+ G2 |- e2: m
+ ---
+ Gc + G1 + G2 |- if c then e1 else e2: m
+
+ Note: `if c then e1 else e2` is treated in the same way as
+ `match c with true -> e1 | false -> e2`
+ *)
+ join [
+ expression cond << Dereference;
+ expression ifso;
+ option expression ifnot;
+ ]
+ | Texp_setfield (e1, _, _, e2) ->
+ (*
+ G1 |- e1: m[Dereference]
+ G2 |- e2: m[Dereference]
+ ---
+ G1 + G2 |- e1.x <- e2: m
+
+ Note: e2 is dereferenced in the case of a field assignment to
+ a record of unboxed floats in that case, e2 evaluates to
+ a boxed float and it is unboxed on assignment.
+ *)
+ join [
+ expression e1 << Dereference;
+ expression e2 << Dereference;
+ ]
+ | Texp_sequence (e1, e2) ->
+ (*
+ G1 |- e1: m[Guard]
+ G2 |- e2: m
+ --------------------
+ G1 + G2 |- e1; e2: m
+
+ Note: `e1; e2` is treated in the same way as `let _ = e1 in e2`
+ *)
+ join [
+ expression e1 << Guard;
+ expression e2;
+ ]
+ | Texp_while (cond, body) ->
+ (*
+ G1 |- cond: m[Dereference]
+ G2 |- body: m[Guard]
+ ---------------------------------
+ G1 + G2 |- while cond do body done: m
+ *)
+ join [
+ expression cond << Dereference;
+ expression body << Guard;
+ ]
+ | Texp_send (e1, _) ->
+ (*
+ G |- e: m[Dereference]
+ ---------------------- (plus weird 'eo' option)
+ G |- e#x: m
+ *)
+ join [
+ expression e1 << Dereference
+ ]
+ | Texp_field (e, _, _) ->
+ (*
+ G |- e: m[Dereference]
+ -----------------------
+ G |- e.x: m
+ *)
+ expression e << Dereference
+ | Texp_setinstvar (pth,_,_,e) ->
+ (*
+ G |- e: m[Dereference]
+ ----------------------
+ G |- x <- e: m
+ *)
+ join [
+ path pth << Dereference;
+ expression e << Dereference;
+ ]
+ | Texp_letexception ({ext_id}, e) ->
+ (* G |- e: m
+ ----------------------------
+ G |- let exception A in e: m
+ *)
+ remove_id ext_id (expression e)
+ | Texp_assert (e, _) ->
+ (*
+ G |- e: m[Dereference]
+ -----------------------
+ G |- assert e: m
+
+ Note: `assert e` is treated just as if `assert` was a function.
+ *)
+ expression e << Dereference
+ | Texp_pack mexp ->
+ (*
+ G |- M: m
+ ----------------
+ G |- module M: m
+ *)
+ modexp mexp
+ | Texp_object (clsstrct, _) ->
+ class_structure clsstrct
+ | Texp_try (e, cases, eff_cases) ->
+ (*
+ G |- e: m (Gi; _ |- pi -> ei : m)^i
+ --------------------------------------------
+ G + sum(Gi)^i |- try e with (pi -> ei)^i : m
+
+ Contrarily to match, the patterns p do not inspect
+ the value of e, so their mode does not influence the
+ mode of e.
+ *)
+ let case_env c m = fst (case c m) in
+ join [
+ expression e;
+ list case_env cases;
+ list case_env eff_cases;
+ ]
+ | Texp_override (pth, fields) ->
+ (*
+ G |- pth : m (Gi |- ei : m[Dereference])^i
+ ----------------------------------------------------
+ G + sum(Gi)^i |- {< (xi = ei)^i >} (at path pth) : m
+
+ Note: {< .. >} is desugared to a function application, but
+ the function implementation might still use its arguments in
+ a guarded way only -- intuitively it should behave as a constructor.
+ We could possibly refine the arguments' Dereference into Guard here.
+ *)
+ let field (_, _, arg) = expression arg in
+ join [
+ path pth << Dereference;
+ list field fields << Dereference;
+ ]
+ | Texp_function (params, body) ->
+ (*
+ G |-{body} b : m[Delay]
+ (Hj |-{def} Pj : m[Delay])^j
+ H := sum(Hj)^j
+ ps := sum(pat(Pj))^j
+ -----------------------------------
+ G + H - ps |- fun (Pj)^j -> b : m
+ *)
+ let param_pat param =
+ (* param P ::=
+ | ?(pat = expr)
+ | pat
+
+ Define pat(P) as
+ pat if P = ?(pat = expr)
+ pat if P = pat
+ *)
+ match param.fp_kind with
+ | Tparam_pat pat -> pat
+ | Tparam_optional_default (pat, _) -> pat
+ in
+ (* Optional argument defaults.
+
+ G |-{def} P : m
+ *)
+ let param_default param =
+ match param.fp_kind with
+ | Tparam_optional_default (_, default) ->
+ (*
+ G |- e : m
+ ------------------
+ G |-{def} ?(p=e) : m
+ *)
+ expression default
+ | Tparam_pat _ ->
+ (*
+ ------------------
+ . |-{def} p : m
+ *)
+ empty
+ in
+ let patterns = List.map param_pat params in
+ let defaults = List.map param_default params in
+ let body = function_body body in
+ let f = join (body :: defaults) << Delay in
+ (fun m ->
+ let env = f m in
+ remove_patlist patterns env)
+ | Texp_lazy e ->
+ (*
+ G |- e: m[Delay]
+ ---------------- (modulo some subtle compiler optimizations)
+ G |- lazy e: m
+ *)
+ let lazy_mode = match Typeopt.classify_lazy_argument e with
+ | `Constant_or_function
+ | `Identifier _
+ | `Float_that_cannot_be_shortcut ->
+ Return
+ | `Other ->
+ Delay
+ in
+ expression e << lazy_mode
+ | Texp_letop{let_; ands; body; _} ->
+ let case_env c m = fst (case c m) in
+ join [
+ list binding_op (let_ :: ands) << Dereference;
+ case_env body << Delay
+ ]
+ | Texp_unreachable ->
+ (*
+ ----------
+ [] |- .: m
+ *)
+ empty
+ | Texp_extension_constructor (_lid, pth) ->
+ path pth << Dereference
+ | Texp_open (od, e) ->
+ open_declaration od >> expression e
+
+(* Function bodies.
+
+ G |-{body} b : m
+*)
+and function_body body =
+ match body with
+ | Tfunction_body body ->
+ (*
+ G |- e : m
+ ------------------
+ G |-{body} e : m (**)
+
+ (**) The "e" here stands for [Tfunction_body] as opposed to
+ [Tfunction_cases].
+ *)
+ expression body
+ | Tfunction_cases { cases; _ } ->
+ (*
+ (Gi; _ |- pi -> ei : m)^i (**)
+ ------------------
+ sum(Gi)^i |-{body} function (pi -> ei)^i : m
+
+ (**) Contrarily to match, the values that are pattern-matched
+ are bound locally, so the pattern modes do not influence
+ the final environment.
+ *)
+ List.map (fun c mode -> fst (case c mode)) cases
+ |> join
+
+and binding_op : Typedtree.binding_op -> term_judg =
+ fun bop ->
+ join [path bop.bop_op_path; expression bop.bop_exp]
+
+and class_structure : Typedtree.class_structure -> term_judg =
+ fun cs -> list class_field cs.cstr_fields
+
+and class_field : Typedtree.class_field -> term_judg =
+ fun cf -> match cf.cf_desc with
+ | Tcf_inherit (_, ce, _super, _inh_vars, _inh_meths) ->
+ class_expr ce << Dereference
+ | Tcf_val (_lab, _mut, _, cfk, _) ->
+ class_field_kind cfk
+ | Tcf_method (_, _, cfk) ->
+ class_field_kind cfk
+ | Tcf_constraint _ ->
+ empty
+ | Tcf_initializer e ->
+ expression e << Dereference
+ | Tcf_attribute _ ->
+ empty
+
+and class_field_kind : Typedtree.class_field_kind -> term_judg =
+ fun cfk -> match cfk with
+ | Tcfk_virtual _ ->
+ empty
+ | Tcfk_concrete (_, e) ->
+ expression e << Dereference
+
+and modexp : Typedtree.module_expr -> term_judg =
+ fun mexp -> match mexp.mod_desc with
+ | Tmod_ident (pth, _) ->
+ path pth
+ | Tmod_structure s ->
+ structure s
+ | Tmod_functor (_, e) ->
+ modexp e << Delay
+ | Tmod_apply (f, p, _) ->
+ join [
+ modexp f << Dereference;
+ modexp p << Dereference;
+ ]
+ | Tmod_apply_unit f ->
+ modexp f << Dereference
+ | Tmod_constraint (mexp, _, _, coe) ->
+ let rec coercion coe k = match coe with
+ | Tcoerce_none ->
+ k Return
+ | Tcoerce_structure _
+ | Tcoerce_functor _ ->
+ (* These coercions perform a shallow copy of the input module,
+ by creating a new module with fields obtained by accessing
+ the same fields in the input module. *)
+ k Dereference
+ | Tcoerce_primitive _ ->
+ (* This corresponds to 'external' declarations,
+ and the coercion ignores its argument *)
+ k Ignore
+ | Tcoerce_alias (_, pth, coe) ->
+ (* Alias coercions ignore their arguments, but they evaluate
+ their alias module 'pth' under another coercion. *)
+ coercion coe (fun m -> path pth << m)
+ in
+ coercion coe (fun m -> modexp mexp << m)
+ | Tmod_unpack (e, _) ->
+ expression e
+
+
+(* G |- pth : m *)
+and path : Path.t -> term_judg =
+ (*
+ ------------
+ x: m |- x: m
+
+ G |- A: m[Dereference]
+ -----------------------
+ G |- A.x: m
+
+ G1 |- A: m[Dereference]
+ G2 |- B: m[Dereference]
+ ------------------------ (as for term application)
+ G1 + G2 |- A(B): m
+ *)
+ fun pth -> match pth with
+ | Path.Pident x ->
+ single x
+ | Path.Pdot (t, _) ->
+ path t << Dereference
+ | Path.Papply (f, p) ->
+ join [
+ path f << Dereference;
+ path p << Dereference;
+ ]
+ | Path.Pextra_ty (p, _extra) ->
+ path p
+
+(* G |- struct ... end : m *)
+and structure : Typedtree.structure -> term_judg =
+ (*
+ G1, {x: _, x in vars(G1)} |- item1: G2 + ... + Gn in m
+ G2, {x: _, x in vars(G2)} |- item2: G3 + ... + Gn in m
+ ...
+ Gn, {x: _, x in vars(Gn)} |- itemn: [] in m
+ ---
+ (G1 + ... + Gn) - V |- struct item1 ... itemn end: m
+ *)
+ fun s m ->
+ List.fold_right (fun it env -> structure_item it m env)
+ s.str_items Env.empty
+
+(* G |- <structure item> : m -| G'
+ where G is an output and m, G' are inputs *)
+and structure_item : Typedtree.structure_item -> bind_judg =
+ fun s m env -> match s.str_desc with
+ | Tstr_eval (e, _) ->
+ (*
+ Ge |- e: m[Guard]
+ G |- items: m -| G'
+ ---------------------------------
+ Ge + G |- (e;; items): m -| G'
+
+ The expression `e` is treated in the same way as let _ = e
+ *)
+ let judg_e = expression e << Guard in
+ Env.join (judg_e m) env
+ | Tstr_value (rec_flag, bindings) ->
+ value_bindings rec_flag bindings m env
+ | Tstr_module {mb_id; mb_expr} ->
+ module_binding (mb_id, mb_expr) m env
+ | Tstr_recmodule mbs ->
+ let bindings = List.map (fun {mb_id; mb_expr} -> (mb_id, mb_expr)) mbs in
+ recursive_module_bindings bindings m env
+ | Tstr_primitive _ ->
+ env
+ | Tstr_type _ ->
+ (*
+ -------------------
+ G |- type t: m -| G
+ *)
+ env
+ | Tstr_typext {tyext_constructors = exts; _} ->
+ let ext_ids = List.map (fun {ext_id = id; _} -> id) exts in
+ Env.join
+ (list extension_constructor exts m)
+ (Env.remove_list ext_ids env)
+ | Tstr_exception {tyexn_constructor = ext; _} ->
+ Env.join
+ (extension_constructor ext m)
+ (Env.remove ext.ext_id env)
+ | Tstr_modtype _
+ | Tstr_class_type _
+ | Tstr_attribute _ ->
+ env
+ | Tstr_open od ->
+ open_declaration od m env
+ | Tstr_class classes ->
+ let class_ids =
+ let class_id ({ci_id_class = id; _}, _) = id in
+ List.map class_id classes in
+ let class_declaration ({ci_expr; _}, _) m =
+ Env.remove_list class_ids (class_expr ci_expr m) in
+ Env.join
+ (list class_declaration classes m)
+ (Env.remove_list class_ids env)
+ | Tstr_include { incl_mod = mexp; incl_type = mty; _ } ->
+ let included_ids = List.map Types.signature_item_id mty in
+ Env.join (modexp mexp m) (Env.remove_list included_ids env)
+
+(* G |- module M = E : m -| G *)
+and module_binding : (Ident.t option * Typedtree.module_expr) -> bind_judg =
+ fun (id, mexp) m env ->
+ (*
+ GE |- E: m[mM + Guard]
+ -------------------------------------
+ GE + G |- module M = E : m -| M:mM, G
+ *)
+ let judg_E, env =
+ match id with
+ | None -> modexp mexp << Guard, env
+ | Some id ->
+ let mM, env = Env.take id env in
+ let judg_E = modexp mexp << (Mode.join mM Guard) in
+ judg_E, env
+ in
+ Env.join (judg_E m) env
+
+and open_declaration : Typedtree.open_declaration -> bind_judg =
+ fun { open_expr = mexp; open_bound_items = sg; _ } m env ->
+ let judg_E = modexp mexp in
+ let bound_ids = List.map Types.signature_item_id sg in
+ Env.join (judg_E m) (Env.remove_list bound_ids env)
+
+and recursive_module_bindings
+ : (Ident.t option * Typedtree.module_expr) list -> bind_judg =
+ fun m_bindings m env ->
+ let mids = List.filter_map fst m_bindings in
+ let binding (mid, mexp) m =
+ let judg_E =
+ match mid with
+ | None -> modexp mexp << Guard
+ | Some mid ->
+ let mM = Env.find mid env in
+ modexp mexp << (Mode.join mM Guard)
+ in
+ Env.remove_list mids (judg_E m)
+ in
+ Env.join (list binding m_bindings m) (Env.remove_list mids env)
+
+and class_expr : Typedtree.class_expr -> term_judg =
+ fun ce -> match ce.cl_desc with
+ | Tcl_ident (pth, _, _) ->
+ path pth << Dereference
+ | Tcl_structure cs ->
+ class_structure cs
+ | Tcl_fun (_, _, args, ce, _) ->
+ let ids = List.map fst args in
+ remove_ids ids (class_expr ce << Delay)
+ | Tcl_apply (ce, args) ->
+ let arg (_label, eo) = option expression eo in
+ join [
+ class_expr ce << Dereference;
+ list arg args << Dereference;
+ ]
+ | Tcl_let (rec_flag, bindings, _, ce) ->
+ value_bindings rec_flag bindings >> class_expr ce
+ | Tcl_constraint (ce, _, _, _, _) ->
+ class_expr ce
+ | Tcl_open (_, ce) ->
+ class_expr ce
+
+and extension_constructor : Typedtree.extension_constructor -> term_judg =
+ fun ec -> match ec.ext_kind with
+ | Text_decl _ ->
+ empty
+ | Text_rebind (pth, _lid) ->
+ path pth
+
+(* G |- let (rec?) (pi = ei)^i : m -| G' *)
+and value_bindings : rec_flag -> Typedtree.value_binding list -> bind_judg =
+ fun rec_flag bindings mode bound_env ->
+ let all_bound_pats = List.map (fun vb -> vb.vb_pat) bindings in
+ let outer_env = remove_patlist all_bound_pats bound_env in
+ let bindings_env =
+ match rec_flag with
+ | Nonrecursive ->
+ (*
+ (Gi, pi:_ |- ei : m[mbody_i])^i (pi : mbody_i -| D)^i
+ ------------------------------------------------------------
+ Sum(Gi) + (D - (pi)^i) |- let (pi=ei)^i : m -| D
+ *)
+ let binding_env {vb_pat; vb_expr; _} m =
+ let m' = Mode.compose m (pattern vb_pat bound_env) in
+ remove_pat vb_pat (expression vb_expr m') in
+ list binding_env bindings mode
+ | Recursive ->
+ (*
+ (Gi, (xj : mdef_ij)^j |- ei : m[mbody_i])^i (xi : mbody_i -| D)^i
+ G'i = Gi + mdef_ij[G'j]
+ -------------------------------------------------------------------
+ Sum(G'i) + (D - (pi)^i) |- let rec (xi=ei)^i : m -| D
+
+ The (mdef_ij)^i,j are a family of modes over two indices:
+ mdef_ij represents the mode of use, within e_i the definition of x_i,
+ of the mutually-recursive variable x_j.
+
+ The (G'i)^i are defined from the (Gi)^i as a family of equations,
+ whose smallest solution is computed as a least fixpoint.
+
+ The (Gi)^i are the "immediate" dependencies of each (ei)^i
+ on the outer context (excluding the mutually-defined
+ variables).
+ The (G'i)^i contain the "transitive" dependencies as well:
+ if ei depends on xj, then the dependencies of G'i of xi
+ must contain the dependencies of G'j, composed by
+ the mode mdef_ij of use of xj in ei.
+
+ For example, consider:
+
+ let rec z =
+ let rec x = ref y
+ and y = ref z
+ in f x
+
+ this definition should be rejected as the body [f x]
+ dereferences [x], which can be used to access the
+ yet-unitialized value [z]. This requires realizing that [x]
+ depends on [z] through [y], which requires the transitive
+ closure computation.
+
+ An earlier version of our check would take only the (Gi)^i
+ instead of the (G'i)^i, which is incorrect and would accept
+ the example above.
+ *)
+ (* [binding_env] takes a binding (x_i = e_i)
+ and computes (Gi, (mdef_ij)^j). *)
+ let binding_env {vb_pat = x_i; vb_expr = e_i; _} =
+ let mbody_i = pattern x_i bound_env in
+ (* Gi, (x_j:mdef_ij)^j *)
+ let rhs_env_i = expression e_i (Mode.compose mode mbody_i) in
+ (* (mdef_ij)^j (for a fixed i) *)
+ let mutual_modes =
+ let mdef_ij {vb_pat = x_j; _} = pattern x_j rhs_env_i in
+ List.map mdef_ij bindings in
+ (* Gi *)
+ let env_i = remove_patlist all_bound_pats rhs_env_i in
+ (* (Gi, (mdef_ij)^j) *)
+ (env_i, mutual_modes) in
+ let env, mdef =
+ List.split (List.map binding_env bindings) in
+ let rec transitive_closure env =
+ let transitive_deps env_i mdef_i =
+ (* Gi, (mdef_ij)^j => Gi + Sum_j mdef_ij[Gj] *)
+ Env.join env_i
+ (Env.join_list (List.map2 Env.compose mdef_i env)) in
+ let env' = List.map2 transitive_deps env mdef in
+ if List.for_all2 Env.equal env env'
+ then env'
+ else transitive_closure env'
+ in
+ let env'_i = transitive_closure env in
+ Env.join_list env'_i
+ in Env.join bindings_env outer_env
+
+(* G; m' |- (p -> e) : m
+ with outputs G, m' and input m
+
+ m' is the mode under which the scrutinee of p
+ (the value matched against p) is placed.
+*)
+and case
+ : 'k . 'k Typedtree.case -> mode -> Env.t * mode
+ = fun { Typedtree.c_lhs; c_guard; c_rhs } ->
+ (*
+ Ge |- e : m Gg |- g : m[Dereference]
+ G := Ge+Gg p : mp -| G
+ ----------------------------------------
+ G - p; m[mp] |- (p (when g)? -> e) : m
+ *)
+ let judg = join [
+ option expression c_guard << Dereference;
+ expression c_rhs;
+ ] in
+ (fun m ->
+ let env = judg m in
+ (remove_pat c_lhs env), Mode.compose m (pattern c_lhs env))
+
+(* p : m -| G
+ with output m and input G
+
+ m is the mode under which the scrutinee of p is placed.
+*)
+and pattern : type k . k general_pattern -> Env.t -> mode = fun pat env ->
+ (*
+ mp := | Dereference if p is destructuring
+ | Guard otherwise
+ me := sum{G(x), x in vars(p)}
+ --------------------------------------------
+ p : (mp + me) -| G
+ *)
+ let m_pat = if is_destructuring_pattern pat
+ then Dereference
+ else Guard
+ in
+ let m_env =
+ pat_bound_idents pat
+ |> List.map (fun id -> Env.find id env)
+ |> List.fold_left Mode.join Ignore
+ in
+ Mode.join m_pat m_env
+
+and is_destructuring_pattern : type k . k general_pattern -> bool =
+ fun pat -> match pat.pat_desc with
+ | Tpat_any -> false
+ | Tpat_var (_, _, _) -> false
+ | Tpat_alias (pat, _, _, _) -> is_destructuring_pattern pat
+ | Tpat_constant _ -> true
+ | Tpat_tuple _ -> true
+ | Tpat_construct _ -> true
+ | Tpat_variant _ -> true
+ | Tpat_record (_, _) -> true
+ | Tpat_array _ -> true
+ | Tpat_lazy _ -> true
+ | Tpat_value pat -> is_destructuring_pattern (pat :> pattern)
+ | Tpat_exception _ -> false
+ | Tpat_or (l,r,_) ->
+ is_destructuring_pattern l || is_destructuring_pattern r
+
+let is_valid_recursive_expression idlist expr : sd option =
+ match expr.exp_desc with
+ | Texp_function _ ->
+ (* Fast path: functions can never have invalid recursive references *)
+ Some Static
+ | _ ->
+ let rkind = classify_expression expr in
+ let is_valid =
+ match rkind with
+ | Static ->
+ (* The expression has known size or is constant *)
+ let ty = expression expr Return in
+ Env.unguarded ty idlist = []
+ | Dynamic ->
+ (* The expression has unknown size *)
+ let ty = expression expr Return in
+ Env.unguarded ty idlist = [] && Env.dependent ty idlist = []
+ in
+ if is_valid then Some rkind else None
+
+(* A class declaration may contain let-bindings. If they are recursive,
+ their validity will already be checked by [is_valid_recursive_expression]
+ during type-checking. This function here prevents a different kind of
+ invalid recursion, which is the unsafe creations of objects of this class
+ in the let-binding. For example,
+ {|class a = let x = new a in object ... end|}
+ is forbidden, but
+ {|class a = let x () = new a in object ... end|}
+ is allowed.
+*)
+let is_valid_class_expr idlist ce =
+ let rec class_expr : mode -> Typedtree.class_expr -> Env.t =
+ fun mode ce -> match ce.cl_desc with
+ | Tcl_ident (_, _, _) ->
+ (*
+ ----------
+ [] |- a: m
+ *)
+ Env.empty
+ | Tcl_structure _ ->
+ (*
+ -----------------------
+ [] |- struct ... end: m
+ *)
+ Env.empty
+ | Tcl_fun (_, _, _, _, _) -> Env.empty
+ (*
+ ---------------------------
+ [] |- fun x1 ... xn -> C: m
+ *)
+ | Tcl_apply (_, _) -> Env.empty
+ | Tcl_let (rec_flag, bindings, _, ce) ->
+ value_bindings rec_flag bindings mode (class_expr mode ce)
+ | Tcl_constraint (ce, _, _, _, _) ->
+ class_expr mode ce
+ | Tcl_open (_, ce) ->
+ class_expr mode ce
+ in
+ match Env.unguarded (class_expr Return ce) idlist with
+ | [] -> true
+ | _ :: _ -> false
diff --git a/upstream/ocaml_503/typing/value_rec_check.mli b/upstream/ocaml_503/typing/value_rec_check.mli
new file mode 100644
index 0000000000..8010e7c92c
--- /dev/null
+++ b/upstream/ocaml_503/typing/value_rec_check.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremy Yallop, University of Cambridge *)
+(* *)
+(* Copyright 2017 Jeremy Yallop *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+val is_valid_recursive_expression :
+ Ident.t list ->
+ Typedtree.expression ->
+ Value_rec_types.recursive_binding_kind option
+
+val is_valid_class_expr : Ident.t list -> Typedtree.class_expr -> bool
diff --git a/upstream/ocaml_503/typing/value_rec_types.mli b/upstream/ocaml_503/typing/value_rec_types.mli
new file mode 100644
index 0000000000..a907935cc9
--- /dev/null
+++ b/upstream/ocaml_503/typing/value_rec_types.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Vincent Laviron, OCamlPro *)
+(* *)
+(* Copyright 2023 OCamlPro, SAS *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Types related to the compilation of value let-recs (non-functional
+ recursive definitions) *)
+
+(** The kind of recursive bindings, as computed by
+ [Value_rec_check.classify_expression] *)
+type recursive_binding_kind =
+| Static
+ (** Bindings for which some kind of pre-allocation scheme is possible.
+ The expression is allowed to be recursive, as long as its definition does
+ not inspect recursively defined values. *)
+| Dynamic
+ (** Bindings for which pre-allocation is not possible.
+ The expression is not allowed to refer to any recursive variable. *)
diff --git a/upstream/ocaml_503/utils/arg_helper.ml b/upstream/ocaml_503/utils/arg_helper.ml
new file mode 100644
index 0000000000..fa80007ad4
--- /dev/null
+++ b/upstream/ocaml_503/utils/arg_helper.ml
@@ -0,0 +1,127 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2015--2016 OCamlPro SAS *)
+(* Copyright 2015--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+let fatal err =
+ prerr_endline err;
+ exit 2
+
+module Make (S : sig
+ module Key : sig
+ type t
+ val of_string : string -> t
+ module Map : Map.S with type key = t
+ end
+
+ module Value : sig
+ type t
+ val of_string : string -> t
+ end
+end) = struct
+ type parsed = {
+ base_default : S.Value.t;
+ base_override : S.Value.t S.Key.Map.t;
+ user_default : S.Value.t option;
+ user_override : S.Value.t S.Key.Map.t;
+ }
+
+ let default v =
+ { base_default = v;
+ base_override = S.Key.Map.empty;
+ user_default = None;
+ user_override = S.Key.Map.empty; }
+
+ let set_base_default value t =
+ { t with base_default = value }
+
+ let add_base_override key value t =
+ { t with base_override = S.Key.Map.add key value t.base_override }
+
+ let reset_base_overrides t =
+ { t with base_override = S.Key.Map.empty }
+
+ let set_user_default value t =
+ { t with user_default = Some value }
+
+ let add_user_override key value t =
+ { t with user_override = S.Key.Map.add key value t.user_override }
+
+ exception Parse_failure of exn
+
+ let parse_exn str ~update =
+ (* Is the removal of empty chunks really relevant here? *)
+ (* (It has been added to mimic the old Misc.String.split.) *)
+ let values = String.split_on_char ',' str |> List.filter ((<>) "") in
+ let parsed =
+ List.fold_left (fun acc value ->
+ match String.index value '=' with
+ | exception Not_found ->
+ begin match S.Value.of_string value with
+ | value -> set_user_default value acc
+ | exception exn -> raise (Parse_failure exn)
+ end
+ | equals ->
+ let key_value_pair = value in
+ let length = String.length key_value_pair in
+ assert (equals >= 0 && equals < length);
+ if equals = 0 then begin
+ raise (Parse_failure (
+ Failure "Missing key in argument specification"))
+ end;
+ let key =
+ let key = String.sub key_value_pair 0 equals in
+ try S.Key.of_string key
+ with exn -> raise (Parse_failure exn)
+ in
+ let value =
+ let value =
+ String.sub key_value_pair (equals + 1) (length - equals - 1)
+ in
+ try S.Value.of_string value
+ with exn -> raise (Parse_failure exn)
+ in
+ add_user_override key value acc)
+ !update
+ values
+ in
+ update := parsed
+
+ let parse str help_text update =
+ match parse_exn str ~update with
+ | () -> ()
+ | exception (Parse_failure exn) ->
+ fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text)
+
+ type parse_result =
+ | Ok
+ | Parse_failed of exn
+
+ let parse_no_error str update =
+ match parse_exn str ~update with
+ | () -> Ok
+ | exception (Parse_failure exn) -> Parse_failed exn
+
+ let get ~key parsed =
+ match S.Key.Map.find key parsed.user_override with
+ | value -> value
+ | exception Not_found ->
+ match parsed.user_default with
+ | Some value -> value
+ | None ->
+ match S.Key.Map.find key parsed.base_override with
+ | value -> value
+ | exception Not_found -> parsed.base_default
+
+end
diff --git a/upstream/ocaml_503/utils/arg_helper.mli b/upstream/ocaml_503/utils/arg_helper.mli
new file mode 100644
index 0000000000..18f60fea5c
--- /dev/null
+++ b/upstream/ocaml_503/utils/arg_helper.mli
@@ -0,0 +1,68 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2015--2016 OCamlPro SAS *)
+(* Copyright 2015--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Decipher command line arguments of the form
+ <value> | <key>=<value>[,...]
+
+ (as used for example for the specification of inlining parameters
+ varying by simplification round).
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module Make (S : sig
+ module Key : sig
+ type t
+
+ (** The textual representation of a key must not contain '=' or ','. *)
+ val of_string : string -> t
+
+ module Map : Map.S with type key = t
+ end
+
+ module Value : sig
+ type t
+
+ (** The textual representation of a value must not contain ','. *)
+ val of_string : string -> t
+ end
+end) : sig
+ type parsed
+
+ val default : S.Value.t -> parsed
+
+ val set_base_default : S.Value.t -> parsed -> parsed
+
+ val add_base_override : S.Key.t -> S.Value.t -> parsed -> parsed
+
+ val reset_base_overrides : parsed -> parsed
+
+ val set_user_default : S.Value.t -> parsed -> parsed
+
+ val add_user_override : S.Key.t -> S.Value.t -> parsed -> parsed
+
+ val parse : string -> string -> parsed ref -> unit
+
+ type parse_result =
+ | Ok
+ | Parse_failed of exn
+
+ val parse_no_error : string -> parsed ref -> parse_result
+
+ val get : key:S.Key.t -> parsed -> S.Value.t
+end
diff --git a/upstream/ocaml_503/utils/binutils.ml b/upstream/ocaml_503/utils/binutils.ml
new file mode 100644
index 0000000000..916d14d026
--- /dev/null
+++ b/upstream/ocaml_503/utils/binutils.ml
@@ -0,0 +1,684 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2020 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. *)
+(* *)
+(**************************************************************************)
+
+let char_to_hex c =
+ Printf.sprintf "0x%02x" (Char.code c)
+
+let int_to_hex n =
+ Printf.sprintf "0x%x" n
+
+type error =
+ | Truncated_file
+ | Unrecognized of string
+ | Unsupported of string * int64
+ | Out_of_range of string
+
+let error_to_string = function
+ | Truncated_file ->
+ "Truncated file"
+ | Unrecognized magic ->
+ Printf.sprintf "Unrecognized magic: %s"
+ (String.concat " "
+ (List.init (String.length magic)
+ (fun i -> char_to_hex magic.[i])))
+ | Unsupported (s, n) ->
+ Printf.sprintf "Unsupported: %s: 0x%Lx" s n
+ | Out_of_range s ->
+ Printf.sprintf "Out of range constant: %s" s
+
+exception Error of error
+
+let name_at ?max_len buf start =
+ if start < 0 || start > Bytes.length buf then
+ raise (Error (Out_of_range (int_to_hex start)));
+ let max_pos =
+ match max_len with
+ | None -> Bytes.length buf
+ | Some n -> Int.min (Bytes.length buf) (start + n)
+ in
+ let rec loop pos =
+ if pos >= max_pos || Bytes.get buf pos = '\000'
+ then
+ Bytes.sub_string buf start (pos - start)
+ else
+ loop (succ pos)
+ in
+ loop start
+
+let array_find_map f a =
+ let rec loop i =
+ if i >= Array.length a then None
+ else begin
+ match f a.(i) with
+ | None -> loop (succ i)
+ | Some _ as r -> r
+ end
+ in
+ loop 0
+
+let array_find f a =
+ array_find_map (fun x -> if f x then Some x else None) a
+
+let really_input_bytes ic len =
+ let buf = Bytes.create len in
+ really_input ic buf 0 len;
+ buf
+
+let uint64_of_uint32 n =
+ Int64.(logand (of_int32 n) 0xffffffffL)
+
+type endianness =
+ | LE
+ | BE
+
+type bitness =
+ | B32
+ | B64
+
+type decoder =
+ {
+ ic: in_channel;
+ endianness: endianness;
+ bitness: bitness;
+ }
+
+let word_size = function
+ | {bitness = B64; _} -> 8
+ | {bitness = B32; _} -> 4
+
+let get_uint16 {endianness; _} buf idx =
+ match endianness with
+ | LE -> Bytes.get_uint16_le buf idx
+ | BE -> Bytes.get_uint16_be buf idx
+
+let get_uint32 {endianness; _} buf idx =
+ match endianness with
+ | LE -> Bytes.get_int32_le buf idx
+ | BE -> Bytes.get_int32_be buf idx
+
+let get_uint s d buf idx =
+ let n = get_uint32 d buf idx in
+ match Int32.unsigned_to_int n with
+ | None -> raise (Error (Unsupported (s, Int64.of_int32 n)))
+ | Some n -> n
+
+let get_uint64 {endianness; _} buf idx =
+ match endianness with
+ | LE -> Bytes.get_int64_le buf idx
+ | BE -> Bytes.get_int64_be buf idx
+
+let get_word d buf idx =
+ match d.bitness with
+ | B64 -> get_uint64 d buf idx
+ | B32 -> uint64_of_uint32 (get_uint32 d buf idx)
+
+let uint64_to_int s n =
+ match Int64.unsigned_to_int n with
+ | None -> raise (Error (Unsupported (s, n)))
+ | Some n -> n
+
+let load_bytes d off len =
+ LargeFile.seek_in d.ic off;
+ really_input_bytes d.ic len
+
+type t =
+ {
+ defines_symbol: string -> bool;
+ symbol_offset: string -> int64 option;
+ }
+
+module ELF = struct
+
+ (* Reference: http://man7.org/linux/man-pages/man5/elf.5.html *)
+
+ let header_size d =
+ 40 + 3 * word_size d
+
+ type header =
+ {
+ e_shoff: int64;
+ e_shentsize: int;
+ e_shnum: int;
+ e_shstrndx: int;
+ }
+
+ let read_header d =
+ let buf = load_bytes d 0L (header_size d) in
+ let word_size = word_size d in
+ let e_shnum = get_uint16 d buf (36 + 3 * word_size) in
+ let e_shentsize = get_uint16 d buf (34 + 3 * word_size) in
+ let e_shoff = get_word d buf (24 + 2 * word_size) in
+ let e_shstrndx = get_uint16 d buf (38 + 3 * word_size) in
+ {e_shnum; e_shentsize; e_shoff; e_shstrndx}
+
+ type sh_type =
+ | SHT_STRTAB
+ | SHT_DYNSYM
+ | SHT_OTHER
+
+ type section =
+ {
+ sh_name: int;
+ sh_type: sh_type;
+ sh_addr: int64;
+ sh_offset: int64;
+ sh_size: int;
+ sh_entsize: int;
+ sh_name_str: string;
+ }
+
+ let load_section_body d {sh_offset; sh_size; _} =
+ load_bytes d sh_offset sh_size
+
+ let read_sections d {e_shoff; e_shnum; e_shentsize; e_shstrndx; _} =
+ let buf = load_bytes d e_shoff (e_shnum * e_shentsize) in
+ let word_size = word_size d in
+ let mk i =
+ let base = i * e_shentsize in
+ let sh_name = get_uint "sh_name" d buf (base + 0) in
+ let sh_type =
+ match get_uint32 d buf (base + 4) with
+ | 3l -> SHT_STRTAB
+ | 11l -> SHT_DYNSYM
+ | _ -> SHT_OTHER
+ in
+ let sh_addr = get_word d buf (base + 8 + word_size) in
+ let sh_offset = get_word d buf (base + 8 + 2 * word_size) in
+ let sh_size =
+ uint64_to_int "sh_size"
+ (get_word d buf (base + 8 + 3 * word_size))
+ in
+ let sh_entsize =
+ uint64_to_int "sh_entsize"
+ (get_word d buf (base + 16 + 5 * word_size))
+ in
+ {sh_name; sh_type; sh_addr; sh_offset;
+ sh_size; sh_entsize; sh_name_str = ""}
+ in
+ let sections = Array.init e_shnum mk in
+ if e_shstrndx = 0 then
+ (* no string table *)
+ sections
+ else
+ let shstrtbl = load_section_body d sections.(e_shstrndx) in
+ let set_name sec =
+ let sh_name_str = name_at shstrtbl sec.sh_name in
+ {sec with sh_name_str}
+ in
+ Array.map set_name sections
+
+ let read_sections d h =
+ let {e_shoff; e_shentsize; e_shnum; e_shstrndx} = h in
+ if e_shoff = 0L then
+ [||]
+ else begin
+ let buf = lazy (load_bytes d e_shoff e_shentsize) in
+ let word_size = word_size d in
+ let e_shnum =
+ if e_shnum = 0 then
+ (* The real e_shnum is the sh_size of the initial section.*)
+ uint64_to_int "e_shnum"
+ (get_word d (Lazy.force buf) (8 + 3 * word_size))
+ else
+ e_shnum
+ in
+ let e_shstrndx =
+ if e_shstrndx = 0xffff then
+ (* The real e_shstrndx is the sh_link of the initial section. *)
+ get_uint "e_shstrndx" d (Lazy.force buf) (8 + 4 * word_size)
+ else
+ e_shstrndx
+ in
+ read_sections d {h with e_shnum; e_shstrndx}
+ end
+
+ type symbol =
+ {
+ st_name: string;
+ st_value: int64;
+ st_shndx: int;
+ }
+
+ let find_section sections type_ sectname =
+ let f {sh_type; sh_name_str; _} =
+ sh_type = type_ && sh_name_str = sectname
+ in
+ array_find f sections
+
+ let read_symbols d sections =
+ match find_section sections SHT_DYNSYM ".dynsym" with
+ | None -> [| |]
+ | Some {sh_entsize = 0; _} ->
+ raise (Error (Out_of_range "sh_entsize=0"))
+ | Some dynsym ->
+ begin match find_section sections SHT_STRTAB ".dynstr" with
+ | None -> [| |]
+ | Some dynstr ->
+ let strtbl = load_section_body d dynstr in
+ let buf = load_section_body d dynsym in
+ let word_size = word_size d in
+ let mk i =
+ let base = i * dynsym.sh_entsize in
+ let st_name = name_at strtbl (get_uint "st_name" d buf base) in
+ let st_value = get_word d buf (base + word_size (* ! *)) in
+ let st_shndx =
+ let off = match d.bitness with B64 -> 6 | B32 -> 14 in
+ get_uint16 d buf (base + off)
+ in
+ {st_name; st_value; st_shndx}
+ in
+ Array.init (dynsym.sh_size / dynsym.sh_entsize) mk
+ end
+
+ let find_symbol symbols symname =
+ let f = function
+ | {st_shndx = 0; _} -> false
+ | {st_name; _} -> st_name = symname
+ in
+ array_find f symbols
+
+ let symbol_offset sections symbols symname =
+ match find_symbol symbols symname with
+ | None ->
+ None
+ | Some {st_shndx; st_value; _} ->
+ (* st_value in executables and shared objects holds a virtual (absolute)
+ address. See https://refspecs.linuxfoundation.org/elf/elf.pdf, page
+ 1-21, "Symbol Values". *)
+ Some Int64.(add sections.(st_shndx).sh_offset
+ (sub st_value sections.(st_shndx).sh_addr))
+
+ let defines_symbol symbols symname =
+ Option.is_some (find_symbol symbols symname)
+
+ let read ic =
+ seek_in ic 0;
+ let identification = really_input_bytes ic 16 in
+ let bitness =
+ match Bytes.get identification 4 with
+ | '\x01' -> B32
+ | '\x02' -> B64
+ | _ as c ->
+ raise (Error (Unsupported ("ELFCLASS", Int64.of_int (Char.code c))))
+ in
+ let endianness =
+ match Bytes.get identification 5 with
+ | '\x01' -> LE
+ | '\x02' -> BE
+ | _ as c ->
+ raise (Error (Unsupported ("ELFDATA", Int64.of_int (Char.code c))))
+ in
+ let d = {ic; bitness; endianness} in
+ let header = read_header d in
+ let sections = read_sections d header in
+ let symbols = read_symbols d sections in
+ let symbol_offset = symbol_offset sections symbols in
+ let defines_symbol = defines_symbol symbols in
+ {symbol_offset; defines_symbol}
+end
+
+module Mach_O = struct
+
+ (* Reference:
+ https://github.com/aidansteele/osx-abi-macho-file-format-reference *)
+
+ let size_int = 4
+
+ let header_size {bitness; _} =
+ (match bitness with B64 -> 6 | B32 -> 5) * 4 + 2 * size_int
+
+ type header =
+ {
+ ncmds: int;
+ sizeofcmds: int;
+ }
+
+ let read_header d =
+ let buf = load_bytes d 0L (header_size d) in
+ let ncmds = get_uint "ncmds" d buf (8 + 2 * size_int) in
+ let sizeofcmds = get_uint "sizeofcmds" d buf (12 + 2 * size_int) in
+ {ncmds; sizeofcmds}
+
+ type lc_symtab =
+ {
+ symoff: int32;
+ nsyms: int;
+ stroff: int32;
+ strsize: int;
+ }
+
+ type load_command =
+ | LC_SYMTAB of lc_symtab
+ | OTHER
+
+ let read_load_commands d {ncmds; sizeofcmds} =
+ let buf = load_bytes d (Int64.of_int (header_size d)) sizeofcmds in
+ let base = ref 0 in
+ let mk _ =
+ let cmd = get_uint32 d buf (!base + 0) in
+ let cmdsize = get_uint "cmdsize" d buf (!base + 4) in
+ let lc =
+ match cmd with
+ | 0x2l ->
+ let symoff = get_uint32 d buf (!base + 8) in
+ let nsyms = get_uint "nsyms" d buf (!base + 12) in
+ let stroff = get_uint32 d buf (!base + 16) in
+ let strsize = get_uint "strsize" d buf (!base + 20) in
+ LC_SYMTAB {symoff; nsyms; stroff; strsize}
+ | _ ->
+ OTHER
+ in
+ base := !base + cmdsize;
+ lc
+ in
+ Array.init ncmds mk
+
+ type symbol =
+ {
+ n_name: string;
+ n_type: int;
+ n_value: int64;
+ }
+
+ let size_nlist d =
+ 8 + word_size d
+
+ let read_symbols d load_commands =
+ match
+ (* Can it happen there be more than one LC_SYMTAB? *)
+ array_find_map (function
+ | LC_SYMTAB symtab -> Some symtab
+ | _ -> None
+ ) load_commands
+ with
+ | None -> [| |]
+ | Some {symoff; nsyms; stroff; strsize} ->
+ let strtbl = load_bytes d (uint64_of_uint32 stroff) strsize in
+ let buf =
+ load_bytes d (uint64_of_uint32 symoff) (nsyms * size_nlist d) in
+ let size_nlist = size_nlist d in
+ let mk i =
+ let base = i * size_nlist in
+ let n_name = name_at strtbl (get_uint "n_name" d buf (base + 0)) in
+ let n_type = Bytes.get_uint8 buf (base + 4) in
+ let n_value = get_word d buf (base + 8) in
+ {n_name; n_type; n_value}
+ in
+ Array.init nsyms mk
+
+ let fix symname =
+ "_" ^ symname
+
+ let find_symbol symbols symname =
+ let f {n_name; n_type; _} =
+ n_type land 0b1111 = 0b1111 (* N_EXT + N_SECT *) &&
+ n_name = symname
+ in
+ array_find f symbols
+
+ let symbol_offset symbols symname =
+ let symname = fix symname in
+ match find_symbol symbols symname with
+ | None -> None
+ | Some {n_value; _} -> Some n_value
+
+ let defines_symbol symbols symname =
+ let symname = fix symname in
+ Option.is_some (find_symbol symbols symname)
+
+ type magic =
+ | MH_MAGIC
+ | MH_CIGAM
+ | MH_MAGIC_64
+ | MH_CIGAM_64
+
+ let read ic =
+ seek_in ic 0;
+ let magic = really_input_bytes ic 4 in
+ let magic =
+ match Bytes.get_int32_ne magic 0 with
+ | 0xFEEDFACEl -> MH_MAGIC
+ | 0xCEFAEDFEl -> MH_CIGAM
+ | 0xFEEDFACFl -> MH_MAGIC_64
+ | 0xCFFAEDFEl -> MH_CIGAM_64
+ | _ -> (* should not happen *)
+ raise (Error (Unrecognized (Bytes.to_string magic)))
+ in
+ let bitness =
+ match magic with
+ | MH_MAGIC | MH_CIGAM -> B32
+ | MH_MAGIC_64 | MH_CIGAM_64 -> B64
+ in
+ let endianness =
+ match magic, Sys.big_endian with
+ | (MH_MAGIC | MH_MAGIC_64), false
+ | (MH_CIGAM | MH_CIGAM_64), true -> LE
+ | (MH_MAGIC | MH_MAGIC_64), true
+ | (MH_CIGAM | MH_CIGAM_64), false -> BE
+ in
+ let d = {ic; endianness; bitness} in
+ let header = read_header d in
+ let load_commands = read_load_commands d header in
+ let symbols = read_symbols d load_commands in
+ let symbol_offset = symbol_offset symbols in
+ let defines_symbol = defines_symbol symbols in
+ {symbol_offset; defines_symbol}
+end
+
+module FlexDLL = struct
+
+ (* Reference:
+ https://docs.microsoft.com/en-us/windows/win32/debug/pe-format *)
+
+ let header_size = 24
+
+ type header =
+ {
+ e_lfanew: int64;
+ number_of_sections: int;
+ size_of_optional_header: int;
+ _characteristics: int;
+ }
+
+ let read_header e_lfanew d buf =
+ let number_of_sections = get_uint16 d buf 6 in
+ let size_of_optional_header = get_uint16 d buf 20 in
+ let _characteristics = get_uint16 d buf 22 in
+ {e_lfanew; number_of_sections; size_of_optional_header; _characteristics}
+
+ type optional_header_magic =
+ | PE32
+ | PE32PLUS
+
+ type optional_header =
+ {
+ _magic: optional_header_magic;
+ image_base: int64;
+ }
+
+ let read_optional_header d {e_lfanew; size_of_optional_header; _} =
+ if size_of_optional_header = 0 then
+ raise (Error (Unrecognized "SizeOfOptionalHeader=0"));
+ let buf =
+ load_bytes d Int64.(add e_lfanew (of_int header_size))
+ size_of_optional_header
+ in
+ let _magic, image_base =
+ match get_uint16 d buf 0 with
+ | 0x10b -> PE32, uint64_of_uint32 (get_uint32 d buf 28)
+ | 0x20b -> PE32PLUS, get_uint64 d buf 24
+ | n ->
+ raise (Error (Unsupported ("optional_header_magic", Int64.of_int n)))
+ in
+ {_magic; image_base}
+
+ type section =
+ {
+ name: string;
+ _virtual_size: int;
+ virtual_address: int64;
+ size_of_raw_data: int;
+ pointer_to_raw_data: int64;
+ }
+
+ let section_header_size = 40
+
+ let read_sections d
+ {e_lfanew; number_of_sections; size_of_optional_header; _} =
+ let buf =
+ load_bytes d
+ Int64.(add e_lfanew (of_int (header_size + size_of_optional_header)))
+ (number_of_sections * section_header_size)
+ in
+ let mk i =
+ let base = i * section_header_size in
+ let name = name_at ~max_len:8 buf (base + 0) in
+ let _virtual_size = get_uint "virtual_size" d buf (base + 8) in
+ let virtual_address = uint64_of_uint32 (get_uint32 d buf (base + 12)) in
+ let size_of_raw_data = get_uint "size_of_raw_data" d buf (base + 16) in
+ let pointer_to_raw_data =
+ uint64_of_uint32 (get_uint32 d buf (base + 20)) in
+ {name; _virtual_size; virtual_address;
+ size_of_raw_data; pointer_to_raw_data}
+ in
+ Array.init number_of_sections mk
+
+ type symbol =
+ {
+ name: string;
+ address: int64;
+ }
+
+ let load_section_body d {size_of_raw_data; pointer_to_raw_data; _} =
+ load_bytes d pointer_to_raw_data size_of_raw_data
+
+ let find_section sections sectname =
+ array_find (function ({name; _} : section) -> name = sectname) sections
+
+ (* We extract the list of exported symbols as encoded by flexlink, see
+ https://github.com/ocaml/flexdll/blob/bd636def70d941674275b2f4b6c13a34ba23f9c9/reloc.ml
+ #L500-L525 *)
+
+ let read_symbols d {image_base; _} sections =
+ match find_section sections ".exptbl" with
+ | None -> [| |]
+ | Some ({virtual_address; _} as exptbl) ->
+ let buf = load_section_body d exptbl in
+ let numexports =
+ uint64_to_int "numexports" (get_word d buf 0)
+ in
+ let word_size = word_size d in
+ let mk i =
+ let address = get_word d buf (word_size * (2 * i + 1)) in
+ let nameoff = get_word d buf (word_size * (2 * i + 2)) in
+ let name =
+ let off = Int64.(sub nameoff (add virtual_address image_base)) in
+ name_at buf (uint64_to_int "exptbl name offset" off)
+ in
+ {name; address}
+ in
+ Array.init numexports mk
+
+ let symbol_offset {image_base; _} sections symbols =
+ match find_section sections ".data" with
+ | None -> Fun.const None
+ | Some {virtual_address; pointer_to_raw_data; _} ->
+ fun symname ->
+ begin match
+ array_find (function {name; _} -> name = symname) symbols
+ with
+ | None -> None
+ | Some {address; _} ->
+ Some Int64.(add pointer_to_raw_data
+ (sub address (add virtual_address image_base)))
+ end
+
+ let defines_symbol symbols symname =
+ Array.exists (fun {name; _} -> name = symname) symbols
+
+ type machine_type =
+ | IMAGE_FILE_MACHINE_ARM
+ | IMAGE_FILE_MACHINE_ARM64
+ | IMAGE_FILE_MACHINE_AMD64
+ | IMAGE_FILE_MACHINE_I386
+
+ let read ic =
+ let e_lfanew =
+ seek_in ic 0x3c;
+ let buf = really_input_bytes ic 4 in
+ uint64_of_uint32 (Bytes.get_int32_le buf 0)
+ in
+ LargeFile.seek_in ic e_lfanew;
+ let buf = really_input_bytes ic header_size in
+ let magic = Bytes.sub_string buf 0 4 in
+ if magic <> "PE\000\000" then raise (Error (Unrecognized magic));
+ let machine =
+ match Bytes.get_uint16_le buf 4 with
+ | 0x1c0 -> IMAGE_FILE_MACHINE_ARM
+ | 0xaa64 -> IMAGE_FILE_MACHINE_ARM64
+ | 0x8664 -> IMAGE_FILE_MACHINE_AMD64
+ | 0x14c -> IMAGE_FILE_MACHINE_I386
+ | n -> raise (Error (Unsupported ("MACHINETYPE", Int64.of_int n)))
+ in
+ let bitness =
+ match machine with
+ | IMAGE_FILE_MACHINE_AMD64
+ | IMAGE_FILE_MACHINE_ARM64 -> B64
+ | IMAGE_FILE_MACHINE_I386
+ | IMAGE_FILE_MACHINE_ARM -> B32
+ in
+ let d = {ic; endianness = LE; bitness} in
+ let header = read_header e_lfanew d buf in
+ let opt_header = read_optional_header d header in
+ let sections = read_sections d header in
+ let symbols = read_symbols d opt_header sections in
+ let symbol_offset = symbol_offset opt_header sections symbols in
+ let defines_symbol = defines_symbol symbols in
+ {symbol_offset; defines_symbol}
+end
+
+let read ic =
+ seek_in ic 0;
+ let magic = really_input_string ic 4 in
+ match magic.[0], magic.[1], magic.[2], magic.[3] with
+ | '\x7F', 'E', 'L', 'F' ->
+ ELF.read ic
+ | '\xFE', '\xED', '\xFA', '\xCE'
+ | '\xCE', '\xFA', '\xED', '\xFE'
+ | '\xFE', '\xED', '\xFA', '\xCF'
+ | '\xCF', '\xFA', '\xED', '\xFE' ->
+ Mach_O.read ic
+ | 'M', 'Z', _, _ ->
+ FlexDLL.read ic
+ | _ ->
+ raise (Error (Unrecognized magic))
+
+let with_open_in fn f =
+ let ic = open_in_bin fn in
+ Fun.protect ~finally:(fun () -> close_in_noerr ic) (fun () -> f ic)
+
+let read filename =
+ match with_open_in filename read with
+ | t -> Ok t
+ | exception End_of_file ->
+ Result.Error Truncated_file
+ | exception Error err ->
+ Result.Error err
+
+let defines_symbol {defines_symbol; _} symname =
+ defines_symbol symname
+
+let symbol_offset {symbol_offset; _} symname =
+ symbol_offset symname
diff --git a/upstream/ocaml_503/utils/binutils.mli b/upstream/ocaml_503/utils/binutils.mli
new file mode 100644
index 0000000000..44e17fec38
--- /dev/null
+++ b/upstream/ocaml_503/utils/binutils.mli
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2020 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. *)
+(* *)
+(**************************************************************************)
+
+type error =
+ | Truncated_file
+ | Unrecognized of string
+ | Unsupported of string * int64
+ | Out_of_range of string
+
+val error_to_string: error -> string
+
+type t
+
+val read: string -> (t, error) Result.t
+
+val defines_symbol: t -> string -> bool
+
+val symbol_offset: t -> string -> int64 option
diff --git a/upstream/ocaml_503/utils/build_path_prefix_map.ml b/upstream/ocaml_503/utils/build_path_prefix_map.ml
new file mode 100644
index 0000000000..17cfac82e2
--- /dev/null
+++ b/upstream/ocaml_503/utils/build_path_prefix_map.ml
@@ -0,0 +1,118 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* *)
+(* Copyright 2017 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. *)
+(* *)
+(**************************************************************************)
+
+type path = string
+type path_prefix = string
+type error_message = string
+
+let errorf fmt = Printf.ksprintf (fun err -> Error err) fmt
+
+let encode_prefix str =
+ let buf = Buffer.create (String.length str) in
+ let push_char = function
+ | '%' -> Buffer.add_string buf "%#"
+ | '=' -> Buffer.add_string buf "%+"
+ | ':' -> Buffer.add_string buf "%."
+ | c -> Buffer.add_char buf c
+ in
+ String.iter push_char str;
+ Buffer.contents buf
+
+let decode_prefix str =
+ let buf = Buffer.create (String.length str) in
+ let rec loop i =
+ if i >= String.length str
+ then Ok (Buffer.contents buf)
+ else match str.[i] with
+ | ('=' | ':') as c ->
+ errorf "invalid character '%c' in key or value" c
+ | '%' ->
+ let push c = Buffer.add_char buf c; loop (i + 2) in
+ if i + 1 = String.length str then
+ errorf "invalid encoded string %S (trailing '%%')" str
+ else begin match str.[i + 1] with
+ | '#' -> push '%'
+ | '+' -> push '='
+ | '.' -> push ':'
+ | c -> errorf "invalid %%-escaped character '%c'" c
+ end
+ | c ->
+ Buffer.add_char buf c;
+ loop (i + 1)
+ in loop 0
+
+type pair = { target: path_prefix; source : path_prefix }
+
+let encode_pair { target; source } =
+ String.concat "=" [encode_prefix target; encode_prefix source]
+
+let decode_pair str =
+ match String.index str '=' with
+ | exception Not_found ->
+ errorf "invalid key/value pair %S, no '=' separator" str
+ | equal_pos ->
+ let encoded_target = String.sub str 0 equal_pos in
+ let encoded_source =
+ String.sub str (equal_pos + 1) (String.length str - equal_pos - 1) in
+ match decode_prefix encoded_target, decode_prefix encoded_source with
+ | Ok target, Ok source -> Ok { target; source }
+ | ((Error _ as err), _) | (_, (Error _ as err)) -> err
+
+type map = pair option list
+
+let encode_map map =
+ let encode_elem = function
+ | None -> ""
+ | Some pair -> encode_pair pair
+ in
+ List.map encode_elem map
+ |> String.concat ":"
+
+let decode_map str =
+ let exception Shortcut of error_message in
+ let decode_or_empty = function
+ | "" -> None
+ | pair ->
+ begin match decode_pair pair with
+ | Ok str -> Some str
+ | Error err -> raise (Shortcut err)
+ end
+ in
+ let pairs = String.split_on_char ':' str in
+ match List.map decode_or_empty pairs with
+ | exception (Shortcut err) -> Error err
+ | map -> Ok map
+
+let make_target path : pair option -> path option = function
+ | None -> None
+ | Some { target; source } ->
+ let is_prefix =
+ String.length source <= String.length path
+ && String.equal source (String.sub path 0 (String.length source)) in
+ if is_prefix then
+ Some (target ^ (String.sub path (String.length source)
+ (String.length path - String.length source)))
+ else None
+
+let rewrite_first prefix_map path =
+ List.find_map (make_target path) (List.rev prefix_map)
+
+let rewrite_all prefix_map path =
+ List.filter_map (make_target path) (List.rev prefix_map)
+
+let rewrite prefix_map path =
+ match rewrite_first prefix_map path with
+ | None -> path
+ | Some path -> path
diff --git a/upstream/ocaml_503/utils/build_path_prefix_map.mli b/upstream/ocaml_503/utils/build_path_prefix_map.mli
new file mode 100644
index 0000000000..d8ec9caf4d
--- /dev/null
+++ b/upstream/ocaml_503/utils/build_path_prefix_map.mli
@@ -0,0 +1,61 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* *)
+(* Copyright 2017 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. *)
+(* *)
+(**************************************************************************)
+
+(** Rewrite paths for reproducible builds
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+ See
+ {{: https://reproducible-builds.org/specs/build-path-prefix-map/ }
+ the BUILD_PATH_PREFIX_MAP spec}
+*)
+
+
+type path = string
+type path_prefix = string
+type error_message = string
+
+val encode_prefix : path_prefix -> string
+val decode_prefix : string -> (path_prefix, error_message) result
+
+type pair = { target: path_prefix; source : path_prefix }
+
+val encode_pair : pair -> string
+val decode_pair : string -> (pair, error_message) result
+
+type map = pair option list
+
+val encode_map : map -> string
+val decode_map : string -> (map, error_message) result
+
+val rewrite_first : map -> path -> path option
+(** [rewrite_first map path] tries to find a source in [map]
+ that is a prefix of the input [path]. If it succeeds,
+ it replaces this prefix with the corresponding target.
+ If it fails, it just returns [None]. *)
+
+val rewrite_all : map -> path -> path list
+(** [rewrite_all map path] finds all sources in [map]
+ that are a prefix of the input [path]. For each matching
+ source, in priority order, it replaces this prefix with
+ the corresponding target and adds the result to
+ the returned list.
+ If there are no matches, it just returns [[]]. *)
+
+val rewrite : map -> path -> path
+(** [rewrite path] uses [rewrite_first] to try to find a
+ mapping for path. If found, it returns that, otherwise
+ it just returns [path]. *)
diff --git a/upstream/ocaml_503/utils/ccomp.ml b/upstream/ocaml_503/utils/ccomp.ml
new file mode 100644
index 0000000000..defe4d2a4b
--- /dev/null
+++ b/upstream/ocaml_503/utils/ccomp.ml
@@ -0,0 +1,209 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Compiling C files and building C libraries *)
+
+let command cmdline =
+ if !Clflags.verbose then begin
+ prerr_string "+ ";
+ prerr_string cmdline;
+ prerr_newline()
+ end;
+ let res = Sys.command cmdline in
+ if res = 127 then raise (Sys_error cmdline);
+ res
+
+let run_command cmdline = ignore(command cmdline)
+
+(* Build @responsefile to work around OS limitations on
+ command-line length.
+ Under Windows, the max length is 8187 minus the length of the
+ COMSPEC variable (or 7 if it's not set). To be on the safe side,
+ we'll use a response file if we need to pass 4096 or more bytes of
+ arguments.
+ For Unix-like systems, the threshold is 2^16 (64 KiB), which is
+ within the lowest observed limits (2^17 per argument under Linux;
+ between 70000 and 80000 for macOS).
+*)
+
+let build_response_file lst =
+ let (responsefile, oc) = Filename.open_temp_file "camlresp" "" in
+ List.iter (fun f -> Printf.fprintf oc "%s\n" f) lst;
+ close_out oc;
+ at_exit (fun () -> Misc.remove_file responsefile);
+ "@" ^ responsefile
+
+let quote_files ~response_files lst =
+ let lst = List.filter (fun f -> f <> "") lst in
+ let quoted = List.map Filename.quote lst in
+ let s = String.concat " " quoted in
+ if response_files &&
+ (String.length s >= 65536
+ || (String.length s >= 4096 && Sys.os_type = "Win32"))
+ then build_response_file quoted
+ else s
+
+let quote_prefixed ~response_files pr lst =
+ let lst = List.filter (fun f -> f <> "") lst in
+ let lst = List.map (fun f -> pr ^ f) lst in
+ quote_files ~response_files lst
+
+let quote_optfile = function
+ | None -> ""
+ | Some f -> Filename.quote f
+
+let display_msvc_output file name =
+ let c = open_in file in
+ try
+ let first = input_line c in
+ if first <> Filename.basename name then
+ print_endline first;
+ while true do
+ print_endline (input_line c)
+ done
+ with _ ->
+ close_in c;
+ Sys.remove file
+
+let compile_file ?output ?(opt="") ?stable_name name =
+ let (pipe, file) =
+ if Config.ccomp_type = "msvc" && not !Clflags.verbose then
+ try
+ let (t, c) = Filename.open_temp_file "msvc" "stdout" in
+ close_out c;
+ (Printf.sprintf " > %s" (Filename.quote t), t)
+ with _ ->
+ ("", "")
+ else
+ ("", "") in
+ let debug_prefix_map =
+ match stable_name with
+ | Some stable when Config.c_has_debug_prefix_map ->
+ Printf.sprintf " -fdebug-prefix-map=%s=%s" name stable
+ | Some _ | None -> "" in
+ let exit =
+ command
+ (Printf.sprintf
+ "%s%s %s %s -c %s %s %s %s %s%s"
+ (match !Clflags.c_compiler with
+ | Some cc -> cc
+ | None ->
+ let (cflags, cppflags) =
+ if !Clflags.native_code
+ then (Config.native_cflags, Config.native_cppflags)
+ else (Config.bytecode_cflags, Config.bytecode_cppflags) in
+ (String.concat " " [Config.c_compiler; cflags; cppflags]))
+ debug_prefix_map
+ (match output with
+ | None -> ""
+ | Some o -> Printf.sprintf "%s%s" Config.c_output_obj o)
+ opt
+ (if !Clflags.debug && Config.ccomp_type <> "msvc" then "-g" else "")
+ (String.concat " " (List.rev !Clflags.all_ccopts))
+ (quote_prefixed ~response_files:true "-I"
+ (List.map (Misc.expand_directory Config.standard_library)
+ (List.rev ( !Clflags.hidden_include_dirs
+ @ !Clflags.include_dirs))))
+ (Clflags.std_include_flag "-I")
+ (Filename.quote name)
+ (* cl tediously includes the name of the C file as the first thing it
+ outputs (in fairness, the tedious thing is that there's no switch to
+ disable this behaviour). In the absence of the Unix module, use
+ a temporary file to filter the output (cannot pipe the output to a
+ filter because this removes the exit status of cl, which is wanted.
+ *)
+ pipe) in
+ if pipe <> ""
+ then display_msvc_output file name;
+ exit
+
+let create_archive archive file_list =
+ Misc.remove_file archive;
+ let quoted_archive = Filename.quote archive in
+ if file_list = [] then
+ 0 (* Don't call the archiver: #6550/#1094/#9011 *)
+ else
+ match Config.ccomp_type with
+ "msvc" ->
+ command(Printf.sprintf "link /lib /nologo /out:%s %s"
+ quoted_archive
+ (quote_files ~response_files:true file_list))
+ | _ ->
+ assert(String.length Config.ar > 0);
+ command(Printf.sprintf "%s rc %s %s"
+ Config.ar quoted_archive
+ (quote_files ~response_files:Config.ar_supports_response_files
+ file_list))
+
+let expand_libname cclibs =
+ cclibs |> List.map (fun cclib ->
+ if String.starts_with ~prefix:"-l" cclib then
+ let libname =
+ "lib" ^ String.sub cclib 2 (String.length cclib - 2) ^ Config.ext_lib in
+ try
+ Load_path.find libname
+ with Not_found ->
+ libname
+ else cclib)
+
+type link_mode =
+ | Exe
+ | Dll
+ | MainDll
+ | Partial
+
+let remove_Wl cclibs =
+ cclibs |> List.map (fun cclib ->
+ (* -Wl,-foo,bar -> -foo bar *)
+ if String.length cclib >= 4 && "-Wl," = String.sub cclib 0 4 then
+ String.map (function ',' -> ' ' | c -> c)
+ (String.sub cclib 4 (String.length cclib - 4))
+ else cclib)
+
+let call_linker mode output_name files extra =
+ Profile.record_call "c-linker" (fun () ->
+ let cmd =
+ if mode = Partial then
+ let (l_prefix, files) =
+ match Config.ccomp_type with
+ | "msvc" -> ("/libpath:", expand_libname files)
+ | _ -> ("-L", files)
+ in
+ Printf.sprintf "%s%s %s %s %s"
+ Config.native_pack_linker
+ (Filename.quote output_name)
+ (quote_prefixed ~response_files:true
+ l_prefix (Load_path.get_path_list ()))
+ (quote_files ~response_files:true (remove_Wl files))
+ extra
+ else
+ Printf.sprintf "%s -o %s %s %s %s %s %s"
+ (match !Clflags.c_compiler, mode with
+ | Some cc, _ -> cc
+ | None, Exe -> Config.mkexe
+ | None, Dll -> Config.mkdll
+ | None, MainDll -> Config.mkmaindll
+ | None, Partial -> assert false
+ )
+ (Filename.quote output_name)
+ "" (*(Clflags.std_include_flag "-I")*)
+ (quote_prefixed ~response_files:true "-L"
+ (Load_path.get_path_list ()))
+ (String.concat " " (List.rev !Clflags.all_ccopts))
+ (quote_files ~response_files:true files)
+ extra
+ in
+ command cmd
+ )
diff --git a/upstream/ocaml_503/utils/ccomp.mli b/upstream/ocaml_503/utils/ccomp.mli
new file mode 100644
index 0000000000..38dfd5486f
--- /dev/null
+++ b/upstream/ocaml_503/utils/ccomp.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Compiling C files and building C libraries
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val command: string -> int
+val run_command: string -> unit
+val compile_file:
+ ?output:string -> ?opt:string -> ?stable_name:string -> string -> int
+val create_archive: string -> string list -> int
+val quote_files: response_files:bool -> string list -> string
+val quote_optfile: string option -> string
+(*val make_link_options: string list -> string*)
+
+type link_mode =
+ | Exe
+ | Dll
+ | MainDll
+ | Partial
+
+val call_linker: link_mode -> string -> string list -> string -> int
diff --git a/upstream/ocaml_503/utils/clflags.ml b/upstream/ocaml_503/utils/clflags.ml
new file mode 100644
index 0000000000..be10f23522
--- /dev/null
+++ b/upstream/ocaml_503/utils/clflags.ml
@@ -0,0 +1,601 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Command-line parameters *)
+
+module Int_arg_helper = Arg_helper.Make (struct
+ module Key = struct
+ include Numbers.Int
+ let of_string = int_of_string
+ end
+
+ module Value = struct
+ include Numbers.Int
+ let of_string = int_of_string
+ end
+end)
+module Float_arg_helper = Arg_helper.Make (struct
+ module Key = struct
+ include Numbers.Int
+ let of_string = int_of_string
+ end
+
+ module Value = struct
+ include Numbers.Float
+ let of_string = float_of_string
+ end
+end)
+
+let objfiles = ref ([] : string list) (* .cmo and .cma files *)
+and ccobjs = ref ([] : string list) (* .o, .a, .so and -cclib -lxxx *)
+and dllibs = ref ([] : string list) (* .so and -dllib -lxxx *)
+
+let cmi_file = ref None
+
+let compile_only = ref false (* -c *)
+and output_name = ref (None : string option) (* -o *)
+and include_dirs = ref ([] : string list) (* -I *)
+and hidden_include_dirs = ref ([] : string list) (* -H *)
+and no_std_include = ref false (* -nostdlib *)
+and no_cwd = ref false (* -nocwd *)
+and print_types = ref false (* -i *)
+and make_archive = ref false (* -a *)
+and debug = ref false (* -g *)
+and debug_full = ref false (* For full DWARF support *)
+and unsafe = ref false (* -unsafe *)
+and use_linscan = ref false (* -linscan *)
+and link_everything = ref false (* -linkall *)
+and custom_runtime = ref false (* -custom *)
+and no_check_prims = ref false (* -no-check-prims *)
+and bytecode_compatible_32 = ref false (* -compat-32 *)
+and output_c_object = ref false (* -output-obj *)
+and output_complete_object = ref false (* -output-complete-obj *)
+and output_complete_executable = ref false (* -output-complete-exe *)
+and all_ccopts = ref ([] : string list) (* -ccopt *)
+and classic = ref false (* -nolabels *)
+and nopervasives = ref false (* -nopervasives *)
+and match_context_rows = ref 32 (* -match-context-rows *)
+and safer_matching = ref false (* -safer-matching *)
+and preprocessor = ref(None : string option) (* -pp *)
+and all_ppx = ref ([] : string list) (* -ppx *)
+let absname = ref false (* -absname *)
+let annotations = ref false (* -annot *)
+let binary_annotations = ref false (* -bin-annot *)
+let store_occurrences = ref false (* -bin-annot-occurrences *)
+and use_threads = ref false (* -thread *)
+and noassert = ref false (* -noassert *)
+and verbose = ref false (* -verbose *)
+and noversion = ref false (* -no-version *)
+and noprompt = ref false (* -noprompt *)
+and nopromptcont = ref false (* -nopromptcont *)
+and init_file = ref (None : string option) (* -init *)
+and noinit = ref false (* -noinit *)
+and open_modules = ref [] (* -open *)
+and use_prims = ref "" (* -use-prims ... *)
+and use_runtime = ref "" (* -use-runtime ... *)
+and plugin = ref false (* -plugin ... *)
+and principal = ref false (* -principal *)
+and real_paths = ref true (* -short-paths *)
+and recursive_types = ref false (* -rectypes *)
+and strict_sequence = ref false (* -strict-sequence *)
+and strict_formats = ref true (* -strict-formats *)
+and applicative_functors = ref true (* -no-app-funct *)
+and make_runtime = ref false (* -make-runtime *)
+and c_compiler = ref (None: string option) (* -cc *)
+and no_auto_link = ref false (* -noautolink *)
+and dllpaths = ref ([] : string list) (* -dllpath *)
+and make_package = ref false (* -pack *)
+and for_package = ref (None: string option) (* -for-pack *)
+and error_size = ref 500 (* -error-size *)
+and float_const_prop = ref true (* -no-float-const-prop *)
+and transparent_modules = ref false (* -trans-mod *)
+let unique_ids = ref true (* -d(no-)unique-ds *)
+let locations = ref true (* -d(no-)locations *)
+let dump_source = ref false (* -dsource *)
+let dump_parsetree = ref false (* -dparsetree *)
+and dump_typedtree = ref false (* -dtypedtree *)
+and dump_shape = ref false (* -dshape *)
+and dump_rawlambda = ref false (* -drawlambda *)
+and dump_lambda = ref false (* -dlambda *)
+and dump_rawclambda = ref false (* -drawclambda *)
+and dump_clambda = ref false (* -dclambda *)
+and dump_rawflambda = ref false (* -drawflambda *)
+and dump_flambda = ref false (* -dflambda *)
+and dump_flambda_let = ref (None : int option) (* -dflambda-let=... *)
+and dump_flambda_verbose = ref false (* -dflambda-verbose *)
+and dump_instr = ref false (* -dinstr *)
+and keep_camlprimc_file = ref false (* -dcamlprimc *)
+
+let keyword_edition: string option ref = ref None
+
+let keep_asm_file = ref false (* -S *)
+let optimize_for_speed = ref true (* -compact *)
+and opaque = ref false (* -opaque *)
+
+and dump_cmm = ref false (* -dcmm *)
+let dump_selection = ref false (* -dsel *)
+let dump_cse = ref false (* -dcse *)
+let dump_live = ref false (* -dlive *)
+let dump_spill = ref false (* -dspill *)
+let dump_split = ref false (* -dsplit *)
+let dump_interf = ref false (* -dinterf *)
+let dump_prefer = ref false (* -dprefer *)
+let dump_regalloc = ref false (* -dalloc *)
+let dump_reload = ref false (* -dreload *)
+let dump_scheduling = ref false (* -dscheduling *)
+let dump_linear = ref false (* -dlinear *)
+let dump_interval = ref false (* -dinterval *)
+let keep_startup_file = ref false (* -dstartup *)
+let dump_combine = ref false (* -dcombine *)
+let profile_columns : Profile.column list ref = ref [] (* -dprofile/-dtimings *)
+
+let native_code = ref false (* set to true under ocamlopt *)
+
+let force_slash = ref false (* for ocamldep *)
+let clambda_checks = ref false (* -clambda-checks *)
+let cmm_invariants =
+ ref Config.with_cmm_invariants (* -dcmm-invariants *)
+
+let flambda_invariant_checks =
+ ref Config.with_flambda_invariants (* -flambda-(no-)invariants *)
+
+let dont_write_files = ref false (* set to true under ocamldoc *)
+
+let insn_sched_default = true
+let insn_sched = ref insn_sched_default (* -[no-]insn-sched *)
+
+let std_include_flag prefix =
+ if !no_std_include then ""
+ else (prefix ^ (Filename.quote Config.standard_library))
+
+let std_include_dir () =
+ if !no_std_include then [] else [Config.standard_library]
+
+let shared = ref false (* -shared *)
+let dlcode = ref true (* not -nodynlink *)
+
+let pic_code = ref (match Config.architecture with (* -fPIC *)
+ | "amd64" | "s390x" -> true
+ | _ -> false)
+
+let runtime_variant = ref ""
+
+let with_runtime = ref true (* -with-runtime *)
+
+let keep_docs = ref false (* -keep-docs *)
+let keep_locs = ref true (* -keep-locs *)
+
+let classic_inlining = ref false (* -Oclassic *)
+let inlining_report = ref false (* -inlining-report *)
+
+let afl_instrument = ref Config.afl_instrument (* -afl-instrument *)
+let afl_inst_ratio = ref 100 (* -afl-inst-ratio *)
+
+let function_sections = ref false (* -function-sections *)
+
+let simplify_rounds = ref None (* -rounds *)
+let default_simplify_rounds = ref 1 (* -rounds *)
+let rounds () =
+ match !simplify_rounds with
+ | None -> !default_simplify_rounds
+ | Some r -> r
+
+let default_inline_threshold = if Config.flambda then 10. else 10. /. 8.
+let inline_toplevel_multiplier = 16
+let default_inline_toplevel_threshold =
+ int_of_float ((float inline_toplevel_multiplier) *. default_inline_threshold)
+let default_inline_call_cost = 5
+let default_inline_alloc_cost = 7
+let default_inline_prim_cost = 3
+let default_inline_branch_cost = 5
+let default_inline_indirect_cost = 4
+let default_inline_branch_factor = 0.1
+let default_inline_lifting_benefit = 1300
+let default_inline_max_unroll = 0
+let default_inline_max_depth = 1
+
+let inline_threshold = ref (Float_arg_helper.default default_inline_threshold)
+let inline_toplevel_threshold =
+ ref (Int_arg_helper.default default_inline_toplevel_threshold)
+let inline_call_cost = ref (Int_arg_helper.default default_inline_call_cost)
+let inline_alloc_cost = ref (Int_arg_helper.default default_inline_alloc_cost)
+let inline_prim_cost = ref (Int_arg_helper.default default_inline_prim_cost)
+let inline_branch_cost =
+ ref (Int_arg_helper.default default_inline_branch_cost)
+let inline_indirect_cost =
+ ref (Int_arg_helper.default default_inline_indirect_cost)
+let inline_branch_factor =
+ ref (Float_arg_helper.default default_inline_branch_factor)
+let inline_lifting_benefit =
+ ref (Int_arg_helper.default default_inline_lifting_benefit)
+let inline_max_unroll =
+ ref (Int_arg_helper.default default_inline_max_unroll)
+let inline_max_depth =
+ ref (Int_arg_helper.default default_inline_max_depth)
+
+
+let unbox_specialised_args = ref true (* -no-unbox-specialised-args *)
+let unbox_free_vars_of_closures = ref true
+let unbox_closures = ref false (* -unbox-closures *)
+let default_unbox_closures_factor = 10
+let unbox_closures_factor =
+ ref default_unbox_closures_factor (* -unbox-closures-factor *)
+let remove_unused_arguments = ref false (* -remove-unused-arguments *)
+
+type inlining_arguments = {
+ inline_call_cost : int option;
+ inline_alloc_cost : int option;
+ inline_prim_cost : int option;
+ inline_branch_cost : int option;
+ inline_indirect_cost : int option;
+ inline_lifting_benefit : int option;
+ inline_branch_factor : float option;
+ inline_max_depth : int option;
+ inline_max_unroll : int option;
+ inline_threshold : float option;
+ inline_toplevel_threshold : int option;
+}
+
+let set_int_arg round (arg:Int_arg_helper.parsed ref) default value =
+ let value : int =
+ match value with
+ | None -> default
+ | Some value -> value
+ in
+ match round with
+ | None ->
+ arg := Int_arg_helper.set_base_default value
+ (Int_arg_helper.reset_base_overrides !arg)
+ | Some round ->
+ arg := Int_arg_helper.add_base_override round value !arg
+
+let set_float_arg round (arg:Float_arg_helper.parsed ref) default value =
+ let value =
+ match value with
+ | None -> default
+ | Some value -> value
+ in
+ match round with
+ | None ->
+ arg := Float_arg_helper.set_base_default value
+ (Float_arg_helper.reset_base_overrides !arg)
+ | Some round ->
+ arg := Float_arg_helper.add_base_override round value !arg
+
+let use_inlining_arguments_set ?round (arg:inlining_arguments) =
+ let set_int = set_int_arg round in
+ let set_float = set_float_arg round in
+ set_int inline_call_cost default_inline_call_cost arg.inline_call_cost;
+ set_int inline_alloc_cost default_inline_alloc_cost arg.inline_alloc_cost;
+ set_int inline_prim_cost default_inline_prim_cost arg.inline_prim_cost;
+ set_int inline_branch_cost
+ default_inline_branch_cost arg.inline_branch_cost;
+ set_int inline_indirect_cost
+ default_inline_indirect_cost arg.inline_indirect_cost;
+ set_int inline_lifting_benefit
+ default_inline_lifting_benefit arg.inline_lifting_benefit;
+ set_float inline_branch_factor
+ default_inline_branch_factor arg.inline_branch_factor;
+ set_int inline_max_depth
+ default_inline_max_depth arg.inline_max_depth;
+ set_int inline_max_unroll
+ default_inline_max_unroll arg.inline_max_unroll;
+ set_float inline_threshold
+ default_inline_threshold arg.inline_threshold;
+ set_int inline_toplevel_threshold
+ default_inline_toplevel_threshold arg.inline_toplevel_threshold
+
+(* o1 is the default *)
+let o1_arguments = {
+ inline_call_cost = None;
+ inline_alloc_cost = None;
+ inline_prim_cost = None;
+ inline_branch_cost = None;
+ inline_indirect_cost = None;
+ inline_lifting_benefit = None;
+ inline_branch_factor = None;
+ inline_max_depth = None;
+ inline_max_unroll = None;
+ inline_threshold = None;
+ inline_toplevel_threshold = None;
+}
+
+let classic_arguments = {
+ inline_call_cost = None;
+ inline_alloc_cost = None;
+ inline_prim_cost = None;
+ inline_branch_cost = None;
+ inline_indirect_cost = None;
+ inline_lifting_benefit = None;
+ inline_branch_factor = None;
+ inline_max_depth = None;
+ inline_max_unroll = None;
+ (* [inline_threshold] matches the current compiler's default.
+ Note that this particular fraction can be expressed exactly in
+ floating point. *)
+ inline_threshold = Some (10. /. 8.);
+ (* [inline_toplevel_threshold] is not used in classic mode. *)
+ inline_toplevel_threshold = Some 1;
+}
+
+let o2_arguments = {
+ inline_call_cost = Some (2 * default_inline_call_cost);
+ inline_alloc_cost = Some (2 * default_inline_alloc_cost);
+ inline_prim_cost = Some (2 * default_inline_prim_cost);
+ inline_branch_cost = Some (2 * default_inline_branch_cost);
+ inline_indirect_cost = Some (2 * default_inline_indirect_cost);
+ inline_lifting_benefit = None;
+ inline_branch_factor = None;
+ inline_max_depth = Some 2;
+ inline_max_unroll = None;
+ inline_threshold = Some 25.;
+ inline_toplevel_threshold = Some (25 * inline_toplevel_multiplier);
+}
+
+let o3_arguments = {
+ inline_call_cost = Some (3 * default_inline_call_cost);
+ inline_alloc_cost = Some (3 * default_inline_alloc_cost);
+ inline_prim_cost = Some (3 * default_inline_prim_cost);
+ inline_branch_cost = Some (3 * default_inline_branch_cost);
+ inline_indirect_cost = Some (3 * default_inline_indirect_cost);
+ inline_lifting_benefit = None;
+ inline_branch_factor = Some 0.;
+ inline_max_depth = Some 3;
+ inline_max_unroll = Some 1;
+ inline_threshold = Some 50.;
+ inline_toplevel_threshold = Some (50 * inline_toplevel_multiplier);
+}
+
+let all_passes = ref []
+let dumped_passes_list = ref []
+let dumped_pass s =
+ assert(List.mem s !all_passes);
+ List.mem s !dumped_passes_list
+
+let set_dumped_pass s enabled =
+ if (List.mem s !all_passes) then begin
+ let passes_without_s = List.filter ((<>) s) !dumped_passes_list in
+ let dumped_passes =
+ if enabled then
+ s :: passes_without_s
+ else
+ passes_without_s
+ in
+ dumped_passes_list := dumped_passes
+ end
+
+let dump_into_file = ref false (* -dump-into-file *)
+let dump_dir: string option ref = ref None (* -dump-dir *)
+
+type 'a env_reader = {
+ parse : string -> 'a option;
+ print : 'a -> string;
+ usage : string;
+ env_var : string;
+}
+
+let color = ref None (* -color *)
+
+let color_reader = {
+ parse = (function
+ | "auto" -> Some Misc.Color.Auto
+ | "always" -> Some Misc.Color.Always
+ | "never" -> Some Misc.Color.Never
+ | _ -> None);
+ print = (function
+ | Misc.Color.Auto -> "auto"
+ | Misc.Color.Always -> "always"
+ | Misc.Color.Never -> "never");
+ usage = "expected \"auto\", \"always\" or \"never\"";
+ env_var = "OCAML_COLOR";
+}
+
+let error_style = ref None (* -error-style *)
+
+let error_style_reader = {
+ parse = (function
+ | "contextual" -> Some Misc.Error_style.Contextual
+ | "short" -> Some Misc.Error_style.Short
+ | _ -> None);
+ print = (function
+ | Misc.Error_style.Contextual -> "contextual"
+ | Misc.Error_style.Short -> "short");
+ usage = "expected \"contextual\" or \"short\"";
+ env_var = "OCAML_ERROR_STYLE";
+}
+
+let unboxed_types = ref false
+
+(* This is used by the -save-ir-after option. *)
+module Compiler_ir = struct
+ type t = Linear
+
+ let all = [
+ Linear;
+ ]
+
+ let extension t =
+ let ext =
+ match t with
+ | Linear -> "linear"
+ in
+ ".cmir-" ^ ext
+
+ (** [extract_extension_with_pass filename] returns the IR whose extension
+ is a prefix of the extension of [filename], and the suffix,
+ which can be used to distinguish different passes on the same IR.
+ For example, [extract_extension_with_pass "foo.cmir-linear123"]
+ returns [Some (Linear, "123")]. *)
+ let extract_extension_with_pass filename =
+ let ext = Filename.extension filename in
+ let ext_len = String.length ext in
+ if ext_len <= 0 then None
+ else begin
+ let is_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ s_len <= ext_len && s = String.sub ext 0 s_len
+ in
+ let drop_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ String.sub ext s_len (ext_len - s_len)
+ in
+ let ir = List.find_opt is_prefix all in
+ match ir with
+ | None -> None
+ | Some ir -> Some (ir, drop_prefix ir)
+ end
+end
+
+(* This is used by the -stop-after option. *)
+module Compiler_pass = struct
+ (* If you add a new pass, the following must be updated:
+ - the variable `passes` below
+ - the manpages in man/ocaml{c,opt}.m
+ - the manual manual/src/cmds/unified-options.etex
+ *)
+ type t = Parsing | Typing | Lambda | Scheduling | Emit
+
+ let to_string = function
+ | Parsing -> "parsing"
+ | Typing -> "typing"
+ | Lambda -> "lambda"
+ | Scheduling -> "scheduling"
+ | Emit -> "emit"
+
+ let of_string = function
+ | "parsing" -> Some Parsing
+ | "typing" -> Some Typing
+ | "lambda" -> Some Lambda
+ | "scheduling" -> Some Scheduling
+ | "emit" -> Some Emit
+ | _ -> None
+
+ let rank = function
+ | Parsing -> 0
+ | Typing -> 1
+ | Lambda -> 2
+ | Scheduling -> 50
+ | Emit -> 60
+
+ let passes = [
+ Parsing;
+ Typing;
+ Lambda;
+ Scheduling;
+ Emit;
+ ]
+ let is_compilation_pass _ = true
+ let is_native_only = function
+ | Scheduling -> true
+ | Emit -> true
+ | _ -> false
+
+ let enabled is_native t = not (is_native_only t) || is_native
+ let can_save_ir_after = function
+ | Scheduling -> true
+ | _ -> false
+
+ let available_pass_names ~filter ~native =
+ passes
+ |> List.filter (enabled native)
+ |> List.filter filter
+ |> List.map to_string
+
+ let compare a b =
+ compare (rank a) (rank b)
+
+ let to_output_filename t ~prefix =
+ match t with
+ | Scheduling -> prefix ^ Compiler_ir.(extension Linear)
+ | _ -> Misc.fatal_error "Not supported"
+
+ let of_input_filename name =
+ match Compiler_ir.extract_extension_with_pass name with
+ | Some (Linear, _) -> Some Emit
+ | None -> None
+end
+
+let stop_after = ref None (* -stop-after *)
+
+let should_stop_after pass =
+ if Compiler_pass.(rank Typing <= rank pass) && !print_types then true
+ else
+ match !stop_after with
+ | None -> false
+ | Some stop -> Compiler_pass.rank stop <= Compiler_pass.rank pass
+
+let save_ir_after = ref []
+
+let should_save_ir_after pass =
+ List.mem pass !save_ir_after
+
+let set_save_ir_after pass enabled =
+ let other_passes = List.filter ((<>) pass) !save_ir_after in
+ let new_passes =
+ if enabled then
+ pass :: other_passes
+ else
+ other_passes
+ in
+ save_ir_after := new_passes
+
+let parse_keyword_edition s =
+ let parse_version s =
+ let bad_version () =
+ raise (Arg.Bad "Ill-formed version in keywords flag,\n\
+ the supported format is <major>.<minor>, for example 5.2 .")
+ in
+ if s = "" then None else match String.split_on_char '.' s with
+ | [] | [_] | _ :: _ :: _ :: _ -> bad_version ()
+ | [major;minor] -> match int_of_string_opt major, int_of_string_opt minor with
+ | Some major, Some minor -> Some (major,minor)
+ | _ -> bad_version ()
+ in
+ match String.split_on_char '+' s with
+ | [] -> None, []
+ | [s] -> parse_version s, []
+ | v :: rest -> parse_version v, rest
+
+module String = Misc.Stdlib.String
+
+let arg_spec = ref []
+let arg_names = ref String.Map.empty
+
+let reset_arguments () =
+ arg_spec := [];
+ arg_names := String.Map.empty
+
+let add_arguments loc args =
+ List.iter (function (arg_name, _, _) as arg ->
+ try
+ let loc2 = String.Map.find arg_name !arg_names in
+ Printf.eprintf
+ "Warning: compiler argument %s is already defined:\n" arg_name;
+ Printf.eprintf " First definition: %s\n" loc2;
+ Printf.eprintf " New definition: %s\n" loc;
+ with Not_found ->
+ arg_spec := !arg_spec @ [ arg ];
+ arg_names := String.Map.add arg_name loc !arg_names
+ ) args
+
+let create_usage_msg program =
+ Printf.sprintf "Usage: %s <options> <files>\n\
+ Try '%s --help' for more information." program program
+
+
+let print_arguments program =
+ Arg.usage !arg_spec (create_usage_msg program)
diff --git a/upstream/ocaml_503/utils/clflags.mli b/upstream/ocaml_503/utils/clflags.mli
new file mode 100644
index 0000000000..248a7d86e6
--- /dev/null
+++ b/upstream/ocaml_503/utils/clflags.mli
@@ -0,0 +1,279 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2005 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. *)
+(* *)
+(**************************************************************************)
+
+
+
+(** Command line flags *)
+
+(** Optimization parameters represented as ints indexed by round number. *)
+module Int_arg_helper : sig
+ type parsed
+
+ val parse : string -> string -> parsed ref -> unit
+
+ type parse_result =
+ | Ok
+ | Parse_failed of exn
+ val parse_no_error : string -> parsed ref -> parse_result
+
+ val get : key:int -> parsed -> int
+end
+
+(** Optimization parameters represented as floats indexed by round number. *)
+module Float_arg_helper : sig
+ type parsed
+
+ val parse : string -> string -> parsed ref -> unit
+
+ type parse_result =
+ | Ok
+ | Parse_failed of exn
+ val parse_no_error : string -> parsed ref -> parse_result
+
+ val get : key:int -> parsed -> float
+end
+
+type inlining_arguments = {
+ inline_call_cost : int option;
+ inline_alloc_cost : int option;
+ inline_prim_cost : int option;
+ inline_branch_cost : int option;
+ inline_indirect_cost : int option;
+ inline_lifting_benefit : int option;
+ inline_branch_factor : float option;
+ inline_max_depth : int option;
+ inline_max_unroll : int option;
+ inline_threshold : float option;
+ inline_toplevel_threshold : int option;
+}
+
+val classic_arguments : inlining_arguments
+val o1_arguments : inlining_arguments
+val o2_arguments : inlining_arguments
+val o3_arguments : inlining_arguments
+
+(** Set all the inlining arguments for a round.
+ The default is set if no round is provided. *)
+val use_inlining_arguments_set : ?round:int -> inlining_arguments -> unit
+
+val objfiles : string list ref
+val ccobjs : string list ref
+val dllibs : string list ref
+val cmi_file : string option ref
+val compile_only : bool ref
+val output_name : string option ref
+val include_dirs : string list ref
+val hidden_include_dirs : string list ref
+val no_std_include : bool ref
+val no_cwd : bool ref
+val print_types : bool ref
+val make_archive : bool ref
+val debug : bool ref
+val debug_full : bool ref
+val unsafe : bool ref
+val use_linscan : bool ref
+val link_everything : bool ref
+val custom_runtime : bool ref
+val no_check_prims : bool ref
+val bytecode_compatible_32 : bool ref
+val output_c_object : bool ref
+val output_complete_object : bool ref
+val output_complete_executable : bool ref
+val all_ccopts : string list ref
+val classic : bool ref
+val nopervasives : bool ref
+val match_context_rows : int ref
+val safer_matching : bool ref
+val open_modules : string list ref
+val preprocessor : string option ref
+val all_ppx : string list ref
+val absname : bool ref
+val annotations : bool ref
+val binary_annotations : bool ref
+val store_occurrences : bool ref
+val use_threads : bool ref
+val noassert : bool ref
+val verbose : bool ref
+val noprompt : bool ref
+val nopromptcont : bool ref
+val init_file : string option ref
+val noinit : bool ref
+val noversion : bool ref
+val use_prims : string ref
+val use_runtime : string ref
+val plugin : bool ref
+val principal : bool ref
+val real_paths : bool ref
+val recursive_types : bool ref
+val strict_sequence : bool ref
+val strict_formats : bool ref
+val applicative_functors : bool ref
+val make_runtime : bool ref
+val c_compiler : string option ref
+val no_auto_link : bool ref
+val dllpaths : string list ref
+val make_package : bool ref
+val for_package : string option ref
+val error_size : int ref
+val float_const_prop : bool ref
+val transparent_modules : bool ref
+val unique_ids : bool ref
+val locations : bool ref
+val dump_source : bool ref
+val dump_parsetree : bool ref
+val dump_typedtree : bool ref
+val dump_shape : bool ref
+val dump_rawlambda : bool ref
+val dump_lambda : bool ref
+val dump_rawclambda : bool ref
+val dump_clambda : bool ref
+val dump_rawflambda : bool ref
+val dump_flambda : bool ref
+val dump_flambda_let : int option ref
+val dump_instr : bool ref
+val keep_camlprimc_file : bool ref
+val keep_asm_file : bool ref
+val optimize_for_speed : bool ref
+val dump_cmm : bool ref
+val dump_selection : bool ref
+val dump_cse : bool ref
+val dump_live : bool ref
+val dump_spill : bool ref
+val dump_split : bool ref
+val dump_interf : bool ref
+val dump_prefer : bool ref
+val dump_regalloc : bool ref
+val dump_reload : bool ref
+val dump_scheduling : bool ref
+val dump_linear : bool ref
+val dump_interval : bool ref
+val keep_startup_file : bool ref
+val dump_combine : bool ref
+val native_code : bool ref
+val default_inline_threshold : float
+val inline_threshold : Float_arg_helper.parsed ref
+val inlining_report : bool ref
+val simplify_rounds : int option ref
+val default_simplify_rounds : int ref
+val rounds : unit -> int
+val default_inline_max_unroll : int
+val inline_max_unroll : Int_arg_helper.parsed ref
+val default_inline_toplevel_threshold : int
+val inline_toplevel_threshold : Int_arg_helper.parsed ref
+val default_inline_call_cost : int
+val default_inline_alloc_cost : int
+val default_inline_prim_cost : int
+val default_inline_branch_cost : int
+val default_inline_indirect_cost : int
+val default_inline_lifting_benefit : int
+val inline_call_cost : Int_arg_helper.parsed ref
+val inline_alloc_cost : Int_arg_helper.parsed ref
+val inline_prim_cost : Int_arg_helper.parsed ref
+val inline_branch_cost : Int_arg_helper.parsed ref
+val inline_indirect_cost : Int_arg_helper.parsed ref
+val inline_lifting_benefit : Int_arg_helper.parsed ref
+val default_inline_branch_factor : float
+val inline_branch_factor : Float_arg_helper.parsed ref
+val dont_write_files : bool ref
+val std_include_flag : string -> string
+val std_include_dir : unit -> string list
+val shared : bool ref
+val dlcode : bool ref
+val pic_code : bool ref
+val runtime_variant : string ref
+val with_runtime : bool ref
+val force_slash : bool ref
+val keep_docs : bool ref
+val keep_locs : bool ref
+val opaque : bool ref
+val profile_columns : Profile.column list ref
+val flambda_invariant_checks : bool ref
+val unbox_closures : bool ref
+val unbox_closures_factor : int ref
+val default_unbox_closures_factor : int
+val unbox_free_vars_of_closures : bool ref
+val unbox_specialised_args : bool ref
+val clambda_checks : bool ref
+val cmm_invariants : bool ref
+val default_inline_max_depth : int
+val inline_max_depth : Int_arg_helper.parsed ref
+val remove_unused_arguments : bool ref
+val dump_flambda_verbose : bool ref
+val classic_inlining : bool ref
+val afl_instrument : bool ref
+val afl_inst_ratio : int ref
+val function_sections : bool ref
+
+val all_passes : string list ref
+val dumped_pass : string -> bool
+val set_dumped_pass : string -> bool -> unit
+
+val dump_into_file : bool ref
+val dump_dir : string option ref
+
+val keyword_edition: string option ref
+val parse_keyword_edition: string -> (int*int) option * string list
+
+(* Support for flags that can also be set from an environment variable *)
+type 'a env_reader = {
+ parse : string -> 'a option;
+ print : 'a -> string;
+ usage : string;
+ env_var : string;
+}
+
+val color : Misc.Color.setting option ref
+val color_reader : Misc.Color.setting env_reader
+
+val error_style : Misc.Error_style.setting option ref
+val error_style_reader : Misc.Error_style.setting env_reader
+
+val unboxed_types : bool ref
+
+val insn_sched : bool ref
+val insn_sched_default : bool
+
+module Compiler_pass : sig
+ type t = Parsing | Typing | Lambda | Scheduling | Emit
+ val of_string : string -> t option
+ val to_string : t -> string
+ val is_compilation_pass : t -> bool
+ val available_pass_names : filter:(t -> bool) -> native:bool -> string list
+ val can_save_ir_after : t -> bool
+ val compare : t -> t -> int
+ val to_output_filename: t -> prefix:string -> string
+ val of_input_filename: string -> t option
+end
+val stop_after : Compiler_pass.t option ref
+val should_stop_after : Compiler_pass.t -> bool
+val set_save_ir_after : Compiler_pass.t -> bool -> unit
+val should_save_ir_after : Compiler_pass.t -> bool
+
+val arg_spec : (string * Arg.spec * string) list ref
+
+(* [add_arguments __LOC__ args] will add the arguments from [args] at
+ the end of [arg_spec], checking that they have not already been
+ added by [add_arguments] before. A warning is printed showing the
+ locations of the function from which the argument was previously
+ added. *)
+val add_arguments : string -> (string * Arg.spec * string) list -> unit
+
+(* [create_usage_msg program] creates a usage message for [program] *)
+val create_usage_msg: string -> string
+(* [print_arguments usage] print the standard usage message *)
+val print_arguments : string -> unit
+
+(* [reset_arguments ()] clear all declared arguments *)
+val reset_arguments : unit -> unit
diff --git a/upstream/ocaml_503/utils/compression.ml b/upstream/ocaml_503/utils/compression.ml
new file mode 100644
index 0000000000..384afb3b40
--- /dev/null
+++ b/upstream/ocaml_503/utils/compression.ml
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, Collège de France and Inria project Cambium *)
+(* *)
+(* Copyright 2023 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. *)
+(* *)
+(**************************************************************************)
+
+external zstd_initialize: unit -> bool = "caml_zstd_initialize"
+
+let compression_supported = zstd_initialize ()
+
+type [@warning "-unused-constructor"] extern_flags =
+ No_sharing (** Don't preserve sharing *)
+ | Closures (** Send function closures *)
+ | Compat_32 (** Ensure 32-bit compatibility *)
+ | Compression (** Optional compression *)
+
+external to_channel: out_channel -> 'a -> extern_flags list -> unit
+ = "caml_output_value"
+
+let output_value ch v = to_channel ch v [Compression]
+
+let input_value = Stdlib.input_value
diff --git a/upstream/ocaml_503/utils/compression.mli b/upstream/ocaml_503/utils/compression.mli
new file mode 100644
index 0000000000..bdfb63da77
--- /dev/null
+++ b/upstream/ocaml_503/utils/compression.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, Collège de France and Inria project Cambium *)
+(* *)
+(* Copyright 2023 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. *)
+(* *)
+(**************************************************************************)
+
+val output_value : out_channel -> 'a -> unit
+(** [Compression.output_value chan v] writes the representation
+ of [v] on channel [chan].
+ If compression is supported, the marshaled data
+ representing value [v] is compressed before being written to
+ channel [chan].
+ If compression is not supported, this function behaves like
+ {!Stdlib.output_value}. *)
+
+val input_value : in_channel -> 'a
+(** [Compression.input_value chan] reads from channel [chan] the
+ byte representation of a structured value, as produced by
+ [Compression.output_value], and reconstructs and
+ returns the corresponding value.
+ If compression is not supported, this function behaves like
+ {!Stdlib.input_value}. *)
+
+val compression_supported : bool
+(** Reports whether compression is supported. *)
diff --git a/upstream/ocaml_503/utils/config.common.ml.in b/upstream/ocaml_503/utils/config.common.ml.in
new file mode 100644
index 0000000000..3603fe6c60
--- /dev/null
+++ b/upstream/ocaml_503/utils/config.common.ml.in
@@ -0,0 +1,163 @@
+(* @configure_input@ *)
+#3 "utils/config.common.ml.in"
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Portions of the Config module common to both the boot and main compiler. *)
+
+(* The main OCaml version string has moved to ../build-aux/ocaml_version.m4 *)
+let version = Sys.ocaml_version
+
+let standard_library =
+ try
+ Sys.getenv "OCAMLLIB"
+ with Not_found ->
+ try
+ Sys.getenv "CAMLLIB"
+ with Not_found ->
+ standard_library_default
+
+let exec_magic_number = {magic|@EXEC_MAGIC_NUMBER@|magic}
+ (* exec_magic_number is duplicated in runtime/caml/exec.h *)
+and cmi_magic_number = {magic|@CMI_MAGIC_NUMBER@|magic}
+and cmo_magic_number = {magic|@CMO_MAGIC_NUMBER@|magic}
+and cma_magic_number = {magic|@CMA_MAGIC_NUMBER@|magic}
+and cmx_magic_number = {magic|@CMX_MAGIC_NUMBER@|magic}
+and cmxa_magic_number = {magic|@CMXA_MAGIC_NUMBER@|magic}
+and ast_impl_magic_number = {magic|@AST_IMPL_MAGIC_NUMBER@|magic}
+and ast_intf_magic_number = {magic|@AST_INTF_MAGIC_NUMBER@|magic}
+and cmxs_magic_number = {magic|@CMXS_MAGIC_NUMBER@|magic}
+and cmt_magic_number = {magic|@CMT_MAGIC_NUMBER@|magic}
+and linear_magic_number = {magic|@LINEAR_MAGIC_NUMBER@|magic}
+
+let safe_string = true
+let default_safe_string = true
+let naked_pointers = false
+
+let interface_suffix = ref ".mli"
+
+let max_tag = 243
+(* This is normally the same as in obj.ml, but we have to define it
+ separately because it can differ when we're in the middle of a
+ bootstrapping phase. *)
+let lazy_tag = 246
+
+let max_young_wosize = 256
+let stack_threshold = 32 (* see runtime/caml/config.h *)
+let stack_safety_margin = 6
+let default_executable_name =
+ match Sys.os_type with
+ "Unix" -> "a.out"
+ | "Win32" | "Cygwin" -> "camlprog.exe"
+ | _ -> "camlprog"
+type configuration_value =
+ | String of string
+ | Int of int
+ | Bool of bool
+
+let configuration_variables () =
+ let p x v = (x, String v) in
+ let p_int x v = (x, Int v) in
+ let p_bool x v = (x, Bool v) in
+[
+ p "version" version;
+ p "standard_library_default" standard_library_default;
+ p "standard_library" standard_library;
+ p "ccomp_type" ccomp_type;
+ p "c_compiler" c_compiler;
+ p "bytecode_cflags" bytecode_cflags;
+ p "ocamlc_cflags" bytecode_cflags;
+ p "bytecode_cppflags" bytecode_cppflags;
+ p "ocamlc_cppflags" bytecode_cppflags;
+ p "native_cflags" native_cflags;
+ p "ocamlopt_cflags" native_cflags;
+ p "native_cppflags" native_cppflags;
+ p "ocamlopt_cppflags" native_cppflags;
+ p "bytecomp_c_compiler" bytecomp_c_compiler;
+ p "native_c_compiler" native_c_compiler;
+ p "bytecomp_c_libraries" bytecomp_c_libraries;
+ p "native_c_libraries" native_c_libraries;
+ p "native_ldflags" native_ldflags;
+ p "native_pack_linker" native_pack_linker;
+ p_bool "native_compiler" native_compiler;
+ p "architecture" architecture;
+ p "model" model;
+ p_int "int_size" Sys.int_size;
+ p_int "word_size" Sys.word_size;
+ p "system" system;
+ p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
+ p_bool "with_frame_pointers" with_frame_pointers;
+ p "ext_exe" ext_exe;
+ p "ext_obj" ext_obj;
+ p "ext_asm" ext_asm;
+ p "ext_lib" ext_lib;
+ p "ext_dll" ext_dll;
+ p "os_type" Sys.os_type;
+ p "default_executable_name" default_executable_name;
+ p_bool "systhread_supported" systhread_supported;
+ p "host" host;
+ p "target" target;
+ p_bool "flambda" flambda;
+ p_bool "safe_string" safe_string;
+ p_bool "default_safe_string" default_safe_string;
+ p_bool "flat_float_array" flat_float_array;
+ p_bool "function_sections" function_sections;
+ p_bool "afl_instrument" afl_instrument;
+ p_bool "tsan" tsan;
+ p_bool "windows_unicode" windows_unicode;
+ p_bool "supports_shared_libraries" supports_shared_libraries;
+ p_bool "native_dynlink" native_dynlink;
+ p_bool "naked_pointers" naked_pointers;
+
+ p "exec_magic_number" exec_magic_number;
+ p "cmi_magic_number" cmi_magic_number;
+ p "cmo_magic_number" cmo_magic_number;
+ p "cma_magic_number" cma_magic_number;
+ p "cmx_magic_number" cmx_magic_number;
+ p "cmxa_magic_number" cmxa_magic_number;
+ p "ast_impl_magic_number" ast_impl_magic_number;
+ p "ast_intf_magic_number" ast_intf_magic_number;
+ p "cmxs_magic_number" cmxs_magic_number;
+ p "cmt_magic_number" cmt_magic_number;
+ p "linear_magic_number" linear_magic_number;
+]
+
+let print_config_value oc = function
+ | String s ->
+ Printf.fprintf oc "%s" s
+ | Int n ->
+ Printf.fprintf oc "%d" n
+ | Bool p ->
+ Printf.fprintf oc "%B" p
+
+let print_config oc =
+ let print (x, v) =
+ Printf.fprintf oc "%s: %a\n" x print_config_value v in
+ List.iter print (configuration_variables ());
+ flush oc
+
+let config_var x =
+ match List.assoc_opt x (configuration_variables()) with
+ | None -> None
+ | Some v ->
+ let s = match v with
+ | String s -> s
+ | Int n -> Int.to_string n
+ | Bool b -> string_of_bool b
+ in
+ Some s
+
+let merlin = false
diff --git a/upstream/ocaml_503/utils/config.fixed.ml b/upstream/ocaml_503/utils/config.fixed.ml
new file mode 100644
index 0000000000..807b929355
--- /dev/null
+++ b/upstream/ocaml_503/utils/config.fixed.ml
@@ -0,0 +1,73 @@
+#2 "utils/config.fixed.ml"
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* David Allsopp, Tarides UK. *)
+(* *)
+(* Copyright 2022 David Allsopp Ltd. *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Configuration for the boot compiler. The compiler should refuse to bootstrap
+ if configured with values which would contradict the configuration below.
+ The values below are picked to trigger errors if accidentally used in the
+ compiler (e.g. for the C compiler). *)
+
+let boot_cannot_call s = "/ The boot compiler should not call " ^ s
+
+let bindir = "/tmp"
+let standard_library_default = "/tmp"
+let ccomp_type = "n/a"
+let c_compiler = boot_cannot_call "the C compiler"
+let c_output_obj = ""
+let c_has_debug_prefix_map = false
+let as_has_debug_prefix_map = false
+let bytecode_cflags = ""
+let bytecode_cppflags = ""
+let native_cflags = ""
+let native_cppflags = ""
+let bytecomp_c_libraries = ""
+let bytecomp_c_compiler = ""
+let native_c_compiler = c_compiler
+let native_c_libraries = ""
+let native_ldflags = ""
+let native_pack_linker = boot_cannot_call "the linker"
+let default_rpath = ""
+let mksharedlibrpath = ""
+let ar = boot_cannot_call "ar"
+let supports_shared_libraries = false
+let native_dynlink = false
+let mkdll = native_pack_linker
+let mkexe = native_pack_linker
+let mkmaindll = native_pack_linker
+let flambda = false
+let with_flambda_invariants = false
+let with_cmm_invariants = false
+let windows_unicode = false
+let flat_float_array = true
+let function_sections = false
+let afl_instrument = false
+let native_compiler = false
+let tsan = false
+let architecture = "none"
+let model = "default"
+let system = "unknown"
+let asm = boot_cannot_call "the assembler"
+let asm_cfi_supported = false
+let with_frame_pointers = false
+let reserved_header_bits = 0
+let ext_exe = ".ex_The boot compiler should not be using Config.ext_exe"
+let ext_obj = ".o_The boot compiler cannot process C objects"
+let ext_asm = ".s_The boot compiler should not be using Config.ext_asm"
+let ext_lib = ".a_The boot compiler cannot process C libraries"
+let ext_dll = ".so_The boot compiler cannot load DLLs"
+let host = "zinc-boot-ocaml"
+let target = host
+let systhread_supported = false
+let flexdll_dirs = []
+let ar_supports_response_files = true
diff --git a/upstream/ocaml_503/utils/config.generated.ml.in b/upstream/ocaml_503/utils/config.generated.ml.in
new file mode 100644
index 0000000000..aa03455409
--- /dev/null
+++ b/upstream/ocaml_503/utils/config.generated.ml.in
@@ -0,0 +1,94 @@
+(* @configure_input@ *)
+#2 "utils/config.generated.ml.in"
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* This file is included in config_main.ml during the build rather
+ than compiled on its own *)
+
+let bindir = {@QS@|@ocaml_bindir@|@QS@}
+
+let standard_library_default = {@QS@|@ocaml_libdir@|@QS@}
+
+let ccomp_type = {@QS@|@ccomptype@|@QS@}
+let c_compiler = {@QS@|@CC@|@QS@}
+let c_output_obj = {@QS@|@outputobj@|@QS@}
+let c_has_debug_prefix_map = @cc_has_debug_prefix_map@
+let as_has_debug_prefix_map = @as_has_debug_prefix_map@
+let bytecode_cflags = {@QS@|@bytecode_cflags@|@QS@}
+let bytecode_cppflags = {@QS@|@bytecode_cppflags@|@QS@}
+let native_cflags = {@QS@|@native_cflags@|@QS@}
+let native_cppflags = {@QS@|@native_cppflags@|@QS@}
+
+let bytecomp_c_libraries = {@QS@|@zstd_libs@ @cclibs@|@QS@}
+(* bytecomp_c_compiler and native_c_compiler have been supported for a
+ long time and are retained for backwards compatibility.
+ For programs that don't need compatibility with older OCaml releases
+ the recommended approach is to use the constituent variables
+ c_compiler, {bytecode,native}_c[pp]flags etc. directly.
+*)
+let bytecomp_c_compiler =
+ c_compiler ^ " " ^ bytecode_cflags ^ " " ^ bytecode_cppflags
+let native_c_compiler =
+ c_compiler ^ " " ^ native_cflags ^ " " ^ native_cppflags
+let native_c_libraries = {@QS@|@cclibs@|@QS@}
+let native_ldflags = {@QS@|@native_ldflags@|@QS@}
+let native_pack_linker = {@QS@|@PACKLD@|@QS@}
+let default_rpath = {@QS@|@rpath@|@QS@}
+let mksharedlibrpath = {@QS@|@mksharedlibrpath@|@QS@}
+let ar = {@QS@|@AR@|@QS@}
+let supports_shared_libraries = @supports_shared_libraries@
+let native_dynlink = @natdynlink@
+let mkdll = {@QS@|@mkdll_exp@|@QS@}
+let mkexe = {@QS@|@mkexe_exp@|@QS@}
+let mkmaindll = {@QS@|@mkmaindll_exp@|@QS@}
+
+let flambda = @flambda@
+let with_flambda_invariants = @flambda_invariants@
+let with_cmm_invariants = @cmm_invariants@
+let windows_unicode = @windows_unicode@ != 0
+
+let flat_float_array = @flat_float_array@
+
+let function_sections = @function_sections@
+let afl_instrument = @afl@
+
+let native_compiler = @native_compiler@
+
+let architecture = {@QS@|@arch@|@QS@}
+let model = {@QS@|@model@|@QS@}
+let system = {@QS@|@system@|@QS@}
+
+let asm = {@QS@|@AS@|@QS@}
+let asm_cfi_supported = @asm_cfi_supported@
+let with_frame_pointers = @frame_pointers@
+let reserved_header_bits = @reserved_header_bits@
+
+let ext_exe = {@QS@|@exeext@|@QS@}
+let ext_obj = "." ^ {@QS@|@OBJEXT@|@QS@}
+let ext_asm = "." ^ {@QS@|@S@|@QS@}
+let ext_lib = "." ^ {@QS@|@libext@|@QS@}
+let ext_dll = "." ^ {@QS@|@SO@|@QS@}
+
+let host = {@QS@|@host@|@QS@}
+let target = {@QS@|@target@|@QS@}
+
+let systhread_supported = @systhread_support@
+
+let flexdll_dirs = [@flexdll_dir@]
+
+let ar_supports_response_files = @ar_supports_response_files@
+
+let tsan = @tsan@
diff --git a/upstream/ocaml_503/utils/config.mli b/upstream/ocaml_503/utils/config.mli
new file mode 100644
index 0000000000..51e31a3729
--- /dev/null
+++ b/upstream/ocaml_503/utils/config.mli
@@ -0,0 +1,266 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** System configuration
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val version: string
+(** The current version number of the system *)
+
+val bindir: string
+(** The directory containing the binary programs *)
+
+val standard_library: string
+(** The directory containing the standard libraries *)
+
+val ccomp_type: string
+(** The "kind" of the C compiler, assembler and linker used: one of
+ "cc" (for Unix-style C compilers)
+ "msvc" (for Microsoft Visual C++ and MASM) *)
+
+val c_compiler: string
+(** The compiler to use for compiling C files *)
+
+val c_output_obj: string
+(** Name of the option of the C compiler for specifying the output
+ file *)
+
+val c_has_debug_prefix_map : bool
+(** Whether the C compiler supports -fdebug-prefix-map *)
+
+val as_has_debug_prefix_map : bool
+(** Whether the assembler supports --debug-prefix-map *)
+
+val bytecode_cflags : string
+(** The flags ocamlc should pass to the C compiler *)
+
+val bytecode_cppflags : string
+(** The flags ocamlc should pass to the C preprocessor *)
+
+val native_cflags : string
+(** The flags ocamlopt should pass to the C compiler *)
+
+val native_cppflags : string
+(** The flags ocamlopt should pass to the C preprocessor *)
+
+val bytecomp_c_libraries: string
+(** The C libraries to link with custom runtimes *)
+
+val native_c_libraries: string
+(** The C libraries to link with native-code programs *)
+
+val native_ldflags : string
+(* Flags to pass to the system linker *)
+
+val native_pack_linker: string
+(** The linker to use for packaging (ocamlopt -pack) and for partial
+ links (ocamlopt -output-obj). *)
+
+val mkdll: string
+(** The linker command line to build dynamic libraries. *)
+
+val mkexe: string
+(** The linker command line to build executables. *)
+
+val mkmaindll: string
+(** The linker command line to build main programs as dlls. *)
+
+val default_rpath: string
+(** Option to add a directory to be searched for libraries at runtime
+ (used by ocamlmklib) *)
+
+val mksharedlibrpath: string
+(** Option to add a directory to be searched for shared libraries at runtime
+ (used by ocamlmklib) *)
+
+val ar: string
+(** Name of the ar command, or "" if not needed (MSVC) *)
+
+val interface_suffix: string ref
+(** Suffix for interface file names *)
+
+val exec_magic_number: string
+(** Magic number for bytecode executable files *)
+
+val cmi_magic_number: string
+(** Magic number for compiled interface files *)
+
+val cmo_magic_number: string
+(** Magic number for object bytecode files *)
+
+val cma_magic_number: string
+(** Magic number for archive files *)
+
+val cmx_magic_number: string
+(** Magic number for compilation unit descriptions *)
+
+val cmxa_magic_number: string
+(** Magic number for libraries of compilation unit descriptions *)
+
+val ast_intf_magic_number: string
+(** Magic number for file holding an interface syntax tree *)
+
+val ast_impl_magic_number: string
+(** Magic number for file holding an implementation syntax tree *)
+
+val cmxs_magic_number: string
+(** Magic number for dynamically-loadable plugins *)
+
+val cmt_magic_number: string
+(** Magic number for compiled interface files *)
+
+val linear_magic_number: string
+(** Magic number for Linear internal representation files *)
+
+val max_tag: int
+(** Biggest tag that can be stored in the header of a regular block. *)
+
+val lazy_tag : int
+(** Normally the same as Obj.lazy_tag. Separate definition because
+ of technical reasons for bootstrapping. *)
+
+val max_young_wosize: int
+(** Maximal size of arrays that are directly allocated in the
+ minor heap *)
+
+val stack_threshold: int
+(** Size in words of safe area at bottom of VM stack,
+ see runtime/caml/config.h *)
+
+val stack_safety_margin: int
+(** Size in words of the safety margin between the bottom of
+ the stack and the stack pointer. This margin can be used by
+ intermediate computations of some instructions, or the event
+ handler. *)
+
+val native_compiler: bool
+(** Whether the native compiler is available or not
+
+ @since 5.1 *)
+
+val architecture: string
+(** Name of processor type for the native-code compiler *)
+
+val model: string
+(** Name of processor submodel for the native-code compiler *)
+
+val system: string
+(** Name of operating system for the native-code compiler *)
+
+val asm: string
+(** The assembler (and flags) to use for assembling
+ ocamlopt-generated code. *)
+
+val asm_cfi_supported: bool
+(** Whether assembler understands CFI directives *)
+
+val with_frame_pointers : bool
+(** Whether assembler should maintain frame pointers *)
+
+val ext_obj: string
+(** Extension for object files, e.g. [.o] under Unix. *)
+
+val ext_asm: string
+(** Extension for assembler files, e.g. [.s] under Unix. *)
+
+val ext_lib: string
+(** Extension for library files, e.g. [.a] under Unix. *)
+
+val ext_dll: string
+(** Extension for dynamically-loaded libraries, e.g. [.so] under Unix.*)
+
+val ext_exe: string
+(** Extension for executable programs, e.g. [.exe] under Windows.
+
+ @since 4.12 *)
+
+val default_executable_name: string
+(** Name of executable produced by linking if none is given with -o,
+ e.g. [a.out] under Unix. *)
+
+val systhread_supported : bool
+(** Whether the system thread library is implemented *)
+
+val flexdll_dirs : string list
+(** Directories needed for the FlexDLL objects *)
+
+val host : string
+(** Whether the compiler is a cross-compiler *)
+
+val target : string
+(** Whether the compiler is a cross-compiler *)
+
+val flambda : bool
+(** Whether the compiler was configured for flambda *)
+
+val with_flambda_invariants : bool
+(** Whether the invariants checks for flambda are enabled *)
+
+val with_cmm_invariants : bool
+(** Whether the invariants checks for Cmm are enabled *)
+
+val reserved_header_bits : int
+(** How many bits of a block's header are reserved *)
+
+val flat_float_array : bool
+(** Whether the compiler and runtime automagically flatten float
+ arrays *)
+
+val function_sections : bool
+(** Whether the compiler was configured to generate
+ each function in a separate section *)
+
+val windows_unicode: bool
+(** Whether Windows Unicode runtime is enabled *)
+
+val naked_pointers : bool
+(** Whether the runtime supports naked pointers
+
+ @since 4.14 *)
+
+val supports_shared_libraries: bool
+(** Whether shared libraries are supported
+
+ @since 4.08 *)
+
+val native_dynlink: bool
+(** Whether native shared libraries are supported
+
+ @since 5.1 *)
+
+val afl_instrument : bool
+(** Whether afl-fuzz instrumentation is generated by default *)
+
+val ar_supports_response_files: bool
+(** Whether ar supports @FILE arguments. *)
+
+val tsan : bool
+(** Whether ThreadSanitizer instrumentation is enabled *)
+
+(** Access to configuration values *)
+val print_config : out_channel -> unit
+
+val config_var : string -> string option
+(** the configuration value of a variable, if it exists *)
+
+(**/**)
+
+val merlin : bool
+
+(**/**)
diff --git a/upstream/ocaml_503/utils/consistbl.ml b/upstream/ocaml_503/utils/consistbl.ml
new file mode 100644
index 0000000000..29289201f6
--- /dev/null
+++ b/upstream/ocaml_503/utils/consistbl.ml
@@ -0,0 +1,95 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2002 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. *)
+(* *)
+(**************************************************************************)
+
+(* Consistency tables: for checking consistency of module CRCs *)
+
+open Misc
+
+module Make (Module_name : sig
+ type t
+ module Set : Set.S with type elt = t
+ module Map : Map.S with type key = t
+ module Tbl : Hashtbl.S with type key = t
+ val compare : t -> t -> int
+end) = struct
+ type t = (Digest.t * filepath) Module_name.Tbl.t
+
+ let create () = Module_name.Tbl.create 13
+
+ let clear = Module_name.Tbl.clear
+
+ exception Inconsistency of {
+ unit_name : Module_name.t;
+ inconsistent_source : string;
+ original_source : string;
+ }
+
+ exception Not_available of Module_name.t
+
+ let check_ tbl name crc source =
+ let (old_crc, old_source) = Module_name.Tbl.find tbl name in
+ if crc <> old_crc then raise(Inconsistency {
+ unit_name = name;
+ inconsistent_source = source;
+ original_source = old_source;
+ })
+
+ let check tbl name crc source =
+ try check_ tbl name crc source
+ with Not_found ->
+ Module_name.Tbl.add tbl name (crc, source)
+
+ let check_noadd tbl name crc source =
+ try check_ tbl name crc source
+ with Not_found ->
+ raise (Not_available name)
+
+ let source tbl name = snd (Module_name.Tbl.find tbl name)
+
+ let extract l tbl =
+ let l = List.sort_uniq Module_name.compare l in
+ List.fold_left
+ (fun assc name ->
+ try
+ let (crc, _) = Module_name.Tbl.find tbl name in
+ (name, Some crc) :: assc
+ with Not_found ->
+ (name, None) :: assc)
+ [] l
+
+ let extract_map mod_names tbl =
+ Module_name.Set.fold
+ (fun name result ->
+ try
+ let (crc, _) = Module_name.Tbl.find tbl name in
+ Module_name.Map.add name (Some crc) result
+ with Not_found ->
+ Module_name.Map.add name None result)
+ mod_names
+ Module_name.Map.empty
+
+ let filter p tbl =
+ let to_remove = ref [] in
+ Module_name.Tbl.iter
+ (fun name _ ->
+ if not (p name) then to_remove := name :: !to_remove)
+ tbl;
+ List.iter
+ (fun name ->
+ while Module_name.Tbl.mem tbl name do
+ Module_name.Tbl.remove tbl name
+ done)
+ !to_remove
+end
diff --git a/upstream/ocaml_503/utils/consistbl.mli b/upstream/ocaml_503/utils/consistbl.mli
new file mode 100644
index 0000000000..acc89eb31d
--- /dev/null
+++ b/upstream/ocaml_503/utils/consistbl.mli
@@ -0,0 +1,77 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2002 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. *)
+(* *)
+(**************************************************************************)
+
+(** Consistency tables: for checking consistency of module CRCs
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Misc
+
+module Make (Module_name : sig
+ type t
+ module Set : Set.S with type elt = t
+ module Map : Map.S with type key = t
+ module Tbl : Hashtbl.S with type key = t
+ val compare : t -> t -> int
+end) : sig
+ type t
+
+ val create: unit -> t
+
+ val clear: t -> unit
+
+ val check: t -> Module_name.t -> Digest.t -> filepath -> unit
+ (* [check tbl name crc source]
+ checks consistency of ([name], [crc]) with infos previously
+ stored in [tbl]. If no CRC was previously associated with
+ [name], record ([name], [crc]) in [tbl].
+ [source] is the name of the file from which the information
+ comes from. This is used for error reporting. *)
+
+ val check_noadd: t -> Module_name.t -> Digest.t -> filepath -> unit
+ (* Same as [check], but raise [Not_available] if no CRC was previously
+ associated with [name]. *)
+
+ val source: t -> Module_name.t -> filepath
+ (* [source tbl name] returns the file name associated with [name]
+ if the latter has an associated CRC in [tbl].
+ Raise [Not_found] otherwise. *)
+
+ val extract: Module_name.t list -> t -> (Module_name.t * Digest.t option) list
+ (* [extract tbl names] returns an associative list mapping each string
+ in [names] to the CRC associated with it in [tbl]. If no CRC is
+ associated with a name then it is mapped to [None]. *)
+
+ val extract_map : Module_name.Set.t -> t -> Digest.t option Module_name.Map.t
+ (* Like [extract] but with a more sophisticated type. *)
+
+ val filter: (Module_name.t -> bool) -> t -> unit
+ (* [filter pred tbl] removes from [tbl] table all (name, CRC) pairs
+ such that [pred name] is [false]. *)
+
+ exception Inconsistency of {
+ unit_name : Module_name.t;
+ inconsistent_source : string;
+ original_source : string;
+ }
+ (* Raised by [check] when a CRC mismatch is detected. *)
+
+ exception Not_available of Module_name.t
+ (* Raised by [check_noadd] when a name doesn't have an associated
+ CRC. *)
+end
diff --git a/upstream/ocaml_503/utils/diffing.ml b/upstream/ocaml_503/utils/diffing.ml
new file mode 100644
index 0000000000..f2c336d9c4
--- /dev/null
+++ b/upstream/ocaml_503/utils/diffing.ml
@@ -0,0 +1,463 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Radanne, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2020 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 "-16"]
+
+(* This module implements a modified version of Wagner-Fischer
+ See <https://en.wikipedia.org/wiki/Wagner%E2%80%93Fischer_algorithm>
+ for preliminary reading.
+
+ The main extensions is that:
+ - State is computed based on the optimal patch so far.
+ - The lists can be extended at each state computation.
+
+ We add the constraint that extensions can only be in one side
+ (either the left or right list). This is enforced by the external API.
+
+*)
+
+(** Shared types *)
+type change_kind =
+ | Deletion
+ | Insertion
+ | Modification
+ | Preservation
+
+let style = function
+ | Preservation -> Misc.Style.[ FG Green ]
+ | Deletion -> Misc.Style.[ FG Red; Bold]
+ | Insertion -> Misc.Style.[ FG Red; Bold]
+ | Modification -> Misc.Style.[ FG Magenta; Bold]
+
+let prefix ppf (pos, p) =
+ let open Format_doc in
+ let sty = style p in
+ pp_open_stag ppf (Misc.Style.Style sty);
+ fprintf ppf "%i. " pos;
+ pp_close_stag ppf ()
+
+
+let (let*) = Option.bind
+let (let+) x f = Option.map f x
+let (let*!) x f = Option.iter f x
+
+module type Defs = sig
+ type left
+ type right
+ type eq
+ type diff
+ type state
+end
+
+type ('left,'right,'eq,'diff) change =
+ | Delete of 'left
+ | Insert of 'right
+ | Keep of 'left * 'right *' eq
+ | Change of 'left * 'right * 'diff
+
+let classify = function
+ | Delete _ -> Deletion
+ | Insert _ -> Insertion
+ | Change _ -> Modification
+ | Keep _ -> Preservation
+
+module Define(D:Defs) = struct
+ open D
+
+type nonrec change = (left,right,eq,diff) change
+
+type patch = change list
+module type S = sig
+ val diff: state -> left array -> right array -> patch
+end
+
+
+type full_state = {
+ line: left array;
+ column: right array;
+ state: state
+}
+
+(* The matrix supporting our dynamic programming implementation.
+
+ Each cell contains:
+ - The diff and its weight
+ - The state computed so far
+ - The lists, potentially extended locally.
+
+ The matrix can also be reshaped.
+*)
+module Matrix : sig
+
+ type shape = { l : int ; c : int }
+
+ type t
+
+ val make : shape -> t
+ val reshape : shape -> t -> t
+
+ (** accessor functions *)
+ val diff : t -> int -> int -> change option
+ val state : t -> int -> int -> full_state option
+ val weight : t -> int -> int -> int
+
+ val line : t -> int -> int -> left option
+ val column : t -> int -> int -> right option
+
+ val set :
+ t -> int -> int ->
+ diff:change option ->
+ weight:int ->
+ state:full_state ->
+ unit
+
+ (** the shape when starting filling the matrix *)
+ val shape : t -> shape
+
+ (** [shape m i j] is the shape as seen from the state at position (i,j)
+ after some possible extensions
+ *)
+ val shape_at : t -> int -> int -> shape option
+
+ (** the maximal shape on the whole matrix *)
+ val real_shape : t -> shape
+
+ (** debugging printer *)
+ val[@warning "-32"] pp : Format.formatter -> t -> unit
+
+end = struct
+
+ type shape = { l : int ; c : int }
+
+ type t =
+ { states: full_state option array array;
+ weight: int array array;
+ diff: change option array array;
+ columns: int;
+ lines: int;
+ }
+ let opt_get a n =
+ if n < Array.length a then Some (Array.unsafe_get a n) else None
+ let line m i j = let* st = m.states.(i).(j) in opt_get st.line i
+ let column m i j = let* st = m.states.(i).(j) in opt_get st.column j
+ let diff m i j = m.diff.(i).(j)
+ let weight m i j = m.weight.(i).(j)
+ let state m i j = m.states.(i).(j)
+ let shape m = { l = m.lines ; c = m.columns }
+
+ let set m i j ~diff ~weight ~state =
+ m.weight.(i).(j) <- weight;
+ m.states.(i).(j) <- Some state;
+ m.diff.(i).(j) <- diff;
+ ()
+
+ let shape_at tbl i j =
+ let+ st = tbl.states.(i).(j) in
+ let l = Array.length st.line in
+ let c = Array.length st.column in
+ { l ; c }
+
+ let real_shape tbl =
+ let lines = ref tbl.lines in
+ let columns = ref tbl.columns in
+ for i = 0 to tbl.lines do
+ for j = 0 to tbl.columns do
+ let*! {l; c} = shape_at tbl i j in
+ if l > !lines then lines := l;
+ if c > !columns then columns := c
+ done;
+ done;
+ { l = !lines ; c = !columns }
+
+ let make { l = lines ; c = columns } =
+ { states = Array.make_matrix (lines + 1) (columns + 1) None;
+ weight = Array.make_matrix (lines + 1) (columns + 1) max_int;
+ diff = Array.make_matrix (lines + 1) (columns + 1) None;
+ lines;
+ columns;
+ }
+
+ let reshape { l = lines ; c = columns } m =
+ let copy default a =
+ Array.init (1+lines) (fun i -> Array.init (1+columns) (fun j ->
+ if i <= m.lines && j <= m.columns then
+ a.(i).(j)
+ else default) ) in
+ { states = copy None m.states;
+ weight = copy max_int m.weight;
+ diff = copy None m.diff;
+ lines;
+ columns
+ }
+
+ let pp ppf m =
+ let { l ; c } = shape m in
+ Format.eprintf "Shape : %i, %i@." l c;
+ for i = 0 to l do
+ for j = 0 to c do
+ let d = diff m i j in
+ match d with
+ | None ->
+ Format.fprintf ppf " "
+ | Some diff ->
+ let sdiff = match diff with
+ | Insert _ -> "\u{2190}"
+ | Delete _ -> "\u{2191}"
+ | Keep _ -> "\u{2196}"
+ | Change _ -> "\u{21F1}"
+ in
+ let w = weight m i j in
+ Format.fprintf ppf "%s%i " sdiff w
+ done;
+ Format.pp_print_newline ppf ()
+ done
+
+end
+
+
+(* Building the patch.
+
+ We first select the best final cell. A potential final cell
+ is a cell where the local shape (i.e., the size of the strings) correspond
+ to its position in the matrix. In other words: it's at the end of both its
+ strings. We select the final cell with the smallest weight.
+
+ We then build the patch by walking backward from the final cell to the
+ origin.
+*)
+
+let select_final_state m0 =
+ let maybe_final i j =
+ match Matrix.shape_at m0 i j with
+ | Some shape_here -> shape_here.l = i && shape_here.c = j
+ | None -> false
+ in
+ let best_state (i0,j0,weigth0) (i,j) =
+ let weight = Matrix.weight m0 i j in
+ if weight < weigth0 then (i,j,weight) else (i0,j0,weigth0)
+ in
+ let res = ref (0,0,max_int) in
+ let shape = Matrix.shape m0 in
+ for i = 0 to shape.l do
+ for j = 0 to shape.c do
+ if maybe_final i j then
+ res := best_state !res (i,j)
+ done
+ done;
+ let i_final, j_final, _ = !res in
+ assert (i_final <> 0 || j_final <> 0);
+ (i_final, j_final)
+
+let construct_patch m0 =
+ let rec aux acc (i, j) =
+ if i = 0 && j = 0 then
+ acc
+ else
+ match Matrix.diff m0 i j with
+ | None -> assert false
+ | Some d ->
+ let next = match d with
+ | Keep _ | Change _ -> (i-1, j-1)
+ | Delete _ -> (i-1, j)
+ | Insert _ -> (i, j-1)
+ in
+ aux (d::acc) next
+ in
+ aux [] (select_final_state m0)
+
+(* Computation of new cells *)
+
+let select_best_proposition l =
+ let compare_proposition curr prop =
+ match curr, prop with
+ | None, o | o, None -> o
+ | Some (curr_m, curr_res), Some (m, res) ->
+ Some (if curr_m <= m then curr_m, curr_res else m,res)
+ in
+ List.fold_left compare_proposition None l
+
+ module type Full_core = sig
+ type update_result
+ type update_state
+ val weight: change -> int
+ val test: state -> left -> right -> (eq, diff) result
+ val update: change -> update_state -> update_result
+ end
+
+module Generic
+ (X: Full_core
+ with type update_result := full_state
+ and type update_state := full_state) = struct
+ open X
+
+ (* Boundary cell update *)
+ let compute_column0 tbl i =
+ let*! st = Matrix.state tbl (i-1) 0 in
+ let*! line = Matrix.line tbl (i-1) 0 in
+ let diff = Delete line in
+ Matrix.set tbl i 0
+ ~weight:(weight diff + Matrix.weight tbl (i-1) 0)
+ ~state:(update diff st)
+ ~diff:(Some diff)
+
+ let compute_line0 tbl j =
+ let*! st = Matrix.state tbl 0 (j-1) in
+ let*! column = Matrix.column tbl 0 (j-1) in
+ let diff = Insert column in
+ Matrix.set tbl 0 j
+ ~weight:(weight diff + Matrix.weight tbl 0 (j-1))
+ ~state:(update diff st)
+ ~diff:(Some diff)
+
+let compute_inner_cell tbl i j =
+ let compute_proposition i j diff =
+ let* diff = diff in
+ let+ localstate = Matrix.state tbl i j in
+ weight diff + Matrix.weight tbl i j, (diff, localstate)
+ in
+ let del =
+ let diff = let+ x = Matrix.line tbl (i-1) j in Delete x in
+ compute_proposition (i-1) j diff
+ in
+ let insert =
+ let diff = let+ x = Matrix.column tbl i (j-1) in Insert x in
+ compute_proposition i (j-1) diff
+ in
+ let diag =
+ let diff =
+ let* state = Matrix.state tbl (i-1) (j-1) in
+ let* line = Matrix.line tbl (i-1) (j-1) in
+ let* column = Matrix.column tbl (i-1) (j-1) in
+ match test state.state line column with
+ | Ok ok -> Some (Keep (line, column, ok))
+ | Error err -> Some (Change (line, column, err))
+ in
+ compute_proposition (i-1) (j-1) diff
+ in
+ let*! newweight, (diff, localstate) =
+ (* The order of propositions is important here:
+ the call [select_best_proposition [P_0, ...; P_n]] keeps the first
+ proposition with minimal weight as the representative path for this
+ weight class at the current matrix position.
+
+ By induction, the representative path for the minimal weight class will
+ be the smallest path according to the reverse lexical order induced by
+ the element order [[P_0;...; P_n]].
+
+ This is why we choose to start with the [Del] case since path ending with
+ [Del+] suffix are likely to correspond to parital application in the
+ functor application case.
+ Similarly, large block of deletions or insertions at the end of the
+ definitions might point toward incomplete definitions.
+ Thus this seems a good overall setting. *)
+ select_best_proposition [del;insert;diag]
+ in
+ let state = update diff localstate in
+ Matrix.set tbl i j ~weight:newweight ~state ~diff:(Some diff)
+
+let compute_cell m i j =
+ match i, j with
+ | _ when Matrix.diff m i j <> None -> ()
+ | 0,0 -> ()
+ | 0,j -> compute_line0 m j
+ | i,0 -> compute_column0 m i;
+ | _ -> compute_inner_cell m i j
+
+(* Filling the matrix
+
+ We fill the whole matrix, as in vanilla Wagner-Fischer.
+ At this point, the lists in some states might have been extended.
+ If any list have been extended, we need to reshape the matrix
+ and repeat the process
+*)
+let compute_matrix state0 =
+ let m0 = Matrix.make { l = 0 ; c = 0 } in
+ Matrix.set m0 0 0 ~weight:0 ~state:state0 ~diff:None;
+ let rec loop m =
+ let shape = Matrix.shape m in
+ let new_shape = Matrix.real_shape m in
+ if new_shape.l > shape.l || new_shape.c > shape.c then
+ let m = Matrix.reshape new_shape m in
+ for i = 0 to new_shape.l do
+ for j = 0 to new_shape.c do
+ compute_cell m i j
+ done
+ done;
+ loop m
+ else
+ m
+ in
+ loop m0
+ end
+
+
+ module type Parameters = Full_core with type update_state := state
+
+ module Simple(X:Parameters with type update_result := state) = struct
+ module Internal = Generic(struct
+ let test = X.test
+ let weight = X.weight
+ let update d fs = { fs with state = X.update d fs.state }
+ end)
+
+ let diff state line column =
+ let fullstate = { line; column; state } in
+ Internal.compute_matrix fullstate
+ |> construct_patch
+ end
+
+
+ let may_append x = function
+ | [||] -> x
+ | y -> Array.append x y
+
+
+ module Left_variadic
+ (X:Parameters with type update_result := state * left array) = struct
+ open X
+
+ module Internal = Generic(struct
+ let test = X.test
+ let weight = X.weight
+ let update d fs =
+ let state, a = update d fs.state in
+ { fs with state ; line = may_append fs.line a }
+ end)
+
+ let diff state line column =
+ let fullstate = { line; column; state } in
+ Internal.compute_matrix fullstate
+ |> construct_patch
+ end
+
+ module Right_variadic
+ (X:Parameters with type update_result := state * right array) = struct
+ open X
+
+ module Internal = Generic(struct
+ let test = X.test
+ let weight = X.weight
+ let update d fs =
+ let state, a = update d fs.state in
+ { fs with state ; column = may_append fs.column a }
+ end)
+
+ let diff state line column =
+ let fullstate = { line; column; state } in
+ Internal.compute_matrix fullstate
+ |> construct_patch
+ end
+
+end
diff --git a/upstream/ocaml_503/utils/diffing.mli b/upstream/ocaml_503/utils/diffing.mli
new file mode 100644
index 0000000000..79c51fbbae
--- /dev/null
+++ b/upstream/ocaml_503/utils/diffing.mli
@@ -0,0 +1,147 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Radanne, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2020 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. *)
+(* *)
+(**************************************************************************)
+
+(** Parametric diffing
+
+ This module implements diffing over lists of arbitrary content.
+ It is parameterized by
+ - The content of the two lists
+ - The equality witness when an element is kept
+ - The diffing witness when an element is changed
+
+ Diffing is extended to maintain state depending on the
+ computed changes while walking through the two lists.
+
+ The underlying algorithm is a modified Wagner-Fischer algorithm
+ (see <https://en.wikipedia.org/wiki/Wagner%E2%80%93Fischer_algorithm>).
+
+ We provide the following guarantee:
+ Given two lists [l] and [r], if different patches result in different
+ states, we say that the state diverges.
+ - We always return the optimal patch on prefixes of [l] and [r]
+ on which state does not diverge.
+ - Otherwise, we return a correct but non-optimal patch where subpatches
+ with no divergent states are optimal for the given initial state.
+
+ More precisely, the optimality of Wagner-Fischer depends on the property
+ that the edit-distance between a k-prefix of the left input and a l-prefix
+ of the right input d(k,l) satisfies
+
+ d(k,l) = min (
+ del_cost + d(k-1,l),
+ insert_cost + d(k,l-1),
+ change_cost + d(k-1,l-1)
+ )
+
+ Under this hypothesis, it is optimal to choose greedily the state of the
+ minimal patch transforming the left k-prefix into the right l-prefix as a
+ representative of the states of all possible patches transforming the left
+ k-prefix into the right l-prefix.
+
+ If this property is not satisfied, we can still choose greedily a
+ representative state. However, the computed patch is no more guaranteed to
+ be globally optimal.
+ Nevertheless, it is still a correct patch, which is even optimal among all
+ explored patches.
+
+*)
+
+(** The core types of a diffing implementation *)
+module type Defs = sig
+ type left
+ type right
+ type eq
+ (** Detailed equality trace *)
+
+ type diff
+ (** Detailed difference trace *)
+
+ type state
+ (** environment of a partial patch *)
+end
+
+(** The kind of changes which is used to share printing and styling
+ across implementation*)
+type change_kind =
+ | Deletion
+ | Insertion
+ | Modification
+ | Preservation
+val prefix: (int * change_kind) Format_doc.printer
+val style: change_kind -> Misc.Style.style list
+
+
+type ('left,'right,'eq,'diff) change =
+ | Delete of 'left
+ | Insert of 'right
+ | Keep of 'left * 'right *' eq
+ | Change of 'left * 'right * 'diff
+
+val classify: _ change -> change_kind
+
+(** [Define(Defs)] creates the diffing types from the types
+ defined in [Defs] and the functors that need to be instantatied
+ with the diffing algorithm parameters
+*)
+module Define(D:Defs): sig
+ open D
+
+ (** The type of potential changes on a list. *)
+ type nonrec change = (left,right,eq,diff) change
+ type patch = change list
+ (** A patch is an ordered list of changes. *)
+
+ module type Parameters = sig
+ type update_result
+
+ val weight: change -> int
+ (** [weight ch] returns the weight of the change [ch].
+ Used to find the smallest patch. *)
+
+ val test: state -> left -> right -> (eq, diff) result
+ (**
+ [test st xl xr] tests if the elements [xl] and [xr] are
+ co mpatible ([Ok]) or not ([Error]).
+ *)
+
+ val update: change -> state -> update_result
+ (** [update ch st] returns the new state after applying a change.
+ The [update_result] type also contains expansions in the variadic
+ case.
+ *)
+ end
+
+ module type S = sig
+ val diff: state -> left array -> right array -> patch
+ (** [diff state l r] computes the optimal patch between [l] and [r],
+ using the initial state [state].
+ *)
+ end
+
+
+ module Simple: (Parameters with type update_result := state) -> S
+
+ (** {1 Variadic diffing}
+
+ Variadic diffing allows to expand the lists being diffed during diffing.
+ in one specific direction.
+ *)
+ module Left_variadic:
+ (Parameters with type update_result := state * left array) -> S
+
+ module Right_variadic:
+ (Parameters with type update_result := state * right array) -> S
+
+end
diff --git a/upstream/ocaml_503/utils/diffing_with_keys.ml b/upstream/ocaml_503/utils/diffing_with_keys.ml
new file mode 100644
index 0000000000..b56db5a06f
--- /dev/null
+++ b/upstream/ocaml_503/utils/diffing_with_keys.ml
@@ -0,0 +1,208 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+
+type 'a with_pos = {pos:int; data:'a}
+let with_pos l = List.mapi (fun n data -> {pos=n+1; data}) l
+
+(** Composite change and mismatches *)
+type ('l,'r,'diff) mismatch =
+ | Name of {pos:int; got:string; expected:string; types_match:bool}
+ | Type of {pos:int; got:'l; expected:'r; reason:'diff}
+
+type ('l,'r,'diff) change =
+ | Change of ('l,'r,'diff) mismatch
+ | Swap of { pos: int * int; first: string; last: string }
+ | Move of {name:string; got:int; expected:int}
+ | Insert of {pos:int; insert:'r}
+ | Delete of {pos:int; delete:'l}
+
+let prefix ppf x =
+ let kind = match x with
+ | Change _ | Swap _ | Move _ -> Diffing.Modification
+ | Insert _ -> Diffing.Insertion
+ | Delete _ -> Diffing.Deletion
+ in
+ let style k ppf inner =
+ let sty = Diffing.style k in
+ Format_doc.pp_open_stag ppf (Misc.Style.Style sty);
+ Format_doc.kfprintf (fun ppf -> Format_doc.pp_close_stag ppf () ) ppf inner
+ in
+ match x with
+ | Change (Name {pos; _ } | Type {pos; _})
+ | Insert { pos; _ } | Delete { pos; _ } ->
+ style kind ppf "%i. " pos
+ | Swap { pos = left, right; _ } ->
+ style kind ppf "%i<->%i. " left right
+ | Move { got; expected; _ } ->
+ style kind ppf "%i->%i. " expected got
+
+
+
+(** To detect [move] and [swaps], we are using the fact that
+ there are 2-cycles in the graph of name renaming.
+ - [Change (x,y,_)] is then an edge from
+ [key_left x] to [key_right y].
+ - [Insert x] is an edge between the special node epsilon and
+ [key_left x]
+ - [Delete x] is an edge between [key_right] and the epsilon node
+ Since for 2-cycle, knowing one edge is enough to identify the cycle
+ it might belong to, we are using maps of partial 2-cycles.
+*)
+module Two_cycle: sig
+ type t = private (string * string)
+ val create: string -> string -> t
+end = struct
+ type t = string * string
+ let create kx ky =
+ if kx <= ky then kx, ky else ky, kx
+end
+module Swap = Map.Make(struct
+ type t = Two_cycle.t
+ let compare: t -> t -> int = Stdlib.compare
+ end)
+module Move = Misc.Stdlib.String.Map
+
+
+module Define(D:Diffing.Defs with type eq := unit) = struct
+
+ module Internal_defs = struct
+ type left = D.left with_pos
+ type right = D.right with_pos
+ type diff = (D.left, D.right, D.diff) mismatch
+ type eq = unit
+ type state = D.state
+ end
+ module Diff = Diffing.Define(Internal_defs)
+
+ type left = Internal_defs.left
+ type right = Internal_defs.right
+ type diff = (D.left, D.right, D.diff) mismatch
+ type composite_change = (D.left,D.right,D.diff) change
+ type nonrec change = (left, right, unit, diff) Diffing.change
+ type patch = composite_change list
+
+ module type Parameters = sig
+ include Diff.Parameters with type update_result := D.state
+ val key_left: D.left -> string
+ val key_right: D.right -> string
+ end
+
+ module Simple(Impl:Parameters) = struct
+ open Impl
+
+ (** Partial 2-cycles *)
+ type ('l,'r) partial_cycle =
+ | Left of int * D.state * 'l
+ | Right of int * D.state * 'r
+ | Both of D.state * 'l * 'r
+
+ (** Compute the partial cycle and edge associated to an edge *)
+ let edge state (x:left) (y:right) =
+ let kx, ky = key_left x.data, key_right y.data in
+ let edge =
+ if kx <= ky then
+ Left (x.pos, state, (x,y))
+ else
+ Right (x.pos,state, (x,y))
+ in
+ Two_cycle.create kx ky, edge
+
+ let merge_edge ex ey = match ex, ey with
+ | ex, None -> Some ex
+ | Left (lpos, lstate, l), Some Right (rpos, rstate,r)
+ | Right (rpos, rstate,r), Some Left (lpos, lstate, l) ->
+ let state = if lpos < rpos then rstate else lstate in
+ Some (Both (state,l,r))
+ | Both _ as b, _ | _, Some (Both _ as b) -> Some b
+ | l, _ -> Some l
+
+ let two_cycles state changes =
+ let add (state,(swaps,moves)) (d:change) =
+ update d state,
+ match d with
+ | Change (x,y,_) ->
+ let k, edge = edge state x y in
+ Swap.update k (merge_edge edge) swaps, moves
+ | Insert nx ->
+ let k = key_right nx.data in
+ let edge = Right (nx.pos, state,nx) in
+ swaps, Move.update k (merge_edge edge) moves
+ | Delete nx ->
+ let k, edge = key_left nx.data, Left (nx.pos, state, nx) in
+ swaps, Move.update k (merge_edge edge) moves
+ | _ -> swaps, moves
+ in
+ List.fold_left add (state,(Swap.empty,Move.empty)) changes
+
+ (** Check if an edge belongs to a known 2-cycle *)
+ let swap swaps x y =
+ let kx, ky = key_left x.data, key_right y.data in
+ let key = Two_cycle.create kx ky in
+ match Swap.find_opt key swaps with
+ | None | Some (Left _ | Right _)-> None
+ | Some Both (state, (ll,lr),(rl,rr)) ->
+ match test state ll rr, test state rl lr with
+ | Ok _, Ok _ ->
+ Some ({pos=ll.pos; data=kx}, {pos=rl.pos; data=ky})
+ | Error _, _ | _, Error _ -> None
+
+ let move moves x =
+ let name =
+ match x with
+ | Either.Left x -> key_left x.data
+ | Either.Right x -> key_right x.data
+ in
+ match Move.find_opt name moves with
+ | None | Some (Left _ | Right _)-> None
+ | Some Both (state,got,expected) ->
+ match test state got expected with
+ | Ok _ ->
+ Some (Move {name; got=got.pos; expected=expected.pos})
+ | Error _ -> None
+
+ let refine state patch =
+ let _, (swaps, moves) = two_cycles state patch in
+ let filter: change -> composite_change option = function
+ | Keep _ -> None
+ | Insert x ->
+ begin match move moves (Either.Right x) with
+ | Some _ as move -> move
+ | None -> Some (Insert {pos=x.pos;insert=x.data})
+ end
+ | Delete x ->
+ begin match move moves (Either.Left x) with
+ | Some _ -> None
+ | None -> Some (Delete {pos=x.pos; delete=x.data})
+ end
+ | Change(x,y, reason) ->
+ match swap swaps x y with
+ | Some ({pos=pos1; data=first}, {pos=pos2; data=last}) ->
+ if x.pos = pos1 then
+ Some (Swap { pos = pos1, pos2; first; last})
+ else None
+ | None -> Some (Change reason)
+ in
+ List.filter_map filter patch
+
+ let diff state left right =
+ let left = with_pos left in
+ let right = with_pos right in
+ let module Raw = Diff.Simple(Impl) in
+ let raw = Raw.diff state (Array.of_list left) (Array.of_list right) in
+ refine state raw
+
+ end
+end
diff --git a/upstream/ocaml_503/utils/diffing_with_keys.mli b/upstream/ocaml_503/utils/diffing_with_keys.mli
new file mode 100644
index 0000000000..94e56fb72e
--- /dev/null
+++ b/upstream/ocaml_503/utils/diffing_with_keys.mli
@@ -0,0 +1,77 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+(**
+
+ When diffing lists where each element has a distinct key, we can refine
+ the diffing patch by introducing two composite edit moves: swaps and moves.
+
+ [Swap]s exchange the position of two elements. [Swap] cost is set to
+ [2 * change - epsilon].
+ [Move]s change the position of one element. [Move] cost is set to
+ [delete + addition - epsilon].
+
+ When the cost [delete + addition] is greater than [change] and with those
+ specific weights, the optimal patch with [Swap]s and [Move]s can be computed
+ directly and cheaply from the original optimal patch.
+
+*)
+
+type 'a with_pos = {pos: int; data:'a}
+val with_pos: 'a list -> 'a with_pos list
+
+type ('l,'r,'diff) mismatch =
+ | Name of {pos:int; got:string; expected:string; types_match:bool}
+ | Type of {pos:int; got:'l; expected:'r; reason:'diff}
+
+(** This specialized version of changes introduces two composite
+ changes: [Move] and [Swap]
+*)
+type ('l,'r,'diff) change =
+ | Change of ('l,'r,'diff) mismatch
+ | Swap of { pos: int * int; first: string; last: string }
+ | Move of {name:string; got:int; expected:int}
+ | Insert of {pos:int; insert:'r}
+ | Delete of {pos:int; delete:'l}
+
+val prefix: ('l,'r,'diff) change Format_doc.printer
+
+module Define(D:Diffing.Defs with type eq := unit): sig
+
+ type diff = (D.left, D.right, D.diff) mismatch
+ type left = D.left with_pos
+ type right = D.right with_pos
+
+ (** Composite changes and patches *)
+ type composite_change = (D.left,D.right,D.diff) change
+ type patch = composite_change list
+
+ (** Atomic changes *)
+ type change = (left,right,unit,diff) Diffing.change
+
+ module type Parameters = sig
+ val weight: change -> int
+ val test: D.state -> left -> right -> (unit, diff) result
+ val update: change -> D.state -> D.state
+
+ val key_left: D.left -> string
+ val key_right: D.right -> string
+ end
+
+ module Simple: Parameters -> sig
+ val diff: D.state -> D.left list -> D.right list -> patch
+ end
+
+end
diff --git a/upstream/ocaml_503/utils/domainstate.ml.c b/upstream/ocaml_503/utils/domainstate.ml.c
new file mode 100644
index 0000000000..6dbae1d07a
--- /dev/null
+++ b/upstream/ocaml_503/utils/domainstate.ml.c
@@ -0,0 +1,38 @@
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* 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. */
+/* */
+/**************************************************************************/
+
+#define CAML_CONFIG_H_NO_TYPEDEFS
+#include "config.h"
+let stack_ctx_words = Stack_ctx_words
+
+type t =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+let idx_of_field =
+ let curr = 0 in
+#define DOMAIN_STATE(type, name) \
+ let idx__##name = curr in \
+ let curr = curr + 1 in
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+ let _ = curr in
+ function
+#define DOMAIN_STATE(type, name) \
+ | Domain_##name -> idx__##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
diff --git a/upstream/ocaml_503/utils/domainstate.mli.c b/upstream/ocaml_503/utils/domainstate.mli.c
new file mode 100644
index 0000000000..66a4750d4c
--- /dev/null
+++ b/upstream/ocaml_503/utils/domainstate.mli.c
@@ -0,0 +1,24 @@
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* 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. */
+/* */
+/**************************************************************************/
+
+val stack_ctx_words : int
+
+type t =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+val idx_of_field : t -> int
diff --git a/upstream/ocaml_503/utils/format_doc.ml b/upstream/ocaml_503/utils/format_doc.ml
new file mode 100644
index 0000000000..97014afd3a
--- /dev/null
+++ b/upstream/ocaml_503/utils/format_doc.ml
@@ -0,0 +1,485 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 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. *)
+(* *)
+(**************************************************************************)
+
+module Doc = struct
+
+ type box_type =
+ | H
+ | V
+ | HV
+ | HoV
+ | B
+
+ type stag = Format.stag
+
+ type element =
+ | Text of string
+ | With_size of int
+ | Open_box of { kind: box_type ; indent:int }
+ | Close_box
+ | Open_tag of Format.stag
+ | Close_tag
+ | Open_tbox
+ | Tab_break of { width : int; offset : int }
+ | Set_tab
+ | Close_tbox
+ | Simple_break of { spaces : int; indent: int }
+ | Break of { fits : string * int * string as 'a; breaks : 'a }
+ | Flush of { newline:bool }
+ | Newline
+ | If_newline
+
+ | Deprecated of (Format.formatter -> unit)
+
+ type t = { rev:element list } [@@unboxed]
+
+ let empty = { rev = [] }
+
+ let to_list doc = List.rev doc.rev
+ let add doc x = { rev = x :: doc.rev }
+ let fold f acc doc = List.fold_left f acc (to_list doc)
+ let append left right = { rev = right.rev @ left.rev }
+
+ let format_open_box_gen ppf kind indent =
+ match kind with
+ | H-> Format.pp_open_hbox ppf ()
+ | V -> Format.pp_open_vbox ppf indent
+ | HV -> Format.pp_open_hvbox ppf indent
+ | HoV -> Format.pp_open_hovbox ppf indent
+ | B -> Format.pp_open_box ppf indent
+
+ let interpret_elt ppf = function
+ | Text x -> Format.pp_print_string ppf x
+ | Open_box { kind; indent } -> format_open_box_gen ppf kind indent
+ | Close_box -> Format.pp_close_box ppf ()
+ | Open_tag tag -> Format.pp_open_stag ppf tag
+ | Close_tag -> Format.pp_close_stag ppf ()
+ | Open_tbox -> Format.pp_open_tbox ppf ()
+ | Tab_break {width;offset} -> Format.pp_print_tbreak ppf width offset
+ | Set_tab -> Format.pp_set_tab ppf ()
+ | Close_tbox -> Format.pp_close_tbox ppf ()
+ | Simple_break {spaces;indent} -> Format.pp_print_break ppf spaces indent
+ | Break {fits;breaks} -> Format.pp_print_custom_break ppf ~fits ~breaks
+ | Flush {newline=true} -> Format.pp_print_newline ppf ()
+ | Flush {newline=false} -> Format.pp_print_flush ppf ()
+ | Newline -> Format.pp_force_newline ppf ()
+ | If_newline -> Format.pp_print_if_newline ppf ()
+ | With_size _ -> ()
+ | Deprecated pr -> pr ppf
+
+ let rec interpret ppf = function
+ | [] -> ()
+ | With_size size :: Text text :: l ->
+ Format.pp_print_as ppf size text;
+ interpret ppf l
+ | x :: l ->
+ interpret_elt ppf x;
+ interpret ppf l
+
+ let format ppf doc = interpret ppf (to_list doc)
+
+
+
+ let open_box kind indent doc = add doc (Open_box {kind;indent})
+ let close_box doc = add doc Close_box
+
+ let string s doc = add doc (Text s)
+ let bytes b doc = add doc (Text (Bytes.to_string b))
+ let with_size size doc = add doc (With_size size)
+
+ let int n doc = add doc (Text (string_of_int n))
+ let float f doc = add doc (Text (string_of_float f))
+ let char c doc = add doc (Text (String.make 1 c))
+ let bool c doc = add doc (Text (Bool.to_string c))
+
+ let break ~spaces ~indent doc = add doc (Simple_break {spaces; indent})
+ let space doc = break ~spaces:1 ~indent:0 doc
+ let cut = break ~spaces:0 ~indent:0
+
+ let custom_break ~fits ~breaks doc = add doc (Break {fits;breaks})
+
+ let force_newline doc = add doc Newline
+ let if_newline doc = add doc If_newline
+
+ let flush doc = add doc (Flush {newline=false})
+ let force_stop doc = add doc (Flush {newline=true})
+
+ let open_tbox doc = add doc Open_tbox
+ let set_tab doc = add doc Set_tab
+ let tab_break ~width ~offset doc = add doc (Tab_break {width;offset})
+ let tab doc = tab_break ~width:0 ~offset:0 doc
+ let close_tbox doc = add doc Close_tbox
+
+ let open_tag stag doc = add doc (Open_tag stag)
+ let close_tag doc = add doc Close_tag
+
+ let iter ?(sep=Fun.id) ~iter:iterator elt l doc =
+ let first = ref true in
+ let rdoc = ref doc in
+ let print x =
+ if !first then (first := false; rdoc := elt x !rdoc)
+ else rdoc := !rdoc |> sep |> elt x
+ in
+ iterator print l;
+ !rdoc
+
+ let rec list ?(sep=Fun.id) elt l doc = match l with
+ | [] -> doc
+ | [a] -> elt a doc
+ | a :: ((_ :: _) as q) ->
+ doc |> elt a |> sep |> list ~sep elt q
+
+ let array ?sep elt a doc = iter ?sep ~iter:Array.iter elt a doc
+ let seq ?sep elt s doc = iter ?sep ~iter:Seq.iter elt s doc
+
+ let option ?(none=Fun.id) elt o doc = match o with
+ | None -> none doc
+ | Some x -> elt x doc
+
+ let either ~left ~right x doc = match x with
+ | Either.Left x -> left x doc
+ | Either.Right x -> right x doc
+
+ let result ~ok ~error x doc = match x with
+ | Ok x -> ok x doc
+ | Error x -> error x doc
+
+ (* To format free-flowing text *)
+ let rec subtext len left right s doc =
+ let flush doc =
+ doc |> string (String.sub s left (right - left))
+ in
+ let after_flush doc = subtext len (right+1) (right+1) s doc in
+ if right = len then
+ if left <> len then flush doc else doc
+ else
+ match s.[right] with
+ | '\n' ->
+ doc |> flush |> force_newline |> after_flush
+ | ' ' ->
+ doc |> flush |> space |> after_flush
+ (* there is no specific support for '\t'
+ as it is unclear what a right semantics would be *)
+ | _ -> subtext len left (right + 1) s doc
+
+ let text s doc =
+ subtext (String.length s) 0 0 s doc
+
+ type ('a,'b) fmt = ('a, t, t, 'b) format4
+ type printer0 = t -> t
+ type 'a printer = 'a -> printer0
+
+ let output_formatting_lit fmting_lit doc =
+ let open CamlinternalFormatBasics in
+ match fmting_lit with
+ | Close_box -> close_box doc
+ | Close_tag -> close_tag doc
+ | Break (_, width, offset) -> break ~spaces:width ~indent:offset doc
+ | FFlush -> flush doc
+ | Force_newline -> force_newline doc
+ | Flush_newline -> force_stop doc
+ | Magic_size (_, n) -> with_size n doc
+ | Escaped_at -> char '@' doc
+ | Escaped_percent -> char '%' doc
+ | Scan_indic c -> doc |> char '@' |> char c
+
+ let to_string doc =
+ let b = Buffer.create 20 in
+ let convert = function
+ | Text s -> Buffer.add_string b s
+ | _ -> ()
+ in
+ fold (fun () x -> convert x) () doc;
+ Buffer.contents b
+
+ let box_type =
+ let open CamlinternalFormatBasics in
+ function
+ | Pp_fits -> H
+ | Pp_hbox -> H
+ | Pp_vbox -> V
+ | Pp_hovbox -> HoV
+ | Pp_hvbox -> HV
+ | Pp_box -> B
+
+ let rec compose_acc acc doc =
+ let open CamlinternalFormat in
+ match acc with
+ | CamlinternalFormat.Acc_formatting_lit (p, f) ->
+ doc |> compose_acc p |> output_formatting_lit f
+ | Acc_formatting_gen (p, Acc_open_tag acc') ->
+ let tag = to_string (compose_acc acc' empty) in
+ let doc = compose_acc p doc in
+ doc |> open_tag (Format.String_tag tag)
+ | Acc_formatting_gen (p, Acc_open_box acc') ->
+ let doc = compose_acc p doc in
+ let box = to_string (compose_acc acc' empty) in
+ let (indent, bty) = CamlinternalFormat.open_box_of_string box in
+ doc |> open_box (box_type bty) indent
+ | Acc_string_literal (p, s)
+ | Acc_data_string (p, s) ->
+ doc |> compose_acc p |> string s
+ | Acc_char_literal (p, c)
+ | Acc_data_char (p, c) -> doc |> compose_acc p |> char c
+ | Acc_delay (p, f) -> doc |> compose_acc p |> f
+ | Acc_flush p -> doc |> compose_acc p |> flush
+ | Acc_invalid_arg (_p, msg) -> invalid_arg msg;
+ | End_of_acc -> doc
+
+ let kprintf k (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc doc -> doc |> compose_acc acc |> k )
+ End_of_acc fmt
+
+ let printf doc = kprintf Fun.id doc
+ let kmsg k (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc -> k (compose_acc acc empty))
+ End_of_acc fmt
+
+ let msg fmt = kmsg Fun.id fmt
+
+end
+
+(** Compatibility interface *)
+
+type doc = Doc.t
+type t = doc
+type formatter = doc ref
+type 'a printer = formatter -> 'a -> unit
+
+let formatter d = d
+
+(** {1 Primitive functions }*)
+
+let pp_print_string ppf s = ppf := Doc.string s !ppf
+
+let pp_print_as ppf size s =
+ ppf := !ppf |> Doc.with_size size |> Doc.string s
+
+let pp_print_substring ~pos ~len ppf s =
+ ppf := Doc.string (String.sub s pos len) !ppf
+
+let pp_print_substring_as ~pos ~len ppf size s =
+ ppf :=
+ !ppf
+ |> Doc.with_size size
+ |> Doc.string (String.sub s pos len)
+
+let pp_print_bytes ppf s = ppf := Doc.string (Bytes.to_string s) !ppf
+let pp_print_text ppf s = ppf := Doc.text s !ppf
+let pp_print_char ppf c = ppf := Doc.char c !ppf
+let pp_print_int ppf c = ppf := Doc.int c !ppf
+let pp_print_float ppf f = ppf := Doc.float f !ppf
+let pp_print_bool ppf b = ppf := Doc.bool b !ppf
+let pp_print_nothing _ _ = ()
+
+let pp_close_box ppf () = ppf := Doc.close_box !ppf
+let pp_close_stag ppf () = ppf := Doc.close_tag !ppf
+
+let pp_print_break ppf spaces indent = ppf := Doc.break ~spaces ~indent !ppf
+
+let pp_print_custom_break ppf ~fits ~breaks =
+ ppf := Doc.custom_break ~fits ~breaks !ppf
+
+let pp_print_space ppf () = pp_print_break ppf 1 0
+let pp_print_cut ppf () = pp_print_break ppf 0 0
+
+let pp_print_flush ppf () = ppf := Doc.flush !ppf
+let pp_force_newline ppf () = ppf := Doc.force_newline !ppf
+let pp_print_newline ppf () = ppf := Doc.force_stop !ppf
+let pp_print_if_newline ppf () =ppf := Doc.if_newline !ppf
+
+let pp_open_stag ppf stag = ppf := !ppf |> Doc.open_tag stag
+
+let pp_open_box_gen ppf indent bxty =
+ let box_type = Doc.box_type bxty in
+ ppf := !ppf |> Doc.open_box box_type indent
+
+let pp_open_box ppf indent = pp_open_box_gen ppf indent Pp_box
+
+
+let pp_open_tbox ppf () = ppf := !ppf |> Doc.open_tbox
+
+let pp_close_tbox ppf () = ppf := !ppf |> Doc.close_tbox
+
+let pp_set_tab ppf () = ppf := !ppf |> Doc.set_tab
+
+let pp_print_tab ppf () = ppf := !ppf |> Doc.tab
+
+let pp_print_tbreak ppf width offset =
+ ppf := !ppf |> Doc.tab_break ~width ~offset
+
+let pp_doc ppf doc = ppf := Doc.append !ppf doc
+
+module Driver = struct
+ (* Interpret a formatting entity on a formatter. *)
+ let output_formatting_lit ppf
+ (fmting_lit:CamlinternalFormatBasics.formatting_lit)
+ = match fmting_lit with
+ | Close_box -> pp_close_box ppf ()
+ | Close_tag -> pp_close_stag ppf ()
+ | Break (_, width, offset) -> pp_print_break ppf width offset
+ | FFlush -> pp_print_flush ppf ()
+ | Force_newline -> pp_force_newline ppf ()
+ | Flush_newline -> pp_print_newline ppf ()
+ | Magic_size (_, _) -> ()
+ | Escaped_at -> pp_print_char ppf '@'
+ | Escaped_percent -> pp_print_char ppf '%'
+ | Scan_indic c -> pp_print_char ppf '@'; pp_print_char ppf c
+
+
+
+ let compute_tag output tag_acc =
+ let buf = Buffer.create 16 in
+ let buf_fmt = Format.formatter_of_buffer buf in
+ let ppf = ref Doc.empty in
+ output ppf tag_acc;
+ pp_print_flush ppf ();
+ Doc.format buf_fmt !ppf;
+ let len = Buffer.length buf in
+ if len < 2 then Buffer.contents buf
+ else Buffer.sub buf 1 (len - 2)
+
+ (* Recursively output an "accumulator" containing a reversed list of
+ printing entities (string, char, flus, ...) in an output_stream. *)
+ (* Differ from Printf.output_acc by the interpretation of formatting. *)
+ (* Used as a continuation of CamlinternalFormat.make_printf. *)
+ let rec output_acc ppf (acc: _ CamlinternalFormat.acc) =
+ match acc with
+ | Acc_string_literal (Acc_formatting_lit (p, Magic_size (_, size)), s)
+ | Acc_data_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
+ output_acc ppf p;
+ pp_print_as ppf size s;
+ | Acc_char_literal (Acc_formatting_lit (p, Magic_size (_, size)), c)
+ | Acc_data_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
+ output_acc ppf p;
+ pp_print_as ppf size (String.make 1 c);
+ | Acc_formatting_lit (p, f) ->
+ output_acc ppf p;
+ output_formatting_lit ppf f;
+ | Acc_formatting_gen (p, Acc_open_tag acc') ->
+ output_acc ppf p;
+ pp_open_stag ppf (Format.String_tag (compute_tag output_acc acc'))
+ | Acc_formatting_gen (p, Acc_open_box acc') ->
+ output_acc ppf p;
+ let (indent, bty) =
+ let box_info = compute_tag output_acc acc' in
+ CamlinternalFormat.open_box_of_string box_info
+ in
+ pp_open_box_gen ppf indent bty
+ | Acc_string_literal (p, s)
+ | Acc_data_string (p, s) -> output_acc ppf p; pp_print_string ppf s;
+ | Acc_char_literal (p, c)
+ | Acc_data_char (p, c) -> output_acc ppf p; pp_print_char ppf c;
+ | Acc_delay (p, f) -> output_acc ppf p; f ppf;
+ | Acc_flush p -> output_acc ppf p; pp_print_flush ppf ();
+ | Acc_invalid_arg (p, msg) -> output_acc ppf p; invalid_arg msg;
+ | End_of_acc -> ()
+end
+
+let kfprintf k ppf (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc -> Driver.output_acc ppf acc; k ppf)
+ End_of_acc fmt
+let fprintf doc fmt = kfprintf ignore doc fmt
+
+
+let kdprintf k (CamlinternalFormatBasics.Format (fmt, _)) =
+ CamlinternalFormat.make_printf
+ (fun acc -> k (fun ppf -> Driver.output_acc ppf acc))
+ End_of_acc fmt
+
+let dprintf fmt = kdprintf (fun i -> i) fmt
+
+let doc_printf fmt =
+ let ppf = ref Doc.empty in
+ kfprintf (fun _ -> let doc = !ppf in ppf := Doc.empty; doc) ppf fmt
+
+let kdoc_printf k fmt =
+ let ppf = ref Doc.empty in
+ kfprintf (fun ppf ->
+ let doc = !ppf in
+ ppf := Doc.empty;
+ k doc
+ )
+ ppf fmt
+
+let doc_printer f x doc =
+ let r = ref doc in
+ f r x;
+ !r
+
+type 'a format_printer = Format.formatter -> 'a -> unit
+
+let format_printer f ppf x =
+ let doc = doc_printer f x Doc.empty in
+ Doc.format ppf doc
+let compat = format_printer
+let compat1 f p1 = compat (f p1)
+let compat2 f p1 p2 = compat (f p1 p2)
+
+let kasprintf k fmt =
+ kdoc_printf (fun doc -> k (Format.asprintf "%a" Doc.format doc)) fmt
+let asprintf fmt = kasprintf Fun.id fmt
+
+let pp_print_iter ?(pp_sep=pp_print_cut) iter elt ppf c =
+ let sep = doc_printer pp_sep () in
+ ppf:= Doc.iter ~sep ~iter (doc_printer elt) c !ppf
+
+let pp_print_list ?(pp_sep=pp_print_cut) elt ppf l =
+ ppf := Doc.list ~sep:(doc_printer pp_sep ()) (doc_printer elt) l !ppf
+
+let pp_print_array ?pp_sep elt ppf a =
+ pp_print_iter ?pp_sep Array.iter elt ppf a
+let pp_print_seq ?pp_sep elt ppf s = pp_print_iter ?pp_sep Seq.iter elt ppf s
+
+let pp_print_option ?(none=fun _ () -> ()) elt ppf o =
+ ppf := Doc.option ~none:(doc_printer none ()) (doc_printer elt) o !ppf
+
+let pp_print_result ~ok ~error ppf r =
+ ppf := Doc.result ~ok:(doc_printer ok) ~error:(doc_printer error) r !ppf
+
+let pp_print_either ~left ~right ppf e =
+ ppf := Doc.either ~left:(doc_printer left) ~right:(doc_printer right) e !ppf
+
+let comma ppf () = fprintf ppf ",@ "
+
+let pp_two_columns ?(sep = "|") ?max_lines ppf (lines: (string * string) list) =
+ let left_column_size =
+ List.fold_left (fun acc (s, _) -> Int.max acc (String.length s)) 0 lines in
+ let lines_nb = List.length lines in
+ let ellipsed_first, ellipsed_last =
+ match max_lines with
+ | Some max_lines when lines_nb > max_lines ->
+ let printed_lines = max_lines - 1 in (* the ellipsis uses one line *)
+ let lines_before = printed_lines / 2 + printed_lines mod 2 in
+ let lines_after = printed_lines / 2 in
+ (lines_before, lines_nb - lines_after - 1)
+ | _ -> (-1, -1)
+ in
+ fprintf ppf "@[<v>";
+ List.iteri (fun k (line_l, line_r) ->
+ if k = ellipsed_first then fprintf ppf "...@,";
+ if ellipsed_first <= k && k <= ellipsed_last then ()
+ else fprintf ppf "%*s %s %s@," left_column_size line_l sep line_r
+ ) lines;
+ fprintf ppf "@]"
+
+let deprecated_printer pr ppf = ppf := Doc.add !ppf (Doc.Deprecated pr)
+let deprecated pr ppf x =
+ ppf := Doc.add !ppf (Doc.Deprecated (fun ppf -> pr ppf x))
+let deprecated1 pr p1 ppf x =
+ ppf := Doc.add !ppf (Doc.Deprecated (fun ppf -> pr p1 ppf x))
diff --git a/upstream/ocaml_503/utils/format_doc.mli b/upstream/ocaml_503/utils/format_doc.mli
new file mode 100644
index 0000000000..bf36829add
--- /dev/null
+++ b/upstream/ocaml_503/utils/format_doc.mli
@@ -0,0 +1,299 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2024 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. *)
+(* *)
+(**************************************************************************)
+
+(** Composable document for the {!Format} formatting engine. *)
+
+(** This module introduces a pure and immutable document type which represents a
+ sequence of formatting instructions to be printed by a formatting engine at
+ later point. At the same time, it also provides format string interpreter
+ which produces this document type from format string and their associated
+ printers.
+
+ The module is designed to be source compatible with code defining format
+ printers: replacing `Format` by `Format_doc` in your code will convert
+ `Format` printers to `Format_doc` printers.
+*)
+
+(** Definitions and immutable API for composing documents *)
+module Doc: sig
+
+ (** {2 Type definitions and core functions }*)
+
+ (** Format box types *)
+ type box_type =
+ | H
+ | V
+ | HV
+ | HoV
+ | B
+
+ type stag = Format.stag
+
+ (** Base formatting instruction recognized by {!Format} *)
+ type element =
+ | Text of string
+ | With_size of int
+ | Open_box of { kind: box_type ; indent:int }
+ | Close_box
+ | Open_tag of Format.stag
+ | Close_tag
+ | Open_tbox
+ | Tab_break of { width : int; offset : int }
+ | Set_tab
+ | Close_tbox
+ | Simple_break of { spaces : int; indent : int }
+ | Break of { fits : string * int * string as 'a; breaks : 'a }
+ | Flush of { newline:bool }
+ | Newline
+ | If_newline
+
+ | Deprecated of (Format.formatter -> unit)
+ (** Escape hatch: a {!Format} printer used to provide backward-compatibility
+ for user-defined printer (from the [#install_printer] toplevel directive
+ for instance). *)
+
+ (** Immutable document type*)
+ type t
+
+ type ('a,'b) fmt = ('a, t, t,'b) format4
+
+ type printer0 = t -> t
+ type 'a printer = 'a -> printer0
+
+
+ (** Empty document *)
+ val empty: t
+
+ (** [format ppf doc] sends the format instruction of [doc] to the Format's
+ formatter [doc]. *)
+ val format: Format.formatter -> t -> unit
+
+ (** Fold over a document as a sequence of instructions *)
+ val fold: ('acc -> element -> 'acc) -> 'acc -> t -> 'acc
+
+ (** {!msg} and {!kmsg} produce a document from a format string and its
+ argument *)
+ val msg: ('a,t) fmt -> 'a
+ val kmsg: (t -> 'b) -> ('a,'b) fmt -> 'a
+
+ (** {!printf} and {!kprintf} produce a printer from a format string and its
+ argument*)
+ val printf: ('a, printer0) fmt -> 'a
+ val kprintf: (t -> 'b) -> ('a, t -> 'b) fmt -> 'a
+
+ (** The functions below mirror {!Format} printers, without the [pp_print_]
+ prefix naming convention *)
+ val open_box: box_type -> int -> printer0
+ val close_box: printer0
+
+ val text: string printer
+ val string: string printer
+ val bytes: bytes printer
+ val with_size: int printer
+
+ val int: int printer
+ val float: float printer
+ val char: char printer
+ val bool: bool printer
+
+ val space: printer0
+ val cut: printer0
+ val break: spaces:int -> indent:int -> printer0
+
+ val custom_break:
+ fits:(string * int * string as 'a) -> breaks:'a -> printer0
+ val force_newline: printer0
+ val if_newline: printer0
+
+ val flush: printer0
+ val force_stop: printer0
+
+ val open_tbox: printer0
+ val set_tab: printer0
+ val tab: printer0
+ val tab_break: width:int -> offset:int -> printer0
+ val close_tbox: printer0
+
+ val open_tag: stag printer
+ val close_tag: printer0
+
+ val list: ?sep:printer0 -> 'a printer -> 'a list printer
+ val iter:
+ ?sep:printer0 -> iter:(('a -> unit) -> 'b -> unit) -> 'a printer
+ ->'b printer
+ val array: ?sep:printer0 -> 'a printer -> 'a array printer
+ val seq: ?sep:printer0 -> 'a printer -> 'a Seq.t printer
+
+ val option: ?none:printer0 -> 'a printer -> 'a option printer
+ val result: ok:'a printer -> error:'e printer -> ('a,'e) result printer
+ val either: left:'a printer -> right:'b printer -> ('a,'b) Either.t printer
+
+end
+
+(** {1 Compatibility API} *)
+
+(** The functions and types below provides source compatibility with format
+printers and conversion function from {!Format_doc} printers to {!Format}
+printers. The reverse direction is implemented using an escape hatch in the
+formatting instruction and should only be used to preserve backward
+compatibility. *)
+
+type doc = Doc.t
+type t = doc
+type formatter
+type 'a printer = formatter -> 'a -> unit
+
+val formatter: doc ref -> formatter
+(** [formatter rdoc] creates a {!formatter} that updates the [rdoc] reference *)
+
+(** Translate a {!Format_doc} printer to a {!Format} one. *)
+type 'a format_printer = Format.formatter -> 'a -> unit
+val compat: 'a printer -> 'a format_printer
+val compat1: ('p1 -> 'a printer) -> ('p1 -> 'a format_printer)
+val compat2: ('p1 -> 'p2 -> 'a printer) -> ('p1 -> 'p2 -> 'a format_printer)
+
+(** If necessary, embbed a {!Format} printer inside a formatting instruction
+ stream. This breaks every guarantees provided by {!Format_doc}. *)
+val deprecated_printer: (Format.formatter -> unit) -> formatter -> unit
+val deprecated: 'a format_printer -> 'a printer
+val deprecated1: ('p1 -> 'a format_printer) -> ('p1 -> 'a printer)
+
+
+(** {2 Format string interpreters }*)
+
+val fprintf : formatter -> ('a, formatter,unit) format -> 'a
+val kfprintf:
+ (formatter -> 'a) -> formatter ->
+ ('b, formatter, unit, 'a) format4 -> 'b
+
+val asprintf : ('a, formatter, unit, string) format4 -> 'a
+val kasprintf : (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b
+
+
+val dprintf : ('a, formatter, unit, formatter -> unit) format4 -> 'a
+val kdprintf:
+ ((formatter -> unit) -> 'a) ->
+ ('b, formatter, unit, 'a) format4 -> 'b
+
+(** {!doc_printf} and {!kdoc_printf} creates a document directly *)
+val doc_printf: ('a, formatter, unit, doc) format4 -> 'a
+val kdoc_printf: (doc -> 'r) -> ('a, formatter, unit, 'r) format4 -> 'a
+
+(** {2 Compatibility with {!Doc} }*)
+
+val doc_printer: 'a printer -> 'a Doc.printer
+val pp_doc: doc printer
+
+(** {2 Source compatibility with Format}*)
+
+(** {3 String printers } *)
+
+val pp_print_string: string printer
+val pp_print_substring: pos:int -> len:int -> string printer
+val pp_print_text: string printer
+val pp_print_bytes: bytes printer
+
+val pp_print_as: formatter -> int -> string -> unit
+val pp_print_substring_as:
+ pos:int -> len:int -> formatter -> int -> string -> unit
+
+(** {3 Primitive type printers }*)
+
+val pp_print_char: char printer
+val pp_print_int: int printer
+val pp_print_float: float printer
+val pp_print_bool: bool printer
+val pp_print_nothing: unit printer
+
+(** {3 Printer combinators }*)
+
+val pp_print_iter:
+ ?pp_sep:unit printer -> (('a -> unit) -> 'b -> unit) ->
+ 'a printer -> 'b printer
+
+val pp_print_list: ?pp_sep:unit printer -> 'a printer -> 'a list printer
+val pp_print_array: ?pp_sep:unit printer -> 'a printer -> 'a array printer
+val pp_print_seq: ?pp_sep:unit printer -> 'a printer -> 'a Seq.t printer
+
+val pp_print_option: ?none:unit printer -> 'a printer -> 'a option printer
+val pp_print_result: ok:'a printer -> error:'e printer -> ('a,'e) result printer
+val pp_print_either:
+ left:'a printer -> right:'b printer -> ('a,'b) Either.t printer
+
+
+(** {3 Boxes and tags }*)
+
+val pp_open_stag: Format.stag printer
+val pp_close_stag: unit printer
+
+val pp_open_box: int printer
+val pp_close_box: unit printer
+
+(** {3 Break hints} *)
+
+val pp_print_space: unit printer
+val pp_print_cut: unit printer
+val pp_print_break: formatter -> int -> int -> unit
+val pp_print_custom_break:
+ formatter -> fits:(string * int * string as 'c) -> breaks:'c -> unit
+
+(** {3 Tabulations }*)
+
+val pp_open_tbox: unit printer
+val pp_close_tbox: unit printer
+val pp_set_tab: unit printer
+val pp_print_tab: unit printer
+val pp_print_tbreak: formatter -> int -> int -> unit
+
+(** {3 Newlines and flushing }*)
+
+val pp_print_if_newline: unit printer
+val pp_force_newline: unit printer
+val pp_print_flush: unit printer
+val pp_print_newline: unit printer
+
+(** {1 Compiler specific functions }*)
+
+(** {2 Separators }*)
+
+val comma: unit printer
+
+(** {2 Compiler output} *)
+
+val pp_two_columns :
+ ?sep:string -> ?max_lines:int ->
+ formatter -> (string * string) list -> unit
+(** [pp_two_columns ?sep ?max_lines ppf l] prints the lines in [l] as two
+ columns separated by [sep] ("|" by default). [max_lines] can be used to
+ indicate a maximum number of lines to print -- an ellipsis gets inserted at
+ the middle if the input has too many lines.
+
+ Example:
+
+ {v pp_two_columns ~max_lines:3 Format.std_formatter [
+ "abc", "hello";
+ "def", "zzz";
+ "a" , "bllbl";
+ "bb" , "dddddd";
+ ] v}
+
+ prints
+
+ {v
+ abc | hello
+ ...
+ bb | dddddd
+ v}
+*)
diff --git a/upstream/ocaml_503/utils/identifiable.ml b/upstream/ocaml_503/utils/identifiable.ml
new file mode 100644
index 0000000000..9bbfb65733
--- /dev/null
+++ b/upstream/ocaml_503/utils/identifiable.ml
@@ -0,0 +1,249 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2013--2016 OCamlPro SAS *)
+(* Copyright 2014--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+module type Thing = sig
+ type t
+
+ include Hashtbl.HashedType with type t := t
+ include Map.OrderedType with type t := t
+
+ val output : out_channel -> t -> unit
+ val print : Format.formatter -> t -> unit
+end
+
+module type Set = sig
+ module T : Set.OrderedType
+ include Set.S
+ with type elt = T.t
+ and type t = Set.Make (T).t
+
+ val output : out_channel -> t -> unit
+ val print : Format.formatter -> t -> unit
+ val to_string : t -> string
+ val of_list : elt list -> t
+ val map : (elt -> elt) -> t -> t
+end
+
+module type Map = sig
+ module T : Map.OrderedType
+ include Map.S
+ with type key = T.t
+ and type 'a t = 'a Map.Make (T).t
+
+ val of_list : (key * 'a) list -> 'a t
+
+ val disjoint_union :
+ ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t ->
+ 'a t -> 'a t
+
+ val union_right : 'a t -> 'a t -> 'a t
+
+ val union_left : 'a t -> 'a t -> 'a t
+
+ val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
+ val rename : key t -> key -> key
+ val map_keys : (key -> key) -> 'a t -> 'a t
+ val keys : 'a t -> Set.Make(T).t
+ val data : 'a t -> 'a list
+ val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t
+ val transpose_keys_and_data : key t -> key t
+ val transpose_keys_and_data_set : key t -> Set.Make(T).t t
+ val print :
+ (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
+end
+
+module type Tbl = sig
+ module T : sig
+ type t
+ include Map.OrderedType with type t := t
+ include Hashtbl.HashedType with type t := t
+ end
+ include Hashtbl.S
+ with type key = T.t
+ and type 'a t = 'a Hashtbl.Make (T).t
+
+ val to_list : 'a t -> (T.t * 'a) list
+ val of_list : (T.t * 'a) list -> 'a t
+
+ val to_map : 'a t -> 'a Map.Make(T).t
+ val of_map : 'a Map.Make(T).t -> 'a t
+ val memoize : 'a t -> (key -> 'a) -> key -> 'a
+ val map : 'a t -> ('a -> 'b) -> 'b t
+end
+
+module Pair (A : Thing) (B : Thing) : Thing with type t = A.t * B.t = struct
+ type t = A.t * B.t
+
+ let compare (a1, b1) (a2, b2) =
+ let c = A.compare a1 a2 in
+ if c <> 0 then c
+ else B.compare b1 b2
+
+ let output oc (a, b) = Printf.fprintf oc " (%a, %a)" A.output a B.output b
+ let hash (a, b) = Hashtbl.hash (A.hash a, B.hash b)
+ let equal (a1, b1) (a2, b2) = A.equal a1 a2 && B.equal b1 b2
+ let print ppf (a, b) = Format.fprintf ppf " (%a, @ %a)" A.print a B.print b
+end
+
+module Make_map (T : Thing) = struct
+ include Map.Make (T)
+
+ let of_list l =
+ List.fold_left (fun map (id, v) -> add id v map) empty l
+
+ let disjoint_union ?eq ?print m1 m2 =
+ union (fun id v1 v2 ->
+ let ok = match eq with
+ | None -> false
+ | Some eq -> eq v1 v2
+ in
+ if not ok then
+ let err =
+ match print with
+ | None ->
+ Format.asprintf "Map.disjoint_union %a" T.print id
+ | Some print ->
+ Format.asprintf "Map.disjoint_union %a => %a <> %a"
+ T.print id print v1 print v2
+ in
+ Misc.fatal_error err
+ else Some v1)
+ m1 m2
+
+ let union_right m1 m2 =
+ merge (fun _id x y -> match x, y with
+ | None, None -> None
+ | None, Some v
+ | Some v, None
+ | Some _, Some v -> Some v)
+ m1 m2
+
+ let union_left m1 m2 = union_right m2 m1
+
+ let union_merge f m1 m2 =
+ let aux _ m1 m2 =
+ match m1, m2 with
+ | None, m | m, None -> m
+ | Some m1, Some m2 -> Some (f m1 m2)
+ in
+ merge aux m1 m2
+
+ let rename m v =
+ try find v m
+ with Not_found -> v
+
+ let map_keys f m =
+ of_list (List.map (fun (k, v) -> f k, v) (bindings m))
+
+ let print f ppf s =
+ let elts ppf s = iter (fun id v ->
+ Format.fprintf ppf "@ (@[%a@ %a@])" T.print id f v) s in
+ Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s
+
+ module T_set = Set.Make (T)
+
+ let keys map = fold (fun k _ set -> T_set.add k set) map T_set.empty
+
+ let data t = List.map snd (bindings t)
+
+ let of_set f set = T_set.fold (fun e map -> add e (f e) map) set empty
+
+ let transpose_keys_and_data map = fold (fun k v m -> add v k m) map empty
+ let transpose_keys_and_data_set map =
+ fold (fun k v m ->
+ let set =
+ match find v m with
+ | exception Not_found ->
+ T_set.singleton k
+ | set ->
+ T_set.add k set
+ in
+ add v set m)
+ map empty
+end
+
+module Make_set (T : Thing) = struct
+ include Set.Make (T)
+
+ let output oc s =
+ Printf.fprintf oc " ( ";
+ iter (fun v -> Printf.fprintf oc "%a " T.output v) s;
+ Printf.fprintf oc ")"
+
+ let print ppf s =
+ let elts ppf s = iter (fun e -> Format.fprintf ppf "@ %a" T.print e) s in
+ Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s
+
+ let to_string s = Format.asprintf "%a" print s
+
+ let of_list l = match l with
+ | [] -> empty
+ | [t] -> singleton t
+ | t :: q -> List.fold_left (fun acc e -> add e acc) (singleton t) q
+
+ let map f s = of_list (List.map f (elements s))
+end
+
+module Make_tbl (T : Thing) = struct
+ include Hashtbl.Make (T)
+
+ module T_map = Make_map (T)
+
+ let to_list t =
+ fold (fun key datum elts -> (key, datum)::elts) t []
+
+ let of_list elts =
+ let t = create 42 in
+ List.iter (fun (key, datum) -> add t key datum) elts;
+ t
+
+ let to_map v = fold T_map.add v T_map.empty
+
+ let of_map m =
+ let t = create (T_map.cardinal m) in
+ T_map.iter (fun k v -> add t k v) m;
+ t
+
+ let memoize t f = fun key ->
+ try find t key with
+ | Not_found ->
+ let r = f key in
+ add t key r;
+ r
+
+ let map t f =
+ of_map (T_map.map f (to_map t))
+end
+
+module type S = sig
+ type t
+
+ module T : Thing with type t = t
+ include Thing with type t := T.t
+
+ module Set : Set with module T := T
+ module Map : Map with module T := T
+ module Tbl : Tbl with module T := T
+end
+
+module Make (T : Thing) = struct
+ module T = T
+ include T
+
+ module Set = Make_set (T)
+ module Map = Make_map (T)
+ module Tbl = Make_tbl (T)
+end
diff --git a/upstream/ocaml_503/utils/identifiable.mli b/upstream/ocaml_503/utils/identifiable.mli
new file mode 100644
index 0000000000..0da5a66191
--- /dev/null
+++ b/upstream/ocaml_503/utils/identifiable.mli
@@ -0,0 +1,113 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2013--2016 OCamlPro SAS *)
+(* Copyright 2014--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Uniform interface for common data structures over various things.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module type Thing = sig
+ type t
+
+ include Hashtbl.HashedType with type t := t
+ include Map.OrderedType with type t := t
+
+ val output : out_channel -> t -> unit
+ val print : Format.formatter -> t -> unit
+end
+
+module Pair : functor (A : Thing) (B : Thing) -> Thing with type t = A.t * B.t
+
+module type Set = sig
+ module T : Set.OrderedType
+ include Set.S
+ with type elt = T.t
+ and type t = Set.Make (T).t
+
+ val output : out_channel -> t -> unit
+ val print : Format.formatter -> t -> unit
+ val to_string : t -> string
+ val of_list : elt list -> t
+ val map : (elt -> elt) -> t -> t
+end
+
+module type Map = sig
+ module T : Map.OrderedType
+ include Map.S
+ with type key = T.t
+ and type 'a t = 'a Map.Make (T).t
+
+ val of_list : (key * 'a) list -> 'a t
+
+ (** [disjoint_union m1 m2] contains all bindings from [m1] and
+ [m2]. If some binding is present in both and the associated
+ value is not equal, a Fatal_error is raised *)
+ val disjoint_union :
+ ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t ->
+ 'a t -> 'a t
+
+ (** [union_right m1 m2] contains all bindings from [m1] and [m2]. If
+ some binding is present in both, the one from [m2] is taken *)
+ val union_right : 'a t -> 'a t -> 'a t
+
+ (** [union_left m1 m2 = union_right m2 m1] *)
+ val union_left : 'a t -> 'a t -> 'a t
+
+ val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
+ val rename : key t -> key -> key
+ val map_keys : (key -> key) -> 'a t -> 'a t
+ val keys : 'a t -> Set.Make(T).t
+ val data : 'a t -> 'a list
+ val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t
+ val transpose_keys_and_data : key t -> key t
+ val transpose_keys_and_data_set : key t -> Set.Make(T).t t
+ val print :
+ (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
+end
+
+module type Tbl = sig
+ module T : sig
+ type t
+ include Map.OrderedType with type t := t
+ include Hashtbl.HashedType with type t := t
+ end
+ include Hashtbl.S
+ with type key = T.t
+ and type 'a t = 'a Hashtbl.Make (T).t
+
+ val to_list : 'a t -> (T.t * 'a) list
+ val of_list : (T.t * 'a) list -> 'a t
+
+ val to_map : 'a t -> 'a Map.Make(T).t
+ val of_map : 'a Map.Make(T).t -> 'a t
+ val memoize : 'a t -> (key -> 'a) -> key -> 'a
+ val map : 'a t -> ('a -> 'b) -> 'b t
+end
+
+module type S = sig
+ type t
+
+ module T : Thing with type t = t
+ include Thing with type t := T.t
+
+ module Set : Set with module T := T
+ module Map : Map with module T := T
+ module Tbl : Tbl with module T := T
+end
+
+module Make (T : Thing) : S with type t := T.t
diff --git a/upstream/ocaml_503/utils/int_replace_polymorphic_compare.ml b/upstream/ocaml_503/utils/int_replace_polymorphic_compare.ml
new file mode 100644
index 0000000000..7cd6bf1099
--- /dev/null
+++ b/upstream/ocaml_503/utils/int_replace_polymorphic_compare.ml
@@ -0,0 +1,8 @@
+let ( = ) : int -> int -> bool = Stdlib.( = )
+let ( <> ) : int -> int -> bool = Stdlib.( <> )
+let ( < ) : int -> int -> bool = Stdlib.( < )
+let ( > ) : int -> int -> bool = Stdlib.( > )
+let ( <= ) : int -> int -> bool = Stdlib.( <= )
+let ( >= ) : int -> int -> bool = Stdlib.( >= )
+
+let compare : int -> int -> int = Stdlib.compare
diff --git a/upstream/ocaml_503/utils/int_replace_polymorphic_compare.mli b/upstream/ocaml_503/utils/int_replace_polymorphic_compare.mli
new file mode 100644
index 0000000000..689e741b66
--- /dev/null
+++ b/upstream/ocaml_503/utils/int_replace_polymorphic_compare.mli
@@ -0,0 +1,8 @@
+val ( = ) : int -> int -> bool
+val ( <> ) : int -> int -> bool
+val ( < ) : int -> int -> bool
+val ( > ) : int -> int -> bool
+val ( <= ) : int -> int -> bool
+val ( >= ) : int -> int -> bool
+
+val compare : int -> int -> int
diff --git a/upstream/ocaml_503/utils/lazy_backtrack.ml b/upstream/ocaml_503/utils/lazy_backtrack.ml
new file mode 100644
index 0000000000..13e4eb4400
--- /dev/null
+++ b/upstream/ocaml_503/utils/lazy_backtrack.ml
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+type ('a,'b) t = ('a,'b) eval ref
+
+and ('a,'b) eval =
+ | Done of 'b
+ | Raise of exn
+ | Thunk of 'a
+
+type undo =
+ | Nil
+ | Cons : ('a, 'b) t * 'a * undo -> undo
+
+type log = undo ref
+
+let force f x =
+ match !x with
+ | Done x -> x
+ | Raise e -> raise e
+ | Thunk e ->
+ match f e with
+ | y ->
+ x := Done y;
+ y
+ | exception e ->
+ x := Raise e;
+ raise e
+
+let get_arg x =
+ match !x with Thunk a -> Some a | _ -> None
+
+let get_contents x =
+ match !x with
+ | Thunk a -> Either.Left a
+ | Done b -> Either.Right b
+ | Raise e -> raise e
+
+let create x =
+ ref (Thunk x)
+
+let create_forced y =
+ ref (Done y)
+
+let create_failed e =
+ ref (Raise e)
+
+let log () =
+ ref Nil
+
+let force_logged log f x =
+ match !x with
+ | Done x -> x
+ | Raise e -> raise e
+ | Thunk e ->
+ match f e with
+ | (Error _ as err : _ result) ->
+ x := Done err;
+ log := Cons(x, e, !log);
+ err
+ | Ok _ as res ->
+ x := Done res;
+ res
+ | exception e ->
+ x := Raise e;
+ raise e
+
+let backtrack log =
+ let rec loop = function
+ | Nil -> ()
+ | Cons(x, e, rest) ->
+ x := Thunk e;
+ loop rest
+ in
+ loop !log
diff --git a/upstream/ocaml_503/utils/lazy_backtrack.mli b/upstream/ocaml_503/utils/lazy_backtrack.mli
new file mode 100644
index 0000000000..4e2fbd3808
--- /dev/null
+++ b/upstream/ocaml_503/utils/lazy_backtrack.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 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. *)
+(* *)
+(**************************************************************************)
+
+type ('a,'b) t
+
+type log
+
+val force : ('a -> 'b) -> ('a,'b) t -> 'b
+val create : 'a -> ('a,'b) t
+val get_arg : ('a,'b) t -> 'a option
+val get_contents : ('a,'b) t -> ('a,'b) Either.t
+val create_forced : 'b -> ('a, 'b) t
+val create_failed : exn -> ('a, 'b) t
+
+(* [force_logged log f t] is equivalent to [force f t] but if [f]
+ returns [Error _] then [t] is recorded in [log]. [backtrack log]
+ will then reset all the recorded [t]s back to their original
+ state. *)
+val log : unit -> log
+val force_logged :
+ log -> ('a -> ('b, 'c) result) -> ('a,('b, 'c) result) t -> ('b, 'c) result
+val backtrack : log -> unit
diff --git a/upstream/ocaml_503/utils/linkdeps.ml b/upstream/ocaml_503/utils/linkdeps.ml
new file mode 100644
index 0000000000..824c898e0b
--- /dev/null
+++ b/upstream/ocaml_503/utils/linkdeps.ml
@@ -0,0 +1,142 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Hugo Heuzard *)
+(* *)
+(* Copyright 2020 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. *)
+(* *)
+(**************************************************************************)
+
+module Style = Misc.Style
+
+type compunit = string
+
+type filename = string
+
+type compunit_and_source = {
+ compunit : compunit;
+ filename : filename;
+}
+
+module Compunit_and_source = struct
+ type t = compunit_and_source
+ module Set = Set.Make(struct type nonrec t = t let compare = compare end)
+end
+
+type refs = Compunit_and_source.Set.t
+
+type t = {
+ complete : bool;
+ missing_compunits : (compunit, refs) Hashtbl.t;
+ provided_compunits : (compunit, filename list) Hashtbl.t;
+ badly_ordered_deps : (Compunit_and_source.t, refs) Hashtbl.t;
+}
+
+type error =
+ | Missing_implementations of (compunit * compunit_and_source list) list
+ | Wrong_link_order of (compunit_and_source * compunit_and_source list) list
+ | Multiple_definitions of (compunit * filename list) list
+
+let create ~complete = {
+ complete;
+ missing_compunits = Hashtbl.create 17;
+ provided_compunits = Hashtbl.create 17;
+ badly_ordered_deps = Hashtbl.create 17;
+}
+
+let required t compunit = Hashtbl.mem t.missing_compunits compunit
+
+let update t k f =
+ let v = Hashtbl.find_opt t k in
+ Hashtbl.replace t k (f v)
+
+let add_required t by (name : string) =
+ let add s =
+ Compunit_and_source.Set.add by
+ (Option.value s ~default:Compunit_and_source.Set.empty) in
+ (try
+ let filename = List.hd (Hashtbl.find t.provided_compunits name) in
+ update t.badly_ordered_deps {compunit = name; filename } add
+ with Not_found -> ());
+ update t.missing_compunits name add
+
+let add t ~filename ~compunit ~provides ~requires =
+ List.iter (add_required t {compunit; filename}) requires;
+ List.iter (fun p ->
+ Hashtbl.remove t.missing_compunits p;
+ let l = Option.value ~default:[]
+ (Hashtbl.find_opt t.provided_compunits p) in
+ Hashtbl.replace t.provided_compunits p (filename :: l)) provides
+
+let check t =
+ let of_seq s =
+ Seq.map (fun (k,v) -> k, Compunit_and_source.Set.elements v) s
+ |> List.of_seq
+ in
+ let missing = of_seq (Hashtbl.to_seq t.missing_compunits) in
+ let badly_ordered_deps = of_seq (Hashtbl.to_seq t.badly_ordered_deps) in
+ let duplicated =
+ Hashtbl.to_seq t.provided_compunits
+ |> Seq.filter (fun (_, files) -> List.compare_length_with files 1 > 0)
+ |> List.of_seq
+ in
+ match duplicated, badly_ordered_deps, missing with
+ | [], [], [] -> None
+ | [], [], l ->
+ if t.complete
+ then Some (Missing_implementations l)
+ else None
+ | [], l, _ ->
+ Some (Wrong_link_order l)
+ | l, _, _ ->
+ Some (Multiple_definitions l)
+
+(* Error report *)
+
+open Format_doc
+
+let print_reference print_fname ppf {compunit; filename} =
+ fprintf ppf "%a (%a)" Style.inline_code compunit print_fname filename
+
+let pp_list_comma f =
+ pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") f
+
+let report_error_doc ~print_filename ppf = function
+ | Missing_implementations l ->
+ let print_modules ppf =
+ List.iter
+ (fun (md, rq) ->
+ fprintf ppf "@ @[<hov 2>%a referenced from %a@]"
+ Style.inline_code md
+ (pp_list_comma (print_reference print_filename)) rq)
+ in
+ fprintf ppf
+ "@[<v 2>No implementation provided for the following modules:%a@]"
+ print_modules l
+ | Wrong_link_order l ->
+ let depends_on ppf (dep, depending) =
+ fprintf ppf "@ @[<hov 2>%a depends on %a@]"
+ (pp_list_comma (print_reference print_filename)) depending
+ (print_reference print_filename) dep
+ in
+ fprintf ppf "@[<hov 2>Wrong link order:%a@]"
+ (pp_list_comma depends_on) l
+ | Multiple_definitions l ->
+ let print ppf (compunit, files) =
+ fprintf ppf
+ "@ @[<hov>Multiple definitions of module %a in files %a@]"
+ Style.inline_code compunit
+ (pp_list_comma (Style.as_inline_code print_filename)) files
+
+ in
+ fprintf ppf "@[<hov 2> Duplicated implementations:%a@]"
+ (pp_list_comma print) l
+
+let report_error ~print_filename =
+ Format_doc.compat (report_error_doc ~print_filename)
diff --git a/upstream/ocaml_503/utils/linkdeps.mli b/upstream/ocaml_503/utils/linkdeps.mli
new file mode 100644
index 0000000000..070b0e5387
--- /dev/null
+++ b/upstream/ocaml_503/utils/linkdeps.mli
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Hugo Heuzard *)
+(* *)
+(* Copyright 2020 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. *)
+(* *)
+(**************************************************************************)
+
+type t
+(** The state of the linking check.
+ It keeps track of compilation units provided and required so far. *)
+
+type compunit = string
+
+type filename = string
+
+val create : complete:bool -> t
+(** [create ~complete] returns an empty state. If [complete] is
+ [true], missing compilation units will be treated as errors. *)
+
+val add : t
+ -> filename:filename -> compunit:compunit
+ -> provides:compunit list -> requires:compunit list -> unit
+(** [add t ~filename ~compunit ~provides ~requires] registers the
+ compilation unit [compunit] found in [filename] to [t].
+ - [provides] are units and sub-units provided by [compunit]
+ - [requires] are units required by [compunit]
+
+ [add] should be called in reverse topological order. *)
+
+val required : t -> compunit -> bool
+(** [required t compunit] returns [true] if [compunit] is a dependency of
+ previously added compilation units. *)
+
+type compunit_and_source = {
+ compunit : compunit;
+ filename : filename;
+}
+
+type error =
+ | Missing_implementations of (compunit * compunit_and_source list) list
+ | Wrong_link_order of (compunit_and_source * compunit_and_source list) list
+ | Multiple_definitions of (compunit * filename list) list
+
+val check : t -> error option
+(** [check t] should be called once all the compilation units to be linked
+ have been added. It returns some error if:
+ - There are some missing implementations
+ and [complete] is [true]
+ - Some implementation appear
+ before their dependencies *)
+
+
+val report_error :
+ print_filename:string Format_doc.printer -> error Format_doc.format_printer
+val report_error_doc :
+ print_filename:string Format_doc.printer -> error Format_doc.printer
diff --git a/upstream/ocaml_503/utils/load_path.ml b/upstream/ocaml_503/utils/load_path.ml
new file mode 100644
index 0000000000..49f593f985
--- /dev/null
+++ b/upstream/ocaml_503/utils/load_path.ml
@@ -0,0 +1,239 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2018 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+open Local_store
+
+module STbl = Misc.Stdlib.String.Tbl
+
+(* Mapping from basenames to full filenames *)
+type registry = string STbl.t
+
+let visible_files : registry ref = s_table STbl.create 42
+let visible_files_uncap : registry ref = s_table STbl.create 42
+
+let hidden_files : registry ref = s_table STbl.create 42
+let hidden_files_uncap : registry ref = s_table STbl.create 42
+
+module Dir = struct
+ type t = {
+ path : string;
+ files : string list;
+ hidden : bool;
+ }
+
+ let path t = t.path
+ let files t = t.files
+ let hidden t = t.hidden
+
+ let find t fn =
+ if List.mem fn t.files then
+ Some (Filename.concat t.path fn)
+ else
+ None
+
+ let find_normalized t fn =
+ let fn = Misc.normalized_unit_filename fn in
+ let search base =
+ if Misc.normalized_unit_filename base = fn then
+ Some (Filename.concat t.path base)
+ else
+ None
+ in
+ List.find_map search t.files
+
+ (* For backward compatibility reason, simulate the behavior of
+ [Misc.find_in_path]: silently ignore directories that don't exist
+ + treat [""] as the current directory. *)
+ let readdir_compat dir =
+ try
+ Sys.readdir (if dir = "" then Filename.current_dir_name else dir)
+ with Sys_error _ ->
+ [||]
+
+ let create ~hidden path =
+ { path; files = Array.to_list (readdir_compat path); hidden }
+end
+
+type auto_include_callback =
+ (Dir.t -> string -> string option) -> string -> string
+
+let visible_dirs = s_ref []
+let hidden_dirs = s_ref []
+let no_auto_include _ _ = raise Not_found
+let auto_include_callback = ref no_auto_include
+
+let reset () =
+ assert (not Config.merlin || Local_store.is_bound ());
+ STbl.clear !hidden_files;
+ STbl.clear !hidden_files_uncap;
+ STbl.clear !visible_files;
+ STbl.clear !visible_files_uncap;
+ hidden_dirs := [];
+ visible_dirs := [];
+ auto_include_callback := no_auto_include
+
+let get_visible () = List.rev !visible_dirs
+
+let get_path_list () =
+ Misc.rev_map_end Dir.path !visible_dirs (List.rev_map Dir.path !hidden_dirs)
+
+type paths =
+ { visible : string list;
+ hidden : string list }
+
+let get_paths () =
+ { visible = List.rev_map Dir.path !visible_dirs;
+ hidden = List.rev_map Dir.path !hidden_dirs }
+
+let get_visible_path_list () = List.rev_map Dir.path !visible_dirs
+let get_hidden_path_list () = List.rev_map Dir.path !hidden_dirs
+
+(* Optimized version of [add] below, for use in [init] and [remove_dir]: since
+ we are starting from an empty cache, we can avoid checking whether a unit
+ name already exists in the cache simply by adding entries in reverse
+ order. *)
+let prepend_add dir =
+ List.iter (fun base ->
+ Result.iter (fun filename ->
+ let fn = Filename.concat dir.Dir.path base in
+ if dir.Dir.hidden then begin
+ STbl.replace !hidden_files base fn;
+ STbl.replace !hidden_files_uncap filename fn
+ end else begin
+ STbl.replace !visible_files base fn;
+ STbl.replace !visible_files_uncap filename fn
+ end)
+ (Misc.normalized_unit_filename base)
+ ) dir.Dir.files
+
+let init ~auto_include ~visible ~hidden =
+ reset ();
+ visible_dirs := List.rev_map (Dir.create ~hidden:false) visible;
+ hidden_dirs := List.rev_map (Dir.create ~hidden:true) hidden;
+ List.iter prepend_add !hidden_dirs;
+ List.iter prepend_add !visible_dirs;
+ auto_include_callback := auto_include
+
+let remove_dir dir =
+ assert (not Config.merlin || Local_store.is_bound ());
+ let visible = List.filter (fun d -> Dir.path d <> dir) !visible_dirs in
+ let hidden = List.filter (fun d -> Dir.path d <> dir) !hidden_dirs in
+ if List.compare_lengths visible !visible_dirs <> 0
+ || List.compare_lengths hidden !hidden_dirs <> 0 then begin
+ reset ();
+ visible_dirs := visible;
+ hidden_dirs := hidden;
+ List.iter prepend_add hidden;
+ List.iter prepend_add visible
+ end
+
+(* General purpose version of function to add a new entry to load path: We only
+ add a basename to the cache if it is not already present, in order to enforce
+ left-to-right precedence. *)
+let add (dir : Dir.t) =
+ assert (not Config.merlin || Local_store.is_bound ());
+ let update base fn visible_files hidden_files =
+ if dir.hidden && not (STbl.mem !hidden_files base) then
+ STbl.replace !hidden_files base fn
+ else if not (STbl.mem !visible_files base) then
+ STbl.replace !visible_files base fn
+ in
+ List.iter
+ (fun base ->
+ Result.iter (fun ubase ->
+ let fn = Filename.concat dir.Dir.path base in
+ update base fn visible_files hidden_files;
+ update ubase fn visible_files_uncap hidden_files_uncap
+ )
+ (Misc.normalized_unit_filename base)
+ )
+ dir.files;
+ if dir.hidden then
+ hidden_dirs := dir :: !hidden_dirs
+ else
+ visible_dirs := dir :: !visible_dirs
+
+let append_dir = add
+
+let add_dir ~hidden dir = add (Dir.create ~hidden dir)
+
+(* Add the directory at the start of load path - so basenames are
+ unconditionally added. *)
+let prepend_dir (dir : Dir.t) =
+ assert (not Config.merlin || Local_store.is_bound ());
+ prepend_add dir;
+ if dir.hidden then
+ hidden_dirs := !hidden_dirs @ [dir]
+ else
+ visible_dirs := !visible_dirs @ [dir]
+
+let is_basename fn = Filename.basename fn = fn
+
+let auto_include_libs libs alert find_in_dir fn =
+ let scan (lib, lazy dir) =
+ let file = find_in_dir dir fn in
+ let alert_and_add_dir _ =
+ alert lib;
+ append_dir dir
+ in
+ Option.iter alert_and_add_dir file;
+ file
+ in
+ match List.find_map scan libs with
+ | Some base -> base
+ | None -> raise Not_found
+
+let auto_include_otherlibs =
+ (* Ensure directories are only ever scanned once *)
+ let expand = Misc.expand_directory Config.standard_library in
+ let otherlibs =
+ let read_lib lib = lazy (Dir.create ~hidden:false (expand ("+" ^ lib))) in
+ List.map (fun lib -> (lib, read_lib lib)) ["dynlink"; "str"; "unix"] in
+ auto_include_libs otherlibs
+
+type visibility = Visible | Hidden
+
+let find_file_in_cache fn visible_files hidden_files =
+ try (STbl.find !visible_files fn, Visible) with
+ | Not_found -> (STbl.find !hidden_files fn, Hidden)
+
+let find fn =
+ assert (not Config.merlin || Local_store.is_bound ());
+ try
+ if is_basename fn && not !Sys.interactive then
+ fst (find_file_in_cache fn visible_files hidden_files)
+ else
+ Misc.find_in_path (get_path_list ()) fn
+ with Not_found ->
+ !auto_include_callback Dir.find fn
+
+let find_normalized_with_visibility fn =
+ assert (not Config.merlin || Local_store.is_bound ());
+ match Misc.normalized_unit_filename fn with
+ | Error _ -> raise Not_found
+ | Ok fn_uncap ->
+ try
+ if is_basename fn && not !Sys.interactive then
+ find_file_in_cache fn_uncap
+ visible_files_uncap hidden_files_uncap
+ else
+ try
+ (Misc.find_in_path_normalized (get_visible_path_list ()) fn, Visible)
+ with
+ | Not_found ->
+ (Misc.find_in_path_normalized (get_hidden_path_list ()) fn, Hidden)
+ with Not_found ->
+ (!auto_include_callback Dir.find_normalized fn_uncap, Visible)
+
+let find_normalized fn = fst (find_normalized_with_visibility fn)
diff --git a/upstream/ocaml_503/utils/load_path.mli b/upstream/ocaml_503/utils/load_path.mli
new file mode 100644
index 0000000000..488b75f760
--- /dev/null
+++ b/upstream/ocaml_503/utils/load_path.mli
@@ -0,0 +1,120 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2018 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Management of include directories.
+
+ This module offers a high level interface to locating files in the load
+ path, which is constructed from [-I] and [-H] command line flags and a few
+ other parameters.
+
+ It makes the assumption that the contents of include directories
+ doesn't change during the execution of the compiler.
+*)
+
+val add_dir : hidden:bool -> string -> unit
+(** Add a directory to the end of the load path (i.e. at lowest priority.) *)
+
+val remove_dir : string -> unit
+(** Remove a directory from the load path *)
+
+val reset : unit -> unit
+(** Remove all directories *)
+
+module Dir : sig
+ type t
+ (** Represent one directory in the load path. *)
+
+ val create : hidden:bool -> string -> t
+
+ val path : t -> string
+
+ val files : t -> string list
+ (** All the files in that directory. This doesn't include files in
+ sub-directories of this directory. *)
+
+ val hidden : t -> bool
+ (** If the modules in this directory should not be bound in the initial
+ scope *)
+
+ val find : t -> string -> string option
+ (** [find dir fn] returns the full path to [fn] in [dir]. *)
+
+ val find_normalized : t -> string -> string option
+ (** As {!find}, but search also for uncapitalized name, i.e. if name is
+ Foo.ml, either /path/Foo.ml or /path/foo.ml may be returned. *)
+end
+
+type auto_include_callback =
+ (Dir.t -> string -> string option) -> string -> string
+(** The type of callback functions on for [init ~auto_include] *)
+
+val no_auto_include : auto_include_callback
+(** No automatic directory inclusion: misses in the load path raise [Not_found]
+ as normal. *)
+
+val init :
+ auto_include:auto_include_callback -> visible:string list ->
+ hidden:string list -> unit
+(** [init ~visible ~hidden] is the same as
+ [reset ();
+ List.iter add_dir (List.rev hidden);
+ List.iter add_dir (List.rev visible)] *)
+
+val auto_include_otherlibs :
+ (string -> unit) -> auto_include_callback
+(** [auto_include_otherlibs alert] is a callback function to be passed to
+ {!Load_path.init} and automatically adds [-I +lib] to the load path after
+ calling [alert lib]. *)
+
+val get_path_list : unit -> string list
+(** Return the list of directories passed to [add_dir] so far. *)
+
+type paths =
+ { visible : string list;
+ hidden : string list }
+
+val get_paths : unit -> paths
+(** Return the directories passed to [add_dir] so far. *)
+
+val find : string -> string
+(** Locate a file in the load path. Raise [Not_found] if the file
+ cannot be found. This function is optimized for the case where the
+ filename is a basename, i.e. doesn't contain a directory
+ separator. *)
+
+val find_normalized : string -> string
+(** Same as [find], but search also for normalized unit name (see
+ {!Misc.normalized_unit_filename}), i.e. if name is [Foo.ml], allow
+ [/path/Foo.ml] and [/path/foo.ml] to match. *)
+
+type visibility = Visible | Hidden
+
+val find_normalized_with_visibility : string -> string * visibility
+(** Same as [find_normalized], but also reports whether the cmi was found in a
+ -I directory (Visible) or a -H directory (Hidden) *)
+
+val[@deprecated] add : Dir.t -> unit
+(** Old name for {!append_dir} *)
+
+val append_dir : Dir.t -> unit
+(** [append_dir d] adds [d] to the end of the load path (i.e. at lowest
+ priority. *)
+
+val prepend_dir : Dir.t -> unit
+(** [prepend_dir d] adds [d] to the start of the load path (i.e. at highest
+ priority. *)
+
+val get_visible : unit -> Dir.t list
+(** Same as [get_paths ()], except that it returns a [Dir.t list], and doesn't
+ include the -H paths. *)
diff --git a/upstream/ocaml_503/utils/local_store.ml b/upstream/ocaml_503/utils/local_store.ml
new file mode 100644
index 0000000000..4babf61d82
--- /dev/null
+++ b/upstream/ocaml_503/utils/local_store.ml
@@ -0,0 +1,74 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Frederic Bour, Tarides *)
+(* Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2020 Tarides *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+type ref_and_reset =
+ | Table : { ref: 'a ref; init: unit -> 'a } -> ref_and_reset
+ | Ref : { ref: 'a ref; mutable snapshot: 'a } -> ref_and_reset
+
+type bindings = {
+ mutable refs: ref_and_reset list;
+ mutable frozen : bool;
+ mutable is_bound: bool;
+}
+
+let global_bindings =
+ { refs = []; is_bound = false; frozen = false }
+
+let is_bound () = global_bindings.is_bound
+
+let reset () =
+ assert (is_bound ());
+ List.iter (function
+ | Table { ref; init } -> ref := init ()
+ | Ref { ref; snapshot } -> ref := snapshot
+ ) global_bindings.refs
+
+let s_table create size =
+ let init () = create size in
+ let ref = ref (init ()) in
+ assert (not global_bindings.frozen);
+ global_bindings.refs <- (Table { ref; init }) :: global_bindings.refs;
+ ref
+
+let s_ref k =
+ let ref = ref k in
+ assert (not global_bindings.frozen);
+ global_bindings.refs <-
+ (Ref { ref; snapshot = k }) :: global_bindings.refs;
+ ref
+
+type slot = Slot : { ref : 'a ref; mutable value : 'a } -> slot
+type store = slot list
+
+let fresh () =
+ let slots =
+ List.map (function
+ | Table { ref; init } -> Slot {ref; value = init ()}
+ | Ref r ->
+ if not global_bindings.frozen then r.snapshot <- !(r.ref);
+ Slot { ref = r.ref; value = r.snapshot }
+ ) global_bindings.refs
+ in
+ global_bindings.frozen <- true;
+ slots
+
+let with_store slots f =
+ assert (not global_bindings.is_bound);
+ global_bindings.is_bound <- true;
+ List.iter (fun (Slot {ref;value}) -> ref := value) slots;
+ Fun.protect f ~finally:(fun () ->
+ List.iter (fun (Slot s) -> s.value <- !(s.ref)) slots;
+ global_bindings.is_bound <- false;
+ )
diff --git a/upstream/ocaml_503/utils/local_store.mli b/upstream/ocaml_503/utils/local_store.mli
new file mode 100644
index 0000000000..545cf71e02
--- /dev/null
+++ b/upstream/ocaml_503/utils/local_store.mli
@@ -0,0 +1,67 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Frederic Bour, Tarides *)
+(* Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2020 Tarides *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** This module provides some facilities for creating references (and hash
+ tables) which can easily be snapshotted and restored to an arbitrary
+ version.
+
+ It is used throughout the frontend (read: typechecker), to register all
+ (well, hopefully) the global state. Thus making it easy for tools like
+ Merlin to go back and forth typechecking different files. *)
+
+(** {1 Creators} *)
+
+val s_ref : 'a -> 'a ref
+(** Similar to {!val:Stdlib.ref}, except the allocated reference is registered
+ into the store. *)
+
+val s_table : ('a -> 'b) -> 'a -> 'b ref
+(** Used to register hash tables. Those also need to be placed into refs to be
+ easily swapped out, but one can't just "snapshot" the initial value to
+ create fresh instances, so instead an initializer is required.
+
+ Use it like this:
+ {[
+ let my_table = s_table Hashtbl.create 42
+ ]}
+*)
+
+(** {1 State management}
+
+ Note: all the following functions are currently unused inside the compiler
+ codebase. Merlin is their only user at the moment. *)
+
+type store
+
+val fresh : unit -> store
+(** Returns a fresh instance of the store.
+
+ The first time this function is called, it snapshots the value of all the
+ registered references, later calls to [fresh] will return instances
+ initialized to those values. *)
+
+val with_store : store -> (unit -> 'a) -> 'a
+(** [with_store s f] resets all the registered references to the value they have
+ in [s] for the run of [f].
+ If [f] updates any of the registered refs, [s] is updated to remember those
+ changes. *)
+
+val reset : unit -> unit
+(** Resets all the references to the initial snapshot (i.e. to the same values
+ that new instances start with). *)
+
+val is_bound : unit -> bool
+(** Returns [true] when a store is active (i.e. when called from the callback
+ passed to {!with_store}), [false] otherwise. *)
diff --git a/upstream/ocaml_503/utils/misc.ml b/upstream/ocaml_503/utils/misc.ml
new file mode 100644
index 0000000000..b3d75dbb86
--- /dev/null
+++ b/upstream/ocaml_503/utils/misc.ml
@@ -0,0 +1,1392 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Errors *)
+
+exception Fatal_error
+
+let fatal_errorf fmt =
+ Format.kfprintf
+ (fun _ -> raise Fatal_error)
+ Format.err_formatter
+ ("@?>> Fatal error: " ^^ fmt ^^ "@.")
+
+let fatal_error msg = fatal_errorf "%s" msg
+
+(* Exceptions *)
+
+let try_finally ?(always=(fun () -> ())) ?(exceptionally=(fun () -> ())) work =
+ match work () with
+ | result ->
+ begin match always () with
+ | () -> result
+ | exception always_exn ->
+ let always_bt = Printexc.get_raw_backtrace () in
+ exceptionally ();
+ Printexc.raise_with_backtrace always_exn always_bt
+ end
+ | exception work_exn ->
+ let work_bt = Printexc.get_raw_backtrace () in
+ begin match always () with
+ | () ->
+ exceptionally ();
+ Printexc.raise_with_backtrace work_exn work_bt
+ | exception always_exn ->
+ let always_bt = Printexc.get_raw_backtrace () in
+ exceptionally ();
+ Printexc.raise_with_backtrace always_exn always_bt
+ end
+
+let reraise_preserving_backtrace e f =
+ let bt = Printexc.get_raw_backtrace () in
+ f ();
+ Printexc.raise_with_backtrace e bt
+
+type ref_and_value = R : 'a ref * 'a -> ref_and_value
+
+let protect_refs =
+ let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in
+ fun refs f ->
+ let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in
+ set_refs refs;
+ Fun.protect ~finally:(fun () -> set_refs backup) f
+
+(* List functions *)
+
+let rec map_end f l1 l2 =
+ match l1 with
+ [] -> l2
+ | hd::tl -> f hd :: map_end f tl l2
+
+let rev_map_end f l1 l2 =
+ let rec rmap_f accu = function
+ | [] -> accu
+ | hd::tl -> rmap_f (f hd :: accu) tl
+ in
+ rmap_f l2 l1
+
+let rec map_left_right f = function
+ [] -> []
+ | hd::tl -> let res = f hd in res :: map_left_right f tl
+
+let rec for_all2 pred l1 l2 =
+ match (l1, l2) with
+ ([], []) -> true
+ | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2
+ | (_, _) -> false
+
+let rec replicate_list elem n =
+ if n <= 0 then [] else elem :: replicate_list elem (n-1)
+
+let rec list_remove x = function
+ [] -> []
+ | hd :: tl ->
+ if hd = x then tl else hd :: list_remove x tl
+
+let rec split_last = function
+ [] -> assert false
+ | [x] -> ([], x)
+ | hd :: tl ->
+ let (lst, last) = split_last tl in
+ (hd :: lst, last)
+
+module Stdlib = struct
+ module List = struct
+ type 'a t = 'a list
+
+ let rec compare cmp l1 l2 =
+ match l1, l2 with
+ | [], [] -> 0
+ | [], _::_ -> -1
+ | _::_, [] -> 1
+ | h1::t1, h2::t2 ->
+ let c = cmp h1 h2 in
+ if c <> 0 then c
+ else compare cmp t1 t2
+
+ let rec equal eq l1 l2 =
+ match l1, l2 with
+ | ([], []) -> true
+ | (hd1 :: tl1, hd2 :: tl2) -> eq hd1 hd2 && equal eq tl1 tl2
+ | (_, _) -> false
+
+ let map2_prefix f l1 l2 =
+ let rec aux acc l1 l2 =
+ match l1, l2 with
+ | [], _ -> (List.rev acc, l2)
+ | _ :: _, [] -> raise (Invalid_argument "map2_prefix")
+ | h1::t1, h2::t2 ->
+ let h = f h1 h2 in
+ aux (h :: acc) t1 t2
+ in
+ aux [] l1 l2
+
+ let rec iteri2 i f l1 l2 =
+ match (l1, l2) with
+ ([], []) -> ()
+ | (a1::l1, a2::l2) -> f i a1 a2; iteri2 (i + 1) f l1 l2
+ | (_, _) -> raise (Invalid_argument "iteri2")
+
+ let iteri2 f l1 l2 = iteri2 0 f l1 l2
+
+ let some_if_all_elements_are_some l =
+ let rec aux acc l =
+ match l with
+ | [] -> Some (List.rev acc)
+ | None :: _ -> None
+ | Some h :: t -> aux (h :: acc) t
+ in
+ aux [] l
+
+ let split_at n l =
+ let rec aux n acc l =
+ if n = 0
+ then List.rev acc, l
+ else
+ match l with
+ | [] -> raise (Invalid_argument "split_at")
+ | t::q -> aux (n-1) (t::acc) q
+ in
+ aux n [] l
+
+ let chunks_of n l =
+ if n <= 0 then raise (Invalid_argument "chunks_of");
+ (* Invariant: List.length l = remaining *)
+ let rec aux n acc l ~remaining =
+ match remaining with
+ | 0 -> List.rev acc
+ | _ when remaining <= n -> List.rev (l :: acc)
+ | _ ->
+ let chunk, rest = split_at n l in
+ aux n (chunk :: acc) rest ~remaining:(remaining - n)
+ in
+ aux n [] l ~remaining:(List.length l)
+
+ let rec is_prefix ~equal t ~of_ =
+ match t, of_ with
+ | [], [] -> true
+ | _::_, [] -> false
+ | [], _::_ -> true
+ | x1::t, x2::of_ -> equal x1 x2 && is_prefix ~equal t ~of_
+
+ type 'a longest_common_prefix_result = {
+ longest_common_prefix : 'a list;
+ first_without_longest_common_prefix : 'a list;
+ second_without_longest_common_prefix : 'a list;
+ }
+
+ let find_and_chop_longest_common_prefix ~equal ~first ~second =
+ let rec find_prefix ~longest_common_prefix_rev l1 l2 =
+ match l1, l2 with
+ | elt1 :: l1, elt2 :: l2 when equal elt1 elt2 ->
+ let longest_common_prefix_rev = elt1 :: longest_common_prefix_rev in
+ find_prefix ~longest_common_prefix_rev l1 l2
+ | l1, l2 ->
+ { longest_common_prefix = List.rev longest_common_prefix_rev;
+ first_without_longest_common_prefix = l1;
+ second_without_longest_common_prefix = l2;
+ }
+ in
+ find_prefix ~longest_common_prefix_rev:[] first second
+ end
+
+ module Option = struct
+ type 'a t = 'a option
+
+ let print print_contents ppf t =
+ match t with
+ | None -> Format.pp_print_string ppf "None"
+ | Some contents ->
+ Format.fprintf ppf "@[(Some@ %a)@]" print_contents contents
+ end
+
+ module Array = struct
+ let exists2 p a1 a2 =
+ let n = Array.length a1 in
+ if Array.length a2 <> n then invalid_arg "Misc.Stdlib.Array.exists2";
+ let rec loop i =
+ if i = n then false
+ else if p (Array.unsafe_get a1 i) (Array.unsafe_get a2 i) then true
+ else loop (succ i) in
+ loop 0
+
+ let for_alli p a =
+ let n = Array.length a in
+ let rec loop i =
+ if i = n then true
+ else if p i (Array.unsafe_get a i) then loop (succ i)
+ else false in
+ loop 0
+
+ let all_somes a =
+ try
+ Some (Array.map (function None -> raise_notrace Exit | Some x -> x) a)
+ with
+ | Exit -> None
+ end
+
+ module String = struct
+ include String
+ module Set = Set.Make(String)
+ module Map = Map.Make(String)
+ module Tbl = Hashtbl.Make(struct
+ include String
+ let hash = Hashtbl.hash
+ end)
+
+ let for_all f t =
+ let len = String.length t in
+ let rec loop i =
+ i = len || (f t.[i] && loop (i + 1))
+ in
+ loop 0
+
+ let print ppf t =
+ Format.pp_print_string ppf t
+ end
+
+ external compare : 'a -> 'a -> int = "%compare"
+end
+
+(** {1 Minimal support for Unicode characters in identifiers} *)
+
+module Utf8_lexeme = struct
+
+ type t = string
+
+ (* Non-ASCII letters that are allowed in identifiers (currently: Latin-9) *)
+
+ type case = Upper of Uchar.t | Lower of Uchar.t
+ let known_chars : (Uchar.t, case) Hashtbl.t = Hashtbl.create 32
+
+ let _ =
+ List.iter
+ (fun (upper, lower) ->
+ let upper = Uchar.of_int upper and lower = Uchar.of_int lower in
+ Hashtbl.add known_chars upper (Upper lower);
+ Hashtbl.add known_chars lower (Lower upper))
+ [
+ (0xc0, 0xe0); (* À, à *) (0xc1, 0xe1); (* Á, á *)
+ (0xc2, 0xe2); (* Â, â *) (0xc3, 0xe3); (* Ã, ã *)
+ (0xc4, 0xe4); (* Ä, ä *) (0xc5, 0xe5); (* Å, å *)
+ (0xc6, 0xe6); (* Æ, æ *) (0xc7, 0xe7); (* Ç, ç *)
+ (0xc8, 0xe8); (* È, è *) (0xc9, 0xe9); (* É, é *)
+ (0xca, 0xea); (* Ê, ê *) (0xcb, 0xeb); (* Ë, ë *)
+ (0xcc, 0xec); (* Ì, ì *) (0xcd, 0xed); (* Í, í *)
+ (0xce, 0xee); (* Î, î *) (0xcf, 0xef); (* Ï, ï *)
+ (0xd0, 0xf0); (* Ð, ð *) (0xd1, 0xf1); (* Ñ, ñ *)
+ (0xd2, 0xf2); (* Ò, ò *) (0xd3, 0xf3); (* Ó, ó *)
+ (0xd4, 0xf4); (* Ô, ô *) (0xd5, 0xf5); (* Õ, õ *)
+ (0xd6, 0xf6); (* Ö, ö *) (0xd8, 0xf8); (* Ø, ø *)
+ (0xd9, 0xf9); (* Ù, ù *) (0xda, 0xfa); (* Ú, ú *)
+ (0xdb, 0xfb); (* Û, û *) (0xdc, 0xfc); (* Ü, ü *)
+ (0xdd, 0xfd); (* Ý, ý *) (0xde, 0xfe); (* Þ, þ *)
+ (0x160, 0x161); (* Š, š *) (0x17d, 0x17e); (* Ž, ž *)
+ (0x152, 0x153); (* Œ, œ *) (0x178, 0xff); (* Ÿ, ÿ *)
+ (0x1e9e, 0xdf); (* ẞ, ß *)
+ ]
+
+ (* NFD to NFC conversion table for the letters above *)
+
+ let known_pairs : (Uchar.t * Uchar.t, Uchar.t) Hashtbl.t = Hashtbl.create 32
+
+ let _ =
+ List.iter
+ (fun (c1, n2, n) ->
+ Hashtbl.add known_pairs
+ (Uchar.of_char c1, Uchar.of_int n2) (Uchar.of_int n))
+ [
+ ('A', 0x300, 0xc0); (* À *) ('A', 0x301, 0xc1); (* Á *)
+ ('A', 0x302, 0xc2); (* Â *) ('A', 0x303, 0xc3); (* Ã *)
+ ('A', 0x308, 0xc4); (* Ä *) ('A', 0x30a, 0xc5); (* Å *)
+ ('C', 0x327, 0xc7); (* Ç *) ('E', 0x300, 0xc8); (* È *)
+ ('E', 0x301, 0xc9); (* É *) ('E', 0x302, 0xca); (* Ê *)
+ ('E', 0x308, 0xcb); (* Ë *) ('I', 0x300, 0xcc); (* Ì *)
+ ('I', 0x301, 0xcd); (* Í *) ('I', 0x302, 0xce); (* Î *)
+ ('I', 0x308, 0xcf); (* Ï *) ('N', 0x303, 0xd1); (* Ñ *)
+ ('O', 0x300, 0xd2); (* Ò *) ('O', 0x301, 0xd3); (* Ó *)
+ ('O', 0x302, 0xd4); (* Ô *) ('O', 0x303, 0xd5); (* Õ *)
+ ('O', 0x308, 0xd6); (* Ö *)
+ ('U', 0x300, 0xd9); (* Ù *) ('U', 0x301, 0xda); (* Ú *)
+ ('U', 0x302, 0xdb); (* Û *) ('U', 0x308, 0xdc); (* Ü *)
+ ('Y', 0x301, 0xdd); (* Ý *) ('Y', 0x308, 0x178); (* Ÿ *)
+ ('S', 0x30c, 0x160); (* Š *) ('Z', 0x30c, 0x17d); (* Ž *)
+ ('a', 0x300, 0xe0); (* à *) ('a', 0x301, 0xe1); (* á *)
+ ('a', 0x302, 0xe2); (* â *) ('a', 0x303, 0xe3); (* ã *)
+ ('a', 0x308, 0xe4); (* ä *) ('a', 0x30a, 0xe5); (* å *)
+ ('c', 0x327, 0xe7); (* ç *) ('e', 0x300, 0xe8); (* è *)
+ ('e', 0x301, 0xe9); (* é *) ('e', 0x302, 0xea); (* ê *)
+ ('e', 0x308, 0xeb); (* ë *) ('i', 0x300, 0xec); (* ì *)
+ ('i', 0x301, 0xed); (* í *) ('i', 0x302, 0xee); (* î *)
+ ('i', 0x308, 0xef); (* ï *) ('n', 0x303, 0xf1); (* ñ *)
+ ('o', 0x300, 0xf2); (* ò *) ('o', 0x301, 0xf3); (* ó *)
+ ('o', 0x302, 0xf4); (* ô *) ('o', 0x303, 0xf5); (* õ *)
+ ('o', 0x308, 0xf6); (* ö *)
+ ('u', 0x300, 0xf9); (* ù *) ('u', 0x301, 0xfa); (* ú *)
+ ('u', 0x302, 0xfb); (* û *) ('u', 0x308, 0xfc); (* ü *)
+ ('y', 0x301, 0xfd); (* ý *) ('y', 0x308, 0xff); (* ÿ *)
+ ('s', 0x30c, 0x161); (* š *) ('z', 0x30c, 0x17e); (* ž *)
+ ]
+
+ let normalize_generic ~keep_ascii transform s =
+ let rec norm check buf prev i =
+ if i >= String.length s then begin
+ Buffer.add_utf_8_uchar buf (transform prev)
+ end else begin
+ let d = String.get_utf_8_uchar s i in
+ let u = Uchar.utf_decode_uchar d in
+ check d u;
+ let i' = i + Uchar.utf_decode_length d in
+ match Hashtbl.find_opt known_pairs (prev, u) with
+ | Some u' ->
+ norm check buf u' i'
+ | None ->
+ Buffer.add_utf_8_uchar buf (transform prev);
+ norm check buf u i'
+ end in
+ let ascii_limit = 128 in
+ if s = ""
+ || keep_ascii && String.for_all (fun x -> Char.code x < ascii_limit) s
+ then Ok s
+ else
+ let buf = Buffer.create (String.length s) in
+ let valid = ref true in
+ let check d u =
+ valid := !valid && Uchar.utf_decode_is_valid d && u <> Uchar.rep
+ in
+ let d = String.get_utf_8_uchar s 0 in
+ let u = Uchar.utf_decode_uchar d in
+ check d u;
+ norm check buf u (Uchar.utf_decode_length d);
+ let contents = Buffer.contents buf in
+ if !valid then
+ Ok contents
+ else
+ Error contents
+
+ let normalize s =
+ normalize_generic ~keep_ascii:true (fun u -> u) s
+
+ (* Capitalization *)
+
+ let uchar_is_uppercase u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then c >= 65 && c <= 90 else
+ match Hashtbl.find_opt known_chars u with
+ | Some(Upper _) -> true
+ | _ -> false
+
+ let uchar_lowercase u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then
+ if c >= 65 && c <= 90 then Uchar.of_int (c + 32) else u
+ else
+ match Hashtbl.find_opt known_chars u with
+ | Some(Upper u') -> u'
+ | _ -> u
+
+ let uchar_uppercase u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then
+ if c >= 97 && c <= 122 then Uchar.of_int (c - 32) else u
+ else
+ match Hashtbl.find_opt known_chars u with
+ | Some(Lower u') -> u'
+ | _ -> u
+
+ let capitalize s =
+ let first = ref true in
+ normalize_generic ~keep_ascii:false
+ (fun u -> if !first then (first := false; uchar_uppercase u) else u)
+ s
+
+ let uncapitalize s =
+ let first = ref true in
+ normalize_generic ~keep_ascii:false
+ (fun u -> if !first then (first := false; uchar_lowercase u) else u)
+ s
+
+ let is_capitalized s =
+ s <> "" &&
+ uchar_is_uppercase (Uchar.utf_decode_uchar (String.get_utf_8_uchar s 0))
+
+ (* Characters allowed in identifiers after normalization is applied.
+ Currently:
+ - ASCII letters, underscore
+ - Latin-9 letters, represented in NFC
+ - ASCII digits, single quote (but not as first character)
+ - dot if [with_dot] = true
+ *)
+ let uchar_valid_in_identifier ~with_dot u =
+ let c = Uchar.to_int u in
+ if c < 0x80 then
+ c >= 97 (* a *) && c <= 122 (* z *)
+ || c >= 65 (* A *) && c <= 90 (* Z *)
+ || c >= 48 (* 0 *) && c <= 57 (* 9 *)
+ || c = 95 (* underscore *)
+ || c = 39 (* single quote *)
+ || (with_dot && c = 46) (* dot *)
+ else
+ Hashtbl.mem known_chars u
+
+ let uchar_not_identifier_start u =
+ let c = Uchar.to_int u in
+ c >= 48 (* 0 *) && c <= 57 (* 9 *)
+ || c = 39 (* single quote *)
+
+ (* Check whether a normalized string is a valid OCaml identifier. *)
+
+ type validation_result =
+ | Valid
+ | Invalid_character of Uchar.t (** Character not allowed *)
+ | Invalid_beginning of Uchar.t (** Character not allowed as first char *)
+
+ let validate_identifier ?(with_dot=false) s =
+ let rec check i =
+ if i >= String.length s then Valid else begin
+ let d = String.get_utf_8_uchar s i in
+ let u = Uchar.utf_decode_uchar d in
+ let i' = i + Uchar.utf_decode_length d in
+ if not (uchar_valid_in_identifier ~with_dot u) then
+ Invalid_character u
+ else if i = 0 && uchar_not_identifier_start u then
+ Invalid_beginning u
+ else
+ check i'
+ end
+ in check 0
+
+ let is_valid_identifier s =
+ validate_identifier s = Valid
+
+ let starts_like_a_valid_identifier s =
+ s <> "" &&
+ (let u = Uchar.utf_decode_uchar (String.get_utf_8_uchar s 0) in
+ uchar_valid_in_identifier ~with_dot:false u
+ && not (uchar_not_identifier_start u))
+
+ let is_lowercase s =
+ let rec is_lowercase_at len s n =
+ if n >= len then true
+ else
+ let d = String.get_utf_8_uchar s n in
+ let u = Uchar.utf_decode_uchar d in
+ (uchar_valid_in_identifier ~with_dot:false u)
+ && not (uchar_is_uppercase u)
+ && is_lowercase_at len s (n+Uchar.utf_decode_length d)
+ in
+ is_lowercase_at (String.length s) s 0
+end
+
+(* File functions *)
+
+let find_in_path path name =
+ if not (Filename.is_implicit name) then
+ if Sys.file_exists name then name else raise Not_found
+ else begin
+ let rec try_dir = function
+ [] -> raise Not_found
+ | dir::rem ->
+ let fullname = Filename.concat dir name in
+ if Sys.file_exists fullname then fullname else try_dir rem
+ in try_dir path
+ end
+
+let find_in_path_rel path name =
+ let rec simplify s =
+ let open Filename in
+ let base = basename s in
+ let dir = dirname s in
+ if dir = s then dir
+ else if base = current_dir_name then simplify dir
+ else concat (simplify dir) base
+ in
+ let rec try_dir = function
+ [] -> raise Not_found
+ | dir::rem ->
+ let fullname = simplify (Filename.concat dir name) in
+ if Sys.file_exists fullname then fullname else try_dir rem
+ in try_dir path
+
+let normalized_unit_filename = Utf8_lexeme.uncapitalize
+
+let find_in_path_normalized path name =
+ match normalized_unit_filename name with
+ | Error _ -> raise Not_found
+ | Ok uname ->
+ let rec try_dir = function
+ [] -> raise Not_found
+ | dir::rem ->
+ let fullname = Filename.concat dir name
+ and ufullname = Filename.concat dir uname in
+ if Sys.file_exists ufullname then ufullname
+ else if Sys.file_exists fullname then fullname
+ else try_dir rem
+ in try_dir path
+
+let remove_file filename =
+ try
+ if Sys.is_regular_file filename
+ then Sys.remove filename
+ with Sys_error _msg ->
+ ()
+
+(* Expand a -I option: if it starts with +, make it relative to the standard
+ library directory *)
+
+let expand_directory alt s =
+ if String.length s > 0 && s.[0] = '+'
+ then Filename.concat alt
+ (String.sub s 1 (String.length s - 1))
+ else s
+
+let path_separator =
+ match Sys.os_type with
+ | "Win32" -> ';'
+ | _ -> ':'
+
+let split_path_contents ?(sep = path_separator) = function
+ | "" -> []
+ | s -> String.split_on_char sep s
+
+(* Hashtable functions *)
+
+let create_hashtable size init =
+ let tbl = Hashtbl.create size in
+ List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
+ tbl
+
+(* File copy *)
+
+let copy_file ic oc =
+ let buff = Bytes.create 0x1000 in
+ let rec copy () =
+ let n = input ic buff 0 0x1000 in
+ if n = 0 then () else (output oc buff 0 n; copy())
+ in copy()
+
+let copy_file_chunk ic oc len =
+ let buff = Bytes.create 0x1000 in
+ let rec copy n =
+ if n <= 0 then () else begin
+ let r = input ic buff 0 (Int.min n 0x1000) in
+ if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r))
+ end
+ in copy len
+
+let string_of_file ic =
+ let b = Buffer.create 0x10000 in
+ let buff = Bytes.create 0x1000 in
+ let rec copy () =
+ let n = input ic buff 0 0x1000 in
+ if n = 0 then Buffer.contents b else
+ (Buffer.add_subbytes b buff 0 n; copy())
+ in copy()
+
+let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
+ let (temp_filename, oc) =
+ Filename.open_temp_file
+ ~mode ~perms:0o666 ~temp_dir:(Filename.dirname filename)
+ (Filename.basename filename) ".tmp" in
+ (* The 0o666 permissions will be modified by the umask. It's just
+ like what [open_out] and [open_out_bin] do.
+ With temp_dir = dirname filename, we ensure that the returned
+ temp file is in the same directory as filename itself, making
+ it safe to rename temp_filename to filename later.
+ With prefix = basename filename, we are almost certain that
+ the first generated name will be unique. A fixed prefix
+ would work too but might generate more collisions if many
+ files are being produced simultaneously in the same directory. *)
+ match fn temp_filename oc with
+ | res ->
+ close_out oc;
+ begin try
+ Sys.rename temp_filename filename; res
+ with exn ->
+ remove_file temp_filename; raise exn
+ end
+ | exception exn ->
+ close_out oc; remove_file temp_filename; raise exn
+
+let protect_writing_to_file ~filename ~f =
+ let outchan = open_out_bin filename in
+ try_finally ~always:(fun () -> close_out outchan)
+ ~exceptionally:(fun () -> remove_file filename)
+ (fun () -> f outchan)
+
+(* Integer operations *)
+
+let rec log2 n =
+ if n <= 1 then 0 else 1 + log2(n asr 1)
+
+let align n a =
+ if n >= 0 then (n + a - 1) land (-a) else n land (-a)
+
+let no_overflow_add a b = (a lxor b) lor (a lxor (lnot (a+b))) < 0
+
+let no_overflow_sub a b = (a lxor (lnot b)) lor (b lxor (a-b)) < 0
+
+(* Taken from Hacker's Delight, chapter "Overflow Detection" *)
+let no_overflow_mul a b =
+ not ((a = min_int && b < 0) || (b <> 0 && (a * b) / b <> a))
+
+let no_overflow_lsl a k =
+ 0 <= k && k < Sys.word_size - 1 && min_int asr k <= a && a <= max_int asr k
+
+let letter_of_int n =
+ let letter = String.make 1 (Char.chr (Char.code 'a' + n mod 26)) in
+ let num = n / 26 in
+ if num = 0 then letter
+ else letter ^ Int.to_string num
+
+module Int_literal_converter = struct
+ (* To convert integer literals, allowing max_int + 1 (PR#4210) *)
+ let cvt_int_aux str neg of_string =
+ if String.length str = 0 || str.[0]= '-'
+ then of_string str
+ else neg (of_string ("-" ^ str))
+ let int s = cvt_int_aux s (~-) int_of_string
+ let int32 s = cvt_int_aux s Int32.neg Int32.of_string
+ let int64 s = cvt_int_aux s Int64.neg Int64.of_string
+ let nativeint s = cvt_int_aux s Nativeint.neg Nativeint.of_string
+end
+
+(* [find_first_mono p] assumes that there exists a natural number
+ N such that [p] is false on [0; N[ and true on [N; max_int], and
+ returns this N. (See misc.mli for the detailed specification.) *)
+let find_first_mono =
+ let rec find p ~low ~jump ~high =
+ (* Invariants:
+ [low, jump, high] are non-negative with [low < high],
+ [p low = false],
+ [p high = true]. *)
+ if low + 1 = high then high
+ (* ensure that [low + jump] is in ]low; high[ *)
+ else if jump < 1 then find p ~low ~jump:1 ~high
+ else if jump >= high - low then find p ~low ~jump:((high - low) / 2) ~high
+ else if p (low + jump) then
+ (* We jumped too high: continue with a smaller jump and lower limit *)
+ find p ~low:low ~jump:(jump / 2) ~high:(low + jump)
+ else
+ (* we jumped too low:
+ continue from [low + jump] with a larger jump *)
+ let next_jump = max jump (2 * jump) (* avoid overflows *) in
+ find p ~low:(low + jump) ~jump:next_jump ~high
+ in
+ fun p ->
+ if p 0 then 0
+ else find p ~low:0 ~jump:1 ~high:max_int
+
+(* String operations *)
+
+let split_null_terminated s =
+ let[@tail_mod_cons] rec discard_last_sep = function
+ | [] | [""] -> []
+ | x :: xs -> x :: discard_last_sep xs
+ in
+ discard_last_sep (String.split_on_char '\000' s)
+
+let concat_null_terminated = function
+ | [] -> ""
+ | l -> String.concat "\000" (l @ [""])
+
+let chop_extensions file =
+ let dirname = Filename.dirname file and basename = Filename.basename file in
+ try
+ let pos = String.index basename '.' in
+ let basename = String.sub basename 0 pos in
+ if Filename.is_implicit file && dirname = Filename.current_dir_name then
+ basename
+ else
+ Filename.concat dirname basename
+ with Not_found -> file
+
+let search_substring pat str start =
+ let rec search i j =
+ if j >= String.length pat then i
+ else if i + j >= String.length str then raise Not_found
+ else if str.[i + j] = pat.[j] then search i (j+1)
+ else search (i+1) 0
+ in search start 0
+
+let replace_substring ~before ~after str =
+ let rec search acc curr =
+ match search_substring before str curr with
+ | next ->
+ let prefix = String.sub str curr (next - curr) in
+ search (prefix :: acc) (next + String.length before)
+ | exception Not_found ->
+ let suffix = String.sub str curr (String.length str - curr) in
+ List.rev (suffix :: acc)
+ in String.concat after (search [] 0)
+
+let rev_split_words s =
+ let rec split1 res i =
+ if i >= String.length s then res else begin
+ match s.[i] with
+ ' ' | '\t' | '\r' | '\n' -> split1 res (i+1)
+ | _ -> split2 res i (i+1)
+ end
+ and split2 res i j =
+ if j >= String.length s then String.sub s i (j-i) :: res else begin
+ match s.[j] with
+ ' ' | '\t' | '\r' | '\n' -> split1 (String.sub s i (j-i) :: res) (j+1)
+ | _ -> split2 res i (j+1)
+ end
+ in split1 [] 0
+
+let get_ref r =
+ let v = !r in
+ r := []; v
+
+let set_or_ignore f opt x =
+ match f x with
+ | None -> ()
+ | Some y -> opt := Some y
+
+let fst3 (x, _, _) = x
+let snd3 (_,x,_) = x
+let thd3 (_,_,x) = x
+
+let fst4 (x, _, _, _) = x
+let snd4 (_,x,_, _) = x
+let thd4 (_,_,x,_) = x
+let for4 (_,_,_,x) = x
+
+
+let cut_at s c =
+ let pos = String.index s c in
+ String.sub s 0 pos, String.sub s (pos+1) (String.length s - pos - 1)
+
+let ordinal_suffix n =
+ let teen = (n mod 100)/10 = 1 in
+ match n mod 10 with
+ | 1 when not teen -> "st"
+ | 2 when not teen -> "nd"
+ | 3 when not teen -> "rd"
+ | _ -> "th"
+
+(* Color support handling *)
+module Color = struct
+ external isatty : out_channel -> bool = "caml_sys_isatty"
+
+ (* reasonable heuristic on whether colors should be enabled *)
+ let should_enable_color () =
+ let term = try Sys.getenv "TERM" with Not_found -> "" in
+ term <> "dumb"
+ && term <> ""
+ && isatty stderr
+
+ type setting = Auto | Always | Never
+
+ let default_setting = Auto
+ let enabled = ref true
+
+end
+
+(* Terminal styling handling *)
+module Style = struct
+ (* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *)
+ type color =
+ | Black
+ | Red
+ | Green
+ | Yellow
+ | Blue
+ | Magenta
+ | Cyan
+ | White
+
+ type style =
+ | FG of color (* foreground *)
+ | BG of color (* background *)
+ | Bold
+ | Reset
+
+ let ansi_of_color = function
+ | Black -> "0"
+ | Red -> "1"
+ | Green -> "2"
+ | Yellow -> "3"
+ | Blue -> "4"
+ | Magenta -> "5"
+ | Cyan -> "6"
+ | White -> "7"
+
+ let code_of_style = function
+ | FG c -> "3" ^ ansi_of_color c
+ | BG c -> "4" ^ ansi_of_color c
+ | Bold -> "1"
+ | Reset -> "0"
+
+ let ansi_of_style_l l =
+ let s = match l with
+ | [] -> code_of_style Reset
+ | [s] -> code_of_style s
+ | _ -> String.concat ";" (List.map code_of_style l)
+ in
+ "\x1b[" ^ s ^ "m"
+
+
+ type Format.stag += Style of style list
+
+ type tag_style ={
+ ansi: style list;
+ text_open:string;
+ text_close:string
+ }
+
+ type styles = {
+ error: tag_style;
+ warning: tag_style;
+ loc: tag_style;
+ hint: tag_style;
+ inline_code: tag_style;
+ }
+
+ let no_markup stl = { ansi = stl; text_close = ""; text_open = "" }
+
+ let default_styles = {
+ warning = no_markup [Bold; FG Magenta];
+ error = no_markup [Bold; FG Red];
+ loc = no_markup [Bold];
+ hint = no_markup [Bold; FG Blue];
+ inline_code= { ansi=[Bold]; text_open = {|"|}; text_close = {|"|} }
+ }
+
+ let cur_styles = ref default_styles
+ let get_styles () = !cur_styles
+ let set_styles s = cur_styles := s
+
+ (* map a tag to a style, if the tag is known.
+ @raise Not_found otherwise *)
+ let style_of_tag s = match s with
+ | Format.String_tag "error" -> (!cur_styles).error
+ | Format.String_tag "warning" ->(!cur_styles).warning
+ | Format.String_tag "loc" -> (!cur_styles).loc
+ | Format.String_tag "hint" -> (!cur_styles).hint
+ | Format.String_tag "inline_code" -> (!cur_styles).inline_code
+ | Style s -> no_markup s
+ | _ -> raise Not_found
+
+
+ let as_inline_code printer ppf x =
+ let open Format_doc in
+ pp_open_stag ppf (Format.String_tag "inline_code");
+ printer ppf x;
+ pp_close_stag ppf ()
+
+ let inline_code ppf s = as_inline_code Format_doc.pp_print_string ppf s
+
+ (* either prints the tag of [s] or delegates to [or_else] *)
+ let mark_open_tag ~or_else s =
+ try
+ let style = style_of_tag s in
+ if !Color.enabled then ansi_of_style_l style.ansi else style.text_open
+ with Not_found -> or_else s
+
+ let mark_close_tag ~or_else s =
+ try
+ let style = style_of_tag s in
+ if !Color.enabled then ansi_of_style_l [Reset] else style.text_close
+ with Not_found -> or_else s
+
+ (* add tag handling to formatter [ppf] *)
+ let set_tag_handling ppf =
+ let open Format in
+ let functions = pp_get_formatter_stag_functions ppf () in
+ let functions' = {functions with
+ mark_open_stag=(mark_open_tag ~or_else:functions.mark_open_stag);
+ mark_close_stag=(mark_close_tag ~or_else:functions.mark_close_stag);
+ } in
+ pp_set_mark_tags ppf true; (* enable tags *)
+ pp_set_formatter_stag_functions ppf functions';
+ ()
+
+ let setup =
+ let first = ref true in (* initialize only once *)
+ let formatter_l =
+ [Format.std_formatter; Format.err_formatter; Format.str_formatter]
+ in
+ let enable_color = function
+ | Color.Auto -> Color.should_enable_color ()
+ | Color.Always -> true
+ | Color.Never -> false
+ in
+ fun o ->
+ if !first then (
+ first := false;
+ Format.set_mark_tags true;
+ List.iter set_tag_handling formatter_l;
+ Color.enabled := (match o with
+ | Some s -> enable_color s
+ | None -> enable_color Color.default_setting)
+ );
+ ()
+end
+
+let edit_distance a b cutoff =
+ let la, lb = String.length a, String.length b in
+ let cutoff =
+ (* using max_int for cutoff would cause overflows in (i + cutoff + 1);
+ we bring it back to the (max la lb) worstcase *)
+ Int.min (Int.max la lb) cutoff in
+ if abs (la - lb) > cutoff then None
+ else begin
+ (* initialize with 'cutoff + 1' so that not-yet-written-to cases have
+ the worst possible cost; this is useful when computing the cost of
+ a case just at the boundary of the cutoff diagonal. *)
+ let m = Array.make_matrix (la + 1) (lb + 1) (cutoff + 1) in
+ m.(0).(0) <- 0;
+ for i = 1 to la do
+ m.(i).(0) <- i;
+ done;
+ for j = 1 to lb do
+ m.(0).(j) <- j;
+ done;
+ for i = 1 to la do
+ for j = Int.max 1 (i - cutoff - 1) to Int.min lb (i + cutoff + 1) do
+ let cost = if a.[i-1] = b.[j-1] then 0 else 1 in
+ let best =
+ (* insert, delete or substitute *)
+ Int.min (1 + Int.min m.(i-1).(j) m.(i).(j-1)) (m.(i-1).(j-1) + cost)
+ in
+ let best =
+ (* swap two adjacent letters; we use "cost" again in case of
+ a swap between two identical letters; this is slightly
+ redundant as this is a double-substitution case, but it
+ was done this way in most online implementations and
+ imitation has its virtues *)
+ if not (i > 1 && j > 1 && a.[i-1] = b.[j-2] && a.[i-2] = b.[j-1])
+ then best
+ else Int.min best (m.(i-2).(j-2) + cost)
+ in
+ m.(i).(j) <- best
+ done;
+ done;
+ let result = m.(la).(lb) in
+ if result > cutoff
+ then None
+ else Some result
+ end
+
+let spellcheck env name =
+ let cutoff =
+ match String.length name with
+ | 1 | 2 -> 0
+ | 3 | 4 -> 1
+ | 5 | 6 -> 2
+ | _ -> 3
+ in
+ let compare target acc head =
+ match edit_distance target head cutoff with
+ | None -> acc
+ | Some dist ->
+ let (best_choice, best_dist) = acc in
+ if dist < best_dist then ([head], dist)
+ else if dist = best_dist then (head :: best_choice, dist)
+ else acc
+ in
+ let env = List.sort_uniq (fun s1 s2 -> String.compare s2 s1) env in
+ fst (List.fold_left (compare name) ([], max_int) env)
+
+
+let did_you_mean ppf get_choices =
+ let open Format_doc in
+ (* flush now to get the error report early, in the (unheard of) case
+ where the search in the get_choices function would take a bit of
+ time; in the worst case, the user has seen the error, she can
+ interrupt the process before the spell-checking terminates. *)
+ fprintf ppf "@?";
+ match get_choices () with
+ | [] -> ()
+ | choices ->
+ let rest, last = split_last choices in
+ fprintf ppf "@\n@[@{<hint>Hint@}: Did you mean %a%s%a?@]"
+ (pp_print_list ~pp_sep:comma Style.inline_code) rest
+ (if rest = [] then "" else " or ")
+ Style.inline_code last
+
+module Error_style = struct
+ type setting =
+ | Contextual
+ | Short
+
+ let default_setting = Contextual
+end
+
+let normalise_eol s =
+ let b = Buffer.create 80 in
+ for i = 0 to String.length s - 1 do
+ if s.[i] <> '\r' then Buffer.add_char b s.[i]
+ done;
+ Buffer.contents b
+
+let delete_eol_spaces src =
+ let len_src = String.length src in
+ let dst = Bytes.create len_src in
+ let rec loop i_src i_dst =
+ if i_src = len_src then
+ i_dst
+ else
+ match src.[i_src] with
+ | ' ' | '\t' ->
+ loop_spaces 1 (i_src + 1) i_dst
+ | c ->
+ Bytes.set dst i_dst c;
+ loop (i_src + 1) (i_dst + 1)
+ and loop_spaces spaces i_src i_dst =
+ if i_src = len_src then
+ i_dst
+ else
+ match src.[i_src] with
+ | ' ' | '\t' ->
+ loop_spaces (spaces + 1) (i_src + 1) i_dst
+ | '\n' ->
+ Bytes.set dst i_dst '\n';
+ loop (i_src + 1) (i_dst + 1)
+ | _ ->
+ for n = 0 to spaces do
+ Bytes.set dst (i_dst + n) src.[i_src - spaces + n]
+ done;
+ loop (i_src + 1) (i_dst + spaces + 1)
+ in
+ let stop = loop 0 0 in
+ Bytes.sub_string dst 0 stop
+
+(* showing configuration and configuration variables *)
+let show_config_and_exit () =
+ Config.print_config stdout;
+ exit 0
+
+let show_config_variable_and_exit x =
+ match Config.config_var x with
+ | Some v ->
+ (* we intentionally don't print a newline to avoid Windows \r
+ issues: bash only strips the trailing \n when using a command
+ substitution $(ocamlc -config-var foo), so a trailing \r would
+ remain if printing a newline under Windows and scripts would
+ have to use $(ocamlc -config-var foo | tr -d '\r')
+ for portability. Ugh. *)
+ print_string v;
+ exit 0
+ | None ->
+ exit 2
+
+let get_build_path_prefix_map =
+ let init = ref false in
+ let map_cache = ref None in
+ fun () ->
+ if not !init then begin
+ init := true;
+ match Sys.getenv "BUILD_PATH_PREFIX_MAP" with
+ | exception Not_found -> ()
+ | encoded_map ->
+ match Build_path_prefix_map.decode_map encoded_map with
+ | Error err ->
+ fatal_errorf
+ "Invalid value for the environment variable \
+ BUILD_PATH_PREFIX_MAP: %s" err
+ | Ok map -> map_cache := Some map
+ end;
+ !map_cache
+
+let debug_prefix_map_flags () =
+ if not Config.as_has_debug_prefix_map then
+ []
+ else begin
+ match get_build_path_prefix_map () with
+ | None -> []
+ | Some map ->
+ List.fold_right
+ (fun map_elem acc ->
+ match map_elem with
+ | None -> acc
+ | Some { Build_path_prefix_map.target; source; } ->
+ (Printf.sprintf "--debug-prefix-map %s=%s"
+ (Filename.quote source)
+ (Filename.quote target)) :: acc)
+ map
+ []
+ end
+
+let print_see_manual ppf manual_section =
+ let open Format_doc in
+ fprintf ppf "(see manual section %a)"
+ (pp_print_list ~pp_sep:(fun f () -> pp_print_char f '.') pp_print_int)
+ manual_section
+
+let print_if ppf flag printer arg =
+ if !flag then Format.fprintf ppf "%a@." printer arg;
+ arg
+
+
+type filepath = string
+type modname = string
+type crcs = (modname * Digest.t option) list
+
+type alerts = string Stdlib.String.Map.t
+
+module Magic_number = struct
+ type native_obj_config = {
+ flambda : bool;
+ }
+ let native_obj_config = {
+ flambda = Config.flambda;
+ }
+
+ type version = int
+
+ type kind =
+ | Exec
+ | Cmi | Cmo | Cma
+ | Cmx of native_obj_config | Cmxa of native_obj_config
+ | Cmxs
+ | Cmt
+ | Ast_impl | Ast_intf
+
+ (* please keep up-to-date, this is used for sanity checking *)
+ let all_native_obj_configs = [
+ {flambda = true};
+ {flambda = false};
+ ]
+ let all_kinds = [
+ Exec;
+ Cmi; Cmo; Cma;
+ ]
+ @ List.map (fun conf -> Cmx conf) all_native_obj_configs
+ @ List.map (fun conf -> Cmxa conf) all_native_obj_configs
+ @ [
+ Cmt;
+ Ast_impl; Ast_intf;
+ ]
+
+ type raw = string
+ type info = {
+ kind: kind;
+ version: version;
+ }
+
+ type raw_kind = string
+
+ let parse_kind : raw_kind -> kind option = function
+ | "Caml1999X" -> Some Exec
+ | "Caml1999I" -> Some Cmi
+ | "Caml1999O" -> Some Cmo
+ | "Caml1999A" -> Some Cma
+ | "Caml1999y" -> Some (Cmx {flambda = true})
+ | "Caml1999Y" -> Some (Cmx {flambda = false})
+ | "Caml1999z" -> Some (Cmxa {flambda = true})
+ | "Caml1999Z" -> Some (Cmxa {flambda = false})
+
+ (* Caml2007D and Caml2012T were used instead of the common Caml1999 prefix
+ between the introduction of those magic numbers and October 2017
+ (8ba70ff194b66c0a50ffb97d41fe9c4bdf9362d6).
+
+ We accept them here, but will always produce/show kind prefixes
+ that follow the current convention, Caml1999{D,T}. *)
+ | "Caml2007D" | "Caml1999D" -> Some Cmxs
+ | "Caml2012T" | "Caml1999T" -> Some Cmt
+
+ | "Caml1999M" -> Some Ast_impl
+ | "Caml1999N" -> Some Ast_intf
+ | _ -> None
+
+ (* note: over time the magic kind number has changed for certain kinds;
+ this function returns them as they are produced by the current compiler,
+ but [parse_kind] accepts older formats as well. *)
+ let raw_kind : kind -> raw = function
+ | Exec -> "Caml1999X"
+ | Cmi -> "Caml1999I"
+ | Cmo -> "Caml1999O"
+ | Cma -> "Caml1999A"
+ | Cmx config ->
+ if config.flambda
+ then "Caml1999y"
+ else "Caml1999Y"
+ | Cmxa config ->
+ if config.flambda
+ then "Caml1999z"
+ else "Caml1999Z"
+ | Cmxs -> "Caml1999D"
+ | Cmt -> "Caml1999T"
+ | Ast_impl -> "Caml1999M"
+ | Ast_intf -> "Caml1999N"
+
+ let string_of_kind : kind -> string = function
+ | Exec -> "exec"
+ | Cmi -> "cmi"
+ | Cmo -> "cmo"
+ | Cma -> "cma"
+ | Cmx _ -> "cmx"
+ | Cmxa _ -> "cmxa"
+ | Cmxs -> "cmxs"
+ | Cmt -> "cmt"
+ | Ast_impl -> "ast_impl"
+ | Ast_intf -> "ast_intf"
+
+ let human_description_of_native_obj_config : native_obj_config -> string =
+ fun[@warning "+9"] {flambda} ->
+ if flambda then "flambda" else "non flambda"
+
+ let human_name_of_kind : kind -> string = function
+ | Exec -> "executable"
+ | Cmi -> "compiled interface file"
+ | Cmo -> "bytecode object file"
+ | Cma -> "bytecode library"
+ | Cmx config ->
+ Printf.sprintf "native compilation unit description (%s)"
+ (human_description_of_native_obj_config config)
+ | Cmxa config ->
+ Printf.sprintf "static native library (%s)"
+ (human_description_of_native_obj_config config)
+ | Cmxs -> "dynamic native library"
+ | Cmt -> "compiled typedtree file"
+ | Ast_impl -> "serialized implementation AST"
+ | Ast_intf -> "serialized interface AST"
+
+ let kind_length = 9
+ let version_length = 3
+ let magic_length =
+ kind_length + version_length
+
+ type parse_error =
+ | Truncated of string
+ | Not_a_magic_number of string
+
+ let explain_parse_error kind_opt error =
+ Printf.sprintf
+ "We expected a valid %s, but the file %s."
+ (Option.fold ~none:"object file" ~some:human_name_of_kind kind_opt)
+ (match error with
+ | Truncated "" -> "is empty"
+ | Truncated _ -> "is truncated"
+ | Not_a_magic_number _ -> "has a different format")
+
+ let parse s : (info, parse_error) result =
+ if String.length s = magic_length then begin
+ let raw_kind = String.sub s 0 kind_length in
+ let raw_version = String.sub s kind_length version_length in
+ match parse_kind raw_kind with
+ | None -> Error (Not_a_magic_number s)
+ | Some kind ->
+ begin match int_of_string raw_version with
+ | exception _ -> Error (Truncated s)
+ | version -> Ok { kind; version }
+ end
+ end
+ else begin
+ (* a header is "truncated" if it starts like a valid magic number,
+ that is if its longest segment of length at most [kind_length]
+ is a prefix of [raw_kind kind] for some kind [kind] *)
+ let sub_length = Int.min kind_length (String.length s) in
+ let starts_as kind =
+ String.sub s 0 sub_length = String.sub (raw_kind kind) 0 sub_length
+ in
+ if List.exists starts_as all_kinds then Error (Truncated s)
+ else Error (Not_a_magic_number s)
+ end
+
+ let read_info ic =
+ let header = Buffer.create magic_length in
+ begin
+ try Buffer.add_channel header ic magic_length
+ with End_of_file -> ()
+ end;
+ parse (Buffer.contents header)
+
+ let raw { kind; version; } =
+ Printf.sprintf "%s%03d" (raw_kind kind) version
+
+ let current_raw kind =
+ let open Config in
+ match[@warning "+9"] kind with
+ | Exec -> exec_magic_number
+ | Cmi -> cmi_magic_number
+ | Cmo -> cmo_magic_number
+ | Cma -> cma_magic_number
+ | Cmx config ->
+ (* the 'if' guarantees that in the common case
+ we return the "trusted" value from Config. *)
+ let reference = cmx_magic_number in
+ if config = native_obj_config then reference
+ else
+ (* otherwise we stitch together the magic number
+ for a different configuration by concatenating
+ the right magic kind at this configuration
+ and the rest of the current raw number for our configuration. *)
+ let raw_kind = raw_kind kind in
+ let len = String.length raw_kind in
+ raw_kind ^ String.sub reference len (String.length reference - len)
+ | Cmxa config ->
+ let reference = cmxa_magic_number in
+ if config = native_obj_config then reference
+ else
+ let raw_kind = raw_kind kind in
+ let len = String.length raw_kind in
+ raw_kind ^ String.sub reference len (String.length reference - len)
+ | Cmxs -> cmxs_magic_number
+ | Cmt -> cmt_magic_number
+ | Ast_intf -> ast_intf_magic_number
+ | Ast_impl -> ast_impl_magic_number
+
+ (* it would seem more direct to define current_version with the
+ correct numbers and current_raw on top of it, but for now we
+ consider the Config.foo values to be ground truth, and don't want
+ to trust the present module instead. *)
+ let current_version kind =
+ let raw = current_raw kind in
+ try int_of_string (String.sub raw kind_length version_length)
+ with _ -> assert false
+
+ type 'a unexpected = { expected : 'a; actual : 'a }
+ type unexpected_error =
+ | Kind of kind unexpected
+ | Version of kind * version unexpected
+
+ let explain_unexpected_error = function
+ | Kind { actual; expected } ->
+ Printf.sprintf "We expected a %s (%s) but got a %s (%s) instead."
+ (human_name_of_kind expected) (string_of_kind expected)
+ (human_name_of_kind actual) (string_of_kind actual)
+ | Version (kind, { actual; expected }) ->
+ Printf.sprintf "This seems to be a %s (%s) for %s version of OCaml."
+ (human_name_of_kind kind) (string_of_kind kind)
+ (if actual < expected then "an older" else "a newer")
+
+ let check_current expected_kind { kind; version } : _ result =
+ if kind <> expected_kind then begin
+ let actual, expected = kind, expected_kind in
+ Error (Kind { actual; expected })
+ end else begin
+ let actual, expected = version, current_version kind in
+ if actual <> expected
+ then Error (Version (kind, { actual; expected }))
+ else Ok ()
+ end
+
+ type error =
+ | Parse_error of parse_error
+ | Unexpected_error of unexpected_error
+
+ let read_current_info ~expected_kind ic =
+ match read_info ic with
+ | Error err -> Error (Parse_error err)
+ | Ok info ->
+ let kind = Option.value ~default:info.kind expected_kind in
+ match check_current kind info with
+ | Error err -> Error (Unexpected_error err)
+ | Ok () -> Ok info
+end
diff --git a/upstream/ocaml_503/utils/misc.mli b/upstream/ocaml_503/utils/misc.mli
new file mode 100644
index 0000000000..54354eba56
--- /dev/null
+++ b/upstream/ocaml_503/utils/misc.mli
@@ -0,0 +1,832 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Miscellaneous useful types and functions
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+(** {1 Reporting fatal errors} *)
+
+val fatal_error: string -> 'a
+ (** Raise the [Fatal_error] exception with the given string. *)
+
+val fatal_errorf: ('a, Format.formatter, unit, 'b) format4 -> 'a
+ (** Format the arguments according to the given format string
+ and raise [Fatal_error] with the resulting string. *)
+
+exception Fatal_error
+
+(** {1 Exceptions and finalization} *)
+
+val try_finally :
+ ?always:(unit -> unit) ->
+ ?exceptionally:(unit -> unit) ->
+ (unit -> 'a) -> 'a
+(** [try_finally work ~always ~exceptionally] is designed to run code
+ in [work] that may fail with an exception, and has two kind of
+ cleanup routines: [always], that must be run after any execution
+ of the function (typically, freeing system resources), and
+ [exceptionally], that should be run only if [work] or [always]
+ failed with an exception (typically, undoing user-visible state
+ changes that would only make sense if the function completes
+ correctly). For example:
+
+ {[
+ let objfile = outputprefix ^ ".cmo" in
+ let oc = open_out_bin objfile in
+ Misc.try_finally
+ (fun () ->
+ bytecode
+ ++ Timings.(accumulate_time (Generate sourcefile))
+ (Emitcode.to_file oc modulename objfile);
+ Warnings.check_fatal ())
+ ~always:(fun () -> close_out oc)
+ ~exceptionally:(fun _exn -> remove_file objfile);
+ ]}
+
+ If [exceptionally] fail with an exception, it is propagated as
+ usual.
+
+ If [always] or [exceptionally] use exceptions internally for
+ control-flow but do not raise, then [try_finally] is careful to
+ preserve any exception backtrace coming from [work] or [always]
+ for easier debugging.
+*)
+
+val reraise_preserving_backtrace : exn -> (unit -> unit) -> 'a
+(** [reraise_preserving_backtrace e f] is (f (); raise e) except that the
+ current backtrace is preserved, even if [f] uses exceptions internally. *)
+
+(** {1 List operations} *)
+
+val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list
+ (** [map_end f l t] is [map f l @ t], just more efficient. *)
+
+val rev_map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list
+ (** [map_end f l t] is [map f (rev l) @ t], just more efficient. *)
+
+val map_left_right: ('a -> 'b) -> 'a list -> 'b list
+ (** Like [List.map], with guaranteed left-to-right evaluation order *)
+
+val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+ (** Same as [List.for_all] but for a binary predicate.
+ In addition, this [for_all2] never fails: given two lists
+ with different lengths, it returns false. *)
+
+val replicate_list: 'a -> int -> 'a list
+ (** [replicate_list elem n] is the list with [n] elements
+ all identical to [elem]. *)
+
+val list_remove: 'a -> 'a list -> 'a list
+ (** [list_remove x l] returns a copy of [l] with the first
+ element equal to [x] removed. *)
+
+val split_last: 'a list -> 'a list * 'a
+ (** Return the last element and the other elements of the given list. *)
+
+(** {1 Hash table operations} *)
+
+val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
+ (** Create a hashtable with the given initial size and fills it
+ with the given bindings. *)
+
+(** {1 Extensions to the standard library} *)
+
+module Stdlib : sig
+
+(** {2 Extensions to the List module} *)
+ module List : sig
+ type 'a t = 'a list
+
+ val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+ (** The lexicographic order supported by the provided order.
+ There is no constraint on the relative lengths of the lists. *)
+
+ val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+ (** Returns [true] if and only if the given lists have the same length and
+ content with respect to the given equality function. *)
+
+ val some_if_all_elements_are_some : 'a option t -> 'a t option
+ (** If all elements of the given list are [Some _] then [Some xs]
+ is returned with the [xs] being the contents of those [Some]s, with
+ order preserved. Otherwise return [None]. *)
+
+ val map2_prefix : ('a -> 'b -> 'c) -> 'a t -> 'b t -> ('c t * 'b t)
+ (** [let r1, r2 = map2_prefix f l1 l2]
+ If [l1] is of length n and [l2 = h2 @ t2] with h2 of length n,
+ r1 is [List.map2 f l1 h1] and r2 is t2. *)
+
+ val iteri2 : (int -> 'a -> 'b -> unit) -> 'a list -> 'b list -> unit
+ (** Same as {!List.iter2}, but the function is applied to the index of
+ the element as first argument (counting from 0) *)
+
+ val split_at : int -> 'a t -> 'a t * 'a t
+ (** [split_at n l] returns the pair [before, after] where [before] is
+ the [n] first elements of [l] and [after] the remaining ones.
+ If [l] has less than [n] elements, raises Invalid_argument. *)
+
+ val chunks_of : int -> 'a t -> 'a t t
+ (** [chunks_of n t] returns a list of nonempty lists whose
+ concatenation is equal to the original list. Every list has [n]
+ elements, except for possibly the last list, which may have fewer.
+ [chunks_of] raises if [n <= 0]. *)
+
+ val is_prefix
+ : equal:('a -> 'a -> bool)
+ -> 'a list
+ -> of_:'a list
+ -> bool
+ (** Returns [true] if and only if the given list, with respect to the given
+ equality function on list members, is a prefix of the list [of_]. *)
+
+ type 'a longest_common_prefix_result = private {
+ longest_common_prefix : 'a list;
+ first_without_longest_common_prefix : 'a list;
+ second_without_longest_common_prefix : 'a list;
+ }
+
+ val find_and_chop_longest_common_prefix
+ : equal:('a -> 'a -> bool)
+ -> first:'a list
+ -> second:'a list
+ -> 'a longest_common_prefix_result
+ (** Returns the longest list that, with respect to the provided equality
+ function, is a prefix of both of the given lists. The input lists,
+ each with such longest common prefix removed, are also returned. *)
+ end
+
+(** {2 Extensions to the Option module} *)
+ module Option : sig
+ type 'a t = 'a option
+
+ val print
+ : (Format.formatter -> 'a -> unit)
+ -> Format.formatter
+ -> 'a t
+ -> unit
+ end
+
+(** {2 Extensions to the Array module} *)
+ module Array : sig
+ val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
+ (** Same as [Array.exists2] from the standard library. *)
+
+ val for_alli : (int -> 'a -> bool) -> 'a array -> bool
+ (** Same as [Array.for_all] from the standard library, but the
+ function is applied with the index of the element as first argument,
+ and the element itself as second argument. *)
+
+ val all_somes : 'a option array -> 'a array option
+ end
+
+(** {2 Extensions to the String module} *)
+ module String : sig
+ include module type of String
+ module Set : Set.S with type elt = string
+ module Map : Map.S with type key = string
+ module Tbl : Hashtbl.S with type key = string
+
+ val print : Format.formatter -> t -> unit
+
+ val for_all : (char -> bool) -> t -> bool
+ end
+
+ external compare : 'a -> 'a -> int = "%compare"
+end
+
+(** {1 Operations on files and file paths} *)
+
+val find_in_path: string list -> string -> string
+ (** Search a file in a list of directories. *)
+
+val find_in_path_rel: string list -> string -> string
+ (** Search a relative file in a list of directories. *)
+
+ (** Normalize file name [Foo.ml] to [foo.ml], using NFC and case-folding.
+ Return [Error] if the input is not a valid utf-8 byte sequence *)
+val normalized_unit_filename: string -> (string,string) Result.t
+
+val find_in_path_normalized: string list -> string -> string
+(** Same as {!find_in_path_rel} , but search also for normalized unit filename,
+ i.e. if name is [Foo.ml], allow [/path/Foo.ml] and [/path/foo.ml] to
+ match. *)
+
+val remove_file: string -> unit
+ (** Delete the given file if it exists and is a regular file.
+ Does nothing for other kinds of files.
+ Never raises an error. *)
+
+val expand_directory: string -> string -> string
+ (** [expand_directory alt file] eventually expands a [+] at the
+ beginning of file into [alt] (an alternate root directory) *)
+
+val split_path_contents: ?sep:char -> string -> string list
+ (** [split_path_contents ?sep s] interprets [s] as the value of
+ a "PATH"-like variable and returns the corresponding list of
+ directories. [s] is split using the platform-specific delimiter, or
+ [~sep] if it is passed.
+
+ Returns the empty list if [s] is empty. *)
+
+val copy_file: in_channel -> out_channel -> unit
+ (** [copy_file ic oc] reads the contents of file [ic] and copies
+ them to [oc]. It stops when encountering EOF on [ic]. *)
+
+val copy_file_chunk: in_channel -> out_channel -> int -> unit
+ (** [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies
+ them to [oc]. It raises [End_of_file] when encountering
+ EOF on [ic]. *)
+
+val string_of_file: in_channel -> string
+ (** [string_of_file ic] reads the contents of file [ic] and copies
+ them to a string. It stops when encountering EOF on [ic]. *)
+
+val output_to_file_via_temporary:
+ ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
+ (** Produce output in temporary file, then rename it
+ (as atomically as possible) to the desired output file name.
+ [output_to_file_via_temporary filename fn] opens a temporary file
+ which is passed to [fn] (name + output channel). When [fn] returns,
+ the channel is closed and the temporary file is renamed to
+ [filename]. *)
+
+val protect_writing_to_file
+ : filename:string
+ -> f:(out_channel -> 'a)
+ -> 'a
+ (** Open the given [filename] for writing (in binary mode), pass
+ the [out_channel] to the given function, then close the
+ channel. If the function raises an exception then [filename]
+ will be removed. *)
+
+val concat_null_terminated : string list -> string
+(** [concat_null_terminated [x1;x2; ... xn]] is
+ [x1 ^ "\000" ^ x2 ^ "\000" ^ ... ^ xn ^ "\000"] *)
+
+val split_null_terminated : string -> string list
+(** [split_null_terminated s] is similar
+ [String.split_on_char '\000'] but ignores the trailing separator, if any *)
+
+val chop_extensions: string -> string
+ (** Return the given file name without its extensions. The extensions
+ is the longest suffix starting with a period and not including
+ a directory separator, [.xyz.uvw] for instance.
+
+ Return the given name if it does not contain an extension. *)
+
+(** {1 Integer operations} *)
+
+val log2: int -> int
+ (** [log2 n] returns [s] such that [n = 1 lsl s]
+ if [n] is a power of 2*)
+
+val align: int -> int -> int
+ (** [align n a] rounds [n] upwards to a multiple of [a]
+ (a power of 2). *)
+
+val no_overflow_add: int -> int -> bool
+ (** [no_overflow_add n1 n2] returns [true] if the computation of
+ [n1 + n2] does not overflow. *)
+
+val no_overflow_sub: int -> int -> bool
+ (** [no_overflow_sub n1 n2] returns [true] if the computation of
+ [n1 - n2] does not overflow. *)
+
+val no_overflow_mul: int -> int -> bool
+ (** [no_overflow_mul n1 n2] returns [true] if the computation of
+ [n1 * n2] does not overflow. *)
+
+val no_overflow_lsl: int -> int -> bool
+ (** [no_overflow_lsl n k] returns [true] if the computation of
+ [n lsl k] does not overflow. *)
+
+val letter_of_int : int -> string
+
+module Int_literal_converter : sig
+ val int : string -> int
+ (** Convert a string to an integer. Unlike {!Stdlib.int_of_string},
+ this function accepts the string representation of [max_int + 1]
+ and returns [min_int] in this case. *)
+
+ val int32 : string -> int32
+ (** Likewise, at type [int32] *)
+
+ val int64 : string -> int64
+ (** Likewise, at type [int64] *)
+
+ val nativeint : string -> nativeint
+ (** Likewise, at type [nativeint] *)
+
+end
+
+val find_first_mono : (int -> bool) -> int
+ (**[find_first_mono p] takes an integer predicate [p : int -> bool]
+ that we assume:
+ 1. is monotonic on natural numbers:
+ if [a <= b] then [p a] implies [p b],
+ 2. is satisfied for some natural numbers in range [0; max_int]
+ (this is equivalent to: [p max_int = true]).
+
+ [find_first_mono p] is the smallest natural number N that satisfies [p],
+ computed in O(log(N)) calls to [p].
+
+ Our implementation supports two cases where the preconditions on [p]
+ are not respected:
+ - If [p] is always [false], we silently return [max_int]
+ instead of looping or crashing.
+ - If [p] is non-monotonic but eventually true,
+ we return some satisfying value.
+ *)
+
+(** {1 String operations} *)
+
+val search_substring: string -> string -> int -> int
+ (** [search_substring pat str start] returns the position of the first
+ occurrence of string [pat] in string [str]. Search starts
+ at offset [start] in [str]. Raise [Not_found] if [pat]
+ does not occur. *)
+
+val replace_substring: before:string -> after:string -> string -> string
+ (** [replace_substring ~before ~after str] replaces all
+ occurrences of [before] with [after] in [str] and returns
+ the resulting string. *)
+
+val rev_split_words: string -> string list
+ (** [rev_split_words s] splits [s] in blank-separated words, and returns
+ the list of words in reverse order. *)
+
+val cut_at : string -> char -> string * string
+(** [String.cut_at s c] returns a pair containing the sub-string before
+ the first occurrence of [c] in [s], and the sub-string after the
+ first occurrence of [c] in [s].
+ [let (before, after) = String.cut_at s c in
+ before ^ String.make 1 c ^ after] is the identity if [s] contains [c].
+
+ Raise [Not_found] if the character does not appear in the string
+ @since 4.01
+*)
+
+val ordinal_suffix : int -> string
+(** [ordinal_suffix n] is the appropriate suffix to append to the numeral [n] as
+ an ordinal number: [1] -> ["st"], [2] -> ["nd"], [3] -> ["rd"],
+ [4] -> ["th"], and so on. Handles larger numbers (e.g., [42] -> ["nd"]) and
+ the numbers 11--13 (which all get ["th"]) correctly. *)
+
+val normalise_eol : string -> string
+(** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters
+ removed. Intended for pre-processing text which will subsequently be printed
+ on a channel which performs EOL transformations (i.e. Windows) *)
+
+val delete_eol_spaces : string -> string
+(** [delete_eol_spaces s] returns a fresh copy of [s] with any end of
+ line spaces removed. Intended to normalize the output of the
+ toplevel for tests. *)
+
+(** {1 Operations on references} *)
+
+type ref_and_value = R : 'a ref * 'a -> ref_and_value
+
+val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a
+(** [protect_refs l f] temporarily sets [r] to [v] for each [R (r, v)] in [l]
+ while executing [f]. The previous contents of the references is restored
+ even if [f] raises an exception, without altering the exception backtrace.
+*)
+
+val get_ref: 'a list ref -> 'a list
+ (** [get_ref lr] returns the content of the list reference [lr] and reset
+ its content to the empty list. *)
+
+val set_or_ignore : ('a -> 'b option) -> 'b option ref -> 'a -> unit
+ (** [set_or_ignore f opt x] sets [opt] to [f x] if it returns [Some _],
+ or leaves it unmodified if it returns [None]. *)
+
+(** {1 Operations on triples and quadruples} *)
+
+val fst3: 'a * 'b * 'c -> 'a
+val snd3: 'a * 'b * 'c -> 'b
+val thd3: 'a * 'b * 'c -> 'c
+
+val fst4: 'a * 'b * 'c * 'd -> 'a
+val snd4: 'a * 'b * 'c * 'd -> 'b
+val thd4: 'a * 'b * 'c * 'd -> 'c
+val for4: 'a * 'b * 'c * 'd -> 'd
+
+(** {1 Spell checking and ``did you mean'' suggestions} *)
+
+val edit_distance : string -> string -> int -> int option
+(** [edit_distance a b cutoff] computes the edit distance between
+ strings [a] and [b]. To help efficiency, it uses a cutoff: if the
+ distance [d] is smaller than [cutoff], it returns [Some d], else
+ [None].
+
+ The distance algorithm currently used is Damerau-Levenshtein: it
+ computes the number of insertion, deletion, substitution of
+ letters, or swapping of adjacent letters to go from one word to the
+ other. The particular algorithm may change in the future.
+*)
+
+val spellcheck : string list -> string -> string list
+(** [spellcheck env name] takes a list of names [env] that exist in
+ the current environment and an erroneous [name], and returns a
+ list of suggestions taken from [env], that are close enough to
+ [name] that it may be a typo for one of them. *)
+
+val did_you_mean :
+ Format_doc.formatter -> (unit -> string list) -> unit
+(** [did_you_mean ppf get_choices] hints that the user may have meant
+ one of the option returned by calling [get_choices]. It does nothing
+ if the returned list is empty.
+
+ The [unit -> ...] thunking is meant to delay any potentially-slow
+ computation (typically computing edit-distance with many things
+ from the current environment) to when the hint message is to be
+ printed. You should print an understandable error message before
+ calling [did_you_mean], so that users get a clear notification of
+ the failure even if producing the hint is slow.
+*)
+
+(** {1 Color support detection }*)
+module Color: sig
+
+ type setting = Auto | Always | Never
+
+ val default_setting : setting
+
+end
+
+
+(** {1 Styling handling for terminal output } *)
+
+module Style : sig
+ type color =
+ | Black
+ | Red
+ | Green
+ | Yellow
+ | Blue
+ | Magenta
+ | Cyan
+ | White
+
+ type style =
+ | FG of color (* foreground *)
+ | BG of color (* background *)
+ | Bold
+ | Reset
+ type Format.stag += Style of style list
+
+ val ansi_of_style_l : style list -> string
+ (* ANSI escape sequence for the given style *)
+
+ type tag_style ={
+ ansi: style list;
+ text_open:string;
+ text_close:string
+ }
+
+ type styles = {
+ error: tag_style;
+ warning: tag_style;
+ loc: tag_style;
+ hint: tag_style;
+ inline_code: tag_style;
+ }
+
+ val as_inline_code: 'a Format_doc.printer -> 'a Format_doc.printer
+ val inline_code: string Format_doc.printer
+
+ val default_styles: styles
+ val get_styles: unit -> styles
+ val set_styles: styles -> unit
+
+ val setup : Color.setting option -> unit
+ (* [setup opt] will enable or disable color handling on standard formatters
+ according to the value of color setting [opt].
+ Only the first call to this function has an effect. *)
+
+ val set_tag_handling : Format.formatter -> unit
+ (* adds functions to support color tags to the given formatter. *)
+end
+
+(* See the -error-style option *)
+module Error_style : sig
+ type setting =
+ | Contextual
+ | Short
+
+ val default_setting : setting
+end
+
+(** {1 Formatted output} *)
+
+val print_if :
+ Format.formatter -> bool ref -> (Format.formatter -> 'a -> unit) -> 'a -> 'a
+(** [print_if ppf flag fmt x] prints [x] with [fmt] on [ppf] if [b] is true. *)
+
+val print_see_manual : int list Format_doc.printer
+(** See manual section *)
+
+(** {1 Displaying configuration variables} *)
+
+val show_config_and_exit : unit -> unit
+ (** Display the values of all compiler configuration variables from module
+ [Config], then exit the program with code 0. *)
+
+val show_config_variable_and_exit : string -> unit
+ (** Display the value of the given configuration variable,
+ then exit the program with code 0. *)
+
+(** {1 Handling of build maps} *)
+
+(** Build maps cause the compiler to normalize file names embedded in
+ object files, thus leading to more reproducible builds. *)
+
+val get_build_path_prefix_map: unit -> Build_path_prefix_map.map option
+(** Returns the map encoded in the [BUILD_PATH_PREFIX_MAP] environment
+ variable. *)
+
+val debug_prefix_map_flags: unit -> string list
+(** Returns the list of [--debug-prefix-map] flags to be passed to the
+ assembler, built from the [BUILD_PATH_PREFIX_MAP] environment variable. *)
+
+(** {1 Handling of magic numbers} *)
+
+module Magic_number : sig
+ (** a typical magic number is "Caml1999I011"; it is formed of an
+ alphanumeric prefix, here Caml1990I, followed by a version,
+ here 011. The prefix identifies the kind of the versioned data:
+ here the I indicates that it is the magic number for .cmi files.
+
+ All magic numbers have the same byte length, [magic_length], and
+ this is important for users as it gives them the number of bytes
+ to read to obtain the byte sequence that should be a magic
+ number. Typical user code will look like:
+ {[
+ let ic = open_in_bin path in
+ let magic =
+ try really_input_string ic Magic_number.magic_length
+ with End_of_file -> ... in
+ match Magic_number.parse magic with
+ | Error parse_error -> ...
+ | Ok info -> ...
+ ]}
+
+ A given compiler version expects one specific version for each
+ kind of object file, and will fail if given an unsupported
+ version. Because versions grow monotonically, you can compare
+ the parsed version with the expected "current version" for
+ a kind, to tell whether the wrong-magic object file comes from
+ the past or from the future.
+
+ An example of code block that expects the "currently supported version"
+ of a given kind of magic numbers, here [Cmxa], is as follows:
+ {[
+ let ic = open_in_bin path in
+ begin
+ try Magic_number.(expect_current Cmxa (get_info ic)) with
+ | Parse_error error -> ...
+ | Unexpected error -> ...
+ end;
+ ...
+ ]}
+
+ Parse errors distinguish inputs that are [Not_a_magic_number str],
+ which are likely to come from the file being completely
+ different, and [Truncated str], raised by headers that are the
+ (possibly empty) prefix of a valid magic number.
+
+ Unexpected errors correspond to valid magic numbers that are not
+ the one expected, either because it corresponds to a different
+ kind, or to a newer or older version.
+
+ The helper functions [explain_parse_error] and [explain_unexpected_error]
+ will generate a textual explanation of each error,
+ for use in error messages.
+
+ @since 4.11
+ *)
+
+ type native_obj_config = {
+ flambda : bool;
+ }
+ (** native object files have a format and magic number that depend
+ on certain native-compiler configuration parameters. This
+ configuration space is expressed by the [native_obj_config]
+ type. *)
+
+ val native_obj_config : native_obj_config
+ (** the native object file configuration of the active/configured compiler. *)
+
+ type version = int
+
+ type kind =
+ | Exec
+ | Cmi | Cmo | Cma
+ | Cmx of native_obj_config | Cmxa of native_obj_config
+ | Cmxs
+ | Cmt | Ast_impl | Ast_intf
+
+ type info = {
+ kind: kind;
+ version: version;
+ (** Note: some versions of the compiler use the same [version] suffix
+ for all kinds, but others use different versions counters for different
+ kinds. We may only assume that versions are growing monotonically
+ (not necessarily always by one) between compiler versions. *)
+ }
+
+ type raw = string
+ (** the type of raw magic numbers,
+ such as "Caml1999A027" for the .cma files of OCaml 4.10 *)
+
+ (** {3 Parsing magic numbers} *)
+
+ type parse_error =
+ | Truncated of string
+ | Not_a_magic_number of string
+
+ val explain_parse_error : kind option -> parse_error -> string
+ (** Produces an explanation for a parse error. If no kind is provided,
+ we use an unspecific formulation suggesting that any compiler-produced
+ object file would have been satisfying. *)
+
+ val parse : raw -> (info, parse_error) result
+ (** Parses a raw magic number *)
+
+ val read_info : in_channel -> (info, parse_error) result
+ (** Read a raw magic number from an input channel.
+
+ If the data read [str] is not a valid magic number, it can be
+ recovered from the [Truncated str | Not_a_magic_number str]
+ payload of the [Error parse_error] case.
+
+ If parsing succeeds with an [Ok info] result, we know that
+ exactly [magic_length] bytes have been consumed from the
+ input_channel.
+
+ If you also wish to enforce that the magic number
+ is at the current version, see {!read_current_info} below.
+ *)
+
+ val magic_length : int
+ (** all magic numbers take the same number of bytes *)
+
+
+ (** {3 Checking that magic numbers are current} *)
+
+ type 'a unexpected = { expected : 'a; actual : 'a }
+ type unexpected_error =
+ | Kind of kind unexpected
+ | Version of kind * version unexpected
+
+ val check_current : kind -> info -> (unit, unexpected_error) result
+ (** [check_current kind info] checks that the provided magic [info]
+ is the current version of [kind]'s magic header. *)
+
+ val explain_unexpected_error : unexpected_error -> string
+ (** Provides an explanation of the [unexpected_error]. *)
+
+ type error =
+ | Parse_error of parse_error
+ | Unexpected_error of unexpected_error
+
+ val read_current_info :
+ expected_kind:kind option -> in_channel -> (info, error) result
+ (** Read a magic number as [read_info],
+ and check that it is the current version as its kind.
+ If the [expected_kind] argument is [None], any kind is accepted. *)
+
+
+ (** {3 Information on magic numbers} *)
+
+ val string_of_kind : kind -> string
+ (** a user-printable string for a kind, eg. "exec" or "cmo", to use
+ in error messages. *)
+
+ val human_name_of_kind : kind -> string
+ (** a user-meaningful name for a kind, eg. "executable file" or
+ "bytecode object file", to use in error messages. *)
+
+ val current_raw : kind -> raw
+ (** the current magic number of each kind *)
+
+ val current_version : kind -> version
+ (** the current version of each kind *)
+
+
+ (** {3 Raw representations}
+
+ Mainly for internal usage and testing. *)
+
+ type raw_kind = string
+ (** the type of raw magic numbers kinds,
+ such as "Caml1999A" for .cma files *)
+
+ val parse_kind : raw_kind -> kind option
+ (** parse a raw kind into a kind *)
+
+ val raw_kind : kind -> raw_kind
+ (** the current raw representation of a kind.
+
+ In some cases the raw representation of a kind has changed
+ over compiler versions, so other files of the same kind
+ may have different raw kinds.
+ Note that all currently known cases are parsed correctly by [parse_kind].
+ *)
+
+ val raw : info -> raw
+ (** A valid raw representation of the magic number.
+
+ Due to past and future changes in the string representation of
+ magic numbers, we cannot guarantee that the raw strings returned
+ for past and future versions actually match the expectations of
+ those compilers. The representation is accurate for current
+ versions, and it is correctly parsed back into the desired
+ version by the parsing functions above.
+ *)
+
+ val all_kinds : kind list
+end
+
+(** {1 Minimal support for Unicode characters in identifiers} *)
+
+(** Characters allowed in identifiers are, currently:
+ - ASCII letters A-Z a-z
+ - Latin-1 letters (U+00C0 - U+00FF except U+00D7 and U+00F7)
+ - Character sequences which normalize to the above character under NFC
+ - digits 0-9, underscore, single quote
+*)
+
+module Utf8_lexeme: sig
+ type t = string
+
+ val normalize: string -> (t,t) Result.t
+ (** Normalize the given UTF-8 encoded string.
+ Invalid UTF-8 sequences results in a error and are replaced
+ by U+FFFD.
+ Identifier characters are put in NFC normalized form.
+ Other Unicode characters are left unchanged. *)
+
+ val capitalize: string -> (t,t) Result.t
+ (** Like [normalize], but if the string starts with a lowercase identifier
+ character, it is replaced by the corresponding uppercase character.
+ Subsequent characters are not changed. *)
+
+ val uncapitalize: string -> (t,t) Result.t
+ (** Like [normalize], but if the string starts with an uppercase identifier
+ character, it is replaced by the corresponding lowercase character.
+ Subsequent characters are not changed. *)
+
+ val is_capitalized: t -> bool
+ (** Returns [true] if the given normalized string starts with an
+ uppercase identifier character, [false] otherwise. May return
+ wrong results if the string is not normalized. *)
+
+ val is_valid_identifier: t -> bool
+ (** Check whether the given normalized string is a valid OCaml identifier:
+ - all characters are identifier characters
+ - it does not start with a digit or a single quote
+ *)
+
+ val is_lowercase: t -> bool
+ (** Returns [true] if the given normalized string only contains lowercase
+ identifier character, [false] otherwise. May return wrong results if the
+ string is not normalized. *)
+
+ type validation_result =
+ | Valid
+ | Invalid_character of Uchar.t (** Character not allowed *)
+ | Invalid_beginning of Uchar.t (** Character not allowed as first char *)
+
+ val validate_identifier: ?with_dot:bool -> t -> validation_result
+ (** Like [is_valid_identifier], but returns a more detailed error code. Dots
+ can be allowed to extend support to path-like identifiers. *)
+
+ val starts_like_a_valid_identifier: t -> bool
+ (** Checks whether the given normalized string starts with an identifier
+ character other than a digit or a single quote. Subsequent characters
+ are not checked. *)
+end
+
+(** {1 Miscellaneous type aliases} *)
+
+type filepath = string
+type modname = string
+type crcs = (modname * Digest.t option) list
+
+type alerts = string Stdlib.String.Map.t
diff --git a/upstream/ocaml_503/utils/numbers.ml b/upstream/ocaml_503/utils/numbers.ml
new file mode 100644
index 0000000000..1680675bab
--- /dev/null
+++ b/upstream/ocaml_503/utils/numbers.ml
@@ -0,0 +1,88 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2013--2016 OCamlPro SAS *)
+(* Copyright 2014--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+module Int_base = Identifiable.Make (struct
+ type t = int
+
+ let compare x y = x - y
+ let output oc x = Printf.fprintf oc "%i" x
+ let hash i = i
+ let equal (i : int) j = i = j
+ let print = Format.pp_print_int
+end)
+
+module Int = struct
+ type t = int
+
+ include Int_base
+
+ let rec zero_to_n n =
+ if n < 0 then Set.empty else Set.add n (zero_to_n (n-1))
+
+ let to_string n = Int.to_string n
+end
+
+module Int8 = struct
+ type t = int
+
+ let zero = 0
+ let one = 1
+
+ let of_int_exn i =
+ if i < -(1 lsl 7) || i > ((1 lsl 7) - 1) then
+ Misc.fatal_errorf "Int8.of_int_exn: %d is out of range" i
+ else
+ i
+
+ let to_int i = i
+end
+
+module Int16 = struct
+ type t = int
+
+ let of_int_exn i =
+ if i < -(1 lsl 15) || i > ((1 lsl 15) - 1) then
+ Misc.fatal_errorf "Int16.of_int_exn: %d is out of range" i
+ else
+ i
+
+ let lower_int64 = Int64.neg (Int64.shift_left Int64.one 15)
+ let upper_int64 = Int64.sub (Int64.shift_left Int64.one 15) Int64.one
+
+ let of_int64_exn i =
+ if Int64.compare i lower_int64 < 0
+ || Int64.compare i upper_int64 > 0
+ then
+ Misc.fatal_errorf "Int16.of_int64_exn: %Ld is out of range" i
+ else
+ Int64.to_int i
+
+ let to_int t = t
+end
+
+module Float = struct
+ type t = float
+
+ include Identifiable.Make (struct
+ type t = float
+
+ let compare x y = Stdlib.compare x y
+ let output oc x = Printf.fprintf oc "%f" x
+ let hash f = Hashtbl.hash f
+ let equal (i : float) j = i = j
+ let print = Format.pp_print_float
+ end)
+end
diff --git a/upstream/ocaml_503/utils/numbers.mli b/upstream/ocaml_503/utils/numbers.mli
new file mode 100644
index 0000000000..fa565e67e1
--- /dev/null
+++ b/upstream/ocaml_503/utils/numbers.mli
@@ -0,0 +1,51 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2013--2016 OCamlPro SAS *)
+(* Copyright 2014--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Modules about numbers, some of which satisfy {!Identifiable.S}.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module Int : sig
+ include Identifiable.S with type t = int
+
+ (** [zero_to_n n] is the set of numbers \{0, ..., n\} (inclusive). *)
+ val zero_to_n : int -> Set.t
+ val to_string : int -> string
+end
+
+module Int8 : sig
+ type t
+
+ val zero : t
+ val one : t
+
+ val of_int_exn : int -> t
+ val to_int : t -> int
+end
+
+module Int16 : sig
+ type t
+
+ val of_int_exn : int -> t
+ val of_int64_exn : Int64.t -> t
+
+ val to_int : t -> int
+end
+
+module Float : Identifiable.S with type t = float
diff --git a/upstream/ocaml_503/utils/profile.ml b/upstream/ocaml_503/utils/profile.ml
new file mode 100644
index 0000000000..27c92a5463
--- /dev/null
+++ b/upstream/ocaml_503/utils/profile.ml
@@ -0,0 +1,335 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* *)
+(* Copyright 2015 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. *)
+(* *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-18-40-42-48"]
+
+type file = string
+
+external time_include_children: bool -> float = "caml_sys_time_include_children"
+let cpu_time () = time_include_children true
+
+module Measure = struct
+ type t = {
+ time : float;
+ allocated_words : float;
+ top_heap_words : int;
+ }
+ let create () =
+ let stat = Gc.quick_stat () in
+ {
+ time = cpu_time ();
+ allocated_words = stat.minor_words +. stat.major_words;
+ top_heap_words = stat.top_heap_words;
+ }
+ let zero = { time = 0.; allocated_words = 0.; top_heap_words = 0 }
+end
+
+module Measure_diff = struct
+ let timestamp = let r = ref (-1) in fun () -> incr r; !r
+ type t = {
+ timestamp : int;
+ duration : float;
+ allocated_words : float;
+ top_heap_words_increase : int;
+ }
+ let zero () = {
+ timestamp = timestamp ();
+ duration = 0.;
+ allocated_words = 0.;
+ top_heap_words_increase = 0;
+ }
+ let accumulate t (m1 : Measure.t) (m2 : Measure.t) = {
+ timestamp = t.timestamp;
+ duration = t.duration +. (m2.time -. m1.time);
+ allocated_words =
+ t.allocated_words +. (m2.allocated_words -. m1.allocated_words);
+ top_heap_words_increase =
+ t.top_heap_words_increase + (m2.top_heap_words - m1.top_heap_words);
+ }
+ let of_diff m1 m2 =
+ accumulate (zero ()) m1 m2
+end
+
+type hierarchy =
+ | E of (string, Measure_diff.t * hierarchy) Hashtbl.t
+[@@unboxed]
+
+let create () = E (Hashtbl.create 2)
+let hierarchy = ref (create ())
+let initial_measure = ref None
+let reset () = hierarchy := create (); initial_measure := None
+
+let record_call ?(accumulate = false) name f =
+ let E prev_hierarchy = !hierarchy in
+ let start_measure = Measure.create () in
+ if !initial_measure = None then initial_measure := Some start_measure;
+ let this_measure_diff, this_table =
+ (* We allow the recording of multiple categories by the same name, for tools
+ like ocamldoc that use the compiler libs but don't care about profile
+ information, and so may record, say, "parsing" multiple times. *)
+ if accumulate
+ then
+ match Hashtbl.find prev_hierarchy name with
+ | exception Not_found -> Measure_diff.zero (), Hashtbl.create 2
+ | measure_diff, E table ->
+ Hashtbl.remove prev_hierarchy name;
+ measure_diff, table
+ else Measure_diff.zero (), Hashtbl.create 2
+ in
+ hierarchy := E this_table;
+ Misc.try_finally f
+ ~always:(fun () ->
+ hierarchy := E prev_hierarchy;
+ let end_measure = Measure.create () in
+ let measure_diff =
+ Measure_diff.accumulate this_measure_diff start_measure end_measure in
+ Hashtbl.add prev_hierarchy name (measure_diff, E this_table))
+
+let record ?accumulate pass f x = record_call ?accumulate pass (fun () -> f x)
+
+type display = {
+ to_string : max:float -> width:int -> string;
+ worth_displaying : max:float -> bool;
+}
+
+let time_display v : display =
+ (* Because indentation is meaningful, and because the durations are
+ the first element of each row, we can't pad them with spaces. *)
+ let to_string_without_unit v ~width = Printf.sprintf "%0*.03f" width v in
+ let to_string ~max:_ ~width =
+ to_string_without_unit v ~width:(width - 1) ^ "s" in
+ let worth_displaying ~max:_ =
+ float_of_string (to_string_without_unit v ~width:0) <> 0. in
+ { to_string; worth_displaying }
+
+let memory_word_display =
+ (* To make memory numbers easily comparable across rows, we choose a single
+ scale for an entire column. To keep the display compact and not overly
+ precise (no one cares about the exact number of bytes), we pick the largest
+ scale we can and we only show 3 digits. Avoiding showing tiny numbers also
+ allows us to avoid displaying passes that barely allocate compared to the
+ rest of the compiler. *)
+ let bytes_of_words words = words *. float_of_int (Sys.word_size / 8) in
+ let to_string_without_unit v ~width scale =
+ let precision = 3 and precision_power = 1e3 in
+ let v_rescaled = bytes_of_words v /. scale in
+ let v_rounded =
+ floor (v_rescaled *. precision_power +. 0.5) /. precision_power in
+ let v_str = Printf.sprintf "%.*f" precision v_rounded in
+ let index_of_dot = String.index v_str '.' in
+ let v_str_truncated =
+ String.sub v_str 0
+ (if index_of_dot >= precision
+ then index_of_dot
+ else precision + 1)
+ in
+ Printf.sprintf "%*s" width v_str_truncated
+ in
+ let choose_memory_scale =
+ let units = [|"B"; "kB"; "MB"; "GB"|] in
+ fun words ->
+ let bytes = bytes_of_words words in
+ let scale = ref (Array.length units - 1) in
+ while !scale > 0 && bytes < 1024. ** float_of_int !scale do
+ decr scale
+ done;
+ 1024. ** float_of_int !scale, units.(!scale)
+ in
+ fun ?previous v : display ->
+ let to_string ~max ~width =
+ let scale, scale_str = choose_memory_scale max in
+ let width = width - String.length scale_str in
+ to_string_without_unit v ~width scale ^ scale_str
+ in
+ let worth_displaying ~max =
+ let scale, _ = choose_memory_scale max in
+ float_of_string (to_string_without_unit v ~width:0 scale) <> 0.
+ && match previous with
+ | None -> true
+ | Some p ->
+ (* This branch is for numbers that represent absolute quantity, rather
+ than differences. It allows us to skip displaying the same absolute
+ quantity many times in a row. *)
+ to_string_without_unit p ~width:0 scale
+ <> to_string_without_unit v ~width:0 scale
+ in
+ { to_string; worth_displaying }
+
+let profile_list (E table) =
+ let l = Hashtbl.fold (fun k d l -> (k, d) :: l) table [] in
+ List.sort (fun (_, (p1, _)) (_, (p2, _)) ->
+ compare p1.Measure_diff.timestamp p2.Measure_diff.timestamp) l
+
+let compute_other_category (E table : hierarchy) (total : Measure_diff.t) =
+ let r = ref total in
+ Hashtbl.iter (fun _pass ((p2 : Measure_diff.t), _) ->
+ let p1 = !r in
+ r := {
+ timestamp = p1.timestamp;
+ duration = p1.duration -. p2.duration;
+ allocated_words = p1.allocated_words -. p2.allocated_words;
+ top_heap_words_increase =
+ p1.top_heap_words_increase - p2.top_heap_words_increase;
+ }
+ ) table;
+ !r
+
+type row = R of string * (float * display) list * row list
+type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ]
+
+let rec rows_of_hierarchy ~nesting make_row name measure_diff hierarchy env =
+ let rows =
+ rows_of_hierarchy_list
+ ~nesting:(nesting + 1) make_row hierarchy measure_diff env in
+ let values, env =
+ make_row env measure_diff ~toplevel_other:(nesting = 0 && name = "other") in
+ R (name, values, rows), env
+
+and rows_of_hierarchy_list ~nesting make_row hierarchy total env =
+ let list = profile_list hierarchy in
+ let list =
+ if list <> [] || nesting = 0
+ then list @ [ "other", (compute_other_category hierarchy total, create ()) ]
+ else []
+ in
+ let env = ref env in
+ List.map (fun (name, (measure_diff, hierarchy)) ->
+ let a, env' =
+ rows_of_hierarchy ~nesting make_row name measure_diff hierarchy !env in
+ env := env';
+ a
+ ) list
+
+let rows_of_hierarchy hierarchy measure_diff initial_measure columns =
+ (* Computing top heap size is a bit complicated: if the compiler applies a
+ list of passes n times (rather than applying pass1 n times, then pass2 n
+ times etc), we only show one row for that pass but what does "top heap
+ size at the end of that pass" even mean?
+ It seems the only sensible answer is to pretend the compiler applied pass1
+ n times, pass2 n times by accumulating all the heap size increases that
+ happened during each pass, and then compute what the heap size would have
+ been. So that's what we do.
+ There's a bit of extra complication, which is that the heap can increase in
+ between measurements. So the heap sizes can be a bit off until the "other"
+ rows account for what's missing. We special case the toplevel "other" row
+ so that any increases that happened before the start of the compilation is
+ correctly reported, as a lot of code may run before the start of the
+ compilation (eg functor applications). *)
+ let make_row prev_top_heap_words (p : Measure_diff.t) ~toplevel_other =
+ let top_heap_words =
+ prev_top_heap_words
+ + p.top_heap_words_increase
+ - if toplevel_other
+ then initial_measure.Measure.top_heap_words
+ else 0
+ in
+ let make value ~f = value, f value in
+ List.map (function
+ | `Time ->
+ make p.duration ~f:time_display
+ | `Alloc ->
+ make p.allocated_words ~f:memory_word_display
+ | `Top_heap ->
+ make (float_of_int p.top_heap_words_increase) ~f:memory_word_display
+ | `Abs_top_heap ->
+ make (float_of_int top_heap_words)
+ ~f:(memory_word_display ~previous:(float_of_int prev_top_heap_words))
+ ) columns,
+ top_heap_words
+ in
+ rows_of_hierarchy_list ~nesting:0 make_row hierarchy measure_diff
+ initial_measure.top_heap_words
+
+let max_by_column ~n_columns rows =
+ let a = Array.make n_columns 0. in
+ let rec loop (R (_, values, rows)) =
+ List.iteri (fun i (v, _) -> a.(i) <- Float.max a.(i) v) values;
+ List.iter loop rows
+ in
+ List.iter loop rows;
+ a
+
+let width_by_column ~n_columns ~display_cell rows =
+ let a = Array.make n_columns 1 in
+ let rec loop (R (_, values, rows)) =
+ List.iteri (fun i cell ->
+ let _, str = display_cell i cell ~width:0 in
+ a.(i) <- Int.max a.(i) (String.length str)
+ ) values;
+ List.iter loop rows;
+ in
+ List.iter loop rows;
+ a
+
+let display_rows ppf rows =
+ let n_columns =
+ match rows with
+ | [] -> 0
+ | R (_, values, _) :: _ -> List.length values
+ in
+ let maxs = max_by_column ~n_columns rows in
+ let display_cell i (_, c) ~width =
+ let display_cell = c.worth_displaying ~max:maxs.(i) in
+ display_cell, if display_cell
+ then c.to_string ~max:maxs.(i) ~width
+ else String.make width '-'
+ in
+ let widths = width_by_column ~n_columns ~display_cell rows in
+ let rec loop (R (name, values, rows)) ~indentation =
+ let worth_displaying, cell_strings =
+ values
+ |> List.mapi (fun i cell -> display_cell i cell ~width:widths.(i))
+ |> List.split
+ in
+ if List.exists (fun b -> b) worth_displaying then
+ Format.fprintf ppf "%s%s %s@\n"
+ indentation (String.concat " " cell_strings) name;
+ List.iter (loop ~indentation:(" " ^ indentation)) rows;
+ in
+ List.iter (loop ~indentation:"") rows
+
+let print ppf columns =
+ match columns with
+ | [] -> ()
+ | _ :: _ ->
+ let initial_measure =
+ match !initial_measure with
+ | Some v -> v
+ | None -> Measure.zero
+ in
+ let total = Measure_diff.of_diff Measure.zero (Measure.create ()) in
+ display_rows ppf
+ (rows_of_hierarchy !hierarchy total initial_measure columns)
+
+let column_mapping = [
+ "time", `Time;
+ "alloc", `Alloc;
+ "top-heap", `Top_heap;
+ "absolute-top-heap", `Abs_top_heap;
+]
+
+let column_names = List.map fst column_mapping
+
+let options_doc =
+ Printf.sprintf
+ " Print performance information for each pass\
+ \n The columns are: %s."
+ (String.concat " " column_names)
+
+let all_columns = List.map snd column_mapping
+
+let generate = "generate"
+let transl = "transl"
+let typing = "typing"
diff --git a/upstream/ocaml_503/utils/profile.mli b/upstream/ocaml_503/utils/profile.mli
new file mode 100644
index 0000000000..7eff6957b6
--- /dev/null
+++ b/upstream/ocaml_503/utils/profile.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* *)
+(* Copyright 2015 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. *)
+(* *)
+(**************************************************************************)
+
+(** Compiler performance recording
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type file = string
+
+val reset : unit -> unit
+(** erase all recorded profile information *)
+
+val record_call : ?accumulate:bool -> string -> (unit -> 'a) -> 'a
+(** [record_call pass f] calls [f] and records its profile information. *)
+
+val record : ?accumulate:bool -> string -> ('a -> 'b) -> 'a -> 'b
+(** [record pass f arg] records the profile information of [f arg] *)
+
+type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ]
+
+val print : Format.formatter -> column list -> unit
+(** Prints the selected recorded profiling information to the formatter. *)
+
+(** Command line flags *)
+
+val options_doc : string
+val all_columns : column list
+
+(** A few pass names that are needed in several places, and shared to
+ avoid typos. *)
+
+val generate : string
+val transl : string
+val typing : string
diff --git a/upstream/ocaml_503/utils/strongly_connected_components.ml b/upstream/ocaml_503/utils/strongly_connected_components.ml
new file mode 100644
index 0000000000..eb1501ca7c
--- /dev/null
+++ b/upstream/ocaml_503/utils/strongly_connected_components.ml
@@ -0,0 +1,195 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2013--2016 OCamlPro SAS *)
+(* Copyright 2014--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+module Int = Numbers.Int
+
+module Kosaraju : sig
+ type component_graph =
+ { sorted_connected_components : int list array;
+ component_edges : int list array;
+ }
+
+ val component_graph : int list array -> component_graph
+end = struct
+ let transpose graph =
+ let size = Array.length graph in
+ let transposed = Array.make size [] in
+ let add src dst = transposed.(src) <- dst :: transposed.(src) in
+ Array.iteri (fun src dsts -> List.iter (fun dst -> add dst src) dsts)
+ graph;
+ transposed
+
+ let depth_first_order (graph : int list array) : int array =
+ let size = Array.length graph in
+ let marked = Array.make size false in
+ let stack = Array.make size ~-1 in
+ let pos = ref 0 in
+ let push i =
+ stack.(!pos) <- i;
+ incr pos
+ in
+ let rec aux node =
+ if not marked.(node)
+ then begin
+ marked.(node) <- true;
+ List.iter aux graph.(node);
+ push node
+ end
+ in
+ for i = 0 to size - 1 do
+ aux i
+ done;
+ stack
+
+ let mark order graph =
+ let size = Array.length graph in
+ let graph = transpose graph in
+ let marked = Array.make size false in
+ let id = Array.make size ~-1 in
+ let count = ref 0 in
+ let rec aux node =
+ if not marked.(node)
+ then begin
+ marked.(node) <- true;
+ id.(node) <- !count;
+ List.iter aux graph.(node)
+ end
+ in
+ for i = size - 1 downto 0 do
+ let node = order.(i) in
+ if not marked.(node)
+ then begin
+ aux order.(i);
+ incr count
+ end
+ done;
+ id, !count
+
+ let kosaraju graph =
+ let dfo = depth_first_order graph in
+ let components, ncomponents = mark dfo graph in
+ ncomponents, components
+
+ type component_graph =
+ { sorted_connected_components : int list array;
+ component_edges : int list array;
+ }
+
+ let component_graph graph =
+ let ncomponents, components = kosaraju graph in
+ let id_scc = Array.make ncomponents [] in
+ let component_graph = Array.make ncomponents Int.Set.empty in
+ let add_component_dep node set =
+ let node_deps = graph.(node) in
+ List.fold_left (fun set dep -> Int.Set.add components.(dep) set)
+ set node_deps
+ in
+ Array.iteri (fun node component ->
+ id_scc.(component) <- node :: id_scc.(component);
+ component_graph.(component) <-
+ add_component_dep node (component_graph.(component)))
+ components;
+ { sorted_connected_components = id_scc;
+ component_edges = Array.map Int.Set.elements component_graph;
+ }
+end
+
+module type S = sig
+ module Id : Identifiable.S
+
+ type directed_graph = Id.Set.t Id.Map.t
+
+ type component =
+ | Has_loop of Id.t list
+ | No_loop of Id.t
+
+ val connected_components_sorted_from_roots_to_leaf
+ : directed_graph
+ -> component array
+
+ val component_graph : directed_graph -> (component * int list) array
+end
+
+module Make (Id : Identifiable.S) = struct
+ type directed_graph = Id.Set.t Id.Map.t
+
+ type component =
+ | Has_loop of Id.t list
+ | No_loop of Id.t
+
+ (* Ensure that the dependency graph does not have external dependencies. *)
+ (* Note: this function is currently not used. *)
+ let _check dependencies =
+ Id.Map.iter (fun id set ->
+ Id.Set.iter (fun v ->
+ if not (Id.Map.mem v dependencies)
+ then
+ Misc.fatal_errorf "Strongly_connected_components.check: the \
+ graph has external dependencies (%a -> %a)"
+ Id.print id Id.print v)
+ set)
+ dependencies
+
+ let number graph =
+ let size = Id.Map.cardinal graph in
+ let bindings = Id.Map.bindings graph in
+ let a = Array.of_list bindings in
+ let forth = Array.map fst a in
+ let back =
+ let back = ref Id.Map.empty in
+ for i = 0 to size - 1 do
+ back := Id.Map.add forth.(i) i !back;
+ done;
+ !back
+ in
+ let integer_graph =
+ Array.init size (fun i ->
+ let _, dests = a.(i) in
+ Id.Set.fold (fun dest acc ->
+ let v =
+ try Id.Map.find dest back
+ with Not_found ->
+ Misc.fatal_errorf
+ "Strongly_connected_components: missing dependency %a"
+ Id.print dest
+ in
+ v :: acc)
+ dests [])
+ in
+ forth, integer_graph
+
+ let component_graph graph =
+ let forth, integer_graph = number graph in
+ let { Kosaraju. sorted_connected_components;
+ component_edges } =
+ Kosaraju.component_graph integer_graph
+ in
+ Array.mapi (fun component nodes ->
+ match nodes with
+ | [] -> assert false
+ | [node] ->
+ (if List.mem node integer_graph.(node)
+ then Has_loop [forth.(node)]
+ else No_loop forth.(node)),
+ component_edges.(component)
+ | _::_ ->
+ (Has_loop (List.map (fun node -> forth.(node)) nodes)),
+ component_edges.(component))
+ sorted_connected_components
+
+ let connected_components_sorted_from_roots_to_leaf graph =
+ Array.map fst (component_graph graph)
+end
diff --git a/upstream/ocaml_503/utils/strongly_connected_components.mli b/upstream/ocaml_503/utils/strongly_connected_components.mli
new file mode 100644
index 0000000000..e700952792
--- /dev/null
+++ b/upstream/ocaml_503/utils/strongly_connected_components.mli
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Chambart, OCamlPro *)
+(* Mark Shinwell and Leo White, Jane Street Europe *)
+(* *)
+(* Copyright 2013--2016 OCamlPro SAS *)
+(* Copyright 2014--2016 Jane Street Group LLC *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Kosaraju's algorithm for strongly connected components.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module type S = sig
+ module Id : Identifiable.S
+
+ type directed_graph = Id.Set.t Id.Map.t
+ (** If (a -> set) belongs to the map, it means that there are edges
+ from [a] to every element of [set]. It is assumed that no edge
+ points to a vertex not represented in the map. *)
+
+ type component =
+ | Has_loop of Id.t list
+ | No_loop of Id.t
+
+ val connected_components_sorted_from_roots_to_leaf
+ : directed_graph
+ -> component array
+
+ val component_graph : directed_graph -> (component * int list) array
+end
+
+module Make (Id : Identifiable.S) : S with module Id := Id
diff --git a/upstream/ocaml_503/utils/targetint.ml b/upstream/ocaml_503/utils/targetint.ml
new file mode 100644
index 0000000000..9d15a2ff56
--- /dev/null
+++ b/upstream/ocaml_503/utils/targetint.ml
@@ -0,0 +1,104 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2016 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. *)
+(* *)
+(**************************************************************************)
+
+type repr =
+ | Int32 of int32
+ | Int64 of int64
+
+module type S = sig
+ type t
+ val zero : t
+ val one : t
+ val minus_one : t
+ val neg : t -> t
+ val add : t -> t -> t
+ val sub : t -> t -> t
+ val mul : t -> t -> t
+ val div : t -> t -> t
+ val unsigned_div : t -> t -> t
+ val rem : t -> t -> t
+ val unsigned_rem : t -> t -> t
+ val succ : t -> t
+ val pred : t -> t
+ val abs : t -> t
+ val max_int : t
+ val min_int : t
+ val logand : t -> t -> t
+ val logor : t -> t -> t
+ val logxor : t -> t -> t
+ val lognot : t -> t
+ val shift_left : t -> int -> t
+ val shift_right : t -> int -> t
+ val shift_right_logical : t -> int -> t
+ val of_int : int -> t
+ val of_int_exn : int -> t
+ val to_int : t -> int
+ val of_float : float -> t
+ val to_float : t -> float
+ val of_int32 : int32 -> t
+ val to_int32 : t -> int32
+ val of_int64 : int64 -> t
+ val to_int64 : t -> int64
+ val of_string : string -> t
+ val to_string : t -> string
+ val compare: t -> t -> int
+ val unsigned_compare : t -> t -> int
+ val equal: t -> t -> bool
+ val repr: t -> repr
+ val print : Format.formatter -> t -> unit
+end
+
+let size = Sys.word_size
+(* Later, this will be set by the configure script
+ in order to support cross-compilation. *)
+
+module Int32 = struct
+ include Int32
+ let of_int_exn =
+ match Sys.word_size with (* size of [int] *)
+ | 32 ->
+ Int32.of_int
+ | 64 ->
+ fun n ->
+ if n < Int32.(to_int min_int) || n > Int32.(to_int max_int) then
+ Misc.fatal_errorf "Targetint.of_int_exn: 0x%x out of range" n
+ else
+ Int32.of_int n
+ | _ ->
+ assert false
+ let of_int32 x = x
+ let to_int32 x = x
+ let of_int64 = Int64.to_int32
+ let to_int64 = Int64.of_int32
+ let repr x = Int32 x
+ let print ppf t = Format.fprintf ppf "%ld" t
+end
+
+module Int64 = struct
+ include Int64
+ let of_int_exn = Int64.of_int
+ let of_int64 x = x
+ let to_int64 x = x
+ let repr x = Int64 x
+ let print ppf t = Format.fprintf ppf "%Ld" t
+end
+
+include (val
+ (match size with
+ | 32 -> (module Int32)
+ | 64 -> (module Int64)
+ | _ -> assert false
+ ) : S)
diff --git a/upstream/ocaml_503/utils/targetint.mli b/upstream/ocaml_503/utils/targetint.mli
new file mode 100644
index 0000000000..a222f5d68c
--- /dev/null
+++ b/upstream/ocaml_503/utils/targetint.mli
@@ -0,0 +1,208 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2016 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. *)
+(* *)
+(**************************************************************************)
+
+(** Target processor-native integers.
+
+ This module provides operations on the type of
+ signed 32-bit integers (on 32-bit target platforms) or
+ signed 64-bit integers (on 64-bit target platforms).
+ This integer type has exactly the same width as that of a
+ pointer type in the C compiler. All arithmetic operations over
+ are taken modulo 2{^32} or 2{^64} depending
+ on the word size of the target architecture.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type t
+(** The type of target integers. *)
+
+val zero : t
+(** The target integer 0.*)
+
+val one : t
+(** The target integer 1.*)
+
+val minus_one : t
+(** The target integer -1.*)
+
+val neg : t -> t
+(** Unary negation. *)
+
+val add : t -> t -> t
+(** Addition. *)
+
+val sub : t -> t -> t
+(** Subtraction. *)
+
+val mul : t -> t -> t
+(** Multiplication. *)
+
+val div : t -> t -> t
+(** Integer division. Raise [Division_by_zero] if the second
+ argument is zero. This division rounds the real quotient of
+ its arguments towards zero, as specified for {!Stdlib.(/)}. *)
+
+val unsigned_div : t -> t -> t
+(** Same as {!div}, except that arguments and result are interpreted as {e
+ unsigned} integers. *)
+
+val rem : t -> t -> t
+(** Integer remainder. If [y] is not zero, the result
+ of [Targetint.rem x y] satisfies the following properties:
+ [Targetint.zero <= Nativeint.rem x y < Targetint.abs y] and
+ [x = Targetint.add (Targetint.mul (Targetint.div x y) y)
+ (Targetint.rem x y)].
+ If [y = 0], [Targetint.rem x y] raises [Division_by_zero]. *)
+
+val unsigned_rem : t -> t -> t
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+ unsigned} integers. *)
+
+val succ : t -> t
+(** Successor.
+ [Targetint.succ x] is [Targetint.add x Targetint.one]. *)
+
+val pred : t -> t
+(** Predecessor.
+ [Targetint.pred x] is [Targetint.sub x Targetint.one]. *)
+
+val abs : t -> t
+(** [abs x] is the absolute value of [x]. On [min_int] this
+ is [min_int] itself and thus remains negative. *)
+
+val size : int
+(** The size in bits of a target native integer. *)
+
+val max_int : t
+(** The greatest representable target integer,
+ either 2{^31} - 1 on a 32-bit platform,
+ or 2{^63} - 1 on a 64-bit platform. *)
+
+val min_int : t
+(** The smallest representable target integer,
+ either -2{^31} on a 32-bit platform,
+ or -2{^63} on a 64-bit platform. *)
+
+val logand : t -> t -> t
+(** Bitwise logical and. *)
+
+val logor : t -> t -> t
+(** Bitwise logical or. *)
+
+val logxor : t -> t -> t
+(** Bitwise logical exclusive or. *)
+
+val lognot : t -> t
+(** Bitwise logical negation. *)
+
+val shift_left : t -> int -> t
+(** [Targetint.shift_left x y] shifts [x] to the left by [y] bits.
+ The result is unspecified if [y < 0] or [y >= bitsize],
+ where [bitsize] is [32] on a 32-bit platform and
+ [64] on a 64-bit platform. *)
+
+val shift_right : t -> int -> t
+(** [Targetint.shift_right x y] shifts [x] to the right by [y] bits.
+ This is an arithmetic shift: the sign bit of [x] is replicated
+ and inserted in the vacated bits.
+ The result is unspecified if [y < 0] or [y >= bitsize]. *)
+
+val shift_right_logical : t -> int -> t
+(** [Targetint.shift_right_logical x y] shifts [x] to the right
+ by [y] bits.
+ This is a logical shift: zeroes are inserted in the vacated bits
+ regardless of the sign of [x].
+ The result is unspecified if [y < 0] or [y >= bitsize]. *)
+
+val of_int : int -> t
+(** Convert the given integer (type [int]) to a target integer
+ (type [t]), module the target word size. *)
+
+val of_int_exn : int -> t
+(** Convert the given integer (type [int]) to a target integer
+ (type [t]). Raises a fatal error if the conversion is not exact. *)
+
+val to_int : t -> int
+(** Convert the given target integer (type [t]) to an
+ integer (type [int]). The high-order bit is lost during
+ the conversion. *)
+
+val of_float : float -> t
+(** Convert the given floating-point number to a target integer,
+ discarding the fractional part (truncate towards 0).
+ The result of the conversion is undefined if, after truncation,
+ the number is outside the range
+ \[{!Targetint.min_int}, {!Targetint.max_int}\]. *)
+
+val to_float : t -> float
+(** Convert the given target integer to a floating-point number. *)
+
+val of_int32 : int32 -> t
+(** Convert the given 32-bit integer (type [int32])
+ to a target integer. *)
+
+val to_int32 : t -> int32
+(** Convert the given target integer to a
+ 32-bit integer (type [int32]). On 64-bit platforms,
+ the 64-bit native integer is taken modulo 2{^32},
+ i.e. the top 32 bits are lost. On 32-bit platforms,
+ the conversion is exact. *)
+
+val of_int64 : int64 -> t
+(** Convert the given 64-bit integer (type [int64])
+ to a target integer. *)
+
+val to_int64 : t -> int64
+(** Convert the given target integer to a
+ 64-bit integer (type [int64]). *)
+
+val of_string : string -> t
+(** Convert the given string to a target integer.
+ The string is read in decimal (by default) or in hexadecimal,
+ octal or binary if the string begins with [0x], [0o] or [0b]
+ respectively.
+ Raise [Failure "int_of_string"] if the given string is not
+ a valid representation of an integer, or if the integer represented
+ exceeds the range of integers representable in type [nativeint]. *)
+
+val to_string : t -> string
+(** Return the string representation of its argument, in decimal. *)
+
+val compare: t -> t -> int
+(** The comparison function for target integers, with the same specification as
+ {!Stdlib.compare}. Along with the type [t], this function [compare]
+ allows the module [Targetint] to be passed as argument to the functors
+ {!Set.Make} and {!Map.Make}. *)
+
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+ integers. *)
+
+val equal: t -> t -> bool
+(** The equal function for target ints. *)
+
+type repr =
+ | Int32 of int32
+ | Int64 of int64
+
+val repr : t -> repr
+(** The concrete representation of a native integer. *)
+
+val print : Format.formatter -> t -> unit
+(** Print a target integer to a formatter. *)
diff --git a/upstream/ocaml_503/utils/terminfo.ml b/upstream/ocaml_503/utils/terminfo.ml
new file mode 100644
index 0000000000..1b4a3578eb
--- /dev/null
+++ b/upstream/ocaml_503/utils/terminfo.ml
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Gallium, INRIA Paris *)
+(* *)
+(* Copyright 2017 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. *)
+(* *)
+(**************************************************************************)
+
+open Printf
+
+external isatty : out_channel -> bool = "caml_sys_isatty"
+external terminfo_rows: out_channel -> int = "caml_terminfo_rows"
+
+type status =
+ | Uninitialised
+ | Bad_term
+ | Good_term
+
+let setup oc =
+ let term = try Sys.getenv "TERM" with Not_found -> "" in
+ (* Same heuristics as in Misc.Color.should_enable_color *)
+ if term <> "" && term <> "dumb" && isatty oc
+ then Good_term
+ else Bad_term
+
+let num_lines oc =
+ let rows = terminfo_rows oc in
+ if rows > 0 then rows else 24
+ (* 24 is a reasonable default for an ANSI-style terminal *)
+
+let backup oc n =
+ if n >= 1 then fprintf oc "\027[%dA%!" n
+
+let resume oc n =
+ if n >= 1 then fprintf oc "\027[%dB%!" n
+
+let standout oc b =
+ output_string oc (if b then "\027[4m" else "\027[0m"); flush oc
diff --git a/upstream/ocaml_503/utils/terminfo.mli b/upstream/ocaml_503/utils/terminfo.mli
new file mode 100644
index 0000000000..10f5f5453f
--- /dev/null
+++ b/upstream/ocaml_503/utils/terminfo.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** Basic interface to the terminfo database
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type status =
+ | Uninitialised
+ | Bad_term
+ | Good_term
+
+val setup : out_channel -> status
+val num_lines : out_channel -> int
+val backup : out_channel -> int -> unit
+val standout : out_channel -> bool -> unit
+val resume : out_channel -> int -> unit
diff --git a/upstream/ocaml_503/utils/warnings.ml b/upstream/ocaml_503/utils/warnings.ml
new file mode 100644
index 0000000000..d9670caf49
--- /dev/null
+++ b/upstream/ocaml_503/utils/warnings.ml
@@ -0,0 +1,1259 @@
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* When you change this, you need to update:
+ - the list 'description' at the bottom of this file
+ - man/ocamlc.m
+*)
+
+type loc = {
+ loc_start: Lexing.position;
+ loc_end: Lexing.position;
+ loc_ghost: bool;
+}
+
+type field_usage_warning =
+ | Unused
+ | Not_read
+ | Not_mutated
+
+type constructor_usage_warning =
+ | Unused
+ | Not_constructed
+ | Only_exported_private
+
+type t =
+ | Comment_start (* 1 *)
+ | Comment_not_end (* 2 *)
+(*| Deprecated --> alert "deprecated" *) (* 3 *)
+ | Fragile_match of string (* 4 *)
+ | Ignored_partial_application (* 5 *)
+ | Labels_omitted of string list (* 6 *)
+ | Method_override of string list (* 7 *)
+ | Partial_match of string (* 8 *)
+ | Missing_record_field_pattern of string (* 9 *)
+ | Non_unit_statement (* 10 *)
+ | Redundant_case (* 11 *)
+ | Redundant_subpat (* 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 Format_doc.t (* 18 *)
+ | Non_principal_labels of string (* 19 *)
+ | Ignored_extra_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 *)
+ (* [Module_linked_twice of string * string * string] (* 31 *)
+ was turned into a hard error *)
+ | 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 * constructor_usage_warning (* 37 *)
+ | Unused_extension of string * bool * constructor_usage_warning (* 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 *)
+ | Unexpected_docstring of bool (* 50 *)
+ | Wrong_tailcall_expectation of bool (* 51 *)
+ | Fragile_literal_pattern (* 52 *)
+ | Misplaced_attribute of string (* 53 *)
+ | Duplicated_attribute of string (* 54 *)
+ | Inlining_impossible of string (* 55 *)
+ | Unreachable_case (* 56 *)
+ | Ambiguous_var_in_pattern_guard of string list (* 57 *)
+ | No_cmx_file of string (* 58 *)
+ | Flambda_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_array_syntax_without_parsing (* 64 *)
+ | Redefining_unit of string (* 65 *)
+ | Unused_open_bang of string (* 66 *)
+ | Unused_functor_parameter of string (* 67 *)
+ | Match_on_mutable_state_prevent_uncurry (* 68 *)
+ | Unused_field of string * field_usage_warning (* 69 *)
+ | Missing_mli (* 70 *)
+ | Unused_tmc_attribute (* 71 *)
+ | Tmc_breaks_tailcall (* 72 *)
+ | Generative_application_expects_unit (* 73 *)
+ | Degraded_to_partial_match (* 74 *)
+
+(* If you remove a warning, leave a hole in the numbering. NEVER change
+ the numbers of existing warnings.
+ If you add a new warning, add it at the end with a new number;
+ do NOT reuse one of the holes.
+*)
+
+type alert = {kind:string; message:string; def:loc; use:loc}
+
+let number = function
+ | Comment_start -> 1
+ | Comment_not_end -> 2
+ | Fragile_match _ -> 4
+ | Ignored_partial_application -> 5
+ | Labels_omitted _ -> 6
+ | Method_override _ -> 7
+ | Partial_match _ -> 8
+ | Missing_record_field_pattern _ -> 9
+ | Non_unit_statement -> 10
+ | Redundant_case -> 11
+ | Redundant_subpat -> 12
+ | Instance_variable_override _ -> 13
+ | Illegal_backslash -> 14
+ | Implicit_public_methods _ -> 15
+ | Unerasable_optional_argument -> 16
+ | Undeclared_virtual_method _ -> 17
+ | Not_principal _ -> 18
+ | Non_principal_labels _ -> 19
+ | Ignored_extra_argument -> 20
+ | Nonreturning_statement -> 21
+ | Preprocessor _ -> 22
+ | Useless_record_with -> 23
+ | Bad_module_name _ -> 24
+ | All_clauses_guarded -> 8 (* used to be 25 *)
+ | Unused_var _ -> 26
+ | Unused_var_strict _ -> 27
+ | Wildcard_arg_to_constant_constr -> 28
+ | Eol_in_string -> 29
+ | Duplicate_definitions _ -> 30
+ | Unused_value_declaration _ -> 32
+ | Unused_open _ -> 33
+ | Unused_type_declaration _ -> 34
+ | Unused_for_index _ -> 35
+ | Unused_ancestor _ -> 36
+ | Unused_constructor _ -> 37
+ | Unused_extension _ -> 38
+ | Unused_rec_flag -> 39
+ | Name_out_of_scope _ -> 40
+ | Ambiguous_name _ -> 41
+ | Disambiguated_name _ -> 42
+ | Nonoptional_label _ -> 43
+ | Open_shadow_identifier _ -> 44
+ | Open_shadow_label_constructor _ -> 45
+ | Bad_env_variable _ -> 46
+ | Attribute_payload _ -> 47
+ | Eliminated_optional_arguments _ -> 48
+ | No_cmi_file _ -> 49
+ | Unexpected_docstring _ -> 50
+ | Wrong_tailcall_expectation _ -> 51
+ | Fragile_literal_pattern -> 52
+ | Misplaced_attribute _ -> 53
+ | Duplicated_attribute _ -> 54
+ | Inlining_impossible _ -> 55
+ | Unreachable_case -> 56
+ | Ambiguous_var_in_pattern_guard _ -> 57
+ | No_cmx_file _ -> 58
+ | Flambda_assignment_to_non_mutable_value -> 59
+ | Unused_module _ -> 60
+ | Unboxable_type_in_prim_decl _ -> 61
+ | Constraint_on_gadt -> 62
+ | Erroneous_printed_signature _ -> 63
+ | Unsafe_array_syntax_without_parsing -> 64
+ | Redefining_unit _ -> 65
+ | Unused_open_bang _ -> 66
+ | Unused_functor_parameter _ -> 67
+ | Match_on_mutable_state_prevent_uncurry -> 68
+ | Unused_field _ -> 69
+ | Missing_mli -> 70
+ | Unused_tmc_attribute -> 71
+ | Tmc_breaks_tailcall -> 72
+ | Generative_application_expects_unit -> 73
+ | Degraded_to_partial_match -> 74
+;;
+(* DO NOT REMOVE the ;; above: it is used by
+ the testsuite/ests/warnings/mnemonics.mll test to determine where
+ the definition of the number function above ends *)
+
+let last_warning_number = 74
+
+type description =
+ { number : int;
+ names : string list;
+ (* The first element of the list is the current name, any following ones are
+ deprecated. The current name should always be derived mechanically from
+ the constructor name. *)
+ description : string;
+ since : Sys.ocaml_release_info option;
+ (* The compiler version introducing this warning; only tagged for warnings
+ created after 3.12, which introduced the numbered syntax. *)
+ }
+
+let since major minor = Some { Sys.major; minor; patchlevel=0; extra=None }
+
+let descriptions = [
+ { number = 1;
+ names = ["comment-start"];
+ description = "Suspicious-looking start-of-comment mark.";
+ since = None };
+ { number = 2;
+ names = ["comment-not-end"];
+ description = "Suspicious-looking end-of-comment mark.";
+ since = None };
+ { number = 3;
+ names = [];
+ description = "Deprecated synonym for the 'deprecated' alert.";
+ since = None };
+ { number = 4;
+ names = ["fragile-match"];
+ description =
+ "Fragile pattern matching: matching that will remain complete even\n\
+ \ if additional constructors are added to one of the variant types\n\
+ \ matched.";
+ since = None };
+ { number = 5;
+ names = ["ignored-partial-application"];
+ description =
+ "Partially applied function: expression whose result has function\n\
+ \ type and is ignored.";
+ since = None };
+ { number = 6;
+ names = ["labels-omitted"];
+ description = "Label omitted in function application.";
+ since = None };
+ { number = 7;
+ names = ["method-override"];
+ description = "Method overridden.";
+ since = None };
+ { number = 8;
+ names = ["partial-match"];
+ description = "Partial match: missing cases in pattern-matching.";
+ since = None };
+ { number = 9;
+ names = ["missing-record-field-pattern"];
+ description = "Missing fields in a record pattern.";
+ since = None };
+ { number = 10;
+ names = ["non-unit-statement"];
+ description =
+ "Expression on the left-hand side of a sequence that doesn't have type\n\
+ \ \"unit\" (and that is not a function, see warning number 5).";
+ since = None };
+ { number = 11;
+ names = ["redundant-case"];
+ description =
+ "Redundant case in a pattern matching (unused match case).";
+ since = None };
+ { number = 12;
+ names = ["redundant-subpat"];
+ description = "Redundant sub-pattern in a pattern-matching." ;
+ since = None};
+ { number = 13;
+ names = ["instance-variable-override"];
+ description = "Instance variable overridden.";
+ since = None };
+ { number = 14;
+ names = ["illegal-backslash"];
+ description = "Illegal backslash escape in a string constant.";
+ since = None };
+ { number = 15;
+ names = ["implicit-public-methods"];
+ description = "Private method made public implicitly.";
+ since = None };
+ { number = 16;
+ names = ["unerasable-optional-argument"];
+ description = "Unerasable optional argument.";
+ since = None };
+ { number = 17;
+ names = ["undeclared-virtual-method"];
+ description = "Undeclared virtual method.";
+ since = None };
+ { number = 18;
+ names = ["not-principal"];
+ description = "Non-principal type.";
+ since = None };
+ { number = 19;
+ names = ["non-principal-labels"];
+ description = "Type without principality.";
+ since = None };
+ { number = 20;
+ names = ["ignored-extra-argument"];
+ description = "Unused function argument.";
+ since = None };
+ { number = 21;
+ names = ["nonreturning-statement"];
+ description = "Non-returning statement.";
+ since = None };
+ { number = 22;
+ names = ["preprocessor"];
+ description = "Preprocessor warning.";
+ since = None };
+ { number = 23;
+ names = ["useless-record-with"];
+ description = "Useless record \"with\" clause.";
+ since = None };
+ { number = 24;
+ names = ["bad-module-name"];
+ description =
+ "Bad module name: the source file name is not a valid OCaml module name.";
+ since = None };
+ { number = 25;
+ names = [];
+ description = "Ignored: now part of warning 8.";
+ since = None };
+ { number = 26;
+ names = ["unused-var"];
+ description =
+ "Suspicious unused variable: unused variable that is bound\n\
+ \ with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\
+ \ character.";
+ since = None };
+ { number = 27;
+ names = ["unused-var-strict"];
+ description =
+ "Innocuous unused variable: unused variable that is not bound with\n\
+ \ \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
+ \ character.";
+ since = None };
+ { number = 28;
+ names = ["wildcard-arg-to-constant-constr"];
+ description =
+ "Wildcard pattern given as argument to a constant constructor.";
+ since = None };
+ { number = 29;
+ names = ["eol-in-string"];
+ description =
+ "Unescaped end-of-line in a string constant (non-portable code).";
+ since = None };
+ { number = 30;
+ names = ["duplicate-definitions"];
+ description =
+ "Two labels or constructors of the same name are defined in two\n\
+ \ mutually recursive types.";
+ since = None };
+ { number = 31;
+ names = ["module-linked-twice"];
+ description =
+ "A module is linked twice in the same executable.\n\
+ \ Ignored: now a hard error (since 5.1).";
+ since = None };
+ { number = 32;
+ names = ["unused-value-declaration"];
+ description = "Unused value declaration.";
+ since = since 4 0 };
+ { number = 33;
+ names = ["unused-open"];
+ description = "Unused open statement.";
+ since = since 4 0 };
+ { number = 34;
+ names = ["unused-type-declaration"];
+ description = "Unused type declaration.";
+ since = since 4 0 };
+ { number = 35;
+ names = ["unused-for-index"];
+ description = "Unused for-loop index.";
+ since = since 4 0 };
+ { number = 36;
+ names = ["unused-ancestor"];
+ description = "Unused ancestor variable.";
+ since = since 4 0 };
+ { number = 37;
+ names = ["unused-constructor"];
+ description = "Unused constructor.";
+ since = since 4 0 };
+ { number = 38;
+ names = ["unused-extension"];
+ description = "Unused extension constructor.";
+ since = since 4 0 };
+ { number = 39;
+ names = ["unused-rec-flag"];
+ description = "Unused rec flag.";
+ since = since 4 0 };
+ { number = 40;
+ names = ["name-out-of-scope"];
+ description = "Constructor or label name used out of scope.";
+ since = since 4 1 };
+ { number = 41;
+ names = ["ambiguous-name"];
+ description = "Ambiguous constructor or label name.";
+ since = since 4 1 };
+ { number = 42;
+ names = ["disambiguated-name"];
+ description =
+ "Disambiguated constructor or label name (compatibility warning).";
+ since = since 4 1 };
+ { number = 43;
+ names = ["nonoptional-label"];
+ description = "Nonoptional label applied as optional.";
+ since = since 4 1 };
+ { number = 44;
+ names = ["open-shadow-identifier"];
+ description = "Open statement shadows an already defined identifier.";
+ since = since 4 1 };
+ { number = 45;
+ names = ["open-shadow-label-constructor"];
+ description =
+ "Open statement shadows an already defined label or constructor.";
+ since = since 4 1 };
+ { number = 46;
+ names = ["bad-env-variable"];
+ description = "Error in environment variable.";
+ since = since 4 1 };
+ { number = 47;
+ names = ["attribute-payload"];
+ description = "Illegal attribute payload.";
+ since = since 4 2 };
+ { number = 48;
+ names = ["eliminated-optional-arguments"];
+ description = "Implicit elimination of optional arguments.";
+ since = since 4 2 };
+ { number = 49;
+ names = ["no-cmi-file"];
+ description = "Absent cmi file when looking up module alias.";
+ since = since 4 2 };
+ { number = 50;
+ names = ["unexpected-docstring"];
+ description = "Unexpected documentation comment.";
+ since = since 4 3 };
+ { number = 51;
+ names = ["wrong-tailcall-expectation"];
+ description =
+ "Function call annotated with an incorrect @tailcall attribute.";
+ since = since 4 3 };
+ { number = 52;
+ names = ["fragile-literal-pattern"];
+ description = "Fragile constant pattern.";
+ since = since 4 3 };
+ { number = 53;
+ names = ["misplaced-attribute"];
+ description = "Attribute cannot appear in this context.";
+ since = since 4 3 };
+ { number = 54;
+ names = ["duplicated-attribute"];
+ description = "Attribute used more than once on an expression.";
+ since = since 4 3 };
+ { number = 55;
+ names = ["inlining-impossible"];
+ description = "Inlining impossible.";
+ since = since 4 3 };
+ { number = 56;
+ names = ["unreachable-case"];
+ description =
+ "Unreachable case in a pattern-matching (based on type information).";
+ since = since 4 3 };
+ { number = 57;
+ names = ["ambiguous-var-in-pattern-guard"];
+ description = "Ambiguous or-pattern variables under guard.";
+ since = since 4 3 };
+ { number = 58;
+ names = ["no-cmx-file"];
+ description = "Missing cmx file.";
+ since = since 4 3 };
+ { number = 59;
+ names = ["flambda-assignment-to-non-mutable-value"];
+ description = "Assignment to non-mutable value.";
+ since = since 4 3 };
+ { number = 60;
+ names = ["unused-module"];
+ description = "Unused module declaration.";
+ since = since 4 4 };
+ { number = 61;
+ names = ["unboxable-type-in-prim-decl"];
+ description = "Unboxable type in primitive declaration.";
+ since = since 4 4 };
+ { number = 62;
+ names = ["constraint-on-gadt"];
+ description = "Type constraint on GADT type declaration.";
+ since = since 4 6 };
+ { number = 63;
+ names = ["erroneous-printed-signature"];
+ description = "Erroneous printed signature.";
+ since = since 4 8 };
+ { number = 64;
+ names = ["unsafe-array-syntax-without-parsing"];
+ description =
+ "-unsafe used with a preprocessor returning a syntax tree.";
+ since = since 4 8 };
+ { number = 65;
+ names = ["redefining-unit"];
+ description = "Type declaration defining a new '()' constructor.";
+ since = since 4 8 };
+ { number = 66;
+ names = ["unused-open-bang"];
+ description = "Unused open! statement.";
+ since = since 4 8 };
+ { number = 67;
+ names = ["unused-functor-parameter"];
+ description = "Unused functor parameter.";
+ since = since 4 10 };
+ { number = 68;
+ names = ["match-on-mutable-state-prevent-uncurry"];
+ description =
+ "Pattern-matching depending on mutable state prevents the remaining \n\
+ \ arguments from being uncurried.";
+ since = since 4 12 };
+ { number = 69;
+ names = ["unused-field"];
+ description = "Unused record field.";
+ since = since 4 13 };
+ { number = 70;
+ names = ["missing-mli"];
+ description = "Missing interface file.";
+ since = since 4 13 };
+ { number = 71;
+ names = ["unused-tmc-attribute"];
+ description = "Unused @tail_mod_cons attribute.";
+ since = since 4 14 };
+ { number = 72;
+ names = ["tmc-breaks-tailcall"];
+ description = "A tail call is turned into a non-tail call \
+ by the @tail_mod_cons transformation.";
+ since = since 4 14 };
+ { number = 73;
+ names = ["generative-application-expects-unit"];
+ description = "A generative functor is applied to an empty structure \
+ (struct end) rather than to ().";
+ since = since 5 1 };
+ { number = 74;
+ names = ["degraded-to-partial-match"];
+ description = "A pattern-matching is compiled as partial \
+ even if it appears to be total.";
+ since = since 5 3 };
+]
+
+let name_to_number =
+ let h = Hashtbl.create last_warning_number in
+ List.iter (fun {number; names; _} ->
+ List.iter (fun name -> Hashtbl.add h name number) names
+ ) descriptions;
+ fun s -> Hashtbl.find_opt h s
+
+(* Must be the max number returned by the [number] function. *)
+
+let letter = function
+ | 'a' ->
+ let rec loop i = if i = 0 then [] else i :: loop (i - 1) in
+ loop last_warning_number
+ | 'b' -> []
+ | 'c' -> [1; 2]
+ | 'd' -> [3]
+ | 'e' -> [4]
+ | 'f' -> [5]
+ | 'g' -> []
+ | 'h' -> []
+ | 'i' -> []
+ | 'j' -> []
+ | 'k' -> [32; 33; 34; 35; 36; 37; 38; 39]
+ | 'l' -> [6]
+ | 'm' -> [7]
+ | 'n' -> []
+ | 'o' -> []
+ | 'p' -> [8]
+ | 'q' -> []
+ | 'r' -> [9]
+ | 's' -> [10]
+ | 't' -> []
+ | 'u' -> [11; 12]
+ | 'v' -> [13]
+ | 'w' -> []
+ | 'x' -> [14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 30]
+ | 'y' -> [26]
+ | 'z' -> [27]
+ | _ -> assert false
+
+type state =
+ {
+ active: bool array;
+ error: bool array;
+ alerts: (Misc.Stdlib.String.Set.t * bool); (* false:set complement *)
+ alert_errors: (Misc.Stdlib.String.Set.t * bool); (* false:set complement *)
+ }
+
+let current =
+ ref
+ {
+ active = Array.make (last_warning_number + 1) true;
+ error = Array.make (last_warning_number + 1) false;
+ alerts = (Misc.Stdlib.String.Set.empty, false);
+ alert_errors = (Misc.Stdlib.String.Set.empty, true); (* all soft *)
+ }
+
+let disabled = ref false
+
+let without_warnings f =
+ Misc.protect_refs [Misc.R(disabled, true)] f
+
+let backup () = !current
+
+let restore x = current := x
+
+let is_active x =
+ not !disabled && (!current).active.(number x)
+
+let is_error x =
+ not !disabled && (!current).error.(number x)
+
+let alert_is_active {kind; _} =
+ not !disabled &&
+ let (set, pos) = (!current).alerts in
+ Misc.Stdlib.String.Set.mem kind set = pos
+
+let alert_is_error {kind; _} =
+ not !disabled &&
+ let (set, pos) = (!current).alert_errors in
+ Misc.Stdlib.String.Set.mem kind set = pos
+
+let with_state state f =
+ let prev = backup () in
+ restore state;
+ try
+ let r = f () in
+ restore prev;
+ r
+ with exn ->
+ restore prev;
+ raise exn
+
+let mk_lazy f =
+ let state = backup () in
+ lazy (with_state state f)
+
+let set_alert ~error ~enable s =
+ let upd =
+ match s with
+ | "all" ->
+ (Misc.Stdlib.String.Set.empty, not enable)
+ | s ->
+ let (set, pos) =
+ if error then (!current).alert_errors else (!current).alerts
+ in
+ let f =
+ if enable = pos
+ then Misc.Stdlib.String.Set.add
+ else Misc.Stdlib.String.Set.remove
+ in
+ (f s set, pos)
+ in
+ if error then
+ current := {(!current) with alert_errors=upd}
+ else
+ current := {(!current) with alerts=upd}
+
+let parse_alert_option s =
+ let n = String.length s in
+ let id_char = function
+ | 'a'..'z' | 'A'..'Z' | '_' | '\'' | '0'..'9' -> true
+ | _ -> false
+ in
+ let rec parse_id i =
+ if i < n && id_char s.[i] then parse_id (i + 1) else i
+ in
+ let rec scan i =
+ if i = n then ()
+ else if i + 1 = n then raise (Arg.Bad "Ill-formed list of alert settings")
+ else match s.[i], s.[i+1] with
+ | '+', '+' -> id (set_alert ~error:true ~enable:true) (i + 2)
+ | '+', _ -> id (set_alert ~error:false ~enable:true) (i + 1)
+ | '-', '-' -> id (set_alert ~error:true ~enable:false) (i + 2)
+ | '-', _ -> id (set_alert ~error:false ~enable:false) (i + 1)
+ | '@', _ ->
+ id (fun s ->
+ set_alert ~error:true ~enable:true s;
+ set_alert ~error:false ~enable:true s)
+ (i + 1)
+ | _ -> raise (Arg.Bad "Ill-formed list of alert settings")
+ and id f i =
+ let j = parse_id i in
+ if j = i then raise (Arg.Bad "Ill-formed list of alert settings");
+ let id = String.sub s i (j - i) in
+ f id;
+ scan j
+ in
+ scan 0
+
+type modifier =
+ | Set (** +a *)
+ | Clear (** -a *)
+ | Set_all (** @a *)
+
+type token =
+ | Letter of char * modifier option
+ | Num of int * int * modifier
+
+let ghost_loc_in_file name =
+ let pos = { Lexing.dummy_pos with pos_fname = name } in
+ { loc_start = pos; loc_end = pos; loc_ghost = true }
+
+let letter_alert tokens =
+ let print_warning_char ppf c =
+ let lowercase = Char.lowercase_ascii c = c in
+ Format.fprintf ppf "%c%c"
+ (if lowercase then '-' else '+') c
+ in
+ let print_modifier ppf = function
+ | Set_all -> Format.fprintf ppf "@"
+ | Clear -> Format.fprintf ppf "-"
+ | Set -> Format.fprintf ppf "+"
+ in
+ let print_token ppf = function
+ | Num (a,b,m) -> if a = b then
+ Format.fprintf ppf "%a%d" print_modifier m a
+ else
+ Format.fprintf ppf "%a%d..%d" print_modifier m a b
+ | Letter(l,Some m) -> Format.fprintf ppf "%a%c" print_modifier m l
+ | Letter(l,None) -> print_warning_char ppf l
+ in
+ let consecutive_letters =
+ (* we are tracking sequences of 2 or more consecutive unsigned letters
+ in warning strings, for instance in '-w "not-principa"'. *)
+ let commit_chunk l = function
+ | [] | [ _ ] -> l
+ | _ :: _ :: _ as chunk -> List.rev chunk :: l
+ in
+ let group_consecutive_letters (l,current) = function
+ | Letter (x, None) -> (l, x::current)
+ | _ -> (commit_chunk l current, [])
+ in
+ let l, on_going =
+ List.fold_left group_consecutive_letters ([],[]) tokens
+ in
+ commit_chunk l on_going
+ in
+ match consecutive_letters with
+ | [] -> None
+ | example :: _ ->
+ let nowhere = ghost_loc_in_file "_none_" in
+ let spelling_hint ppf =
+ let max_seq_len =
+ List.fold_left (fun l x -> Int.max l (List.length x))
+ 0 consecutive_letters
+ in
+ if max_seq_len >= 5 then
+ Format.fprintf ppf
+ "@ @[Hint: Did you make a spelling mistake \
+ when using a mnemonic name?@]"
+ else
+ ()
+ in
+ let message =
+ Format.asprintf
+ "@[<v>@[Setting a warning with a sequence of lowercase \
+ or uppercase letters,@ like '%a',@ is deprecated.@]@ \
+ @[Use the equivalent signed form:@ %t.@]@ \
+ @[Hint: Enabling or disabling a warning by its mnemonic name \
+ requires a + or - prefix.@]\
+ %t@?@]"
+ Format.(pp_print_list ~pp_sep:(fun _ -> ignore) pp_print_char) example
+ (fun ppf -> List.iter (print_token ppf) tokens)
+ spelling_hint
+ in
+ Some {
+ kind="ocaml_deprecated_cli";
+ use=nowhere; def=nowhere;
+ message
+ }
+
+
+let parse_warnings s =
+ let error () = raise (Arg.Bad "Ill-formed list of warnings") in
+ let rec get_num n i =
+ if i >= String.length s then i, n
+ else match s.[i] with
+ | '0'..'9' -> get_num (10 * n + Char.code s.[i] - Char.code '0') (i + 1)
+ | _ -> i, n
+ in
+ let get_range i =
+ let i, n1 = get_num 0 i in
+ if i + 2 < String.length s && s.[i] = '.' && s.[i + 1] = '.' then
+ let i, n2 = get_num 0 (i + 2) in
+ if n2 < n1 then error ();
+ i, n1, n2
+ else
+ i, n1, n1
+ in
+ let rec loop tokens i =
+ if i >= String.length s then List.rev tokens else
+ match s.[i] with
+ | 'A' .. 'Z' | 'a' .. 'z' ->
+ loop (Letter(s.[i],None)::tokens) (i+1)
+ | '+' -> loop_letter_num tokens Set (i+1)
+ | '-' -> loop_letter_num tokens Clear (i+1)
+ | '@' -> loop_letter_num tokens Set_all (i+1)
+ | _ -> error ()
+ and loop_letter_num tokens modifier i =
+ if i >= String.length s then error () else
+ match s.[i] with
+ | '0' .. '9' ->
+ let i, n1, n2 = get_range i in
+ loop (Num(n1,n2,modifier)::tokens) i
+ | 'A' .. 'Z' | 'a' .. 'z' ->
+ loop (Letter(s.[i],Some modifier)::tokens) (i+1)
+ | _ -> error ()
+ in
+ loop [] 0
+
+let parse_opt error active errflag s =
+ let flags = if errflag then error else active in
+ let action modifier i = match modifier with
+ | Set ->
+ if i = 3 then set_alert ~error:errflag ~enable:true "deprecated"
+ else flags.(i) <- true
+ | Clear ->
+ if i = 3 then set_alert ~error:errflag ~enable:false "deprecated"
+ else flags.(i) <- false
+ | Set_all ->
+ if i = 3 then begin
+ set_alert ~error:false ~enable:true "deprecated";
+ set_alert ~error:true ~enable:true "deprecated"
+ end
+ else begin
+ active.(i) <- true;
+ error.(i) <- true
+ end
+ in
+ let eval = function
+ | Letter(c, m) ->
+ let lc = Char.lowercase_ascii c in
+ let modifier = match m with
+ | None -> if c = lc then Clear else Set
+ | Some m -> m
+ in
+ List.iter (action modifier) (letter lc)
+ | Num(n1,n2,modifier) ->
+ for n = n1 to Int.min n2 last_warning_number do action modifier n done
+ in
+ let parse_and_eval s =
+ let tokens = parse_warnings s in
+ List.iter eval tokens;
+ letter_alert tokens
+ in
+ match name_to_number s with
+ | Some n -> action Set n; None
+ | None ->
+ if s = "" then parse_and_eval s
+ else begin
+ let rest = String.sub s 1 (String.length s - 1) in
+ match s.[0], name_to_number rest with
+ | '+', Some n -> action Set n; None
+ | '-', Some n -> action Clear n; None
+ | '@', Some n -> action Set_all n; None
+ | _ -> parse_and_eval s
+ end
+
+let parse_options errflag s =
+ let error = Array.copy (!current).error in
+ let active = Array.copy (!current).active in
+ let alerts = parse_opt error active errflag s in
+ current := {(!current) with error; active};
+ alerts
+
+(* If you change these, don't forget to change them in man/ocamlc.m *)
+let defaults_w = "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70-74"
+let defaults_warn_error = "-a"
+let default_disabled_alerts = [ "unstable"; "unsynchronized_access" ]
+
+let () = ignore @@ parse_options false defaults_w
+let () = ignore @@ parse_options true defaults_warn_error
+let () =
+ List.iter (set_alert ~error:false ~enable:false) default_disabled_alerts
+
+let message = function
+ | Comment_start ->
+ "this `(*' is the start of a comment.\n\
+ Hint: Did you forget spaces when writing the infix operator `( * )'?"
+ | Comment_not_end -> "this is not the end of a comment."
+ | Fragile_match "" ->
+ "this pattern-matching is fragile."
+ | Fragile_match s ->
+ "this pattern-matching is fragile.\n\
+ It will remain exhaustive when constructors are added to type " ^ s ^ "."
+ | Ignored_partial_application ->
+ "this function application is partial,\n\
+ maybe some arguments are missing."
+ | Labels_omitted [] -> assert false
+ | Labels_omitted [l] ->
+ "label " ^ l ^ " was omitted in the application of this function."
+ | Labels_omitted ls ->
+ "labels " ^ String.concat ", " ls ^
+ " were omitted in the application of this function."
+ | Method_override [lab] ->
+ "the method " ^ lab ^ " is overridden."
+ | Method_override (cname :: slist) ->
+ String.concat " "
+ ("the following methods are overridden by the class"
+ :: cname :: ":\n " :: slist)
+ | Method_override [] -> assert false
+ | Partial_match "" -> "this pattern-matching is not exhaustive."
+ | Partial_match s ->
+ "this pattern-matching is not exhaustive.\n\
+ Here is an example of a case that is not matched:\n" ^ s
+ | Missing_record_field_pattern s ->
+ "the following labels are not bound in this record pattern:\n" ^ s ^
+ "\nEither bind these labels explicitly or add '; _' to the pattern."
+ | Non_unit_statement ->
+ "this expression should have type unit."
+ | Redundant_case -> "this match case is unused."
+ | Redundant_subpat -> "this sub-pattern is unused."
+ | Instance_variable_override [lab] ->
+ "the instance variable " ^ lab ^ " is overridden."
+ | Instance_variable_override (cname :: slist) ->
+ String.concat " "
+ ("the following instance variables are overridden by the class"
+ :: cname :: ":\n " :: slist)
+ | Instance_variable_override [] -> assert false
+ | Illegal_backslash ->
+ "illegal backslash escape in string.\n\
+ Hint: Single backslashes \\ are reserved for escape sequences\n\
+ (\\n, \\r, ...). Did you check the list of OCaml escape sequences?\n\
+ To get a backslash character, escape it with a second backslash: \\\\."
+ | Implicit_public_methods l ->
+ "the following private methods were made public implicitly:\n "
+ ^ String.concat " " l ^ "."
+ | Unerasable_optional_argument -> "this optional argument cannot be erased."
+ | Undeclared_virtual_method m -> "the virtual method "^m^" is not declared."
+ | Not_principal msg ->
+ Format_doc.asprintf "%a is not principal."
+ Format_doc.pp_doc msg
+ | Non_principal_labels s -> s^" without principality."
+ | Ignored_extra_argument -> "this argument will not be used by the function."
+ | Nonreturning_statement ->
+ "this statement never returns (or has an unsound type.)"
+ | Preprocessor s -> s
+ | Useless_record_with ->
+ "all the fields are explicitly listed in this record:\n\
+ the 'with' clause is useless."
+ | Bad_module_name (modname) ->
+ "bad source file name: \"" ^ modname ^ "\" is not a valid module name."
+ | All_clauses_guarded ->
+ "this pattern-matching is not exhaustive.\n\
+ All clauses in this pattern-matching are guarded."
+ | Unused_var v | Unused_var_strict v -> "unused variable " ^ v ^ "."
+ | Wildcard_arg_to_constant_constr ->
+ "wildcard pattern given as argument to a constant constructor"
+ | Eol_in_string ->
+ "unescaped end-of-line in a string constant\n\
+ (non-portable behavior before OCaml 5.2)"
+ | Duplicate_definitions (kind, cname, tc1, tc2) ->
+ Printf.sprintf "the %s %s is defined in both types %s and %s."
+ kind cname tc1 tc2
+ | Unused_value_declaration v -> "unused value " ^ v ^ "."
+ | Unused_open s -> "unused open " ^ s ^ "."
+ | Unused_open_bang s -> "unused open! " ^ s ^ "."
+ | Unused_type_declaration s -> "unused type " ^ s ^ "."
+ | Unused_for_index s -> "unused for-loop index " ^ s ^ "."
+ | Unused_ancestor s -> "unused ancestor variable " ^ s ^ "."
+ | Unused_constructor (s, Unused) -> "unused constructor " ^ s ^ "."
+ | Unused_constructor (s, Not_constructed) ->
+ "constructor " ^ s ^
+ " is never used to build values.\n\
+ (However, this constructor appears in patterns.)"
+ | Unused_constructor (s, Only_exported_private) ->
+ "constructor " ^ s ^
+ " is never used to build values.\n\
+ Its type is exported as a private type."
+ | Unused_extension (s, is_exception, complaint) ->
+ let kind =
+ if is_exception then "exception" else "extension constructor" in
+ let name = kind ^ " " ^ s in
+ begin match complaint with
+ | Unused -> "unused " ^ name
+ | Not_constructed ->
+ name ^
+ " is never used to build values.\n\
+ (However, this constructor appears in patterns.)"
+ | Only_exported_private ->
+ name ^
+ " is never used to build values.\n\
+ It is exported or rebound as a private extension."
+ end
+ | Unused_rec_flag ->
+ "unused rec flag."
+ | Name_out_of_scope (ty, [nm], false) ->
+ nm ^ " was selected from type " ^ ty ^
+ ".\nIt is not visible in the current scope, and will not \n\
+ be selected if the type becomes unknown."
+ | Name_out_of_scope (_, _, false) -> assert false
+ | Name_out_of_scope (ty, slist, true) ->
+ "this record of type "^ ty ^" contains fields that are \n\
+ not visible in the current scope: "
+ ^ String.concat " " slist ^ ".\n\
+ They will not be selected if the type becomes unknown."
+ | Ambiguous_name ([s], tl, false, expansion) ->
+ s ^ " belongs to several types: " ^ String.concat " " tl ^
+ "\nThe first one was selected. Please disambiguate if this is wrong."
+ ^ expansion
+ | Ambiguous_name (_, _, false, _ ) -> assert false
+ | Ambiguous_name (_slist, tl, true, expansion) ->
+ "these field labels belong to several types: " ^
+ String.concat " " tl ^
+ "\nThe first one was selected. Please disambiguate if this is wrong."
+ ^ expansion
+ | Disambiguated_name s ->
+ "this use of " ^ s ^ " relies on type-directed disambiguation,\n\
+ it will not compile with OCaml 4.00 or earlier."
+ | Nonoptional_label s ->
+ "the label " ^ s ^ " is not optional."
+ | Open_shadow_identifier (kind, s) ->
+ Printf.sprintf
+ "this open statement shadows the %s identifier %s (which is later used)"
+ kind s
+ | Open_shadow_label_constructor (kind, s) ->
+ Printf.sprintf
+ "this open statement shadows the %s %s (which is later used)"
+ kind s
+ | Bad_env_variable (var, s) ->
+ Printf.sprintf "illegal environment variable %s : %s" var s
+ | Attribute_payload (a, s) ->
+ Printf.sprintf "illegal payload for attribute '%s'.\n%s" a s
+ | Eliminated_optional_arguments sl ->
+ Printf.sprintf "implicit elimination of optional argument%s %s"
+ (if List.length sl = 1 then "" else "s")
+ (String.concat ", " sl)
+ | No_cmi_file(name, None) ->
+ "no cmi file was found in path for module " ^ name
+ | No_cmi_file(name, Some msg) ->
+ Printf.sprintf
+ "no valid cmi file was found in path for module %s. %s"
+ name msg
+ | Unexpected_docstring unattached ->
+ if unattached then "unattached documentation comment (ignored)"
+ else "ambiguous documentation comment"
+ | Wrong_tailcall_expectation b ->
+ Printf.sprintf "expected %s"
+ (if b then "tailcall" else "non-tailcall")
+ | Fragile_literal_pattern ->
+ let[@manual.ref "ss:warn52"] ref_manual = [ 13; 5; 3 ] in
+ Format.asprintf
+ "Code should not depend on the actual values of\n\
+ this constructor's arguments. They are only for information\n\
+ and may change in future versions. %a"
+ (Format_doc.compat Misc.print_see_manual) ref_manual
+ | Unreachable_case ->
+ "this match case is unreachable.\n\
+ Consider replacing it with a refutation case '<pat> -> .'"
+ | Misplaced_attribute attr_name ->
+ Printf.sprintf "the %S attribute cannot appear in this context" attr_name
+ | Duplicated_attribute attr_name ->
+ Printf.sprintf "the %S attribute is used more than once on this \
+ expression"
+ attr_name
+ | Inlining_impossible reason ->
+ Printf.sprintf "Cannot inline: %s" reason
+ | Ambiguous_var_in_pattern_guard vars ->
+ let[@manual.ref "ss:warn57"] ref_manual = [ 13; 5; 4 ] in
+ let vars = List.sort String.compare vars in
+ let vars_explanation =
+ let in_different_places =
+ "in different places in different or-pattern alternatives"
+ in
+ match vars with
+ | [] -> assert false
+ | [x] -> "variable " ^ x ^ " appears " ^ in_different_places
+ | _::_ ->
+ let vars = String.concat ", " vars in
+ "variables " ^ vars ^ " appear " ^ in_different_places
+ in
+ Format.asprintf
+ "Ambiguous or-pattern variables under guard;\n\
+ %s.\n\
+ Only the first match will be used to evaluate the guard expression.\n\
+ %a"
+ vars_explanation (Format_doc.compat Misc.print_see_manual) ref_manual
+ | No_cmx_file name ->
+ Printf.sprintf
+ "no cmx file was found in path for module %s, \
+ and its interface was not compiled with -opaque" name
+ | Flambda_assignment_to_non_mutable_value ->
+ "A potential assignment to a non-mutable value was detected \n\
+ in this source file. Such assignments may generate incorrect code \n\
+ when using Flambda."
+ | Unused_module s -> "unused module " ^ s ^ "."
+ | Unboxable_type_in_prim_decl t ->
+ Printf.sprintf
+ "This primitive declaration uses type %s, whose representation\n\
+ may be either boxed or unboxed. Without an annotation to indicate\n\
+ which representation is intended, the boxed representation has been\n\
+ selected by default. This default choice may change in future\n\
+ versions of the compiler, breaking the primitive implementation.\n\
+ You should explicitly annotate the declaration of %s\n\
+ with [@@boxed] or [@@unboxed], so that its external interface\n\
+ remains stable in the future." t t
+ | Constraint_on_gadt ->
+ "Type constraints do not apply to GADT cases of variant types."
+ | Erroneous_printed_signature s ->
+ "The printed interface differs from the inferred interface.\n\
+ The inferred interface contained items which could not be printed\n\
+ properly due to name collisions between identifiers.\n"
+ ^ s
+ ^ "\nBeware that this warning is purely informational and will not catch\n\
+ all instances of erroneous printed interface."
+ | Unsafe_array_syntax_without_parsing ->
+ "option -unsafe used with a preprocessor returning a syntax tree"
+ | Redefining_unit name ->
+ Printf.sprintf
+ "This type declaration is defining a new '()' constructor\n\
+ which shadows the existing one.\n\
+ Hint: Did you mean 'type %s = unit'?" name
+ | Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "."
+ | Match_on_mutable_state_prevent_uncurry ->
+ "This pattern depends on mutable state.\n\
+ It prevents the remaining arguments from being uncurried, which will \
+ cause additional closure allocations."
+ | Unused_field (s, Unused) -> "unused record field " ^ s ^ "."
+ | Unused_field (s, Not_read) ->
+ "record field " ^ s ^
+ " is never read.\n\
+ (However, this field is used to build or mutate values.)"
+ | Unused_field (s, Not_mutated) ->
+ "mutable record field " ^ s ^
+ " is never mutated."
+ | Missing_mli ->
+ "Cannot find interface file."
+ | Unused_tmc_attribute ->
+ "This function is marked @tail_mod_cons\n\
+ but is never applied in TMC position."
+ | Tmc_breaks_tailcall ->
+ "This call\n\
+ is in tail-modulo-cons position in a TMC function,\n\
+ but the function called is not itself specialized for TMC,\n\
+ so the call will not be transformed into a tail call.\n\
+ Please either mark the called function with the [@tail_mod_cons]\n\
+ attribute, or mark this call with the [@tailcall false] attribute\n\
+ to make its non-tailness explicit."
+ | Generative_application_expects_unit ->
+ "A generative functor\n\
+ should be applied to '()'; using '(struct end)' is deprecated."
+ | Degraded_to_partial_match ->
+ let[@manual.ref "ss:warn74"] ref_manual = [ 13; 5; 5 ] in
+ Format.asprintf
+ "This pattern-matching is compiled \n\
+ as partial, even if it appears to be total. \
+ It may generate a Match_failure\n\
+ exception. This typically occurs due to \
+ complex matches on mutable fields.\n\
+ %a"
+ (Format_doc.compat Misc.print_see_manual) ref_manual
+;;
+
+let nerrors = ref 0
+
+type reporting_information =
+ { id : string
+ ; message : string
+ ; is_error : bool
+ ; sub_locs : (loc * string) list;
+ }
+
+let id_name w =
+ let n = number w in
+ match List.find_opt (fun {number; _} -> number = n) descriptions with
+ | Some {names = s :: _; _} ->
+ Printf.sprintf "%d [%s]" n s
+ | _ ->
+ string_of_int n
+
+let report w =
+ match is_active w with
+ | false -> `Inactive
+ | true ->
+ if is_error w then incr nerrors;
+ `Active
+ { id = id_name w;
+ message = message w;
+ is_error = is_error w;
+ sub_locs = [];
+ }
+
+let report_alert (alert : alert) =
+ match alert_is_active alert with
+ | false -> `Inactive
+ | true ->
+ let is_error = alert_is_error alert in
+ if is_error then incr nerrors;
+ let message = Misc.normalise_eol alert.message in
+ (* Reduce \r\n to \n:
+ - Prevents any \r characters being printed on Unix when processing
+ Windows sources
+ - Prevents \r\r\n being generated on Windows, which affects the
+ testsuite
+ *)
+ let sub_locs =
+ if not alert.def.loc_ghost && not alert.use.loc_ghost then
+ [
+ alert.def, "Definition";
+ alert.use, "Expected signature";
+ ]
+ else
+ []
+ in
+ `Active
+ {
+ id = alert.kind;
+ message;
+ is_error;
+ sub_locs;
+ }
+
+exception Errors
+
+let reset_fatal () =
+ nerrors := 0
+
+let check_fatal () =
+ if !nerrors > 0 then begin
+ nerrors := 0;
+ raise Errors;
+ end
+
+let pp_since out release_info =
+ Printf.fprintf out " (since %d.%0*d)"
+ release_info.Sys.major
+ (if release_info.Sys.major >= 5 then 0 else 2)
+ release_info.Sys.minor
+
+let help_warnings () =
+ List.iter
+ (fun {number; description; names; since} ->
+ let name =
+ match names with
+ | s :: _ -> " [" ^ s ^ "]"
+ | [] -> ""
+ in
+ Printf.printf "%3i%s %s%a\n"
+ number name description (fun out -> Option.iter (pp_since out)) since)
+ descriptions;
+ print_endline " A all warnings";
+ for i = Char.code 'b' to Char.code 'z' do
+ let c = Char.chr i in
+ match letter c with
+ | [] -> ()
+ | [n] ->
+ Printf.printf " %c Alias for warning %i.\n" (Char.uppercase_ascii c) n
+ | l ->
+ Printf.printf " %c warnings %s.\n"
+ (Char.uppercase_ascii c)
+ (String.concat ", " (List.map Int.to_string l))
+ done;
+ exit 0
diff --git a/upstream/ocaml_503/utils/warnings.mli b/upstream/ocaml_503/utils/warnings.mli
new file mode 100644
index 0000000000..1da12c15fd
--- /dev/null
+++ b/upstream/ocaml_503/utils/warnings.mli
@@ -0,0 +1,171 @@
+(**************************************************************************)
+(* *)
+(* 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;
+}
+
+val ghost_loc_in_file : string -> loc
+(** Return an empty ghost range located in a given file *)
+
+type field_usage_warning =
+ | Unused
+ | Not_read
+ | Not_mutated
+
+type constructor_usage_warning =
+ | Unused
+ | Not_constructed
+ | Only_exported_private
+
+type t =
+ | Comment_start (* 1 *)
+ | Comment_not_end (* 2 *)
+(*| Deprecated --> alert "deprecated" *) (* 3 *)
+ | Fragile_match of string (* 4 *)
+ | Ignored_partial_application (* 5 *)
+ | Labels_omitted of string list (* 6 *)
+ | Method_override of string list (* 7 *)
+ | Partial_match of string (* 8 *)
+ | Missing_record_field_pattern of string (* 9 *)
+ | Non_unit_statement (* 10 *)
+ | Redundant_case (* 11 *)
+ | Redundant_subpat (* 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 Format_doc.t (* 18 *)
+ | Non_principal_labels of string (* 19 *)
+ | Ignored_extra_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
+ Note: since OCaml 5.2, the lexer normalizes \r\n sequences in
+ the source file to a single \n character, so the behavior of
+ newlines in string literals is portable. This warning is
+ never emitted anymore. *)
+ | Duplicate_definitions of string * string * string * string (* 30 *)
+ | 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 * constructor_usage_warning (* 37 *)
+ | Unused_extension of string * bool * constructor_usage_warning (* 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 *)
+ | Unexpected_docstring of bool (* 50 *)
+ | Wrong_tailcall_expectation of bool (* 51 *)
+ | Fragile_literal_pattern (* 52 *)
+ | Misplaced_attribute of string (* 53 *)
+ | Duplicated_attribute of string (* 54 *)
+ | Inlining_impossible of string (* 55 *)
+ | Unreachable_case (* 56 *)
+ | Ambiguous_var_in_pattern_guard of string list (* 57 *)
+ | No_cmx_file of string (* 58 *)
+ | Flambda_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_array_syntax_without_parsing (* 64 *)
+ | Redefining_unit of string (* 65 *)
+ | Unused_open_bang of string (* 66 *)
+ | Unused_functor_parameter of string (* 67 *)
+ | Match_on_mutable_state_prevent_uncurry (* 68 *)
+ | Unused_field of string * field_usage_warning (* 69 *)
+ | Missing_mli (* 70 *)
+ | Unused_tmc_attribute (* 71 *)
+ | Tmc_breaks_tailcall (* 72 *)
+ | Generative_application_expects_unit (* 73 *)
+ | Degraded_to_partial_match (* 74 *)
+
+type alert = {kind:string; message:string; def:loc; use:loc}
+
+val parse_options : bool -> string -> alert option
+
+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 with_state : state -> (unit -> 'a) -> 'a
+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. *)
+
+type description =
+ { number : int;
+ names : string list;
+ description : string;
+ since : Sys.ocaml_release_info option; }
+
+val descriptions : description list