From d57938d2ffbe2c60a892cc3355e81524308954cb Mon Sep 17 00:00:00 2001 From: cod-xknown <144150758+cod-xknown@users.noreply.github.com> Date: Tue, 5 Sep 2023 11:45:50 -0400 Subject: [PATCH 001/402] Replace Val_int(0) with Val_emptylist for [] --- manual/src/cmds/intf-c.etex | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/manual/src/cmds/intf-c.etex b/manual/src/cmds/intf-c.etex index 26e93be9bcb..bb47cccd8b7 100644 --- a/manual/src/cmds/intf-c.etex +++ b/manual/src/cmds/intf-c.etex @@ -1210,7 +1210,7 @@ value alloc_list_int(int i1, int i2) r = caml_alloc(2, 0); /* Allocate a cons cell */ Store_field(r, 0, Val_int(i2)); /* car = the integer i2 */ - Store_field(r, 1, Val_int(0)); /* cdr = the empty list [] */ + Store_field(r, 1, Val_emptylist); /* cdr = the empty list [] */ result = caml_alloc(2, 0); /* Allocate the other cons cell */ Store_field(result, 0, Val_int(i1)); /* car = the integer i1 */ Store_field(result, 1, r); /* cdr = the first cons cell */ @@ -1233,7 +1233,7 @@ value alloc_list_int(int i1, int i2) r = caml_alloc_small(2, 0); /* Allocate a cons cell */ Field(r, 0) = Val_int(i2); /* car = the integer i2 */ - Field(r, 1) = Val_int(0); /* cdr = the empty list [] */ + Field(r, 1) = Val_emptylist; /* cdr = the empty list [] */ result = caml_alloc_small(2, 0); /* Allocate the other cons cell */ Field(result, 0) = Val_int(i1); /* car = the integer i1 */ Field(result, 1) = r; /* cdr = the first cons cell */ @@ -1254,7 +1254,7 @@ value alloc_list_int(int i1, int i2) Field(r, 1) = Val_int(0); /* A dummy value tail = caml_alloc_small(2, 0); /* Allocate the other cons cell */ Field(tail, 0) = Val_int(i2); /* car = the integer i2 */ - Field(tail, 1) = Val_int(0); /* cdr = the empty list [] */ + Field(tail, 1) = Val_emptylist; /* cdr = the empty list [] */ caml_modify(&Field(r, 1), tail); /* cdr of the result = tail */ CAMLreturn (r); } From af8f622f844707621fb2c3e906ecd6c0f941ad5b Mon Sep 17 00:00:00 2001 From: cod-xknown <144150758+cod-xknown@users.noreply.github.com> Date: Tue, 5 Sep 2023 13:55:36 -0400 Subject: [PATCH 002/402] Update intf-c.etex --- manual/src/cmds/intf-c.etex | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/manual/src/cmds/intf-c.etex b/manual/src/cmds/intf-c.etex index bb47cccd8b7..7fc03e3cd19 100644 --- a/manual/src/cmds/intf-c.etex +++ b/manual/src/cmds/intf-c.etex @@ -616,7 +616,8 @@ contains "h", second field "t".} \end{tableau} As a convenience, "caml/mlvalues.h" defines the macros "Val_unit", -"Val_false" and "Val_true" to refer to "()", "false" and "true". +"Val_false", "Val_true" and "Val_emptylist" to refer to "()", +"false", "true" and "[]". The following example illustrates the assignment of integers and block tags to constructors: From 0ea8c74089b9f2999a9bc98abfec41d19378a2e6 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Fri, 8 Sep 2023 21:25:41 -0400 Subject: [PATCH 003/402] Restore a small piece of the implementation of pre-#12236 code --- typing/typecore.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/typing/typecore.ml b/typing/typecore.ml index ea009fc174f..29bd2b893a5 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -3807,8 +3807,9 @@ and type_expect_ 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 + let (ty, exp_extra) = type_constraint env sty in + let ty' = instance ty in + let arg = type_argument env sarg ty (instance ty) in rue { exp_desc = arg.exp_desc; exp_loc = arg.exp_loc; From 7e093ede50081fd5b4377ebfb5a0966f67b945e5 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 8 Sep 2023 17:12:07 +0200 Subject: [PATCH 004/402] Better error message if a needed TSan flag is missing --- aclocal.m4 | 1 + build-aux/ax_check_compile_flag.m4 | 53 ++++++++++++++++++++++++++++++ configure | 50 +++++++++++++++++++++++++--- configure.ac | 15 ++++++--- 4 files changed, 109 insertions(+), 10 deletions(-) create mode 100644 build-aux/ax_check_compile_flag.m4 diff --git a/aclocal.m4 b/aclocal.m4 index aefc1112db4..c7b94fed750 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -26,6 +26,7 @@ m4_include([build-aux/ltoptions.m4]) m4_include([build-aux/ltsugar.m4]) m4_include([build-aux/ltversion.m4]) m4_include([build-aux/lt~obsolete.m4]) +m4_include([build-aux/ax_check_compile_flag.m4]) # Macros from the autoconf macro archive m4_include([build-aux/ax_func_which_gethostbyname_r.m4]) diff --git a/build-aux/ax_check_compile_flag.m4 b/build-aux/ax_check_compile_flag.m4 new file mode 100644 index 00000000000..bd753b34d7d --- /dev/null +++ b/build-aux/ax_check_compile_flag.m4 @@ -0,0 +1,53 @@ +# =========================================================================== +# https://www.gnu.org/software/autoconf-archive/ax_check_compile_flag.html +# =========================================================================== +# +# SYNOPSIS +# +# AX_CHECK_COMPILE_FLAG(FLAG, [ACTION-SUCCESS], [ACTION-FAILURE], [EXTRA-FLAGS], [INPUT]) +# +# DESCRIPTION +# +# Check whether the given FLAG works with the current language's compiler +# or gives an error. (Warnings, however, are ignored) +# +# ACTION-SUCCESS/ACTION-FAILURE are shell commands to execute on +# success/failure. +# +# If EXTRA-FLAGS is defined, it is added to the current language's default +# flags (e.g. CFLAGS) when the check is done. The check is thus made with +# the flags: "CFLAGS EXTRA-FLAGS FLAG". This can for example be used to +# force the compiler to issue an error when a bad flag is given. +# +# INPUT gives an alternative input source to AC_COMPILE_IFELSE. +# +# NOTE: Implementation based on AX_CFLAGS_GCC_OPTION. Please keep this +# macro in sync with AX_CHECK_{PREPROC,LINK}_FLAG. +# +# LICENSE +# +# Copyright (c) 2008 Guido U. Draheim +# Copyright (c) 2011 Maarten Bosmans +# +# Copying and distribution of this file, with or without modification, are +# permitted in any medium without royalty provided the copyright notice +# and this notice are preserved. This file is offered as-is, without any +# warranty. + +#serial 6 + +AC_DEFUN([AX_CHECK_COMPILE_FLAG], +[AC_PREREQ(2.64)dnl for _AC_LANG_PREFIX and AS_VAR_IF +AS_VAR_PUSHDEF([CACHEVAR],[ax_cv_check_[]_AC_LANG_ABBREV[]flags_$4_$1])dnl +AC_CACHE_CHECK([whether _AC_LANG compiler accepts $1], CACHEVAR, [ + ax_check_save_flags=$[]_AC_LANG_PREFIX[]FLAGS + _AC_LANG_PREFIX[]FLAGS="$[]_AC_LANG_PREFIX[]FLAGS $4 $1" + AC_COMPILE_IFELSE([m4_default([$5],[AC_LANG_PROGRAM()])], + [AS_VAR_SET(CACHEVAR,[yes])], + [AS_VAR_SET(CACHEVAR,[no])]) + _AC_LANG_PREFIX[]FLAGS=$ax_check_save_flags]) +AS_VAR_IF(CACHEVAR,yes, + [m4_default([$2], :)], + [m4_default([$3], :)]) +AS_VAR_POPDEF([CACHEVAR])dnl +])dnl AX_CHECK_COMPILE_FLAGS diff --git a/configure b/configure index da48d8f472a..5b6ecab6060 100755 --- a/configure +++ b/configure @@ -3244,11 +3244,10 @@ oc_dll_ldflags="" oc_exe_ldflags="" tsan=false -oc_tsan_cflags="-fsanitize=thread" - # Passed to the linker by ocamlopt when tsan is enabled - +oc_tsan_cflags="-fsanitize=thread" oc_tsan_cppflags="-DWITH_THREAD_SANITIZER" +tsan_distinguish_volatile_cflags="" # The C# compiler and its flags CSC="" @@ -16525,12 +16524,53 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam \ esac case $ocaml_cv_cc_vendor in #( gcc*) : - oc_tsan_cflags="$oc_tsan_cflags --param=tsan-distinguish-volatile=1" ;; #( + tsan_distinguish_volatile_cflags="--param=tsan-distinguish-volatile=1" ;; #( clang*) : - oc_tsan_cflags="$oc_tsan_cflags -mllvm -tsan-distinguish-volatile" ;; #( + tsan_distinguish_volatile_cflags="-mllvm -tsan-distinguish-volatile" ;; #( *) : ;; esac + as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_-fsanitize=thread $tsan_distinguish_volatile_cflags" | $as_tr_sh` +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether C compiler accepts -fsanitize=thread $tsan_distinguish_volatile_cflags" >&5 +printf %s "checking whether C compiler accepts -fsanitize=thread $tsan_distinguish_volatile_cflags... " >&6; } +if eval test \${$as_CACHEVAR+y} +then : + printf %s "(cached) " >&6 +else $as_nop + + ax_check_save_flags=$CFLAGS + CFLAGS="$CFLAGS $warn_error_flag -fsanitize=thread $tsan_distinguish_volatile_cflags" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + eval "$as_CACHEVAR=yes" +else $as_nop + eval "$as_CACHEVAR=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + CFLAGS=$ax_check_save_flags +fi +eval ac_res=\$$as_CACHEVAR + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } +if eval test \"x\$"$as_CACHEVAR"\" = x"yes" +then : + : +else $as_nop + as_fn_error $? "The C compiler does not support the \`$tsan_distinguish_volatile_cflags' flag. Try upgrading to GCC >= 11, or to Clang >= 11." "$LINENO" 5 +fi + + oc_tsan_cflags="$oc_tsan_cflags $tsan_distinguish_volatile_cflags" common_cppflags="$common_cppflags $oc_tsan_cppflags" native_cflags="$native_cflags $oc_tsan_cflags" ocamlc_cflags="$ocamlc_cflags $oc_tsan_cflags" diff --git a/configure.ac b/configure.ac index 2f1cb8bba4a..ac005dcaf9b 100644 --- a/configure.ac +++ b/configure.ac @@ -55,11 +55,10 @@ oc_dll_ldflags="" oc_exe_ldflags="" tsan=false -oc_tsan_cflags="-fsanitize=thread" - # Passed to the linker by ocamlopt when tsan is enabled - +oc_tsan_cflags="-fsanitize=thread" oc_tsan_cppflags="-DWITH_THREAD_SANITIZER" +tsan_distinguish_volatile_cflags="" # The C# compiler and its flags CSC="" @@ -1657,9 +1656,15 @@ AS_IF([$tsan], [oc_tsan_cflags="$oc_tsan_cflags -Wno-tsan"]) AS_CASE([$ocaml_cv_cc_vendor], [gcc*], - [oc_tsan_cflags="$oc_tsan_cflags --param=tsan-distinguish-volatile=1"], + [tsan_distinguish_volatile_cflags="--param=tsan-distinguish-volatile=1"], [clang*], - [oc_tsan_cflags="$oc_tsan_cflags -mllvm -tsan-distinguish-volatile"]) + [tsan_distinguish_volatile_cflags="-mllvm -tsan-distinguish-volatile"]) + AX_CHECK_COMPILE_FLAG([-fsanitize=thread $tsan_distinguish_volatile_cflags], + [], + [AC_MSG_ERROR(m4_normalize([The C compiler does not support the + `$tsan_distinguish_volatile_cflags' flag. Try upgrading to GCC >= 11, or + to Clang >= 11.]))], [$warn_error_flag]) + oc_tsan_cflags="$oc_tsan_cflags $tsan_distinguish_volatile_cflags" common_cppflags="$common_cppflags $oc_tsan_cppflags" native_cflags="$native_cflags $oc_tsan_cflags" ocamlc_cflags="$ocamlc_cflags $oc_tsan_cflags" From b00913ce928157e5a0291edbf05572cd995d5606 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Mon, 11 Sep 2023 14:06:26 +0200 Subject: [PATCH 005/402] Look for modname.cmi/Modname.cmi in the loadpath when compiling implementation files --- Changes | 2 +- parsing/unit_info.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 0c9e98c8a18..3eaf4136e5e 100644 --- a/Changes +++ b/Changes @@ -277,7 +277,7 @@ Working version bytecode executable (`ocamlc -custom`). (Antonin Décimo, review by Xavier Leroy) -- #12389, centralize the handling of metadata for compilation units and +- #12389, #12544: centralize the handling of metadata for compilation units and artifacts in preparation for better unicode support for OCaml source files. (Florian Angeletti, review by Gabriel Scherer) diff --git a/parsing/unit_info.ml b/parsing/unit_info.ml index 70d5cf363b3..b2e081a221d 100644 --- a/parsing/unit_info.ml +++ b/parsing/unit_info.ml @@ -114,6 +114,6 @@ let mli_from_source u = let is_cmi f = Filename.check_suffix (Artifact.filename f) ".cmi" let find_normalized_cmi f = - let filename = prefix f ^ ".cmi" in + 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 } From a9ca4a3ebdb74e91b43700c6b8be57ef4a2c6149 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 11 Sep 2023 14:02:56 +0000 Subject: [PATCH 006/402] POWER: correct the list of FP registers that need saving and restoring It's all caller-save FP regs, that is, FPR0 to FPR13, not FPR1 to FPR14. --- runtime/power.S | 56 ++++++++++++++++++++++++------------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/runtime/power.S b/runtime/power.S index 957e9e90af8..1a9f8b93c6e 100644 --- a/runtime/power.S +++ b/runtime/power.S @@ -162,20 +162,20 @@ std 28, 0x0B0(TMP) /* Save caller-save floating-point registers */ /* (callee-saves are preserved by C functions) */ - stfd 1, 0x0B8(TMP) - stfd 2, 0x0C0(TMP) - stfd 3, 0x0C8(TMP) - stfd 4, 0x0D0(TMP) - stfd 5, 0x0D8(TMP) - stfd 6, 0x0E0(TMP) - stfd 7, 0x0E8(TMP) - stfd 8, 0x0F0(TMP) - stfd 9, 0x0F8(TMP) - stfd 10, 0x100(TMP) - stfd 11, 0x108(TMP) - stfd 12, 0x110(TMP) - stfd 13, 0x118(TMP) - stfd 14, 0x120(TMP) + stfd 0, 0x0B8(TMP) + stfd 1, 0x0C0(TMP) + stfd 2, 0x0C8(TMP) + stfd 3, 0x0D0(TMP) + stfd 4, 0x0D8(TMP) + stfd 5, 0x0E0(TMP) + stfd 6, 0x0E8(TMP) + stfd 7, 0x0F0(TMP) + stfd 8, 0x0F8(TMP) + stfd 9, 0x100(TMP) + stfd 10, 0x108(TMP) + stfd 11, 0x110(TMP) + stfd 12, 0x118(TMP) + stfd 13, 0x120(TMP) /* Save bucket to gc_regs */ std TMP, Caml_state(gc_regs) .endm @@ -210,20 +210,20 @@ ld 28, 0x0B0(TMP) /* Save caller-save floating-point registers (callee-saves are preserved by C functions) */ - lfd 1, 0x0B8(TMP) - lfd 2, 0x0C0(TMP) - lfd 3, 0x0C8(TMP) - lfd 4, 0x0D0(TMP) - lfd 5, 0x0D8(TMP) - lfd 6, 0x0E0(TMP) - lfd 7, 0x0E8(TMP) - lfd 8, 0x0F0(TMP) - lfd 9, 0x0F8(TMP) - lfd 10, 0x100(TMP) - lfd 11, 0x108(TMP) - lfd 12, 0x110(TMP) - lfd 13, 0x118(TMP) - lfd 14, 0x120(TMP) + lfd 0, 0x0B8(TMP) + lfd 1, 0x0C0(TMP) + lfd 2, 0x0C8(TMP) + lfd 3, 0x0D0(TMP) + lfd 4, 0x0D8(TMP) + lfd 5, 0x0E0(TMP) + lfd 6, 0x0E8(TMP) + lfd 7, 0x0F0(TMP) + lfd 8, 0x0F8(TMP) + lfd 9, 0x100(TMP) + lfd 10, 0x108(TMP) + lfd 11, 0x110(TMP) + lfd 12, 0x118(TMP) + lfd 13, 0x120(TMP) /* Put gc_regs struct back in bucket linked list */ ld TMP2, Caml_state(gc_regs_buckets) std TMP2, 0(TMP) /* next ptr */ From ef7bf6aa9f2dc338af323d65da3ead0368400340 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 5 Sep 2023 08:41:14 +0200 Subject: [PATCH 007/402] matching debug: fix stray Printfs among the Formats --- lambda/matching.ml | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/lambda/matching.ml b/lambda/matching.ml index 0a929ad0b4d..c1631fadeeb 100644 --- a/lambda/matching.ml +++ b/lambda/matching.ml @@ -93,7 +93,6 @@ open Types open Typedtree open Lambda open Parmatch -open Printf open Printpat module Scoped_location = Debuginfo.Scoped_location @@ -868,7 +867,7 @@ end = struct let eprintf (env : t) = List.iter (fun (i, ctx) -> - Printf.eprintf "jump for %d\n" i; + Format.eprintf "jump for %d\n" i; Context.eprintf ctx) env @@ -1017,7 +1016,7 @@ let rec pretty_precompiled = function pretty_matrix Format.err_formatter x.or_matrix; List.iter (fun { exit = i; pm; _ } -> - eprintf "++ Handler %d ++\n" i; + Format.eprintf "++ Handler %d ++\n" i; pretty_pm pm) x.handlers @@ -1025,7 +1024,7 @@ let pretty_precompiled_res first nexts = pretty_precompiled first; List.iter (fun (e, pmh) -> - eprintf "** DEFAULT %d **\n" e; + Format.eprintf "** DEFAULT %d **\n" e; pretty_precompiled pmh) nexts @@ -1072,7 +1071,7 @@ let make_catch_delayed handler = | None -> ( let i = next_raise_count () in (* - Printf.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler); + Format.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler); *) ( i, fun body -> @@ -2522,7 +2521,7 @@ let as_interval_canfail fail low high l = let do_store _tag act = let i = store.act_store () act in (* - eprintf "STORE [%s] %i %s\n" tag i (string_of_lam act) ; + Format.eprintf "STORE [%s] %i %s\n" tag i (string_of_lam act) ; *) i in @@ -2707,16 +2706,16 @@ let mk_failaction_pos partial seen ctx defs = defs in if dbg then ( - eprintf "POSITIVE JUMPS [%i]:\n" (List.length fail_pats); + Format.eprintf "POSITIVE JUMPS [%i]:\n" (List.length fail_pats); Jumps.eprintf jmps ); (None, fail, jmps) ) else ( (* Too many non-matched constructors -> reduced information *) - if dbg then eprintf "POS->NEG!!!\n%!"; + if dbg then Format.eprintf "POS->NEG!!!\n%!"; let fail, jumps = mk_failaction_neg partial ctx defs in if dbg then - eprintf "FAIL: %s\n" + Format.eprintf "FAIL: %s\n" ( match fail with | None -> "" | Some lam -> string_of_lam lam From e17cc0a81da32e0b45d7acafba967c592c22d6a5 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 5 Sep 2023 09:37:00 +0200 Subject: [PATCH 008/402] matching debug: use formatting boxes --- lambda/matching.ml | 298 ++++++++++++++++++++++++++++++-------------- typing/parmatch.ml | 2 +- typing/printpat.ml | 32 ++--- typing/printpat.mli | 5 +- 4 files changed, 221 insertions(+), 116 deletions(-) diff --git a/lambda/matching.ml b/lambda/matching.ml index c1631fadeeb..bfd491b565f 100644 --- a/lambda/matching.ml +++ b/lambda/matching.ml @@ -99,6 +99,11 @@ module Scoped_location = Debuginfo.Scoped_location let dbg = false +let debugf fmt = + if dbg + then Format.eprintf fmt + else Format.ifprintf Format.err_formatter fmt + (* Compatibility predicate that considers potential rebindings of constructors of an extension type. @@ -125,10 +130,6 @@ and may_compats = MayCompat.compats - Jump summaries: mapping from exit numbers to contexts *) -let string_of_lam lam = - Printlambda.lambda Format.str_formatter lam; - Format.flush_str_formatter () - let all_record_args lbls = match lbls with | [] -> fatal_error "Matching.all_record_args" @@ -472,7 +473,7 @@ module Context : sig val start : int -> t - val eprintf : t -> unit + val pp : Format.formatter -> t -> unit val specialize : Patterns.Head.t -> t -> t @@ -499,8 +500,11 @@ end = struct Right: what we know about whas is below us, towards the leaves. *) - let eprintf { left; right } = - Format.eprintf "LEFT:%a RIGHT:%a\n" pretty_line left pretty_line right + let pp ppf { left; right } = + Format.fprintf ppf + "@[LEFT@ %aRIGHT@ %a@]" + pretty_line left + pretty_line right let le c1 c2 = le_pats c1.left c2.left && le_pats c1.right c2.right @@ -546,7 +550,9 @@ end = struct | [] -> true | _ -> false - let eprintf ctx = List.iter Row.eprintf ctx + let pp ppf ctx = + Format.pp_print_list ~pp_sep:Format.pp_print_cut + Row.pp ppf ctx let lshift ctx = if List.length ctx < !Clflags.match_context_rows then @@ -679,7 +685,7 @@ module Default_environment : sig val flatten : int -> t -> t - val pp : t -> unit + val pp : Format.formatter -> t -> unit end = struct type t = (int * matrix) list (** All matrices in the list should have the same arity -- their rows should @@ -819,12 +825,22 @@ end = struct | [] -> None | def :: defs -> Some (def, defs) - let pp def = - Format.eprintf "+++++ Defaults +++++\n"; - List.iter - (fun (i, pss) -> Format.eprintf "Matrix for %d\n%a" i pretty_matrix pss) - def; - Format.eprintf "+++++++++++++++++++++\n" + let pp ppf def = + Format.fprintf ppf + "@[Default environment:@,\ + %a@]" + (fun ppf li -> + if li = [] then Format.fprintf ppf "empty" + else + Format.pp_print_list ~pp_sep:Format.pp_print_cut + (fun ppf (i, pss) -> + Format.fprintf ppf + "Matrix for %d:@,\ + %a" + i + pretty_matrix pss + ) ppf li + ) def let flatten size def = List.map (fun (i, pss) -> (i, flatten_matrix size pss)) def @@ -860,16 +876,19 @@ module Jumps : sig and the rest of the jump summary. *) val extract : int -> t -> Context.t * t - val eprintf : t -> unit + val pp : Format.formatter -> t -> unit end = struct type t = (int * Context.t) list - let eprintf (env : t) = - List.iter - (fun (i, ctx) -> - Format.eprintf "jump for %d\n" i; - Context.eprintf ctx) - env + let pp ppf (env : t) = + if env = [] then Format.fprintf ppf "empty" else + Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf (i, ctx) -> + Format.fprintf ppf + "jump for %d@,\ + %a" + i + Context.pp ctx + ) ppf env let rec extract i = function | [] -> (Context.empty, []) @@ -991,42 +1010,65 @@ let erase_cases f cases = let erase_pm pm = { pm with cases = erase_cases General.erase pm.cases } -let pretty_cases cases = - List.iter - (fun (ps, _l) -> - List.iter (fun p -> Format.eprintf " %a%!" top_pretty p) ps; - Format.eprintf "\n") +let pretty_cases ppf cases = + Format.fprintf ppf "@[ %a@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_cut + (fun ppf (ps, _l) -> + Format.fprintf ppf "@["; + List.iter (fun p -> Format.fprintf ppf "%a@ " pretty_pat p) ps; + Format.fprintf ppf "@]"; + )) cases -let pretty_pm pm = - pretty_cases pm.cases; +let pretty_pm ppf pm = + pretty_cases ppf pm.cases; if not (Default_environment.is_empty pm.default) then - Default_environment.pp pm.default + Format.fprintf ppf "@,%a" + Default_environment.pp pm.default -let rec pretty_precompiled = function +let rec pretty_precompiled ppf = function | Pm pm -> - Format.eprintf "++++ PM ++++\n"; - pretty_pm (erase_pm pm) + Format.fprintf ppf + "PM:@,\ + %a" + pretty_pm (erase_pm pm) | PmVar x -> - Format.eprintf "++++ VAR ++++\n"; - pretty_precompiled x.inside + Format.fprintf ppf + "PM Var:@,\ + %a" + pretty_precompiled x.inside | PmOr x -> - Format.eprintf "++++ OR ++++\n"; - pretty_pm (erase_pm x.body); - pretty_matrix Format.err_formatter x.or_matrix; - List.iter - (fun { exit = i; pm; _ } -> - Format.eprintf "++ Handler %d ++\n" i; - pretty_pm pm) - x.handlers - -let pretty_precompiled_res first nexts = - pretty_precompiled first; - List.iter - (fun (e, pmh) -> - Format.eprintf "** DEFAULT %d **\n" e; - pretty_precompiled pmh) - nexts + let pretty_handlers ppf handlers = + List.iter (fun { exit = i; pm; _ } -> + Format.fprintf ppf + "++ Handler %d ++@,\ + %a" + i + pretty_pm pm + ) handlers + in + Format.fprintf ppf "PM Or:@,\ + %a@,\ + %a@,\ + %a" + pretty_pm (erase_pm x.body) + pretty_matrix x.or_matrix + pretty_handlers x.handlers + +let pretty_precompiled_res ppf (first, nexts) = + Format.fprintf ppf + "@[First matrix:@,\ + %a@]@,\ + %a" + pretty_precompiled first + (Format.pp_print_list ~pp_sep:Format.pp_print_cut + (fun ppf (e, pmh) -> + Format.fprintf ppf + "@[Default matrix %d:@,\ + %a@]" + e + pretty_precompiled pmh) + ) nexts (* Identifying some semantically equivalent lambda-expressions, Our goal here is also to @@ -1071,8 +1113,8 @@ let make_catch_delayed handler = | None -> ( let i = next_raise_count () in (* - Format.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler); -*) + debugf "SHARE LAMBDA: %i@,%a@," i Printlambda.lambda handler; + *) ( i, fun body -> match body with @@ -1630,6 +1672,28 @@ and precompile_or ~arg (cls : Simple.clause list) ors args def k = }, k ) +let separate_debug_output () = + (* This function should be called when a debug-producing function + has just been called, and another debug-producing function is + about to be called. + + The format boxes used for debug pretty-printing must use @, as + *separator* between two non-empty outputs. (We use vertical boxes + with indentation, where extraneous cuts give ugly output, so we + do not want to place a cut before each item or after each item.) + + Each debug-outputting function can assume that it starts on a new + line, and is expected to *not* include a cut the end of its + output. The glue code that calls those functions is responsible + for placing separator cut @, between them. + + In most cases we know statically that some output was produced + and some other output will follow, and place a cut separator @, + at the right places in the debug format strings. But sometimes it + is not obvious in the code that a separator is needed. This + function is meant to be used in those less obvious cases. *) + debugf "@," + let dbg_split_and_precompile pm next nexts = if dbg @@ -1640,9 +1704,16 @@ let dbg_split_and_precompile pm next nexts = | _ -> false ) then ( - Format.eprintf "** SPLIT **\n"; - pretty_pm (erase_pm pm); - pretty_precompiled_res next nexts + debugf + "SPLIT@,\ + %a@,\ + @[INTO:@,\ + %a@]" + pretty_pm (erase_pm pm) + pretty_precompiled_res (next, nexts); + separate_debug_output + (* split_and_precompile is always followed by a compile_* function. *) + (); ) let split_and_precompile_simplified pm = @@ -1747,8 +1818,9 @@ let drop_expr_arg _head _arg rem = rem let get_key_constant caller = function | { pat_desc = Tpat_constant cst } -> cst | p -> - Format.eprintf "BAD: %s" caller; - pretty_pat p; + Format.eprintf "BAD (%s): %a" + caller + pretty_pat p; assert false let get_pat_args_constant = drop_pat_arg @@ -2521,8 +2593,8 @@ let as_interval_canfail fail low high l = let do_store _tag act = let i = store.act_store () act in (* - Format.eprintf "STORE [%s] %i %s\n" tag i (string_of_lam act) ; -*) + debugf "@,STORE [%s] %i %a" tag i Printlambda.lambda act; + *) i in let rec nofail_rec cur_low cur_high cur_act = function @@ -2668,11 +2740,6 @@ let mk_failaction_neg partial ctx def = (* In line with the article and simpler than before *) let mk_failaction_pos partial seen ctx defs = - if dbg then ( - Format.eprintf "**POS**\n"; - Default_environment.pp defs; - () - ); let rec scan_def env to_test defs = match (to_test, Default_environment.pop defs) with | [], _ @@ -2705,21 +2772,35 @@ let mk_failaction_pos partial seen ctx defs = (List.map (fun pat -> (pat, Context.lub pat ctx)) fail_pats) defs in - if dbg then ( - Format.eprintf "POSITIVE JUMPS [%i]:\n" (List.length fail_pats); - Jumps.eprintf jmps - ); + debugf + "@,@[COMBINE (mk_failaction_pos)@,\ + %a@,\ + @[FAIL PATTERNS:@,\ + %a@]@,\ + @[POSITIVE JUMPS:@,\ + %a@]\ + @]" + Default_environment.pp defs + (Format.pp_print_list ~pp_sep:Format.pp_print_cut + Printpat.pretty_pat) fail_pats + Jumps.pp jmps + ; (None, fail, jmps) ) else ( (* Too many non-matched constructors -> reduced information *) - if dbg then Format.eprintf "POS->NEG!!!\n%!"; let fail, jumps = mk_failaction_neg partial ctx defs in - if dbg then - Format.eprintf "FAIL: %s\n" - ( match fail with - | None -> "" - | Some lam -> string_of_lam lam - ); + debugf + "@,@[COMBINE (mk_failaction_pos)@,\ + %a@,\ + @[FAIL:@,\ + %t@]\ + @]" + Default_environment.pp defs + ( fun ppf -> match fail with + | None -> Format.fprintf ppf "" + | Some lam -> Printlambda.lambda ppf lam + ) + ; (fail, [], jumps) ) @@ -3108,8 +3189,11 @@ let compile_list compile_fun division = c_rec totals rem else begin match compile_fun cell.ctx cell.pm with - | exception Unused -> c_rec totals rem + | exception Unused -> + if rem <> [] then separate_debug_output (); + c_rec totals rem | lambda1, total1 -> + if rem <> [] then separate_debug_output (); let c_rem, total, new_discrs = c_rec (Jumps.map Context.combine total1 :: totals) rem in @@ -3128,8 +3212,10 @@ let compile_orhandlers compile_fun lambda1 total1 ctx to_catch = let ctx = Context.select_columns mat ctx in match compile_fun ctx pm with | exception Unused -> + if rem <> [] then separate_debug_output (); do_rec (Lstaticcatch (r, (i, vars), lambda_unit)) total_r rem | handler_i, total_i -> + if rem <> [] then separate_debug_output (); begin match raw_action r with | Lstaticraise (j, args) -> if i = j then @@ -3216,6 +3302,7 @@ let rec comp_match_handlers comp_fun partial ctx first_match next_matches = let rec c_rec body jumps_body = function | [] -> (body, jumps_body) | (i, pm_i) :: rem -> ( + separate_debug_output (); let ctx_i, jumps_rem = Jumps.extract i jumps_body in if Context.is_empty ctx_i then c_rec body jumps_body rem @@ -3241,6 +3328,7 @@ let rec comp_match_handlers comp_fun partial ctx first_match next_matches = | first_lam, jumps -> c_rec first_lam jumps next_matches | exception Unused -> + separate_debug_output (); comp_match_handlers comp_fun partial ctx second_match next_next_matches ) @@ -3277,13 +3365,18 @@ let rec compile_match ~scopes repr partial ctx (m : initial_clause pattern_matching) = match m.cases with | ([], action) :: rem -> - if is_guarded action then - let lambda, total = - compile_match ~scopes None partial ctx { m with cases = rem } - in - (event_branch repr (patch_guarded lambda action), total) - else - (event_branch repr action, Jumps.empty) + let res = + if is_guarded action then + let lambda, total = + compile_match ~scopes None partial ctx { m with cases = rem } + in + (event_branch repr (patch_guarded lambda action), total) + else + (event_branch repr action, Jumps.empty) + in + debugf "empty matrix%t" + (fun ppf -> if is_guarded action then Format.fprintf ppf " (guarded)"); + res | nonempty_cases -> compile_match_nonempty ~scopes repr partial ctx { m with cases = map_on_rows Non_empty_row.of_initial nonempty_cases } @@ -3328,17 +3421,30 @@ and combine_handlers ~scopes repr partial ctx (v, str, arg) first_match rem = (* verbose version of do_compile_matching, for debug *) and do_compile_matching_pr ~scopes repr partial ctx x = - Format.eprintf "COMPILE: %s\nMATCH\n" + debugf + "@[MATCH %s\ + @,%a" ( match partial with | Partial -> "Partial" | Total -> "Total" - ); - pretty_precompiled x; - Format.eprintf "CTX\n"; - Context.eprintf ctx; - let ((_, jumps) as r) = do_compile_matching ~scopes repr partial ctx x in - Format.eprintf "JUMPS\n"; - Jumps.eprintf jumps; + ) + pretty_precompiled x; + debugf "@,@[CTX:@,%a@]" + Context.pp ctx; + debugf "@,@[COMPILE:@,"; + let ((_, jumps) as r) = + try do_compile_matching ~scopes repr partial ctx x with + | exn -> + debugf "EXN (%s)@]@]" (Printexc.to_string exn); + raise exn + in + debugf "@]"; + if Jumps.is_empty jumps then + debugf "@,NO JUMPS" + else + debugf "@,@[JUMPS:@,%a@]" + Jumps.pp jumps; + debugf "@]"; r and do_compile_matching ~scopes repr partial ctx pmh = @@ -3551,6 +3657,12 @@ let check_total ~scopes loc ~failer total lambda i = failure_handler ~scopes loc ~failer ()) let toplevel_handler ~scopes loc ~failer partial args cases compile_fun = + let compile_fun partial pm = + debugf "@[MATCHING@,"; + let result = compile_fun partial pm in + debugf "@]@."; + result + in match partial with | Total when not !Clflags.safer_matching -> let default = Default_environment.empty in @@ -3798,7 +3910,7 @@ let flatten_simple_pattern size (p : Simple.pattern) = Since the PM is well typed, none of these cases are possible. *) let msg = Format.fprintf Format.str_formatter - "Matching.flatten_pattern: got '%a'" top_pretty (General.erase p); + "Matching.flatten_pattern: got '%a'" pretty_pat (General.erase p); Format.flush_str_formatter () in fatal_error msg diff --git a/typing/parmatch.ml b/typing/parmatch.ml index d646b2d5cd3..30faed66cce 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -1900,7 +1900,7 @@ let do_check_partial ~pred loc casel pss = match pss with try let buf = Buffer.create 16 in let fmt = Format.formatter_of_buffer buf in - Printpat.top_pretty fmt v; + 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.)"; diff --git a/typing/printpat.ml b/typing/printpat.ml index 64094b63ec3..ae143b7ecd0 100644 --- a/typing/printpat.ml +++ b/typing/printpat.ml @@ -144,26 +144,20 @@ 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 p = - top_pretty Format.str_formatter p ; - prerr_string (Format.flush_str_formatter ()) +let pretty_pat ppf p = + fprintf ppf "@[%a@]" pretty_val p type 'k matrix = 'k general_pattern list list -let pretty_line fmt = +let pretty_line ppf line = + Format.fprintf ppf "@["; List.iter (fun p -> - Format.fprintf fmt " <"; - top_pretty fmt p; - Format.fprintf fmt ">"; - ) - -let pretty_matrix fmt (pss : 'k matrix) = - Format.fprintf fmt "begin matrix\n" ; - List.iter (fun ps -> - pretty_line fmt ps ; - Format.fprintf fmt "\n" - ) pss; - Format.fprintf fmt "end matrix\n%!" + Format.fprintf ppf "<%a>@ " + pretty_val p + ) line; + Format.fprintf ppf "@]" + +let pretty_matrix ppf (pss : 'k matrix) = + Format.fprintf ppf "@[ %a@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_cut pretty_line) + pss diff --git a/typing/printpat.mli b/typing/printpat.mli index de47939099a..1f03508c2d2 100644 --- a/typing/printpat.mli +++ b/typing/printpat.mli @@ -18,10 +18,9 @@ val pretty_const : Asttypes.constant -> string val pretty_val : Format.formatter -> 'k Typedtree.general_pattern -> unit -val top_pretty - : Format.formatter -> 'k Typedtree.general_pattern -> unit + val pretty_pat - : 'k Typedtree.general_pattern -> unit + : Format.formatter -> 'k Typedtree.general_pattern -> unit val pretty_line : Format.formatter -> 'k Typedtree.general_pattern list -> unit val pretty_matrix From 34ac420f972325b81997f99317a6b820bbcd34d9 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 5 Sep 2023 14:10:08 +0200 Subject: [PATCH 009/402] matching errors: minor refactoring --- lambda/matching.ml | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/lambda/matching.ml b/lambda/matching.ml index bfd491b565f..94f8d20dfb2 100644 --- a/lambda/matching.ml +++ b/lambda/matching.ml @@ -1818,10 +1818,9 @@ let drop_expr_arg _head _arg rem = rem let get_key_constant caller = function | { pat_desc = Tpat_constant cst } -> cst | p -> - Format.eprintf "BAD (%s): %a" + fatal_errorf "BAD(%s): %a" caller - pretty_pat p; - assert false + pretty_pat p let get_pat_args_constant = drop_pat_arg let get_expr_args_constant = drop_expr_arg @@ -1957,11 +1956,11 @@ let get_mod_field modname field = in match Env.open_pers_signature modname env with | Error `Not_found -> - fatal_error ("Module " ^ modname ^ " unavailable.") + fatal_errorf "Module %s unavailable." modname | Ok env -> ( match Env.find_value_by_name (Longident.Lident field) env with | exception Not_found -> - fatal_error ("Primitive " ^ modname ^ "." ^ field ^ " not found.") + fatal_errorf "Primitive %s.%s not found." modname field | path, _ -> transl_value_path Loc_unknown env path )) @@ -3162,8 +3161,7 @@ let rec event_branch repr lam = Llet (str, k, id, lam, event_branch repr body) | Lstaticraise _, _ -> lam | _, Some _ -> - Printlambda.lambda Format.str_formatter lam; - fatal_error ("Matching.event_branch: " ^ Format.flush_str_formatter ()) + fatal_errorf "Matching.event_branch: %a" Printlambda.lambda lam (* This exception is raised when the compiler cannot produce code @@ -3908,12 +3906,8 @@ let flatten_simple_pattern size (p : Simple.pattern) = where we know that the scrutinee is a tuple literal. Since the PM is well typed, none of these cases are possible. *) - let msg = - Format.fprintf Format.str_formatter - "Matching.flatten_pattern: got '%a'" pretty_pat (General.erase p); - Format.flush_str_formatter () - in - fatal_error msg + fatal_errorf + "Matching.flatten_pattern: got '%a'" pretty_pat (General.erase p) let flatten_cases size cases = List.map From cf0266baed1c65235f3e87902954220c4bdb8cb2 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 5 Sep 2023 14:40:25 +0200 Subject: [PATCH 010/402] matching debug: do not show default environment of split matrices When we split a matrix inside a given default environment, the default environment of the resulting split matrices are highly redundant with the split matrices themselves: they contain the input default environment, plus each other. We hide the default environment of the result matrices to make the output shorter and less redundant, thus more readable. Example before: SPLIT _ 0 1 3 _ INTO: First matrix: PM: _ Default environment: Matrix for 2: <0> <1> <3> Matrix for 1: <_> Default matrix 2: PM: 0 1 3 Default environment: Matrix for 1: <_> Default matrix 1: PM: _ Notice that the "default matrix 2" and "default matrix 1" are repeated in the default environment of the "First matrix". Example after: SPLIT _ 0 1 3 _ INTO: First matrix: PM: _ Default matrix 2: PM: 0 1 3 Default matrix 1: PM: _ --- lambda/matching.ml | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/lambda/matching.ml b/lambda/matching.ml index 94f8d20dfb2..8a054de0550 100644 --- a/lambda/matching.ml +++ b/lambda/matching.ml @@ -1020,23 +1020,23 @@ let pretty_cases ppf cases = )) cases -let pretty_pm ppf pm = +let pretty_pm_ ~print_default ppf pm = pretty_cases ppf pm.cases; - if not (Default_environment.is_empty pm.default) then + if print_default && not (Default_environment.is_empty pm.default) then Format.fprintf ppf "@,%a" Default_environment.pp pm.default -let rec pretty_precompiled ppf = function +let rec pretty_precompiled_ ~print_default ppf = function | Pm pm -> Format.fprintf ppf "PM:@,\ %a" - pretty_pm (erase_pm pm) + (pretty_pm_ ~print_default) (erase_pm pm) | PmVar x -> Format.fprintf ppf "PM Var:@,\ %a" - pretty_precompiled x.inside + (pretty_precompiled_ ~print_default) x.inside | PmOr x -> let pretty_handlers ppf handlers = List.iter (fun { exit = i; pm; _ } -> @@ -1044,30 +1044,37 @@ let rec pretty_precompiled ppf = function "++ Handler %d ++@,\ %a" i - pretty_pm pm + (pretty_pm_ ~print_default) pm ) handlers in Format.fprintf ppf "PM Or:@,\ %a@,\ %a@,\ %a" - pretty_pm (erase_pm x.body) + (pretty_pm_ ~print_default) (erase_pm x.body) pretty_matrix x.or_matrix pretty_handlers x.handlers +let pretty_pm = + pretty_pm_ ~print_default:true +let pretty_precompiled = + pretty_precompiled_ ~print_default:true +let pretty_precompiled_without_default = + pretty_precompiled_ ~print_default:false + let pretty_precompiled_res ppf (first, nexts) = Format.fprintf ppf "@[First matrix:@,\ %a@]@,\ %a" - pretty_precompiled first + pretty_precompiled_without_default first (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf (e, pmh) -> Format.fprintf ppf "@[Default matrix %d:@,\ %a@]" e - pretty_precompiled pmh) + pretty_precompiled_without_default pmh) ) nexts (* Identifying some semantically equivalent lambda-expressions, From 98b84ef08b5a819435a3e1e3824a0f07e1e6b38e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 5 Sep 2023 16:36:09 +0200 Subject: [PATCH 011/402] Changes --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index 3eaf4136e5e..4c2891d2a64 100644 --- a/Changes +++ b/Changes @@ -281,6 +281,9 @@ Working version artifacts in preparation for better unicode support for OCaml source files. (Florian Angeletti, review by Gabriel Scherer) +- #12532: improve readability of the pattern-matching debug output + (Gabriel Scherer, review by Thomas Refis) + ### Build system: - #12198, #12321: continue the merge of the sub-makefiles into the root Makefile From 85787e3df4e442dcaa5000578e4c3172c934cadd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Mon, 2 Jan 2023 16:56:41 +0100 Subject: [PATCH 012/402] Check and fix old style declarations in C code Check whether the C compiler supports the -Wold-style-declaration warning. From the GCC manual [1]: > Warn for obsolescent usages, according to the C Standard, in a > declaration. For example, warn if storage-class specifiers like > static are not the first things in a declaration. [1]: https://gcc.gnu.org/onlinedocs/gcc-13.2.0/gcc/Warning-Options.html#index-Wold-style-declaration The compiler may not fail with an error code if it doesn't support the warning, we need to turn warnings into hard errors for that. --- configure | 42 ++++++++++++++++++++++++++++++++++++++++++ configure.ac | 5 +++++ runtime/sys.c | 2 +- 3 files changed, 48 insertions(+), 1 deletion(-) diff --git a/configure b/configure index 5b6ecab6060..ac220238aa6 100755 --- a/configure +++ b/configure @@ -13731,6 +13731,48 @@ case $ocaml_cv_cc_vendor in #( -Wold-style-definition" ;; esac +# Use -Wold-style-declaration if supported +as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_-Wold-style-declaration" | $as_tr_sh` +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether C compiler accepts -Wold-style-declaration" >&5 +printf %s "checking whether C compiler accepts -Wold-style-declaration... " >&6; } +if eval test \${$as_CACHEVAR+y} +then : + printf %s "(cached) " >&6 +else $as_nop + + ax_check_save_flags=$CFLAGS + CFLAGS="$CFLAGS $warn_error_flag -Wold-style-declaration" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + eval "$as_CACHEVAR=yes" +else $as_nop + eval "$as_CACHEVAR=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + CFLAGS=$ax_check_save_flags +fi +eval ac_res=\$$as_CACHEVAR + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } +if eval test \"x\$"$as_CACHEVAR"\" = x"yes" +then : + cc_warnings="$cc_warnings -Wold-style-declaration" +else $as_nop + : +fi + + case $enable_warn_error,true in #( yes,*|,true) : cc_warnings="$cc_warnings $warn_error_flag" ;; #( diff --git a/configure.ac b/configure.ac index ac005dcaf9b..efd3a023ad4 100644 --- a/configure.ac +++ b/configure.ac @@ -735,6 +735,11 @@ AS_CASE([$ocaml_cv_cc_vendor], cc_warnings="-Wall -Wint-conversion -Wstrict-prototypes \ -Wold-style-definition"]) +# Use -Wold-style-declaration if supported +AX_CHECK_COMPILE_FLAG([-Wold-style-declaration], + [cc_warnings="$cc_warnings -Wold-style-declaration"], [], + [$warn_error_flag]) + AS_CASE([$enable_warn_error,OCAML__DEVELOPMENT_VERSION], [yes,*|,true], [cc_warnings="$cc_warnings $warn_error_flag"]) diff --git a/runtime/sys.c b/runtime/sys.c index 26c7246b00c..a90d1b2fa48 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -219,7 +219,7 @@ CAMLprim value caml_sys_exit(value retcode) #endif #endif -const static int sys_open_flags[] = { +static const int sys_open_flags[] = { O_RDONLY, O_WRONLY, O_APPEND | O_WRONLY, O_CREAT, O_TRUNC, O_EXCL, O_BINARY, O_TEXT, O_NONBLOCK }; From d81e1b9cc31c1dde17f72f8f6ec2f37bef788e57 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Tue, 12 Sep 2023 15:26:45 +0100 Subject: [PATCH 013/402] Add a reference to the paper describing the recursive bindings check --- typing/rec_check.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/typing/rec_check.ml b/typing/rec_check.ml index 2d1b9922a93..7ba0a510a33 100644 --- a/typing/rec_check.ml +++ b/typing/rec_check.ml @@ -16,7 +16,11 @@ (* *) (**************************************************************************) -(** Static checking of recursive declarations +(** 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 {[ From 48a5febf117af8894d2222d87240b358fc9910c1 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 4 Sep 2023 15:17:47 +0200 Subject: [PATCH 014/402] -dtypedtree: print pattern partiality information --- typing/printtyped.ml | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/typing/printtyped.ml b/typing/printtyped.ml index 2e76ae838a0..c9f2bdc4ad8 100644 --- a/typing/printtyped.ml +++ b/typing/printtyped.ml @@ -106,6 +106,11 @@ let fmt_private_flag f x = | 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 (*...*) @@ -292,9 +297,11 @@ and function_body i ppf (body : function_body) = line i ppf "Tfunction_body\n"; expression (i+1) ppf e | Tfunction_cases - { cases; loc; exp_extra; attributes = attrs; param = _; partial = _ } + { cases; loc; exp_extra; attributes = attrs; param = _; partial } -> - line i ppf "Tfunction_cases %a\n" fmt_location loc; + 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 @@ -344,8 +351,9 @@ 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\n"; + | Texp_match (e, l, partial) -> + line i ppf "Texp_match%a\n" + fmt_partiality partial; expression i ppf e; list i case ppf l; | Texp_try (e, l) -> @@ -436,8 +444,9 @@ and expression i ppf x = | 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"; + | 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 @@ -469,10 +478,12 @@ and function_param i ppf x = arg_label i ppf p; match x.fp_kind with | Tparam_pat pat -> - line i ppf "Param_pat\n"; + 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\n"; + line i ppf "Param_optional_default%a\n" + fmt_partiality x.fp_partial; pattern (i+1) ppf pat; expression (i+1) ppf expr From 366f9ace541958f27cb1b6b9d3bc04e811f38a23 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 4 Sep 2023 15:30:10 +0200 Subject: [PATCH 015/402] typecore.type_pat: label boolean argument --- typing/typecore.ml | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/typing/typecore.ml b/typing/typecore.ml index ea009fc174f..3c374ea7636 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -3463,7 +3463,8 @@ and type_expect_ in let cases, partial = type_cases Computation env - arg.exp_type ty_expected_explained true loc caselist in + 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 @@ -3478,7 +3479,8 @@ and type_expect_ let body = type_expect env sbody ty_expected_explained in let cases, _ = type_cases Value env - Predef.type_exn ty_expected_explained false loc caselist in + Predef.type_exn ty_expected_explained + ~check_if_total:false loc caselist in re { exp_desc = Texp_try(body, cases); exp_loc = loc; exp_extra = []; @@ -4179,7 +4181,8 @@ and type_expect_ let scase = Ast_helper.Exp.case spat_params sbody in let cases, partial = type_cases Value env - ty_params (mk_expected ty_func_result) true loc [scase] + ty_params (mk_expected ty_func_result) + ~check_if_total:true loc [scase] in let body = match cases with @@ -4566,7 +4569,7 @@ and type_function 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 - ~partial_flag:true + ~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 @@ -5522,10 +5525,10 @@ and map_half_typed_cases -> ty_infer:_ (* type to infer for body *) -> contains_gadt:_ (* whether the pattern contains a GADT *) -> ret) - -> partial_flag:bool + -> check_if_total:bool (* if false, assume Partial right away *) -> ret list * partial = fun ?additional_checks_for_split_cases - category env ty_arg ty_res loc caselist ~type_body ~partial_flag -> + 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 @@ -5716,7 +5719,7 @@ and map_half_typed_cases if val_cases = [] && exn_cases <> [] then raise (Error (loc, env, No_value_clauses)); let partial = - if partial_flag then + if check_if_total then check_partial ~lev env ty_arg_check loc val_cases else Partial @@ -5750,10 +5753,10 @@ and map_half_typed_cases (* Typing of match cases *) and type_cases : type k . k pattern_category -> - _ -> _ -> _ -> _ -> _ -> Parsetree.case list -> + _ -> _ -> _ -> check_if_total:bool -> _ -> Parsetree.case list -> k case list * partial = fun category env - ty_arg ty_res_explained partial_flag loc caselist -> + ty_arg ty_res_explained ~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 @@ -5762,7 +5765,7 @@ 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 ~partial_flag + map_half_typed_cases 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:_ -> @@ -5806,7 +5809,8 @@ and type_function_cases_expect 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) true loc cases + 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))) From 2c53a09b7c0a624e0f7e0b11cae3260799ad1f9e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 4 Sep 2023 15:32:44 +0200 Subject: [PATCH 016/402] Ctype.instance_{poly,label}: label boolean argument (I'm not sure what 'fixed' means here, it comes all the way from 0a8236066f945c6026337dd4ea9342a9034f7987 without documentation, but it is better to have the parameter name at the callsite than to know nothing at all.) --- typing/ctype.ml | 12 ++++++------ typing/ctype.mli | 7 ++++--- typing/typeclass.ml | 2 +- typing/typecore.ml | 27 ++++++++++++++------------- typing/typedecl.ml | 5 +++-- 5 files changed, 28 insertions(+), 25 deletions(-) diff --git a/typing/ctype.ml b/typing/ctype.ml index fa2e6117fc3..cd9da31deb8 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1472,7 +1472,7 @@ let copy_sep ~copy_scope ~fixed ~(visited : type_expr TypeHash.t) sch = List.iter Lazy.force !delayed_copies; ty -let instance_poly' copy_scope ~keep_names fixed univars sch = +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 @@ -1485,17 +1485,17 @@ let instance_poly' copy_scope ~keep_names fixed univars sch = let ty = copy_sep ~copy_scope ~fixed ~visited sch in vars, ty -let instance_poly ?(keep_names=false) fixed univars sch = +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 + instance_poly' copy_scope ~keep_names ~fixed univars sch ) -let instance_label fixed lbl = +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 + instance_poly' copy_scope ~keep_names:false ~fixed tl ty | _ -> [], copy copy_scope lbl.lbl_arg in @@ -4894,7 +4894,7 @@ let rec subtype_rec env trace t1 t2 cstrs = | (Tpoly (u1, []), Tpoly (u2, [])) -> subtype_rec env trace u1 u2 cstrs | (Tpoly (u1, tl1), Tpoly (u2, [])) -> - let _, u1' = instance_poly false tl1 u1 in + let _, u1' = instance_poly ~fixed:false tl1 u1 in subtype_rec env trace u1' u2 cstrs | (Tpoly (u1, tl1), Tpoly (u2,tl2)) -> begin try diff --git a/typing/ctype.mli b/typing/ctype.mli index 4ba26faefe1..b38894b334e 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -206,12 +206,13 @@ val instance_class: type_expr list -> class_type -> type_expr list * class_type val instance_poly: - ?keep_names:bool -> - bool -> type_expr list -> type_expr -> type_expr list * type_expr + ?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: - bool -> label_description -> type_expr list * type_expr * type_expr + fixed:bool -> + label_description -> type_expr list * type_expr * type_expr (* Same, for a label *) val apply: ?use_current_level:bool -> diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 6a288ffea9e..ceeaa851d76 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -779,7 +779,7 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf = 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 false tl ty1 in + 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 diff --git a/typing/typecore.ml b/typing/typecore.ml index 3c374ea7636..1955b66c130 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -692,7 +692,7 @@ and build_as_type_aux (env : Env.t) p = 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 false lbl in + 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 && @@ -701,7 +701,7 @@ and build_as_type_aux (env : Env.t) p = 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 false lbl in + 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 @@ -731,7 +731,7 @@ let solve_Ppat_poly_constraint tps env loc sty expected_ty = | Tpoly (body, tyl) -> let _, ty' = with_level ~level:generic_level - (fun () -> instance_poly ~keep_names:true false tyl body) + (fun () -> instance_poly ~keep_names:true ~fixed:false tyl body) in (cty, ty, ty') | _ -> assert false @@ -870,7 +870,7 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials let solve_Ppat_record_field ~refine loc penv label label_lid record_ty = with_local_level_iter ~post:generalize_structure begin fun () -> - let (_, ty_arg, ty_res) = instance_label false label in + 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, _)) -> @@ -2755,7 +2755,7 @@ let check_univars env kind exp ty_expected vars = (* 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 true tl body in + 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) @@ -3651,14 +3651,14 @@ and type_expect_ | Some exp -> let ty_exp = instance exp.exp_type in let unify_kept lbl = - let _, ty_arg1, ty_res1 = instance_label false lbl in + 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 false lbl in + 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); @@ -3694,7 +3694,7 @@ and type_expect_ let (record, label, _) = type_label_access env srecord Env.Projection lid in - let (_, ty_arg, ty_res) = instance_label false label in + let (_, ty_arg, ty_res) = instance_label ~fixed:false label in unify_exp env record ty_res; rue { exp_desc = Texp_field(record, lid, label); @@ -3846,7 +3846,7 @@ and type_expect_ 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 false tl ty) + snd (instance_poly ~fixed:false tl ty) | Tvar _ -> let ty' = newvar () in unify env (instance typ) (newty(Tpoly(ty',[]))); @@ -4070,7 +4070,7 @@ and type_expect_ with_local_level begin fun () -> let vars, ty'' = with_local_level_if_principal - (fun () -> instance_poly true tl ty') + (fun () -> instance_poly ~fixed:true tl ty') ~post:(fun (_,ty'') -> generalize_structure ty'') in let exp = type_expect env sbody (mk_expected ty'') in @@ -4989,7 +4989,8 @@ and type_label_exp create env loc ty_expected 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 true label in + let ((_, ty_arg, ty_res) as r) = + instance_label ~fixed:true label in (r, [ty_arg; ty_res]) end in @@ -5845,7 +5846,7 @@ and type_let ?check ?check_strict match get_desc pat.pat_type with | Tpoly (ty, tl) -> {pat with pat_type = - snd (instance_poly ~keep_names:true false tl ty)} + snd (instance_poly ~keep_names:true ~fixed:false tl ty)} | _ -> pat in let bound_expr = vb_exp_constraint binding in @@ -5904,7 +5905,7 @@ and type_let ?check ?check_strict let vars, ty' = with_local_level_if_principal ~post:(fun (_,ty') -> generalize_structure ty') - (fun () -> instance_poly ~keep_names:true true tl ty) + (fun () -> instance_poly ~keep_names:true ~fixed:true tl ty) in let exp = Builtin_attributes.warning_scope pvb_attributes (fun () -> diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 58e23ed8e8f..fcee399fdd2 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -528,7 +528,7 @@ let rec check_constraints_rec env loc visited ty = end; List.iter (check_constraints_rec env loc visited) args | Tpoly (ty, tl) -> - let _, ty = Ctype.instance_poly false tl ty in + 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 @@ -946,7 +946,8 @@ let check_regularity ~abs_env env loc path decl to_check = end; List.iter (check_subtype cpath args prev_exp trace ty) args' | Tpoly (ty, tl) -> - let (_, ty) = Ctype.instance_poly ~keep_names:true false tl ty in + 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 From 8020985750954e9eb51bc0f2cbd8ffbfea5e1701 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 3 Sep 2023 23:02:06 +0200 Subject: [PATCH 017/402] testsuite for matching and side-effects --- .../tests/match-side-effects/contexts_1.ml | 43 ++++++ .../tests/match-side-effects/contexts_2.ml | 15 +++ .../tests/match-side-effects/contexts_3.ml | 13 ++ .../match-side-effects/test_contexts_code.ml | 126 ++++++++++++++++++ .../test_contexts_results.ml | 43 ++++++ 5 files changed, 240 insertions(+) create mode 100644 testsuite/tests/match-side-effects/contexts_1.ml create mode 100644 testsuite/tests/match-side-effects/contexts_2.ml create mode 100644 testsuite/tests/match-side-effects/contexts_3.ml create mode 100644 testsuite/tests/match-side-effects/test_contexts_code.ml create mode 100644 testsuite/tests/match-side-effects/test_contexts_results.ml diff --git a/testsuite/tests/match-side-effects/contexts_1.ml b/testsuite/tests/match-side-effects/contexts_1.ml new file mode 100644 index 00000000000..e0fce8a8f3d --- /dev/null +++ b/testsuite/tests/match-side-effects/contexts_1.ml @@ -0,0 +1,43 @@ +(* Example where a side-effect invalidates static knowledge about + a sub-value at the "toplevel" of the current matching context + -- on the current arguments of the pattern matrix. + + This example is adapted from the main example of #7241, showing + that mutable state combined with context optimization could be + unsound. + + The example of #7241 was adapted to return type-unsound result + (on non-fixed systems) instead of segfaulting. Segfaults are + painful to record and test reliably in a testsuite. *) + +type u = {a: bool; mutable b: (bool, int) Either.t} + +let example_1 () = + let input = { a = true; b = Either.Left true } in + match input with + | {a = false; b = _} -> Result.Error 1 + | {a = _; b = Either.Right _} -> Result.Error 2 + + (* evil trick: mutate the scrutinee from a guard *) + | {a = _; b = _} when (input.b <- Either.Right 3; false) -> Result.Error 3 + + (* At this point, field [b] has been mutated to hold a [Right] + constructor, but the pattern-matching compiler has already + checked read the field in the past and checked that the + constructor was not [Right] -- otherwise the action [Error 2] + would have been taken. + + The following behaviors would be reasonable on the input [f_input]: + + - read the field again, observe [Right], and fail with a match + failure -- there is no clause left to match it. + + - reuse the previously read subvalue [Left true], and return [Ok true]. + + For many years the OCaml compiler behaved incorrectly here: it + would read the mutated value [Right 3], but assume from static + context information that the head constructor is [Left]. and + dereference its field without checking the constructor + again. This returns the unsound result [Ok (3 : bool)]. *) + | {a = true; b = Either.Left y} -> Result.Ok y +;; diff --git a/testsuite/tests/match-side-effects/contexts_2.ml b/testsuite/tests/match-side-effects/contexts_2.ml new file mode 100644 index 00000000000..cf422a2da78 --- /dev/null +++ b/testsuite/tests/match-side-effects/contexts_2.ml @@ -0,0 +1,15 @@ +(* Example where a side-effect invalidates static knowledge about + a sub-value below the "toplevel" of the current matching context + -- a sub-value of the current arguments of the pattern matrix. + *) + +type 'a myref = { mutable mut : 'a } +type u = {a: bool; b: (bool, int) Either.t myref } + +let example_2 () = + let input = { a = true; b = { mut = Either.Left true } } in + match input with + | {a = false; b = _} -> Result.Error 1 + | {a = _; b = { mut = Either.Right _ }} -> Result.Error 2 + | {a = _; b = _} when (input.b.mut <- Either.Right 3; false) -> Result.Error 3 + | {a = true; b = { mut = Either.Left y }} -> Result.Ok y diff --git a/testsuite/tests/match-side-effects/contexts_3.ml b/testsuite/tests/match-side-effects/contexts_3.ml new file mode 100644 index 00000000000..25d8e70aff5 --- /dev/null +++ b/testsuite/tests/match-side-effects/contexts_3.ml @@ -0,0 +1,13 @@ +(* Example where a side-effect invalidates static knowledge about + a sub-value above the current matching context. *) + +type 'a myref = { mutable mut : 'a } +type u = (bool * (bool, int) Either.t) myref + +let example_3 () = + let input = { mut = (true, Either.Left true) } in + match input with + | { mut = (false, _) } -> Result.Error 1 + | { mut = (_, Either.Right _) } -> Result.Error 2 + | { mut = (_, _) } when (input.mut <- (true, Either.Right 3); false) -> Result.Error 3 + | { mut = (true, Either.Left y) } -> Result.Ok y diff --git a/testsuite/tests/match-side-effects/test_contexts_code.ml b/testsuite/tests/match-side-effects/test_contexts_code.ml new file mode 100644 index 00000000000..6ddb35d86d3 --- /dev/null +++ b/testsuite/tests/match-side-effects/test_contexts_code.ml @@ -0,0 +1,126 @@ +(* TEST + readonly_files = "contexts_1.ml contexts_2.ml contexts_3.ml"; + flags = "-dsource -dlambda"; + expect; +*) + +#use "contexts_1.ml";; +(* Notice that (field_mut 1 input) occurs twice, it + is evaluated once in the 'false' branch and once in the 'true' + branch. The compiler assumes that its static knowledge about the + first read (it cannot be a [Right] as we already matched against it + and failed) also applies to the second read, which is unsound. +*) +[%%expect {| + +#use "contexts_1.ml";; + +type u = { + a: bool ; + mutable b: (bool, int) Either.t };; +0 +type u = { a : bool; mutable b : (bool, int) Either.t; } + +let example_1 () = + let input = { a = true; b = (Either.Left true) } in + match input with + | { a = false; b = _ } -> Result.Error 1 + | { a = _; b = Either.Right _ } -> Result.Error 2 + | { a = _; b = _ } when input.b <- (Either.Right 3); false -> + Result.Error 3 + | { a = true; b = Either.Left y } -> Result.Ok y;; +(let + (example_1/309 = + (function param/333[int] + (let (input/311 = (makemutable 0 (int,*) 1 [0: 1])) + (if (field_int 0 input/311) + (let (*match*/336 =o (field_mut 1 input/311)) + (switch* *match*/336 + case tag 0: + (if (seq (setfield_ptr 1 input/311 [1: 3]) 0) [1: 3] + (let (*match*/338 =o (field_mut 1 input/311)) + (makeblock 0 (int) (field_imm 0 *match*/338)))) + case tag 1: [1: 2])) + [1: 1])))) + (apply (field_mut 1 (global Toploop!)) "example_1" example_1/309)) +val example_1 : unit -> (bool, int) Result.t = +|}] + +#use "contexts_2.ml";; +[%%expect {| + +#use "contexts_2.ml";; + +type 'a myref = { + mutable mut: 'a };; +0 +type 'a myref = { mutable mut : 'a; } + +type u = { + a: bool ; + b: (bool, int) Either.t myref };; +0 +type u = { a : bool; b : (bool, int) Either.t myref; } + +let example_2 () = + let input = { a = true; b = { mut = (Either.Left true) } } in + match input with + | { a = false; b = _ } -> Result.Error 1 + | { a = _; b = { mut = Either.Right _ } } -> Result.Error 2 + | { a = _; b = _ } when (input.b).mut <- (Either.Right 3); false -> + Result.Error 3 + | { a = true; b = { mut = Either.Left y } } -> Result.Ok y;; +(let + (example_2/345 = + (function param/349[int] + (let (input/347 = (makeblock 0 (int,*) 1 (makemutable 0 [0: 1]))) + (if (field_int 0 input/347) + (let (*match*/353 =o (field_mut 0 (field_imm 1 input/347))) + (switch* *match*/353 + case tag 0: + (if (seq (setfield_ptr 0 (field_imm 1 input/347) [1: 3]) 0) + [1: 3] + (let (*match*/356 =o (field_mut 0 (field_imm 1 input/347))) + (makeblock 0 (int) (field_imm 0 *match*/356)))) + case tag 1: [1: 2])) + [1: 1])))) + (apply (field_mut 1 (global Toploop!)) "example_2" example_2/345)) +val example_2 : unit -> (bool, int) Result.t = +|}] + +#use "contexts_3.ml";; +[%%expect {| + +#use "contexts_3.ml";; + +type 'a myref = { + mutable mut: 'a };; +0 +type 'a myref = { mutable mut : 'a; } + +type u = (bool * (bool, int) Either.t) myref;; +0 +type u = (bool * (bool, int) Either.t) myref + +let example_3 () = + let input = { mut = (true, (Either.Left true)) } in + match input with + | { mut = (false, _) } -> Result.Error 1 + | { mut = (_, Either.Right _) } -> Result.Error 2 + | { mut = (_, _) } when input.mut <- (true, (Either.Right 3)); false -> + Result.Error 3 + | { mut = (true, Either.Left y) } -> Result.Ok y;; +(let + (example_3/362 = + (function param/366[int] + (let (input/364 =mut [0: 1 [0: 1]] *match*/367 =o *input/364) + (if (field_imm 0 *match*/367) + (switch* (field_imm 1 *match*/367) + case tag 0: + (if (seq (assign input/364 [0: 1 [1: 3]]) 0) [1: 3] + (makeblock 0 (int) (field_imm 0 (field_imm 1 *match*/367)))) + case tag 1: [1: 2]) + [1: 1])))) + (apply (field_mut 1 (global Toploop!)) "example_3" example_3/362)) +val example_3 : unit -> (bool, int) Result.t = +|}] diff --git a/testsuite/tests/match-side-effects/test_contexts_results.ml b/testsuite/tests/match-side-effects/test_contexts_results.ml new file mode 100644 index 00000000000..a4126366cbd --- /dev/null +++ b/testsuite/tests/match-side-effects/test_contexts_results.ml @@ -0,0 +1,43 @@ +(* TEST + readonly_files = "contexts_1.ml contexts_2.ml contexts_3.ml"; + expect; +*) + +#use "contexts_1.ml";; +[%%expect {| +type u = { a : bool; mutable b : (bool, int) Either.t; } +val example_1 : unit -> (bool, int) Result.t = +|}] + +let _ = example_1 ();; +(* means that we got an 'unsound boolean', + which is neither 'true' nor 'false'. There was a bug here! *) +[%%expect {| +- : (bool, int) Result.t = Result.Ok +|}] + +#use "contexts_2.ml";; +[%%expect {| +type 'a myref = { mutable mut : 'a; } +type u = { a : bool; b : (bool, int) Either.t myref; } +val example_2 : unit -> (bool, int) Result.t = +|}];; + +let _ = example_2 ();; +(* Also a bug! *) +[%%expect {| +- : (bool, int) Result.t = Result.Ok +|}] + +#use "contexts_3.ml";; +[%%expect {| +type 'a myref = { mutable mut : 'a; } +type u = (bool * (bool, int) Either.t) myref +val example_3 : unit -> (bool, int) Result.t = +|}];; + +let _ = example_3 ();; +(* This one works correctly. *) +[%%expect {| +- : (bool, int) Result.t = Result.Ok true +|}] From e8b12619828813202d58293c33d46114dce9f7ca Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 10 Sep 2023 07:24:05 +0200 Subject: [PATCH 018/402] testsuite for the Total/Partial decisions --- .../tests/match-side-effects/partiality.ml | 181 ++++++++++++++++++ 1 file changed, 181 insertions(+) create mode 100644 testsuite/tests/match-side-effects/partiality.ml diff --git a/testsuite/tests/match-side-effects/partiality.ml b/testsuite/tests/match-side-effects/partiality.ml new file mode 100644 index 00000000000..cc17dbf7511 --- /dev/null +++ b/testsuite/tests/match-side-effects/partiality.ml @@ -0,0 +1,181 @@ +(* TEST + flags = "-dlambda"; + expect; +*) + +(* The original example of unsoundness in #7421. *) +type t = {a: bool; mutable b: int option} + +let f x = + match x with + | {a = false; b = _} -> 0 + | {a = _; b = None} -> 1 + | {a = _; b = _} when (x.b <- None; false) -> 2 + | {a = true; b = Some y} -> y +;; +(* Correctness condition: there should either be a single + (field_mut 1) access, or the second access should include + a Match_failure case. + + FAIL: the second occurrence of (field_mut 1) is used with a direct + (field_imm 0) access without a constructor check. The compiler is + unsound here. *) +[%%expect {| +0 +type t = { a : bool; mutable b : int option; } +(let + (f/279 = + (function x/281 : int + (if (field_int 0 x/281) + (let (*match*/285 =o (field_mut 1 x/281)) + (if *match*/285 + (if (seq (setfield_ptr 1 x/281 0) 0) 2 + (let (*match*/286 =o (field_mut 1 x/281)) + (field_imm 0 *match*/286))) + 1)) + 0))) + (apply (field_mut 1 (global Toploop!)) "f" f/279)) +val f : t -> int = +|}] + + + +(* A simple example of a complete switch + inside a mutable position. *) +type t = {a: bool; mutable b: int option} + +let f x = + match x with + | {a = false; b = _} -> 0 + | {a = _; b = None} -> 1 + | {a = true; b = Some y} -> y +;; +(* Performance expectation: there should not be a Match_failure case. *) +[%%expect {| +0 +type t = { a : bool; mutable b : int option; } +(let + (f/290 = + (function x/291 : int + (if (field_int 0 x/291) + (let (*match*/295 =o (field_mut 1 x/291)) + (if *match*/295 (field_imm 0 *match*/295) 1)) + 0))) + (apply (field_mut 1 (global Toploop!)) "f" f/290)) +val f : t -> int = +|}] + + + +(* A variant of the #7421 example. *) +let f r = + match Some r with + | Some { contents = None } -> 0 + | _ when (r := None; false) -> 1 + | Some { contents = Some n } -> n + | None -> 3 +;; +(* Correctness condition: there should either be a single + (field_mut 1) access, or the second access should include + a Match_failure case. + + FAIL: the second occurrence of (field_mut 0) is used with a direct + (field_imm 0) access without a constructor check. The compiler is + unsound here. *) +[%%expect {| +(let + (f/297 = + (function r/298 : int + (let (*match*/300 = (makeblock 0 r/298)) + (catch + (if *match*/300 + (let (*match*/302 =o (field_mut 0 (field_imm 0 *match*/300))) + (if *match*/302 (exit 7) 0)) + (exit 7)) + with (7) + (if (seq (setfield_ptr 0 r/298 0) 0) 1 + (if *match*/300 + (let (*match*/304 =o (field_mut 0 (field_imm 0 *match*/300))) + (field_imm 0 *match*/304)) + 3)))))) + (apply (field_mut 1 (global Toploop!)) "f" f/297)) +val f : int option ref -> int = +|}] + + + +(* This example has an ill-typed counter-example: the type-checker + finds it Total, but the pattern-matching compiler cannot see that + (Some (Some (Bool b))) cannot occur. *) +type _ t = Int : int -> int t | Bool : bool -> bool t + +let test = function + | None -> 0 + | Some (Int n) -> n +;; +(* Performance expectation: there should not be a Match_failure case. *) +[%%expect {| +0 +type _ t = Int : int -> int t | Bool : bool -> bool t +(let + (test/308 = + (function param/311 : int + (if param/311 (field_imm 0 (field_imm 0 param/311)) 0))) + (apply (field_mut 1 (global Toploop!)) "test" test/308)) +val test : int t option -> int = +|}] + + +(* This example has an ill-typed counter-example, inside + a mutable position. *) +type _ t = Int : int -> int t | Bool : bool -> bool t + +let test = function + | { contents = None } -> 0 + | { contents = Some (Int n) } -> n +;; +(* Performance expectation: there should not be a Match_failure case. *) +[%%expect {| +0 +type _ t = Int : int -> int t | Bool : bool -> bool t +(let + (test/316 = + (function param/318 : int + (let (*match*/319 =o (field_mut 0 param/318)) + (if *match*/319 (field_imm 0 (field_imm 0 *match*/319)) 0)))) + (apply (field_mut 1 (global Toploop!)) "test" test/316)) +val test : int t option ref -> int = +|}] + + + +(* This example has a ill-typed counter-example, + and also mutable sub-patterns, but in different places. *) +type _ t = Int : int -> int t | Bool : bool -> bool t + +let test n = + match Some (ref true, Int 42) with + | Some ({ contents = true }, Int n) -> n + | Some ({ contents = false }, Int n) -> -n + | None -> 3 +;; +(* Performance expectation: there should not be a Match_failure case. *) +[%%expect {| +0 +type _ t = Int : int -> int t | Bool : bool -> bool t +(let + (test/324 = + (function n/325 : int + (let + (*match*/328 = + (makeblock 0 (makeblock 0 (makemutable 0 (int) 1) [0: 42]))) + (if *match*/328 + (let + (*match*/329 =a (field_imm 0 *match*/328) + *match*/331 =o (field_mut 0 (field_imm 0 *match*/329))) + (if *match*/331 (field_imm 0 (field_imm 1 *match*/329)) + (~ (field_imm 0 (field_imm 1 *match*/329))))) + 3)))) + (apply (field_mut 1 (global Toploop!)) "test" test/324)) +val test : 'a -> int = +|}] From 0c1e12bc425c60b404044ec7fadec5ba284bae92 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 5 Sep 2023 16:54:34 +0200 Subject: [PATCH 019/402] matching debug: show record patterns whose fields are wildcards Before this commit, a record pattern that accepts all values for all its fields will be pretty-printed (in exhaustivity counter-examples and in the debug output of the pattern-matching compiler0 as a wildcard pattern `_`. This is correct for users, but it gives inaccurate information in the debug output, as the two patterns are distinct. Instead I propose to show "{ _ }" in this case, to mean a record whose field values do not matter. This happens to not be valid OCaml syntax, but it is perfectly understandable (it is the 0-ary version of the { ; _ } syntax) and thus unlikely to confuse users. --- testsuite/tests/typing-warnings/exhaustiveness.ml | 2 +- typing/printpat.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/typing-warnings/exhaustiveness.ml b/testsuite/tests/typing-warnings/exhaustiveness.ml index 63fc4f2cf8f..fe2c232667d 100644 --- a/testsuite/tests/typing-warnings/exhaustiveness.ml +++ b/testsuite/tests/typing-warnings/exhaustiveness.ml @@ -333,7 +333,7 @@ Line 1, characters 8-37: ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8 [partial-match]: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: -(_, 1) +({ _ }, 1) val f : 'a ref * int -> int = |}] diff --git a/typing/printpat.ml b/typing/printpat.ml index ae143b7ecd0..38524529f6a 100644 --- a/typing/printpat.ml +++ b/typing/printpat.ml @@ -84,7 +84,7 @@ let rec pretty_val : type k . _ -> k general_pattern -> _ = fun ppf v -> | (_,_,{pat_desc=Tpat_any}) -> false (* do not show lbl=_ *) | _ -> true) lvs in begin match filtered_lvs with - | [] -> fprintf ppf "_" + | [] -> fprintf ppf "{ _ }" | (_, lbl, _) :: q -> let elision_mark ppf = (* we assume that there is no label repetitions here *) From a64394ceea6f6654eecaa2908ead85e50fcd120b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 12 Sep 2023 22:48:52 +0200 Subject: [PATCH 020/402] [refactoring] matching: pp_partial --- lambda/matching.ml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lambda/matching.ml b/lambda/matching.ml index 8a054de0550..a1b2288e794 100644 --- a/lambda/matching.ml +++ b/lambda/matching.ml @@ -104,6 +104,10 @@ let debugf fmt = then Format.eprintf fmt else Format.ifprintf Format.err_formatter fmt +let pp_partial ppf = function + | Total -> Format.fprintf ppf "Total" + | Partial -> Format.fprintf ppf "Partial" + (* Compatibility predicate that considers potential rebindings of constructors of an extension type. @@ -3427,12 +3431,9 @@ and combine_handlers ~scopes repr partial ctx (v, str, arg) first_match rem = (* verbose version of do_compile_matching, for debug *) and do_compile_matching_pr ~scopes repr partial ctx x = debugf - "@[MATCH %s\ + "@[MATCH %a\ @,%a" - ( match partial with - | Partial -> "Partial" - | Total -> "Total" - ) + pp_partial partial pretty_precompiled x; debugf "@,@[CTX:@,%a@]" Context.pp ctx; From e5c932694c3212237310be22a345de8c3196b083 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 5 Sep 2023 17:47:24 +0200 Subject: [PATCH 021/402] matching debug: totality information on all COMBINE calls --- lambda/matching.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lambda/matching.ml b/lambda/matching.ml index a1b2288e794..f74450342a8 100644 --- a/lambda/matching.ml +++ b/lambda/matching.ml @@ -2735,6 +2735,10 @@ let complete_pats_constrs = function *) let mk_failaction_neg partial ctx def = + debugf + "@,@[COMBINE (mk_failaction_neg %a)@]" + pp_partial partial + ; match partial with | Partial -> ( match Default_environment.pop def with @@ -2783,13 +2787,14 @@ let mk_failaction_pos partial seen ctx defs = defs in debugf - "@,@[COMBINE (mk_failaction_pos)@,\ + "@,@[COMBINE (mk_failaction_pos %a)@,\ %a@,\ @[FAIL PATTERNS:@,\ %a@]@,\ @[POSITIVE JUMPS:@,\ %a@]\ @]" + pp_partial partial Default_environment.pp defs (Format.pp_print_list ~pp_sep:Format.pp_print_cut Printpat.pretty_pat) fail_pats From b52c6ba3801ae9b4bebaf695ab7c2dfaf53a4f09 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 13 Sep 2023 13:46:17 +0200 Subject: [PATCH 022/402] Changes --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 4c2891d2a64..cb1ec92d3e9 100644 --- a/Changes +++ b/Changes @@ -281,7 +281,7 @@ Working version artifacts in preparation for better unicode support for OCaml source files. (Florian Angeletti, review by Gabriel Scherer) -- #12532: improve readability of the pattern-matching debug output +- #12532, #12553: improve readability of the pattern-matching debug output (Gabriel Scherer, review by Thomas Refis) ### Build system: From 59029b99420f0f871f56cccc63fd6c29e146e91b Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 24 Feb 2022 17:30:33 +0100 Subject: [PATCH 023/402] Do not access the TLS from signal handlers When a signal arrives, we interrupt all domains. This is a strategy that makes much fewer assumptions about signal-safety, threads, and domains. The point of view of this commit is that realistic uses of signals (SIGINT, SIGALRM...) make them arrive infrequently-enough that this is affordable. * In mixed C/OCaml applications, there is no guarantee that the POSIX signal handler runs in an OCaml thread so [domain_state] might not be available. * While C11 mandates that atomic thread-local variables are async-signal-safe for reading, gcc does not conform and can allocate in corner cases involving dynamic linking. * It is unclear whether the OSX implementation of [domain_state] is safe to read from signal handlers either, but this might be a theoretical concern only. * Do not make the hypothesis that the thread executing a POSIX signal handler is the most ready to execute the corresponding OCaml signal handler (e.g. Ctrl-C sent to the toplevel received by domain 0 when stuck inside [Domain.join]). * These changes allow simplifications to the spawning of threads and domains since we no longer need to mask signals during thread creation. (See subsequent commit.) The biggest risk of this change is the fact that C code allocating on the GC heap repeatedly polls without clearing pending actions until a safe point is found. By interrupting all domains when a signal arrives, the cost of this phenomenon is amplified. A subsequent commit fixes this behaviour by making sure that a signal notified to a domain causes this domain to poll only once inside C code. --- runtime/caml/domain.h | 1 + runtime/domain.c | 40 ++++++++++++--- runtime/minor_gc.c | 9 ++-- runtime/signals.c | 38 ++++++++++----- testsuite/tests/parallel/catch_break.ml | 65 +++++++++++++++++++++++++ 5 files changed, 132 insertions(+), 21 deletions(-) create mode 100644 testsuite/tests/parallel/catch_break.ml diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h index 2edfae09c00..0b6c96fe667 100644 --- a/runtime/caml/domain.h +++ b/runtime/caml/domain.h @@ -66,6 +66,7 @@ void caml_handle_gc_interrupt(void); void caml_handle_incoming_interrupts(void); CAMLextern void caml_interrupt_self(void); +void caml_interrupt_all_for_signal(void); void caml_reset_young_limit(caml_domain_state *); CAMLextern void caml_reset_domain_lock(void); diff --git a/runtime/domain.c b/runtime/domain.c index 0c5b4963613..1f64f63f849 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -141,7 +141,10 @@ typedef cpuset_t cpu_set_t; /* control of STW interrupts */ struct interruptor { - atomic_uintnat* interrupt_word; + /* The outermost atomic is for synchronization with + caml_interrupt_all_for_signal. The innermost atomic is also for + cross-domain communication.*/ + _Atomic(atomic_uintnat *) interrupt_word; caml_plat_mutex lock; caml_plat_cond cond; @@ -205,7 +208,7 @@ static caml_plat_mutex all_domains_lock = CAML_PLAT_MUTEX_INITIALIZER; static caml_plat_cond all_domains_cond = CAML_PLAT_COND_INITIALIZER(&all_domains_lock); static atomic_uintnat /* dom_internal* */ stw_leader = 0; -static struct dom_internal all_domains[Max_domains]; +static dom_internal all_domains[Max_domains]; CAMLexport atomic_uintnat caml_num_domains_running; @@ -294,7 +297,8 @@ CAMLexport caml_domain_state* caml_get_domain_state(void) Caml_inline void interrupt_domain(struct interruptor* s) { - atomic_store_release(s->interrupt_word, (uintnat)(-1)); + atomic_uintnat * interrupt_word = atomic_load_relaxed(&s->interrupt_word); + atomic_store_release(interrupt_word, (uintnat)(-1)); } int caml_incoming_interrupts_queued(void) @@ -585,8 +589,14 @@ static void domain_create(uintnat initial_minor_heap_wsize) { caml_state = domain_state; + domain_state->young_limit = 0; + /* Synchronized with [caml_interrupt_all_for_signal], so that the + initializing write of young_limit happens before any + interrupt. */ + atomic_store_explicit(&s->interrupt_word, &domain_state->young_limit, + memory_order_release); + s->unique_id = fresh_domain_unique_id(); - s->interrupt_word = &domain_state->young_limit; s->running = 1; atomic_fetch_add(&caml_num_domains_running, 1); @@ -876,7 +886,7 @@ void caml_init_domains(uintnat minor_heap_wsz) { dom->id = i; - dom->interruptor.interrupt_word = 0; + dom->interruptor.interrupt_word = NULL; caml_plat_mutex_init(&dom->interruptor.lock); caml_plat_cond_init(&dom->interruptor.cond, &dom->interruptor.lock); @@ -1586,10 +1596,28 @@ int caml_try_run_on_all_domains_async( leader_setup, 0, 0); } -void caml_interrupt_self(void) { +void caml_interrupt_self(void) +{ interrupt_domain(&domain_self->interruptor); } +/* async-signal-safe */ +void caml_interrupt_all_for_signal(void) +{ + for (dom_internal *d = all_domains; d < &all_domains[Max_domains]; d++) { + /* [all_domains] is an array of values. So we can access + [interrupt_word] directly without synchronisation other than + with other people who access the same [interrupt_word].*/ + atomic_uintnat * interrupt_word = + atomic_load_explicit(&d->interruptor.interrupt_word, + memory_order_acquire); + /* Early exit: if the current domain was never initialized, then + neither have been any of the remaining ones. */ + if (interrupt_word == NULL) return; + interrupt_domain(&d->interruptor); + } +} + void caml_reset_young_limit(caml_domain_state * dom_st) { CAMLassert ((uintnat)dom_st->young_ptr > (uintnat)dom_st->young_trigger); diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index 04a463c2c82..26613e6eb6e 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -820,9 +820,12 @@ void caml_alloc_small_dispatch (caml_domain_state * dom_st, caml_raise_if_exception(caml_do_pending_actions_exn()); else { caml_handle_gc_interrupt(); - /* In the case of long-running C code that regularly polls with - [caml_process_pending_actions], still force a query of all - callbacks at every minor collection or major slice. */ + /* We might be here due to a recently-recorded signal, so we + need to remember that we must run signal handlers. In + addition, in the case of long-running C code that regularly + polls with caml_process_pending_actions, we want to force a + query of all callbacks at every minor collection or major + slice (similarly to OCaml behaviour). */ dom_st->action_pending = 1; } diff --git a/runtime/signals.c b/runtime/signals.c index 6dc6c3b6de8..0be42213587 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -106,12 +106,8 @@ CAMLexport value caml_process_pending_signals_exn(void) } /* Record the delivery of a signal, and arrange for it to be processed - as soon as possible: - - via Caml_state->action_pending, processed in - caml_process_pending_actions. - - by playing with the allocation limit, processed in - caml_alloc_small_dispatch. -*/ + as soon as possible, by playing with the allocation limit, + processed in caml_alloc_small_dispatch. */ CAMLexport void caml_record_signal(int signal_number) { unsigned int i; @@ -119,8 +115,28 @@ CAMLexport void caml_record_signal(int signal_number) i = signal_number - 1; atomic_fetch_or(&caml_pending_signals[i / BITS_PER_WORD], (uintnat)1 << (i % BITS_PER_WORD)); - // FIXME: the TLS variable is not thread-safe - caml_interrupt_self(); + /* We interrupt all domains when a signal arrives. Signals (SIGINT, + SIGALRM...) arrive infrequently-enough that this is affordable. + This is a strategy that makes as little assumptions as possible + about signal-safety, threads, and domains. + + * In mixed C/OCaml applications there is no guarantee that the + POSIX signal handler runs in an OCaml thread, so Caml_state might + be unavailable. + + * While C11 mandates that atomic thread-local variables are + async-signal-safe for reading, gcc does not conform and can + allocate in corner cases involving dynamic linking. It is also + unclear whether the OSX implementation conforms, but this might + be a theoretical concern only. + + * The thread executing a POSIX signal handler is not necessarily + the most ready to execute the corresponding OCaml signal handler. + Examples: + - Ctrl-C in the toplevel when domain 0 is stuck inside [Domain.join]. + - a thread that has just spawned, before the appropriate mask is set. + */ + caml_interrupt_all_for_signal(); } /* Management of blocking sections. */ @@ -270,7 +286,7 @@ void caml_request_minor_gc (void) [Caml_state->action_pending] is 1, or there is a function currently running which is executing all actions. - This is used to ensure [Caml_state->young_limit] is always set + This is used to ensure that [Caml_state->young_limit] is always set appropriately. In case there are two different callbacks (say, a signal and a @@ -283,9 +299,7 @@ void caml_request_minor_gc (void) calling them first. */ -CAMLno_tsan /* When called from [caml_record_signal], these memory - accesses may not be synchronized. Otherwise we assume - that we have unique access to dom_st. */ +/* We assume that we have unique access to dom_st. */ void caml_set_action_pending(caml_domain_state * dom_st) { dom_st->action_pending = 1; diff --git a/testsuite/tests/parallel/catch_break.ml b/testsuite/tests/parallel/catch_break.ml new file mode 100644 index 00000000000..e650a4208be --- /dev/null +++ b/testsuite/tests/parallel/catch_break.ml @@ -0,0 +1,65 @@ +(* TEST +hassysthreads; +include systhreads; +not-windows; +{ + bytecode; +}{ + native; +} +*) + +let verbose = false + +(* Expected when verbose (depending on scheduling and platform): + +[Sys.Break caught] +Domain 1 +[Sys.Break caught] +Domain 0 - 1 +[Sys.Break caught] +Domain 0 - 2 +Success. + +*) + +let print = if verbose then print_endline else fun _ -> () + +let break_trap s = + begin + try while true do () done + with Sys.Break -> print "[Sys.Break caught]"; + end; + print s + +let run () = + (* Goal: joining the domain [d] must be achievable by Ctrl-C *) + let d = Domain.spawn (fun () -> break_trap "Domain 1") + in + let finished = ref false in + (* Simulate repeated Ctrl-C *) + let d2 = Domain.spawn (fun () -> + ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigint]); + let pid = Unix.getpid () in + let rec kill n = + if n = 0 then ( + print "[Kill thread reached max attempts without succeeding]"; + Unix._exit 1 + ); + Unix.sleepf 0.05; + Unix.kill pid Sys.sigint; + if not !finished then kill (n - 1) + in + kill 10) + in + break_trap "Domain 0 - 1"; + Domain.join d; + break_trap "Domain 0 - 2"; + finished := true; + Domain.join d2 + +let () = + Sys.catch_break true; + (try run () with Sys.Break -> ()); + (try print "Success." with Sys.Break -> ()); + exit 0 From 2c30dc178d68b1c352994639487a078ea1207158 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Sun, 29 Jan 2023 00:22:23 +0100 Subject: [PATCH 024/402] [minor] Better documentation for catch_break As implemented by the previous bugfix commit. --- stdlib/sys.mli | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/stdlib/sys.mli b/stdlib/sys.mli index b7d44865292..5fdd8c5c418 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -331,7 +331,7 @@ val sigxfsz : int exception Break (** Exception raised on interactive interrupt if {!Sys.catch_break} - is on. *) + is enabled. *) val catch_break : bool -> unit @@ -339,7 +339,13 @@ val catch_break : bool -> unit terminates the program or raises the [Break] exception. Call [catch_break true] to enable raising [Break], and [catch_break false] to let the system - terminate the program on user interrupt. *) + terminate the program on user interrupt. + + Inside multi-threaded programs, the [Break] exception will arise in + any one of the active threads, and will keep arising on further + interactive interrupt until all threads are terminated. Use + signal masks from [Thread.sigmask] to direct the interrupt towards a + specific thread. *) val ocaml_version : string From 3137b0e03579f151ce05ea67f479e831fe7dd9db Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Mon, 28 Aug 2023 18:34:47 +0200 Subject: [PATCH 025/402] [minor] Additional comments --- runtime/domain.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/runtime/domain.c b/runtime/domain.c index 1f64f63f849..86dc552f6ce 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -1618,11 +1618,17 @@ void caml_interrupt_all_for_signal(void) } } +/* To avoid any risk of forgetting an action through a race, + [caml_reset_young_limit] is the only way (apart from setting + young_limit to -1 for immediate interruption) through which + [young_limit] can be modified. We take care here of possible + races. */ void caml_reset_young_limit(caml_domain_state * dom_st) { CAMLassert ((uintnat)dom_st->young_ptr > (uintnat)dom_st->young_trigger); - /* An interrupt might have been queued in the meanwhile; this - achieves the proper synchronisation. */ + /* An interrupt might have been queued in the meanwhile; the + atomic_exchange achieves the proper synchronisation with the + reads that follow (an atomic_store is not enough). */ atomic_exchange(&dom_st->young_limit, (uintnat)dom_st->young_trigger); dom_internal * d = &all_domains[dom_st->id]; if (atomic_load_relaxed(&d->interruptor.interrupt_pending) From 5742171d76ad7f0832003aad667ecfe6e2f1c769 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Wed, 8 Jun 2022 21:54:30 +0200 Subject: [PATCH 026/402] Simplify spawning of threads and domains As follows from the preceding commit. --- otherlibs/systhreads/st_stubs.c | 29 ++--------------------------- runtime/domain.c | 31 ++----------------------------- 2 files changed, 4 insertions(+), 56 deletions(-) diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index 1ed505645cd..0765baacb7d 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -95,10 +95,6 @@ struct caml_thread_struct { struct caml_exception_context* external_raise; /* saved value of Caml_state->external_raise */ #endif - -#ifdef POSIX_SIGNALS - sigset_t init_mask; -#endif }; typedef struct caml_thread_struct* caml_thread_t; @@ -575,12 +571,6 @@ static void * caml_thread_start(void * v) restore_runtime_state(th); signal_stack = caml_init_signal_stack(); -#ifdef POSIX_SIGNALS - /* restore the signal mask from the spawning thread, now it is safe for the - signal handler to run (as Caml_state is initialised) */ - pthread_sigmask(SIG_SETMASK, &th->init_mask, NULL); -#endif - clos = Start_closure(Active_thread->descr); caml_modify(&(Start_closure(Active_thread->descr)), Val_unit); caml_callback_exn(clos, Val_unit); @@ -595,8 +585,8 @@ static int create_tick_thread(void) #ifdef POSIX_SIGNALS sigset_t mask, old_mask; - /* Block all signals so that we don't try to execute an OCaml signal - handler in the new tick thread */ + /* Block all signals, so that we do not try to execute a C signal + handler in the new tick thread. */ sigfillset(&mask); pthread_sigmask(SIG_BLOCK, &mask, &old_mask); #endif @@ -630,12 +620,6 @@ CAMLprim value caml_thread_new(value clos) Tick_thread_running = 1; } -#ifdef POSIX_SIGNALS - sigset_t mask, old_mask; - - sigfillset(&mask); - pthread_sigmask(SIG_BLOCK, &mask, &old_mask); -#endif /* Create a thread info block */ caml_thread_t th = caml_thread_new_info(); @@ -645,10 +629,6 @@ CAMLprim value caml_thread_new(value clos) th->descr = caml_thread_new_descriptor(clos); -#ifdef POSIX_SIGNALS - th->init_mask = old_mask; -#endif - th->next = Active_thread->next; th->prev = Active_thread; @@ -657,11 +637,6 @@ CAMLprim value caml_thread_new(value clos) err = st_thread_create(NULL, caml_thread_start, (void *) th); -#ifdef POSIX_SIGNALS - /* regardless of error, return our sigmask to the original state */ - pthread_sigmask(SIG_SETMASK, &old_mask, NULL); -#endif - if (err != 0) { /* Creation failed, remove thread info block from list of threads */ caml_thread_remove_and_free(th); diff --git a/runtime/domain.c b/runtime/domain.c index 86dc552f6ce..15a451ecad5 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -954,10 +954,6 @@ struct domain_startup_params { struct domain_ml_values* ml_values; /* in */ dom_internal* newdom; /* out */ uintnat unique_id; /* out */ -#ifndef _WIN32 - /* signal mask to set after it is safe to do so */ - sigset_t* mask; /* in */ -#endif }; static void* backup_thread_func(void* v) @@ -1129,11 +1125,9 @@ static void* domain_thread_func(void* v) { struct domain_startup_params* p = v; struct domain_ml_values *ml_values = p->ml_values; -#ifndef _WIN32 - sigset_t mask = *(p->mask); - void * signal_stack; - signal_stack = caml_init_signal_stack(); +#ifndef _WIN32 + void * signal_stack = caml_init_signal_stack(); if (signal_stack == NULL) { caml_fatal_error("Failed to create domain: signal stack"); } @@ -1158,11 +1152,6 @@ static void* domain_thread_func(void* v) if (domain_self) { install_backup_thread(domain_self); -#ifndef _WIN32 - /* It is now safe for us to handle signals */ - pthread_sigmask(SIG_SETMASK, &mask, NULL); -#endif - caml_gc_log("Domain starting (unique_id = %"ARCH_INTNAT_PRINTF_FORMAT"u)", domain_self->interruptor.unique_id); CAML_EV_LIFECYCLE(EV_DOMAIN_SPAWN, getpid()); @@ -1211,9 +1200,6 @@ CAMLprim value caml_domain_spawn(value callback, value term_sync) struct domain_startup_params p; pthread_t th; int err; -#ifndef _WIN32 - sigset_t mask, old_mask; -#endif #ifndef NATIVE_CODE if (caml_debugger_in_use) @@ -1227,20 +1213,7 @@ CAMLprim value caml_domain_spawn(value callback, value term_sync) sizeof(struct domain_ml_values)); init_domain_ml_values(p.ml_values, callback, term_sync); -/* We block all signals while we spawn the new domain. This is because - pthread_create inherits the current signals set, and we want to avoid a - signal handler being triggered in the new domain before the domain_state is - fully populated. */ -#ifndef _WIN32 - sigfillset(&mask); - pthread_sigmask(SIG_BLOCK, &mask, &old_mask); - p.mask = &old_mask; -#endif err = pthread_create(&th, 0, domain_thread_func, (void*)&p); -#ifndef _WIN32 - /* We can restore the signal mask we had initially now. */ - pthread_sigmask(SIG_SETMASK, &old_mask, NULL); -#endif if (err) { caml_failwith("failed to create domain thread"); From 12a3377d678d1a29d616489dc383835ef62ea020 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Fri, 25 Feb 2022 16:31:17 +0100 Subject: [PATCH 027/402] Do not raise from `caml_thread_yield` --- otherlibs/systhreads/st_stubs.c | 14 ++++++++------ runtime/caml/signals.h | 4 ++-- runtime/signals.c | 4 ++-- 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index 0765baacb7d..879498ace10 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -746,17 +746,19 @@ CAMLprim value caml_thread_yield(value unit) if (st_masterlock_waiters(m) == 0) return Val_unit; - /* Do all the parts of a blocking section enter/leave except lock - manipulation, which we'll do more efficiently in st_thread_yield. (Since - our blocking section doesn't contain anything interesting, don't bother - with saving errno.) + /* Do all the parts of a blocking section enter&leave except lock + manipulation, which we will do more efficiently in + st_thread_yield, and asynchronous actions (since + [caml_thread_yield] must not raise). (Since our blocking section + does not contain anything interesting, do not bother saving + errno.) */ - caml_raise_if_exception(caml_process_pending_signals_exn()); save_runtime_state(); st_thread_yield(m); restore_runtime_state(This_thread); - caml_raise_if_exception(caml_process_pending_signals_exn()); + if (Caml_state->action_pending || caml_check_pending_signals()) + caml_set_action_pending(Caml_state); return Val_unit; } diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h index cccce2eee55..f11d7b8345f 100644 --- a/runtime/caml/signals.h +++ b/runtime/caml/signals.h @@ -60,7 +60,7 @@ CAMLextern atomic_uintnat caml_pending_signals[NSIG_WORDS]; #define caml_requested_major_slice (Caml_state_field(requested_major_slice)) #define caml_requested_minor_gc (Caml_state_field(requested_minor_gc)) -int caml_check_pending_signals(void); +CAMLextern int caml_check_pending_signals(void); void caml_request_major_slice (int global); void caml_request_minor_gc (void); CAMLextern int caml_convert_signal_number (int); @@ -68,7 +68,7 @@ CAMLextern int caml_rev_convert_signal_number (int); value caml_execute_signal_exn(int signal_number, int in_signal_handler); CAMLextern void caml_record_signal(int signal_number); CAMLextern value caml_process_pending_signals_exn(void); -void caml_set_action_pending(caml_domain_state *); +CAMLextern void caml_set_action_pending(caml_domain_state *); value caml_do_pending_actions_exn(void); value caml_process_pending_actions_with_root (value extra_root); // raises value caml_process_pending_actions_with_root_exn (value extra_root); diff --git a/runtime/signals.c b/runtime/signals.c index 0be42213587..33525626354 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -45,7 +45,7 @@ CAMLexport atomic_uintnat caml_pending_signals[NSIG_WORDS]; static caml_plat_mutex signal_install_mutex = CAML_PLAT_MUTEX_INITIALIZER; -int caml_check_pending_signals(void) +CAMLexport int caml_check_pending_signals(void) { int i; for (i = 0; i < NSIG_WORDS; i++) { @@ -300,7 +300,7 @@ void caml_request_minor_gc (void) */ /* We assume that we have unique access to dom_st. */ -void caml_set_action_pending(caml_domain_state * dom_st) +CAMLexport void caml_set_action_pending(caml_domain_state * dom_st) { dom_st->action_pending = 1; atomic_store_release(&dom_st->young_limit, (uintnat)-1); From 3f9b1225eda0f21f5c63bd68c6700137be4ce888 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Wed, 23 Feb 2022 21:12:29 +0100 Subject: [PATCH 028/402] Optimal polling in C code based on masking Do not slow down allocations from C when an asynchronous callback cannot be handled immediately. Before this commit, an async action pending in C code, and thus not immediately processed inside allocations, is remembered by leaving [young_limit] to the max value after the allocation. Thus all subsequent allocations go through the slow path until the action is processed. There is also an [action_pending] flag which is a bit redundant in remembering that an async action is pending. This commit introduces a simpler design whereby: - [action_pending] alone is used to remember that an async action is pending, - [young_limit] is only used to interrupt running code in order to notify of new pending actions. When switching from C to OCaml, the value of [action_pending] is used to set [young_limit] for interruption as necessary. This is done when returning from C to OCaml (see RET_FROM_C_CALL) or when calling into an OCaml callback (see caml_update_young_limit_after_c_call). Other relevant changes: - We can always reset [young_limit] to its regular value inside C code and thus avoid the repeated slow path. - We make [action_pending] a _Bool (better code generation for RET_FROM_C_CALL across platforms) - [caml_set_action_pending] no longer immediately interrupts the program; the [action_pending] flag is no longer used in this way. This new design can also be seen as a step towards implementing masking (i.e. delaying async action inside OCaml code blocks just like inside C code). --- otherlibs/systhreads/st_stubs.c | 2 +- runtime/amd64.S | 29 +++++++++++++- runtime/arm64.S | 18 +++++++-- runtime/callback.c | 7 ++++ runtime/caml/domain.h | 1 + runtime/caml/domain_state.tbl | 2 +- runtime/domain.c | 30 ++++++++++---- runtime/interp.c | 4 +- runtime/minor_gc.c | 4 +- runtime/power.S | 13 ++++++- runtime/riscv.S | 13 ++++++- runtime/s390x.S | 11 +++++- runtime/signals.c | 69 ++++++++++++++++++++------------- 13 files changed, 154 insertions(+), 49 deletions(-) diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index 879498ace10..430c2fe7d08 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -757,7 +757,7 @@ CAMLprim value caml_thread_yield(value unit) save_runtime_state(); st_thread_yield(m); restore_runtime_state(This_thread); - if (Caml_state->action_pending || caml_check_pending_signals()) + if (caml_check_pending_signals()) caml_set_action_pending(Caml_state); return Val_unit; diff --git a/runtime/amd64.S b/runtime/amd64.S index 38731b19cab..4acce6cf389 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -684,6 +684,31 @@ ENDFUNCTION(G(caml_allocN)) /* Call a C function from OCaml */ /******************************************************************************/ +/* Update [young_limit] when returning from non-noalloc extern calls. + Here is C code that can be used to generate RET_FROM_C_CALL for a + new back-end. + + #include + #include + + typedef struct { _Atomic(uint64_t) young_limit; + _Bool action_pending; } caml_domain_state; + + void ret_from_c_call(caml_domain_state *dom_st) + { + if (__builtin_expect(dom_st->action_pending, 0)) + atomic_store_explicit(&dom_st->young_limit, (uint64_t)-1, + memory_order_relaxed); + } + +*/ +#define RET_FROM_C_CALL \ + cmpb $0, Caml_state(action_pending); \ + jne 1f; \ + ret; \ +1: movq $-1, Caml_state(young_limit); \ + ret + FUNCTION(G(caml_c_call)) CFI_STARTPROC CFI_SIGNAL_FRAME @@ -716,7 +741,7 @@ LBL(caml_c_call): #endif LEAVE_FUNCTION /* Return to OCaml caller */ - ret + RET_FROM_C_CALL CFI_ENDPROC ENDFUNCTION(G(caml_c_call)) @@ -764,7 +789,7 @@ LBL(106): SWITCH_C_TO_OCAML /* Return to OCaml caller */ LEAVE_FUNCTION - ret + RET_FROM_C_CALL CFI_ENDPROC ENDFUNCTION(G(caml_c_call_stack_args)) diff --git a/runtime/arm64.S b/runtime/arm64.S index 20d866846e9..0c4cf501765 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -417,6 +417,15 @@ FUNCTION(caml_allocN) /* Call a C function from OCaml */ /* Function to call is in ADDITIONAL_ARG */ +.macro RET_FROM_C_CALL + ldrb w16, Caml_state(action_pending) + cbnz w16, 1f + ret +1: mov TMP, #-1 + str TMP, Caml_state(young_limit) + ret +.endm + FUNCTION(caml_c_call) CFI_STARTPROC CFI_OFFSET(29, -16) @@ -437,9 +446,9 @@ FUNCTION(caml_c_call) SWITCH_C_TO_OCAML /* Return */ ldp x29, x30, [sp], 16 - ret + RET_FROM_C_CALL CFI_ENDPROC - END_FUNCTION(caml_c_call) +END_FUNCTION(caml_c_call) FUNCTION(caml_c_call_stack_args) CFI_STARTPROC @@ -478,8 +487,9 @@ FUNCTION(caml_c_call_stack_args) SWITCH_C_TO_OCAML /* Return */ ldp x29, x30, [sp], 16 - ret -CFI_ENDPROC + RET_FROM_C_CALL + CFI_ENDPROC +END_FUNCTION(caml_c_call_stack_args) /* Start the OCaml program */ diff --git a/runtime/callback.c b/runtime/callback.c index 68df624aab8..d39264da634 100644 --- a/runtime/callback.c +++ b/runtime/callback.c @@ -122,6 +122,7 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[]) However, they are never used afterwards, as they were copied into the root [domain_state->current_stack]. */ + caml_update_young_limit_after_c_call(domain_state); res = caml_interprete(callback_code, sizeof(callback_code)); if (Is_exception_result(res)) domain_state->current_stack->sp += narg + 4; /* PR#3419 */ @@ -187,6 +188,7 @@ CAMLexport value caml_callback_exn(value closure, value arg) End_roots(); Begin_roots1(cont); + caml_update_young_limit_after_c_call(domain_state); res = caml_callback_asm(domain_state, closure, &arg); End_roots(); @@ -194,6 +196,7 @@ CAMLexport value caml_callback_exn(value closure, value arg) return res; } else { + caml_update_young_limit_after_c_call(domain_state); return caml_callback_asm(domain_state, closure, &arg); } } @@ -214,6 +217,7 @@ CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2) Begin_roots1(cont); value args[] = {arg1, arg2}; + caml_update_young_limit_after_c_call(domain_state); res = caml_callback2_asm(domain_state, closure, args); End_roots(); @@ -222,6 +226,7 @@ CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2) return res; } else { value args[] = {arg1, arg2}; + caml_update_young_limit_after_c_call(domain_state); return caml_callback2_asm(domain_state, closure, args); } } @@ -243,6 +248,7 @@ CAMLexport value caml_callback3_exn(value closure, Begin_root(cont); value args[] = {arg1, arg2, arg3}; + caml_update_young_limit_after_c_call(domain_state); res = caml_callback3_asm(domain_state, closure, args); End_roots(); @@ -251,6 +257,7 @@ CAMLexport value caml_callback3_exn(value closure, return res; } else { value args[] = {arg1, arg2, arg3}; + caml_update_young_limit_after_c_call(domain_state); return caml_callback3_asm(domain_state, closure, args); } } diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h index 0b6c96fe667..ea21d10a4ab 100644 --- a/runtime/caml/domain.h +++ b/runtime/caml/domain.h @@ -68,6 +68,7 @@ void caml_handle_incoming_interrupts(void); CAMLextern void caml_interrupt_self(void); void caml_interrupt_all_for_signal(void); void caml_reset_young_limit(caml_domain_state *); +void caml_update_young_limit_after_c_call(caml_domain_state *); CAMLextern void caml_reset_domain_lock(void); CAMLextern int caml_bt_is_in_blocking_section(void); diff --git a/runtime/caml/domain_state.tbl b/runtime/caml/domain_state.tbl index 3c1760fa3ac..dd64a87fda2 100644 --- a/runtime/caml/domain_state.tbl +++ b/runtime/caml/domain_state.tbl @@ -37,7 +37,7 @@ DOMAIN_STATE(struct stack_info*, current_stack) DOMAIN_STATE(void*, exn_handler) /* Pointer into the current stack */ -DOMAIN_STATE(int, action_pending) +DOMAIN_STATE(_Bool, action_pending) /* Whether we are due to start the processing of delayable pending actions. See runtime/signal.c. */ diff --git a/runtime/domain.c b/runtime/domain.c index 15a451ecad5..8cc241f5fa6 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -20,6 +20,7 @@ #define _GNU_SOURCE /* For sched.h CPU_ZERO(3) and CPU_COUNT(3) */ #include "caml/config.h" +#include #include #include #include @@ -298,7 +299,12 @@ CAMLexport caml_domain_state* caml_get_domain_state(void) Caml_inline void interrupt_domain(struct interruptor* s) { atomic_uintnat * interrupt_word = atomic_load_relaxed(&s->interrupt_word); - atomic_store_release(interrupt_word, (uintnat)(-1)); + atomic_store_release(interrupt_word, UINTNAT_MAX); +} + +Caml_inline void interrupt_domain_local(caml_domain_state* dom_st) +{ + atomic_store_relaxed(&dom_st->young_limit, UINTNAT_MAX); } int caml_incoming_interrupts_queued(void) @@ -660,7 +666,7 @@ static void domain_create(uintnat initial_minor_heap_wsize) { domain_state->c_stack = NULL; domain_state->exn_handler = NULL; - domain_state->action_pending = 0; + domain_state->action_pending = false; domain_state->gc_regs_buckets = NULL; domain_state->gc_regs = NULL; @@ -1602,19 +1608,29 @@ void caml_reset_young_limit(caml_domain_state * dom_st) /* An interrupt might have been queued in the meanwhile; the atomic_exchange achieves the proper synchronisation with the reads that follow (an atomic_store is not enough). */ - atomic_exchange(&dom_st->young_limit, (uintnat)dom_st->young_trigger); + if (atomic_exchange(&dom_st->young_limit, (uintnat)dom_st->young_trigger) + == UINTNAT_MAX) { + /* In case a signal just arrived, we need to remember that we must + run signal handlers. */ + caml_set_action_pending(dom_st); + } + /* In case of actions that we never delay, interrupt the domain + again immediately. */ dom_internal * d = &all_domains[dom_st->id]; if (atomic_load_relaxed(&d->interruptor.interrupt_pending) || dom_st->requested_minor_gc || dom_st->requested_major_slice || dom_st->major_slice_epoch < atomic_load (&caml_major_slice_epoch) - || atomic_load_relaxed(&dom_st->requested_external_interrupt) - || dom_st->action_pending) { - atomic_store_release(&dom_st->young_limit, (uintnat)-1); - CAMLassert(caml_check_gc_interrupt(dom_st)); + || atomic_load_relaxed(&dom_st->requested_external_interrupt)) { + interrupt_domain_local(dom_st); } } +void caml_update_young_limit_after_c_call(caml_domain_state * dom_st) +{ + if (CAMLunlikely(dom_st->action_pending)) interrupt_domain_local(dom_st); +} + Caml_inline void advance_global_major_slice_epoch (caml_domain_state* d) { uintnat old_value; diff --git a/runtime/interp.c b/runtime/interp.c index 257a0097d5c..27d8c3faf64 100644 --- a/runtime/interp.c +++ b/runtime/interp.c @@ -91,7 +91,9 @@ sp is a local copy of the global variable Caml_state->extern_sp. */ { sp -= 2; sp[0] = env; sp[1] = (value)(pc + 1); \ domain_state->current_stack->sp = sp; } #define Restore_after_c_call \ - { sp = domain_state->current_stack->sp; env = *sp; sp += 2; } + { sp = domain_state->current_stack->sp; env = *sp; sp += 2; \ + caml_update_young_limit_after_c_call(domain_state); \ + } /* For VM threads purposes, an event frame must look like accu + a C_CALL frame + a RETURN 1 frame. diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index 26613e6eb6e..1f2193fa95e 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -819,6 +819,8 @@ void caml_alloc_small_dispatch (caml_domain_state * dom_st, asynchronous callbacks. */ caml_raise_if_exception(caml_do_pending_actions_exn()); else { + /* In the case of allocations performed from C, only perform + non-delayable actions. */ caml_handle_gc_interrupt(); /* We might be here due to a recently-recorded signal, so we need to remember that we must run signal handlers. In @@ -826,7 +828,7 @@ void caml_alloc_small_dispatch (caml_domain_state * dom_st, polls with caml_process_pending_actions, we want to force a query of all callbacks at every minor collection or major slice (similarly to OCaml behaviour). */ - dom_st->action_pending = 1; + caml_set_action_pending(dom_st); } /* Now, there might be enough room in the minor heap to do our diff --git a/runtime/power.S b/runtime/power.S index 1a9f8b93c6e..25d4830f5d4 100644 --- a/runtime/power.S +++ b/runtime/power.S @@ -288,6 +288,15 @@ ENDFUNCTION caml_call_gc /* Call a C function from OCaml. Function to call is in C_CALL_FUN */ +.macro RET_FROM_C_CALL + lbz TMP, Caml_state(action_pending) + cmplwi TMP, 0 + beqlr 0 + li TMP, -1 + std TMP, Caml_state(young_limit) + blr +.endm + FUNCTION caml_c_call .Lcaml_c_call: /* Save return address in caller's frame AND in a callee-save register */ @@ -311,7 +320,7 @@ FUNCTION caml_c_call /* Switch from C to OCaml */ SWITCH_C_TO_OCAML /* Return to caller */ - blr + RET_FROM_C_CALL ENDFUNCTION caml_c_call FUNCTION caml_c_call_stack_args @@ -351,7 +360,7 @@ FUNCTION caml_c_call_stack_args /* Switch from C to OCaml */ SWITCH_C_TO_OCAML /* Return to caller */ - blr + RET_FROM_C_CALL ENDFUNCTION caml_c_call_stack_args /* Raise an exception from OCaml */ diff --git a/runtime/riscv.S b/runtime/riscv.S index c17a7657975..8fc2b85563b 100644 --- a/runtime/riscv.S +++ b/runtime/riscv.S @@ -336,6 +336,15 @@ END_FUNCTION(caml_allocN) /* Call a C function from OCaml */ /* Function to call is in ADDITIONAL_ARG */ +.macro RET_FROM_C_CALL + lbu TMP, Caml_state(action_pending) + bnez TMP, 1f + ret +1: li TMP, -1 + sd TMP, Caml_state(young_limit) + ret +.endm + FUNCTION(caml_c_call) L(caml_c_call): CFI_OFFSET(ra, -8) @@ -356,7 +365,7 @@ L(caml_c_call): /* Return */ ld ra, 8(sp) addi sp, sp, 16 - ret + RET_FROM_C_CALL END_FUNCTION(caml_c_call) FUNCTION(caml_c_call_stack_args) @@ -398,7 +407,7 @@ FUNCTION(caml_c_call_stack_args) /* Return */ ld ra, 8(sp) addi sp, sp, 16 - ret + RET_FROM_C_CALL END_FUNCTION(caml_c_call_stack_args) /* Start the OCaml program */ diff --git a/runtime/s390x.S b/runtime/s390x.S index 76b70719270..a2f19a226e3 100644 --- a/runtime/s390x.S +++ b/runtime/s390x.S @@ -385,6 +385,13 @@ ENDFUNCTION(G(caml_allocN)) /* Call a C function from OCaml */ /******************************************************************************/ +#define RET_FROM_C_CALL \ + cli Caml_state(action_pending), 0; \ + ber %r14; \ + lghi TMP, -1; \ + stg TMP, Caml_state(young_limit); \ + br %r14 + FUNCTION(G(caml_c_call)) CFI_STARTPROC CFI_SIGNAL_FRAME @@ -418,7 +425,7 @@ LBL(caml_c_call): lg %r14, 0(%r15) CFI_RESTORE(14) la %r15, 8(%r15) - br %r14 + RET_FROM_C_CALL CFI_ENDPROC ENDFUNCTION(G(caml_c_call)) @@ -471,7 +478,7 @@ LBL(106): lg %r14, 0(%r15) CFI_RESTORE(14) la %r15, 8(%r15) - br %r14 + RET_FROM_C_CALL CFI_ENDPROC ENDFUNCTION(G(caml_c_call_stack_args)) diff --git a/runtime/signals.c b/runtime/signals.c index 33525626354..5f10bc5a300 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -19,6 +19,7 @@ #include #include +#include #include "caml/config.h" #ifdef USE_MMAP_MAP_STACK #include @@ -200,7 +201,7 @@ CAMLexport void caml_leave_blocking_section(void) So we force the examination of signals as soon as possible. */ - if (Caml_state->action_pending || caml_check_pending_signals()) + if (caml_check_pending_signals()) caml_set_action_pending(Caml_state); errno = saved_errno; @@ -267,43 +268,57 @@ void caml_request_minor_gc (void) } -/* Pending asynchronous actions ([Caml_state->action_pending]) +/* Pending asynchronous actions (the flag [Caml_state->action_pending]) === - There are two kinds of asynchronous actions: - - - Those that cannot be delayed but never call OCaml code (STW - interrupts, requested minor or major GC, forced systhread yield). - - - Those that may raise OCaml exceptions but can be delayed - (asynchronous callbacks, finalisers, memprof callbacks). - - [Caml_state->action_pending] records whether an action of the - second kind is currently pending, and is reset _at the beginning_ - of processing all actions. + [Caml_state->action_pending] records that an asynchronous action + might have been delayed. - Hence, when a delayable action is pending, either - [Caml_state->action_pending] is 1, or there is a function currently - running which is executing all actions. + There are two kinds of asynchronous actions: - This is used to ensure that [Caml_state->young_limit] is always set - appropriately. + - Those that we execute immediately in all circumstances (STW + interrupts, requested minor or major GC, forced systhread yield); + they must never call OCaml code. + + - Those that run OCaml code and may raise OCaml exceptions + (asynchronous callbacks, finalisers, memprof callbacks); those + can be delayed, and do not run during allocations from C. + + Queued asynchronous actions are notified to the domain by setting + [young_limit] to a high value, thereby making the next allocation + fail. When this happens, all non-delayable actions are performed + immediately. Then, the delayable actions are either all processed + immediately, if the context is ready to run OCaml code concurrently + and receive an asynchronous exception (in the case of an allocation + from OCaml), or [Caml_state->action_pending] is set in order to + record that an action of the delayable kind might be pending (in + the case of an allocation from C, typically). + + [Caml_state->action_pending] remains set until the program calls + [caml_process_pending_actions], [caml_leave_blocking_section], or + it returns to OCaml. When returning to OCaml, we set again + [Caml_state->young_limit] to a high value if + [Caml_state->action_pending] is set. + + [Caml_state->action_pending] is then reset _at the beginning_ of + processing all actions. Hence, when a delayable action is pending, + either [Caml_state->action_pending] is true, or there is a function + running which is in process of executing all actions. In case there are two different callbacks (say, a signal and a finaliser) arriving at the same time, then the processing of one awaits the return of the other. In case of long-running callbacks, we may want to run the second one without waiting the end of the first one. We do this by provoking an additional polling every - minor collection and every major slice. To guarantee a low latency - for signals, we avoid delaying signal handlers in that case by - calling them first. + minor collection and every major slice. In order to guarantee a low + latency for signals, we avoid delaying signal handlers in that case + by calling them first. */ /* We assume that we have unique access to dom_st. */ CAMLexport void caml_set_action_pending(caml_domain_state * dom_st) { - dom_st->action_pending = 1; - atomic_store_release(&dom_st->young_limit, (uintnat)-1); + dom_st->action_pending = true; } CAMLexport int caml_check_pending_actions(void) @@ -314,15 +329,17 @@ CAMLexport int caml_check_pending_actions(void) value caml_do_pending_actions_exn(void) { - Caml_state->action_pending = 0; - /* 1. Non-delayable actions that do not run OCaml code. */ /* Do any pending STW interrupt, minor collection or major slice */ caml_handle_gc_interrupt(); /* [young_limit] has now been reset. */ - /* 2. Delayable actions that may raise OCaml exceptions. */ + /* 2. Delayable actions that may raise OCaml exceptions. + + We can now clear the action_pending flag since we are going to + execute all actions. */ + Caml_state->action_pending = false; /* Call signal handlers first */ value exn = caml_process_pending_signals_exn(); From c9af30922da6c2b830ee580686b8a43a698040d2 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Fri, 25 Aug 2023 20:22:31 +0200 Subject: [PATCH 029/402] Reintroduce testcase and make it test the optimal polling --- testsuite/tests/c-api/alloc_async.ml | 17 ++++++++++++----- testsuite/tests/c-api/alloc_async_stubs.c | 18 +++++++++++++++--- 2 files changed, 27 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/c-api/alloc_async.ml b/testsuite/tests/c-api/alloc_async.ml index abbf729bd66..99546fc0afa 100644 --- a/testsuite/tests/c-api/alloc_async.ml +++ b/testsuite/tests/c-api/alloc_async.ml @@ -1,19 +1,26 @@ (* TEST modules = "alloc_async_stubs.c"; - reason = "alloc async changes: https://github.com/ocaml/ocaml/pull/8897"; - skip; *) external test : int ref -> unit = "stub" +external print_status : string -> int -> unit = "print_status_caml" [@@noalloc] + +(* This tests checks that the finaliser does not run during various + allocations from C, but runs at the first polling location in OCaml + code after that. + + See in particular RET_FROM_C_CALL from runtime/amd64.S. + +*) let f () = let r = ref 42 in Gc.finalise (fun s -> r := !s) (ref 17); - Printf.printf "OCaml, before: %d\n%!" !r; + print_status "OCaml, before" !r; test r; - Printf.printf "OCaml, after: %d\n%!" !r; + print_status "OCaml, after" !r; ignore (Sys.opaque_identity (ref 100)); - Printf.printf "OCaml, after alloc: %d\n%!" !r; + print_status "OCaml, after alloc" !r; () let () = (f [@inlined never]) () diff --git a/testsuite/tests/c-api/alloc_async_stubs.c b/testsuite/tests/c-api/alloc_async_stubs.c index a90b6d7f8f4..506da37601e 100644 --- a/testsuite/tests/c-api/alloc_async_stubs.c +++ b/testsuite/tests/c-api/alloc_async_stubs.c @@ -5,6 +5,19 @@ #define CAML_INTERNALS #include "caml/gc_ctrl.h" + +void print_status(const char *str, int n) +{ + printf("%s: %d\n", str, n); + fflush(stdout); +} + +value print_status_caml(value str, value n) +{ + print_status(String_val(str), Int_val(n)); + return Val_unit; +} + const char* strs[] = { "foo", "bar", 0 }; value stub(value ref) { @@ -12,7 +25,7 @@ value stub(value ref) CAMLlocal2(x, y); char* s; intnat coll_before; - printf("C, before: %d\n", Int_val(Field(ref, 0))); + print_status("C, before", Int_val(Field(ref, 0))); /* First, do enough major allocations to do a full major collection cycle */ coll_before = caml_stat_major_collections; @@ -50,7 +63,6 @@ value stub(value ref) free(s); - printf("C, after: %d\n", Int_val(Field(ref, 0))); - fflush(stdout); + print_status("C, after", Int_val(Field(ref, 0))); CAMLreturn (Val_unit); } From bed598819b6e998ed5b5346365c1c811fcf820a1 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Mon, 28 Aug 2023 19:58:49 +0200 Subject: [PATCH 030/402] Simplify caml_reset_young_limit Omit a redundant call to caml_set_action_pending --- runtime/domain.c | 14 ++++++++------ runtime/minor_gc.c | 7 ------- 2 files changed, 8 insertions(+), 13 deletions(-) diff --git a/runtime/domain.c b/runtime/domain.c index 8cc241f5fa6..68b71437c6b 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -1608,12 +1608,7 @@ void caml_reset_young_limit(caml_domain_state * dom_st) /* An interrupt might have been queued in the meanwhile; the atomic_exchange achieves the proper synchronisation with the reads that follow (an atomic_store is not enough). */ - if (atomic_exchange(&dom_st->young_limit, (uintnat)dom_st->young_trigger) - == UINTNAT_MAX) { - /* In case a signal just arrived, we need to remember that we must - run signal handlers. */ - caml_set_action_pending(dom_st); - } + atomic_exchange(&dom_st->young_limit, (uintnat)dom_st->young_trigger); /* In case of actions that we never delay, interrupt the domain again immediately. */ dom_internal * d = &all_domains[dom_st->id]; @@ -1624,6 +1619,13 @@ void caml_reset_young_limit(caml_domain_state * dom_st) || atomic_load_relaxed(&dom_st->requested_external_interrupt)) { interrupt_domain_local(dom_st); } + /* We might be here due to a recently-recorded signal, so we + need to remember that we must run signal handlers. In + addition, in the case of long-running C code (that may + regularly poll with caml_process_pending_actions), we want to + force a query of all callbacks at every minor collection or + major slice (similarly to the OCaml behaviour). */ + caml_set_action_pending(dom_st); } void caml_update_young_limit_after_c_call(caml_domain_state * dom_st) diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index 1f2193fa95e..b9955139fdc 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -822,13 +822,6 @@ void caml_alloc_small_dispatch (caml_domain_state * dom_st, /* In the case of allocations performed from C, only perform non-delayable actions. */ caml_handle_gc_interrupt(); - /* We might be here due to a recently-recorded signal, so we - need to remember that we must run signal handlers. In - addition, in the case of long-running C code that regularly - polls with caml_process_pending_actions, we want to force a - query of all callbacks at every minor collection or major - slice (similarly to OCaml behaviour). */ - caml_set_action_pending(dom_st); } /* Now, there might be enough room in the minor heap to do our From 4fb37db5f5684f003e7842a9f7b998d34d3d8077 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Mon, 28 Aug 2023 22:21:01 +0200 Subject: [PATCH 031/402] Reimplement polling for signals only, in caml_enter_blocking_section This depends on the "Optimal polling" commit --- runtime/signals.c | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/runtime/signals.c b/runtime/signals.c index 5f10bc5a300..fcdabbd69c9 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -159,12 +159,20 @@ CAMLexport void (*caml_enter_blocking_section_hook)(void) = CAMLexport void (*caml_leave_blocking_section_hook)(void) = caml_leave_blocking_section_default; +static int check_pending_actions(caml_domain_state * dom_st); + CAMLexport void caml_enter_blocking_section(void) { caml_domain_state * domain = Caml_state; - while (1){ + while (1) { /* Process all pending signals now */ - caml_process_pending_actions(); + if (check_pending_actions(domain)) { + /* First reset young_limit, and set action_pending in case there + are further async callbacks pending beyond OCaml signal + handlers. */ + caml_handle_gc_interrupt(); + caml_raise_if_exception(caml_process_pending_signals_exn()); + } caml_enter_blocking_section_hook (); /* Check again if a signal arrived in the meanwhile. If none, done; otherwise, try again. Since we do not hold the domain @@ -321,10 +329,15 @@ CAMLexport void caml_set_action_pending(caml_domain_state * dom_st) dom_st->action_pending = true; } +static int check_pending_actions(caml_domain_state * dom_st) +{ + return Caml_check_gc_interrupt(dom_st) || dom_st->action_pending; +} + CAMLexport int caml_check_pending_actions(void) { Caml_check_caml_state(); - return Caml_check_gc_interrupt(Caml_state) || Caml_state->action_pending; + return check_pending_actions(Caml_state); } value caml_do_pending_actions_exn(void) From f9f20023f1a9f4fe29dfc7155e29e548282afc07 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 26 Jan 2023 17:41:23 +0100 Subject: [PATCH 032/402] Changes --- Changes | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Changes b/Changes index cb1ec92d3e9..bce5f1a6e7d 100644 --- a/Changes +++ b/Changes @@ -109,6 +109,16 @@ Working version (Stephen Dolan, report by Chris Casinghino, review by Jeremy Yallop and Xavier Leroy) +- #11307: Finish adapting the implementation of asynchronous actions for + multicore: soundness, liveness, and performance issues. + Do not crash if a signal handler is called from an unregistered C + thread, and other possible soundness issues. Prevent issues where join + on other domains could make the toplevel unresponsible to Ctrl-C. Avoid + needless repeated polling in C code when callbacks cannot run + immediately. + (Guillaume Munch-Maccagnoni, review by Enguerrand Decorne, Xavier + Leroy, and KC Sivaramakrishnan) + ### Code generation and optimizations: - #11239: on x86-64 and RISC-V, reduce alignment of OCaml stacks from 16 to 8. From f6010b97a5fb22b4fc8f7f2de6ca9d05266b3793 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Wed, 13 Sep 2023 20:46:54 +0200 Subject: [PATCH 033/402] Reviewer feedback: improve comment --- runtime/signals.c | 3 ++- testsuite/tests/c-api/alloc_async.ml | 9 ++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/runtime/signals.c b/runtime/signals.c index fcdabbd69c9..ddc12ffcbd1 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -306,7 +306,8 @@ void caml_request_minor_gc (void) [caml_process_pending_actions], [caml_leave_blocking_section], or it returns to OCaml. When returning to OCaml, we set again [Caml_state->young_limit] to a high value if - [Caml_state->action_pending] is set. + [Caml_state->action_pending] is set, to execute asynchronous + actions as soon as possible when back in OCaml code. [Caml_state->action_pending] is then reset _at the beginning_ of processing all actions. Hence, when a delayable action is pending, diff --git a/testsuite/tests/c-api/alloc_async.ml b/testsuite/tests/c-api/alloc_async.ml index 99546fc0afa..b3093e5ba86 100644 --- a/testsuite/tests/c-api/alloc_async.ml +++ b/testsuite/tests/c-api/alloc_async.ml @@ -7,11 +7,10 @@ external print_status : string -> int -> unit = "print_status_caml" [@@noalloc] (* This tests checks that the finaliser does not run during various allocations from C, but runs at the first polling location in OCaml - code after that. - - See in particular RET_FROM_C_CALL from runtime/amd64.S. - -*) + code after that. For native backends, something like + RET_FROM_C_CALL from runtime/amd64.S is necessary, see its + description there and the documentation of + [Caml_state->action_pending] in runtime.signals.c. *) let f () = let r = ref 42 in From a47e554f02342d5a80d97a1925faafcf7c7c3b2b Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Thu, 14 Sep 2023 10:57:50 +0200 Subject: [PATCH 034/402] Changes bookkeeping --- Changes | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Changes b/Changes index cb1ec92d3e9..3ee1e90355b 100644 --- a/Changes +++ b/Changes @@ -273,10 +273,6 @@ Working version - #12446: remove the hooks machinery around channel locking in runtimee/io.c (Gabriel Scherer, review by Xavier Leroy) -- #12509: Use strict prototypes on primitives when generating a standalone - bytecode executable (`ocamlc -custom`). - (Antonin Décimo, review by Xavier Leroy) - - #12389, #12544: centralize the handling of metadata for compilation units and artifacts in preparation for better unicode support for OCaml source files. (Florian Angeletti, review by Gabriel Scherer) @@ -342,16 +338,12 @@ Working version - #12949: open shadowing mistriggers (Gabriel Scherer, review by Florian Angeletti, report by Andreas Rossberg) -- #12486: Fix delivery of unhandled effect exceptions on s390x - (Miod Vallat, report by Jan Midtgaard, review by Vincent Laviron and Xavier - Leroy) - - #12526: Honor `ocaml.inline always` attribute on functions with optional arguments and default values in the Closure backend (Alain Frisch, review by Vincent Laviron) -OCaml 5.1.0 ---------------- +OCaml 5.1.0 (14 September 2023) +------------------------------- ### Restored backends @@ -1077,6 +1069,10 @@ Some of those changes will benefit all OCaml packages. lists for simpler printing of manual references (Stefan Muenzel, review by Florian Angeletti) +- #12509: Use strict prototypes on primitives when generating a standalone + bytecode executable (`ocamlc -custom`). + (Antonin Décimo, review by Xavier Leroy) + ### Build system: - #11844: Reduce verbosity of `make` logs by printing program invocations in @@ -1265,6 +1261,10 @@ Some of those changes will benefit all OCaml packages. - #11186, #11188: Fix composition of coercions with aliases (Vincent Laviron, report and review by Leo White) +- #12486: Fix delivery of unhandled effect exceptions on s390x + (Miod Vallat, report by Jan Midtgaard, review by Vincent Laviron and Xavier + Leroy) + OCaml 5.0.0 (15 December 2022) ------------------------------ From 53dedf18eb79e8f2dbc3edf66e017b2715f7def7 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 14 Sep 2023 12:01:56 +0200 Subject: [PATCH 035/402] Use beqlr+ on Power --- runtime/power.S | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/power.S b/runtime/power.S index 25d4830f5d4..819c2c4310f 100644 --- a/runtime/power.S +++ b/runtime/power.S @@ -291,7 +291,7 @@ ENDFUNCTION caml_call_gc .macro RET_FROM_C_CALL lbz TMP, Caml_state(action_pending) cmplwi TMP, 0 - beqlr 0 + beqlr+ 0 li TMP, -1 std TMP, Caml_state(young_limit) blr From 998cb999eef97f78c55c42099906ade37899c14e Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 14 Sep 2023 15:35:55 +0200 Subject: [PATCH 036/402] Adapt GC alarms for OCaml 5 & improve documentation --- Changes | 3 +++ stdlib/gc.ml | 4 ++-- stdlib/gc.mli | 33 +++++++++++++++++++++++++++------ 3 files changed, 32 insertions(+), 8 deletions(-) diff --git a/Changes b/Changes index 4d733cf9809..78fca83db15 100644 --- a/Changes +++ b/Changes @@ -154,6 +154,9 @@ Working version of modules Int32, Int64, and Nativeint (Xavier Leroy, review by Gabriel Scherer and Daniel Bünzli) +- #12557: Adapt GC alarms for multicore and fix their documentation. + (Guillaume Munch-Maccagnoni, review by) + ### Other libraries: - #12213: Dynlink library, improve legibility of error messages diff --git a/stdlib/gc.ml b/stdlib/gc.ml index 4826131c674..a6de55c8f12 100644 --- a/stdlib/gc.ml +++ b/stdlib/gc.ml @@ -112,15 +112,15 @@ let rec call_alarm arec = Fun.protect ~finally arec.f end +let delete_alarm a = Atomic.set a false let create_alarm f = let arec = { active = Atomic.make true; f = f } in + Domain.at_exit (fun () -> delete_alarm arec.active); finalise call_alarm arec; arec.active -let delete_alarm a = Atomic.set a false - module Memprof = struct type t diff --git a/stdlib/gc.mli b/stdlib/gc.mli index 3d13958c341..a1fca2c59cc 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -391,15 +391,36 @@ val finalise_release : unit -> unit type alarm (** An alarm is a piece of data that calls a user function at the end of - each major GC cycle. The following functions are provided to create + major GC cycle. The following functions are provided to create and delete alarms. *) val create_alarm : (unit -> unit) -> alarm -(** [create_alarm f] will arrange for [f] to be called at the end of each - major GC cycle, not caused by [f] itself, starting with the current - cycle or the next one. - A value of type [alarm] is returned that you can - use to call [delete_alarm]. *) +(** [create_alarm f] will arrange for [f] to be called at the end of + major GC cycles, not caused by [f] itself, starting with the + current cycle or the next one. [f] will run on the same domain that + created the alarm, until the domain exits or [delete_alarm] is + called. A value of type [alarm] is returned that you can use to + call [delete_alarm]. + + It is not guaranteed that the Gc alarm runs at the end of every major + GC cycle, but it is guaranteed that it will run eventually. + + As an example, here is a crude way to interrupt a function if the + memory consumption of the program exceeds a given [limit] in MB, + suitable for use in the toplevel: + + {[ +let run_with_memory_limit (limit : int) (f : unit -> 'a) : 'a = + let limit_memory () = + let mem = Gc.(quick_stat ()).heap_words in + if mem / (1024 * 1024) > limit / (Sys.word_size / 8) then + raise Out_of_memory + in + let alarm = Gc.create_alarm limit_memory in + Fun.protect f ~finally:(fun () -> Gc.delete_alarm alarm ; Gc.compact ()) + ]} + +*) val delete_alarm : alarm -> unit (** [delete_alarm a] will stop the calls to the function associated From 8324eccd8e76dedb720f5e7282cd7b457cc2caf3 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 14 Sep 2023 15:36:46 +0200 Subject: [PATCH 037/402] [minor] Remove outdated and superfluous comment The LIFO character is already mentioned in domain.mli. --- stdlib/domain.ml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/stdlib/domain.ml b/stdlib/domain.ml index a1a923f890a..6cb6ef34c84 100644 --- a/stdlib/domain.ml +++ b/stdlib/domain.ml @@ -177,10 +177,6 @@ let at_exit_key = DLS.new_key (fun () -> (fun () -> ())) let at_exit f = let old_exit : unit -> unit = DLS.get at_exit_key in let new_exit () = - (* The domain termination callbacks ([at_exit]) are run in - last-in-first-out (LIFO) order in order to be symmetric with the domain - creation callbacks ([at_each_spawn]) which run in first-in-fisrt-out - (FIFO) order. *) f (); old_exit () in DLS.set at_exit_key new_exit From 4bac7d0e78b1e8303fcca46ce48afdac3d968093 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 14 Sep 2023 15:59:09 +0200 Subject: [PATCH 038/402] Update Changes --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 78fca83db15..656467bccdf 100644 --- a/Changes +++ b/Changes @@ -154,7 +154,7 @@ Working version of modules Int32, Int64, and Nativeint (Xavier Leroy, review by Gabriel Scherer and Daniel Bünzli) -- #12557: Adapt GC alarms for multicore and fix their documentation. +- #12558: Adapt GC alarms for multicore and fix their documentation. (Guillaume Munch-Maccagnoni, review by) ### Other libraries: From d4a0e45b4f458a627ae2d6b39e416ecddff09356 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 14 Sep 2023 16:01:52 +0200 Subject: [PATCH 039/402] make alldepend --- stdlib/.depend | 2 ++ 1 file changed, 2 insertions(+) diff --git a/stdlib/.depend b/stdlib/.depend index 2ec28052e0e..35298eda380 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -359,6 +359,7 @@ stdlib__Gc.cmo : gc.ml \ stdlib__Printf.cmi \ stdlib__Printexc.cmi \ stdlib__Fun.cmi \ + stdlib__Domain.cmi \ stdlib__Atomic.cmi \ stdlib__Gc.cmi stdlib__Gc.cmx : gc.ml \ @@ -367,6 +368,7 @@ stdlib__Gc.cmx : gc.ml \ stdlib__Printf.cmx \ stdlib__Printexc.cmx \ stdlib__Fun.cmx \ + stdlib__Domain.cmx \ stdlib__Atomic.cmx \ stdlib__Gc.cmi stdlib__Gc.cmi : gc.mli \ From de050b48b8e1ccd2b15ab6f146029337a81808e6 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 14 Sep 2023 18:11:38 +0200 Subject: [PATCH 040/402] Improve TSan-related comments in amd64.S --- runtime/amd64.S | 41 ++++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/runtime/amd64.S b/runtime/amd64.S index 38731b19cab..83f7f57cf35 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -569,7 +569,8 @@ G(caml_system__code_begin): #define TSAN_SAVE_CALLER_REGS #endif -/* Undo TSAN_SAVE_CALLER_REGS. Expects gc_regs bucket in %r15 */ +/* Restore registers saved by TSAN_SAVE_CALLER_REGS. Expects gc_regs bucket in + %r15 */ #ifdef WITH_THREAD_SANITIZER #define TSAN_RESTORE_CALLER_REGS \ /* Restore %rax, freeing up the next ptr slot */ \ @@ -706,6 +707,7 @@ LBL(caml_c_call): /* Load ocaml stack and restore global variables */ SWITCH_C_TO_OCAML #ifdef WITH_THREAD_SANITIZER + /* Save non-callee-saved registers %rax and %xmm0 before C call */ pushq %rax; CFI_ADJUST(8); subq $16, %rsp; CFI_ADJUST(16); movupd %xmm0, (%rsp) @@ -778,9 +780,10 @@ CFI_STARTPROC /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS #if defined(WITH_THREAD_SANITIZER) - /* TSan enter function from C */ - pushq C_ARG_1 - movq 56(%rsp), C_ARG_1 + /* We can't use the TSAN_ENTER_FUNCTION macro as it assumes an OCaml stack, + and we are on a C stack. */ + pushq C_ARG_1 /* Save C_ARG_1 before C call */ + movq 56(%rsp), C_ARG_1 /* Read return address */ C_call (GCALL(__tsan_func_entry)) popq C_ARG_1 #endif @@ -857,8 +860,9 @@ LBL(108): movq %r10, Caml_state(c_stack) addq $SIZEOF_C_STACK_LINK, %rsp; CFI_ADJUST(-SIZEOF_C_STACK_LINK) #if defined(WITH_THREAD_SANITIZER) - /* TSan exit function from C */ - pushq %rax + /* We can't use the TSAN_EXIT_FUNCTION macro as it assumes an OCaml stack, + and we are on a C stack. */ + pushq %rax /* Save %rax before C call */ movq $0, C_ARG_1 C_call (GCALL(__tsan_func_exit)) popq %rax @@ -916,6 +920,8 @@ LBL(117): C_call (GCALL(caml_stash_backtrace)) #if defined(WITH_THREAD_SANITIZER) LBL(118): + /* Signal to TSan all stack frames exited by the exception. No need to save + any registers here. */ movq STACK_RETADDR(%r13), C_ARG_1 /* arg 1: pc of raise */ leaq STACK_ARG_1(%r13), C_ARG_2 /* arg 2: sp at raise */ movq Caml_state(exn_handler), C_ARG_3 /* arg 3: sp of handler */ @@ -981,11 +987,11 @@ ENDFUNCTION(G(caml_raise_exception)) FUNCTION(G(caml_callback_asm)) CFI_STARTPROC #if defined(WITH_THREAD_SANITIZER) - /* TSan enter function from C */ + /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call */ pushq C_ARG_1 pushq C_ARG_2 pushq C_ARG_3 - movq 24(%rsp), C_ARG_1 + movq 24(%rsp), C_ARG_1 /* Read return address */ C_call (GCALL(__tsan_func_entry)) popq C_ARG_3 popq C_ARG_2 @@ -1007,11 +1013,11 @@ ENDFUNCTION(G(caml_callback_asm)) FUNCTION(G(caml_callback2_asm)) CFI_STARTPROC #if defined(WITH_THREAD_SANITIZER) - /* TSan enter function from C */ + /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call */ pushq C_ARG_1 pushq C_ARG_2 pushq C_ARG_3 - movq 24(%rsp), C_ARG_1 + movq 24(%rsp), C_ARG_1 /* Read return address */ C_call (GCALL(__tsan_func_entry)) popq C_ARG_3 popq C_ARG_2 @@ -1033,11 +1039,11 @@ ENDFUNCTION(G(caml_callback2_asm)) FUNCTION(G(caml_callback3_asm)) CFI_STARTPROC #if defined(WITH_THREAD_SANITIZER) - /* TSan enter function from C */ + /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call */ pushq C_ARG_1 pushq C_ARG_2 pushq C_ARG_3 - movq 24(%rsp), C_ARG_1 + movq 24(%rsp), C_ARG_1 /* Read return address */ C_call (GCALL(__tsan_func_entry)) popq C_ARG_3 popq C_ARG_2 @@ -1080,6 +1086,7 @@ LBL(do_perform): cmpq $0, %r10 /* parent is NULL? */ je LBL(112) #if defined(WITH_THREAD_SANITIZER) + /* Signal to TSan all stack frames exited by the perform. */ TSAN_SAVE_CALLER_REGS movq (%rsp), C_ARG_1 /* arg 1: pc of perform */ leaq 8(%rsp), C_ARG_2 /* arg 2: sp at perform */ @@ -1148,12 +1155,15 @@ CFI_STARTPROC testq %r10, %r10 jz 2f #if defined(WITH_THREAD_SANITIZER) + /* Save non-callee-saved registers %rax and %r10 before C call */ pushq %rax; CFI_ADJUST(8); pushq %r10; CFI_ADJUST(8); + /* Necessary to include the caller of caml_resume in the TSan backtrace */ TSAN_ENTER_FUNCTION(16) popq %r10; CFI_ADJUST(-8); popq %rax; CFI_ADJUST(-8); TSAN_SAVE_CALLER_REGS + /* Signal to TSan all stack frames exited by the perform. */ movq Stack_sp(%r10), %r11 movq (%r11), C_ARG_1 /* arg 1: pc of perform */ leaq 8(%r11), C_ARG_2 /* arg 2: sp at perform */ @@ -1177,7 +1187,8 @@ CFI_STARTPROC UPDATE_BASE_POINTER(%rcx) SWITCH_OCAML_STACKS jmp *(%rbx) -2: TSAN_ENTER_FUNCTION(0) +2: TSAN_ENTER_FUNCTION(0) /* Necessary to include the caller of caml_resume + in the TSan backtrace */ LEA_VAR(caml_raise_continuation_already_resumed, %rax) jmp LBL(caml_c_call) CFI_ENDPROC @@ -1190,8 +1201,10 @@ CFI_STARTPROC CFI_SIGNAL_FRAME ENTER_FUNCTION #ifdef WITH_THREAD_SANITIZER + /* Save non-callee-saved registers %rax and %rdi before C call */ pushq %rax; CFI_ADJUST(8); pushq %rdi; CFI_ADJUST(8); + /* Necessary to include the caller of caml_runstack in TSan backtrace */ TSAN_ENTER_FUNCTION(16) popq %rdi; CFI_ADJUST(-8); popq %rax; CFI_ADJUST(-8); @@ -1252,6 +1265,7 @@ LBL(frame_runstack): /* switch directly to parent stack with correct return */ movq %r13, %rsp CFI_RESTORE_STATE + /* signal to TSan that we exit caml_runstack (no registers to save here) */ TSAN_EXIT_FUNCTION movq %r12, %rax /* Invoke handle_value (or handle_exn) */ @@ -1267,6 +1281,7 @@ ENDFUNCTION(G(caml_runstack)) FUNCTION(G(caml_ml_array_bound_error)) CFI_STARTPROC ENTER_FUNCTION + /* No registers require saving before C call to TSan */ TSAN_ENTER_FUNCTION(0) LEA_VAR(caml_array_bound_error_asm, %rax) jmp LBL(caml_c_call) From f5a40e0cc9588b72df5b7b0c394726659076487a Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 14 Sep 2023 18:44:36 +0200 Subject: [PATCH 041/402] Fix long lines --- runtime/amd64.S | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/runtime/amd64.S b/runtime/amd64.S index 83f7f57cf35..72cea5b7c41 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -987,7 +987,8 @@ ENDFUNCTION(G(caml_raise_exception)) FUNCTION(G(caml_callback_asm)) CFI_STARTPROC #if defined(WITH_THREAD_SANITIZER) - /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call */ + /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call + */ pushq C_ARG_1 pushq C_ARG_2 pushq C_ARG_3 @@ -1013,7 +1014,8 @@ ENDFUNCTION(G(caml_callback_asm)) FUNCTION(G(caml_callback2_asm)) CFI_STARTPROC #if defined(WITH_THREAD_SANITIZER) - /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call */ + /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call + */ pushq C_ARG_1 pushq C_ARG_2 pushq C_ARG_3 @@ -1039,7 +1041,8 @@ ENDFUNCTION(G(caml_callback2_asm)) FUNCTION(G(caml_callback3_asm)) CFI_STARTPROC #if defined(WITH_THREAD_SANITIZER) - /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call */ + /* Save non-callee-saved registers C_ARG_1, C_ARG_2, C_ARG_3 before C call + */ pushq C_ARG_1 pushq C_ARG_2 pushq C_ARG_3 From 2922b0046e983a454e333251b04d899ec52ac47c Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Fri, 15 Sep 2023 08:58:36 -0400 Subject: [PATCH 042/402] Add Changes --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index 72353b8208f..adfd88dec2c 100644 --- a/Changes +++ b/Changes @@ -261,6 +261,9 @@ Working version (Nick Roberts; review by Richard Eisenberg, Leo White, and Gabriel Scherer; RFC by Stephen Dolan) +- #12542: Minor bugfix to #12236: restore dropped call to `instance` + (Nick Roberts, review by Jacques Garrigue) + - #12242: Move the computation of stack frame parameters to a separate `Stackframe` module, and save the parameters in the results of the `Linearize` pass From 0f950f747504b6e8ddebd87e9dadc17bd81dc344 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Fri, 15 Sep 2023 08:59:00 -0400 Subject: [PATCH 043/402] Minor style tweak from review --- typing/typecore.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/typing/typecore.ml b/typing/typecore.ml index 29bd2b893a5..33326d3f4ac 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -3808,12 +3808,11 @@ and type_expect_ exp_env = env } | Pexp_constraint (sarg, sty) -> let (ty, exp_extra) = type_constraint env sty in - let ty' = instance ty in let arg = type_argument env sarg ty (instance ty) in rue { exp_desc = arg.exp_desc; exp_loc = arg.exp_loc; - exp_type = ty'; + exp_type = instance ty; exp_attributes = arg.exp_attributes; exp_env = env; exp_extra = (exp_extra, loc, sexp.pexp_attributes) :: arg.exp_extra; From ef37369445cdc9a003ce2ddef394bee21dd65c57 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Mon, 24 Jul 2023 17:22:34 +0200 Subject: [PATCH 044/402] Look for pthread libraries first, then only for get_pthreadaffinity_np Until now the test involving get_pthreadaffinity_np occurred before the detection of which libraries to use to enable pthread support. This commit reorders these two steps. --- configure | 118 +++++++++++++++++++++++++-------------------------- configure.ac | 54 +++++++++++------------ 2 files changed, 86 insertions(+), 86 deletions(-) diff --git a/configure b/configure index da48d8f472a..f9462e4e853 100755 --- a/configure +++ b/configure @@ -18260,65 +18260,6 @@ then : fi -## pthread_getaffinity_np, args differ from GNU and BSD -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking arguments for pthread_getaffinity_np" >&5 -printf %s "checking arguments for pthread_getaffinity_np... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#define _GNU_SOURCE - #include - #include -int -main (void) -{ -cpu_set_t cs; - CPU_ZERO(&cs); - CPU_COUNT(&cs); - pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO" -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: gnu" >&5 -printf "%s\n" "gnu" >&6; } - printf "%s\n" "#define HAS_GNU_GETAFFINITY_NP 1" >>confdefs.h - -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - #include -int -main (void) -{ -cpuset_t cs; - /* Not every BSD has CPU_ZERO and CPU_COUNT (NetBSD) */ - CPU_ZERO(&cs); - CPU_COUNT(&cs); - pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO" -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: BSD" >&5 -printf "%s\n" "BSD" >&6; } - printf "%s\n" "#define HAS_BSD_GETAFFINITY_NP 1" >>confdefs.h - -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: pthread_getaffinity_np not found" >&5 -printf "%s\n" "pthread_getaffinity_np not found" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext - if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 @@ -19340,6 +19281,65 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu ;; esac +## pthread_getaffinity_np, args differ from GNU and BSD +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking arguments for pthread_getaffinity_np" >&5 +printf %s "checking arguments for pthread_getaffinity_np... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _GNU_SOURCE + #include + #include +int +main (void) +{ +cpu_set_t cs; + CPU_ZERO(&cs); + CPU_COUNT(&cs); + pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: GNU" >&5 +printf "%s\n" "GNU" >&6; } + printf "%s\n" "#define HAS_GNU_GETAFFINITY_NP 1" >>confdefs.h + +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + #include + #include +int +main (void) +{ +cpuset_t cs; + /* Not every BSD has CPU_ZERO and CPU_COUNT (NetBSD) */ + CPU_ZERO(&cs); + CPU_COUNT(&cs); + pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: BSD" >&5 +printf "%s\n" "BSD" >&6; } + printf "%s\n" "#define HAS_BSD_GETAFFINITY_NP 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: pthread_getaffinity_np not found" >&5 +printf "%s\n" "pthread_getaffinity_np not found" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + ## Activate the systhread library case $enable_systhreads,$enable_unix_lib in #( diff --git a/configure.ac b/configure.ac index 2f1cb8bba4a..b9b07f956a2 100644 --- a/configure.ac +++ b/configure.ac @@ -2078,33 +2078,6 @@ AC_CHECK_HEADER([spawn.h], AC_CHECK_FUNC([ffs], [AC_DEFINE([HAS_FFS])]) AC_CHECK_FUNC([_BitScanForward], [AC_DEFINE([HAS_BITSCANFORWARD])]) -## pthread_getaffinity_np, args differ from GNU and BSD -AC_MSG_CHECKING([arguments for pthread_getaffinity_np]) -AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#define _GNU_SOURCE - #include - #include ]], - [[cpu_set_t cs; - CPU_ZERO(&cs); - CPU_COUNT(&cs); - pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs);]])], - [AC_MSG_RESULT([gnu]) - AC_DEFINE([HAS_GNU_GETAFFINITY_NP])], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include - #include - #include ]], - [[cpuset_t cs; - /* Not every BSD has CPU_ZERO and CPU_COUNT (NetBSD) */ - CPU_ZERO(&cs); - CPU_COUNT(&cs); - pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs);]])], - [AC_MSG_RESULT([BSD]) - AC_DEFINE([HAS_BSD_GETAFFINITY_NP])], - [AC_MSG_RESULT([pthread_getaffinity_np not found])])]) - AC_PATH_TOOL([PKG_CONFIG], [pkg-config], [false]) ## ZSTD compression library @@ -2183,6 +2156,33 @@ AS_CASE([$host], [AC_MSG_ERROR(m4_normalize([POSIX threads are required but not supported on this platform]))])]) +## pthread_getaffinity_np, args differ from GNU and BSD +AC_MSG_CHECKING([arguments for pthread_getaffinity_np]) +AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#define _GNU_SOURCE + #include + #include ]], + [[cpu_set_t cs; + CPU_ZERO(&cs); + CPU_COUNT(&cs); + pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs);]])], + [AC_MSG_RESULT([GNU]) + AC_DEFINE([HAS_GNU_GETAFFINITY_NP])], + [AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + #include + #include ]], + [[cpuset_t cs; + /* Not every BSD has CPU_ZERO and CPU_COUNT (NetBSD) */ + CPU_ZERO(&cs); + CPU_COUNT(&cs); + pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs);]])], + [AC_MSG_RESULT([BSD]) + AC_DEFINE([HAS_BSD_GETAFFINITY_NP])], + [AC_MSG_RESULT([pthread_getaffinity_np not found])])]) + ## Activate the systhread library AS_CASE([$enable_systhreads,$enable_unix_lib], From 2b6080db0cfcaa148ad5410fed0f02b755e12def Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Fri, 15 Sep 2023 16:30:41 +0200 Subject: [PATCH 045/402] Take pthread-specific CFLAGS and LIBS into account correctly --- configure | 7 +++---- configure.ac | 9 ++++----- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/configure b/configure index f9462e4e853..a99ab8043ef 100755 --- a/configure +++ b/configure @@ -19254,8 +19254,9 @@ test -n "$PTHREAD_CXX" || PTHREAD_CXX="$CXX" # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: if test "x$ax_pthread_ok" = "xyes"; then common_cflags="$common_cflags $PTHREAD_CFLAGS" - saved_CFLAGS="$CFLAGS" - saved_LIBS="$LIBS" + # The two following lines add flags and libraries for pthread to the + # global CFLAGS and LIBS variables. This means that all the subsequent + # tests can rely on the assumption that pthread is enabled. CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LIBS="$LIBS $PTHREAD_LIBS" ac_fn_c_check_func "$LINENO" "sigwait" "ac_cv_func_sigwait" @@ -19265,8 +19266,6 @@ then : fi - LIBS="$saved_LIBS" - CFLAGS="$saved_CFLAGS" : else ax_pthread_ok=no diff --git a/configure.ac b/configure.ac index b9b07f956a2..c9439ac689b 100644 --- a/configure.ac +++ b/configure.ac @@ -2146,13 +2146,12 @@ AS_CASE([$host], [PTHREAD_LIBS="-l:libpthread.lib"], [AX_PTHREAD( [common_cflags="$common_cflags $PTHREAD_CFLAGS" - saved_CFLAGS="$CFLAGS" - saved_LIBS="$LIBS" + # The two following lines add flags and libraries for pthread to the + # global CFLAGS and LIBS variables. This means that all the subsequent + # tests can rely on the assumption that pthread is enabled. CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LIBS="$LIBS $PTHREAD_LIBS" - AC_CHECK_FUNC([sigwait], [AC_DEFINE([HAS_SIGWAIT])]) - LIBS="$saved_LIBS" - CFLAGS="$saved_CFLAGS"], + AC_CHECK_FUNC([sigwait], [AC_DEFINE([HAS_SIGWAIT])])], [AC_MSG_ERROR(m4_normalize([POSIX threads are required but not supported on this platform]))])]) From 22df6184b6fb54fb457ffcca034589cbc29abed9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Sat, 29 Jul 2023 10:52:28 +0200 Subject: [PATCH 046/402] Fix the configure test for pthread_getaffinity_np The C test program should include the right header files to avoid warnings. --- configure | 3 +++ configure.ac | 3 +++ 2 files changed, 6 insertions(+) diff --git a/configure b/configure index a99ab8043ef..5de79491162 100755 --- a/configure +++ b/configure @@ -19287,6 +19287,9 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _GNU_SOURCE #include + #ifdef HAS_PTHREAD_NP_H + #include + #endif #include int main (void) diff --git a/configure.ac b/configure.ac index c9439ac689b..dd4c19ead17 100644 --- a/configure.ac +++ b/configure.ac @@ -2161,6 +2161,9 @@ AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[#define _GNU_SOURCE #include + #ifdef HAS_PTHREAD_NP_H + #include + #endif #include ]], [[cpu_set_t cs; CPU_ZERO(&cs); From 64b56a47027a1260368425460c6af369b0e912c7 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Sat, 16 Sep 2023 20:22:26 +0100 Subject: [PATCH 047/402] Disable the nonreturning-statement warning for `while true` in more cases. --- Changes | 3 ++- testsuite/tests/typing-warnings/never_returns.ml | 7 +++++++ typing/typecore.ml | 9 +++++---- 3 files changed, 14 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index 88e36d7e31b..1cc41660f4d 100644 --- a/Changes +++ b/Changes @@ -8,7 +8,8 @@ Working version ### Language features: -- #12295: Give `while true' a polymorphic type, similarly to `assert false' +- #12295, #12568: Give `while true' a polymorphic type, similarly to + `assert false' (Jeremy Yallop, review by Nicolás Ojeda Bär and Gabriel Scherer, suggestion by Rodolphe Lepigre and John Whitington) diff --git a/testsuite/tests/typing-warnings/never_returns.ml b/testsuite/tests/typing-warnings/never_returns.ml index feb8c040d12..b77354771bc 100644 --- a/testsuite/tests/typing-warnings/never_returns.ml +++ b/testsuite/tests/typing-warnings/never_returns.ml @@ -10,6 +10,13 @@ fun () -> while true do () done; 3;; - : unit -> int = |}];; +(** For now, we don't warn for non-terminating while loops, for backwards compatibility. *) +fun () -> (if true then while true do () done else while true do () done); 3;; + +[%%expect{| +- : unit -> int = +|}];; + let () = (let module L = List in raise Exit); () ;; [%%expect {| Line 1, characters 33-43: diff --git a/typing/typecore.ml b/typing/typecore.ml index 9487d8895ae..4668a58a152 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -5477,18 +5477,19 @@ and type_statement ?explanation env sexp = 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.pexp_desc with - | Pexp_while _ -> true + let allow_polymorphic e = match e.exp_desc with + | Texp_while _ -> true | _ -> 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 && get_level ty > get_current_level () - && not (allow_polymorphic sexp) then + && not (allow_polymorphic subexp) then Location.prerr_warning - (final_subexpression exp).exp_loc + subexp.exp_loc Warnings.Nonreturning_statement; if !Clflags.strict_sequence then let expected_ty = instance Predef.type_unit in From ad868faff091eae242ee5625f9f8764a3cce5869 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Sep 2023 07:12:10 +0200 Subject: [PATCH 048/402] reviewers for #12558 --- Changes | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index c49270aa8e4..732792b0dbf 100644 --- a/Changes +++ b/Changes @@ -156,7 +156,8 @@ Working version (Xavier Leroy, review by Gabriel Scherer and Daniel Bünzli) - #12558: Adapt GC alarms for multicore and fix their documentation. - (Guillaume Munch-Maccagnoni, review by) + (Guillaume Munch-Maccagnoni, review by KC Sivaramakrishnan + and Gabriel Scherer) ### Other libraries: From 3707da6397cf4e5d9c69d3f31045307f1a96cbf4 Mon Sep 17 00:00:00 2001 From: Swrup Date: Sun, 17 Sep 2023 17:04:55 +0200 Subject: [PATCH 049/402] documentation: fix make_formatter code example --- stdlib/format.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stdlib/format.mli b/stdlib/format.mli index aba1303f4f9..112495a0308 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -1041,7 +1041,7 @@ val make_formatter : For instance, {[ make_formatter - (Stdlib.output oc) + (Stdlib.output_substring oc) (fun () -> Stdlib.flush oc) ]} returns a formatter to the {!Stdlib.out_channel} [oc]. From c45c47b137e88c8627338c4e1343e9172f627b75 Mon Sep 17 00:00:00 2001 From: Swrup Date: Sun, 17 Sep 2023 17:30:55 +0200 Subject: [PATCH 050/402] documentation: fix typo --- stdlib/lazy.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stdlib/lazy.mli b/stdlib/lazy.mli index b9f3059adfc..0dbdadbd30e 100644 --- a/stdlib/lazy.mli +++ b/stdlib/lazy.mli @@ -116,7 +116,7 @@ val map_val : ('a -> 'b) -> 'a t -> 'b t (** {1 Advanced} The following definitions are for advanced uses only; they require - familiary with the lazy compilation scheme to be used appropriately. *) + familiarity with the lazy compilation scheme to be used appropriately. *) val from_fun : (unit -> 'a) -> 'a t (** [from_fun f] is the same as [lazy (f ())] but slightly more efficient. From 670481e53fcd411c530bb0a1ffe8ab9138782e41 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Mon, 18 Sep 2023 13:16:22 +0200 Subject: [PATCH 051/402] Added sentence about libzstd. --- INSTALL.adoc | 3 +++ 1 file changed, 3 insertions(+) diff --git a/INSTALL.adoc b/INSTALL.adoc index 8c0a1e47498..cb9d61d8dd6 100644 --- a/INSTALL.adoc +++ b/INSTALL.adoc @@ -38,6 +38,9 @@ * If you do not have write access to `/tmp`, you should set the environment variable `TMPDIR` to the name of some other temporary directory. +* The zstd library is used for compression of marshaled data, if it is not available + the option `--without-zstd` should be passed to `configure` disabling it. + == Prerequisites (special cases) * Under Cygwin, the `gcc-core` package is required. `flexdll` is also necessary From 795cad3c52fc3a7032243f33743858a024849993 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Sep 2023 22:37:47 +0200 Subject: [PATCH 052/402] Makefile: build `runtop` without `otherlibraries` This shortens a cold build from 1m20s to 40s on my machine. If you want to test an otheribs/ library (Unix, Str, etc.) from the toplevel, use the new target `runtop-with-otherlibs`. --- Changes | 4 ++++ HACKING.adoc | 2 ++ Makefile | 18 +++++++++++++----- 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index 732792b0dbf..4b5ee2ff5dc 100644 --- a/Changes +++ b/Changes @@ -304,6 +304,10 @@ Working version started with #11243, #11248, #11268, #11420 and #11675. (Sébastien Hinderer, review by David Allsopp and Florian Angeletti) +- #12569, #12570: remove 'otherlibraries' as a prerequisite for 'runtop'; + use 'runtop-with-otherlibs' to use a library from otherlibs/ + (Gabriel Scherer, review by Sébastien Hinderer, suggestion by David Allsopp) + ### Bug fixes: - #12490: Unix: protect the popen_processes hashtable with a mutex diff --git a/HACKING.adoc b/HACKING.adoc index afbd65d9756..e8bfdc47788 100644 --- a/HACKING.adoc +++ b/HACKING.adoc @@ -399,6 +399,8 @@ installation, the following targets may be of use: `make runtop` :: builds and runs the ocaml toplevel of the distribution (optionally uses `rlwrap` for readline+history support) + (use `make runtop-with-otherlibs` if you need `Unix` or other + `otherlibs/` libraries) `make natruntop`:: builds and runs the native ocaml toplevel (experimental) `make partialclean`:: Clean the OCaml files but keep the compiled C files. diff --git a/Makefile b/Makefile index 59343613778..a12048719c3 100644 --- a/Makefile +++ b/Makefile @@ -535,23 +535,31 @@ partialclean:: TOPFLAGS ?= OC_TOPFLAGS = $(STDLIBFLAGS) -I toplevel -noinit $(TOPINCLUDES) $(TOPFLAGS) -# Note: Beware that, since this rule begins with a coldstart, both +RUN_OCAML = $(RLWRAP) $(OCAMLRUN) ./ocaml$(EXE) $(OC_TOPFLAGS) +RUN_OCAMLNAT = $(RLWRAP) ./ocamlnat$(EXE) $(OC_TOPFLAGS) + +# Note: Beware that, since these rules begin with a coldstart, both # boot/ocamlrun and runtime/ocamlrun will be the same when the toplevel # is run. .PHONY: runtop -runtop: - $(MAKE) coldstart +runtop: coldstart + $(MAKE) ocamlc + $(MAKE) ocaml + @$(RUN_OCAML) + +.PHONY: runtop-with-otherlibs +runtop-with-otherlibs: coldstart $(MAKE) ocamlc $(MAKE) otherlibraries $(MAKE) ocaml - @$(RLWRAP) $(OCAMLRUN) ./ocaml$(EXE) $(OC_TOPFLAGS) + @$(RUN_OCAML) .PHONY: natruntop natruntop: $(MAKE) core $(MAKE) opt $(MAKE) ocamlnat - @$(RLWRAP) ./ocamlnat$(EXE) $(OC_TOPFLAGS) + @$(RUN_OCAMLNAT) # Native dynlink From 87744253ab4c5387b9b6b0d7cb24e26c6ecd3438 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 15 Sep 2023 22:39:35 +0200 Subject: [PATCH 053/402] caml_output_value_to_malloc: really use malloc External users (unison, hhvm, pyre-check) assume that the memory they get from `caml_output_value_to_malloc` can be freed with `free`. The function was changed to use caml_stat_alloc in 4.06 ( 02a8b999f08dcbf6cfcdc1145f3286392d26ad52 ); this breaks user code, as one should then use `caml_stat_free`. There is no use of caml_output_value_to_malloc in the runtime itself, so we do not need to provide a caml_output_value_to_stat_alloc variant. --- Changes | 5 +++++ runtime/extern.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index 732792b0dbf..66f5f630b32 100644 --- a/Changes +++ b/Changes @@ -306,6 +306,11 @@ Working version ### Bug fixes: +- #12566: caml_output_value_to_malloc wrongly uses `caml_stat_alloc` + instead of `malloc` since 4.06, breaking (in pooled mode) user code + that uses `free` on the result. + (Gabriel Scherer, review by Enguerrand Decorne, report by Ido Yariv) + - #12490: Unix: protect the popen_processes hashtable with a mutex (Gabriel Scherer, report by Olivier Nicole, review by Xavier Leroy) diff --git a/runtime/extern.c b/runtime/extern.c index 6d85fca4c11..65bbfa9cfc0 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -1189,7 +1189,7 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags, init_extern_output(s); data_len = extern_value(s, v, flags, header, &header_len); - res = caml_stat_alloc_noexc(header_len + data_len); + res = malloc(header_len + data_len); if (res == NULL) extern_out_of_memory(s); *buf = res; *len = header_len + data_len; From df01ee7934431d036b19be0a846c331ff207a3dd Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 18 Sep 2023 14:11:44 +0200 Subject: [PATCH 054/402] caml_input_value_from_malloc; use free in error cases --- Changes | 6 ++++-- runtime/intern.c | 21 ++++++++++++++------- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/Changes b/Changes index 66f5f630b32..dde4cdf0e36 100644 --- a/Changes +++ b/Changes @@ -308,8 +308,10 @@ Working version - #12566: caml_output_value_to_malloc wrongly uses `caml_stat_alloc` instead of `malloc` since 4.06, breaking (in pooled mode) user code - that uses `free` on the result. - (Gabriel Scherer, review by Enguerrand Decorne, report by Ido Yariv) + that uses `free` on the result. Symmetrically, + caml_input_value_from_malloc should use `free`. + (Gabriel Scherer, review by Xavier Leroy and Enguerrand Decorne, + report by Ido Yariv) - #12490: Unix: protect the popen_processes hashtable with a mutex (Gabriel Scherer, report by Olivier Nicole, review by Xavier Leroy) diff --git a/runtime/intern.c b/runtime/intern.c index db9cb4ac517..dab7d83d5c3 100644 --- a/runtime/intern.c +++ b/runtime/intern.c @@ -67,7 +67,11 @@ struct caml_intern_state { unsigned char * intern_input; /* Pointer to beginning of block holding input data, - if non-NULL this pointer will be freed by the cleanup function. */ + if non-NULL this pointer will be freed by the cleanup function. + + Allocated using malloc/free instead of stat_alloc/stat_free to + satisfy the expectations of caml_input_value_from_malloc users. + */ asize_t obj_counter; /* Count how many objects seen so far */ @@ -229,7 +233,7 @@ static void intern_free_stack(struct caml_intern_state* s) static void intern_cleanup(struct caml_intern_state* s) { if (s->intern_input != NULL) { - caml_stat_free(s->intern_input); + free(s->intern_input); s->intern_input = NULL; } if (s->intern_obj_table != NULL) { @@ -793,7 +797,7 @@ static void intern_decompress_input(struct caml_intern_state * s, s->compressed = h->compressed; if (! h->compressed) return; #ifdef HAS_ZSTD - unsigned char * blk = caml_stat_alloc_noexc(h->uncompressed_data_len); + unsigned char * blk = malloc(h->uncompressed_data_len); if (blk == NULL) { intern_cleanup(s); caml_raise_out_of_memory(); @@ -801,11 +805,11 @@ static void intern_decompress_input(struct caml_intern_state * s, size_t res = ZSTD_decompress(blk, h->uncompressed_data_len, s->intern_src, h->data_len); if (res != h->uncompressed_data_len) { - caml_stat_free(blk); + free(blk); intern_cleanup(s); intern_failwith2(fun_name, "decompression error"); } - if (s->intern_input != NULL) caml_stat_free(s->intern_input); + if (s->intern_input != NULL) free(s->intern_input); s->intern_input = blk; /* to be freed at end of demarshaling */ s->intern_src = blk; #else @@ -855,9 +859,12 @@ value caml_input_val(struct channel *chan) can take place (via context switching in systhreads), and the context [s] may change. So, wait until all I/O is over before using the context [s] again. */ - block = caml_stat_alloc(h.data_len); + block = malloc(h.data_len); + if (block == NULL) { + caml_raise_out_of_memory(); + } if (caml_really_getblock(chan, block, h.data_len) < h.data_len) { - caml_stat_free(block); + free(block); caml_failwith("input_value: truncated object"); } /* Initialize global state */ From b3104faf796c6d0b5542bd2d2317e6a79d012a86 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Mon, 18 Sep 2023 14:59:30 +0200 Subject: [PATCH 055/402] Improve wording. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Nicolás Ojeda Bär --- INSTALL.adoc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/INSTALL.adoc b/INSTALL.adoc index cb9d61d8dd6..ed29bf01df9 100644 --- a/INSTALL.adoc +++ b/INSTALL.adoc @@ -38,8 +38,8 @@ * If you do not have write access to `/tmp`, you should set the environment variable `TMPDIR` to the name of some other temporary directory. -* The zstd library is used for compression of marshaled data, if it is not available - the option `--without-zstd` should be passed to `configure` disabling it. +* The zstd library is used for compression of marshaled data. The option + `--without-zstd` may be passed to `configure` in order to disable it. == Prerequisites (special cases) From 455d3c95119f64b6c8049d4451e3dfe1867099f6 Mon Sep 17 00:00:00 2001 From: Janith Petangoda <22471198+janithpet@users.noreply.github.com> Date: Mon, 18 Sep 2023 15:22:47 +0100 Subject: [PATCH 056/402] Issue 11517 - Updated Format documentation (#12477) * Exposed pp_infinity in interface, and updated validate_geometry to check whether bounds are satisfied. * Updated documentation for set_geometry and check_geometry to be more accurate about when exception is raised * In set_max_indent, removed documentation regarding too large values, since that can never happen, as margin is limited to pp_infinity, and max_indent < margin. * Added links to pp_infinity in set_margin text and others * Added @since tag --- Changes | 5 +++++ stdlib/format.ml | 2 ++ stdlib/format.mli | 25 +++++++++++++++---------- 3 files changed, 22 insertions(+), 10 deletions(-) diff --git a/Changes b/Changes index 4b5ee2ff5dc..efce9879a04 100644 --- a/Changes +++ b/Changes @@ -135,6 +135,11 @@ Working version * #10775, #12499: Half-precision floating-point elements in Bigarray. (Anton Yabchinskiy, review by Xavier Leroy and Nicolás Ojeda Bär) +- #11517, #12477: Expose pp_infinity in interface of the format module, and + check that margin is less than pp_infinity when setting or checking geometry. + (Janith Petangoda, reported by Simmo Saan, reviewed by Florian Angeletti, + Simmo Saan, Josh Berdine and Gabriel Scherer) + - #12217: Add `Array.shuffle`. (Daniel Bünzli, review by Nicolás Ojeda Bär, David Allsopp and Alain Frisch) diff --git a/stdlib/format.ml b/stdlib/format.ml index b7c53a77035..cacd98768bb 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -819,6 +819,8 @@ let validate_geometry {margin; max_indent} = Error "max_indent < 2" else if margin <= max_indent then Error "margin <= max_indent" + else if margin >= pp_infinity then + Error "margin >= pp_infinity" else Ok () let check_geometry geometry = diff --git a/stdlib/format.mli b/stdlib/format.mli index 112495a0308..b960096918d 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -418,6 +418,13 @@ val print_newline : unit -> unit (** {1 Margin} *) +val pp_infinity : int +(** [pp_infinity] is the maximal size of the margin. + Its exact value is implementation dependent but is guaranteed to be greater + than 10{^9}. + + @since 5.2*) + val pp_set_margin : formatter -> int -> unit val set_margin : int -> unit (** [pp_set_margin ppf d] sets the right margin to [d] (in characters): @@ -426,8 +433,7 @@ val set_margin : int -> unit Setting the margin to [d] means that the formatting engine aims at printing at most [d-1] characters per line. Nothing happens if [d] is smaller than 2. - If [d] is too large, the right margin is set to the maximum - admissible value (which is greater than [10 ^ 9]). + If [d >= ]{!pp_infinity}, the right margin is set to {!pp_infinity}[ - 1]. If [d] is less than the current maximum indentation limit, the maximum indentation limit is decreased while trying to preserve a minimal ratio [max_indent/margin>=50%] and if possible @@ -473,11 +479,8 @@ val set_max_indent : int -> unit Nothing happens if [d] is smaller than 2. - If [d] is too large, the limit is set to the maximum - admissible value (which is greater than [10 ^ 9]). - - If [d] is greater or equal than the current margin, it is ignored, - and the current maximum indentation limit is kept. + If [d] is greater than the current margin, it is ignored, and the current + maximum indentation limit is kept. See also {!pp_set_geometry}. *) @@ -497,8 +500,10 @@ type geometry = { max_indent:int; margin: int} (** @since 4.08 *) val check_geometry: geometry -> bool -(** Check if the formatter geometry is valid: [1 < max_indent < margin] - @since 4.08 *) +(** Check if the formatter geometry is valid: + [1 < max_indent < margin < ]{!pp_infinity} + + @since 4.08 *) val pp_set_geometry : formatter -> max_indent:int -> margin:int -> unit val set_geometry : max_indent:int -> margin:int -> unit @@ -508,7 +513,7 @@ val safe_set_geometry : max_indent:int -> margin:int -> unit [pp_set_geometry ppf ~max_indent ~margin] sets both the margin and maximum indentation limit for [ppf]. - When [1 < max_indent < margin], + When [1 < max_indent < margin < ]{!pp_infinity}, [pp_set_geometry ppf ~max_indent ~margin] is equivalent to [pp_set_margin ppf margin; pp_set_max_indent ppf max_indent]; From 58c91b60863e2ce87f1ebf5ade2a81674da5f1b5 Mon Sep 17 00:00:00 2001 From: cod-xknown <144150758+cod-xknown@users.noreply.github.com> Date: Mon, 18 Sep 2023 21:26:18 +0100 Subject: [PATCH 057/402] Add emptylist to one more spot --- manual/src/cmds/intf-c.etex | 1 + 1 file changed, 1 insertion(+) diff --git a/manual/src/cmds/intf-c.etex b/manual/src/cmds/intf-c.etex index 7fc03e3cd19..a32f1743ddf 100644 --- a/manual/src/cmds/intf-c.etex +++ b/manual/src/cmds/intf-c.etex @@ -711,6 +711,7 @@ truth value of the C integer \var{x}. \item "Bool_val("\var{v}")" returns 0 if \var{v} is the OCaml boolean "false", 1 if \var{v} is "true". \item "Val_true", "Val_false" represent the OCaml booleans "true" and "false". +\item "Val_emptylist", "Val_emptylist" represents the empty list. \item "Val_none" represents the OCaml value "None". \end{itemize} From 5551db426bdb1d3363e652339f4037d1edbf0188 Mon Sep 17 00:00:00 2001 From: Sudha Parimala Date: Tue, 19 Sep 2023 18:11:13 +0530 Subject: [PATCH 058/402] Add a closing event for when EV_MAJOR_EPHE_MARK is complete --- runtime/major_gc.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 47036b70ddf..18a615b0e63 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -1635,6 +1635,8 @@ static void major_collection_slice(intnat howmuch, } } + CAML_EV_END(EV_MAJOR_EPHE_MARK); + if (domain_state->ephe_info->todo == (value)NULL) { ephe_todo_list_emptied (); } From 20f1d09d7ebd2269c6fdfcaef5b3753654375271 Mon Sep 17 00:00:00 2001 From: Sudha Parimala Date: Tue, 19 Sep 2023 18:52:19 +0530 Subject: [PATCH 059/402] add a Changes entry --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index ea22c5b320b..090a15bc773 100644 --- a/Changes +++ b/Changes @@ -315,6 +315,9 @@ Working version ### Bug fixes: +- #12583: Add a closing event for when `EV_MAJOR_EPHE_MARK` is complete + (Sudha Parimala, review by Gabriel Scherer) + - #12566: caml_output_value_to_malloc wrongly uses `caml_stat_alloc` instead of `malloc` since 4.06, breaking (in pooled mode) user code that uses `free` on the result. Symmetrically, From 74f8c996d47051a1987c2fbca01588833555067b Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Tue, 19 Sep 2023 09:41:17 -0400 Subject: [PATCH 060/402] Improve location of alias pattern variables (#12580) --- Changes | 3 +++ testsuite/tests/typing-gadts/or_patterns.ml | 4 ++-- testsuite/tests/warnings/w26_alias.ml | 19 +++++++++++++++++++ typing/typecore.ml | 2 +- 4 files changed, 25 insertions(+), 3 deletions(-) create mode 100644 testsuite/tests/warnings/w26_alias.ml diff --git a/Changes b/Changes index ea22c5b320b..3089e65e6c4 100644 --- a/Changes +++ b/Changes @@ -315,6 +315,9 @@ Working version ### Bug fixes: +- #12580: Fix location of alias pattern variables. + (Chris Casinghino, review Gabriel Scherer, report by Milo Davis) + - #12566: caml_output_value_to_malloc wrongly uses `caml_stat_alloc` instead of `malloc` since 4.06, breaking (in pooled mode) user code that uses `free` on the result. Symmetrically, diff --git a/testsuite/tests/typing-gadts/or_patterns.ml b/testsuite/tests/typing-gadts/or_patterns.ml index 0ff5a8c863a..5f6e8e2db41 100644 --- a/testsuite/tests/typing-gadts/or_patterns.ml +++ b/testsuite/tests/typing-gadts/or_patterns.ml @@ -217,9 +217,9 @@ let simple_merged_annotated_return (type a) (t : a t) (a : a) = ;; [%%expect{| -Line 3, characters 12-20: +Line 3, characters 18-19: 3 | | IntLit, (3 as x) - ^^^^^^^^ + ^ Error: This pattern matches values of type "int" This instance of "int" is ambiguous: it would escape the scope of its equation diff --git a/testsuite/tests/warnings/w26_alias.ml b/testsuite/tests/warnings/w26_alias.ml new file mode 100644 index 00000000000..0cc291b8b09 --- /dev/null +++ b/testsuite/tests/warnings/w26_alias.ml @@ -0,0 +1,19 @@ +(* TEST + expect; +*) +type t = + { x : int + ; y : int + } + +let sum ({ x; y } as t) = x + y + +[%%expect{| +type t = { x : int; y : int; } +Line 6, characters 21-22: +6 | let sum ({ x; y } as t) = x + y + ^ +Warning 26 [unused-var]: unused variable t. + +val sum : t -> int = +|}] diff --git a/typing/typecore.ml b/typing/typecore.ml index 4668a58a152..1eb9dab22a2 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -1640,7 +1640,7 @@ and type_pat_aux let ty_var = solve_Ppat_alias !!penv q in let id = enter_variable - ~is_as_variable:true tps loc name ty_var sp.ppat_attributes + ~is_as_variable:true tps name.loc name ty_var sp.ppat_attributes in rvp { pat_desc = Tpat_alias(q, id, name); pat_loc = loc; pat_extra=[]; From b908a1c3953cd3eb1d2a081a315f90259490957d Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 20 Sep 2023 11:03:03 +0200 Subject: [PATCH 061/402] [minor] tests/frame-pointers/filter-locations.sh update On my system, the "symbols" printed by backtrace_symbols* look like this (the ... at the beginning are an elided absolute path): .../ocamlopt.byte/c_call.opt(fp_backtrace_many_args+0x9e) [0x417dde] Notice the space before the address [0x417dde]. The current filter-locations.sh regex would not accept the space, so I extended it to allow spaces there. --- testsuite/tests/frame-pointers/filter-locations.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/frame-pointers/filter-locations.sh b/testsuite/tests/frame-pointers/filter-locations.sh index 31c7fc3189d..b532087451c 100755 --- a/testsuite/tests/frame-pointers/filter-locations.sh +++ b/testsuite/tests/frame-pointers/filter-locations.sh @@ -5,7 +5,7 @@ set -eu program="${1}" # https://stackoverflow.com/questions/29613304/is-it-possible-to-escape-regex-metacharacters-reliably-with-sed/29626460#29626460 program_escaped=$(echo ${program} | sed 's/[^^\\]/[&]/g; s/\^/\\^/g; s/\\/\\\\/g') -regex_backtrace='^.*(\(.*\)+0x[[:xdigit:]]*)[0x[[:xdigit:]]*]$' +regex_backtrace='^.*(\(.*\)+0x[[:xdigit:]]*) *[0x[[:xdigit:]]*]$' regex_trim_fun='^\(caml.*\)_[[:digit:]]*$' # - Ignore backtrace not coming from the program binary From c04755a4f5e9a62980fb90ee87f90cdfc74326e6 Mon Sep 17 00:00:00 2001 From: Miod Vallat Date: Wed, 6 Sep 2023 07:22:29 +0000 Subject: [PATCH 062/402] Set up frame pointer correctly prior to tail calling caml_c_call. This repairs operation when the compiler is built with --enable-frame-pointers and either Effect.Unhandled or Effect.Continuation_already_resumed needs to be raised. --- Changes | 4 +++ runtime/amd64.S | 4 ++- testsuite/tests/effects/unhandled_effects.ml | 36 ++++++++++++++++++++ 3 files changed, 43 insertions(+), 1 deletion(-) create mode 100644 testsuite/tests/effects/unhandled_effects.ml diff --git a/Changes b/Changes index 37e6a869154..262918acd94 100644 --- a/Changes +++ b/Changes @@ -382,6 +382,10 @@ Working version optional arguments and default values in the Closure backend (Alain Frisch, review by Vincent Laviron) +- #12486: Fix delivery of unhandled effect exceptions on amd64 with + --enable-frame-pointers + (Miod Vallat, report by Jan Midtgaard, review by Gabriel Scherer) + OCaml 5.1.0 (14 September 2023) ------------------------------- diff --git a/runtime/amd64.S b/runtime/amd64.S index 7e6f95c680c..24dfa7111b8 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -1137,6 +1137,7 @@ LBL(112): movq Caml_state(current_stack), %rsi SWITCH_OCAML_STACKS /* No parent stack. Raise Effect.Unhandled. */ + ENTER_FUNCTION #if defined(WITH_THREAD_SANITIZER) /* We must let the TSan runtime know that we switched back to the original performer stack. For that, we perform the necessary calls @@ -1215,7 +1216,8 @@ CFI_STARTPROC UPDATE_BASE_POINTER(%rcx) SWITCH_OCAML_STACKS jmp *(%rbx) -2: TSAN_ENTER_FUNCTION(0) /* Necessary to include the caller of caml_resume +2: ENTER_FUNCTION + TSAN_ENTER_FUNCTION(0) /* Necessary to include the caller of caml_resume in the TSan backtrace */ LEA_VAR(caml_raise_continuation_already_resumed, %rax) jmp LBL(caml_c_call) diff --git a/testsuite/tests/effects/unhandled_effects.ml b/testsuite/tests/effects/unhandled_effects.ml new file mode 100644 index 00000000000..bf776457c47 --- /dev/null +++ b/testsuite/tests/effects/unhandled_effects.ml @@ -0,0 +1,36 @@ +(* TEST + set OCAMLRUNPARAM = "s32"; + native; +*) + +(* This test verifies that stack frames are correct when raising unhandled + effect exceptions. This used not to be the case on some platforms, + causing assertions when the garbage collector would fire. + + By using a very small initial heap (s32), this test guarantees the GC + will get triggered. + + Refer to https://github.com/ocaml/ocaml/issues/12486 for more + information. +*) + +open Effect + +type _ t += Yield : unit t + +let rec burn l = + if List.hd l > 12 then () + else + burn (l @ l |> List.map (fun x -> x + 1)) + +let foo l = + burn l; + perform Yield + +let bar i = foo [i] + +let () = + for _ = 1 to 10_000 do + try bar 8 + with Unhandled _ -> () + done From 68be7d828b0b4196f18d749eea8b5157ee4f1e16 Mon Sep 17 00:00:00 2001 From: fabbing Date: Thu, 14 Sep 2023 17:10:21 +0200 Subject: [PATCH 063/402] Add missing ENTER/LEAVE_FUNCTION when using TSan Co-authored-by: Olivier Nicole --- runtime/amd64.S | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/runtime/amd64.S b/runtime/amd64.S index 24dfa7111b8..a6ee4b1aadd 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -1115,6 +1115,7 @@ LBL(do_perform): je LBL(112) #if defined(WITH_THREAD_SANITIZER) /* Signal to TSan all stack frames exited by the perform. */ + ENTER_FUNCTION TSAN_SAVE_CALLER_REGS movq (%rsp), C_ARG_1 /* arg 1: pc of perform */ leaq 8(%rsp), C_ARG_2 /* arg 2: sp at perform */ @@ -1122,6 +1123,7 @@ LBL(do_perform): C_call (GCALL(caml_tsan_exit_on_perform)) SWITCH_C_TO_OCAML TSAN_RESTORE_CALLER_REGS + LEAVE_FUNCTION #endif SWITCH_OCAML_STACKS /* preserves r11 and rsi */ /* We have to null the Handler_parent after the switch because the @@ -1185,6 +1187,7 @@ CFI_STARTPROC jz 2f #if defined(WITH_THREAD_SANITIZER) /* Save non-callee-saved registers %rax and %r10 before C call */ + ENTER_FUNCTION pushq %rax; CFI_ADJUST(8); pushq %r10; CFI_ADJUST(8); /* Necessary to include the caller of caml_resume in the TSan backtrace */ @@ -1201,6 +1204,7 @@ CFI_STARTPROC C_call (GCALL(caml_tsan_entry_on_resume)) SWITCH_C_TO_OCAML TSAN_RESTORE_CALLER_REGS + LEAVE_FUNCTION #endif /* Find end of list of stacks and add current */ movq %r10, %rsi From c0d4daa82a8e1afb9778a501024b37db2441b837 Mon Sep 17 00:00:00 2001 From: fabbing Date: Thu, 14 Sep 2023 17:12:15 +0200 Subject: [PATCH 064/402] Add missing handling of potential fp for TSan arguments Co-authored-by: Olivier Nicole --- runtime/amd64.S | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/runtime/amd64.S b/runtime/amd64.S index a6ee4b1aadd..3876a456a37 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -947,8 +947,8 @@ LBL(117): LBL(118): /* Signal to TSan all stack frames exited by the exception. No need to save any registers here. */ - movq STACK_RETADDR(%r13), C_ARG_1 /* arg 1: pc of raise */ - leaq STACK_ARG_1(%r13), C_ARG_2 /* arg 2: sp at raise */ + movq STACK_RETADDR(%r13), C_ARG_1 /* arg 1: pc of raise */ + leaq STACK_ARG_1(%r13), C_ARG_2 /* arg 2: sp at raise */ movq Caml_state(exn_handler), C_ARG_3 /* arg 3: sp of handler */ C_call (GCALL(caml_tsan_exit_on_raise)) #endif @@ -1117,8 +1117,8 @@ LBL(do_perform): /* Signal to TSan all stack frames exited by the perform. */ ENTER_FUNCTION TSAN_SAVE_CALLER_REGS - movq (%rsp), C_ARG_1 /* arg 1: pc of perform */ - leaq 8(%rsp), C_ARG_2 /* arg 2: sp at perform */ + movq STACK_RETADDR(%rsp), C_ARG_1 /* arg 1: pc of perform */ + leaq STACK_ARG_1(%rsp), C_ARG_2 /* arg 2: sp at perform */ SWITCH_OCAML_TO_C C_call (GCALL(caml_tsan_exit_on_perform)) SWITCH_C_TO_OCAML @@ -1145,10 +1145,9 @@ LBL(112): original performer stack. For that, we perform the necessary calls to __tsan_func_entry via caml_tsan_entry_on_resume. */ TSAN_SAVE_CALLER_REGS - movq Stack_sp(%r10), %r11 - movq (%r11), C_ARG_1 /* arg 1: pc of perform */ - leaq 8(%r11), C_ARG_2 /* arg 2: sp at perform */ - movq %r10, C_ARG_3 /* arg 3: fiber */ + movq STACK_RETADDR(%rsp), C_ARG_1 /* arg 1: pc of perform */ + leaq STACK_ARG_1(%rsp), C_ARG_2 /* arg 2: sp at perform */ + movq Caml_state(current_stack), C_ARG_3 /* arg 3: fiber */ SWITCH_OCAML_TO_C C_call (GCALL(caml_tsan_entry_on_resume)) SWITCH_C_TO_OCAML @@ -1197,9 +1196,9 @@ CFI_STARTPROC TSAN_SAVE_CALLER_REGS /* Signal to TSan all stack frames exited by the perform. */ movq Stack_sp(%r10), %r11 - movq (%r11), C_ARG_1 /* arg 1: pc of perform */ - leaq 8(%r11), C_ARG_2 /* arg 2: sp at perform */ - movq %r10, C_ARG_3 /* arg 3: fiber */ + movq STACK_RETADDR(%r11), C_ARG_1 /* arg 1: pc of perform */ + leaq STACK_ARG_1(%r11), C_ARG_2 /* arg 2: sp at perform */ + movq %r10, C_ARG_3 /* arg 3: fiber */ SWITCH_OCAML_TO_C C_call (GCALL(caml_tsan_entry_on_resume)) SWITCH_C_TO_OCAML From 4303cba1e05f72cfac6fef6d14259beddbe16cdc Mon Sep 17 00:00:00 2001 From: fabbing Date: Thu, 14 Sep 2023 17:14:56 +0200 Subject: [PATCH 065/402] Simplify caml_raise_exn using macros that account for fp Co-authored-by: Olivier Nicole --- runtime/amd64.S | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/runtime/amd64.S b/runtime/amd64.S index 3876a456a37..41aa7ac3489 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -932,16 +932,10 @@ LBL(117): testq $1, Caml_state(backtrace_active) je LBL(118) #endif - movq %rax, C_ARG_1 /* arg 1: exception bucket */ -#ifdef WITH_FRAME_POINTERS - movq 8(%r13), C_ARG_2 /* arg 2: pc of raise */ - leaq 16(%r13), C_ARG_3 /* arg 3: sp at raise */ -#else - movq (%r13), C_ARG_2 /* arg 2: pc of raise */ - leaq 8(%r13), C_ARG_3 /* arg 3: sp at raise */ -#endif - movq Caml_state(exn_handler), C_ARG_4 - /* arg 4: sp of handler */ + movq %rax, C_ARG_1 /* arg 1: exception bucket */ + movq STACK_RETADDR(%r13), C_ARG_2 /* arg 2: pc of raise */ + leaq STACK_ARG_1(%r13), C_ARG_3 /* arg 3: sp at raise */ + movq Caml_state(exn_handler), C_ARG_4 /* arg 4: sp of handler */ C_call (GCALL(caml_stash_backtrace)) #if defined(WITH_THREAD_SANITIZER) LBL(118): From 1cbb92f13d9f943969f7afd9f82b55a7f7023c02 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 29 Aug 2023 17:17:14 +0200 Subject: [PATCH 066/402] #12502: normalize \r*\n newlines to \n during lexing --- Changes | 9 +++++++++ parsing/lexer.mll | 38 ++++++++++++++++++++++++++++++-------- utils/warnings.ml | 3 ++- utils/warnings.mli | 6 +++++- 4 files changed, 46 insertions(+), 10 deletions(-) diff --git a/Changes b/Changes index 262918acd94..eb4289c2977 100644 --- a/Changes +++ b/Changes @@ -41,6 +41,15 @@ Working version and variant with only constant constructors. (Christophe Raffalli, review by Gabriel Scherer) +- #12502: the compiler now normalizes newline sequences (\r*\n) to + a single \n character during lexing, to guarantee that the semantics + of newlines in string literals is not modified by tools applying OS-specific + newline conversions. + Warning 29 [eol-in-string] is not emitted anymore, as the normalization + gives a more robust semantics to newlines in string literals. + (Gabriel Scherer, review by Daniel Bünzli and David Allsopp, report + by Andreas Rossberg) + ### Type system: - #12313, #11799: Do not re-build as-pattern type when a ground type annotation diff --git a/parsing/lexer.mll b/parsing/lexer.mll index 9b248b368d5..b17edda81e4 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -108,6 +108,24 @@ 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_lexeme lexbuf = store_string (Lexing.lexeme lexbuf) +let store_normalizated_newline () = + (* #12502: we normalize newlines 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++. + *) + store_string_char '\n' + (* To store the position of the beginning of a string and comment *) let string_start_loc = ref Location.none @@ -661,7 +679,9 @@ and comment = parse { store_lexeme lexbuf; comment lexbuf } | "\'" newline "\'" { update_loc lexbuf None 1 false 1; - store_lexeme lexbuf; + store_string_char '\''; + store_normalized_newline (); + store_string_char '\''; comment lexbuf } | "\'" [^ '\\' '\'' '\010' '\013' ] "\'" @@ -684,7 +704,7 @@ and comment = parse } | newline { update_loc lexbuf None 1 false 0; - store_lexeme lexbuf; + store_normalized_newline (); comment lexbuf } | ident @@ -697,7 +717,11 @@ and string = parse { lexbuf.lex_start_p } | '\\' newline ([' ' '\t'] * as space) { update_loc lexbuf None 1 false (String.length space); - if in_comment () then store_lexeme lexbuf; + if in_comment () then begin + store_string_char '\\'; + store_normalized_newline (); + store_string space; + end; string lexbuf } | '\\' (['\\' '\'' '\"' 'n' 't' 'b' 'r' ' '] as c) @@ -727,10 +751,8 @@ and string = parse string lexbuf } | newline - { if not (in_comment ()) then - Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string; - update_loc lexbuf None 1 false 0; - store_lexeme lexbuf; + { update_loc lexbuf None 1 false 0; + store_normalized_newline (); string lexbuf } | eof @@ -743,7 +765,7 @@ and string = parse and quoted_string delim = parse | newline { update_loc lexbuf None 1 false 0; - store_lexeme lexbuf; + store_normalized_newline (); quoted_string delim lexbuf } | eof diff --git a/utils/warnings.ml b/utils/warnings.ml index 65721fe1b09..1812e0a3412 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -944,7 +944,8 @@ let message = function | 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 (non-portable code)" + "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 diff --git a/utils/warnings.mli b/utils/warnings.mli index 8af3d53b437..c46b5588c6e 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -68,7 +68,11 @@ type t = | Unused_var of string (* 26 *) | Unused_var_strict of string (* 27 *) | Wildcard_arg_to_constant_constr (* 28 *) - | Eol_in_string (* 29 *) + | 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 *) From c78d3aac046342ca543d96947f09e2aeccc03a8e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 29 Aug 2023 17:42:48 +0200 Subject: [PATCH 067/402] mention newline normalization in the manual --- manual/src/refman/lex.etex | 38 ++++++++++++++++++++++++++++++-------- parsing/lexer.mll | 2 +- 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/manual/src/refman/lex.etex b/manual/src/refman/lex.etex index 2d95099af47..1c96efc78e7 100644 --- a/manual/src/refman/lex.etex +++ b/manual/src/refman/lex.etex @@ -183,7 +183,7 @@ let copyright = '\xA9';; \begin{syntax} string-literal: '"' { string-character } '"' - | '{' quoted-string-id '|' { any-char } '|' quoted-string-id '}' + | '{' quoted-string-id '|' { newline | any-char } '|' quoted-string-id '}' ; quoted-string-id: { 'a'...'z' || '_' } @@ -192,6 +192,7 @@ string-character: regular-string-char | escape-sequence | "\u{" {{ "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" }} "}" + | newline | '\' newline { space || tab } \end{syntax} @@ -211,6 +212,12 @@ let greeting = "Hello, World!\n" let superscript_plus = "\u{207A}";; \end{caml_example} +Any sequence of carriage return characters followed by a line feed +character is considered as a newline sequence. Since OCaml 5.2, +a newline sequence occurring in a string literal is normalized into +a single line feed character. This guarantees that the OCaml value is +independent of the newline convention used by the source file. + To allow splitting long string literals across lines, the sequence "\\"\var{newline}~\var{spaces-or-tabs} (a backslash at the end of a line followed by any number of spaces and horizontal tabulations at the @@ -225,14 +232,29 @@ let longstr = he world.";; \end{caml_example} +Escaped newlines provide more convenient behavior than non-escaped +newlines, as the indentation is not considered part of the string +literal. + +\begin{caml_example}{toplevel} +let contains_unexpected_spaces = + "This multiline literal + contains three consecutive spaces." + +let no_unexpected_spaces = + "This multiline literal \n\ + uses a single space between all words.";; +\end{caml_example} + Quoted string literals provide an alternative lexical syntax for -string literals. They are useful to represent strings of arbitrary content -without escaping. Quoted strings are delimited by a matching pair -of @'{' quoted-string-id '|'@ and @'|' quoted-string-id '}'@ with -the same @quoted-string-id@ on both sides. Quoted strings do not interpret -any character in a special way but requires that the -sequence @'|' quoted-string-id '}'@ does not occur in the string itself. -The identifier @quoted-string-id@ is a (possibly empty) sequence of +string literals. They are useful to represent strings of arbitrary +content without escaping. Quoted strings are delimited by a matching +pair of @'{' quoted-string-id '|'@ and @'|' quoted-string-id '}'@ with +the same @quoted-string-id@ on both sides. Quoted strings do not +interpret any character in a special way (except for +newline normalization) but requires that the sequence @'|' +quoted-string-id '}'@ does not occur in the string itself. The +identifier @quoted-string-id@ is a (possibly empty) sequence of lowercase letters and underscores that can be freely chosen to avoid such issue. diff --git a/parsing/lexer.mll b/parsing/lexer.mll index b17edda81e4..fe40a947e38 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -108,7 +108,7 @@ 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_lexeme lexbuf = store_string (Lexing.lexeme lexbuf) -let store_normalizated_newline () = +let store_normalized_newline () = (* #12502: we normalize newlines to "\n" at lexing time, to avoid behavior difference due to OS-specific newline characters in string literals. From 9d65ae5bfe586b12cc0682743f450a119feb6de3 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Sep 2023 22:11:50 +0200 Subject: [PATCH 068/402] newline normalization: only erase the last \r --- Changes | 10 +++++----- manual/src/refman/lex.etex | 20 +++++++++----------- parsing/lexer.mll | 37 +++++++++++++++++++++++-------------- utils/warnings.mli | 2 +- 4 files changed, 38 insertions(+), 31 deletions(-) diff --git a/Changes b/Changes index eb4289c2977..08a8510da5d 100644 --- a/Changes +++ b/Changes @@ -41,14 +41,14 @@ Working version and variant with only constant constructors. (Christophe Raffalli, review by Gabriel Scherer) -- #12502: the compiler now normalizes newline sequences (\r*\n) to +- #12502: the compiler now normalizes the newline sequence \r\n to a single \n character during lexing, to guarantee that the semantics - of newlines in string literals is not modified by tools applying OS-specific - newline conversions. + of newlines in string literals is not modified by Windows tools + transforming \n into \r\n in source files. Warning 29 [eol-in-string] is not emitted anymore, as the normalization gives a more robust semantics to newlines in string literals. - (Gabriel Scherer, review by Daniel Bünzli and David Allsopp, report - by Andreas Rossberg) + (Gabriel Scherer and Damien Doligez, review by Daniel Bünzli, David + Allsopp, Andreas Rossberg, Xavier Leroy, report by Andreas Rossberg) ### Type system: diff --git a/manual/src/refman/lex.etex b/manual/src/refman/lex.etex index 1c96efc78e7..7972a9b5fbf 100644 --- a/manual/src/refman/lex.etex +++ b/manual/src/refman/lex.etex @@ -212,11 +212,9 @@ let greeting = "Hello, World!\n" let superscript_plus = "\u{207A}";; \end{caml_example} -Any sequence of carriage return characters followed by a line feed -character is considered as a newline sequence. Since OCaml 5.2, -a newline sequence occurring in a string literal is normalized into -a single line feed character. This guarantees that the OCaml value is -independent of the newline convention used by the source file. +A newline sequence is a line feed optionally preceded by a carriage +return. Since OCaml 5.2, a newline sequence occurring in a string +literal is normalized into a single line feed character. To allow splitting long string literals across lines, the sequence "\\"\var{newline}~\var{spaces-or-tabs} (a backslash at the end of a line @@ -251,12 +249,12 @@ string literals. They are useful to represent strings of arbitrary content without escaping. Quoted strings are delimited by a matching pair of @'{' quoted-string-id '|'@ and @'|' quoted-string-id '}'@ with the same @quoted-string-id@ on both sides. Quoted strings do not -interpret any character in a special way (except for -newline normalization) but requires that the sequence @'|' -quoted-string-id '}'@ does not occur in the string itself. The -identifier @quoted-string-id@ is a (possibly empty) sequence of -lowercase letters and underscores that can be freely chosen to avoid -such issue. +interpret any character in a special way\footnote{Except for the + normalization of newline sequences into a single line feed mentioned + earlier.} but requires that the sequence @'|' quoted-string-id '}'@ +does not occur in the string itself. The identifier +@quoted-string-id@ is a (possibly empty) sequence of lowercase letters +and underscores that can be freely chosen to avoid such issue. \begin{caml_example}{toplevel} let quoted_greeting = {|"Hello, World!"|} diff --git a/parsing/lexer.mll b/parsing/lexer.mll index fe40a947e38..df87f9a3c37 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -107,9 +107,11 @@ 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 () = - (* #12502: we normalize newlines to "\n" at lexing time, +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. @@ -124,8 +126,15 @@ let store_normalized_newline () = Many programming languages use the same approach, for example Java, Javascript, Kotlin, Python, Swift and C++. *) - store_string_char '\n' - + (* 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 @@ -677,10 +686,10 @@ and comment = parse comment lexbuf } | "\'\'" { store_lexeme lexbuf; comment lexbuf } - | "\'" newline "\'" + | "\'" (newline as nl) "\'" { update_loc lexbuf None 1 false 1; store_string_char '\''; - store_normalized_newline (); + store_normalized_newline nl; store_string_char '\''; comment lexbuf } @@ -702,9 +711,9 @@ and comment = parse comment_start_loc := []; error_loc loc (Unterminated_comment start) } - | newline + | newline as nl { update_loc lexbuf None 1 false 0; - store_normalized_newline (); + store_normalized_newline nl; comment lexbuf } | ident @@ -715,11 +724,11 @@ and comment = parse and string = parse '\"' { 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 () then begin store_string_char '\\'; - store_normalized_newline (); + store_normalized_newline nl; store_string space; end; string lexbuf @@ -750,9 +759,9 @@ and string = parse store_lexeme lexbuf; string lexbuf } - | newline + | newline as nl { update_loc lexbuf None 1 false 0; - store_normalized_newline (); + store_normalized_newline nl; string lexbuf } | eof @@ -763,9 +772,9 @@ and string = parse string lexbuf } and quoted_string delim = parse - | newline + | newline as nl { update_loc lexbuf None 1 false 0; - store_normalized_newline (); + store_normalized_newline nl; quoted_string delim lexbuf } | eof diff --git a/utils/warnings.mli b/utils/warnings.mli index c46b5588c6e..f0a4b1c9239 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -69,7 +69,7 @@ type t = | 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 + 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. *) From 5a69ac521381c213dc76e764bdfc9179683c5564 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Sep 2023 22:05:28 +0200 Subject: [PATCH 069/402] a testsuite for newline normalization --- testsuite/tests/lexing/newlines.ml | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 testsuite/tests/lexing/newlines.ml diff --git a/testsuite/tests/lexing/newlines.ml b/testsuite/tests/lexing/newlines.ml new file mode 100644 index 00000000000..c940b04faa5 --- /dev/null +++ b/testsuite/tests/lexing/newlines.ml @@ -0,0 +1,23 @@ +(* TEST *) + +let check ~kind ~input ~result = + if input <> result then + Printf.printf "FAIL: %s %S should normalize to %S +" + kind input result +;; + +check ~kind:"string literal" ~input:" +" ~result:"\n"; +check ~kind:"quoted string literal" ~input:{| +|} ~result:"\n"; + +check ~kind:"string literal" ~input:" +" ~result:"\n"; +check ~kind:"quoted string literal" ~input:{| +|} ~result:"\n"; + +check ~kind:"string literal" ~input:" +" ~result:"\r\n"; +check ~kind:"quoted string literal" ~input:{| +|} ~result:"\r\n"; From 2114a001b7df6e721356eaa480b42dd8ae0b5370 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Glen=20M=C3=A9vel?= Date: Wed, 2 Aug 2023 19:03:54 +0200 Subject: [PATCH 070/402] stdlib: add Array.init_matrix --- Changes | 3 +++ stdlib/array.ml | 7 +++++++ stdlib/array.mli | 15 +++++++++++++++ stdlib/arrayLabels.mli | 15 +++++++++++++++ testsuite/tests/lib-array/test_array.ml | 13 +++++++++++++ 5 files changed, 53 insertions(+) diff --git a/Changes b/Changes index 08a8510da5d..abb7a7b5a35 100644 --- a/Changes +++ b/Changes @@ -165,6 +165,9 @@ Working version (Nicolás Ojeda Bär, review by Jeremy Yallop, Xavier Leroy, Gabriel Scherer, David Allsopp) +- #12455: Add `Array.init_matrix`. + (Glen Mével, review by Xavier Leroy, Gabriel Scherer and Jeremy Yallop) + - #12511: Minor performance improvements and cleanups in the implementation of modules Int32, Int64, and Nativeint (Xavier Leroy, review by Gabriel Scherer and Daniel Bünzli) diff --git a/stdlib/array.ml b/stdlib/array.ml index c7b66ca6058..7edda2867ff 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -63,6 +63,13 @@ let make_matrix sx sy init = done; res +let init_matrix sx sy f = + let res = create sx [||] in + for x = 0 to pred sx do + unsafe_set res x (init sy (fun y -> f x y)) + done; + res + let copy a = let l = length a in if l = 0 then [||] else unsafe_sub a 0 l diff --git a/stdlib/array.mli b/stdlib/array.mli index 9d8b302ceb1..bba00c5a518 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -91,6 +91,21 @@ val make_matrix : int -> int -> 'a -> 'a array array If the value of [e] is a floating-point number, then the maximum size is only [Sys.max_array_length / 2]. *) +val init_matrix : int -> int -> (int -> int -> 'a) -> 'a array array +(** [init_matrix dimx dimy f] returns a two-dimensional array + (an array of arrays) + with first dimension [dimx] and second dimension [dimy], + where the element at index ([x,y]) is initialized with [f x y]. + The element ([x,y]) of a matrix [m] is accessed + with the notation [m.(x).(y)]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_array_length}. + If the return type of [f] is [float], + then the maximum size is only [Sys.max_array_length / 2]. + + @since 5.2 *) + val append : 'a array -> 'a array -> 'a array (** [append v1 v2] returns a fresh array containing the concatenation of the arrays [v1] and [v2]. diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli index b5751fc3820..84a413f05f7 100644 --- a/stdlib/arrayLabels.mli +++ b/stdlib/arrayLabels.mli @@ -91,6 +91,21 @@ val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array If the value of [e] is a floating-point number, then the maximum size is only [Sys.max_array_length / 2]. *) +val init_matrix : dimx:int -> dimy:int -> f:(int -> int -> 'a) -> 'a array array +(** [init_matrix ~dimx ~dimy ~f] returns a two-dimensional array + (an array of arrays) + with first dimension [dimx] and second dimension [dimy], + where the element at index ([x,y]) is initialized with [f x y]. + The element ([x,y]) of a matrix [m] is accessed + with the notation [m.(x).(y)]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_array_length}. + If the return type of [f] is [float], + then the maximum size is only [Sys.max_array_length / 2]. + + @since 5.2 *) + val append : 'a array -> 'a array -> 'a array (** [append v1 v2] returns a fresh array containing the concatenation of the arrays [v1] and [v2]. diff --git a/testsuite/tests/lib-array/test_array.ml b/testsuite/tests/lib-array/test_array.ml index c5b6143db69..6d80092d3ef 100644 --- a/testsuite/tests/lib-array/test_array.ml +++ b/testsuite/tests/lib-array/test_array.ml @@ -177,3 +177,16 @@ let a : int array = [%%expect{| val a : int array = [|2; 4; 6; 8|] |}] + +let a = Array.init_matrix 2 3 (fun i j -> ref (10*i+j));; +a.(0).(0) := 99;; +a (* other cells are unchanged *);; +[%%expect{| +val a : int ref array array = + [|[|{contents = 0}; {contents = 1}; {contents = 2}|]; + [|{contents = 10}; {contents = 11}; {contents = 12}|]|] +- : unit = () +- : int ref array array = +[|[|{contents = 99}; {contents = 1}; {contents = 2}|]; + [|{contents = 10}; {contents = 11}; {contents = 12}|]|] +|}] From 96f0bb48b4c5b2d4806310483a13ae974ec48657 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Glen=20M=C3=A9vel?= Date: Thu, 3 Aug 2023 23:42:00 +0200 Subject: [PATCH 071/402] Array: inline init in init_matrix --- stdlib/array.ml | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/stdlib/array.ml b/stdlib/array.ml index 7edda2867ff..36c550cc908 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -64,10 +64,17 @@ let make_matrix sx sy init = res let init_matrix sx sy f = + if sy < 0 then invalid_arg "Array.init_matrix"; let res = create sx [||] in - for x = 0 to pred sx do - unsafe_set res x (init sy (fun y -> f x y)) - done; + if sy > 0 then begin + for x = 0 to pred sx do + let row = create sy (f x 0) in + for y = 1 to pred sy do + unsafe_set row y (f x y) + done; + unsafe_set res x row + done; + end; res let copy a = From 034069b33ea1952a69c6661f53171b775a75bb03 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Glen=20M=C3=A9vel?= Date: Fri, 4 Aug 2023 00:03:44 +0200 Subject: [PATCH 072/402] Array: add test for make_matrix, simplify test for init_matrix --- testsuite/tests/lib-array/test_array.ml | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/testsuite/tests/lib-array/test_array.ml b/testsuite/tests/lib-array/test_array.ml index 6d80092d3ef..09817baa6f6 100644 --- a/testsuite/tests/lib-array/test_array.ml +++ b/testsuite/tests/lib-array/test_array.ml @@ -178,15 +178,20 @@ let a : int array = val a : int array = [|2; 4; 6; 8|] |}] -let a = Array.init_matrix 2 3 (fun i j -> ref (10*i+j));; -a.(0).(0) := 99;; -a (* other cells are unchanged *);; +let a = Array.make_matrix 2 3 "placeholder";; +a.(0).(0) <- "hello";; +a (* other rows are unchanged *);; [%%expect{| -val a : int ref array array = - [|[|{contents = 0}; {contents = 1}; {contents = 2}|]; - [|{contents = 10}; {contents = 11}; {contents = 12}|]|] +val a : string array array = + [|[|"placeholder"; "placeholder"; "placeholder"|]; + [|"placeholder"; "placeholder"; "placeholder"|]|] - : unit = () -- : int ref array array = -[|[|{contents = 99}; {contents = 1}; {contents = 2}|]; - [|{contents = 10}; {contents = 11}; {contents = 12}|]|] +- : string array array = +[|[|"hello"; "placeholder"; "placeholder"|]; + [|"placeholder"; "placeholder"; "placeholder"|]|] +|}] + +let a = Array.init_matrix 2 3 (fun i j -> 10 * i + j);; +[%%expect{| +val a : int array array = [|[|0; 1; 2|]; [|10; 11; 12|]|] |}] From 39a397a670aa40c64ffb7de5d96e59ba506bcc18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Glen=20M=C3=A9vel?= Date: Sat, 5 Aug 2023 14:36:48 +0200 Subject: [PATCH 073/402] Array: make_matrix now raises if dimx = 0 && dimy < 0 This conforms to the documented behavior, and aligns `make_matrix` with the new `init_matrix`. --- Changes | 4 ++++ stdlib/array.ml | 3 +++ 2 files changed, 7 insertions(+) diff --git a/Changes b/Changes index abb7a7b5a35..041a3a0c2c6 100644 --- a/Changes +++ b/Changes @@ -168,6 +168,10 @@ Working version - #12455: Add `Array.init_matrix`. (Glen Mével, review by Xavier Leroy, Gabriel Scherer and Jeremy Yallop) +* #12455: `Array.make_matrix dimx dimy f` now raises `Invalid_argument` + when `dimx = 0 && dimy < 0` This was already specified but not enforced. + (Glen Mével, report by Jeremy Yallop) + - #12511: Minor performance improvements and cleanups in the implementation of modules Int32, Int64, and Nativeint (Xavier Leroy, review by Gabriel Scherer and Daniel Bünzli) diff --git a/stdlib/array.ml b/stdlib/array.ml index 36c550cc908..4d79090d6cd 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -57,6 +57,8 @@ let init l f = res let make_matrix sx sy init = + (* We raise even if [sx = 0 && sy < 0]: *) + if sy < 0 then invalid_arg "Array.make_matrix"; let res = create sx [||] in for x = 0 to pred sx do unsafe_set res x (create sy init) @@ -64,6 +66,7 @@ let make_matrix sx sy init = res let init_matrix sx sy f = + (* We raise even if [sx = 0 && sy < 0]: *) if sy < 0 then invalid_arg "Array.init_matrix"; let res = create sx [||] in if sy > 0 then begin From ee697a0aea079b4c34b3e2a5b1c13fd27f9c95c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Glen=20M=C3=A9vel?= Date: Sat, 5 Aug 2023 14:40:47 +0200 Subject: [PATCH 074/402] Array: make_matrix now skips loop if dimx = 0 This aligns with the implementation of `init_matrix`, where this short-circuit is not just an optimization, but a required test. --- Changes | 5 +++-- stdlib/array.ml | 12 ++++++++---- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/Changes b/Changes index 041a3a0c2c6..347ffd1ac99 100644 --- a/Changes +++ b/Changes @@ -166,11 +166,12 @@ Working version David Allsopp) - #12455: Add `Array.init_matrix`. - (Glen Mével, review by Xavier Leroy, Gabriel Scherer and Jeremy Yallop) + (Glen Mével, review by Xavier Leroy, Gabriel Scherer, Jeremy Yallop, + Nicolas Ojeda Bar) * #12455: `Array.make_matrix dimx dimy f` now raises `Invalid_argument` when `dimx = 0 && dimy < 0` This was already specified but not enforced. - (Glen Mével, report by Jeremy Yallop) + (Glen Mével, report by Jeremy Yallop, review by Nicolas Ojeda Bar) - #12511: Minor performance improvements and cleanups in the implementation of modules Int32, Int64, and Nativeint diff --git a/stdlib/array.ml b/stdlib/array.ml index 4d79090d6cd..eac27d5fa28 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -47,7 +47,8 @@ end let init l f = if l = 0 then [||] else if l < 0 then invalid_arg "Array.init" - (* See #6575. We could also check for maximum array size, but this depends + (* See #6575. We must not evaluate [f 0] when [l <= 0]. + We could also check for maximum array size, but this depends on whether we create a float array or a regular one... *) else let res = create l (f 0) in @@ -60,15 +61,18 @@ let make_matrix sx sy init = (* We raise even if [sx = 0 && sy < 0]: *) if sy < 0 then invalid_arg "Array.make_matrix"; let res = create sx [||] in - for x = 0 to pred sx do - unsafe_set res x (create sy init) - done; + if sy > 0 then begin + for x = 0 to pred sx do + unsafe_set res x (create sy init) + done; + end; res let init_matrix sx sy f = (* We raise even if [sx = 0 && sy < 0]: *) if sy < 0 then invalid_arg "Array.init_matrix"; let res = create sx [||] in + (* We must not evaluate [f x 0] when [sy <= 0]: *) if sy > 0 then begin for x = 0 to pred sx do let row = create sy (f x 0) in From c62b3dbc4142ce5eb6f19fb24ed7b3fa84253c30 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Glen=20M=C3=A9vel?= Date: Sat, 5 Aug 2023 16:53:41 +0200 Subject: [PATCH 075/402] Float.Array: add {make,init}_matrix --- Changes | 3 +- stdlib/float.ml | 26 +++++++++++ stdlib/float.mli | 42 ++++++++++++++++++ .../templates/floatarraylabeled.template.mli | 21 +++++++++ testsuite/tests/lib-floatarray/floatarray.ml | 43 +++++++++++++++++++ 5 files changed, 134 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index 347ffd1ac99..0ea6fafda84 100644 --- a/Changes +++ b/Changes @@ -165,7 +165,8 @@ Working version (Nicolás Ojeda Bär, review by Jeremy Yallop, Xavier Leroy, Gabriel Scherer, David Allsopp) -- #12455: Add `Array.init_matrix`. +- #12455: Add `Array.init_matrix`, `Float.Array.make_matrix`, + `Float.Array.init_matrix`. (Glen Mével, review by Xavier Leroy, Gabriel Scherer, Jeremy Yallop, Nicolas Ojeda Bar) diff --git a/stdlib/float.ml b/stdlib/float.ml index 266641f65d3..9d40f0c214d 100644 --- a/stdlib/float.ml +++ b/stdlib/float.ml @@ -204,6 +204,32 @@ module Array = struct done; res + let make_matrix sx sy v = + (* We raise even if [sx = 0 && sy < 0]: *) + if sy < 0 then invalid_arg "Float.Array.make_matrix"; + let res = Array.make sx (create 0) in + if sy > 0 then begin + for x = 0 to sx - 1 do + Array.unsafe_set res x (make sy v) + done; + end; + res + + let init_matrix sx sy f = + (* We raise even if [sx = 0 && sy < 0]: *) + if sy < 0 then invalid_arg "Float.Array.init_matrix"; + let res = Array.make sx (create 0) in + if sy > 0 then begin + for x = 0 to sx - 1 do + let row = create sy in + for y = 0 to sy - 1 do + unsafe_set row y (f x y) + done; + Array.unsafe_set res x row + done; + end; + res + let append a1 a2 = let l1 = length a1 in let l2 = length a2 in diff --git a/stdlib/float.mli b/stdlib/float.mli index d8dc86cb84a..239f1bd982e 100644 --- a/stdlib/float.mli +++ b/stdlib/float.mli @@ -533,6 +533,27 @@ module Array : sig applied to the integers [0] to [n-1]. @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *) + val make_matrix : int -> int -> float -> t array + (** [make_matrix dimx dimy e] returns a two-dimensional array + (an array of arrays) with first dimension [dimx] and + second dimension [dimy], where all elements are initialized with [e]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_floatarray_length}. + + @since 5.2 *) + + val init_matrix : int -> int -> (int -> int -> float) -> t array + (** [init_matrix dimx dimy f] returns a two-dimensional array + (an array of arrays) + with first dimension [dimx] and second dimension [dimy], + where the element at index ([x,y]) is initialized with [f x y]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_floatarray_length}. + + @since 5.2 *) + val append : t -> t -> t (** [append v1 v2] returns a fresh floatarray containing the concatenation of the floatarrays [v1] and [v2]. @@ -879,6 +900,27 @@ module ArrayLabels : sig applied to the integers [0] to [n-1]. @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *) + val make_matrix : dimx:int -> dimy:int -> float -> t array + (** [make_matrix ~dimx ~dimy e] returns a two-dimensional array + (an array of arrays) with first dimension [dimx] and + second dimension [dimy], where all elements are initialized with [e]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_floatarray_length}. + + @since 5.2 *) + + val init_matrix : dimx:int -> dimy:int -> f:(int -> int -> float) -> t array + (** [init_matrix ~dimx ~dimy ~f] returns a two-dimensional array + (an array of arrays) + with first dimension [dimx] and second dimension [dimy], + where the element at index ([x,y]) is initialized with [f x y]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_floatarray_length}. + + @since 5.2 *) + val append : t -> t -> t (** [append v1 v2] returns a fresh floatarray containing the concatenation of the floatarrays [v1] and [v2]. diff --git a/stdlib/templates/floatarraylabeled.template.mli b/stdlib/templates/floatarraylabeled.template.mli index a615ffc2208..a691538367f 100644 --- a/stdlib/templates/floatarraylabeled.template.mli +++ b/stdlib/templates/floatarraylabeled.template.mli @@ -49,6 +49,27 @@ val init : int -> f:(int -> float) -> t applied to the integers [0] to [n-1]. @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *) +val make_matrix : dimx:int -> dimy:int -> float -> t array +(** [make_matrix ~dimx ~dimy e] returns a two-dimensional array + (an array of arrays) with first dimension [dimx] and + second dimension [dimy], where all elements are initialized with [e]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_floatarray_length}. + + @since 5.2 *) + +val init_matrix : dimx:int -> dimy:int -> f:(int -> int -> float) -> t array +(** [init_matrix ~dimx ~dimy ~f] returns a two-dimensional array + (an array of arrays) + with first dimension [dimx] and second dimension [dimy], + where the element at index ([x,y]) is initialized with [f x y]. + + @raise Invalid_argument if [dimx] or [dimy] is negative or + greater than {!Sys.max_floatarray_length}. + + @since 5.2 *) + val append : t -> t -> t (** [append v1 v2] returns a fresh floatarray containing the concatenation of the floatarrays [v1] and [v2]. diff --git a/testsuite/tests/lib-floatarray/floatarray.ml b/testsuite/tests/lib-floatarray/floatarray.ml index 564c325d7c6..654e15b6465 100644 --- a/testsuite/tests/lib-floatarray/floatarray.ml +++ b/testsuite/tests/lib-floatarray/floatarray.ml @@ -11,6 +11,8 @@ module type S = sig val make : int -> float -> t val create : int -> t val init : int -> (int -> float) -> t + val make_matrix : int -> int -> float -> t array + val init_matrix : int -> int -> (int -> int -> float) -> t array val append : t -> t -> t val concat : t list -> t val sub : t -> int -> int -> t @@ -125,6 +127,47 @@ module Test (A : S) : sig end = struct check_inval (fun i -> A.init i Float.of_int) (-1); check_inval (fun i -> A.init i Float.of_int) (A.max_length + 1); + (* [make_matrix] *) + let check_make_matrix m n = + let a = A.make_matrix m n 42. in + assert (Array.length a = m); + for i = 0 to m-1 do + let row = Array.get a i in + assert (A.length row = n); + for j = 0 to n-1 do + assert (A.get row j = 42.); + A.set row j (Float.of_int (i*n + j)); + done; + done; + (* check absence of sharing: *) + if n > 0 then begin + for i = 0 to m-1 do + assert (A.get (Array.get a i) 0 = Float.of_int (i*n)); + done + end + in + check_make_matrix 0 0; + check_make_matrix 0 3; + check_make_matrix 5 0; + check_make_matrix 5 3; + + (* [init_matrix] *) + let check_init_matrix m n = + let a = A.init_matrix m n (fun i j -> Float.of_int (i*n + j)) in + assert (Array.length a = m); + for i = 0 to m-1 do + let row = Array.get a i in + assert (A.length row = n); + for j = 0 to n-1 do + assert (A.get row j = Float.of_int (i*n + j)); + done; + done; + in + check_init_matrix 0 0; + check_init_matrix 0 3; + check_init_matrix 5 0; + check_init_matrix 5 3; + (* [append] *) let check m n = let a = A.init m Float.of_int in From ece4947ca8e2d09f86b1a960dac831f21bbbeea1 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 21 Sep 2023 16:26:01 +0200 Subject: [PATCH 076/402] Reuse register rather than loading from memory Co-authored-by: Fabrice Buoro --- runtime/amd64.S | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/amd64.S b/runtime/amd64.S index 41aa7ac3489..27496b22315 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -1141,7 +1141,7 @@ LBL(112): TSAN_SAVE_CALLER_REGS movq STACK_RETADDR(%rsp), C_ARG_1 /* arg 1: pc of perform */ leaq STACK_ARG_1(%rsp), C_ARG_2 /* arg 2: sp at perform */ - movq Caml_state(current_stack), C_ARG_3 /* arg 3: fiber */ + movq %r10, C_ARG_3 /* arg 3: performer stack */ SWITCH_OCAML_TO_C C_call (GCALL(caml_tsan_entry_on_resume)) SWITCH_C_TO_OCAML From 28edabf054c3e64b426ba89d5017d0f9f9ae388a Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 21 Sep 2023 16:30:33 +0200 Subject: [PATCH 077/402] Add Changes entry --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 262918acd94..8bec7f7f60e 100644 --- a/Changes +++ b/Changes @@ -386,6 +386,10 @@ Working version --enable-frame-pointers (Miod Vallat, report by Jan Midtgaard, review by Gabriel Scherer) +- #12561: Fix crash when combining TSan and frame-pointers + (Fabrice Buoro and Olivier Nicole, report by Jan Midtgaard, review by Miod + Vallat and Gabriel Scherer) + OCaml 5.1.0 (14 September 2023) ------------------------------- From 5c1b60cf41c1e2007bbd2eae41f1080be2746094 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Fri, 21 Apr 2023 15:51:44 +0200 Subject: [PATCH 078/402] Fix a typo in inheritance error message. --- testsuite/tests/typing-objects/errors.ml | 10 ++++++++++ typing/typeclass.ml | 4 ++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/typing-objects/errors.ml b/testsuite/tests/typing-objects/errors.ml index 148db20715d..d14b619bceb 100644 --- a/testsuite/tests/typing-objects/errors.ml +++ b/testsuite/tests/typing-objects/errors.ml @@ -50,3 +50,13 @@ Line 1, characters 37-41: ^^^^ Error: This expression has no method "bar" |}] + +class empty = object end +class also_empty = object inherit! empty end +[%%expect{| +class empty : object end +Line 2, characters 26-40: +2 | class also_empty = object inherit! empty end + ^^^^^^^^^^^^^^ +Error: This inheritance does not override any methods or instance variables. +|}] diff --git a/typing/typeclass.ml b/typing/typeclass.ml index ceeaa851d76..4bdd0012f5d 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -2173,8 +2173,8 @@ let report_error env 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@ %s@]" - "or instance variables" + fprintf ppf "@[This inheritance does not override any methods@ \ + or instance variables.@]" | No_overriding (kind, name) -> fprintf ppf "@[The %s %a@ has no previous definition@]" kind Style.inline_code name From e25b5abd4d3cdaeaea9e18635c18ac9a8a8cb377 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Mon, 24 Apr 2023 10:53:57 +0200 Subject: [PATCH 079/402] review: non-overriding inheritance error message --- Changes | 3 +++ testsuite/tests/typing-objects/errors.ml | 3 ++- typing/typeclass.ml | 7 +++++-- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 08a8510da5d..d016ee59736 100644 --- a/Changes +++ b/Changes @@ -227,6 +227,9 @@ Working version of --disable-debugger (which remains available for compatibility) (Gabriel Scherer, review by Damien Doligez and Sébastien Hinderer) +- #12199: improve the error message for non-overriding `inherit!` + (Florian Angeletti, review by Jules Aguillon) + - #12210: uniform style for inline code in compiler messages (Florian Angeletti, review by Gabriel Scherer) diff --git a/testsuite/tests/typing-objects/errors.ml b/testsuite/tests/typing-objects/errors.ml index d14b619bceb..fffab9c670e 100644 --- a/testsuite/tests/typing-objects/errors.ml +++ b/testsuite/tests/typing-objects/errors.ml @@ -58,5 +58,6 @@ class empty : object end Line 2, characters 26-40: 2 | class also_empty = object inherit! empty end ^^^^^^^^^^^^^^ -Error: This inheritance does not override any methods or instance variables. +Error: This inheritance does not override any methods or instance variables + but is explicitly marked as overriding with "!". |}] diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 4bdd0012f5d..bbc2e6b5dd8 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -2173,8 +2173,11 @@ let report_error env 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.@]" + 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 From 47a14444fa08706cca76e6cbc3fdeb6a1dc3dc62 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 21 Sep 2023 18:47:54 +0200 Subject: [PATCH 080/402] Avoid synchronising via ref inside test --- testsuite/tests/parallel/catch_break.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/parallel/catch_break.ml b/testsuite/tests/parallel/catch_break.ml index e650a4208be..250fe54e9f3 100644 --- a/testsuite/tests/parallel/catch_break.ml +++ b/testsuite/tests/parallel/catch_break.ml @@ -36,7 +36,7 @@ let run () = (* Goal: joining the domain [d] must be achievable by Ctrl-C *) let d = Domain.spawn (fun () -> break_trap "Domain 1") in - let finished = ref false in + let finished = Atomic.make false in (* Simulate repeated Ctrl-C *) let d2 = Domain.spawn (fun () -> ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigint]); @@ -48,14 +48,14 @@ let run () = ); Unix.sleepf 0.05; Unix.kill pid Sys.sigint; - if not !finished then kill (n - 1) + if not (Atomic.get finished) then kill (n - 1) in kill 10) in break_trap "Domain 0 - 1"; Domain.join d; break_trap "Domain 0 - 2"; - finished := true; + Atomic.set finished true; Domain.join d2 let () = From 90c1efc7f413b199e5abfad67915c844bea780dc Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 21 Sep 2023 18:49:54 +0200 Subject: [PATCH 081/402] Remove dead argument --- runtime/caml/signals.h | 2 +- runtime/signals.c | 23 +++++++---------------- 2 files changed, 8 insertions(+), 17 deletions(-) diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h index f11d7b8345f..4ef8ad1b2b2 100644 --- a/runtime/caml/signals.h +++ b/runtime/caml/signals.h @@ -65,7 +65,7 @@ void caml_request_major_slice (int global); void caml_request_minor_gc (void); CAMLextern int caml_convert_signal_number (int); CAMLextern int caml_rev_convert_signal_number (int); -value caml_execute_signal_exn(int signal_number, int in_signal_handler); +value caml_execute_signal_exn(int signal_number); CAMLextern void caml_record_signal(int signal_number); CAMLextern value caml_process_pending_signals_exn(void); CAMLextern void caml_set_action_pending(caml_domain_state *); diff --git a/runtime/signals.c b/runtime/signals.c index ddc12ffcbd1..ce6913dae10 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -93,7 +93,7 @@ CAMLexport value caml_process_pending_signals_exn(void) if (curr == 0) goto next_word; if ((curr & mask) == 0) goto next_bit; } - exn = caml_execute_signal_exn(signo, 0); + exn = caml_execute_signal_exn(signo); if (Is_exception_result(exn)) return exn; /* curr probably changed during the evaluation of the signal handler; refresh it from memory */ @@ -228,10 +228,8 @@ void caml_init_signal_handling(void) { /* Execute a signal handler immediately */ -value caml_execute_signal_exn(int signal_number, int in_signal_handler) +value caml_execute_signal_exn(int signal_number) { - value res; - value handler; #ifdef POSIX_SIGNALS sigset_t nsigs, sigs; /* Block the signal before executing the handler, and record in sigs @@ -240,19 +238,12 @@ value caml_execute_signal_exn(int signal_number, int in_signal_handler) sigaddset(&nsigs, signal_number); pthread_sigmask(SIG_BLOCK, &nsigs, &sigs); #endif - handler = Field(caml_signal_handlers, signal_number); - res = caml_callback_exn( - handler, - Val_int(caml_rev_convert_signal_number(signal_number))); + value handler = Field(caml_signal_handlers, signal_number); + value signum = Val_int(caml_rev_convert_signal_number(signal_number)); + value res = caml_callback_exn(handler, signum); #ifdef POSIX_SIGNALS - if (! in_signal_handler) { - /* Restore the original signal mask */ - pthread_sigmask(SIG_SETMASK, &sigs, NULL); - } else if (Is_exception_result(res)) { - /* Restore the original signal mask and unblock the signal itself */ - sigdelset(&sigs, signal_number); - pthread_sigmask(SIG_SETMASK, &sigs, NULL); - } + /* Restore the original signal mask */ + pthread_sigmask(SIG_SETMASK, &sigs, NULL); #endif return res; } From 02a07a40001d55b01cd63c43fa04442775d71204 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 21 Sep 2023 18:52:53 +0200 Subject: [PATCH 082/402] Remove needless signal masking (cf. 59029b994 and 5742171d) --- runtime/domain.c | 9 --------- 1 file changed, 9 deletions(-) diff --git a/runtime/domain.c b/runtime/domain.c index 68b71437c6b..08d26bf39a3 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -1864,19 +1864,10 @@ static void domain_terminate (void) caml_domain_state* domain_state = domain_self->state; struct interruptor* s = &domain_self->interruptor; int finished = 0; -#ifndef _WIN32 - sigset_t mask; -#endif caml_gc_log("Domain terminating"); s->terminating = 1; -#ifndef _WIN32 - /* Block all signals so that signal handlers do not run on this thread */ - sigfillset(&mask); - pthread_sigmask(SIG_BLOCK, &mask, NULL); -#endif - /* Join ongoing systhreads, if necessary, and then run user-defined termination hooks. No OCaml code can run on this domain after this. */ From 387f0ff4d1a171285e7babec19a30a5af100f4d5 Mon Sep 17 00:00:00 2001 From: eutro Date: Thu, 21 Sep 2023 19:09:18 +0100 Subject: [PATCH 083/402] Move `caml_collect_gc_stats_sample` before barrier arrival --- runtime/minor_gc.c | 63 ++++++++++++++++++++++++++++++---------------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index b9955139fdc..d2dd6641991 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -459,6 +459,9 @@ void caml_empty_minor_heap_domain_clear(caml_domain_state* domain) domain->extra_heap_resources_minor = 0.0; } +void caml_do_opportunistic_major_slice + (caml_domain_state* domain_unused, void* unused); + void caml_empty_minor_heap_promote(caml_domain_state* domain, int participating_count, caml_domain_state** participating) @@ -641,13 +644,33 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain, + (domain->young_end - domain->young_start) / 2; caml_reset_young_limit(domain); + domain->stat_minor_words += Wsize_bsize (minor_allocated_bytes); + domain->stat_promoted_words += domain->allocated_words - prev_alloc_words; + + /* gc stats may be accessed unsynchronised by mutator code, so we collect the + sample before arriving at the barrier, which ensures that it doesn't race + */ + caml_collect_gc_stats_sample(domain); + + /* The code above is synchronised with other domains by the barrier below, + which is split into two steps, "arriving" and "leaving". When the final + domain arrives at the barrier, all other domains are free to leave, after + which they finish running the STW callback and may, depending on the + specific STW section, begin executing mutator code. + + Leaving the barrier synchronises (only) with the arrivals of other domains, + so that all writes performed by a domain before arrival "happen-before" any + domain leaves the barrier. However, any code after arrival, including the + code between the two steps, can potentially race with mutator code. + */ + + /* arrive at the barrier */ if( participating_count > 1 ) { atomic_fetch_add_explicit (&domains_finished_minor_gc, 1, memory_order_release); } - - domain->stat_minor_words += Wsize_bsize (minor_allocated_bytes); - domain->stat_promoted_words += domain->allocated_words - prev_alloc_words; + /* other domains may be executing mutator code from this point, but + not before */ call_timing_hook(&caml_minor_gc_end_hook); CAML_EV_COUNTER(EV_C_MINOR_PROMOTED, @@ -660,6 +683,22 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain, domain->id, 100.0 * (double)st.live_bytes / (double)minor_allocated_bytes, (unsigned)(minor_allocated_bytes + 512)/1024); + + /* leave the barrier */ + if( participating_count > 1 ) { + CAML_EV_BEGIN(EV_MINOR_LEAVE_BARRIER); + { + SPIN_WAIT { + if (atomic_load_acquire(&domains_finished_minor_gc) == + participating_count) { + break; + } + + caml_do_opportunistic_major_slice(domain, 0); + } + } + CAML_EV_END(EV_MINOR_LEAVE_BARRIER); + } } void caml_do_opportunistic_major_slice @@ -703,24 +742,6 @@ caml_stw_empty_minor_heap_no_major_slice(caml_domain_state* domain, caml_gc_log("running stw empty_minor_heap_promote"); caml_empty_minor_heap_promote(domain, participating_count, participating); - /* collect gc stats before leaving the barrier */ - caml_collect_gc_stats_sample(domain); - - if( participating_count > 1 ) { - CAML_EV_BEGIN(EV_MINOR_LEAVE_BARRIER); - { - SPIN_WAIT { - if (atomic_load_acquire(&domains_finished_minor_gc) == - participating_count) { - break; - } - - caml_do_opportunistic_major_slice(domain, 0); - } - } - CAML_EV_END(EV_MINOR_LEAVE_BARRIER); - } - CAML_EV_BEGIN(EV_MINOR_FINALIZERS_ADMIN); caml_gc_log("running finalizer data structure book-keeping"); caml_final_update_last_minor(domain); From ed53c13d51171be5bbfa5a543ae9a6bb342ebd83 Mon Sep 17 00:00:00 2001 From: eutro Date: Thu, 21 Sep 2023 22:27:22 +0100 Subject: [PATCH 084/402] Add Changes entry --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 0ea6fafda84..d72594c1e0c 100644 --- a/Changes +++ b/Changes @@ -333,6 +333,10 @@ Working version ### Bug fixes: +- #12590, #12595: Move `caml_collect_gc_stats_sample` in + `caml_empty_minor_heap_promote` before barrier arrival. + (B. Szilvasy, review by Gabriel Scherer) + - #12580: Fix location of alias pattern variables. (Chris Casinghino, review Gabriel Scherer, report by Milo Davis) From dd74311982c621cdbf4e833e901eaa265a79a012 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Fri, 22 Sep 2023 17:40:28 +0200 Subject: [PATCH 085/402] Contributor name normalization: use a single name for contributions from the same person. --- Changes | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/Changes b/Changes index 26f0a32aa15..19a21d8644c 100644 --- a/Changes +++ b/Changes @@ -105,7 +105,7 @@ Working version - #12114: Add ThreadSanitizer support (Fabrice Buoro and Olivier Nicole, based on an initial work by Anmol Sahoo, - review by Damien Doligez, Sebastien Hinderer, Jacques-Henri Jourdan, Luc + review by Damien Doligez, Sébastien Hinderer, Jacques-Henri Jourdan, Luc Maranget, Guillaume Munch-Maccagnoni, Gabriel Scherer) - #11911, #12381: Restore statmemprof functionality in part @@ -524,7 +524,7 @@ OCaml 5.1.0 (14 September 2023) fold_right : ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc fold_left_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list ... - (Valentin Gatien-Baron and Francois Berenger, + (Valentin Gatien-Baron and François Berenger, review by Gabriel Scherer and Nicolás Ojeda Bär) - #11354: Hashtbl.find_all is now tail-recursive. @@ -605,7 +605,7 @@ Some of those changes will benefit all OCaml packages. (Fabrice Buoro and Stephen Dolan, review by Gabriel Scherer and Sadiq Jaffer) - #11144: Restore frame-pointers support for amd64 - (Fabrice Buoro, review by Frederic Bour and KC Sivaramakrishnan) + (Fabrice Buoro, review by Frédéric Bour and KC Sivaramakrishnan) - #11935: Load frametables of dynlink'd modules in batch (Stephen Dolan, review by David Allsopp and Guillaume Munch-Maccagnoni) @@ -709,7 +709,7 @@ Some of those changes will benefit all OCaml packages. was made based on the type of `F`. With this patch, we now distinguish these two application forms; writing `F (struct end)` for a generative functor leads to new warning 73. - (Frederic Bour and Richard Eisenberg, review by Florian Angeletti) + (Frédéric Bour and Richard Eisenberg, review by Florian Angeletti) - #9975, #11365: Make empty types (`type t = |`) immediate. @@ -1598,7 +1598,7 @@ OCaml 5.0.0 (15 December 2022) - #11309, #11424, #11427, #11545: Add Domain.recommended_domain_count. (Christiano Haesbaert, Konstantin Belousov, review by David Allsopp, - KC Sivaramakrishnan, Gabriel Scherer, Nicolas Ojeda Bar) + KC Sivaramakrishnan, Gabriel Scherer, Nicolás Ojeda Bär) - #11461, #11466: Fix gethostbyaddr for IPv6 arguments and make it domain-safe (Olivier Nicole, Nicolás Ojeda Bär, David Allsopp and Xavier Leroy, @@ -2626,7 +2626,7 @@ OCaml 4.13.0 (24 September 2021) - #1400: Add an optional invariants check on Cmm, which can be activated with the -dcmm-invariants flag - (Vincent Laviron, with help from Sebastien Hinderer, review by Stephen Dolan + (Vincent Laviron, with help from Sébastien Hinderer, review by Stephen Dolan and David Allsopp) - #9562, #367: Allow CSE of immutable loads across stores @@ -2662,7 +2662,7 @@ OCaml 4.13.0 (24 September 2021) - #9487, #9489: Add Random.full_int which allows 62-bit bounds on 64-bit systems. - (David Allsopp, request by Francois Berenger, review by Xavier Leroy and + (David Allsopp, request by François Berenger, review by Xavier Leroy and Damien Doligez) - #9961: Add Array.fold_left_map. @@ -3656,7 +3656,7 @@ OCaml 4.12.0 (24 February 2021) not low (Chet Murthy, review by Florian Angeletti) - #9590: fix pprint of extension constructors (and exceptions) that rebind - (Chet Murthy, review by octachron@) + (Chet Murthy, review by Florian Angeletti) - #9963: Centralized tracking of frontend's global state (Frédéric Bour and Thomas Refis, review by Gabriel Scherer) @@ -3714,7 +3714,7 @@ OCaml 4.12.0 (24 February 2021) - #7902, #9556: Type-checker infers recursive type, even though -rectypes is off. - (Jacques Garrigue, report by Francois Pottier, review by Leo White) + (Jacques Garrigue, report by François Pottier, review by Leo White) - #8746: Hashtbl: Restore ongoing traversal status after filter_map_inplace (Mehdi Bouaziz, review by Alain Frisch) @@ -4120,7 +4120,7 @@ OCaml 4.11.0 (19 August 2020) (Glenn Slotte, review by Florian Angeletti) - #9410, #9422: replaced naive fibonacci example with gcd - (Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès) + (Anukriti Kumar, review by San Vũ Ngọc, Florian Angeletti, Léo Andrès) - #9541: Add a documentation page for the instrumented runtime; additional changes to option names in the instrumented runtime. @@ -4751,7 +4751,7 @@ OCaml 4.10.0 (21 February 2020) locate an `.ocamlinit` file. Reads an `$XDG_CONFIG_HOME/ocaml/init.ml` file before trying to lookup `~/.ocamlinit`. On Windows the behaviour is unchanged. - (Daniel C. Bünzli, review by David Allsopp, Armaël Guéneau and + (Daniel Bünzli, review by David Allsopp, Armaël Guéneau and Nicolás Ojeda Bär) - #9113: ocamldoc: fix the rendering of multi-line code blocks @@ -4759,7 +4759,7 @@ OCaml 4.10.0 (21 February 2020) (Gabriel Scherer, review by Florian Angeletti) - #9127, #9130: ocamldoc: fix the formatting of closing brace in record types. - (David Allsopp, report by San Vu Ngoc) + (David Allsopp, report by San Vũ Ngọc) - #9181: make objinfo work on Cygwin and look for the caml_plugin_header symbol in both the static and the dynamic symbol tables. @@ -5528,7 +5528,7 @@ OCaml 4.08.0 (13 June 2019) ### Other libraries: - #2533, #1839, #1949: added Unix.fsync - (Francois Berenger, Nicolás Ojeda Bär, review by Daniel Bünzli, David Allsopp + (François Berenger, Nicolás Ojeda Bär, review by Daniel Bünzli, David Allsopp and ygrek) - #1792, #7794: Add Unix.open_process_args{,_in,_out,_full} similar to @@ -6458,15 +6458,15 @@ OCaml 4.07.0 (10 July 2018) (Hugo Heuzard, reviewed by Nicolás Ojeda Bär) - #1627: Reduce cmx sizes by sharing variable names (Flambda only). - (Fuyong Quah, Leo White, review by Xavier Clerc) + (Fu Yong Quah, Leo White, review by Xavier Clerc) - #1665: reduce the size of cmx files in classic mode by dropping the bodies of functions that will not be inlined. - (Fuyong Quah, review by Leo White and Pierre Chambart) + (Fu Yong Quah, review by Leo White and Pierre Chambart) - #1666: reduce the size of cmx files in classic mode by dropping the bodies of functions that cannot be reached from the module block. - (Fuyong Quah, review by Leo White and Pierre Chambart) + (Fu Yong Quah, review by Leo White and Pierre Chambart) - #1686: Turn off by default flambda invariants checks. (Pierre Chambart) @@ -7302,7 +7302,7 @@ OCaml 4.06.0 (3 Nov 2017): - #1012: ocamlyacc, fix parsing of raw strings and nested comments, as well as the handling of ' characters in identifiers. - (Demi Obenour) + (Demi Marie Obenour) - #1045: ocamldep, add a "-shared" option to generate dependencies for native plugin files (i.e. .cmxs files) @@ -8484,7 +8484,7 @@ OCaml 4.04.0 (4 Nov 2016): - #427: Obj.is_block is now an inlined OCaml function instead of a C external. This should be faster. - (Demi Obenour) + (Demi Marie Obenour) - #580: Optimize immutable float records (Pierre Chambart, review by Mark Shinwell) @@ -8626,7 +8626,7 @@ OCaml 4.04.0 (4 Nov 2016): * #512, #587: Installed `ocamlc`, `ocamlopt`, and `ocamllex` are now the native-code versions of the tools, if those versions were built. - (Demi Obenour) + (Demi Marie Obenour) - #525: fix build on OpenIndiana (Sergey Avseyev, review by Damien Doligez) @@ -9048,7 +9048,7 @@ OCaml 4.03.0 (25 Apr 2016): settings that are currently the default: `-alias-deps`, `-app-funct`, `-no-keep-docs`, `-no-keep-locs`, `-no-principal`, `-no-rectypes`, `-no-strict-formats` - (Demi Obenour) + (Demi Marie Obenour) - #545: use reraise to preserve backtrace on `match .. with exception e -> raise e` From 6da5a5d119b319e0dfc5d6234cdc6983119f0ea8 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Fri, 22 Sep 2023 17:45:40 +0200 Subject: [PATCH 086/402] typo in contributor names --- Changes | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Changes b/Changes index 19a21d8644c..08b352924a2 100644 --- a/Changes +++ b/Changes @@ -1210,7 +1210,7 @@ Some of those changes will benefit all OCaml packages. - #11450, #12018: Fix erroneous functor error messages that were too eager to cast `struct end` functor arguments as unit modules in `F(struct end)`. - (Florian Angetti, review by Gabriel Scherer) + (Florian Angeletti, review by Gabriel Scherer) - #11643: Add missing test declaration to float_compare test, so that it will run. @@ -1279,7 +1279,7 @@ Some of those changes will benefit all OCaml packages. - #12075: auto-detect whether `ar` support @FILE arguments at configure-time to avoid using this feature with toolchains that do not support it (eg FreeBSD/Darwin). - (Nicolás Ojeda Bär, review by Xavier Leroy, David Allsop, Javier + (Nicolás Ojeda Bär, review by Xavier Leroy, David Allsopp, Javier Chávarri, Anil Madhavapeddy) - #12103, 12104: fix a concurrency memory-safety bug in Buffer @@ -2022,7 +2022,7 @@ OCaml 4.14.0 (28 March 2022) * #10583, #10998: Add over 40 new functions in Seq. (François Pottier and Simon Cruanes, review by Nicolás Ojeda Bär, - Daniel Bünzli, Naëla Courant, Craig Ferguson, Wiktor Kuchta, + Daniel Bünzli, Nathanaëlle Courant, Craig Ferguson, Wiktor Kuchta, Xavier Leroy, Guillaume Munch-Maccagnoni, Raphaël Proust, Gabriel Scherer and Thierry Martinez) @@ -2134,7 +2134,7 @@ OCaml 4.14.0 (28 March 2022) (Dong An, review by Xavier Leroy and David Allsopp) - #10397: Document exceptions raised by Unix module functions on Windows - (Martin Jambon, review by Daniel Bünzli, David Alsopp, Damien Doligez, + (Martin Jambon, review by Daniel Bünzli, David Allsopp, Damien Doligez, Xavier Leroy, and Florian Angeletti) - #10589: Fix many typos (excess/inconsistent spaces) in the HTML manual. @@ -2524,7 +2524,7 @@ OCaml 4.13.0 (24 September 2021) A mostly-internal change that preserves more information in errors during type checking; most significantly, it split the errors from unification, moregen, and type equality into three different types. - (Antal Spector-Zabusky and Mekhrubon Tuarev, review by Leo White, + (Antal Spector-Zabusky and Mekhrubon Turaev, review by Leo White, Florian Angeletti, and Jacques Garrigue) - #9994: Make Types.type_expr a private type, and abstract marking mechanism @@ -2814,7 +2814,7 @@ OCaml 4.13.0 (24 September 2021) (Gabriel Scherer, review by Thomas Refis and Florian Angeletti) - #9827: Replace references with functions arguments in Simplif - (Anukriti Kumar, review by Vincent Laviron and David Allsop) + (Anukriti Kumar, review by Vincent Laviron and David Allsopp) - #10007: Driver.compile_common: when typing a .ml file, return the compilation unit signature (inferred or from the .cmi) in addition @@ -3189,8 +3189,8 @@ OCaml 4.12.0 (24 February 2021) I/O locks are not held while it runs. A polling point was removed from caml_leave_blocking_section, and one added to caml_raise. (Stephen Dolan, review by Goswin von Brederlow, Xavier Leroy, Damien - Doligez, Anil Madhavapeddy, Guillaume Munch-Maccagnoni and Jacques- - Henri Jourdan) + Doligez, Anil Madhavapeddy, Guillaume Munch-Maccagnoni + and Jacques-Henri Jourdan) * #5154, #9569, #9734: Add `Val_none`, `Some_val`, `Is_none`, `Is_some`, `caml_alloc_some`, and `Tag_some`. As these macros are sometimes defined by @@ -3324,7 +3324,7 @@ OCaml 4.12.0 (24 February 2021) - #10050: update {PUSH,}OFFSETCLOSURE* bytecode instructions to match new representation for closures - (Nathanaël Courant, review by Xavier Leroy) + (Nathanaëlle Courant, review by Xavier Leroy) - #9728: Take advantage of the new closure representation to simplify the compaction algorithm and remove its dependence on the page table @@ -3623,7 +3623,7 @@ OCaml 4.12.0 (24 February 2021) report by Alex Fedoseev through Hongbo Zhang) - #9514: optimize pattern-matching exhaustivity analysis in the single-row case - (Gabriel Scherer, review by Stephen DOlan) + (Gabriel Scherer, review by Stephen Dolan) - #9442: refactor the implementation of the [@tailcall] attribute to allow for a structured attribute payload @@ -4218,7 +4218,7 @@ OCaml 4.11.0 (19 August 2020) Caml_inline to stop abuse of the inline keyword on MSVC and to help ensure that only static inline is used in the codebase (erroneous instance in runtime/win32.c removed). - (David Allsopp, review by Oliver Andrieu and Xavier Leroy) + (David Allsopp, review by Olivier Andrieu and Xavier Leroy) - #8934: Stop relying on location to track usage (Thomas Refis, review by Gabriel Radanne) @@ -6304,7 +6304,7 @@ OCaml 4.07.0 (10 July 2018) - #7528, #1500: add a Format.pp_set_geometry function to avoid memory effects in set_margin and set_max_indent. (Florian Angeletti, review by Richard Bonichon, Gabriel Radanne, - Gabiel Scherer and Pierre Weis) + Gabriel Scherer and Pierre Weis) - #7690, #1528: fix the float_of_string function for hexadecimal floats with very large values of the exponent. From 12fa1636c9d70200c33672f9cb417a9c35e8a492 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Fri, 22 Sep 2023 17:48:24 +0200 Subject: [PATCH 087/402] changes: missing comma --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 08b352924a2..d3e5ad1f97c 100644 --- a/Changes +++ b/Changes @@ -1507,7 +1507,7 @@ OCaml 5.0.0 (15 December 2022) - #10972: ARM64 multicore support: OCaml & C stack separation; dynamic stack size checks; fiber and effects support. - (Tom Kelly and Xavier Leroy, review by KC Sivaramakrishnan, Xavier Leroy + (Tom Kelly and Xavier Leroy, review by KC Sivaramakrishnan, Xavier Leroy, Guillaume Munch-Maccagnoni, Eduardo Rafael, Stephen Dolan and Gabriel Scherer) From adf1a8f050bfb352856d5ad26e11265607964a41 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 21 Sep 2023 14:55:49 +0200 Subject: [PATCH 088/402] major_gc.c: shorter `orphaned_lock` sections There is currently a race on the `orph_structs` global, which is read by `no_orphaned_work()` without being protected by the `orphaned_lock` mutex. We will add locking inside `no_orphaned_work`, but to reduce the performance impact we first ensure that the `orphaned_lock` critical sections are as short as possible. --- runtime/major_gc.c | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 18a615b0e63..d8c4a76cc59 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -346,15 +346,14 @@ static void orph_ephe_list_verify_status (int status) value v; caml_plat_lock(&orphaned_lock); - v = orph_structs.ephe_list_live; + caml_plat_unlock(&orphaned_lock); + while (v) { CAMLassert (Tag_val(v) == Abstract_tag); CAMLassert (Has_status_val(v, status)); v = Ephe_link(v); } - - caml_plat_unlock(&orphaned_lock); } #endif @@ -366,8 +365,6 @@ static intnat ephe_mark (intnat budget, uintnat for_cycle, int force_alive); CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ void caml_add_to_orphaned_ephe_list(struct caml_ephe_info* ephe_info) { - caml_plat_lock(&orphaned_lock); - /* Force all ephemerons and their data on todo list to be alive */ if (ephe_info->todo) { while (ephe_info->todo) { @@ -380,13 +377,14 @@ void caml_add_to_orphaned_ephe_list(struct caml_ephe_info* ephe_info) if (ephe_info->live) { value live_tail = ephe_list_tail(ephe_info->live); CAMLassert(Ephe_link(live_tail) == 0); + + caml_plat_lock(&orphaned_lock); Ephe_link(live_tail) = orph_structs.ephe_list_live; orph_structs.ephe_list_live = ephe_info->live; ephe_info->live = 0; + caml_plat_unlock(&orphaned_lock); } - caml_plat_unlock(&orphaned_lock); - if (ephe_info->must_sweep_ephe) { ephe_info->must_sweep_ephe = 0; atomic_fetch_add_verify_ge0(&num_domains_to_ephe_sweep, -1); @@ -397,7 +395,7 @@ CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ void caml_adopt_orphaned_work (void) { caml_domain_state* domain_state = Caml_state; - value last; + value orph_ephe_list_live, last; struct caml_final_info *f, *myf, *temp; if (no_orphaned_work() || caml_domain_is_terminating()) @@ -405,15 +403,21 @@ void caml_adopt_orphaned_work (void) caml_plat_lock(&orphaned_lock); - if (orph_structs.ephe_list_live) { - last = ephe_list_tail(orph_structs.ephe_list_live); + orph_ephe_list_live = orph_structs.ephe_list_live; + orph_structs.ephe_list_live = 0; + + f = orph_structs.final_info; + orph_structs.final_info = NULL; + + caml_plat_unlock(&orphaned_lock); + + if (orph_ephe_list_live) { + last = ephe_list_tail(orph_ephe_list_live); CAMLassert(Ephe_link(last) == 0); Ephe_link(last) = domain_state->ephe_info->live; - domain_state->ephe_info->live = orph_structs.ephe_list_live; - orph_structs.ephe_list_live = 0; + domain_state->ephe_info->live = orph_ephe_list_live; } - f = orph_structs.final_info; myf = domain_state->final_info; while (f != NULL) { CAMLassert (!f->updated_first); @@ -441,8 +445,6 @@ void caml_adopt_orphaned_work (void) f = f->next; caml_stat_free (temp); } - orph_structs.final_info = NULL; - caml_plat_unlock(&orphaned_lock); } #define BUFFER_SIZE 64 From f144f99959d899b85afe9ef0771718732a266305 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 21 Sep 2023 15:01:59 +0200 Subject: [PATCH 089/402] major_gc.c: fix a race on `orph_structs` in `no_orphaned_work()` To avoid taking a lock in `no_orphaned_work()`, we make the orph_struct fields atomic. The lock is now only used to guarantee that the `add_*` and `adopt` operations do not race to each other. Suggested-by: Guillaume Munch-Maccagnoni --- Changes | 4 ++++ runtime/major_gc.c | 26 +++++++++++++++----------- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/Changes b/Changes index 26f0a32aa15..d54adf57bf4 100644 --- a/Changes +++ b/Changes @@ -380,6 +380,10 @@ Working version (Vincent Laviron, report by François Pottier, review by Nathanaëlle Courant and Gabriel Scherer) +- #11040, #12591: fix a data race in major_gc.c + (Gabriel Scherer, review by Guillaume Munch-Maccagnoni + and KC Sivaramakrishnan, report by Sadiq Jaffer) + - #12238, #12403: read input files in one go to avoid source reprinting issues (Gabriel Scherer, report by Mike Spivey and Vincent Laviron, review by Nicolás Ojeda Bär, Xavier Leroy and Jeremy Yallop) diff --git a/runtime/major_gc.c b/runtime/major_gc.c index d8c4a76cc59..9b9799d6caa 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -286,11 +286,20 @@ static void record_ephe_marking_done (uintnat ephe_cycle) caml_plat_unlock(&ephe_lock); } -/* These are biased data structures left over from terminating domains. */ +/* These are biased data structures left over from terminating domains. + + Synchronization: + - operations that mutate the structure + (adding new orphaned values or adopting orphans) + are protected from each other using [orphaned_lock]; + this is simpler than using atomic lists, and not performance-sensitive + - the read-only function [no_orphaned_work()] uses atomic accesses + to avoid taking a lock (it is called more often) + */ static struct { - value ephe_list_live; - struct caml_final_info *final_info; -} orph_structs = {0, 0}; + value _Atomic ephe_list_live; + struct caml_final_info * _Atomic final_info; +} orph_structs = {0, NULL}; static caml_plat_mutex orphaned_lock = CAML_PLAT_MUTEX_INITIALIZER; @@ -321,12 +330,11 @@ void caml_final_domain_terminate (caml_domain_state *domain_state) } } -CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ static int no_orphaned_work (void) { return - orph_structs.ephe_list_live == 0 && - orph_structs.final_info == NULL; + atomic_load_acquire(&orph_structs.ephe_list_live) == 0 && + atomic_load_acquire(&orph_structs.final_info) == NULL; } Caml_inline value ephe_list_tail(value e) @@ -345,9 +353,7 @@ static void orph_ephe_list_verify_status (int status) { value v; - caml_plat_lock(&orphaned_lock); v = orph_structs.ephe_list_live; - caml_plat_unlock(&orphaned_lock); while (v) { CAMLassert (Tag_val(v) == Abstract_tag); @@ -362,7 +368,6 @@ static void orph_ephe_list_verify_status (int status) static intnat ephe_mark (intnat budget, uintnat for_cycle, int force_alive); -CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ void caml_add_to_orphaned_ephe_list(struct caml_ephe_info* ephe_info) { /* Force all ephemerons and their data on todo list to be alive */ @@ -391,7 +396,6 @@ void caml_add_to_orphaned_ephe_list(struct caml_ephe_info* ephe_info) } } -CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ void caml_adopt_orphaned_work (void) { caml_domain_state* domain_state = Caml_state; From 4c3016f1a1c697b1b883fc35f7819f6cfbaec2bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Sun, 24 Sep 2023 15:33:34 +0200 Subject: [PATCH 090/402] Get rid of the LongString module (#12360) Reimplements the LongString module defined in utils/misc.ml on top of 1-dimension bigarrays of characters, which are a more efficient representation than the currently implemented one, based on an array of strings. --------- Co-authored-by: Stephen Dolan --- .depend | 1 - bytecomp/bytelink.ml | 26 ++++++---- bytecomp/emitcode.ml | 45 ++++++++++-------- bytecomp/emitcode.mli | 3 +- bytecomp/meta.ml | 3 +- bytecomp/meta.mli | 3 +- bytecomp/symtable.ml | 9 ++-- bytecomp/symtable.mli | 4 +- otherlibs/dynlink/byte/dynlink.ml | 12 ++++- runtime/meta.c | 23 +++------ .../test10_main.byte.reference | 4 +- toplevel/byte/topeval.ml | 7 ++- utils/misc.ml | 47 ------------------- utils/misc.mli | 17 ------- 14 files changed, 81 insertions(+), 123 deletions(-) diff --git a/.depend b/.depend index 7867d3167eb..9ca340a45f3 100644 --- a/.depend +++ b/.depend @@ -2241,7 +2241,6 @@ bytecomp/symtable.cmx : \ parsing/asttypes.cmi \ bytecomp/symtable.cmi bytecomp/symtable.cmi : \ - utils/misc.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ file_formats/cmo_format.cmi diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 1fb2d085351..754ecb9fc5a 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -226,7 +226,14 @@ let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list) let link_compunit output_fun currpos_fun inchan file_name compunit = check_consistency file_name compunit; seek_in inchan compunit.cu_pos; - let code_block = LongString.input_bytes inchan compunit.cu_codesize in + let code_block = + Bigarray.Array1.create Bigarray.Char Bigarray.c_layout compunit.cu_codesize + in + match + In_channel.really_input_bigarray inchan code_block 0 compunit.cu_codesize + with + | None -> raise End_of_file + | Some () -> (); Symtable.patch_object code_block compunit.cu_reloc; if !Clflags.debug && compunit.cu_debug > 0 then begin seek_in inchan compunit.cu_debug; @@ -239,7 +246,7 @@ let link_compunit output_fun currpos_fun inchan file_name compunit = else file_path :: debug_dirs in debug_info := (currpos_fun(), debug_event_list, debug_dirs) :: !debug_info end; - Array.iter output_fun code_block; + output_fun code_block; if !Clflags.link_everything then List.iter Symtable.require_primitive compunit.cu_primitives @@ -372,7 +379,8 @@ let link_bytecode ?final_name tolink exec_name standalone = try Dll.open_dlls Dll.For_checking sharedobjs with Failure reason -> raise(Error(Cannot_open_dll reason)) end; - let output_fun = output_bytes outchan + let output_fun buf = + Out_channel.output_bigarray outchan buf 0 (Bigarray.Array1.dim buf) and currpos_fun () = pos_out outchan - start_code in List.iter (link_file output_fun currpos_fun) tolink; if check_dlls then Dll.close_all_dlls(); @@ -418,12 +426,12 @@ let output_code_string_counter = ref 0 let output_code_string outchan code = let pos = ref 0 in - let len = Bytes.length code in + let len = Bigarray.Array1.dim code in while !pos < len do - let c1 = Char.code(Bytes.get code !pos) in - let c2 = Char.code(Bytes.get code (!pos + 1)) in - let c3 = Char.code(Bytes.get code (!pos + 2)) in - let c4 = Char.code(Bytes.get code (!pos + 3)) in + let c1 = Char.code(Bigarray.Array1.get code !pos) in + let c2 = Char.code(Bigarray.Array1.get code (!pos + 1)) in + let c3 = Char.code(Bigarray.Array1.get code (!pos + 2)) in + let c4 = Char.code(Bigarray.Array1.get code (!pos + 3)) in pos := !pos + 4; Printf.fprintf outchan "0x%02x%02x%02x%02x, " c4 c3 c2 c1; incr output_code_string_counter; @@ -506,7 +514,7 @@ let link_bytecode_as_c tolink outfile with_main = let currpos = ref 0 in let output_fun code = output_code_string outchan code; - currpos := !currpos + Bytes.length code + currpos := !currpos + (Bigarray.Array1.dim code) and currpos_fun () = !currpos in List.iter (link_file output_fun currpos_fun) tolink; (* The final STOP instruction *) diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml index 3ac5b9707c4..091e2bbbe36 100644 --- a/bytecomp/emitcode.ml +++ b/bytecomp/emitcode.ml @@ -50,24 +50,30 @@ let () = ) (* Buffering of bytecode *) -let out_buffer = ref(LongString.create 0) +let create_bigarray = Bigarray.Array1.create Bigarray.Char Bigarray.c_layout + +let copy_bigarray src dst size = + Bigarray.Array1.(blit (sub src 0 size) (sub dst 0 size)) + +let out_buffer = ref(create_bigarray 0) and out_position = ref 0 let extend_buffer needed = - let size = LongString.length !out_buffer in + let size = Bigarray.Array1.dim !out_buffer in let new_size = ref(max size 16) (* we need new_size > 0 *) in while needed >= !new_size do new_size := 2 * !new_size done; - let new_buffer = LongString.create !new_size in - LongString.blit !out_buffer 0 new_buffer 0 (LongString.length !out_buffer); + let new_buffer = create_bigarray !new_size in + copy_bigarray !out_buffer new_buffer size; out_buffer := new_buffer let out_word b1 b2 b3 b4 = let p = !out_position in - if p+3 >= LongString.length !out_buffer then extend_buffer (p+3); - LongString.set !out_buffer p (Char.unsafe_chr b1); - LongString.set !out_buffer (p+1) (Char.unsafe_chr b2); - LongString.set !out_buffer (p+2) (Char.unsafe_chr b3); - LongString.set !out_buffer (p+3) (Char.unsafe_chr b4); + let open Bigarray.Array1 in + if p+3 >= dim !out_buffer then extend_buffer (p+3); + set !out_buffer p (Char.unsafe_chr b1); + set !out_buffer (p+1) (Char.unsafe_chr b2); + set !out_buffer (p+2) (Char.unsafe_chr b3); + set !out_buffer (p+3) (Char.unsafe_chr b4); out_position := p + 4 let out opcode = @@ -117,10 +123,11 @@ let extend_label_table needed = let backpatch (pos, orig) = let displ = (!out_position - orig) asr 2 in - LongString.set !out_buffer pos (Char.unsafe_chr displ); - LongString.set !out_buffer (pos+1) (Char.unsafe_chr (displ asr 8)); - LongString.set !out_buffer (pos+2) (Char.unsafe_chr (displ asr 16)); - LongString.set !out_buffer (pos+3) (Char.unsafe_chr (displ asr 24)) + let open Bigarray.Array1 in + set !out_buffer pos (Char.unsafe_chr displ); + set !out_buffer (pos+1) (Char.unsafe_chr (displ asr 8)); + set !out_buffer (pos+2) (Char.unsafe_chr (displ asr 16)); + set !out_buffer (pos+3) (Char.unsafe_chr (displ asr 24)) let define_label lbl = if lbl >= Array.length !label_table then extend_label_table lbl; @@ -198,12 +205,12 @@ let clear() = reloc_info := []; debug_dirs := String.Set.empty; events := []; - out_buffer := LongString.create 0 + out_buffer := create_bigarray 0 let init () = clear (); label_table := Array.make 16 (Label_undefined []); - out_buffer := LongString.create 1024 + out_buffer := create_bigarray 1024 (* Emission of one instruction *) @@ -420,7 +427,7 @@ let to_file outchan artifact_info ~required_globals code = output_binary_int outchan 0; let pos_code = pos_out outchan in emit code; - LongString.output outchan !out_buffer 0 !out_position; + Out_channel.output_bigarray outchan !out_buffer 0 !out_position; let (pos_debug, size_debug) = if !Clflags.debug then begin let filename = Unit_info.Artifact.filename artifact_info in @@ -466,8 +473,8 @@ let to_memory instrs = init(); Fun.protect ~finally:clear (fun () -> emit instrs; - let code = LongString.create !out_position in - LongString.blit !out_buffer 0 code 0 !out_position; + let code = create_bigarray !out_position in + copy_bigarray !out_buffer code !out_position; let reloc = List.rev !reloc_info in let events = !events in (code, reloc, events)) @@ -478,7 +485,7 @@ let to_packed_file outchan code = init (); Fun.protect ~finally:clear (fun () -> emit code; - LongString.output outchan !out_buffer 0 !out_position; + Out_channel.output_bigarray outchan !out_buffer 0 !out_position; let reloc = List.rev !reloc_info in let events = !events in let debug_dirs = !debug_dirs in diff --git a/bytecomp/emitcode.mli b/bytecomp/emitcode.mli index f7420c0b624..45dec1de8bd 100644 --- a/bytecomp/emitcode.mli +++ b/bytecomp/emitcode.mli @@ -29,7 +29,8 @@ val to_file: out_channel -> Unit_info.Artifact.t -> list of instructions to emit *) val to_memory: instruction list -> - Misc.LongString.t * (reloc_info * int) list * debug_event list + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t * + (reloc_info * int) list * debug_event list (* Arguments: initialization code (terminated by STOP) function code diff --git a/bytecomp/meta.ml b/bytecomp/meta.ml index db2ba1557c9..0009be19039 100644 --- a/bytecomp/meta.ml +++ b/bytecomp/meta.ml @@ -18,7 +18,8 @@ external realloc_global_data : int -> unit = "caml_realloc_global" type closure = unit -> Obj.t type bytecode external reify_bytecode : - bytes array -> Instruct.debug_event list array -> string option -> + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> + Instruct.debug_event list array -> string option -> bytecode * closure = "caml_reify_bytecode" external release_bytecode : bytecode -> unit diff --git a/bytecomp/meta.mli b/bytecomp/meta.mli index 6ce6ea0316c..cc051f68cf4 100644 --- a/bytecomp/meta.mli +++ b/bytecomp/meta.mli @@ -20,7 +20,8 @@ external realloc_global_data : int -> unit = "caml_realloc_global" type closure = unit -> Obj.t type bytecode external reify_bytecode : - bytes array -> Instruct.debug_event list array -> string option -> + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> + Instruct.debug_event list array -> string option -> bytecode * closure = "caml_reify_bytecode" external release_bytecode : bytecode -> unit diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 5d68dc40c26..2364ad4d6a6 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -270,10 +270,11 @@ let init () = (* Relocate a block of object bytecode *) let patch_int buff pos n = - LongString.set buff pos (Char.unsafe_chr n); - LongString.set buff (pos + 1) (Char.unsafe_chr (n asr 8)); - LongString.set buff (pos + 2) (Char.unsafe_chr (n asr 16)); - LongString.set buff (pos + 3) (Char.unsafe_chr (n asr 24)) + let open Bigarray.Array1 in + set buff pos (Char.unsafe_chr n); + set buff (pos + 1) (Char.unsafe_chr (n asr 8)); + set buff (pos + 2) (Char.unsafe_chr (n asr 16)); + set buff (pos + 3) (Char.unsafe_chr (n asr 24)) let patch_object buff patchlist = List.iter diff --git a/bytecomp/symtable.mli b/bytecomp/symtable.mli index 4b98f487224..9bf63384aa6 100644 --- a/bytecomp/symtable.mli +++ b/bytecomp/symtable.mli @@ -46,7 +46,9 @@ end (* Functions for batch linking *) val init: unit -> unit -val patch_object: Misc.LongString.t -> (reloc_info * int) list -> unit +val patch_object: + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> + (reloc_info * int) list -> unit val require_primitive: string -> unit val initial_global_table: unit -> Obj.t array val output_global_map: out_channel -> unit diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml index 2bac5d796b9..08fc80eff01 100644 --- a/otherlibs/dynlink/byte/dynlink.ml +++ b/otherlibs/dynlink/byte/dynlink.ml @@ -99,13 +99,21 @@ module Bytecode = struct Fun.protect f ~finally:(fun () -> Mutex.unlock lock) + let really_input_bigarray ic ar st n = + match In_channel.really_input_bigarray ic ar st n with + | None -> raise End_of_file + | Some () -> () + let run lock (ic, file_name, file_digest) ~unit_header ~priv = - let open Misc in let clos = with_lock lock (fun () -> let old_state = Symtable.current_state () in let compunit : Cmo_format.compilation_unit = unit_header in seek_in ic compunit.cu_pos; - let code = LongString.input_bytes ic compunit.cu_codesize in + let code = + Bigarray.Array1.create Bigarray.Char Bigarray.c_layout + compunit.cu_codesize + in + really_input_bigarray ic code 0 compunit.cu_codesize; begin try Symtable.patch_object code compunit.cu_reloc; Symtable.check_global_initialized compunit.cu_reloc; diff --git a/runtime/meta.c b/runtime/meta.c index 5bd1000b920..4dea22357aa 100644 --- a/runtime/meta.c +++ b/runtime/meta.c @@ -20,6 +20,7 @@ #include #include "caml/alloc.h" #include "caml/backtrace_prim.h" +#include "caml/bigarray.h" #include "caml/codefrag.h" #include "caml/config.h" #include "caml/debugger.h" @@ -64,28 +65,16 @@ CAMLprim value caml_reify_bytecode(value ls_prog, CAMLparam3(ls_prog, debuginfo, digest_opt); CAMLlocal3(clos, bytecode, retval); code_t prog; - asize_t len, off; /* in bytes */ + asize_t len; /* in bytes */ enum digest_status digest_kind; unsigned char * digest; - int fragnum, i; + int fragnum; - /* ls_prog is a bytes array (= LongString.t) */ - len = 0; - for (i = 0; i < Wosize_val(ls_prog); i++) { - value s = Field(ls_prog, i); - len += caml_string_length(s); - } - prog = caml_stat_alloc(len + sizeof(opcode_t) * 2 /* for 'RETURN 1' */); + len = caml_ba_byte_size(Caml_ba_array_val(ls_prog)); - off = 0; - for (i = 0; i < Wosize_val(ls_prog); i++) { - size_t s_len; - value s = Field(ls_prog, i); - s_len = caml_string_length(s); - memcpy((char*)prog + off, Bytes_val(s), s_len); - off += s_len; - } + prog = caml_stat_alloc(len + sizeof(opcode_t) * 2 /* for 'RETURN 1' */); + memcpy(prog, Caml_ba_data_val(ls_prog), len); #ifdef ARCH_BIG_ENDIAN caml_fixup_endianness(prog, len); #endif diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference index 1457b960859..5f6077ec204 100644 --- a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference +++ b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference @@ -3,8 +3,8 @@ Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33 Called from Test10_plugin.g in file "test10_plugin.ml", line 3, characters 2-21 Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6 Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6 -Called from Dynlink.Bytecode.run in file "byte/dynlink.ml", line 146, characters 16-25 -Re-raised at Dynlink.Bytecode.run in file "byte/dynlink.ml", line 148, characters 6-137 +Called from Dynlink.Bytecode.run in file "byte/dynlink.ml", line 154, characters 16-25 +Re-raised at Dynlink.Bytecode.run in file "byte/dynlink.ml", line 156, characters 6-137 Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 360, characters 11-54 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15 diff --git a/toplevel/byte/topeval.ml b/toplevel/byte/topeval.ml index b831602a310..dd94366b572 100644 --- a/toplevel/byte/topeval.ml +++ b/toplevel/byte/topeval.ml @@ -218,7 +218,12 @@ let check_consistency ppf filename cu = let load_compunit ic filename ppf compunit = check_consistency ppf filename compunit; seek_in ic compunit.cu_pos; - let code = LongString.input_bytes ic compunit.cu_codesize in + let code = + Bigarray.Array1.create Bigarray.Char Bigarray.c_layout compunit.cu_codesize + in + match In_channel.really_input_bigarray ic code 0 compunit.cu_codesize with + | None -> raise End_of_file + | Some () -> (); let initial_symtable = Symtable.current_state() in Symtable.patch_object code compunit.cu_reloc; Symtable.update_global_table(); diff --git a/utils/misc.ml b/utils/misc.ml index a5639a7cccf..d19b5cdc9d5 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -513,53 +513,6 @@ let thd4 (_,_,x,_) = x let for4 (_,_,_,x) = x -module LongString = struct - type t = bytes array - - let create str_size = - let tbl_size = str_size / Sys.max_string_length + 1 in - let tbl = Array.make tbl_size Bytes.empty in - for i = 0 to tbl_size - 2 do - tbl.(i) <- Bytes.create Sys.max_string_length; - done; - tbl.(tbl_size - 1) <- Bytes.create (str_size mod Sys.max_string_length); - tbl - - let length tbl = - let tbl_size = Array.length tbl in - Sys.max_string_length * (tbl_size - 1) + Bytes.length tbl.(tbl_size - 1) - - let get tbl ind = - Bytes.get tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length) - - let set tbl ind c = - Bytes.set tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length) - c - - let blit src srcoff dst dstoff len = - for i = 0 to len - 1 do - set dst (dstoff + i) (get src (srcoff + i)) - done - - let output oc tbl pos len = - for i = pos to pos + len - 1 do - output_char oc (get tbl i) - done - - let input_bytes_into tbl ic len = - let count = ref len in - Array.iter (fun str -> - let chunk = Int.min !count (Bytes.length str) in - really_input ic str 0 chunk; - count := !count - chunk) tbl - - let input_bytes ic len = - let tbl = create len in - input_bytes_into tbl ic len; - tbl -end - - 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) diff --git a/utils/misc.mli b/utils/misc.mli index d10396fcb45..e75e2aab0ad 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -416,23 +416,6 @@ val snd4: 'a * 'b * 'c * 'd -> 'b val thd4: 'a * 'b * 'c * 'd -> 'c val for4: 'a * 'b * 'c * 'd -> 'd -(** {1 Long strings} *) - -(** ``Long strings'' are mutable arrays of characters that are not limited - in length to {!Sys.max_string_length}. *) - -module LongString : - sig - type t = bytes array - val create : int -> t - val length : t -> int - val get : t -> int -> char - val set : t -> int -> char -> unit - val blit : t -> int -> t -> int -> int -> unit - val output : out_channel -> t -> int -> int -> unit - val input_bytes : in_channel -> int -> t - end - (** {1 Spell checking and ``did you mean'' suggestions} *) val edit_distance : string -> string -> int -> int option From 94187890388f16d3dcf9fef12d582603dafe6797 Mon Sep 17 00:00:00 2001 From: Miod Vallat Date: Fri, 8 Sep 2023 08:51:11 +0000 Subject: [PATCH 091/402] Remove the SIGTRAP-based bounds checking on POWER This switches the code generation back to the usual "compare and branch" logic used by all other native backends. --- Changes | 4 ++++ asmcomp/emitenv.mli | 3 +-- asmcomp/power/emit.mlp | 50 ++++++++++++++++++++++++++++++++++++------ runtime/caml/signals.h | 4 ---- runtime/power.S | 6 +++++ runtime/signals.c | 10 --------- runtime/signals_nat.c | 34 ---------------------------- 7 files changed, 54 insertions(+), 57 deletions(-) diff --git a/Changes b/Changes index abd6ca41af0..dc2fc58975e 100644 --- a/Changes +++ b/Changes @@ -419,6 +419,10 @@ Working version (Fabrice Buoro and Olivier Nicole, report by Jan Midtgaard, review by Miod Vallat and Gabriel Scherer) +- #12482: Rework bounds checking code in the POWER backend + (Miod Vallat and Xavier Leroy, report by Jan Midtgaard, review by + KC Sivaramakrishnan) + OCaml 5.1.0 (14 September 2023) ------------------------------- diff --git a/asmcomp/emitenv.mli b/asmcomp/emitenv.mli index c618f3ee726..fcd2c57db6e 100644 --- a/asmcomp/emitenv.mli +++ b/asmcomp/emitenv.mli @@ -72,8 +72,7 @@ type per_function_env = { mutable call_gc_sites : gc_call list; (* used in all targets except power *) mutable call_gc_label : label; (* used only in power *) mutable bound_error_sites : bound_error_call list; - (* used in all targets except power *) - mutable bound_error_call : label option; (* used in amd64,s390x *) + mutable bound_error_call : label option; (* used in amd64,power,s390x *) (* record jump tables (for PPC64). In order to reduce the size of the TOC, we concatenate all jumptables and emit them at the end of the function. *) diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 6630728a372..ee6e8f38a6e 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -271,7 +271,7 @@ let adjust_stack_offset env delta = (* Record live pointers at call points *) -let record_frame env live dbg = +let record_frame_label env live dbg = let lbl = new_label() in let live_offset = ref [] in Reg.Set.iter @@ -286,6 +286,10 @@ let record_frame env live dbg = live; record_frame_descr ~label:lbl ~frame_size:(frame_size env) ~live_offset:!live_offset dbg; + lbl + +let record_frame env live dbg = + let lbl = record_frame_label env live dbg in `{emit_label lbl}:\n` (* Names for conditional branches after comparisons *) @@ -521,6 +525,36 @@ let emit_poll env i return_label far = | Some return_label -> ` b {emit_label return_label}\n` end +let bound_error_label env dbg = + if !Clflags.debug then begin + let lbl_bound_error = new_label() in + let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in + env.bound_error_sites <- + { bd_lbl = lbl_bound_error; + bd_frame = lbl_frame; } :: env.bound_error_sites; + lbl_bound_error + end else begin + match env.bound_error_call with + | None -> + let lbl = new_label() in + env.bound_error_call <- Some lbl; + lbl + | Some lbl -> lbl + end + +let emit_call_bound_error bd = + `{emit_label bd.bd_lbl}:\n`; + emit_call "caml_ml_array_bound_error"; + emit_call_nop(); + `{emit_label bd.bd_frame}:\n` + +let emit_call_bound_errors env = + List.iter emit_call_bound_error env.bound_error_sites; + match env.bound_error_call with + | None -> () + | Some lbl -> + `{emit_label lbl}:`; emit_call "caml_ml_array_bound_error" + (* Output the assembly code for an instruction *) let emit_instr env i = @@ -733,9 +767,9 @@ let emit_instr env i = let (bitnum, negated) = emit_float_comp cmp i.arg in emit_extract_crbit bitnum negated i.res.(0) | Lop(Iintop (Icheckbound)) -> - if !Clflags.debug then - record_frame env Reg.Set.empty (Dbg_other i.dbg); - ` tdlle {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` + let lbl = bound_error_label env i.dbg in + ` cmpld {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; + ` ble- {emit_label lbl}\n` | Lop(Iintop op) -> let instr = name_for_intop op in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` @@ -751,9 +785,9 @@ let emit_instr env i = emit_set_comp c i.res.(0) end | Lop(Iintop_imm(Icheckbound, n)) -> - if !Clflags.debug then - record_frame env Reg.Set.empty (Dbg_other i.dbg); - ` tdllei {emit_reg i.arg.(0)}, {emit_int n}\n` + let lbl = bound_error_label env i.dbg in + ` cmpldi {emit_reg i.arg.(0)}, {emit_int n}\n`; + ` ble- {emit_label lbl}\n` | Lop(Iintop_imm(op, n)) -> let instr = name_for_intop_imm op in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` @@ -957,6 +991,8 @@ let fundecl fundecl = ` mtctr 12\n`; ` bctr\n` end; + (* Emit the glue code to handle bound errors *) + emit_call_bound_errors env; cfi_endproc(); ` .size {emit_symbol fundecl.fun_name}, . - {emit_symbol fundecl.fun_name}\n`; (* Emit the numeric literals *) diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h index 4ef8ad1b2b2..2a340cf2ee8 100644 --- a/runtime/caml/signals.h +++ b/runtime/caml/signals.h @@ -79,10 +79,6 @@ void caml_terminate_signals(void); CAMLextern void * caml_init_signal_stack(void); CAMLextern void caml_free_signal_stack(void *); -#if defined(NATIVE_CODE) && defined(TARGET_power) -void caml_sigtrap_handler(int, siginfo_t *, void *); -#endif - /* These hooks are not modified after other threads are spawned. */ CAMLextern void (*caml_enter_blocking_section_hook)(void); CAMLextern void (*caml_leave_blocking_section_hook)(void); diff --git a/runtime/power.S b/runtime/power.S index 819c2c4310f..9aa425c83b8 100644 --- a/runtime/power.S +++ b/runtime/power.S @@ -815,6 +815,11 @@ FUNCTION caml_runstack b 1b ENDFUNCTION caml_runstack +FUNCTION caml_ml_array_bound_error + Addrglobal(C_CALL_FUN, caml_array_bound_error_asm) + b .Lcaml_c_call +ENDFUNCTION caml_resume + .section ".text" .globl caml_system__code_end caml_system__code_end: @@ -848,6 +853,7 @@ TOCENTRY(caml_program) TOCENTRY(caml_exn_Stack_overflow) TOCENTRY(caml_raise_unhandled_effect) TOCENTRY(caml_raise_continuation_already_resumed) +TOCENTRY(caml_array_bound_error_asm) TOCENTRYLABEL(fiber_exn_handler) TOCENTRYLABEL(trap_handler) diff --git a/runtime/signals.c b/runtime/signals.c index ce6913dae10..cfae277dbee 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -597,16 +597,6 @@ void caml_init_signals(void) } } } -#endif - /* Bound-check trap handling for Power */ -#if defined(NATIVE_CODE) && defined(TARGET_power) - { - struct sigaction act; - act.sa_sigaction = caml_sigtrap_handler; - sigemptyset(&act.sa_mask); - act.sa_flags = SA_SIGINFO | SA_NODEFER; - sigaction(SIGTRAP, &act, NULL); - } #endif } diff --git a/runtime/signals_nat.c b/runtime/signals_nat.c index 4d904c8edbd..3efb0580a6f 100644 --- a/runtime/signals_nat.c +++ b/runtime/signals_nat.c @@ -85,37 +85,3 @@ void caml_garbage_collection(void) nallocs, alloc_len); } } - -/* Trap handling for the POWER architecture. Convert the trap into - an out-of-bounds exception. */ - -#if defined(TARGET_power) - -extern void caml_array_bound_error_asm(void); - -void caml_sigtrap_handler(int signo, siginfo_t * info, void * context) -{ - /* The trap occurs in ocamlopt-generated code. */ - /* The purpose of this function is to simulate a [caml_c_call] - to [caml_array_bound_error_asm]. */ - - caml_domain_state * dom_st = Caml_state; - /* Recover the values of interesting registers. */ - ucontext_t * ctx = context; - uint64_t ctx_pc = ctx->uc_mcontext.gp_regs[32]; - uint64_t ctx_sp = ctx->uc_mcontext.gp_regs[1]; - uint64_t ctx_exn_ptr = ctx->uc_mcontext.gp_regs[29]; - uint64_t ctx_young_ptr = ctx->uc_mcontext.gp_regs[31]; - /* Save address of trap as the return address in the standard stack frame - location, so that it will be recorded in the stack backtrace. */ - ((uint64_t *) ctx_sp)[2] = ctx_pc; - /* Record the OCaml stack pointer (for backtraces) */ - /* Update the exception handler pointer and the allocation pointer */ - dom_st->current_stack-> sp = (void *) ctx_sp; - dom_st->young_ptr = (value *) ctx_young_ptr; - dom_st->exn_handler = (void *) ctx_exn_ptr; - /* Raise the exception */ - caml_array_bound_error_asm(); -} - -#endif From bbc3346e842e59396fecd425df4f0f1e4b29e931 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sun, 10 Sep 2023 07:12:22 +0000 Subject: [PATCH 092/402] Fix calls to caml_ml_array_bound_error --- asmcomp/power/emit.mlp | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index ee6e8f38a6e..b3644f2b5f2 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -543,17 +543,16 @@ let bound_error_label env dbg = end let emit_call_bound_error bd = - `{emit_label bd.bd_lbl}:\n`; - emit_call "caml_ml_array_bound_error"; - emit_call_nop(); - `{emit_label bd.bd_frame}:\n` + `{emit_label bd.bd_lbl}:`; emit_call "caml_ml_array_bound_error"; + `{emit_label bd.bd_frame}:`; emit_call_nop() let emit_call_bound_errors env = List.iter emit_call_bound_error env.bound_error_sites; match env.bound_error_call with | None -> () | Some lbl -> - `{emit_label lbl}:`; emit_call "caml_ml_array_bound_error" + `{emit_label lbl}:`; emit_call "caml_ml_array_bound_error"; + emit_call_nop() (* Output the assembly code for an instruction *) From b453aaa3a777cb6680abb4232ef783fd3ba479c2 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 9 Sep 2023 17:53:09 +0200 Subject: [PATCH 093/402] Add branch relaxation for checkbound operations in large functions --- asmcomp/power/arch.ml | 17 +++++++++-- asmcomp/power/arch.mli | 3 ++ asmcomp/power/emit.mlp | 68 +++++++++++++++++++++++++++++++++++++----- 3 files changed, 78 insertions(+), 10 deletions(-) diff --git a/asmcomp/power/arch.ml b/asmcomp/power/arch.ml index f0662236396..a93b1ea64a8 100644 --- a/asmcomp/power/arch.ml +++ b/asmcomp/power/arch.ml @@ -33,6 +33,9 @@ type specific_operation = | Ialloc_far of (* allocation in large functions *) { bytes : int; dbginfo : Debuginfo.alloc_dbginfo } | Ipoll_far of { return_label : cmm_label option } + (* poll point in large functions *) + | Icheckbound_far (* bounds check in large functions *) + | Icheckbound_imm_far of int (* bounds check in large functions *) (* Addressing modes *) @@ -94,15 +97,25 @@ let print_specific_operation printreg op ppf arg = fprintf ppf "alloc_far %d" bytes | Ipoll_far _ -> fprintf ppf "poll_far" + | Icheckbound_far -> + fprintf ppf "check_far > %a %a" printreg arg.(0) printreg arg.(1) + | Icheckbound_imm_far n -> + fprintf ppf "check_far > %a %d" printreg arg.(0) n (* Specific operations that are pure *) let operation_is_pure = function - | Ialloc_far _ | Ipoll_far _ -> false + | Ialloc_far _ + | Ipoll_far _ + | Icheckbound_far + | Icheckbound_imm_far _ -> false | _ -> true (* Specific operations that can raise *) let operation_can_raise = function - | Ialloc_far _ | Ipoll_far _ -> true + | Ialloc_far _ + | Ipoll_far _ + | Icheckbound_far + | Icheckbound_imm_far _ -> true | _ -> false diff --git a/asmcomp/power/arch.mli b/asmcomp/power/arch.mli index 9931722feff..a4a619a9561 100644 --- a/asmcomp/power/arch.mli +++ b/asmcomp/power/arch.mli @@ -31,6 +31,9 @@ type specific_operation = | Ialloc_far of (* allocation in large functions *) { bytes : int; dbginfo : Debuginfo.alloc_dbginfo } | Ipoll_far of { return_label : cmm_label option } + (* poll point in large functions *) + | Icheckbound_far (* bounds check in large functions *) + | Icheckbound_imm_far of int (* bounds check in large functions *) (* Addressing modes *) diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index b3644f2b5f2..d1ba127e899 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -363,8 +363,11 @@ module BR = Branch_relaxation.Make (struct let classify_instr = function | Lop (Ialloc _) | Lop (Ipoll _) - (* [Ialloc_far] does not need to be here, since its code sequence - never involves any conditional branches that might need relaxing. *) + | Lop (Iintop Icheckbound) + | Lop (Iintop_imm (Icheckbound, _)) + (* The various "far" variants in [specific_operation] don't need to + return [Some] here, since their code sequences never contain any + conditional branches that might need relaxing. *) | Lcondbranch _ | Lcondbranch3 _ -> Some Branch | _ -> None @@ -431,9 +434,13 @@ module BR = Branch_relaxation.Make (struct | Lop(Ispecific(Ipoll_far { return_label = None } )) -> 4 | Lop(Iintop Imod) -> 3 | Lop(Iintop(Icomp _)) -> 4 + | Lop(Iintop(Icheckbound)) -> 2 + | Lop(Ispecific(Icheckbound_far)) -> 3 | Lop(Icompf _) -> 5 | Lop(Iintop _) -> 1 | Lop(Iintop_imm(Icomp _, _)) -> 4 + | Lop(Iintop_imm(Icheckbound, _)) -> 2 + | Lop(Ispecific(Icheckbound_imm_far _)) -> 3 | Lop(Iintop_imm _) -> 1 | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1 | Lop(Ifloatofint) -> 9 @@ -468,11 +475,15 @@ module BR = Branch_relaxation.Make (struct let relax_poll ~return_label = Lop (Ispecific (Ipoll_far { return_label })) + let relax_intop_checkbound () = + Lop (Ispecific (Icheckbound_far)) + + let relax_intop_imm_checkbound ~bound = + Lop (Ispecific (Icheckbound_imm_far bound)) + (* [classify_addr], above, never identifies these instructions as needing relaxing. As such, these functions should never be called. *) let relax_specific_op _ = assert false - let relax_intop_checkbound () = assert false - let relax_intop_imm_checkbound ~bound:_ = assert false end) (* Assembly code for inlined allocation *) @@ -769,6 +780,13 @@ let emit_instr env i = let lbl = bound_error_label env i.dbg in ` cmpld {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ` ble- {emit_label lbl}\n` + | Lop(Ispecific (Icheckbound_far)) -> + let lbl_err = bound_error_label env i.dbg in + let lbl_next = new_label() in + ` cmpld {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; + ` bgt+ {emit_label lbl_next}\n`; + ` b {emit_label lbl_err}\n`; + `{emit_label lbl_next}:\n` | Lop(Iintop op) -> let instr = name_for_intop op in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` @@ -787,6 +805,13 @@ let emit_instr env i = let lbl = bound_error_label env i.dbg in ` cmpldi {emit_reg i.arg.(0)}, {emit_int n}\n`; ` ble- {emit_label lbl}\n` + | Lop(Ispecific(Icheckbound_imm_far n)) -> + let lbl_err = bound_error_label env i.dbg in + let lbl_next = new_label() in + ` cmpldi {emit_reg i.arg.(0)}, {emit_int n}\n`; + ` bgt+ {emit_label lbl_next}\n`; + ` b {emit_label lbl_err}\n`; + `{emit_label lbl_next}:\n` | Lop(Iintop_imm(op, n)) -> let instr = name_for_intop_imm op in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` @@ -931,6 +956,35 @@ let rec emit_all env i = | Lend -> () | _ -> emit_instr env i; emit_all env i.next +(* On this target, the possible "out of line" code blocks are: + - a single "call GC" point, which comes immediately after the + function's body; + - zero, one or several "call bound error" point, which comes just after. +*) + +let max_out_of_line_code_offset fundecl = + let rec num_checkbounds count instr = + match instr.desc with + | Lend -> count + | Lop (Iintop Icheckbound) + | Lop (Iintop_imm (Icheckbound, _)) -> + num_checkbounds (count + 1) instr.next + (* The following two should never be seen, since this function is run + before branch relaxation. *) + | Lop (Ispecific Icheckbound_far) + | Lop (Ispecific (Icheckbound_imm_far _)) -> assert false + | _ -> num_checkbounds count instr.next in + let num_chk = num_checkbounds 0 fundecl.fun_body in + (* This is what the end of the function looks like: + - offset 0: call GC point (5 insn) + - offset 5: first (or only if not !Clflags.debug) call bound error + (2 insns) + - offsets 7, 9, .. : second, third, ..., call bound error + (2 insns each) *) + if num_chk = 0 then 0 + else if !Clflags.debug then 5 + (num_chk - 1) * 2 + else 5 + (* Emission of a function declaration *) let fundecl fundecl = @@ -976,10 +1030,8 @@ let fundecl fundecl = ` ble- {emit_label overflow}\n`; `{emit_label ret}:\n` end; - (* On this target, there is at most one "out of line" code block per - function: a single "call GC" point. It comes immediately after the - function's body. *) - BR.relax fundecl ~max_out_of_line_code_offset:0; + BR.relax fundecl + ~max_out_of_line_code_offset: (max_out_of_line_code_offset fundecl); emit_all env fundecl.fun_body; (* Emit the glue code to call the GC *) if env.call_gc_label > 0 then begin From 234e5fea05d5ef4ff5027288f309c094200652d0 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 23 Sep 2023 18:57:48 +0200 Subject: [PATCH 094/402] More comments in arch.ml for POWER --- asmcomp/power/arch.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/asmcomp/power/arch.ml b/asmcomp/power/arch.ml index a93b1ea64a8..dcd5f462bae 100644 --- a/asmcomp/power/arch.ml +++ b/asmcomp/power/arch.ml @@ -35,7 +35,8 @@ type specific_operation = | Ipoll_far of { return_label : cmm_label option } (* poll point in large functions *) | Icheckbound_far (* bounds check in large functions *) - | Icheckbound_imm_far of int (* bounds check in large functions *) + | Icheckbound_imm_far of int (* bounds check in large functions, + constant 2nd arg (the index) *) (* Addressing modes *) From 4219686782d3be2a0151d474eb9520b42e74bf7c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 25 Sep 2023 12:20:41 +0200 Subject: [PATCH 095/402] we broke carriage returns --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index dc2fc58975e..70f647e5c93 100644 --- a/Changes +++ b/Changes @@ -41,7 +41,7 @@ Working version and variant with only constant constructors. (Christophe Raffalli, review by Gabriel Scherer) -- #12502: the compiler now normalizes the newline sequence \r\n to +* #12502: the compiler now normalizes the newline sequence \r\n to a single \n character during lexing, to guarantee that the semantics of newlines in string literals is not modified by Windows tools transforming \n into \r\n in source files. From f5704c7edb7911fd24480f5383efb88cbd0708d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 13 Jun 2023 18:23:45 +0200 Subject: [PATCH 096/402] Document forgotten ocamldep options in man page --- man/ocamldep.1 | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/man/ocamldep.1 b/man/ocamldep.1 index c774b48c20e..166936b7315 100644 --- a/man/ocamldep.1 +++ b/man/ocamldep.1 @@ -177,6 +177,11 @@ Generate dependencies for native plugin files (.cmxs) in addition to native compiled files (.cmx). .TP .B \-slash +(Windows) Use forward slash / instead of backslash \\ in file paths. +Under Unix, this option does nothing. +.TP +.B \-no\-slash +(Windows) Preserve any backslash \\ in file paths. Under Unix, this option does nothing. .TP .B \-sort @@ -188,6 +193,14 @@ Print version string and exit. .B \-vnum Print short version number and exit. .TP +.BI \-args " file" +Read additional newline separated command line arguments from +.IR file . +.TP +.BI \-args0 " file" +Read additional NUL separated command line arguments from +.IR file . +.TP .BR \-help " or " \-\-help Display a short usage summary and exit. From b30d6ce8be252885092ff2a715a87a28fdc99e72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 6 Jun 2023 14:50:12 +0200 Subject: [PATCH 097/402] ocamldep: use Array.find_opt --- driver/makedepend.ml | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index a0b86d03a29..85820e7646d 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -103,21 +103,15 @@ let find_module_in_load_path name = let uname = Unit_info.normalize name in List.map (fun ext -> uname ^ ext) (!mli_synonyms @ !ml_synonyms) in - let rec find_in_array a pos = - if pos >= Array.length a then None else begin - let s = a.(pos) in - if List.mem s names || List.mem s unames then - Some s - else - find_in_array a (pos + 1) - end in let rec find_in_path = function - [] -> raise Not_found - | (dir, contents) :: rem -> - match find_in_array contents 0 with - Some truename -> - if dir = "." then truename else Filename.concat dir truename - | None -> find_in_path rem in + | [] -> raise Not_found + | (dir, contents) :: rem -> + let mem s = List.mem s names || List.mem s unames in + match Array.find_opt mem contents with + | Some truename -> + if dir = Filename.current_dir_name then truename + else Filename.concat dir truename + | None -> find_in_path rem in find_in_path !load_path let find_dependency target_kind modname (byt_deps, opt_deps) = From 85d8f264ef2d72008f67017585e3b1d193b32c60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 6 Jun 2023 14:51:27 +0200 Subject: [PATCH 098/402] ocamldep: code simplifications --- driver/makedepend.ml | 5 +++-- parsing/depend.ml | 2 -- parsing/depend.mli | 3 ++- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 85820e7646d..5ca641424c9 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -21,6 +21,7 @@ let ppf = Format.err_formatter type file_kind = ML | MLI +(* [(dir, contents)] where [contents] is returned by [Sys.readdir dir]. *) let load_path = ref ([] : (string * string array) list) let ml_synonyms = ref [".ml"] let mli_synonyms = ref [".mli"] @@ -381,7 +382,7 @@ let ml_file_dependencies source_file = | Ptop_def s -> s | Ptop_dir _ -> [] in - List.flatten (List.map f (Parse.use_file lexbuf)) + List.concat_map f (Parse.use_file lexbuf) in let (extracted_deps, ()) = read_parse_and_extract parse_use_file_as_impl Depend.add_implementation () @@ -546,7 +547,7 @@ let parse_map fname = (fun ppf -> String.Set.iter (Format.fprintf ppf " %s") deps) (dump_map deps) (String.Map.add modname mm String.Map.empty) end; - let mm = Depend.(weaken_map (String.Set.singleton modname) mm) in + let mm = Depend.weaken_map (String.Set.singleton modname) mm in module_map := String.Map.add modname mm !module_map (* Dependency processing *) diff --git a/parsing/depend.ml b/parsing/depend.ml index c054f513423..7d76e6fc92a 100644 --- a/parsing/depend.ml +++ b/parsing/depend.ml @@ -52,8 +52,6 @@ let rec lookup_map lid m = | Ldot (l, s) -> String.Map.find s (get_map (lookup_map l m)) | Lapply _ -> raise Not_found -(* Collect free module identifiers in the a.s.t. *) - let free_structure_names = ref String.Set.empty let add_names s = diff --git a/parsing/depend.mli b/parsing/depend.mli index 74c095f969e..745cc722c7b 100644 --- a/parsing/depend.mli +++ b/parsing/depend.mli @@ -28,9 +28,10 @@ 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 *) +(** Dependencies found by preprocessing tools. *) val pp_deps : string list ref val open_module : bound_map -> Longident.t -> bound_map From 38a1c529b79f3f7cc7e71fd2473ebf7491f8346c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 1 Jun 2023 16:08:26 +0200 Subject: [PATCH 099/402] ocamldep: remove unused map_files var This variable has been unused and write-only since its introduction in 381328e92e3dcf00c3fb4dbe0cbd25290d545b6a. --- driver/makedepend.ml | 3 --- 1 file changed, 3 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 5ca641424c9..1bc8a6fb704 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -36,7 +36,6 @@ let one_line = ref false let files = ref ([] : (string * file_kind * String.Set.t * string list) list) let allow_approximation = ref false -let map_files = ref [] let module_map = ref String.Map.empty let debug = ref false @@ -53,7 +52,6 @@ end (* Fix path to use '/' as directory separator instead of '\'. Only under Windows. *) - let fix_slash s = if Sys.os_type = "Unix" then s else begin String.map (function '\\' -> '/' | c -> c) s @@ -529,7 +527,6 @@ let process_mli_map = String.Map.empty Pparse.Signature let parse_map fname = - map_files := fname :: !map_files ; let old_transp = !Clflags.transparent_modules in Clflags.transparent_modules := true; let (deps, m) = From 30ed20f58e70d328cab8305602947b4440af870b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 1 Jun 2023 16:14:26 +0200 Subject: [PATCH 100/402] ocamldep: separate global vars from CLI arguments --- driver/makedepend.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 1bc8a6fb704..22f23f82cbe 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -21,8 +21,6 @@ let ppf = Format.err_formatter type file_kind = ML | MLI -(* [(dir, contents)] where [contents] is returned by [Sys.readdir dir]. *) -let load_path = ref ([] : (string * string array) list) let ml_synonyms = ref [".ml"] let mli_synonyms = ref [".mli"] let shared = ref false @@ -33,11 +31,14 @@ let sort_files = ref false let all_dependencies = ref false let nocwd = ref false let one_line = ref false +let allow_approximation = ref false +let debug = ref false + +(* [(dir, contents)] where [contents] is returned by [Sys.readdir dir]. *) +let load_path = ref ([] : (string * string array) list) let files = ref ([] : (string * file_kind * String.Set.t * string list) list) -let allow_approximation = ref false let module_map = ref String.Map.empty -let debug = ref false module Error_occurred : sig val set : unit -> unit From bbcd1060752f6beb8d7e2868b6840c669078f62f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 1 Jun 2023 16:30:23 +0200 Subject: [PATCH 101/402] ocamldep: use Format.eprintf instead of ppf or Format.err_formatter --- driver/makedepend.ml | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 22f23f82cbe..910fcb043ba 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -13,11 +13,12 @@ (* *) (**************************************************************************) +(** Print the dependencies *) + open Parsetree module String = Misc.Stdlib.String -let ppf = Format.err_formatter -(* Print the dependencies *) +let stderr = Format.err_formatter type file_kind = ML | MLI @@ -69,7 +70,7 @@ let readdir dir = try Sys.readdir dir with Sys_error msg -> - Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg; + Format.eprintf "@[Bad -I option: %s@]@." msg; Error_occurred.set (); [||] in @@ -85,14 +86,14 @@ let add_to_load_path dir = let contents = readdir dir in add_to_list load_path (dir, contents) with Sys_error msg -> - Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg; + Format.eprintf "@[Bad -I option: %s@]@." msg; Error_occurred.set () let add_to_synonym_list synonyms suffix = if (String.length suffix) > 1 && suffix.[0] = '.' then add_to_list synonyms suffix else begin - Format.fprintf Format.err_formatter "@[Bad suffix: '%s'@]@." suffix; + Format.eprintf "@[Bad suffix: '%s'@]@." suffix; Error_occurred.set () end @@ -237,7 +238,7 @@ let print_raw_dependencies source_file deps = (* Process one file *) let print_exception exn = - Location.report_exception Format.err_formatter exn + Location.report_exception stderr exn let report_err exn = Error_occurred.set (); @@ -397,7 +398,7 @@ let mli_file_dependencies source_file = files := (source_file, MLI, extracted_deps, !Depend.pp_deps) :: !files let process_file_as process_fun def source_file = - Compenv.readenv ppf (Before_compile source_file); + Compenv.readenv stderr (Before_compile source_file); load_path := []; let cwd = if !nocwd then [] else [Filename.current_dir_name] in List.iter add_to_load_path ( @@ -486,19 +487,18 @@ let sort_files_by_dependencies files = if !worklist <> [] then begin Location.error "cycle in dependencies. End of list is not sorted." - |> Location.print_report Format.err_formatter; + |> Location.print_report stderr; let sorted_deps = let li = ref [] in Hashtbl.iter (fun _ file_deps -> li := file_deps :: !li) h; List.sort (fun (file1, _) (file2, _) -> String.compare file1 file2) !li in List.iter (fun (file, deps) -> - Format.fprintf Format.err_formatter "\t@[%s: " file; + Format.eprintf "\t@[%s: " file; List.iter (fun (modname, kind) -> - Format.fprintf Format.err_formatter "%s.%s " modname - (if kind=ML then "ml" else "mli"); + Format.eprintf "%s.%s " modname (if kind=ML then "ml" else "mli") ) !deps; - Format.fprintf Format.err_formatter "@]@."; + Format.eprintf "@]@."; Printf.printf "%s " file) sorted_deps; Error_occurred.set () end; @@ -577,7 +577,7 @@ let run_main argv = let add_dep_arg f s = dep_args_rev := (f s) :: !dep_args_rev in Clflags.classic := false; try - Compenv.readenv ppf Before_args; + Compenv.readenv stderr Before_args; Clflags.reset_arguments (); (* reset arguments from ocamlc/ocamlopt *) Clflags.add_arguments __LOC__ [ "-absname", Arg.Set Clflags.absname, @@ -647,7 +647,7 @@ let run_main argv = Compenv.parse_arguments (ref argv) (add_dep_arg (fun f -> Src (f, None))) program; process_dep_args (List.rev !dep_args_rev); - Compenv.readenv ppf Before_link; + Compenv.readenv stderr Before_link; if !sort_files then sort_files_by_dependencies !files else List.iter print_file_dependencies (List.sort compare !files); (if Error_occurred.get () then 2 else 0) @@ -655,7 +655,7 @@ let run_main argv = | Compenv.Exit_with_status n -> n | exn -> - Location.report_exception ppf exn; + Location.report_exception stderr exn; 2 From 8056bf3c801b3b055f99e3587134b1db64bac334 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 1 Jun 2023 16:52:44 +0200 Subject: [PATCH 102/402] ocamldep: consistently use prepend_to_list Replace add_to_list with prepend_to_list, to explicit where the new element is added. Use the new combinator consistently. --- driver/makedepend.ml | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 910fcb043ba..4e9b1371c90 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -52,6 +52,8 @@ end = struct let set () = error_occurred := true end +let prepend_to_list l e = l := e :: !l + (* Fix path to use '/' as directory separator instead of '\'. Only under Windows. *) let fix_slash s = @@ -77,21 +79,18 @@ let readdir dir = dirs := String.Map.add dir contents !dirs; contents -let add_to_list li s = - li := s :: !li - let add_to_load_path dir = try let dir = Misc.expand_directory Config.standard_library dir in let contents = readdir dir in - add_to_list load_path (dir, contents) + prepend_to_list load_path (dir, contents) with Sys_error msg -> Format.eprintf "@[Bad -I option: %s@]@." msg; Error_occurred.set () let add_to_synonym_list synonyms suffix = if (String.length suffix) > 1 && suffix.[0] = '.' then - add_to_list synonyms suffix + prepend_to_list synonyms suffix else begin Format.eprintf "@[Bad suffix: '%s'@]@." suffix; Error_occurred.set () @@ -388,14 +387,14 @@ let ml_file_dependencies source_file = read_parse_and_extract parse_use_file_as_impl Depend.add_implementation () Pparse.Structure source_file in - files := (source_file, ML, extracted_deps, !Depend.pp_deps) :: !files + prepend_to_list files (source_file, ML, extracted_deps, !Depend.pp_deps) let mli_file_dependencies source_file = let (extracted_deps, ()) = read_parse_and_extract Parse.interface Depend.add_signature () Pparse.Signature source_file in - files := (source_file, MLI, extracted_deps, !Depend.pp_deps) :: !files + prepend_to_list files (source_file, MLI, extracted_deps, !Depend.pp_deps) let process_file_as process_fun def source_file = Compenv.readenv stderr (Before_compile source_file); @@ -439,15 +438,13 @@ let sort_files_by_dependencies files = let key = (modname, file_kind) in let new_deps = ref [] in Hashtbl.add h key (file, new_deps); - worklist := key :: !worklist; + prepend_to_list worklist key; (modname, file_kind, deps, new_deps, pp_deps) ) files in (* Keep only dependencies to defined modules *) List.iter (fun (modname, file_kind, deps, new_deps, _pp_deps) -> - let add_dep modname kind = - new_deps := (modname, kind) :: !new_deps; - in + let add_dep modname kind = prepend_to_list new_deps (modname, kind) in String.Set.iter (fun modname -> match file_kind with ML -> (* ML depends both on ML and MLI *) @@ -474,14 +471,14 @@ let sort_files_by_dependencies files = let set = !deps in deps := []; List.iter (fun key -> - if Hashtbl.mem h key then deps := key :: !deps + if Hashtbl.mem h key then prepend_to_list deps key ) set; if !deps = [] then begin printed := true; Printf.printf "%s " file; Hashtbl.remove h key; end else - worklist := key :: !worklist + prepend_to_list worklist key ) files done; @@ -490,7 +487,7 @@ let sort_files_by_dependencies files = |> Location.print_report stderr; let sorted_deps = let li = ref [] in - Hashtbl.iter (fun _ file_deps -> li := file_deps :: !li) h; + Hashtbl.iter (fun _ file_deps -> prepend_to_list li file_deps) h; List.sort (fun (file1, _) (file2, _) -> String.compare file1 file2) !li in List.iter (fun (file, deps) -> @@ -574,7 +571,7 @@ let print_version_num () = let run_main argv = let dep_args_rev : dep_arg list ref = ref [] in - let add_dep_arg f s = dep_args_rev := (f s) :: !dep_args_rev in + let add_dep_arg f s = prepend_to_list dep_args_rev (f s) in Clflags.classic := false; try Compenv.readenv stderr Before_args; @@ -593,7 +590,7 @@ let run_main argv = (* "compiler uses -no-alias-deps, and no module is coerced"; *) "-debug-map", Arg.Set debug, " Dump the delayed dependency map for each map file"; - "-I", Arg.String (add_to_list Clflags.include_dirs), + "-I", Arg.String (prepend_to_list Clflags.include_dirs), " Add to the list of include directories"; "-nocwd", Arg.Set nocwd, " Do not add current working directory to \ @@ -616,13 +613,13 @@ let run_main argv = " Generate dependencies for bytecode-code only (no .cmx files)"; "-one-line", Arg.Set one_line, " Output one line per file, regardless of the length"; - "-open", Arg.String (add_to_list Clflags.open_modules), + "-open", Arg.String (prepend_to_list Clflags.open_modules), " Opens the module before typing"; "-plugin", Arg.String(fun _p -> Clflags.plugin := true), " (no longer supported)"; "-pp", Arg.String(fun s -> Clflags.preprocessor := Some s), " Pipe sources through preprocessor "; - "-ppx", Arg.String (add_to_list Compenv.first_ppx), + "-ppx", Arg.String (prepend_to_list Compenv.first_ppx), " Pipe abstract syntax trees through preprocessor "; "-shared", Arg.Set shared, " Generate dependencies for native plugin files (.cmxs targets)"; From e3fa5bceef56a6f3703b441982aba40e2d07d372 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 1 Jun 2023 17:10:25 +0200 Subject: [PATCH 103/402] ocamldep: use In_channel.with_open_bin --- driver/makedepend.ml | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 4e9b1371c90..58edc8364f5 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -278,19 +278,17 @@ let rec lexical_approximation lexbuf = let read_and_approximate inputfile = Depend.free_structure_names := String.Set.empty; - let ic = open_in_bin inputfile in - try + begin try + In_channel.with_open_bin inputfile @@ fun ic -> seek_in ic 0; Location.input_name := inputfile; let lexbuf = Lexing.from_channel ic in Location.init lexbuf inputfile; - lexical_approximation lexbuf; - close_in ic; - !Depend.free_structure_names + lexical_approximation lexbuf with exn -> - close_in ic; - report_err exn; - !Depend.free_structure_names + report_err exn + end; + !Depend.free_structure_names let read_parse_and_extract parse_function extract_function def ast_kind source_file = From 34892387cd44b0dd86732a4c219450a5871d36ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 6 Jun 2023 14:44:21 +0200 Subject: [PATCH 104/402] ocamldep: reduce scope of exception catching --- driver/makedepend.ml | 52 ++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 29 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 58edc8364f5..9f79401a4ff 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -115,8 +115,9 @@ let find_module_in_load_path name = find_in_path !load_path let find_dependency target_kind modname (byt_deps, opt_deps) = - try - let filename = find_module_in_load_path modname in + match find_module_in_load_path modname with + | exception Not_found -> (byt_deps, opt_deps) + | filename -> let basename = Filename.chop_extension filename in let cmi_file = basename ^ ".cmi" in let cmx_file = basename ^ ".cmx" in @@ -157,8 +158,6 @@ let find_dependency target_kind modname (byt_deps, opt_deps) = else [ cmx_file ] in (bytenames @ byt_deps, optnames @ opt_deps) - with Not_found -> - (byt_deps, opt_deps) let (depends_on, escaped_eol) = (":", " \\\n ") @@ -254,26 +253,25 @@ let rec lexical_approximation lexbuf = lower-case identifier - always skip the token after a backquote *) - try - let rec process after_lident lexbuf = - match Lexer.token lexbuf with - | Parser.UIDENT name -> - Depend.free_structure_names := - String.Set.add name !Depend.free_structure_names; - process false lexbuf - | Parser.LIDENT _ -> process true lexbuf - | Parser.DOT when after_lident -> process false lexbuf - | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf - | Parser.EOF -> () - | _ -> process false lexbuf - and skip_one lexbuf = - match Lexer.token lexbuf with - | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf - | Parser.EOF -> () - | _ -> process false lexbuf + let rec process after_lident lexbuf = + match Lexer.token lexbuf with + | Parser.UIDENT name -> + Depend.free_structure_names := + String.Set.add name !Depend.free_structure_names; + process false lexbuf + | Parser.LIDENT _ -> process true lexbuf + | Parser.DOT when after_lident -> process false lexbuf + | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf + | Parser.EOF -> () + | _ -> process false lexbuf + and skip_one lexbuf = + match Lexer.token lexbuf with + | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf + | Parser.EOF -> () + | _ -> process false lexbuf - in - process false lexbuf + in + try process false lexbuf with Lexer.Error _ -> lexical_approximation lexbuf let read_and_approximate inputfile = @@ -296,7 +294,8 @@ let read_parse_and_extract parse_function extract_function def ast_kind Depend.free_structure_names := String.Set.empty; try let input_file = Pparse.preprocess source_file in - begin try + Fun.protect ~finally:(fun () -> Pparse.remove_preprocessed input_file) + @@ fun () -> let ast = Pparse.file ~tool_name input_file parse_function ast_kind in let bound_vars = List.fold_left @@ -310,12 +309,7 @@ let read_parse_and_extract parse_function extract_function def ast_kind !module_map ((* PR#7248 *) List.rev !Clflags.open_modules) in let r = extract_function bound_vars ast in - Pparse.remove_preprocessed input_file; (!Depend.free_structure_names, r) - with x -> - Pparse.remove_preprocessed input_file; - raise x - end with x -> begin print_exception x; if not !allow_approximation then begin From 0d376fb434ef08f21e6aef67170aa6d01c79d15d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 6 Jun 2023 14:44:38 +0200 Subject: [PATCH 105/402] ocamldep: use labelled boolean arguments --- driver/makedepend.ml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/driver/makedepend.ml b/driver/makedepend.ml index 9f79401a4ff..c2c007d5872 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -253,25 +253,25 @@ let rec lexical_approximation lexbuf = lower-case identifier - always skip the token after a backquote *) - let rec process after_lident lexbuf = + let rec process ~after_lident lexbuf = match Lexer.token lexbuf with | Parser.UIDENT name -> Depend.free_structure_names := String.Set.add name !Depend.free_structure_names; - process false lexbuf - | Parser.LIDENT _ -> process true lexbuf - | Parser.DOT when after_lident -> process false lexbuf + process ~after_lident:false lexbuf + | Parser.LIDENT _ -> process ~after_lident:true lexbuf + | Parser.DOT when after_lident -> process ~after_lident:false lexbuf | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf | Parser.EOF -> () - | _ -> process false lexbuf + | _ -> process ~after_lident:false lexbuf and skip_one lexbuf = match Lexer.token lexbuf with | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf | Parser.EOF -> () - | _ -> process false lexbuf + | _ -> process ~after_lident:false lexbuf in - try process false lexbuf + try process ~after_lident:false lexbuf with Lexer.Error _ -> lexical_approximation lexbuf let read_and_approximate inputfile = From d862b82be63ecf842ed91b9f3712326b6d2fdf43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 12 Sep 2023 16:35:18 +0200 Subject: [PATCH 106/402] Changes --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index 70f647e5c93..bc06635fa12 100644 --- a/Changes +++ b/Changes @@ -207,6 +207,9 @@ Working version (Antonin Décimo, Damien Doligez, review by Sébastien Hinderer, Damien Doligez, Gabriel Scherer, and Xavier Leroy) +- #12576: ocamldep: various refactors. + (Antonin Décimo, review by Florian Angeletti, Gabriel Scherer, and Léo Andrès) + ### Manual and documentation: - #12338: clarification of the documentation of process related function in From 49e23ee234afa01f71ff49ec014aaba852a28f62 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Mon, 25 Sep 2023 14:01:12 +0200 Subject: [PATCH 107/402] Symtable: remove useless warning directive There is no need to disable warning 40 in bytecomp/symtable.ml since the warning is already disabled globally by the compiler's build system. --- bytecomp/symtable.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 2364ad4d6a6..989c493fc91 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -13,8 +13,6 @@ (* *) (**************************************************************************) -[@@@ocaml.warning "-40"] - (* To assign numbers to globals and primitives *) open Misc From e5a6458fc541cd499bff7da2e0267feaa774ab76 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Mon, 25 Sep 2023 14:10:58 +0200 Subject: [PATCH 108/402] Symtable: remove unused open --- .depend | 2 -- bytecomp/symtable.ml | 1 - 2 files changed, 3 deletions(-) diff --git a/.depend b/.depend index 9ca340a45f3..2aa12344da5 100644 --- a/.depend +++ b/.depend @@ -2223,7 +2223,6 @@ bytecomp/symtable.cmo : \ file_formats/cmo_format.cmi \ utils/clflags.cmi \ bytecomp/bytesections.cmi \ - parsing/asttypes.cmi \ bytecomp/symtable.cmi bytecomp/symtable.cmx : \ lambda/runtimedef.cmx \ @@ -2238,7 +2237,6 @@ bytecomp/symtable.cmx : \ file_formats/cmo_format.cmi \ utils/clflags.cmx \ bytecomp/bytesections.cmx \ - parsing/asttypes.cmi \ bytecomp/symtable.cmi bytecomp/symtable.cmi : \ lambda/lambda.cmi \ diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 989c493fc91..4a472a3eeed 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -16,7 +16,6 @@ (* To assign numbers to globals and primitives *) open Misc -open Asttypes open Lambda open Cmo_format From b36616fbe786ce3e3c38fe3fef099944a5469b05 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Mon, 25 Sep 2023 14:38:04 +0200 Subject: [PATCH 109/402] Dynlink: stop configuring warnings in source files Most of the settings in these files were redundent with those of the build system anyway. The only warning which was disabled in the source files but not in the build system was warning 30 (duplicate-definitions) but since the current implementations do not trigger it anyway it seems better to not disable it, at least as long as there is no need to do so. --- otherlibs/dynlink/byte/dynlink.ml | 2 -- otherlibs/dynlink/dynlink.mli | 2 -- otherlibs/dynlink/dynlink_common.ml | 2 -- otherlibs/dynlink/dynlink_common.mli | 2 -- otherlibs/dynlink/dynlink_platform_intf.ml | 2 -- otherlibs/dynlink/dynlink_types.ml | 2 -- otherlibs/dynlink/dynlink_types.mli | 2 -- otherlibs/dynlink/native/dynlink.ml | 2 -- .../backtrace_dynlink.flambda.reference | 28 +++++++++---------- .../backtrace/backtrace_dynlink.reference | 14 +++++----- .../test10_main.byte.reference | 6 ++-- .../test10_main.native.reference | 8 +++--- 12 files changed, 28 insertions(+), 44 deletions(-) diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml index 08fc80eff01..eefe208d5e6 100644 --- a/otherlibs/dynlink/byte/dynlink.ml +++ b/otherlibs/dynlink/byte/dynlink.ml @@ -15,8 +15,6 @@ (* *) (**************************************************************************) -[@@@ocaml.warning "+a-4-30-40-41-42"] - open! Dynlink_compilerlibs module DC = Dynlink_common diff --git a/otherlibs/dynlink/dynlink.mli b/otherlibs/dynlink/dynlink.mli index a9770a25ac4..a88c9190db1 100644 --- a/otherlibs/dynlink/dynlink.mli +++ b/otherlibs/dynlink/dynlink.mli @@ -17,8 +17,6 @@ (** Dynamic loading of .cmo, .cma and .cmxs files. *) -[@@@ocaml.warning "+a-4-30-40-41-42"] - val is_native : bool (** [true] if the program is native, [false] if the program is bytecode. *) diff --git a/otherlibs/dynlink/dynlink_common.ml b/otherlibs/dynlink/dynlink_common.ml index 85c4fb86806..a37a386345a 100644 --- a/otherlibs/dynlink/dynlink_common.ml +++ b/otherlibs/dynlink/dynlink_common.ml @@ -15,8 +15,6 @@ (* *) (**************************************************************************) -[@@@ocaml.warning "+a-4-30-40-41-42"] - open! Dynlink_compilerlibs module String = struct diff --git a/otherlibs/dynlink/dynlink_common.mli b/otherlibs/dynlink/dynlink_common.mli index c6f92d05cd1..c0b7d3ed120 100644 --- a/otherlibs/dynlink/dynlink_common.mli +++ b/otherlibs/dynlink/dynlink_common.mli @@ -15,8 +15,6 @@ (* *) (**************************************************************************) -[@@@ocaml.warning "+a-4-30-40-41-42"] - (** Construction of dynlink functionality given the platform-specific code. *) module Make (_ : Dynlink_platform_intf.S) : sig diff --git a/otherlibs/dynlink/dynlink_platform_intf.ml b/otherlibs/dynlink/dynlink_platform_intf.ml index 31189c35f21..6e63c2d0d1e 100644 --- a/otherlibs/dynlink/dynlink_platform_intf.ml +++ b/otherlibs/dynlink/dynlink_platform_intf.ml @@ -18,8 +18,6 @@ (** Interface for platform-specific dynlink providers. Note that this file needs to be a valid .mli file. *) -[@@@ocaml.warning "+a-4-30-40-41-42"] - module type S = sig type handle diff --git a/otherlibs/dynlink/dynlink_types.ml b/otherlibs/dynlink/dynlink_types.ml index 2a13ecefc60..9b690dcdc39 100644 --- a/otherlibs/dynlink/dynlink_types.ml +++ b/otherlibs/dynlink/dynlink_types.ml @@ -17,8 +17,6 @@ (** Types shared amongst the various parts of the dynlink code. *) -[@@@ocaml.warning "+a-4-30-40-41-42"] - type implem_state = | Loaded | Not_initialized diff --git a/otherlibs/dynlink/dynlink_types.mli b/otherlibs/dynlink/dynlink_types.mli index 6adf9b896d0..84276ced28e 100644 --- a/otherlibs/dynlink/dynlink_types.mli +++ b/otherlibs/dynlink/dynlink_types.mli @@ -17,8 +17,6 @@ (** Types shared amongst the various parts of the dynlink code. *) -[@@@ocaml.warning "+a-4-30-40-41-42"] - type implem_state = | Loaded | Not_initialized diff --git a/otherlibs/dynlink/native/dynlink.ml b/otherlibs/dynlink/native/dynlink.ml index ae902951ce3..050bb69e550 100644 --- a/otherlibs/dynlink/native/dynlink.ml +++ b/otherlibs/dynlink/native/dynlink.ml @@ -17,8 +17,6 @@ (* Dynamic loading of .cmx files *) -[@@@ocaml.warning "+a-4-30-40-41-42"] - open! Dynlink_compilerlibs module DC = Dynlink_common diff --git a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference index e344d01f1ee..f8df384eeb7 100644 --- a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference +++ b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference @@ -1,25 +1,25 @@ Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38 -Called from Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 12-29 +Called from Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 -Called from Dynlink.Native.run in file "native/dynlink.ml", line 84, characters 4-273 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 360, characters 11-54 +Called from Dynlink.Native.run in file "native/dynlink.ml", line 82, characters 4-273 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml" (inlined), line 356, characters 6-372 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml" (inlined), line 354, characters 6-372 Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 33, characters 8-15 -Called from Dynlink_common.Make.load in file "dynlink_common.ml", line 349, characters 4-662 -Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 368, characters 26-45 +Called from Dynlink_common.Make.load in file "dynlink_common.ml", line 347, characters 4-662 +Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52 execution of module initializers in the shared library failed: Failure("SUCCESS") -Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 12-29 -Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 87, characters 10-149 +Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29 +Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 10-149 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 -Called from Dynlink.Native.run in file "native/dynlink.ml", line 84, characters 4-273 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 360, characters 11-54 +Called from Dynlink.Native.run in file "native/dynlink.ml", line 82, characters 4-273 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml" (inlined), line 356, characters 6-372 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml" (inlined), line 354, characters 6-372 Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 33, characters 8-15 -Called from Dynlink_common.Make.load in file "dynlink_common.ml", line 349, characters 4-662 +Called from Dynlink_common.Make.load in file "dynlink_common.ml", line 347, characters 4-662 Re-raised at Stdlib__Fun.protect in file "fun.ml" (inlined), line 38, characters 6-52 -Called from Dynlink_common.Make.load in file "dynlink_common.ml", line 349, characters 4-662 -Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 368, characters 26-45 +Called from Dynlink_common.Make.load in file "dynlink_common.ml", line 347, characters 4-662 +Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52 diff --git a/testsuite/tests/backtrace/backtrace_dynlink.reference b/testsuite/tests/backtrace/backtrace_dynlink.reference index 8edaaa0774e..cc3265a38c3 100644 --- a/testsuite/tests/backtrace/backtrace_dynlink.reference +++ b/testsuite/tests/backtrace/backtrace_dynlink.reference @@ -1,18 +1,18 @@ Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38 -Called from Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 12-29 +Called from Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 360, characters 11-54 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15 -Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 368, characters 26-45 +Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52 execution of module initializers in the shared library failed: Failure("SUCCESS") -Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 12-29 -Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 87, characters 10-149 +Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29 +Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 10-149 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 360, characters 11-54 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15 Re-raised at Stdlib__Fun.protect in file "fun.ml", line 38, characters 6-52 -Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 368, characters 26-45 +Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52 diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference index 5f6077ec204..9bbb5a25c98 100644 --- a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference +++ b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference @@ -3,9 +3,9 @@ Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33 Called from Test10_plugin.g in file "test10_plugin.ml", line 3, characters 2-21 Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6 Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6 -Called from Dynlink.Bytecode.run in file "byte/dynlink.ml", line 154, characters 16-25 -Re-raised at Dynlink.Bytecode.run in file "byte/dynlink.ml", line 156, characters 6-137 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 360, characters 11-54 +Called from Dynlink.Bytecode.run in file "byte/dynlink.ml", line 152, characters 16-25 +Re-raised at Dynlink.Bytecode.run in file "byte/dynlink.ml", line 154, characters 6-137 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15 Re-raised at Stdlib__Fun.protect in file "fun.ml", line 38, characters 6-52 diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference index 9c7b2de2238..4da7d537af0 100755 --- a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference +++ b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference @@ -1,10 +1,10 @@ Error: Failure("Plugin error") -Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 12-29 -Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 87, characters 10-149 +Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29 +Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 85, characters 10-149 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 -Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 360, characters 11-54 +Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15 Re-raised at Stdlib__Fun.protect in file "fun.ml", line 38, characters 6-52 -Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 368, characters 26-45 +Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45 Called from Test10_main in file "test10_main.ml", line 49, characters 30-87 From 9c7d11ecc8da10aa0eeed40d642d5944508b5fd1 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Mon, 25 Sep 2023 12:19:04 +0200 Subject: [PATCH 110/402] Dynlink: release the dependency on Misc.fatal_error --- otherlibs/dynlink/byte/dynlink.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml index eefe208d5e6..2efe38130f5 100644 --- a/otherlibs/dynlink/byte/dynlink.ml +++ b/otherlibs/dynlink/byte/dynlink.ml @@ -68,7 +68,7 @@ module Bytecode = struct let adapt_filename f = f let num_globals_inited () = - Misc.fatal_error "Should never be called for bytecode dynlink" + failwith "Should never be called for bytecode dynlink" let fold_initial_units ~init ~f = List.fold_left (fun acc (compunit, interface) -> From 04e0e5dcbec8cbdfd250b9667b102673604bc869 Mon Sep 17 00:00:00 2001 From: Vincent Laviron Date: Mon, 25 Sep 2023 17:53:02 +0200 Subject: [PATCH 111/402] Propagate the classification from Rec_check (#12551) --- .depend | 19 +++++++++ Changes | 3 ++ asmcomp/cmmgen.ml | 9 ++++- bytecomp/bytegen.ml | 26 ++++++++---- lambda/lambda.ml | 30 ++++++++++---- lambda/lambda.mli | 8 +++- lambda/printlambda.ml | 9 ++++- lambda/simplif.ml | 35 +++++++++++----- lambda/simplif.mli | 2 +- lambda/tmc.ml | 40 ++++++++++++++++--- lambda/translclass.ml | 2 +- lambda/translcore.ml | 14 ++++--- lambda/translmod.ml | 3 +- middle_end/clambda.ml | 6 ++- middle_end/clambda.mli | 6 ++- middle_end/closure/closure.ml | 40 ++++++++++--------- middle_end/flambda/build_export_info.ml | 2 +- middle_end/flambda/closure_conversion.ml | 25 +++++++----- middle_end/flambda/effect_analysis.ml | 2 +- middle_end/flambda/flambda.ml | 16 +++++--- middle_end/flambda/flambda.mli | 2 +- middle_end/flambda/flambda_invariants.ml | 4 +- middle_end/flambda/flambda_iterators.ml | 21 +++++++--- middle_end/flambda/flambda_to_clambda.ml | 8 ++-- middle_end/flambda/flambda_utils.ml | 16 +++++--- middle_end/flambda/freshening.ml | 5 +++ middle_end/flambda/freshening.mli | 7 ++++ middle_end/flambda/inconstant_idents.ml | 2 +- middle_end/flambda/inline_and_simplify.ml | 8 ++-- middle_end/flambda/inlining_cost.ml | 2 +- middle_end/flambda/lift_code.ml | 18 ++++++--- .../flambda/lift_let_to_initialize_symbol.ml | 22 +++++----- middle_end/flambda/ref_to_variables.ml | 2 +- middle_end/flambda/un_anf.ml | 13 +++--- middle_end/printclambda.ml | 10 ++++- otherlibs/dynlink/Makefile | 1 + toplevel/native/topeval.ml | 1 + typing/rec_check.ml | 26 ++++++------ typing/rec_check.mli | 5 ++- typing/tast_mapper.ml | 3 +- typing/typeclass.ml | 5 ++- typing/typecore.ml | 23 ++++++----- typing/typecore.mli | 3 +- typing/typedtree.ml | 5 +++ typing/typedtree.mli | 5 +++ typing/typemod.ml | 5 ++- 46 files changed, 360 insertions(+), 159 deletions(-) diff --git a/.depend b/.depend index 2aa12344da5..be45c688919 100644 --- a/.depend +++ b/.depend @@ -1959,6 +1959,7 @@ typing/untypeast.cmi : \ parsing/asttypes.cmi bytecomp/bytegen.cmo : \ typing/types.cmi \ + typing/typedtree.cmi \ lambda/switch.cmi \ typing/subst.cmi \ typing/primitive.cmi \ @@ -1975,6 +1976,7 @@ bytecomp/bytegen.cmo : \ bytecomp/bytegen.cmi bytecomp/bytegen.cmx : \ typing/types.cmx \ + typing/typedtree.cmx \ lambda/switch.cmx \ typing/subst.cmx \ typing/primitive.cmx \ @@ -2632,6 +2634,7 @@ asmcomp/cmm_invariants.cmi : \ asmcomp/cmm.cmi asmcomp/cmmgen.cmo : \ typing/types.cmi \ + typing/typedtree.cmi \ asmcomp/thread_sanitizer.cmi \ middle_end/printclambda_primitives.cmi \ typing/primitive.cmi \ @@ -2652,6 +2655,7 @@ asmcomp/cmmgen.cmo : \ asmcomp/cmmgen.cmi asmcomp/cmmgen.cmx : \ typing/types.cmx \ + typing/typedtree.cmx \ asmcomp/thread_sanitizer.cmx \ middle_end/printclambda_primitives.cmx \ typing/primitive.cmx \ @@ -3331,6 +3335,7 @@ middle_end/backend_var.cmi : \ typing/ident.cmi \ lambda/debuginfo.cmi middle_end/clambda.cmo : \ + typing/typedtree.cmi \ typing/path.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ @@ -3340,6 +3345,7 @@ middle_end/clambda.cmo : \ parsing/asttypes.cmi \ middle_end/clambda.cmi middle_end/clambda.cmx : \ + typing/typedtree.cmx \ typing/path.cmx \ lambda/lambda.cmx \ typing/ident.cmx \ @@ -3349,6 +3355,7 @@ middle_end/clambda.cmx : \ parsing/asttypes.cmi \ middle_end/clambda.cmi middle_end/clambda.cmi : \ + typing/typedtree.cmi \ typing/path.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ @@ -3482,6 +3489,7 @@ middle_end/linkage_name.cmx : \ middle_end/linkage_name.cmi : \ utils/identifiable.cmi middle_end/printclambda.cmo : \ + typing/typedtree.cmi \ lambda/printlambda.cmi \ middle_end/printclambda_primitives.cmi \ lambda/lambda.cmi \ @@ -3491,6 +3499,7 @@ middle_end/printclambda.cmo : \ parsing/asttypes.cmi \ middle_end/printclambda.cmi middle_end/printclambda.cmx : \ + typing/typedtree.cmx \ lambda/printlambda.cmx \ middle_end/printclambda_primitives.cmx \ lambda/lambda.cmx \ @@ -3585,6 +3594,7 @@ lambda/debuginfo.cmi : \ parsing/asttypes.cmi lambda/lambda.cmo : \ typing/types.cmi \ + typing/typedtree.cmi \ typing/primitive.cmi \ typing/path.cmi \ utils/misc.cmi \ @@ -3597,6 +3607,7 @@ lambda/lambda.cmo : \ lambda/lambda.cmi lambda/lambda.cmx : \ typing/types.cmx \ + typing/typedtree.cmx \ typing/primitive.cmx \ typing/path.cmx \ utils/misc.cmx \ @@ -3609,6 +3620,7 @@ lambda/lambda.cmx : \ lambda/lambda.cmi lambda/lambda.cmi : \ typing/types.cmi \ + typing/typedtree.cmi \ typing/primitive.cmi \ typing/path.cmi \ typing/ident.cmi \ @@ -4516,6 +4528,7 @@ middle_end/flambda/find_recursive_functions.cmi : \ middle_end/backend_intf.cmi middle_end/flambda/flambda.cmo : \ middle_end/variable.cmi \ + typing/typedtree.cmi \ middle_end/flambda/base_types/tag.cmi \ middle_end/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ @@ -4542,6 +4555,7 @@ middle_end/flambda/flambda.cmo : \ middle_end/flambda/flambda.cmi middle_end/flambda/flambda.cmx : \ middle_end/variable.cmx \ + typing/typedtree.cmx \ middle_end/flambda/base_types/tag.cmx \ middle_end/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ @@ -4568,6 +4582,7 @@ middle_end/flambda/flambda.cmx : \ middle_end/flambda/flambda.cmi middle_end/flambda/flambda.cmi : \ middle_end/variable.cmi \ + typing/typedtree.cmi \ middle_end/flambda/base_types/tag.cmi \ middle_end/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ @@ -4791,6 +4806,7 @@ middle_end/flambda/flambda_to_clambda.cmi : \ middle_end/flambda/flambda_utils.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ + typing/typedtree.cmi \ middle_end/symbol.cmi \ lambda/switch.cmi \ middle_end/flambda/base_types/static_exception.cmi \ @@ -4816,6 +4832,7 @@ middle_end/flambda/flambda_utils.cmo : \ middle_end/flambda/flambda_utils.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ + typing/typedtree.cmx \ middle_end/symbol.cmx \ lambda/switch.cmx \ middle_end/flambda/base_types/static_exception.cmx \ @@ -5756,6 +5773,7 @@ middle_end/flambda/traverse_for_exported_symbols.cmi : \ middle_end/flambda/base_types/export_id.cmi \ middle_end/flambda/base_types/closure_id.cmi middle_end/flambda/un_anf.cmo : \ + typing/typedtree.cmi \ middle_end/symbol.cmi \ middle_end/semantics_of_primitives.cmi \ middle_end/printclambda.cmi \ @@ -5769,6 +5787,7 @@ middle_end/flambda/un_anf.cmo : \ parsing/asttypes.cmi \ middle_end/flambda/un_anf.cmi middle_end/flambda/un_anf.cmx : \ + typing/typedtree.cmx \ middle_end/symbol.cmx \ middle_end/semantics_of_primitives.cmx \ middle_end/printclambda.cmx \ diff --git a/Changes b/Changes index bc06635fa12..cee71a4b03e 100644 --- a/Changes +++ b/Changes @@ -139,6 +139,9 @@ Working version were not correctly rounded sometimes. (Xavier Leroy, review by Anil Madhavapeddy and Tim McGilchrist) +- #12551: Propagate classification of recursive bindings from Rec_check + (Vincent Laviron, review by Gabriel Scherer) + ### Standard library: * #10775, #12499: Half-precision floating-point elements in Bigarray. diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 35af8ebebf6..c41cfd7efb7 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -152,7 +152,7 @@ let rec expr_size env = function | Uletrec(bindings, body) -> let env = List.fold_right - (fun (id, exp) env -> V.add (VP.var id) (expr_size env exp) env) + (fun (id, _, exp) env -> V.add (VP.var id) (expr_size env exp) env) bindings env in expr_size env body @@ -222,6 +222,11 @@ let rec expr_size env = function | Uassign _ | Usend _ -> RHS_nonrec | Uunreachable -> RHS_unreachable +let expr_size_of_binding (clas : Typedtree.recursive_binding_kind) expr = + match clas with + | Not_recursive -> RHS_nonrec + | Static -> expr_size V.empty expr + (* Translate structured constants to Cmm data items *) let transl_constant dbg = function @@ -1425,7 +1430,7 @@ and transl_switch dbg env arg index cases = match Array.length cases with and transl_letrec env bindings cont = let dbg = Debuginfo.none in let bsz = - List.map (fun (id, exp) -> (id, exp, expr_size V.empty exp)) + List.map (fun (id, clas, exp) -> (id, exp, expr_size_of_binding clas exp)) bindings in let op_alloc prim args = diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 0af08b7112f..0b4d2ba5f29 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -240,19 +240,22 @@ let rec size_of_lambda env = function size_of_lambda env body (* See the Lletrec case of comp_expr *) | Lletrec(bindings, body) when - List.for_all (function (_, Lfunction _) -> true | _ -> false) bindings -> + List.for_all + (function { def = Lfunction _ } -> true | _ -> false) + bindings -> (* let rec of functions *) let fv = Ident.Set.elements (free_variables (Lletrec(bindings, lambda_unit))) in (* See Instruct(CLOSUREREC) in interp.c *) let blocksize = List.length bindings * 3 - 1 + List.length fv in - let offsets = List.mapi (fun i (id, _e) -> (id, i * 3)) bindings in + let offsets = List.mapi (fun i { id } -> (id, i * 3)) bindings in let env = List.fold_right (fun (id, offset) env -> Ident.add id (RHS_infix { blocksize; offset }) env) offsets env in size_of_lambda env body | Lletrec(bindings, body) -> let env = List.fold_right - (fun (id, e) env -> Ident.add id (size_of_lambda env e) env) + (fun { id; rkind=_; def } env -> + Ident.add id (size_of_lambda env def) env) bindings env in size_of_lambda env body @@ -308,6 +311,11 @@ let rec size_of_lambda env = function | Lmutvar _ | Lapply _ | Lwhile _ | Lfor _ | Lassign _ | Lsend _ | Lifused _ -> RHS_nonrec +let size_of_rec_binding clas expr = + match (clas : Typedtree.recursive_binding_kind) with + | Not_recursive -> RHS_nonrec + | Static -> size_of_lambda Ident.empty expr + (**** Merging consecutive events ****) let copy_event ev kind info repr = @@ -724,18 +732,18 @@ let rec comp_expr stack_info env exp sz cont = (add_pop 1 cont)) | Lletrec(decl, body) -> let ndecl = List.length decl in - if List.for_all (function (_, Lfunction _) -> true | _ -> false) + if List.for_all (function { def = Lfunction _ } -> true | _ -> false) decl then begin (* let rec of functions *) let fv = Ident.Set.elements (free_variables (Lletrec(decl, lambda_unit))) in - let rec_idents = List.map (fun (id, _lam) -> id) decl in + let rec_idents = List.map (fun { id } -> id) decl in let entries = closure_entries (Multiple_recursive rec_idents) fv in let rec comp_fun pos = function [] -> [] - | (_id, Lfunction{params; body}) :: rem -> + | { def = Lfunction{params; body} } :: rem -> let lbl = new_label() in let to_compile = { params = List.map fst params; body = body; label = lbl; @@ -751,8 +759,10 @@ let rec comp_expr stack_info env exp sz cont = (add_pop ndecl cont))) end else begin let decl_size = - List.map (fun (id, exp) -> (id, exp, size_of_lambda Ident.empty exp)) - decl in + List.map (fun { id; rkind; def } -> + (id, def, size_of_rec_binding rkind def)) + decl + in let rec comp_init new_env sz = function | [] -> comp_nonrec new_env sz ndecl decl_size | (id, _exp, RHS_floatblock blocksize) :: rem -> diff --git a/lambda/lambda.ml b/lambda/lambda.ml index a7cebcc49f3..8c112d6bad6 100644 --- a/lambda/lambda.ml +++ b/lambda/lambda.ml @@ -297,7 +297,7 @@ type lambda = | Lfunction of lfunction | Llet of let_kind * value_kind * Ident.t * lambda * lambda | Lmutlet of value_kind * Ident.t * lambda * lambda - | Lletrec of (Ident.t * lambda) list * lambda + | Lletrec of rec_binding list * lambda | Lprim of primitive * lambda list * scoped_location | Lswitch of lambda * lambda_switch * scoped_location | Lstringswitch of @@ -314,6 +314,12 @@ type lambda = | Levent of lambda * lambda_event | Lifused of Ident.t * lambda +and rec_binding = { + id : Ident.t; + rkind : Typedtree.recursive_binding_kind; + def : lambda; +} + and lfunction = { kind: function_kind; params: (Ident.t * value_kind) list; @@ -513,7 +519,7 @@ let shallow_iter ~tail ~non_tail:f = function f arg; tail body | Lletrec(decl, body) -> tail body; - List.iter (fun (_id, exp) -> f exp) decl + List.iter (fun { def } -> f def) decl | Lprim (Psequand, [l1; l2], _) | Lprim (Psequor, [l1; l2], _) -> f l1; @@ -570,8 +576,12 @@ let rec free_variables = function (free_variables arg) (Ident.Set.remove id (free_variables body)) | Lletrec(decl, body) -> - let set = free_variables_list (free_variables body) (List.map snd decl) in - Ident.Set.diff set (Ident.Set.of_list (List.map fst decl)) + let set = + free_variables_list (free_variables body) + (List.map (fun { def } -> def) decl) + in + Ident.Set.diff set + (Ident.Set.of_list (List.map (fun { id } -> id) decl)) | Lprim(_p, args, _loc) -> free_variables_list Ident.Set.empty args | Lswitch(arg, sw,_) -> @@ -730,6 +740,12 @@ let subst update_env ?(freshen_bound_variables = false) s input_lam = ((id', rhs) :: ids' , l) ) ids ([], l) in + let bind_rec ids l = + List.fold_right (fun rb (ids', l) -> + let id', l = bind rb.id l in + ({ rb with id = id' } :: ids' , l) + ) ids ([], l) + in let rec subst s l lam = match lam with | Lvar id as lam -> @@ -763,7 +779,7 @@ let subst update_env ?(freshen_bound_variables = false) s input_lam = let id, l' = bind id l in Lmutlet(k, id, subst s l arg, subst s l' body) | Lletrec(decl, body) -> - let decl, l' = bind_many decl l in + let decl, l' = bind_rec decl l in Lletrec(List.map (subst_decl s l') decl, subst s l' body) | Lprim(p, args, loc) -> Lprim(p, subst_list s l args, loc) | Lswitch(arg, sw, loc) -> @@ -829,7 +845,7 @@ let subst update_env ?(freshen_bound_variables = false) s input_lam = let id = try Ident.Map.find id l with Not_found -> id in Lifused (id, subst s l e) and subst_list s l li = List.map (subst s l) li - and subst_decl s l (id, exp) = (id, subst s l exp) + and subst_decl s l decl = { decl with def = subst s l decl.def } and subst_case s l (key, case) = (key, subst s l case) and subst_strcase s l (key, case) = (key, subst s l case) and subst_opt s l = function @@ -874,7 +890,7 @@ let shallow_map f = function | Lmutlet (k, v, e1, e2) -> Lmutlet (k, v, f e1, f e2) | Lletrec (idel, e2) -> - Lletrec (List.map (fun (v, e) -> (v, f e)) idel, f e2) + Lletrec (List.map (fun rb -> { rb with def = f rb.def }) idel, f e2) | Lprim (p, el, loc) -> Lprim (p, List.map f el, loc) | Lswitch (e, sw, loc) -> diff --git a/lambda/lambda.mli b/lambda/lambda.mli index d1488e30638..48a57b8d7df 100644 --- a/lambda/lambda.mli +++ b/lambda/lambda.mli @@ -284,7 +284,7 @@ type lambda = | Lfunction of lfunction | Llet of let_kind * value_kind * Ident.t * lambda * lambda | Lmutlet of value_kind * Ident.t * lambda * lambda - | Lletrec of (Ident.t * lambda) list * lambda + | Lletrec of rec_binding list * lambda | Lprim of primitive * lambda list * scoped_location | Lswitch of lambda * lambda_switch * scoped_location (* switch on strings, clauses are sorted by string order, @@ -305,6 +305,12 @@ type lambda = | Levent of lambda * lambda_event | Lifused of Ident.t * lambda +and rec_binding = { + id : Ident.t; + rkind : Typedtree.recursive_binding_kind; + def : lambda; +} + and lfunction = private { kind: function_kind; params: (Ident.t * value_kind) list; diff --git a/lambda/printlambda.ml b/lambda/printlambda.ml index fff85d7ba8d..d4a3fe75338 100644 --- a/lambda/printlambda.ml +++ b/lambda/printlambda.ml @@ -581,9 +581,14 @@ let rec lam ppf = function let bindings ppf id_arg_list = let spc = ref false in List.iter - (fun (id, l) -> + (fun { id; rkind; def } -> if !spc then fprintf ppf "@ " else spc := true; - fprintf ppf "@[<2>%a@ %a@]" Ident.print id lam l) + let rec_annot = + match rkind with + | Static -> "" + | Not_recursive -> "[Nonrec]" + in + fprintf ppf "@[<2>%a%s@ %a@]" Ident.print id rec_annot lam def) id_arg_list in fprintf ppf "@[<2>(letrec@ (@[%a@])@ %a)@]" bindings id_arg_list lam body diff --git a/lambda/simplif.ml b/lambda/simplif.ml index f84737844b8..479b46d6bc7 100644 --- a/lambda/simplif.ml +++ b/lambda/simplif.ml @@ -40,8 +40,11 @@ let rec eliminate_ref id = function | Lmutlet(kind, v, e1, e2) -> Lmutlet(kind, v, eliminate_ref id e1, eliminate_ref id e2) | Lletrec(idel, e2) -> - Lletrec(List.map (fun (v, e) -> (v, eliminate_ref id e)) idel, - eliminate_ref id e2) + let bindings = + List.map (fun rb -> { rb with def = eliminate_ref id rb.def }) + idel + in + Lletrec(bindings, eliminate_ref id e2) | Lprim(Pfield (0, _, _), [Lvar v], _) when Ident.same v id -> Lmutvar id | Lprim(Psetfield(0, _, _), [Lvar v; e], _) when Ident.same v id -> @@ -129,7 +132,7 @@ let simplify_exits lam = | Lmutlet(_kind, _v, l1, l2) -> count ~try_depth l2; count ~try_depth l1 | Lletrec(bindings, body) -> - List.iter (fun (_v, l) -> count ~try_depth l) bindings; + List.iter (fun { def } -> count ~try_depth def) bindings; count ~try_depth body | Lprim(_p, ll, _) -> List.iter (count ~try_depth) ll | Lswitch(l, sw, _loc) -> @@ -226,8 +229,11 @@ let simplify_exits lam = | Lmutlet(kind, v, l1, l2) -> Lmutlet(kind, v, simplif ~try_depth l1, simplif ~try_depth l2) | Lletrec(bindings, body) -> - Lletrec(List.map (fun (v, l) -> (v, simplif ~try_depth l)) bindings, - simplif ~try_depth body) + let bindings = + List.map (fun rb -> { rb with def = simplif ~try_depth rb.def }) + bindings + in + Lletrec(bindings, simplif ~try_depth body) | Lprim(p, ll, loc) -> begin let ll = List.map (simplif ~try_depth) ll in match p, ll with @@ -417,7 +423,7 @@ let simplify_lets lam = count bv l1; count bv l2 | Lletrec(bindings, body) -> - List.iter (fun (_v, l) -> count bv l) bindings; + List.iter (fun { def } -> count bv def) bindings; count bv body | Lprim(_p, ll, _) -> List.iter (count bv) ll | Lswitch(l, sw, _loc) -> @@ -556,7 +562,11 @@ let simplify_lets lam = | Llet(str, kind, v, l1, l2) -> mklet str kind v (simplif l1) (simplif l2) | Lmutlet(kind, v, l1, l2) -> mkmutlet kind v (simplif l1) (simplif l2) | Lletrec(bindings, body) -> - Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body) + let bindings = + List.map (fun rb -> { rb with def = simplif rb.def }) + bindings + in + Lletrec(bindings, simplif body) | Lprim(p, ll, loc) -> Lprim(p, List.map simplif ll, loc) | Lswitch(l, sw, loc) -> let new_l = simplif l @@ -629,7 +639,7 @@ let rec emit_tail_infos is_tail lambda = emit_tail_infos false lam; emit_tail_infos is_tail body | Lletrec (bindings, body) -> - List.iter (fun (_, lam) -> emit_tail_infos false lam) bindings; + List.iter (fun { def } -> emit_tail_infos false def) bindings; emit_tail_infos is_tail body | Lprim ((Pbytes_to_string | Pbytes_of_string), [arg], _) -> emit_tail_infos is_tail arg @@ -753,14 +763,17 @@ let split_default_wrapper ~id:fun_id ~kind ~params ~return ~body ~attr ~loc = ~params:(List.map (fun id -> id, Pgenval) new_ids) ~return ~body ~attr ~loc in - (wrapper_body, (inner_id, inner_fun)) + (wrapper_body, { id = inner_id; rkind = Static; def = inner_fun }) in try let body, inner = aux [] body in let attr = default_stub_attribute in - [(fun_id, lfunction ~kind ~params ~return ~body ~attr ~loc); inner] + [{ id = fun_id; rkind = Static; + def = lfunction ~kind ~params ~return ~body ~attr ~loc }; + inner] with Exit -> - [(fun_id, lfunction ~kind ~params ~return ~body ~attr ~loc)] + [{ id = fun_id; rkind = Static; + def = lfunction ~kind ~params ~return ~body ~attr ~loc }] (* Simplify local let-bound functions: if all occurrences are fully-applied function calls in the same "tail scope", replace the diff --git a/lambda/simplif.mli b/lambda/simplif.mli index 2e5be0acca1..8161579abc8 100644 --- a/lambda/simplif.mli +++ b/lambda/simplif.mli @@ -37,4 +37,4 @@ val split_default_wrapper -> body:lambda -> attr:function_attribute -> loc:Lambda.scoped_location - -> (Ident.t * lambda) list + -> rec_binding list diff --git a/lambda/tmc.ml b/lambda/tmc.ml index 18c489cd2f8..899a01b9eca 100644 --- a/lambda/tmc.ml +++ b/lambda/tmc.ml @@ -551,6 +551,10 @@ and specialized = { direct_kind: function_kind; } +type _ binding_kind = + | Recursive : rec_binding binding_kind + | Non_recursive : (Ident.t * lambda) binding_kind + let llets lk vk bindings body = List.fold_right (fun (var, def) body -> Llet (lk, vk, var, def, body) @@ -928,17 +932,41 @@ and traverse ctx = function and traverse_let outer_ctx var def = let inner_ctx = declare_binding outer_ctx (var, def) in - let bindings = traverse_binding outer_ctx inner_ctx (var, def) in + let bindings = + traverse_binding Non_recursive outer_ctx inner_ctx (var, def) + in inner_ctx, bindings and traverse_letrec ctx bindings = - let ctx = List.fold_left declare_binding ctx bindings in - let bindings = List.concat_map (traverse_binding ctx ctx) bindings in + let ctx = + List.fold_left declare_binding ctx + (List.map (fun { id; rkind=_; def } -> id, def) bindings) + in + let bindings = + List.concat_map (traverse_binding Recursive ctx ctx) bindings + in ctx, bindings -and traverse_binding outer_ctx inner_ctx (var, def) = +and traverse_binding : + type a. a binding_kind -> context -> context -> a -> a list = + fun binding_kind outer_ctx inner_ctx binding -> + let (var, def) : Ident.t * lambda = + match binding_kind, binding with + | Recursive, { id; rkind=_; def } -> id, def + | Non_recursive, (var, def) -> var, def + in + let mk_same_binding (var : Ident.t) (def : lambda) : a = + match binding_kind, binding with + | Recursive, { id=_; rkind; def=_ } -> { id = var; rkind; def } + | Non_recursive, _ -> var, def + in + let mk_static_binding (var : Ident.t) (def : lambda) : a = + match binding_kind, binding with + | Recursive, _ -> { id = var; rkind = Static; def } + | Non_recursive, _ -> var, def + in match find_candidate def with - | None -> [(var, traverse outer_ctx def)] + | None -> [mk_same_binding var (traverse outer_ctx def)] | Some lfun -> let special = Ident.Map.find var inner_ctx.specialized in let fun_choice = choice outer_ctx ~tail:true lfun.body in @@ -968,7 +996,7 @@ and traverse_binding outer_ctx inner_ctx (var, def) = ~loc:lfun.loc in let dps_var = special.dps_id in - [(var, direct); (dps_var, dps)] + [mk_static_binding var direct; mk_static_binding dps_var dps] and traverse_list ctx terms = List.map (traverse ctx) terms diff --git a/lambda/translclass.ml b/lambda/translclass.ml index b3c5278a079..8db67e101b4 100644 --- a/lambda/translclass.ml +++ b/lambda/translclass.ml @@ -666,7 +666,7 @@ let free_methods l = | Lmutlet(_k, id, _arg, _body) -> fv := Ident.Set.remove id !fv | Lletrec(decl, _body) -> - List.iter (fun (id, _exp) -> fv := Ident.Set.remove id !fv) decl + List.iter (fun { id } -> fv := Ident.Set.remove id !fv) decl | Lstaticcatch(_e1, (_,vars), _e2) -> List.iter (fun (id, _) -> fv := Ident.Set.remove id !fv) vars | Ltrywith(_e1, exn, _e2) -> diff --git a/lambda/translcore.ml b/lambda/translcore.ml index 659a08ab8e3..e08e4a5c2ec 100644 --- a/lambda/translcore.ml +++ b/lambda/translcore.ml @@ -897,7 +897,8 @@ and transl_let ~scopes ?(in_structure=false) rec_flag pat_expr_list = let rec transl = function [] -> fun body -> body - | {vb_pat=pat; vb_expr=expr; vb_attributes=attr; vb_loc} :: rem -> + | {vb_pat=pat; vb_expr=expr; vb_rec_kind=_; vb_attributes=attr; vb_loc} + :: rem -> let lam = transl_bound_exp ~scopes ~in_structure pat expr in let lam = Translattribute.add_function_attributes lam vb_loc attr in let mk_body = transl rem in @@ -912,12 +913,13 @@ and transl_let ~scopes ?(in_structure=false) rec_flag pat_expr_list = | Tpat_alias ({pat_desc=Tpat_any}, id,_) -> id | _ -> assert false) pat_expr_list in - let transl_case {vb_expr=expr; vb_attributes; vb_loc; vb_pat} id = - let lam = transl_bound_exp ~scopes ~in_structure vb_pat expr in - let lam = - Translattribute.add_function_attributes lam vb_loc vb_attributes + let transl_case {vb_expr=expr; vb_attributes; vb_rec_kind = rkind; + vb_loc; vb_pat} id = + let def = transl_bound_exp ~scopes ~in_structure vb_pat expr in + let def = + Translattribute.add_function_attributes def vb_loc vb_attributes in - (id, lam) in + { id; rkind; def } in let lam_bds = List.map2 transl_case pat_expr_list idlist in fun body -> Lletrec(lam_bds, body) diff --git a/lambda/translmod.ml b/lambda/translmod.ml index bb39711885f..83e8b8cdd6e 100644 --- a/lambda/translmod.ml +++ b/lambda/translmod.ml @@ -425,7 +425,8 @@ let transl_class_bindings ~scopes cl_list = (ids, List.map (fun ({ci_id_class=id; ci_expr=cl; ci_virt=vf}, meths) -> - (id, transl_class ~scopes ids id meths cl vf)) + let def = transl_class ~scopes ids id meths cl vf in + { id; rkind = Static; def}) cl_list) (* Compile one or more functors, merging curried functors to produce diff --git a/middle_end/clambda.ml b/middle_end/clambda.ml index bea11899579..29edd251b8a 100644 --- a/middle_end/clambda.ml +++ b/middle_end/clambda.ml @@ -54,7 +54,11 @@ and ulambda = * ulambda * ulambda | Uphantom_let of Backend_var.With_provenance.t * uphantom_defining_expr option * ulambda - | Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda + | Uletrec of + (Backend_var.With_provenance.t * + Typedtree.recursive_binding_kind * + ulambda) list + * ulambda | Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t | Uswitch of ulambda * ulambda_switch * Debuginfo.t | Ustringswitch of ulambda * (string * ulambda) list * ulambda option diff --git a/middle_end/clambda.mli b/middle_end/clambda.mli index bc944148e5d..8b11f9217ed 100644 --- a/middle_end/clambda.mli +++ b/middle_end/clambda.mli @@ -65,7 +65,11 @@ and ulambda = * ulambda * ulambda | Uphantom_let of Backend_var.With_provenance.t * uphantom_defining_expr option * ulambda - | Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda + | Uletrec of + (Backend_var.With_provenance.t * + Typedtree.recursive_binding_kind * + ulambda) list + * ulambda | Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t | Uswitch of ulambda * ulambda_switch * Debuginfo.t | Ustringswitch of ulambda * (string * ulambda) list * ulambda option diff --git a/middle_end/closure/closure.ml b/middle_end/closure/closure.ml index 9d98ec334f8..87d0c144b1f 100644 --- a/middle_end/closure/closure.ml +++ b/middle_end/closure/closure.ml @@ -71,7 +71,7 @@ let occurs_var var u = | Ulet(_str, _kind, _id, def, body) -> occurs def || occurs body | Uphantom_let _ -> no_phantom_lets () | Uletrec(decls, body) -> - List.exists (fun (_id, u) -> occurs u) decls || occurs body + List.exists (fun (_id, _clas, u) -> occurs u) decls || occurs body | Uprim(_p, args, _) -> List.exists occurs args | Uswitch(arg, s, _dbg) -> occurs arg || @@ -576,18 +576,18 @@ let rec substitute loc ((backend, fpc) as st) sb rn ulam = | Uphantom_let _ -> no_phantom_lets () | Uletrec(bindings, body) -> let bindings1 = - List.map (fun (id, rhs) -> - (VP.var id, VP.rename id, rhs)) bindings + List.map (fun (id, clas, rhs) -> + (VP.var id, VP.rename id, clas, rhs)) bindings in let sb' = - List.fold_right (fun (id, id', _) s -> + List.fold_right (fun (id, id', _, _) s -> V.Map.add id (Uvar (VP.var id')) s) bindings1 sb in Uletrec( - List.map - (fun (_id, id', rhs) -> (id', substitute loc st sb' rn rhs)) - bindings1, + List.map (fun (_id, id', clas, rhs) -> + (id', clas, substitute loc st sb' rn rhs)) + bindings1, substitute loc st sb' rn body) | Uprim(p, args, dbg) -> let sargs = List.map (substitute loc st sb rn) args in @@ -1053,7 +1053,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam = (Ulet(Mutable, kind, VP.create id, ulam, ubody), abody) | Lletrec(defs, body) -> if List.for_all - (function (_id, Lfunction _) -> true | _ -> false) + (function { def = Lfunction _ } -> true | _ -> false) defs then begin (* Simple case: only function definitions *) @@ -1078,10 +1078,12 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam = (* General case: recursive definition of values *) let rec clos_defs = function [] -> ([], fenv) - | (id, lam) :: rem -> + | { id; rkind; def } :: rem -> let (udefs, fenv_body) = clos_defs rem in - let (ulam, approx) = close_named env id lam in - ((VP.create id, ulam) :: udefs, V.Map.add id approx fenv_body) in + let (ulam, approx) = close_named env id def in + ((VP.create id, rkind, ulam) :: udefs, + V.Map.add id approx fenv_body) + in let (udefs, fenv_body) = clos_defs defs in let (ubody, approx) = close { backend; fenv = fenv_body; cenv; mutable_vars } body in @@ -1257,12 +1259,13 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs = is forced. Cf #12526 *) match fun_defs with - | [_, Lfunction{attr = { inline = Always_inline; }}] -> + | [{ def = Lfunction{attr = { inline = Always_inline; }}}] -> fun_defs | _ -> List.concat_map (function - | (id, Lfunction{kind; params; return; body; attr; loc}) -> + | { id; rkind=_; + def = Lfunction{kind; params; return; body; attr; loc} } -> Simplif.split_default_wrapper ~id ~kind ~params ~body ~attr ~loc ~return | _ -> assert false @@ -1270,7 +1273,7 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs = fun_defs in let inline_attribute = match fun_defs with - | [_, Lfunction{attr = { inline; }}] -> inline + | [{ def = Lfunction{attr = { inline; }}}] -> inline | _ -> Default_inline (* recursive functions can't be inlined *) in (* Update and check nesting depth *) @@ -1286,7 +1289,8 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs = let uncurried_defs = List.map (function - (id, Lfunction{kind; params; return; body; loc; attr}) -> + { id; rkind=_; + def = Lfunction{kind; params; return; body; loc; attr} } -> let label = Compilenv.make_symbol (Some (V.unique_name id)) in let arity = List.length params in let fundesc = @@ -1298,7 +1302,7 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs = fun_poll = attr.poll } in let dbg = Debuginfo.from_location loc in (id, params, return, body, fundesc, dbg) - | (_, _) -> fatal_error "Closure.close_functions") + | _ -> fatal_error "Closure.close_functions") fun_defs in (* Build an approximate fenv for compiling the functions *) let fenv_rec = @@ -1423,7 +1427,7 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs = (* Same, for one non-recursive function *) and close_one_function env id funct = - match close_functions env [id, funct] with + match close_functions env [{ id; rkind = Static; def = funct }] with | (clos, (i, _, approx) :: _) when id = i -> (clos, approx) | _ -> fatal_error "Closure.close_one_function" @@ -1514,7 +1518,7 @@ let collect_exported_structured_constants a = | Uoffset(u, _) -> ulam u | Ulet (_str, _kind, _, u1, u2) -> ulam u1; ulam u2 | Uphantom_let _ -> no_phantom_lets () - | Uletrec (l, u) -> List.iter (fun (_, u) -> ulam u) l; ulam u + | Uletrec (l, u) -> List.iter (fun (_, _, u) -> ulam u) l; ulam u | Uprim (_, ul, _) -> List.iter ulam ul | Uswitch (u, sl, _dbg) -> ulam u; diff --git a/middle_end/flambda/build_export_info.ml b/middle_end/flambda/build_export_info.ml index a3cb96d2519..83080d752c7 100644 --- a/middle_end/flambda/build_export_info.ml +++ b/middle_end/flambda/build_export_info.ml @@ -240,7 +240,7 @@ let rec approx_of_expr (env : Env.t) (flam : Flambda.t) : Export_info.approx = approx_of_expr env body | Let_rec (defs, body) -> let env = - List.fold_left (fun env (var, defining_expr) -> + List.fold_left (fun env (var, _clas, defining_expr) -> let approx = descr_of_named env defining_expr in Env.add_approx env var approx) env defs diff --git a/middle_end/flambda/closure_conversion.ml b/middle_end/flambda/closure_conversion.ml index 4bfb622d9b6..24393745cd6 100644 --- a/middle_end/flambda/closure_conversion.ml +++ b/middle_end/flambda/closure_conversion.ml @@ -34,8 +34,9 @@ type t = { } let add_default_argument_wrappers lam = - let defs_are_all_functions (defs : (_ * Lambda.lambda) list) = - List.for_all (function (_, Lambda.Lfunction _) -> true | _ -> false) defs + let defs_are_all_functions (defs : Lambda.rec_binding list) = + List.for_all (function Lambda.{ def = Lfunction _ } -> true | _ -> false) + defs in let f (lam : Lambda.lambda) : Lambda.lambda = match lam with @@ -45,8 +46,10 @@ let add_default_argument_wrappers lam = Simplif.split_default_wrapper ~id ~kind ~params ~body:fbody ~return:Pgenval ~attr ~loc with - | [fun_id, def] -> Llet (Alias, Pgenval, fun_id, def, body) - | [fun_id, def; inner_fun_id, def_inner] -> + | [{ id = fun_id; rkind=_; def }] -> + Llet (Alias, Pgenval, fun_id, def, body) + | [{ id = fun_id;rkind=_; def }; + { id = inner_fun_id; rkind=_; def = def_inner }] -> Llet (Alias, Pgenval, inner_fun_id, def_inner, Llet (Alias, Pgenval, fun_id, def, body)) | _ -> assert false @@ -57,7 +60,8 @@ let add_default_argument_wrappers lam = List.flatten (List.map (function - | (id, Lambda.Lfunction {kind; params; body; attr; loc}) -> + | Lambda.{ id; rkind = _; + def = Lambda.Lfunction {kind; params; body; attr; loc} } -> Simplif.split_default_wrapper ~id ~kind ~params ~body ~return:Pgenval ~attr ~loc | _ -> assert false) @@ -246,7 +250,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = }))) | Lletrec (defs, body) -> let env = - List.fold_right (fun (id, _) env -> + List.fold_right (fun { Lambda.id } env -> Env.add_var env id (Variable.create_with_same_name_as_ident id)) defs env in @@ -254,8 +258,8 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = (* Identify any bindings in the [let rec] that are functions. These will be named after the corresponding identifier in the [let rec]. *) List.map (function - | (let_rec_ident, - Lambda.Lfunction { kind; params; body; attr; loc }) -> + | Lambda.{ id = let_rec_ident; rkind = _; + def = Lambda.Lfunction { kind; params; body; attr; loc }} -> let closure_bound_var = Variable.create_with_same_name_as_ident let_rec_ident in @@ -305,9 +309,10 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = expression; any functions bound by it will have their own individual closures. *) let defs = - List.map (fun (id, def) -> + List.map (fun Lambda.{ id; rkind; def } -> let var = Env.find_var env id in - var, close_let_bound_expression t ~let_rec_ident:id var env def) + var, rkind, + close_let_bound_expression t ~let_rec_ident:id var env def) defs in Let_rec (defs, close t env body) diff --git a/middle_end/flambda/effect_analysis.ml b/middle_end/flambda/effect_analysis.ml index 2ddba764bc5..98ff726767b 100644 --- a/middle_end/flambda/effect_analysis.ml +++ b/middle_end/flambda/effect_analysis.ml @@ -31,7 +31,7 @@ let rec no_effects (flam : Flambda.t) = | Let_mutable { body } -> no_effects body | Let_rec (defs, body) -> no_effects body - && List.for_all (fun (_, def) -> no_effects_named def) defs + && List.for_all (fun (_, _, def) -> no_effects_named def) defs | If_then_else (_, ifso, ifnot) -> no_effects ifso && no_effects ifnot | Switch (_, sw) -> let aux (_, flam) = no_effects flam in diff --git a/middle_end/flambda/flambda.ml b/middle_end/flambda/flambda.ml index 0d1a1f946ca..b8040a70fc2 100644 --- a/middle_end/flambda/flambda.ml +++ b/middle_end/flambda/flambda.ml @@ -60,7 +60,7 @@ type t = | Var of Variable.t | Let of let_expr | Let_mutable of let_mutable - | Let_rec of (Variable.t * named) list * t + | Let_rec of (Variable.t * Typedtree.recursive_binding_kind * named) list * t | Apply of apply | Send of send | Assign of assign @@ -255,9 +255,15 @@ let rec lam ppf (flam : t) = let bindings ppf id_arg_list = let spc = ref false in List.iter - (fun (id, l) -> + (fun (id, clas, l) -> if !spc then fprintf ppf "@ " else spc := true; - fprintf ppf "@[<2>%a@ %a@]" Variable.print id print_named l) + let clas_annot = + match (clas : Typedtree.recursive_binding_kind) with + | Static -> "" + | Not_recursive -> "[Nonrec]" + in + fprintf ppf "@[<2>%a%s@ %a@]" + Variable.print id clas_annot print_named l) id_arg_list in fprintf ppf "@[<2>(letrec@ (@[%a@])@ %a)@]" bindings id_arg_list lam body @@ -554,7 +560,7 @@ let rec variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument free_variable var; aux body | Let_rec (bindings, body) -> - List.iter (fun (var, defining_expr) -> + List.iter (fun (var, _clas, defining_expr) -> bound_variable var; free_variables (variables_usage_named ?ignore_uses_in_project_var @@ -777,7 +783,7 @@ let iter_general ~toplevel f f_named maybe_named = | Let_mutable { body; _ } -> aux body | Let_rec (defs, body) -> - List.iter (fun (_,l) -> aux_named l) defs; + List.iter (fun (_,_,l) -> aux_named l) defs; aux body | Try_with (f1,_,f2) | While (f1,f2) diff --git a/middle_end/flambda/flambda.mli b/middle_end/flambda/flambda.mli index d673ac49e51..f5074b088a2 100644 --- a/middle_end/flambda/flambda.mli +++ b/middle_end/flambda/flambda.mli @@ -93,7 +93,7 @@ type t = | Var of Variable.t | Let of let_expr | Let_mutable of let_mutable - | Let_rec of (Variable.t * named) list * t + | Let_rec of (Variable.t * Typedtree.recursive_binding_kind * named) list * t (** CR-someday lwhite: give Let_rec the same fields as Let. *) | Apply of apply | Send of send diff --git a/middle_end/flambda/flambda_invariants.ml b/middle_end/flambda/flambda_invariants.ml index 6c2b572d96f..21d54418aa8 100644 --- a/middle_end/flambda/flambda_invariants.ml +++ b/middle_end/flambda/flambda_invariants.ml @@ -162,12 +162,12 @@ let variable_and_symbol_invariants (program : Flambda.program) = loop (add_mutable_binding_occurrence env mut_var) body | Let_rec (defs, body) -> let env = - List.fold_left (fun env (var, def) -> + List.fold_left (fun env (var, _clas, def) -> will_traverse_named_expression_later def; add_binding_occurrence env var) env defs in - List.iter (fun (var, def) -> + List.iter (fun (var, _clas, def) -> already_added_bound_variable_to_env var; loop_named env def) defs; loop env body diff --git a/middle_end/flambda/flambda_iterators.ml b/middle_end/flambda/flambda_iterators.ml index 6edc4bba3b4..a892f0cd095 100644 --- a/middle_end/flambda/flambda_iterators.ml +++ b/middle_end/flambda/flambda_iterators.ml @@ -27,7 +27,7 @@ let apply_on_subexpressions f f_named (flam : Flambda.t) = | Let_mutable { body; _ } -> f body | Let_rec (defs, body) -> - List.iter (fun (_,l) -> f_named l) defs; + List.iter (fun (_,_,l) -> f_named l) defs; f body | Switch (_, sw) -> List.iter (fun (_,l) -> f l) sw.consts; @@ -74,6 +74,13 @@ let map_snd_sharing f ((a, b) as cpl) = else (a, new_b) +let map_rec_binding_sharing f ((v, clas, named) as binding) = + let new_named = f v named in + if named == new_named then + binding + else + (v, clas, new_named) + let map_subexpressions f f_named (tree:Flambda.t) : Flambda.t = match tree with | Var _ | Apply _ | Assign _ | Send _ | Proved_unreachable @@ -87,7 +94,7 @@ let map_subexpressions f f_named (tree:Flambda.t) : Flambda.t = Flambda.create_let var new_named new_body | Let_rec (defs, body) -> let new_defs = - list_map_sharing (map_snd_sharing f_named) defs + list_map_sharing (map_rec_binding_sharing f_named) defs in let new_body = f body in if new_defs == defs && new_body == body then @@ -179,7 +186,8 @@ let iter_named_toplevel f f_named named = let iter_all_immutable_let_and_let_rec_bindings t ~f = iter_expr (function | Let { var; defining_expr; _ } -> f var defining_expr - | Let_rec (defs, _) -> List.iter (fun (var, named) -> f var named) defs + | Let_rec (defs, _) -> + List.iter (fun (var, _clas, named) -> f var named) defs | _ -> ()) t @@ -187,7 +195,8 @@ let iter_all_toplevel_immutable_let_and_let_rec_bindings t ~f = iter_general ~toplevel:true (function | Let { var; defining_expr; _ } -> f var defining_expr - | Let_rec (defs, _) -> List.iter (fun (var, named) -> f var named) defs + | Let_rec (defs, _) -> + List.iter (fun (var, _clas, named) -> f var named) defs | _ -> ()) (fun _ -> ()) (Is_expr t) @@ -302,8 +311,8 @@ let map_general ~toplevel f f_named tree = | Let_rec (defs, body) -> let done_something = ref false in let defs = - List.map (fun (id, lam) -> - id, aux_named_done_something id lam done_something) + List.map (fun (id, clas, lam) -> + id, clas, aux_named_done_something id lam done_something) defs in let body = aux_done_something body done_something in diff --git a/middle_end/flambda/flambda_to_clambda.ml b/middle_end/flambda/flambda_to_clambda.ml index 70d0f72ee4c..0be0943a1b5 100644 --- a/middle_end/flambda/flambda_to_clambda.ml +++ b/middle_end/flambda/flambda_to_clambda.ml @@ -246,14 +246,14 @@ let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda = Ulet (Mutable, contents_kind, VP.create id, def, to_clambda t env_body body) | Let_rec (defs, body) -> let env, defs = - List.fold_right (fun (var, def) (env, defs) -> + List.fold_right (fun (var, clas, def) (env, defs) -> let id, env = Env.add_fresh_ident env var in - env, (id, var, def) :: defs) + env, (id, var, clas, def) :: defs) defs (env, []) in let defs = - List.map (fun (id, var, def) -> - VP.create id, to_clambda_named t env var def) + List.map (fun (id, var, clas, def) -> + VP.create id, clas, to_clambda_named t env var def) defs in Uletrec (defs, to_clambda t env body) diff --git a/middle_end/flambda/flambda_utils.ml b/middle_end/flambda/flambda_utils.ml index 01172ecb604..40a0f4997dd 100644 --- a/middle_end/flambda/flambda_utils.ml +++ b/middle_end/flambda/flambda_utils.ml @@ -221,8 +221,14 @@ and same_move_within_set_of_closures (m1 : Flambda.move_within_set_of_closures) && Closure_id.equal m1.start_from m2.start_from && Closure_id.equal m1.move_to m2.move_to -and samebinding (v1, n1) (v2, n2) = - Variable.equal v1 v2 && same_named n1 n2 +and samebinding (v1, clas1, n1) (v2, clas2, n2) = + let equal_clas c1 c2 = + match (c1 : Typedtree.recursive_binding_kind), + (c2 : Typedtree.recursive_binding_kind) with + | Not_recursive, Not_recursive | Static, Static -> true + | Not_recursive, Static | Static, Not_recursive -> false + in + Variable.equal v1 v2 && equal_clas clas1 clas2 && same_named n1 n2 and sameswitch (fs1 : Flambda.switch) (fs2 : Flambda.switch) = let samecase (n1, a1) (n2, a2) = n1 = n2 && same a1 a2 in @@ -638,7 +644,7 @@ let substitute_read_symbol_field_for_variables expr | Let_rec (defs, body) -> let free_variables_of_defs = - List.fold_left (fun set (_, named) -> + List.fold_left (fun set (_, _, named) -> Variable.Set.union set (Flambda.free_variables_named named)) Variable.Set.empty defs in @@ -654,8 +660,8 @@ let substitute_read_symbol_field_for_variables Variable.Map.of_set (fun var -> Variable.rename var) to_substitute in let defs = - List.map (fun (var, named) -> - var, substitute_named bindings named) + List.map (fun (var, clas, named) -> + var, clas, substitute_named bindings named) defs in let expr = diff --git a/middle_end/flambda/freshening.ml b/middle_end/flambda/freshening.ml index 78169bfcd8f..68f9483bc6f 100644 --- a/middle_end/flambda/freshening.ml +++ b/middle_end/flambda/freshening.ml @@ -158,6 +158,11 @@ let add_variables t defs = let id', t = add_variable t id in (id', data) :: defs, t) defs ([], t) +let add_variables3 t defs = + List.fold_right (fun (id, data1, data2) (defs, t) -> + let id', t = add_variable t id in + (id', data1, data2) :: defs, t) defs ([], t) + let add_variables' t ids = List.fold_right (fun id (ids, t) -> let id', t = add_variable t id in diff --git a/middle_end/flambda/freshening.mli b/middle_end/flambda/freshening.mli index 1550797ac1c..a45c2b98f49 100644 --- a/middle_end/flambda/freshening.mli +++ b/middle_end/flambda/freshening.mli @@ -62,6 +62,13 @@ val add_variables -> (Variable.t * 'a) list -> (Variable.t * 'a) list * t +(** Like [add_variables'], but passes through the other components of the + input list unchanged. *) +val add_variables3 + : t + -> (Variable.t * 'a * 'b) list + -> (Variable.t * 'a * 'b) list * t + (** Like [add_variable], but for mutable variables. *) val add_mutable_variable : t -> Mutable_variable.t -> Mutable_variable.t * t diff --git a/middle_end/flambda/inconstant_idents.ml b/middle_end/flambda/inconstant_idents.ml index 156a2fa70ff..2c802b8510a 100644 --- a/middle_end/flambda/inconstant_idents.ml +++ b/middle_end/flambda/inconstant_idents.ml @@ -236,7 +236,7 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct mark_var var curr; mark_loop ~toplevel curr body | Let_rec(defs, body) -> - List.iter (fun (var, def) -> + List.iter (fun (var, _clas, def) -> mark_named ~toplevel [Var var] def; (* adds 'var in NC => curr in NC' same remark as let case *) mark_var var curr) diff --git a/middle_end/flambda/inline_and_simplify.ml b/middle_end/flambda/inline_and_simplify.ml index c5c51bf8af0..f21b18dd196 100644 --- a/middle_end/flambda/inline_and_simplify.ml +++ b/middle_end/flambda/inline_and_simplify.ml @@ -1135,17 +1135,17 @@ and simplify env r (tree : Flambda.t) : Flambda.t * R.t = contents_kind }, r) | Let_rec (defs, body) -> - let defs, sb = Freshening.add_variables (E.freshening env) defs in + let defs, sb = Freshening.add_variables3 (E.freshening env) defs in let env = E.set_freshening env sb in let def_env = - List.fold_left (fun env_acc (id, _lam) -> + List.fold_left (fun env_acc (id, _clas, _lam) -> E.add env_acc id (A.value_unknown Other)) env defs in let defs, body_env, r = - List.fold_right (fun (id, lam) (defs, env_acc, r) -> + List.fold_right (fun (id, clas, lam) (defs, env_acc, r) -> let lam, r = simplify_named def_env r lam in - let defs = (id, lam) :: defs in + let defs = (id, clas, lam) :: defs in let env_acc = E.add env_acc id (R.approx r) in defs, env_acc, r) defs ([], env, r) diff --git a/middle_end/flambda/inlining_cost.ml b/middle_end/flambda/inlining_cost.ml index 1e503e3b671..3c61b62db47 100644 --- a/middle_end/flambda/inlining_cost.ml +++ b/middle_end/flambda/inlining_cost.ml @@ -86,7 +86,7 @@ let lambda_smaller' lam ~than:threshold = lambda_size body | Let_mutable { body } -> lambda_size body | Let_rec (bindings, body) -> - List.iter (fun (_, lam) -> lambda_named_size lam) bindings; + List.iter (fun (_, _, lam) -> lambda_named_size lam) bindings; lambda_size body | Switch (_, sw) -> let cost cases = diff --git a/middle_end/flambda/lift_code.ml b/middle_end/flambda/lift_code.ml index 3474b06ba56..40c1ef8cdaa 100644 --- a/middle_end/flambda/lift_code.ml +++ b/middle_end/flambda/lift_code.ml @@ -120,11 +120,15 @@ and lift_lets_named _var (named:Flambda.named) ~toplevel : Flambda.named = module Sort_lets = Strongly_connected_components.Make (Variable) -let rebuild_let_rec (defs:(Variable.t * Flambda.named) list) body = - let map = Variable.Map.of_list defs in +let rebuild_let_rec (defs:(Variable.t * _ * Flambda.named) list) body = + let map = + List.fold_left (fun map (var, clas, def) -> + Variable.Map.add var (clas, def) map) + Variable.Map.empty defs + in let graph = Variable.Map.map - (fun named -> + (fun (_clas, named) -> Variable.Set.filter (fun v -> Variable.Map.mem v map) (Flambda.free_variables_named named)) map @@ -135,11 +139,15 @@ let rebuild_let_rec (defs:(Variable.t * Flambda.named) list) body = Array.fold_left (fun body (component:Sort_lets.component) -> match component with | No_loop v -> - let def = Variable.Map.find v map in + let (_clas, def) = Variable.Map.find v map in Flambda.create_let v def body | Has_loop l -> Flambda.Let_rec - (List.map (fun v -> v, Variable.Map.find v map) l, + (List.map + (fun v -> + let clas, def = Variable.Map.find v map in + v, clas, def) + l, body)) body components diff --git a/middle_end/flambda/lift_let_to_initialize_symbol.ml b/middle_end/flambda/lift_let_to_initialize_symbol.ml index ccef0d8a1f3..cfec4092023 100644 --- a/middle_end/flambda/lift_let_to_initialize_symbol.ml +++ b/middle_end/flambda/lift_let_to_initialize_symbol.ml @@ -40,7 +40,7 @@ type accumulated = { let rec accumulate ~substitution ~copied_lets ~extracted_lets (expr : Flambda.t) = match expr with - | Let { var; body = Var var'; _ } | Let_rec ([var, _], Var var') + | Let { var; body = Var var'; _ } | Let_rec ([var, _, _], Var var') when Variable.equal var var' -> { copied_lets; extracted_lets; terminator = Flambda_utils.toplevel_substitution substitution expr; @@ -53,13 +53,14 @@ let rec accumulate ~substitution ~copied_lets ~extracted_lets when Variable.equal var var' && List.for_all (fun field -> - List.exists (fun (def_var, _) -> Variable.equal def_var field) defs) + List.exists (fun (def_var, _, _) -> + Variable.equal def_var field) defs) fields -> { copied_lets; extracted_lets; terminator = Flambda_utils.toplevel_substitution substitution expr; } | Let { var; defining_expr = Expr (Var alias); body; _ } - | Let_rec ([var, Expr (Var alias)], body) -> + | Let_rec ([var, _, Expr (Var alias)], body) -> let alias = match Variable.Map.find alias substitution with | exception Not_found -> alias @@ -71,7 +72,7 @@ let rec accumulate ~substitution ~copied_lets ~extracted_lets ~extracted_lets body | Let { var; defining_expr = named; body; _ } - | Let_rec ([var, named], body) + | Let_rec ([var, _, named], body) when should_copy named -> accumulate body ~substitution @@ -101,12 +102,12 @@ let rec accumulate ~substitution ~copied_lets ~extracted_lets ~substitution ~copied_lets ~extracted_lets:(extracted::extracted_lets) - | Let_rec ([var, named], body) -> + | Let_rec ([var, clas, named], body) -> let renamed = Variable.rename var in let def_substitution = Variable.Map.add var renamed substitution in let expr = Flambda_utils.toplevel_substitution def_substitution - (Let_rec ([renamed, named], Var renamed)) + (Let_rec ([renamed, clas, named], Var renamed)) in let extracted = Expr (var, expr) in accumulate body @@ -115,23 +116,24 @@ let rec accumulate ~substitution ~copied_lets ~extracted_lets ~extracted_lets:(extracted::extracted_lets) | Let_rec (defs, body) -> let renamed_defs, def_substitution = - List.fold_right (fun (var, def) (acc, substitution) -> + List.fold_right (fun (var, clas, def) (acc, substitution) -> let new_var = Variable.rename var in - (new_var, def) :: acc, + (new_var, clas, def) :: acc, Variable.Map.add var new_var substitution) defs ([], substitution) in let extracted = + let fst3 (v, _, _) = v in let expr = let name = Internal_variable_names.lifted_let_rec_block in Flambda_utils.toplevel_substitution def_substitution (Let_rec (renamed_defs, Flambda_utils.name_expr ~name (Prim (Pmakeblock (0, Immutable, None), - List.map fst renamed_defs, + List.map fst3 renamed_defs, Debuginfo.none)))) in - Exprs (List.map fst defs, expr) + Exprs (List.map fst3 defs, expr) in accumulate body ~substitution diff --git a/middle_end/flambda/ref_to_variables.ml b/middle_end/flambda/ref_to_variables.ml index 746374e8852..1cbcffec8d4 100644 --- a/middle_end/flambda/ref_to_variables.ml +++ b/middle_end/flambda/ref_to_variables.ml @@ -45,7 +45,7 @@ let variables_not_used_as_local_reference (tree:Flambda.t) = loop_named defining_expr; loop body | Let_rec (defs, body) -> - List.iter (fun (_var, named) -> loop_named named) defs; + List.iter (fun (_var, _clas, named) -> loop_named named) defs; loop body | Var v -> set := Variable.Set.add v !set diff --git a/middle_end/flambda/un_anf.ml b/middle_end/flambda/un_anf.ml index 33f0a140a5a..d69c161819e 100644 --- a/middle_end/flambda/un_anf.ml +++ b/middle_end/flambda/un_anf.ml @@ -57,6 +57,7 @@ let ignore_params_with_value_kind (_ : (VP.t * Lambda.value_kind) list) = () let ignore_direction_flag (_ : Asttypes.direction_flag) = () let ignore_meth_kind (_ : Lambda.meth_kind) = () let ignore_value_kind (_ : Lambda.value_kind) = () +let ignore_rec_classification (_ : Typedtree.recursive_binding_kind) = () (* CR-soon mshinwell: check we aren't traversing function bodies more than once (need to analyse exactly what the calls are from Cmmgen into this @@ -167,8 +168,9 @@ let make_var_info (clam : Clambda.ulambda) : var_info = ignore_uphantom_defining_expr_option defining_expr_opt; loop ~depth body | Uletrec (defs, body) -> - List.iter (fun (var, def) -> + List.iter (fun (var, clas, def) -> ignore_var_with_provenance var; + ignore_rec_classification clas; loop ~depth def) defs; loop ~depth body @@ -352,8 +354,9 @@ let let_bound_vars_that_can_be_moved var_info (clam : Clambda.ulambda) = (* Evaluation order for [defs] is not defined, and this case probably isn't important for [Cmmgen] anyway. *) let_stack := []; - List.iter (fun (var, def) -> + List.iter (fun (var, clas, def) -> ignore_var_with_provenance var; + ignore_rec_classification clas; loop def; let_stack := []) defs; @@ -517,8 +520,8 @@ let rec substitute_let_moveable is_let_moveable env (clam : Clambda.ulambda) Uphantom_let (var, defining_expr, body) | Uletrec (defs, body) -> let defs = - List.map (fun (var, def) -> - var, substitute_let_moveable is_let_moveable env def) + List.map (fun (var, clas, def) -> + var, clas, substitute_let_moveable is_let_moveable env def) defs in let body = substitute_let_moveable is_let_moveable env body in @@ -743,7 +746,7 @@ let rec un_anf_and_moveable var_info env (clam : Clambda.ulambda) Uphantom_let (var, defining_expr, body), body_moveable | Uletrec (defs, body) -> let defs = - List.map (fun (var, def) -> var, un_anf var_info env def) defs + List.map (fun (var, clas, def) -> var, clas, un_anf var_info env def) defs in let body = un_anf var_info env body in Uletrec (defs, body), Fixed diff --git a/middle_end/printclambda.ml b/middle_end/printclambda.ml index 3b8ffab0966..2d5897c2d59 100644 --- a/middle_end/printclambda.ml +++ b/middle_end/printclambda.ml @@ -145,10 +145,16 @@ and lam ppf = function let bindings ppf id_arg_list = let spc = ref false in List.iter - (fun (id, l) -> + (fun (id, clas, l) -> if !spc then fprintf ppf "@ " else spc := true; - fprintf ppf "@[<2>%a@ %a@]" + let clas_annot = + match (clas : Typedtree.recursive_binding_kind) with + | Static -> "" + | Not_recursive -> "[Nonrec]" + in + fprintf ppf "@[<2>%a%s@ %a@]" VP.print id + clas_annot lam l) id_arg_list in fprintf ppf diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index cbd856dd752..59d4428edd0 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -112,6 +112,7 @@ COMPILERLIBS_SOURCES=\ file_formats/cmi_format.ml \ typing/persistent_env.ml \ typing/env.ml \ + typing/typedtree.ml \ lambda/debuginfo.ml \ lambda/lambda.ml \ lambda/runtimedef.ml \ diff --git a/toplevel/native/topeval.ml b/toplevel/native/topeval.ml index 7cc0a896de3..241849bd607 100644 --- a/toplevel/native/topeval.ml +++ b/toplevel/native/topeval.ml @@ -139,6 +139,7 @@ let name_expression ~loc ~attrs exp = let vb = { vb_pat = pat; vb_expr = exp; + vb_rec_kind = Not_recursive; vb_attributes = attrs; vb_loc = loc; } in diff --git a/typing/rec_check.ml b/typing/rec_check.ml index 7ba0a510a33..c03eec4d596 100644 --- a/typing/rec_check.ml +++ b/typing/rec_check.ml @@ -110,7 +110,7 @@ exception Illegal_expr (** {1 Static or dynamic size} *) -type sd = Static | Dynamic +type sd = Typedtree.recursive_binding_kind let is_ref : Types.value_description -> bool = function | { Types.val_kind = @@ -146,7 +146,7 @@ let classify_expression : Typedtree.expression -> sd = 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 = match e.exp_desc with + 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 @@ -179,7 +179,7 @@ let classify_expression : Typedtree.expression -> sd = when List.exists is_abstracted_arg args -> Static | Texp_apply _ -> - Dynamic + Not_recursive | Texp_for _ | Texp_constant _ @@ -207,7 +207,7 @@ let classify_expression : Typedtree.expression -> sd = | Texp_try _ | Texp_override _ | Texp_letop _ -> - Dynamic + Not_recursive and classify_value_bindings rec_flag env bindings = (* We use a non-recursive classification, classifying each binding with respect to the old environment @@ -247,17 +247,17 @@ let classify_expression : Typedtree.expression -> sd = 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 Dynamic. + under-approximate with Not_recursive. This could be fixed by a more complete implementation. *) - Dynamic + Not_recursive 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 + Not_recursive in classify_expression Ident.empty @@ -1275,21 +1275,23 @@ and is_destructuring_pattern : type k . k general_pattern -> bool = | Tpat_or (l,r,_) -> is_destructuring_pattern l || is_destructuring_pattern r -let is_valid_recursive_expression idlist expr = +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 *) - true + Some Static | _ -> match classify_expression expr with | Static -> (* The expression has known size *) let ty = expression expr Return in - Env.unguarded ty idlist = [] - | Dynamic -> + if Env.unguarded ty idlist = [] then Some Static else None + | Not_recursive -> (* The expression has unknown size *) let ty = expression expr Return in - Env.unguarded ty idlist = [] && Env.dependent ty idlist = [] + if Env.unguarded ty idlist = [] && Env.dependent ty idlist = [] + then Some Not_recursive + else None (* A class declaration may contain let-bindings. If they are recursive, their validity will already be checked by [is_valid_recursive_expression] diff --git a/typing/rec_check.mli b/typing/rec_check.mli index aa5c1ca3c1a..d749c6bba50 100644 --- a/typing/rec_check.mli +++ b/typing/rec_check.mli @@ -14,6 +14,9 @@ exception Illegal_expr -val is_valid_recursive_expression : Ident.t list -> Typedtree.expression -> bool +val is_valid_recursive_expression : + Ident.t list -> + Typedtree.expression -> + Typedtree.recursive_binding_kind option val is_valid_class_expr : Ident.t list -> Typedtree.class_expr -> bool diff --git a/typing/tast_mapper.ml b/typing/tast_mapper.ml index 791f2582238..f8ad6834b9d 100644 --- a/typing/tast_mapper.ml +++ b/typing/tast_mapper.ml @@ -854,7 +854,8 @@ let value_binding sub x = 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 - {vb_loc; vb_pat; vb_expr; vb_attributes} + 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 diff --git a/typing/typeclass.ml b/typing/typeclass.ml index bbc2e6b5dd8..42920e4b293 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -1342,8 +1342,9 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl = ([], met_env) in let cl = class_expr cl_num val_env met_env virt self_scope scl' in - let () = if rec_flag = Recursive then - check_recursive_bindings val_env defs + 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; diff --git a/typing/typecore.ml b/typing/typecore.ml index 1eb9dab22a2..c927145f32d 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -2605,13 +2605,15 @@ and is_nonexpansive_opt = function let maybe_expansive e = not (is_nonexpansive e) -let check_recursive_bindings env valbinds = +let annotate_recursive_bindings env valbinds = let ids = let_bound_idents valbinds in - List.iter - (fun {vb_expr} -> - if not (Rec_check.is_valid_recursive_expression ids vb_expr) then + List.map + (fun {vb_pat; vb_expr; vb_rec_kind = _; vb_attributes; vb_loc} -> + match (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 = @@ -3311,9 +3313,9 @@ and type_expect_ allow_modules in let body = type_expect new_env sbody ty_expected_explained in - let () = - if rec_flag = Recursive then - check_recursive_bindings env pat_exp_list + 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. @@ -5154,7 +5156,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected = 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_loc=Location.none; vb_rec_kind = Not_recursive; }], func let_var) } end @@ -5966,8 +5968,9 @@ and type_let ?check ?check_strict 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_loc=pvb.pvb_loc; vb_rec_kind = Not_recursive; }) l spat_sexp_list in diff --git a/typing/typecore.mli b/typing/typecore.mli index 88f85de9bd0..4f2bff38cec 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -256,6 +256,7 @@ val type_package: val constant: Parsetree.constant -> (Asttypes.constant, error) result -val check_recursive_bindings : Env.t -> Typedtree.value_binding list -> unit +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/typing/typedtree.ml b/typing/typedtree.ml index eec3e2605c3..d0df9da8e31 100644 --- a/typing/typedtree.ml +++ b/typing/typedtree.ml @@ -32,6 +32,10 @@ type _ pattern_category = | Value : value pattern_category | Computation : computation pattern_category +type recursive_binding_kind = +| Not_recursive +| Static + type pattern = value general_pattern and 'k general_pattern = 'k pattern_desc pattern_data @@ -323,6 +327,7 @@ and value_binding = { vb_pat: pattern; vb_expr: expression; + vb_rec_kind: recursive_binding_kind; vb_attributes: attributes; vb_loc: Location.t; } diff --git a/typing/typedtree.mli b/typing/typedtree.mli index 11e400e1b96..5309741026c 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -41,6 +41,10 @@ type _ pattern_category = | Value : value pattern_category | Computation : computation pattern_category +type recursive_binding_kind = +| Not_recursive +| Static + type pattern = value general_pattern and 'k general_pattern = 'k pattern_desc pattern_data @@ -489,6 +493,7 @@ and value_binding = { vb_pat: pattern; vb_expr: expression; + vb_rec_kind: recursive_binding_kind; vb_attributes: attributes; vb_loc: Location.t; } diff --git a/typing/typemod.ml b/typing/typemod.ml index 433945673f4..84e8f85b512 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -2509,8 +2509,9 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr = | Pstr_value(rec_flag, sdefs) -> let (defs, newenv) = Typecore.type_binding env rec_flag sdefs in - let () = if rec_flag = Recursive then - Typecore.check_recursive_bindings env defs + 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. *) From 8711fcd389676e129769abfcad9b103192bb5c6a Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 14 Sep 2023 16:15:23 +0200 Subject: [PATCH 112/402] Improve major slice trigger No change entry needed --- runtime/caml/domain.h | 2 +- runtime/domain.c | 28 ++++------------------------ runtime/signals.c | 2 +- 3 files changed, 6 insertions(+), 26 deletions(-) diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h index ea21d10a4ab..54251984273 100644 --- a/runtime/caml/domain.h +++ b/runtime/caml/domain.h @@ -66,7 +66,7 @@ void caml_handle_gc_interrupt(void); void caml_handle_incoming_interrupts(void); CAMLextern void caml_interrupt_self(void); -void caml_interrupt_all_for_signal(void); +void caml_interrupt_all_signal_safe(void); void caml_reset_young_limit(caml_domain_state *); void caml_update_young_limit_after_c_call(caml_domain_state *); diff --git a/runtime/domain.c b/runtime/domain.c index 08d26bf39a3..a65a61e428b 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -143,7 +143,7 @@ typedef cpuset_t cpu_set_t; /* control of STW interrupts */ struct interruptor { /* The outermost atomic is for synchronization with - caml_interrupt_all_for_signal. The innermost atomic is also for + caml_interrupt_all_signal_safe. The innermost atomic is also for cross-domain communication.*/ _Atomic(atomic_uintnat *) interrupt_word; caml_plat_mutex lock; @@ -596,7 +596,7 @@ static void domain_create(uintnat initial_minor_heap_wsize) { caml_state = domain_state; domain_state->young_limit = 0; - /* Synchronized with [caml_interrupt_all_for_signal], so that the + /* Synchronized with [caml_interrupt_all_signal_safe], so that the initializing write of young_limit happens before any interrupt. */ atomic_store_explicit(&s->interrupt_word, &domain_state->young_limit, @@ -1581,7 +1581,7 @@ void caml_interrupt_self(void) } /* async-signal-safe */ -void caml_interrupt_all_for_signal(void) +void caml_interrupt_all_signal_safe(void) { for (dom_internal *d = all_domains; d < &all_domains[Max_domains]; d++) { /* [all_domains] is an array of values. So we can access @@ -1646,27 +1646,7 @@ Caml_inline void advance_global_major_slice_epoch (caml_domain_state* d) if (old_value != atomic_load (&caml_minor_collections_count)) { /* This domain is the first one to use up half of its minor heap arena in this minor cycle. Trigger major slice on other domains. */ - if (caml_plat_try_lock(&all_domains_lock)) { - /* Note that this interrupt is best-effort. If we get the lock, - then interrupt all the domains. If not, either some other domain - is calling for a stop-the-world section interrupting all the - domains, or a domain is being created or terminated. All of these - actions also try to lock [all_domains_lock] mutex, and the above - lock acquisition may fail. - - If we don't get the lock, we don't interrupt other domains. This is - acceptable since it does not affect safety but only liveness -- the - speed of the major gc. The other domains may themselves fill half of - their minor heap triggering a major slice, or will certainly do a - major slice right after their next minor GC when they observe that - their domain-local [Caml_state->major_slice_epoch] is less than the - global one [caml_major_slice_epoch]. */ - for(int i = 0; i < stw_domains.participating_domains; i++) { - dom_internal * di = stw_domains.domains[i]; - if (di->state != d) interrupt_domain(&di->interruptor); - } - caml_plat_unlock (&all_domains_lock); - } + caml_interrupt_all_signal_safe(); } } diff --git a/runtime/signals.c b/runtime/signals.c index ce6913dae10..81c3ecccad5 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -137,7 +137,7 @@ CAMLexport void caml_record_signal(int signal_number) - Ctrl-C in the toplevel when domain 0 is stuck inside [Domain.join]. - a thread that has just spawned, before the appropriate mask is set. */ - caml_interrupt_all_for_signal(); + caml_interrupt_all_signal_safe(); } /* Management of blocking sections. */ From 7da351b7980f2880ca4763c624a4e932222a34ed Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Thu, 14 Sep 2023 16:15:46 +0200 Subject: [PATCH 113/402] [minor] Minor clean-ups --- runtime/domain.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/runtime/domain.c b/runtime/domain.c index a65a61e428b..c77fdf90527 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -1577,7 +1577,7 @@ int caml_try_run_on_all_domains_async( void caml_interrupt_self(void) { - interrupt_domain(&domain_self->interruptor); + interrupt_domain_local(Caml_state); } /* async-signal-safe */ @@ -1588,8 +1588,7 @@ void caml_interrupt_all_signal_safe(void) [interrupt_word] directly without synchronisation other than with other people who access the same [interrupt_word].*/ atomic_uintnat * interrupt_word = - atomic_load_explicit(&d->interruptor.interrupt_word, - memory_order_acquire); + atomic_load_acquire(&d->interruptor.interrupt_word); /* Early exit: if the current domain was never initialized, then neither have been any of the remaining ones. */ if (interrupt_word == NULL) return; From 8eb94b89a32efc3cfcd0e8d05fdda4c12ae35360 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 25 Sep 2023 22:31:31 +0200 Subject: [PATCH 114/402] system-wide user .gitignore configuration should go in XDG_CONFIG_HOME/git/ignore --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index cb62271a829..fe97b1e3588 100644 --- a/.gitignore +++ b/.gitignore @@ -38,7 +38,6 @@ _ocamltestd .merlin _build META -.vscode # local to root directory From 72997bb8e0b776aa354a381a6c1d2933e4f67e69 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 26 Sep 2023 13:49:52 +0200 Subject: [PATCH 115/402] [minor] Ctype: act on TODO --- typing/ctype.ml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/typing/ctype.ml b/typing/ctype.ml index cd9da31deb8..00be1e3eec4 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1938,14 +1938,12 @@ let local_non_recursive_abbrev uenv p ty = (* Since we cannot duplicate universal variables, unification must be done at meta-level, using bindings in univar_pairs *) -(* TODO: use find_opt *) let rec unify_univar t1 t2 = function (cl1, cl2) :: rem -> let find_univ t cl = - try - let (_, r) = List.find (fun (t',_) -> eq_type t t') cl in - Some r - with Not_found -> None + 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 -> From e3c59ebd906c61e70e69343d1998090940c822a7 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 26 Sep 2023 14:51:24 +0200 Subject: [PATCH 116/402] asmcomp/*/emit.mlp: use tabs in generated asm where appropriate (#12607) We try to stick to the format `opcodearguments`. --- asmcomp/arm64/emit.mlp | 4 ++-- asmcomp/power/emit.mlp | 16 +++++++-------- asmcomp/riscv/emit.mlp | 12 +++++------ asmcomp/s390x/emit.mlp | 46 +++++++++++++++++++++--------------------- 4 files changed, 39 insertions(+), 39 deletions(-) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 630ff9eaff3..1dbb4b2b1ea 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -898,10 +898,10 @@ let emit_instr env i = ` smulh {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` | Lop(Iintop op) -> let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` | Lop(Iintop_imm(op, n)) -> let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n` + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n` | Lop(Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf as op) -> let instr = (match op with | Ifloatofint -> "scvtf" diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index d1ba127e899..08bac76ac88 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -492,7 +492,7 @@ let emit_alloc env i bytes dbginfo far = if env.call_gc_label = 0 then env.call_gc_label <- new_label (); let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in ` ld 0, {emit_int offset}(30)\n`; - ` addi 31, 31, {emit_int(-bytes)}\n`; + ` addi 31, 31, {emit_int(-bytes)}\n`; ` cmpld 31, 0\n`; if not far then begin ` bltl- {emit_label env.call_gc_label}\n`; @@ -520,9 +520,9 @@ let emit_poll env i return_label far = end | Some return_label -> begin - ` bltl- {emit_label env.call_gc_label}\n`; + ` bltl- {emit_label env.call_gc_label}\n`; record_frame env i.live (Dbg_alloc []); - ` b {emit_label return_label}\n` + ` b {emit_label return_label}\n` end end; end else begin @@ -530,10 +530,10 @@ let emit_poll env i return_label far = ` bge+ {emit_label lbl}\n`; ` bl {emit_label env.call_gc_label}\n`; record_frame env i.live (Dbg_alloc []); - ` {emit_label lbl}: \n`; + `{emit_label lbl}: \n`; match return_label with | None -> () - | Some return_label -> ` b {emit_label return_label}\n` + | Some return_label -> ` b {emit_label return_label}\n` end let bound_error_label env dbg = @@ -838,7 +838,7 @@ let emit_instr env i = ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` | Lop (Idls_get) -> let offset = Domainstate.(idx_of_field Domain_dls_root) * 8 in - ` ld {emit_reg i.res.(0)}, {emit_int offset}(30)\n` + ` ld {emit_reg i.res.(0)}, {emit_int offset}(30)\n` | Lop (Ireturn_addr) -> invalid_arg ( "Support for Ireturn_addr is not implemented on architecture " @@ -925,7 +925,7 @@ let emit_instr env i = adjust_stack_offset env trap_size; ` std 29, {emit_int reserved_stack_space}(1)\n`; emit_tocload emit_gpr 29 (TocLabel lbl_handler); - ` std 29, {emit_int (reserved_stack_space + 8)}(1)\n`; + ` std 29, {emit_int (reserved_stack_space + 8)}(1)\n`; ` addi 29, 1, {emit_int reserved_stack_space}\n` | Lpoptrap -> ` ld 29, {emit_int reserved_stack_space}(1)\n`; @@ -944,7 +944,7 @@ let emit_instr env i = | Lambda.Raise_notrace -> ` ld 0, 8(29)\n`; ` addi 1, 29, {emit_int (trap_size - reserved_stack_space)}\n`; - ` mtctr 0\n`; + ` mtctr 0\n`; ` ld 29, {emit_int (reserved_stack_space - trap_size)}(1)\n`; ` bctr\n` end diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp index 01d4b5d7178..545e7013705 100644 --- a/asmcomp/riscv/emit.mlp +++ b/asmcomp/riscv/emit.mlp @@ -99,10 +99,10 @@ let emit_reg r = let emit_stack_adjustment n = if n <> 0 then begin if is_immediate n then - ` addi sp, sp, {emit_int n}\n` + ` addi sp, sp, {emit_int n}\n` else begin - ` li {emit_reg reg_tmp}, {emit_int n}\n`; - ` add sp, sp, {emit_reg reg_tmp}\n` + ` li {emit_reg reg_tmp}, {emit_int n}\n`; + ` add sp, sp, {emit_reg reg_tmp}\n` end; cfi_adjust_cfa_offset (-n) end @@ -274,7 +274,7 @@ let emit_instr env i = if src.loc <> dst.loc then begin match (src, dst) with | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} -> - ` mv {emit_reg dst}, {emit_reg src}\n` + ` mv {emit_reg dst}, {emit_reg src}\n` | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} -> ` fmv.d {emit_reg dst}, {emit_reg src}\n` | {loc = Reg _; typ = Float}, {loc = Reg _; typ = (Val | Int | Addr)} -> @@ -431,8 +431,8 @@ let emit_instr env i = begin match return_label with | None -> ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`; `{emit_label lbl_after_poll}:\n`; - | Some lbl -> ` bgeu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl}\n`; - ` j {emit_label lbl_call_gc}\n` + | Some lbl -> ` bgeu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl}\n`; + ` j {emit_label lbl_call_gc}\n` end; env.call_gc_sites <- { gc_lbl = lbl_call_gc; diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index e72f2ba97da..dae5920fe60 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -367,8 +367,8 @@ let emit_instr env i = | Lop(Iextcall {func; alloc; stack_ofs}) -> if stack_ofs > 0 then begin - ` lgr {emit_reg reg_stack_arg_begin}, %r15\n`; - ` lay {emit_reg reg_stack_arg_end}, {emit_int stack_ofs}(%r15)\n`; + ` lgr {emit_reg reg_stack_arg_begin}, %r15\n`; + ` lay {emit_reg reg_stack_arg_end}, {emit_int stack_ofs}(%r15)\n`; emit_load_symbol_addr reg_r7 func; emit_call "caml_c_call_stack_args"; `{record_frame env i.live (Dbg_other i.dbg)}\n` @@ -378,16 +378,16 @@ let emit_instr env i = `{record_frame env i.live (Dbg_other i.dbg)}\n` end else begin (* Save OCaml SP in C callee-save register *) - ` lgr %r12, %r15\n`; + ` lgr %r12, %r15\n`; cfi_remember_state (); cfi_def_cfa_register "%r12"; (* NB: gdb has asserts on contiguous stacks that mean it will not unwind through this unless we were to tag this calling frame with cfi_signal_frame in it's definition. *) let offset = Domainstate.(idx_of_field Domain_c_stack) * 8 in - ` lg %r15, {emit_int offset}(%r10)\n`; + ` lg %r15, {emit_int offset}(%r10)\n`; emit_call func; - ` lgr %r15, %r12\n`; + ` lgr %r15, %r12\n`; cfi_restore_state () end @@ -431,11 +431,11 @@ let emit_instr env i = let lbl_after_alloc = new_label () in let lbl_call_gc = new_label () in let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in - ` lay %r11, {emit_int(-n)}(%r11)\n`; + ` lay %r11, {emit_int(-n)}(%r11)\n`; ` clg %r11, {emit_int offset}(%r10)\n`; - ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *) + ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *) `{emit_label lbl_after_alloc}:`; - ` la {emit_reg i.res.(0)}, 8(%r11)\n`; + ` la {emit_reg i.res.(0)}, 8(%r11)\n`; env.call_gc_sites <- { gc_lbl = lbl_call_gc; gc_return_lbl = lbl_after_alloc; @@ -446,11 +446,11 @@ let emit_instr env i = | 24 -> ` {emit_call "caml_alloc2"}\n` | 32 -> ` {emit_call "caml_alloc3"}\n` | _ -> - ` lay %r11, {emit_int(-n)}(%r11)\n`; + ` lay %r11, {emit_int(-n)}(%r11)\n`; ` {emit_call "caml_allocN"}\n` end; `{emit_label lbl_frame_lbl}:\n`; - ` la {emit_reg i.res.(0)}, 8(%r11)\n` + ` la {emit_reg i.res.(0)}, 8(%r11)\n` end | Lop(Ipoll { return_label }) -> @@ -464,8 +464,8 @@ let emit_instr env i = record_frame_label env i.live (Dbg_alloc []) in begin match return_label with - | None -> ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *) - | Some return_label -> ` brcl 10, {emit_label return_label}\n`; (* greater or equal *) + | None -> ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *) + | Some return_label -> ` brcl 10, {emit_label return_label}\n`; (* greater or equal *) end; env.call_gc_sites <- { gc_lbl = lbl_call_gc; @@ -473,7 +473,7 @@ let emit_instr env i = gc_frame_lbl = lbl_frame; } :: env.call_gc_sites; begin match return_label with | None -> `{emit_label label_after_gc}:`; - | Some _ -> ` brcl 15, {emit_label lbl_call_gc}\n`; (* unconditional *) + | Some _ -> ` brcl 15, {emit_label lbl_call_gc}\n`; (* unconditional *) end | Lop(Iintop Imulh) -> (* Hacker's Delight section 8.3: @@ -731,9 +731,9 @@ let fundecl fundecl = let threshold_offset = Domainstate.stack_ctx_words * 8 + stack_threshold_size in let f = max_frame_size + threshold_offset in let offset = Domainstate.(idx_of_field Domain_current_stack) * 8 in - ` lay %r1, {emit_int (-f)}(%r15)\n`; - ` clg %r1, {emit_int offset}(%r10)\n`; - ` brcl 4, {emit_label overflow}\n`; + ` lay %r1, {emit_int (-f)}(%r15)\n`; + ` clg %r1, {emit_int offset}(%r10)\n`; + ` brcl 4, {emit_label overflow}\n`; `{emit_label ret}:\n`; handle_overflow := Some (overflow, ret); end; @@ -749,13 +749,13 @@ let fundecl fundecl = | Some (overflow,ret) -> begin `{emit_label overflow}:\n`; let s = (Config.stack_threshold + max_frame_size / 8) in - ` lay %r15, -8(%r15)\n`; - ` stg %r14, 0(%r15)\n`; - ` lgfi %r12, {emit_int s}\n`; - ` brasl %r14, {emit_symbol "caml_call_realloc_stack"}\n`; - ` lg %r14, 0(%r15)\n`; - ` la %r15, 8(%r15)\n`; - ` brcl 15, {emit_label ret}\n` + ` lay %r15, -8(%r15)\n`; + ` stg %r14, 0(%r15)\n`; + ` lgfi %r12, {emit_int s}\n`; + ` brasl %r14, {emit_symbol "caml_call_realloc_stack"}\n`; + ` lg %r14, 0(%r15)\n`; + ` la %r15, 8(%r15)\n`; + ` brcl 15, {emit_label ret}\n` end end; From 5b8651ba254bf382d588b10faad3b47ceb0f3575 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 26 Sep 2023 15:57:46 +0200 Subject: [PATCH 117/402] Implement leaf functions on POWER (#12601) Previously, a stack frame was always allocated and the return address always saved in the stack frame. This is not necessary if the function is a leaf function (no calls to other functions) and has no stack-allocated variables. --- Changes | 5 +++-- asmcomp/power/emit.mlp | 15 +++++++-------- asmcomp/power/stackframe.ml | 2 -- 3 files changed, 10 insertions(+), 12 deletions(-) diff --git a/Changes b/Changes index cee71a4b03e..246e73f591a 100644 --- a/Changes +++ b/Changes @@ -3,8 +3,9 @@ Working version ### Restored backends: -- #12276: native-code compilation for POWER (64 bits, little-endian) - (Xavier Leroy, review by KC Sivaramakrishnan and Anil Madhavapeddy) +- #12276, #12601: native-code compilation for POWER (64 bits, little-endian) + (Xavier Leroy, review by KC Sivaramakrishnan, Anil Madhavapeddy, + and Stephen Dolan) ### Language features: diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 08bac76ac88..9d758293384 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -31,9 +31,12 @@ let reserved_stack_space = 32 (* Layout of the stack. The stack is kept 16-aligned. *) let initial_stack_offset f = - reserved_stack_space + (* Including the return address *) - size_int * f.fun_num_stack_slots.(0) + (* Local int variables *) - size_float * f.fun_num_stack_slots.(1) (* Local float variables *) + if f.fun_frame_required then + reserved_stack_space + (* Including the return address *) + size_int * f.fun_num_stack_slots.(0) + (* Local int variables *) + size_float * f.fun_num_stack_slots.(1) (* Local float variables *) + else + 0 let frame_size env = let size = @@ -375,12 +378,8 @@ module BR = Branch_relaxation.Make (struct let offset_pc_at_branch = 1 - let profiling_prologue_size = 6 - let prologue_size f = - profiling_prologue_size - + (if initial_stack_offset f > 0 then 1 else 0) - + (if f.fun_frame_required then 3 else 0) + if f.fun_frame_required then 4 else 0 let tocload_size = 2 diff --git a/asmcomp/power/stackframe.ml b/asmcomp/power/stackframe.ml index 0d7398e4cf6..d165a2078cf 100644 --- a/asmcomp/power/stackframe.ml +++ b/asmcomp/power/stackframe.ml @@ -24,8 +24,6 @@ class stackframe = object inherit Stackframegen.stackframe_generic -method! frame_required _f _contains_calls = true - method trap_handler_size = trap_handler_size end From 9a7e6c2fe174d99ae09b07fc652df1099e87627e Mon Sep 17 00:00:00 2001 From: fabbing Date: Thu, 21 Sep 2023 14:07:40 +0200 Subject: [PATCH 118/402] TSan should handle `Effect.Unhandled` correctly Co-authored-by: Olivier Nicole --- Changes | 4 + runtime/amd64.S | 32 ++++++-- runtime/tsan.c | 6 +- testsuite/tests/tsan/unhandled.ml | 83 +++++++++++++++++++ testsuite/tests/tsan/unhandled.reference | 100 +++++++++++++++++++++++ testsuite/tests/tsan/unhandled.run | 4 + 6 files changed, 220 insertions(+), 9 deletions(-) create mode 100644 testsuite/tests/tsan/unhandled.ml create mode 100644 testsuite/tests/tsan/unhandled.reference create mode 100644 testsuite/tests/tsan/unhandled.run diff --git a/Changes b/Changes index 246e73f591a..73fe3bef331 100644 --- a/Changes +++ b/Changes @@ -430,6 +430,10 @@ Working version (Miod Vallat and Xavier Leroy, report by Jan Midtgaard, review by KC Sivaramakrishnan) +- #12593: TSan should handle Effect.Unhandled correctly + (Fabrice Buoro and Olivier Nicole, report by Jan Midtgaard and Miod Vallat, + review by ...) + OCaml 5.1.0 (14 September 2023) ------------------------------- diff --git a/runtime/amd64.S b/runtime/amd64.S index 27496b22315..1d4673bf0f8 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -1102,11 +1102,8 @@ CFI_STARTPROC leaq 1(%rsi), %rdi /* %rdi (last_fiber) := Val_ptr(old stack) */ movq %rdi, 0(%rbx) /* Initialise continuation */ LBL(do_perform): - /* %rsi: old stack */ - movq Stack_handler(%rsi), %r11 /* %r11 := old stack -> handler */ - movq Handler_parent(%r11), %r10 /* %r10 := parent stack */ - cmpq $0, %r10 /* parent is NULL? */ - je LBL(112) + /* %rdi: last_fiber + %rsi: old stack */ #if defined(WITH_THREAD_SANITIZER) /* Signal to TSan all stack frames exited by the perform. */ ENTER_FUNCTION @@ -1118,6 +1115,26 @@ LBL(do_perform): SWITCH_C_TO_OCAML TSAN_RESTORE_CALLER_REGS LEAVE_FUNCTION +#endif + movq Stack_handler(%rsi), %r11 /* %r11 := old stack -> handler */ + movq Handler_parent(%r11), %r10 /* %r10 := parent stack */ + cmpq $0, %r10 /* parent is NULL? */ + je LBL(112) +#if defined(WITH_THREAD_SANITIZER) + /* Save non-callee-saved registers %rax, %rdi, %rsi, %r10, %r11 before C + call */ + pushq %rax; CFI_ADJUST(8); + pushq %rdi; CFI_ADJUST(8); + pushq %rsi; CFI_ADJUST(8); + pushq %r10; CFI_ADJUST(8); + pushq %r11; CFI_ADJUST(8); + /* Match the TSan-enter made from caml_runstack */ + TSAN_EXIT_FUNCTION + popq %r11; CFI_ADJUST(-8); + popq %r10; CFI_ADJUST(-8); + popq %rsi; CFI_ADJUST(-8); + popq %rdi; CFI_ADJUST(-8); + popq %rax; CFI_ADJUST(-8); #endif SWITCH_OCAML_STACKS /* preserves r11 and rsi */ /* We have to null the Handler_parent after the switch because the @@ -1137,7 +1154,10 @@ LBL(112): #if defined(WITH_THREAD_SANITIZER) /* We must let the TSan runtime know that we switched back to the original performer stack. For that, we perform the necessary calls - to __tsan_func_entry via caml_tsan_entry_on_resume. */ + to __tsan_func_entry via caml_tsan_entry_on_resume. + Note that from TSan's point of view, we just exited all stack + frames, including those of the main fiber. This is ok, because we + re-enter them immediately via caml_tsan_entry_on_resume below. */ TSAN_SAVE_CALLER_REGS movq STACK_RETADDR(%rsp), C_ARG_1 /* arg 1: pc of perform */ leaq STACK_ARG_1(%rsp), C_ARG_2 /* arg 2: sp at perform */ diff --git a/runtime/tsan.c b/runtime/tsan.c index 391c619345c..3f667a35509 100644 --- a/runtime/tsan.c +++ b/runtime/tsan.c @@ -215,13 +215,13 @@ void caml_tsan_exit_on_perform(uintnat pc, char* sp) /* iterate on each frame */ while (1) { frame_descr* descr = caml_next_frame_descriptor(fds, &next_pc, &sp, stack); + if (descr == NULL) { + break; + } caml_tsan_debug_log_pc("forced__tsan_func_exit for", pc); __tsan_func_exit(NULL); - if (descr == NULL) { - break; - } pc = next_pc; } } diff --git a/testsuite/tests/tsan/unhandled.ml b/testsuite/tests/tsan/unhandled.ml new file mode 100644 index 00000000000..31b380715bf --- /dev/null +++ b/testsuite/tests/tsan/unhandled.ml @@ -0,0 +1,83 @@ +(* TEST + + ocamlopt_flags = "-g"; + include unix; + set TSAN_OPTIONS="detect_deadlocks=0"; + + tsan; + native; + +*) + +open Printf +open Effect +open Effect.Deep + +let print_endline s = Stdlib.print_endline s; flush stdout + +type _ t += E : int -> int t + +let g_ref1 = ref 0 +let g_ref2 = ref 0 + +let [@inline never] race = function + | 0 -> g_ref1 := 42 + | 1 -> g_ref2 := 42 + | _ -> assert false + +let [@inline never] h () = + print_endline "entering h"; + let v = + try perform (E 0) + with Unhandled _ -> race 1; 1 + in + print_endline "leaving h"; + v + +let [@inline never] g () = + print_endline "entering g"; + let v = h () in + print_endline "leaving g"; + v + +let f () = + print_endline "entering f"; + let v = g () in + print_endline "leaving f"; + v + 1 + +let [@inline never] fiber2 () = + ignore @@ match_with f () + { retc = Fun.id; + exnc = raise; + effc = (fun (type a) (e : a t) -> None) }; + 42 + +let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = fun _ -> None + +let [@inline never] fiber1 () = + ignore @@ match_with fiber2 () + { retc = (fun v -> + print_endline "value handler"; v + 1); + exnc = (fun e -> raise e); + effc = effh }; + 1338 + +let[@inline never] main () = + print_endline "performing an unhandled effect from the main fiber"; + try perform (E 42) with + | Effect.Unhandled _ -> race 0; + print_endline "performing an unhandled effect from another fiber"; + let v = fiber1 () in + v + 1 + +let[@inline never] other_domain () = + ignore @@ (Sys.opaque_identity !g_ref1, !g_ref2); + Unix.sleepf 0.66 + +let () = + let d = Domain.spawn other_domain in + Unix.sleepf 0.33; + let v = main () in + printf "result=%d\n%!" v; + Domain.join d diff --git a/testsuite/tests/tsan/unhandled.reference b/testsuite/tests/tsan/unhandled.reference new file mode 100644 index 00000000000..2e1e0cd3f11 --- /dev/null +++ b/testsuite/tests/tsan/unhandled.reference @@ -0,0 +1,100 @@ +performing an unhandled effect from the main fiber +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlUnhandled.race_ () + #1 camlUnhandled.main_ () + #2 camlUnhandled.entry () + #3 caml_program () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlUnhandled.other_domain_ () + #1 camlStdlib__Domain.body_ () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlUnhandled.entry () + #4 caml_program () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlUnhandled.entry () + #5 caml_program () + +SUMMARY: ThreadSanitizer: data race (:) in camlUnhandled.race_ +================== +performing an unhandled effect from another fiber +entering f +entering g +entering h +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlUnhandled.race_ () + #1 camlUnhandled.h_ () + #2 camlUnhandled.g_ () + #3 camlUnhandled.f_ () + #4 caml_runstack () + #5 camlUnhandled.fiber2_ () + #6 caml_runstack () + #7 camlUnhandled.fiber1_ () + #8 camlUnhandled.main_ () + #9 camlUnhandled.entry () + #10 caml_program () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlUnhandled.other_domain_ () + #1 camlStdlib__Domain.body_ () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlUnhandled.entry () + #4 caml_program () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlUnhandled.entry () + #5 caml_program () + +SUMMARY: ThreadSanitizer: data race (:) in camlUnhandled.race_ +================== +leaving h +leaving g +leaving f +value handler +result=1339 +ThreadSanitizer: reported 2 warnings diff --git a/testsuite/tests/tsan/unhandled.run b/testsuite/tests/tsan/unhandled.run new file mode 100644 index 00000000000..e96b5ea13a1 --- /dev/null +++ b/testsuite/tests/tsan/unhandled.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} From d8c6b4ed59ec3037e9919106b3292894909b69b7 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 26 Sep 2023 21:03:23 +0200 Subject: [PATCH 119/402] the mysterious reviewer of #12593 --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 73fe3bef331..3e21ee4eab9 100644 --- a/Changes +++ b/Changes @@ -432,7 +432,7 @@ Working version - #12593: TSan should handle Effect.Unhandled correctly (Fabrice Buoro and Olivier Nicole, report by Jan Midtgaard and Miod Vallat, - review by ...) + review by Gabriel Scherer) OCaml 5.1.0 (14 September 2023) ------------------------------- From 5227ea2707d63138653ee2ccd9f93eb0a417ac03 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Tue, 19 Sep 2023 18:07:20 +0200 Subject: [PATCH 120/402] Make early-exit invariant more manifest --- runtime/domain.c | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/runtime/domain.c b/runtime/domain.c index c77fdf90527..b1a0014cae3 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -249,19 +249,22 @@ static struct { { 0 } }; -static void add_to_stw_domains(dom_internal* dom) { - int i; +static void add_next_to_stw_domains(void) +{ CAMLassert(stw_domains.participating_domains < Max_domains); - for(i=stw_domains.participating_domains; stw_domains.domains[i]!=dom; ++i) { - CAMLassert(i Date: Tue, 26 Sep 2023 20:54:14 +0200 Subject: [PATCH 121/402] Document young_limit --- runtime/caml/domain_state.tbl | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/runtime/caml/domain_state.tbl b/runtime/caml/domain_state.tbl index dd64a87fda2..6378cf39d29 100644 --- a/runtime/caml/domain_state.tbl +++ b/runtime/caml/domain_state.tbl @@ -15,9 +15,14 @@ /**************************************************************************/ DOMAIN_STATE(atomic_uintnat, young_limit) -/* Minor heap limit. Typically young_limit == young_start, but this field is set - * by other domains to signal this domain by causing a spurious allocation - * failure. */ +/* Minor heap limit. Typically [young_start] <= [young_limit] <= + * [young_end], but this field can be set atomically to UINTNAT_MAX by + * another thread (typically from another domain) in order to + * interrupt this domain (by causing an allocation failure). Setting + * [young_limit] to UINTNAT_MAX can be done safely at any time + * whatsoever by any thread. To avoid races, setting [young_limit] to + * anything else than UINTNAT_MAX should only be done via + * [caml_reset_young_limit] by the domain itself. */ DOMAIN_STATE(value*, young_ptr) /* Minor heap pointer */ From 1dbc01004a07b7577b046bc5ec3d7c927d4d2dac Mon Sep 17 00:00:00 2001 From: Dhruv Maroo Date: Wed, 27 Sep 2023 14:18:03 +0530 Subject: [PATCH 122/402] Move the `[[noreturn]]` attribute to the front of the declaration (#12468) * Move the `[[noreturn]]` attribute to the front of the declarations in Needed in C++17. * Move the `[[noreturn]]` attribute to the front of the definitions Also needed in C 23, meaning that the move must be applied to source files and internal header files as well. * Document that `CAMLnoret` must occur first in declarations Signed-off-by: Dhruv Maroo Co-authored-by: Xavier Leroy --- Changes | 7 +++--- otherlibs/unix/unixsupport.h | 4 ++-- runtime/caml/domain_state.h | 2 +- runtime/caml/fail.h | 34 +++++++++++++------------- runtime/caml/fiber.h | 4 ++-- runtime/caml/intext.h | 2 +- runtime/caml/misc.h | 7 +++--- runtime/caml/sys.h | 6 ++--- runtime/compare.c | 2 +- runtime/extern.c | 8 +++---- runtime/fail_nat.c | 2 +- runtime/intern.c | 4 ++-- yacc/defs.h | 46 ++++++++++++++++++------------------ 13 files changed, 65 insertions(+), 63 deletions(-) diff --git a/Changes b/Changes index 3e21ee4eab9..381da59ee27 100644 --- a/Changes +++ b/Changes @@ -75,9 +75,10 @@ Working version - #12234: make instrumented time calculation more thread-safe on macOS. (Anil Madhavapeddy, review by Daniel Bünzli and Xavier Leroy) -- #12235: introduce and use the `CAMLnoret` macro as a lighter alternative - to `CAMLnoreturn_start` / `CAMLnoreturn_end` - (Xavier Leroy, with help from Antonin Décimo, review by +- #12235, #12468: introduce and use the `CAMLnoret` macro as + a lighter alternative to `CAMLnoreturn_start` / `CAMLnoreturn_end`. + Implement it so as to conform with C11, C23, C++11, C++17. + (Xavier Leroy and Dhruv Maroo, with help from Antonin Décimo, review by Gabriel Scherer and David Allsopp) - #12275: caml/stack.h: more abstract macros to describe OCaml stacks and diff --git a/otherlibs/unix/unixsupport.h b/otherlibs/unix/unixsupport.h index 575266284b1..5270f39271e 100644 --- a/otherlibs/unix/unixsupport.h +++ b/otherlibs/unix/unixsupport.h @@ -100,10 +100,10 @@ extern void caml_win32_maperr(DWORD errcode); extern value caml_unix_error_of_code (int errcode); extern int caml_unix_code_of_unix_error (value error); -extern CAMLnoret +CAMLnoret extern void caml_unix_error (int errcode, const char * cmdname, value arg); -extern CAMLnoret void caml_uerror (const char * cmdname, value arg); +CAMLnoret extern void caml_uerror (const char * cmdname, value arg); extern void caml_unix_check_path(value path, const char * cmdname); diff --git a/runtime/caml/domain_state.h b/runtime/caml/domain_state.h index 06401a4a175..fe66925364e 100644 --- a/runtime/caml/domain_state.h +++ b/runtime/caml/domain_state.h @@ -61,7 +61,7 @@ CAML_STATIC_ASSERT( #define Caml_state (CAMLassert(Caml_state_opt != NULL), Caml_state_opt) -CAMLextern CAMLnoret void caml_bad_caml_state(void); +CAMLnoret CAMLextern void caml_bad_caml_state(void); /* This check is performed regardless of debug mode. It is placed once at every code path starting from entry points of the public C API, diff --git a/runtime/caml/fail.h b/runtime/caml/fail.h index a9ac4b55113..4652bb89692 100644 --- a/runtime/caml/fail.h +++ b/runtime/caml/fail.h @@ -81,40 +81,40 @@ CAMLextern value caml_raise_if_exception(value res); extern "C" { #endif -CAMLextern CAMLnoret void caml_raise (value bucket); +CAMLnoret CAMLextern void caml_raise (value bucket); -CAMLextern CAMLnoret void caml_raise_constant (value tag); +CAMLnoret CAMLextern void caml_raise_constant (value tag); -CAMLextern CAMLnoret void caml_raise_with_arg (value tag, value arg); +CAMLnoret CAMLextern void caml_raise_with_arg (value tag, value arg); -CAMLextern CAMLnoret +CAMLnoret CAMLextern void caml_raise_with_args (value tag, int nargs, value arg[]); -CAMLextern CAMLnoret void caml_raise_with_string (value tag, char const * msg); +CAMLnoret CAMLextern void caml_raise_with_string (value tag, char const * msg); -CAMLextern CAMLnoret void caml_failwith (char const *msg); +CAMLnoret CAMLextern void caml_failwith (char const *msg); -CAMLextern CAMLnoret void caml_failwith_value (value msg); +CAMLnoret CAMLextern void caml_failwith_value (value msg); -CAMLextern CAMLnoret void caml_invalid_argument (char const *msg); +CAMLnoret CAMLextern void caml_invalid_argument (char const *msg); -CAMLextern CAMLnoret void caml_invalid_argument_value (value msg); +CAMLnoret CAMLextern void caml_invalid_argument_value (value msg); -CAMLextern CAMLnoret void caml_raise_out_of_memory (void); +CAMLnoret CAMLextern void caml_raise_out_of_memory (void); -CAMLextern CAMLnoret void caml_raise_stack_overflow (void); +CAMLnoret CAMLextern void caml_raise_stack_overflow (void); -CAMLextern CAMLnoret void caml_raise_sys_error (value); +CAMLnoret CAMLextern void caml_raise_sys_error (value); -CAMLextern CAMLnoret void caml_raise_end_of_file (void); +CAMLnoret CAMLextern void caml_raise_end_of_file (void); -CAMLextern CAMLnoret void caml_raise_zero_divide (void); +CAMLnoret CAMLextern void caml_raise_zero_divide (void); -CAMLextern CAMLnoret void caml_raise_not_found (void); +CAMLnoret CAMLextern void caml_raise_not_found (void); -CAMLextern CAMLnoret void caml_array_bound_error (void); +CAMLnoret CAMLextern void caml_array_bound_error (void); -CAMLextern CAMLnoret void caml_raise_sys_blocked_io (void); +CAMLnoret CAMLextern void caml_raise_sys_blocked_io (void); #ifdef __cplusplus } diff --git a/runtime/caml/fiber.h b/runtime/caml/fiber.h index 480412b69f7..403940c0e26 100644 --- a/runtime/caml/fiber.h +++ b/runtime/caml/fiber.h @@ -281,9 +281,9 @@ value caml_continuation_use (value cont); Used for cloning continuations and continuation backtraces. */ void caml_continuation_replace(value cont, struct stack_info* stack); -CAMLextern CAMLnoret void caml_raise_continuation_already_resumed (void); +CAMLnoret CAMLextern void caml_raise_continuation_already_resumed (void); -CAMLextern CAMLnoret void caml_raise_unhandled_effect (value effect); +CAMLnoret CAMLextern void caml_raise_unhandled_effect (value effect); value caml_make_unhandled_effect_exn (value effect); diff --git a/runtime/caml/intext.h b/runtime/caml/intext.h index e19b4e6d210..e93d37a400f 100644 --- a/runtime/caml/intext.h +++ b/runtime/caml/intext.h @@ -195,7 +195,7 @@ CAMLextern void caml_deserialize_block_4(void * data, intnat len); CAMLextern void caml_deserialize_block_8(void * data, intnat len); CAMLextern void caml_deserialize_block_float_8(void * data, intnat len); -CAMLextern CAMLnoret void caml_deserialize_error(char * msg); +CAMLnoret CAMLextern void caml_deserialize_error(char * msg); #ifdef __cplusplus } diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index dc52382fc66..3e081d89244 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -78,7 +78,8 @@ CAMLdeprecated_typedef(addr, char *); /* Noreturn, CAMLnoreturn_start and CAMLnoreturn_end are preserved for compatibility reasons. Instead, we recommend using the CAMLnoret macro, to be added as a modifier at the beginning of the - function definition or declaration. + function definition or declaration. It must occur first, before + "static", "extern", "CAMLexport", "CAMLextern". Note: CAMLnoreturn is a different macro defined in memory.h, to be used in function bodies rather than as a function attribute. @@ -248,7 +249,7 @@ typedef char char_os; #define CAMLassert(x) \ (CAMLlikely(x) ? (void) 0 : caml_failed_assert ( #x , __OSFILE__, __LINE__)) -CAMLextern CAMLnoret void caml_failed_assert (char *, char_os *, int); +CAMLnoret CAMLextern void caml_failed_assert (char *, char_os *, int); #else #define CAMLassert(x) ((void) 0) #endif @@ -299,7 +300,7 @@ typedef void (*fatal_error_hook) (char *msg, va_list args); extern _Atomic fatal_error_hook caml_fatal_error_hook; #endif -CAMLextern CAMLnoret void caml_fatal_error (char *, ...) +CAMLnoret CAMLextern void caml_fatal_error (char *, ...) #ifdef __GNUC__ __attribute__ ((format (printf, 1, 2))) #endif diff --git a/runtime/caml/sys.h b/runtime/caml/sys.h index 5ee508bb7e6..b6e6af87031 100644 --- a/runtime/caml/sys.h +++ b/runtime/caml/sys.h @@ -28,14 +28,14 @@ CAMLextern char * caml_strerror(int errnum, char * buf, size_t buflen); #define NO_ARG Val_int(0) -CAMLextern CAMLnoret void caml_sys_error (value); +CAMLnoret CAMLextern void caml_sys_error (value); -CAMLextern CAMLnoret void caml_sys_io_error (value); +CAMLnoret CAMLextern void caml_sys_io_error (value); CAMLextern double caml_sys_time_unboxed(value); CAMLextern void caml_sys_init (char_os * exe_name, char_os ** argv); -CAMLextern CAMLnoret void caml_do_exit (int); +CAMLnoret CAMLextern void caml_do_exit (int); #ifdef __cplusplus } diff --git a/runtime/compare.c b/runtime/compare.c index 06d372b296e..fd90087a40a 100644 --- a/runtime/compare.c +++ b/runtime/compare.c @@ -49,7 +49,7 @@ static void compare_free_stack(struct compare_stack* stk) } /* Same, then raise Out_of_memory */ -static CAMLnoret void compare_stack_overflow(struct compare_stack* stk) +CAMLnoret static void compare_stack_overflow(struct compare_stack* stk) { caml_gc_message (0x04, "Stack overflow in structural comparison\n"); compare_free_stack(stk); diff --git a/runtime/extern.c b/runtime/extern.c index 65bbfa9cfc0..402663d354d 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -170,14 +170,14 @@ void caml_free_extern_state (void) /* Forward declarations */ -static CAMLnoret void extern_out_of_memory(struct caml_extern_state* s); +CAMLnoret static void extern_out_of_memory(struct caml_extern_state* s); -static CAMLnoret +CAMLnoret static void extern_invalid_argument(struct caml_extern_state* s, char *msg); -static CAMLnoret void extern_failwith(struct caml_extern_state* s, char *msg); +CAMLnoret static void extern_failwith(struct caml_extern_state* s, char *msg); -static CAMLnoret void extern_stack_overflow(struct caml_extern_state* s); +CAMLnoret static void extern_stack_overflow(struct caml_extern_state* s); static void free_extern_output(struct caml_extern_state* s); diff --git a/runtime/fail_nat.c b/runtime/fail_nat.c index 3e5dac3f73b..744934fb09b 100644 --- a/runtime/fail_nat.c +++ b/runtime/fail_nat.c @@ -53,7 +53,7 @@ extern caml_generated_constant /* Exception raising */ -extern CAMLnoret +CAMLnoret extern void caml_raise_exception (caml_domain_state* state, value bucket); void caml_raise(value v) diff --git a/runtime/intern.c b/runtime/intern.c index dab7d83d5c3..aa7b1ccc1f2 100644 --- a/runtime/intern.c +++ b/runtime/intern.c @@ -128,7 +128,7 @@ void caml_free_intern_state (void) static char * intern_resolve_code_pointer(unsigned char digest[16], asize_t offset); -static CAMLnoret void intern_bad_code_pointer(unsigned char digest[16]); +CAMLnoret static void intern_bad_code_pointer(unsigned char digest[16]); Caml_inline unsigned char read8u(struct caml_intern_state* s) { return *s->intern_src++; } @@ -305,7 +305,7 @@ static void readfloats(struct caml_intern_state* s, #endif } -static CAMLnoret void intern_stack_overflow(struct caml_intern_state* s) +CAMLnoret static void intern_stack_overflow(struct caml_intern_state* s) { caml_gc_message (0x04, "Stack overflow in un-marshaling value\n"); intern_cleanup(s); diff --git a/yacc/defs.h b/yacc/defs.h index 355588abcb2..0089b70bcb6 100644 --- a/yacc/defs.h +++ b/yacc/defs.h @@ -320,25 +320,25 @@ extern action *add_reductions(int stateno, action *actions); extern action *add_reduce(action *actions, int ruleno, int symbol); extern void closure (short int *nucleus, int n); extern void create_symbol_table (void); -extern CAMLnoret void default_action_error (void); -extern CAMLnoret void done (int k); -extern CAMLnoret void entry_without_type (char *s); -extern CAMLnoret void fatal (char *msg); +CAMLnoret extern void default_action_error (void); +CAMLnoret extern void done (int k); +CAMLnoret extern void entry_without_type (char *s); +CAMLnoret extern void fatal (char *msg); extern void finalize_closure (void); extern void free_parser (void); extern void free_symbol_table (void); extern void free_symbols (void); -extern CAMLnoret void illegal_character (char *c_cptr); -extern CAMLnoret void illegal_token_ref (int i, char *name); +CAMLnoret extern void illegal_character (char *c_cptr); +CAMLnoret extern void illegal_token_ref (int i, char *name); extern void lalr (void); extern void lr0 (void); extern void make_parser (void); -extern CAMLnoret void no_grammar (void); -extern CAMLnoret void no_space (void); -extern CAMLnoret void open_error (char_os *filename); +CAMLnoret extern void no_grammar (void); +CAMLnoret extern void no_space (void); +CAMLnoret extern void open_error (char_os *filename); extern void output (void); extern void prec_redeclared (void); -extern CAMLnoret void polymorphic_entry_point(char *s); +CAMLnoret extern void polymorphic_entry_point(char *s); extern void forbidden_conflicts (void); extern void reader (void); extern void reflexive_transitive_closure (unsigned int *R, int n); @@ -346,20 +346,20 @@ extern void reprec_warning (char *s); extern void retyped_warning (char *s); extern void revalued_warning (char *s); extern void set_first_derives (void); -extern CAMLnoret void syntax_error (int st_lineno, char *st_line, char *st_cptr); -extern CAMLnoret void terminal_lhs (int s_lineno); -extern CAMLnoret void terminal_start (char *s); -extern CAMLnoret void tokenized_start (char *s); -extern CAMLnoret void too_many_entries (void); +CAMLnoret extern void syntax_error (int st_lineno, char *st_line, char *st_cptr); +CAMLnoret extern void terminal_lhs (int s_lineno); +CAMLnoret extern void terminal_start (char *s); +CAMLnoret extern void tokenized_start (char *s); +CAMLnoret extern void too_many_entries (void); extern void undefined_goal (char *s); extern void undefined_symbol (char *s); -extern CAMLnoret void unexpected_EOF (void); -extern CAMLnoret void unknown_rhs (int i); -extern CAMLnoret void unterminated_action (int a_lineno, char *a_line, char *a_cptr); -extern CAMLnoret void unterminated_comment (int c_lineno, char *c_line, char *c_cptr, char start_char); -extern CAMLnoret void unterminated_string (int s_lineno, char *s_line, char *s_cptr); -extern CAMLnoret void unterminated_text (int t_lineno, char *t_line, char *t_cptr); -extern CAMLnoret void used_reserved (char *s); +CAMLnoret extern void unexpected_EOF (void); +CAMLnoret extern void unknown_rhs (int i); +CAMLnoret extern void unterminated_action (int a_lineno, char *a_line, char *a_cptr); +CAMLnoret extern void unterminated_comment (int c_lineno, char *c_line, char *c_cptr, char start_char); +CAMLnoret extern void unterminated_string (int s_lineno, char *s_line, char *s_cptr); +CAMLnoret extern void unterminated_text (int t_lineno, char *t_line, char *t_cptr); +CAMLnoret extern void used_reserved (char *s); extern void verbose (void); extern void write_section (char **section); -extern CAMLnoret void invalid_literal(int s_lineno, char *s_line, char *s_cptr); +CAMLnoret extern void invalid_literal(int s_lineno, char *s_line, char *s_cptr); From fd0551b7b73e9b65e105a7071642aae155d1ae77 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Wed, 27 Sep 2023 15:33:52 +0200 Subject: [PATCH 123/402] Remove the dependency of the cmo and cmxs file formats on compiler internals (#12611) * file_formats/cmx_format.mli: fix documentation The documentation wrongly claimed that the module defines the cmxs format whereas this is not true, this format being defined in is own module, cmxs_format.mli. * Remove the dependency of the cmo and cmxs file formats on compiler internals --- .depend | 6 ++---- file_formats/cmo_format.mli | 3 ++- file_formats/cmx_format.mli | 2 +- file_formats/cmxs_format.mli | 3 ++- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.depend b/.depend index be45c688919..ddebe7863df 100644 --- a/.depend +++ b/.depend @@ -4018,8 +4018,7 @@ file_formats/cmi_format.cmx : \ file_formats/cmi_format.cmi : \ typing/types.cmi \ utils/misc.cmi -file_formats/cmo_format.cmi : \ - utils/misc.cmi +file_formats/cmo_format.cmi : file_formats/cmt_format.cmo : \ parsing/unit_info.cmi \ typing/types.cmi \ @@ -4063,8 +4062,7 @@ file_formats/cmx_format.cmi : \ utils/misc.cmi \ middle_end/flambda/export_info.cmi \ middle_end/clambda.cmi -file_formats/cmxs_format.cmi : \ - utils/misc.cmi +file_formats/cmxs_format.cmi : file_formats/linear_format.cmo : \ utils/misc.cmi \ parsing/location.cmi \ diff --git a/file_formats/cmo_format.mli b/file_formats/cmo_format.mli index cf0d0dadbb7..a4dbfce082e 100644 --- a/file_formats/cmo_format.mli +++ b/file_formats/cmo_format.mli @@ -15,7 +15,8 @@ (* Symbol table information for .cmo and .cma files *) -open Misc +type modname = string +type crcs = (modname * Digest.t option) list (* Names of compilation units as represented in CMO files *) type compunit = Compunit of string [@@unboxed] diff --git a/file_formats/cmx_format.mli b/file_formats/cmx_format.mli index a9139358760..7a167d0cd4d 100644 --- a/file_formats/cmx_format.mli +++ b/file_formats/cmx_format.mli @@ -17,7 +17,7 @@ (* *) (**************************************************************************) -(* Format of .cmx, .cmxa and .cmxs files *) +(* Format of .cmx and .cmxa files *) open Misc diff --git a/file_formats/cmxs_format.mli b/file_formats/cmxs_format.mli index c670024f928..52ff0ffb55f 100644 --- a/file_formats/cmxs_format.mli +++ b/file_formats/cmxs_format.mli @@ -15,7 +15,8 @@ (* Format of .cmxs files *) -open Misc +type modname = string +type crcs = (modname * Digest.t option) list (* Each .cmxs dynamically-loaded plugin contains a symbol "caml_plugin_header" containing the following info From e9185865ceec9ff0e3dff4cb7aa0af110f1a2d7e Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Fri, 29 Sep 2023 11:45:24 +0200 Subject: [PATCH 124/402] ocamldoc/Makefile: remove a few no lnger used targets and recipes This commit removes the following no longer used targets and their associated recipes from ocamldoc/Makefile: dot, test, test_stdlib, test_stdlib_code, test_latex, test_latex_simple, test_man, test_texi and autotest_stdlib. --- ocamldoc/Makefile | 72 ----------------------------------------------- 1 file changed, 72 deletions(-) diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 861889f13e6..9263d7b3c6e 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -175,12 +175,6 @@ $(OCAMLDOC_LIBCMA): $(LIBCMOFILES) $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES) $(V_LINKOPT)$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $^ -.PHONY: dot -dot: ocamldoc.dot - -ocamldoc.dot: $(EXECMOFILES) - $(OCAMLDOC_RUN) -dot -dot-reduce -o $@ $(INCLUDES) odoc*.ml - # Lexers and parsers LEXERS = $(addsuffix .mll,\ @@ -255,72 +249,6 @@ endif # TODO: also split into several rules -# Testing : -########### - -.PHONY: test -test: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/ocamldoc.odoc odoc*.ml odoc*.mli -v - $(MKDIR) $@-custom - $(OCAMLDOC_RUN_PLUGINS) -colorize-code -sort -d $@-custom $(INCLUDES) \ - -g generators/odoc_literate.cmo -g generators/odoc_todo.cmo \ - -load $@/ocamldoc.odoc -v - -.PHONY: test_stdlib -test_stdlib: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/stdlib.odoc -keep-code \ - $(ROOTDIR)/stdlib/*.mli \ - $(ROOTDIR)/otherlibs/unix/unix.mli \ - $(ROOTDIR)/otherlibs/str/str.mli - -.PHONY: test_stdlib_code -test_stdlib_code: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/stdlib.odoc -keep-code \ - `ls $(ROOTDIR)/stdlib/*.ml | grep -v Labels` \ - $(ROOTDIR)/otherlibs/unix/unix.ml \ - $(ROOTDIR)/otherlibs/str/str.ml - -.PHONY: test_latex -test_latex: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) odoc*.ml \ - odoc*.mli test2.txt $(ROOTDIR)/stdlib/*.mli $(ROOTDIR)/otherlibs/unix/unix.mli - -.PHONY: test_latex_simple -test_latex_simple: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) \ - -latextitle 6,subsection -latextitle 7,subsubection \ - $(ROOTDIR)/stdlib/hashtbl.mli \ - $(ROOTDIR)/stdlib/arg.mli \ - $(ROOTDIR)/otherlibs/unix/unix.mli \ - $(ROOTDIR)/stdlib/map.mli - -.PHONY: test_man -test_man: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -man -sort -d $@ $(INCLUDES) odoc*.ml odoc*.mli - -.PHONY: test_texi -test_texi: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -texi -sort -d $@ $(INCLUDES) odoc*.ml odoc*.mli - -# stdlib non-prefixed : -####################### - -.PHONY: autotest_stdlib -autotest_stdlib: - $(MKDIR) $@ - $(OCAMLDOC_RUN_PLUGINS) -g autotest/odoc_test.cmo\ - $(INCLUDES) -keep-code \ - $(ROOTDIR)/stdlib/*.mli \ - $(ROOTDIR)/otherlibs/unix/unix.mli \ - $(ROOTDIR)/otherlibs/str/str.mli - # backup, clean and depend : ############################ From fc084a9b76f262d923caa0ac4053082ca9f9b545 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Fri, 29 Sep 2023 12:22:10 +0200 Subject: [PATCH 125/402] Remove ocamldoc's generators --- ocamldoc/.depend | 45 ----- ocamldoc/Makefile | 26 +-- ocamldoc/generators/odoc_literate.ml | 213 ----------------------- ocamldoc/generators/odoc_literate.mli | 23 --- ocamldoc/generators/odoc_todo.ml | 233 -------------------------- ocamldoc/generators/odoc_todo.mli | 32 ---- 6 files changed, 3 insertions(+), 569 deletions(-) delete mode 100644 ocamldoc/generators/odoc_literate.ml delete mode 100644 ocamldoc/generators/odoc_literate.mli delete mode 100644 ocamldoc/generators/odoc_todo.ml delete mode 100644 ocamldoc/generators/odoc_todo.mli diff --git a/ocamldoc/.depend b/ocamldoc/.depend index 31634207ed1..76a3681c366 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -963,48 +963,3 @@ odoc_value.cmi : \ odoc_types.cmi \ odoc_parameter.cmi \ odoc_name.cmi -generators/odoc_literate.cmo : \ - odoc_info.cmi \ - odoc_html.cmi \ - odoc_gen.cmi \ - odoc_args.cmi \ - generators/odoc_literate.cmi -generators/odoc_literate.cmx : \ - odoc_info.cmx \ - odoc_html.cmx \ - odoc_gen.cmx \ - odoc_args.cmx \ - generators/odoc_literate.cmi -generators/odoc_literate.cmxs : \ - odoc_info.cmx \ - odoc_html.cmx \ - odoc_gen.cmx \ - odoc_args.cmx \ - generators/odoc_literate.cmi -generators/odoc_literate.cmi : \ - odoc_html.cmi -generators/odoc_todo.cmo : \ - odoc_module.cmi \ - odoc_info.cmi \ - odoc_html.cmi \ - odoc_gen.cmi \ - odoc_args.cmi \ - generators/odoc_todo.cmi -generators/odoc_todo.cmx : \ - odoc_module.cmx \ - odoc_info.cmx \ - odoc_html.cmx \ - odoc_gen.cmx \ - odoc_args.cmx \ - generators/odoc_todo.cmi -generators/odoc_todo.cmxs : \ - odoc_module.cmx \ - odoc_info.cmx \ - odoc_html.cmx \ - odoc_gen.cmx \ - odoc_args.cmx \ - generators/odoc_todo.cmi -generators/odoc_todo.cmi : \ - odoc_scan.cmi \ - odoc_info.cmi \ - odoc_html.cmi diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 9263d7b3c6e..2635864c37e 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -40,21 +40,13 @@ OCAMLDOC_LIBCMIS=$(OCAMLDOC_LIBMLIS:.mli=.cmi) OCAMLDOC_LIBCMTS=$(OCAMLDOC_LIBMLIS:.mli=.cmt) $(OCAMLDOC_LIBMLIS:.mli=.cmti) ODOC_TEST=odoc_test.cmo -GENERATORS_CMOS= \ - generators/odoc_todo.cmo \ - generators/odoc_literate.cmo -ifeq "$(NATDYNLINK)" "true" -GENERATORS_CMXS = $(GENERATORS_CMOS:.cmo=.cmxs) -else -GENERATORS_CMXS = -endif # Compilation ############# INCLUDE_DIRS = $(addprefix $(ROOTDIR)/,\ - utils parsing typing driver bytecomp toplevel) generators + utils parsing typing driver bytecomp toplevel) INCLUDES_DEP = $(addprefix -I ,$(INCLUDE_DIRS)) INCLUDES_NODEP = $(addprefix -I $(ROOTDIR)/,\ compilerlibs otherlibs/str otherlibs/dynlink \ @@ -130,7 +122,7 @@ LIBCMXFILES = $(LIBCMOFILES:.cmo=.cmx) LIBCMIFILES = $(LIBCMOFILES:.cmo=.cmi) .PHONY: all -all: lib exe generators +all: lib exe .PHONY: exe exe: $(OCAMLDOC) @@ -138,11 +130,8 @@ exe: $(OCAMLDOC) .PHONY: lib lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI) $(ODOC_TEST) -.PHONY: generators -generators: $(GENERATORS_CMOS) - .PHONY: opt.opt allopt # allopt and opt.opt are synonyms -opt.opt: exeopt libopt generatorsopt +opt.opt: exeopt libopt allopt: opt.opt .PHONY: exeopt @@ -151,9 +140,6 @@ exeopt: $(OCAMLDOC_OPT) .PHONY: libopt libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) -.PHONY: generatorsopt -generatorsopt: $(GENERATORS_CMXS) - OCAMLDOC_LIBRARIES = ocamlcommon unix str dynlink OCAMLDOC_BCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cma) @@ -197,9 +183,6 @@ DEPEND_PREREQS = $(LEXERS:.mll=.ml) \ %.cmx: %.ml $(V_OCAMLOPT)$(OCAMLOPT) $(COMPFLAGS) -c $< -%.cmxs: %.ml - $(V_OCAMLOPT)$(OCAMLOPT) -shared -o $@ $(COMPFLAGS) $< - # Installation targets ###################### @@ -260,8 +243,6 @@ clean: rm -f odoc_parser.output odoc_text_parser.output rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli - rm -f generators/*.cm[taiox] generators/*.a generators/*.lib generators/*.o generators/*.obj \ - generators/*.cmx[as] generators/*.cmti .PHONY: distclean distclean: clean @@ -270,6 +251,5 @@ distclean: clean .PHONY: depend depend: $(DEPEND_PREREQS) $(OCAMLDEP_CMD) *.mll *.mly *.ml *.mli > .depend - $(OCAMLDEP_CMD) -shared generators/*.ml generators/*.mli >> .depend include .depend diff --git a/ocamldoc/generators/odoc_literate.ml b/ocamldoc/generators/odoc_literate.ml deleted file mode 100644 index 6761873ddbd..00000000000 --- a/ocamldoc/generators/odoc_literate.ml +++ /dev/null @@ -1,213 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Maxence Guesdon, 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. *) -(* *) -(**************************************************************************) - -open Odoc_info -module Naming = Odoc_html.Naming -open Odoc_info.Value - -let p = Printf.bprintf -let bp = Printf.bprintf -let bs = Buffer.add_string - -module Html = - (val - ( - match !Odoc_args.current_generator with - None -> (module Odoc_html.Generator : Odoc_html.Html_generator) - | Some (Odoc_gen.Html m) -> m - | _ -> - failwith - "A non-html generator is already set. Cannot install the Todo-list html generator" - ) : Odoc_html.Html_generator) - -module Generator = -struct -class html = - object (self) - inherit Html.html - - method! private html_of_module_comment b text = - let br1, br2 = - match text with - [(Odoc_info.Title _)] -> false, false - | (Odoc_info.Title _) :: _ -> false, true - | _ -> true, true - in - if br1 then p b "
"; - self#html_of_text b text; - if br2 then p b "

\n" - - method! private html_of_Title b n l_opt t = - let label1 = self#create_title_label (n, l_opt, t) in - p b "\n" (Naming.label_target label1); - p b "" n; - self#html_of_text b t; - p b "" n - - val mutable code_id = 0 - method private code_block b code = - code_id <- code_id + 1; - Printf.bprintf b - "\ - \"+/-\"/" - code_id code_id code_id; - Printf.bprintf b "
" code_id; - self#html_of_code b code; - Printf.bprintf b "
" - - (** Print html code for a value. *) - method! private html_of_value b v = - Odoc_info.reset_type_names (); - self#html_of_info b v.val_info; - bs b "
";
-      bs b (self#keyword "val");
-      bs b " ";
-      (* html mark *)
-      bp b "" (Naming.value_target v);
-      bs b (self#escape (Name.simple v.val_name));
-      bs b " : ";
-      self#html_of_type_expr b (Name.father v.val_name) v.val_type;
-      bs b "
"; - ( - if !Odoc_html.with_parameter_list then - self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters - else - self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters - ); - ( - match v.val_code with - None -> () - | Some code -> - self#code_block b code - ) -(* - (** Print html code for a module. *) - method private html_of_module b ?(info=true) ?(complete=true) ?(with_link=true) m = - let (html_file, _) = Naming.html_files m.m_name in - let father = Name.father m.m_name in - bs b "
";
-      bs b ((self#keyword "module")^" ");
-      (
-       if with_link then
-         bp b "%s" html_file (Name.simple m.m_name)
-       else
-         bs b (Name.simple m.m_name)
-      );
-(*      A remettre quand on compilera avec ocaml 3.10
-         (
-       match m.m_kind with
-         Module_functor _ when !Odoc_info.Args.html_short_functors  ->
-           ()
-
-       | _ -> *) bs b ": ";
-      (*
-      );
-      *)
-      self#html_of_module_kind b father ~modu: m m.m_kind;
-      bs b "
"; - if info && complete then - self#html_of_info ~indent: false b m.m_info - -*) - initializer - default_style_options <- - ["a:visited {color : #416DFF; text-decoration : none; }" ; - "a:link {color : #416DFF; text-decoration : none;}" ; - "a:hover {color : Red; text-decoration : none; background-color: #5FFF88}" ; - "a:active {color : Red; text-decoration : underline; }" ; - ".keyword { font-weight : bold ; color : Red }" ; - ".keywordsign { color : #C04600 }" ; - ".superscript { font-size : 0.6em }" ; - ".subscript { font-size : 0.6em }" ; - ".comment { color : Green }" ; - ".constructor { color : Blue }" ; - ".type { color : #5C6585 }" ; - ".string { color : Maroon }" ; - ".warning { color : Red ; font-weight : bold }" ; - ".info { margin-top: 8px; }"; - ".param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }" ; - ".code { color : #465F91 ; }" ; - "h1 { font-size : 20pt ; text-align: center; }" ; - - "h2 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90BDFF ;"^ - "padding: 2px; }" ; - - "h3 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90DDFF ;"^ - "padding: 2px; }" ; - - "h4 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90EDFF ;"^ - "padding: 2px; }" ; - - "h5 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90FDFF ;"^ - "padding: 2px; }" ; - - "h6 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #C0FFFF ; "^ - "padding: 2px; }" ; - - "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #E0FFFF ; "^ - "padding: 2px; }" ; - - "div.h8 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #F0FFFF ; "^ - "padding: 2px; }" ; - - "div.h9 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #FFFFFF ; "^ - "padding: 2px; }" ; - - ".typetable { border-style : hidden }" ; - ".indextable { border-style : hidden }" ; - ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ; - "body { background-color : White }" ; - "tr { background-color : White }" ; - "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ; - "pre { margin-bottom: 4px ; margin-left: 1em; "^ - "border-color: #27408b; border-style: solid; "^ - "border-width: 1px 1px 1px 3px; "^ - "padding: 4px; }" ; - "div.sig_block {margin-left: 2em}" ; - - "div.codeblock { "^ - "margin-left: 2em; margin-right: 1em; padding: 6px; "^ - "margin-bottom: 8px; display: none; "^ - "border-width: 1px 1px 1px 3px; border-style: solid; border-color: grey; }" ; - - "span.code_expand { color: blue; text-decoration: underline; cursor: pointer; "^ - "margin-left: 1em ; } "; - ]; - end -end - -let _ = Odoc_args.set_generator - (Odoc_gen.Html (module Generator : Odoc_html.Html_generator)) diff --git a/ocamldoc/generators/odoc_literate.mli b/ocamldoc/generators/odoc_literate.mli deleted file mode 100644 index eaf38ba8f28..00000000000 --- a/ocamldoc/generators/odoc_literate.mli +++ /dev/null @@ -1,23 +0,0 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -module Naming = Odoc_html.Naming - -module Html : Odoc_html.Html_generator - -module Generator : - sig - class html : Odoc_html.Generator.html - end diff --git a/ocamldoc/generators/odoc_todo.ml b/ocamldoc/generators/odoc_todo.ml deleted file mode 100644 index ce3c2c12802..00000000000 --- a/ocamldoc/generators/odoc_todo.ml +++ /dev/null @@ -1,233 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2010 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. *) -(* *) -(**************************************************************************) - -(** An OCamldoc generator to retrieve information in "todo" tags and - generate an html page with all todo items. *) - -open Odoc_info -module Naming = Odoc_html.Naming -open Odoc_info.Value -open Odoc_info.Module -open Odoc_info.Type -open Odoc_info.Extension -open Odoc_info.Exception -open Odoc_info.Class - -let p = Printf.bprintf - -module Html = - (val - ( - match !Odoc_args.current_generator with - None -> (module Odoc_html.Generator : Odoc_html.Html_generator) - | Some (Odoc_gen.Html m) -> m - | _ -> - failwith - "A non-html generator is already set. Cannot install the Todo-list html generator" - ) : Odoc_html.Html_generator) - -module Generator = -struct - class scanner html = - object (self) - inherit Odoc_info.Scan.scanner - - val b = Buffer.create 256 - method buffer = b - - method private gen_if_tag name target info_opt = - match info_opt with - None -> () - | Some i -> - let l = - List.fold_left - (fun acc (t, text) -> - match t with - "todo" -> - begin - match text with - (Odoc_info.Code s) :: q -> - ( - try - let n = int_of_string s in - let head = - Odoc_info.Code (Printf.sprintf "[%d] " n) - in - (Some n, head::q) :: acc - with _ -> (None, text) :: acc - ) - | _ -> (None, text) :: acc - - end - | _ -> acc - ) - [] - i.i_custom - in - match l with - [] -> () - | _ -> - let l = List.sort - (fun a b -> - match a, b with - (None, _), _ -> -1 - | _, (None, _) -> 1 - | (Some n1, _), (Some n2, _) -> compare n1 n2 - ) - l - in - p b "
%s
" - target name; - let col = function - None -> "#000000" - | Some 1 -> "#FF0000" - | Some 2 -> "#AA5555" - | Some 3 -> "#44BB00" - | Some n -> Printf.sprintf "#%2x0000" (0xAA - (n * 0x10)) - in - List.iter - (fun (n, e) -> - Printf.bprintf b "" (col n); - html#html_of_text ?with_p:(Some false) b e; - p b "
\n"; - ) - l; - p b "
" - - method! scan_value v = - self#gen_if_tag - v.val_name - (Odoc_html.Naming.complete_value_target v) - v.val_info - - method! scan_type t = - self#gen_if_tag - t.ty_name - (Odoc_html.Naming.complete_type_target t) - t.ty_info - - method! scan_extension_constructor x = - self#gen_if_tag - x.xt_name - (Odoc_html.Naming.complete_extension_target x) - x.xt_type_extension.te_info - - method! scan_exception e = - self#gen_if_tag - e.ex_name - (Odoc_html.Naming.complete_exception_target e) - e.ex_info - - method! scan_attribute a = - self#gen_if_tag - a.att_value.val_name - (Odoc_html.Naming.complete_attribute_target a) - a.att_value.val_info - - method! scan_method m = - self#gen_if_tag - m.met_value.val_name - (Odoc_html.Naming.complete_method_target m) - m.met_value.val_info - - (** This method scans the elements of the given module. *) - method! scan_module_elements m = - List.iter - (fun ele -> - match ele with - Odoc_module.Element_module m -> self#scan_module m - | Odoc_module.Element_module_type mt -> self#scan_module_type mt - | Odoc_module.Element_included_module im -> self#scan_included_module im - | Odoc_module.Element_class c -> self#scan_class c - | Odoc_module.Element_class_type ct -> self#scan_class_type ct - | Odoc_module.Element_value v -> self#scan_value v - | Odoc_module.Element_type_extension te -> self#scan_type_extension te - | Odoc_module.Element_exception e -> self#scan_exception e - | Odoc_module.Element_type t -> self#scan_type t - | Odoc_module.Element_module_comment t -> self#scan_module_comment t - ) - (Odoc_module.module_elements ~trans: false m) - - method! scan_included_module _ = () - - method! scan_class_pre c = - self#gen_if_tag - c.cl_name - (fst (Odoc_html.Naming.html_files c.cl_name)) - c.cl_info; - true - - method! scan_class_type_pre ct = - self#gen_if_tag - ct.clt_name - (fst (Odoc_html.Naming.html_files ct.clt_name)) - ct.clt_info; - true - - method! scan_module_pre m = - self#gen_if_tag - m.m_name - (fst (Odoc_html.Naming.html_files m.m_name)) - m.m_info; - true - - method! scan_module_type_pre mt = - self#gen_if_tag - mt.mt_name - (fst (Odoc_html.Naming.html_files mt.mt_name)) - mt.mt_info; - true - end - - class html : Html.html = - object (self) - inherit Html.html as html - - (** we have to hack a little because we cannot inherit from - scanner, since public method cannot be hidden and - our html class must respect the type of the default - html generator class *) - val mutable scanner = new scanner (new Html.html ) - - method! generate modules = - (* prevent having the 'todo' tag signaled as not handled *) - tag_functions <- ("todo", (fun _ -> "")) :: tag_functions; - (* generate doc as usual *) - html#generate modules; - (* then retrieve the todo tags and generate the todo.html page *) - let title = - match !Odoc_info.Global.title with - None -> "" - | Some s -> s - in - let b = Buffer.create 512 in - p b ""; - self#print_header b title ; - p b "

%s

" title; - scanner#scan_module_list modules; - Buffer.add_buffer b scanner#buffer; - let oc = open_out - (Filename.concat !Odoc_info.Global.target_dir "todo.html") - in - Buffer.output_buffer oc b; - close_out oc - - initializer - scanner <- new scanner self - end -end - -let _ = Odoc_args.set_generator - (Odoc_gen.Html (module Generator : Odoc_html.Html_generator)) diff --git a/ocamldoc/generators/odoc_todo.mli b/ocamldoc/generators/odoc_todo.mli deleted file mode 100644 index fce85d6600c..00000000000 --- a/ocamldoc/generators/odoc_todo.mli +++ /dev/null @@ -1,32 +0,0 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -(** An OCamldoc generator to retrieve information in "todo" tags and - generate an html page with all todo items. *) - -module Naming = Odoc_html.Naming -module Html : Odoc_html.Html_generator - -module Generator : - sig - class scanner : - < html_of_text : ?with_p:bool -> Buffer.t -> Odoc_info.text -> unit; - .. > -> - object - inherit Odoc_scan.scanner - method buffer : Buffer.t - end - class html : Html.html - end From 513b9c923a204023a5e761a8901e090190da1297 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Fri, 29 Sep 2023 14:09:24 +0200 Subject: [PATCH 126/402] Add Changes entry --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index 381da59ee27..f44224df2fa 100644 --- a/Changes +++ b/Changes @@ -215,6 +215,9 @@ Working version - #12576: ocamldep: various refactors. (Antonin Décimo, review by Florian Angeletti, Gabriel Scherer, and Léo Andrès) +- #12615: ocamldoc: get rid of the odoc_literate and odoc_todo generators. + (Sébaistien Hinderer, review by Gabriel Scherer and Florian Angeletti) + ### Manual and documentation: - #12338: clarification of the documentation of process related function in From 424cd44cdec688e9261d1b708d090bd81e9c63c9 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 20 Sep 2023 11:05:43 +0200 Subject: [PATCH 127/402] frame-pointer tests: stop backtraces at caml_main|caml_startup --- .../tests/frame-pointers/c_call.reference | 6 ---- .../tests/frame-pointers/effects.reference | 10 ------- .../exception_handler.reference | 8 ----- testsuite/tests/frame-pointers/fp_backtrace.c | 29 +++++++++++++++---- .../tests/frame-pointers/reperform.reference | 2 -- .../frame-pointers/stack_realloc.reference | 2 -- .../frame-pointers/stack_realloc2.reference | 2 -- 7 files changed, 24 insertions(+), 35 deletions(-) diff --git a/testsuite/tests/frame-pointers/c_call.reference b/testsuite/tests/frame-pointers/c_call.reference index 92fb40a2389..65cde20adcd 100644 --- a/testsuite/tests/frame-pointers/c_call.reference +++ b/testsuite/tests/frame-pointers/c_call.reference @@ -4,18 +4,12 @@ camlC_call.f camlC_call.entry caml_program caml_start_program -caml_main/caml_startup -main caml_c_call camlC_call.f camlC_call.entry caml_program caml_start_program -caml_main/caml_startup -main camlC_call.f camlC_call.entry caml_program caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/effects.reference b/testsuite/tests/frame-pointers/effects.reference index c8bd0a391a5..9052ef04d0f 100644 --- a/testsuite/tests/frame-pointers/effects.reference +++ b/testsuite/tests/frame-pointers/effects.reference @@ -4,16 +4,12 @@ caml_runstack camlEffects.entry caml_program caml_start_program -caml_main/caml_startup -main # perform effect (E 0) # caught effect (E 0). continuing... camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program -caml_main/caml_startup -main # perform returns 1 camlEffects.f caml_runstack @@ -21,21 +17,15 @@ camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program -caml_main/caml_startup -main # done 2 camlEffects.v_retc camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program -caml_main/caml_startup -main # continue returns 3 camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program -caml_main/caml_startup -main # result=4 diff --git a/testsuite/tests/frame-pointers/exception_handler.reference b/testsuite/tests/frame-pointers/exception_handler.reference index 513ca488b92..9292c32117d 100644 --- a/testsuite/tests/frame-pointers/exception_handler.reference +++ b/testsuite/tests/frame-pointers/exception_handler.reference @@ -3,26 +3,18 @@ camlException_handler.bare camlException_handler.entry caml_program caml_start_program -caml_main/caml_startup -main camlException_handler.handler camlException_handler.bare camlException_handler.entry caml_program caml_start_program -caml_main/caml_startup -main camlException_handler.handler camlException_handler.nested camlException_handler.entry caml_program caml_start_program -caml_main/caml_startup -main camlException_handler.handler camlException_handler.nested camlException_handler.entry caml_program caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/fp_backtrace.c b/testsuite/tests/frame-pointers/fp_backtrace.c index a521218a387..2b2541877ef 100644 --- a/testsuite/tests/frame-pointers/fp_backtrace.c +++ b/testsuite/tests/frame-pointers/fp_backtrace.c @@ -2,7 +2,9 @@ #include #include #include +#include #include +#include #define ARRSIZE(a) (sizeof(a) / sizeof(*(a))) @@ -77,13 +79,19 @@ static int safe_read(const struct frame_info* fi, struct frame_info** prev, return ret; } -static void print_location(void* addr) +static char *get_symbol(void* addr) { if (!addr) - return; + return NULL; - /* This requires the binary to be linked with '-rdynamic' */ - backtrace_symbols_fd(&addr, 1, STDOUT_FILENO); + char **symbols = backtrace_symbols(&addr, 1); + if (symbols == NULL) + return NULL; + + char *symb = strdup(symbols[0]); + free(symbols); + + return symb; } void fp_backtrace(void) @@ -99,7 +107,18 @@ void fp_backtrace(void) if (safe_read(fi, &next, &retaddr) != 0) return; - print_location(retaddr); + char *symbol = get_symbol(retaddr); + if (symbol != NULL) { + /* stop before entering C code */ + if ( strstr(symbol, "caml_main") + || strstr(symbol, "caml_startup")) + { + free(symbol); + return; + } + printf("%s\n", symbol); fflush(stdout); + free(symbol); + } /* Detect the simplest kind of infinite loop */ if (fi == next) { diff --git a/testsuite/tests/frame-pointers/reperform.reference b/testsuite/tests/frame-pointers/reperform.reference index 9ac6681d4b1..dfda92514bc 100644 --- a/testsuite/tests/frame-pointers/reperform.reference +++ b/testsuite/tests/frame-pointers/reperform.reference @@ -16,5 +16,3 @@ caml_runstack camlReperform.entry caml_program caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/stack_realloc.reference b/testsuite/tests/frame-pointers/stack_realloc.reference index 016a03550a3..078d923d7be 100644 --- a/testsuite/tests/frame-pointers/stack_realloc.reference +++ b/testsuite/tests/frame-pointers/stack_realloc.reference @@ -8,5 +8,3 @@ caml_runstack camlStack_realloc.entry caml_program caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/stack_realloc2.reference b/testsuite/tests/frame-pointers/stack_realloc2.reference index ae492abd882..a0480da25d7 100644 --- a/testsuite/tests/frame-pointers/stack_realloc2.reference +++ b/testsuite/tests/frame-pointers/stack_realloc2.reference @@ -8,5 +8,3 @@ caml_runstack camlStack_realloc2.entry caml_program caml_start_program -caml_main/caml_startup -main From 1a62bc075023d4216bf4633f4df62d145c3fbc3c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 22 Sep 2023 21:41:12 +0200 Subject: [PATCH 128/402] [minor] runtime: add caml_domain_terminating(domain_state *) Suggested-by: B. Szilvasy --- runtime/caml/domain.h | 1 + runtime/domain.c | 12 ++++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h index 54251984273..86a4a9c6cd5 100644 --- a/runtime/caml/domain.h +++ b/runtime/caml/domain.h @@ -121,6 +121,7 @@ int caml_global_barrier_is_final(barrier_status); void caml_global_barrier_end(barrier_status); int caml_global_barrier_num_domains(void); +int caml_domain_terminating(caml_domain_state *); int caml_domain_is_terminating(void); #endif /* CAML_INTERNALS */ diff --git a/runtime/domain.c b/runtime/domain.c index b1a0014cae3..6536fcfdeee 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -1835,10 +1835,18 @@ static void handover_finalisers(caml_domain_state* domain_state) caml_final_domain_terminate(domain_state); } +static inline int domain_terminating(dom_internal *d) { + return d->interruptor.terminating; +} + +int caml_domain_terminating (caml_domain_state *dom_st) +{ + return domain_terminating(&all_domains[dom_st->id]); +} + int caml_domain_is_terminating (void) { - struct interruptor* s = &domain_self->interruptor; - return s->terminating; + return domain_terminating(domain_self); } static void domain_terminate (void) From 75d99e23cdf1af7ffae6e732b7900e4c9577691c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 22 Sep 2023 18:05:23 +0200 Subject: [PATCH 129/402] fix a race between [caml_compute_gc_stats] and domain termination Reported-by: B. Szilvasy --- runtime/caml/gc_stats.h | 9 ++++----- runtime/domain.c | 12 ++++++------ runtime/gc_stats.c | 29 +++++++++++++++++++---------- runtime/minor_gc.c | 7 +++---- 4 files changed, 32 insertions(+), 25 deletions(-) diff --git a/runtime/caml/gc_stats.h b/runtime/caml/gc_stats.h index 80227b33c24..4cded2c8bec 100644 --- a/runtime/caml/gc_stats.h +++ b/runtime/caml/gc_stats.h @@ -72,11 +72,10 @@ struct gc_stats { void caml_orphan_alloc_stats(caml_domain_state *); -/* Update the sampled stats of a domain from its live stats. */ -void caml_collect_gc_stats_sample(caml_domain_state *domain); - -/* Clear the sampled stats on domain termination. */ -void caml_clear_gc_stats_sample(caml_domain_state *domain); +/* Update the sampled stats of a domain from its live stats. + May only be called during STW, so that it does not race + with mutators calling [caml_compute_gc_stats]. */ +void caml_collect_gc_stats_sample_stw(caml_domain_state *domain); /* Compute global runtime stats. diff --git a/runtime/domain.c b/runtime/domain.c index 6536fcfdeee..648eb9d9691 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -1929,13 +1929,13 @@ static void domain_terminate (void) domain_state->minor_tables = 0; caml_orphan_alloc_stats(domain_state); - /* Heap stats were orphaned by caml_teardown_shared_heap above. - At this point, the stats of the domain must be empty; - we also clear the sampled copy. + /* Heap stats were orphaned by [caml_teardown_shared_heap] above. + At this point, the stats of the domain must be empty. - Note: We cannot call caml_collect_gc_stats_sample to clear the - sample at this point as the shared heap is gone. */ - caml_clear_gc_stats_sample(domain_state); + The sampled copy was also cleared by the minor collection(s) + performed above at [caml_empty_minor_heaps_once()], see the + termination-specific logic in [caml_collect_gc_stats_sample_stw]. + */ /* TODO: can this ever be NULL? can we remove this check? */ if(domain_state->current_stack != NULL) { diff --git a/runtime/gc_stats.c b/runtime/gc_stats.c index f236476b9cf..09d5ca74051 100644 --- a/runtime/gc_stats.c +++ b/runtime/gc_stats.c @@ -106,20 +106,29 @@ void caml_orphan_alloc_stats(caml_domain_state *domain) { /* The "sampled stats" of a domain are a recent copy of its domain-local stats, accessed without synchronization and only updated ("sampled") during stop-the-world events -- each minor - collection, and on domain termination. */ + collection, including those happening during domain termination. */ static struct gc_stats sampled_gc_stats[Max_domains]; -/* Update the sampled stats for the given domain. */ -void caml_collect_gc_stats_sample(caml_domain_state* domain) +/* Update the sampled stats for the given domain during a STW section. */ +void caml_collect_gc_stats_sample_stw(caml_domain_state* domain) { struct gc_stats* stats = &sampled_gc_stats[domain->id]; - caml_collect_alloc_stats_sample(domain, &stats->alloc_stats); - caml_collect_heap_stats_sample(domain->shared_heap, &stats->heap_stats); -} - -void caml_clear_gc_stats_sample(caml_domain_state *domain) { - struct gc_stats* stats = &sampled_gc_stats[domain->id]; - memset(stats, 0, sizeof(*stats)); + if (caml_domain_terminating(domain)) { + /* If the domain is terminating, we should not update the sample + with accurate domain-local data, but instead clear the sample + so that a new domain spawning there in the future can start + with empty stats. + + The current stats will also be 'orphaned' during domain + termination, so they will remain accounted for in the global + statistics. (Orphaning right now would be correct but + insufficient as further stat updates may come after the current + STW section.) */ + memset(stats, 0, sizeof(*stats)); + } else { + caml_collect_alloc_stats_sample(domain, &stats->alloc_stats); + caml_collect_heap_stats_sample(domain->shared_heap, &stats->heap_stats); + } } CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index d2dd6641991..4fb4b2ebb8b 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -647,10 +647,9 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain, domain->stat_minor_words += Wsize_bsize (minor_allocated_bytes); domain->stat_promoted_words += domain->allocated_words - prev_alloc_words; - /* gc stats may be accessed unsynchronised by mutator code, so we collect the - sample before arriving at the barrier, which ensures that it doesn't race - */ - caml_collect_gc_stats_sample(domain); + /* Must be called during the STW section -- before any mutators + start running, so before arriving at the barrier. */ + caml_collect_gc_stats_sample_stw(domain); /* The code above is synchronised with other domains by the barrier below, which is split into two steps, "arriving" and "leaving". When the final From 6884cc50cfd386819d211c9e247ad06b1b802cb2 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 22 Sep 2023 18:09:23 +0200 Subject: [PATCH 130/402] remove CAMLno_tsan clutches: to my knowledge the gc_stats code is now race-free --- runtime/gc_stats.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/runtime/gc_stats.c b/runtime/gc_stats.c index 09d5ca74051..f6011a81a9e 100644 --- a/runtime/gc_stats.c +++ b/runtime/gc_stats.c @@ -23,7 +23,6 @@ Caml_inline intnat intnat_max(intnat a, intnat b) { return (a > b ? a : b); } -CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ void caml_accum_heap_stats(struct heap_stats* acc, const struct heap_stats* h) { acc->pool_words += h->pool_words; @@ -48,7 +47,6 @@ void caml_remove_heap_stats(struct heap_stats* acc, const struct heap_stats* h) acc->large_blocks -= h->large_blocks; } -CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ void caml_accum_alloc_stats( struct alloc_stats* acc, const struct alloc_stats* s) @@ -131,7 +129,6 @@ void caml_collect_gc_stats_sample_stw(caml_domain_state* domain) } } -CAMLno_tsan /* Disable TSan reports from this function (see #11040) */ /* Compute global stats for the whole runtime. */ void caml_compute_gc_stats(struct gc_stats* buf) { From de18b89f504e976d2d41959b71adb6550186667e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 26 Sep 2023 14:07:09 +0200 Subject: [PATCH 131/402] Changes --- Changes | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index f44224df2fa..884bf636db9 100644 --- a/Changes +++ b/Changes @@ -347,10 +347,12 @@ Working version ### Bug fixes: -- #12590, #12595: Move `caml_collect_gc_stats_sample` in - `caml_empty_minor_heap_promote` before barrier arrival. +- #12590, #12595: fix a race in `caml_collect_gc_stats_sample` (B. Szilvasy, review by Gabriel Scherer) +- #12595, #12597: fix a race in `caml_clear_gc_stats_sample` + (Gabriel Scherer, review by B. Szilvasy, report by B. Szilvasy) + - #12580: Fix location of alias pattern variables. (Chris Casinghino, review Gabriel Scherer, report by Milo Davis) From 1a9c45317b2c6c9ca9b4cb95fe4891f9f1a2820e Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Wed, 4 Oct 2023 10:05:44 +0200 Subject: [PATCH 132/402] Fix variance composition (#12623) Possible positive occurrence under possible negative occurrence were forgotten, making the typechecker accepts the absurd statement type -'a n type +'a p type +'a ko = 'a p n --- Changes | 8 +++ boot/ocamlc | Bin 3159598 -> 3195717 bytes boot/ocamllex | Bin 392055 -> 392500 bytes testsuite/tests/typing-misc/variance.ml | 87 ++++++++++++++++++++++++ typing/types.ml | 2 +- 5 files changed, 96 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index 884bf636db9..44a19c000b8 100644 --- a/Changes +++ b/Changes @@ -440,6 +440,14 @@ Working version (Fabrice Buoro and Olivier Nicole, report by Jan Midtgaard and Miod Vallat, review by Gabriel Scherer) +OCaml 5.1.1 +----------- + +### Bug fixes: + +- #12623, fix the computation of variance composition + (Florian Angeletti, report by Vesa Karvonen, review by Gabriel Scherer) + OCaml 5.1.0 (14 September 2023) ------------------------------- diff --git a/boot/ocamlc b/boot/ocamlc index 644f7e1b83cd69e87a4456ccb64b96090ec88eef..02675bc831fc30e19c5e842934b28ad3527a91d5 100755 GIT binary patch delta 383119 zcmd4433yaRvo}tkWikUZFvBF7tYiZcNFs?47TFRO0Rc$_0cA@B1tdU%$Ra3-;=(IP z!T<#dnkc9!Y9inP1x-W*ktI=FP|(EXRTMCBMMe4l>dZM|GV8`Ho zy}G)(x=-iDvsL221N%kA($*rxdw1(UMX)#BnIICq)oslGlQ!5|OyHnw(q)7(x+B11-9f~j~>lG~f>4!c4$rEL<*dM#e@ zmbs^O;$++ucrB*GwSu*6f`+5xFcncaa*a(t133dC^gty7`aR&cpD>Ug>OM^xF&J%9q?Phaqn{r z+_e2u*-rUy%dynZKh#NeuZURhS5eubh{QyBAWfX!)=ryNh%m|?;lhYUD{2PvY3Ysj zc)V578^j9lP3?-kv9 z*oFYZ4Ib{z>K>WV1R*vbu{JpNt#CXfJRH{o$No?=<&M(sPg#&@`T!55bybxe*?o6Q zVgl8#iJR*^k`?AH$&3P+bB$#dReWVvyir-1m(e5i%H8G7>Fw6@ct(ubadN=IXfa_& zPVVt2uzTFyT`&?kcTXJ)K0nh*B!jE!-=As=LIs?th|`-Ff;oP|4s>~E5#wEXB8e$G zi>~mZlZEHy4|+<-2-0WAh>t2Hr2p$=7ZJ20^^-pZfYeXAJ~i=_+!Vd)b2EC!-uj{- z#P>Zj0puIc{05>OrRN@QD}vTVi#zatsX#`%sznbW1qr(9Lp7d?K9UuRmBjpi#KcnB z1Sys-N}?NTmM#l7S2Ojc-EH*YiSMSl}p5mAPsqW zWtA&FgUTPZCTh7M=qqoUQ?Z#-7enq5%aG@0k9f(*no3IItyB;urg20ck-R<}HOZj9 z5ju|)Mxcg=!o_@GFGsBgBqGIJc!iPTd6XUAc0Y&{Eoo zy{(Y5&Zim7rvMgr7K!k{oI@DJjG3WPn8>kx#KRy;?JL>@(X>I*P@3^oq%(W~hQBS`V8icY z_?h0E8V}VyC0nVkq^*@U>~qD^BA3M}#?#&H;ypC9&=TevXi&4@;#{t$oG%kSG^4NT zq%GfioXU^CU%EtPp`KuIr#G*&hibHr!BjO^WQs{7t`%Kex#+rCNXgyDqOORtuGM*| z@mets1J6q@l>}jFo;E}*H#tEWDtIN(A+UxpGqNZZ*-y(cCdDsc?;O)210BiTdnOt(0AkSrQu}6e_EV zS5&6Up{(r0E|l_P2k=|I2)kmvp8?_jX}x27^>)rgFPEs+L2jJei*qrud15QESTrU6G|8nUP`(|Ah zf`(T992!O27r3lcbu`g>^;3T~&u4W2d`ke_@lU$zm(X^il5EElV`%8{MCXki{%D@Z zui#?;HXaIq#|OYxz@}oc8ujfCw~gYq3XjO6!ucYm!>L~{UE*H#&-E^}&L7UFtoFj4 z%Ip&cXEs^|ng4)%^0O})D-J2-8e)MeJ31(qa{rCFn|7!8Rw)7nmHgq1f@rrW@%=#9 z8IFH$IGzH%;GTmU19w9!@A)`^2LKuMzDf@q#z2#G_@e zi{3SAyDo9j`m#J`r zAhAQ|#Mq6{EvqcT8p^#EI8}GHpnERLp&gh_?}uvzXHK=iDLO!B^>FTR=4?~<~Mw5h~BerVNs#ZD93w{U1~>);ANe5<{NV%1$bKrwtbSH2`(d zP%;2xR`VR>L+&ChJq6Q+ohmj8t9S+d6v?VK)h!T;c50(|OA?Eze3NiXiv>NB9~40~ zo1l#>rs~bmbrw_lX0h6UY>P30Sb*6nXJn9@8a9ia|3%_J^6V!tcK-RsP|*{powH0# z3(rB;NywU~XegXHI615WV#LeKMDOTPeniY5nnB3Jw3~h}6EVZ~7*RZ+Jh&^7g#A0= z%=~$;cn_Q|ui$f5uflOQuNnSc$}5M0wvS57u_(T-)s~A{B9Cij&YznD1kdjQg6E?E zxEe6eH&YOCODADQ!E4I%DQa{^yMreNBpnJEJF%c(svB%kT&VzgHaFFV8V|VK(vN@A zb0Z?!|;`U`r81)sGh(Mdh=-;ILe$t`e=$fsfUC7WYh`)bRhYwJX3+mpMN&m(EVMI7zvujnfqj5*{v=k(|s$)%Qn@qO!%|u_A=37l$WO_Uv#cMco@d zzLUiuZf_8)2He4bSrTz(9Vsg$$Zb3PqmLDmsMO_jw|^C&zvzD<0Nw(aigGQ`owf;U z`2WuuV`7YHfm((q0tPeBhBxtT)-iAS|OE@IYc(Au;!EbOlq*Yho#7 zzl0s$WXk!#5=ohRAwm(+jj}UcV62zK%J6EG#Il9OkSSYOmb^*z6~e8yMljS{8VfzL zLX3&t50JTtQyhTvPw^I~=q(OVbR~4rx2ax*cpXs*aUS-g%^t#;9)x27b;$7Fq0(Ve zj5l+j({=39rAv%DY@ptyU6t7F9HGKnq(};W8GT@xF5SHc8_&$~HYl@SN?79W#Kd(bx5h}MV#Uu*YU^B|A}i}(Zl_SySCQC9 z{Ms4>D_UEpGUDO=KHIujK%0pIvnsCKJ5%pJsjt6S5`QKcSx>aQy>M zllEc@-J2@+Vn7Gc(Y<1v`U#gx_50ADp9b(nYb$X4iuot`+z;2K9eR&KH%5mpEDSv?&4Uo`ObJ9{uvS(Pl?=9j|RS~O}ojbdOM@uRo=6OXrHnX;=wnxTlFu!q5#`io)} zKl65yMyS$7I?-DS_C@}x?=hEJq!BjpoAyo{=?({N=!+t zS)~?2>wK*=S(XG22wqh}wX$K-S|Le7>pon%!6M0KbdD4zNs7>39W9NuQc6B59yp?{q%HIRkWhgS<+*uGa}tuX1-LW3J28} zN^TLwJ2r}%Ck2aWee>3i(&tGrSmAQ!Ny#DYz>xe~1IN;Yxx5{f&XbnF#_VH`a2k0B zs*Js4x)AWKggirswmW0>Bf=Uj+pjTGhZ5y zaVU(7aZ~=C=&cJA!<^KRgOj?No^D0VpuBHF-8AvT7$;3!AVqcJTJkRrZU!6|%$f4f zjLTwxO1}?5%gQ5B-EShSu2)eT?kZFG=2GdO7BIst3g!0?wQBZ-(oi8e1jKh*6jF_LXvOhTyUn?l`fN(P)e~h zp2|)t3KiT79t|c(k<|k+&CSC#4 zLcqe0)Y3F5xD6r)zwL{>=^$p=4cfMY(i1Yye1^R%;W+frPg1PPk}yLneqSOXy6baH zOZz~&Xc0YpW%tzMDEAcRK`-sjQ_^UUxW-3U_mebKQF~+PTT|(BoY`hxkh-a?z_e+C z6|Llgv{PVGZN4ata`a_ll*l~epz=SY{*Hc3-xPK359uQir~fStR2{&yqVl267)rSa zVPWLKnovLnPuTot9%K$YDZhjqlFm41XILNDz?i#RL;B=72YQge8nM038=Ku zt>sbTI&F4qIYx-#+Nw6PEW`*Zb)w9XBwTW`xSmp7@)I~7Lu4{taLH*Qygsvxk>Oa0 zXH%4&(p|7VJJZ|><+hdIvfY5ld?3?&h?3c`w`IHKp03eGYF0`(^%!lVTmG#z>RcKx zlPqqeP90^)ajmkW3|1*3_}cnT^3RC+r4vVurB%uD1Tl`{QqlUb6giEYSK&OeeX5*7 zivX_gg20IswDD$YOp!g|T$!;bi-#@-ju(3_dje-MBzz*!Y$J$<>kr32)&*{$;#Ap# z6O)ap@HMWgv?-+O7;aNQkMlueFcd zy!1Zkd}}Yc8~yxCoRdcMLT+uyagF@FIt`U?P4xri1d8n~gR%6>0_!t^u<`3H^W^~~ z#)7Do_Ce9ot%6?cCdaS2#ZCqNGCx_{r(UMBX2glI(etHWw_mdBzakuuDr*pNB zX3Fov+n9xZxJ`2nkasYX9T>=bQ$$}6LUa*L8Z3LobZQ)|Lo=^szUIhC2Mc0UQ)lTJ z6gNbkC1y5FcUW47$V1Vb--pOuks@^{(6`gZp_m^qg7L+Os3&3PsGJ^3mKoUBQAyH=s-AQtb_xO$EOA z@uN|CA%_#iyr#q>#2s4d7#XVMd|zDIyiN*P$6}VXq4e82V4)f-JH?$edn~5b0<aDq$9$-FJaQdO@UDy%eix6USlj zpfuNxmlGv4>i3&@7Etj7c^N$L#2x8NI7g)G2xm^drHC`vxn&45o3jm!+52vN;m@Ew zNQ_#iPD01Fp~}^`5wd-fT(ayQ(DRgFUSDCP<$7^i&MOet#lW#33B>WV;&jDVz=asN zdz<4T^vZJOIpKZ&NGNgOdk5uBk-O^RxdrXp>A{))6nVLgPkmXmBvN(0Jeo>!E4$9eV1>8AGp|dyg zB6$l&S%g#hR7}gh)OVW9Dx-e9o3<5a&zZN%TXcPJ4*m5nYb2G(L3VQ9CU-NawA|a| zB!SB}E2hgo(Wx17KCPW8=hD!bayDI<39#aJ6AYdO@W?C^Ov{(^Z{#ZPHktrW@18vY z@T&pvYXR`y02qe(eA(j)Lw0d+yoqG356qD--{;~kWfhB;JLZNWZRBiuAkXd6IV|Pq zg*kG6c;$DXM?FpsZ*kmdf*G@diha7FF!^*0PJ_-9oCy zs=Q1N)nf0J>sYH7%jGVp5R|fo>YM16R+RNJ^z*9aa<{zw0iF6*0DK?-emej@7yus% zfZri#p-`(kIbvz;{c@N%ti5o*JVBP;#Zl8D?2uwt$k}}LqHrxn2VMCj6y`%~<%h6K z$yq1QlEo2i-v)U<4_xu1=%6C)^rP~Zia4rOKOyf>Y{yU_ZztcR$~%=Vw0(W9UuWGB{=m9N1PmVGe-n}My6d&ji&t&k>2vH58* z$T8aUG*pRWgjhFKJPq;3MOkUz)ADdVXrXl65YSdW!!zSJ?Rr)wM-50=(_tm;IF;IA zHqO4wW2d5Rn3=psZ$&R`gH(3V2iwpXXjjk4z2VJ%4)fAMw&&%!x^S>yBh?X>+2`fV z2u{Y#&GvsQ9RGAi7j$f2Na*_Qs63Y8?NDvnP~YwHr>=NL3dho>qUxqDO%%!}auph{MQC9SWOQwN|B0bJS+lS&RM)sFh95B8p zm%wyc`WkvB^CkHqdduTXqlPbGfxY;WJl+r_wNGFuODbfm4S5(-^X>|Hh>eBqazw>a zaVxfzRLH^1rInCp2~>VpOc$C_iRqO<>2us&s9--V@>P{`u2@BJFU!x^-bZp@|JJ@N zkFuR;0<(5vX;$(VH4<2^ifl+PV{jT2%@f(>*b38_b5?X#V)j0oYb;3 ztg+$~fc?Bo6~qloVQZN9*EOZS3qRH3dCtf zOrW|~<&_;iLq&Mi`rPpA;4@dn!m*OcxOxrU|GtpEF!p>!`{Xe?hpBXOpFG+KroRq( z^BfhP#_%tCT|R635?L{8L{a5#Ig;vz;tE(%TziF%9E8~n`-(T@apEib{S7&})7J*A z|6*#cZU6Si(a0*fhwB?evChdn>KmV&Y7|jXC1<+6HE?WA_2ERd+~38!^?xMk@A~c^ z(dE_9^uDJv$WWXm^-VcOpC$r^IB;vxwn(eDW`Uw|)(#r^ro6*(4tX%R4z8u<*e{b} zJ8#4trxy;&iMmh#7DAys45q7wgSzPW>!6(A_yLrc>zaB9r8kh{9f+t#%6Uh2iy!Ie zA*>%i`67SzMgGE($yD-=+)e!zIYd$^DKXSg(>iSZVHx&AQV+}19lrs^S0H^IvG}mu z)pY?;JgUDN{vWjOFxIv|0XFZSuMf)~iHo%FT{*_ZbCWL&@tF8lzH{$F(zl`LBj_fm zMVjiN>?4>;e^DVv{q6HEY1@v-U1bTkT|YZ6Uo8oV9+@Oy$z2U@E?AJHP+E-~W|LrX z@l`RW1{&K8s;$8?cPmBLLYe>AclX;)v8RwIw^shyh71k*N$<&BZAufk@jZEoq)HU} zzI>O%Vn(BB64hV8m5++|ApqLYf%oM%Y!eX8vY~}HJ;OrD+uYD%d~Qj z>d|sPl*b6ak#uD%iPYyLZXGv#BzJSbB2FE!+ttFJh(&>;lXc8API=5=r^vp@qcaDz&RE5N6>_982{vE;nU= zDtEKFO&qQIRQ}u++yp|n#n7{J-N7`X6zg8aDY?BZqzQZa6x5nfnt57Iws{b%w}H~v zz_M0xTJDJ>t}~~xZ#hnm&#+>J)6CCwXca>dCgk{Bz7MwO($Asc+ajCtj;oiGT~S7+ z@br#}rb+d3jH8`Ng$|P`Z!fL@*I_%eylgB9$(Dc=JWIxs_*y1gdw?w1W@_bMvsCXu>NlY7 zK)t@f`kW8T9Ry(qimSs10r^z_jXcWL0ZI552gj2Y2k_rwPnk&N-7(Q(&p<_B5-Zj2 z!kA>9k$c*b0Q0~;NyTTdWlf^`Gx8F0dT@_?t<#DB)1inJd?)vT>hr>P@(`+c7K*ps z+TQAQ#wZm0J#NmQou6b6`2hw%9(Wgei#J1DhZdCnJ?{cn1zFdBkAsWs@8yX$^R`P5 z+681rCscrK118gOGL{?sq2}W68vtW z)0G-<_#8{ojnH`e(Xd8+FE!KWt!R|L6#Z%Tj}TJ01N|dby-adlgrZvYqkIZcn}0%7 zmM`kaPuLX~X^x-SJ^>9BH^apM%J~(N4QleQa)Qkq=5l!-0Fha2VW=9z(?xw&vrdYF=oZi45b`C&@187@Ou+A8S$ z#CD-nb^&JmnlL5Iz^)I!Oqk*eXN6zRXSpA`BD^UT)%k^;5trjL{lW!);WEE)O~mCQ zvDtFQjX;x_#YP(b^@cwRzJ4M@jUP&pYu>bK*^x?;aAYIi`rf0VM?k>eM2lH#J3 zCFwUHil+_BbkjJ>%*;|~w1H#s|0NvL^q`~B%3Lvq`nFU0iyr*l6K!gzbc3Zu z2Vy=Ykx0i?YiB!raTcRQiGlnTkhkb+1t#5IF-j!tw$(984_X<6E*a;G8qZPF#ZBx* z(x6yn8cenbCsWx&(3C!oRZ`Tg$UBl65A*(LMxvs{#-WSEK+1?$dWeDA?06+e=r*Cd zP|+Kya45`MB?%bGZhdj1tg4Sip=T2mCqBo)0tChN555*V60DhaNZ>|ig3?D46Dho- z(!(*y=qbHhXi`TdvcqIV-Hwb|E>D5G3XXee3gS&0*bTH9q%aBZ>8NxS!|7Z{Wt<}q z1l*;%uBqiDD&qu>lC~wG|Gw7FBq>h`96GJ)tc;e$En0o5qNyRgT=5)Yc^wDGV&@jB zzDaRwRb7=btC&i8eU$grX~;U#o0k$v&Uazk7~fZ!@6xw0E~>p==`TIkg8t4?L$#z) z%Bdho7MIHRmV$8&t0b$f-COr4OjzTTTyd*bK2CX1=t=Rd&g*eFuXqbbSR=YBQMCLf zCF#mF(omyT!gd>K!Hs*I&Mi`V*rqpusf$&p^{1i2<47-0jilTON(yeHq(2TBRW<=! za|;#Us=CqsGZU2Ol@2qJl*Pl~Q2d7Ea#wd~(fKj>9@pKVRAJ^Kkp%Cv3oDAHuG+ zWD5*fb$2Q=3`0fZ_1NF!E>IL?a_a(Rpb=d^7>rf*kLcPXP|9N$8maN=Qg0mTRds3u z*2}|3hR0~%LS>dO3$N>KT%`G3f;noDGEo?Y&7AMrdg!giN_(Fz!<(bI*WabEUB+>j z!p4uyUk~(*FN#eVXV0zuU(Djk5kX^8Alu;jQb78@`cNd>GNzYNrzqD&6$2ZW73q z=fE|R0YQql=6O4vU5njo=0nO6KErkV3-Z)Ko#5%S0(UAF;%a8>@-~XTC51p}GGnup zaM0cV!usT*b4U>$C`T`=0dWs2!<+WBEMj>P^kq=|uo8m|${$9_fnLraY@Y2aArT<6 zT&qCH4D|?noEE+IV z&kDrtR9vdWKqC1rhr}alDjYXn(yIhH1hMxmjB+)lP>Li$|1MSL;gs#BHOjbtIt^&! z;5f^sbpN9`I=@DlgPq|dFP8cFq&Vr+fjB!(<|@-6RGqDPY5E#R$Jt&8zPUP?R3Oo@ z191^JniFf4kHkFf-HAmc36){hkJk}iu{`_ZC0FgV2(i4+;a*#ea29<2F?^RFZV3&0T)~MhdXF_O zcD}{F@o~lD`-0Q%O@BLvDqh7>llG*d;5$NZyKH=A{jX@dmiwfVDOB!PJH^ch%VhVH za9S}R7Nx4ElrUJDjFk`h@^3Jl+3Wg>sK?^EVN*P{+@eJA{i%*ylxrj#XTW>6I4V}$ zPyjYtaQpWqaM#MGm24*a>}h2^Oidt@DE&URKHeoM7GD|k_%`JaW`akbQ^xvbRXf3z zKn+hit?S0FD;@d!$(x^4BD9L}xnF4EF>D6+5q66O4cC3VD3#mSYKyi>WJ{TFvC?Vy^_v7O4JfVJCqDV>E> zEMeH=so*+KFcmf6{&;MM)(Y8I;z*_L6{W^;FAC&(u->_X_GyX-E&4!HzJ#}Dw=zoQ zS&M^(AgJ9nlQBcn_9!V_%;Y`F)tI5Bdz2;OKF#qemVWixGq{UI)xFrnvEDely_jj!6cos30IT0D+87L2UlnsN6c&Owd4g*#;S6_VUc z2Tml$1bcw;-@RG@)28;=qJB-bYDlP#)VErR9QGVOCE;q_Y?OfJwYblSo8T8W6>;B(PQV1}9N4A0DXBR#wpe+7I+a?JQn!)ytc{U+irXIH(S=l_1i z?x<`QKXbn_+%ctD6i9iIsb|dZ_?n|xCI$uEy4p}X8^1k>6z)dCd_reH8juTTgp3t ziSRNlKA=R}W&_K0cT({IX!{eX60z889cAP-2GXq~qdOU3Fz7iAkFi-w7{$Gfg!l*^ zp7iSvbo1LvgzXDh44E>F^4>=7HB`z(Z_o?yY%dzfNF8b0Y=BWP!^XMAN)iV_yM&_I zn@+vpMc-)9#3E15cRZX~gF#ftlwD~RJX^d$nV@GL?J~gjMnc|lnh9G_JtzEu{$lSl z3O|IB4xjhcJjqC4&M5BD-IN0o@eIvoZ#}JmXS?4>kV07p(bV}=&B&>An!Qo)g2Q*2P{tl2H8p)o8X2P@ma?V$9H!5VBuc(}n@6$f^-lUUEQ)$rPZr@?hl#%N& zkgF+`JuIK_qGuX3eT)V??APM)RLqn^Xfu1=X%8ppU?j*i60G%05DYs3C~>y@t`ZsY z<5^!7+1AaS$b5W)`o61p!pnea1&{}4DV*8I_tI>j#WcGAT_qvC6{!5#`pEaq;q3wN z8ajz`ZIcnr884^$d(;?;I-*2LzkNs798t!K1yp)O8F$mQ-(0%H)iJBJ>$~PTKNbK# z2-ut~oNfVN7SCJ^Z=KEhPo}J+iYG1;XkOgR?BfCZ&sQrgKB^>#e}<)kqdAv%{c_n) z`xw2+4}H`RT}wMYXK@=vRzs!KzTrS)Q>ZK8jgLd0dF&4+kb#xH1KvT z_3tU6%j^c-uBLcjeyw7KT#|__P7@OHv$f;)h%T-w*h8aQfoQA3)Z^@mCeg zwVd~rcU9OoqE9Ma6c=BwVEGmY$Gv|{n{--9R&WEVvR+BhZ`(egA&3t#j#1XXmB)M@ zZV`T?6qw;Hm&01-w@Q1-_8{a&J7i~}#=oRUZ^>G0FuubcKAP&kQxa%Xn|M6)hwL8G(mm8h(RfUGl3kUN`l$ zrpia1?pJFH|LG%3fBmU=97TxZ z9@MuO6n7C~4!56A!*=An4_lYqi+G#Ewh`$$&2g&yOIe66?)10vu&_O9Mr->nDG%Cg zk2S#~ZEB>jZEAuGTdH$giOp0WqJAkJ*A9fLL5g^Sjz*|YKo^}IsgA>aW^d~iq1vfP zb)pp_y;pm6nXSAjgX;F`6d|6ZxQ^;5+f!yVE$*o9hq1qJqWYBBLiLGiSFx2n52Ylj zQQ~P|IG4lE_`++GRK7H}D@l#f@4(!LW+i)zGho4Gsy3RVlbS5Vvp#mn?yM$t+J@q| zi*z*_-8B|rhBM%v^T+Y4Sjmp(&Dw!fruvq!`kn2Jtczf{hMqkddU{&2+CF-_KOM44 zgfn-PFHm8!>Xu%V=*46;)b^4|N=K7X?~3MNr9TMcZHijqco}g#ZS*>8M^n_PeEBoI zi`oT^&+DQNF>DL2U)#g_*hL+rAK!DU;wdgZ3ZLmlTAgcfuoNp`Fz=J5PW%t{jTh2X zzCvY7S09YqfkK(h;OU*SGXUPDVPC#l7O!Yo89bbthC|y(N$jS5J=FxUhw9;}uObyJ zCAoGS%J%4>XtBN28ItQY#B%lG;CNc?)i(B4Nx{ni>6vPOa7JM!cnM~dEOm*%MZHx6 z)Zx%)PYzI*guH>Yd{D|-&lZdd^ZIH|u#oBos!1TT4N`}|gF%K>-NHf0(M6RE-9oj4 z)ULKFWZ|0uj=}0^?!&>V2QvlM+XTw(>rtp|Ft$_Ge9C|$xsBMFR}EIJ%?OjBzc{W{ zBSUy=KNofI7Xp}cbudNM3;}!OUaNM)Xsx?e?STxAUaRsKM$tpm`v8>>Q3p1EjffhD zs2&%u+Ws80pKbaH-ilGUO@gBn+yEXt6n%^wW)4#$o354JPL<0oZZxEP7#jN)RS#1i z1I?uC02R^QK5z4NIDbDt2d-1Qs&Ats#!&eL-1u=0M*|O1?QmcZQPyxwKHM~9=rC<& z=v^OlgnmaPEgGrXq2;BHfM_^I!$zoy;m46#CMwQ99@HA6m)B8aInLxajZm|3E8^S; zbakzteFn!Yu`v8+ja1#K?;#2EMJ62oIGgtom&pKr44(k3i%2L*sCVW%2(~iL1B_dJ zJz9!Srmk0g<~H2RoR{R*tuM=vl-EK|s^4Zz42ecC9*%!{G)7X8P+)B;7^V75?X9SB z8f*?_)3Bkg;5~K`?HYyNaL}1i7((1L%!Y))t@muz3n(>59S1LGvf734UWlEla#Vb3 zj*MA_YF>x>9Q2)o{>s707(SrAK~2zEfhW38eiz;VUS(EDfWyVcN5b6rMvOg`CBZVv z8IR#Ivs!n{x9HQ}JlDanMO#mx^%6)#s5gtC6!!&l$vSsyrNo`$C(+ z!e>Wgu<>FKi_zYw6#sm+*Qr0$sXJVWn)#c5IyDNMMUCTe-t!Sv zB7aA-6qI+YBfbT{O!V;;h>Uyet8UVn{iYk?Wsm`F^g(;rE25J(LU0z5ZLIpBI7y{r zF$|yR%q@K?(Q_?hBB)_38hpyf@VG|EM}j@asqL|!(r3iyz9?MORA>|89d#y8qCL38 zD!Xt2x|B~3ACm1&v-Y2(i!b`dtFa+wTUmlI_XiGcZ;Cw-3|1Ns_5(*x#RFftBf*b# z<1Y_Oz24FPO}BmV-*(#zH|bq-`X1gj?V7BPqV2hA5~WO0 z$JoxGVCJ~TDLqdeP9=-cr{B}bDeC*-XMth?bI$P38~zV;AXlAgYw%Cm1>e!)*mAT8 z|IwiO$?$(R{9m-Aw?IyG`W3J_sOI+*470xRn?FwLG!3$&>DZIj-HPmS`gtqnxVWIX zrmI1gmcJtfZ{=j!+pl#*OH;%6L-I~;-A)a~3~A}D-RhyL?!59utBSX*brOx4;dIj8 zO%^*n^m^N1%0JjKj7pvfa(dr-CWRUX;TSyk8(i8h`4^543*HIE{gBN#6@RuKpD{$; zhl9i;9YCAi7vs1%N%2~@IcX`b5PPRN!l**EDK@qX=D;aor!VUp{7;!BnyV zZ?_hFfWw1(qpW2AAMl#?7U| zc40UO{VKvqvHy1CAmkOix@4alZw=u-B3@w<2f9CkWIR;z6;BH2VTh8n#%?kLH`MdXq%959Ukkc4MFepA9| z=Vwm5uo{ZbQp@(B=f2IC@FZIyCVOrzqLy2%jvmM$9ggb-tL#k4tzX$;TRT?`-?(LAONWrU(pu%B6o(?=fyb`d^bR8U@f9PoVTtS{Z9jSV+gpOB* zqQ88}aqMvZax-4o-QE{ZgJfV2lLWa|(;GeNti*q53ch$M*^6_0e9JsT^7Qi0b{LX# zgSmJf6E12X+!DAO;b4NhG!;Jo22y=K4$1vHQNh?%9>gmkOpi;3Qzdr@Ge0+ur_Z05 z47_fqQd}-1^s_TD2z}DP6*~*jD`f@fpS6eZ>MABfEfJ%w*xMIjZaQj zj&)n{C9OD)s|Xc&NL==zqPV!t%mHS<%%Qk3kmofKm{B#q;-bjzkhb>l6R0}(BC{Ji zP8AO~m+IGrCeqFoINR?z2Ny*3$yPBk1Qq%d_WUD*P=(B2@sW4#=eUxHH-%MSvf?1T z2y>CJjfJ{CSKvXNneHgc?ZGVeOblL!>w(vPOJ;{)1Y{f7WhCb6rXHB91+U?NPcNlr zw%ciA3HBE{1~+X^;(PCa0{(6)AXo~;a}%G+p_DrVJA*4o2Rbw;!dY6R(1usIx}Z{1 zk@;9Ee!VSj(3(QzKak~IiHtIrq1w*3;+9q~kP=B;S{=XkirIxEqx!uWj&n%b#Qw}bD8^1$%- zZx(OdeeP7AiCpmxa5}rdALSRm-Y=X@mGdNbw7(gwn)3!pG8{xuiaqn?RC-aVYe7>sHK1wouU8sAnj>5 zj^jq~j~{t7`-azH{}Q8tYvrxHCX&Wn3WxNQJKEPjf%#PCYKhM?f;xf=`C*Te{fg6D zcMYDKJKzeVw70>hRo^5k)N_AZyDJ)bvQ_F5D#6osvA4KQq^&E8*SD2)rcjCzEbVa% zu(LaGE=bsJ<8kWFQU`nhnc5N0_TsqP$1Hu3*%g_kw;!|g(V0c(*b$V|F(~1G$TE~; z!wsah8s2Wo=8O1YxG*2ic4u?2Sj#oTeJSsDJZYLcK2C`?`Q!Bfet8M7oeFn`x|f;k z!ZOgzg85`n0L*7aCVseIc!XcLpI^AYUpUh*?4M5-+w9Ct2lx>+RfcLqaMm{h)iudR zg3O;Q`UB?=cc-lDBq&+l@@rz~0P-hz2)R8SS8c(>2PhYU~1&h_2#iBrMTc)+6O zekC*l8S;;fmSJ$r9zxb4W~(iQL&CH*Z($tAmrAPFAtTBG8m`cBs+|K}Px(ibOZAUp z?)Hk0@VHncE=p|b>VoK+t8TzvwQ)WyNzMXnbMbO5htoK0^@X!JZ1aT+INZ_~F5xgl z3)5F{*zOD0a2RKu9N&O2eKk+TG$=$!xdWjzgdoI$hehUY*#5E$RsBNgok*~hk!>lR z!<#saXTvyLbXOeIQuMJ`9g z`H~cIINld7<8Xp6T*cw`zHl9fJLuu{NRK04z2{;%oaieflfyVg;wt8HxRZ~jh{K&Z zjGjbTzqrn;Tr$-faZZuK;TVz1WHI#Z0@S|@{i2(=yKtT{B8_s`OQ%BiuBKAYPe_g%ZloPy_#@#no{xCqXw_oev9vEzhlb}E_!|s=wBe7T*^AJ37Zyx=-JIA2;_l}3@JU9p$%a40@N?;f#j0mn9zcDgg3?)6y9F@UCKhfi zoVjzE8bCMA$mUkVzs>Nc8~zN#p9y~^@?mH8%I%0_QHUQ6yi4shcorgB0piuo+m1{B_T{1`JP6QXtb+Z$`j!uvIM5RxVL1WKpQ~U8c4Y zy7h^bZ|+OBVJxNEA*#%Su$~pt)xFl6sj2)_zzAjdG;EZ?Uy=o7~ouJe6 zKwcI)eJ_k#xP;fq)n$EKi;sU7P}Y6er*lOT;JAOADuK@wbc7aU%;nK%9SsV8g; z%}nu$BrX|MEXUk%(4OULax`}cXK@c4^92t<7#!EZLE?U7S45rehly+v&AwlqiaA<) zKTMyC=@<5jDEtBS4RIHpd;k!PX%DE$`aN%7`n>J1-Icrnb!F&->cm_5svQ@`x*@8h z58M(2A`#XT0MG66$1nYF@OKB|b(5oR>oK#$nfw&=N1uoAhF~U^+DeZp1*!Xyw{srWT) zn@S#0vmM2V<1&vUbDUKSigmAFt#%8)*T@r|-s1ZZ;9kIec^j&gyBdFoWVxA?X0JwH z>kmN0;G7TzkHY1;xDwUfw-7X8NXNx;^;vi1IA+nnI9}+R#Ze)$2x0Qrf1rw$M7PSQ zXevD;d-NdgQIx8^^|`|=ahbzjD8>4qn=ZlMQK;LbQnmkoM~6qu`g!n_)4@X%Yon~{I*?(9?^T}%HhQi4+EovtdEDuyD7q10QwBZ+oWHDG z0a+3k5sE*s5WNnj)`x-SVI2y`TVJjR3;dNv{BgoZfgZ|Vr>0Rbsrj^%pmT+-SHo=U znn*+#-e*k9#ZC4aXtlQW%@Gy5Ep`_nj>n9}4NJidcqv>RNY)K%%4~)=8F(IhhBpVm zj|ad{1i)nhaCrdyqzO~rI<+faB3G@;o-*T%GPeZ4TLa*y1K?)@;AaEiZ2|CeelUup zR*yzH$k`Z+P0t3^>U!Qln_aY>@;0c6%U%eGelY-k39vc%{GJMP^aF7Gy8(`SvjQ}{ zN|+47!f=RztGoh^wnxSdzPu^?pJt}Ebpbz$5q|G?1$ z8`aL#^D))lfeHA-Dt|uO69B(T^&6o{y+-0uHD=k~e`E)B$|!2z6>w(LUcUm)Y}y-F zz?n^}YL4^0FJrc?+8;^98zE|H9#xYDyoq@KChZS^-wJ>a1i)|0-bd~T)gL2md(gm{ z)98>)tq;e?Q%$E%*gfNwA9@x&sV)bPh4M$dk$7odR&=;6KPHN^ZQ$b=e=qte9*(8K zJIL1DDlu*ax|gFc(oSl3|?m>PnQVD=_hm@iQECeO;08K(pHMI9{|@$Emz*;iVA?&-hi`f=`ZP6Jh0w-G_}r z_86F5b6v1})fIL^=y5enJqqebJg?!w@%B+vZxctd{J)l}%cHP!+lH?fPd%=V&?5&^ z{o~MG)3#b-sir$riu@B4m23H309a4)}R!yyN++<&NS+C=8vEe$H->S;7h`x6vA`oLEBg6I>`=oxzd*hR; z2A!n-b*!tgPpRYaan0hVaA<}Klx|UHv4XM%;N^FMfN`gJ~ujfKe1foC|@68(Ip_PZjt<>jfb%g5!(D*MiAJWFB z)r1b*+kG;p#rgkoh(u0=1ar)-}C&BfQzq#Za< zs|UzUTL)*MeLK|Q(ibvK_9_wLORC<9ecj#~{C&Zqbk!Oj1{yBmE2LqeW(uOO$*~?v z^uKw3+652lBH55--v$t!34p%~fWHrb&j!Hf0^suj@DG0QO*}7oR&s3{fbdBi9Ncx0 z8fE(I5FX~_1H4W@0%xwT=01-n6Q}#hA4jfNz!2q>`U+0#f2QhJARB&R4@R7;U|uZA zfH<;iI9C0YV}0+B|3>MWni!IR%y^FQ;@z~JquD?~Nvz%4w&{J4*aLA^Eq^amNlbLH zASr>$_8~`IEIdp-U&l3w3|jHJu3YL5io~W0#m4Is^OjEbk@59Y?b{GlHE*bE^*xQg z-=p#+3SaRku2M%gy*b2^P@jMpORn1-s{cFEy}lYn;i=kcthRU#sv0%TppDg-$VF6J z4LMYV=U;FJet`<##8kdO_rIxc_bT7SwH9-K=PwyAQ2m>#Cxq7u{+TGQ_A+wp$DdSU z6gr&Evp=Eg+56Q&>IEJFY8(o<=x4mf{X5_$UInfHZtD*^x*yW;Pfh}qKH2E6{p#}} z7yYBq%o~Ajjl04YJZAcqxl{H{ z_%1qz54$+ZFhUrp;tiG7ITR6Asr3kD~h> z+Nz`KXbEp0)*nZ$W|G*6GlQrab-Y6$duD52uN2qd8jf;4EXv!^mp38r)Toi+EM1p_ zBpHr}2cVBJ=r5p~wlSt`zd)U8)#T7Jkc|Z;^4A@+(lfYWdr)qNJCyiS0ClgxR=BfP zZLjMI=nQ=(FxPQU7(Gx69(t7j-kIAQyBUpr4~y%g{KPgc7j1(j-8l+haE*9RjitJe zagSMZdh^E;0VOqUFm7n8< zvO3(=8u31E16`om?_+Qu#Y0`##8h1ah2-P+)iH=~^i>q`!vU>2p;K`+@i+Fc+MiHI zh~?z?K)(pl_XAud%izE97fEFwsMFNvP&6(WZE2IBrF@7>4tR6gdwsW1s`^MB?~>7h zJa4!|c3qMU=BpY$52Ql*lqirQqM~kMZ4;>dKdnDqT+jU z7!TUwlw~i@w~u^=B{GTIHy1Wkw|>u;pAqP)8z@U2ljIuzf~)nhW| z^XTKZhTl_;!8{=$$y*F9EMcDd2sP?yz1Z( zsNWZAsIG(-0OmZH<+woHYu67DxC2V)&M(wtsg*+av~L?qyT4HLZ>YgF^Av*?UW=~- z;6DQ3cF545zDoc+?0ap&m+Cx;3R>gRLcy~zXf@m)<xbD_E9jkIB_@vlh!2zS-i9X^cd^~* ze&1wYd{*s2^N-;To+GrmHX)`{LBQYjNdU~E$IN-lZ@$k9U>~~H<%Xm$T;g&^3tYoz z3jU1-1^W+U^xK(5#M|Hck0%F@4s#cfS0P~k({`uYz0H@$(SEswRKgq5ise6Okulrp%!1iy# zr~o+J__~V)^J+L|5Qm~ah@ZuW-wd|~!?525J`X?~9K%k)JOC!_0_=ab(3V7_+GXU| z_}a>U98Uq}Y*?O|jK#dUFyJe#n~kru%<&!0=_qR!4pB=QRjV2a7%QA=gWVT!==Zqv z!A&)J1oNiF>kV|QQ4LLHk#Q&BOgR4WoZvVXF`01uGvnrv>qlHSUe`cZ{iw#`Bf9>OqN9MEg}#lNuBMDWrmbhKG$$ddwj$K12UT4$^gJsP!-ERp}pn>+4tlK3s=5RyfRjSQHc+ zaV@FxN!hLbiO-o@lK3&yBYpA>J^qUt(b0=2f2NzjBuL4+7MIRl82^p-*)QrbN!;kI zzs5t)j=+cE8}5d*KJ>J(cVH748m22d1L0q5ga^Ur<8Q9hU_5XJ5#MkSUGnkMBF$wY zh8hGzskSb$3uU$sa;~=|;V+Z^u2v~{m#_S9sAr*C$R+hPtK%OM9wyh{op=b?VM!9y zkRPsSNjA%J$>lLRnmKnBN=T&o$^>kOJ@_kgVZb#vTU4gRccJXRajz)KZt3X?2LaDc zlg(F9;WMqFINyM+@=`nQl|}gFpudNj;D|&N_adh`PStix7e`dHsK4x%9?cg$4U67E zOGq@x+94G@zY??NB_vR0uw{&^9T3eGnskCXSJ#NYqL68e!=0v>V0_@B!K|En01Gb^ zJNqjkmJ^aA1}V)ptfG34rAu_Ie-sK#faAetvQSD5vwRt_;%e=}EjP%`E3U8BT1k{; zyX1;PhAf)Qa#m33jjfX@cU&Z{H^x{BSb2`M3~|N#(ec?xi{^CLCd68D1N9+!T^4T%#`WP{@si3~Z33UN#F;miR#Ng~nm5>izrTKL`9#!S~N8k1z%Bsyu0NtR_&c;It;osAlS zY1+eLwJF(>iFDYs%3^> z7>^-x#0n}-hGyRFDvQ&>lQ|xa)U_!dS4g{C>RjE>3bt!q4Y{eGNl|5Qi$~>X z*d(Wh#z+~yB-uSInc<;`<{snakY^$b4Ic+)Wm<4?wudDNcQPS@sB*hInbO|Fo*?&D zY}sOa;s8`nO`UpLy5i(1u$bi(91Fcw+r_5vUu^rBmN$I ze-Y=u`O&vF7+upibHzsCUc$NFmett7+}+0#X_i;f2f|1%JF*kcFXj=wb$+epId_GY zBPq6Lzv7x}-A=SQyRXIW%PEGI;*qQ?w6_;_0Xq}$WI-lUUhE5b!N!;Wy4KfdoBN@? zsP^gpmKdX|6owrB>ydfv3g!1UxFXA}DGUx-U{JmNdKeb3EX#O((`KXUkMMT%1rSH~ zF?z%7=&|S#3mkX!1&SMB@kmemZGYEW&>#5&EU_+s=Ft<=<^h&S=>nd6<(rf>11#+g z7RgzNyR^=MmT8Q<=N1nvRRc}7fNgk?#Tw2G%HzXxgXeK)xF$~Y(dbMp^u?Mo2U*tY za0_x(z>raNJXX;f23fj^aMl zD$`r3`dK{sRb_9jIQpY9x`acGWXd^*V}{sn5bN!S>K$5ccgGClX~UB^(~p*m9jA~ zlI$>DOC&+eS4}q~}<=s*D*;m7Af6R9z2-#iwA`W97i#pt>IOAcI_^EM1!H zGh789f8~s__zq`SvC_vBzG>=fN$C&6bXhhRZ_pM6<1Z7Gjk2t4Jq88y9OvPR=|`IwCz7l6AFiMdFw_IR@;27D7Y5UXPm-~WCL_KGUxzU<}zstEz` z#DEfb(wW0B=?XZrW|ISOTr<`@xn@%?ml3K*al8dH&~|0`iYc8SzFpf(zDy!+M{ptORvjmzo`i0 z(pbxbYA2Aipvu0=eN;9cc8J)m(4MxBv*i0>G+@TdAzhdhKOShFjebc>CR&zaA$Lr& zyd;Y*+P+-NCE=P5djD<0419EAc}&vpSzLqkCXVweq`Pmm%#CJQ!Q9H+F%!xCXVi@( zUc>7#*_T3a1^YIrq}loSuWTw#-WqO!X!B)Le4AxLs<}zwQ8e!{%tCg&5c4Gk9-Vx^ zT+D2;O}8ZSeY)vbH|J=#PPaTG#mzOa1%_W}`19a1?@uCE8$9Nhc{@J&o_M<@#c>A^ zGl1YM=hM2|EiZ-NX{1?T_zMkx5lxz9`N_7}0Pmuk@-6*sOAK%+{$4oNpu6$Kfn|xf zN1HU81!JfN5wzd(|FQQj@KIJ*!*3@{=6U84n2>}7NXP^Ngc4+^C{cn85*167K~ZT9 zIw%%YtUo{MFthy;H9EO2o)6-GKaon`jt9`S1INfEX5f46Ze^gSHaL+6_TlSQDx# zD)j;Ud+XP8k8AK{bjP0KWyUIO`APGv%5j6On`){6+l*0rD{Ny}*28YFou-uug3PZ} z8=6tnc^=O<)v6n8+wAiJTsnM_T5zLnWXghA5&(Rv;ufR3{dc^TF5aRJ-DvBTdMi0( zGs;H_GRJdmeeIPzmd0$l_fi!cg zy??`de}T=tDzdI?n202ev56YWtG}_ ziw%l}OsZ-aS0EJK$^z)RI9hl~^t&edt-=+RwoVqyQnhHIZD8J=JZ`(+QDTDfhK{bjj_u+@w0fS^dq@rP|Bd3*Bz>*zYHgoKM=pZeY?1n3uSo z?oYf+#5d=XPq+g?77rx8QzNQuY01l(*>kx^DK%F$?1pX*R@r9Z`Tup5t-mIDz+`&h zSGFoTY!S!mpD`bU33^Dr`l|XxkX|P#`yICa{e;j?r(hl*>6#$27-91;73uEkCAC3u zZOn{27_&KQ`5mx#tD>)$5bDO0mU63(eFfu5Suda1u_wP}b|dvj@QJ7vQ^I8=tpV(Z`gNVTn147>CsY8*0h=4C&?CHHR|gcTd$P0QE(!bj;W)Kw2T-O8B`RbkLIh? zk8-lvhVPE-)lJP;HkUrPMv_GsAnAk*jI=8wEk$L3*2QX98Kd<)jdO+e56mVXMW}n0N zY|=6TG6<4RQ5CoL>z*o|W2flHGEbe=)+ac^+_%}R884E)ly@?Qy`p&{TcqpXcqKK- zI*FZ(x@NWYE?eetFGXJ`4qc3tk5LgD$&-kgURF8m7rjd)i@^U%v>J|=yKT9tn@Gwo zkwp?|j2$*qmk<)x$4CCjt7&T2-L{A+D}~~(q|%0HrHP=67?&Z{jlLRhbWp9Wd&*{# zG5TPE`c19v4@~dYT4s5H`l!}+yZu257Esn&z5I$?t=tr})0>Yhn&bEofMprHLnAfC z*SB_u^3CE(pt^r>k&OEun?Gf1n+yb&*nwLM@3J&WhU)Vk7Qx@60O}5?o%h(f>j(fh z(~|T;5Uu=+Y|m8IW7pTBB?j@h)k;?To`l%&-%A5}ld9DOFiF`)_83{SMJ>G7*4_R( zk7V%PNLb*x)y-Txzvo`t_@p<{Q9KR}5(wF{y2|Pj9(N?4bNR^Dmtokh7KOl64~1V3 zarm;NbMCWUiJ)uYeUN2ut9|#uVZQ?(b8d1UeDaUGpMAA63iuXv$^B4r@2WrDZ@V|; zz39`(0E}G$%5I8hyk-R~<*s=0sTH=rro2xwCT!iJZu*n$e%;-EYQO_z{(!fF9!{;U zI0tt70h`tSVf4`{@+cg70FpfQqgb7?_sHH?O*<)_>w8xsOzZkFFJ%$PB9gv-5=*OP z580~c$fJF+N6{=_wn_i9O?rQu^uI_8N|xmOih+oTV+NgryHKHMh#oldKhbMre75UAqopMg3j0Zvt;eV*REr-B@QetqyYag~x0~ zD)canq=qh|1-dR2@=0#~33QpH;{!lC5xOkiMWL&!i$T{d0$q+2?oI}QPJU-6R-{J~ z4_#ZC3OV6Fku(d)ue zEESyAb(lPf4)sa=j?YnV|X`l`iG!grjKkoD9fva0dx=z}yeDzYN9;ZSK6Yc#${( zXOosSIWArv?}xO-xZ8UULg{6%vt`@QiN71M&X&oY66|^o&3V`W1=rck&gbzyw!37j zj!#y{OzzAbtNxzWyx;ILvBBSxmIlv{SBfu1uDvXtT%Oh4W5!eZ^}C}g%8R?pXUYGFMhmg@oXQZ-@^((?87wu7m2 zNXJAJnpaXUZ?K6S`M);Ua^q%~QRReX((_+V;Gyh~FtM zK&c$3&UgX6S1`Qb1<6Pdx0g700&k;VYJL%@xs%~~FSzMqZ1{+me?MH*nAK zOJGC{L|?LTi+glfGKnAfE3DqlS8TUa zB4-X~y*?3d{(<-N+P+uQ9+vwjt|B`3ss>we>U=W9=(PyUUpLq$LvT-g)plO;ExhG^ zz{~m|2zr$vpR4SfZM||N;|)L{8%j3Qtz?Sj$4zQy)f%ED+_J?Pb`b8s13i`ad~7MrOJ+qpS?4)IDNYr)b8Y$>-T z7Kz+mi18n1<5pW%%I&RQZvCe?cZkK`j;)+@ox=OJiUw@t6SJXSeGSBh z)?_bRa@}jFue+#4y>Y+rZeu&>=V@X8HrqzznrijKdAX|S4O>~l?{rnW04AgH4cj_R z^Y&K@--PO3qz=7lduGrbw3Ub;tJ|a(w@EKi)868!d&^dkSJUQ|YLi~7v#P*b9LRUd z@9wF0waIdKx+ytk6e>Ay5?Um%8qR9u;pk211sSiezEBT&Ep;OiBCXSJ%yO_8?N8ddp@6_sZ za#?e`Z29(wqt92VLsVgZB$|9wjd-6LAB!gIq!cxtthT;yJJ!BB`uK76GP&$eM3ZY& z$_FH$j3(Eru_RN&(d0V5rH+%-t`Df=sp#XU)mu{NnP_so%J~ph=GkcSFKU7${~Ar! zt7Veh5KR&hU6Rj7lP{>8k4U~4P5wYx7Y*!}Z3!VIx z*tOWyZ4Di|S-ORnf5kb8;m*qkY?G58q5>j4a%;vN>2ke8Pixr!HDZ4W`E;?|$o@^# zGywMv4|KC)#^qL?Z&+%9OS}P3 zt?XoDsUVLpeqrhTrn4I^-~V@s;N^`r3QOKvrX&#z_0C)GtH-YIx9O+!549m*GW$!-!>u z-6_Tli(PDwB*$Bk9N~4Hj8cmwUk_^7lWGh$?Y*f}Xy_9qb9*QnKYHO5;k zeZv3hW}NMSvpc=Fad%RIO&v~2h2K8hJ6pLIbKv?qbKZyMK@xfU7;`avf3lA;W>65x zfCwFBJoNcW`Z9jUjzoEXIq8^8E*L(puW@!#$9{k!M2VDHU{QbB(}z3!&g$Z>ZboBK z-_KY{Y>~WS2GsTOSkzYi(r8vM4B(1ZZ*h*>j_s;8$$W?yo6K~m$m3Ft{SB*K`+!qp z60s3_i?x(dY3Z-7D>N<#-cJjShha&V3^2~O5RqhnaUm?}*kg=~ndz+~j7-&VjFHvS zigFD!%HdY88)yt6O39N0jVmpK!o9r)euEFGVS|j3L@TKnWK=89Fe5wc{S~>1ShDNqoeBolCY@_M*gh;o}AyrxAIedbz08h9V&; zAC8eh=y<~eU%TOWR`ZD}=S2DvxPbe@1`jdT2(X_P8F#C7C5BrE%`T?K*mRvmScIH3 zweAFC5)o1;c_mtag(n)HP-^B-qgV29$*d+mEAb(Q8U@Kd(%sdFAOZNANhgi4sg6%} z>B%i>$P_#)xTa-Pv9TSVm&u!l$%xEhxM7%qOU4|F>Ue8%9|5_{QlefRZhQd4yV_@r z=JLoxKI65>Jmhj`z`hamWR4nXE4-`Ja3&G&Xz!UULPMP~#^}%2puynC#bXSQ zCR)3zttT_e4P%U~q_Y|2n&fUZek1(^@$3{VSk6b#UyOhr2e9%yky90Xa8C637OV&a zO|G?N+0TtX(_H>}@ubdDcU`8n-}u-wniKhHA3pLe|D@XA#NMk<{l@wB-;(t47+p$A z_q1?etg+ID6`g&&ahlaq79Lw>%t3!C_g~s$G%Y^XQi;RCdEf+)(RN(iANVJ7M+5mFOH^V(j+}eU3Zl+ zG~*H;3xm{}xysv;otYCW`MYQqNyk``18$Er>1Y@5Se0K8fYdQqNvz^gnJ2*@YXB;?mJe+oUgRlfGQiYSG)E4)68G3WNf$UvF&b zD(A62M){U8m7eQo;b-R<-z5oias`n;>$VfABeWFbV((nTqsre(w}!KBG`2|wEHu(; zZZ>AM{4~RhZ#MAd!{+ZhtVK%q5E0S+yacKHbw^iClZ%6YP&URp^NfQ@mU-cww;0!2 zlBWV-hw6!hi7&4-)WH+Q)Gvu}OHII(~EP(1!?H=g(H#_u3dWtB-Ftew$KG6SB6_WE!e1pJpzpBC_L@ zDkG@tU8E*HlA5-55vT`!$jm#8_mZvx_cY;;H>27pNuEw|WQc?FGCPY<=L9M_m5*$f z88&sn;Jj|yR59`SOqIIW5QED>i;c_)ZA)EEg|U^mkXk%^WOa(VM?Q&E$W5fBr9ZSO zBP&Rr&r<6 zsbyJ--McOk7`1wd(Y?1!Pz=`V6JOIt4AwaUtH@&p)EKuWS>}eHTFPO;E?jn(@m_Q) zD(*J!POYE<8Hka5gp`=02GkmVO}&A~t#(rQP_1!(QpSxukI9c>n*1I_Zrz5 zb9pZaUqmAM{Ys%fLWVW<=C)0$T_JoU=e7TMe*2FX9Pv2y zZVq$*a>LZU9;qfQH%9B9r>IAk8>eYkzY#zyGjt23rFX4*t}^a3rl;P@tHi~!Kq636*Q%zC$LJ!oxm&tgdB2f0;I?Q>tuQ4m=kwu} zZc6Lh8OVE;<Jr+rL`|#3J7mwp;DMAd!K|DX!Uj$}gcKrl3DJtnpF~zv_Y6i(zKft+e6Mgo z6#o++JB0h_rDkt1vUT@w;5IPuNge6b z`^Xzp%||A7wGSGsd4u7po|Idlik>q{PPso?VT2WmQ2(;vW!6@-^DaiW{weXD+VGt5 zhl~e!Btt3tqy;6O@x1X&#)G_)S!j&~a$Yco_Fl;=!SZ>0WLf+fmS?i@T=tZM1)^%H7#0cn-XpUCvl>6QwtRB@lPI#=n9JJx#6C>p6qInWY zp#>`EZ$|$N8C&UCA3n11Bep&h{$>pMuez`2YOi(+b;a<^9BzqYIUV4ZI95xMO<;y=H%>mTxjH);}jHdxPH30~$biGO&|$ zO%rE=4Fe4{H&J(-WJi!7Fr{F9Zwn%~Yy7(o9PBV>6zyl;y!Iw@I@ zj7wR{!RUdjP3tcOi1YAomK`CIp8kAfZ47JU^W5`a>ZIp7cge7}dH%WhLKDmmJ6G?Y z2z1wM!!WoZ(A!K8xAB6$iL~-e!G=k9J0%3AiN* zwXTakmmbPWdXThBE&94kTFx2#lnIt1r}2pmg2d&YBEy@~%uSQA4za9YxCgx+y?in= zT5v@4`^;zsvXX8gk5nw%iO4UhZo(OF$W2Rn!lvUu^ef=Kn4`&iXS zzEfS_G`_=l9rxTJs_u=xZtl*U7VeW-J?fVp%hhVEtzaNnV$fFN^Y6Z%plK&jXsEI* z>YSFbhB*)t^8q?7GyJ6Nz-mhcXw#o=*38SZ>Z=vRh}W)0JO*`LZbh?Q{}q2qoY|PP zJb{4F-4U~nU?ov&)=GKmkyBR2S74W+5u9vGxSQGIO}FZ^K&CgAN$efFs8r%yD(|Ka zE`2$KenuWdS3anim1kyW^$=7MrXgvh4<8u>`6tiU+0>bT>d-}dpd6zr9G0}>yMKC*`qxFi#$g_L14CTxwxV-sVlDj)WaRZ{`5?>B7?i!-D|mN zL9QZBmPzGG(?>BAXxx}=t+@oB)=|!Eu%`@i<1JV-1j|6=2-Fh8_a%d)YI?dv%+%T@A%RU~M&gIitrGB25rnYxAT{U-rZ2TKLSW{*7$gYY_ z;2JgdLp&t{_nTIcqiYWeIVi4G6USww=}VJ>EVS-w!}FPGDYBkrZ7kuFp+}d?LsRrzm(xE_EgIaXy9)A*3k0YADp~G(syL%>CS>2B z-=|?TUIPc^55r!R-AFJOoX5U{0&Khlp@(-6W<&I@K;u^;J!5+7hKg*ZzF14;af(Ty`C4cFfkT*3qB@Sz4{j7 zDy;qAhC=2VytmOg5c@YQ%B8oBlB5l`>K+q%s=|(@ySl!dgZLd|h5fmBB^x&PLT>yH z^vv_>iXHGy;yWMPHd(YIZC$FC?=UjECcctErIP6Dt-RJ=Hc4vQPB^E=orwMT<5rbB zjd5ZAxRapimc0iJ`?-3SFHPDds}1i#CV#FDy=M&MYd{ksw@9`q>1S!;)`xl+@;Ww@ zer8pJnvDLc;nhqtnqE#F`lk`AZon=`;Lp`>cInDz?lN+7gglh#k|_}+C*K$Ik?wuY zU8=_UnoN`~$tzjCkym-|!~K1(u6SS9wcvf@{H}?0#Ys&HB&$KML({uIFbXJf!Uslo zdpxV!Km}^{tv%CGnlAjnxK*qgJ_O9RsY4&4S4n)>U8R4FCg4)l`(tA|Uu3vY9rzd- z@}(-}6XR~aq7}9OCNq3+x3R~9?Na3Q)2yQ+d^mjPTlv{?w^_}LeKEdm!d}n!nXy0R z#a1~->@jY|qA9U3k8p+CV+2xOI`VnQbX&u-_8LJ;#zx-CNXmYY(G-;2SEVlK&|MXL zVPvJgOj@5SvG;217Z?)0!ehyvrLOq`Y1*b}QcBA|IqMqK>Skb=+H4f1BtCyto?p(8 zjC}-4n!)=FU+j0~J|htOZT%9)KAI=+C9H*jim;6ArAWn0pOO1N;;_#eah3; zF3MYl!m9Bbn3JvHly8mmC z#13XJRd?9%rv9C5f`p{|($~#u-(g)z@^{7)KUDJ)k6B5cJQJL^dC3Nodz#g9yV+L- zE#_c;KWQ-^mO7HmV|Bwwz6G9DNoG~#vCipHQ$qwqeoX*w10%9c{sh3dC(%oT6z!|3<9suG)GnYe{ZdMp^IF?oLKAY-&bpxT8GLiic}aLn{INk zbL$G;_}&V(W|?C;v?=lC_mxn(BTd<+s~Z=1R&?l;wsweFoNW0>4J$U!Pku{gQH>}z zN2}e%rYrf?Sh_z{G}6iX3%f#z{F$T3H_R-H8l5d4X69Pfgf|Q`KkIJU9)9FE<`>qC zw}3*1asVG;g5@{9G8dRbGTv_Y)gfMWeW$%w7K$qDA9Jhguzo1N&@9c^(Oy2a^+NOf zjGgVi8WAujXT00)t7ik|@QnA`dlgQdXntX_G=-7zaRc$Lh+Hr5Kxb=s)FjiIWO+aG zr0MQ1xCR`sW`(PMXL@Xw55lXbnpY-SJ`CqwXeDziN)6HzlC*cv( zO=Yv}j?~b6jXB%$soJ+1la|2C(Bf5pG|SbvkeQ{5KXaQ8dagB-&=KZcXAbA4!-?0K zXKRBN28Ia18|t8tFUK6Q>1t^3%1)5v&837II(VHKwCssgT7C*amus&#$Eyz?pig%A~E#%o~(0##-tN~0Nmxr&`iB-bT(m``9R1fQuUW?~B%s5WuUIlu!s z4Ze{G?tD$$h`IWBW!76h4R>8? zj**+0FTKmWov*L&GS7#cI_GXy0B&`6o1^)9^=@;xmit>I#!#+~pDe7RGzIFH3oHD! z<}9eOmut;2@i43c>ES2{161l*j81&ZOc&LkvCJHjESDorQCEE0t(RK0%p9f0eTr3( z`yS9^CpF<7bExIJ@SXRVLo7+y3TyWkZ?Ic|$_|-DVjZBLxF54xs~c=i=%`P_i=HvDcQ{`WROfQlJb{($ z`itpLd=PHC_)!pwXRGx3_`6}dcjZ?1I&2)ll z<-N|i-*l0kkW**MpJfihTb*cMqdepIQ~riIs%DI9u&PVpTEO5t;yIX$AzA%)epT6B zo|+eti@HB^ELQ%0Hq>0(&4bF_E7qhZO#u2MS(nEzgtminns&hKHV&`Nnv6^gWLCxv(#J8J%t~)Cuz2^2F%-#clzo)N@!o&MmYd%IW(bx}Rs=twT z{ax(dcDm1&`z@u+u1u4Ar&);ZkR^?;XJ#?K6@!UB zzJ42nS2dSRdb9$wTm{PWo|&&2KXsI-=D)K}nubwu)M0bIs{bnyRj1sR&!Frzr^*uW ztK#>0!Qe66-%yqBN*bu!#!eo|>XTKQrk3}0_Ek-NDO=zH%oGszu;4-dZG%&WJUKY`g!kD9cfy!Dr|PJCZGijORitu_u| z_Fni{PNB=0VBbRwZ`M3lnF=gp*Uc`-MWS@Q!>@u*^0u*qGh2C|Vd4TGBl&6SYgr05PZDw+j z{H|j#mO8i_`PS}Kpz%y%YQ{TL%4A&^L}2io&&YTeNY7t)4PH_&+a#Gs^>-o(@LvrF zUpfa=;pz>P9;>rR!=UQBGQWXqdjslm$f25_r0LKc&TP3Ht? z3KUg_o_3X}rgXaxV#>0|%uP}|oUYh1_o+Y%5QoYg9yPlgpj3`#1(YA42?*zXX09>^ zv-0bo0$JDhLPXbaX%FrW*vIN>&Z1zTlo46_iJfE*Mw?w)Ee#&OFvTgS4c#AJ`N1)6~OIzh#xvDiVg~H`i8K8AZ z_98)#-uS}N3mY6bmpN~|oce?3@~1FAgXUiI2o=2OUo67Vm!O#PK5Qgk4*>r^sRx+% zo8#k^u|wKbDRqRYW0K`4 z+Za^&5R1>V-sO!>Papdf!C!36X0upUsz*l-6w#i*OAyfj@HWo}srWvosP|LQK*&R{ z%WenP`36EzcrEs-BO4?*>y5x)EZCwhj{le%(^W2*9-DIUdH>gBRWV5^(TpH){=tnN-{mMZUsWO~mj90Q&aeK=4q2Yc2v zvt6r_nK|=<&RJ@EB|YDh%ot|(=g*3Rviu`EQx=pOZ?l&v>y=dNe$B-|CoxB}&ic_U z7pdZrG*AzhTpj!jH1ic;(YjX^j$@ClIvW%f`=q3r*^VNOXoRFH{E29k=6^at!zqmLQOFa& z^1JDw=W|nIO%?Ds%UUBhCiW}_YX2yg2YV@YL!F?Yz$#E*Wd~mPWQWv!&Oujvx+^;sP>0}3l4T=)qIXcqW=IVk*_<)XXycm%F=XudP+JJv+PPCDl*i*Yl-X}OsBc5 zEv(tPg^cau&&;VDQF$5mk^k+-^N39QvHv4ZW(`Q}P>!zTHuO&nEfuQq&$^1^^PQ!F zKK8h#f7d<8q_;=<1}=3LrF2P{ipi^;hXc{v@9K#=kevUo$1#9yE z{&HSr;h6HD?lM_-Bl7Lsu{(+7u6Nq^F6OL+5$vi4O>uTd<(3+B^@^N~{;`n9fuJj2 z1?`OMEU%;OA*C-KfkLZ9hqyivqu*mERJNQjlT_$qPDrSK*ouy@YHQBQfP(FYyOA%M zGot=?5Z9X3D1S$onny)lGaW?bDP^}d-UEBn9B{f)x+TDhYs6))ObiUExP{*cZ2>!k zR&%;-{1^lhJC%w#Cn45a(P;k}8ar}SkBYzQ-UkB&{|;Z$K2MyVA_8NHOen&+RF&Gt zE+GdwijKk@NBa>c3)I2C!TI>!U}mcRX|q=Q_gU5AwFnn$3z#DKOwi&CP_n0^17b)R z?v~kLpN(rn(YSVbgv4I7mQbjX8v59S5t?N1mG-5P)2*o=WJlGl^lZ-rD4t4q2~~C& z{pzS+g1j5I=Cex9ff#7o%y#vTx4Wx-C&0JP&V}AzXTn!K!4*HJ(qGZ+WvkQ=v2j|w zlA`N{j|pB2?NW7x$6DQRA|Y3wa`{!$9EV(_Tw!$%j}m*T+|7!f`)Q6_jXJ>M$UX=K zU+9z5+wJlSM-YUAX?C+@HhyGxRePUg2nvCC&0y$#xu`<9tpCKT>bmGcF06s%!6oT zp7Sh`ReY%G{snL5f6I&@LU;$wj1X6HRYz-5o}q4g)6pY7PnxbPY(ws9mb&wyO}9fQ&QCWg2%+7E{J@8)1(ps|@9VlP(y8fSUi3WUam zFCR3-K03k>3%f)7_C(&*GF&a6?i?MjjstQSl8WMHSCw)Pa5kvW-<^I{)t6b^9v*h0 z{j+um;TF2IFmg<4u7Y)*&&6|~oH_&K;OoI$hk8?Ya01~Us#r*>;ZDGBz8%?2u!nOn z;RHc34f9=Qb%1kz_Ma%_oed>n&Ljql#|DN7oWjx>cam%cKSk?jvGVGsI%(&Ko@J}~ z{b1f)9eY7fH1@P29?bJ_#JAA*5Ix>@`HRK>;M56@u)AtT0^0f#;HXW31Zl%#_>Xms zkL;?JEj{CvXi>Gkwm0S^58~vtbOeweG}zPa;nnsS91Q?0GmW3j!f&r}g>e= zKWP5(=-iT2rXy?Qt4B)g-P^BC7=WzKjY2r3Xyoa?J*NE@TX9?}fA1f*-xm_7vJBzWuc0op;Mp z8!xO0V!87jkmE;+Z&Z4L!(Cms5`wO&XQE`LX%?_I_kfgb{JY6vbsCEnSxS*|XG3we zU4^d_gfX@N5ot6#%9Zas&~4Fh?qsOF*-@-&vrJb2HIoy96{W-A}?vO@gnO>dkM;9dtprv=O|VF94O9zIaM}# zoKsX&7CFiq3Rt3DSs(6qIUVayw_ELE6)b|_j%wE)(8Ce!d(LdtK1cB;P-5-JY!tZ2 zbU`J>${b^F&Zc);;-zBE$3lJ7npkK5V=`oZ#Oh533)>LO*a9lt7c; zKB+xkb;`SDVa;Xi9lg&+-NdxFk~VnMj*HpIRd0jKz1zTn>rO<7dA5BesDcAe3*6|- z+{hWcrvd3$%Zd=>g0OR{h{Ry_l6rt!zF`Ir-03Vq*d!Qk4x>^k?1M%m{&V3=c5DXo zcsFHOwK#hOgPf%{q(EdLW@QKuBD)LDBHz*yX30~*AHU*7{pAc!sTw=XajSGRDrn7D zm5Z5a_a>RvZzx)xE6atWvbz2nB*p`1D>MPAUABPORL)53*+|}l*D>9J!)ey)+N+2S z^mZ3gk07XCIo`gTb+za>_U<6um65T@hIDj~=3?P=uSzZ5o`}hRz9l2$&x{+W$T5PFBhJhJOps$>| z>;KKNY|M9LSNowOf{(+6w@lXjGrMuAJ0e#-L-l7tn$%yyu5e$#pV9^{PYrbFZe6mt zBQz(V0mQ!Z?R^vBQU}kWk>WB4MdYnVok9@tbzNN5zG?Wxj!nYfB*We!`>P3psocr- zY%Tvg@`Qp3T@5_@huM9qVN-_7a=)4u0FPF=ki5<>cDkx()PqFkLHabN08L#9zgSDi zb1nq;)Xil4wC$Tj za|a(qwmIt}>4V7Z!Mk4NnF1crOt_Xj{^ZTANa8Hlo&7&*Q`LVXUdlJaNigr6ugPJdY=#5ML;1oP167jG zmAGkGrPv25ubb7r^a}f`n*GeFr#OB z*dKe-Rj)d#B21JXy4n-6(wBr7lg1H%5x7+2BX)hmW``?9Y}#T3em6C!n`4NozrC|Z zdDmN8DF5zi-zx-C%KyNgUfrgIZ~**ZN0zL!W%U*VR81k7>3l?+MXW&ZsnRhnSw-iKC}(QvuSM za#l{Akf}RF>MQG674^f0xA|6%k96tw7j40a9Al{vYWk#IxgFwTRS9zM?c?lI62O2* zE%<(ftQDA5uhBYk%p&ERO?Ndi9RChPRbaND;&;Hp-;au0q~0-pr2u`q$poJSP~}#gX=r zaJC^o2;MOVM6fj3#RSEP;TG)YJqf_7Ix+N`h0ogL@I;2}s}2RSlwEO7y=#P1uMJ^T z-g0zQzJ-!pcdWTIkI|C1A%g*}yzeBKE z_o|~Z0l#R}3~<>*s~CG27aoKQZneJ)7a#=7L9s2P8v1ufv^ERi(^kEYJYaVy!(Cl} zB4#^dn7F~+!J=ARs|U1i!hjaE9nc@{igr;V`g7+TXzJ;9uO(0Ku%3|}c8szNbWCoe zEY^x9RbR~Hx+Zbn9_Yg49=L(A38e^ID<^v!C5kx^S!HXLbGx<7n0vHZ;OkUqk69RA ze3RXu98pthOM~XyDH2E(WPKf*CRha#r}e{4nfwZz*H^DkWJWRlu=g~q9Q?f{MyyZ} zQ?KBl($X&Pd|vqci0nfm-iPplLfKF4<#o`Hjg|Bgt+h*yTgdU~UdZN}JBJqQ4pBjH zArr`HWvzLQqE%MpyMeD+q_d|uiy|CXx#&9r-BKXhAXjQ`L1?0Nt^a=~{{NZy|JHIk z@K~!o5&V}Bntz7H?*}Rqk_0D|Z&C2qhd3AX!B~EaoTxX$X=qipHvpPxx<$@_`Hm?B zt!Jawz22MCt;#X@`#1ldtL^S3O>T%fA@AIOu&+_R`|U;cUq+iwQ5*1C&&GKJvsiT z?a7dzuO~%6ZBI`4`Fe8VPur8BKVMIZf7+f5`}ulu(ofry;Xhwbd_QeZM*Ms|Ir*pU z$;h9tCnY~^Pfq#ydUEQ2))Q#&p$@OA``Er)?VgPW0o5Ml`6{??w2UroL#)b02<$xOYeA)=6@l!bOm=O#b z)!$?J&~z5I${$eRzrF2}wuS}mnXhZ_4^eh1zsrSBh3LELf6cH2u5g%I@3_7K&ZTMx zBPV#`nM&e$i;Unzf%lF>^?! z<2>NS1TJDx+9;;uzB5pKHhhWfsFkHaHn++%r-dKT2eUWBf_K0u1YvB3DPprh?WS`7 zn|>vjif(ew5CL$BREiqDt&$=lhgRh)v)pk(G!oL7EK3ZPYVtAmU;j7S)3Ruc6TGsE z(CmC+Uk40~)WOGq!TVUgXkW30zX|{YU6Ac**fxF@>A8lD{(cRpF$p!Byfa0Yc6IvO z3S)nytlD?7G%Xq^|2GVn&p=b;zZm1xx|!U);C%ywnDX0D!vqf@Vw?3*0XpP94kRXa zw9GB$1ua^{jTaEU%Kf@)M%;}-&wf=t&Fq;c`r#2+GBgz@d#VE{UyoEsqZzv+3la7q zth*Y2jlRE9JW8}$N~t_&qRD%+9;vc ziMc37Fbu2czc+4$xQW@3qE?9L47|~6+!d?I-ndo+Gs`^g zjOqW>MHL0_XI)tZY5&_-mhQpNu(FPU%Kaa_vIM-JcV!*p`d^N-3Zw_$v$9lrXQDHQ zJ~IQ!;(bMQzJEAwRi%eqE^d4n^luDOn{UQMsV)yLX=MjOY58u(2DfSmx5RAxx1*%B zxn;ImcPD7o_c(N(r!Nd?<^52%>HQr3q)|royT^4=v-`osRQ{O&NK>ze_?*!hGPK20 z9}8Q*nlchvwCI=o@fM_8t6z8y?eRUGU}6Gjl$$O6AYNaB?k{R~E!C!A_7B)ae+`6aR~xQ!$52lyP`>XjdZNK&V#D zx7K5;Uh^VsK=Ve26&IR8gB+QvPD!SV4AOzkemv zwEsC~b;lxmezfYNc;FMrZrZQ#muMV_h@f$#VXc`9N2U$0TYT^9KVT?=A(~#d91gPT zuvr+f7x!ER8>!WbEfS3S&l$_QYQT!QL8q%J*Nc^^c$sV4T5Y>r`&F`8v#|i7#@T6R zbrbsj#=*4ExQM&bzk)Y#6;!s5HLl;D`IdzDQ+UvzJa>7C@k(o=6YO2)v9?wB+fOsU^BW? zI&i;k(}mP`q)|E>4fAttDF16Uwum9E`n_;p>F|)+yPy@6^bRLvg^e@jLd5wlANMnB+r4BW(<{OqYZ7p!Wz*b~RR`h5|;bbS}r zk9KBlJWh7T$gFJT`<=zALjh~s^fcuXvBLUXVd6hUXwW2PM!UZ-F^m$K3{nF4=Npkt zc#0h>BKGXM3`SkWj(}xUTkB@87#4{I7S6rfQ6pm}#0UxfhA|H|l#M_>TVyb62FZ@7 zzzB8EV>INIkQDV3#m-l#I4lB-Rp?ZxN2l6~aXIE7Rt(~ne}`o|$ixFA8>~(&az;94 z5VU4@Z&OB^TJuXd@xX1E#}tbf6au;Y1ZP+=6<6Le?0NmS5prZwv%^=t z{Y01Af3hP#xs+KZ6!IKmfqF+WXIc=n&2M+>KK4FJA9LI3qb1SgF=n$ld!%bdg0=b7 zwsd`Me+JrZVsfWFqN~CrwFhtG4p3h017g}W6eosqU{%cpJPV!dDA9AFibjIZ>c3(^ z)-Pf9f^PDa;XbBj@9LFq7q>Qv;)8GgX`DA6pF>BDU`|wdi3lP;r(g?j5I2!mxS6$B z5|*f#d0IildHlz&AZ?;l*Pml5`zcq6Wr`X!l9mNp>?${$%5OXg3H@=7Gd(pOFvTIc zHOQ?OQUcJjmel@K+|oilo%O2xPDg3W!Q{Q24OG4#2bVKi(3N(vIWyuz){>Po%-=3j z_)pwZkmvf8XE%pJ@G(2MAdYrJPdc({tj?^OeD=CFaP(!R6ef7NZ+wH}d1`8&OXW8@ z+}yY}_FOyw%Ez(aTD(R6z&;v#4x{Bei^aLU3-jD!P`z%GbBYL*TL1u|w6fP%{#RhV zs=g5cu3)658~B3+3j^kIz^WC~!;l}GTD+Qt*TyM7ndq|O0XR1q!xnMOPtIbJi1OMg zrN0_~u2|rYbELEPC$4oI%NNcy1PUDIm>YpPH?q2j0fIgCXh*5I3vv926C46!PO_-$ zTjW`oXN?xs=msqB0tBo_3sIxpYw%vczB_ay6;@4hAgso_p}MwG8?!<)d7c6pQ=1T;k0#z*Txpnh#?Yh-aQ)QDmZM6uSJ`06~ zi$u{$+>^1bi`|_pHqE_MUO%RM>I7z$sVz`3*D59@8kNY~K4`l(P|kM&OQi)q|9txt zRWBz?(*+E#j=Qn({MO-CJlwO&lvhcNfZEr%I8f}DOqDtj)9Dts)KL-(f%DC)=Fen> z1>R(VG>@m^`ha7Gs(+h<$-k37^*1<=aGi_QkNNyXjCib4?L!GgBjJOBmjL(D-#|q+ zUF6W%v2~cLe7pGbi^2C4wfxWc!TOzI(t0s4YXTw?rs{iO#Kq`=?qGW<*4zmyPZJ9* zaLY)AfugR%4{AA>!5$b#hAwpkYg~+g&kqW2xI!eda%^gI=h)GlAi!76r?FzZ4#y}w z8F(&^0<+h##ynS0$$^2mW`!h3)t;X0$J)!85@IvqEz=q7?OF>F0hxeA-T0OADEp34Cx@#P^LZb{gh&Rk$r*^_M$~Uad4ZNj}8CW z=`dPlBRUdjYB4Pp=Cffve-*?aPU@{38`*v0E!#AWT@=%k#9V{{O5zo1uTC93NP-sK zv5sT88#J2^krrtSH>WG6L-@otKz1}TixWyE;$qbSMA6)jKkfLyXf;f51FIqC>NPkL z_{=49BVhn)wlWRDLMWSU+u4eNZ=F^m(_3bOvLsqdYmkW6I+N~ycrMzws+mla`)ina<|tpc{A^Hs8@>+DXMfEUM-b;^mT;59S*fZ{XZDJ(fz=H3 zwvUROvD#tzsLYgaJd;-c8KE7EoB7pTK*#*wI3n)!AqVu)cnOsji(odYJs6MbWnJTR zm4xfAbxcW8F>T9~$hwL;AZjN-A9nf-P0TxD2PfK~c~G#Mx%LtCxNdI-yJ9BW-<8Ut zV#=RAo6&%J=Q^~PU67$)B`V5hc$S(9cKp;rW*4^zt#m?$N?nR zgaRv5UV~sL0davXzD2V-Edz@C;4Lsk>1x9z+?i0nkS$qvi$kIx?7GE~Yq6_+LAG6@ zojunOe1qek455ySUp~d&0s{wgqpLI)s{zX2Oo#QJ1HXRo85n_eom>HAMI-~X#BK7C zTNy@1?u!U61QNYgqaMz?Z)9~eT$01STIeXUY+qs_*pKTr9ySN51G>zkJU1HFa6mbV zA%<=O`hxT9T6>ExTs(SI`3;Ve7);>I*<5;nR|*tRCytgx#cgy|Hh#qh_D;mzV%Ebr zO`D|3mN3#1(1}$E?JqGT_AP=(jDqXG!@-930olRfY?j9RAnWuW&(khT?&IiQ z)xlYyHEH5vj(Bi9t8!hhUhMpGHfr6)kW~cWqPq8>F3TTbxV7@2s5AMRXESj&FpxHb>-ge^s4Ox@g6MQ?c5e^Ka8tX3*XWX{U>2R zQzR6E47o@owyTMc!_gK!1T<}_!F;6;`?&B>%f_Mw=BL|BqqKyL_;x=sDr-%58M=MF zSm|q+o$cy`HK1l)C9KyPkWNbw)>)4cw#@SdJ&JLkI@lRKud?T>=5OthGg|3jN$zvG zZ>tq$549$ajO8~oR+>=LRx6=H>^Hv+hD5X5UNN#*xdl4ALF`oOlG$9vYuUfEpMnt8 z_@n8DeAy~(*lL!?T1SE4mA^P739|qYa&4*1 zpMqIRXmu-69Vh6lm=#k?2w2Fg_24EVR;{PzHOD8pRr93))}|V5@#VXW?V_>!;vGf@*VgEHoG6q_XYEF-h( zYNR)M&$L*4)k`3}_3{>HJe16lz$3e!Wzi*0-AD-y#p^R+aUhpr7UN?-T%mB8p=DNn zLJ_^?x?wZLtQ6`Q`drS%di^$S+3Tq^reS1a&=#P#KGWPOe;OX|VFW%#r^RXP3LW;xR7a z8-ZxomjW{ySc834;Y%EHv4D1HL&T*Yimna$f>b8akP0!_rA)Gpgw-A;(`HE$`Ic#X z3OYvvR4&XHtRJQqZ6I==!yo|BU=UIm7M(q4({ASPE2=Go?hk?u+DAyEZT}^YMZklTZ=)m4(oaoGN$Cp-w!Fd7%bpi~=~1sX zIPQ=5(drOfcDd+4#Pp?V`KyTOLmxu~0daB7KTOz-Axr=fA3=TEB`q2^g_vhuh`Ljb zip)}?HjE?U$l~4wZk0Y6bkNcf_qQeP7iyZSdNCLkdod^R zY-Aa)>dPe;;|_DLK>nmmq!p)wm75!o=4c_u?nc>WDF|JxTcPxOYuDo55!d2hsjX+* z?`}`NA?KSa`8%NLxv!g!@bajEz}n_{zCXHIn@;`M&i~Z; zi0i$$J$Zh6;gWQ;aD;58j@PGSc(;lY&OxSQk^QHHM*a2ztL5y7T3^!@jc42aqB~z4 z35h)QA!n)Jfbpt%veQf!J>$4YZhiU`PV4Dj;z>cO8jZbAV3{8sCV68-ysASlx6{r! zk#<5;;NBsmcSj|}?U)#7rRagtP_-V3q#Cg^=pYzL(R1I|(gQSUR4^=fDYBTg9b+!cc-#;2;SamVvf#*voa_=RW2zxGb zrKg;WjxHAB^*l9gI3c?>8k|Q}C)tZ)2KC6~-ecj%M|FIBR147>v-O)c5gV!M6Iix( z!e*+ne^FQm=JDPN4W1AaSFSAGaXKVN{ccPNQq;7U_R3%7^tR$U`TzJLr88-2qnYsG!soqt&)2YN^RJ66k46gBBK$%Kss?fXh?R8+9?(V%^%CH-`2g%~0(X{pge69m{4a(To{%tf7qks49C`v$OE#P~u5yGit{QHM z$M-DJXKE{(kAh_3MSW_*BqAHNi3Lftx)|b5>;p(x&iJN7G7|c1QMGvClDty*ntG zi#K8su~0Qh@OF?&lyW{=OunO9DwO3zQxU;^6h>j7NezQ`!AO8Xi(9zZb_~}p50-GT z2d&P*F;HS?M91kvPd3y(Tlp^`u1VeT&Z5OsHDwe?2>&|KQ1_f* zkA#T5C?QQEaJ}7G)gdlBLbfp%VP5cfB>PP+4j;r|GgMYb=i+!4Bzhfr z5zKT7bL~WR{S>`zttF9r_cEQws&cW$F8n=_4ADHgYF-B$*H3pAC0Kj69PKOI&cSN? zLMHBDNAh8irWr#1$TcNeKMow|>N|rR>zq!E@I;7bO49S1(~HlC;|Q;=`p(W#KiI5S z>O|L(*kb!DUjsnT^S{5&Z2~9RkbcMj6c6lz79qWLr^IyX2y(Q#_+B`IOlP5mTXoZ& z#9m%W`I!0-iS#6AARd$mu#XbXRQc~^6|ZzNDBh1aF`EB~;aTG$HG; z8M_b3@4?X+IJ##+mmKKkEM_NIdP?7u86prVM`0$Tpzo5=%sGbo?e;yU|7?+{Abgcj zURpP~$HE+=nAAd}2qxG!njJXHjR^2yHz!Jgc)Qp>wgl>%hi%RG2?YwZQH#GB4jgd~ z(&`@knQszC4$`3}_lO4lxlS=YqK|zOgacet6P;SYIY)$dJtD}kSNU@p6;A+Za^rDn z)|&6wiW=wWE|;%{arEc01VuvB77|3x()C10%JJok1RoA2JLj(*il;%Gd_mS6y)-M| zE=2kzoI!3ivD%tx`JLQc)Ss)r7v&>7ZlQXQSlT+8bn=vzlH5HjB`=GV)CXouK(IJk z(CuB`Qfg|X)D=Inz2CQ#yfRX<{71Amt)O*Qz7MA&Imkv5clfoS0&Gm$ye6k_*RLb3D4V@*8`ZmSna3 zO-xp6Ka@c;QoKLqbqMpA_85~oKY>csM^Bj@0*;#yv=exnBRjEI|3wOUK| z?p38ZDJ2@O#cWu#5f~w74?{(|(IM5G%8ylD8KfN>p+zEBDa6@cx1Z%${*k=MCtr-; z&5o(BTP!Ka5shj!RW%zPROpG!C+gtjZiq4`vo29~Mcq^b|HOKs=~7O-sw)T*T{{_o zgGDSR|LOeMwh;_1SH>vszc3A1Dc2BbczmV&YDG7~nGoMuEp-v4HPkVp*w2^Cn<7xv zJZwkA-Xgoqh5OX8?3=&I&W_xF1~cl?Y6@ss2Bs{-T3vR6`QZLvJ1uJCQvyi*dL6BT zs6QK6TMMAEIgMF1BkYI{MzPpna|=yWK5E8ApTuSD!J)6EqyE$!$ow|JSs%mL#{U8% zulf11nVrq*b=WPBdjvCR^Gs(g*YptZQ9IW4QiDE5`n#$MiHK*6bA4p!;>s0lZc|I0 z1J%Lt&a75;%67Szelnl2t@Py)=-Uq3rKk=nH)3t1BjXP4ffBT}q@lVBZ|r!WTs3tI zLZ0F`2&X!=nHl9yHcL0PwTnAb1P<6ij&*v%2gW*=TB6XR08s9|7&75aQ|fFT1lQg# z3h0Cc|Hb(9N+`89;|y;$4p6lex_waTeF33XbXZ2r zf}&v=-5AlUz<2~DdToo0XN$d8Qb~J z{Qq5xJ9q&m-;uG4U9ED|#f=euMX`Nyf+$j(Lt?QDy&S~_u9lmtL_`IfeGit7qPMJ> zgYI$vVb0PP+}MHw;&Q2K-!0aoUQTsu0%ER=Am&z=Q$?dO#H`X1EjQ~<;W*xL9%w7L z7^y@oKs{>vb2y^8vxfua_Rd+dIOFy!t-?NMseMrd!a4ph8vb$r^uV4At_`>y8rKeP zJ(3)X9|?-jLZ&lIG%zLU_Ux2}34ORNawm}vAlnia;AbA>+YQ8ixT>9N4tZ( z;bZ5uKjzY=sogleINLGYh#u+g8XJ6OLK=YFRTI8%3AfP}--0kveE+|SAJg(QD1Ja_3YSwWsHV7a-#K4t7sda3zqIqCe>U9jiVsnG2KOS?^G}EIEGr`rhrTAu*BL9Ba#01w zLVy-UOl>1~@TlL+cfP6WR&j#HI6!Frj^LUjuNf|hTa=^Sbjxu?CV{p(%hYbu=^WA+FCnbD1IV(AYw5re+4eMi!* zd;TBx-UO_ws{0@3TtK;S&$$;tX5}KNsFr-uM0X{=UEe^Za?dp0n0odpLVo zd+)W^UJK&>3Wa0&t93Hh|LAz`-M=Z4tk&Z60iV>`2A$b(9;aB7zSG9ql(wwL*s8dR zo4cbHxGlR6Rs;k06DafP548`%y%2*#C}e3of{otl*!w=wo)30Q_7blw*H z>IFwc-(xpkG|gwy-<*`nrp52u8G629=nV43p5#g19sj@1I~M%SDEbF@$HKqK;(vj6 zEc%-wq1Sf#s9>rM60UNu=+4({>nS7CXRzWL8QltNu{&NpmE(FDyk-YC&sYT#zE~~9 z<5sy>ll$FT*4?f4jK{9X9is+kS=yn&2uhT&3p6njc~qx1^X7|P7!k^yBe)jKc32ZB zKHDeVbe^Fcd8NE=#nO|oNl0CW0j3>PW13=r@-ic?gh$?2;o@)Iv&%;WszI!D?d&eT zTzMNiVdXkAmg(*ooN%X({ny*L)LY4Q=4|M{XU&ImCizZ8YNEdNRFsSW``|ePL^b?h<%R(K>^uw*kx$omNLOzdYO=>pWfT@>{suCCY zgb5#*j;C^T$5V@S$5S8bj;EGDxo4fv8{~WlcQ%I6m0sSjQP8{GOot%EFrG2tstIO| zI|sn@in=0Gv?LY+@PGHw{2U*F1?)?FhA#h*UtM^8O+|&ea+dleGV;nYA0LbItSZ1{ z0@yxZ$eXp+Cl|31T9-<9`m}eUCw|6}fq|prdzNatI-M@iluBYZ;Nc@j}4_K_CTY^_bW=%13aK-a52}X zt#Z>Ru@*MU$!~xtziXhEYfGNbI7kTi)@FswboEA`Xq~uJzNIM}I>!LG@9fxohu{Cy5+c^PD8!_lhea@Y{0hZ8ht}C}^vIX5 zWn+n{-f&aK+Q!b0!RL}^W5g(z6%P9}rPgT{FZeLS<(1A@NXxRBlp{Xl2u&5nYk(Mv z+HUP=y1f3y5l*u)0@f>Q(>ux#3uRssrBgISs$xSWmTk($K90>= zNwBr~pN}*6>L40&L<97SoTX@`ijJ){T2u6c=ClI4VVblJdBuK-#P{~W=YV1MBL|DX zniDpiUT@?jsPWUc!_783XzmsZ_A~D}Jm%$K zde85P8y!U~4_6g={OI?KK7@HW^O8>^Ja$~dgsq)G#IV9hb64_ZEJP6D)l&El-|u?2 z)TbS8BB`e$Min2dIR69VF!EdsZnWRsUtL)}hAvuei-d)-m%Wg+tb0Uz|3GobCT}(bl}q-Oz{FV5O>`~{U>_hjxuu>tiU3k zv`#NSp#QH~j=}c*Ylx;wgTebW<2Sem&f?H8c6ogV)-ybpLVQ+XH3qXh+ck;$%P*(W zeohZh<lIJ$v!TX0yrQ}P$KNs97V zg+hg<8H%}rRmTjznpHIl?dGNp(qkM1us*19jZA~z!(B63U!^W7mr2W5X$$vApQQ9e zG*gZj>LZ`MjOBaTAOgd+bV~PNTNi8{*!d(zJ4A^o3V+s$^dBp$T5J>1Nmg2LvNCCU zH0G{Nwx0i%(kcobPN{I|neAbVWhbaH&|JjkTsudEE8D}i#B5L7{PJt!@*d>Bb4lA+ z*%jBdg)2Cr&aGvQ!LC zHllOSPk+C?a*yEnqn1eA}*a2}6sjea@nQ{iFTP*=Zd zaCoom?G*(w7YxHKqe4F$wo}Jps=q!F<>)`FBtlvajdeQrqXhdq0T?S$POt)#JwAD-B#YKk<1vI~>GNkF zVcn7oO>Nk)DE?6j<=9w0>_B2+;V^8IzX(IT;8j#uzh}V!y7;4c`wYekA?GaSx`Hxr zfqs1HOqNq;yon`1a)ekROuet58x_(Hs>Wj=L5&)RwMxGPl*l>F2PfJ$AjunX9`}j0 zdzny=j7Q%vmRF09mNb@b)^q<-=?v?Bwfc5{48zz(p=d2xdsnt(Sgr~9F*fzDTVI62 z4D=&atMLC;$;8#VbC@+$9D=J2d&|(~_p3ld5yJ>3{BfIa6?5Ay;AygfmH$wOWUa0w z>x?=iXuH;MlgpP74XV_YIwF^E)>H_3cAv!|yzXiZFT3Gnpr@kKS+2W-MSH>^SaPe( zhV^>1BMm#~xL5qY@exL)Kfo58H}zidPHeib8^4(4ds((ylEM7FN` zj}?(^(*75U2s5q!ViEiBiUqfTyJ7~zBhD&r;8D$iuC@z9-_#` zRtHm>f+1@IMz2bca{$N0vcAM#SZ&L0qN^6wf|e|(056Ej?u2b(STCQjdHI-abTtme zG}-sOw$F0V-s`yQEH7d+M#8dX&P}Oft*=D4`QQ0UIph0$rL6Ra^Fa~YaQRjrTk#McgW5f>t3}+- z?ihr{78{qMj!7`$6h<(s!8TE_oK0r4t6}ul{(mbu>dXETspS-7)X!=IyUw}vZW~*q zvSdmbY;BD@leN6EAI7rD>}a?nBI_US{dPWE?3B0W}uG8C%LKD zu^i`QMZUVuUIKW}98O7#U`lCqZ)E38!FR|u28udC9LAy?PF8c81G8NHvF6ZjL*js8 zHJl=tbW!EoO!}Jy(Uj4~I+*st=TlZP3~5bTh6;$C!k8-iOx9M0Se9zm_}JK#LowFcF9}nJ+}w`wC}-+t z=$!pzYiNAg7S6`8eBKEqX3i`3NIi5j?M9@md3G5*Zgn(P4ziL=%6Rl0r33ilE$nGD zd+8`lK^Y!4|Lj08M%XUa8Y24duUuezQV;4qrF^?sNq2WR2XcbW~C-SB>H@ zhFws%?qmzY{xBh`+)H`_!fzdnMhEVM&ytp>mL_}i#iYbLYSOn%TZ)pvb{XbxVpL-nb-p# zQn3%=qd)q~9b9EQqT^Fg&-dMAur`%k%FVjHO}Qe>efMtd%axR{kL`_8R;UwI?BI5v z#Ze0!XUPKrd^#1}E`AaEZX%l56ugO#`x( zR*Frr@%e00imfdknJKnV_AS;2yQe!q}bTvpPKuW2@orFJdI23MQpSyF_*uO z&49sR39bV61xsGdM)m%>P^cSuPb6DP`O9TzG{r1q0VUW!<#2DG#8+}1d2I0%s~+)l zU1!~*Y$+>dgRpd+#*4f%gNdBG0LpytmShfwooz^Yl2E*a!9_ z+s9sg7Sl+6F1~k5M@)+qrn0cuhPpm`2HzW2qF!?A@Yvsss~w&|7)v$aNUjn@=-r~%lkVqh@&<>Ja#MON{MMuhDsjh(_GBg6>Eo5 zELpxH%V#oHV#6sPhW)w0P?=Y8=7^Iu3;5DC-Y$hPo4rG4Zu3%JbK`tizMho4i zIqXH@pJTAQbvCRlcm}ZNozCKAM)hmQ{9Ipna1>Hn! z7THFH<2^{opY%zgm=DoM`mMlFmN!?o>^QYrf65k?eXt%T_3toe;j|Mr`#ZwSta0w< zbr#Tvt89QQUNd zE7z+UP?C>0NEX$W8`$IPKUgqoCsyj!y?EZ7LL%jl6DuqvKY_%nGGCmx)?sy{sf5JJ zTQ~YF9XI3oHbcdZ;yYc76(}v%g%4Avy@2(qe8^DA*`2(v7$L|zcfC?L08V{Cecfda@HpE`zVPw)-1v7R28xR1+Cqf;i;=~tDDU50c zvOo{_9N6HG!8#F^uiSZ9brT17zR8}@HB_$k%bRiZoEgxp$hV-WVfq+*!vL%@!Y-m; z-sz4l!JQXz=fv@*+LNq)=zc6Qh@hl2OaaM>kWRpDFg6k=V5Zu}~~{16NP; zXWE)7I!gtIp_yS))y-i;|3Porwp6O;vg=puRid59w&Ey_751`!^h$BvnPp2?{YpSX zF_rGj#)NpMH=MiT8aFH&PDkrv0~F6YYHVGHp-M2x1&Iz6+y}pS{2U~_W^KX;UtJUn zo3f76f5g=aDIv?&jBO-9i699KazR%VAh|U}6h)_iV+)nAC<~p^Oq}ptI|IfkYs2F> zH(HrB|MR@R|DWXTIE4nv@DV%yTiZp-osRvFuc0olR0X@xwq8-@t>8bmtURC_&`I|GLj+g8mt)#KdAsdW4RH1_|%Pk=k11~y{Evnpj5W%DI zSm^d2ZWVseeaerOZWUskqCt7UDR*GL{mvcOoAQ$3wN~b0=teM|0I%m%uB)*|dLN|SwT;$d9@kLc=JUU}xfjw+R%I>@5V|6yGp{a5Q+ zW_!vYADaz zKi9brY`B!2A7gdOqM#ExJ@%8j_fxv}BHeqj?)@j-`_H=f)4KOFy7#lX_g{4H=XCGq zb?+B+@4xEaOLXrSb?=vS@0WG&rMmYky7#NP_uq8y*L3gKb?-NH?>BYtw{-8n>)vnc z-v7|O-_gC_)xF=-y_f0U-Mr}GAG}_c+Y6Iw`MX8;4oO=%9{sNT9V+_e?~v}7zhhlr z{tk9h{*JC${*Fnd{2h~W`8#Hp@^>r(*LsSdu+NC{OC1&Zd$8EV_L7WuIoMN$7ksi+ z<`r!{j2Mt(Ml?prZP*p^&f3w^&t!}r3)3+lS;Hwm1LDM-O|s>A)fU>OO*VF_6}MT| zWr7MNtPR&f$z>I0EC(QnW$!Pt70rH|e0r8^9Ac{0Oak5af=ju%ks=FDmWp1)Hq^ES zOhBgqp_=w;?#kI>JI$J!u!!G;Vqt^BmA}n)Sf{(WA>Y=l!lH$7QT6}pZdT^??_bj0 zl%U`7|B~+JyksBM%aNuc`9IRyY`+n!yHuD3s&EjJRX6}Lk^NZW<(HwS&wmH9xFUcU z2Jlk?)5zapfY?d!gm5&T-67?Ek2Uw-Ds~!sWE9Psi-oPhht4=<%`U6#IUGD04#&D# zb)!U?)-sWLV&hB@dY2MN0rW7crKUhZ?Td*lg#e{D1x>KRnU7?Ry?s2DF zACacnQP|{reqaOTPJ{jhmBb3I&i2fZ{#v1voJVX+|4aIuV1`ccX1PU0M$ebmC7A|yjyiXaaMV{4}3(0P7;Eoca1$NoG zg}vTrck7}2@C1|-aKT)@Tj*$k?l9|;&6bri)|Op_C6yxzqbvUsx}0W~yS-w(BGzUd z;W~WT_L-_!j9bD`FuRE;seQdWmY>H$WTqM>a54jb+v!Km=U^9)yTF4f@e^d%bSK0W z$#=Xus?KxRfasPZ?7e6eE+NYHL}f5)j(1Pl$f^aZC6}7}Jgq1+%gdlHFM99d=*A|_CCHJD&i0mppxK9ihtroQVs0BW~ zD|Q-?`t%|+XY+q53==-@ zO$XqYCb+rv#?uqO2l1uE+FRmM3byw}BH~@GBgx`l8jY2)4hU>lIvD=mnu#sh8NE_Pzm;WX3h9Nv*C54@H_E zlnUif`1Ir(5eB^{eFDw-{>B||F{V5&mTP*m>WOTw3fdqnH^}%Dg7v-cqB&(H9fQkp zoK0)aTBsDa1m%Mh8(r}hVLg2Z#E!XnU=BDY#~SB5oMczXZ#5rCiLz(m?1#boG9CrX zNpA>EBj;zh4XF7%f-CJ;pp=vDX>CdcUx3ZT_C#{YN%$}3G|HE2hxnqPB_#SbF&ej7 z*e3}=;2%X3MG+j27g$S0v8Qr{4c;hKThy?DJ%UB0kYfFf*OBIwxCpaEK`Nw0a4n*) z*Jd1n4M15zsC8#lc7{!Cj+@nmyW!LbhOazipT_J;#8(p;N20^A=otQZ*-uI>#hVCw z=w)n}f(@0uiLlpdFPum%7EzHo4iQ40yBIM`PXu7qoLt4jYSUt|^AI@bWd7bBRjnEJ zF84+kt@zVUjf9d>$)ny)i3NR%E3RDGu&&vbH!Ky@WiON%!ty;V#X5mz#~TBrDcUB- zPfXQ047k(F8*YHwKp=p-^D|&yVBjjBEIg8IK54W*Pn!Yu4uhBgE+b|r6M_uJ*w6s- zDYL;(BKr4R2$1cB8hRnN#~ab|6)U{b5~xqh-mYZ-V)&@`v>*tw0N$ZwVY^R>cd-b| zXRp|fU=iIX9%^p<0vCCZt_P#j$WG+prYjWDk~yfPYF$Y5)0jz>-!a2I>Sy_GmDV5d{Xu672a(}|G?JU`nff%K z^w#KHb6bkMRoK%~94$2DjNw|Xl{f>aBdx@pLSIU1S><`Ch=SD7M)cPqnpzKIK_I)Z zr-)f$p_KTA!^>6LMqJIJoP}*gz6-lac^qnsFOeO)!F%^gNVi+Ziw+>V#*5D&tAuu9 zI2ColW+#6xTrKQv9Oj=De;ADPLZ~e}L1e$8aS388JVq*ymCEBxg4hA6G<-zPYsVu< zCFK#Zbq&o!Xb12lK4D^$mdu~n2_J6uJt7W8tSRlpKqYT>%c(-|q9heip#ieC*M+$f z+KUaUaETrlf5hX_&SKjdTp_$jYKLE4{5fP2!e;sVQq52&jnccj4!wMKw>(WYO_#hPg1C@xVPRHHG_ z@gU_tURyK)%te`pUlqzr6w@M_0u>Dqt3x^U2TkxpuB0R}&=TAXcwR1QrDzVAlS-p0 zJy7{AC}{xZh1?!sT`lQI53xa~R%#5^m*H}^R$$usEW-gjr0%-U2pdmvjic5BKn}CJwpBah%X53sIU+EN_&PHP~u0J zaua8Tc+`6o<>2q)h4oBzVa;Xc?|Muh=9>4EcvBEMaP>5y{Jx^IUPpbnDQ+iyn9JHv z>|kMkt^>qo!hN>kvn3qK3R2uH23riK;cpdIdiW>_i5kg60MZdJ$zm}D83v@-Z z^0OPBBk6PkpXmBEBB}5HOcwIDTAGE=5Zf_q-1G{RNp$k~7l?`_mPa z$#U*IRe3?I1()gdUJxUF-#=%}Vl2J=f*77u$ArH7i;?W03C=UYvrX`L+V_GOYT0p? zF1#RySZ|(DKBPY-eCy#SG^dDhqTk5PrxolZ-KTU=aj)udhkiB|<`WY<#{`c6%+>ac zE{*!M7+Kc2`jZm$tS)E)aQa#w{u3P?C)P?UDpqK@CACV;RB=OexUMShIUUXloIcG{ zMMijo34Y524=gH6GbGT)L=bF(ub(nza11cl!3tfWmZ`XvI^0lGyawfP8mRE+S&mTP zl9R@a@=fqU6FklYKMj}*_A-82tv;aQUeVz!X{LxjoG@lgCU^v3PI#j(k-8=t4-LJ&w95)7BLo&e{Z?;R^E%bw&312upwA;)MG6J;MQ zE6Yla^`{j~Q;nhA5m0w!X!;Q(;NU2w9Hs0q-J2kWSUx&TArr-rhaWtwWWENOb0NOQ zkITUP>HQy#1)X4md;CaaCyKQKHvFKZF0XI}#CwL+TBwAMm}cA`qF|AxE*+W!*1 zcVYou!1Lj@1q$tcH9an?mx}vNhs*s=q0@80Dc{i}FXMY}?yo4D)?T0Nrf;~)d(Ox6{785*wuW9^_GZ7@3;20C^Wr9zCYs@g; z1TQeb6TeL}M(AlGh&91B6MXI)WBgqvIL8D}GQoY)Oo*l?*kOW8_82qVZGxAY;B*t* z&jhD6HzE8@aOrMihI>u$3KKld1Sgx|)D)LP_Tor-5IfE}ao-m;fAy z1?j^6*g^L=o#8tuBuxzIbtGR&$3vwJ)zMB;!#vfnFkM)r8m8e8Ea`nW1HzH!~HhXjdU!Sb2d@P6tRBGpFUI4ypD7^?HDy}Zkh>d z*gZ9@p)Sn%8BLyo^cK75y(vh~;-YPMraie)NiSAc#!waahnh}fT{^iN6nYJZAh+jK z++CHvsgC~KdWD|rlFR#``fRDt&@)p-&u-0CqB1pshja<-|5Qmp!y(8mUBzjAr@4;a z@+o~X71PaQpD6KKs9_w>{s~<`m}PMuNw1+YTI5lEes0dC$6f>8kxRq*`Qkd74Saxo zosvepE{y|gX&Z;7tX0Au(S_AqOP4skoomQ@8fb>EQD`33(KKE|EjjGMY9*|LF6`6Q zG#p`;5v%EqX(-2G0jt2nJH)q0kP z?(!A%@asrEbOk;AI@>&R2)qxJ;qb*agS! zsN(c&;)|s+U7DM}E^9V@M3a&JW1AN$^uu&vlU3Ys z9j>X0;}OYa9-)SDnfEN9lSs=lb^+bSGwsIvN}8i|@w0)`ugeCT;KnBS_IpP9FHGkt!`$(CWFgb|x0gi?Zmb9OoUnHxm`s z_ZKyv&O|e$B@pFtd-+d0Zl)O%EHuGOOz$Z#h$(sEs-Uq{p0EL7k-qm=~z z(1mpvO(!|*(kLbDt}ZNh6iIVYxlfLw`go>Y99f>ZoY&VTcphN>$RCgfKefi^%57$% zl}zxN5yrH)nBc4tWog=%%b5>15hR%4AQOD~d1D4&nc#&ccpPBj(51ri2~Ug%zdHCmdEKMG4an-`PXy>OAaPQ=X%Tva#A&JcORj z23&tIEoV4n5Pi?^^??*XfEx{@NAOG=nyjQ1h?>=wI2IMBjVctuZS^z8Z+;mtf736z z^7*N_P+eM^1{mW_H^OOdgN+EcwkEia3BJ|enBXZBoM(dPo8aLF7(0-p{xoVn)+C?z zGba3o2_9*J+nV4yCiqrgV|u3mbB*b1hbm}zPR1ClK*;b@COF;%hnirE2|oX{u@GOG z;19}SC4aYx-vqmx;NwpjGu&W;XPe-m8m#8;7Ox?c{M~|0@YO!X48AqN zOHJ^rCiqDc9H+va6eb8+k%{2Ulg13Uo8b3N@I=@o!||qmO8cg_F^Q2TILriZ?`5PP zWr91K;Aj)<*{du~?rV==ByykYr;bQG+zPSd(mZ6LS_`sk|fOjiZ>ln$2*oW7=}o8bN?xQPk28)1vvuQYG5 z7@oGai!t4KCU`7hF5e)Og`cmgWx~U4eP<dTR}%9!6`bTu^s8X zMGzBtsbO7pVOu&V^xbv1r&QeQI-I+TO9YNqeh;ii~N2& zC9}RNj+?f-iqmt3l1CJ}OdVaeikmCrR4&k6MLwe=3;<5wlou0}#OCQ}maDjI9WF`5 zaevhoEJ48O)4Ck5!WtLY3j|lubGk@xs<@|hxOgohX!);(2|m}>n9)uXJlh1P4KpE{ znqa#LKKigRgAFG5WfNTA1Yd4rh(E~fYa_yKmI)qgf*YA&Zxei|wIKty+}2d(Lr8o+ zXhrq;`F>04_8}Jfr7dVUo@r0CP-=cYYMEQ$L$$W?aQn8o685edwnP_}sD^1c?t{mg z8S{1l<}|md@t9_!id(LvndX+SOZ1nAln5G*BP>*LE0hRsU+Cx$Kd8`aIHsSX;#R5j zyL9v)H&y60oZuGa=Jphj`p#)J!QVBZ6>f`T1yLy2sDAA2v&^;8m@$mXae3A*SZGvs}>G9=a$nZ|}jPYUt zbDsOvywB{7{J1)F8~C)G+D80zz?}9E zYTBi`wCyI^pQ4O$*8t|Y->Gr9S0<{s@744U>Cy|1D(fsqIG~GgBvMJ_st%V4oW2K) zQfc1O(IiCD$&avQ`>>W0pJzTUjD8YpsD{nf#dFi)m|mN>K;kwv!kBMk6MV<1f~aO62_|AOcSCDYo~^7(S4VHP+6Lx@IM9`Gh1tdrOu6Yhnuvk`bG2(+xRI`aJM2o>*J`uH>cYC)Y0+wMy0en8 z5IZIM2Kc9Y1JCKk>GGCLv}Z(P+%HVl%5$=__=q zjb2^@-IP~+Xf5Jcj(F2I43}Ez9>YVe6tWg@vKMt*3wT>q8qV;cDzu2&nV!;gB> zC5D%HkoP*ko89T*b%5jC>1l?$S!g!H-wL#f;d5?ulHnn4bQ`ey)UtcjC|3-2FS~b- zI_HXU?vZ#&W6Vc)@6r2=IeX_GeaD!Yc=?qvU;c5A!t;Ph#!IU_F(UB9?R#>4{G$8j z1-I|f3wdH(_%FXJfelevTxq>@jg|fTJ=)1c#kUk9Zb>G3Qb&|=>mK=iBDQefe)Ar6 z|3r*%?~0cf7&Ga{JzB>YZ@e5}OpELH$o?rXUthaNO+E$Y#&7p%G-IaWC5thiUd1Od zCIK(MF(&m2Dq=k__e$?kkM+Pb#LFDUe17>Jeae^%m+sMJ#!SSE-v(elx`^^@0Omow zyug^jB`6PLuKtSh0Aq>xm86Xrf9oz#{)uk1-SZIn$7T%GxQ0=2T#)_h6kOdYM%j~`!jX>3~=PnG?w9>Khau-e=er) z8TKzGX%ojUqQ;vz{wW#-IBn1=rNYzHism60sp6hj8)1sB5%!-{=rtVEPgikMb!oI! zaZPo&A5JK7AFRNoxs6nj4*|(7o~Q<*3%Sv8B|@``2yP|E6kKza{s|p@8#PQn9yc9T z=$UPE`mNOG9627%-YixLIDSN-;V^Bv*!Kvn+KdXTa+vn>)Al1>#WNt_2Zgq+j&{-^ zs{gqdQs48C5|*F~OFO9G9?{``KR}~EZy9!g-o&%!`tKE*M?u47d{?FAIuO67FFuE| zMR1`)(?O-tDw}Ci3+@^CN>>vcT|l+Ah_xPn?>i%1UlZIGFz276E9=?)3ho0P?&JM5 zdkf0%v!7PsnbvQgLi3o8rXg^8URS!;2!CmUSDWCOCipqPT(%XuJkES8z#>X1_u zq}wVTuDy!;ScfbAMoDnB4mVcCtiqj2UbhqlrKJ212t zZ=uKW3<%kxkSpRUxy3a zOqaL}{Wp>K7ho?ReWt`K)X_9oalhzrB5?XTKju>6?bgw3RB`8ZxTjT|KK)SO)U*@{ z;jN8IVrO*`*Qz*uA)Zok=X7*-6{pX1^M>*aP^H*t0_MJVTobVxxZJgLLI zvtEgON{5S7aYZ`Z=1VjV6?#r>qi?fpcd`1w*qKf=YM;N5yuIX^!LN1a~mOQGhug{dD=oDg{?f z_szqB(~p@BCOA@oedJ0)dTwPaUA4XvLj;Qi8v{-u zc(-^ht?J5qWj+Ye>hk)Edu7@sQSMMb1LixpT6iH~Ne6ES%vU|N@HK$>LaPS9514Oq zYw%3KavLeQG`ZKls3NtGIf#jz0q4YyInRcF4XAy=x%03B|DiVM`? z=BPNFiIvBls^WrmxbZ5EopNh=q^LMH=gv6RlXmN?BH1R2M%Yco)zIM{`3QTlWx`0; z;Jsp$#rgzp^73{03zWGZ77lvQmHlEnYinTmqVjoHoA1Oj!S_7gx!P*sR};S$)U{Bo z>lw=^x_A}V3`Tg=_QLhp#f7*Q-JFUG#qMHHB+U)V5n`#$_qcj}o(d1)_Wi8y#nyPg zcmQ?{no;rhVrM`}2SqV9lr=FK8fq+&iSw{dPKB|4S|cqk1zE0ro1D#=`RMpWwAy)k^n~0_Q%;C}o{d2OBk_2p z)hAGI$4`iGK880K7Z6Uul7`$`u%>Vls8||#68$Ka;#R`?LYE>GGvzCIFj##Ok>s~6 z-_~+?wnCciDD!NvpWLwfDdH6JeVV3RKde7UNsjQ=4M35gsFp@yY95uNPxf?tC5ou!5bG&D` zwIb0p%Pxo=XhpK!Mz=1AgRRVmlr)F@Dh_I~0JXamzt#Ay$8QUMyYRb!pEs(z8h*@U znSZv!kC~L*0wk1hXBY>I4`C%>DWO!H?FSzjYheT_xddiBLh02Ku~BV~*a<%@Bb110 z)71uySGl>9sjx&0H}oIw86hNG#3$6C+84#?N(P}qO&Zf7JT!Yc3>@{_T-9bx0U;BI z(%p+-EVZe)GrY{lUJ|{8foxs)L^sKc*gppS~7*1LnmN z*Iqw0jF}GCsG!2U&S9AUIIb_nU11i-oY#3BT<1J7SN3%xjOlnZ$}K}l*D=qmxDLxv zVK-211=q!}@;93&&q=k&_XcRt5xjh()cE{$96y9=+&~`;pf)#Pm}fmbr929&pszb# zfSsIKH;|s(hxQ(piXJrvtFsKp;4p3O8UQ%Wb>*&TcSq`iAZ5u>t5UH= zfORsuKjp$qz$z~Y=GpA)z0B{4VO0dgaRf@KZ)Z+p@N9ps; ztSW^@jMn9wig*50ZEh>iAN;JU6y(VZj>fcONUhN70cgAyAbku!F7g;TVc%6g@}kj8 ziWJ7`3fRi>LU}m~y`*Nfxzd>@@R()BYwi-9SR{qX{Z>HvAb((0EV#V>u zOpCRi-nL4Ca?u*nl^-mDu6!#R*OOIVyeMgzyC3>gu{T=sJYDyedI&F4Cm-n*>jb31 zxqe6ce59M!i4~wt+AhANfdY5oq`XL2Tzd;fDINV`S*_G2IVnE`tCu2CVit5!l)xlh zRtcXCu%TUQCcG@0fy;8HdAQQ;QgcCgMX?K4-~h0mtiDncJlgn5r|_szO*-bu7p_Gr z{zia3e?O@pE4h_Nb;j{1o`xS@<&HX(3in~=zZMN&Rqan$99I5}^Y~SzxZzyD2=ek|*iLb?Lj&bkoBS$>G|(TF$bkYCzXfYTB4zp`&S#Iq z5y6P4YL19WsF8SNatl9homT;mz;hmcTz~*7){=0e;%6`gI;uRVuCz8+ib{4D_8p)HK`O*#sz&mPHa zjk~wQt2$J84AKmoN0!;Ca9wSzmNp4Ck9@%7TptlcMg2UyI?V#eTWsFkG{BFm`DGOs zpu>#-&Z@$AxHSaKO{2xRK*cv|`uTEF`VH}Wv^4;|V;~*Dqjuf9Wd`Yn9WakLp7%H* zu7WSA__qK*k4<+_%%W|AzyA`v>2n^|Ok-Un?t%!mrPbva+H0O}trFHWfe1Eqn>p2u5=f^7O`h z1Xmpe``tY}CIF_y7puYhK(OTR5e-U;?NJrh<9GRb2-RqDu+&a?lzdNHLbF38nDQ(M z_Ohm-fV`w>Nf99ud8Pw|Bj4rdxCJ3n$KWY|d5YrIjT1kfaQM5XQe3FCM0kxN!lZC= zdeHyPVQc#E#rl==#@C@CD!+q5hk-Fr6e375i! zIdmS6;0*PP+>tLgMJ8Y_@;emal9EWq}XpA65abfNTQ-zQlju4#YJK= zeV@ieN`tB|P>ZopeJ6*tc_Xf zLwc#UG?cEzqTxzwOS5QF9O^u!Hm0*>B-E3_vu5;$QNc8KY~$-l(Z0*oY(7$-E0knb zQgLl5(iLA<@)v|v)GJz=E_}>EepDKbv{rLkjcDS7$R@s?lq;;IEA`Me>s$-#OR!6r zOK~w^b9qSBm-4(}2{buIiWWXmICD;nv|9WWVLqsDUX#ouA=@74N^K}53t;bs4`8V= zaD$!zyrMSmly1s!P$vYiz7pwvOwMK3*wF8w8KZH6}dii!aZ{90dD z)A#SLBuxAMJ(YxM-~Ww1j4~fW-rv%ZhtPlaQbIH76=9!J1Q;o8j^d|Bf&JfVCWQ&# zDfj}$cZVrTxuD;3=^JGaK@Z#897G4`d~;052PvWj9*6id8d1SiOyuc(tHaXuVRsMV z2U^?$T>3}a+5+?PVY<>nIyLZ!zF4MDJz7ba_Nm7z3DZ9HxIT>HT4AW1AhEUdk>^Q- z_|m`#JLb265(-xxQ(Jn25LkF@EiJWbEh|z)TP$Wy(c(6!rXsr77X8EaFgkl0ZGBkk zU@b;E%;4>CQHg=!Y>UD26I0iver++Zf2K8U(ZNo0%)Y`II?)q6Ep=T@FW01a9#>~6 zGeP=X_=O*SuH;9ge2aL_Q0j({O3!1N^X{Wk_j(ufA!;3I-}!HT8Sk<@q8yQ z`RS?0q_*`g>Z#NeVnD(Jmq$Y z>FHp?>#qm-Q${<;{IBPW8Hhm84VGZs;*pC}I~%mYiepuvSGXBaq80 zloyIQzNnkzW%07og>KSAR;wBoO_?7>)TPAkQXe6bR(3~9cG}k+dl+v}*ePO06|9XD zrEw4gz%fu_CY(d$_rz?_C8j3k@|J%7uNdqjRl>(lSo(_;e%!GtrBz{~ob}PN{g!EyELk-IU&WWEk zS^HXDkMxk<6D-xNbh4+^*y3lUnscj!P)skWpQk@!VG0-)8A_?nD*jncnAXnkCG~`D z_KPE>CX`W6@~3{ir7oTUpmf0MD~3{jZ)r7_DP zF!??$y=DzT93FzA5-;~@sQ?n7DSff#2%{?lQ2iNLZcuzb496Oj*-zRDG24zoU~SD8 zVNOr)FC|jPp{TUu{V}UKl@?1}j%9~qfYeWjpfQ8BG-eEtQebi(i8k|$l#41Pqp0!E zV3!d^`v!wK6upJKu)b*zVco!C;N*2EVj#FdajEps zfl_F8hSS3}e;6uTXysZt94k$sH6@IY!n5ljJ;#)A*!ixH0z{9%$G34IWRPHeSZ!r1 z3B&x*J4T|=ZC&U-LxtdYgmI6Zj-L}htyd<{$kAAdJVHV$rki&B2&AT|QWVT1%cw^c z)T~r#LGWYuNu&cMjKMJMsP>BtFZ7G)4u4uOMhf%ngh<%%jmBpejKP?Foa&7Q6X*j~ z(4bG#yA!bJ=u21l(T_S!M0e;<%O+w#4WPJ}&{dwHVtyo3=F3tV_ENsDAoXWy$2aKS z`4iA%;wPaB2hos85CaXS#gnkuob;vyf3)8qF!wbnfCjuOO%{gIiC3kMgcNF+hI(Hx zS<1kf9NxDJ!|7rgR*KKlm_<^kb%a_!$;bi%gppL3jyZP}ok_GiLXf$JjWoWL_#b&MErhi5eg z+?n77uaNkrG`jjEgqgQ1uX07t5hhc_ThjZyI^ah-Jv9qCOkoJJPabWKx22}msYrm^ z)|&>-;d^rjq1%tIvR1-d-m#p2wWqgJ4mV6rY88=uVgq$fQ;1lF!#mXP>9 zHV{i`c0#t@O;W#hU(ctcb7>&TE4*4eaSB%tMnRnn#(bRV1x1zCcIrJxH8yW=^ruko<^A~ zFi^jwWh;=#S9D~BG(q^9l2&49@20ye0qtQZoNnF4Vk2jjv_klXI(;m4wtkDWlmU?R zF$O^H$5;&PCC}BU;(at_C+c=T6|M%`{f>6*L>>iXT_ZK}EJQR1Wfp`*x{}vOy9JE1 zq}&jA9$km>d{151VfS*twPzhB4D3J}=AlXsG2epNVJrO1IGQ=VY3=8dH@!9sLZ`VWs=IRD!L8Jf41`UR%Iw&e4@EC>@UEw{o}M zh1GiR;3a#7@x$RZZa65TH zc7%3{&&S&8H}c&fJz4J>f_N^vu0C(5$u$JdiJ#W5Z&KzCw8t&FzC#N4{T)>L!F`)* ze*t#)2W|KQOPo7O+ux;yJJI&{l(sLULp!A=AuO3?!CjP^Hg9Zr*CKdRx97a-Q2GW8 z-^5)~Pm9HymhX}#hqxmKe_&nwocL)a^6;jIzm$4gJ=Jhe%4>@mB=<{59;!eGL-Nc1 zCIS-h->{~N`3i#uqTYSzgkH4xBq~4kD@gjS-t^vA(kNtJ2zpA~11*o}ucf9IA8#7) zwe+~f=1r@x=`}2t5ZKED$Xn^Qg@;hd8Hd0k8_~i;=-62K9s(&Ll*53mgCBRDLHMz-obi038=>NwskrfY`cPpIoV0HF zLGqH*oRE%zlJmpo!9u$!ozmCjJP)XH%ucGP+^j zF8BrBapFG>_R2miMOhzIKh{bEheiZi+o2fTHV;wP!#KZdhES0beBC1{=dc8|8^A0w z(7t3Q6(5%TYVgqqFQ4&k@+cdOr`EFRO%vMJ8;~2L<+OC_NGe%#F|vl3WFwNqlbskhKi4X3p~ujtC7%F9%Yo6Sj9t# z=Xb11j^e8ml;B5b%rPna9fFHH#FlbVuk! zZBAgl@Hovp0rJkY=7jVcmf{!~?JQlsLt_^GgovZwzxS zIVbfJst*7*8lh-sc?RAjNcEh5O07U9!#%ZK-CPPH5a5v z-{%mjXZS;@7?I?`fhzeG>qb6Ss6s-hpC7gg1Amnwt;5tfHkyK?M9TS9@~Su7l+N>j zxgT>i@>EdKp9_DLz7%}@2Ccqndx6%IcAyJnmqGxM zPD!Qcobm&^sZuPo)9Fm9^eJQ;NmsFGOQ%g&&~4M{gz^xsVpf-njwxY@mj@qIR?v>Q zD$~wW9-GQ(oA{=p9LxsBsL!#k+P^`7FET5d2|S0rK%1^%Mc34obRDN1^?ul0R(2D= zu6xSL;=U~_o4mKI%(1Vm>lV*Zd0LNYAektU>#S8JlYWssxBOSx0N_&4Db{w91P!Z~g8;rL6yqepn_x`c37 z@~ijqedu3N=yl}9w{W(TcvtHAr-S!NpiQAE3*ftT?_J5OnmO-Ry=k(=hm`{E-o+SL zPYv%$4gQqMWI2^FOXcJHDV0&AnJ5CO}jK$L>*MI>IX}@eDa0SAm-A;tjP!$$8w}W8N*htvYKg z@LvRe+Ps@a!Gb-q`X!*iF$_WbDM_%mReIvk;F)Tke5%bXf@ee?&1vLo0aYO-S?uA# zZ{C+`rp4Y&xI{ZF_68unh&c5)DP99`d3fZ!b>GOn+~rvCe3ypu2p;zLtFvY`OJA8S zZ~|N(Pf(tR-LDM?@s!IPtUL%f0WeQZdK^dRWXf@H0&n*V<|MditXfna1RO-qXX^T4 z?n>~q2g+2OiM;93Q_>g&dvYQ++Hq5kuvm)#q#VIe5-RjW^+2bhiapDF7V3ey`^#Z8 zdz5D_+Fix&@B228MwT4cqFy99s@lDLXCsVfC9VUR6_IaM>{k-M_jUNrK^T8UMcBxy z_Mw&xZyMFfzZTu9YVQddMprNU^AK8W^0Lo?(4vzS)jgNSTkWlcd6Z|h4}~})*c%VR zt^ zJsN_C7QVnQ=X{|0T@7vobA0VVkUos@hYndmXMgOA{p|2(-xLCSXClh9g438TtSpbx z4^js$*`^RZ7-B|22vNh|-i%6X*qy=}e(!;USkSbE@FCCN-T}gg-~CZZc?`9Jmr#2Y z&R~&XI4!Mi?*f6tmFo6E*7a)T`;u=ExOr-Ty#UgOgg|`UMw$`^RDPfxPB{Df+pH}8 z=TYD)4~T~ZLI|?Ig_Bg!ViysLFI^F2&%l}L;$RdnHP{|Y=W5xTQ+xH^cT>*Wcm)-HBpMM`1LKwEf&_av)n>XC_Nkr z?cszP(BW|VM93|WaSt4nR#e4aZ#$G)oJe9XU2&qK_bEBX4#2nfi?Am`hJiYXq=E>0 zdk8X6TD;HqhbPHeNWFlmBdN5Pe-LvS^&Rr`NXSa^{p=nPXvkIPj6_E|z!Y^UHPYS` zk`1jA;Kw}D9tIf)0tew(H7Uye3XWCBG(d9|McJ3)Y!%fOj#C#D36+K$0JZJW6gvr< z&O0|PHr%-=JdVv^hI|;bv9_1@EVXHmV6iXy1z6_;cH)OUa%MFg=hd-?@wVA5j;?eT zkjYH!TnE=d$8c~K)0(+EJfT`rR+kC~VHQcg>VYf~Y&q&pv;Xi2z;KM)2EUs{Ns=Qg z{{@>YTRTS9y7tkQP?Py*p$n!=ml$aQ-R}yx4m75{OXn-UEV@ zG4(<46YXH=XNFL`2B_)N{QZ$QYn4%}8`zT}DiLEq^^0p@3`RC&C5IZ?UxTdVsR!)g z!UcNi0efA@NESZ;ni771Uo=8RU!<;$P_LILuaP~{^D@3$q@+fu+xS>+qb4{lPHc^# z?h$K`@+>t3cYy@u?O1yw;VNy7wYP)NM2JJDyhg*~?9T|-X-^z-zCq{X&>3&iz{d7= z)>}wGk%`3(_Yb69jqNGI@6@n~y{_kN1mT2v0`}4)nxO0dLCgLRZ*Kz@Rki&AJHrgl z=)jzP&J2SB!U&3{CZwk37o?`97N)7C7F@Hk)S$d+sR?DJr3sNNElsGbG%YA?>ZS#m zsig&$hNT9nm8B(>eQLbFwdWi>Gt&Rw_j%suorl9Yd#$y<*Is+=wZD4c3i-2?*9)~f zxhFv9Xhly*n!l;OCj?_7V=#$Lc|$n4nW!7brS6_qOKTc{u2KYUm7&_hCU1+tRcMPG*^|l~8S|eNIu6g%u)|Rd5`o8X~FtV#3%0jKLdz{tT znqn?<-wbm|!7xNvcp0j^b!&R&GWTs3Xz@+3sMd5zKZFt8nx5_ldUp`Fv7g%|2jEI; zx~M<=h%mU?n*P(@eX~;-pFyan z!h!CUFotv<1gRPeQx9ss4ZC_!mIsxWo8j({wX`xX2m{L)GQcr$O(i!R29hP2?nj*o z=i?rXxYI6oFNKW+;rVFSV8m0$fW)A`{K06mN&G#DvbVvcoHZCStt%|dJfFyQA}QMQ z_wBHX93JAng`OCVb~J7%lGA~ThJv{}a;k2JVPy0bV46-;KLZ{suW(OJm!7671Q7 zUzntXSf-6vBJDkC|CM0ywMF-0nE9gY63fAIV4Xtb&UlztVMcVMvS>aGIw4q|j-&~N{%(S|dq;A+%U zCckc{+$;old62$53-s8&GYTs=My>H+(t92ZR`FvXQHPj9$u30CI(M`?o=#sMlC+IF z0*llO(XU)V$H%xQz>Fa45s87#{~9pWa5{bsGCLwz=DB0R5?4~qSO|!bO(0ykJr0Q( z6%H8P1jx2rMFrQQCaicWQ|T za(x_sUJWAy$OmJ753b&Xt_k|}L=@_TU@%Gw0F@KLHWP!j<+;wC@4T*wTk9u-Lr-7I z66-o-<9hO6kDTF_VPK*&4@JZZHH1)CFILb_ zbN96037A3+S?Jp)PjlyD?r`rk_f9bzVEma>)3VtSKH7S-JH^Rr?ES#CFBY>kI(sux z@o!pl8w!2YEy&E>wCNW2TApR()|-8+`w7cjQ%YRZA?EKf0hUe&6WmLOr$Zy1$KgC+ znNR-P(V`d7lH1YD?+X&=M<+wcoZ-&rVb2V(35*0Yz+43sH52{L{WM@Ebm9jXhyHd| z8>P7J{iNbTFnIM?tTL#c=^m9}3$U3wlW+X=519t zKIrYqaB!Hnr^4|;Z>z(>Vcyn+p^&#m{D|w?QT?s$0eQxB6OHIW>s6QxKo)@GTZGE z&jB48W6sewiN&QQSRj)Dy_cg-Uk9R)s1X-W6S3KWZBx$!k3UoVncG?>(#C(g9rhQ1 zh^8XU{D~L&GlWc|k9(Z|V?o%y-XjvjJ|NA4=9!%5F}zpDfqdwAUB7_gEna_AYdj^Hq4~ z0{NI~UX8#A<@?Ta_?%1FS2trDC>t9VV3aEOPIPdOh6l&!E}17$UX& zA;{@kvOMg5D=H99^)annj6O?}^3CN)By_NIe%zbu#M;5^CGL!PO08vUp{(f%J$#8HtmS_7o&QIuImVP_a99tD%X6^6SyYHLUy<$}xF zdC+W2?~JhpMlHq2%)1RFw;~#TjHvrk<}2;us5Bs zx6Q#?LMLP1G2`U?2`yUgo+~QD;|W9+x?5U0SDERxg{r-*puSXrfS<1 zCk*zu!n$L>F>I^@DUaNPqjn(-7HP~9_fZwOeG7L3#Ep_c#!QoBB)C6l1~(dTPT_~m z;QH&hJp{tOyg|Jf&q%o_Y z2W70ncw`}sUWGnBhKg3XCoTNg9Ex7B*XuD5diqfehhu+WjOf2n(s|b*kP5h{Pc~NF94du+2Llb0=01orR37Ps!9W=dXPYU#3@U3aO(_GH z)KURnQD%X4j4H~YI>u1NOe`ipTjuU>KaOIGr~3Mquo`>N&z4@+UMWt?RpfaBUjrE` z(zZV1cG)ff{?+|(hJn_#Em9?~Ooh*qH z>)ay~%+YXPX=XO0{CQA*PYa%RCp%9fEU7n8)jTYOs{RNY;pMX6{135Vul9M^VNOAL z|0$v^DN)!U<$A$=>wgKp=miA-Ltxtr?&JuhynciGN4#oYazBMv*@iY~h=IV@>+3Nd>d$ygkh3$|py9ZHr0+ud2 z%H8uNPzeGHck}3^9K$a3?iKFWf-fwGKLlHF?k?39==!R=D<|r@E$%Oz99&D3&S3Im zX%S`InF5P(8P>s3&!y zB9;pNfMh!RrhBgLZfJm8`3**dx`U`u6vBUC=EZWbw=iI>4dlJ$E)It3lc8E_G5X1U zs*Q{KzYCQDL2q+!$IJh=>~pK$cE14E^mi~8#h#aU+>`JcU5UP?Hc(TEITabJ9g|dG zq0>9vU3GWPHl!l$eTE=oQ2i%h3{gxUrT%6m4S5L&VkUT?HC;*b?-^nn)i_B zS`s^?vb27O#ChMBxQgrq7|!391?}JI9;?Sx(-I3fmhObD2SM+|kg}E%c5zne-@(`3 zU9d0L(umy{o7M)LA3*5Anf{?9E%;CmD3Tg}M-``igxXBn;~pnNkL1#gqZe!3NhR$t zTCe_hdu(0UBO6Dzy|RGz?v*8T?ML!;_#>HOG*b-4KX%VXL^U5{(2wY=IeK!|z`|Ke zOKM=Yucco5Bzf6B_gipH`9!bONE*G{?JN0I#xwI%$;wmq%Lp=)aMH#BX(V5FKnB&} zGqmAay5}>Q%QK%zvIVuW+BzJRu1yDJi90`+#gg+mj5?^x&x3XOh4i=k3+d``NEY?_ zLy`w(9%f)*_hHmVNn0%HsT+cpvuA_bQSu_}5lfeYYi2u@B-(Q}7Hj%hmqZyyVDpM^4dFYk z&RvQWo~d)+D60WWfxcraO}%8$RrN6Y)Y2dIlC3kplCLGfSIt*4i=B^3U>;t201dss zCDlhImxyDMX!V7ZXa*D2U=?(QQ! zVENR$V3N}xyCo22({J2q2(jQBS)_-*kwu#Gt#obsR>ti;Aw|vM6EZ6UzLQm0^qow} z{_kYE628|H@1kX2p^av2j0IdJL? z5*=499X?Mm^BBS`-xO=3iKoyz*V2MhO~H-X7^~6AQ+i`|QAG+0FYO2SWH7_BAKb-O zkoz0-GHFHWH$aFlZGhRRmQFReNhYclRcv?nC^;mb4z|nMr6rRJj!bdQ?k=OMY*J!a^_8raa0no5BLIuU%pBxXmtsBO(=+7iS_B7G-%Y z6>gV%TPj$&TN|)A6>KvC!xf?9%5J612kdYwWx1`x_tk4Ac||mKw+zfTe%um^KOdL&wKd0(7;}YyA|cU7yJ>cTB1`aGZ})f~H*EVFnBf94G5rMx2uYGsiiK ziZn%YcGO9`lHc3XmmqW}EA)oXpJ1vO2zR&Q%&E6G1g?5WH@Fm!npnP zf$Y9YZoGJr4@%I}i&u+zRDUhF=^B7JeOQovED4+9#<#Q;7k-4EW4z+>(wQJv8veK* zb18E?8u@KhG+ycLSs5lV?uDBQ->`T@i!jVFvP@9ouwJ8JLu_Jk<#hCW6O>r*y*~w` zFqhF#S};MG=ls4Qh{9$FG=A>^-N|~WQRu6v^F%c7xj-3d1h&O>I%!+V*@}}#y3@ZW zqN&-bY@(v|`to!zSe`jC!g&)ga{#aCG=77IEC-S`F+GgzN{YG;ExJ3UUxya`4dq;? zBw`gq!F4F0%~W%pqIG-j$Iy_UfSVh74+mqn|Ml^q}cr7EA)N>ONE+j3$ALPcmdhZ7m#KCpkN8LQ*@<`D>0C&+=<~x z-6UnM#rjKYx-W&Nsir9X5&xzsN^i{YAD^Q1==>{!!C#1(hFd?U|2H!(fZfs`Td+$) zWGktd_QwlHX->wWGuiiGwkH2BtTo8ZRytv(MR6q<79Vb;9MoUtpr|Ta>DT$J83g7W z4>E)NoEaA+|Jw`-BWL-AzhEYU%V%s3{;q}{>xuHy0`*iW<@Criarw|}9g zVrkjGlrHvIIVh~!AL*k#Wf;%%hUMv2a~OK~wR&dxu9fh(Yjm8g8C<50vp0hSTg_3l zYmM?Wj+SWI3~5(A7)LWW9#wKZIL){~#Z=`kD~_`0aI-SV>g0T~FvXFc_j@t=TI#pi z8PJj}<72QCEFII><+m#1I=3^GBtXez{4IZm0Yovy^{v6k(KfJQh9R)VA_VU#I+1UhlbZHi*WVQ-h- zrfdKw*Wae}mgdM*%ADFBJ6|+R8)V$BJm-u?I=G+wm`>e}I%JbgH?r)-%JE9x+BB*s zq<3jU9D1Tzh&5}5(#h#=@=`DZ!frFInW6N9m89U1hH1ZZk&cp?$`F8u&VIHA07EtUCTs@ptEnGF*3;abT@eMg5aB(e?t0%)1p$#9aW+nPi6zZjmg zlbVJ{n$-a3tWLtiZHM(P%oUvvuBty~1qB=olMT5M*Db*aH2RDvN*(fK;>DJ92qY zjc{o8)bpR6&VP13|9R2*&o1XbyEc7dchiE$QJ^)n?r|_h17#K~FJRT*iDD(rUW(JF zuyElGizepdlN)~*JS+@m(VAy1an_M%>9IAi1I{08b?~TRJh(FLSD(%HB@U{hq_=FC z%XtDrh7#KJgo0h!fO2mPi$R7(vs@lH{shFCy5`SNefIG`>9GN}wzToZ2uG`nkybAJ z6}SnCY#pg?R7Y2^Ekpj0;^8*964otcrNVpF@O?F2MJtsFc$K*z2&(Ha&!?VR4nD!c~`mvk(ih1Ix(@0}pv_rC{M|U zk**i&URLaum;e$2L)gNAbBl7+!ijxP=|M>Wdc2yubzx0K(*5tg@=-k6XCOO|hwMS<9O2Ppdr0EvSkWKld2$f{H-Bj7;v%kc`v zOo;h9`sg}$WMJ|Rr8)w01l@MaVmE~&V<*JkHBh%(ndt1CZZ0Ohi5uF(C1xDue4?a! zxzTYK<;TPAmD_V~D(Z^kqbffEO9fMCq?(XwoT9T|Q2;mi0p-453hAm-k%=XzlbLS{ z_Csfsm3|{$mILTEAk=}U{s)wd0arlf?26c!$N4uq%>5wTJlky0Fx_UrShAqVwyBs1 zpA~5*n&V5m*;n5A`PHkTP6H<{wh3Efyz@Iih^8gR;IZ3EROlyMd;++#qX|My50xFGWs>^f&p zDUPTc#K{A@S zr~wyHBn$)ye=>$a_y~=meh7Bh@Fo&E{hvsO$hd%@p%G^j4Wuxz;&nL zzbKQP!}Qp|n#nkpr}7unaZf5bqiFV?viGUkBDBEPGsv*ebeX`C?Rr z_}DtiMK=`N+FD1u=)O+&7*cG)g~f^qHt_&Fl-b1X-m5t{)DRE;j6z*Pe!F-;WC0br z#zt1yF1tv>;>NON0`q8_p~lo@K#V3uias3XOC8Wda{pTShT;n3M~X@=ao$F1xh62h zDPFQf{f4Oc$I<KLj1`?fx3K7`^7MAd;B zW~X3O@}*x1q$pykMP%#5R{$$}(m<6EnnmPaZH9j#i>Q?yT(&Ldn z4ny5(MN@nX6M*AlMTT>_jyywaV#Oyg&E&Nae0)q%8?*(SKNED-w-H*@43Ki6ab_0= zENu}3&Z4P^6W>^8xhVQS*cV;793Q}h} zf}2ha6H~C;CtdWnOb={I7jH#~IS88BSyJ;iW$wiB2!*e-hc?tpjPlL}klPoRHxtRW z5NPOyf))4Z>1u+Lzc)&H1dZt}g5#9?sf-U2C?^{ZK9~>}Nze2am-;!3hY%JglMDA= zgcHia^*eCNZFxr+`IJ7w)0qo^6Trmt@XeBn8)8$$_)futoyGOM8qAMbwi$mR&bfU= zws*enBUFf;>LUhu7w9OXj%4mAv#%KJy-!DlO2mqG7zUL06~ny?bv$0@(?L;}i7wv! zX1$6d5x$Z|SP&-HLl%H0G|vkzLk->!aA=6@FB8df%=Zx0AaL;j(4jW1qNt=)D*p|_ zw){`bCvaZ4pcY*a!<2rgHSk0~(IxmwEZN=>^Ev&5L-r@pywU>8$NQmsK+n@pq?*AQ z{UvyGe=|5)E;6n>+Y)nlM|_x#9|enaU4Jn#=Rrize9np(^YlYu?uWzNi^JSY!rYI9 zxgVuf1H>?-vwna`?8Y3zrNRx4GrtsW<_?wbsH#>;d9KuW_&LDKYdn> zffc5FpqMPHWCn>rka~~7OA`lCL9&Vs#nakj_1hp6EVC4L#T4+&mq^odo|F&J7(GA3O-HHvfl?*zPtJCq-muh(e4-p>)JWL|@pA z#!%W2u{5ek&mWf<28QJ=wZNev0z;I?1I{bNT{cT`V8NAQ9_w2EYK(uB^%1s!a3^DnW9)ksWJp`$pUt@IYDbZoltNC9&{im5#w=7u$(4Q(?JOPEgW+uk$g z>F{ts-w_YX8|K@!{{>$fjt`XG2JXUmZO856sD*BwDO@!F2<9gGJQRWBJf`E^%IcY7 zu|w*O7HXJg*8;hBi#`$1C)eL2CSZ%c`gJQu*o0O=b`1$#WaNK2G+ zK|drKp^N$-7MP{Rg0>yleYR@}I*Kx~JQ*{RvK|q!*x)L)z3f@AvK=bGq)g!>;J7lJ zf(EHy78vs=IvHmf%7bO5pBk1zg}~O?rNW0-SrQDPryPpu6R{H4feH$x-))bHRQ9`EB$ss1T*XQ` zwvr+k?T0T%Y9(@#PD6Fe#YB9U6*0#ag5S$%K_SWkph6jv#MBjvn@m(#VezFFOZi3M zaOwA9>x(WLILwOO5jfk{y55D0pCj7`54znzGanaStS;H?8y7eiy_x)=+E7i|K6_o6a^ z9frz(FujvB-D1PmopYPS7eHGgP{v>h2c3OcGFZYZvidE~81U#TVu;MHuQ+G5R`OL0 z*TRmAirG1M=&-k0h_x#$=GT9B+Q$Yn?-EN zX2=eS8N?V|Pxe}nyR#Co@_w@zB`Q#RELn{WLS=MnGjt`cR4zLfj##5Eh2yJ~xrN(4 z)!%by)CY{$?{St?<-Vi<-5WY#oZ*|BqY1cK>fR7tu+)z zfcfa;jdllZ+#$-NxKoVPJ&d5~?~CQO*8rlz=PdDo*qtIPLLcqRYZ&rB5d9^ucZV0F ze<=&>{Xh(Ai6KJNJ~38of%lMcB<1acxLXvc*eAZUB)ksv|EbO5mX>|skm^r`O9Yw= zODowAA&les_KO}-Z-Bx`$RgYirmNv?$$wPQN)8AGgyI02+M85%K={Oe%=EGoEpWid ze&~Q0-uErwcwA%D^;Wp?C)tAa6MndJ-3DN&K_{oZPZMtg9NIq@d?o_o9e|rsC}Z54 z6b%FFeq?e{t;iLXAh@8wFoYP1y$+}U#x*>PDE%OpAmtqty+sws|3RI?LSdZgb}^RN z)wNSxB?sbcW@Sw2hl$;!&&3nsT?D}yl0zwhJCRTi2# z;lX&Y@;LTSWAuR@I@;~%z~d$sgY0Xk?kjxQl0=!=7zWP&Li7~7KoeRvRbPl6-F5>U zGIl|5DR|i2$vy2&c$yMJ{zGVqi)g?h5j^oM23H*7>>^e}tt6I2_==V1Y~lli+2n_- zp*W{&9916@oy3Pgh3KD@?opGe>tPI~_5jCu55<=q7K1YPHirUf5*}7vS=Nuo!v(;l z{1NCwaz*|lqPzGQVEoA@8yt=09D&fT1}r4KwBm?JOs@$C!>3t3?F+}_;8uaX$1f$t zQv8B?eaJ`V5KfO74IhA#5rNGpW#xAL#V%v(W(RA zMRn+B_ESZjNR=LAOddH97DS7vp$;0+B68M?-gsr!i>ciX0Bde+pTW&+Q;RnzEOZoF zQ!g}e5U9{1sc(t#KzupQ3Qzh9N347ff>3tK{0be?7qs9jH2p)shE`+22RN?2`YSQf zdsvS(gjs38Q8ChcL`Q{|)R;-}7#1BBS>7+3^=jDz!+Q3UXyX~jAT#Sg)KrdA2xLx( z??IKvM9P?Y;LIiQ72M1x%sa+$gGa+?j={~PbsX;tnMv!6UqxbPNJ-D#bWPiJ(keQlr^H95Ix&8 za8w9G@+Mb?9=?sr&LIQ2C(!f!1e#D*!a^D-HPM}237iJDzH*L!23@E$t~mi#{RLqB zosWWw4%#qH&Ox8KAZTea%DA|ri&npkMQ};a;|`7MzZVw=3cnM(EZ$$?fh!_3o|z}b zSnqE-Dm1J6Pl{CWJ5Yu~6Kvg4r_g=;aRC^6aGFG!{-}!q`_79?uI19X)iOyw#=5FTE*1Fqh#4g><<{3_T6x>`0p{>C%xH*aopMV1JiPcu} zlZfpQ9TvDdEO3S0Brd^zf~=oJk}7n((V44JbpKD{Hm?RaM~at;J1swhX+402)UoU$ zGk%6-^@gJ;=V$a?F#v}KRQ9tdZsP+iq{tB$H{eJb^BXkP>|aEzh`qq;l3&1{Z2%7K zBx`;VSBtg)hZXx7@OT`+At|QJmT^AHKO=gk#{&m$JD*8>o6Q^v;drX~9F|)?lT)<2 zAl%Ns!V;MXa7ez$@{Auxe|?HE@6unzWRV1dP<|Sd5gjM>5B~*0)}Iq|M0J z;LKDi`%_$vGgun_6p7x>dLW@C+u<*f?7c`wg|h4vpm0n}!C&y)Ri_9|dER)p=4>iD zs`(4-)=f`PlNctH2<$yCcXAc4-hwXuEQV$mgD5mJ;D$8bFgbJv8gU`Iq;#0K_f)pyNA!B=Cg&fwjk4KffOu=vZ;NalbQe=mj{xUDfOzpiwxf{_&Q$L=`48am5A6nQ2$!U_=j3W&L+?iN%Gv zw!l`qy4Zp_^_-S!94tEWb!G51GWZ%LUt;tHDS$#eOk4#p{!B$K72T|ser&OFsGYo5 z18ZiKEV!ewR3jp8=olSk^kLWNZbMRx)!jxPHV$rPlTd+>9uKJpn{~Hqfo36Wn4ZS# zq})A@2QIYSPyOk|<}Ih%UrYclv<{{ERsLhNO=>9h7DeXt*_^4YZ#mzt4~t&@d_%O*1aS6JYe>jJaofG(^+*lw}WrOw9@MV+J6 zE;yp-+9);Ef&+@9)ZW+{gIBUVf$nBH9Hsg&q1*(yH3*r09&%d{ayvs3X-^#_Lei61 z>slJEdZ5jxx5E_AjJILdt&UdNrcxiRzF?U_Gc~aC%nQ@Ty0V=0n*|*HOuUHGGNA%o zi)G(gLvg@@qNqa<-e^rt6n9)eY`Mc8Cvuwy=QR($vstj^u3%bc0~=b7V}yFO`1b|i z3Zb$o^OR6W;vBcWDg@KrAmSfVMO3Vc+RPvS$gMF}%CJUDHjRTTo zIo^9gB4C@sOXnRLQ;!$c)%O;fy1Ai2ph}U@3-roBF=3IpO zIN?$6@Gb-_BodG%Q|7MNxWHmBlG`~S1l(i|9fF%Pmj*ZI0yB=V;2-BQ#i$N(Kj5Jy zF4#Wm@~QDSzp1lNUE6CBNbq+)1Nb&30FhVOfjt;bL+5;IvZYtRAFF<1aqgoAD5hAfz({_YAI9}|YS)B^5Kkur z#PJ$J?qR@KOZk}mi7MuF+NqtKi_Ne>QA-Rb{6tXR#uQ&ktld`f3$6xOng|W#5#U`^ zpB>>7kK)safeUUa?MOsomH`|`Wu8==kw4pJd)&i@b13q6fC~$f)Un+j;~+raq%Yyy z5L%p4hRf5&@%B>#7QhWy{$IS9#V-eK){hHu$)`G1E}`LJq#yH8I1{Y0Fv3IM`qiE& z)`a$GBAtu$I1HX(z0&AC9tW-|4xT6W$!k_4n^M@V_`jr(#cNZhsXkeqAfA91{GBfc z5>sJ{oSdR2VTQKq9n}|jB1N5HvCIxwI;y>GSn}KVBDFi_{PI48{+!hlMw#p_*eF$c zk@}pI5EPdj)aMN@ zM^$x)Zh>1m&Y;K5+SdwmKxt|pOh#v>soR^fK2}Siw0-Cb79Wps1+vmr7f+Q=>7nxM znt3{=^mETmn7cyHfE&eos#BXX#bv-rDWl^()x-qO3d9jU$k9tB98)~z zBQ>sg*GX)#_|1>q;l0#x2sQIkq<1q-xl|p5SHn%{j><1p`?TQ@J0O%KJY0%KcZ|uV z-YQS974?RA*o<@T&;ug(8)L8=2oN3Fxk=wzC9TCVJsNND`pNtGfK;gv|+wWyU zshdorF9#=1rUjR)!<>xeUwg{A9;<)qE?0lYewu@W)rXxR$r+8BolFIz)u~8M&XySD z_%4T|vwf0#Z5sTEqco z!FctS4SSr@ zB4L53zFFNWTNrl==1dyGvW(W>f~qldurjo5A4)pvi=>P1$F9-JGHmm&yCMObNcm8b z!dulWXIT?#7afEyUA-MM)UN4h>P9%z)y2+dnus7pdpnZ4BC z5)c#aRvZOJsLbIKkF;XrUk(atmU>e-MV-TrwsZug6@P~s+rjY9oXM5bteeuizydPk z4)r<9>43;p2ZzkQ&bUjBb-sw4vhi?zVA);jYj&KTo_UYzGc8+lav#GKFHyz4NNMcf zQCKE$Gp?Pid)nbB-Z%-Xt`^_`xXOFfC+r)!+^DRpJ<+}ipRVGD?O4%puWGZuEHUYy z#A|X4fz#ISh3GA&287w6Tu(#=-jdVM9E_glRz%G(9KtY9%Ip#Izyhz*vU%!A*>qY0 z*&Yv?pd^%GY9;eAbmyHF{4=;WmC_%J!H%l=Y8qzH133%SRPKS6ER;RaxrGoUWq}p> z=-BMs@?l?$g>9m`K>gJ0-g>`!$m}kEK+TSN4N1qJDFu|asM#cxZNl#Kn-)P(1ygF5 zsiVD%WP2}r5aM(*g}x3ys6M)oMK9-(d7VWC*U4r?X?Aacn`sRE>w2mTcK~ifz_b51 z;AWmT@NdG+ii6?)58P}!fje48_!a=%<2opB8Tw4e!>TKNn+`K-j01jKhnW-ijt;}s z3G8kO-7_YWBU?1wR%S^C6 zB$gtGy*jGD3H6Z<8(@NctiuMHVAZ%nQ~h~BjgA^>LhaLGSD0X*=&)fX*r!y4+UvYu zM~yI{4(PBeO|Z`bdzY!haCAw)TcrMIg{EMCLcPN(HG$StpNGw=g(Yg8AP}Hu zRIEfd^?9IXCAvDx7lF(t)j1Za02_TI7waKJ#Tp7Xe523YOqQp?SErwXI#x`XzoY3U ztyW!4N2CSYSwnq1FZ-$Z6*1p>q&-%G1@cy->ZR@?qoA5AF{@C$Mvax~AYy321;G6~ zM;8nRQQZ!9nfbKplbvK&V7T(e({~%lKTdPc+y(cBPADG+&M)4 z1w$PHBH4?30pj3-LF8zOarDGm3<@?A!r@LosuV9M6Wg%Pa8xPAPxvmC%4}6BdKvWQ zWvZ5N7{w%mfKb3^izGa}j(}msR8$6~Ycs7cgMH@+R-d5}eM#aOwHRmBt$Rkwq55ak zNwNUB7hqplOo=;iL_IlQLH=@s@zR#(N)?-n0U!8(e+P1f{m3#-w>-^``PB`d%-E-ihdPI*iks=l3w&W~4a|%i)OfiZS&+X6rr9&LVo-Q;16F{1 zOJ_EyW1~(P!Gc+RbnQ#($C5mP>ialAzEKSx4EYe1ZNwtJAE;m>RD*@IW+NE-M|Q>I zLR48;>6_GH$SGb}9x)*fcH5O$tT~;wZ34H;4VAc}rW)I5T`#kiL=`VXv&3d$*3Rc| zz<@FS6&Mt!Q_d@D7w1oUvSMk)D{66Z<@4Ba_lnvd*RNo8;oNd{HY({U>wdWwmcfnf(erUmO7&9cPPbM-Z`@1^D%3e4*IyYGi}XLyvbk!B`o$b7 zjeZrP^Gwi&Q1^0MS3>xC9>0c=SG+2_yfd$=-J^a3hIv}@Go`<#_CTiPc9*%YsjHp5 z5Rh|{jQz4$blGRK`W|JB$Btj+X1~M#4j7L|y;tC2sbw@?13r{$zQK?$_ZpkS$=t%_ zVujrsIxoxMek zEt#r0=!q?`Ff63KThv!@w)2A5)whu1z5xio>2xrlHuCEYWMeW#y{TR;%e4#QW`WCM zfYUKKkoTtg4WFPdbDG`O*M~}rusFMG7Hp< z!|=Uf0G5qpy^S%^@09a4*l8dwcpD?FZ)xw_5b=LV?kqly{hpoPQ57dwGK-okD4`6U z+QfH|)Hqu94)XqI0QRdn7W*-5a&JvlAMs6XRWKjsz}<=(CfhWBId-nIZ!Q~7{+clN zBebGQP3(9bz+9~cS(Luvokvp!?598JhUak0M|mIga(g~Xb@>C>|BkwDqF4a8VJw!u zitBNSmO=yGg(O~}E)Zj6wK;J3 zJ;(}Ue46w=F_!V&P+UFug&DcOZ3*u(eX_^GTqG=#3ZVLF&h zYj%UlM+C0>05%icT2t|%`Vv~els%YC;PIbBkJnI$M$no);GVHm^$K*J5wv%Y`WjvZ zd)1F|cv#U8G{3r^t+v37kJL9<^XgEoeku3LNtK_W|J1dI`6us>dU+j&nb{YlKX|a15)MEt6_fZJJx|sFHAPyH zn3=ecg1v`0h!v8#@5W=_{;6dA1C^b_6jW1(B`7Bks4g$Nxnj&M7>k5I!{Dus3O-Yx z;@ggD)kp1I2M{mcwL?N`(W#t|8Yha^s!H?m7h~+Z4#_|$yZKd2H4kfA$>(T>GJruS zi!q-=mm5n(r1?O-<8$;a7V>|r={tDSzEESOkq-L~KIbLwE7~a~NO}}!c8H$YWGebX z)toYs09`>9wdl2qX~!4pv(2Y0xug!AMCl=Qh}9ZRUmsGhI-iEohf%}DH2ttlu`J@! z!~a;sGN7}E)ii5FG+lf|y+T$TA0X16Y7U}$3XjP0T6N@naMefDPXAZB(!PXInd`>G z!Qf%`=UOeMyf4oOgH(BF>zDsj`kco;V41#k>hd-=lowBFFhldtXo@k$u?G6-2LHng zCldGqTkBDY!7_tg^eZ?Zv%f;YO{b`%Na6-cKZ-ioKqHQ#Mw?vgkHRDmtM@T=EQ)yB zbhMXIbFGeUb|lZtzI=`lcaF@?aSrfL9ali zX|Ty>9Y^0^Oh97~{}14mNCeGn9_)#Wj>C68Rr~k(FLS;IR{-hTU z4NLJkxzyQ9K27-=0!QC9QTny&Y1+07mE$u$_V{bHoZIg=>O3Ai*Plet^G~!xQm#Rl zQa1sodUQRZ&UUs$LO2VtwEhGd@Ce#{0&+(tReuFj+`$1t7OyhJ$oRGR=Bk^D$AIV4 zw(rz$5_n%Pi>G8fTx2}30_z0%B~bM};t3|{1t*^)5{$m+l#IUO6inAL`ef?!13EcV zsdZ=tY8G4OG_ae~V8CTD@@=t53N|hL0Ha)TV8@T@7gn_SvY#Lo>jHT{L#A3=M+e%S zQ7>vLo<0+?$0+w#HQ(uKO4T2~qL^_W>2Ii@vDEiBjFSp2t&Nt>k@-O0Tn=LOU<{ENEMhEM<8%IHL~V2mRqI6qe4E|1Hc8&4ww9e&y*zsBb>4YlrX= zR>x*N)%dilFCb0*C(?en_Cw?2pXA896Uai9S1=%I-$c^+zmr__-$}ascapBnlPGO9 zkLcDs&YaGR|2s+d3rNa_d6H>{jrHXz7@FngU@^nb7?r)#e*gy-~RjhfM-Dqg~Z-?PbD zb2_QquAG*lO-9$dEJcchniTCu+-I5ILE{4mrgVVV$6oRd8V&{v)OXN+=Kca5h!*&^ zlU8jFQetuCeb~R4eSZgs-q+CYT_6&I{SJ=lKL7nb)ivF4pHecE_P@AC7DK*4m z5L(?8^JYndwCoEn;LLk!xbG9UtU(M7!O{N z0SybxpP-F%LEWjD3bswA^qbJCl4<5m;McLV?ItY|uERHJ6XaZ{)I6x_1#E=MnueI9 zHypb4bW7NUCStAWqG?(@{FP19;(**XO`8Ch_huOiV$ewoZ-Q+o`(~{xkjrkCq!PLH zX3dj62u0DPTSHSF4+&scWixExCHtyl`&ISenr;6$`*sM?B@0CphF>8tZ$0Jgk#*@$sP1 zSS$l`S`!SPP2XG_>}R?O7DN75Q?TUWChUg)Wp#{_VAvU1F=S$%STV%@Uv%zH&F5v? zCdX-z%Be4$R|HF2QvXQXic;8>PP>tV{CzOxWG#TXG526gN68JaMY=xnIs9w^VI?ye z4=1)09!?zpIAC1qbC>Kia7G`N=iH@vM*I#sBY(^`L(B~krN`qWFCKh0rHzB;EEtL< zr#GUw;i*K*{uVrtq$RqFvvM){J`)F)l&0JA@<7F;pI%s8^l(T0J$Y9dk2Y4h4b;x}~YM1^y-;VkJfqNUSwv~k8# zh;uD5v@OKGf!sMby(V`ql$Wve;9M;guT68cxODRfnM-20-hjg4BMf-p5B80o!+$Th z{YuKaS9=YC;W!gWhlLJDAY-1EZN>R)Wed=+j)FI?52GoM4ve@@`+|>n>imEtu#p1nGb67fH?6WqK3)mA?*dc-h4=Vw8>aA zl&T&=(_Hzm)(0rqhn{UhT|w!Su%@bTv9<^(?-Fe}Uh9G{*g>#?@)2#T>;s)t^`alw zR6Q!&X!@htSS0kpM^WI#wD(bMQX3xkFyFMt!E_z~_maWtI`yoo@F&U-*F&Sk=FD#;3{FszD+a802-arY< zp&?-j$Z~BYi_hiSO9-!OrKa(sszR_goJ)$dTR_vmFFi74UT0e%_i>14C_c-IwHvw5 zKeYm#67Hrg(H>~SEuDX?adFO!5#I*tM%o~RHj@x>lVNQ=X>rnyW+%%pnDD71%@s1Z zWFESTWi$3Kt<)wW9n)9JlrLMUB}!uy2xM$*+X|MQ%mxhcFbL7fm0BmH&A$l&^sfgy zrLBUtgNuiyEibp!fpcb_MAtW&4nGM2Kbg)wsdbSlvQg0~e;ma>rMYysWfyK-%=%o5 zru(1LI)ZlnQ(B^qD|iaWLFMz}^lzU+(d+$d(rP3b-+Y%{QhNwY+~YbCCHBW^sERm% zaE+|w^=q`JLR^Dr)RoY^Dxa1bVZvG{e;a7bT1jAu#0`STS|2tju9YQTj0#QTVL(Z7`vU#b=izZO>_|;f9hK=j8SkoZ84)r}dCV z;g&EHW40k_Af!#*bFsESJ1ZLE|%MaTOV^o_-3MT>YY!76d?+y%&p>P7__l z88{@=vtBDrFpu?F_VJ`;lL!ygtk-s0ZRKkWp%_eD50c8|5yxbP^_ z!&Jc53h0j`Xv?cw?+eBY#dHqfkY$>Zw`D4GHet1J_G^&6V}eO6d<`{$b(@(THQkm%m7Bn{u!_D3Nr<~{-UM?=OFMXa z2X5yq{g2dQ4*v&5bq$HPplpqmLm;aA7}FQoZ)r_4D;#m)C7JT-j|78_CB)s7j1iAN}2&XA>7cmSK(@;{GD37 zmnS9oC$%HInY%Vq#ZIk9UtV2o7`eIe7!Ay5sLcKb44>x}Hr$GaSc+)?zfhUGwA2s@ z%}Nw|Y?A&JyR>0)UV?*(qcP9mR3^`EEmz7^3*}vcGn~p_hrPOdH%d>QLWdFMZt(E6 z(ZyHwjKRGL7$}Vh4ETUYM+*a)AEH|a9aITl@$kEFickWMtI59zr_{P)B3;FGFnDLJ z#2Ngtd$kPEUAI>&#_QBxbV5=r71yKtPWlLpw2%tsc0!$ejFVckK0<$I^o~^U5h`T7 z9D+GHN32p!U}rK_UTL@Cws~$JH1QV<6o&`c7L`68ZNqo;B4S)A_a${;~V>c3<_5rmB6YT3l5B37D^vYAoJl@fwia^RYI` zW183K%s!Y5CIyL}p(31GN2Pyb)kWH&c#JGQ(R$h^vl2y?Vi-#w4D((PjAM%Q?w<`T z|2PGEUcBYZ<a7SAC<5x#V$3uku+KWUeg7nPxNoo#-j~ zp#z4?3u7JD>}dKsA7}F>C3S|S=mY}KI2doU=0sEU!N|7Q)FwyA)iYuo*x4q(D}O@% zv#}L{%J-w>u`}|x)}7KSadkr40qsRu_X$`>V#P%7Cm6>U-h}HSD_ioNkvqLu81fl3 zJ=oqq(^|912=C-T_2)>e^w^H7`q9)gsM;cFXs;&#Ac)D&~r5m<9DJ9`9-DJ>@0 z-S#ay(EeX)ZvZ~v1O!LcCTk?!@VVBC;_I}Ha=n}#w*zCxNnITx!I7l(5RN#EvR=Cb zfp9+?aC`+G1{hb;3^lHBHAKGB07KApoxm6k+(x4t!2Gx4FlsF|P}%^6*FHlsXN}c?DdMb1 zo0u6E=qwI&q~#9w^9@?L9JOPl?y_^k&XtqryaEF&hKk;VlwOQ>4YIOdG+!G&&e{Sh zR^MmfF^sqWU!YBA9#ZxhX;9!eb+BZ)x-*bs!MM!etY4+DEci`}3(Wl$oe1g&4q2Q3 z!#rvziBzI7s|qpphZbwiiDh>`48i&r(2P0DbiUn!8a>%1`G?r!Er zs9ONzj*N{9{F@Nw9uVgC!Hp9*W3Z|5bPO8&r@zH0mVMM~e`=zr{3SH3EmZLr({NuJ z=59|F?>f5U&=zQprDwGi>(QU-{j*v-91D5;EQT$AD#_mnZR@iTJpNVsyHRT^ zx`M=9k8M|U_QWL|gQ<(d3aw9!w2!d&djbRRr?H?lQPhYd5qZr5Q( zvY59fuc-29meDKrdlIA0A#LfeHa3pLgMBBs)6jMayvP#v`tik)cE!UU`58o+7EiL} zQ<}!FhiD02=?A|L&DCzWjTqsl#b&sTHX1yTpO5JCuLHO>&_)KiL)mn zZA&TL>hXDdgMy3CoT76y#p+4Uy!5rk#vyo^bvl^>Z3{14re>H+hw)uGM&$dc%8G)1 z4HrN%InVJLs3-YSNRxZ9ercqU3ZPm{(4)S^M3+PU2v4fzUK$bM=^>uN)sg1ht)*oV z9^Yk)a3Q3*tj6mXM2<8CG*E{PG{KI4Lq{S!7h$)G(}qG?gUcdYQQmIcBsY%+*gUBV z4n za2KQWf=d=7G@O}Q6X}WbF4v*0^#GXD?Nd#WE8KaHc{FCVrjjT3Cy&kEK8|9u9gp9-~g*#wD8O zWCh@6n!P5P$D4u81k7OQIXW#T^-7&~=Xw7NTO{egUFU%&PblCnT81^*${#h`x&zgWOT71BG_E;rqtL~de5x8>9<$+CWip}BW0_M~m)bTus zz-HYj;JZe79MJ}x)v$4&(#0{+F*GsCLQCT)h5tQ<}ZU>gub zo5Omj5qNh41?yED8!U9u9?iaQA3#*~RkDvd-5II$tbc zX|NcNfJEMlr_DQ!jVowXv?tNt4Z$gtnU5iNb+pG}`G^hzjAK^*h=!bQRYUFEp7uB< zJk#w-whgOhDfFhrL-XC9c<7|7+@3_M_A$-!M#NZ-QH>kv-||stnXZDH6XuX=syaOk zJ^UlOLGiS;#s=S5z@Dji;(EQhH#C$*aC0c_@$h>i9_9|N*%3OfHRZi0w9H@jgnE4+ zZuY{e0KZ?sV|aa3$C;(_Sh5I@HsCTH<1V)tinYlAI^ivy0*Gt2>h zft#sikHfEp>vso}z?LhfR7{lPO*kW-0nNZtbl7k`3_HT$uvGmWtB1+W^3Gks_%=}ChF6O-JA?Jbv<@B4*{TP;HQo$wWrFVpoa>L_txfO>z@vCm z86#XK#7ZCxiEb{pg@7|{1|EK&(%*@?UltpFohDPq>A7s-H_^QEelVQNnFjH<_)#bR zTYqyEa0IwSTvjF<1tf zoTK4*xUc}Xw&+RAydGb-6g@01;EwQX4(o?^L)~>$122|p`4X$cu(_~Dc(iHb{vXQT z1g@%T{U5#u4hjZxj_gSWIS2?QCZq-?Dx|3-CJ0Wc38^_Ngqj*AsFiad%A={tNxKed zK~YCb6EaIn3mR@#+J$WLrUhLqE6w-&ti3mK!2A1uUO#O2*=t_Udge7Dm@8^dwh2ZU zdqPcI4>rO$tr_-@TZCPx*2`-yX5XP~R3+~>qMF<28>j+NUh@&vuB7&(@#G!R)^=|i zD&dOajNWpN1rQm{dDHh0CH&3l?l#i#XuOPYhNQkZ#~z6&PEv)3-+QR~H=K5PM3oZm z8Dzxq8A=@Ypz$7Ty!#mMr;NO-jkg&;)Iwivk`+uT4cDa5u&`&Hs1K|N$WL9 zjXTh)6utIdMzXt%x64R(nCcI8QEAH~Z5%#ljIfU>`RgdPPnGf6^34hycW8Kv_;E(j z^_1LRRXbiZqHB$}NyR_YB21@ZAcNxWuHQo;x z?+J8xew)x` z_#YD#LxoMtJX#zqZL`cbwl{@H!PxKt-(YHp6k}PSPmJ1}xX04>QK_Wv1I|~=LjCU1>OYnd%aUG77 z-nh-@F~lb!-Bqk-2@P-+#Ytn^ip{oWp_TM&f^^)H?>gK^`q-=0{4cJ79w7a0S*o|T zV6X+N0qSj7;WGpO&GrxScGV?GQ#>t?>j`2%#d@Z!LDE>vTZx4Y1rLUMD$kMI= zP2riLH-c!xT(8b_vW>rFFGL`-_NM;P%{_F>5y#x;W}Lk(c6{S<1)F^Z;+UD-jI)$s zK09k0t`3+!M2fbrY?T?SdS}T`Aeb?P+3n4|;?l$?Tjk(O6UAYTPa(>j(a;ynpC2kc zZCOS2DIl*)ZT)e8N{W<*O`!;wXJ3Ql+&F%CP4F(tz7KA(gVgBnA4&a7I<~>=hZO6x z7U}SZ`TonJd4_QtmNM~)n_lY>YNOg=QWS2q_qW;C8wD~n^a87W{8h_7>=cy-(6vk) zeA;Ua{;L^=?L8}f{BinCmZXs_6)O1CRC_;!2ksL}g(kk6(o?0rmLfCI?>7G^I*oMl zL9=YUSuU`EZcpjA`3KQ~AwJ&CN-Q=r8zt6vKp91g;bSfuE_r)wY)}1z{1wz#FP0_sLcVD=Q2j!dz) z`&%urw9=#=ep>)xlO!<1l?G64r5$O~td7qhhB1Zx18ll=#&Z{*ZCuDC`*ve!%(31< z#pxL9Jv`P}{xm_7ymlZ-d#Zf^sB$e`TIKbu_)Zy*A6sk}pChW@3!WDDF<4+3@qnc{@S=z8<@cp+rF)Fe+Jr{@(WITU8SFAR6iz zg>s(7!A1T-_J6iYVzfiV?r9b493^!l?<~oNhVXCuzE(->WBq&D_am6$!+m5j*g;{P z(5#}-Qlk9@#Nn^0@6XWr(JcCW{ILV`@Ag*v0i#Sa^D`7O1_`3up|g%IK**tEq+X!W zdW7OUy5cAdU+fs1VYr(r#z;MI6;aC=A4XgV2^^MNn1wm|*s;=3`%9>X85%#_M#A<~ zDU{Osdtw55tQ1XIemGGv=7-KW9qv*Dm?f5!2695yNzB17#c#&3^7b@$YX{|C!fyv2 zw!)e7o6Ln3ZAc+ekrVH5JgiWf@jdaIX_>=bBzqV(1jjB8w)${D)Yl8kJN}sH# zUe6*ZoU*Zdgl0bgVkRnl06yaNd@o~(a*DZ*^y!kxN??32*d>ANDa zBx*ahsN_$?y?tjNh6o6rgkOtBqdPUKe>Bw~!t%P#D~qXdqSVu}kt_~>wUqI`e5GWw zzkvdqQ&lm|c@X%%k!c>&^bbOq9%+@Nq9b^|Z4zjHBZ2>8fyw}X2Nh)bd;1ij3p`Fo zMXf%?`02poMb)7osRO~_A&h(T@bED55N^~NPr<_&wSwtDlwwMsq&KxcjZU=77O zGeffy!Q>l;Ne-Wt$jUWg2?~q2VqL_E21V%%tXgMawEaOzq66(9BsMiQSE8aq53Btx zh9?R!X%AIrqp;&tjTtsBvkR|F2*bkfE!mK%Ne^L#NaA=51P|5QW-7~lfWZ&hI7ntI zg2VA}^a(RMtPH~y^N^5d$qz~4_IFxA6s#=Di-ED3oDWG+_IF#gt2o%d8{}Sn7}ieN z+5wCwk)%1lcL!1IFiEqYYE?>li2p!9L2!Bj@TvfRTrSkAJ@zTm5c~VBg3-*rl)pA2 znoduVqPyoH&xnWf$yJ%)zF!s-m_DsB=`UeAJ#|bVQGZr!)9OI$hQv; z=@V#O!wuEZT43+Bhaov@Zw5wB19$$&9B5M+kV-p&bC*q%toDzQ)*To^E}fhva8w}8 z4_wA4CNV&9z|q9*kw0xZWa_8L?@k85akw$JV7w1ZmtySyYE^-dRiE8D_-w1->={xI z`{%8Koim{2jcpUDQC2lrU(sNYZrW>+H|gjL0kNBORFd3?^K1rj+IZ+(wwb`nRaXG* zE5oq#zHT-6U3oS>&-M40yqLk54gYUVJ1EVG>jLQ9(sP2;O(nb&gW z44)0i$E4v&jd3B+GxlTsOuig}UFA!$6v?p_C;TeVm?Les z)HiF@a=lAK=YqSeV|`6m_P+**SbDQ(id%tXbEO_(E4WNNEPt7{FSJTlJ6DQtmF$~V z$-2&yhFQL)+I%S>Y&i;Y;9+H(3;nKD>V5OTi=QCNWB}K3(26x?clc{@-yT6-+<2s3f0qfA+-E+F78uCn-Bm>gMwZ+QI{KN$+kxemd}&-MwtoVRj>*oVilZ zu%$*a6VyMoN>+P2n(Y0E)}9;7;|l{8#VHLZg*tXRdG|2s1mgkdpgi&@K%G zwmR8!ky(jeQ z-;El~q01w`1(ND@mCL2ZN0Ax%yeYc9CQ;2(AjH`VU|IZu=;oct5!NV8=)p->NuB6} z1yX;@pE?i7A+T1J5*K0&bIAhf>+_e0Nce_#gNun?y!_bLEa$e}rpN(1eGBLn`L^u;+;jbJROsqTR#tByrdu$|r2 z&6_=w>hFTiaU~8lpIa`qrw5nflBq46lp)%D@Mn@Um4)_1R9&}7n&5$DK>Zg>3a*!L zjQ8(G1&gID506%18ddGH!oR`t&=ch~*9wqx2CyUNE_8n75{L^c5;PYVc{u0T5BIMQ zMV&cM0`}LI0QO!+FmFr?&enOz&Dqf}83jN|DiCGXyy zk)S2ok3t3q9uw`ujp|I!I!edCXvVbBP55Vvi!drPao;S*#Qn%tRq7pw^%2b|36gS`f^Yo#Q6j~11rQsG*RbF5CQ zse)EZ*P&6v^+v_DN-uQqR6PlMe@NR5YEIP|^pWBI8U&j=6pgrR!~J{Vcmw--2)I=A z#X-e8ak^I0dek<$96%>Mz=R7TG9(|hE6^=|?gZ=JSZNL09D#NCX9a4|Y zWsoC%Tcr>X$tn^+6A+oQRWwtCAJD@K``}_{araU`K`#lK8pLkfzC2g+8=Ckq#V3rMRl_R-CinkAH6)Xz6 z_kR~OxK$1m)Qu+Og8`R$Ln&A{4y<$tQZFc&aKxH=1<@YM~@ta*VGLO1dX1JL~ zU|>hLiUTV$;>NU!6TEOcdl74%k$mAib_aJnF}0O$6YVw`gGPzl;4B*_7y*^l;vmpf z8$kct*_pO#8+4QhnnmSLg!yaR4v;77ykLB*I)-nT1^_Nhi{ zucxw4Y?+FfpXe<}-2wW25DA)(Op-2?%SNN8NxQL-^>&oYJOSI6SQPi7icJ3=aMk!n zP(dg3gFSSROPHp~@~1Z^1Spm`HmqNPf|b3K)%6J-td=_{Hyet7XQQl#I4TsOg*&Al zK5Slc4U^4KzlWgMl>KG3G7hjC%vL5P(aMMX(=0J;PjOJ@|`FN$8KaJTY(d;n(9w~PxkLbHM?N3&(HSP+VRN>T;IdZV;Y>&6kG?!eWcS@ zFj9`+aWZUGCJ?l0ihnQrbOVrh35xDakn&)uQ~e{nW-tt?G0hTS=}g^sVZLrALYnv< za)dHF3>ErUSE}75t;J3rQPraS5MMfy3EgGOZYjZMHu4E>NMT>#lz>aSr5KMnI#{Xb z=g#n=JP&G`i&V{3K`4sP1DwHB@w~JG`+dYf1@J)OJj#Dci#&4tg%<-Vv1Jb|?m+6w zFS|})xh+bA$;FE0_C3-8k4OBe{dWO@R1kwfp1oJnyecrK<%Qc37zci6hrMKbF$8(A ze9Aj06ub}ETS0OApc~Amu>F8#&hu?`$0p{j`MYc%wBUvOJBX4NN8%(w+|SN}33Jw$ zIo~3Vn-nr13piwBpcbQr?vtgpojXNQ)?EKV9!vabZX2k|ju#;F9;3JyfF1e#0)Lwf z9-ec~!wQpr{R=4iajJd+1cb{i4nXBCU|3UjXK!3eeE{t)q~Ql4YL`>-0jXz){ivI# z?-*qnL06!QIsSKAaJ@I8De)kxdqU*!dQvawuePBjj^8n5c@Ql3DGoz6p6Ao&cdI{B z^$XZnQ+h7oD=t-Cg=FR=p`NVb5&x*T)h&ZjN*6q)+PS7>JaIP6Oh~@sercZhX`X)F zEz`%XZyDSo+lH3$qMEp;TL!ntR@5?HZ(Z=&|IxaQw@e>b(lWS3HJe(->#f_|GPp&y z(w6aHLiQ-C3I%n|FNa1#NZ>wn;>Nu#t%7UIr3`s1g4x<|A4NM)8>d!4P&|WpmW?+N zA^U;Oq4sU9N)wfAzjg4ATL(YeGPuO@89Y>H+hg*#WfY~qEcK1#t-y>#j2xydREDJP zt*>|)vjxspCE$|Ppb|b9Y#I5yA`O(ELkiQ-YSz71q)_{=R%I5y0_XqkR%Kp%MH&$K zJc99e6Gr$Qfu{`~c3!Z@VO)tl9>?WWN)a6sun7bqO>528Lhf_@*o;~Uwlyr!>vGt+ZZ)*uY~;`}_ek!>MPK`qkSOUq&q!QzXTqpm_H z|NQpGjm+OzA$t;! zihXGbcrN0(ukpr>U3d=uf^>Mc{P)I<_whtvliz1oZj8L~4SwYQcH_n-JT5#nc#?j< zaYMd(<3g{7fE6C2`8D2t{{(n>G0*Px_>Xd}5Pz|UFxlgz+(TFygX^OX zOL?^DEm=Qb%(eZn6u}qYRKFoj7N=^kp3OtXsNlq~CQ$llT%VD81fCe&I&}o7fnxyp zu8AW@ByVvW2a^CJfSH9EJu`eBArU67uPZ$&@ud~Rk3xjthKi%WZ!VvQGt5XR3g$z! zYL8+q3~sh~6Fzp)WH|6X4D3bg-jrfxzKf+*m6W`+4UVSaa)U~bVb!{5EA|!7#i>mR z$DmN+mY271Do@P?>|`$Z*yfECxyP_j#4OGv9VgWv!(6x-+yn~_#^st-aKV^yH?!nc z!I@(Q-^@~71s2dcSd`>jEv0(pA+0~<4#HWyIn`2~C6ChIf_jK^y5qC~bS?~wxzhG~ zTE)nikTSU{!1NX*t&=Xl1(4$Muj3M*NWJtpmW^fL}>(q?kC_p7qdh|Yc&`Yn3w zg-bi5PfAzxAY3VMN}Axq#S26tOPg?5V5h_oo;fA@nEgK5l=PlxQ~G<*6dA_&6CC(K z(fZo=ukFy$^Td&FaHc z>l@6>s zBgNxo@x=-KRcEm7s2L<w8gpAKfpD+77)W>H_neF9G(IET5E?R>SO45K$*2*ECt)_!E|~guI}~yM2cks zJEq{4%1!P zg5oK5X(ZfSYxp{C{;z62mM)(D7o7GCCzA-6uNZvj>c21$26e}N2B=k1pU)&dv#by= zaXl9fk9sQ*7cd+LBG$arl`jOeoRxwi_kl8QLrEs*VnSh|&f<>O^yu6x`7B5YcXFJS zUa~k{-9Ja!Xnc!XD*3_>Tu?cLCVYvenl#TisTWdx0(4>P&lgzK;6%BiFQqLw0wwGM zBl0<{eZ%nnk8A#hQR)iJz~%%1mR0Aa34$3&D45x%sT4UW?kg|@@Yk<&s{ITFulq_` zgo3^PE&UfU;%ZCZIsvS>I?Q#tT>wbsbZE9Rxf1=-h_)~UsvL(t{$Ua>H4)E z_hh8NHF#%{H>*zu+kRC+FX(*BL!L?MZuTB3-c)ZvUChVVLu7FO|Ovy@Krw>K$`y( z7KDS5e+NDh`y$S%soD$dDf$@%>?C^wm`Ek1Gze+Bv;jf`LYyym&~v-08bFdr(b&jn z;qv=MQhh9WuE@X8Mx;4-O`1fBzhNZB(%|UpQUgM>{{{>lsf?t5BfAKA3@`g&(X7V5 zr4<7E*!E}ayNTY(yJXc>c0r(ePdNrr2R-EhcwP3C z{{jpyTIC>P)Y9*RbJO7^$LfLs;>|V3OO9%bLqN{^$*S8rXu;@RM}1|S6t72jXnuB> zh_=wP=W!HF-OM1X%h6sw!hNs5Br~)a$Sz--9LwjD^y?tc<92nBhu~E!$)U7Y!IV`) z2U*96o@7Z-gJ@8I+zVh_93cB!1g7{<_6(f*Q6{0uA|o^wmqnI;6gAc16ed-+8nscd zDwm_OGphVFf+lKaWmvzV$>Mh{HY5Q}f0ZdCP* z%|Ycia9PO@UFAB9xbB42L2j{GTZZd=H@SrM+T1(j61<#gA)(~`xgwSR43AuaQ^Q)G z9CCG~Bk`M6DTXPx&{W*`n{V^$Ov$S-b&__soPa7<-z|3wGxZp=DD!q_ z7JIA>VX1mwVC|*5fm2xdijN+amnbYz9>|?!)}5ayk40&pCIWJ}5x1XsJ>O4eCZi|l zFV7YL??qwNyaIM6xT9@=EQxV5$KGVf1}{n*An!HMz22XBfyA=B)9(>Y z0O5dvWZ@vC%6sG~z`c$GDrtuPwf;T<_%jtjOcwTGA_+3|q;(HrO;ye?!4ynz!EzlYI=^F> zU_)`K48~MJAo$HXH(osJ(+Np;;l%l(V3t{3p($m(#K%Ua0*6GRrhK)%Rh6XS@=(!w z-WbEJXU@%nb_V4RmnVx`4b3RiHz+RnqU?B!Djad%_sgvD;o9LIlr#&XA?<$Ab`j8U z0jg@llL)PPt|Nrg{qiPgsC_QCfm?EfoGHp@RN|_6c!cVZ6!n0O_?!gMZbtUQq638wvrM9}Y4TdU;(UXn=+ZQtopx@TAUex* zxu>Y0Cpqh&gw%C}R7;yK$Jk94$YUb7DXpI_FGCrEn?=l!lbWo*Cay^fX2`lpYqA|3 zcV3+#4-o7`1XJSxSVgv(LUJe1G{jRIN`99Q5t}JsdVZ!Dq(5fL84z~EXNkVdnT0Q? zTeIY+M4NG#(H~kUHJor@jnQmyF6e^yfeRg)Eykv4IDo5FaL^8+nIT`|jK9Np}s^@TFw6}eoV zXJBEW3rf|2&T>>Q8|` z1K3b%T{%z5(=C?Q=<`)#1aA(B%f1?9B8-y`IGr9g%b+#DeJ3&N7WcWDjGv9d<~$4t zutqeYaSa386|xqw=#htcsbTZxf=|vFo3c*IpEaTAlq({y7pcr08OmjAV&$Yz~X?( zm%Z6K(EOejwRL|Q1}jwV!*hL zZj#@ySPs+TQh~!2rE*3K9A^C@z?HOJJ_$r7pPd5BoI3?{Yj-v&O{IGj$(2+FZ4w=8 zh2Lq<$>(m3#4aH54U3x&!a`gdI1iJ7uh)E!Oy&cQKhlAS6%jGKE-=SpE&~iiR z=|c4{%6)0Ye-PCEoVIHG$n3JwV-p4=ApeC);c-maQM5GyD#_b*`hmBVr+ zS9=Wh$C20NL-@^d+O_HpV7utCg`90X;dwhESfLQ&1@Gbj(AX0)oVD-Ck}K;dEGOWX z{TQUG<)~h5T9rUWAqWbpAbha~t6H9Bf78$(fW8L7Ev^<^qM{mfXJ`qIw_wS^1u|I) zw;a>UD|$=dtIu(HGLBExeKRLQY_3hm*&H$QX(#ZJ=URP2zF>yA(Ac3Kq9<0Wy^aG_ z>rM&jA$pSZo*ZHDm-_C|$R$5xm)XC*B@u(w>DV!o7%F)8+V=5m^)gQ|7LNVjdd+{&>@W7+< zrsgh){2I^%u9d76jA*fVxi;6z@h39~cm9Edv$!$GRT>Za6mU%9Fos8r90iFx;XLzN2 z3k0hB2FzRh-swh&H^)~fIR*Qm$Z=;{?@EZKqcrrx|^W*LC|JW1a3*uF3YPRE1j3+c}z`q++>B9z`n!==-@o`AT^4RVwiV}Cfi+j445zhG{$PiQRVY*Vqzq7fMXIMp@+z<^b6co@n~AiQX8 zkZ^f zHK<@a?BN{#wf8p=3Iy!$f~v;-E(#W1EBakvaqaJViC5*G?M{Fi8MTmk!@`bTDCer| zEe5E$ZpNYpr&jy752C$ShLG&+3E!+KnR=-Kn+p_ggB{eq(jj1TnF5dX z=6%XCL6ht=aNuEo0XIyi$z+QXFV6i1dpQuoqbO!B4p@|xs5;I=;i(?9uP2pxD0@+n zt-5Yq?fBiXjWPnS#&~Sh zsCrXzV1Enz@JR<@XVxTlux`v_BjQ9Gg6GI^wHv@uw`KQFr7Zi9?|1}kn?>FHd8w#(||zn zA7P=EcLc4u8rmt6rFrfY3@MY(>hoxSA2*9hVWahH8El)o*1}bnljRY-Km0|~S-3r_? zU9j3}6}Aimg*6`@{5-1Flz9MMaz|w{n)rN2g*E%yj>@CLW$HoI4sRg8H}=%d4^(;? zfyquQqj7DZ!laMdCgTNvJD5+9qT#pDH@61?`HT@d5~L(F&0CmuI>v+NEwo?-ti4G` zg(euR^b#V4od)5Q+&>%^Q?POl>}gJj0`>&H)JX{!YB1}}Okbn$uz}6?t&Y|eos?Nf z84_yX&_5{dcN8=sREa>Vn)BBKp~@5va-chc{#lP<27L>HtZ)b&7d#;xi7q-6-Gjtc zccI2@(E%<;7)HBEA`T+^Wz?F}S;<0UYCB_)m(ac8%1dG}p{m7o2_@SeoZOyAArT5Q zp!5jkDN6=@9-)kgj{X1;kCW*{ z#lXaYIe=%zp?%=?cPg)-$WQMCJNb~V--#}W#s<-~UYLyB(o?B3+E<;08)l$&;98J6?wP9(_$U_Dt{Ser2k}v^_$2HnffGx>MChpqLP8v^+fb`2~F&WzJsIoLu>Wv ztCG4HFw}m6JQ@)zO7bajo>aveAA<*^_6Ne@cYmduNYH~CT~G%q=|q3!=O#oP2q&8d z^r!(!5~A!$%A(`hP(PEbzyP9)$&x*n82LS{?grJ>huWd#_@1^YKmx7Tt8A88&CdR3)f%u%ge6vU0*H#2gK!<7P<8 z*^4{2e!_hu4WD5*W#V8Z2NfP1tV9W2faM`)5{v^s?xySqqcM5-3)0$#DC=(F13EZF z8Gs@#4-rkjo(b`nITS1(!gHwdnEo0;6H=6X{Qf*eSpnuX@jhjbhcJPdONCKxU34gR zH$xl83Y1wP-mbLa;7v#`h-}sUN&+in_k)mt9oI)-j08!Y3(?w|L!REQ{81nTq%R&Vi1z$wr3bc3 z`;AdDL~eE%nxX zj)UWrcmW4Ks-iPyZ84Gc02m~?_kd6*RzINZ!dLh43^%G6uVe_i#*J1_!h04xL7+{) z3Ceib4_hao(Uq=K6CmM{Shx;y9#nkYw7e$QkP90308Ups32?>Bm{VXL&@W5*5y)Nr zCNMe?XP)7AdN%3+lj7N}s%#}wwE9jldbMe||1$O=$UDoYlrmYFB%0WhY7?*{ux^u` z1u@%ybn-p$@P=QoRM~fm@(t=~oPrhu-=`|9aRYVV^{{+Ki>IUOc`oO4WuAx6SwpQ& zp~46-m6%yT49rx`Qoa{t=S7VkSUjCJTgjqtzC!U?=RBaVVt=mX3#yo{gqM_OW4~r7 zSWyP~%u(QlqvSb|2Vc_GIm&pU(|FO%89v)wpl%)wpDP6V9R0O^F8ILBl}^0OqJFL* zf6#dV`OY&`O|O#cT_E{Oa3V#`8r-RoI8QLF>aq@MNlq5bp1-lbvS7V31 cn+@PG zRx+(YKFm|%yYjV%{EtmVmgCWQ*craw51q;|~4=RllrFi$I(_$0EE^XIMsb~EZ` z4yT!e3v$n4U+0P4)#tFAz99!K&J*iafJt($g6UU%p1<(^fWDNr1FQdLKOz*meUAvP z2xX@mWjWxIt$WOBEzJ|`4=fr|A`fLji^v1wKqbr*SavE;s7T%C3-}J7F917ZK8gYc z_UsUVmvg?za9w|mTcGGJb6k`3b+C%~;sruAJGuZP06Dn;sn0Pbcf+tu1VIbD2!uu4 z9!s2^-ldOW=|F5kS1+nq2*L3c@M${5UG!1u%0eYa^lm!UpKb?65Q6npNoiOIQ}igr znv)Jc3QYkvpB-BE>_ti}f(&h`Vv%TnEx&-qi<-1^=Sz;zjc?%$fW@FpXlILoaS(5d zl>vTBAn{H6e+eyp2)2}M2{_jh>bFGc>#+n^Iy~H=3zaQVd=YkV2}olJonN9v`EX9A z+d)`;ftvWUO-Wc9?2I*7ke~IK(r^p?EIVH?DU%K9?tA9%rs9F2St^VRtf#@2nWf5Z zAtIU8L01d01h~>32N=-&9m_DBMa$4G@f&==^~W;hXTFx?VxbU`NDW%ph!sc30(;N4W-O=!a`lT&aj+%Q2kmQiI3UAbpiqG zN6?tMxqSTE8(ksj*F&4+YqmWpOaXH(TWYnsz_zBdJLclkLj4ITf~?J>#v-~d@b5P)F}Y)at@DS_UHQgb)q4MEVOLll*7fQP7I6Z!{n zvssD11#a)#jNuc)h-K2zQXxew&p_QUBox*ZBv9HDA&J=cWiaPHWa$lYX4?YIi&+}( zG+h+}uk{uHm9uSC#tWPgD>l%`$$0c(uibj9@^R%nx+6-3J-!oM!}kYIY=-^_Q?-s$ zins7Hv?>f)dQ;p~9G8`}OGB%y$3SCOiUSfZ+P2xMgBs&IZ;6#HBy(Z~7g%_Wlc@FID0yAHj zZm(h1qQ;_FT`{}h^RRrQt8;Z#!4Q1AbrPSZb)(on0yS5|ZZ@KzeUF0ap88LvfD8Ml z5C+_P%oOC~j1a&koXYkHag$rk9oQq-#`QgdFBk6>W&)NULh0ITsJx6{Cb=7C^|ig| z9;TD`2_^*B)IfYazfWXluMw}GH0|@!{X$P&x?k6cSRw&8PN?cF(EHc@=>2!p{RN;0 zp!b5{gsi2M#)4#vUQl#@bfi92bovEBkZ>8X$bg%ur)7Lede$^LazIHGBkfDcxT@P_ zJE%-CohrgOSoe}J%-~cBr6NB7`1DI`?xJ0<0wzN%1WbyLC;_hN6;M49k&6#%cp1Y` z=}LY@3H8tum)w+gSajDLQ%%9IDT@#%yz}4d7*X>Y%5%ETzXqKQQ5YfI#doR=!lxwa_oXP?J;Q%&mpFgb36POf5)l)l0 zQPS%eEhfT+7%k?tOlT#Pd==|s9owN}l+O>d(xTTDhsTfDGPM%BwaQAU3;2#8Mzie?tk7`Jh@p3I|)dJ$FmWZV>(hC1N~$4jtR|5u=4U_Li>i>8LIR#Wdfr6RS8u` zU~YbuG6+G{RmwmC-+xero!1!ufYtY60Z%3Mt_CWj&}xCDPW|hAwKC1a=}Ui)>Z*_p zOW!H$Es!XZy`_wi#nKdXExdUbsp2wp-3CsE1|JvJ-tgl}H^DUd&KOo47!U#|wEj5g zYX(k^0IMr|74~M;ORN?jS9-PL=lTNUjt`i54S?b$@B-??+aRqOH1Tc0hruAQdn`Oa z;ME7@;F`@`Qgy`l(B$nC)(B5|hbFF>{))wx}d>8J98MOFa z*dC%B+{I=ASSPd0dsis~Y_YVT5fF1Y?3n0!O2^pIb1czpq?CCDk=h@RHcckak)q@Z(Mkqh6Tb z2M{D`h1&2l-`#0`_oVtWXjRTrScjH66+YIq%dl@83gm$8A)%y&oDp5=cSfL~sHNx( z^k~$0MsUmXXOtnL>^Mq3!)^Eg5=w86EA~S$A`uzO73l~btEVfg5$ZKcWRc&mR#XEL zQ%ln30+%~s8Y#b4*^M{^vSBd%BcP)pyw-iBYyv9@`&gNLi*c{WhBj7=hoA!vIl$7bs{3%VR*t4$3J!Vmi4yNo=}T`;^6W%qBdxx!h)*%7G9T^C z%!BPc{>Nwot>=&wRr;ASNG$PTvN1`B*C76Ea4dL6KNIGWPz$zyrWCm)XV*R_Z)i$h z{RWoXOgPJ2oEKzb8$hK!mMYH*lSa%G7i_m#UDwVk-*_TP{W<7>Fm4M&d(e@>P@Ia` z#tS~~^U%N_C$F!B3#afaSZ$4ld>D-7L=8Xt0$&q@aWmt;m7y}Ta!)h@Z4h14O-AQ4 z7}43^wCzQQ{;gbtgW}aX;Z|_gW4L~y>U!voSZ(^XaQ#((4UGFQSuO~Jsm}#5T-g_( zKVyT-1t{%TI72{5>~hq80dDGF_3yfq;3``!xDERo1j@gm2|P^9{s$VZflH{;-i@}u z9L`d{@H_Z?VwZM=CGnkr(anII?*wy00DC1WzC$x1^u9yGmf>6hIAZeX)$dttaGn1i za6#y}i%7c6wfZ7YStzdS|4}}(*ndYGO!lJhlPx^$5l~tTp6q=YQVf?lMq;kyKwDqT zeOy+gkgLcr-DqrO8$Gkxc(^k!vm9}4y$m2wK|6MQ|BQD2NpU}ehW-*SO7l0vuj}D| z>#rN)<$)dFZ~m-|_Q0m<_ODwN%Gv?EU4$Hwn`A2F2TlD`#YaZS#AZ01v3M z8%}!$dRUD&CTzra8;xW6?i;91>1z-cd+sn11QTexrhmXzm z_!Z?ri)A~V{}qtiNa??UL+_&}egiJNPM`kuB|xuI#@-m_EK{_sMzKg8lga!mPxB8>sgZ9lfFKv21&Fs=CYS;b(KT^HRH5 zJ#bdVoj&Sd5A63|;-fD2u-WKueq-|Q?%MD`+TKo$_P}kqi0ni*_$rAg`(-Ep&?oIj`muG6xbY4wrO z(o76eF?9{ZtPR{;f$CZq44((8BYdVJ;t@Q{$v)l|;M26kpX%=mS1lvS@{%>cYa$Z# zrlmn@co-XqjOByz48g;+&rFh8+cDtLKj=)5s>-)aMwa!CfX!*0y-QC)^>7>vw+Rp@ zQ`}r!2n*(mLs#Ak@!j0e8CKQqaBo*ZuA}Te>STK` zg7GK%r3ZU;R)@$T2or5_i^}e-26XI%C{t9397xgyk0;gVc|aTLtj6{UHL^4NW{8>T zBJi7m$N8BO9Z1)Lm+Z8MQqrH8V9vP@rd4dX+6yNex2Tblr*_5(G*POry))uWmyh25 zLT~K%J`%3->|cF2Oq*~dVZ2}#&Xq=xPlVb-jzlnb(XB6(+y{Q`@;CggI65Ql_NHS3 z3M15Ma+Hz7oKn~8OCJySf-O=_uty^ve>ZzfIMN=o#*u2O-1Yyijn+MnbIltfRjd7W zq-@or@REjAR;qgrI!tUAHCpaw6z2wDYK%m61ziA^7{oK)GyxyGF1?^RBMxB6U8eS> zt6kLKknTo0cF;3!-GOh$68_zT;-XX)=Ru`JsXZd&5W}H&;>}=_@idi=-#oNfpmG*_ zmBhgGM7q}9poS<_viCA-Y06KQQ(dt=a};d0*ec9#4~kZ!?YD)S00DJ!*7S+p7x zcNgN_kOwVbL}V?U$2q=bJcT{)fyK%LI#@emBlQjLO#;%m!zr$-8fEX(D!BHdJ-~i9 zg5A*t_b~wFyQ-SKFXGH~@j7ByuD1_}OKcg8N(HqTjqHbbmgYA>;di^*&E6lu?$G1X z>;n+&-hi-B9I3eKb~QpyLL9GlWF_ooY1Ox@(}ejQPU6gfqFq==P!Bg)jI|>+0ASmk zu_8XVo65VW;LU;|x6f(?niR*V+wclojkVfI-PM)&4O0%T?+o09SJMYt$))Zp=9Tiu z(nB4A-Bam3fG;Vo89mftyqT&xT@5Hn%7F%B^F&?#!MIN%Ry|~ablQ5S`fn5`R`9Ls zsjjkgJ@11uVG4ySM$Ym0uO=-S}_3ukr}VfwhVMl zOaK^s2AS<4%iU^#$GwnMd1@eB32}F;V>}HHM{XK?Ze{&c%oPo$!~Ink;&TV6F9;{# ztC)F?O;*bhR-ddMx7b^D&4=Pvc*0RXP~};w%LCO6FP3RxnCpthZ32VTD;`5^GMNAZ>e zY@Yqef{pw`xnNNt%;x-qzg=c@Hnq|R(t`!;TkC-8l?^a zrQ=mcNG770Z@N)6zL{_0ih*t#nmt}k^pHm(A=5F_!%aGNPE<$SKKfQsMj76CGdE<; zHwNm}aF}QZN`p05+JkDQhdkEE>Q+4+&Qe3=akq@RoTUc&J%A{)4I4<#RtMsc%5m9h zygcESnJlNFm6nZz%OdzC<`LQI0nGAXGH9Cq3M!op0)@FTS$zy47$0!Y$?6qs5ZF9L z-RX&_-qY2|W>noPIO?ciFHRA!ny!}hnTR?Wgl=pW-wr&y(VA^c#u1E_NXMhWqdk(g z&QMo)JP4?K8qlSrZl1Ly<~WR#nQ9qoYMiO|^qb_?(YRTnc?V~yY$?@u0iU=!OHC76 z9Il=|6VQ_iW~<&Xb>eXQfjtYE-A0}YWgKWwUWr+aq?h0?$l8EKJvFn{1S5x>ZS=%l ze8;ez?9{xF#xWx*nh}X%lsa8OIWc06Nu%Hs1CHN_7SL^JS}K3 z>YnD7G<^ZsMnR#M4QmSBl1+C@mYk=K@SEWlRQM2b77c6z{K^wG)#s_I-%PhOwewZ@ z<1%m}QLp*n>k717q?zTGCU?Ht*NmC%7K7XaMn1ljHR7zXmRiR0E|9#wts zH34j@L;TJE7?YR>nDLBN%xqX-GG^tu6}P5IO&1@()ZlPPM#zkt+Tcvu`EmieG+&t%a z2&W~KErjo{{O9&onaf&)R16c7A+9D%yAA;DY0*dA9|1%(e0tI6*O z^)20xR%bm9K4mm7W|=yO6D(8ny7CGrW^|0Iri+Gq#dUJ8OdclIc!#%gp~D4VpvHS~ zM>>)HF?cj|2;5`xJTpDQs;+ypjn8K5m%<{sSC zGWX!P$$^rsRl|x$wZ}lL#UZGBpHL47jd2+{?}n2+YcwW=bDmTSFanKFszGjRuuPlG z=?Z&F#W@ifv~QLAC{n_Zm=yLDs)16W+!jo)fa*5*Qwp)f)*^6l^2}6dBlRw>OcxEM*d2gQw)m- z22m;$tpml7aiE^N#4IKh?-UxoQ5~a~fWsp;!om}|e>c?N!Zm<=-51`NM?4RUaqK2x zT#2oV@~Lii%2wS&~dJF9ayTnz41?RMbbo z;gPsSo#6EdvUpOq3jMQTWE8fU+~tFHIGgUgg9d8Bb1f=`wuW(oFGwN6ie7nF_sJz<%nhdJgrsg%Ps_>U~s%y}8 zXqlp`o@9RpN=??YFz-ZH#_MH;QjHhZ-Pb*JVl^f0PNk zHPQ)QB;bvMqnu!W;7d-psCdFg)B9fIgh38|))qUXYkEgwy5n|C14lfk4z-lH<~#>e z4WoW}m%75T$(6fX?dFN|KX>d=OZ+yY^Cm~f3dy~yK07EjrSl@vwpN*`wX}IMRNISq zNf@QQh4Y(YUW|lNJp<=b*X&heSjzmpSACB$POKH(C-}9656eo}57?zp@qW>tiv6m- z^<6G45b1btx8M z7yTj!Q{9Vdns5#C)Oi?H_YMqlWxm7~dZ}wpxjNn)o5E*R^aFFnXmDeNItf;K`peL& z@rex`IN{U-zTC1`)M&v6ajNaxomJk%f(6vC2pSW;gwTY^T&Y%Bxc|Srs&+wsaTrDH zYid3(DLd!_FH|V<5LhG8!9!?)g3C16z|ZZ9(-;n804wR|s?2?rPw~hJ#%$>uz^K(=D#AVwIja6; zEC>jBQ=RO$#TZZBD7H_*V(qdw)pcMl-H!nUVc;C>fNOY<>E6_1!fzs+Hnu8t6T{~D zYM`hw#MZaeAGq5;y`?^Yu$1E>s`xkx!e*kkg%dyIZ87HNP9dC$v^UV#a6$229$NP{ za07=Vyshddx=2*ZjuXcTmDjVotyRHD8w$(n6KXdxmnrceo56_ZBts}}ffXx4`dhq1 znlC{ejW||hO-*zw+229qo}svRz+W>c_kA#~MehLkd9?Z+H6B2zen-_;nY1B$IUEhM z-^EM>lGdI?=eE)1laR~U-*E~EZLC(E1MZP_Nz=@1aXr*7P1|O_;4z zf4*%u`s6)TU$fy!#dRLolv9RNo9Z48^!8y1v>gK$OpPZIQ5FZ&Ehi52o%udkN`{LY z%&pmxh&@+jr`3p#yaT!yaxse=g@*;9u#)NgX-pwtH{cmGJcEXx0d8TT+Zi?9hnvD+ z38Szp0T4ITcm`OeQ1TXdOkzGzHNPEhNR$2noPGta86T+AJa9*3Z4F?slPtCBfVeUw zbQ7&8me&xlYlFFo(!bjgULx$FHN8uir0|Y2P3l7L}9VmOg7J$>|8qY!tNuk4^V=_v2pB1k33b4Om z^qhg=K6E+XDPJfyc*=g2(lc>I#X^Rdw~3+k;@%_ER&$0Tsw~uSIF-x=*ce`$xKnJ zqglVN)DP|Dh;kzq-C6M{nSOHGInXC zy#p1kpbp~1=47T=lAVSW{c@M&XHv ziTSk_-!2F@V`A3f6H#9Z&5`at^XGKHkLym7O(nm zVI6Wu|3S4cVL4Omcj_jQDT(U81Ix{$^WTBBGvmBRgovL5&B(~_)p=eeKnx2NFT;kd zm2~iXkTEB3M-^8vH*b5dGqy{|W70GK2T%r|x6c1e3I;tp~%D^@2V$nv^t&NcOY55c{bQ+0wDW)g0wE1S_#;ma1)b>)WoiKpca z*C|i!V-K7Rv7?O^Dj!7;nmf;Qs;OhU!tp-$VT=YpeOj9YeeuO(G48 zAk#Zjg?M+;Do%6+EUW&1WP7V+HWb+fkBNQ9{~z&h{~z%nCz=PAwd@EI#iCHA$P@T& z3b^Ls?;xCoMpNJMo8=n&!&!6uaw)gaQpix2b6RZ0I)~3Ap7ZC2cNlh z@CUaJ{;*YWcV8{aUV~u#HLEf^4APMi?EFsiGLOy$#*qky+)ZvBkO7PaEbF&b$TfaZvI&Pqier1m^DmKWiJt z38>?p+G}^RT0XM9wgy|+&bQYlf#m!7YcOt>QMOHs7p!G0EJ*C2EVpSZ_27U=9@T%L ziOmU&^;#ZrQ_D_q&9Q4_kz48uY?P|hcpdZOF#*~+NC6*7<9)Ajl7`hhuHlllho{|= zH7Kh#RZ9gMov3OT^q^U2;XzI7VS$2izN0qKvfmXJs7>P|K8hV$JknN&XnoNu*WV%9 z!xo><&`R!Z9%X;z2yhjI0y;)o(Yf|ye?PbfE-7i_EkKz|=@){dT(Mz5D-rMrSyG|H zWp&mTF|5AmtUWBk=TmhgpmOet!`qb=t_>1)-9IBV_MX;9Xpf3S3-m-ekyY^2}!CM=py1v)Fxwz0#h-3c@k-8LPQ{*TrH5s3;T{En(iE zE(w#!jyAYEDyxxI-Z)J{p~75p48gYPv^XsX0XThpmj1$8-aEA^X!X%MQ9ty7J2hS| zklYgkoI<%hwc}`e?_Sy~9_Y%&yR?_^+8VEofhB--GuG3T_272cwO$J4db@F*BPeS-P$(> zf{68;X??XS#Mu+IX?QJ8M5)4_;%#o9CTbrF4L6AVzJar#Y!TF#ntqyOz$Vv;GkdP} z(`?3fX$VlMa0PVDB zo3Flbtn34vRZ>12KE#Gkq1u(<;#|tVKg7E~7AUY6p1l5^(01+t)>pa~+ymr9vamtgXCTTy z25H^!ns^Kooegt<-*tmPN(i`DgeO0Z8T9STVs6&{we)F%b7M*b8{l{pXE+B74 z5st@%FgI*Gg$>6b)}(3)qT#${mFsFsLm|Vp5h9Ac6Yf!k!?hs-M7NPM8Ku+>*Md>u z_2JrhkI&&QjcF4|^Y7P=06pSHFdO71VWMS(X7%|3z0v!*V+45NmzdT0P3}xt_jk3H zrfCU4+&*dA5R_J^zfPrTZ1RVsi&t(s*ys!jJBWd*n%CJzH4lNRYtl77?WO*?4)GK_ zQuFm=G0nOXR|MOkU8tBRFtJD1wsQCIva^wzx4_mys{I=7_Zj3IsRf7->}$c!A1eB@ zt#`RgTEz>(3m?C}^+c8-S@6Js$rvZ6J;|E3`$`c{P!=!V(g<}~CaEP&x@12ZPFV50R#ncvS-px5HkcbaNt^3>0 z>RL2g+wIw+?7MImC1%L5bs_?dz|ypVd_poL;}Zc^FWHJK*nYEgmTV7M~TEVhe0@R&pdmFU@A?M(|d7*5R79+jI9pJ`AEe=V-p zo3Hii$nj!)PzEauGw^T=K!x)))$2P%M^m-R=Gs=w1o_6a^=7v>ionzZ@QG7dzNa&I z`TW3%k@q$VYmfp;7l4;tq>u%W2>+p!1(5PT5~u{wUI<#dMBNu^Um7l>+M;NcA|BN~ zF4~LiYy+h{uCp1&2lret*e}w389Me0 zja#ODh^F4MQMg~M0Etp)X#qHKxa&lL*3-k|zfcjEYuK5#LQA;wiUBikz>W3oUt4_t z*5dpBXM}@lqLE?oGHPeKLUM^gI!+gYSm7_VogXS zAW(;xs=WtPdpFZNb3E!WT)J_USo;PDxU!bH`mh!WfnL$M1sUxuKN$CiZY;xM$n;R^kvL)8m`S`~;w^;vly&Yv=n?x=%zW72v7l=sBkD0<3l_US8D zFkLa{u5fkcwFeR)tAjnb!u3GI>S`cC4z_-U>psX*;>)BExXSuv1xQpq2W$9}>w!BU zo3n*4xjHy#Ii`-I8B4PiOEOMdS=me2c?3IHt1R$tHZ-vwE1nDVPsws60dip$W-_ms zC062=cv+Uq8d@LOXk+KUmfy^BP3DU}-3q%?gM)rj<#(c2XS*Up8|Xj?5M}XpNoh7l z-dimmK`%puW7jhpT#+|pmzQ0g^oFHYs$n8^lta(ye`vq+WmofB1iTz}!&+ghId?DN zthL1Q9G85j$6K>AIWEN%;$VN}xHjDx$WRB{^@^((kBFiMHv%x~L=r0*2<<15q3N^0 z6NYT`O-7(1l#TdF0^?%ED_xx&BC;9Ftd61kX@Sah6@*H9v;7h9$6Sz@H0EHg?om|Y zIRI;{1C{j>{tzz(fNRfUcgGDyFXoRMEmyhvaonK$u(jaEooJ35st)8|aU)#M`0uz8 zq38U6#|?L_u>T1+Jhhfs_o{0tA9Ah=));y4&j;n76&Vq=g%i@G63jKw?QMl(G9znShM z#5YH@-^d~>Q3s=Vi|XmHqYgr*taHUdiZ)=KD=fZc^(@suw5p!Y;#bIF`Yb722h3~D z&aT5s6UQv;u}bfUnFd#co}RxR`}}xTxgG~a_j(^~ypOi5|00h=eT$r@E}T zr3rh94Oo$H)9w3^$#2j_eq#e9A^JgdNuFzFEoyBz)*sB2 zjVioJZ*{}Q{3#cyD5 z)|DlPLOr+af8ZeFHi1*>=8eec1&zp*O^~f5Xr-H6R|QL2AhnX8M3-#=qvIRl-sXBm z2ueiX5khTd2e#8DM{~JZ!g-HX3*O;c*x14kkC^ZU+ProhZs-*(b-@0@an}_v31^XY zODi!1Tsr(keuB8^oaQGmkk!X%U%eKOLR=6St zOoGcon*78)8%cqB9IYcp+{r)u9XP&+cPiJ&C(oa(u)^hRNnQ~tiN@Y2{wd;!v!!?< zrW6k{c+XH)i6Z6zB|%IiByfagMl~sV zT&z!AHp{GZITr-Nk)tovU*O=;_k9K430zB`qMyMbq;H;Gc&9wAee%rIhUa z{;i5Re|LpG@D4mp`U2co?LDK~`|xV-121d!9}?#X4ev*7G#MYzap&PiY~&nQGq^?( z-K?a&XlMPeKsMdqfeS>VL-F6KZsuS%OMz_J z&!`diW9@xzAB0hjb~@x`bQ5$D?%d3qjSjGBi*BQUfE8)N(g zOH2}-mflFJ%PQMhWVYkHYz2-g3-nEFim zI-)Ks87iK^4c(m&i=8aJP}t5A$B1Dp<^q(n?ZZTur8kevUWiMx3B$xVWSA z#^T|k)8^acg{&M=e8GE~T^}w+;_{L@LhOgjOI^l@xLmamD4#V#Y%2_814fE-S;9y$ z7}vD%n>9{CoxXdWA>t(W2Ef*uhqO zZZagL`;_U__ zUoQk|Qdb0cP;C^1k8O#o9(gSx3!U;}Xt0IOP2jR+tQZzb%2d>Z?g+yXsFzfhFF`#a z{MVF0GCj$x8>h9Xk8S*|sOPUH)7e;9Fr-=aqBuSam#j(Oj?Z@fj z5tA?!&d0^>mU$>=V!{asl7=$d4Ds7g(&3`k`YJXIW;bVu&28ssVDU$l%wX+iigd&{ zb*8x4LbK%_mb?xZJ6p^Galr++F;9uD0dx6Npf29z^bJrIJo6NiQPtDpFmH{p_WCs1 z`GB_bX|X%WUMuH_beX_07j$wcn?F}<9?Cf|)X*3KL&qC1R68)22qcGzrUW%I>gtz^Ck>kGc8uML)W{5Ka>W;w& z(eyv&V$a5f-3Jj;am{6hA=L+iJb+1 z(`2^RdAV33`0dRJ$sf_wm&9lRCp$ury*DfP6h`~ITJ3=>YXuBw?avYqA}KRleBSTm zm`Xm12FfgdB0T@L(T3!UX(r(@FZ-T!*#>Rg<+#yU@wzw~jUKR3{EZslWsA6h`YBbz0#>nAEWq#l zZQ^!325cAKLJnbv*vX97E(PLMUWuJ0Z-;oNq?;Q~O$x;hCRWl3!r8Ww;ZUvrFK%^( zgT*R(OZ1{OCtLB9_Fcsnu0^1PQ7qXV;7673&zg=nRuVp^=) zev#OnRF)EV!e^mfAVWRH;te|gyM9n?jz{+929aFSIF=3gSbP&PH$N8pv5fE0#G*o& zwOQ5!d}K)h{!6)n*>JHR;_^NbJD{1TKM}i|&?NORDnWl97H4?H$t&|4M(_PhoN4xJ zDABtN*5#8xs7%boIs0+3gc_1wDt--MeZLSjylTP;@HU7Zb5fj+$FY-?%8GBI2jBTx z+`)$fj*Cu;xU+E<4az$u?m>p~ZOCx6Sy)JJ7ZGax4`R-`Z#BS~&&>wV&s%{Bly<8@ z3M(^-W^Lj(BHV|bVyn-He{*;+F}_{w&C1S-v-x`+KHOT`IWd9Ipzu3!GaiYBsA9_Z z;$olQ(5GJOuxl-T5XT9&ahOQPI&_Sc{wPM<#`{E__C`JK6ZIpMXQ1SnGTnkhuAjvI z4zf8%908F{FVSB96Tr~&9f{ywGKzl!xr}Ake*$$|sfp)BQ2w!O=g(qmHtr*5zS-WvJIU3IVmtBf%l*DgUy8Wkoa~9t&>fd*^75-# z;xD3e!409}+UN@jh`sRO8*pR(lV_JF)$3eac+?xvG_42TTAv z@7p2c&iglRuqON}&K2Un`^mqfj^f?7qxRyR(8K7sJht%|mSdRc69`=pwprZUHGVmHUM>Xoz9-^6}Vv{(`bdvpNPk&U_wjN+Yk zveMr`g152x6_{)@SX3oevs4o@W60cci zp==^6O|yov#ec(gR@&n*^p!RPZiXtV#1vuM%4DgNFk@x8grn{k!>lX!NG#P0^0P)CBr_-$;tRceDru@&vx#%@}r1?cPf zLDKmkQqCo;YRuwyVO`3oE1kjhpE32Mmjtd2`vRpQ+#X*h*d!-T(Tnk5F*a$H@U({C zP-Mx`dfKH3jG{K)fh?%unTFCwG{#Ou=ddwO>2o|49SV^a3$r!I z{(hz6UBaX~^z7+EIo?7-+1^-ba3vu_l==(LaK1wOL6q`Hk#4mrb%!MLup)H>1_Y^S z{O!oIDuCddRgm2|Y-PBVBg|#75z-=5UKkfZqdL-JG zz6zR0XoFVNWu=>NYF6-tDLAKOCbY;}fkR9C4sx2Ly%AO|&m;XHcws@!4mVY@ro#WV z7n#cI1VpluNNFvqoZ3X%EX-%AD}X8q55sOg*KF(@C0Rup5$bJJ$OGp)2$^9UKODEk zz^mQEx-^x#v7(tK;NWuHktvCi+8VVY6DsgDmG=Z&;k< zU6=hNbTLxym5Tg6+?Y4De|YIr*yN0EBlST801J0PR+1)58wnaq+SxX!nhX5uviK8_ zKxB1-E8o1sk#IFUJse6o?a=UATKMz#A&|u1$MNCPedr%-kJ@93fPEfYdJgy*ZhFRb?d zLbdl7tGzF(_P)5<`x2k`SWKpf9#TutjR8G?O4$1L0QulbwqVnHN+9bjy(j3z3AVha zG#EAq%X>|$w; zKvBQw5y_6&(nqAHb!~oFdjXYsR3eqaC67wY9jgJyn3vvZQkW3v%vG%B+X@EwO#aP! z7rcrR{u9fQB1Q1ds+Mz2^_*I23f4KxT53DX%&!MCqs;M`wA8YW$Hed8G4DPmc@-Y~ z!CBVxOpY&tsaWb*Da^8g$E3d3fYhF{$4VQ7JQhEWldPfRq-Zst()HHU;LEsf?MNn$!IuXikOJc9 z6QEI(h9x*FRx(FrAuq*KUIM)X@3e;@9_CK(cUb^a7jeBB0A;31jWPC>Q>AW>oybdN zcHv2R6ItRkDZ)clx$s)sC{gw|S>`lJZuf853Uug&I&@CFSSgBn>v!f(mwJf1^;~c1 z&pmo>5a;PqbQDz*jyjEH))!-_EpH?HBy2+T_WV=Uy?PCrUPEo|fqkJgDM5Tk&-$+Z zd`~Zu$X-a3qIm~V=iIGP``EEGDS~&biT@tNS7kGvKJZVyj>q# zk}gHIq`vWs_L)u8H}CtwJ)Mpmanvm;p`fjCRo7EqhW*sByux2*v!#dg2Ue1{VZ8$I{^> zlO3HQEw&XSo3UPi3eS|r+CKCt2}g@FrGAc&5M_`M@2V=~S>&98LFU|#qj9}vmNeVM zdyPO*XBt$RdcHT_=|c_zh!MYs{qeLkjJKvcOP(z?=lED#X*$+1x@HQ?pDoE9i5s9l z0~l43Snb`Y^ke@@XG`7GPY`8HU|RE|5CDPmgrBnHXC&En$Ttgvj1J0N&q)0phkfHw z#KYp>t>?_0Be`s!`6e+aD?yWej+9_K;uoI{W6bc-B+axP^^5n+l_uDZ`9)O@1dqRE zu4K0z_lr+_R)SviTxlbS+6(irBh6xm=Sl5jKlja5?XyaJ)4bo4FdvO8^@}fE4Y9iY z2(}yr^Q9)XFZ>eA=Sz{cFa4q%&m!t8-zW`@+ipsv0iqry(n&o{?*=LL9khp#MmTDa zWSS|IA13RUTD|{H{OEX46 zDLu{E)S44F76$@ZI1)MY8O{>i&w(+fX=$dL!7%jEEyT{wjKrbKl;@G=k@Z?>AVS=)4e=k~a|m z=)1r5%UIkQJIgH#rO~SInH1$a^{EEy5E#i$qJm+HYB5UHEAa(cTK-C`lzdI5$xEG9p*PLy*EH`H<6KGc%UgN(ya`N-ar};S{PX$5 z!s9Tvm&K$e?fzFi4f%|YHc;;h^7vy0dF*3F=gA57iLl_6c9;b19~*%Kn+|a2k+4b% zcKm@d#=v^9iQ6(yTO}=a{8_zD#@pjwEx8?6YosNwhN$8iq79nm1y_Cz;?u0vQVT8u zr>bbe8#sL(`D5^ItTunK^3~Gowe3s)t^xVj8VrWMWxG)$mDihevpz18uaQ>N2JvQ% zGQJRR)ksa=4ViS@T8Ngbyr-*NTXObV$%S2h_FCyJ0WQBUNMSh@ZnKuMPMU2s2@Tmd zZ%FGcbX&SEOOFHtRX+DMzYbHrLUk!8ox#Q9*@i&GW=<51yv>q zw3~V6VTnxH3VD%uRq8TZVQXK--IX{o`c_%baz8&OnZ2cDrxTUDu-a|6-aN= zJq~`O%3UZa^wPCZYRo?h-LM)WfO&<|GVYNFzTc}%SVwJSYJE3al+TV8$}*M7-7RgS z=L2uuE}M7>hLbYRc+6yNa1V(n-;&00xUJxC2R-3_TWZ0wS^$?bzJzg`q&-pyH@1}w zJc?wg-`QlN75eo&yBE^eHKVn{x1}!yQ$R!Z$eackvuf{!`wQ7E;1b?@5n= zq*Z1_z=7r}vo>X)bWpGnAlk_iQ&683PsUyFqyv)uwrMeAF2l6e0ZHb!rsx|hm1_`V!Y=$l2nS)# z@nZ>A(pculIIx(+rhXz_4I-aUL~XO?csU_?Rw~t z^a$^D7e!MwxI_;MThra{qDbbNIVvop=k3aPXJXGIV{H-MHah@FnE%li0B@akwyv4fsmxO~rD*0!o`vnzqN;FmWS)3Znt>== zMpz_w(oHAJgd1Q#?ztC%@D%uQl1sz5+u$>)P%nx5S{jGanf=hw1z$^PwUPcH;D!IH zM`m@~)kU;1=?reh;J}FYpqW6m5+`bG{mS$4TExZMY?Iq9I07b!cHIhJV$M-M`hvyF^xbBUqv2 z457|4hSOVz=Zw^zk23P<8A)UrD(YZ~<-Ieq%g+ET8CDAQ%k7YAz|GIYTyg&$9-Mm? zycHeg6GH?JghPYO_AD0gTBE^G9D!+;g19hq4P29Js|N*!f!gH-L>YG7J1WRmTi2_1 zi4Qm8S(kISS+LLu#NuBy_Am3CGz^%${5zc8Rh*MTs?8DVy;!$i(vOD*BsT($2>ns} zbfQtT9ZUbj|6-OmV#od~wRd<>o(9~QSFlbsJIu-L+Ia_)k5Oa27XL9yjrBy-=(tE^ ztv2uvfssz?0JZ9ZhB(ZqXyh{2GP0pfYOO;k#}Won(#K(NsEKw)A(uZ&cPW>`xI0W* zXK7)27{Orco7TuaABqmObY#2e+NuX6H-f=&$JBsUSq}LQku>_d(_xNS0tVR}KGRQ8lv6l8Zn%BtA?IM#2Z$}HH8MBs8HZA#ku&1=3-1vJd|n8zuM zd-K^*4l}G%>dMxjJH@>=E}_^Y?c-USvGkeXj7xSyDJJWZ6z3rCHAE%|Uuf9ovC>P@ z*dWp=CDiH8ghycdVf1AT*D3bQWvNPN<7L-U@=Rv zj>FTL%=0_WRH;K0mfr>T@8M_75q8c8Y&W+}g||e@cJh z6-EhR8!{ivN5)l*p-x@$u0nGGHh`{T&bDXez2#_@)Y}G~lY1eCx+d+xcj+u?ld_{1x*SiOS*vEoe}m%_&4Dm#dr6Zc7%-30VTupNzv{Wqn~mKY#f z0IPftu7a}O*X>!s6#Zb#u+jM*=op8(y$B5p8s&8&y=ERWZUOZ=ddF!0Eu4_w85oqf z1!Ukh7}1GU*!2)bgkb0ioxLc40a}1tj>T0FEO7HnNHLff_$sQxPI*KinEbOOTIq#)Vq=v4z=<%1!z(3=VMWv8PLQqhZ?8hG2qrR)2H zxbw&bm>4{IVZHg4$c4D#@CZ4;|@}3 zJvprJK;)p$ScyO!JI!or8-3~^y|jVYyse0DfqY#VpLrDO z$Z5f{8TYEF*3iLvHX?v`IuZ64`h^auHA%3^VQ|P@z26`(halW0PYHdv){2X5=Rh}rX9RGgd!t9AvU5MXtF zy-t00tFmDrJJU#ZIi5h)YMmV>%Z|ylM^C9edTNbmP6^hA$!&wCA&olhb0)ath@k2I zuWA0T>He=z`oGTbf1P>fbzh)tn}ydqbfeNGPY`$hT~)OZcREfXw7FGPH5XwE!j~*v zl$|O~{N@M(f(MGVG>wh-zjHF50j=r@BPY9Yo6J2KJCUwggzo#FQxK zaG$$WZ_}K@6u8EdWOqO<($7*=9xFUeTu^J4wI7!czzRZf@MVY9G#k8Kq#Uko377lV zh0bg76d;;CR_@?2_F&Y1v|vTxd7B3!(#29=z?xX{6N@LK)mckHZ8S{94Q#t^V-Ty@H;;dtV`Jrus_$@$`yX);TcUEe;?K} zJd4}QuyZtr0R+@G=Ama(I?8)2)a*K7cp>&_alZ^_X@1oY=_Id3*~(6`93VWa*}BPZ z3PB5Qe_HV*m`yvAAg7@izF;sOXiX093!>}YSz#F{SJDIWQ837AcX^FBM;QDN$`=9n zKo1!vCiiG>^pZQ_#OP&o5MSVAC#l1KdGZwLQXgs%4}$Km-LsfSU8K;oE3J3YV4VZ(4+-${4P6l zQu@O6!$sIXC>bp8z)jZqL*yz8bhPJ>1mfVme3XoPMGLg3G4h%qVX#*Gxcp@RScH{N z$ZJ^4N@HN%_roDbQZuJ3_Xx~KXH3Reyui|@$b;CbT-lXVu>i-gQ{*kCMGbYg(Ni(n zFsD9EZo{vsk2pp^10MvZE#sivwJ}X@i{Gbx zqU`B%Frqwdqrf_+%Vu4tu`r|w>`|u6WZy159gDY%oux-#*7r&IOK6X(GvrQ|2WVQt zTQQU*(`Lvaye!f<9^m+Hs)!0n4YW4HY}tiPs>T@e9vs4 z2~3X8mb;tgG|XA?RU?)b)fBGn;k3>h58=c!@-<|Qe-E5o${ab#L02k?92&bETpgSP zR9d1Vn@bxrS7vY)iOCnu@(+XUE*jy%mT$i^j-~v^VI{p$FJc61v!9h=*3_kayg+VF zBL2z@c>*3IGUe^8!x};|x?8vZA+YH!o|9)I=Nr#q&Y>TKKOqf1`n+t_D@uJN2G&#y z?Jn5Oh2z16au#=6)d&qG%0t~Tm>pOshjpYA1Ts={JDNBc{Lzv$6oJ$}iQT1qVR+uo z$80Zvp)n31Zbwsbmc5Y((gTsf!m}Va@+j6hRSF(JOV~1_U(g>k)u`JZMi_=L0)ezZ zCLkDWqK!x`{wSX>(*!=aH53lY-U_$I($_o%xL8d2GPxYTjq-e%M7$fp%;H~^JK0ts z*hj*8qeP4aBT#Mzl{Mx0J360#%nL9|qO;T3;SrdrN{|kM^gf}6& zaSy{ra_yvs!8rw^un}7fq8Ef&p9$~>+$`bh?E>zq>nWSa%IFs-SEfWya zmw~XHSpg(k={@90nFf{owONEYFM%M#TaTU%;6cjaYy}ZG-k@y3S@;rvGV1ORd39Qr zyir(HZKv5k8)Ra&ci|cSvh23JN*~SAcVQcy^|HJLTR+Ix@o`&mnv&v%cK7HU`4xb# z%mFc7I+PmGj_4gE#ol z<8WuRkl_pRSU!_;_?^5M^tmA?#?JE>DBYy20_(j;8^211(km?)_pr>d5g^O2%JYQR zd|L7Tt7ygR-c}@h4hdS?kVqJoTqQSQS!?91j2(32)b^@OCNAGXooe+n# z`++JIqe0Qr)?x?-v&t_+ojIeQ3)a3`i-C&YRITLZYVTXBy>Dg7>*eR6zI|f7+}(Bz zbr1ojI=8c^4Tw7J6SafQqNpEzqIR;6H^>a*GbT@7%B3F-m}4^(j`QUvLAy{Hp)Py^ z9fvMcLcTl^G<<8mJVOY26KV8G*oU8nTmbHk>{`<6a$6Hj5)|I=jwHd#wm0M_AZ!ZV zBzKD{F!Iwh$6pizaor?gEHu&>mSXs~*(A5XbZ{JxlymYjytYIM+~rO3y|r*g@tftV zxaAPL1ykIFA)>lQ#&vaV=CPw;;#1W2V04J-)KMd!VV zH9em>3gp53M2L<#ja?5Nl~ebDDepvv4GORZqDk&X?OED+vpKg=p3O%ikR@(XW&X2{ z_ZmS#A@JOLB#p*iz{xZ}@*4zT(aiBa?1IF-(-<(kF^kP7w4h^A51j8WB!_sOpda4SLT1}x!0TzJ{vOSWpu4qyhbIH8FZbSk|H>vdKS zNbT%0Dop7Gm9QNnWn5o=UxweaB{(_10&Z$z-B3`*55VZYYk)Viu|i zWi3J_Svz43cG(%gI8-dZgU`zRP@Yai=R-M+9`8jub21(SxWN`&(0a9zRZI8?v?}O5 z12U^TC|7}ns{9z70Qju@Pvxt3InESbZPbq?{RdmCW)MgfxpDty-`zw(khVeY^F)+2 zw-BPSg7p@&jo;%F-NxTJR*^ z>7;|+=?{j1%VekJe_vEp)nVoD3r^GDf3S09vJ^kPnkB4PV7uy{+WY~FEyvVv$@-Q< zC~>%&F{|HMX1VO_(oesBO&?@5Nzvn)_{7yg9DPO$1Zp;gldQBH%xoFEgbEtRR=b`3 z6|P$Qe%QeZ)~cduxa}%R(jPVbDpVij$e>L9mNp1*Q^6^Ov;6O5XHYpVRZ|}qvCIoF z%USXrXrsh#eg{O@g5Ht8Bv&P+y|A$_`m;X#e|Cv7=UluWw}v+fupae2(C0oj|9fnj z#;`xWmm@5jPE=J{SmFQ(qKn=F`X&4z_Ys{ZtE!eEbpN`lijd%TAF%u%C!o)W zZ>p+peS4?zFa~g5j_&99|v2pdonwV(rR4Uoz^V<-oMB+7J5PM9$SJe_`KUg(6w5& zDc^ZS7kp1gBP3DQB6mFs5IT$tyzk-&o;hUo(d= z_ZciIH?GJyfY5Az5OaW?<)5ze*7_)mA-|ICj7QTUuIE+^=-4#Ll6#em|BXUtR=sJf(rZDt^lPo-|=&2j@T_W zj0Ec#pezPGzaF5p!6SPM9B3q%l~pKn+N?C^%mQppt%K6L+oBL>l4w!FxKV9lihClE zh^HO`ZRLm+G2*>TNTx+0otJeMWf*U6D$5Rl!cB0X63p8ITf!rt>l_yd;5d5>RLJ;z z`3BMe3RGI~!w&-FLGS`R8^~JbkU(w*@4N*P5eiMivR4~1d z%uSv!cB7#}uIIT@RDx3(&P}{iD|#UqGUt4@)2Td)Y_<@EJX{V9!6@gmB_T?4)UkXC zI_PMKLd+^*e{QHkCzZ*e3SFBm4^`&kZA>HOY2h%j*pXh7={FnUWAa(YFs0M&I_b*| z5i`JtDWnFP+)-(t1NUsX#f`kS-(iA14xV(<+Tfo1J57VYJGm6Q@EI#~Dcu0E(xo_c z(+NHFkF zPCPs(6f{=2cbr>|m2hNLBNY(5qb&1(7}=~S#lNj!iBx_Dy4;WmE!e<_5 zQaM8%QkqE$Z0|Jc0QoN_4&;t; z%5Ow2p|&ft#ch>&LaCQ#^7H&Jn5P}a5&M{S${_6C)cce+bh?RQeHxF$-bdp77&}ac z`;|3#sGX1%1pXaJ5*Bw-68Lb|W2GjjWM(YGwE5Dzg-;j>rwa7xB=Vl?b)>fTaVXVi zY; zQZbVE(YCf))^GHzb&y1@HL?=r@Xu=cwxRZvNqtc;ooT4u3Qz+D^(+b-nS2kZX`U?5 zJQj7bz?(=ajcZwSp3b1pts#Y#AC86l;3>a1VYm6`yfvzDExu%{9!Si-LR%une@>cqg z+tJmEQ{6^!|K3Xs(u?~IRkh*-)+p{jPUwX;+@%kdXv`d+La(nB?YS~=-k3! zbrc>po7#y_RV%+=#IN(}sJPIkc8;Z4dM_G5qeP9N@uaw#1eq@*^;NISR^8=O+DD-G z85L0K$g8jJ*QuqJ)+qw7w3MIs%)sf{z2xHNBJ$ji{LhFLS5q>|8J9eom`L zdi~qP^;Ycs9ahkKhr%;?Z!97-HQ!Ofnf+aOJ&Eh1bl|*=#IonWFE>AFUEGHg(v^Lb z1t#G;S|lUbypi_)L=pQb-Bd%bmp<`(e3mg8yl265|0B1*5>id^uk=-kYl<2Rsy8#~ z6Nml?7zQ31f^zswEr7*{q5{Ee`U&TZ-5WM#84tsOc|m{0>Nu}=rXgqjnH}!0L|85m zAXYjI*ZZ>e1ez_s+<9*@0A2Cxop(xCFVZ_cg3oY}mWT11*c>8qmst7$rB-VOmr=_9 zlZyu^PRDOLFhV2m$0hE^mGGhgj$m6i#2NGmY|%g^I-WX_<}X1qC^5wmg`Qx!#pl>r!S>*T~(bc;5W__pQe~31a#0!b!q<2$&zM{jv{TXOW zQv{={|M-{mKmR5D>OZIVy64(IXSnD3KctUEL#g5W+1VteQ^)FR&3~b&!9*H})&$vU zWuYa*zjzIO*T1V5XTob9+)7GTmc`z>4n!1$g^-j}w zhboa!{H_kPvMcC-`C)97pz;1NkSU}_mh=a})n{dz%#P3+X}tJapW=;bWbqciiJLGX z!;~1R<}8`58m6S+ci}MXlweVO820M>S11} zi{VH!<`5BFD$5(qNdKLkNl}7ri1rzW(kl=;>=>!E5Is8l#`-f7PcNQSj#T8H|JDyp z^kPx^vnig`FUDrgJM77$u(?G)k5bw%_&12rI;0pp>4PWg4ga@tvB-b>-UNNEUd|v4 zwA%n*#Ja(CliEzLq&c27hjGbhMHX8i$+uH)!{ePQw$vfC!m~!-hUJb?#&KFrn+)Q{ z2v2AjTkFN*^k+PtH5*WBg2-ae7$uHd&LQv~Rv6g8nfr*+1pOHGh~l-^;ieRXJA zs{?MM12($EI}pMw@JuOFqs%Pt5l$-#A5pwl0E|V%d#zS&tAlB$gYo~w;w0P;cRvb& z#D3Q0Q6-`!VI9#qY7BkmeR}cscW*`Bqe_gYgPyM=o<>Uv7IlfwN8PVy>r^W^F-3{+ zbk?(U`DaL7^=#d0g|vhqCFofa{~6K)dbaMhLb{%!JRjOaPx7aM$?5f-u|4(Dz4T{q z{n-c48q*wl(xdF&dlmju+tC-<{YelmaYuORh_E zR9KT7)|Rvc4nR5|0n|u*c`q7Ogn>265yQJ+&|R`8-6cNxF7XfDC4MmCYtR)mhma1m zhP^dbQ9BMnCfbk~jNQ z4s#}syi4{`cZnZe15D=OSeWcOfr}p($0;H0#?(@fhL{2k&Lc>tUh+q{pf0fyjz^K? zj}5|f+@_d49+Q|~o2rc`aHP~|5iE^Fu(VV4t&Y?h5Ir3Qt~2X+3`qv<^!7*Q28V}T zK2pDa&i=Jfd3-+1duQ^_Ja_ znF1h_*{mr_KYkn?idcibLoPT)X`@a-8+_03BCEUxk-Y#sQgD6i$ zQGc}0pQ=pYEg4E);~;)Zfr3uVG^Ib^Kto}|0TrvPX`IgQoTl#`?{qsi5O#4Iw$_c< z^=UYen1&iC*`Ig$>ox_5q z(AQ0nw-i8ec>j_Z*tmI88FyRX!|&P?_nd2g3zsE}W++zHWQLN&K_oNJUflB@5#zn_ zg2Uou__9Kt6qtGR%*4q_B5=M^4);S9vy{>FaRZ-H{sXbY z>8BtRPNV)}`TbmUOYn`Sm8VVVP8R-Nqh|cd=TrDBWAt;FV=yjkOqtEkiI&girw#a0 z*g=`CWboF_W0kwiP#@X{V+&>Z3Y;K4gLWUmcnH||N8`Zz86^&4dSQ+djYr`Sz)SiY zm|CzxY0HvMLhe+Q4|AGnf8f8YIgsUi&Q??2lTf@=A}uFrWLe_hfnj^+Dl-Kx@oG*@ zWTo>XBiPz`7+{j(z;5}|xGk79I?T;F&&MQ)WCP}7f+e!$^OY}!Ct2#VO0?rid^(Yc z?g(61!B#(unUcZYepcxg#06xO$||RWakei|T#gxf30jG~B|0uphSkzj`3o=vaBICl z@mf&z@5k5-<#nVU%TP8znQ1Cy?Yd?ssqAxUvaiI9rrHPuS^|x=mrLj$1&sLTFys*T zKBue+CH9mi7k!T*nt)v7d7NYLB;D>+^(FgcD-V65y^KydB~5LB2=Ux70ioSLnuIUN&p01vUOM^z}Gy@U-MZ_r)Z zh$Zc~&6?XEE`+@8cDTXIb@-nJ2Jv2kI5d$@-PG@~_l(N|b*D@nS^g>gHf%CHfRIs# zESz{^jmlOuE~AZS#ZRcXS(xgyvw4tVYs+3%rU>GE^eACR7y^w_54}-GnBx_tx9M3Y zd*pP0#8MUjiRZndaKjS2UQtH+bdu&?sT>tN+&B(O6Ah;gBjMWuKsUx23*wfr=sRc3 z_{?|enE6fW4Bu?PV_dX+6V?FJo+jGLO2~d(y+P_XdS0|XuY5~j8dx= z5#jJPtu*oQK0zeSD#}D%X7F^B7S7_ELA@|;hMTWZyH+bBX_V@|syyhkij*I1%FWxX z=qoj5CGjA|d9R|=yjPF;7?O$vO*9xI9$ECd zKt;<}tXCdleZE&*tZ0|jn!7<4tPk=cLyHZ{GIsD1QcLiwb}9?4j&b#@E3@jFwN-i8 znNkDZ&sUn6Ft0AWu8eii-n)hVUDV+-*qDvVWc>gj{uOYN7dL_o!m+?cWlhiv7*opS z($>9!IZ;cUd<~qJgE6kyq*!(K!J*M<+h(k7FR}rfF-PZV>Ga_E7RHLZ<3d5f7A1wh z2a^Z(2v*h%ijhTu*avsssuT%}*v+lVRh8CCB2hFv#!z77d80mOj_p{VPO_HUtIgN6 z?U-S7T&!C^>hqS>&c50XDbq>q=62wquowpI6eqMEg+tJ+zwtQiKxOSz%Ag37z6&$} zbB-L`^Fw-CZ>VbO2ht{Kz#TgfqTPB^8OWJJzbve@XCoXtYv~1`W?(ndcVnfdt-umk zTH+cJ@jYYY+}%oNB*Jt{8*iTGxE!%=HyETnjM7=sPjztp=x^v-UfYeyGl_|BDMz@0 z9e~1_R`I8(1&%WIC>n~SUx7N!S9=r}eskpw^V?YFb?&ys+sY6uikWXK?Wx)Cy{&ZR zJs%F`L(CuhUL^wqp1oJ$H?rT~t8j}mxArRc@@%+A)jJdhqA!`P+GtIgDAZl5qXmHB zl;>rdOYbT(>MpwzeePXlH=?uO!^*CoKb5tBV*EbPd%cAR_i-%|=z=(N-^ZmBuE_z@ z{^(-36Fcg_>HB_AdESHs7M}pO2Pp@X5dID>G{OnD-M@hsTzdfOMbHX4phR%R6k2x) zU1(kzs4|#|@AJcU&qC;Jq`j~7*ZU^-Ku8A`{DBgJ{_%XEyd^AWN*oNwKn!qDV;uzpZTMhstnc zG+;6VY~3PgI$irvX~Fp_qO!P$<;2Qn-(JUSvgm0XgJCzA@)2eg@m??$Wd(7{_y`0< z*GDQsngO-!Bk!r(ii3(ogWUC!Sz-qdDh0elC00Bt79%|h3SDVwm}nK3>9WMf$~eFh zKEd?a!(u;CxL*6fPn5<4;oQdo65j-27(Y?IH7Z*8DR}D{?8i@)e!>bCe@OA#4}eZ< z8wfUwM!CF)fnad^L(i96DkwUH9@@rihr#`kE-*0>kq9)Swy}r!WG&?gX_sZwu;Fs{QJ^xc2^>=f3or9@*bxI6 z!X=Vp*zMtHu`7mTqB|m3OFK^79`4m21QXceVvv>PeXhKN+a*Ml+3XT1ge+heN-*>* z2~c1tc4N^mfqGe+i9?B>(MR;i~j}#mNgVgXZA60_ndJ7D|5nW z#Vl-K^G~Bp9y@j#`hNMyYzLVGnYMoeF6}j~6y$M;Hm7PCTiX(`_W%W2~5`ax-m zT2B0cBMfXee}pEGzUwTzA11%-a|6lv7;Lviv$e(WESGW;6LNns>?P;DhFexiv!Gr- zm?i$C4C6=e20bI$0nGub;U`6c{_EkNlo@=kpI7ef!f{Q{LNwHk-$VulJkIK^``3)(Jb$0=wc?a*bB-&&annCaww4di*nE)2e@*c zRSOc%{}njEji^Pk8^40Qq6aQQIgwOeusS20|6I zt8eCu`BpfW=9mMMXb=WhDpt-cv_&!Mb>eHiAi7inm$!MT%8p8~h{Qv*Wn`T|tEhyY znpdkM+Gt?Oys+A~bdD=v6!x&5SCqeNP(`%!59Ljy;$|e{^gfyuW?6N-CQT2H(k0(O zlvMGjl1Ga@DIsqMdQ&4K*^gJ1h#=zqiOuz38xrfp(0Hza#_wQLuPL&5C-UZ`Yz7Ux z25w}RR(uUpUbv*4zK&JHauGVv^>Pv?QmN1zU}8RJ?eMTUpupc8An9)tOGT8U2h^#l zgDIMDGnQrFP&!5Z3Vm;4*xU$4(x9{cS+B9m8%pGYEl@}&j>`bt6YstdqpQ8Y3Y~V} z{N`%!SD^Rqo4&K!dnVp};0N3j{tY|#SDj|8=%%7rzW)lTEdQ%I&Y+?ATJNCWys0d$ z`zE@Kc4aqgY@p_BrWHBVjX@UL*;`oo%XPvwXUM9BzX!3(RiJNl1yRd$s~PpcK6+ZH zM~Dx_69T{MFuWYxOtotER;m&Ne!69QH8Oyu^$&=FZ$wWImi3v*6-azUfs?IIwuR@E z^fN;gDlCI`NWx&j$}Mn_oCexZ-vl^Kh0dIT0~@j7ozxiHLPXOa2}=UNCOX4d$TtCY z({9Ss7*-Rl+Qv@mGOv3dM~?6{2!9!HDXEKEfu2jDI#uBWK?W+92`+rFSQ3dlm@5sY0)9U zxxLjiEOzO=)t6w95pHGNzoD?bkE$Rx@%5PA?C8{{STy>mQ*3XcpX;INw8Sl8{0^$U zuR6}O$I0ryXKutwUdL?D>Z{T{?2r4Z&*RbeK{c|PQlmEKL3Nj@@2j}t(haw8Mj}i@ zn1!$d;VQzTxX1GbLK(u5t5sFvwW_L_2-^^vUazVuLTLY2Rn-K990>T-NQ(j+3-wuc zZ->)#<1e;rfZ8nRZ5=JZ#0^lratqkLf&spqvgz3T3{-~@O@Dcy%DJ$;1J(ODfog@X zBMl$=BP1hwUYBLgkAh{)L29r>@1zVz)Q4uV&yKq5AaxGGtbbW;%+3r_LA*6srHtUK z6_3ms367{DSzXJcRt#2m^HrdWZV_~dO6s(gL)7kEnb^3JW$eYh_x1Re+l88=SpFJZ zsLU9uhH&$Ot=a0KYA2q|OR{3S8Oq#4)zOx1$X<^nKdh35HSPz(HCO}&tLS01$v@OY z-_mH9`V;8b&0%T|ie?Xo-sD~)vQU<74caB;A?6RtK#s2L`m zt18STLx1zZ;3SMz-OPR7ZqJQ|-)Fpe&09UkQpF%=IQ492G?bPG>RqA*KD~Quw0aIL z($0-hA0#iHu_@}Kcq~a#qwy$AQ8#eb&={NgEcF~Ti_=n}Mc8FCKz)u74@$Tg;cLhM z`+?cNiO>#f$X5uzVgK6_Ql0S#M-i?dR3TVd>3M7j++$U*#ow{&gM851Gob{Q1kxJ1 z&6~H3RRxw;iklh*<5X8}A*Nl{1e2MxSNQ3arkx(AekuqLY59+<@ICmBcd5-94~DF4 zf;wFIiFKT)_5(RjY>tIC;T3W>^PXhBJ=PvbmO-BuAHxmels_@$vz}Jr4yYln0AK9y zvF@Fu#t2-v(2=Ev;mjf733aycE_?S0brf%GCw^B%i<_)gn6Q9(rm4L-&RALg5<75c zn%W;r%CTwcOL&Z#t`0*cejz>OKuCyoX1WR$pS)2EynkV3{ zBi|F2Rp8oX=b35};opjx>Uw&%nx(G5Rg?p>)K2KE>$B7aIDmiVDRqrG7t|p4;fB!3 z{;@G^EkBJmA^*sy)#ITGlI~!T7o!@p!WAY6h-RzYY}=gKYE!61=Fe7J;|f9PY*mAt zbjdSnCqlJPo>3nPBxq8G`Vc**WvI^z2eeBWG>E5I&~qw7f92yrsrNsxK80Q?d|qwM z2ab@rrw^O-KIcxfCJWVTCgB67E>a_fA}w)|+AY9mpyw~a%E%MY7;M&bRwF>m5w11dWv%jXA z&78fupJhgqF_uj#mn+}5No~rnZX1M==rgYSY*JfO``2$$AK;(pV#0@ZId`+#BF{@b36m$|v2ZYfdsLTT`2;wmFvsiQ924HgT1(YF;B}s3-yhEVe$Lyf zS6AE4GQWV8u!I;8=CZfFBy9bMDi;+E+^arF9rG*16nT}XBkmmwHvM}+Tlu~fmPhug z!#RUNOh^<09aYg%Pd$w0uK!4F#WFN?9<}|J#=-S{M;#VLO`<~y4}yU-B>sO&kE8NA zOnBadOLc_t+G*9w4yZ+(xZvZPQq!?BdL6cV zONvx}mcY59w1(KOm#l!nf?_p|$|JTZ^$u9y)3B_tu^0rCz~1S|rmXBkHJCGOhU&br z$)>)5#PufmQR(OoW~a){_MD?okMI1EnxePve*R%~$oC64q>sG!6IvZq8v*@EiJ#?7 zuVdA%m%|D>^zwIgzq3z2_6C$@|1$>3BSX@ zQ{HAEgYo9 z=&q=0-lwYf3=d~|pORqlQ*}!e(RM2WO&}7B&~K7s5LZS!Efa#k#vB4il6OcAp-mm% z)P%G2S-5wQG7y&=m$LFhSjhVCgZYHCS-9&^^c{q9?!#UrYIPV)9M+mSht=nVL;;`D z72z^MTg=!^2(5v>&me3?XaYuiJi=Ub$$Esd2-C3Qk%P4~a2HmV7!VXz*QX;MIil{y zRanPSaNjtsKB`W@>dqyO!K3P-El1Tj-0IVl9mmwU)R+~=)P@2-4eN^!qK~}~;RvQb zJ&)>335+ov$HEQL`9Y|Q-8`=L7U`Iq{-_A`9i0QyQoVp>e@wRtKUZrrY+C$rqcDD= zcMOpKkFqa;i?ZteZ-zku0cRXwSe)m%4~vMPg8PCBsktYV=3bDNS!$4(nI>SVl~xeS z$x?&%Obf~yEj4KG%?w(ttRU+xOAT5~OXL4N_jw+i!RhVy=i}ou&)x62=bn4cx#ynC zGC4CyJX3M{^L_XCU3l-8A$_h}p6&JSKFoO3B#XH6iO&R8eBeIJNcPnS?zN5(_?JT# zgIF-bpM8fG=PCUVgg%3@$)uG$g#4SEXd)9=a;_r8OA^avo9jxCkKOUO?{m_}?!Fwn z8lMtJFCfP-*lgB*?0(yFmde&bP_kbJ7k`zXxbtY9Q;DWZD@zKWVp>b>KrYE5UCr}B`yI>7QH_;M9Pn>CTTX975>=E}succG#BF|ptehaWx z(eiKg!FlFe@Tni@L4ip~CmSP-@jjd!Uq>WU#8LMS%ZF5V)I9=RkL5?e_y_9$Bfiei z(jVQuby7%{cVUfN`=dJz{tJ))=ypk#FpPqKa=-8R(QwAWLM!8QJeBN&(~2`cK~DNe z7ZDa7b58*UtvlwP@5u8?9*N}O$G-vLu}^Z_BE2zM^3I6AhUzk~3(&Y8TM-+MLrlfY z=LJXS>~L{6_PRY2e+G$`Gmv*h&lN-0HoLDz%?-_NXCO~dINxFf(kQ0I-P;xf&mg)i z(&FY#X*$tSQLxy%$A)oY)>bkp!M%ThxDh+_7xX`zBe)Wd_ykI&j!G2G{uQkIr*!mJ z_wzm(56O&F`@!RdFOlkUyX(IDa5lRGIFB8_yLEF2uv-&whOz#4caZd|=Gz%i z0IKPjulkTBDL5Jz=N%y#{| zcY?e~hRZq!K0|dvnhR2H=_z-pqZjLeI1&E1#3i)zlzTGH51u{cPWCeZo3;Tw6HmJz zH4%w@?Uk+#fxiDwce>;Js#>;bxWD929MlY)1>Y#4)UqG`b8{YsI->FgWIObi+a8vU z7!%3uyiX2yUhGcIP-gc#`%WE{pq9g}@V~qR~y4#|-f{&P=o}Ku#1O}dfdYKv&%-6;cfLN{s zKUkG1mT&c$i~FO3Xm)_2A46YF*~fyRe&~apvWYgh@wR_~rJ^!GiAX9v?yD_sJ?4uj zOj|?9@u~tpMFGkV%d@oArg(g2%Xd6mJ`MXX+UR$p_`r|nh-S{kbAxGMEZ~k(!1Oq> ztj@p`v?Yi#=A-F{J1BVuJ;0ii+fnHo{L@dZt-KOIXLBWFhRTl0M1vH}415l8q11Fo z2UiT+)}`Ws3hIIt2tJ2@842Cu=>8xjv**PKXYC&&8UHbAfFF{masJ|B305BDnzjWi z2O;<`3Q-aw30`Zw=a&TArX~ohD<4mUg-eKHmyIh``p~f*kXO5QQm$zW+3*E3OPv(E z<$Djdc$QfLzl2|#aBAuSel;&lsg*LANm;pdth6(G;=A<8ZK1qyh4*_K!WG>DA&~Mr zVgzlSl?Xph*>ahC%IvHJ#ry#1drukZ`Vv*eQ^pZ1IIPZ!6db#*XxUuI)TH{ot@<)kKE=&2z8`Ug2L&FRXGc?D%<0u>S+OsP{ zY1GwrgQ(>&NaBttWrLi6j6dg)kjA@|)u2i5xs>_nmS;e;vPz2PFUBZWLt=BsDr|r| zDOPz`(w$yp>4*_dk5hDM6&QDw7(qFSkb+7P=%d7DQsY(C{x~H{@)uVj99J?GK>^bo zr(`lXdv#UxySC(rlQshS<@&BlqFy&V?+T%-ELS7126JTO&6^!$>^LR0iYWF*t6Z5%UR*0@4Nu>j&TS@V3yW0y^1? zCMH3bYuA)fveok_;~o{p3YsEyiw|px+%tGnQwDGg{?-(Eq1*O&B_5!7FJ58N>QNGu zd*moRlc-#RK3bB1^n7y{l&)~^5C5EjybaF5ksQo~AOR2mapSOeouoV=H9dW)a1D%9 z(z_`vI1cNkBumkE2vTv5bHfKU09?7iTBfucNGz)WuF=#KB^zWsgc=5gsZ?1J z4nK?Cm2|8x`Q4RNbNR$pYbG^zSAwKHF#Mp@V*|pTf)-SH+$oC6ZfS@0P-X?6!0>R- zVSds>Nw)lK3TTkuoST{hY!#`>6d&AW;grFqPiI=3DhI}MUn&5OLcdE>RIm0sJ_kOE zo{Cibp6I8T@{1JVn|W5l%<}nIJ54+S`+yxim12;pp1qW~E)2--sE6sWQP<2~%4M=_ zW>J$V|7j>TfeQzFDZj{IeTvlVbHf`?Z$;ON$5PWsj7@POtnbp&l?~QQEOhXCr3Z;@ zP@7}v%2?m5sg!pQwh{_5l<6>#hG~sT6Gy_K-+>O;sXLRQ?4mm|;iG169|&1{-`0X6 z8Q&M+;WmxJ!?b54IR=Nh$}69x8`_XgSg!2f zSwhR3%c1i88`}(r{(#W_dI6M`hh7C>>N{aOGW`IIYb&3FR&-)NrK_Q+ZI~OST7EIs zcvj%2|DZ|@&vX5hJ|Ql&!+=|Rxc{od9jX&MP4BM=x&y2??H-CQZRxKpr27l-S+EQO zW$~vSZ55j$ZK1qsG7r@XC+bvvr7eQ81}K@77YOV9;sHt``%+;tI`rlTCs2i^TN(`;ojpC zXjTq4!U1P<&xoLkx_C_8Kf$Yt!3us+h|SWGN;ELO69+4yv@5rheUm*YG?-!XG?W10 zlpVoh>tO)x$zXN>IT+ws*co1Fim!wPY2(yRI5~^N-aWkq8M*dw?kOzqhA4xm@#i3$ zXZjH3m?iMDGuTSOWt|~$G%r)>s=bMCUO5<0K%NVp!#6Lc=JzH~Ri-k=VmV1ihbd(F z0~TS*NT!N!4p*%DnwP0>RW*)K7Ftfxq%7q+%V}!KQsQXKXz+ulvXltRUorr)qYQ60 z!zt||BLz+5U)N+SH(D=BBb5l+(DrKwe!-#^w_Q6c zMky2N0LM%jr9@amBIx2#N-WJDYlejCA=WVC4NA!=teuUw-FRbLO@?EAly9f;jxgSl z#yiS*yYzQpG`F1!Z^AJc`$bAuYfJ?7x=2y1v53bT&W#pbq+9`Sj_+Lrg6pQ^{8A`v z3|=brjHc+rkYX!DI@KqcdiGH`LDEF+QL8>1|-BvJNQCC<`Ke@R8gh=k7&9||ltWPH+L-hu3i5`)u%>X-xr_~z1N zY>$pa5uukL0r}q$0-80&S*20k(9-CV#}YyOJ|~CGGK}xko5@sF*dgfd&Ol~x~5XbRHfW;#Dw(ECgL1K9CMui7l})qE){82hu4KXODC${extwZdpt_tHkh!kl-vcdq zUMG0mRVB*QUk^yiP2QpZ@7$Y_@AAA$@ zV53+sf$h9}rJwxnMHzkKowPS!XIl^ED?|EoI$0eGVQPF{GZ4m_Mtv>TPhKQ|LG(Jg zVeWqA$V%j<1(hz+uy1pv!Nv5#MjUJ^D`#SVCTlKe4OZ^U=PKV|$;+OnNZa}JM3<+g>U(_sl_UfxKvf%x%R&+B5Z0BB!l`m($qBkG+Pj3^>iXIVmI=t_kr0WU2 zM)|?wN8pq)Donhw)LyHsM9EvPRpc$lZ(gfh%Xn}d=EPoHTde$HSxkEtDvu<|g&hrL z*3bm^`CD%#i&)@g^&4E)VHd7?k&-AOGlg2_<80EgMM|gPo&aUQut>whC=*SST-ac0*_Psx20fn~&7;F4Ppo%M{o$d)6!i89~m5o0Z9Y9o=$eg*+w8$vBG$bjvZ!ZsQ$w*rT`qf@D6X*BN8TBYDd_N6*7YKtJpqf15T z(oNuJ6}Ful>#BGY)eK~lW(hCP4&)%l=mcp+|=e+3|Ebncgk$YdXNUhf5+m-QHulC#y zX%;pnw<~kGQET)meb*Z0gMXMSg=>{*65M_a4LYIu60ZRto`VcCQzZvI#?6rLx~>B( zmQ&AlIuO<=Y$3dKosud|+@ifQF%!<{$OU3z?O&(dz*OcAT~@h6DVMFlHq;Op`i0(! zmC%^TJIZjvWZ|7yyNf(q?^F^b_+GtBiI*rRXFqAjROgH9!P+3xunmfSnh>X|UhV?p zy&W3viOhj;SGhsig+iv@jm8GD0}?1zJ*-o|f~ALhjh0IuguR&jj zQO&z>ACXn66nNo!(_{#}jitJ21c=4eGB2(YeF(@@zXvNa?-0}NWy%H_(}^tc0bo_0 z4-eYZ*fFTQx*Fs?7WNl8_knwmWYREet1Sn)y2az(sNje>d^&GZ{sO#GDwMd$^F{Ov zF5ufsaq6ToHw5P~D-2~$m~U;kEIvRAs()4}&w;vmo*|{1&9XvA>thcpm(ayS++8ZB zhV`SoA?~bAk2(Z3Z-MgSeL9O(I`UPxAz*r;kD;ys1%B^^WXZU~RK^qynH;pI%s|LZ zQLY#>_i7|(lxjmWDtkN1S;V3pW}d_}j-HOkRBX-1Z^lFx_F3rXqP*!HPZU;&F|A{X zkMqUg;qd>Z@aDC{kV)y@uY&^NAOr>j-M1;BqpwGw(HAK$b5r8+1mIy3$oR};Z~-31 z@3D9|p8q(H+0&ksy$!2d{bjbG^2!3R66rx5XxlcZt`E_ohm<1{H9C_#lT+KniR&9O z;E?_q7|>Q$D*gB-g^#Orjo`^DQ(nFL9ye#nYimeN2&-IN^^g2N`p| zdR!UK?Q%Z}(z*mEctJ0D$or7?Wv5iS{Yjm_`OlNeTFa}H`;@Yb8}py1l-2yccsul( zDR&@r%kfOM)lN1BM=axMMVq+~-{Bz|{l0m9gB0mv%#xT@^w54@O2&^KM1ox#>}! zaTCsj>`}VQLQ~=?J;J14{F)Ss&H;KNRNILw(SmN95mSkL#%?HU?^w5 z1Z^gF0JdN+!-!$SOUlNuBCw$hNony$P19T|Reus?ujmgu-1jN;kPx*b6O=!xLYg-5dB?2c9LHme(oe zoILzh+Lrn+-;zS9hjiaZz$a%6_$L1L8%^r zJ-vQ!BC?+zF#AocNnn%TRNjg_@5nQVM+!CljHPSCThOJ#wCYs0u+``xld{Y4z<}nvE_|VM%?T`82fE|>Ui^MrSx|U))AYNBAW8wRa}lWh+-I>3%>JRB{eV_Ji3i)x?q3nz`M{1 ztu;&b{Qj;o*BZ7C-`rqs-JJw;R+nexL5K=C>C8-_$6gPKByTadv}} z#e=l1!QgRp-a=xo{!=n+K6W9*#*Z>M+N-5iGMLM{_yc{1B$SXOfSuo7pz zD}pYc+&z|zBZRz*KnqKto6h-Cna-tc|5D$`IrybA-VeLnG7y(t+jnBU&+36&QL=X8 z=Cbzfyv%2K8_ZiNOWmpR)G$Ihge}HY%sU|7Iw-r7(Rs z^nCVJE?XpXTFe$OrZXBckl~d58^x)y+o;v}>!ukJ`RCZ z|Mr`$)NeLN*?ETdd0aR#^Lppp%6D6kjjRY8Op3wSKr%9S1#9rvGC96OYCY(B3GCEr0% z;X(%Ch8M+^!BdjUdjKi9Ep4^pH^c8ig!>L=#`58qN=f2e6yzF40_`>>?&3M z05TRuxj#Xyu0moTT&3@R0KaF%K73wm#!+N?1i>am^;v^kmf?u|sB$}S!SW**pG#@* zkBaWz&FqRS6KaDWmC&U21MnzHY<$m=BUE(vF{Q8L3FPr@Uc)iP`LC1dNo4bdl_M|K z>EIzhfA}3wotJvfapk&n9T~j@L(K(Fr9rQDfiYw;je@M00JC$XhS+H!-exI*be7XF>n4u zs<*sT!A{)^kdAkdhtcRi#`|3}t@az#So)YzW+3!GZwILn0RNXkYH!c$zkv~#UWfQR z#6@_xjQ6POZ#hH_-8GzkItjTMQW%0L>mzG~r}`vI1_%G4k?;EnH~A3XiI}p~6&F~K zya$<(|S2NH5lD>msb&4nhK1VZ|Sf!Zh(27slf zm3}b|D9@Y=zSS|-!n(QTv{YJ${i)0f`;aR~X^cv!eHMhvEiQI8^e0w!GdDxzBP8rh zb$5lRQr+H%GX8*!)A%Q(-j5}qjo_+EKD7E5nE6l0VO4eIeIIhPSfM=o8>#hyfRU~N z;am%j^&I*ODlOK%^re!Qux+vOjIt5XaGZtsd&nHeNoTR!bZ!`;so0`M&<|%}N41N> z{+66A#wgXS;xn^~hGZ?F9rc!8t`mb)_D6&zAXJWM664Dn5F70mahLN(z$eEZU?sd1YQsc8l<08KcVO?TPO%kh<&1Mp+* zEc%ZtM2_Gt&m5~7(XKmk;J@}BkA^QW(pgqD(O=3&nG%I=wW{TgCXDAtP)!^CgHaDJC-Kqn1F` z8TOM;kfQ^Fj`;*-aL{p|pj-|*;S*HIK|lKhm32_B2dFF^RcBx`V%h+Z(NSf$F*2g1 zT?FReT=0rpI;x>zeCM_Wy^#>r*QZ~QoTu)u#``yOSX)r$c?k8p2{}pf@`BXvs5Uze z{&cxW240j;@vu;-3sQmB9?(&EEYs(8@E=BHr(~=_6l&_RiBlS)4ziw(py40D1fn@a z4YmA9XG7F6qyIvdDJYw1BoD|LXf1fqJSy#*7e;ePd+vV?8{w7C1NU35pn?`n0 zbyvYAw<(%?c`Ku~eiD@=`!GHEGylEnmWh%J&1hNu@64L=zoc z8HdA@D>{QQhg%QqTfWkbH|rtK6i2At+nkk}9KG&VREt06S=!F(zJ3tTTc^+SbnwbWd+M=fZw=)*_cZiP1sw?nX5U0Lk zIpj&{s?KLsdYK#VL!Q%a6}|`$!B$!Ajn^DiJ%U%ZP?zDgN2t@J^=c{#=UKrsfjKp< z4BDt3nyQ}^?M04v1LMj|3*bjXQ?vMDJZYFvo1o4!em{|!2(wuud`c3+chR0CHBS1| zWCFvh!)17QjJV@m2j(Y|AZ1uLmG^#o%9m#n?kEk2xEo65KJP?=S!>mdvKvWGfSs>Avqr$!~4u(4a+5nA<$sVZAuYQ?bW-jJ&HlP4=p z{iexC^6@#CNM0cD1X4|Lw6vl`YVt;(OWQlK@Kn zN7QgSmLVdx>8lRJ*PNT87(6BWV5NCYUo{=S3ztK4S=|?_2pm`U1$Be>r+zYz)(>M0DC~;@ zbBJEVvL9C5xSa=!vMv2ofw+DBfHJ#0XOY2%PxoLo*^iphvWI=04OS2NiQ{qi6bw<% zu(-7-Qyu6hO-Ttj&-zSttRJ2l-pw$6)i5|Z{2!?9bB3vdda~lS2agpVW`=b1I~T@8 zt1XPQ_W*zc!{ks(EVK_-=gEn4AzPMXXoss^<@a#jw1;Pz;p%h{;i_A)fuA=98s?l4 zYET!hlqVwNy@Bu7j!<=VbSO3&pbW_g)^tlJxW0ZHY^QXwLk{qaOM_!3T+EiI?&sr)Wg#JqB}KwiA&LHM}y40K<|xK*HKRIZm6b1 z5)Sg$!No*%8EBbU-oaK;A#8!{2+2Yj&tT(zVL8+_5ub_(9J0Wkc(pY+NSYlp^$w>N zkCIIGa5X59?`97sN2}(nNRAK1(dnv(60y_vF=ln%AwHpnD~-uM21t$rv}4o+d900x zgK^3v-_f*Sj5Q>jaEj zbbZ}epjKC25vU;orXk7<=$H3i2xq zlnybs`#pMUHkS1z^yO?-_uzaVmDP8RV`ppSIRJOT996$f z(n?KRK#T2nVUzyY9CcT4k^z`#dg^lZudr^$=O#3u1JzuCb!3;P;R>}C)ZNpNuMV}s zIxK9S`ZN1zI(s#+=rz*jtMjeNk+is1U@UyO#N%Mfe6`Wh9YwK{k=J_0x?P^F*QoFm z2;;E@>Jxa)xmI0*6Fv>sqK6CU^tEbg%yy(>o|FQR2{lM!NkfFpP$+Rymk{rpt zBCK7KMJh7reg4%QUFG5r8`Tzr|B!Br=BLQ@!Dzh6<#X6Lgz;dS;uRcFmZ-BZ_+OT& z>!hDdh?KI++}%Ftu7k>&L0UGfR^=hjldDzfGbrjd^+KM`Gj9VUuD2Ls)K^$VsxQHR z$8MJlpJR2S+o0hEh43s@6(UO()i>7jvrN>r{CtaPd0zax~(- zb*d_j_{>J|81wH#WVu7VR9ZH|hns|w8713HC8yZS^Bq`257FIs=#{_?fI_G4P)#3Z z?6%vJekbI8IXWcqz{Nfd!+u$9BPa}-}T(8r{ zs10g2d1DO^sX45se9Z&a*9W!pH-g^Xya5f~MQb*wsS;L_rJ{_FlHdS)gTa>#(;dAx zPs3@?yt~x{3^q9Xe^F*gL%F#60oG|1_o|0v4`2<`+X_36d(}*tv{Z-ms#3L^^qSol zSw>P_2vmu+rBGeL*yH8u!?GPAdb_2A`htyWqR&Y`Uhllt&u2F3jr@C~dWj#FIDeCR z9ZrIHQLIhsO3MH}fUoEFY^YG}Of9#PI$2@~2$CE;jAPs24T48Cplt2aF#i?zs|&Mv zM45H=R-14bPrzJVB!a(Xp=#TR*fj7?3C&3TpZN?NdU=1toAex@mEs@^dtfseFT$?BdKbS9o z+3Na$+SP({#XGSgRqq1xla(HkNW~9eX&Xmj52}|+_?o;4%ZcY0f4b#CoiLc(^Zp0b zhYe!`AGf$Xzwhv@*@Cs^pQ2Zhdz(5TxNYl;_Vt8#P&x^GQ|UJKc8L~N%D)aiJF<4M zQ%d$%lKBwW3>Y^&1nLi00}rWVQn&zK?U>+sW5ao@5y3Mz7OEI~?)`a6ZQe5{k#JblXRi|LsVjffDq}vzv48$bDq(v|5Y+5m|j$3n#N=wvDj#I)YBCp1X* zHRl+ zU_z)mJ-?U=Z4inoivn#DLfxq)0MotlOgG)Whe4A>Wlv!DpcIDa={144f)%YdmtBrG z$zQcvEX8kDN19b)OKUB>)=#g2oRmr09yQrL48*{UX4~6TBK+rOq^^5j*{V!xF!N_!>pn}*x{Z)tdteA1NXr^S^w zzXme8TOEs|YE8Gp1()atyx)x_S^vf*J?3v$#XvY)o_7@7aURTTpby~jw~W?b7wNAt z26cW96mQ2mh~~9>)QF<7#-K~y3BbDyP07I1AI~^HaSU&c8}BEM(SqY9_=)3r$Z->W zrA@e^k@BG)&LZrdCfNqGxd;qbD$G4c{bcSl

KJP&zJ zzk)%rl#^BmVQV@enaeY~PW{MYS>efejfJ8ou7bA^+WI;)xj3fCrOl+RZ-9H>Oy9ks z@|6Q+Z>q1v{I;aEH4P18#OJ@`H@3D8Th`jTfEK(3t=-*lyUvRj&v*XoNi}b&t}b(s zf!GV-3D}XX4vCeXy0lvK(G_hTLpLXBByziTy z;8;VQ>=^O3Z}5J~K8Rh+HLvU4W1|ixJQ^Mz?wNSF+ka8XLFiqU&}O7gnS<0E+Y65g z;7LYUx>wi;YC5PogL@*1yAnjXqpeUoy$>!lcos+*t0R|D&wBMIx$k13hF{{LR|+kh&iS44eBZopLZJ6^^joUR2DnD4}+&(_<^dQs*0t;PoOlhf2ih3Rw^20;@Z`4 z7XLp~$4UjPgX&tKM{WKP8%U7WJ_gH{wGuoyGG)>3kH9x)dl0%FhpjwYKT+rM^=6jO zpbSf({-3EUq{;ZzTrM6S1J<`P9x!Ck#)F@!J@j(pD5$;*HfBCoBV^-m6>ZK}m=P@a zTs80DVO40w7wWFIn*$-)egR2FHV>{LK7e-Cei*yc41;#XfSk?2nh+w#wO@6`4B-k)lCC4S>I%}d2+r{asNmaH64K!$ZQJx zR_cTBh0~GWf}4QS?pvr<=6G7ZWgQ+Ii~kqPl^oUH!3cCL2Q}W!oT?mi?u^l^-Iov37Tpxl0Y z<_A^xac^w#*pEUi)sxix(H$P+J`DGcI-=am_WeI_S`bZ?ufuGb< za1QXsF_|m>IG}gx2xd$^#T=IaMG%`1NmyPjLS=9f8)Kt^uC)5g5mVY?)+ zYa=Xcgj4RNjNyji>4b+N0jDx2)i_BE5~<}R+SYiI+e^n!s?((25guVC1ja?q#X$0Y zDzAJ@MmaP5g8m_!QT2z~SDtfb!}xeSoJvn|R8QeJ1)#x{tONEVN+&=GT3-YGU*0JU z2+O32l%0T%7N3%J-+c-S?0In52yIXmeRm2hR22oEh6Yl4a>pTv(-0S`JbO;7&oc#C z^cVJhED4+L7EfcQ47P~%qh+CJ#7MItsDv#xyuTCMeYcNKrlxn3ppCx)>aGFMP8SSi zMJ-=*m}M1Hyq%SQ%}1E5qTevaWhT4~2No+#Q3dnXm+Qwj!-?m6Ta!o&5D9WaG8(}= zN~WN|#a=))Ss<|m0YXx`wE2oJIL<^HX&!w zYMX%DZI3%pj9~nn(?MXz+Ow&H7;3|eY6uap1vA-U>e~(b=n1$JZb$@__?^TqOAPBy zB(5VCKlL%k4;;bKa2Z}b3`J;fm zjscZi;dFW`JBvXUi6`C2(uj%DY!^I#a4-j#r#OV}Xu5!EGI1nqwnMPD2hYO}VKr|G zDNF!Ss;q{QQms>nAq=lkXf1=7v6QD;KfD=!Ry@oMa`^e_Jh2htN+#jAMv5_b!KFEN z!K^9ptzYYcr!DM5a+m&&6yv4j--%kTf`7HVC=n$0#d@GrUmYK`gP zU56%I5W%I7hQ=r{-A6IT?J_Qr%X<-rov(2TJ65ITF0ldw{kuy%h!?vK=ysm#07gRm zu?~^(j!T*qNq=7w7)6cIf(;RZV?=KZ#o!o`fY+QD5r^0E7?J8`4CDb8co?yH(Ax^3 zx)|}iBrih|%usEEAl(@&%29H=GyYFZj1v~POVRGs;^>;Lf_2Y0;*ZgL3GU>Y3H(T9 zSJ@nqsCz;kV)_}dzMHDJx*K!Ico#39<+ z9RneqbE}T|W+ZrP9uN&q^kZF!)i*r53w!W2W)ip@mie<+K*K+~yNC#0&=z%G(eV4d z9@ZS)MQHG~ZK+zi3so;WA@C63*MXY)flg0M5mOLcl_G}X^<|2P3%;%`k9VbmdWb}% znA1Z%A$dinBJgtGigWw|TY;4K0qhYoQ$;2cEl(Ay919$5Y`{6$>QpgSeg{!qP5>Cr zG$Hp9E>06slHD2t6E)Z$u1u4N@>rS}$V2y4n%HJps4w{TFsQk=^c1?cMLV_3f*1KS zJ%LO`6xd4~ky~@#ehGqlqx)@V+^MDq^Z@C-MY=JL?=^ro$a?{HjK#ghVV)xCfWS)H zoG#X*DZ_Zkyf;%98;#4rG_%vK8RA)Paj!mNK=8+$1%L1|eH28p zxR1C|E(O^L03WVmIh~D^q!?-Dby4Y6HbQW?o7rbcKz`V6ml$WkKd# zczNa7+#kv#09)eNdOScXY362}iMH{g- z2#%=$1>_c(i@SNsYBZl3g9(xgCS_tM#tMt`P*9}3@X4w1>&~H=vU_RgP)xkN^xjYr zcisuDC8&~xL6)w0xOBVBuuPF4ccU!`;{Bl;k<6sSdJ;bDm$9^cgOSu5UN^Omr?N~m za2ao)0}1}L*?bPraZNX$R}-Huax6cuB+D?7>bT{+;Q!Ogm&

4H;8z?i!HLmZ+y#eF%mqiJaMp(5rrTswy zc`#t!cwslr)MjJ}Rh|n-H`=6|rAOZGw<1QE$TfbWWG`y7MAyi*e&buriaPsLWL+0Y z7f%2I*D-PuOju=ekVt~aIEJ)iLR*Wg{3nUL%Wt(!r)#s>$zr==eyX`kY#jC?}78XE3x^BPDl{xdx^S zJTN?4?)BS<{86IsKa`fzzBDeS)Nd)U`5EYEd?U;Jrf$i{a-KI@;x)|i!2*mH{ea`& zjTZWWA|`FzD+6io^IJ;xc1UA8cE`ee=pt|iduj7USZ<9h<$klYTqII)Ov^n+sOM4J zjec|Fj}apxH~Ec1pW%J3#A+K>fq0Vwdm|rupmzg=VHkd!Q-sq*nQ>H=1m1YiSYh{p zHzP1V3zHu^|@n}t5c!NGtW4J7b}i8$=0Aroc|%D;l(R_mEd#g(%9E_}(UO8usY>6Ult?kV7(-ldu;V9}oS9G@cI(%IqR zR5J(1_3JMax_OoSjw{cZ1g-Bhq1%VUvS9~U%|X+Iek;dSFeZ)GuhPP`x^33nwbO(E zIGUyjX_DGyIy5m)wpmZ$wwvjqUTg0@iFIct^<|7(LM1bVdS0>!Bbmv*K%SieF!_{5 zO*4dUYBH5_ah$X~=Ljr*>cb;E=`#hc;l#zyb0qhet-tc;K%W2|;5N|3<_EjjJf(9W za5E#m?Q$V)*zXw^8&9PZVSp_j!1>?i%OQEOjL-vjQFM2Oj6$Qh&B$^26WBeWI%!Lio8$#V6pa z=Uj0w#%bSN!TQ=3yreh@H`qV1ea<{#lR7b`xZ}vum-RIBpiG%Xh4U~AVE8%@DlsWi zUL~ZBV6Usi0BMlNz%bG4Ah%G<9NJ-D2|U+fwWNASk|D#q1-V!p^j z?@Q(jY0>t~{I(s8>{>MGhxxji?$7z++F-7SDFIHy%n8sRS^i zyzUwuRsA*~bAh;-TjyJ|tAjD(e=ZR6%8OgB75ep$lWFwxv8J1z?Bg~ZP03(e&TGX& z=;Y*0J#YW_ql2K5`@Sg3K4xCS+}G<7v@Nq14#Z@RML8VyLbJViSfW7KgDXR(kr zMSm|AY~JbVb-n1pw#R7N)4ZD#c!QW6#1%3FNToxPqEnuR4?4Z?`bx_KeQr=MxZrAh z^NKqHXKZigq6p<-Qp0=t5}*+*rI&yPVFPc8_>|#$!;NC5Jg(v`Y9sus z8wDS6v@8V#uxW7;HfHHdF+mMj%3I$gY0V~X#!9_}=G-i1`A-5nhy^f~Xw=iWmxGmBLX(z@RH^JL)WzBR zmxBthAYVus7TjaQwg9uJZaLNsSk2#pX|#hZD?pQWlEyC_U0We^jZz?GJ7B!Ma)sy~ z$V3n4TXMs2GHL}R8k~1~kI&+*5NVjsau-ov>6pF}kum^I<5vp(l#q|w7}i|y`&b6; zPyI?AyLn5GM`7`;K!9gx^Q{2QE;@Rv_>e>QuQHH(Az3bqQgvF`SOhsj6bb#v%ypDI z5$fh0s^KK=THll_xtPm~jbd=FBsW^6#s^hw!53pP1V4)g zcc-k?=u9=uSS^;JK@F=RYvY26)nYwfg|~?nT<(e6jB*#3*Sx6GmSrH)S+|Rukz~*9 zB3ZW*g3Z6&=Sg8IF$PsJlA4+k4jXNRott&T)`%-CH98LMULz)2p3^N+o`->%7#O?@ zZRVLUj`G)vb&fIEbx*@5a~b?Mmrk!0ui@BB-LC*l{W@`t_5e2h$HOS$4Lll*6*wt# zx2brncnayNB^EVf0N5Art@h-0-=}aDw0HbVROhrg!&v{tC2^_aNy|@C%d-YYSKKM? z7<|KF%vxBN9EBmvvyH8-QBAF_*L~C4I`Y4*t#gswoWKkR7NK}jbJq@0-JK#Xeh+Rl z;!@4-@$a(;!JT zFmh2eiC;g{g7uKEA8ghw5V*gyXcL0EzlFXD+yTW6G$Fbg$-EnygKw&TUqts$Z5I<^ z6lmtOw)^JWr9#SEaG6-<1`!k-f={j+{wg{^$DX%A(&5%uTopn%)BSNt5d+dyz8T?44@C1^EEOGSFvp7!DJ zA2P^|BYb6IY}iX)kprpWMO>-T+yk4_;zD@u&&$L0C8cFzL(Cy8Dh%HC%ZH0k2tbRx z4%`1Z_lbzemr))MIIrLgCT`5Nc&}MG&Dn?ruG~|$ z5sM5+@_U=WoJ$59Ui93^`V+LX=@sI3+}57I1O@|*eZsp?ulvJ0P-6ww&Sz;HiS=@= zb&*yD!TT7AEhvcZ?yWeD4Vdcth3?hTXmN8P_TAGri>_h&%toN4eW+nKR;+@}qL?#p zHa1LLRJR5?#7)Nd0T zEJ@5F$UdM*la}y6-NgOE!vj}NI68KPW4|$;rnY{Gr=?Pi)SacuA~u!qO;wLTh=3i! zBhdA5L2F1_Kr}uAop%C-{TE#>*wG=>Q}8J7eR2vwy11+AIq;a+VFqNZ>YCuGd;&YM zFfyO|6xdyv@&d|O+|Bj)(}II7I|O_hFTsV};wNwqXLn*X-cG}wL1JLdGh$t&oN-?L zU>fP7oyRZ(i=P!;k!n|JlWzV76RZEpiaoR4v|zq*YUcbqH96HwG&i zTdilF6UPwH5UQn8#4c=?JWDOR#BIp3^ab%QkMD&qiUH_s_Ih?E^9nZCOJDTM$27et z2-)PV(&>qv!TgWL#NOc%Pja_+gC+4oq_Q(farERKa0NQh^3%bD7W9M#Q}Z5hYD?(% zJ)*ZCUZ?*{;$^*(gh*4|V$}kGAxC#RrM!$i)+L_DUKYgX>4xnGiM70<3w{N!fHZHX zTVDYax1Bb62kX zRXPQ3QxCl=c3WQXl)c7t{RJv;4Mh_GhyWkY=Cjm+rUEI6>SS#(@_1}AiPT`@*TgBn);5I z>;>?`-e7r49}_SU+X;j4`gZ_{C7v(e5pa4^PTB85kH`)2ohfVH6%U<I_9b;AH5eLH4F zeQTUF5g78Bw0g+@Ogx0PSw0u@@mlaXlovRb@;SCi`0i(35=`o{gx>iarWr{4g-DP? z3upmL>gI$2i@pH!hKz`^lzM8u5U=Pb5kQ9T#CX=;1VMSjS3>w1iG5#*3DS;(sUxU#pm%=4e;}NV#MKtbPp~@X{-l!?U1D;ND4zuXiZ$(_>>jq`zDQW5? zV8HY(YR4Y)cVbLnIikX;VHz&b-1{9Wg74@5f}ys&;nBVq&s(LPMKV>ri9^86M?ptR zY3q;RyO&T^wdV4q{RGqvEXAzvKqb#&&CEFlL9UeYkBM2_ul>hFk2c!CAUa1I&K`qU zvz^?>F#y{s`?$D1>`fDB7$@9Kb2anG$59^cbUzN`kwcVnLQIwma3Qgo3zeP_A9>fl z@@KPlNSO^Cf`Z>RN`yy~pT&gWciKJ!o52hGhXywTLCUGH859|0wFNT7A$qR`OESa7 zPPu=_LT7YuNG-JD z4>8aBF04mF)NZul4+v<*o;`nnrhupvo(4!~($Ui(sO9w7pW=G=Ou&@!i;6nd zjFx*c{t~b764i1BjBPo&&jN_$p6s*Yh!N_d%vMBPqh;d`K?rpvw;P}!3h#b$gX+1ZZT1gUPq zO{C`0+sy2)&|HLq)4e$e1}237!X7*wz$RwmxdRVDN^%BVaKQ{bMR<1OX~A;|pmvpw zl!_RIehAVc(8aSs+ALW^fT7xKwgg#1NP8{NDT4)7z17hr)!R677OV}W1GTs!VRk`M zbVU)I2p>C%Tl1XSa(CTK>){hAsYBk zis_^+!^&RPNgIeu(HmB?Y3ftZ`89UZqAk1WbSI>`o?33hZcbLHR;n`u6VOf>lpdya zwKUVDFl{6k5~eYG5E(8@9v7~aOJmd3fDt2(i7;)v7-b)YbB5Yvtf2PJTB0K#d>>1j zWk8yn$C zb7*P2tmQ^vt`z^J!GyPqwh?EXvUjq(zrW(`7F=V-zwQ4;WR_DKWNU>qOVu^-BvXn{ zYvo_G?GYDjuAEwgH5VU$C&rRJ0)XgEJtMSK>)(Hp5~lUCd`NdjpcQXm4P~fCgC~DI zLaUUtAH4+a&wsOvD~x3aUb7?%>M4uV;9B4X+8U*e!2Qd0F5vD%@L7b{9W=}ZI7|Lv zgr&P4_bat<+!uU9{S^?VN}@HVF@LDwq@lNU>E0l6mV&c56s=`S{4XGj)tNxmZ$kFT zD+FsXHbzT?8}&so+6t6#G)5bPS4OP%lQtO;;AJHZ50G3wxBsC_=G<(_h=AP20SNEX zqBt}tfwsnJ`mM7!Q`rEluvz;e;PZwUpzuw(P1;i9L;|b@Wyzq z2)Uu?TL(SaQwyaX8iofNEz`LqO7?0;%-8?WfkrBfm+gZWKClS!T0~O&Mq*fHNj&EK zcdmEtrhh2)8-%y{4Ac^|zCGI)%Imp5#L){cNzioDigWd`OULMcsP0?Sh2BwAb>5N^ zMLiQWm*ntF^!&$K*iInkyML(Wzh*W260wfy1|UqFdSVWLFX3pQn(odrNwaG|pePg3 z8GZ~x9(=4jI!vV@lADo_x28=-kdsCkNl;Icmg?h9o=f2__$HGcCy$b)8%Qd=RCUvO zC;j+8svl__m`6NM#fak9s8IDY~mJ1bcWlGaMx z74J4OzA~yGLvzme+FF^cg@&;eAj@f-?6?oYd&ivciQ(>>oB8@?JalmF=SsT-&20(% zx>Lhh0!s2>XOANd=!3MYnG1=<+jj-b)2>&`~_*Bu05a3Vilp%E(#hqmJ<;SSVhe-7(`Yj2P$rxJr{APu@3{~hRcTeHAakPr-Z_pk z|4@T8@5QTqb=>Mdy+$yZ@_J$E)KSj;7wYhrFyBI>2N+9Hl#lY=C84rmV@r* zABl3tu&ls?%Kc+}z$6 z2xl3cNkuV~diw#C4c0EvJkO%_R}GGgWQw?6ko9 zSB91_g8^U)E1a0SXI2al$^v+;W=(g!*qaeI=D9_^z=(}AOLc3Qar zUMcdf4uzIsTc}N5{l%c?>0x%71uxo-@prz5YR4d*cumV=`3L;8M_tK@Pfl> z`vdn+Q}b655s=JthiT5>J}5`!hEPLLh_k%-Ak<8kC)t2@mQU<)GV5|;zhHqpu{%=s zK5X9Q{efzlAMRu;PcO5T7vEr`h*i+kAJ`Te^v?~{4ZhRsaHL}FZ=ullJqGP;bw4dM zi8XUkC_Mp>xmq*SZo;?O$8s2{V*$izh<;j8Am^}A%YInhmhSHmWMDa7HT|_qW$XoH zxd*!Hf@iT^II+eKo0tLG#PZS!Q0a#y;Lf4|T!mhHyVI7-Sjr=Z`q~hJskvFP1TMZ4 z@vsVm5nwJJMhK2$1ToWY$L|ob+!W;uo9oQM>;#_@aHTfVWi~Kh{qeLK zNXO;y@gED`@p!nL80d6iJXKu=Z)DZ)rQXL|{POz1(9 zeI9z+`fY)s25l@`-4T8>2M5?CQx!QG*-xRfa?2ntl}b0DbF8vIq0HaYLc38mc8j!N%~wI=OWyIyyTP z>iU&)a0sA&C|2WOswsj}aPN)SQQ18cHegdSwSHQAgllVvQSvU@oT;h7Jo|WXa3iiK z$?01!l+u^MqfzK+Xh7=+!7Rr<46Bmf7KiuP=pbdHGLC6BgU3V))?*k-QQyO;g$gT>H>;aWPCTCoujy&iYhr||{$jYTe7 z4ELO;G#AZ9n$uWNep)=}f&ip*)&{_fWD@k-Vztv2+y*RiY_L1a(?$eIFW{Wh#QF=$ z%SPfr(I#wbgsua{tDGCtHD)YmDvvayIzQa|06fuD!gQ0l6PWZp2>g-GW4IbSWn2^L zOyY*|Cl54FR&K1xdYR#)DL*C{))x#P2&Fv6BedNZ3418El$^b(cvN%*)n{vbZozS(rmHXErnHk23-pCrqEu(%K+OXkalrXPP2iY! z(}fx~0*qa}thi)sX^ql;V1MYAG1?fayh!Ux-7B$#Rqs*ll!;G0YOcjfh1FQ(?6Wj` zMF%KT((g&ad>x~W^1~K3J&*f1?PIkpKXLhEp&HZ|DZJ_ycW`;?$D$fE>i9Tq9n?Ha z$D=EfG*U}u0`6rW55-|X6#aL+w%=-tqI;UKMZK_hBv4?2HeISqJ5oa`G`d+6HE4)E zxf8XHmj33pkx6Ix8+24IRwi*fFAd#237SGLrE~KnE|M%4YjTt9;KkZyk~zet!^2(S zC2o)t7nn{4zlJfW%F#x8=RK1n^Fm<_i`86ho;*Ut>o%i{Nn+TIA=W$(wpsGRai?Kz zt~RAjt?koxs(TU&w#-Ykl~8J1GT^Jd{t{?CxUok6^DdSBFT4~wAEY@xMf)N+5F~)slVoR?H)Va1?f##vnO@r!hJB3Y$9LF26HfrjEos+ET zz_{&HGF`h(28Ym`{5V{rF+*c#UQ=g)E#=gma8Y9tRM;~NjVzqCEP#fpc82yFV5QqX z&H^GGn5k`)8(7QH%6MwH2#SW{S=wwPk*9eUE0(0|9q^cQQ1?vAodYDo4$B-g5PL~; zAcA%<`uRHpma2kr0KB;YY*@kf7Mmyfa_vzo8n-VGlKFNznx|cl*Nl89;BcTXUy~ap zujXrgkS6;KETHNeQ*55lE44~iFYcU+|($)nQGjXGgiMSK5`lZ+izPB-yCe8#+ zns+riUF@m5TDy&}d>efobh&8qbx?X@i+CaAFvtW8wSkgNip6l^d~NkYEm7_lnIw~` zvPq2>P{y2Y&Wc4EZ)avK0>~E7qD2}z3~gGZy{0i6z?>0NFm54#Gd7yv+v$zPGLz+c zFz^fL|L}V1dZ@vfMG3$)qA;vF4yh`=0Gh}snp&Wh<8`zE-GbF;A?6B$2b}3%7yPdm zY74DN-kaZ-qa{Taoe_$}8~b6w7I5@~yHiIa?AEZI!1aEa`uzNd}YSB`sI~8RL+`DImB6%rXR&#xG zsbQV!thhB0_dsb6|;H$unJFE4)XgfAy1sAbh%dRFJt~n zh_^6WT#1oBM31f1;A@`3ZiV8ul&0RQec`9B>{T*L{wnkW$BtKFOr)X0DNP^dv^nz@xzaqe8V1XI0&A4`f+$3KbM@vaV5@k{eQHLEpG zxhI;ysO496_L)e@$3d(WC)c+|oQuA1HVlx6PW!YEp>45*}+SM@Wr z2{L}Po7IWS-Gfjw71h8o?gYxdI&iw`dci%~q;bzogLs?3^n+=TvC87KZY4_doa@p% zE8SDD!PSN*qa4!$T~rQ?^KJ~xutDLh0v)4u!$O-~r|z@WOBHUI?%1jhT?L}7-HGC& zu7zVEmX$X5$Fbju)$WO5qjYk{6oTV0l^8`MUe>7i7cV253VJdmmi2ryUqJ;h9-dFp zE1-Iyysx-pnpa|8RhX0GOt7-PqOAeS8f`hrUgMsvz0k}NxC59a=Ms%lU#0prC;+SW zS`6cCx@IjVHAwO>yk$|o76S~8?6ttYV!E^zIc}n)b=njhx(>UCO_aY5Fx)s_hgI3( z>A3l?x)%x1m|Blnhy&>L?v>gU;#wL65lr3&)DqG@+1cfpTXE<%%w>%`jTpS6;c9aA zdclS0oqL!XH@IP$gvqxa1s|=+ODJk1ILFzvU?XU6e=w|=2`xpb)f?T%JnBxpC^rJl zs@$ZVOI{ig8DH9PH{OZd1irm$Y%ru8l{kx>P3}R6HM|l_gOi)YXSz7{U+?)$r^-dp z$lJBq-NVL50|FOD`M(D`O`%`_4+X%iIx3xk;0vXh2c5!Cbj|BXe32SocdM2^w!sh> zRe#9mkz3r6+5~x=Do){H`i3p;6~bTikaqDP8^ECc++aQ9dHBQ^&FD1_~>ak?z`~jYSd113M;5YbteYCgNSkO(H_urcmEs}fv~}F0f(BJmcf1TVN+8M3|1A;?j7if2s*pNJ=wPYcvDj~ z+hsd1;fch99z;k6;O3xn~u3u?WL;wf+( z#u;uxn0K5fXwoisgpvgvS8(bPB+h{7ls+^k3L^2KgYoCNv?ruqS^fa%^reSLh`B2@$Zy(8deeQz+6GpgM#-*C068WUdMc@!1$OVfMZv6^3? z%wACBE#8arV?ETNcn{9lckOkLrWq$t?=!0%R@L|OBRBK!GOl>B$ylBW)()u*r|GEkz% zcirPGGIEQh#&x)rl=Gf@5XkAv?}3U9rIVhIvL9@%LND)kPwttZ*Mj*ce)N}FFXl^o z!X*OM317ys$#7g-j#o&I98+(aa{xQQPKXmkxuxa^Q&Kp+_HaOW*+CH1&J=ghJxb`J z<{xyo39uz277K<)Q_%1*gi%31?6@AoPxlD(|=OoArJD88$>Dq3OdyGAwPH=ih&IW1H;w+ zC*8N2gfVzo%)L{HhWb7>v~|q))C|ME?#!P~tAJyuQ(zrxRrhK4gaB>11qITWonH8+ z;x%0GO#1$@;S98bu*jW57c~5UZD`?V0iY3QftEvQ#98+P8gdAfyA7nxZV{~NnX}kF zdy*t-3syVQUSh5JR0Q9A4y>(~HB9U^X!~qzQ?XC(48{ApY2YYxo(PXD!?ReFw-;iu z!Uk}0|Nr=EPNVxB6J9?^l@emqj9=V?EJ*$EAK*oFdo;V zTgTYayg_E>YFK+~$OJsYP_sBD6ef5f&HfwY^C;E7DkW0N-|iDADYyybXecE$xo3@G z)awGrl;LT}m5rS*bD_+LCByLmv2g8msJsLrP83`+Tz|MMI9@=Rk=_&Ri(5ED*FvP`O2?EvxSke`_c+A z#?&L6zWmc1t_c*Om-Y!5)XF^EpsmA`S4%I7$=YzoQm!B}7c@x_S*THhj|PY#_aAs_ zBIk3+opX9)JCia5vcLvG91_ADuA#HQIM~xu5O1$dqDtkx;zP^Q1#4;5E9lMLVvss0 zKpYZi>xHSJwOCzh69)>m-p&5{w&L$BC)wB^R|6V?#T@+3ZZAH7&j;;A@_Zomve;l- zzk`^^(<>KOaaFrhJTAZv{pnCKUPEn}ir#{`b61$C35CLtxQ}OXYM6_eXAc*Xg#xu- zxTpqL?$&y~cDMy^#6*irVElY}w0PJu?MzeCJm?>ZlF*k*VnnC={-1pBJRR}#kEVSw z;(Y~oo@==)wEKcD!*Kx@db}~`px=d`UvP!Tn?ZR4es2cmZa;XAAH07fkjpzkoL_`f ze%E)l`1xO;;6sjhIS^h200M^rH( z1a|>m4aFVqtCB$B`Pp-Oycp@|kEm>hj8VeF2W?IkM={C86KC<_aK`{d;91oYA=@R! zI5Juf&TKvSf2{`(Y(02T>%rGt7A&~M$zj(bm^%k}WMhsA6Fr{=BJJGV1 zzy%3n_qa$@n8{=>xG|R%PX>j@uu(%W2%W@Y$3#T%Mf$l( zVxnUbf_*m)n>qOA%d*ot$~73=ylX;79MklIglY!5jIuh5R>v)u#YZ1XwCt(Cplfmf zDlpSd#?F?ojj%vJiJtGF_3nhr9gGoE6Lt`wgRyHf{+B4zW8QR6l$axgc9JDw*k7u*YO#y=*5=5%d}*sbSG#PA-zyWrOj&h;E-={fkK zf6r90w~);_K$AIDG>7H28f|&1*d?hAG^@Sq*9$r4>(PBX|7@x_F6l$u=jA!Y?kc?! zck9u8J8kAwVsA~eiU|dynGt=q9^F7aPal79l{heLPOBiLyVyPKo>uELlR@{k3VNfv zIQg3U0P^m?`{Cyq$8|BP>y7$z^{lv$n+KUD^$@%HV9>l)OWfE)9AF7R2el)|X93RO z2lT?Z8wJ|@lf&tluLl{^aRK%0DJF(JsOQI6*-~tNPjOUcfmbFxfeUp%vuf-w^2_ld z_zeuNP>czC7*HeMC9?N&g5)}7nUV>ns0nv+PPJ`?Hj6a<6CnZKaL)bdL0fmv+zG9H0^s=J+^cCYB&t4Wht*d=|R7Av2V}i{;`pRQ7U%}=lGm| z9NL&J4(|E9e{d^FSNO-_q=|U)Rtyb$0Wg2m5OGlzd->viqTTVLe_C~OKkIKhV$L#?No{ z^V|IVZTso#uX!&`%<)>{#OTH~XhqnBj*7EbQmY?fdejaG~dAjAN?fRB{@v}gqo9KFP zqI9Kyr~ARX{RcedKj5h?@B+^!(64~2S|YRx@BSa~9{&OF*$gkxccFe2=+zvdb$IXp zfT#TjypI7#`K`9_Y9qow!2A9OJpDi5{dBmdd+b>|Gj9_kuzj$beVF$Ci0Dgri>?>r zeWDDwJc_lwM0MATox(BzW5&UkmCi1J{4Hf9HcXj-`>w#*%W=JK#z-+G^M8Qx@?mf? z19iW_8x4Y=X#=}naMxUx*B2wj-eK4JB^wNXFs0T9#3(~_5Q|Wl0uR;w#xi*w`ziCi zwoW$}FbrO93`cKfEb!a23#{k^>1xerJU_>DEo``+mr>gh@I#dj#SXn*2N}hV)cr=W zS-PJW21C%uJ6gg7>{7zYE<6_T9b}dt23P)BSz>{y8@9@Z$jjMV^Aje z!>N7(l1=mvMva+r87-OQ52xCW&<-p=2COm02)l*?i}f|FneVGNkC+W_;eYQ-4z z_3f<(-_d&T)YgNiT^5Xn#S3>*_E=DYjIr2}54sWm<%|^v(Nz5xtWN-YU$zvuFA*i7OHaACaI38!bsSP~xK;w0E5(>@D4ADA5Ezykij=H88BvaJvu z!`tvc(uh&YO~|5%ZoCPimxnIvGYy>=BKY6Xd67R{LuXn$sae#uV^Z_F%$QCWTR_1# z`+~A=Zcdfk0xG&$?523H=Ej^@(t6n!T5_@7;#ntq8SIrOWI4i-`HQR(*0pNe6{Z9 zb%o=$|_biaXJYjwZAR?&bQ(c)N#Kwq*58911Wu_9YB)W}Qa4Pt2O zdc^y;X|ur}PPIAW$byXs_SqDmp5FZHYySb?^dIobe}{)$vDrTYxv|u>%1dwYkLp*~ zt^Wak<3HfrTHwYT1=+WX0}9lZ@Kzbj?f(Ja@gMLv{~dnS6+8bu!WFyx;gmTU=RCU+ zY>0V1e5rPnl$C*}PghJ9S3C9~f-e)4Jw@!^?=1xT@G5#gGu|?8vOL=j$4gKZ;`%Pn z)l9k#~)7FIMH$JL$L44&g_!*i~~!TxSsDKitjW^ z9SQXy`wuuOiM?G6b-#xQJlT!OxnK7ilk)&&-!6_SIH(8nd}jB)?oZYIhjf2e-T#5^ zPtyG#>V8G{AJ+ZcpPXNf?l)*ot?t)p&J9<5qz8oQ36AJ~gXkR9{RYwbSoa(4`b75| z?K(#H+#$xBjz`doqk^NU@(vtwe2O@}cp?0VW0|@;u*>)iFyFq;ye&GOa{53{gDPpA z{W;<=Q-7F*oviD=Ai``rad}wq7e*McDgbvzU~sQ^BQ82tPDN&4URF@;RI#u7D+GH> zYU=#__0)Bmct`5j2>v$&{Kg;72&glP-vZ{-#8TlH&he)~hf*fV>-Z+Ry((1hu~|8um@5i}utX{eWlu{Ad0AKT-B{G12t<8Fk)t z@hTJU(r=t8ZV{%bxp#?p&aeTB-)MR9EHM@;bncB%3aFYTUI;KXM$nZNmISJsExLrC zRbh@exGl-=ijiv0gJMG<4LTr3QsK2wU77JP6b`1*2M>#q?NzjjJ5QvF#b5%nj$u6Q zkBFlw_K+T3EreIFXc6htN5!3}%F@N+1e5R^H9js*&}#wB7%>IEOP&y)@C3z|{mMpC zo))3w@gU}H&Jxiq{7$zm0jG^C6O%guMMH59v3!Ym0(mZYQpA<1X;lA|$jX6eS#t(+ z^!R1B2iVn%PowsTKdD6g-XvV0Yo5iXd+k=IXaRs@tO)}5L*qV*1jTk3qak4SH&(S;ZL>e2Jw7=mPK2t z7!0-9B|D*cpHV61=z(~09QNM&V$gD4!X7RoBoKP*0Gm9o%c20DxHv-TzeU{E_Aj6k z6U9FU)8AXfm*~RxqKm4widnWxfN)IQ1lt*dX?r^^45q&!=3#%Z@eQ#H&3GMlb{hKO zNZM81!5qg#oxARDB;)M>ljY`ZKj8!yd+Y%)4SMk=Xk=RJ5?s^}5FQjPA=*`NEYKWS zS~AHw?Hefn@Vp)b$6rRZYv4Gudm&KZjJb;j!Wrun(eQ?(dqgsS{@ohS>vFtm3J#{iC^Rg+;i{_mqWNLYAQiGBhQ1; z)xsc$Sxr{aL&7}uh3(=47CbuN__o+x9ll2l4WM^^#PrB{1$O1dBA9ZYG-*ZRgGmCr7>%j|(C} zYleI*3N~AFc=jjQ8;+;clUR3CWYJ19ta2oji&CGDkW$k*DIBJlmd!bg5zjpyueL@O z7+i+4vIefJ9CzQLmLCIcLK~}(i{Epft@})TKL8zDdsK#=<%hUcz2r-5vD4{=FL44l zvotj1c=U@>%+*ViVL>Q*OmUTFQ6m zcl!>!A^h!1E0hZ?A+bUh<=+S0*omjYtPXA@FGM_5#=>1m!Z%_8`mg94tQE_VtB57UoF zmuD$QizdgnP&DgG`QJetbg=_&s2=)OOrfdo;*Q;h^H9`{JSisAobFMPWFL!B$~g(> zoZ61DR9PMqRN62d;;6My)GYo9*jc^}F=|eVX=Jubk>vVL%n~}Q$QmZSBB^4!S)%gq z#qqdB(-;125V;O|<9QHZK5h$cGZdc|%?fvn-3!K8!91VCE6h#qo3S#u)`J+j zel$V9`8@1(&EJkEN0w~Dh4AD7;nuh`BvP0r;?E#zAx0)t5`Y`E#yiT-Vfu}3jI&eKIgEQe)&APS z8Jvb(>QQ_kzHZ7s2R5k&h1+;BalwJ=o<-Q!bI_HHSC==4)7x00&_S8BIgVd>`yKRI zz5t*pJ)GL7nZhaW4{^RN8c{fFsAhKqnW{=<<@JRSuw@MA|6YoRg7XRiRN zqi*jS5=k@u6c^iKjI`>dKQ)p^Coh7{Nv4WIWHs>;x+7Mdc1c`l65>1ryY9Tnywob4 zvUSvx!fsYFn*|r7i8Q4LCP>}$;V`N<49I5x(1p$tq%tMF9LPa!HTm?R*@+x#idZ6Sgt;vJ-!#EfZ$oOBBd1($*qFi&3 zm1{V%pI8qfQF#_N9P(nJn>^?S5b(+lSQ6_RE#^3;Xw0E=g^f+Ew*GM#Z60D}OT)SG zF%m6#AIigd7U>X843r{y6}>l5x*Chi=0It0fQ=JrxJ^YxAcDnhrA`ok?r1CB2fe4% zc4!CGZ}HKnax|43hCT1%@))x^BuE-rnAs4X&5d5tIFnN0R;P{oP2>>DtqpgU zmb2B{wYZv6IRu7lmaRd{%Ec&i*Y81Bx$v=Yo#A@Ju_X^~6%)}ha55Ykd&MbnB4Bu zSP19arE)=`IENGuEKM~l5pn!PyNKE`{;*y)i_Kq>}d&kvKHpsd$X zxyt^y>un8}Qfx^EzEWnmv`Sk-V_+}p$}-8{n>CUdRAN3%a4YdExb6uJkC=v1VXLWL9*kIL#Iyj!*rD z?}P33XRBf&HI{=K>O;(ecl{YI1k#PM(j6cS)v@TxL$|lV1)M?w>tZHu&&)0@nvD5+ z3K+8_PD-Lk=Yl^j1wPBp!=^iCku*o9PSf`F?MjccVCQ};-^d3>92wfHI^x6s2A z*wYh8b={>!)ag16(c?3Ks@kJlGR~XvL{v{H z$Ykq-I`BNdn$Gr?B--CwinaCC!_qlyfUTeI?eB>)J`GU@=wTVOAWhmC##~1R9CH=y zm?8&JbrN6H>La6xpgMSOW%qcpHivo<>>PSlEM>=JBH&7rs`K= z5KDBBP3=cy0$=_9NO zT{tq_Y&3)mVS1$%f-mnGxqyL@^x;HjIHhgJJ@2}HQfQP>976}`#q;Eo=xje}f`=Xz z-h&z3@TCX?H{pz4{iP+CWS9C&_gUUXNx`)FYV6~)&c#}7%!e?;c#X!ms=EeAF0*j0 zXPIyK8CP^K48+nsm{JExn*HqjL}%Fu?8Ea0Ng2Wrb@L$Un8`8}^@uGk+JI|+aV9Hm z7%Wu@*QqmyNTq@>jD+hjHp4wxW?YAf05jakM$NkpIYVmFI38?r=O)1-xdBg=3_i496Wb zf+|Mg8r=2dn2Dj!YiEg6>qeml!6Q-QG(_-hcQW6@HJsu*!(_@BBaJqwc6|GIb^92p ziZ`Tl$4k?7`I372M(I5hwm6$7N`0ZG3u@7u3U3Rxs>zeMK{t5TFj&P~VH;%>LzAXs zFP(7<2ox=zi!rh1N_Dtn)|iW?jrD9Aas~rq>h28;qOG?|8*I!a0yV*N<~}UPsEZ~` zR+BK!!xiUkf`#bH+du)w^Dcc0M)%j-r2$&M*h(9pfz;+|QEj=4NQWnNp1HmS%76Olg&nLx_w=!R`W5>V<{Ql4fY? zqdfhY|KQpg%eX-ja3_2gmT?ZgjT$%OQc|6Q&G=dun82LZz)dvF0@CQ$uUzlP#**uI zvpI^li_9A_I^^m#VQWq>h1t^?v9tlSqD}$YRpm)mg%?nsio7XiW(Qs^;jKOiH$RT2 z)o^3q&z%o#Lm*vUGTyr>{)lhc``a3pPGkh=&WI z#vTwX#NLZemT$$*qvljcbMQ#%dPo}YU{b|7 zr@`@W8`ZbLwWZ?^VG_-!l7-;@=Bt|*O5dAxQAIYPzbh9@L1^yo#nL#9*uiR714IeQ zk4aX;za#*(V3EnJW<4hD7tpCuPe`LInxKN&c>@9UJFvyYK&zotQ4AJg9-a1lQcI+- zz%V$TkvwveK-kg^i=i27Ot|rPFSds{&q!+#!B#3w&}tW0T0IPRG)tw$9xpk*2mxNHv6N}X`3teXHG&};s+;8y6h8AJPS@4U= z`$Mc(|JO>!BW+BDJmlDN9z!?ZgDZV?S7R2PIUZ`wMMRC3GK0x9h{d6tl4&e=&v>}8 zaJ(*h!w17}EM561f%g|_a9W-5mEm|u+fd`)aAz|L^4z=|(Yc7`=;SEwAZe@YY=F4# z%^>_1$-NuY2<;A{iz}rd#~lAilqp(p&FBO!beCVkQdqvjVea`~UBorH2RZQ~(p((z zgS#~GpxdgZERzZY@fIg6xNzskU5j|e1iBaLS{bB_^A5Y?KEMn@<{7}Ve?o4!3DYzq z#A=QD$9fUoGX@vTyR9lG?RN{1CMk2aSkuZvVO%9;C}N0Ta~ zQ3AAlDll`$QT?zI~|@1c67<8r&Gj*=B0VcLBuE zYb+hf^*o3)`1Dm+`-5&3LQAvoI6}h;YBU@4?V*?mHD|Rn zL=Ya-$h=zhGInu>9fryfP`@>xeppYL_lG?sO*+o95^C55@o4foX+O;w21^RAuBc#2 z5u{VDSHT+>q5sk_2>Si@!aUeS%z6Xtb5@g6VZw_v;rj|0UEw@PNc^NVf@z}eQH zfo93=5S-N&6*yme;UE{ZhVy9b(lgE_jAz*iHljbCGYnehCRFTK9xd-su znDFx`w>u8B@)YpRt~bH6Ok5XfRU5XUrr54tQl$cn8P;c~TD%=h5k?{IP3Z^*4h#ea z4%e=Cfdv?%7~#tbHDTwF-@!U&2>?d-7>k2O zgOHd}`pJKRhXXzqj=P@!(%?9cCn&$JjZ=G*Jf}aJL20=6=xo`sFZo^J%2ifa>j}Tnh|v=0$_y%&C#=j;GMh48*?x zr=_E!8Y#x%z^y*+OU{=6(r6=+o0|Tj4{M~W9C!Wc3(hHR{J42NXd3=<_<0^0{%7DXEuV`^v)5rPDnF8}=6nQEVWS17 z8DZ$hDMu3RN$J0N_R!2%8cBcuwPjyzgw;^+5vf24QDGFyE9wh~Iu(BJKFOn!{g6w( zb3}>^9SFGhFt38804m-tgvQ1B*%0UeKhqbUHnHSBD#i5t>1W^0e#g&W2|q{oE?_E5 ztYGfLcJ5KhnOz100Lh5K7{-6K@bgG}SNC_=7T{cXiW{x{QV%oYar(D8tP}>SdVYmm z5a9FnOCq5DVHpVH9QiMY7JMwtvJ6I2Xah_%I}@3|1%B=zH{3MZ+y*?_nOiK@xcM+@;GGW}Ip7(=Te3h(txS+$s;lG^DI#egAl`jt z)>C@-(Dx|m3JN~#h>0qNVF>Sx$HUJZh1Y=I4sqH#>0X$5dKqR^b2@~YuiAIkQvyem z;JEc#I}pxcEQ2vh<37E#jqW-oB@{fR!$pJ{WAHWJSoJP`pYAu(BkC1)pd*hPlTIVu zI=^(!z|XDb@;Q!?p6hj`Cw;;d-E|;WYQA3vIeG>`Hyap`}KRD^Ni?euS#(#=WEo*a{LFCwWFy? zfxWaJ;fCz;G^-zAMs5$EMl&co61rcmUN{FBzrYgIk%7Eq3}zs{20`Gq$*1Y3?LxS% z>6EAMlc+i-&^hUS-P;*ajJ#h)n0Hs-3_oYb^oVQD=)~W2I8MVmk#2rzzQ?ghTdGz= zo&9*h*aok6mL-1vNB#Wc;SWN(AgVo*6j6F+p|zloUlfa<|5H4K%(ddZlhKk{2;-V_ zR@}1;H>fDr+NGyqq+!@~a7Nn3lPzfhqrX0r9PNkd5qPNfpQPx|rG!3%^f1owr*D1R zxd(nGh|}PB*)NXtbRU~%xq=)^1D!KpK@#o;*K2+$p2ZAmz0cgB5F>AbNUH-9G)tpDF1{MQE-DE#L3$EB|C>_tGQ^S_8Z{mY;N%io23I+i_}S50S=S``)N?i>aAKzOMxlKu=?f{|eg3ParWpw4(dR+B6OMa) zDSA2$-@B>g3rIrde<20g%DltkGhaYbZicZ$bMH++823;z9QOwQjfJ^G=EDfdy_+pi z;}=r5elG&d(RiG=lB3|bl00QTg!MlT%Yx%CE2uDxiz)`JEpBX?ootfyOUc=%R?o?3 z;^(@NK<~<2Kpby>XV4XxbbKMeIVn%ioV)ZHB;{^chC1_ix&D1l|30sOSLojt@b$)w zNWEyT3jh60lg=f^7rb=B7lEFF-@8lZ`oVAU^N;uQ4}+ik<#ss!^5_};Q}Ve7#(XNn zreg%of0y_$W!2$ia9KcTknQWwJW+0fQbwp#7^E((lc0q17vBE`*UJnb{MFdnzJ5ay2}t5B5DRV9FvJsMl2?SET> zwC7%U5~aYD7X;47JK_8&GC$DnDA3F2yk7WNv$XKPwh)V*lFU>-$!zUESC7D}!EZ-= zS;2?l_a3jVe*S$Q;eAu7R~+L6cV3a67Z29x8czqbrQC44v-AGLx>t|F{qedU*3K)e z;4r=RjU-0qBaE|rNQd#(W59=Kb5(KM&;p}XjQtxwxV)z(qNjKodo$)Q0{Jo!b^(ra zW^%+O8>R5~Q8?~l?#e~Tm%}E)@prcVUCa{;53A+}I@@ww?zj_&=<#o*=*<1^UtX8z zbp$cy6Sw?#Kcp!{Ixgc8s(;_?%pR?K8F@IE$qs)X)4xyQYh=e&eRj9+bo~;31Zz#< z;yO^jlhR7JcXH0|IXM1q*1uaR_ih~j)oo9(7Oc_3HsH%easS7|eT}Rq?P+Q{0ypxl zrlw-J-{4kOx8UZcgTC{1HT>RaRNx1{!w-JV!6uWw00~i4@tqXWFUT*-sso-PjArma z@U$uL3f~Gp!(&SuJ40^yJ;c$!??*B!8q>~s=SCg63SUmm^z1bT>wfOHhv9GM<?=O97K)9s~jM6%&u?ZSQSxdsq1?%)EJbZQgJfpwK zE7=M?>~*iOSqSs4-Xz`6ja;k8<4y?I(;8)PH7>p5Nvl`iruEid1XA6Q$ViG!5UiF5 zI1Z)mg|f+_Q5FpX+|hg!kQMm7Wkfslx-aab+WFwSNwS`dzN#|u)r;}ty)cLcL{&_LXSEeE!H z7jU$dPG4M*cG}kHk?y97KP1x5^`I*BQ$&oW?PQ_GZIF~KyBa!Jg?~acxt6m3l6K~< zLn@vGH^Z@g*s=KXu>mtHueJi?$-uDnt-zQGV%P?67|pyWO-7q*FXGq?Z&O^7dKYZ; zitr!`Wwd_;j{kTw!I`{ET72_=v!#1@7OVDAJt-y>1ZT7%KpG=wO;!I!nPDn+| zEwIvfNt#-)#XDT@A)_K&TY(uBd7~AWQITz}z>IpRzA#$2+!97rSIRg!+$EW}HA$f! z8F?b*PH{VzCd)yZ$UKpX@~{c4seo7~ds*6wAo;`as2%q|35^l zd=E$OdA}jrA-kLwe84-Jirm@=c=|jlM4pbPgBwHSZnUHjDr8w9au4AU2Xwc6fFwNT z8Kt>>L0+BmT8!~&ryP%$gl(a6f$cCNq#?p#DhZYQDmA)yDS|K#wvX_@HAyaIpPN!gD_r277qt-zRcG3;C`FkUnn*5D1J-7dL{QO8Dah+iFl_J%cgNvvAv zmZ7e4o*q+xxp>ZXSZv?2eo@eqfmIppF<$0=u7%_2^b0aE$fI^bLu^^*vS`0v7Hx9~ zM2T4s;`p*EL6&j)RMa2(U4?V-DCpcdW_%h6wy*+mJOJeKc; zzp=KmDojNZRDmW#XR{_lPO~-Xoq3oXnetnxVQr?oCWPPkV?u}0HI&01=kfo^y=e8d zax9G=jO8lr8aahx2g;E&buhxR2Fg9eHh!tBetugNU3rasHPs2a;_wR(@$);iOl}AX^$QP+qGzr_`f$JS2tR+MUWw#u zTm)sPMs~hNd zJz(1q`GiTkj(45>t{zr41f!Jmni*^MFgZvA4wHYjXbOZ>J5g|!x^BZf87^;U*sCMt z7x{bL^`7q!`uFjX9)IU7`8O?X8_K>7hn*SOa)Y-&>jt^FwSsX{I!dTJFf1-aJ~qI-KKhe7`uajh1_9 zFs7+~us;FA0Y~Z>*~!^lJ4U`5-Xh&w=JD3*-tRnK_gLAfotJC%q}*R{?_&RGOn{o+ zAUO8*&`lV=E7YnMj+OIFJn_ea4D_Vb8!_<<@#>wtDvGy6%v$l%$h+!rIBq@2!%gz+ zB%at3yzF>4!63Ha&P*y303!_dKW@^9O713HqpG_}4n=Xl-XwR|NE&z7KsY98nB1N# z9F#dhK6V+{=w+x%Pm~v$+)>p2O}w9YXd*~78ZZ$J$j1|La+fPb;3HQ@6ZPZERb<*D zA)IN?066X!4wIwku2%xXq1Y-}}iy8P_3$Th) zKJS&w3cZR|cgVv73b@iAacq3~kNrpd{73!#AN%<~@$(<^^B?!~f7;?N&;^yrb}rt6a!bx26;>-VG&*yJUUyxfFR*T1=>@4 z+CZ{5M^0vyF70k+%Dv!1lU3n9P;`XxO*oS&nqHiXCGR{i9bavwuxOCFT> z<0e|w8gOA7`0icag<)e_cc*e49vHWez&t&TKm0{)PR{ zq{roNcw94=$fGobFqM{UivjN)0Y%#-s5$P-KPj&=@=bdRb`H`h`zdr>Iz9Q69ARo3 zO?SPjh_wGHZP&%cmpzTek%h2O#D5H%u#~4Er9gK-E%UZZkAZz!OEmZ6h}PhVCKSu# zTB1cpX&Iq|4Thkdjuk`cg<^SDaFFh0Y{sLu67D?aoK-qe%^HYsb4uj#$SZdP@Hi+> zf!6aJs6OvshB0k;PKJJO33rZK|BSp|2o6S0#xCbED(M9=Vdb-Ox+e8bqU_00PBg-@ z6r166N?j`Vef-@-huM)|G*`@{A7E zm7%X#+%8ecJLm*E$wLfS9)a)D7T=C*u{AHqLwKe~zbM}Ugu zpiN!5PR`K%^}{gNYc^tYlQjaOg1VWw)9QLv&aj0V_3+$eZ>Yz8zv5Tr$Z*~_SWzCA z$=JaJ2?M|9Rrz+K13!dy>WuZEo-5Vd_3}W|Wp~3$k!G@)8Uo)=e!p?2pCOHMvu3{6m%juL`DLXOJxqCp@^4da;xA+P$Mv9!VFj zcLmWesj#!~&hOCSZXhW9?s{Gh^3uJn$ITydU2iknu0cI`MG7IuY^b0&d=5qSoO0NW z$Qulc1j!lr?^K`@o4=`1W(QY_|6Fh^_;gUoo1uE5;@4%|PEW&q)vSAA94D_`2W#2u z*s_-=5gU%w@K5rhL%o!YhZkp+W(Bup%GY8<3d=aip7ruq<4>u^vdoXyzpkNPBj~n#;Dx-x>px zhQYtM1*^(Rn!8ngLim;PcSNBd8u1#M>q~SRUdS;=ac^)&j9Ci4yb)qQ?A5%1g`mPa z5flok?hQFTI9$gUzSD&VwfK5>-Pd^Ld-yiFkg@m!Rh#1&H7sV+VHTmVAktjABoV6E z+cg^6XFKvf5BoV7T{b?tLtBf^?vQ7rwz+SDTKuv)JhZgtS`f-!9Yf2;MnQMC8uu|O z-^5~cp3c50cMHQAXHzFsfcI@(;P`JhrS6owmo3EvY#19amo}8bTE&~POgVADwTuI@ zIm+m|^B4*K&7_sH=s+dgLYy$9fin3XY55~Cw35@A4Uw$C<9C1Wlpm+H_1KV>?~?PN zob1>QVmP1r?Z%3a?bL4h4s9XYEx*RrNqA+(Gmx5O;KecYwU-RAc(& zQ%SWPV~cK{)^AkH!=hg0M#AxA<_7aHbC``X=LX`1hPSadWPgO3`!<9j5JPCKsN4(L zgT}=Ci1#hEpmKiIdB{F_3dVZlKKYy@&L{~T%2~T1w}v34>RmZYE0*OE+|T@F$3^Q4 z$Kpq1(4+UjdvxT?*SNjWoUxNR$9O$|ek(PU94ai#)pW+yle{088tj)l#kss=AO$zF z8Mmo^zdQ_>)%Acp(2Ky=UxKc2ULQ<_8a8*3l7{{(oP>9R3hxBHuRI_p^SHnU)7Kd1 z>Vr5_aeLaY@g_OTVwe{i@jk|XKIOlU^8`G_HyziIJr}aymt(`(*aXu}u8q-dUP2Ce zmXJeW$nct{@S!~0BB22|BcInXLM{GKt`tz+%o_O)lK%k8Rn=fIVA2sl)mgYNsy?SL$)F2B^-tyQIt#aXYzK_Tr*gTVnY&;d zX52OI$+lqFh|gui+=Xx^3|2@!hiF~zm<^xHm3ZY;L0eB?C()IjJb~VUdF2z>i4@R* z6JTfbsKdW#W}__J2!XQu;_laqFTg~47@lAb=0BEl;kv^&xFV7Ar98!UrO`H+(P2UK zmsnSKK>*mF*%RoTd?ojAu%G+XXh#7p{YoCFc)w%FV8(}TdUl5e4?iT8I*P$@)S+3U zD6URUv@r(pX@wi+60or3Fi3AkVI9sJwT%FdU+X|Wu#(qfO-P}lddU7$J-As_kCDF$ z+H&$pTX(%UU5|43*8ugPnP1Bf!20&-uaUNxY~RSGLzhA|^+mWFzHMqc4&CoYI6L&o zWw`6$rocT3w-fFZTrxE2r@}SDeT0hwKm5|vl!2=S*U`yuAb`UWY#_Miv~SVxJ!$#3 zD5w`X%nI|UIy2k&Ef%Ylw9%~eMmwH7DHmwSVWaGWa(7DJZf{Rt-rqh@9sixY%w+4W zH)JUNaY|N^3wBswn$<5(%fkXtMABLLdwd)}$;aGjMqGnz>V4nG2q)V)U`o2$^_=`o z04~is&dURM*O~n*>e-X>`BOk8zoH>m!`2bdX(*lkRW8N4z2G-=T~GSsH@Ua1ubv`yBY?YB4D`pB5%(^O{>y^sPHsNgHN@b8RSq1&mjBB~g>%1XBH@Ftk$GUE#;T`3-EF76Xm35I@iz#=;Wb z&kcp+Lom%x+3!Yh>0clpd}ijw#NgxZq1=K`Q4eLdW~#u3=-d^oaCQR(b1+q#aT5LR z>Zw?hlCg#2zrk?KbTHG$E9vcMJ6G1I1~iBJxMQ@p!8KkPApSCVEfw`tW<@c3!CNaM zhdY{k&(=#>sZ2Gze#^!*?{G@Jhy$LwUKsp4jc^ZZH@vs9T9{6ay_Ipoj21H9b*2%` zFWb8i&hwdT)eeKL@MjvGZ zFCb^HRwQ@6k;<<^cN^i9+7}Z&ov=K{)9Stoi|2Ot1u20=l5}O3Fh|W#R|cDG_vi`M zQgwf&i>}F;dpORi{ai}9hhRw0H9!gCrFH zyAZr$kdl{rADUxep}%V6v&e!u-TM&--KJscgVgUDC8A(1g7|pUTU*l5q@33ZELG3y zfmUD%I&6L`FhhZHfiKLX<-{|X>-V5H(4%r_zE-)vpujsEtmjz7P0`a7wgO`gp7See z1%@CE_E0M@L)&MeFN_A>Y!4&*U}b*6B0!pZ5H;aB`Uo8VT@A;jKJ1&?r?!u@0yDbp z(Nz4%fTQ7{4c4ff*H9(hAI|$dj$WjNyCA7e>-h zWx4RQMofaa(~R{(<88WuiNT^6z|$&hm@>{?jMN4tF-Ra&$`T`-o*br}D|p86`py5+ ze+Yl}AHtXZLwH#$;k=_`H~oq$)W3!+O9g?bR0Xx^%HUe;NE+@T=J)B0x)4!AfxDyf6rjvz2s%i%q!! zRC|R{J9_K}Wq|30XzKrYy98>uK^bCx5irWDu()XADCHgSQSQ;o1GbfZ<&0KV>$Zi3 z{SX@D9SJns%A0eADtW{+H$i;zE^eUK9Ef6JM)eqFWK;#B@Bvx?93%NlzS)-d3AC4H zWt(aISY@JZl@Cy3EKZD7de~O`gwu>W@nU`YI8a!$5nB_9s%AqVmp5JswY}^c6AqF|PTkcpo!wivqU)YXl zxJi-GG)>zqqd&-P@oJW>PEcfxU%>4;HkCPlf@0PEsbPr_TC9Z`#|;y}!oY&}1Z6s_ zr)AGikf`uxaN1y1Z`Sz2OE)XfoTI2)uvn~BN8F;|4nt2mdn>kz`k7?-EOzwiYWpz|d}w+mu~==J4}v%GF5K^>%QwEU9e^ zqny~&XZ#HVF2%QNtZ()0%J=&ACEE$}HHYp{QfwQ1^UPQQcE3CXVszJ3WxJk}AOyrv zLk;YB6#fXwWyVdA$plT0vtsp0ou){R=50PuL7TK5E@DMH$jO(TYKQ)u2KJF_rEzCe zKNc1qYNjckNAm)aY7iVt9GEC@98WHd)0Ej^&B+kVbi)Ihd#5r%TM#+*K+2vF0I~a> zisxJ{f~qCEQ*}*ODuv)z5y7A!?P296&Z#!cQ05D^je5%s`z{R~B1?;(fhilw4ZcvV zz6)%g@S5k4_f!sAVb25S0rnwJxdQ^``Uinu8TmjfY_{{k1VVc|UwMmnEO%q%a6UR) zc^V^KF&o2)=(917Yw5{3%0hIT;~soG;sYMM*X~iq>Wpz}CG2~;?gjtl5vQpq?!_{% zdkCJjRGt-MEiKN&&Mg&&J8JI7;NrA-F7iil8|Nv*9GlQI=En>g+mmb$U|TR>O?p7- z!06ZKLGV6C8`@x(vHwA^Mq0oVT-ID{rwR)|xL5>kLQWD@N4g_u`-kQrN-0zpBaa=0 z$}ppnu|?PjB5c}2N$}Z0JVP%x< z_2!{T{azVBqaRU5)Anj?xwbx{WLdNkrTSZNdJ+35<|LyZOoQwUWA41)qu8TvrHV%} z1_hM47$?~U>WzzeEa$65k6|y4@@to3?1CQ0?#5M$TnnGTgw;b=JO-IZN@*Kdj-O>! zW0xqEX2@=l5GVbmN@!UbDEGut#YKxta1gU(vI~}kf3XCWRxZXtPbv1~6HAmFlaX6p z8Vrn|C{@z*05#=VWomN`wl2knUMu%e)ZD#6aawq{fjvnXXa+dcZxCWaUzjPk8_t#N z?NMabUohxdQ>ILGzX1qiHqQv&Ve^H4=H7U9=6>HsBS@n%jcwwcU71d+M!)*)$G0Qg zSk^eVt+bC6={Em)?Y)iXLbR!f&eueIy5BpFAldD~(vDJRt0# z#%0*s;SLFZc6vU$JfGdnG)Qbx*|7%|HBx$n2HDG%L~WyFRKlPUi>O`-iFoE#Y#&sk1Or3mw_?r6`vhkj zHRVdA+VGqbDhO2?Q&U>?Ac*D)Wky^zvdcuaEZyMj--h4lDqNkL8U!;xD?pm|(##i> zQsEsYF;58l=*btA*`OQ3N=#L(*DIR`zfo<&N1P*8YHAs`tyFHY@s5=De{RaW4)#bI zRw|2(x-N&nr`fx--V{$672q`VS-rSIBVvvx5+JfGgw!kRCG4Z;Q`9OYM!Pl_hFrO0 zxF5Msxdrd~bx=>5v`XoQx<0uITbFeDV-<$5C*89e^iMBm$jjKV>lCKuJ>a?iJLMIK zR+y&SsCqoEl4ZT3txZL*Kp55&#auyWm-C^-D>^O5(bNARU39Hc%$E_C_l%CEeruE; zwOqp}Tf*sB?3{22Ef!&Wr4yU|%~2PuMV~{ux=th6`RmZxL#bpPX!=&#{Hj7Y)&{}V zes2LJ_ash%t2Q`e%eGi>&UZ0^Wd;@Nb)?hQGgR6@I!FiBV{@rZ<`{+N4`Ztv&X}l% z2!K~SMhZ>)LcPq)=H=0tCac3YGQu68+}A+RdeURBX)>cXUQ-ro7{UCQoAUdFM}%o) zgS~K!C>jFN%uUJ`#;r;a$)W1QmCBC-)cf*Z#}YM^HovYsZ9AxUR5%UYg3O1~JzF5x z@{rt(TeNs*w(C>0(lng!T4&&O9M5$f(8FVobm74gS9K2u6av2Z(wBB4ji9P ztOBm+r%{DfXa{sAs?b`f<5wx)!zlQUYL=_1pH}lGMaSiwS7WVZdoN4abFY!G3zhFx zwg!KQS{ekwPT4yl666_xe>mi?AA^ypv71CC}uY_tRy*v{bD|vry%mOTe?<=KRCJ-4vj0r#gka86Lo&5o5 zqEY#}50y~8pzMdBl@oNBSszdDWE}=ft3OqwfvyxDRxS!P9>lW;gU+p}QKlHwptiYP z?po!2Pg}<6rPnTxf;qesI5nR75yk*bKMEu)?t@Eu4GlO0u8W5CzYQNLRT|sNjo`*G zmHfzazJiC6ra@R#(^IgQjZXk-y<)Ozc|)gV4mMeZW1!1%=7^E^6DZ=zqgbbpP<;_d zSKU!G>L@urR#avU4}PpXr=`Zl@bhSM%65xcE&K$B6sUIfG36`mw6FOjlWJd0fF=Ep zz!(;8v3i8q5WF5&7V2}j=q(&S+gD=OQ}`*SF2tf2nHjH3GON2jRrXshYt_d_t2W<< z2XQho_;TU*NiHf*Pk%-f_wlAUSn!*dy#JcSQ}H$SJ}ekbp!&a94d-jj zV;?T6z7joHehjRZGk#D;2lKX&|6Fi^)VKpmcU7=%OnLV}!swcV4Pez` z%(j~UW9&-cqbiaB=0aBiHLw)69It*AyGgO&;X*KfQf*j3nWoI z0S!jdpn$@MsGtNbx9&hp&wV_tuG#hENd%?2G~iP{)! zPP#V7lZzzmCeA0-v^|I8`y+7PQ0h-mr}(%MBA+QH7VEj9^i;H$b91l?_H*7o#{n$s zL5qIGg~m%9A9GQdpDW^M(ZNSB1$d7guV^(=0-?GiXfKW?(fCW=Ab%qKX|(46hKXU# zZxa?G3Vwy2M2h{ZRW!< zt=ojlspa_74|nwbq$c~#K(>YxmzXJP0samG{sAX9$;l0bKSt0}U9)4B+cgsF?D1mz zKQX}7#dfE5p8rOyzHTcwAcl#ARQ1OzB%3O4dyrs_`ZFy$`R{zn_M+FI(ww zRn^HdwB*z`K2sUu*oG4|JNUh#9_WE1fDR9}13MeS z;hBJ$e>+o5IZ7NuP|s)B2*JWXEiz)Yd>pDVK32QY^BGu0v)O^re)x8a`n+e&q~*Qj zW~rJTqhYlCH8#%iMQBJs!xz!Ak4O{io(!am$^@;C(oz_7^!7P1P<|yrI}bf|MxypF zjO0SC$r?5wd>O(nwU476Uxoa=G;9F+THqN7Ey&bTqCs5MTT8~bMzyfD?HGvFv4gi@ z!hLk78+-QWc(5o{(2xZk`b-k`A!cCMUA-22Aa|dReOFD(u@|h#zy`(AS8#lhJn?wn zTG+Vuy#SllmpNLlV}Wqoi!V~sb2X!;2}j_zIMClV-HbWgm+NA2f7>jF6Uj8(kPU^> z5mnvba=JJqi4%nZXxieDUSI92>Ao7@Kd}k##_n+rzi4voHZ@Cs-D{F zjq7r?I2T2st9UF|;~-RitV@1}f7m^zJEnGTXXA9;JgpeY1RJLG>~F#v0Y$1uf8Sc{6(9CMmK&8(cyo6g9qold4_TA2(tBCutD*NJ~iC;qMQ4>LY=m4_m+V{(i7MVUC^Sl2i%W!_4@2krlo zw;wu5>qq$8(-CEoD0-q7Ca{KfH0r0G;!SU6Z!{ABDcVy}KZk>u*u05ZkS||T7A*Ac z&tfEBkgqN9A4Z&s+vy)y>wFJCjzTYLIwyv;P!+E2TzYw9mnHrqC3 z+0m%GE~)&s$(* zY`X0r$b%s72Zc2s?iRSa;2wu-fcrPx7jTE+k`W{qZXDcH zI9TO>aMI%EAEmw8iIrH68r`?y&J5pZ?NhPi2yQ-0-v;5_axXsMh#Ts~3DUQ?5=5UL zu*-XAIj(3ZW|!XbVK#0d7^6L;hKBe|V~IZy@{Q9l=pG*`8Ly4ybMv1x>}0xA6yA?U z-}F5c*1ic^I*pF`S%KP#+B(Odg#Q5z_dj$`O$aqj1W$3f3lgs^);L*fYtz`1-(0L! z#3Crp_u+oOtEX#Y{p2uzY{3+S3egCx=Xa~_Qt*AN_5?K9_8A)P_{CSET0kr~Uz>vW zUFU1(;^CjEUFcXCDxawdelG8st?7!8J872BmNa{2YxhDSFTOxa<2SQ6mufk9JXVUb zEfjl7waXmG)x4y5j#dh<`Z=1KDfJYE+q%NYJ{Kt_vL&10J~6ZsOkkfVJReicR$G2 zX^S;%pDDwTcFJOH^hxN;8*s|r?lGMDC-z35)tF50TdYmN(GS?L)$$;0$9wOBz?9zW z!_wFi4VIGeqG37u(aJLIH5#JEFGoEoKLI~5Z#je%ixq4_sGE|7UO1Fv!8UeJ$D=7`;~eKs~ULa2-NhJ$BZ5 zyh8xiQt7SN)?~=Dw@|_yI0qaXN1H~cu(Ku3xK*3n;Sh|epki;#fpUdtxK-o970tJ5 zm-t_YBHoXIJ16>5ti_DmWJ_Ijn|3*Jap*QpZLP}Xhfe4ls-ccMicu)IK^x|da!H|h zpl$JNGy}k7@S9KdLtfmykenubcWDLG=ZpRaecnSXxJ&a5q$ZyQ0oe@qB3ux{&|`>Tv@s7FqYBif2-3e+#pk{~Y6>>Ib35 zWJJ(w&jcWq4?)SZjvv2wH96QERpeqBrAFXnK~loJc03=8^sQS^+$Moc;BZm z703s~AC433Fij{#6yei`4AJ<6mR9sAWQ*Q?;80caHyBf#pD`-VgQLM+e?N$MiKy!5g4N3l`T7hodPH+NP3k+exNHxy&T(H? zJb4V~G&B{C_qy4zID}~8;{cukZ*C#=riFUdYuh|g@oAwKpVuyq^78AzWMCKpPJ7s; zrTJ|ywmK;dq1n5%yJ_Y;_M(;t)b*CPTBM8F9VaAE|U6agnkz$qQ!=q|88PI}JhC92;@cUJTSwyhw@(lq3V zjyX#^32vf=OFs$jObeHB5*(|NarWwnTOt$dYauf`A|o-`GBb3WeyViOw%o`T$(6+ z1)A^?Q8gCdg!2*{@xm)wbypqql#Fc-(eJXrh(wN`X%t{-InChqRZaL;KqTwjx;rBX zn3*yVjx-b{2)2Ab5^Datw$|Y=#p2hrKf7i^RY!?A%TfZkblR~;d(a`jR4o)$kHgGc z{0J@=+xxnf05#M6x)v~bk`Skb*>J2s)+v8Xg*g7?yU6&5_8oMTcdvH2pNa6tP;46c zV*OrCh}RB5_bvDvMj633v`s^pOZL@_(~ge;Sv5?HrDmsc0v+xPf%#z|#Og+%nTsqq zGN3OQaH*(Y6BCe=+#Gnxp_Z8QCWcyA>L2e)Yr`;S{X$#c)NYLO^tWngNvLllYQ!-m zwDq4HoMB1rU+BpSfVO)=HD5aE308&w8`-HRBf}u7taKqNt^`EBINa~k}~ zsie@1ceU=(@{qWmV)1_MJP*Z!V{cpZ?7{y^I;Jzb*l8GLf^=!fWY^2DwWwPfiXEBqH?s#p3r%(vC? zxDwBI0G-9fp&19Xe@E5q9_qwxr$tR#j`u>c748x^pQvxb5V^Vu^F`?|9tKHC(DIGV9B5fNuG}EEfCp@@flE7v*tE=>=uP(ltoJ6OT>E?90ioZ!Y1>GC~4+& zB($&@U9{v-wAj#uuPcHt;NH_MpJ-X0L2aCPNxv9+Ep$p>@K4G5feuZ+zZRW z?*G7`@d*5I0RMlqOh0o_0FXIQYTNOt7U&!9O-as!W0~Y|C@j+|ND+c04n|58z9B3l zo~i*Y{8Ss&m(|G7I-EVIV#Xlr(hg2Pk~3ep={Fjd--DlOqrGQIs_?(%#btr-V)u0Q7f?fIiu=F7csfbcFZQL0iFe_1<1gV|DH6ZbDvHQ^ zDr;8BR5+SXY>mMuqowvBvt^fxERZf1PS%fj=S#%iUwFSl6QT}4gk5^q6m7z63T_vD0q)j@5LTwF;IRR=LH+jmf#b;1dDqry0#)I{?u*zi+&NJ}|^cJv9fjbHf# zQDf4?1vSo|QD@=l!RTxEq;#y|9n$t84-Ma99F-)tr(sLKR#S8pwEwO6g4p++w!nKB z8Rw5hJ}er)Ll*14f)#QWZ&-cwJ1r$%%8*3?L&S(~JP&EKKc%)sOTjT#sV&-olf_cj zq8Xiq#SCQ!RQm4SZfETTej(nXm7XjPnUh7WTGmM;+R>_wjv9;6CQp%y`yS>9tVY7t z9vb#NhLf(180mEpRqMK@)da7{3R5el+oj)j!~NqwAmf^-|3T{?<@!x5*%sZ?u}(A> zxdV=6!vCWd@Lcw*I;1%uN`8n9_(uZ_A4(n+B|l z@Cy%dJYq2Vo@hi+EG9ONmZ>^^(gG!yf`}1ihD9{d@}qXJBR4HSEzHkh`LX@mbl-{j zKWUk+?chV#nhgsAo;7%5JwGk(|4AE)k5QU`f*SLTgG6zZ@rv;O2DKTy4RiWghoQy$ ziN%LuHRvZEJFE%sc#zpzXPYQFf?3_u;_4&XJh1)15zsv?n(yf`T&(`5FG=iP;&S@` zgb=nBLy5KHa#xyv!U^8>zo3_zD6)Uma%y&C>iVe>>+{;m{WvtXS2VB10T1KWU}3so zO?RiCM}AUCjfYb$vf)=Pv#;&VhAm49GWPSfu4p?c6n;r!|0NiEwycGrcjX5-rm)Wd zDEjJ6Sa2-Zs9 z1tTeLQrq4=0MKXPDk9FrHGM=>+JCQf_`GQbKp1#Bv1IXdqA!*vZh!(=8WoW znibEa$ar91i%zboz8B5u9CYg3CX~7kd1V52FUEJ~bDh|A6iXrlafmf^P=&}lrVVg( z7c-7&nQh}KHPX8Nm^R8Y8EG+Cl4v{z8w5Ux`W?Yq#Qnd+6xAXce@74B5B2U4T-~lc zt_^FanR8sytUqqipwCb=u=QZ8cVaQ(CSOXz%5y{P- zXC`vUk${9*rR-@~z$3yDr6+r)f|}r4I4@dHcI+2JqVzN?J2Rs6OzU-3l%DUp6Fi+R zs=h`&?~c-g%5 z*2d^Y)Jzz7a(g6+V2u89)GP}~kJbC+HN$4X24pw1TL6cvcy@jsig^Qx%Ha5X(*;0k=-+Ldyfhk#T zJ=k?N3PF|H=ocRaU7DzN>qg=Q@T7jX+b|jbuqgk|o$O-dPSH3LhejQB>%J&3Gv1?X zkimf-NCBH?wkUZXTYbtrI`);#PK}eQfDF5^jbR%-dOm~x&7+^1A;T~n9LY*8vW<9; z5&o`_zBz3n3kl9`153K<^Stu_+F3m!8Zf!^kblyN`s;BhdTAC`##)lFTcn^{hEoo7 zsgp;+k)0JHyPM7rvWvRuX?V=;rq6R+BpMWSpqoAcpER0r`eZps@1V`W879q`IPRk4 zDlNY~PEVE+dq1v@NXWc>sS^=5$LW75yf{3&U?)esy{+(+gMo0Dgwu#!UOitnj3l6# zRC{TU0p(o~NsV36@p>5&Y>3wf$XvvV#yenm-hCO&bXnc?*JMeCThUF!ll3igjuLV7 z$YfX>Sg-KuREPt8`p87P+iL60KpiKt&&bZNeH*<~%T>@aFZlF=6Ii@o9P{aeWLDgw zbzu~G?|@F0l=vaYN5s{BRKOA84?wx#fCay-hd2CsviH&sg=>YEG|q$Z_{xe)J7-P_t5o|0q=d!7`CNM} zES!wR)6M~T>Jl>;o>_pFT+RvTT-)0a(DkUxpg(_gCdnp<<7OYgeSAz)322X)@YG)DfYINwhY)0$8DYI7$Ca47)YO z?dS&6drH7d;b)qvn|&i$uW{@Wb5is_M=il}=JEKXREpoJpvZzlf#fKF@uTlZ)nCoa zV;cC`n&fgM&tVB=+YP5ks}A97Z>;_Hgs43&%$|_HU81C?eo1_pC2DFWB|h>bCW#Mw z>Vv)IVVv0|veWdL8CSq-HsajoP|RBz9yYW&P5+l8aT)wLP{E^(k#B{nGW5$G-sSM5 z=3`o`#j#$H^ef>-9j?5xGxg*lSHa89z4S(EWYZ0B{EYxieX+u#V->65MenRr{V+IV=$n5vMe z&S)U0lIB{QMigbEWnITqu{R)FS4}B0X-56ulD4B=(-v)Gwtly`!_a+gAMj5Tj~VFP z>^cgHH^RX}aVQ*26J8VYd$Vxlpl@Jlbz~t3#~=B1i)5wL1DY6eik>e&r%wS>qC|E) zKFr$jQ-)ijH;VF8^c>NYqsMs}Q>_)ldeJwi_m`1#v>b%vkCERhs!q`}#jIT2oqd~C z$8E9~A){DV&JQcsc_JI&9J`nU5F175b}N=hQDw1+ujvF2Z;8Jn60aofv^+gQ7V=iH zxDN_hmZuMvI+yx@>XWU@R?!??PZ>EAxHFPK757t3_sQa7-fQapWly;k^&FM1$y_Tyb|~-Yw=WLJ$V4>jX~*6TiI^{Ade*PbYYWh3nDf-bez)ykVy7 z&dxS@gNnlAbAmq-G|kK%l+ zys)6m2=n`>MQ0BZDnxldJz19eBA~;YQia%_ujf1R#2ak;kJ$mm99<89hmJlN*Wh^d zK7bx?XOKWFK{)=H;1d!B!tEs7(N1_1kU=>9NLa7*QCwf>qbIGz+N2Kb4DU0Sh~~mD zeKbQjP7MP`i)?^JwtDK1$jRepBUxnCk;TIJbQ3hdqhQlJwrCJd&JeJVN$JB)}H=&r993T_3$;R(Cjfgy{SJa3@=%+cN9~} z;N=#{%bk;4YLUFsImwk4$=@v!yZ@*V`wJ{Ba1KaG3`8hQGFoHx;Hz)!&}Dx zR!4kP7mPzVt}8y(8rM;-gK+$@`1?c&YD{X1M1Vm!{)lR9Z`DZvgK+#2_0M+H^#Fr# z{1Nr9cGMbxK{)=1dRyv(3bq3B;+>9pZ5spIyn442yv?hBcY?Qh_1?+xJ>{sM8Q335 zApECUW3~#QgK+#Y>+iR-iI%4z9DhW8&|cu70E2M+5%pm^$^;mMZA6w?g1Et2+vD-cnQrjF^C`%tMMsODTlTPsGiLJxJv~7{t z6%OWz0{}Uyr8JeEuDhZ8+3cm{R3hFW9DmH_=fY7S%{C3ELoskNh0W3H(r7?%46?#- zq7;PVk72%$43SzSUMwGOjqWnVW5Y2xEY8*ADprDuCHT6N5}a${zv%=&+`=F11aHgD zp_Aj=<>uQ+0^Gl3$qnakK{)DY77z ztgtI1{^w5cv&4pAn5>*F>chb_(Fo9%mE56L(N05zK{)X)GSpAFUfdw)ZAC`=lh7auO`0cqnY1sH_m&z?P&;5|qW{FvBL;Rs5JTr~{6 z=&?@9WlPZSo#1T=I^GH1o)Xcvz%f^(miNOCeC^T25lNuh)x_a?E(%*dTn|J=rHj>l z^xjGAKUsnx9DjU|RydG0lhm0mejcv(mTl*LvHfN2s@&ixIgx z_DhY>-ToLWFKxmiyRVAa$Shj2VQXi1CwN;sdpg0}t*mP&c(7LSs9Pj~C>g2e%krE8 znjjp1uMz+U;rJuY8;08sI0(ldaq;Qm%^bZ~Jb8SJ<<~u3^b6|!WI8v)F9^pU z>3ufeg1WoHADKUkK_q13>Cp+EnI}Hb37!QYKA{u5JrwI++ub9wiu3}AK}iwBATeEB zkcV1bQ=|uF_KOfp5RO0QDk)vOUt|^cV#_Z%UBsM;WrA|i_e}jVR|*pCZqEhk&(!Zl z-ib9 zb%0yaxXumh&gU1X0zvT4|uCMP8O$LNz~CnHk_5pBw{nTz3P!P0SG2$uv@Z_384 z0QaW&lr?|DSs2l!BMYS42p1z7&eGGOGSWq_zNtypw7TJWZg~DPw=s;>eP%Dva~2+M zj^p@|#mNlEiS4IgXT_|sXscN=msWg^pVM%WF}}RoF;*Yv$QEE}9n+tBiH z`q;u8L`VH#H#vKh$Z;`~%ZwZ5B$vW;QU51>P?VW29^aXqR69YhcAP>I94mpU!7kKw?&R8um_b(x|3v*p ze6O^5A~dK^JU3Cl+{{M;K_rexn~|nNEuuy>;9x1*1V8O7T zMb{VJCR{e0q*KvSfa65@=ZR_3+(xjQaQqvqfxFMqol?HZew<)Yj~xt6=jgd!n%b$t z^WdVz)`a++sQ&3{ugJu6^?jn+iH~1C{3Q?`1kbO;ZfW+xQSD*%g2ps|_y!jAN^g;z$Jd zCuwns&DeC!rbel-X$InsOKj^eK2J{(#RfKuG@Xi7NZ;N(r}#0WH?+xH(QZd_O~aeX zHJfmlT#7#?OYD3AqQ9dFW3|&>!dD;bN}cY3g^)NZxnew%@T8Q|FBVVA4D-w8e5xgx z#5qNIQ)~c=aPf4xl6Es5a`;1g#dx@j;G}v(%_NICW&FT;x-?`pgH&q56G(-BhP4Wx zEY?rQ*b57$@R9Ly<{ud^wjVIw${8}=4Kw7(sD6gEZ$J}`jE=bth+}K<1xfK;{N&|9 z-I-w*kz!*PQ4ZALk=wp_#tfV<2dw26KTK8DX)6mwR<&o<-~V zScVxG78Ex#fsb;?(^E9egQi82GhrB{S{Po_Ffc9Z^mJ~!5WH%B2n$0I9R&uqzG_^Sob z`$hf3*p%NV8sa=#Pw<{$CCLb5h2sJ}N9wryS;(5kDL9X>DVB!xvw^__^~44C4aEkb zdO)(!S+e}9?vU9FEF<;^QF4J4n!*c_t>8o0-yvmIlmPZ}D+gP4o0keH?L2JHWU>KA z4N2jVmD4Ufk_T>?aE3JegM`W)3QmqE?D`6*a|Y{{!nU+BgA3qfCV}S=q<0t|UQ$wqS$t$1ku>aqC{4p7XxQ@+Hy;l1pCuQ)A~V1Q z{#yp@$Vb?bi=sJLIb=Qs`=VP;Z%RF7JHcpa#hivwD*xg9sMSA8R4cF&moxV`iU#O>LuqAtt z>dAx?AIjOgOJo{e(Re>jwa7ZnSvwy+%OA`MkcbS`J0ceBUi>yTv!-c`Gqi5LZbZv# zsS`wVv4LX;`1NqG8b>htN};cdr(!?yL+?7{o?WP4Gy-267lqJmOc0F^qQ{&lHarOE zYz0jcMGpa*ETKg9?;LYb0daK3`YKVVb54RfSH&?!#W7Vu(-d@`f~G5IhJwyl&`br* zQqXJ#U7(-~6;!IAISQJqpm_?qNI~-zbg_aiQP2VfEmY8@3c5@|ixjk2K}!^Lxq`|R zRIZ>a6tq-9%M`R+L02m1Dg~`j(A5gMMnQj8&`JfZQV{kPkkiZ59DX3aO8x(ZAf@&0Whk`aLs8&Hj zL7Nn`SwVLy2&;}P!xjZ?RnRsC-L0TH1>yKEQr@E^@LmPor*QWx=mCX$5Z^5713V8w z%-E9O5?h}@cm1%Uc|?Wyi-I0i&|?zn`?wtfii$l6J5b6nW%mi-f?@Cu6{P;Z1bH$d z$Wtx)jz|>ML+^xy<7q5Lk^+C3gPk2Io>L`wUY0<-{gfWW z_l^!+F2HL1t3vKpP=kX0rl6M;^s<6pQPAHN^s0hhQ;giBpw|`j4+(kqTG`-89UHgm zq5?R%j){uuXY>T-!6}}8MxUaJNHxCJD!{+m3gBya zFCzc{Rw=)ya zjC`q}uN3ZU1%0ESg9sdj%`&4K2mm5 z5H>!(1jwtPcm;J=kWW$i71TpP0R<%}C{aO43QAT`ih@!V)Kfue3QAW{hJt!2C{saM z3c|so%x7-}VIwr5Tm|JR2;XtC47!301(^yuMM3!r!pViC?5m)D3hJ+*0tFQ+=u`y_ zP|#@#8YoI$uyzMjTk?E*hOJ;^lO3e!2P=Af+Rxmcp`f7(!jX~8!*B(SP|!#P1r=1J zpfeRTNadcZ^{gDC`&}MZ_@KilMk;3?(W@=P21ZS3y%0G*v;<6m(uYH?KxI%+2(+xFk1c zv{PJRQJmkA0#_1)nIib_EF1(s8RrM>hDmBx8_n?DdZu@_4N{}4FCxoci*Y+HP)xh9 zJ&}c0BBgc+rHAK83OP#TT!f=hW_E5H6;+vIo+{i$D%SZ5x>!M%$Qa~2Zj%)QdnJCD zV^25Mi0n^#1+wXNEl|DTn8*Sv5&EwOoFg3dke-Dq`b$;xmr2O8s69h_kfFux1)FEZ zwxo?h^7nETOPQ(__Xq$lPl%jc>5W4?C3C>X29{q(VIp1Ck zwy{Q@K~O%Q#gjFh11Bd~kb)(6CoW{s?8K9kg>ah7Et=;nn&WgRr~bgjs{sKaj?XQs~OxM*9tu8aEG35 z)Q|L#x-}1xPgfdAH#;f6_hr!w&8u0 z1=DEN7w=REHl8zL#?H*OXR!V&EAep_nw8v+Znn`>FAPl{x1;@E%e)nJc$6!Mk3weh zZUnJ2QHS^cmdQ-qe~52%F8@e<%v2!`e2rpLE--ojTz{*!S4_1Sb{Jcu``NMLlVp8> zQMhke5PIT%?GW5a*3TKp&c-+B!{eOnPXRc5qxB{XIlYS!|ege55eeAAvPb< z^Ci`V7FD1F)d55Ts-F~b#m#?^u2zbmm)mE!s3MK zAFyMzLah41`cSBcY&Q(N;U`k|4I9u6d60Lano+P|KTD7poBJaRMBzwK6|5oy2 z>W{Lds}Mjk{dy}v7M|@~eGF6*eS?M0?SMY?qkf4*v-@N2xCqo9dht*CSc$&YLU-VK z=#8KBe>-G3ah924&#uE(z2%E~=@UA1SjWA^6(P@2{l)~aX@k#T4L#>Gz_ie3KI4ZN z8HJ%**LC~s*5ybsk}ZROM*FMP&`QOER3pXlQm87`IL{^X$X&`T0;5u$KxSDcq|rs4LyVs%P?7lmgU13+1| zDF#QjpJ_~Yy~@5!Y~QQlLhd_p-pkQ5jbfQtnJ5`$Oc+S9i$-F!s=DE9Lp8OlEvVGG zT<7j><3-~rF#I*~%P6CN-X5e7PD#CM$5MxPi4$j!HqLcy6Wd1{*LgcETZ_Um#(5^s z%OkVN3x4VyVEL+%Ta{-U`SACr#|W5yZ(7xiX_xD_{C4$*)W|a!j8*u*3K}vCe}I;*GGQ1IV}#hg8CUaxHQ-k2Lm>}rn&LOb!)Zs6J_)4zPD)xd$ruW< zk|n+zQHLNy8bQX{7+dUYxb+UTUxS_51#poYKmG}N^5ZRWU=kYHdf}ODqOwCwfbvB_wL>qYZq@b+y{1knsw= zElHXsiRTlWL~K6?YV|+T*YT-%1K}N?Nyz)TMMKWuQ=VyH{udIH{UtCSM8+P8zv*Bn z^Fi@rB3~)8uOrAtMUZ`?(m8171;Kl(bPh?3<6Cj)T;%6F1+|EbDS%oP^u0Kn&<_gw zQLG~LlY)L0k4=I699GZ~@fD$8B$V)LM5g|UjV{7>u91MVaml@eqY(uE*G6zm5&RxO za9NDnq}qMb#GUX1D-{q{DGK&Ckn4h_%fy$nXYJwX+7LKAsuh{%K=e%)w(1F z!)C|e)t1g8kcN}RwvlDH@ru8k%7v47+DJsfW!T9=8fvp}nr>}0o;bX!oMxYA1YF)W zOm@7DLA`N!A09#XHnKur7#SP4-M~610Qgh0Frg!&{yg-GiDEwy&<%wQ-GZgm$v3a_&6x~H@i>Zss$8n47VCvSV#h4j}?)O`{pk};< zxe$eSV<*j~8HUf_pBLD(cCbK71DK6*59+1TD@oK(8($!MQw3g8U$gL}K;@Yb1zI>w9f zG7dH|#{1W>p4rZtJn$)5d^!_qGyz$*#w#hauoY72KHtSJhS1_ z#Q0fg-tq_`40vXNZ#c{DDV!el_FUY=QC$)5%wuCG{c5ygj^&st8+&3n_eA48IL4u6 zmh5!4zk>*Tvkj-0X|WZMX)rlomJzVyFP?3jW+owuaNB4yV2UK8PYH{DE$-Cvrpd!; z+*L-Lmvyn$iq;{;pzSuaRZq#>HyYI z_`X5bdt2HlHr1~N$CWFm*zhI3CX5xXQZyVZXTegVK)p}E1BW?dH&!VILlQkelsRG{ zXGdePBj|hNr}Pu-Bdgqr%Sc#C9HfAe$&Q$GvEV`@E)OSz%DsN961Gz2gVMl0WfO4B zt84~o;=MVBA+lCR*~PZgb&9OHM$jdt7RR7~-Qk5{;qaZtVhnSR%ryohkA?G$98qvN zj(({7hUaVy(C~H(w#&SH1UCW%2f1+_%BMK;-!~lCg99{NlxO1j-s?owJg^{DJUq`B zBu<;2++4gvZ1>umlkokeL^GH87 z-fUdm7YiF3!fmXKLyI*b5w%eN42UC+D>3X`_ag>ze-?W#GV(>`Y_Rt2YZHB}-{7>QHa^Fgn)0l?C<6FMNK}tI=Hr#TT z05)hvd(@7ruA&uJlyU@lG4!G}SZ-Quz!HCnkq+&5_9bZ8cZ!9V7?bl@d8{-lCzhGn zX49k)@m(HdB<7UxB-%?5McFf%PCp4)L8IU(0kC`zz%I&(!3=jzO8`|+i&53OPm>I> z<8)jeQ?>xwhY`Wj{|?S4&RUo397suJ9F!XVu&GjR)Fe~c=7R+uM3tQp zsYKc`B1)=}%eG8hbaiyD2yVi5(M1c574ig5=9SHzEh-aC=UjsY=M0SgEHI8*%0(Jk ziw)S;FEw&qSs?6=JMA&!*gFf?y{x>{$a36SQ;3bVJ1#Zi^rlU(~-mX{#YfOa~b-uJVY9=B5k=8x_IYhMy^8(9RQA(vM~!GWTB6v?bxr` z$Rs|gAAosQ(}XN{##czj)}Q1TlhxY7bxRe?pIx7EV$SIv%!Za2ZplGT zzgQhE;olpd#;nQew?&;PlOzj{%w{w&3~+YXdfvN4m47^ij9mqs;n?#_;F@tQCrv18$Y2lnn5UJjoV?8*um9 zj#`LoX&DrZ)$P_z^g@15!L4vFml;_#E$5(AMYzbIbU>_c42R}SmW`i0XSVpW8xHG) ziIL&t9y4Imw^f8_{v78H%H&ijJ#D3gB`P+M$}F>H-$s^c1Y-<5^vx*>|B{YNBKn~B zdG9Hg&qHo0w)*QK`CG>4xW%}qk}(NNh z0@BAAB~2_?YAgcDJ4=nFQ3D-f(lut1C|w2tH$>Gk$l^fp@G|4CIP?|}wA^xNfXd~t zmqWl$5$`O=)DA~)U5Q7f=zFCx56}h$?Yh#q3Z4V60wp$O@}W*$6uYl7rhqPS zg>e}aQPm2hq*_#P1=QQVczy*j8fn#ShPv<5kby768gUriL(SMSntmO=`0=eYvc&EI z9KbXuID61?LuO~gu_5I55|1B(T_*c#Wa~vye+EV%rB`D>|A>6|kaijz?oGKGy3j4Q zUxRkK_iAGW&bsRgE%z*DiPKwoC&XzOhAr5QqvL~HGUIAmUT}&#t~Pug&I_d^GU$1U zebH#bhb#R6<4PDRjonv5(z71H?)rj1W4?|x{y!TtMddUkbMQH|l3A@djK6XPk1x>H8cCsVOTD3A_%* zwQR{r5Idj1_+#Hcea;Ryt>bLuKIo@bmb&Al&4e7|&z`*Fsp= zc;O$pK0o_;whdMh_3bF(c*TS+2bJTWV$N!#zh?skK1HFfb>jl{;ZDd%<7!k;r8uRyvpb=P1)2u zXTgmXC11tjcEX2o!NZQnAh5woBSq}^0UB-ezp=|d*o2`*%DH-6Zz>A%tPD>!j{!)4 zQ#1YupVmu!TN-nx-1eNbaeG?6$l4bhm-u{y4y_05sVSU|FG{?S-n#41arH?}^LcFL zDklp$BJ2N5Tww&_uK3DL3uIBDvEz6b!y<|m*=Z}edd`&No{LKn`zED2YYGNC9m_?@ z8l!*eP<$T3%nd|l`8*v@w%cx^WFig;Js=)iV`Q5B@xcfgLTAUh6Q|N~I>Mm@{U~-T zMe7p68_i&#)K-{hNB@X8N@OmT8Lr$$dWxJG184hD zolxQD!BNE|!HtEZP)~znjoJ)mc#2LCjz2q23TTiX_%Wm8Wmp(-;SNut=(7qcbkmHS zI8i*7=Yx-rar#q0XfyW%G^$>r{Ki;ZEclOjC$@++wz|~$meCkA!fdeb7N;){SMEt> zjY3d6edd+rvBxUg#IajoNv#ouYti*p{|%ks-gk53X3(Bb+TK=JZvJE6(-saec|bhl zvw8FY6eIna9<7YjP~-#oNIw`4)}lAua&eMde)mKEb;M_^1HSZ9(^)|tG7pTKLSSn= z#={{W{p|eJLn<7A?R1$Q>!U4QL_{IUfwS|v3=trSwlJgd9u}sD>_6;4tn_G6K0g(^ zUM6O8fdHa4NG^imKHt7*-39B7;#8&|p6@n(@n~S2>2<3!&Xt3LM2lu`Vj!EOEC#d0 zq?rX4lhJThVufh_8*j?+dYl!+vD+b?U8SrhhR=m_!m*0jMS(kQG~wA{ye~kVQSCF$ z)8U4o&Cs7+!xB90_nYxf8XXRCpVbyIGeROJ?!uEqbo68W^T&6){+XG!dJugNVwzxY|Alo+Cd^w_Mz~LlpL1aE+zBdA&jW1Mj3`( zixFDg%q*u!{}4mGx2>#|l403iw6q5kVkBULOehaeW`J~Egnt!2x|_Jv@AEGMJvFBE$MZ+g`c-l= zjzWLsb!^``S5#e>8gS&-R9!tt?8{F}aSRpD)ffZ14zo1&S9vv$Ka2y*?=Y$z<3n5T zF#ZuM@7jqKtxqCr#akTinzF_eeC(SS7uvDKzz96J3>Obp-kRnXFWisMAnNwue1IL} zT+XQRapJ`bqkDgSA7v3q}Rl6d|e z;|35F-D_0HOS;(O+gu$VYP{Fz7L9G8^*fN0rXLW;kq3-2(3iyb#$ftEqZF4H9eB`4 zJ~6Cl++`$((jPLiqOpR=2;?EXi!+>|S${D;jXL43<&n4s2t5}jW+k}Dw|Flszv~`1 zj-)<9VZaaUlGSq-o~)Xs*glVLyASV@L*||^_Bnzfq%*!5#E1E~EP6*SA`HIi zixI!So83dC?=&Vl#wu=B?le|LMLERpJB=$~VZ`jE^!k*T(CX)mGo2^rW`#Ej4V!%o zTQF{lejk-md3~BQwBkj?+j&i7pOzPRcDJ#`=@^GAEYLi6ziiy$8E-X%q|oeFjF)if zdno%|V?Y!>rJ4F3>}C_hay}-Cjqky1bGCSe&?NC0p~)g~KgMIlh#@Ez@5P+Dct0kW zC1O6jJ?GFHImBl0VHjQ15p{0pnf+L>bWM>#3Y+oyF*WeiP~iv0fM~}w<_n#~M@F^h zJS$&Uh}4gbrJm^)m?SoSZ2ab!5d!69F2~)WW1kuSiguhIYW&Lhx2yL|J5j{Sm}f=6 zvwMjVKXy$LP2a%;c!4N**uDTaCLtrELkNes9cl%u&@;@J^I7RQ?Lg5xh)_-}x1@$E(UPb&;v{F`<4|BIywtL6S+t)sP@>OwnrBEPZb7--H9+ijnot>`;VyHg10SDmjxp2lcqYco z#Qx;=hFbj>w0K{vd0HwpBY!L5romCua|$;MmJ(dUp1vEqfD4Xb(*MG|D0iqj)_lz& z9_@z150-h%_rzYlt%);z70l~G#6`YSi4(pw0=_H)UK9Z@j)0d$z?VnBW$myy+|^9< zm$!S!3|t{Hx|#j`OC!9O;W%uwf64L)?<*tVt0LeP5%AR!@HOH-mO%m%x|_|O!B4puW4VPVI zB}3^TSFeqLuM4AH6M?%v0=|K?X=1wH42rt$$k2{!p`godh<1yF?q;t4W{aLuz_e}= zRmgirDqcBT!p9Y*de0 z^$_Z@Nj)~J$DQhN7w*wSse;$SJX8E1m?Y}_W>(1-D+e~;wno6)BH+6t;JOHSyYTlg z2VuWga}P5|Eb3wQaonrkU+7`xI_~4UKI48Xl-&j%h=3oAfFFv0AC7<@v0?E`f|*tk z-n<^OQC7`79sxfQ0q=-_>m%SNBjBgPV5lDs^~J~^dV9o*Q9X@{r-9|%lA}q=#WNO6 zSt0za1t(f?$bvbyC4Q#`bHqXTISc0Kj_~sqY**j^Suk_55IOlvg6Z+R08dKQTVhv& znU6!SAqasC27eKlaAy70qQq5<rl=PKDKIQ=b(-By=DCr|Rp>jU_L7)1pGDZaN+ptkJj8eGRdCX*Ic^Z*R6?4;EHp<3J49>1 z8SsTibOT7m-jCDLv)y=G03r$(`(9=%8;--BS5ZSFYl`{@O1_D>YUm|e+Y2y0% zT6dcG@{=@QA@%!Pmc7j8;CjH_;BUj%0w%xQaA~}{9`=Y!yE;9m0j6Q>wUDR4yu{(( z0}ipBvs|3;-z=&M&3ymsCwT8FgsA)j-mJHFYR9Q&vVSkUITC93-afNOrr7;R0>t}N z+{X9_kln=gRmlPW8{cpmb1!#}MJl#x_8)t78z?-4 zui9TdgW4i9+h51ywL%sfDRW$B_XYbSa}$Ao{}1pV`~m*Mc6>$KMxpQw9B3yvDgL8B zz<>M)_@*{|Mf*;r@C-D!5u6x4p5v%D9HT7`RYwaj`C0Gk$jA(w0 zA!}G$423vG+=`)ah^hO3KnQzjN~IyM%-f-1#$PwALq_~Roe;Z>;^&h`v2qAHmcu6m z**XMj;t0HHm2BgzXdYsw`F}Zqx?z6rv<&VngOVp)|C7lpN%2e_R-tUYwXL?fL&GEY{G$d$_bmE$8am{G6 z7oT^IHZS(XqwnQzQJgJ59Q&x!$3O(>*GptiM*SC$$2hQhEcW0`8Dmb7m{Y~7(dZ9J zbXp|QhihOv4H^l~XV1b6n2B64)||$>wVxep{v1V*$NyxmrboXC<^@qO@~l4_18O23 znWVDSYqHr(_}0Pp(lW{HLkxUY%k*Ha7!4~4lOE2barMV!Gl8-FJlQM->>C<5t##L4MSeM!Tq}yE^!UmJ3 znc&-w+sMHY*fDVMT3DC&y$fSe+0R^B-t3;Ox|vhap0yuf+$`owYMf z>>&Lr)9JB`f0iixEhiwpoMEPjiKsZw(}$6NXz=6(YU)y8)Lw~x z@AUT9^V?r%wZATIe_hi4ilYVW7|PmTam0Y_dqw-}()QP7?XSz*U$1O`y{i3nMf)pG z8nENNx&8Ip_E&tcZxd{6f320TWY|Y@%t?Iqn``!z+`=g-7h@xT)BRk_xdt|+rqPh# z%DHAb$+pckdrPuZlI6?SK>I6>L$Q4``3j4`B1li=JTpO(W{d4}%}n`amO&E0FMHq1rl`pn0K+w9Mb8s*i z=K1u4&7leF0>SxaorL>|!ntNLi}3q=v!5*S#p-#%#pat5zQp3dC5#@Mrk;hGT6Bq- zF2jd=?zo4x!)LJN+;^idK~(x6!}~zUSiZf)62PJDvBXeOk;e_GXQhzA{80O zY8HOm0@$>PAKA_e#u>j*)zJkDt+;VM3hStDp~WlQ`ijEIpkpIYTB`ic{&Fn2Yb84$XFCk?iKtRm1htO9s5L{q=@6!bz7~^?7wW z_L}zBKexZGYJY{*9O=kNSJ%|TmOiT%3#!GhXwFlpd()w77vaez)C=HfprNv)7>$R! z1P(p%LHd>U zMCt05Ls!i*ySg2{!orUWl`l1)a(FVqG1bY|Uj^w7E;rY>E<~>SVOuSxck0!9W!vkR z_Sc5D`C-A8SXs&v$F4L-c^^SIj`_3TT%z%KUb498Ds!|aJ3Nihe_vbr*hSv-7Ufr) zqw-|x06CoD(4qnkTx;85qH@=IHHMe!HRGDL*YVew*r9|S-16>76=~Hq=2DotATjQ_ ziE+YRk{2i5ZuI#?sUJq!f)Oxk?(G+oP*Zx5JDU*>fa92uLnA(IKZ+JkrFso5KyKmO z-4`Q}N8R`=R$jP`dG~v{*!;K{AF~wfjB)#WXGRRqYqC=?_!$JVZJ(8B-5j^1itUf~ z2w;48_DZuxOz-B66N_?t_#C;SVHGMpVU^iO-lZ*v7)YO$HUW&`u%9B2N^kSyew9(8 zVK9zW-|=*U)5ZM9iN>|qxV!s2B)Vf=Z|BBw_*lJv&H9na{uT@=I6ATIdH=!r_t?Uh zCsX!618lf8^j^8Q!haLInYJBhsqn8hlRZ-`>N9xav@-#a*f9oc@dXo{PRILV!?vC{ zNP3w+&U+86x6Ct#tbWnp%LusU!mF#?$mp0Vs(!$_?7r2e&oNRoBW710V7uW6I7a}M zP=5t{-lb(%WKVDg9IxUgWK({=wF}0;rX|?JR(&&9>De$sO`5gReZ^HcuL8FHuiYu`=whS8} z!}){Lh9{?@VZ>ndtgg}wI=&XomF7rqUn?5YJ}>%KnFDZPvC}7Z7df2r8s8gXenl;9 zi`GTl3QPyKRGA6hf$(Gqwkt#Is)A4-{XE*;Rf9-zo)#Z3zO6D(b&M0)*P3@J`5RDE zd8!lF%(joml{uzpSFDb2yn47n?RZ_XtK?zGoPx5s#gOLOv*2jiFc3jUbM1!f%$a`k z#CU0H%9@Go-qdBu2&yznp+6Atp91oZ_8D4PPDYu3Qpyvu)#pSq8eDv@AszPa|5c$Gq_* z$@V`n*EBZSl;n58$w<<~4t#De*4=;wCUi+Rn1Q^=dMZ3=ZuZ|`>IlIKK7oa&B1A_X zRPEv9{YG=N$+BFF-1LTHt_FaX-6^Y7mJ`ohIH%ZtetM=TofIxk|2q!{o_4ZaTX9p^ zsc)0u?75rV04oaj#3Wmnq;0Ze=n*mdX7h5aC%tjAIY=Jw z)epWMDN=7i_m111Z!yPqLb2f%D4Ej{^<|=UQhdHl7w13R0&&5&3U`>v*@J*&D`e-y zVJa1Q6`ssAnKxK$xEmVAfgy0|S}dR8%$K#8mhHzzRP#LfZ6~WC8%~B6@_)A(`UVHQjNc`VlCqeYeIqdr-`&6c~{G!5QHcS?kSGBviHDoRH1@Ad78G zBuwj#&D08UXuUZK+u;gtHIw6qfs{>^IUk-WUYz8`DCt&nFcd`5GZ-AaaI5(cV)pMg zGv)qSR?~PmyW|--YzUd=d>Lj8m~5FG7lPY}MB{B(@S!)e-|p?LHis64XKpIcK{%Ff z1hT~}jl`2ZnXF()DSMwB3uf42(V+JZID%qpwV9JzWQ962GL$HKw@0A1hR4y(+a!o1x)m(p>&ncOCfwi1(H7Ky6jgk-V%c64Xu z;*HzQ8_~9>)|i>*IK)lyAYP7f&7zbt-sRm!zZrN^)lU6ED6hC4* zWxM)tqus9h3!~N?tr}OdSW}C+uGN%k%>hxpyNJ(gO-)q(3+l9ZESgf*d(lq+ImjVv z)y`!XTw)JX%D!hYY&-V^oTDr5BA)_ps*9oYWzT~a{Wi`>G0YR}}_Y226g7#2Yb9>{YJo=KtDg#jxsg)MNF#@I+hGvIp zqgnY1?cHqVc+L-x6P(x#lUhWwGuueo7++|2!Qm>Avn)1XiWoD*LeAqt8HXWG#g}W__KBwf9hxFVO{S zFdJMx9N5(54UBn5itJsn0e=Hu;l&?|ilY$j#Quf~(Re3TvM)q>3`k5^8~5F14z>i> z5BUOj=iG%BHBL0&57x6hifbG0f|knz&!GxsZ;gjS!4F>xZ0iw_*FD%h4AHEXtpc%|Nl;kMDgS+F~XoR$3wFAmdcN%*R`z zaf>;~H5Xp-l%HggyVacK;pl-?Fa=*NV8p*=tLe_r0JCY2f~$ZdvltBpOcM=T(H(2z zfO`D0)g0uXhe$chvWJgviK1=TNv9fh>o&8$DD%ZTYfAsWvoC>Ps43lJ%j7(Q+;sDq-juIo>5 z(cM*7VOP8_JXXOAba%ae>hJq{ro#}#|L^mkd^+9rs_NCNSFc{ZdR1LL1205w5fasR zd{xgjKlv*5Yvv7ziOXqVxEeU9P?85KOdGFC!*H4$(np$pgFF4miXfS3L;1g^_Z+03 z3b3{M@d2?YR@IxxmBSB92E5k$XS`7~)tNM&+Xlrurcpytg|l%H--xb}<hgG~*SDAl@0u3^;06hSsknL`9MZDHw=$$-hLm0S!=8xVjR;E%y)Ih~a#jDDU z+wZ~Lr}!SM6Iu9;cvel2nTXa%p$5p{rb8Ht4&5V;Kdo<|A}VR8r%B|6yTtg@5|ZxF z*jUT!cR?sE+=-hQsS`;TQYvCpCm2s*O%vtw2ax<%kfI+G(jRw;Gg2e_uO^mB{Ae7G zky&vswj)QzYsRgGZ@3q`Snv(YH{s?yaj)2!s&)y`KpfZ5z|Eb8Hw4!IPBi1_3iS2! zQ=i8anrwNE^Lr2utExeIL=^p~4byn(ZphuYylyvyLi1ITU=b@x_$bxB;H|r{vnP#s zLqBQ?qJj8wX%=7jBs>nW@1jAV)SyD|7yYa@xc7eXW(Fz59me7wacefA`gLE1>3eLo z9*j#iVh7sc+k|ujy^Rj9Sy5i{tajvX#YN*y4KC6#gpr7XNT|eWOo?3BqV&;x)&rRN zBpymi;WID8d%yxOC#5?^z45>!qA```XsJl6i8C<)=XcJ4J(hTa4&!-1oXQV5bpjUu zN_*iGvppy#l0H$jdt{TO0Y)r34;N8M6wD3ZRf_pl4?=?;lIUEQn=#b1wPJI*SvCm4 z-49}BhBhzRE8Y!_b9k?KjcO~AysG+(+aJcZ2kNn!2#0#@tq+TTRy#G>{Uoz07}OCF zGx_4D#Y(DXUaVRzz;LqqDt&VB#3Qthq+0%@GI}0WHOGCAip>bcJ_d8OmM?!yygig8 zc}q~NQcq)^0Tfin3vf{p3vg-NKTYBB%YqmLNekJKgtCO{ac2;&PMnGu6lWy3(6@*& zB;OWZx|-g${=IkyUc?dNH;q3Ro7ER%VfBvNV^X%nnT!eFASwMQ%Qw6{0d0}^I4r1J z-p49m@#FBtsBRK;ipMdu)$&^(7k{VfZEB1fK4HiBbbi58NmDT3-S`LbZo@n{nDAY< zRJ>WM$73A7s>YPe4yzjovpeAmB2B1uraFX4pHi59seHo|m?=KN4?F=0`*3hv;<%sS zDxwij%W?$aa}ai;t4uIW!a@gpX)Uk{33BlP4mSj3|4lFC1SM!X{Y*!3(n8vFQ$ zXT=~|q3+M(`J?=xiHw_V(cJxhB6d(*gSo}pr;_oKN_#HWHUEr(R`q7j;%ojQN+Wz) z2Ug+ry0iEVdw`jYPU2pu71>{5CJp->$%!=ro$4v7th+$-MAGnQx!C0#>A(8#LIpN4m3XmFm* z5|UL98?^Q}`f zG@|7-@lDkYM&=F?*oup0B_X0RUKigCp-boSZ-`?x)XEz$6-KDTZEs?VG13~jkxbSb z@Fnx5Z;8zjVr?P(Bb$(zqcM%*@QP4tTDk!|f$ur{Z85W&dKPhxnugTtW^{$frn(tn z!mPbaM^ZpbV=#VH%*5Aqq4|;W5T^Jk&(pyyZ^K|1RO0d8^pse<;`@^xM@hX2x&82M zaVA)m{f_FXQ$1eq6~y6?v3JB;H29HsFeUjVI~d>KBJbG#-($ms`CV}<(yCqX(7WP? z5zi^Xx86f*;p-S!vujIdF&|9w$N z)n3)5R?}K8e9+U0_hA6F@X`;&%v4%TBL-`;0TP;*_(`n73AM0vw$$Pr+dvn*gewvf z1>tj;HoX7$EG0D^FF=q863gi~hhA;qrZ2~)81Y2R-pAkmK%AU?4J46NSaDNggfI}B%@#&um2EBw=fRwiH6qe)f{MX5&#P> zq8>{f^MrJfqNo?pk0hAF^nN~R0c!8-!v${V*L{S|`IX@$RD#x1wO)Bzsr9%`5Ik|&W4j8eiYX4ANk37 zc)cm`;CQ^)I>l(*WP3uG7Rg59v_?NEJNjv1Y6&u|G|Ak~AO9HocMl20qpla&aSdkkK-?L74u`muU&0hNhM8)B~Eb;rax88;)N z##R!jTf(HmR}KUdZVd;gf=uG-99;CHq_^?I$DpKdAI@>|7(4;}JmI)l5OK)j(aUh4 zN5gS=g6ZJJ6l@ZWg-Oq{jp1Ww7wdA9O+=v{IElg#{o9UXv2sHgH|31s2abcHjQ~;U zo5E34bNW$x-^5QI7qir|Nv~$}C!OX@1F<}Yn?{@9hW!*9d`MdN@S_W{VRPy?f;rX^ z&JAnxQ?Y32@bQoUw`x(yLT#_$q8}AT>1g(&;G&-t`6V{)->@Om&_f{S4OR=Fnai^XKB&YNGERWUj%LgNtgrC0yIhcqWO|;5-ah83Z^L zNUIaE{N#ObO!a>*8nf>hk%oAzjT<3eKmNIxTTM+szg%1@7-Wz>&^iMZp+lImYhp<- zN<%Oz+RwAU5R)_LlOUS+T|L>Cc;>+R5-v5OduZlDXR2iYQ(pY}< z3o%Rm$|yAq5q<%#^Kelw4N)-ROO@-hz7#{J=%WT|%B8qd)BV4yPSqqsK*F8sNMWp# z0bLn^OC!Nxm)2N>o;q|Ht~=2nr?RrQ$#2wW6thm(pqUukIlN0U=6GW)7czzVSzz0ua#6E~HRazSdC>+I)He>V73n%e9>Q>|<9+Sn_ zjXR0ba$MRe_FH+vSFqBz@mXJ?p|%H?eae7%gncukb<%I~7sD=!DV2<_rap@b%y6oN#r`tSxmbtsT+39Yl zGFAuY&9W|w>FZZw=heBJTRZJ;x5I_1bocn1?Jn1Ja~Na>k$#8UZ+803E+BGv&3+^{ zciC4tyL!6JK2+P?VRkv(9sbTTuLF5kqYy%)@wQ(HJCm*3Imn!SB1Ra}2B?IK9_;l?2DPbsD>xkJ@Ez!m4ufF6(0U2flZg z^_{XjskO^F{LimGN+CJ5ekuk{H7I~<(1$GTlV=FZxHpkun< z;-+W1?Kgb$kTv+tLq${Gueq)vP}*(x`oJXF_fLkY33@#q^Rf#~mB z2M31Ac;L;FRKDlU67LvWBSjk;kxI{E;({e_mF!4Z{8(eaz%FG8kI;Q3i!YmpyNkt_ zHsIdH;iI#Fy;+1_pU6OQ8H zki|Y~aOfPq;hT~)1I0{JANdcrlzbN4@NLPzlhUo`LZtRP?JiM?c;;JoB1w0=#B_aC zS8P-^ZYbZlK?w-)Ebj5ner3ZjAeoK+ymP~UmG>h)lq8dxW-bZ{U{pA56k0rkh0kE)?=K86X{?*+M$?frW*x z{KRN!Ou@Ak0ilqkc31Q(l)i{1MJ?#hwh~I2neM6&2sUQAv3~O!c^p^9NW%2x^8>;Z zHhL6d%2>j#%dNh(3k?k z|C9q>Xt7&-3i{FDPG!%P1ADFrMH-laVyzb6EQ@`{sd&YrLNrQ-EHit}lV&TS+fa_# zJfP-RloDl`8f7+DS?tR4!98mS_N>!zPb^oI{FxT}Y{jf$QVc9b$x)W6VUvQ#3*5TNaDf;bvxrAAlsA8NOUdVrb|= zD3=MjOS20|4E6g_U_KKP)&+zDCK%U{^a*<0L?&b|BYOnD6LUxsh2&)cp_u7Eg20q8 z{ZFfktd3O}rhL!=)*}AMb<+Lk%w+m=Q0rMtUjpf$&GhlmdUKdw4=Gic?(l-rVLtdA z81%dyzJO4{H(f84vFhMoua{z2@J~aKD}Lw(DUHPkKfXbFE|nE>!*(gB*1X8=S{-iR zfI-((t_;Om?d~?S$KQ!D(%IGJXmi^A4l{KupScx7W{bnz0w+{}`Eg|8~j9+W4K@rCm_>a|WbRI7%)XK&tEb zo&o8L#gm6DO+-Ri+H{*hX+BJXm5w$I!~x2?-0APs0Cxe9i+X6`0Z700jL&E8lv1jEIY?_J6rN&E)@L=gWmf<+a=%OlSdL_8;A?Y;%+X8OgC#}?dy@(&)Cr#vIAC>a)tfNxJN8 z-uk0d+c#7OBi8Bm`R(pjhq>48b&`Fn^-y*MqA;VSM>V-&sJNW1PCs-_sLz`1!|7f} zI-950;q^M($Ofk#43m%~EDmEv>=nwgCgOq94UOas71ri)`1s#`lrqVVK9dB+{43=u z=8=V2?9yoi)0&~YrcMWh4hC4bhhUR`{7=%d)Ej>x>N~#nC#hGsV<wcDAO{`=wnTtqnpl53s`*gEIE@cZI<+6tve}YaQ$KpDIqjmDKw6wB9 zPmAB~bUWJ2EvvOw7y0h7@Hw$|blbvAAovAw!-MJCW(O5G0G&XUMsk z*^G5Va&4TZ+>)oNphiTSA^LGd*cUag8?OCa@zi`gWeZkFo}mF3EwPA*N5@$#ElHsP$pjb`~atWRWT%Wif(-3oXxTdrkWx8%q* zY!9ECBNwwE_vgsxvuF7WIkJVl#J|ds8#3NGrKs4^i02RavRt_;AwrL_|L{Gza%BS9 zKw1mosLEVv{6rgxZJ{^LdFyz8MPa zaf{r7gWksH%Z&-QMkMIxYxCtQe9!qnzC4pX!hfRB6TGrO&c=r;9R+e3W1sQ63K9H@ zKUpZ}V1Legg|e0X#Bp*R%m_Y3ltr9Oc!>ypB=MU?c@lgRSQ#$?i$9|zc|6sMBvwAh zijXbXX_aTCPG1V!Oq_0Rr&&A9vmwiL^croIZ81Zpi_#9%(WQiU9c4_ZHQH^(V_f?dh;Uh^iWd4h?L>SxKod#DgUHU zLdvCGgF^)Xo@XDP$Jv!s&ZM@4G!@@xja@sfT_*iayh+^rbn2^bo9Wj;%HOnG}`mvP_d({+fT}i z+#{$=Orj!1f-HVA$`Y2;kx`bgyiPN7hjM53&Q|E(P=0-RQ)R7LV?_ngT}lS^Y&D_} zJxHxwm{oHXg`QykjoWy4hsrHHJoT6jR%z!ElLEZoQvcJk>J zGF|~-V|w|874ih(PBvy4UsEB^KmQjRsZec;x`lJq>IDP{jUu0FBt(E05e%qO@=$Rp zAOzUx77Xlr+31!0?-la&vOlu8%a`WDPJTow$Gqez7I)zyU<(KbSls+e)TckOxI$R| z2U%POZqKl|L|$GgPwUH{38T$18?!0(u5s$Qv$f(3v|>fw!fJD2*UIL0yVGS4c@erj zJ`ALx_6i8EXbcPpub&N*R8wBJpwHY;-qcjRWMQMm`wz6NN|-GlpACWBu&A-FsqVb$ zP=jj-PM(ecqk89X8=gUY-zn-Xc2R9yO|*%;Q`CjpeHhV*qQkMno#5NE(L9oUeG&W< zLlrhKomK<*Yz$|^WFh*(bvCduYOu{IYsP(nD%WTxu^K%w1 z%Du3@OMS?YMy3+XV(q=uSzxqE$~oZ}WQc^L>`Pe84x*u% z#rPKUm#gI5Ne0%!V&)LAmBmc2%Wre`I@=tBLwObDRZx*bxfp9PW>E;5aXOgDE!A>a zpQW*3L0yw3QqBmGa-FR)Ep-c<77dFOl%=NcXQ{YOlM^**NbJKp!@$-;fnl&#!+mEC zCUTXd-QMH!hetN^K_uU^Mx*eiQ^m~*%gTuKmbS>D=1lx0HBPTj!`?Ssk2{7DYej7Z zM47D#d_<-&eyY}RrFKx_JQWlkPIDBPYO3$%l=I0v()H9wg`G*`FFLp|7%v|j5-;uP z>V{-_RmNzvf=L64JRD_dQz;p;s0M)&x(yB$)vLzBaPB>8)bdS`n!|)(Qbc^1jTmK5 z!|}`XPSM)H;qG;MJ?<{7YYcPteV|t9L=Vp%(PrmHW(dg%h&jRZIZYUkXh<@!ubJ*; zOd{C7m_7~@YW8oYAH&zw$n*OQ>^r8LNG|Q~nJ$s;KQLV!-T#N_qU+Vh0dp0hZYXa- zbxl~zg+|!FLzX3Vb89uo1)4>yC}qkrN=mZ_H3dB=%V&Tyt(}+)!n4;6>#`Y>5f7g* zS1!x}hnhToyGse($XE>dpkV@r9)i_#<@uQ_HeyDV%Jg5i1cWrEf2<>qmWu+ySf+n5 zsxlyCF#Q`>if+f{gxZVQZYIQvJ}nU3uZaxWqO$OSGZ(r+O2gDBeA8$PXVEgMOW}AT$pFM_z{ zznr4z%JXzPP*^t;_VV~HIp3Jp84&!;FqTj6l8>>%V4ho^8;co{>vDPNnAbp14AW(w zM}EzygE#|Urmv(OyIg*WeH?szm3(D#>XcS2CN+0KioBloW^Ix1oLl6zEd88NoNL6o zR`B6lF*O@|t`@5;YH5pz`rGAWqx%XAdp*uJamFa+Tyjx*-I(yZdK_kpPm37D{Fj_c zZI1SET%onKxm#1#qLxniza;~@A}rcLc@Prr+b(CvDW^bq|4E)&P+&IO%vXXa?E$&U z!nr!_UaTLg0iH4-=cX!Wi<%jyWe1*M*MKYu>>%HIx4a}V&$7%`GRSt~O>gT-GzKvHfWK;Ya8t64$IKcWDjb!IF%j*tQ&Ftiv&9F! zHYyijI2cqX2V$jR00uydFSdynXWE){v8{Z4rma;sb5!udOq)AKH#o?@yjD)15t5eX z4tSiqds^Vzfy|NHXmC(c<%nF-9#6BgO;&@=!(m0?AEnr?;a}8SO~H?IZQB^X(PGO9 z1}rv%e!3SsD)OVEjBjIx^~xa28aNdGDgD-RZ%1>d!`1D;b{|sNC=OYMJByt&~?*^%qt+-93J%%g3UZ z9YPvQ1xYiD-^VW!ZJ9;ul#1&9NfkX#m*44bwj;k2P9}$s#pi-XrN5wJwcpX1uPYUm)iwPEm9BP|y~D?ZKH?HsRN3Wh#$bh6DogkT z0I{;mKS^BzW~SvRj8gcu6sC(*vMYfS;{qFBIvjMm94zZ56ev+7Ld|_BxXXjO%|Oxp zg#_-x1_UA`Az2h(2$nyXPLdacvvZ*j5cOqDK+x-7>MQ;8#0cE8>0==QRN z_lUwOM@tWu_1irxt(YjxuX2E#HWoiwsYDg4ob3?Pjy@LcBJxVZ;bw9YHm`K7Mq_nT zL~a$9qcc^psPeRiR`U_}B9U8E<>`Vm4Sq_$gGCppBo$V}glzS+p`!VqDz_RO8119V z;K|;ziY30I@=NvW`n`SjRtFos2Jx1vh%T%{CA>YY zel~F?Ur}r;?8~RJ@)y{}}0h@$F>7Y?a!g1)f&BtJ#MR<6y!RY9@lvQZ$R+2L#CC?tqDlnn(W$;kBmaql+XmJ`Hp|z7G zJxxt%LD=VDqi#{qZgu_nY7jhG0!&m+UIQ^CzLB1h*H2@dk0q@EUa0|PLZVUqX6h;l zKOjv$HZ1fJ#!Tv2U_yghxZUSxqx@>KG(L-SjVsYbpdy$C7%L%Kl}cFc`!V{|K5w7}P`J zb^!HfVLQbZ=WkkY21sX=|*_AUq0eajPVw$vH>Bk|OP z^q=lps(#UMo*p;T6;gp#4K%lv>1Ok0AeiU`e3Aw~wU3DDex|17YizchjK3kxa3$;9 z{&S|VsMir)#rN54`B=ny(`L)X=)0xVX3ZdJEY%P$L`Uj%plMmuN4&DsR?-JlleO4I z*kTmkq{Q@$nn2c~NJOFhSkxD)gbp)66#~a9&~J%kmI`iX>?H`wFr|xo96b)4PZG)N zQO!$WReQRau7$r-YAe786rv~D@>9QwtYV{|)Cbe?@<}!u`;L1j+2-|S5t{r)k}w}L zEk)^;#-0{5Tf+TnggV=2>C`_88&`L!8=hEZEpf4`Uu;|riH9QcvgpG|AvR&L+5v%w zQn4Uh(uD4CYUDOm09K^J!b7*I55l1ieT7X9ZM^u&u@w8mZ#_m2JNy2%$(Vy8k z9SNDb3fLT8q-|Zz;(OKR5}UxKP+_T$qOd|WOhu(GqpnOr8X#EmL)Zkd(<##1*o>9jaq*zm@ZUI8xKa9oeO#k0!M#*$tD&eCD9x*CUNIhOQ1^n^-E zo8RleAhuRTUO*|SnrWnH)R3neTIHy+2&$4IVc6^d6)Ks2%)?kxxoRefOKG2=%KPZ2 zR9t}gk%4rXse>wdzTNAF++zG4t5k4(nXN_-dxg&{vkg|xt({-FsH!^3+M80fpn>+n yMpZ3X&`9@&C3W@Kzv`_jZz_+99{*kAh4mHKo_#%{qAM}2DV;WL+6A`Blm8cr_MM6V delta 383553 zcmd?Sd0bUh_do7F6Za}t@AZP0(aWTuNPuEECZwk31ZfVb1*xUw08MI1LRnd9LRVS( zqy=fEsRgMWEiHJOw6vtOQ45+aEhrm&(#PL>oqG;mZ}$0qKd;~KzaKBR`>bIPXYIAu z-h1u6&wbO{@r_9Dzz(*7^u_GLN~MUt<+gY|zG<2jA;kH~J3;;V4F$>|Y_ zFUuL{TjL57;fyl>?}X=Uk?QB|dY*TNE5~=BLxgXiGs`!?86kT3Ig**fm*EWc9Y98v z+nZe3LUoHaZ94f{+JoSBI+7S_)27Wd1h;RrJJodo2GkVFuM%!*-mNLVD))?TOiuwf zqBb`ov_*(UxEA4pwEs7`sYY&8JTJkmauw`85k69AzR}?~3XgAR_`|4on>N!y@gOiq zxG%rc!w}}NPV>bBR69H*+Sfc#@y+pMi3fbup20}GA}adPh*|yz-_nRAaBq&dF0vXq zaSpMF9f;c@aHTVS@sVCMOm1YV;PRs>ufIpp42cNeO|ArTu5*X_>LL|!4cZE#SR8Ki z@z8 zVYiJ6zLpirn;W7S0&x3^qnC(yUrY4OtrhlOq{41${6Y?;s<-7ha@KWnQq?Z zo2=*UvlIW4#SPnMCXZA^M?)32x86X^?Js|a{5-@YhqY>1fT+n;rvItheD zRQ*kg+n3Y3j|paOhjNws6yKWON#NVtd$73LCoavl4*@s7@^D}7rO~}xAzH*l9ECQ-gC;btmwCn&xHxe>ndoEQ`5 zi^v@kL>^^S^G;uWf47m*Ga`TcCzmgX6_d8-7rYk(J&!L*M}y>-OrIb$I^IpBLa~}Y zm~Pil3nyyh^cA8Z3l4{ZT-{xGeajE0FlTqs3sG#U@Vs!OkA#e1AGVMBs76Biv!A33 zZF}0Me+d9-pZ3}?^{Cv6Uh##6-oB@)Gz9p8$ESdO?eRarw7ufw!ySdTI#%3@|0@JC z+F38Mg`}Z*7pn=BH&e1vog`u?M-t=zhAu*-GG*cB+GdJg`a)TRp%#?eTX<-rB5Lp) z-v@TDR26$H{CG_a$8&zR7-XSN`B5#|TmyfKH6db@_3X5X@hXeRL9UY>5-F#zU;&Np zi&AQAVwrL48|sj-z&BgFi~AqE)s~ zDk>LFstFYeuy`*op*>ddvrE9n6pK(QcZh{RG#pNLQ`M3X8#T8V8GcehdvRMZ>42G7 z|G0x#%mR9FZAVy39U1y$t1sNUxiks^z`s4x@Vp{HM;dg_pSJAroG z)>HTlt7f%tPj26jE=1{Q+71GVp?Gg0GITEMQs`VyYPnQghsaR3o>Y--K!&Cndm84Bww#)-vL-51*0Q*Y`kvL&Q2Gy(E=QX_R#X!rmziLnF3!(d7qC_03Q zkyQA2LNYmrC~;J^xuebA56amQ;WBbuu6k(JYSl@*79fjV85;g8QsaCn-JPz2)K-(XOH&P3x$nlXJGP(ehiw8ro4LoW8p2Z8YFkQH4qz zyA>88?~9Ny$}93HRO1y9bm+D)g_2%@G@O0aP}kA_o;w%#HaazIN^++Kq6P=CLJz<+Lp9teFAHX)2hc&V-Lrw&oi#`f=y8?&yp_avlAG40yF+O}NVrYyjSRL?@ftB*JV*7u#As?>0~_@`HQ1DBDqSlu zO{d&{2@k`xhp?RfW4XqdlmPj*zr&4F61oTfZ7G->7|+tQ1P6NVn*Z`NHzs8 z!~*8&yVVEB@Q9B0YuG6I$BqhM;HD;&4MB(Cx^Ng1a*``a-}Km-e*r;*i#0B zjb|&CW}FS`Ioy*vQpNlTk9e2zFAaB7)>SD^8g($rnRa^+Z=WDo1j3YmFxKtb6x6F` zP)nTfN{+wiU%BqiVmsNJLcFx@ijGdI+a#PKoGR)Sw776g|7)(_2B$BRhrK-_8g z&+0&&bUGED>5xvNPDKx)nj+0v=mnBHD(lTKgw7_+dcbh33G+0U;TRKcZ^FFbo^;@N`RN;znce@c_pggY$ zg7X2hAiI&vt$Aq9nGQ++f0f+Jzg!@>EdT>0_jnMz8n9n-6@!(*6j3Wel?A|2#ywgX z4X70x?Ry|tHsvyneihTQIWLGlv~a8zN_%#TQ1yOL+E9F*=ta#hh#~3&23+P)qiI#O zH|9~NjY?k<3+cpmf&6xeII641gn8)>ahrWFc&|m!scDDo>9PZl_i=Lkv6iy`z_OC9 zH0rxkOcbwB#ZF9GUnSR0I6CTfiWE^t$ANOx2PCSY{H+cwMYn|7!r31F8-eZNYi9g9 z<-RDg?QfXin^g89ro(Ufsz3Gkn&T8|d{Oif?I}{n?D*?+#VLwupf0@PdMX^7;&t^q zci}LZO2w~ZF!oUW(=l$^v|S5TS}--CxRuVha8~f=0R@h$>nMH&>{p+J5GUpA;wfcI zNCd@c?QE2DHr$3MyFyiWv{fkMeH-RSr(%`L&`t{FER6jNF z8cgtgZZRy{_d>Tm?&xxgbyPM{g13P(xq)sBYM@C*10@XsIKfPv*saW0M6#nH&?r#T^boh$ zM)}`4Jk)0w=8peMli;je-C3b>(S`qmcVfW&B={>~FGMHGd=+!u&-G8<5GxfdR%gEr zzXBF^$KMg~NKo$s?31Fx17f@35%N;jL6IfC&}SbM6D2WPuYV5{ZP7@R8{j8u(kmK- zEOq)4f?>5CAmKm!ag*LA=ZRX{i1y+KUu}_F-}<}A z=pcUdk0DDGD*9Os)fG*es)!RX8d9`4$;%&F)mAzqeljo=_MN~Ix}B6~7tOjWT)NdE zTF#eLlOQSWu-?jiQuXSG)1;4u_?5G#(zhK>U-LXg|2SPLQpG9C{RtkcoEu#V6~sx3 zUesIK+D`n2WssXPawVJiotiF}JbGTPbej-=wBl)Lf)qx})Tq!G2TMgZ$7x7~+mwy( zbgH;cN~W4TX_VePQfic>|FogcC9M(<(3bD*A~D zQkc~CteMwzjb527U8~QUEH#JF>zAXzxM6UoEi9CBM2Wt;Q2I=mF7L8~(Qe91cVpc) zU77>Gcl9iuLn^|^T(4riSa(V1Fv^%IrGT|?L_#)|&y+U$ z{W-qe8D46hF2&Kp8>BGMSKJ_tMD)oG(gt{KN^X?;i*tr758WtLi8gxiENMQxJbKej z(nNoK=KCrhaAO7zm!Ke!;iJt`^f_~+8Iq8wVIDHl==S;2b|F)@BFP7cop6#O=#ePV zoooZ(1#=clGiXww6y|Gu0}IM*5vs2#mde#|c3-lnFG1ix?mkh*f-sW*r@RFa)PMz& z-v=KzQMHLkTDw3>?G%HQ{P!pVTP98!Bj_^ncB1A5(v0vBGwVnY_>URd8CzKnW2=c~ zEkw3woMANeQ#FQ~%au_2exa1q)@Id7qIpN;PPFk!kCV!GwGX9&6>i1O{ettBsm0w9 zdm7J%D75FJa2tF+vlmHTI`nl{g__^C*{EuyE0juSby8I37nC0r;ihFZ-ca>J*hVaH zPI;rrxhpEH@>=9^<`D_I42z^mG~i~;hej=PhF0cdpXF3~+px+nI@@ULDb+@KKVl1| zd|m>!Cn$fZ4HCNEV-tfYcX^bX`fLvm^VM9Z#IrznF@<7{b&`hIsyE}}DL&f+Ps1qq zxXbTNR3h!bGD8{yGju^v`580FPHu`jn5;yyAbHusd@LgwvB5{xQQc9IlgZH7JEbr~ z@}L=OpIL~F1XTT;?4^S6?xB>^1*RtBy-qe-+*QLX9f?z7%ODZ1H7~Dt?#rt(Ub*og zR6w==ih#d+c!WZ)_kiy(V`_w==iMds5tLE{sqJe~os~0@)z-xj-_}x~`aJCjqoa>1 zHY!>y!P8nIt@E4L5c*_^^nvK0Z!49iNa71ByS0N?&F1AlReu(TInBN3((UMtd!@V3 zKXaE#>B8ZU+WVsp{>bT%Tt54FnRU=-;K%MuJ^rslB<2k(paK-m0yPsM9w!~u@KV$b!8el%_&F@IdWs#WEh7h>IR@p>FF1!m zv`ffgFmnfC@h+O1*Ovi@Oxzo2mbgE7870ZLiT-r8EI%U#&{j zN`M13IbCv!cG|iNTcLQ64LX=+zx%uMk7^ zdbcbKaRrG^aw;{4$wS02eoi*Lki)4kTz*1~V9b)qZkNcIcjYnP6p>G{8S-`FDk|Y<939J$heeJ@8SGqPu?<4tKQ!@rO=BWie<->F|L+(KZ zz2pq|@hf`C(Wu$BUh>V7GzI(1S#lJOQqcQzE|vS>Jr-Rmzb2;Y1GD823EZaIq$e5q8PBWHoD;_7I({xLs`>#*M^8ZMXL zLjBhcmTzPo6hq~A5FH#UFHj4>98In+a3ke7yrKG>E9B+e3a5v$nv_uF2zddbiV?EU zUI^aK5R;dxW6?iLyGTl9V+UCDE9Ft(S$`#~HnT?4@R3l#>*?x|^37s8)pOLI(niU> zz)&~}&7j+{C0rDtaF)l=6v?!OaH3(Cs;dRNYj?todH7vq_gmIr25)&<5ysVAK*kZ(m*3kwaQ9xRkMELjLvwtJlHelr;x6i&A2 zBD8dqcIQQC+&?(oT^FH+n>4OkKzUI{J-ObTkoB*XNcQRS!^W;Zu$YLrCSWY7nJz~d zrnC(;WMQcPdb+$6^V8WgPOQrrVvmD`E+`X3Ej7QY2-Y!fP%rpo|92WYb2s z&y;nfOS?fHB<|7Y-oWY|K}T*xhv|pOtNa;=yn$IcfhPvD-0_OK;*2v3n*x|ml^3Ae%Q*T*^K?(BN`8Z5l ziSBwr{z{SF!kX!%+({4JD6dn*KH9tq=`}jJ38UmbRDjhi0fGOFSrl-BG9ONWA7Hbb zWM>{;UL;f5x3XI=-7Mz`WYh30M#z11@>$F=_R+vCa zXyEghCuy|pd3j>wCS=2oN?x3>%JZMUr^MDEKMcn;aw-gFagF?$>m6ik8CdSoSCbg; z#(bn!E`l_hYUKyQxl1J?aO`T$tKnii%Sm@S9r_qc zz7y^kDBA$c^pzLoJoO<|auC&P?clTd#tR3_i}G^&K_LCoi`^xUwZGd6);Gbt7U}YM z@emzj(tE8WgY!@;_&3gmR+7Q_ek;hFdev_Eun-^6?pNd~`k|L)n-GWTlRcOu9-&2h z5q(IJuORw}Ilgm!jMO{;ePYI+Qthj1%(q3Ut%J-&>WBdGj?_KJa%Y5l+Dzr-o;+p zko$lj*YJ3>>6=g{jmqAXw>!QAnhWRQ!LH}NC6i+R-o)*vrgt!j=ag-z_UbNJ%pWjP zW*(3e9mjz_U-iNR(99nw_n|0S_~{}XKQl)v#r**9)uB}E z-W2r@fs4TwiF0C~cCpc(shw=Tnq@XS52($^00wnTmu%ypWKZh*u6(1T1y~-S{L0-XDJmle6}ee+ctY z!=0A2zFQbAJ%qmZ2h{^B{`5zu^<#(RUb6i^D1g0FPgC*3E_dZ)F#5}W?}kbKVOf#> zf`e-smiBQ+&_@p(jIhz6ufR~WTPQBB>=`7sv<9=mdvL~W-C+!;GY!X9#1YIkuV+V8 zvM7XC3QON3@}KszRwAnSQ0`^_Z!384L-{W0oS-W|lJB(h#K$k5gC7}|?DR*Nv`*4@ ze=KhoE&*zwmS0WznH|0Qx=+!ApfSfkljpl6@U#jUg(y^iOdd;9ZwtX0z$awIaLfU3 z*iZ#Ax0g)Ej>;c66r^P{=&!-vWAb$_)hyC_UufEsVQ{5(O00yc$mpHtw_Yr?SJkz&8Z#D72Keu=Tt zP3!$oJwss@l>3!@FQop)SMmeG9^RU7^+DLExNWLJbH0(oT%9;;)Eto^MGsYcBYPbY z7C)pcQ*}K~yz&Xb#&6^ld!$7p*SB(FJg-I69&QrTA_I9+#KUhL`&JWmL30G>;*QRcKR zZoT=qJY2w^)b~fM#k@54M;H=bUA3Y3jYwMaBP8XelRz7bE)d#0N)>0kQ08OUrag46 zjE&qAa+1r7{P`~)fomQ|xoPMRHEUEjGp8oUJ?eyW=))A4`4e)fh^K)kvDoy|w3BGl z1f=DbUr9Sp%Gaq3%GBU>dyVszLw1WLN@~UB%*8MEQ=ld}xQy>2T#!F zI+|9(dZ1ei%wIRqFEox7Epl}15U}w)hO_8?F_z@a)L^t(gE%CyOhFIuvWMp{Iy;Gs~p|CH&DEiwcZntM&kl)=mk%fS+bV~^3h2o zb!1X#2a06=V`au3D6P7sgR?RZXU9%W$8JEucMd1*JB4Zg zWmNlDjEAN!!Kkz2ov0**(^B~@I5<()$s0;1HiX*f`$%kN2qo;8m7VgZZUlfnAqvNaVuTbb;@H^o!@?Xf(nl`PbTo3GO>0k1nVxYe0jGQXr zEsze^dG0~S{I8q@kER7zo&%WE3Q`Wkxdu$-_uE2!HT`Y+@^hH`!=vdEif8p6WxN=y z!v~bn4wYD)+V(Lup%#;(=?w1rar_$E>n328UV(s&U03c+tP3lo(2 zVhlATD1$^6xe}Fe;UgeH&V>D02?(4ZheQupePJybXG;?jD5)BvdL5}kLjhxp- ziJ;OXC~#a7#E|bNUUeaHfEedT97H`@1UH zP(6{X!0+0V>?sPi>0ZGA-FzMQz!W70K4Kn`^nw&+lmsX7w(d%{W1=Y=e#x=a(p`yG zCjoU6HFU=z%gK1Oyjo)^GZk-e4UJA!dO^|3Qk990DPU-I(&*m+C9n_~m&GeU$AsIE=ZEPzKK4W9Y-_ zs9a@}dM#4IU7HbsH%drS^yXZp$mLginmG2qDtA|^Ym#l!^(dyMV`nP(0h`pJ1xgrY-P#2^cm+zIaDHo6M;?=A zA+S|#raUch3p^xJ4GE@mo4(%Clpmot?Y zB{&r_i@>UHovkd@{Lo0Vdts@((CD#E_oC@DhJ;~FvIx>MoEMbaj1BkYiHqWUf)k-AW>& z>bn*H(o3eo-@VDyI2!tvw?xUIIv;FQ&Jy&0tVl+bLO0-UDplAobG8&YqTMQ<4Rz~_ z?@Ry zT#<3TjH(|&vum^$k?DOZybBwnhhi1~`UvXT>WO9D)yTCHhOix#tu*vy{YqoFiT9z` z>|3eyL0+OV;7gUWb>v+Gwh;y$zYCtwIOT^ukrj6C(U9azxdP+_^9FFf@b0D-~}flhB)u zVPHC9F8D75LAiG$%YsTJ0w-wb&PwGLF_TVKDibd=$Y9~RT9)De9!K|(GEdwP-e!x*113`h;|%t!tDzF-M=fR(VVkbN!1H3<);l zgaMV0j*g+cb;>4e51n48B)aBvrl=y%zj<^l((~6V52)RWf#=yV3*i<#=OX4mhHnj^ z-9}=ALWb*}?H~uXr#e30q$O-esW{6)3j;Xp~=P6q}CHwK%W zEy{Q%S8h=%C2p=uo>RJlt$qd0j?H>b`JQoCJ+DmQ_}S-`OTz=J!p+Vve>?s5ypnEI zUE(!wG@s7(JAd@iHOhO!$}!^wWijXU+zU#A8AthYVE3D0{4FNic4eJeQ(yB?%p|uf z%PiW|9SUE8tKX>%qJkHd7}}#_Mp3#`$-%Z9u+gnWHNU8=io64@!afaNb!)~Rs%IdHB zDsZ@=YPV8q)o)HX4iy#bz+sm0FDZYDJN3~oqfTA!LYZ6#o^sre{xktGubA*?;0^U) zeSpt&k8%iaSiDymYn0KJikC&>!c9I8F|oLscVe%Sg3*yWy`uD_KC^LPef%pJFBeP3 z`8ECME06^ac*NEzui^sQ

Add to the list of include directories" +let mk_H f = + "-H", Arg.String f, + " Add to the list of \"hidden\" include directories\n\ + \ (Like -I, but the program can not directly reference these dependencies)" + let mk_impl f = "-impl", Arg.String f, " Compile as a .ml file" @@ -755,6 +760,7 @@ module type Common_options = sig val _no_absname : unit -> unit val _alert : string -> unit val _I : string -> unit + val _H : string -> unit val _labels : unit -> unit val _alias_deps : unit -> unit val _no_alias_deps : unit -> unit @@ -1025,6 +1031,7 @@ struct mk_stop_after ~native:false F._stop_after; mk_i F._i; mk_I F._I; + mk_H F._H; mk_impl F._impl; mk_intf F._intf; mk_intf_suffix F._intf_suffix; @@ -1123,6 +1130,7 @@ struct mk_no_absname F._no_absname; mk_alert F._alert; mk_I F._I; + mk_H F._H; mk_init F._init; mk_labels F._labels; mk_alias_deps F._alias_deps; @@ -1217,6 +1225,7 @@ struct mk_save_ir_after ~native:true F._save_ir_after; mk_i F._i; mk_I F._I; + mk_H F._H; mk_impl F._impl; mk_inline F._inline; mk_inline_toplevel F._inline_toplevel; @@ -1355,6 +1364,7 @@ module Make_opttop_options (F : Opttop_options) = struct mk_alert F._alert; mk_compact F._compact; mk_I F._I; + mk_H F._H; mk_init F._init; mk_inline F._inline; mk_inline_toplevel F._inline_toplevel; @@ -1460,6 +1470,7 @@ struct mk_no_absname F._no_absname; mk_alert F._alert; mk_I F._I; + mk_H F._H; mk_impl F._impl; mk_intf F._intf; mk_intf_suffix F._intf_suffix; @@ -1587,7 +1598,8 @@ module Default = struct module Core = struct include Common - let _I dir = include_dirs := (dir :: (!include_dirs)) + let _I dir = include_dirs := dir :: (!include_dirs) + let _H dir = hidden_include_dirs := dir :: (!hidden_include_dirs) let _color = Misc.set_or_ignore color_reader.parse color let _dlambda = set dump_lambda let _dparsetree = set dump_parsetree @@ -1839,6 +1851,11 @@ module Default = struct (* placeholder: Odoc_global.include_dirs := (s :: (!Odoc_global.include_dirs)) *) () + let _H(_:string) = + (* placeholder: + Odoc_global.hidden_include_dirs := + (s :: (!Odoc_global.hidden_include_dirs)) + *) () let _impl (_:string) = (* placeholder: Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s]) diff --git a/driver/main_args.mli b/driver/main_args.mli index e7427d2838d..dfc6ad4753d 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -21,6 +21,7 @@ module type Common_options = sig val _no_absname : unit -> unit val _alert : string -> unit val _I : string -> unit + val _H : string -> unit val _labels : unit -> unit val _alias_deps : unit -> unit val _no_alias_deps : unit -> unit diff --git a/driver/makedepend.ml b/driver/makedepend.ml index c2c007d5872..c90a22036fd 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -393,7 +393,8 @@ let process_file_as process_fun def source_file = load_path := []; let cwd = if !nocwd then [] else [Filename.current_dir_name] in List.iter add_to_load_path ( - (!Compenv.last_include_dirs @ + (!Clflags.hidden_include_dirs @ + !Compenv.last_include_dirs @ !Clflags.include_dirs @ !Compenv.first_include_dirs @ cwd @@ -584,6 +585,8 @@ let run_main argv = " Dump the delayed dependency map for each map file"; "-I", Arg.String (prepend_to_list Clflags.include_dirs), " Add to the list of include directories"; + "-H", Arg.String (prepend_to_list Clflags.hidden_include_dirs), + " Add to the list of include directories"; "-nocwd", Arg.Set nocwd, " Do not add current working directory to \ the list of include directories"; diff --git a/manual/src/cmds/ocamldep.etex b/manual/src/cmds/ocamldep.etex index 93d6741d02b..1213cb9b1b2 100644 --- a/manual/src/cmds/ocamldep.etex +++ b/manual/src/cmds/ocamldep.etex @@ -65,6 +65,12 @@ and no dependencies are generated. For programs that span multiple directories, it is recommended to pass "ocamldep" the same "-I" options that are passed to the compiler. +\item["-H" \var{directory}] +Behaves identically to "-I", except that the "-H" directories are searched +last. This flag is included to make it easier to invoke "ocamldep" with +the same options as the compiler, where "-H" is used for transitive +dependencies that the program should not directly mention. + \item["-nocwd"] Do not add current working directory to the list of include directories. diff --git a/manual/src/cmds/ocamldoc.etex b/manual/src/cmds/ocamldoc.etex index e2488f6f0a3..286aa335cf1 100644 --- a/manual/src/cmds/ocamldoc.etex +++ b/manual/src/cmds/ocamldoc.etex @@ -207,6 +207,10 @@ They have the same meaning as for the "ocamlc" and "ocamlopt" commands. Add \var{directory} to the list of directories search for compiled interface files (".cmi" files). +\item["-H" \var{directory}] +Like "-I", but the "-H" directories are searched last and the program may +not directly refer to the modules included this way. + \item["-nolabels"] Ignore non-optional labels in types. diff --git a/manual/src/cmds/unified-options.etex b/manual/src/cmds/unified-options.etex index ec161dedd9f..a409557f671 100644 --- a/manual/src/cmds/unified-options.etex +++ b/manual/src/cmds/unified-options.etex @@ -300,6 +300,16 @@ the toplevel is running with the "#directory" directive (section~\ref{s:toplevel-directives}). }%top +\notop{% +\item["-H" \var{directory}] +Behaves identically to "-I", except that (a) programs may not directly refer to +modules added to the search path this way, and (b) these directories are +searched after any "-I" directories. This makes it possible to provide the +compiler with compiled interface and object code files for the current program's +transitive dependencies (the dependencies of its dependencies) without allowing +them to silently become direct dependencies. +}%notop + \top{% \item["-init" \var{file}] Load the given file instead of the default initialization file. diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index cad9ae4a13e..8d61505931d 100644 --- a/ocamldoc/odoc_args.ml +++ b/ocamldoc/odoc_args.ml @@ -187,6 +187,7 @@ let anonymous f = module Options = Main_args.Make_ocamldoc_options(struct include Main_args.Default.Odoc_args let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs + let _H s = Odoc_global.hidden_include_dirs := s :: !Odoc_global.hidden_include_dirs let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s] let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s] end) diff --git a/ocamldoc/odoc_global.ml b/ocamldoc/odoc_global.ml index 3bb1a67cd4a..221745438a0 100644 --- a/ocamldoc/odoc_global.ml +++ b/ocamldoc/odoc_global.ml @@ -24,6 +24,7 @@ type source_file = | Text_file of string let include_dirs = Clflags.include_dirs +let hidden_include_dirs = Clflags.hidden_include_dirs let errors = ref 0 diff --git a/ocamldoc/odoc_global.mli b/ocamldoc/odoc_global.mli index c85b453453b..1e3df3ec2ae 100644 --- a/ocamldoc/odoc_global.mli +++ b/ocamldoc/odoc_global.mli @@ -24,6 +24,9 @@ type source_file = (** The include_dirs in the OCaml compiler. *) val include_dirs : string list ref +(** The hidden_include_dirs in the OCaml compiler. *) +val hidden_include_dirs : string list ref + (** The merge options to be used. *) val merge_options : Odoc_types.merge_option list ref diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml index d4a73fe1ed9..8a80224452f 100644 --- a/ocamldoc/odoc_info.ml +++ b/ocamldoc/odoc_info.ml @@ -111,6 +111,7 @@ module Module = Odoc_module let analyse_files ?(merge_options=([] : Odoc_types.merge_option list)) ?(include_dirs=([] : string list)) + ?(hidden_include_dirs=([] : string list)) ?(labels=false) ?(sort_modules=false) ?(no_stop=false) @@ -118,6 +119,7 @@ let analyse_files files = Odoc_global.merge_options := merge_options; Odoc_global.include_dirs := include_dirs; + Odoc_global.hidden_include_dirs := hidden_include_dirs; Odoc_global.classic := not labels; Odoc_global.sort_modules := sort_modules; Odoc_global.no_stop := no_stop; diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index da53554f892..bb4aa1d89e3 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -1082,12 +1082,13 @@ end val analyse_files : ?merge_options:Odoc_types.merge_option list -> ?include_dirs:string list -> - ?labels:bool -> - ?sort_modules:bool -> - ?no_stop:bool -> - ?init: Odoc_module.t_module list -> - Odoc_global.source_file list -> - Module.t_module list + ?hidden_include_dirs:string list -> + ?labels:bool -> + ?sort_modules:bool -> + ?no_stop:bool -> + ?init: Odoc_module.t_module list -> + Odoc_global.source_file list -> + Module.t_module list (** Dump of a list of modules into a file. @raise Failure if an error occurs.*) diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 1076969953d..916eda60d8d 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -879,11 +879,16 @@ module PpxContext = struct } let make ~tool_name () = + let Load_path.{ visible; hidden } = Load_path.get_path_info () in let fields = [ lid "tool_name", make_string tool_name; - lid "include_dirs", make_list make_string !Clflags.include_dirs; - lid "load_path", make_list make_string (Load_path.get_paths ()); + 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; @@ -952,6 +957,8 @@ module PpxContext = struct 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. *) @@ -962,7 +969,10 @@ module PpxContext = struct let alert = Location.auto_include_alert in Load_path.auto_include_otherlibs alert find_in_dir fn in - Load_path.init ~auto_include (get_list get_string payload) + 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" -> diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli index 56e3349f843..7c74ef41061 100644 --- a/parsing/ast_mapper.mli +++ b/parsing/ast_mapper.mli @@ -122,8 +122,8 @@ val tool_name: unit -> string ["ocaml"], ... Some global variables that reflect command-line options are automatically synchronized between the calling tool and the ppx preprocessor: {!Clflags.include_dirs}, - {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, - {!Clflags.debug}. *) + {!Clflags.hidden_include_dirs}, {!Load_path}, {!Clflags.open_modules}, + {!Clflags.for_package}, {!Clflags.debug}. *) val apply: source:string -> target:string -> mapper -> unit diff --git a/testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference b/testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference new file mode 100644 index 00000000000..2d834047bf9 --- /dev/null +++ b/testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference @@ -0,0 +1,4 @@ +File "libc/c3.ml", line 1, characters 8-11: +1 | let x = A.x + 1 + ^^^ +Error: Unbound module A diff --git a/testsuite/tests/hidden_includes/liba/a.ml b/testsuite/tests/hidden_includes/liba/a.ml new file mode 100644 index 00000000000..2be7c57aa2a --- /dev/null +++ b/testsuite/tests/hidden_includes/liba/a.ml @@ -0,0 +1,3 @@ +type t = int + +let x = 1 diff --git a/testsuite/tests/hidden_includes/liba_alt/a.ml b/testsuite/tests/hidden_includes/liba_alt/a.ml new file mode 100644 index 00000000000..e907a667ba2 --- /dev/null +++ b/testsuite/tests/hidden_includes/liba_alt/a.ml @@ -0,0 +1,3 @@ +type t = string + +let x = "hi" diff --git a/testsuite/tests/hidden_includes/libb/b.ml b/testsuite/tests/hidden_includes/libb/b.ml new file mode 100644 index 00000000000..d6a1c3a539f --- /dev/null +++ b/testsuite/tests/hidden_includes/libb/b.ml @@ -0,0 +1,5 @@ +type t = A.t + +let x : A.t = A.x + +let f : A.t -> A.t = fun x -> x diff --git a/testsuite/tests/hidden_includes/libc/c1.ml b/testsuite/tests/hidden_includes/libc/c1.ml new file mode 100644 index 00000000000..e0e5a1fd8d9 --- /dev/null +++ b/testsuite/tests/hidden_includes/libc/c1.ml @@ -0,0 +1,3 @@ +let x = B.x + 1 + +let () = Printf.printf "%d\n" x diff --git a/testsuite/tests/hidden_includes/libc/c2.ml b/testsuite/tests/hidden_includes/libc/c2.ml new file mode 100644 index 00000000000..dee5a2e74b9 --- /dev/null +++ b/testsuite/tests/hidden_includes/libc/c2.ml @@ -0,0 +1 @@ +let x = B.f B.x diff --git a/testsuite/tests/hidden_includes/libc/c3.ml b/testsuite/tests/hidden_includes/libc/c3.ml new file mode 100644 index 00000000000..88c0aa8d0d6 --- /dev/null +++ b/testsuite/tests/hidden_includes/libc/c3.ml @@ -0,0 +1 @@ +let x = A.x + 1 diff --git a/testsuite/tests/hidden_includes/not_included.ocamlc.reference b/testsuite/tests/hidden_includes/not_included.ocamlc.reference new file mode 100644 index 00000000000..5a15a116e12 --- /dev/null +++ b/testsuite/tests/hidden_includes/not_included.ocamlc.reference @@ -0,0 +1,6 @@ +File "libc/c1.ml", line 1, characters 8-11: +1 | let x = B.x + 1 + ^^^ +Error: This expression has type A.t but an expression was expected of type + int + A.t is abstract because no corresponding cmi file was found in path. diff --git a/testsuite/tests/hidden_includes/test.ml b/testsuite/tests/hidden_includes/test.ml new file mode 100644 index 00000000000..876ae6f9284 --- /dev/null +++ b/testsuite/tests/hidden_includes/test.ml @@ -0,0 +1,136 @@ +(* This tests the -H flag. + + The basic structure is that libc depends on libb, which depends on liba. We + want to test a few things: + + - Compiling libc with -I liba allows the compiler to see the type definitions + in liba and allows c.ml to reference it directly. + + - Compiling libc with -H liba allows the compiler to see the type definitions + in liba, but doesn't allow c.ml to reference it directly. + + - If -H and -I are are passed for two different versions of liba, the -I one + takes priority. + + - If -H is passed twice with two different versions of liba, the first takes + priority. + + The liba_alt directory has an alternate versions of liba used for testing the + precedence order of the includes. +*) + + +(* TEST + +subdirectories = "liba liba_alt libb libc"; +setup-ocamlc.byte-build-env; + +flags = "-I liba -nocwd"; +module = "liba/a.ml"; +ocamlc.byte; + +flags = "-I liba_alt -nocwd"; +module = "liba_alt/a.ml"; +ocamlc.byte; + +flags = "-I liba -I libb -nocwd"; +module = "libb/b.ml"; +ocamlc.byte; +{ + (* Test hiding A completely *) + flags = "-I libb -nocwd"; + module = "libc/c2.ml"; + setup-ocamlc.byte-build-env; + ocamlc.byte; +} +{ + (* Test hiding A completely, but using it *) + flags = "-I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc_byte_exit_status = "2"; + ocamlc.byte; + compiler_reference = "${test_source_directory}/not_included.ocamlc.reference"; + check-ocamlc.byte-output; +} +{ + (* Test transitive use of A's cmi with -I. *) + flags = "-I liba -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc.byte; +} +{ + (* Test transitive use of A's cmi with -H. *) + flags = "-H liba -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc.byte; +} +{ + (* Test direct use of A cmi with -H. *) + flags = "-H liba -I libb -nocwd"; + module = "libc/c3.ml"; + setup-ocamlc.byte-build-env; + ocamlc_byte_exit_status = "2"; + ocamlc.byte; + compiler_reference = + "${test_source_directory}/cant_reference_hidden.ocamlc.reference"; + check-ocamlc.byte-output; +} + +(* The next four tests check that -I takes priority over -H regardless of the + order on the command line. +*) +{ + flags = "-H liba_alt -I liba -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc.byte; +} +{ + flags = "-I liba -H liba_alt -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc.byte; +} +{ + flags = "-H liba -I liba_alt -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc_byte_exit_status = "2"; + ocamlc.byte; + compiler_reference = + "${test_source_directory}/wrong_include_order.ocamlc.reference"; + check-ocamlc.byte-output; +} +{ + flags = "-I liba_alt -H liba -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc_byte_exit_status = "2"; + ocamlc.byte; + compiler_reference = + "${test_source_directory}/wrong_include_order.ocamlc.reference"; + check-ocamlc.byte-output; +} + +(* The next two tests show that earlier -Hs take priority over later -Hs *) +{ + flags = "-H liba_alt -H liba -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc_byte_exit_status = "2"; + ocamlc.byte; + compiler_reference = + "${test_source_directory}/wrong_include_order.ocamlc.reference"; + check-ocamlc.byte-output; +} +{ + flags = "-H liba -H liba_alt -I libb -nocwd"; + module = "libc/c1.ml"; + setup-ocamlc.byte-build-env; + ocamlc.byte; +} + +*) diff --git a/testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference b/testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference new file mode 100644 index 00000000000..cb4538eb625 --- /dev/null +++ b/testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference @@ -0,0 +1,3 @@ +File "libc/c1.ml", line 1: +Error: The files libb/b.cmi and liba_alt/a.cmi make inconsistent assumptions + over interface A diff --git a/testsuite/tests/self-contained-toplevel/main.ml b/testsuite/tests/self-contained-toplevel/main.ml index c3342b6b405..23caa21d434 100644 --- a/testsuite/tests/self-contained-toplevel/main.ml +++ b/testsuite/tests/self-contained-toplevel/main.ml @@ -23,14 +23,14 @@ let () = if Sys.file_exists "foo.cmi" then Sys.remove "foo.cmi"; let module Persistent_signature = Persistent_env.Persistent_signature in let old_loader = !Persistent_signature.load in - Persistent_signature.load := (fun ~unit_name -> + Persistent_signature.load := (fun ~allow_hidden ~unit_name -> match unit_name with | "Foo" -> Some { Persistent_signature. filename = Sys.executable_name ; cmi = Marshal.from_string Cached_cmi.foo 0 } - | _ -> old_loader unit_name); + | _ -> old_loader ~allow_hidden ~unit_name); Toploop.add_hook (function | Toploop.After_setup -> Toploop.toplevel_env := diff --git a/tools/ocamlcmt.ml b/tools/ocamlcmt.ml index 399a2232dd6..8036148c2be 100644 --- a/tools/ocamlcmt.ml +++ b/tools/ocamlcmt.ml @@ -174,7 +174,7 @@ let main () = | Some _ as x -> x in Envaux.reset_cache (); - List.iter Load_path.add_dir cmt.cmt_loadpath; + List.iter (Load_path.add_dir ~hidden:false) cmt.cmt_loadpath; Cmt2annot.gen_annot target_filename ~sourcefile:cmt.cmt_sourcefile ~use_summaries:cmt.cmt_use_summaries diff --git a/toplevel/topcommon.ml b/toplevel/topcommon.ml index 88360734409..1a2702f49db 100644 --- a/toplevel/topcommon.ml +++ b/toplevel/topcommon.ml @@ -263,18 +263,23 @@ let set_paths ?(auto_include=Compmisc.auto_include) () = but keep the directories that user code linked in with ocamlmktop may have added to load_path. *) let expand = Misc.expand_directory Config.standard_library in - let current_load_path = Load_path.get_paths () in - let load_path = List.concat [ + let Load_path.{ visible; hidden } = Load_path.get_path_info () in + let visible = List.concat [ [ "" ]; List.map expand (List.rev !Compenv.first_include_dirs); List.map expand (List.rev !Clflags.include_dirs); List.map expand (List.rev !Compenv.last_include_dirs); - current_load_path; + visible; [expand "+camlp4"]; ] in - Load_path.init ~auto_include load_path; - Dll.add_path load_path + let hidden = List.concat [ + List.map expand (List.rev !Clflags.hidden_include_dirs); + hidden + ] + in + Load_path.init ~auto_include ~visible ~hidden; + Dll.add_path (visible @ hidden) let update_search_path_from_env () = let extra_paths = diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 140aaa77b7c..dea295b7c86 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -75,7 +75,7 @@ let _ = add_directive "quit" (Directive_none dir_quit) let dir_directory s = let d = expand_directory Config.standard_library s in Dll.add_path [d]; - let dir = Load_path.Dir.create d in + let dir = Load_path.Dir.create ~hidden:false d in Load_path.prepend_dir dir; toplevel_env := Stdlib.String.Set.fold diff --git a/typing/env.ml b/typing/env.ml index 7bd8e037e21..399d5e1824b 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -1028,7 +1028,7 @@ 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 (Ident.name id) + | Mod_persistent -> find_pers_mod ~allow_hidden:true (Ident.name id) let rec find_module_components path env = match path with @@ -2764,10 +2764,10 @@ let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env = | Mod_persistent -> begin match load with | Don't_load -> - check_pers_mod ~loc s; + check_pers_mod ~allow_hidden:false ~loc s; path, (() : a) | Load -> begin - match find_pers_mod s with + match find_pers_mod ~allow_hidden:false s with | mda -> use_module ~use ~loc path mda; path, (mda : a) @@ -3272,7 +3272,7 @@ let bound_module name env = | exception Not_found -> if Current_unit_name.is name then false else begin - match find_pers_mod name with + match find_pers_mod ~allow_hidden:false name with | _ -> true | exception Not_found -> false end diff --git a/typing/persistent_env.ml b/typing/persistent_env.ml index 41ac7aeff44..ab19cbb2866 100644 --- a/typing/persistent_env.ml +++ b/typing/persistent_env.ml @@ -36,10 +36,14 @@ module Persistent_signature = struct { filename : string; cmi : Cmi_format.cmi_infos } - let load = ref (fun ~unit_name -> - match Load_path.find_normalized (unit_name ^ ".cmi") with - | filename -> Some { filename; cmi = read_cmi filename } - | exception Not_found -> None) + let load = ref (fun ~allow_hidden ~unit_name -> + let find = + Load_path.(if allow_hidden then find_normalized + else find_visible_normalized) + in + match find (unit_name ^ ".cmi") with + | filename -> Some { filename; cmi = read_cmi filename } + | exception Not_found -> None) end type can_load_cmis = @@ -202,7 +206,7 @@ let read_pers_struct penv val_of_pers_sig check cmi = let ps = acknowledge_pers_struct penv check modname pers_sig pm in (ps, pm) -let find_pers_struct penv val_of_pers_sig check name = +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 @@ -213,7 +217,7 @@ let find_pers_struct penv val_of_pers_sig check name = | Cannot_load_cmis _ -> raise Not_found | Can_load_cmis -> let psig = - match !Persistent_signature.load ~unit_name:name with + match !Persistent_signature.load ~allow_hidden ~unit_name:name with | Some psig -> psig | None -> Hashtbl.add persistent_structures name Missing; @@ -226,9 +230,9 @@ let find_pers_struct penv val_of_pers_sig check name = module Style = Misc.Style (* Emits a warning if there is no valid cmi for name *) -let check_pers_struct penv f ~loc name = +let check_pers_struct ~allow_hidden penv f ~loc name = try - ignore (find_pers_struct penv f false name) + ignore (find_pers_struct ~allow_hidden penv f false name) with | Not_found -> let warn = Warnings.No_cmi_file(name, None) in @@ -259,10 +263,10 @@ let check_pers_struct penv f ~loc name = let read penv f a = snd (read_pers_struct penv f true a) -let find penv f name = - snd (find_pers_struct penv f true name) +let find ~allow_hidden penv f name = + snd (find_pers_struct ~allow_hidden penv f true name) -let check penv f ~loc 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 @@ -271,11 +275,11 @@ let check penv f ~loc name = add_import penv name; if (Warnings.is_active (Warnings.No_cmi_file("", None))) then !add_delayed_check_forward - (fun () -> check_pers_struct penv f ~loc name) + (fun () -> check_pers_struct ~allow_hidden penv f ~loc name) end let crc_of_unit penv f name = - let (ps, _pm) = find_pers_struct penv f true name in + let (ps, _pm) = find_pers_struct ~allow_hidden:true penv f true name in let crco = try List.assoc name ps.ps_crcs diff --git a/typing/persistent_env.mli b/typing/persistent_env.mli index 2a9420a8c44..432c41fc2d8 100644 --- a/typing/persistent_env.mli +++ b/typing/persistent_env.mli @@ -37,7 +37,7 @@ module Persistent_signature : sig (** 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 : (unit_name:string -> t option) ref + val load : (allow_hidden:bool -> unit_name:string -> t option) ref end type can_load_cmis = @@ -54,11 +54,12 @@ 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 : 'a t -> (Persistent_signature.t -> 'a) -> modname -> '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 : 'a t -> (Persistent_signature.t -> 'a) +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 diff --git a/typing/typemod.ml b/typing/typemod.ml index 55365987bec..aa2f25a722e 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -136,7 +136,7 @@ let initial_env ~loc ~initially_opened_module env in let units = - List.map Env.persistent_structures_of_dir (Load_path.get ()) + List.map Env.persistent_structures_of_dir (Load_path.get_visible ()) in let env, units = match initially_opened_module with diff --git a/utils/ccomp.ml b/utils/ccomp.ml index 33a4c9d0b41..e27141ba782 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -115,7 +115,8 @@ let compile_file ?output ?(opt="") ?stable_name name = (String.concat " " (List.rev !Clflags.all_ccopts)) (quote_prefixed ~response_files:true "-I" (List.map (Misc.expand_directory Config.standard_library) - (List.rev !Clflags.include_dirs))) + (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 diff --git a/utils/clflags.ml b/utils/clflags.ml index 5ba6e04688a..b7ac07204b3 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -46,7 +46,8 @@ 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 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 *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 0fc0c56e4f3..72a0053236a 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -75,6 +75,7 @@ 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 diff --git a/utils/load_path.ml b/utils/load_path.ml index 4042fb8e7cc..5db3a0d9b97 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -19,17 +19,22 @@ module STbl = Misc.Stdlib.String.Tbl (* Mapping from basenames to full filenames *) type registry = string STbl.t -let files : registry ref = s_table STbl.create 42 -let files_uncap : registry ref = s_table STbl.create 42 +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 @@ -56,26 +61,42 @@ module Dir = struct with Sys_error _ -> [||] - let create path = - { path; files = Array.to_list (readdir_compat path) } + 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 dirs = s_ref [] +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 !files; - STbl.clear !files_uncap; - dirs := []; + 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 () = List.rev !dirs -let get_paths () = List.rev_map Dir.path !dirs +let get_visible () = List.rev !visible_dirs + +let get_paths () = + Misc.rev_map_end Dir.path !visible_dirs (List.rev_map Dir.path !hidden_dirs) + +type path_info = + { visible : string list; + hidden : string list } + +let get_path_info () = + { visible = List.rev_map Dir.path !visible_dirs; + hidden = List.rev_map Dir.path !hidden_dirs } + +let get_visible_paths () = List.rev_map Dir.path !visible_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 @@ -84,51 +105,73 @@ let get_paths () = List.rev_map Dir.path !dirs let prepend_add dir = List.iter (fun base -> let fn = Filename.concat dir.Dir.path base in - STbl.replace !files base fn; - STbl.replace !files_uncap (Misc.normalized_unit_filename base) fn + let filename = Misc.normalized_unit_filename 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 ) dir.Dir.files -let init ~auto_include l = +let init ~auto_include ~visible ~hidden = reset (); - dirs := List.rev_map Dir.create l; - List.iter prepend_add !dirs; + 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 new_dirs = List.filter (fun d -> Dir.path d <> dir) !dirs in - if List.compare_lengths new_dirs !dirs <> 0 then begin + 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 (); - List.iter prepend_add new_dirs; - dirs := new_dirs + 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 the cache, in - order to enforce left-to-right precedence. *) -let add dir = + 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 -> let fn = Filename.concat dir.Dir.path base in - if not (STbl.mem !files base) then - STbl.replace !files base fn; + update base fn visible_files hidden_files; let ubase = Misc.normalized_unit_filename base in - if not (STbl.mem !files_uncap ubase) then - STbl.replace !files_uncap ubase fn) - dir.Dir.files; - dirs := dir :: !dirs + update ubase fn visible_files_uncap hidden_files_uncap) + dir.files; + if dir.hidden then + hidden_dirs := dir :: !hidden_dirs + else + visible_dirs := dir :: !visible_dirs let append_dir = add -let add_dir dir = add (Dir.create dir) +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 = +let prepend_dir (dir : Dir.t) = assert (not Config.merlin || Local_store.is_bound ()); prepend_add dir; - dirs := !dirs @ [dir] + if dir.hidden then + hidden_dirs := !hidden_dirs @ [dir] + else + visible_dirs := !visible_dirs @ [dir] let is_basename fn = Filename.basename fn = fn @@ -150,27 +193,41 @@ 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 (expand ("+" ^ lib))) in + 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 +let find_file_in_cache fn visible_files hidden_files = + try STbl.find !visible_files fn with + | Not_found -> + match hidden_files with + | Some hidden_files -> STbl.find !hidden_files fn + | None -> raise Not_found + let find fn = assert (not Config.merlin || Local_store.is_bound ()); try if is_basename fn && not !Sys.interactive then - STbl.find !files fn + find_file_in_cache fn visible_files (Some hidden_files) else Misc.find_in_path (get_paths ()) fn with Not_found -> !auto_include_callback Dir.find fn -let find_normalized fn = +let find_normalized fn visible_files hidden_files get_paths = assert (not Config.merlin || Local_store.is_bound ()); try if is_basename fn && not !Sys.interactive then - STbl.find !files_uncap (Misc.normalized_unit_filename fn) + find_file_in_cache (Misc.normalized_unit_filename fn) visible_files + hidden_files else Misc.find_in_path_normalized (get_paths ()) fn with Not_found -> let fn_uncap = Misc.normalized_unit_filename fn in !auto_include_callback Dir.find_normalized fn_uncap + +let find_visible_normalized fn = + find_normalized fn visible_files_uncap None get_visible_paths + +let find_normalized fn = + find_normalized fn visible_files_uncap (Some hidden_files_uncap) get_paths diff --git a/utils/load_path.mli b/utils/load_path.mli index 636ce23c6e5..b3610416991 100644 --- a/utils/load_path.mli +++ b/utils/load_path.mli @@ -22,7 +22,7 @@ doesn't change during the execution of the compiler. *) -val add_dir : string -> unit +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 @@ -35,7 +35,7 @@ module Dir : sig type t (** Represent one directory in the load path. *) - val create : string -> t + val create : hidden:bool -> string -> t val path : t -> string @@ -43,6 +43,10 @@ module Dir : sig (** 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]. *) @@ -59,8 +63,13 @@ 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 -> string list -> unit -(** [init l] is the same as [reset (); List.iter add_dir (List.rev l)] *) +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 @@ -71,6 +80,13 @@ val auto_include_otherlibs : val get_paths : unit -> string list (** Return the list of directories passed to [add_dir] so far. *) +type path_info = + { visible : string list; + hidden : string list } + +val get_path_info : unit -> path_info +(** 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 @@ -82,6 +98,9 @@ val find_normalized : string -> string {!Misc.normalized_unit_filename}), i.e. if name is [Foo.ml], allow [/path/Foo.ml] and [/path/foo.ml] to match. *) +val find_visible_normalized : string -> string +(** Same as [find_normalized], but search only the -I directories, not -H *) + val[@deprecated] add : Dir.t -> unit (** Old name for {!append_dir} *) @@ -93,5 +112,6 @@ 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 : unit -> Dir.t list -(** Same as [get_paths ()], except that it returns a [Dir.t list]. *) +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/utils/misc.ml b/utils/misc.ml index bd34e66cc9b..e36861cc2b9 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -70,6 +70,13 @@ let rec map_end f l1 l2 = [] -> 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 diff --git a/utils/misc.mli b/utils/misc.mli index 9dd6351b012..b6cb93d7478 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -77,6 +77,9 @@ val reraise_preserving_backtrace : exn -> (unit -> unit) -> 'a 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 *) From 1291b498896530c6bbccb1962c7803b9383313f4 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Mon, 9 Oct 2023 09:26:07 +0100 Subject: [PATCH 148/402] Update comments --- manual/src/cmds/ocamldoc.etex | 2 +- utils/load_path.mli | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/manual/src/cmds/ocamldoc.etex b/manual/src/cmds/ocamldoc.etex index 286aa335cf1..51022fd571c 100644 --- a/manual/src/cmds/ocamldoc.etex +++ b/manual/src/cmds/ocamldoc.etex @@ -209,7 +209,7 @@ interface files (".cmi" files). \item["-H" \var{directory}] Like "-I", but the "-H" directories are searched last and the program may -not directly refer to the modules included this way. +not directly refer to the modules added to the search path this way. \item["-nolabels"] Ignore non-optional labels in types. diff --git a/utils/load_path.mli b/utils/load_path.mli index b3610416991..d9f34b43799 100644 --- a/utils/load_path.mli +++ b/utils/load_path.mli @@ -14,8 +14,8 @@ (** Management of include directories. - This module offers a high level interface to locating files in the - load path, which is constructed from [-I] command line flags and a few + 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 From 4aae28a35d45a9f20a7ac8aaff93c466de2652e0 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 6 Oct 2023 15:07:29 +0200 Subject: [PATCH 149/402] typing: Use more precise location of alias type mismatch Before: 1 | type t = (int as 'a) * (float as 'a) ^^^^^^^^^^^ Error: This alias is bound to type float but is used as an instance of type int After: 1 | type t = (int as 'a) * (float as 'a) ^ Error: This alias is bound to type float but is used as an instance of type int --- testsuite/tests/typing-external/pr11392.ml | 4 ++-- testsuite/tests/typing-misc/polyvars.ml | 4 ++-- testsuite/tests/typing-objects/Tests.ml | 4 ++-- .../typing-rectypes-bugs/pr6870_bad.compilers.reference | 4 ++-- typing/typetexp.ml | 5 +++-- 5 files changed, 11 insertions(+), 10 deletions(-) diff --git a/testsuite/tests/typing-external/pr11392.ml b/testsuite/tests/typing-external/pr11392.ml index 8dd88740dc1..4e7cd3a88fa 100644 --- a/testsuite/tests/typing-external/pr11392.ml +++ b/testsuite/tests/typing-external/pr11392.ml @@ -16,9 +16,9 @@ type 'self nat = Z | S of 'self external cast : int -> 'self nat as 'self = "%identity" ;; [%%expect{| -Line 1, characters 16-41: +Line 1, characters 37-41: 1 | external cast : int -> 'self nat as 'self = "%identity" - ^^^^^^^^^^^^^^^^^^^^^^^^^ + ^^^^ Error: This alias is bound to type "int -> 'a nat" but is used as an instance of type "'a" The type variable "'a" occurs inside "int -> 'a nat" diff --git a/testsuite/tests/typing-misc/polyvars.ml b/testsuite/tests/typing-misc/polyvars.ml index 148fd294fcd..47722b39517 100644 --- a/testsuite/tests/typing-misc/polyvars.ml +++ b/testsuite/tests/typing-misc/polyvars.ml @@ -165,9 +165,9 @@ val f : [> `AnyOtherTag ] * [> `AnyOtherTag | `AnyOtherTag' ] -> int = let x:(([`A] as 'a)* ([`B] as 'a)) = [`A] [%%expect {| -Line 1, characters 22-32: +Line 1, characters 31-32: 1 | let x:(([`A] as 'a)* ([`B] as 'a)) = [`A] - ^^^^^^^^^^ + ^ Error: This alias is bound to type "[ `B ]" but is used as an instance of type "[ `A ]" These two variant types have no intersection diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml index 01a47f485b7..088203bd6f0 100644 --- a/testsuite/tests/typing-objects/Tests.ml +++ b/testsuite/tests/typing-objects/Tests.ml @@ -778,9 +778,9 @@ type 'a t |}];; fun (x : 'a t as 'a) -> ();; [%%expect{| -Line 1, characters 9-19: +Line 1, characters 18-19: 1 | fun (x : 'a t as 'a) -> ();; - ^^^^^^^^^^ + ^ Error: This alias is bound to type "'a t" but is used as an instance of type "'a" The type variable "'a" occurs inside "'a t" |}];; diff --git a/testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference index 9980a0ee27b..369db2ca8a1 100644 --- a/testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference +++ b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference @@ -1,6 +1,6 @@ -File "pr6870_bad.ml", line 10, characters 38-50: +File "pr6870_bad.ml", line 10, characters 49-50: 10 | module Fix (T : T) = struct type r = ('r T.t as 'r) end - ^^^^^^^^^^^^ + ^ Error: This alias is bound to type "'a T.t" but is used as an instance of type "'a" The type variable "'a" occurs inside "'a T.t" diff --git a/typing/typetexp.ml b/typing/typetexp.ml index d31311915f2..24cbf515d4b 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -530,18 +530,19 @@ and transl_type_aux env ~row_context ~aliased ~policy styp = 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(styp.ptyp_loc, env, Alias_type_mismatch err)) + raise(Error(alias.loc, env, Alias_type_mismatch err)) end; ty with Not_found -> let t, ty = with_local_level_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(styp.ptyp_loc, env, Alias_type_mismatch err)) + raise(Error(alias.loc, env, Alias_type_mismatch err)) end; (t, ty) end From ff5393569a3301acd0cabdb8debe83ce9a11f360 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Mon, 9 Oct 2023 14:55:14 +0200 Subject: [PATCH 150/402] typing: Improve location for 'variable in scope' Use the location of the alias instead of the `_ as 'a` type expression: 2 | let none: type a. (_ as 'a) option = None ^ Error: In this scoped type, variable 'a is reserved for the local type a. Co-authored-by: Florian Angeletti --- parsing/ast_helper.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index de574471dda..bc18f41be4c 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -104,7 +104,7 @@ module Typ = struct | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias(core_type, alias) -> - check_variable var_names t.ptyp_loc alias.txt; + 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, From 022d5fe51d28ef57a014afbdc36434097fc6488d Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Mon, 9 Oct 2023 14:58:57 +0200 Subject: [PATCH 151/402] Update Changes --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 7b298ddd467..3fa18f07a7a 100644 --- a/Changes +++ b/Changes @@ -278,6 +278,10 @@ Working version ### Internal/compiler-libs changes: +- #12639: parsing: Attach a location to the RHS of Ptyp_alias + and improve the 'alias type mismatch' error message. + (Jules Aguillon, review by Florian Angeletti) + - #12447: Remove 32-bit targets from X86_proc.system (Masanori Ogino, review by David Allsopp) From 93567a42eb9cfc803bba4d20aee3ebae1f3941b8 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Mon, 9 Oct 2023 10:32:20 +0100 Subject: [PATCH 152/402] Rename `Load_path.path_info` to `Load_path.paths` --- bytecomp/bytelink.ml | 2 +- debugger/command_line.ml | 3 ++- debugger/loadprinter.ml | 2 +- debugger/program_management.ml | 2 +- debugger/source.ml | 2 +- file_formats/cmt_format.ml | 2 +- parsing/ast_mapper.ml | 2 +- toplevel/topcommon.ml | 2 +- toplevel/topdirs.ml | 2 +- utils/ccomp.ml | 5 +++-- utils/load_path.ml | 14 +++++++------- utils/load_path.mli | 6 +++--- 12 files changed, 23 insertions(+), 21 deletions(-) diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 754ecb9fc5a..2d2f5b98914 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -375,7 +375,7 @@ let link_bytecode ?final_name tolink exec_name standalone = if check_dlls then begin (* Initialize the DLL machinery *) Dll.init_compile !Clflags.no_std_include; - Dll.add_path (Load_path.get_paths ()); + Dll.add_path (Load_path.get_path_list ()); try Dll.open_dlls Dll.For_checking sharedobjs with Failure reason -> raise(Error(Cannot_open_dll reason)) end; diff --git a/debugger/command_line.ml b/debugger/command_line.ml index 87923614da7..6e4669567df 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -281,7 +281,8 @@ let instr_dir ppf lexbuf = List.iter (function x -> add_path (expand_path x)) new_directory' end; let print_dirs ppf l = List.iter (function x -> fprintf ppf "@ %s" x) l in - fprintf ppf "@[<2>Directories: %a@]@." print_dirs (Load_path.get_paths ()); + fprintf ppf "@[<2>Directories: %a@]@." print_dirs + (Load_path.get_path_list ()); Hashtbl.iter (fun mdl dirs -> fprintf ppf "@[<2>Source directories for %s: %a@]@." mdl print_dirs diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml index 3fd85843c8a..15ac6c325c7 100644 --- a/debugger/loadprinter.ml +++ b/debugger/loadprinter.ml @@ -40,7 +40,7 @@ let rec loadfiles ppf name = Dynlink.loadfile filename; let d = Filename.dirname name in if d <> Filename.current_dir_name then begin - if not (List.mem d (Load_path.get_paths ())) then + if not (List.mem d (Load_path.get_path_list ())) then Load_path.add_dir ~hidden:false d; end; fprintf ppf "File %s loaded@." diff --git a/debugger/program_management.ml b/debugger/program_management.ml index 22cf5ce0c5e..ea315589d20 100644 --- a/debugger/program_management.ml +++ b/debugger/program_management.ml @@ -128,7 +128,7 @@ let initialize_loading () = end; Symbols.clear_symbols (); Symbols.read_symbols Debugcom.main_frag !program_name; - let Load_path.{visible; hidden} = Load_path.get_path_info () in + let Load_path.{visible; hidden} = Load_path.get_paths () in let visible = visible @ !Symbols.program_source_dirs in Load_path.init ~auto_include:Compmisc.auto_include ~visible ~hidden; Envaux.reset_cache (); diff --git a/debugger/source.ml b/debugger/source.ml index 093a431916c..5f659d2319e 100644 --- a/debugger/source.ml +++ b/debugger/source.ml @@ -40,7 +40,7 @@ let source_of_module pos mdle = else acc) Debugger_config.load_path_for - (Load_path.get_paths ()) in + (Load_path.get_path_list ()) in let fname = pos.Lexing.pos_fname in if fname = "" then let innermost_module = diff --git a/file_formats/cmt_format.ml b/file_formats/cmt_format.ml index a046eb2d952..8f0167edec3 100644 --- a/file_formats/cmt_format.ml +++ b/file_formats/cmt_format.ml @@ -184,7 +184,7 @@ let save_cmt target binary_annots initial_env cmi shape = cmt_args = Sys.argv; cmt_sourcefile = sourcefile; cmt_builddir = Location.rewrite_absolute_path (Sys.getcwd ()); - cmt_loadpath = Load_path.get_paths (); + cmt_loadpath = Load_path.get_path_list (); cmt_source_digest = source_digest; cmt_initial_env = if need_to_clear_env then keep_only_summary initial_env else initial_env; diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 916eda60d8d..8175b808048 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -879,7 +879,7 @@ module PpxContext = struct } let make ~tool_name () = - let Load_path.{ visible; hidden } = Load_path.get_path_info () in + let Load_path.{ visible; hidden } = Load_path.get_paths () in let fields = [ lid "tool_name", make_string tool_name; diff --git a/toplevel/topcommon.ml b/toplevel/topcommon.ml index 1a2702f49db..149b61da4ac 100644 --- a/toplevel/topcommon.ml +++ b/toplevel/topcommon.ml @@ -263,7 +263,7 @@ let set_paths ?(auto_include=Compmisc.auto_include) () = but keep the directories that user code linked in with ocamlmktop may have added to load_path. *) let expand = Misc.expand_directory Config.standard_library in - let Load_path.{ visible; hidden } = Load_path.get_path_info () in + let Load_path.{ visible; hidden } = Load_path.get_paths () in let visible = List.concat [ [ "" ]; List.map expand (List.rev !Compenv.first_include_dirs); diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index dea295b7c86..9113c059d9c 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -110,7 +110,7 @@ let _ = add_directive "remove_directory" (Directive_string dir_remove_directory) } let dir_show_dirs () = - List.iter print_endline (Load_path.get_paths ()) + List.iter print_endline (Load_path.get_path_list ()) let _ = add_directive "show_dirs" (Directive_none dir_show_dirs) { diff --git a/utils/ccomp.ml b/utils/ccomp.ml index e27141ba782..afde5a6567c 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -186,7 +186,7 @@ let call_linker mode output_name files extra = Config.native_pack_linker (Filename.quote output_name) (quote_prefixed ~response_files:true - l_prefix (Load_path.get_paths ())) + l_prefix (Load_path.get_path_list ())) (quote_files ~response_files:true (remove_Wl files)) extra else @@ -200,7 +200,8 @@ let call_linker mode output_name files extra = ) (Filename.quote output_name) "" (*(Clflags.std_include_flag "-I")*) - (quote_prefixed ~response_files:true "-L" (Load_path.get_paths ())) + (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 diff --git a/utils/load_path.ml b/utils/load_path.ml index 5db3a0d9b97..367019ddf5f 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -85,18 +85,18 @@ let reset () = let get_visible () = List.rev !visible_dirs -let get_paths () = +let get_path_list () = Misc.rev_map_end Dir.path !visible_dirs (List.rev_map Dir.path !hidden_dirs) -type path_info = +type paths = { visible : string list; hidden : string list } -let get_path_info () = +let get_paths () = { visible = List.rev_map Dir.path !visible_dirs; hidden = List.rev_map Dir.path !hidden_dirs } -let get_visible_paths () = List.rev_map Dir.path !visible_dirs +let get_visible_path_list () = List.rev_map Dir.path !visible_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 @@ -210,7 +210,7 @@ let find fn = if is_basename fn && not !Sys.interactive then find_file_in_cache fn visible_files (Some hidden_files) else - Misc.find_in_path (get_paths ()) fn + Misc.find_in_path (get_path_list ()) fn with Not_found -> !auto_include_callback Dir.find fn @@ -227,7 +227,7 @@ let find_normalized fn visible_files hidden_files get_paths = !auto_include_callback Dir.find_normalized fn_uncap let find_visible_normalized fn = - find_normalized fn visible_files_uncap None get_visible_paths + find_normalized fn visible_files_uncap None get_visible_path_list let find_normalized fn = - find_normalized fn visible_files_uncap (Some hidden_files_uncap) get_paths + find_normalized fn visible_files_uncap (Some hidden_files_uncap) get_path_list diff --git a/utils/load_path.mli b/utils/load_path.mli index d9f34b43799..8ea4dba83e2 100644 --- a/utils/load_path.mli +++ b/utils/load_path.mli @@ -77,14 +77,14 @@ val auto_include_otherlibs : {!Load_path.init} and automatically adds [-I +lib] to the load path after calling [alert lib]. *) -val get_paths : unit -> string list +val get_path_list : unit -> string list (** Return the list of directories passed to [add_dir] so far. *) -type path_info = +type paths = { visible : string list; hidden : string list } -val get_path_info : unit -> path_info +val get_paths : unit -> paths (** Return the directories passed to [add_dir] so far. *) val find : string -> string From 45384b34e044834c8f0b677ec60143cbc7a73f4b Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Mon, 9 Oct 2023 10:53:08 +0100 Subject: [PATCH 153/402] update cmt format for -H --- file_formats/cmt_format.ml | 4 ++-- file_formats/cmt_format.mli | 2 +- tools/objinfo.ml | 6 ++++-- tools/ocamlcmt.ml | 11 ++++++++--- 4 files changed, 15 insertions(+), 8 deletions(-) diff --git a/file_formats/cmt_format.ml b/file_formats/cmt_format.ml index 8f0167edec3..54e7f216ec3 100644 --- a/file_formats/cmt_format.ml +++ b/file_formats/cmt_format.ml @@ -54,7 +54,7 @@ type cmt_infos = { cmt_args : string array; cmt_sourcefile : string option; cmt_builddir : string; - cmt_loadpath : string list; + cmt_loadpath : Load_path.paths; cmt_source_digest : Digest.t option; cmt_initial_env : Env.t; cmt_imports : (string * Digest.t option) list; @@ -184,7 +184,7 @@ let save_cmt target binary_annots initial_env cmi shape = cmt_args = Sys.argv; cmt_sourcefile = sourcefile; cmt_builddir = Location.rewrite_absolute_path (Sys.getcwd ()); - cmt_loadpath = Load_path.get_path_list (); + 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; diff --git a/file_formats/cmt_format.mli b/file_formats/cmt_format.mli index 34864091dc5..3cca22b0205 100644 --- a/file_formats/cmt_format.mli +++ b/file_formats/cmt_format.mli @@ -59,7 +59,7 @@ type cmt_infos = { cmt_args : string array; cmt_sourcefile : string option; cmt_builddir : string; - cmt_loadpath : string list; + cmt_loadpath : Load_path.paths; cmt_source_digest : string option; cmt_initial_env : Env.t; cmt_imports : crcs; diff --git a/tools/objinfo.ml b/tools/objinfo.ml index 7e911017157..81e6e7afd2a 100644 --- a/tools/objinfo.ml +++ b/tools/objinfo.ml @@ -95,8 +95,10 @@ let print_cmt_infos cmt = (match cmt.cmt_sourcefile with None -> "(none)" | Some f -> f); printf "Compilation flags:"; Array.iter print_spaced_string cmt.cmt_args; - printf "\nLoad path:"; - List.iter print_spaced_string cmt.cmt_loadpath; + printf "\nLoad path:\n Visible:"; + List.iter print_spaced_string cmt.cmt_loadpath.visible; + printf "\n Hidden:"; + List.iter print_spaced_string cmt.cmt_loadpath.hidden; printf "\n"; printf "cmt interface digest: %s\n" (match cmt.cmt_interface_digest with diff --git a/tools/ocamlcmt.ml b/tools/ocamlcmt.ml index 8036148c2be..92014a2336e 100644 --- a/tools/ocamlcmt.ml +++ b/tools/ocamlcmt.ml @@ -69,7 +69,10 @@ let print_info cmt = Printf.fprintf oc "sourcefile: %s\n" name; end; Printf.fprintf oc "build directory: %s\n" cmt.cmt_builddir; - List.iter (Printf.fprintf oc "load path: %s\n%!") cmt.cmt_loadpath; + List.iter (Printf.fprintf oc "load path (visible): %s\n%!") + cmt.cmt_loadpath.visible; + List.iter (Printf.fprintf oc "load path (hidden): %s\n%!") + cmt.cmt_loadpath.hidden; begin match cmt.cmt_source_digest with None -> () @@ -149,7 +152,8 @@ let record_cmt_info cmt = Annot.Idef (location_file value))) in let open Cmt_format in - List.iter (fun dir -> record_info "include" dir) cmt.cmt_loadpath; + List.iter (fun dir -> record_info "include" dir) cmt.cmt_loadpath.visible; + List.iter (fun dir -> record_info "include" dir) cmt.cmt_loadpath.hidden; record_info "chdir" cmt.cmt_builddir; (match cmt.cmt_sourcefile with None -> () | Some file -> record_info "source" file) @@ -174,7 +178,8 @@ let main () = | Some _ as x -> x in Envaux.reset_cache (); - List.iter (Load_path.add_dir ~hidden:false) cmt.cmt_loadpath; + List.iter (Load_path.add_dir ~hidden:false) cmt.cmt_loadpath.visible; + List.iter (Load_path.add_dir ~hidden:true) cmt.cmt_loadpath.hidden; Cmt2annot.gen_annot target_filename ~sourcefile:cmt.cmt_sourcefile ~use_summaries:cmt.cmt_use_summaries From 51ec9448f6c508f047567a6329f384db64e924c5 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Mon, 9 Oct 2023 14:02:17 +0100 Subject: [PATCH 154/402] Fix tests --- .../hidden_includes/cant_reference_hidden.ocamlc.reference | 2 +- .../tests/hidden_includes/not_included.ocamlc.reference | 7 ++++--- testsuite/tests/hidden_includes/test.ml | 4 +--- .../hidden_includes/wrong_include_order.ocamlc.reference | 4 ++-- 4 files changed, 8 insertions(+), 9 deletions(-) diff --git a/testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference b/testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference index 2d834047bf9..caae6f73442 100644 --- a/testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference +++ b/testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference @@ -1,4 +1,4 @@ File "libc/c3.ml", line 1, characters 8-11: 1 | let x = A.x + 1 ^^^ -Error: Unbound module A +Error: Unbound module "A" diff --git a/testsuite/tests/hidden_includes/not_included.ocamlc.reference b/testsuite/tests/hidden_includes/not_included.ocamlc.reference index 5a15a116e12..a3c0d1055eb 100644 --- a/testsuite/tests/hidden_includes/not_included.ocamlc.reference +++ b/testsuite/tests/hidden_includes/not_included.ocamlc.reference @@ -1,6 +1,7 @@ File "libc/c1.ml", line 1, characters 8-11: 1 | let x = B.x + 1 ^^^ -Error: This expression has type A.t but an expression was expected of type - int - A.t is abstract because no corresponding cmi file was found in path. +Error: This expression has type "A.t" but an expression was expected of type + "int" + Type "A.t" is abstract because no corresponding cmi file was found + in path. diff --git a/testsuite/tests/hidden_includes/test.ml b/testsuite/tests/hidden_includes/test.ml index 876ae6f9284..58963b43a6a 100644 --- a/testsuite/tests/hidden_includes/test.ml +++ b/testsuite/tests/hidden_includes/test.ml @@ -1,3 +1,4 @@ +(* TEST (* This tests the -H flag. The basic structure is that libc depends on libb, which depends on liba. We @@ -19,9 +20,6 @@ precedence order of the includes. *) - -(* TEST - subdirectories = "liba liba_alt libb libc"; setup-ocamlc.byte-build-env; diff --git a/testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference b/testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference index cb4538eb625..6863dffdf5e 100644 --- a/testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference +++ b/testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference @@ -1,3 +1,3 @@ File "libc/c1.ml", line 1: -Error: The files libb/b.cmi and liba_alt/a.cmi make inconsistent assumptions - over interface A +Error: The files "libb/b.cmi" and "liba_alt/a.cmi" make inconsistent assumptions + over interface "A" From dc09c0b5c2afcff10ea70309ad52c9e57d51fc44 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Mon, 9 Oct 2023 16:17:59 +0100 Subject: [PATCH 155/402] Prevent hidden cmis from incorrectly being used from the penv cache --- .../hidden_stays_hidden.ocamlc.reference | 4 ++ testsuite/tests/hidden_includes/libc/c4.ml | 6 +++ testsuite/tests/hidden_includes/test.ml | 13 ++++++ .../tests/self-contained-toplevel/main.ml | 5 ++- typing/env.ml | 9 ++-- typing/persistent_env.ml | 28 ++++++++----- typing/persistent_env.mli | 4 +- utils/load_path.ml | 42 ++++++++++++------- utils/load_path.mli | 7 +++- 9 files changed, 84 insertions(+), 34 deletions(-) create mode 100644 testsuite/tests/hidden_includes/hidden_stays_hidden.ocamlc.reference create mode 100644 testsuite/tests/hidden_includes/libc/c4.ml diff --git a/testsuite/tests/hidden_includes/hidden_stays_hidden.ocamlc.reference b/testsuite/tests/hidden_includes/hidden_stays_hidden.ocamlc.reference new file mode 100644 index 00000000000..8ba62b877af --- /dev/null +++ b/testsuite/tests/hidden_includes/hidden_stays_hidden.ocamlc.reference @@ -0,0 +1,4 @@ +File "libc/c4.ml", line 2, characters 8-11: +2 | let y = A.x + 1 + ^^^ +Error: Unbound module "A" diff --git a/testsuite/tests/hidden_includes/libc/c4.ml b/testsuite/tests/hidden_includes/libc/c4.ml new file mode 100644 index 00000000000..7c14a26c835 --- /dev/null +++ b/testsuite/tests/hidden_includes/libc/c4.ml @@ -0,0 +1,6 @@ +let x = B.x + 1 +let y = A.x + 1 + +(* Typing x requires loading A's cmi. When it is made available with -H, y + should fail to typecheck because direct references to A are not allowed, even + though it has been loaded. *) diff --git a/testsuite/tests/hidden_includes/test.ml b/testsuite/tests/hidden_includes/test.ml index 58963b43a6a..71dd8e18adc 100644 --- a/testsuite/tests/hidden_includes/test.ml +++ b/testsuite/tests/hidden_includes/test.ml @@ -131,4 +131,17 @@ ocamlc.byte; ocamlc.byte; } +(* Test that a hidden `A` doesn't become visible as a result of the typechecker + using it. *) +{ + flags = "-H liba -I libb -nocwd"; + module = "libc/c4.ml"; + setup-ocamlc.byte-build-env; + ocamlc_byte_exit_status = "2"; + ocamlc.byte; + compiler_reference = + "${test_source_directory}/hidden_stays_hidden.ocamlc.reference"; + check-ocamlc.byte-output; +} + *) diff --git a/testsuite/tests/self-contained-toplevel/main.ml b/testsuite/tests/self-contained-toplevel/main.ml index 23caa21d434..06643df5b1b 100644 --- a/testsuite/tests/self-contained-toplevel/main.ml +++ b/testsuite/tests/self-contained-toplevel/main.ml @@ -27,8 +27,9 @@ let () = match unit_name with | "Foo" -> Some { Persistent_signature. - filename = Sys.executable_name - ; cmi = Marshal.from_string Cached_cmi.foo 0 + filename = Sys.executable_name + ; cmi = Marshal.from_string Cached_cmi.foo 0 + ; visibility = Visible } | _ -> old_loader ~allow_hidden ~unit_name); Toploop.add_hook (function diff --git a/typing/env.ml b/typing/env.ml index 399d5e1824b..4fbd32e8e02 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -2541,10 +2541,11 @@ let save_signature_with_transform cmi_transform ~alerts sg cmi_info = (Unit_info.Artifact.modname cmi_info) sg alerts |> cmi_transform in let filename = Unit_info.Artifact.filename cmi_info in - let pm = save_sign_of_cmi - { Persistent_env.Persistent_signature.cmi; filename } in - Persistent_env.save_cmi !persistent_env - { Persistent_env.Persistent_signature.filename; cmi } pm; + 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 = diff --git a/typing/persistent_env.ml b/typing/persistent_env.ml index ab19cbb2866..e70bb756fd3 100644 --- a/typing/persistent_env.ml +++ b/typing/persistent_env.ml @@ -34,15 +34,16 @@ let error err = raise (Error err) module Persistent_signature = struct type t = { filename : string; - cmi : Cmi_format.cmi_infos } + cmi : Cmi_format.cmi_infos; + visibility : Load_path.visibility } let load = ref (fun ~allow_hidden ~unit_name -> - let find = - Load_path.(if allow_hidden then find_normalized - else find_visible_normalized) - in - match find (unit_name ^ ".cmi") with - | filename -> Some { filename; cmi = read_cmi filename } + 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 @@ -55,6 +56,7 @@ type pers_struct = { 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 @@ -172,7 +174,7 @@ let save_pers_struct penv crc ps pm = add_import penv modname let acknowledge_pers_struct penv check modname pers_sig pm = - let { Persistent_signature.filename; cmi } = pers_sig in + 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 @@ -180,6 +182,7 @@ let acknowledge_pers_struct penv check modname pers_sig pm = 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)); @@ -201,7 +204,7 @@ let read_pers_struct penv val_of_pers_sig check cmi = 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 } 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) @@ -210,7 +213,9 @@ 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) -> (ps, pm) + | 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 @@ -319,7 +324,7 @@ let make_cmi penv modname sign alerts = } let save_cmi penv psig pm = - let { Persistent_signature.filename; cmi } = psig in + let { Persistent_signature.filename; cmi; visibility } = psig in Misc.try_finally (fun () -> let { cmi_name = modname; @@ -338,6 +343,7 @@ let save_cmi penv psig pm = 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 ) diff --git a/typing/persistent_env.mli b/typing/persistent_env.mli index 432c41fc2d8..136da7f8810 100644 --- a/typing/persistent_env.mli +++ b/typing/persistent_env.mli @@ -32,7 +32,9 @@ val report_error: Format.formatter -> error -> unit module Persistent_signature : sig type t = { filename : string; (** Name of the file containing the signature. *) - cmi : Cmi_format.cmi_infos } + 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 diff --git a/utils/load_path.ml b/utils/load_path.ml index 367019ddf5f..76103030516 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -97,6 +97,7 @@ let get_paths () = 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 @@ -197,37 +198,50 @@ let auto_include_otherlibs = 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 with - | Not_found -> - match hidden_files with - | Some hidden_files -> STbl.find !hidden_files fn - | None -> raise Not_found + | Not_found -> STbl.find !hidden_files fn + +let find_file_in_cache_with_visibility 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 - find_file_in_cache fn visible_files (Some hidden_files) + 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 fn visible_files hidden_files get_paths = +let find_normalized fn = assert (not Config.merlin || Local_store.is_bound ()); try if is_basename fn && not !Sys.interactive then - find_file_in_cache (Misc.normalized_unit_filename fn) visible_files - hidden_files + find_file_in_cache (Misc.normalized_unit_filename fn) visible_files_uncap + hidden_files_uncap else - Misc.find_in_path_normalized (get_paths ()) fn + Misc.find_in_path_normalized (get_path_list ()) fn with Not_found -> let fn_uncap = Misc.normalized_unit_filename fn in !auto_include_callback Dir.find_normalized fn_uncap -let find_visible_normalized fn = - find_normalized fn visible_files_uncap None get_visible_path_list - -let find_normalized fn = - find_normalized fn visible_files_uncap (Some hidden_files_uncap) get_path_list +let find_normalized_with_visibility fn = + assert (not Config.merlin || Local_store.is_bound ()); + try + if is_basename fn && not !Sys.interactive then + find_file_in_cache_with_visibility (Misc.normalized_unit_filename fn) + 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 -> + let fn_uncap = Misc.normalized_unit_filename fn in + (!auto_include_callback Dir.find_normalized fn_uncap, Visible) diff --git a/utils/load_path.mli b/utils/load_path.mli index 8ea4dba83e2..983368bfe04 100644 --- a/utils/load_path.mli +++ b/utils/load_path.mli @@ -98,8 +98,11 @@ val find_normalized : string -> string {!Misc.normalized_unit_filename}), i.e. if name is [Foo.ml], allow [/path/Foo.ml] and [/path/foo.ml] to match. *) -val find_visible_normalized : string -> string -(** Same as [find_normalized], but search only the -I directories, not -H *) +type visibility = Visible | Hidden + +val find_normalized_with_visibility : string -> string * visibility +(** Same as [find_normalized], but also 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} *) From 2f72e5167255a67a05f9f3776fe27035dd106464 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Mon, 9 Oct 2023 17:48:08 +0100 Subject: [PATCH 156/402] Add test for constructor disambiguation --- testsuite/tests/hidden_includes/liba/a.ml | 2 ++ testsuite/tests/hidden_includes/libb/b.ml | 2 ++ testsuite/tests/hidden_includes/libc/c5.ml | 7 +++++++ testsuite/tests/hidden_includes/test.ml | 9 +++++++++ 4 files changed, 20 insertions(+) create mode 100644 testsuite/tests/hidden_includes/libc/c5.ml diff --git a/testsuite/tests/hidden_includes/liba/a.ml b/testsuite/tests/hidden_includes/liba/a.ml index 2be7c57aa2a..22b40309256 100644 --- a/testsuite/tests/hidden_includes/liba/a.ml +++ b/testsuite/tests/hidden_includes/liba/a.ml @@ -1,3 +1,5 @@ type t = int let x = 1 + +type s = Baz diff --git a/testsuite/tests/hidden_includes/libb/b.ml b/testsuite/tests/hidden_includes/libb/b.ml index d6a1c3a539f..7e41643e960 100644 --- a/testsuite/tests/hidden_includes/libb/b.ml +++ b/testsuite/tests/hidden_includes/libb/b.ml @@ -3,3 +3,5 @@ type t = A.t let x : A.t = A.x let f : A.t -> A.t = fun x -> x + +let g : A.s -> unit = fun _ -> () diff --git a/testsuite/tests/hidden_includes/libc/c5.ml b/testsuite/tests/hidden_includes/libc/c5.ml new file mode 100644 index 00000000000..bd0715ec1e8 --- /dev/null +++ b/testsuite/tests/hidden_includes/libc/c5.ml @@ -0,0 +1,7 @@ +let _ = B.g Baz + +(* Type-directed disambiguation: Baz is defined in A, and even when a.cmi is + provided with -H this still typechecks. It's not obvious that this is + necessary (rejecting this program also seems fine, in that case), but this + test is here to record the current behavior so any change will be + intentional. *) diff --git a/testsuite/tests/hidden_includes/test.ml b/testsuite/tests/hidden_includes/test.ml index 71dd8e18adc..961474b7af5 100644 --- a/testsuite/tests/hidden_includes/test.ml +++ b/testsuite/tests/hidden_includes/test.ml @@ -144,4 +144,13 @@ ocamlc.byte; check-ocamlc.byte-output; } +(* Test that type-directed constructor disambiguation works through -H (at + least, for now). *) +{ + flags = "-H liba -I libb -nocwd"; + module = "libc/c5.ml"; + setup-ocamlc.byte-build-env; + ocamlc.byte; +} + *) From 8add5d0f0ce485c1caad73912993fdb042ade40c Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Tue, 10 Oct 2023 09:10:11 +0100 Subject: [PATCH 157/402] make depend --- .depend | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.depend b/.depend index ddebe7863df..ba3052d481a 100644 --- a/.depend +++ b/.depend @@ -1036,6 +1036,7 @@ typing/persistent_env.cmi : \ typing/types.cmi \ utils/misc.cmi \ parsing/location.cmi \ + utils/load_path.cmi \ utils/lazy_backtrack.cmi \ utils/consistbl.cmi \ file_formats/cmi_format.cmi @@ -4056,6 +4057,7 @@ file_formats/cmt_format.cmi : \ typing/shape.cmi \ utils/misc.cmi \ parsing/location.cmi \ + utils/load_path.cmi \ typing/env.cmi \ file_formats/cmi_format.cmi file_formats/cmx_format.cmi : \ From d5ff0a7100b949e21082aea4e3993f8a87387100 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Tue, 10 Oct 2023 14:25:43 +0100 Subject: [PATCH 158/402] Eliminate code duplication --- utils/load_path.ml | 22 ++++------------------ 1 file changed, 4 insertions(+), 18 deletions(-) diff --git a/utils/load_path.ml b/utils/load_path.ml index 76103030516..08b94c83437 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -201,10 +201,6 @@ let auto_include_otherlibs = type visibility = Visible | Hidden let find_file_in_cache fn visible_files hidden_files = - try STbl.find !visible_files fn with - | Not_found -> STbl.find !hidden_files fn - -let find_file_in_cache_with_visibility fn visible_files hidden_files = try (STbl.find !visible_files fn, Visible) with | Not_found -> (STbl.find !hidden_files fn, Hidden) @@ -212,29 +208,17 @@ let find fn = assert (not Config.merlin || Local_store.is_bound ()); try if is_basename fn && not !Sys.interactive then - find_file_in_cache fn visible_files hidden_files + 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 fn = - assert (not Config.merlin || Local_store.is_bound ()); - try - if is_basename fn && not !Sys.interactive then - find_file_in_cache (Misc.normalized_unit_filename fn) visible_files_uncap - hidden_files_uncap - else - Misc.find_in_path_normalized (get_path_list ()) fn - with Not_found -> - let fn_uncap = Misc.normalized_unit_filename fn in - !auto_include_callback Dir.find_normalized fn_uncap - let find_normalized_with_visibility fn = assert (not Config.merlin || Local_store.is_bound ()); try if is_basename fn && not !Sys.interactive then - find_file_in_cache_with_visibility (Misc.normalized_unit_filename fn) + find_file_in_cache (Misc.normalized_unit_filename fn) visible_files_uncap hidden_files_uncap else try @@ -245,3 +229,5 @@ let find_normalized_with_visibility fn = with Not_found -> let fn_uncap = Misc.normalized_unit_filename fn in (!auto_include_callback Dir.find_normalized fn_uncap, Visible) + +let find_normalized fn = fst (find_normalized_with_visibility fn) From 0354e0609140a856bdd39818e83825b6cf903964 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Tue, 10 Oct 2023 15:34:33 +0200 Subject: [PATCH 159/402] fix printing of error messages for cyclic definitions --- testsuite/tests/typing-short-paths/errors.ml | 58 ++++++++++++++++++++ typing/typedecl.ml | 37 +++++++------ 2 files changed, 77 insertions(+), 18 deletions(-) diff --git a/testsuite/tests/typing-short-paths/errors.ml b/testsuite/tests/typing-short-paths/errors.ml index f083789370e..a9929570bfa 100644 --- a/testsuite/tests/typing-short-paths/errors.ml +++ b/testsuite/tests/typing-short-paths/errors.ml @@ -73,3 +73,61 @@ Error: This expression has type "$a" but an expression was expected of type "'a" it would escape the scope of its equation Hint: "$a" is an existential type bound by the constructor "Pair". |}] + +(** Cycle type definitions *) + +type 'a t = 'a t +[%%expect {| +Line 3, characters 0-16: +3 | type 'a t = 'a t + ^^^^^^^^^^^^^^^^ +Error: The type abbreviation "t" is cyclic: + "'a t" = "'a t" +|}] + +type 'a t = 'a u +and 'a u = 'a v * 'a +and 'a v = 'a w list +and 'a w = 'a option z +and 'a z = 'a t +[%%expect {| +Line 1, characters 0-16: +1 | type 'a t = 'a u + ^^^^^^^^^^^^^^^^ +Error: The type abbreviation "t" is cyclic: + "'a t" = "'a u", + "'a u" = "'a v * 'a", + "'a v * 'a" contains "'a v", + "'a v" = "'a w list", + "'a w list" contains "'a w", + "'a w" = "'a option z", + "'a option z" = "'a option t" +|}] + + +type 'a u = < x : 'a> +and 'a t = 'a t u;; +[%%expect{| +Line 2, characters 0-17: +2 | and 'a t = 'a t u;; + ^^^^^^^^^^^^^^^^^ +Error: The type abbreviation "t" is cyclic: + "'a t u" contains "'a t", + "'a t" = "'a t u", + "'a t u" contains "'a t" +|}];; (* fails since 4.04 *) + + +module rec A : sig type t = B.t -> int end = struct type t = B.t -> int end + and B : sig type t = A.t end = struct type t = A.t end;; +[%%expect {| +Line 1, characters 0-75: +1 | module rec A : sig type t = B.t -> int end = struct type t = B.t -> int end + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The definition of "A.t" contains a cycle: + "B.t -> int" contains "B.t", + "B.t" = "B.t", + "B.t" = "B.t -> int", + "B.t -> int" contains "B.t", + "B.t" = "B.t" +|}] diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 5fce1591e88..ae29deaf75c 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -781,7 +781,7 @@ let check_abbrev env sdecl (id, decl) = - 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 env loc path to_check visited ty0 = +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;*) @@ -797,8 +797,8 @@ let check_well_founded env loc path to_check visited ty0 = | trace -> List.rev trace, false in if rec_abbrev - then Recursive_abbrev (Path.name path, env, reaching_path) - else Cycle_in_def (Path.name path, env, reaching_path) + 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) = @@ -843,11 +843,11 @@ let check_well_founded env loc path to_check visited ty0 = (* Will be detected by check_regularity *) Btype.backtrack snap -let check_well_founded_manifest env loc path decl = +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 env loc path (Path.same path) visited + 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), @@ -865,7 +865,7 @@ let check_well_founded_manifest env loc path decl = (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 env loc path decl to_check = +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. *) @@ -884,7 +884,7 @@ let check_well_founded_decl env loc path decl to_check = {type_iterators with it_type_expr = (fun self ty -> if TypeSet.mem ty !checked then () else begin - check_well_founded env loc path to_check visited ty; + 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 @@ -1124,24 +1124,25 @@ let transl_type_decl env rec_flag sdecl_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 new_env (List.assoc id id_loc_list) + 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 new_env (List.assoc id id_loc_list) (Path.Pident id) + check_well_founded_decl ~abs_env new_env (List.assoc id id_loc_list) + (Path.Pident id) decl to_check) decls; - (* [check_abbrev_regularity] 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 (check_abbrev_regularity ~abs_env new_env id_loc_list to_check) tdecls; @@ -1823,7 +1824,7 @@ 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 env loc path decl to_check; + 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 *) From 9ce5c9f527445158898a613cd69d3413738ba1e7 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Tue, 10 Oct 2023 14:48:16 +0100 Subject: [PATCH 160/402] Fix additional potential bug in the penv cache --- typing/persistent_env.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/typing/persistent_env.ml b/typing/persistent_env.ml index e70bb756fd3..5e59b995d5e 100644 --- a/typing/persistent_env.ml +++ b/typing/persistent_env.ml @@ -225,7 +225,7 @@ let find_pers_struct ~allow_hidden penv val_of_pers_sig check name = match !Persistent_signature.load ~allow_hidden ~unit_name:name with | Some psig -> psig | None -> - Hashtbl.add persistent_structures name Missing; + if allow_hidden then Hashtbl.add persistent_structures name Missing; raise Not_found in add_import penv name; From d2d4c0a183aec4473d53fc8cb7fc68874b1d48c8 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Wed, 11 Oct 2023 10:28:27 +0200 Subject: [PATCH 161/402] Update Changes --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 7b298ddd467..d52466574a1 100644 --- a/Changes +++ b/Changes @@ -458,6 +458,10 @@ OCaml 5.1.1 - #12623, fix the computation of variance composition (Florian Angeletti, report by Vesa Karvonen, review by Gabriel Scherer) +- #12645, fix error messages for cyclic type definitions in presence of + the `-short-paths` flag. + (Florian Angeletti, report by Vesa Karvonen, review by Gabriel Scherer) + OCaml 5.1.0 (14 September 2023) ------------------------------- From 7ed72683b8edc6507003d49f85029a28630fc96f Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 11 Oct 2023 13:34:59 +0100 Subject: [PATCH 162/402] Correct libs used in output-complete-obj test --- testsuite/tests/output-complete-obj/test.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/output-complete-obj/test.ml b/testsuite/tests/output-complete-obj/test.ml index 9e140558a71..57e01d13a33 100644 --- a/testsuite/tests/output-complete-obj/test.ml +++ b/testsuite/tests/output-complete-obj/test.ml @@ -6,7 +6,7 @@ flags = "-w -a -output-complete-obj"; program = "test.ml.bc.${objext}"; ocamlc.byte; - script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_bc_stub.exe test.ml.bc.${objext} ${nativecc_libs} test.ml_stub.c"; + script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_bc_stub.exe test.ml.bc.${objext} ${bytecc_libs} test.ml_stub.c"; output = "${compiler_output}"; script; program = "./test.ml_bc_stub.exe"; @@ -18,7 +18,7 @@ flags = "-w -a -output-complete-obj"; program = "test.ml.exe.${objext}"; ocamlopt.byte; - script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_stub.exe test.ml.exe.${objext} ${bytecc_libs} test.ml_stub.c"; + script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_stub.exe test.ml.exe.${objext} ${nativecc_libs} test.ml_stub.c"; output = "${compiler_output}"; script; program = "./test.ml_stub.exe"; From 6143355e784c7e2d845f868eacc2b072561b3ad3 Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Wed, 11 Oct 2023 18:04:32 +0100 Subject: [PATCH 163/402] Fix comment typo --- utils/load_path.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/utils/load_path.mli b/utils/load_path.mli index 983368bfe04..488b75f760d 100644 --- a/utils/load_path.mli +++ b/utils/load_path.mli @@ -101,8 +101,8 @@ val find_normalized : string -> string type visibility = Visible | Hidden val find_normalized_with_visibility : string -> string * visibility -(** Same as [find_normalized], but also whether the cmi was found in a -I - directory (Visible) or a -H directory (Hidden) *) +(** 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} *) From 474e96d1624c01f69d096380c6500a30155db46d Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Wed, 11 Oct 2023 18:11:01 +0100 Subject: [PATCH 164/402] Disable tests that print paths on windows --- testsuite/tests/hidden_includes/test.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/hidden_includes/test.ml b/testsuite/tests/hidden_includes/test.ml index 961474b7af5..4ea735dfba6 100644 --- a/testsuite/tests/hidden_includes/test.ml +++ b/testsuite/tests/hidden_includes/test.ml @@ -93,6 +93,7 @@ ocamlc.byte; ocamlc.byte; } { + not-windows; flags = "-H liba -I liba_alt -I libb -nocwd"; module = "libc/c1.ml"; setup-ocamlc.byte-build-env; @@ -103,6 +104,7 @@ ocamlc.byte; check-ocamlc.byte-output; } { + not-windows; flags = "-I liba_alt -H liba -I libb -nocwd"; module = "libc/c1.ml"; setup-ocamlc.byte-build-env; @@ -115,6 +117,7 @@ ocamlc.byte; (* The next two tests show that earlier -Hs take priority over later -Hs *) { + not-windows; flags = "-H liba_alt -H liba -I libb -nocwd"; module = "libc/c1.ml"; setup-ocamlc.byte-build-env; From 45e42acd8386a6b052e3e621953c340cf93e9767 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 28 Jul 2023 16:24:17 +0200 Subject: [PATCH 165/402] PR#12437: generalize tests/unwind to work on clang -O0 --- testsuite/tests/unwind/stack_walker.c | 2 +- testsuite/tests/unwind/unwind_test.reference | 8 -------- 2 files changed, 1 insertion(+), 9 deletions(-) diff --git a/testsuite/tests/unwind/stack_walker.c b/testsuite/tests/unwind/stack_walker.c index 6d30dbe915f..c0323ddb43b 100644 --- a/testsuite/tests/unwind/stack_walker.c +++ b/testsuite/tests/unwind/stack_walker.c @@ -50,7 +50,7 @@ value ml_perform_stack_walk(value unused) { } else { printf("%s\n", procname); } - if (!strcmp(procname, "main")) break; + if (!strcmp(procname, "caml_program")) break; } { diff --git a/testsuite/tests/unwind/unwind_test.reference b/testsuite/tests/unwind/unwind_test.reference index b3804d00e51..e9d7ddd39fd 100644 --- a/testsuite/tests/unwind/unwind_test.reference +++ b/testsuite/tests/unwind/unwind_test.reference @@ -3,16 +3,8 @@ caml_c_call Mylib.baz Driver.entry caml_program -caml_start_program -caml_startup_common -caml_main -main ml_perform_stack_walk ml_do_no_alloc Mylib.bob Driver.entry caml_program -caml_start_program -caml_startup_common -caml_main -main From 210cc86a526633683ec332518f4f254566a8115b Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Thu, 12 Oct 2023 14:41:13 +0200 Subject: [PATCH 166/402] Fix custom block promotion (#12439) Dead custom blocks in the minor heap are now finalized and not promoted to the major heap. --- Changes | 4 ++++ runtime/minor_gc.c | 49 +++++++++++++++++++++++++--------------------- 2 files changed, 31 insertions(+), 22 deletions(-) diff --git a/Changes b/Changes index df2bc5df794..d2deee94fd7 100644 --- a/Changes +++ b/Changes @@ -117,6 +117,10 @@ Working version (Stephen Dolan, review by Sébastien Hinderer, Vincent Laviron and Xavier Leroy) +- #12439: Finalize and collect dead custom blocks during minor collection + (Damien Doligez, review by Xavier Leroy, Gabriel Scherer and KC + Sivaramakrishnan) + - #12489: Fix an error-handling bug in caml_alloc_sprintf (Stephen Dolan, report by Chris Casinghino, review by Jeremy Yallop and Xavier Leroy) diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index 4fb4b2ebb8b..fe082044256 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -467,7 +467,6 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain, caml_domain_state** participating) { struct caml_minor_tables *self_minor_tables = domain->minor_tables; - struct caml_custom_elt *elt; value* young_ptr = domain->young_ptr; value* young_end = domain->young_end; uintnat minor_allocated_bytes = (uintnat)young_end - (uintnat)young_ptr; @@ -577,20 +576,6 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain, } #endif - /* unconditionally promote custom blocks so accounting is correct */ - for (elt = self_minor_tables->custom.base; - elt < self_minor_tables->custom.ptr; elt++) { - value *v = &elt->block; - if (Is_block(*v) && Is_young(*v)) { - caml_adjust_gc_speed(elt->mem, elt->max); - if (get_header_val(*v) == 0) { /* value copied to major heap */ - *v = Field(*v, 0); - } else { - oldify_one(&st, *v, v); - } - } - } - CAML_EV_BEGIN(EV_MINOR_FINALIZERS_OLDIFY); /* promote the finalizers unconditionally as we want to avoid barriers */ caml_final_do_young_roots (&oldify_one, oldify_scanning_flags, &st, @@ -614,13 +599,6 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain, CAMLassert (!Is_block(vnew) || (get_header_val(vnew) != 0 && !Is_young(vnew))); } - - for (elt = self_minor_tables->custom.base; - elt < self_minor_tables->custom.ptr; elt++) { - value vnew = elt->block; - CAMLassert (!Is_block(vnew) - || (get_header_val(vnew) != 0 && !Is_young(vnew))); - } #endif CAML_EV_BEGIN(EV_MINOR_LOCAL_ROOTS); @@ -700,6 +678,28 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain, } } +/* Finalize dead custom blocks and do the accounting for the live + ones. This must be done right after leaving the barrier. At this + point, all domains have finished minor GC, but this domain hasn't + resumed running OCaml code. Other domains may have resumed OCaml + code, but they cannot have any pointers into our minor heap. */ +static void custom_finalize_minor (caml_domain_state * domain) +{ + struct caml_custom_elt *elt; + for (elt = domain->minor_tables->custom.base; + elt < domain->minor_tables->custom.ptr; elt++) { + value *v = &elt->block; + if (Is_block(*v) && Is_young(*v)) { + if (get_header_val(*v) == 0) { /* value copied to major heap */ + caml_adjust_gc_speed(elt->mem, elt->max); + } else { + void (*final_fun)(value) = Custom_ops_val(*v)->finalize; + if (final_fun != NULL) final_fun(*v); + } + } + } +} + void caml_do_opportunistic_major_slice (caml_domain_state* domain_unused, void* unused) { @@ -741,6 +741,11 @@ caml_stw_empty_minor_heap_no_major_slice(caml_domain_state* domain, caml_gc_log("running stw empty_minor_heap_promote"); caml_empty_minor_heap_promote(domain, participating_count, participating); + CAML_EV_BEGIN(EV_MINOR_FINALIZED); + caml_gc_log("finalizing dead minor custom blocks"); + custom_finalize_minor(domain); + CAML_EV_END(EV_MINOR_FINALIZED); + CAML_EV_BEGIN(EV_MINOR_FINALIZERS_ADMIN); caml_gc_log("running finalizer data structure book-keeping"); caml_final_update_last_minor(domain); From ae18ffb44bf2592e750bea9b10a849a8bba9fff5 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 12 Oct 2023 15:31:49 +0200 Subject: [PATCH 167/402] .mailmap --- .mailmap | 1 + 1 file changed, 1 insertion(+) diff --git a/.mailmap b/.mailmap index 242dcc64191..465449bab49 100644 --- a/.mailmap +++ b/.mailmap @@ -116,6 +116,7 @@ Thomas Leonard Adrien Nader Sébastien Hinderer Sébastien Hinderer +Sébastien Hinderer Gabriel Scherer Immanuel Litzroth Jacques Le Normand From 663035af5709ba28d1b00af36c2de3eb0935d9f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 12 Oct 2023 16:34:33 +0200 Subject: [PATCH 168/402] Remove configure detection of ffs and _BitScanForward They were only needed for the best-fit allocator policy, removed in OCaml 5. --- configure | 17 ----------------- configure.ac | 5 ----- runtime/caml/s.h.in | 3 --- 3 files changed, 25 deletions(-) diff --git a/configure b/configure index 07098c63ca0..d560b0487b3 100755 --- a/configure +++ b/configure @@ -18325,23 +18325,6 @@ fi fi -## ffs or _BitScanForward - -ac_fn_c_check_func "$LINENO" "ffs" "ac_cv_func_ffs" -if test "x$ac_cv_func_ffs" = xyes -then : - printf "%s\n" "#define HAS_FFS 1" >>confdefs.h - -fi - -ac_fn_c_check_func "$LINENO" "_BitScanForward" "ac_cv_func__BitScanForward" -if test "x$ac_cv_func__BitScanForward" = xyes -then : - printf "%s\n" "#define HAS_BITSCANFORWARD 1" >>confdefs.h - -fi - - if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 diff --git a/configure.ac b/configure.ac index 7c7d9a814cd..16a58dde2c2 100644 --- a/configure.ac +++ b/configure.ac @@ -2083,11 +2083,6 @@ AC_CHECK_HEADER([spawn.h], [AC_CHECK_FUNC([posix_spawn], [AC_CHECK_FUNC([posix_spawnp], [AC_DEFINE([HAS_POSIX_SPAWN])])])]) -## ffs or _BitScanForward - -AC_CHECK_FUNC([ffs], [AC_DEFINE([HAS_FFS])]) -AC_CHECK_FUNC([_BitScanForward], [AC_DEFINE([HAS_BITSCANFORWARD])]) - AC_PATH_TOOL([PKG_CONFIG], [pkg-config], [false]) ## ZSTD compression library diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in index ce859c1354b..307fa8d633c 100644 --- a/runtime/caml/s.h.in +++ b/runtime/caml/s.h.in @@ -289,9 +289,6 @@ #undef HAS_POSIX_SPAWN -#undef HAS_FFS -#undef HAS_BITSCANFORWARD - #undef HAS_SIGWAIT #undef HAS_HUGE_PAGES From 53d0d25e36b48945f470f2deb62ba6bb99a79d44 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Thu, 12 Oct 2023 18:22:33 +0200 Subject: [PATCH 169/402] toplevel: allow multiple phrases in one line (#12029) --- .gitattributes | 1 + Changes | 4 + driver/main_args.ml | 7 ++ driver/main_args.mli | 1 + man/ocaml.1 | 24 ++-- manual/src/cmds/top.etex | 19 +-- .../multi_phrase_line.compilers.reference | 70 +++++++++++ .../tests/tool-toplevel/multi_phrase_line.ml | 32 +++++ toplevel/topcommon.ml | 4 +- toplevel/topcommon.mli | 2 + toplevel/toploop.ml | 117 ++++++++++++++++-- 11 files changed, 249 insertions(+), 32 deletions(-) create mode 100644 testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/multi_phrase_line.ml diff --git a/.gitattributes b/.gitattributes index d944f09490b..84e9c135243 100644 --- a/.gitattributes +++ b/.gitattributes @@ -118,6 +118,7 @@ testsuite/tests/generated-parse-errors/errors.* typo.very-long-line testsuite/tools/*.S typo.missing-header testsuite/tools/*.asm typo.missing-header testsuite/tests/messages/highlight_tabs.ml typo.tab +testsuite/tests/tool-toplevel/multi_phrase_line.ml typo.very-long-line # prune testsuite reference files testsuite/tests/**/*.reference typo.prune diff --git a/Changes b/Changes index d2deee94fd7..5a1f9dd3bf0 100644 --- a/Changes +++ b/Changes @@ -1240,6 +1240,10 @@ Some of those changes will benefit all OCaml packages. ### Bug fixes: +- #8813, #12029: In the toplevel, let the user type several phrases in one line + (Damien Doligez, report by Daniel Bünzli, review by Gabriel Scherer and + Wiktor Kuchta) + - #12062: fix runtime events consumer: when events are dropped they shouldn't be parsed. (Lucas Pluvinage) diff --git a/driver/main_args.ml b/driver/main_args.ml index 8fde5e4d756..13e8fbb650f 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -341,6 +341,9 @@ let mk_noinit f = let mk_nolabels f = "-nolabels", Arg.Unit f, " Ignore non-optional labels in types" +let mk_prompt f = + "-prompt", Arg.Unit f, " Output prompts (default)" + let mk_noprompt f = "-noprompt", Arg.Unit f, " Suppress all prompts" @@ -873,6 +876,7 @@ module type Toplevel_options = sig val _init : string -> unit val _noinit : unit -> unit val _no_version : unit -> unit + val _prompt : unit -> unit val _noprompt : unit -> unit val _nopromptcont : unit -> unit val _stdin : unit -> unit @@ -1140,6 +1144,7 @@ struct mk_noassert F._noassert; mk_noinit F._noinit; mk_nolabels F._nolabels; + mk_prompt F._prompt; mk_noprompt F._noprompt; mk_nopromptcont F._nopromptcont; mk_nostdlib F._nostdlib; @@ -1389,6 +1394,7 @@ module Make_opttop_options (F : Opttop_options) = struct mk_noassert F._noassert; mk_noinit F._noinit; mk_nolabels F._nolabels; + mk_prompt F._prompt; mk_noprompt F._noprompt; mk_nopromptcont F._nopromptcont; mk_nostdlib F._nostdlib; @@ -1803,6 +1809,7 @@ module Default = struct let _init s = init_file := (Some s) let _no_version = set noversion let _noinit = set noinit + let _prompt = clear noprompt let _noprompt = set noprompt let _nopromptcont = set nopromptcont let _stdin () = (* placeholder: file_argument ""*) () diff --git a/driver/main_args.mli b/driver/main_args.mli index dfc6ad4753d..e28b8fbed7b 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -134,6 +134,7 @@ module type Toplevel_options = sig val _init : string -> unit val _noinit : unit -> unit val _no_version : unit -> unit + val _prompt : unit -> unit val _noprompt : unit -> unit val _nopromptcont : unit -> unit val _stdin : unit -> unit diff --git a/man/ocaml.1 b/man/ocaml.1 index 3bc2f6e8f68..9bf9de1da6e 100644 --- a/man/ocaml.1 +++ b/man/ocaml.1 @@ -36,24 +36,20 @@ The command is the toplevel system for OCaml, that permits interactive use of the OCaml system through a read-eval-print loop. In this mode, the system repeatedly reads OCaml -phrases from the input, then typechecks, compiles and evaluates -them, then prints the inferred type and result value, if any. The -system prints a # (hash) prompt before reading each phrase. - -A toplevel phrase can span several lines. It is terminated by ;; (a -double-semicolon). The syntax of toplevel phrases is as follows. - -The toplevel system is started by the command -.BR ocaml (1). -Phrases are read on standard input, results are printed on standard -output, errors on standard error. End-of-file on standard input -terminates +phrases from standard input, then typechecks, compiles and evaluates +them, then prints the inferred type and result value, if any. +End-of-file on standard input terminates .BR ocaml (1). +Input to the toplevel can span several lines. It begins after the # +(sharp) prompt printed by the system and is terminated by ;; (a +double-semicolon) followed by optional white space and an end of line. +The toplevel input consists in one or several toplevel phrases. + If one or more .I object-files -(ending in .cmo or .cma) are given, they are loaded silently before -starting the toplevel. +(ending in .cmo or .cma) are given on the command line, they are +loaded silently before starting the toplevel. If a .I script-file diff --git a/manual/src/cmds/top.etex b/manual/src/cmds/top.etex index e237443c704..8b91f47c2f3 100644 --- a/manual/src/cmds/top.etex +++ b/manual/src/cmds/top.etex @@ -1,21 +1,22 @@ \chapter{The toplevel system or REPL (ocaml)} \label{c:camllight} %HEVEA\cutname{toplevel.html} -This chapter describes the toplevel system for OCaml, that permits +This chapter describes "ocaml", the toplevel system for OCaml, that permits interactive use of the OCaml system through a read-eval-print loop (REPL). In this mode, the system repeatedly reads OCaml phrases from the input, then typechecks, compile and evaluate them, then prints the inferred type and result value, if -any. The system prints a "#" (sharp) prompt before reading each -phrase. +any. End-of-file on standard input terminates "ocaml". -Input to the toplevel can span several lines. It is terminated by @";;"@ (a -double-semicolon). The toplevel input consists in one or several +Input to the toplevel can span several lines. It begins after the "#" +(sharp) prompt printed by the system and is terminated by @";;"@ (a +double-semicolon) followed by optional white space and comments and an +end of line. The toplevel input consists in one or several toplevel phrases, with the following syntax: \begin{syntax} toplevel-input: - {{ definition }} ';;' + { definition } ';;' | expr ';;' | '#' ident [ directive-argument ] ';;' ; @@ -26,10 +27,10 @@ directive-argument: | 'true' || 'false' \end{syntax} -A phrase can consist of a definition, like those found in +A phrase can consist of a sequence of definitions, like those found in implementations of compilation units or in @'struct' \ldots 'end'@ -module expressions. The definition can bind value names, type names, -an exception, a module name, or a module type name. The toplevel +module expressions. The definitions can bind value names, type names, +exceptions, module names, or module type names. The toplevel system performs the bindings, then prints the types and values (if any) for the names thus defined. diff --git a/testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference b/testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference new file mode 100644 index 00000000000..d02a6629bb4 --- /dev/null +++ b/testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference @@ -0,0 +1,70 @@ +# - : unit = () +# - : int = 1 +- : int = 2 +# - : int = 3 +- : unit = () +# - : int = 5 +- : unit = () +# * - : int = 7 +# * Line 2, characters 6-9: +2 | 750;; (*) comment-start warning after semicolon must be displayed once + ^^^ +Warning 1 [comment-start]: this `(*' is the start of a comment. +Hint: Did you forget spaces when writing the infix operator `( * )'? + +- : int = 750 +# Line 2, characters 9-11: +2 | 8;; let 9;; 10;; (* Syntax error in second phrase. *) + ^^ +Error: Syntax error +# - : int = 11 +Line 2, characters 16-20: +2 | 11;; let x = 12+true;; 13;; (* Type error in second phrase. *) + ^^^^ +Error: This expression has type "bool" but an expression was expected of type + "int" +# Line 2, characters 0-22: +2 | match 14 with 15 -> ();; 16;; 17;; (* Warning + run-time error in 1st phrase. *) + ^^^^^^^^^^^^^^^^^^^^^^ +Warning 8 [partial-match]: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +0 + +Exception: Match_failure ("//toplevel//", 2, 0). +- : int = 16 +- : int = 17 +# - : int = 18 +Line 2, characters 5-27: +2 | 18;; match 19 with 20 -> ();; 21;; (* Warning + run-time error in 2nd phrase. *) + ^^^^^^^^^^^^^^^^^^^^^^ +Warning 8 [partial-match]: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +0 + +Exception: Match_failure ("//toplevel//", 2, 5). +- : int = 21 +# Line 2, characters 6-8: +2 | let f 22 = ();; let f 23 = ();; let f 24 = ();; (* Several warnings. *) + ^^ +Warning 8 [partial-match]: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +0 + +val f : int -> unit = +Line 2, characters 22-24: +2 | let f 22 = ();; let f 23 = ();; let f 24 = ();; (* Several warnings. *) + ^^ +Warning 8 [partial-match]: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +0 + +val f : int -> unit = +Line 2, characters 38-40: +2 | let f 22 = ();; let f 23 = ();; let f 24 = ();; (* Several warnings. *) + ^^ +Warning 8 [partial-match]: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +0 + +val f : int -> unit = +# * * * diff --git a/testsuite/tests/tool-toplevel/multi_phrase_line.ml b/testsuite/tests/tool-toplevel/multi_phrase_line.ml new file mode 100644 index 00000000000..939913047e4 --- /dev/null +++ b/testsuite/tests/tool-toplevel/multi_phrase_line.ml @@ -0,0 +1,32 @@ +(* TEST_BELOW *) + +Printexc.record_backtrace false;; + +1;; 2;; (* Two phrases on the same line *) + +3;; ignore +4;; (* Wait for ;; at end of line before evaluating anything. *) + +5;; ignore +6;; (* Very long line needs buffer refills. *) + +7;; (* linefeed in a comment after double-semi +*) + +750;; (*) comment-start warning after semicolon must be displayed once +*) + +8;; let 9;; 10;; (* Syntax error in second phrase. *) + +11;; let x = 12+true;; 13;; (* Type error in second phrase. *) + +match 14 with 15 -> ();; 16;; 17;; (* Warning + run-time error in 1st phrase. *) + +18;; match 19 with 20 -> ();; 21;; (* Warning + run-time error in 2nd phrase. *) + +let f 22 = ();; let f 23 = ();; let f 24 = ();; (* Several warnings. *) + +(* TEST + flags = "-prompt"; + toplevel; +*) diff --git a/toplevel/topcommon.ml b/toplevel/topcommon.ml index 149b61da4ac..d281b3ad68f 100644 --- a/toplevel/topcommon.ml +++ b/toplevel/topcommon.ml @@ -239,13 +239,15 @@ let read_input_default prompt buffer len = let read_interactive_input = ref read_input_default +let comment_prompt_override = ref false + let refill_lexbuf buffer len = if !got_eof then (got_eof := false; 0) else begin let prompt = if !Clflags.noprompt then "" else if !first_line then "# " else if !Clflags.nopromptcont then "" - else if Lexer.in_comment () then "* " + else if Lexer.in_comment () || !comment_prompt_override then "* " else " " in first_line := false; diff --git a/toplevel/topcommon.mli b/toplevel/topcommon.mli index f71304bd4f3..bcbe1a80f97 100644 --- a/toplevel/topcommon.mli +++ b/toplevel/topcommon.mli @@ -230,4 +230,6 @@ val backtrace: string option ref val parse_mod_use_file: string -> Lexing.lexbuf -> Parsetree.toplevel_phrase list +val comment_prompt_override : bool ref + val refill_lexbuf: bytes -> int -> int diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index b2f1d2f82ec..c4692860be0 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -187,6 +187,110 @@ let load_ocamlinit ppf = exception PPerror +let ends_with_lf lb = + let open Lexing in + Bytes.get lb.lex_buffer (lb.lex_buffer_len - 1) = '\n' + +(* Without changing the state of [lb], try to see if it contains a token. + Return [EOF] if there is no token in [lb], a token if there is one, + or raise a lexer error as appropriate. + Print lexer warnings or not according to [print_warnings]. +*) +let look_ahead ~print_warnings lb = + let shadow = + Lexing.{ lb with + refill_buff = (fun newlb -> newlb.lex_eof_reached <- true); + lex_buffer = Bytes.copy lb.lex_buffer; + lex_mem = Array.copy lb.lex_mem; + } + in + Misc.protect_refs [ + R (Lexer.print_warnings, print_warnings); + Location.(R (report_printer, fun () -> batch_mode_printer)); + ] (fun () -> Lexer.token shadow) +;; + +(* Refill the buffer until the next linefeed or end-of-file that is not + inside a comment and check that its contents can be ignored. + We do this by adding whole lines to the lexbuf until one of these + occurs: + - it contains no tokens and no unterminated comments + - it contains some token or unterminated string + - it contains a lexical error +*) +let is_blank_with_linefeed lb = + let open Lexing in + if Bytes.get lb.lex_buffer lb.lex_curr_pos = '\n' then + (* shortcut for the most usual case *) + true + else begin + let rec loop () = + if not (lb.lex_eof_reached || ends_with_lf lb) then begin + (* Make sure the buffer does not contain a truncated line. *) + lb.refill_buff lb; + loop () + end else begin + (* Check for tokens in the lexbuf. We may have to + repeat this step, so don't print any warnings yet. *) + match look_ahead ~print_warnings:false lb with + | EOF -> true (* no tokens *) + | _ -> false (* some token *) + | exception Lexer.(Error ((Unterminated_comment _ + | Unterminated_string_in_comment _), _)) -> + (* In this case we don't know whether there will be a token + before the next linefeed, so get more chars and continue. *) + Misc.protect_refs [ R (comment_prompt_override, true) ] + (fun () -> lb.refill_buff lb); + loop () + | exception _ -> false (* syntax error *) + end + in + loop () + end + +(* Read and parse toplevel phrases, stop when a complete phrase has been + parsed and the lexbuf contains and end of line with optional whitespace + and comments. *) +let rec get_phrases ppf lb phrs = + match !parse_toplevel_phrase lb with + | phr -> + if is_blank_with_linefeed lb then begin + (* The lexbuf does not contain any tokens. We know it will be + flushed after the phrases are evaluated, so print warnings now. *) + ignore (look_ahead ~print_warnings:true lb); + List.rev (phr :: phrs) + end else + get_phrases ppf lb (phr :: phrs) + | exception Exit -> raise PPerror + | exception e -> Location.report_exception ppf e; [] + +(* Type, compile and execute a phrase. *) +let process_phrase ppf snap phr = + snap := Btype.snapshot (); + Warnings.reset_fatal (); + let phr = preprocess_phrase ppf phr in + Env.reset_cache_toplevel (); + ignore(execute_phrase true ppf phr) + +(* Type, compile and execute a list of phrases, setting the report printer + to batch mode for all but the first one. + We have to use batch mode for reporting for two reasons: + 1. we can't underline several parts of the input line(s) in place + 2. the execution of the first phrase may mess up the line count so we + can't move the cursor back to the correct line + *) +let process_phrases ppf snap phrs = + match phrs with + | [] -> () + | phr :: rest -> + process_phrase ppf snap phr; + if rest <> [] then begin + let process ph = Location.reset (); process_phrase ppf snap ph in + Misc.protect_refs + Location.[R (report_printer, fun () -> batch_mode_printer)] + (fun () -> List.iter process rest) + end + let loop ppf = Clflags.debug := true; Location.formatter_for_warnings := ppf; @@ -209,21 +313,18 @@ let loop ppf = run_hooks After_setup; load_ocamlinit ppf; while true do - let snap = Btype.snapshot () in + let snap = ref (Btype.snapshot ()) in try Lexing.flush_input lb; (* Reset the phrase buffer when we flush the lexing buffer. *) Buffer.reset phrase_buffer; Location.reset(); - Warnings.reset_fatal (); first_line := true; - let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in - let phr = preprocess_phrase ppf phr in - Env.reset_cache_toplevel (); - ignore(execute_phrase true ppf phr) + let phrs = get_phrases ppf lb [] in + process_phrases ppf snap phrs with | End_of_file -> raise (Compenv.Exit_with_status 0) - | Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap + | Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack !snap | PPerror -> () - | x -> Location.report_exception ppf x; Btype.backtrack snap + | x -> Location.report_exception ppf x; Btype.backtrack !snap done From 51d7900c06f0f0ed01f27eda74ab0da0656e1f39 Mon Sep 17 00:00:00 2001 From: Fabrice Buoro Date: Thu, 12 Oct 2023 18:30:34 +0200 Subject: [PATCH 170/402] TSan tests more reliable by removing sleep synchronisation Co-authored-by: Antonin Decimo Co-authored-by: Olivier Nicole --- testsuite/tests/tsan/array_elt.ml | 19 +++++-- testsuite/tests/tsan/array_elt.reference | 21 +++----- testsuite/tests/tsan/exn_from_c.ml | 37 ++++++++------ testsuite/tests/tsan/exn_from_c.reference | 34 +++++-------- testsuite/tests/tsan/exn_in_callback.ml | 45 ++++++++-------- .../tests/tsan/exn_in_callback.reference | 32 +++++------- testsuite/tests/tsan/exn_reraise.ml | 37 +++++++++----- testsuite/tests/tsan/exn_reraise.reference | 34 +++++-------- testsuite/tests/tsan/norace_atomics.ml | 19 +++++-- testsuite/tests/tsan/perform.ml | 51 +++++++++++-------- testsuite/tests/tsan/perform.reference | 43 ++++------------ testsuite/tests/tsan/raise_through_handler.ml | 27 +++++----- .../tsan/raise_through_handler.reference | 25 ++++----- testsuite/tests/tsan/record_field.ml | 21 ++++++-- testsuite/tests/tsan/record_field.reference | 19 +++---- testsuite/tests/tsan/reperform.ml | 28 ++++++---- testsuite/tests/tsan/reperform.reference | 37 +++----------- testsuite/tests/tsan/unhandled.ml | 42 ++++++++------- testsuite/tests/tsan/unhandled.reference | 34 ++++--------- testsuite/tests/tsan/waitgroup.ml | 7 +++ testsuite/tests/tsan/waitgroup_stubs.c | 51 +++++++++++++++++++ 21 files changed, 348 insertions(+), 315 deletions(-) create mode 100644 testsuite/tests/tsan/waitgroup.ml create mode 100644 testsuite/tests/tsan/waitgroup_stubs.c diff --git a/testsuite/tests/tsan/array_elt.ml b/testsuite/tests/tsan/array_elt.ml index 52b7b92b76d..dd0a9eb0a2f 100644 --- a/testsuite/tests/tsan/array_elt.ml +++ b/testsuite/tests/tsan/array_elt.ml @@ -4,12 +4,23 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml array_elt.ml"; native; *) +let wg = Waitgroup.create 2 + +let [@inline never] writer v () = + Waitgroup.join wg; + Array.set v 3 0 + +let [@inline never] reader v = + ignore (Sys.opaque_identity (Array.get v 3)); + Waitgroup.join wg + let () = let v = Array.make 4 0 in - let t1 = Domain.spawn (fun () -> Array.set v 3 0; Unix.sleepf 0.1) in - let t2 = Domain.spawn (fun () -> ignore (Sys.opaque_identity (Array.get v 3)); Unix.sleepf 0.1) in - Domain.join t1; - Domain.join t2; + let d = Domain.spawn (writer v) in + reader v; + Domain.join d diff --git a/testsuite/tests/tsan/array_elt.reference b/testsuite/tests/tsan/array_elt.reference index 716e76937d2..3e37b6d616b 100644 --- a/testsuite/tests/tsan/array_elt.reference +++ b/testsuite/tests/tsan/array_elt.reference @@ -1,12 +1,13 @@ ================== WARNING: ThreadSanitizer: data race (pid=) - Read of size 8 at by thread T4 (mutexes: write M): - #0 camlArray_elt.fun_ () + Write of size 8 at by thread T1 (mutexes: write M): + #0 camlArray_elt.writer_ () #1 camlStdlib__Domain.body_ () - Previous write of size 8 at by thread T1 (mutexes: write M): - #0 camlArray_elt.fun_ () - #1 camlStdlib__Domain.body_ () + Previous read of size 8 at by main thread (mutexes: write M): + #0 camlArray_elt.reader_ () + #1 camlArray_elt.entry () + #2 caml_program () Mutex M () created at: #0 pthread_mutex_init () @@ -20,14 +21,6 @@ WARNING: ThreadSanitizer: data race (pid=) #2 caml_init_domains () #3 caml_init_gc () - Thread T4 (tid=, running) created by main thread at: - #0 pthread_create () - #1 caml_domain_spawn () - #2 caml_c_call () - #3 camlStdlib__Domain.spawn_ () - #4 camlArray_elt.entry () - #5 caml_program () - Thread T1 (tid=, running) created by main thread at: #0 pthread_create () #1 caml_domain_spawn () @@ -36,6 +29,6 @@ WARNING: ThreadSanitizer: data race (pid=) #4 camlArray_elt.entry () #5 caml_program () -SUMMARY: ThreadSanitizer: data race (:) in camlArray_elt.fun_ +SUMMARY: ThreadSanitizer: data race (:) in camlArray_elt.writer_ ================== ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/exn_from_c.ml b/testsuite/tests/tsan/exn_from_c.ml index 2e79ef71dec..335cd03623c 100644 --- a/testsuite/tests/tsan/exn_from_c.ml +++ b/testsuite/tests/tsan/exn_from_c.ml @@ -1,12 +1,12 @@ (* TEST - modules = "callbacks.c"; - ocamlopt_flags = "-g -ccopt -fsanitize=thread -ccopt -O1 -ccopt -fno-omit-frame-pointer -ccopt -g"; include unix; set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "callbacks.c waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml exn_from_c.ml"; native; *) @@ -15,37 +15,44 @@ external print_and_raise : unit -> unit = "print_and_raise" open Printf +let wg = Waitgroup.create 2 let r = ref 0 -let [@inline never] race () = ignore @@ !r +let [@inline never] race () = + ignore @@ !r; + Waitgroup.join wg let [@inline never] i () = - printf "entering i\n%!"; - printf "calling print_and_raise...\n%!"; + printf "Entering i\n%!"; + printf "Calling print_and_raise...\n%!"; print_and_raise (); - printf "leaving i\n%!" + printf "Leaving i\n%!" let [@inline never] h () = - printf "entering h\n%!"; + printf "Entering h\n%!"; i (); - printf "leaving h\n%!" + printf "Leaving h\n%!" let [@inline never] g () = - printf "entering g\n%!"; + printf "Entering g\n%!"; h (); - printf "leaving g\n%!" + printf "Leaving g\n%!" let [@inline never] f () = - printf "entering f\n%!"; + printf "Entering f\n%!"; (try g () with Failure msg -> - printf "caught Failure \"%s\"\n%!" msg; + printf "Caught Failure \"%s\"\n%!" msg; Printexc.print_backtrace stdout; race ()); - printf "leaving f\n%!" + printf "Leaving f\n%!" + +let [@inline never] writer () = + Waitgroup.join wg; + r := 1 let () = Printexc.record_backtrace true; - let d = Domain.spawn (fun () -> Unix.sleep 1; r := 1) in - f (); Unix.sleep 1; + let d = Domain.spawn writer in + f (); Domain.join d diff --git a/testsuite/tests/tsan/exn_from_c.reference b/testsuite/tests/tsan/exn_from_c.reference index f29fdf2f91b..bc7acc2bddc 100644 --- a/testsuite/tests/tsan/exn_from_c.reference +++ b/testsuite/tests/tsan/exn_from_c.reference @@ -1,19 +1,19 @@ -entering f -entering g -entering h -entering i -calling print_and_raise... +Entering f +Entering g +Entering h +Entering i +Calling print_and_raise... Hello from print_and_raise -caught Failure "test" -Raised by primitive operation at Exn_from_c.i in file "exn_from_c.ml", line 25, characters 2-20 -Called from Exn_from_c.h in file "exn_from_c.ml", line 30, characters 2-6 -Called from Exn_from_c.g in file "exn_from_c.ml", line 35, characters 2-6 -Called from Exn_from_c.f in file "exn_from_c.ml", line 40, characters 7-11 -leaving f +Caught Failure "test" +Raised by primitive operation at Exn_from_c.i in file "exn_from_c.ml", line 28, characters 2-20 +Called from Exn_from_c.h in file "exn_from_c.ml", line 33, characters 2-6 +Called from Exn_from_c.g in file "exn_from_c.ml", line 38, characters 2-6 +Called from Exn_from_c.f in file "exn_from_c.ml", line 43, characters 7-11 +Leaving f ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by thread T1 (mutexes: write M): - #0 camlExn_from_c.fun_ () + #0 camlExn_from_c.writer_ () #1 camlStdlib__Domain.body_ () Previous read of size 8 at by main thread (mutexes: write M): @@ -22,14 +22,6 @@ WARNING: ThreadSanitizer: data race (pid=) #2 camlExn_from_c.entry () #3 caml_program () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlUnix.sleep_ () - #4 camlExn_from_c.fun_ () - #5 camlStdlib__Domain.body_ () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -50,6 +42,6 @@ WARNING: ThreadSanitizer: data race (pid=) #4 camlExn_from_c.entry () #5 caml_program () -SUMMARY: ThreadSanitizer: data race (:) in camlExn_from_c.fun_ +SUMMARY: ThreadSanitizer: data race (:) in camlExn_from_c.writer_ ================== ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/exn_in_callback.ml b/testsuite/tests/tsan/exn_in_callback.ml index a136e6db359..c4d327cef9a 100644 --- a/testsuite/tests/tsan/exn_in_callback.ml +++ b/testsuite/tests/tsan/exn_in_callback.ml @@ -1,12 +1,12 @@ (* TEST - modules = "callbacks.c"; - ocamlopt_flags = "-g -ccopt -fsanitize=thread -ccopt -O1 -ccopt -fno-omit-frame-pointer -ccopt -g"; include unix; set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "callbacks.c waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml exn_in_callback.ml"; native; *) @@ -17,45 +17,48 @@ external print_and_call_ocaml_h : unit -> unit = "print_and_call_ocaml_h" open Printf +let wg = Waitgroup.create 2 let r = ref 0 -let [@inline never] race () = ignore @@ !r +let [@inline never] race () = + ignore @@ !r; + Waitgroup.join wg let [@inline never] i () = - printf "entering i\n%!"; - printf "throwing Exn...\n%!"; - (*race ();*) + printf "Entering i\n%!"; + printf "Throwing ExnB...\n%!"; ignore (raise ExnB); - printf "leaving i\n%!" + printf "Leaving i\n%!" let [@inline never] h () = - printf "entering h\n%!"; + printf "Entering h\n%!"; i (); - (* try i () with - | ExnA -> printf "caught an ExnA\n%!"; - *) - printf "leaving h\n%!" + printf "Leaving h\n%!" let _ = Callback.register "ocaml_h" h let [@inline never] g () = - printf "entering g\n%!"; - printf "calling C code\n%!"; + printf "Entering g\n%!"; + printf "Calling C code\n%!"; print_and_call_ocaml_h (); - printf "back from C code\n%!"; - printf "leaving g\n%!" + printf "Back from C code\n%!"; + printf "Leaving g\n%!" let [@inline never] f () = - printf "entering f\n%!"; + printf "Entering f\n%!"; (try g () with | ExnB -> - printf "caught an ExnB\n%!"; + printf "Caught an ExnB\n%!"; Printexc.print_backtrace stdout; race ()); - printf "leaving f\n%!" + printf "Leaving f\n%!" + +let [@inline never] writer () = + Waitgroup.join wg; + r := 1 let () = Printexc.record_backtrace true; - let d = Domain.spawn (fun () -> Unix.sleep 1; r := 1) in - f (); Unix.sleep 1; + let d = Domain.spawn writer in + f (); Domain.join d diff --git a/testsuite/tests/tsan/exn_in_callback.reference b/testsuite/tests/tsan/exn_in_callback.reference index bea150c90f0..e4d01834d21 100644 --- a/testsuite/tests/tsan/exn_in_callback.reference +++ b/testsuite/tests/tsan/exn_in_callback.reference @@ -1,18 +1,18 @@ -entering f -entering g -calling C code +Entering f +Entering g +Calling C code Hello from print_and_call_ocaml_h -entering h -entering i -throwing Exn... -caught an ExnB -Raised by primitive operation at Exn_in_callback.g in file "exn_in_callback.ml", line 44, characters 2-27 -Called from Exn_in_callback.f in file "exn_in_callback.ml", line 50, characters 7-11 -leaving f +Entering h +Entering i +Throwing ExnB... +Caught an ExnB +Raised by primitive operation at Exn_in_callback.g in file "exn_in_callback.ml", line 43, characters 2-27 +Called from Exn_in_callback.f in file "exn_in_callback.ml", line 49, characters 7-11 +Leaving f ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by thread T1 (mutexes: write M): - #0 camlExn_in_callback.fun_ () + #0 camlExn_in_callback.writer_ () #1 camlStdlib__Domain.body_ () Previous read of size 8 at by main thread (mutexes: write M): @@ -21,14 +21,6 @@ WARNING: ThreadSanitizer: data race (pid=) #2 camlExn_in_callback.entry () #3 caml_program () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlUnix.sleep_ () - #4 camlExn_in_callback.fun_ () - #5 camlStdlib__Domain.body_ () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -49,6 +41,6 @@ WARNING: ThreadSanitizer: data race (pid=) #4 camlExn_in_callback.entry () #5 caml_program () -SUMMARY: ThreadSanitizer: data race (:) in camlExn_in_callback.fun_ +SUMMARY: ThreadSanitizer: data race (:) in camlExn_in_callback.writer_ ================== ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/exn_reraise.ml b/testsuite/tests/tsan/exn_reraise.ml index 9ad6fb9193d..444e7b0da77 100644 --- a/testsuite/tests/tsan/exn_reraise.ml +++ b/testsuite/tests/tsan/exn_reraise.ml @@ -5,6 +5,8 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml exn_reraise.ml"; native; *) @@ -13,38 +15,45 @@ exception ExnB open Printf +let wg = Waitgroup.create 2 let r = ref 0 -let [@inline never] race () = ignore @@ !r +let [@inline never] race () = + ignore @@ !r; + Waitgroup.join wg let [@inline never] i () = - printf "entering i\n%!"; - printf "throwing Exn...\n%!"; + printf "Entering i\n%!"; + printf "Throwing ExnA...\n%!"; ignore (raise ExnA); - printf "leaving i\n%!" + printf "Leaving i\n%!" let [@inline never] h () = - printf "entering h\n%!"; + printf "Entering h\n%!"; try i () with - | ExnB -> printf "caught an ExnB\n%!"; - printf "leaving h\n%!" + | ExnB -> printf "Caught an ExnB\n%!"; + printf "Leaving h\n%!" let [@inline never] g () = - printf "entering g\n%!"; + printf "Entering g\n%!"; h (); - printf "leaving g\n%!" + printf "Leaving g\n%!" let [@inline never] f () = - printf "entering f\n%!"; + printf "Entering f\n%!"; (try g () with | ExnA -> - printf "caught an ExnA\n%!"; + printf "Caught an ExnA\n%!"; Printexc.print_backtrace stdout; race ()); - printf "leaving f\n%!" + printf "Leaving f\n%!" + +let [@inline never] writer () = + Waitgroup.join wg; + r := 1 let () = Printexc.record_backtrace true; - let d = Domain.spawn (fun () -> Unix.sleep 1; r := 1) in - f (); Unix.sleep 1; + let d = Domain.spawn writer in + f (); Domain.join d diff --git a/testsuite/tests/tsan/exn_reraise.reference b/testsuite/tests/tsan/exn_reraise.reference index 27342e6b8fe..58dd9b5db21 100644 --- a/testsuite/tests/tsan/exn_reraise.reference +++ b/testsuite/tests/tsan/exn_reraise.reference @@ -1,18 +1,18 @@ -entering f -entering g -entering h -entering i -throwing Exn... -caught an ExnA -Raised at Exn_reraise.i in file "exn_reraise.ml", line 23, characters 9-21 -Called from Exn_reraise.h in file "exn_reraise.ml", line 28, characters 6-10 -Called from Exn_reraise.g in file "exn_reraise.ml", line 34, characters 2-6 -Called from Exn_reraise.f in file "exn_reraise.ml", line 39, characters 7-11 -leaving f +Entering f +Entering g +Entering h +Entering i +Throwing ExnA... +Caught an ExnA +Raised at Exn_reraise.i in file "exn_reraise.ml", line 28, characters 9-21 +Called from Exn_reraise.h in file "exn_reraise.ml", line 33, characters 6-10 +Called from Exn_reraise.g in file "exn_reraise.ml", line 39, characters 2-6 +Called from Exn_reraise.f in file "exn_reraise.ml", line 44, characters 7-11 +Leaving f ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by thread T1 (mutexes: write M): - #0 camlExn_reraise.fun_ () + #0 camlExn_reraise.writer_ () #1 camlStdlib__Domain.body_ () Previous read of size 8 at by main thread (mutexes: write M): @@ -21,14 +21,6 @@ WARNING: ThreadSanitizer: data race (pid=) #2 camlExn_reraise.entry () #3 caml_program () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlUnix.sleep_ () - #4 camlExn_reraise.fun_ () - #5 camlStdlib__Domain.body_ () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -49,6 +41,6 @@ WARNING: ThreadSanitizer: data race (pid=) #4 camlExn_reraise.entry () #5 caml_program () -SUMMARY: ThreadSanitizer: data race (:) in camlExn_reraise.fun_ +SUMMARY: ThreadSanitizer: data race (:) in camlExn_reraise.writer_ ================== ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/norace_atomics.ml b/testsuite/tests/tsan/norace_atomics.ml index 1bd42299941..1b6363e6802 100644 --- a/testsuite/tests/tsan/norace_atomics.ml +++ b/testsuite/tests/tsan/norace_atomics.ml @@ -4,15 +4,24 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml norace_atomics.ml"; native; *) +let wg = Waitgroup.create 2 let v = Atomic.make 0 +let [@inline never] writer () = + Waitgroup.join wg; + Atomic.set v 10 + +let [@inline never] reader () = + ignore (Sys.opaque_identity (Atomic.get v)); + Waitgroup.join wg + let () = - let t1 = Domain.spawn (fun () -> Atomic.set v 10; Unix.sleep 1) in - let t2 = Domain.spawn (fun () -> - ignore (Sys.opaque_identity (Atomic.get v)); Unix.sleep 1) in - Domain.join t1; - Domain.join t2 + let d = Domain.spawn writer in + reader (); + Domain.join d diff --git a/testsuite/tests/tsan/perform.ml b/testsuite/tests/tsan/perform.ml index 0b0ad24b937..7512ab2e9bf 100644 --- a/testsuite/tests/tsan/perform.ml +++ b/testsuite/tests/tsan/perform.ml @@ -5,6 +5,8 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml perform.ml"; native; *) @@ -20,42 +22,47 @@ open Effect.Deep type _ Effect.t += E : int -> int t -let g_ref1 = ref 0 -let g_ref2 = ref 0 -let g_ref3 = ref 0 +let wg1 = Waitgroup.create 2 +let wg2 = Waitgroup.create 2 +let r1 = ref 0 +let r2 = ref 0 +let r3 = ref 0 + +(* Force synchronisation of test output with TSan output to stderr *) +let print_endline s = Stdlib.print_endline s; flush stdout let [@inline never] race = function - | 0 -> g_ref1 := 42 - | 1 -> g_ref2 := 42 - | _ -> g_ref3 := 42 + | 0 -> r1 := 42 + | 1 -> r2 := 42 + | _ -> r3 := 42 let [@inline never] h () = - print_endline "entering h and perform-ing"; + print_endline "Entering h and perform-ing"; let v = perform (E 0) in - print_endline "resuming h"; + print_endline "Resuming h"; race 0; - print_endline "leaving h"; + print_endline "Leaving h"; v let [@inline never] g () = - print_endline "entering g"; + print_endline "Entering g"; let v = h () in - print_endline "leaving g"; + print_endline "Leaving g"; v let [@inline never] f () = - print_endline "computation, entering f"; + print_endline "Computation, entering f"; let v = g () in - print_endline "computation, leaving f"; + print_endline "Computation, leaving f"; v + 1 let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = function | E v -> Some (fun k -> - print_endline "in the effect handler"; + print_endline "In the effect handler"; race 1; let v = continue k (v + 1) in - print_endline "handler after continue"; + print_endline "Handler after continue"; v + 1 ) | e -> None @@ -65,22 +72,24 @@ let[@inline never] main () = ignore ( match_with f () { retc = (fun v -> - print_endline "value handler"; + print_endline "Value handler"; race 2; v + 1 ); exnc = (fun e -> raise e); effc = effh } ); - 44 + 42 let[@inline never] other_domain () = - ignore (Sys.opaque_identity (!g_ref1, !g_ref2, !g_ref3)); - Unix.sleepf 0.66 + ignore (Sys.opaque_identity (!r1, !r2, !r3)); + Waitgroup.join wg1; + Waitgroup.join wg2 let () = let d = Domain.spawn other_domain in - Unix.sleepf 0.33; + Waitgroup.join wg1; let v = main () in - printf "result = %d\n" v; + Waitgroup.join wg2; + eprintf "Result = %d\n" v; Domain.join d diff --git a/testsuite/tests/tsan/perform.reference b/testsuite/tests/tsan/perform.reference index b06777fb25d..1f6a7eb76de 100644 --- a/testsuite/tests/tsan/perform.reference +++ b/testsuite/tests/tsan/perform.reference @@ -1,8 +1,8 @@ Let's work! -computation, entering f -entering g -entering h and perform-ing -in the effect handler +Computation, entering f +Entering g +Entering h and perform-ing +In the effect handler ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by main thread (mutexes: write M): @@ -16,13 +16,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlPerform.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlPerform.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -45,7 +38,7 @@ WARNING: ThreadSanitizer: data race (pid=) SUMMARY: ThreadSanitizer: data race (:) in camlPerform.race_ ================== -resuming h +Resuming h ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by main thread (mutexes: write M): @@ -63,13 +56,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlPerform.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlPerform.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -92,10 +78,10 @@ WARNING: ThreadSanitizer: data race (pid=) SUMMARY: ThreadSanitizer: data race (:) in camlPerform.race_ ================== -leaving h -leaving g -computation, leaving f -value handler +Leaving h +Leaving g +Computation, leaving f +Value handler ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by main thread (mutexes: write M): @@ -110,13 +96,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlPerform.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlPerform.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -139,6 +118,6 @@ WARNING: ThreadSanitizer: data race (pid=) SUMMARY: ThreadSanitizer: data race (:) in camlPerform.race_ ================== -handler after continue -result = 44 +Handler after continue +Result = 42 ThreadSanitizer: reported 3 warnings diff --git a/testsuite/tests/tsan/raise_through_handler.ml b/testsuite/tests/tsan/raise_through_handler.ml index d72b6ba1a6e..d656c66e801 100644 --- a/testsuite/tests/tsan/raise_through_handler.ml +++ b/testsuite/tests/tsan/raise_through_handler.ml @@ -5,6 +5,8 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml raise_through_handler.ml"; native; *) @@ -13,21 +15,23 @@ open Printf open Effect open Effect.Deep -let g_ref = ref 0 +let wg = Waitgroup.create 2 +let r = ref 0 let [@inline never] race () = - g_ref := 42 + r := 42; + Waitgroup.join wg let [@inline never] g () = - print_endline "entering g"; + print_endline "Entering g"; ignore @@ raise Exit; - print_endline "leaving g"; + print_endline "Leaving g"; 12 let [@inline never] f () = - print_endline "computation, entering f"; + print_endline "Computation, entering f"; let v = g () in - print_endline "computation, leaving f"; + print_endline "Computation, leaving f"; v + 1 let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = fun _ -> None @@ -47,13 +51,12 @@ let[@inline never] main () = ); 44 -let[@inline never] other_domain () = - ignore (Sys.opaque_identity !g_ref); - Unix.sleepf 0.66 +let [@inline never] reader () = + Waitgroup.join wg; + ignore (Sys.opaque_identity !r) let () = - let d = Domain.spawn other_domain in - Unix.sleepf 0.33; + let d = Domain.spawn reader in let v = main () in - printf "result = %d\n" v; + printf "Result = %d\n" v; Domain.join d diff --git a/testsuite/tests/tsan/raise_through_handler.reference b/testsuite/tests/tsan/raise_through_handler.reference index e7841fbaa72..9f8ae796e9a 100644 --- a/testsuite/tests/tsan/raise_through_handler.reference +++ b/testsuite/tests/tsan/raise_through_handler.reference @@ -1,26 +1,19 @@ Let's work! -computation, entering f -entering g +Computation, entering f +Entering g In exception handler ================== WARNING: ThreadSanitizer: data race (pid=) - Write of size 8 at by main thread (mutexes: write M): + Read of size 8 at by thread T1 (mutexes: write M): + #0 camlRaise_through_handler.reader_ () + #1 camlStdlib__Domain.body_ () + + Previous write of size 8 at by main thread (mutexes: write M): #0 camlRaise_through_handler.race_ () #1 camlRaise_through_handler.main_ () #2 camlRaise_through_handler.entry () #3 caml_program () - Previous read of size 8 at by thread T1 (mutexes: write M): - #0 camlRaise_through_handler.other_domain_ () - #1 camlStdlib__Domain.body_ () - - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlRaise_through_handler.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -41,7 +34,7 @@ WARNING: ThreadSanitizer: data race (pid=) #4 camlRaise_through_handler.entry () #5 caml_program () -SUMMARY: ThreadSanitizer: data race (:) in camlRaise_through_handler.race_ +SUMMARY: ThreadSanitizer: data race (:) in camlRaise_through_handler.reader_ ================== -result = 44 +Result = 44 ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/record_field.ml b/testsuite/tests/tsan/record_field.ml index e35947e0697..0029073f776 100644 --- a/testsuite/tests/tsan/record_field.ml +++ b/testsuite/tests/tsan/record_field.ml @@ -4,15 +4,28 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml record_field.ml"; native; *) type t = { mutable x : int } +let wg1 = Waitgroup.create 2 +let wg2 = Waitgroup.create 2 let v = { x = 0 } +let writer () = + v.x <- 10; + Waitgroup.join wg1; + Waitgroup.join wg2 + +let reader () = + Waitgroup.join wg1; + ignore (Sys.opaque_identity v.x); + Waitgroup.join wg2 + let () = - let t1 = Domain.spawn (fun () -> v.x <- 10; Unix.sleepf 0.1) in - let t2 = Domain.spawn (fun () -> ignore (Sys.opaque_identity v.x); Unix.sleepf 0.1) in - Domain.join t1; - Domain.join t2 + let d = Domain.spawn writer in + reader (); + Domain.join d diff --git a/testsuite/tests/tsan/record_field.reference b/testsuite/tests/tsan/record_field.reference index 8fac57ab4d0..581f4440ab3 100644 --- a/testsuite/tests/tsan/record_field.reference +++ b/testsuite/tests/tsan/record_field.reference @@ -1,11 +1,12 @@ ================== WARNING: ThreadSanitizer: data race (pid=) - Read of size 8 at by thread T4 (mutexes: write M): - #0 camlRecord_field.fun_ () - #1 camlStdlib__Domain.body_ () + Read of size 8 at by main thread (mutexes: write M): + #0 camlRecord_field.reader_ () + #1 camlRecord_field.entry () + #2 caml_program () Previous write of size 8 at by thread T1 (mutexes: write M): - #0 camlRecord_field.fun_ () + #0 camlRecord_field.writer_ () #1 camlStdlib__Domain.body_ () Mutex M () created at: @@ -20,14 +21,6 @@ WARNING: ThreadSanitizer: data race (pid=) #2 caml_init_domains () #3 caml_init_gc () - Thread T4 (tid=, running) created by main thread at: - #0 pthread_create () - #1 caml_domain_spawn () - #2 caml_c_call () - #3 camlStdlib__Domain.spawn_ () - #4 camlRecord_field.entry () - #5 caml_program () - Thread T1 (tid=, running) created by main thread at: #0 pthread_create () #1 caml_domain_spawn () @@ -36,6 +29,6 @@ WARNING: ThreadSanitizer: data race (pid=) #4 camlRecord_field.entry () #5 caml_program () -SUMMARY: ThreadSanitizer: data race (:) in camlRecord_field.fun_ +SUMMARY: ThreadSanitizer: data race (:) in camlRecord_field.reader_ ================== ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/reperform.ml b/testsuite/tests/tsan/reperform.ml index 4d008e43f22..a2610b1b164 100644 --- a/testsuite/tests/tsan/reperform.ml +++ b/testsuite/tests/tsan/reperform.ml @@ -5,6 +5,8 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml reperform.ml"; native; *) @@ -23,6 +25,8 @@ let print_endline s = Stdlib.print_endline s; flush stdout type _ t += E1 : int -> int t type _ t += E2 : int -> int t +let wg1 = Waitgroup.create 2 +let wg2 = Waitgroup.create 2 let g_ref1 = ref 0 let g_ref2 = ref 0 let g_ref3 = ref 0 @@ -34,22 +38,22 @@ let [@inline never] race = | _ -> g_ref3 := 1 let [@inline never] h () = - print_endline "entering h"; + print_endline "Entering h"; let v = perform (E1 0) in race 1; - print_endline "leaving h"; + print_endline "Leaving h"; v let [@inline never] g () = - print_endline "entering g"; + print_endline "Entering g"; let v = h () in - print_endline "leaving g"; + print_endline "Leaving g"; v let f () = - print_endline "entering f"; + print_endline "Entering f"; let v = g () in - print_endline "leaving f"; + print_endline "Leaving f"; v + 1 let [@inline never] fiber2 () = @@ -79,10 +83,10 @@ let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = function let [@inline never] fiber1 () = ignore @@ match_with fiber2 () { retc = (fun v -> - print_endline "value handler"; v + 1); + print_endline "Value handler"; v + 1); exnc = (fun e -> raise e); effc = effh }; - 1338 + 41 let[@inline never] main () = let v = fiber1 () in @@ -90,12 +94,14 @@ let[@inline never] main () = let[@inline never] other_domain () = ignore @@ (!g_ref1, !g_ref2, !g_ref3); - Unix.sleepf 0.66 + Waitgroup.join wg1; + Waitgroup.join wg2 let () = let d = Domain.spawn other_domain in - Unix.sleepf 0.33; + Waitgroup.join wg1; let v = main () in - printf "result=%d\n%!" v; + printf "Result=%d\n%!" v; race 2; + Waitgroup.join wg2; Domain.join d diff --git a/testsuite/tests/tsan/reperform.reference b/testsuite/tests/tsan/reperform.reference index 6ed33a7162b..e97e0aa50e9 100644 --- a/testsuite/tests/tsan/reperform.reference +++ b/testsuite/tests/tsan/reperform.reference @@ -1,6 +1,6 @@ -entering f -entering g -entering h +Entering f +Entering g +Entering h E1 handler before continue ================== WARNING: ThreadSanitizer: data race (pid=) @@ -16,13 +16,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlReperform.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlReperform.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -65,13 +58,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlReperform.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlReperform.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -94,12 +80,12 @@ WARNING: ThreadSanitizer: data race (pid=) SUMMARY: ThreadSanitizer: data race (:) in camlReperform.race_ ================== -leaving h -leaving g -leaving f -value handler +Leaving h +Leaving g +Leaving f +Value handler E1 handler after continue -result=1339 +Result=42 ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by main thread (mutexes: write M): @@ -111,13 +97,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlReperform.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlReperform.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/unhandled.ml b/testsuite/tests/tsan/unhandled.ml index 31b380715bf..52f2c3b51e5 100644 --- a/testsuite/tests/tsan/unhandled.ml +++ b/testsuite/tests/tsan/unhandled.ml @@ -5,6 +5,8 @@ set TSAN_OPTIONS="detect_deadlocks=0"; tsan; + readonly_files = "waitgroup_stubs.c"; + all_modules = "${readonly_files} waitgroup.ml unhandled.ml"; native; *) @@ -17,33 +19,35 @@ let print_endline s = Stdlib.print_endline s; flush stdout type _ t += E : int -> int t -let g_ref1 = ref 0 -let g_ref2 = ref 0 +let wg1 = Waitgroup.create 2 +let wg2 = Waitgroup.create 2 +let r1 = ref 0 +let r2 = ref 0 let [@inline never] race = function - | 0 -> g_ref1 := 42 - | 1 -> g_ref2 := 42 + | 0 -> r1 := 42 + | 1 -> r2 := 42 | _ -> assert false let [@inline never] h () = - print_endline "entering h"; + print_endline "Entering h"; let v = try perform (E 0) with Unhandled _ -> race 1; 1 in - print_endline "leaving h"; + print_endline "Leaving h"; v let [@inline never] g () = - print_endline "entering g"; + print_endline "Entering g"; let v = h () in - print_endline "leaving g"; + print_endline "Leaving g"; v let f () = - print_endline "entering f"; + print_endline "Entering f"; let v = g () in - print_endline "leaving f"; + print_endline "Leaving f"; v + 1 let [@inline never] fiber2 () = @@ -58,26 +62,28 @@ let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = fun _ -> None let [@inline never] fiber1 () = ignore @@ match_with fiber2 () { retc = (fun v -> - print_endline "value handler"; v + 1); + print_endline "Value handler"; v + 1); exnc = (fun e -> raise e); effc = effh }; - 1338 + 41 let[@inline never] main () = - print_endline "performing an unhandled effect from the main fiber"; + print_endline "Performing an unhandled effect from the main fiber"; try perform (E 42) with | Effect.Unhandled _ -> race 0; - print_endline "performing an unhandled effect from another fiber"; + print_endline "Performing an unhandled effect from another fiber"; let v = fiber1 () in v + 1 let[@inline never] other_domain () = - ignore @@ (Sys.opaque_identity !g_ref1, !g_ref2); - Unix.sleepf 0.66 + ignore @@ (Sys.opaque_identity !r1, !r2); + Waitgroup.join wg1; + Waitgroup.join wg2 let () = let d = Domain.spawn other_domain in - Unix.sleepf 0.33; + Waitgroup.join wg1; let v = main () in - printf "result=%d\n%!" v; + Waitgroup.join wg2; + printf "Result=%d\n%!" v; Domain.join d diff --git a/testsuite/tests/tsan/unhandled.reference b/testsuite/tests/tsan/unhandled.reference index 2e1e0cd3f11..17591399849 100644 --- a/testsuite/tests/tsan/unhandled.reference +++ b/testsuite/tests/tsan/unhandled.reference @@ -1,4 +1,4 @@ -performing an unhandled effect from the main fiber +Performing an unhandled effect from the main fiber ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by main thread (mutexes: write M): @@ -11,13 +11,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlUnhandled.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlUnhandled.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -40,10 +33,10 @@ WARNING: ThreadSanitizer: data race (pid=) SUMMARY: ThreadSanitizer: data race (:) in camlUnhandled.race_ ================== -performing an unhandled effect from another fiber -entering f -entering g -entering h +Performing an unhandled effect from another fiber +Entering f +Entering g +Entering h ================== WARNING: ThreadSanitizer: data race (pid=) Write of size 8 at by main thread (mutexes: write M): @@ -63,13 +56,6 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlUnhandled.other_domain_ () #1 camlStdlib__Domain.body_ () - As if synchronized via sleep: - #0 nanosleep () - #1 caml_unix_sleep () - #2 caml_c_call () - #3 camlUnhandled.entry () - #4 caml_program () - Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -92,9 +78,9 @@ WARNING: ThreadSanitizer: data race (pid=) SUMMARY: ThreadSanitizer: data race (:) in camlUnhandled.race_ ================== -leaving h -leaving g -leaving f -value handler -result=1339 +Leaving h +Leaving g +Leaving f +Value handler +Result=42 ThreadSanitizer: reported 2 warnings diff --git a/testsuite/tests/tsan/waitgroup.ml b/testsuite/tests/tsan/waitgroup.ml new file mode 100644 index 00000000000..098b9dd078e --- /dev/null +++ b/testsuite/tests/tsan/waitgroup.ml @@ -0,0 +1,7 @@ +type t + +external create : int -> t = "wg_create" [@@noalloc] +external finish : t -> unit = "wg_finish" [@@noalloc] +external wait : t -> unit = "wg_wait" [@@noalloc] + +let [@inline never] join t = finish t; wait t diff --git a/testsuite/tests/tsan/waitgroup_stubs.c b/testsuite/tests/tsan/waitgroup_stubs.c new file mode 100644 index 00000000000..16f02363e69 --- /dev/null +++ b/testsuite/tests/tsan/waitgroup_stubs.c @@ -0,0 +1,51 @@ +#include +#include +#include + +#include +#include + +#define MAX_WAITGROUP 8 +#define SPIN_WAIT_MS 10 + +typedef struct { + unsigned limit; /* Number of threads participating to the checkpoint */ + atomic_uint count; /* Number of threads that have reach the checkpoint */ +} waitgroup; + +static waitgroup waitgroups[MAX_WAITGROUP] = { 0 }; + +static atomic_uint index = 0; + +CAMLno_tsan static waitgroup* wg_get(unsigned idx) +{ + assert(idx < MAX_WAITGROUP); + + waitgroup* wg = &waitgroups[idx]; + return wg; +} + +CAMLno_tsan value wg_create(value n) +{ + waitgroup* wg = wg_get(index); + + wg->limit = Int_val(n); + wg->count = 0; + return Val_int(index++); +} + +CAMLno_tsan value wg_finish(value t) +{ + waitgroup* wg = wg_get(Int_val(t)); + + wg->count += 1; + return Val_unit; +} + +CAMLno_tsan value wg_wait(value t) +{ + waitgroup* wg = wg_get(Int_val(t)); + + while (wg->count != wg->limit) { /* spinwait */ } + return Val_unit; +} From a22a9fa5ae08776dd101fbbd262c35050816fabf Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 15:01:37 +0200 Subject: [PATCH 171/402] domain.h: naming conventions for STW functions These naming conventions are not yet respected by the runtime code, this will be achieved in following commits. --- runtime/caml/domain.h | 54 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h index 86a4a9c6cd5..e2e234ab2c7 100644 --- a/runtime/caml/domain.h +++ b/runtime/caml/domain.h @@ -113,6 +113,60 @@ int caml_try_run_on_all_domains( void*, void (*leader_setup)(caml_domain_state*)); +/* Function naming conventions for STW callbacks and STW critical sections. + + A "STW callback" is a callback passed to one of the + [caml_try_run_on_all_domains*] runners, it will + run on all participant domains in parallel. + + The "STW critical section" is the runtime interval betweeen the + start of the execution of the STW callback and the last barrier in + the callback. During this interval, mutator code from registered + participants cannot be running in parallel. + + Note: + + - Some parts of a STW callback are *not* inside the STW critical + section: all the code after the last barrier, or all the callback + if it does not contain a barrier. + + - Program initialization can be considered as a STW critical + section as well, when no mutators or domains are running yet. + + Some functions must be called within a STW critical section only, + calling then in a less-synchronized context introduces races with + mutators. To avoid these mistakes we use naming conventions as + a barebones effect system. + + 1. [stw_*] prefix for STW callbacks. + + A function that defines a STW callback starts with [stw_] or + [caml_stw_]. It is passed to the [caml_try_run_on_all_domains*] + runner. + + Examples: + - [caml_stw_empty_minor_heap] is a STW callback that empties the + minor heap + - [stw_resize_minor_heap_reservation] is a STW callback that + resizes the memory reservation for the minor heap + + 2. [*_from_stw] suffix for auxiliary functions that may only be + called within a STW critical section. + + 3. [*_from_stw_single] suffix for auxiliary functions that may only + be called within a STW critical section, and only by a single + domain at a time -- typically the last one entering a barrier. + + 5. No [stw] in the name for functions that are not called in a STW + callback, in particular functions that themselves start a STW + context by calling a [caml_try_run_on_all_domains*]. + + We could consider a [*_outside_stw] suffix for functions that must + not be called inside a STW callback, but it is generally not + necessary to enforce this discipline in the function name. +*/ + + /* barriers */ typedef uintnat barrier_status; void caml_global_barrier(void); From 761d3cd0641129c4a3175b7a635f5de08d57c126 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 15:06:22 +0200 Subject: [PATCH 172/402] STW naming conventions --- runtime/caml/minor_gc.h | 2 +- runtime/minor_gc.c | 13 +++++++------ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h index 5c691b84671..1c85af63c26 100644 --- a/runtime/caml/minor_gc.h +++ b/runtime/caml/minor_gc.h @@ -74,7 +74,7 @@ extern void caml_set_minor_heap_size (asize_t); /* size in bytes */ extern void caml_empty_minor_heap_no_major_slice_from_stw (caml_domain_state* domain, void* unused, int participating_count, caml_domain_state** participating); /* in STW */ -extern int caml_try_stw_empty_minor_heap_on_all_domains(void); /* out STW */ +extern int caml_try_empty_minor_heap_on_all_domains(void); /* out STW */ extern void caml_empty_minor_heaps_once(void); /* out STW */ void caml_alloc_small_dispatch (caml_domain_state* domain, intnat wosize, int flags, diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index fe082044256..c7b654bb50b 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -774,10 +774,11 @@ static void caml_stw_empty_minor_heap (caml_domain_state* domain, void* unused, } /* must be called within a STW section */ -void caml_empty_minor_heap_no_major_slice_from_stw(caml_domain_state* domain, - void* unused, - int participating_count, - caml_domain_state** participating) +void caml_empty_minor_heap_no_major_slice_from_stw( + caml_domain_state* domain, + void* unused, + int participating_count, + caml_domain_state** participating) { barrier_status b = caml_global_barrier_begin(); if( caml_global_barrier_is_final(b) ) { @@ -792,7 +793,7 @@ void caml_empty_minor_heap_no_major_slice_from_stw(caml_domain_state* domain, } /* must be called outside a STW section */ -int caml_try_stw_empty_minor_heap_on_all_domains (void) +int caml_try_empty_minor_heap_on_all_domains (void) { #ifdef DEBUG CAMLassert(!caml_domain_is_in_stw()); @@ -820,7 +821,7 @@ void caml_empty_minor_heaps_once (void) /* To handle the case where multiple domains try to execute a minor gc STW section */ do { - caml_try_stw_empty_minor_heap_on_all_domains(); + caml_try_empty_minor_heap_on_all_domains(); } while (saved_minor_cycle == atomic_load(&caml_minor_cycles_started)); } From 0949e8b66a09e46a72f1c5319ad89d53b2ea64a9 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 15:16:32 +0200 Subject: [PATCH 173/402] STW naming conventions for shared_heap.c --- runtime/caml/shared_heap.h | 10 +++------- runtime/major_gc.c | 10 +++++++--- runtime/shared_heap.c | 4 ++-- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/runtime/caml/shared_heap.h b/runtime/caml/shared_heap.h index 768415c586f..a3e52afd720 100644 --- a/runtime/caml/shared_heap.h +++ b/runtime/caml/shared_heap.h @@ -88,18 +88,14 @@ void caml_redarken_pool(struct pool*, scanning_action, void*); intnat caml_sweep(struct caml_heap_state*, intnat); - -/* must be called during STW */ -void caml_cycle_heap_stw(void); +void caml_cycle_heap_from_stw_single(void); /* must be called on each domain - (after caml_cycle_heap_stw) */ + (after caml_cycle_heap_from_stw_single) */ void caml_cycle_heap(struct caml_heap_state*); /* Heap invariant verification (for debugging) */ - -/* caml_verify_heap must only be called while all domains are paused */ -void caml_verify_heap(caml_domain_state *domain); +void caml_verify_heap_from_stw(caml_domain_state *domain); #ifdef DEBUG /* [is_garbage(v)] returns true if [v] is a garbage value */ diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 9b9799d6caa..3293fc350d4 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -1259,10 +1259,11 @@ static void cycle_all_domains_callback(caml_domain_state* domain, void* unused, { /* Cycle major heap */ - // FIXME: delete caml_cycle_heap_stw and have per-domain copies of the data? + /* FIXME: delete caml_cycle_heap_from_stw_single + and have per-domain copies of the data? */ barrier_status b = caml_global_barrier_begin(); if (caml_global_barrier_is_final(b)) { - caml_cycle_heap_stw(); + caml_cycle_heap_from_stw_single(); caml_gc_log("GC cycle %lu completed (heap cycled)", (long unsigned int)caml_major_cycles_completed); @@ -1355,8 +1356,11 @@ static void cycle_all_domains_callback(caml_domain_state* domain, void* unused, /* If the heap is to be verified, do it before the domains continue running OCaml code. */ if (caml_params->verify_heap) { - caml_verify_heap(domain); + caml_verify_heap_from_stw(domain); caml_gc_log("Heap verified"); + /* This global barrier avoids races between the verify_heap code + and the rest of the STW critical section, for example the parts + that mark global roots. */ caml_global_barrier(); } diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c index a8f426dbd71..feb3148506a 100644 --- a/runtime/shared_heap.c +++ b/runtime/shared_heap.c @@ -777,7 +777,7 @@ static void verify_object(struct heap_verify_state* st, value v) { } } -void caml_verify_heap(caml_domain_state *domain) { +void caml_verify_heap_from_stw(caml_domain_state *domain) { struct heap_verify_state* st = caml_verify_begin(); caml_do_roots (&caml_verify_root, verify_scanning_flags, st, domain, 1); caml_scan_global_roots(&caml_verify_root, st); @@ -882,7 +882,7 @@ static void verify_swept (struct caml_heap_state* local) { CAMLassert(local->stats.large_blocks == large_stats.live_blocks); } -void caml_cycle_heap_stw (void) { +void caml_cycle_heap_from_stw_single (void) { struct global_heap_state oldg = caml_global_heap_state; struct global_heap_state newg; newg.UNMARKED = oldg.MARKED; From a455fe851cb3142868da053d49c348e0aef5d34d Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 15:37:05 +0200 Subject: [PATCH 174/402] STW implementation comment --- runtime/major_gc.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 3293fc350d4..d5512d508e6 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -1789,6 +1789,11 @@ static void finish_major_cycle_callback (caml_domain_state* domain, void* arg, uintnat saved_major_cycles = (uintnat)arg; CAMLassert (domain == Caml_state); + /* We are in a STW critical section here. There is no obvious call + to a barrier at the end of the callback, but the [while] loop + will only terminate when [caml_major_cycles_completed] is + incremented, and this happens in [cycle_all_domains] inside + a barrier. */ caml_empty_minor_heap_no_major_slice_from_stw (domain, (void*)0, participating_count, participating); From 8519cfd57fe2dda54e2135e7ce5480b91307a430 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 15:42:09 +0200 Subject: [PATCH 175/402] STW naming conventions: foo_callback => stw_foo --- runtime/domain.c | 11 ++++++----- runtime/major_gc.c | 20 +++++++++++--------- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/runtime/domain.c b/runtime/domain.c index 648eb9d9691..0352ed9f4d7 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -1652,10 +1652,11 @@ Caml_inline void advance_global_major_slice_epoch (caml_domain_state* d) } } -static void global_major_slice_callback (caml_domain_state *domain, - void *unused, - int participating_count, - caml_domain_state **participating) +static void stw_global_major_slice( + caml_domain_state *domain, + void *unused, + int participating_count, + caml_domain_state **participating) { domain->requested_major_slice = 1; /* Nothing else to do, as [stw_hander] will call [caml_poll_gc_work] @@ -1710,7 +1711,7 @@ void caml_poll_gc_work(void) if (d->requested_global_major_slice) { if (caml_try_run_on_all_domains_async( - &global_major_slice_callback, NULL, NULL)){ + &stw_global_major_slice, NULL, NULL)){ d->requested_global_major_slice = 0; } /* If caml_try_run_on_all_domains_async fails, we'll try again next time diff --git a/runtime/major_gc.c b/runtime/major_gc.c index d5512d508e6..85c94bfc226 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -1237,9 +1237,10 @@ static intnat ephe_sweep (caml_domain_state* domain_state, intnat budget) return budget; } -static void cycle_all_domains_callback(caml_domain_state* domain, void* unused, - int participating_count, - caml_domain_state** participating) +static void stw_cycle_all_domains( + caml_domain_state* domain, void* unused, + int participating_count, + caml_domain_state** participating) { uintnat num_domains_in_stw; @@ -1742,10 +1743,10 @@ static void major_collection_slice(intnat howmuch, while (saved_major_cycle == caml_major_cycles_completed) { if (barrier_participants) { - cycle_all_domains_callback + stw_cycle_all_domains (domain_state, (void*)0, participant_count, barrier_participants); } else { - caml_try_run_on_all_domains(&cycle_all_domains_callback, 0, 0); + caml_try_run_on_all_domains(&stw_cycle_all_domains, 0, 0); } } } @@ -1782,9 +1783,10 @@ void caml_major_collection_slice(intnat howmuch) Caml_state->major_slice_epoch = major_slice_epoch; } -static void finish_major_cycle_callback (caml_domain_state* domain, void* arg, - int participating_count, - caml_domain_state** participating) +static void stw_finish_major_cycle( + caml_domain_state* domain, void* arg, + int participating_count, + caml_domain_state** participating) { uintnat saved_major_cycles = (uintnat)arg; CAMLassert (domain == Caml_state); @@ -1811,7 +1813,7 @@ void caml_finish_major_cycle (void) while( saved_major_cycles == caml_major_cycles_completed ) { caml_try_run_on_all_domains - (&finish_major_cycle_callback, (void*)caml_major_cycles_completed, 0); + (&stw_finish_major_cycle, (void*)caml_major_cycles_completed, 0); } } From 79b9dec17acb2c0c2ef0e50f01cd76fd829766ef Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 15:50:15 +0200 Subject: [PATCH 176/402] STW naming conventions --- runtime/caml/codefrag.h | 5 ++--- runtime/codefrag.c | 2 +- runtime/domain.c | 18 ++++++++++-------- runtime/frame_descriptors.c | 4 ++-- runtime/major_gc.c | 4 +--- 5 files changed, 16 insertions(+), 17 deletions(-) diff --git a/runtime/caml/codefrag.h b/runtime/caml/codefrag.h index fc6fac1edd9..d0f9a629cf0 100644 --- a/runtime/caml/codefrag.h +++ b/runtime/caml/codefrag.h @@ -87,9 +87,8 @@ extern struct code_fragment * Returns NULL if the code fragment was registered with [DIGEST_IGNORE]. */ extern unsigned char * caml_digest_of_code_fragment(struct code_fragment *); -/* Cleans up (and frees) removed code fragments. Must be called from a stop the - world pause by only a single thread. */ -extern void caml_code_fragment_cleanup(void); +/* Cleans up (and frees) removed code fragments. */ +extern void caml_code_fragment_cleanup_from_stw_single(void); #endif diff --git a/runtime/codefrag.c b/runtime/codefrag.c index 9237995fa26..27e1459c04a 100644 --- a/runtime/codefrag.c +++ b/runtime/codefrag.c @@ -160,7 +160,7 @@ caml_find_code_fragment_by_digest(unsigned char digest[16]) { } /* This is only ever called from a stw by one domain */ -void caml_code_fragment_cleanup (void) +void caml_code_fragment_cleanup_from_stw_single (void) { struct code_fragment_garbage *curr; diff --git a/runtime/domain.c b/runtime/domain.c index 0352ed9f4d7..d687971a6a8 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -753,7 +753,7 @@ CAMLexport void caml_reset_domain_lock(void) /* minor heap initialization and resizing */ -static void reserve_minor_heaps(void) { +static void reserve_minor_heaps_from_stw_single(void) { void* heaps_base; uintnat minor_heap_reservation_bsize; uintnat minor_heap_max_bsz; @@ -790,7 +790,7 @@ static void reserve_minor_heaps(void) { } } -static void unreserve_minor_heaps(void) { +static void unreserve_minor_heaps_from_stw_single(void) { uintnat size; caml_gc_log("unreserve_minor_heaps"); @@ -842,16 +842,16 @@ static void stw_resize_minor_heap_reservation(caml_domain_state* domain, caml_gc_log("stw_resize_minor_heap_reservation: " "unreserve_minor_heaps"); - unreserve_minor_heaps(); + unreserve_minor_heaps_from_stw_single(); /* new_minor_wsz is page-aligned because caml_norm_minor_heap_size has been called to normalize it earlier. */ caml_minor_heap_max_wsz = new_minor_wsz; caml_gc_log("stw_resize_minor_heap_reservation: reserve_minor_heaps"); - reserve_minor_heaps(); - /* The call to [reserve_minor_heaps] makes a new reservation, - and it also updates the reservation boundaries of each domain - by mutating its [minor_heap_area_start{,_end}] variables. + reserve_minor_heaps_from_stw_single(); + /* The call to [reserve_minor_heaps_from_stw_single] makes a new + reservation, and it also updates the reservation boundaries of each + domain by mutating its [minor_heap_area_start{,_end}] variables. These variables are synchronized by the fact that we are inside a STW section: no other domains are running in parallel, and @@ -887,7 +887,9 @@ void caml_update_minor_heap_max(uintnat requested_wsz) { void caml_init_domains(uintnat minor_heap_wsz) { int i; - reserve_minor_heaps(); + reserve_minor_heaps_from_stw_single(); + /* stw_single: mutators and domains have not started yet. */ + for (i = 0; i < Max_domains; i++) { struct dom_internal* dom = &all_domains[i]; diff --git a/runtime/frame_descriptors.c b/runtime/frame_descriptors.c index 1c2169c0f44..5fee51bb25e 100644 --- a/runtime/frame_descriptors.c +++ b/runtime/frame_descriptors.c @@ -180,7 +180,7 @@ typedef struct frametable_array { int ntables; } frametable_array; -static void register_frametables(frametable_array *array) +static void register_frametables_from_stw_single(frametable_array *array) { caml_frametable_list *new_frametables = NULL; for (int i = 0; i < array->ntables; i++) @@ -198,7 +198,7 @@ static void stw_register_frametables( barrier_status b = caml_global_barrier_begin (); if (caml_global_barrier_is_final(b)) { - register_frametables((frametable_array*) frametables); + register_frametables_from_stw_single((frametable_array*) frametables); } caml_global_barrier_end(b); diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 85c94bfc226..cd394a2e616 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -1345,9 +1345,7 @@ static void stw_cycle_all_domains( atomic_store(&domain_global_roots_started, WORK_UNSTARTED); - /* Cleanups for various data structures that must be done in a STW by - only a single domain */ - caml_code_fragment_cleanup(); + caml_code_fragment_cleanup_from_stw_single(); } // should interrupts be processed here or not? // depends on whether marking above may need interrupts From 8bbeb2ed845a2bb59a67b5d723678efd0108f93c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 16:04:59 +0200 Subject: [PATCH 177/402] STW naming conventions --- runtime/major_gc.c | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/runtime/major_gc.c b/runtime/major_gc.c index cd394a2e616..f17eb612452 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -1483,9 +1483,10 @@ static int is_complete_phase_sweep_ephe (void) /* All orphaned structures have been adopted */ } -static void try_complete_gc_phase (caml_domain_state* domain, void* unused, - int participant_count, - caml_domain_state** participating) +static void stw_try_complete_gc_phase( + caml_domain_state* domain, void* unused, + int participant_count, + caml_domain_state** participating) { barrier_status b; CAML_EV_BEGIN(EV_MAJOR_GC_PHASE_CHANGE); @@ -1709,12 +1710,13 @@ static void major_collection_slice(intnat howmuch, is_complete_phase_mark_final ()) { CAMLassert (caml_gc_phase != Phase_sweep_ephe); if (barrier_participants) { - try_complete_gc_phase (domain_state, - (void*)0, - participant_count, - barrier_participants); + stw_try_complete_gc_phase( + domain_state, + (void*)0, + participant_count, + barrier_participants); } else { - caml_try_run_on_all_domains (&try_complete_gc_phase, 0, 0); + caml_try_run_on_all_domains (&stw_try_complete_gc_phase, 0, 0); } if (get_major_slice_work(mode) > 0) goto mark_again; } From e9768ae97732ac18d0eb4249f1e051d04bc292f3 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 30 Sep 2023 16:18:56 +0200 Subject: [PATCH 178/402] STW naming conventions --- runtime/runtime_events.c | 42 +++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/runtime/runtime_events.c b/runtime/runtime_events.c index dedcb24d705..d42665a5a5b 100644 --- a/runtime/runtime_events.c +++ b/runtime/runtime_events.c @@ -128,7 +128,7 @@ static void write_to_ring(ev_category category, ev_message_type type, int word_offset); static void events_register_write_buffer(int index, value event_name); -static void runtime_events_create_raw(void); +static void runtime_events_create_from_stw_single(void); void caml_runtime_events_init(void) { @@ -150,17 +150,15 @@ void caml_runtime_events_init(void) { caml_secure_getenv(T("OCAML_RUNTIME_EVENTS_PRESERVE")) ? 1 : 0; if (caml_secure_getenv(T("OCAML_RUNTIME_EVENTS_START"))) { - /* since [caml_runtime_events_init] can only be called from the startup code - and we can be sure there is only a single domain running, it is safe to call - [runtime_events_create_raw] outside of a stop-the-world section */ - runtime_events_create_raw(); + runtime_events_create_from_stw_single(); + /* stw_single: mutators and domains have not started yet. */ } } /* teardown the ring buffers. This must be called from a stop-the-world unless we are sure there is only a single domain running (e.g after a fork) */ -static void runtime_events_teardown_raw(int remove_file) { +static void runtime_events_teardown_from_stw_single(int remove_file) { #ifdef _WIN32 UnmapViewOfFile(current_metadata); CloseHandle(ring_file_handle); @@ -186,13 +184,15 @@ static void runtime_events_teardown_raw(int remove_file) { } /* Stop-the-world which calls the teardown code */ -static void stw_teardown_runtime_events(caml_domain_state *domain_state, - void *remove_file_data, int num_participating, - caml_domain_state **participating_domains) { +static void stw_teardown_runtime_events( + caml_domain_state *domain_state, + void *remove_file_data, int num_participating, + caml_domain_state **participating_domains) +{ caml_global_barrier(); if (participating_domains[0] == domain_state) { int remove_file = *(int*)remove_file_data; - runtime_events_teardown_raw(remove_file); + runtime_events_teardown_from_stw_single(remove_file); } caml_global_barrier(); } @@ -208,9 +208,9 @@ void caml_runtime_events_post_fork(void) { /* In the child we need to tear down the various structures used for the existing runtime_events from the parent. In doing so we need to make sure we don't remove the runtime_events file itself as that may still be used by - the parent. There is no need for a stop-the-world in this case as we are - certain there is only a single domain running. */ - runtime_events_teardown_raw(0 /* don't remove the file */); + the parent. */ + runtime_events_teardown_from_stw_single(0 /* don't remove the file */); + /* stw_single: mutators and domains have not started after the fork yet. */ /* We still have the path and ring size from our parent */ caml_runtime_events_start(); @@ -249,7 +249,7 @@ void caml_runtime_events_destroy(void) { /* Create the initial runtime_events ring buffers. This must be called from within a stop-the-world section if we cannot be sure there is only a single domain running. */ -static void runtime_events_create_raw(void) { +static void runtime_events_create_from_stw_single(void) { /* Don't initialise runtime_events twice */ if (!atomic_load_acquire(&runtime_events_enabled)) { int ret, ring_headers_length, ring_data_length; @@ -404,18 +404,16 @@ static void runtime_events_create_raw(void) { } } -/* Stop the world section which calls [runtime_events_create_raw], used when we - can't be sure there is only a single domain running. */ -static void -stw_create_runtime_events(caml_domain_state *domain_state, void *data, - int num_participating, - caml_domain_state **participating_domains) { - /* Everyone must be stopped for starting and stopping runtime_events */ +static void stw_create_runtime_events( + caml_domain_state *domain_state, void *data, + int num_participating, + caml_domain_state **participating_domains) +{ caml_global_barrier(); /* Only do this on one domain */ if (participating_domains[0] == domain_state) { - runtime_events_create_raw(); + runtime_events_create_from_stw_single(); } caml_global_barrier(); } From bba42ff1df665914b989bda1a692807aae73082b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 2 Oct 2023 12:52:47 +0200 Subject: [PATCH 179/402] Changes --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 5a1f9dd3bf0..1f2e9defc05 100644 --- a/Changes +++ b/Changes @@ -357,6 +357,10 @@ Working version - #12532, #12553: improve readability of the pattern-matching debug output (Gabriel Scherer, review by Thomas Refis) +- #12169: runtime: document and enforce naming conventions around STW sections. + (Gabriel Scherer, review by Enguerrand Decorne, Miod Vallat, B. Szilvasy + and Nick Barnes, report by KC Sivaramakrishnan) + ### Build system: - #12198, #12321: continue the merge of the sub-makefiles into the root Makefile From 6a2b1beeefcde00ceac15065e142bb7dff349d80 Mon Sep 17 00:00:00 2001 From: Fabrice Buoro Date: Fri, 13 Oct 2023 15:39:54 +0200 Subject: [PATCH 180/402] Reintroduce the `sleep`ing spinwait --- testsuite/tests/tsan/array_elt.reference | 6 ++++++ testsuite/tests/tsan/exn_from_c.reference | 6 ++++++ testsuite/tests/tsan/exn_in_callback.reference | 6 ++++++ testsuite/tests/tsan/exn_reraise.reference | 6 ++++++ testsuite/tests/tsan/perform.reference | 18 ++++++++++++++++++ .../tests/tsan/raise_through_handler.reference | 6 ++++++ testsuite/tests/tsan/record_field.reference | 7 +++++++ testsuite/tests/tsan/reperform.reference | 18 ++++++++++++++++++ testsuite/tests/tsan/unhandled.reference | 12 ++++++++++++ testsuite/tests/tsan/waitgroup_stubs.c | 14 +++++++++++--- 10 files changed, 96 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/tsan/array_elt.reference b/testsuite/tests/tsan/array_elt.reference index 3e37b6d616b..549cfd4c0d1 100644 --- a/testsuite/tests/tsan/array_elt.reference +++ b/testsuite/tests/tsan/array_elt.reference @@ -9,6 +9,12 @@ WARNING: ThreadSanitizer: data race (pid=) #1 camlArray_elt.entry () #2 caml_program () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlArray_elt.writer_ () + #3 camlStdlib__Domain.body_ () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/exn_from_c.reference b/testsuite/tests/tsan/exn_from_c.reference index bc7acc2bddc..0c0007b7b3c 100644 --- a/testsuite/tests/tsan/exn_from_c.reference +++ b/testsuite/tests/tsan/exn_from_c.reference @@ -22,6 +22,12 @@ WARNING: ThreadSanitizer: data race (pid=) #2 camlExn_from_c.entry () #3 caml_program () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlExn_from_c.writer_ () + #3 camlStdlib__Domain.body_ () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/exn_in_callback.reference b/testsuite/tests/tsan/exn_in_callback.reference index e4d01834d21..b882a9ba82f 100644 --- a/testsuite/tests/tsan/exn_in_callback.reference +++ b/testsuite/tests/tsan/exn_in_callback.reference @@ -21,6 +21,12 @@ WARNING: ThreadSanitizer: data race (pid=) #2 camlExn_in_callback.entry () #3 caml_program () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlExn_in_callback.writer_ () + #3 camlStdlib__Domain.body_ () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/exn_reraise.reference b/testsuite/tests/tsan/exn_reraise.reference index 58dd9b5db21..fd562f316c7 100644 --- a/testsuite/tests/tsan/exn_reraise.reference +++ b/testsuite/tests/tsan/exn_reraise.reference @@ -21,6 +21,12 @@ WARNING: ThreadSanitizer: data race (pid=) #2 camlExn_reraise.entry () #3 caml_program () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlExn_reraise.writer_ () + #3 camlStdlib__Domain.body_ () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/perform.reference b/testsuite/tests/tsan/perform.reference index 1f6a7eb76de..362f0507ce8 100644 --- a/testsuite/tests/tsan/perform.reference +++ b/testsuite/tests/tsan/perform.reference @@ -16,6 +16,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlPerform.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlPerform.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -56,6 +62,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlPerform.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlPerform.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -96,6 +108,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlPerform.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlPerform.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/raise_through_handler.reference b/testsuite/tests/tsan/raise_through_handler.reference index 9f8ae796e9a..eefa5475c0e 100644 --- a/testsuite/tests/tsan/raise_through_handler.reference +++ b/testsuite/tests/tsan/raise_through_handler.reference @@ -14,6 +14,12 @@ WARNING: ThreadSanitizer: data race (pid=) #2 camlRaise_through_handler.entry () #3 caml_program () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlRaise_through_handler.reader_ () + #3 camlStdlib__Domain.body_ () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/record_field.reference b/testsuite/tests/tsan/record_field.reference index 581f4440ab3..aff9f632673 100644 --- a/testsuite/tests/tsan/record_field.reference +++ b/testsuite/tests/tsan/record_field.reference @@ -9,6 +9,13 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlRecord_field.writer_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlRecord_field.reader_ () + #3 camlRecord_field.entry () + #4 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/reperform.reference b/testsuite/tests/tsan/reperform.reference index e97e0aa50e9..0f91dcc7a61 100644 --- a/testsuite/tests/tsan/reperform.reference +++ b/testsuite/tests/tsan/reperform.reference @@ -16,6 +16,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlReperform.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlReperform.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -58,6 +64,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlReperform.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlReperform.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -97,6 +109,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlReperform.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlReperform.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/unhandled.reference b/testsuite/tests/tsan/unhandled.reference index 17591399849..3d0af2d7cf0 100644 --- a/testsuite/tests/tsan/unhandled.reference +++ b/testsuite/tests/tsan/unhandled.reference @@ -11,6 +11,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlUnhandled.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlUnhandled.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () @@ -56,6 +62,12 @@ WARNING: ThreadSanitizer: data race (pid=) #0 camlUnhandled.other_domain_ () #1 camlStdlib__Domain.body_ () + As if synchronized via sleep: + #0 usleep () + #1 wg_wait () + #2 camlUnhandled.entry () + #3 caml_program () + Mutex M () created at: #0 pthread_mutex_init () #1 caml_plat_mutex_init () diff --git a/testsuite/tests/tsan/waitgroup_stubs.c b/testsuite/tests/tsan/waitgroup_stubs.c index 16f02363e69..bdaf76b3ede 100644 --- a/testsuite/tests/tsan/waitgroup_stubs.c +++ b/testsuite/tests/tsan/waitgroup_stubs.c @@ -8,9 +8,11 @@ #define MAX_WAITGROUP 8 #define SPIN_WAIT_MS 10 +/* waitgroup inspired by Golang's `sync.WaitGroup`. This version does *not* + * allow to restart a waitgroup. */ typedef struct { - unsigned limit; /* Number of threads participating to the checkpoint */ - atomic_uint count; /* Number of threads that have reach the checkpoint */ + unsigned limit; /* Number of threads participating in the checkpoint */ + atomic_uint count; /* Number of threads that have reached the checkpoint */ } waitgroup; static waitgroup waitgroups[MAX_WAITGROUP] = { 0 }; @@ -46,6 +48,12 @@ CAMLno_tsan value wg_wait(value t) { waitgroup* wg = wg_get(Int_val(t)); - while (wg->count != wg->limit) { /* spinwait */ } + /* Always sleep at least once, even for the last thread to reach the + * checkpoint. This allows TSan to always generate a report with a + * 'As if synchronized via sleep' section. */ + do { + usleep(SPIN_WAIT_MS); + } + while (wg->count != wg->limit); return Val_unit; } From 2f945aef4fa830e843fb81f328601b22b74ab65c Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sun, 15 Oct 2023 11:40:20 +0200 Subject: [PATCH 181/402] CI other-configs: test C23 conformance using clang-18 -std=gnu2x Also: test with clang-18 and default standard. Also: print delimiters between tests for easier searching. --- tools/ci/inria/other-configs/script | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/tools/ci/inria/other-configs/script b/tools/ci/inria/other-configs/script index 6536c4db7ad..ba47e39e41f 100755 --- a/tools/ci/inria/other-configs/script +++ b/tools/ci/inria/other-configs/script @@ -16,12 +16,13 @@ # Commands to run for the 'other-configs' job on Inria's CI -# Stop on error and be verbose -set -e -x +# Stop on error +set -e mainjob=./tools/ci/inria/main main="${mainjob} -j8" +echo "============== minimal build =================" # The "MIN_BUILD" (formerly on Travis) builds with everything disabled (apart # from ocamltest). Its goals: # - Ensure that the system builds correctly without native compilation @@ -37,8 +38,20 @@ ${main} -conf --disable-native-compiler \ -conf --disable-ocamldoc \ -conf --disable-dependency-generation \ -no-native -${main} -conf --disable-flat-float-array + +echo "============== no flat float arrays, clang, C23 =================" +${main} -conf --disable-flat-float-array \ + -conf CC=clang-18 \ + -conf CFLAGS=-std=gnu2x + +echo "============== flambda =================" ${main} -conf --enable-flambda + +echo "============== frame pointers, reserved header bits =================" ${main} -conf --enable-frame-pointers -conf --enable-reserved-header-bits=27 + +echo "============== bootstrap, pic =================" ${main} -with-bootstrap -conf --with-pic -OCAMLRUNPARAM="c=1" ${main} + +echo "============== cleanup at exit, clang =================" +OCAMLRUNPARAM="c=1" ${main} -conf CC=clang-18 From 3d4eb0663a1c474bd97bf17c88450ab7fac35141 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Sun, 15 Oct 2023 16:44:55 +0200 Subject: [PATCH 182/402] Use C11/C++11 standard static assertion (#12537) Remove CAML_STATIC_ASSERT, use static_assert directly. The assertions were moved to .c files as not to pollute the ocaml user-facing headers with includes of assert.h. --- Changes | 4 ++++ runtime/caml/domain_state.h | 6 ------ runtime/caml/fiber.h | 2 -- runtime/caml/misc.h | 8 -------- runtime/domain.c | 8 ++++++++ runtime/fiber.c | 7 +++++-- runtime/shared_heap.c | 6 +++--- 7 files changed, 20 insertions(+), 21 deletions(-) diff --git a/Changes b/Changes index 1f2e9defc05..f066a749b8d 100644 --- a/Changes +++ b/Changes @@ -357,6 +357,10 @@ Working version - #12532, #12553: improve readability of the pattern-matching debug output (Gabriel Scherer, review by Thomas Refis) +- #12537: Use C11/C++11 standard static assertion. + (Antonin Décimo, review by Sebastien Hinderer, Xavier Leroy, + and KC Sivaramakrishnan) + - #12169: runtime: document and enforce naming conventions around STW sections. (Gabriel Scherer, review by Enguerrand Decorne, Miod Vallat, B. Szilvasy and Nick Barnes, report by KC Sivaramakrishnan) diff --git a/runtime/caml/domain_state.h b/runtime/caml/domain_state.h index fe66925364e..ac20ea27d4e 100644 --- a/runtime/caml/domain_state.h +++ b/runtime/caml/domain_state.h @@ -42,12 +42,6 @@ enum { #define LAST_DOMAIN_STATE_MEMBER extra_params -/* Check that the structure was laid out without padding, - since the runtime assumes this in computing offsets */ -CAML_STATIC_ASSERT( - offsetof(caml_domain_state, LAST_DOMAIN_STATE_MEMBER) == - (Domain_state_num_fields - 1) * 8); - #if defined(HAS_FULL_THREAD_VARIABLES) || defined(IN_CAML_RUNTIME) CAMLextern __thread caml_domain_state* caml_state; #define Caml_state_opt caml_state diff --git a/runtime/caml/fiber.h b/runtime/caml/fiber.h index 403940c0e26..712a1f44b9e 100644 --- a/runtime/caml/fiber.h +++ b/runtime/caml/fiber.h @@ -61,8 +61,6 @@ struct stack_info { int64_t id; }; -CAML_STATIC_ASSERT(sizeof(struct stack_info) == - Stack_ctx_words * sizeof(value)); #define Stack_base(stk) ((value*)(stk + 1)) #define Stack_threshold_ptr(stk) \ (Stack_base(stk) + Stack_threshold / sizeof(value)) diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 3e081d89244..bb469cb62fe 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -216,14 +216,6 @@ Caml_inline void call_timing_hook(_Atomic caml_timing_hook * a) #endif /* CAML_INTERNALS */ -#define CAML_STATIC_ASSERT_3(b, l) \ - CAMLunused_start \ - CAMLextern char static_assertion_failure_line_##l[(b) ? 1 : -1] \ - CAMLunused_end - -#define CAML_STATIC_ASSERT_2(b, l) CAML_STATIC_ASSERT_3(b, l) -#define CAML_STATIC_ASSERT(b) CAML_STATIC_ASSERT_2(b, __LINE__) - /* Windows Unicode support (rest below - char_os is needed earlier) */ #ifdef _WIN32 diff --git a/runtime/domain.c b/runtime/domain.c index d687971a6a8..530387261d2 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -25,6 +25,7 @@ #include #include #include +#include #ifdef HAS_GNU_GETAFFINITY_NP #include #ifdef HAS_PTHREAD_NP_H @@ -65,6 +66,13 @@ typedef cpuset_t cpu_set_t; #include "caml/sync.h" #include "caml/weak.h" +/* Check that the domain_state structure was laid out without padding, + since the runtime assumes this in computing offsets */ +static_assert( + offsetof(caml_domain_state, LAST_DOMAIN_STATE_MEMBER) == + (Domain_state_num_fields - 1) * 8, + ""); + /* The runtime can run stop-the-world (STW) sections, during which all active domains run the same callback in parallel (with a barrier mechanism to synchronize within the callback). diff --git a/runtime/fiber.c b/runtime/fiber.c index a6301f7c776..bd6e41d0348 100644 --- a/runtime/fiber.c +++ b/runtime/fiber.c @@ -20,6 +20,7 @@ #include #include +#include #include "caml/alloc.h" #include "caml/callback.h" #include "caml/codefrag.h" @@ -46,6 +47,8 @@ #define fiber_debug_log(...) #endif +static_assert(sizeof(struct stack_info) == Stack_ctx_words * sizeof(value), ""); + static _Atomic int64_t fiber_id = 0; uintnat caml_get_init_stack_wsize (void) @@ -143,8 +146,8 @@ alloc_size_class_stack_noexc(mlsize_t wosize, int cache_bucket, value hval, struct stack_handler* hand; struct stack_info **cache = Caml_state->stack_cache; - CAML_STATIC_ASSERT(sizeof(struct stack_info) % sizeof(value) == 0); - CAML_STATIC_ASSERT(sizeof(struct stack_handler) % sizeof(value) == 0); + static_assert(sizeof(struct stack_info) % sizeof(value) == 0, ""); + static_assert(sizeof(struct stack_handler) % sizeof(value) == 0, ""); CAMLassert(cache != NULL); diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c index feb3148506a..1b30a52d382 100644 --- a/runtime/shared_heap.c +++ b/runtime/shared_heap.c @@ -17,7 +17,7 @@ #include #include - +#include #include "caml/addrmap.h" #include "caml/custom.h" #include "caml/runtime_events.h" @@ -48,14 +48,14 @@ typedef struct pool { caml_domain_state* owner; sizeclass sz; } pool; -CAML_STATIC_ASSERT(sizeof(pool) == Bsize_wsize(POOL_HEADER_WSIZE)); +static_assert(sizeof(pool) == Bsize_wsize(POOL_HEADER_WSIZE), ""); #define POOL_SLAB_WOFFSET(sz) (POOL_HEADER_WSIZE + wastage_sizeclass[sz]) typedef struct large_alloc { caml_domain_state* owner; struct large_alloc* next; } large_alloc; -CAML_STATIC_ASSERT(sizeof(large_alloc) % sizeof(value) == 0); +static_assert(sizeof(large_alloc) % sizeof(value) == 0, ""); #define LARGE_ALLOC_HEADER_SZ sizeof(large_alloc) static struct { From f1ca080bcb30077344533c621d4dc3780dd609c5 Mon Sep 17 00:00:00 2001 From: "A. Wilcox" Date: Sun, 15 Oct 2023 21:23:35 -0500 Subject: [PATCH 183/402] Update POWER asmgen test for OCaml 5 This updates the asmgen code the same way the runtime assembler was updated in 05d82f9d90. --- testsuite/tools/asmgen_power.S | 149 ++++++++++----------------------- 1 file changed, 42 insertions(+), 107 deletions(-) diff --git a/testsuite/tools/asmgen_power.S b/testsuite/tools/asmgen_power.S index 71c692f97bf..b3323484172 100644 --- a/testsuite/tools/asmgen_power.S +++ b/testsuite/tools/asmgen_power.S @@ -10,55 +10,11 @@ /* */ /*********************************************************************/ -#if defined(MODEL_ppc64) || defined(MODEL_ppc64le) -#define EITHER(a,b) b -#else -#define EITHER(a,b) a -#endif - -#define WORD EITHER(4,8) -#define lg EITHER(lwz,ld) -#define lgu EITHER(lwzu,ldu) -#define stg EITHER(stw,std) -#define stgu EITHER(stwu,stdu) - -#if defined(MODEL_ppc) -#define RESERVED_STACK 16 -#define LR_SAVE_AREA 4 -#endif -#if defined(MODEL_ppc64) -#define RESERVED_STACK 48 -#define LR_SAVE_AREA 16 -#endif -#if defined(MODEL_ppc64le) #define RESERVED_STACK 32 #define LR_SAVE_AREA 16 -#endif /* Function definitions */ -#if defined(MODEL_ppc) -#define FUNCTION(name) \ - .section ".text"; \ - .globl name; \ - .type name, @function; \ - .align 2; \ - name: -#endif - -#if defined(MODEL_ppc64) -#define FUNCTION(name) \ - .section ".opd","aw"; \ - .align 3; \ - .globl name; \ - .type name, @function; \ - name: .quad .L.name,.TOC.@tocbase; \ - .text; \ - .align 2; \ - .L.name: -#endif - -#if defined(MODEL_ppc64le) #define FUNCTION(name) \ .section ".text"; \ .globl name; \ @@ -68,35 +24,34 @@ 0: addis 2, 12, (.TOC. - 0b)@ha; \ addi 2, 2, (.TOC. - 0b)@l; \ .localentry name, . - 0b -#endif FUNCTION(call_gen_code) /* Allocate and link stack frame */ - stgu 1, -(WORD*18 + 8*18 + RESERVED_STACK)(1) + stdu 1, -(8*18 + 8*18 + RESERVED_STACK)(1) /* 18 saved GPRs, 18 saved FPRs */ /* Save return address */ mflr 0 - stg 0, (WORD*18 + 8*18 + RESERVED_STACK + LR_SAVE_AREA)(1) + std 0, (8*18 + 8*18 + RESERVED_STACK + LR_SAVE_AREA)(1) /* Save all callee-save registers, starting at RESERVED_STACK */ - addi 11, 1, RESERVED_STACK - WORD - stgu 14, WORD(11) - stgu 15, WORD(11) - stgu 16, WORD(11) - stgu 17, WORD(11) - stgu 18, WORD(11) - stgu 19, WORD(11) - stgu 20, WORD(11) - stgu 21, WORD(11) - stgu 22, WORD(11) - stgu 23, WORD(11) - stgu 24, WORD(11) - stgu 25, WORD(11) - stgu 26, WORD(11) - stgu 27, WORD(11) - stgu 28, WORD(11) - stgu 29, WORD(11) - stgu 30, WORD(11) - stgu 31, WORD(11) + addi 11, 1, RESERVED_STACK - 8 + stdu 14, 8(11) + stdu 15, 8(11) + stdu 16, 8(11) + stdu 17, 8(11) + stdu 18, 8(11) + stdu 19, 8(11) + stdu 20, 8(11) + stdu 21, 8(11) + stdu 22, 8(11) + stdu 23, 8(11) + stdu 24, 8(11) + stdu 25, 8(11) + stdu 26, 8(11) + stdu 27, 8(11) + stdu 28, 8(11) + stdu 29, 8(11) + stdu 30, 8(11) + stdu 31, 8(11) stfdu 14, 8(11) stfdu 15, 8(11) stfdu 16, 8(11) @@ -116,18 +71,8 @@ FUNCTION(call_gen_code) stfdu 30, 8(11) stfdu 31, 8(11) /* Get function pointer in CTR */ -#if defined(MODEL_ppc) - mtctr 3 -#elif defined(MODEL_ppc64) - ld 0, 0(3) - mtctr 0 - ld 2, 8(3) -#elif defined(MODEL_ppc64le) mtctr 3 mr 12, 3 -#else -#error "wrong MODEL" -#endif /* Shuffle arguments */ mr 3, 4 mr 4, 5 @@ -136,25 +81,25 @@ FUNCTION(call_gen_code) /* Call the function */ bctrl /* Restore callee-save registers */ - addi 11, 1, RESERVED_STACK - WORD - lgu 14, WORD(11) - lgu 15, WORD(11) - lgu 16, WORD(11) - lgu 17, WORD(11) - lgu 18, WORD(11) - lgu 19, WORD(11) - lgu 20, WORD(11) - lgu 21, WORD(11) - lgu 22, WORD(11) - lgu 23, WORD(11) - lgu 24, WORD(11) - lgu 25, WORD(11) - lgu 26, WORD(11) - lgu 27, WORD(11) - lgu 28, WORD(11) - lgu 29, WORD(11) - lgu 30, WORD(11) - lgu 31, WORD(11) + addi 11, 1, RESERVED_STACK - 8 + ldu 14, 8(11) + ldu 15, 8(11) + ldu 16, 8(11) + ldu 17, 8(11) + ldu 18, 8(11) + ldu 19, 8(11) + ldu 20, 8(11) + ldu 21, 8(11) + ldu 22, 8(11) + ldu 23, 8(11) + ldu 24, 8(11) + ldu 25, 8(11) + ldu 26, 8(11) + ldu 27, 8(11) + ldu 28, 8(11) + ldu 29, 8(11) + ldu 30, 8(11) + ldu 31, 8(11) lfdu 14, 8(11) lfdu 15, 8(11) lfdu 16, 8(11) @@ -174,26 +119,16 @@ FUNCTION(call_gen_code) lfdu 30, 8(11) lfdu 31, 8(11) /* Reload return address */ - lg 0, (WORD*18 + 8*18 + RESERVED_STACK + LR_SAVE_AREA)(1) + ld 0, (8*18 + 8*18 + RESERVED_STACK + LR_SAVE_AREA)(1) mtlr 0 /* Return */ - addi 1, 1, (WORD*18 + 8*18 + RESERVED_STACK) + addi 1, 1, (8*18 + 8*18 + RESERVED_STACK) blr FUNCTION(caml_c_call) /* Jump to C function (address in r28) */ -#if defined(MODEL_ppc) - mtctr 28 -#elif defined(MODEL_ppc64) - ld 0, 0(28) - mtctr 0 - ld 2, 8(28) -#elif defined(MODEL_ppc64le) mtctr 28 mr 12, 28 -#else -#error "wrong MODEL" -#endif bctr /* Mark stack as non-executable */ From 13355e6f3a729768d0d5ebc31a74fd3c0b0956fb Mon Sep 17 00:00:00 2001 From: "A. Wilcox" Date: Sun, 15 Oct 2023 21:28:16 -0500 Subject: [PATCH 184/402] Support native compiler on ABIv2 Power BE (#12656) This will only work on ABIv2 systems, such as Linux on musl libc and FreeBSD/OpenBSD. Tested on musl libc system and all tests pass. --- asmcomp/power/arch.ml | 6 +++++- configure | 2 ++ configure.ac | 2 ++ 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/asmcomp/power/arch.ml b/asmcomp/power/arch.ml index dcd5f462bae..649618f6cc9 100644 --- a/asmcomp/power/arch.ml +++ b/asmcomp/power/arch.ml @@ -47,7 +47,11 @@ type addressing_mode = (* Sizes, endianness *) -let big_endian = false (* ppc64le only *) +let big_endian = + match Config.model with + | "ppc64" -> true + | "ppc64le" -> false + | _ -> assert false let size_addr = 8 let size_int = size_addr let size_float = 8 diff --git a/configure b/configure index d560b0487b3..68c11e094d4 100755 --- a/configure +++ b/configure @@ -15493,6 +15493,8 @@ case $host in #( arch=amd64; system=win64 ;; #( powerpc64le*-*-linux*) : has_native_backend=yes; arch=power; model=ppc64le; system=linux ;; #( + powerpc64*-*-linux-musl*) : + has_native_backend=yes; arch=power; model=ppc64; system=linux ;; #( s390x*-*-linux*) : has_native_backend=yes; arch=s390x; model=z10; system=linux ;; #( # expected to match "gnueabihf" as well as "musleabihf" diff --git a/configure.ac b/configure.ac index 16a58dde2c2..7eb3ae9ad81 100644 --- a/configure.ac +++ b/configure.ac @@ -1262,6 +1262,8 @@ AS_CASE([$host], [arch=amd64; system=win64], [[powerpc64le*-*-linux*]], [has_native_backend=yes; arch=power; model=ppc64le; system=linux], + [[powerpc64*-*-linux-musl*]], + [has_native_backend=yes; arch=power; model=ppc64; system=linux], [[s390x*-*-linux*]], [has_native_backend=yes; arch=s390x; model=z10; system=linux], # expected to match "gnueabihf" as well as "musleabihf" From db89e7edcc1a71903e7fc76c75c140c5477ec60d Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Mon, 16 Oct 2023 19:54:38 +0800 Subject: [PATCH 185/402] Remove global state in asmcomp/schedgen --- Changes | 3 ++ asmcomp/schedgen.ml | 89 ++++++++++++++++++++++---------------------- asmcomp/schedgen.mli | 2 - 3 files changed, 47 insertions(+), 47 deletions(-) diff --git a/Changes b/Changes index f066a749b8d..1f18ae5a986 100644 --- a/Changes +++ b/Changes @@ -365,6 +365,9 @@ Working version (Gabriel Scherer, review by Enguerrand Decorne, Miod Vallat, B. Szilvasy and Nick Barnes, report by KC Sivaramakrishnan) +- #????? : Clean up some global state handling in schedgen + (Stefan Muenzel, review by ?????) + ### Build system: - #12198, #12321: continue the merge of the sub-makefiles into the root Makefile diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml index bd3d38013ae..50cee355b97 100644 --- a/asmcomp/schedgen.ml +++ b/asmcomp/schedgen.ml @@ -44,18 +44,21 @@ let dummy_node = - code_checkbounds contains the latest checkbound node not matched by a subsequent load or store. *) -let code_results = (Hashtbl.create 31 : (location, code_dag_node) Hashtbl.t) -let code_uses = (Hashtbl.create 31 : (location, code_dag_node) Hashtbl.t) -let code_stores = ref ([] : code_dag_node list) -let code_loads = ref ([] : code_dag_node list) -let code_checkbounds = ref ([] : code_dag_node list) - -let clear_code_dag () = - Hashtbl.clear code_results; - Hashtbl.clear code_uses; - code_stores := []; - code_loads := []; - code_checkbounds := [] +type code_dag = + { results : (location, code_dag_node) Hashtbl.t + ; uses : (location, code_dag_node) Hashtbl.t + ; mutable stores : code_dag_node list + ; mutable loads : code_dag_node list + ; mutable checkbounds : code_dag_node list + } + +let create () = + { results = Hashtbl.create 31 + ; uses = Hashtbl.create 31 + ; stores = [] + ; loads = [] + ; checkbounds = [] + } (* Add an edge to the code DAG *) @@ -68,9 +71,9 @@ let add_edge_after son ancestor = add_edge ancestor son 0 (* Add edges from all instructions that define a pseudoregister [arg] being used as argument to node [node] (RAW dependencies *) -let add_RAW_dependencies node arg = +let add_RAW_dependencies t node arg = try - let ancestor = Hashtbl.find code_results arg.loc in + let ancestor = Hashtbl.find t.results arg.loc in add_edge ancestor node ancestor.delay with Not_found -> () @@ -78,16 +81,16 @@ let add_RAW_dependencies node arg = (* Add edges from all instructions that use a pseudoregister [res] that is defined by node [node] (WAR dependencies). *) -let add_WAR_dependencies node res = - let ancestors = Hashtbl.find_all code_uses res.loc in +let add_WAR_dependencies t node res = + let ancestors = Hashtbl.find_all t.uses res.loc in List.iter (add_edge_after node) ancestors (* Add edges from all instructions that have already defined a pseudoregister [res] that is defined by node [node] (WAW dependencies). *) -let add_WAW_dependencies node res = +let add_WAW_dependencies t node res = try - let ancestor = Hashtbl.find code_results res.loc in + let ancestor = Hashtbl.find t.results res.loc in add_edge ancestor node 0 with Not_found -> () @@ -256,7 +259,7 @@ method private destroyed_by_instr instr = (* Add an instruction to the code dag *) -method private add_instruction ready_queue instr = +method private add_instruction t ready_queue instr = let delay = self#instr_latency instr in let destroyed = self#destroyed_by_instr instr in let node = @@ -269,50 +272,50 @@ method private add_instruction ready_queue instr = emitted_ancestors = 0 } in (* Add edges from all instructions that define one of the registers used (RAW dependencies) *) - Array.iter (add_RAW_dependencies node) instr.arg; + Array.iter (add_RAW_dependencies t node) instr.arg; (* Also add edges from all instructions that use one of the result regs of this instruction, or a reg destroyed by this instruction (WAR dependencies). *) - Array.iter (add_WAR_dependencies node) instr.res; - Array.iter (add_WAR_dependencies node) destroyed; (* PR#5731 *) + Array.iter (add_WAR_dependencies t node) instr.res; + Array.iter (add_WAR_dependencies t node) destroyed; (* PR#5731 *) (* Also add edges from all instructions that have already defined one of the results of this instruction, or a reg destroyed by this instruction (WAW dependencies). *) - Array.iter (add_WAW_dependencies node) instr.res; - Array.iter (add_WAW_dependencies node) destroyed; (* PR#5731 *) + Array.iter (add_WAW_dependencies t node) instr.res; + Array.iter (add_WAW_dependencies t node) destroyed; (* PR#5731 *) (* If this is a load, add edges from the most recent store viewed so far (if any) and remember the load. Also add edges from the most recent checkbound and forget that checkbound. *) if self#instr_is_load instr then begin - List.iter (add_edge_after node) !code_stores; - code_loads := node :: !code_loads; - List.iter (add_edge_after node) !code_checkbounds; - code_checkbounds := [] + List.iter (add_edge_after node) t.stores; + t.loads <- node :: t.loads; + List.iter (add_edge_after node) t.checkbounds; + t.checkbounds <- [] end (* If this is a store, add edges from the most recent store, as well as all loads viewed since then, and also the most recent checkbound. Remember the store, discarding the previous stores, loads and checkbounds. *) else if self#instr_is_store instr then begin - List.iter (add_edge_after node) !code_stores; - List.iter (add_edge_after node) !code_loads; - List.iter (add_edge_after node) !code_checkbounds; - code_stores := [node]; - code_loads := []; - code_checkbounds := [] + List.iter (add_edge_after node) t.stores; + List.iter (add_edge_after node) t.loads; + List.iter (add_edge_after node) t.checkbounds; + t.stores <- [node]; + t.loads <- []; + t.checkbounds <- [] end else if self#instr_is_checkbound instr then begin - code_checkbounds := [node] + t.checkbounds <- [node] end; (* Remember the registers used and produced by this instruction *) for i = 0 to Array.length instr.res - 1 do - Hashtbl.add code_results instr.res.(i).loc node + Hashtbl.add t.results instr.res.(i).loc node done; for i = 0 to Array.length destroyed - 1 do - Hashtbl.add code_results destroyed.(i).loc node (* PR#5731 *) + Hashtbl.add t.results destroyed.(i).loc node (* PR#5731 *) done; for i = 0 to Array.length instr.arg - 1 do - Hashtbl.add code_uses instr.arg.(i).loc node + Hashtbl.add t.uses instr.arg.(i).loc node done; (* If this is a root instruction (all arguments already computed), add it to the ready queue *) @@ -375,14 +378,13 @@ method schedule_fundecl f = | Lpoptrap -> { i with next = schedule i.next (try_nesting - 1) } | _ -> if self#instr_in_basic_block i try_nesting then begin - clear_code_dag(); - schedule_block [] i try_nesting + schedule_block (create ()) [] i try_nesting end else { i with next = schedule i.next try_nesting } - and schedule_block ready_queue i try_nesting = + and schedule_block t ready_queue i try_nesting = if self#instr_in_basic_block i try_nesting then - schedule_block (self#add_instruction ready_queue i) i.next try_nesting + schedule_block t (self#add_instruction t ready_queue i) i.next try_nesting else begin let critical_outputs = match i.desc with @@ -396,11 +398,8 @@ method schedule_fundecl f = if f.fun_fast && !Clflags.insn_sched then begin let new_body = schedule f.fun_body 0 in - clear_code_dag(); { f with fun_body = new_body } end else f end - -let reset () = clear_code_dag () diff --git a/asmcomp/schedgen.mli b/asmcomp/schedgen.mli index 3f2ea61f368..80df1c05c24 100644 --- a/asmcomp/schedgen.mli +++ b/asmcomp/schedgen.mli @@ -46,5 +46,3 @@ class virtual scheduler_generic : object (* Entry point *) method schedule_fundecl : Linear.fundecl -> Linear.fundecl end - -val reset : unit -> unit From 72c74712e45e37dfecdfca4d93ad9ac47c29d6bf Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Mon, 16 Oct 2023 20:16:27 +0800 Subject: [PATCH 186/402] remove unused variable trywith_nesting --- asmcomp/schedgen.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml index 50cee355b97..80f21c2551e 100644 --- a/asmcomp/schedgen.ml +++ b/asmcomp/schedgen.ml @@ -149,8 +149,6 @@ let some_load = class virtual scheduler_generic = object (self) -val mutable trywith_nesting = 0 - (* Determine whether an operation ends a basic block or not. Can be overridden for some processors to signal specific instructions that terminate a basic block. *) From df4b35a004872905e7f57512c76da2d3415a9236 Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Mon, 16 Oct 2023 20:17:58 +0800 Subject: [PATCH 187/402] Update changes --- Changes | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 1f18ae5a986..75d72c3e79b 100644 --- a/Changes +++ b/Changes @@ -365,8 +365,8 @@ Working version (Gabriel Scherer, review by Enguerrand Decorne, Miod Vallat, B. Szilvasy and Nick Barnes, report by KC Sivaramakrishnan) -- #????? : Clean up some global state handling in schedgen - (Stefan Muenzel, review by ?????) +- #12669 : Clean up some global state handling in schedgen + (Stefan Muenzel, review by Miod Vallat) ### Build system: From 5fc549613891b03051efbb57e345b6f246446512 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 16 Oct 2023 14:50:10 +0200 Subject: [PATCH 188/402] runtime/power.S: add a compile-time check on the ABI version used Makes me feel safer about possible misdetection by config.guess and configure. --- runtime/power.S | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/runtime/power.S b/runtime/power.S index 9aa425c83b8..7afefe8735b 100644 --- a/runtime/power.S +++ b/runtime/power.S @@ -15,6 +15,10 @@ .abiversion 2 +#if _CALL_ELF != 2 +#error "This POWER port requires the ELFv2 ABI" +#endif + /* Special registers */ #define SP 1 #define TMP 11 From 782709fd6f5ad918ffa9d9d388ad5287dc4655cd Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 16 Oct 2023 14:52:06 +0200 Subject: [PATCH 189/402] README update and changes entry for 12667 --- Changes | 5 ++++- README.adoc | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index f066a749b8d..0b0b9434a66 100644 --- a/Changes +++ b/Changes @@ -1,12 +1,15 @@ Working version --------------- -### Restored backends: +### Restored and new backends: - #12276, #12601: native-code compilation for POWER (64 bits, little-endian) (Xavier Leroy, review by KC Sivaramakrishnan, Anil Madhavapeddy, and Stephen Dolan) +- #12667: extend the latter to POWER 64 bits, big-endian, ELFv2 ABI + (A. Wilcox, review by Xavier Leroy) + ### Language features: - #12295, #12568: Give `while true' a polymorphic type, similarly to diff --git a/README.adoc b/README.adoc index 2d9438fcdfa..078bd745084 100644 --- a/README.adoc +++ b/README.adoc @@ -71,7 +71,7 @@ compiler currently runs on the following platforms: | x86 64 bits | Linux, macOS, Windows, FreeBSD | NetBSD, OpenBSD, OmniOS (Solaris) | ARM 64 bits | Linux, macOS | FreeBSD, OpenBSD, NetBSD -| Power 64 bits | Linux | +| Power 64 bits | Linux (little-endian, ABIv2) | Linux (big-endian, ABIv2) | RISC-V 64 bits | Linux | | IBM Z (s390x) | Linux | |==== From 830fff51434efa5300c65e34ebc97e850696c404 Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Mon, 16 Oct 2023 21:33:21 +0800 Subject: [PATCH 190/402] Small changes --- Changes | 2 +- asmcomp/schedgen.ml | 34 ++++++++++++++++++---------------- 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/Changes b/Changes index 75d72c3e79b..0b98592328f 100644 --- a/Changes +++ b/Changes @@ -366,7 +366,7 @@ Working version and Nick Barnes, report by KC Sivaramakrishnan) - #12669 : Clean up some global state handling in schedgen - (Stefan Muenzel, review by Miod Vallat) + (Stefan Muenzel, review by Miod Vallat and Gabriel Scherer) ### Build system: diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml index 80f21c2551e..e36f6bfe30d 100644 --- a/asmcomp/schedgen.ml +++ b/asmcomp/schedgen.ml @@ -21,15 +21,16 @@ open Linear (* Representation of the code DAG. *) -type code_dag_node = - { instr: instruction; (* The instruction *) +type code_dag_node = { + instr: instruction; (* The instruction *) delay: int; (* How many cycles before result is available *) mutable sons: (code_dag_node * int) list; (* Instructions that depend on it *) mutable date: int; (* Start date *) mutable length: int; (* Length of longest path to result *) mutable ancestors: int; (* Number of ancestors *) - mutable emitted_ancestors: int } (* Number of emitted ancestors *) + mutable emitted_ancestors: int (* Number of emitted ancestors *) + } let dummy_node = { instr = end_instr; delay = 0; sons = []; date = 0; @@ -44,20 +45,21 @@ let dummy_node = - code_checkbounds contains the latest checkbound node not matched by a subsequent load or store. *) -type code_dag = - { results : (location, code_dag_node) Hashtbl.t - ; uses : (location, code_dag_node) Hashtbl.t - ; mutable stores : code_dag_node list - ; mutable loads : code_dag_node list - ; mutable checkbounds : code_dag_node list +type code_dag = { + results : (location, code_dag_node) Hashtbl.t; + uses : (location, code_dag_node) Hashtbl.t; + mutable stores : code_dag_node list; + mutable loads : code_dag_node list; + mutable checkbounds : code_dag_node list; } -let create () = - { results = Hashtbl.create 31 - ; uses = Hashtbl.create 31 - ; stores = [] - ; loads = [] - ; checkbounds = [] +let empty_dag () = + { + results = Hashtbl.create 31; + uses = Hashtbl.create 31; + stores = []; + loads = []; + checkbounds = []; } (* Add an edge to the code DAG *) @@ -376,7 +378,7 @@ method schedule_fundecl f = | Lpoptrap -> { i with next = schedule i.next (try_nesting - 1) } | _ -> if self#instr_in_basic_block i try_nesting then begin - schedule_block (create ()) [] i try_nesting + schedule_block (empty_dag ()) [] i try_nesting end else { i with next = schedule i.next try_nesting } From e5555c7eae6abe822fd20bf396435b93aebe8b64 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Wed, 23 Aug 2023 11:33:35 -0400 Subject: [PATCH 191/402] Add regression test --- .../syntactic-arity/comparative_alloc.ml | 121 ++++++++++++++++++ .../comparative_alloc.reference | 10 ++ 2 files changed, 131 insertions(+) create mode 100644 testsuite/tests/syntactic-arity/comparative_alloc.ml create mode 100644 testsuite/tests/syntactic-arity/comparative_alloc.reference diff --git a/testsuite/tests/syntactic-arity/comparative_alloc.ml b/testsuite/tests/syntactic-arity/comparative_alloc.ml new file mode 100644 index 00000000000..d2f526c9e4d --- /dev/null +++ b/testsuite/tests/syntactic-arity/comparative_alloc.ml @@ -0,0 +1,121 @@ +(* TEST + flags = "-w +A-70"; + setup-ocamlopt.byte-build-env; + ocamlopt.byte; + run; + check-program-output; +*) + +(* Check that the runtime arity of a function (i.e., its 'fast path' for + runtime application) matches its syntactic arity (i.e., the number + of arguments appearing directly following [fun]). +*) + +type (_, _) raw_arity = + | One : (int -> 'ret, 'ret) raw_arity + | Succ : ('f, 'ret) raw_arity -> (int -> 'f, 'ret) raw_arity + +let rec numeric_arity : type f ret. (f, ret) raw_arity -> int = + fun arity -> + match arity with + | One -> 1 + | Succ arity -> numeric_arity arity + 1 + +let rec apply : type f ret. (f, ret) raw_arity -> f -> int -> ret = + fun arity f arg -> + match arity with + | One -> f arg + | Succ arity -> apply arity (f arg) arg + +type 'a arity = + | Tupled + | Curried : ('a, _) raw_arity -> 'a arity + +type packed_raw_arity = Packed_raw_arity : _ raw_arity -> packed_raw_arity +type packed_arity = Packed_arity : _ arity -> packed_arity + +let arity_description (type a) (arity : a arity) = + match arity with + | Tupled -> "tupled fun" + | Curried arity -> Printf.sprintf "%d-ary fun" (numeric_arity arity) + +(* [runtime_arity] depends on representation details of functions and + is subject to change. +*) +let runtime_arity (f : 'a -> 'b) : ('a -> 'b) arity = + let clos_info = Obj.raw_field (Obj.repr f) 1 in + let raw_arity = + Nativeint.(to_int (shift_right clos_info (Sys.word_size - 8))) + in + if raw_arity < 0 then Tupled else + let rec build_arity n = + if n = 1 then Packed_raw_arity One + else + let Packed_raw_arity pred = build_arity (n-1) in + Packed_raw_arity (Succ pred) + in + let Packed_raw_arity arity = build_arity raw_arity in + (* Obj.magic is claiming that [f]'s arity matches the arity + we've constructed here. + *) + Curried (Obj.magic arity : ('a -> 'b, _) raw_arity) + +let maybe_runtime_arity (type a) (x : a) : a arity option = + let open struct + type _ is_function = + | Not_function : _ is_function + | Is_function : (_ -> _) is_function + + let is_function (type a) (x : a) = + if Obj.tag (Obj.repr x) = Obj.closure_tag + then (Obj.magic Is_function : a is_function) + else Not_function + end + in + match is_function x with + | Is_function -> Some (runtime_arity x) + | Not_function -> None + +(* The "nested arity" of a value is either: + - the empty list, if the value isn't a function + - x :: xs if the value is a function [f], where [x] is [f]'s arity, and + [xs] is the nested arity of the result of applying [f] to a value. + + "nested arity" isn't well-defined for a function that, say, returns a 2-ary + function for some inputs and a 3-ary for others. None of the functions in + this test do that. +*) +let rec nested_arity : type a. a -> packed_arity list = + fun f -> + match maybe_runtime_arity f with + | None -> [] + | Some x -> + let rest = + match x with + | Tupled -> [] + | Curried arity -> nested_arity (apply arity f 1_234) + in + Packed_arity x :: rest + +let run ~name f = + Printf.printf "%s: %s\n" name + (nested_arity f + |> List.map (fun (Packed_arity arity) -> arity_description arity) + |> String.concat " returning ") + +let () = + print_endline "Key:"; + print_endline " : "; + print_newline (); + run (fun _ _ _ -> ()) ~name:"3 params"; + run (fun _ _ -> fun _ -> ()) ~name:"2 params then 1 param"; + run (fun _ -> fun _ _ -> ()) ~name:"1 param then 2 params"; + run (fun _ -> fun _ -> fun _ -> ()) + ~name:"1 param, then 1 param, then 1 param"; + run (fun _ -> let g _ _ = () in g) + ~name:"1 param then let-bound 2 params"; + run (fun _ _ -> let g _ = () in g) + ~name:"2 params then let-bound 1 param"; + run (fun _ -> let g _ = let h _ = () in h in g) + ~name:"1 param, then let-bound 1 param, then let-bound 1 param"; +;; diff --git a/testsuite/tests/syntactic-arity/comparative_alloc.reference b/testsuite/tests/syntactic-arity/comparative_alloc.reference new file mode 100644 index 00000000000..37644c762b8 --- /dev/null +++ b/testsuite/tests/syntactic-arity/comparative_alloc.reference @@ -0,0 +1,10 @@ +Key: + : + +3 params: 3-ary fun +2 params then 1 param: 3-ary fun +1 param then 2 params: 3-ary fun +1 param, then 1 param, then 1 param: 3-ary fun +1 param then let-bound 2 params: 3-ary fun +2 params then let-bound 1 param: 3-ary fun +1 param, then let-bound 1 param, then let-bound 1 param: 3-ary fun From 84daf9e092a12ca8d6f92378ee7e751a17f81f92 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Wed, 23 Aug 2023 14:26:54 -0400 Subject: [PATCH 192/402] Turn off arity fusion for [fun] and [function] --- lambda/lambda.ml | 10 ++++++++++ lambda/lambda.mli | 3 +++ lambda/simplif.ml | 12 ++++++++---- lambda/translclass.ml | 3 ++- lambda/translcore.ml | 13 +++++++++---- lambda/translmod.ml | 4 +++- .../syntactic-arity/comparative_alloc.reference | 12 ++++++------ 7 files changed, 41 insertions(+), 16 deletions(-) diff --git a/lambda/lambda.ml b/lambda/lambda.ml index 8c112d6bad6..ba964cd0bee 100644 --- a/lambda/lambda.ml +++ b/lambda/lambda.ml @@ -285,6 +285,7 @@ type function_attribute = { is_a_functor: bool; stub: bool; tmc_candidate: bool; + may_fuse_arity: bool; } type scoped_location = Debuginfo.Scoped_location.t @@ -384,6 +385,15 @@ let default_function_attribute = { is_a_functor = false; stub = false; tmc_candidate = false; + (* Plain functions ([fun] and [function]) set [may_fuse_arity] to [false] so + that runtime arity matches syntactic arity in more situations. + + Many things compile to functions without having a notion of syntactic arity + that survives typechecking, e.g. functors. Multi-arg functors are compiled + as nested unary functions, and rely on the arity fusion in simplif to make + them multi-argument. So, we keep arity fusion turned on by default for now. + *) + may_fuse_arity = true; } let default_stub_attribute = diff --git a/lambda/lambda.mli b/lambda/lambda.mli index 48a57b8d7df..4186132fd40 100644 --- a/lambda/lambda.mli +++ b/lambda/lambda.mli @@ -272,6 +272,9 @@ type function_attribute = { is_a_functor: bool; stub: bool; tmc_candidate: bool; + (* [may_fuse_arity] is true if [simplif.ml] is permitted to fuse arity, i.e., + to perform the rewrite [fun x -> fun y -> e] to [fun x y -> e] *) + may_fuse_arity: bool; } type scoped_location = Debuginfo.Scoped_location.t diff --git a/lambda/simplif.ml b/lambda/simplif.ml index 479b46d6bc7..8d01fcc2912 100644 --- a/lambda/simplif.ml +++ b/lambda/simplif.ml @@ -516,19 +516,23 @@ let simplify_lets lam = end | _ -> no_opt () end - | Lfunction{kind; params; return=return1; body = l; attr; loc} -> + | Lfunction{kind; params; return=return1; body = l; attr=attr1; loc} + -> begin match simplif l with - Lfunction{kind=Curried; params=params'; return=return2; body; attr; loc} + Lfunction{kind=Curried; params=params'; return=return2; body; + attr=attr2; loc} when kind = Curried && optimize && + attr1.may_fuse_arity && attr2.may_fuse_arity && List.length params + List.length params' <= Lambda.max_arity() -> (* The return type is the type of the value returned after applying all the parameters to the function. The return type of the merged function taking [params @ params'] as parameters is the type returned after applying [params']. *) let return = return2 in - lfunction ~kind ~params:(params @ params') ~return ~body ~attr ~loc + lfunction ~kind ~params:(params @ params') ~return ~body ~attr:attr2 + ~loc | body -> - lfunction ~kind ~params ~return:return1 ~body ~attr ~loc + lfunction ~kind ~params ~return:return1 ~body ~attr:attr1 ~loc end | Llet(_str, _k, v, Lvar w, l2) when optimize -> Hashtbl.add subst v (simplif (Lvar w)); diff --git a/lambda/translclass.ml b/lambda/translclass.ml index 8db67e101b4..12915737706 100644 --- a/lambda/translclass.ml +++ b/lambda/translclass.ml @@ -31,7 +31,8 @@ let lfunction params body = if params = [] then body else match body with | Lfunction {kind = Curried; params = params'; body = body'; attr; loc} - when List.length params + List.length params' <= Lambda.max_arity() -> + when attr.may_fuse_arity && + List.length params + List.length params' <= Lambda.max_arity() -> lfunction ~kind:Curried ~params:(params @ params') ~return:Pgenval ~body:body' diff --git a/lambda/translcore.ml b/lambda/translcore.ml index e08e4a5c2ec..b9f10ab4a99 100644 --- a/lambda/translcore.ml +++ b/lambda/translcore.ml @@ -120,6 +120,11 @@ let assert_failed loc ~scopes exp = Const_base(Const_int line); Const_base(Const_int char)]))], loc))], loc) +(* In cases where we're careful to preserve syntactic arity, we disable + the arity fusion attempted by simplif.ml *) +let function_attribute_disallowing_arity_fusion = + { default_function_attribute with may_fuse_arity = false } + let rec cut n l = if n = 0 then ([],l) else match l with [] -> failwith "Translcore.cut" @@ -524,7 +529,7 @@ and transl_exp0 ~in_new_scope ~scopes e = let fn = lfunction ~kind:Curried ~params:[Ident.create_local "param", Pgenval] ~return:Pgenval - ~attr:default_function_attribute + ~attr:function_attribute_disallowing_arity_fusion ~loc:(of_location ~scopes e.exp_loc) ~body:(transl_exp ~scopes e) in Lprim(Pmakeblock(Config.lazy_tag, Mutable, None), [fn], @@ -831,7 +836,7 @@ and transl_curried_function ~scopes loc return repr params body = let body, return = List.fold_right (fun chunk (body, return) -> - let attr = default_function_attribute in + let attr = function_attribute_disallowing_arity_fusion in let loc = of_location ~scopes loc in let body = lfunction ~kind:Curried ~params:chunk ~return ~body ~attr ~loc @@ -852,7 +857,7 @@ and transl_function ~scopes e params body = let params, body = fuse_method_arity params body in transl_function_without_attributes ~scopes e.exp_loc repr params body) in - let attr = default_function_attribute in + let attr = function_attribute_disallowing_arity_fusion in let loc = of_location ~scopes e.exp_loc in let lam = lfunction ~kind ~params ~return ~body ~attr ~loc in let attrs = @@ -1175,7 +1180,7 @@ and transl_letop ~scopes loc env let_ ands param case partial = { cases = [case]; param; partial; loc = ghost_loc; exp_extra = None; attributes = []; })) in - let attr = default_function_attribute in + let attr = function_attribute_disallowing_arity_fusion in let loc = of_location ~scopes case.c_rhs.exp_loc in lfunction ~kind ~params ~return ~body ~attr ~loc in diff --git a/lambda/translmod.ml b/lambda/translmod.ml index 83e8b8cdd6e..8e0b9ab287d 100644 --- a/lambda/translmod.ml +++ b/lambda/translmod.ml @@ -121,7 +121,8 @@ and apply_coercion_result loc strict funct params args cc_res = ~return:Pgenval ~attr:{ default_function_attribute with is_a_functor = true; - stub = true; } + stub = true; + may_fuse_arity = true; } ~loc ~body:(apply_coercion loc Strict cc_res @@ -500,6 +501,7 @@ let rec compile_functor ~scopes mexp coercion root_path loc = is_a_functor = true; stub = false; tmc_candidate = false; + may_fuse_arity = true; } ~loc ~body diff --git a/testsuite/tests/syntactic-arity/comparative_alloc.reference b/testsuite/tests/syntactic-arity/comparative_alloc.reference index 37644c762b8..9f1e7c56c3e 100644 --- a/testsuite/tests/syntactic-arity/comparative_alloc.reference +++ b/testsuite/tests/syntactic-arity/comparative_alloc.reference @@ -2,9 +2,9 @@ Key: : 3 params: 3-ary fun -2 params then 1 param: 3-ary fun -1 param then 2 params: 3-ary fun -1 param, then 1 param, then 1 param: 3-ary fun -1 param then let-bound 2 params: 3-ary fun -2 params then let-bound 1 param: 3-ary fun -1 param, then let-bound 1 param, then let-bound 1 param: 3-ary fun +2 params then 1 param: 2-ary fun returning 1-ary fun +1 param then 2 params: 1-ary fun returning 2-ary fun +1 param, then 1 param, then 1 param: 1-ary fun returning 1-ary fun returning 1-ary fun +1 param then let-bound 2 params: 1-ary fun returning 2-ary fun +2 params then let-bound 1 param: 2-ary fun returning 1-ary fun +1 param, then let-bound 1 param, then let-bound 1 param: 1-ary fun returning 1-ary fun returning 1-ary fun From ad637612ac386b10967ba8f9129ec9415e133778 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Wed, 23 Aug 2023 16:16:25 -0400 Subject: [PATCH 193/402] Add Changes --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 381da59ee27..5a24f8773d6 100644 --- a/Changes +++ b/Changes @@ -295,7 +295,7 @@ Working version in Typecore in favor of local mutable state. (Nick Roberts, review by Takafumi Saikawa) -- #12236, #12386, #12391: Use syntax as the sole determiner of function arity +- #12236, #12386, #12391, #12496: Use syntax as the sole determiner of fun arity This changes function arity to be based solely on the source program's parsetree. Previously, the heuristic for arity had more subtle heuristics that involved type information about patterns. Function arity is important From 7602c4f624a0ac08da439650fd69d0da3a237e8c Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Mon, 16 Oct 2023 17:28:06 +0100 Subject: [PATCH 194/402] Update lambda/lambda.mli Co-authored-by: Richard Eisenberg --- lambda/lambda.mli | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lambda/lambda.mli b/lambda/lambda.mli index 4186132fd40..ce143291d0f 100644 --- a/lambda/lambda.mli +++ b/lambda/lambda.mli @@ -272,8 +272,10 @@ type function_attribute = { is_a_functor: bool; stub: bool; tmc_candidate: bool; - (* [may_fuse_arity] is true if [simplif.ml] is permitted to fuse arity, i.e., - to perform the rewrite [fun x -> fun y -> e] to [fun x y -> e] *) + (* [simplif.ml] (in the `simplif` function within `simplify_lets`) attempts to fuse + nested functions, rewriting e.g. [fun x -> fun y -> e] to [fun x y -> e]. This + fusion is allowed only when the [may_fuse_arity] field on *both* functions + involved is [true]. *) may_fuse_arity: bool; } From 4cdb26344d30bec8562ae90812c0e15724f6dfbe Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Mon, 16 Oct 2023 17:37:30 +0100 Subject: [PATCH 195/402] Add comment explaining lazy block --- lambda/translcore.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lambda/translcore.ml b/lambda/translcore.ml index b9f10ab4a99..c5f91ccafe8 100644 --- a/lambda/translcore.ml +++ b/lambda/translcore.ml @@ -529,6 +529,10 @@ and transl_exp0 ~in_new_scope ~scopes e = let fn = lfunction ~kind:Curried ~params:[Ident.create_local "param", Pgenval] ~return:Pgenval + (* The translation of [e] may be a function, in + which case disallowing arity fusion gives a very + small performance improvement. + *) ~attr:function_attribute_disallowing_arity_fusion ~loc:(of_location ~scopes e.exp_loc) ~body:(transl_exp ~scopes e) in From 90c46ff4c6c422ec1ce3cf394e6e64aa8ebfec49 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Mon, 16 Oct 2023 17:38:45 +0100 Subject: [PATCH 196/402] fix long lines committed through GitHub web UI --- lambda/lambda.mli | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lambda/lambda.mli b/lambda/lambda.mli index ce143291d0f..4936e8816ea 100644 --- a/lambda/lambda.mli +++ b/lambda/lambda.mli @@ -272,10 +272,10 @@ type function_attribute = { is_a_functor: bool; stub: bool; tmc_candidate: bool; - (* [simplif.ml] (in the `simplif` function within `simplify_lets`) attempts to fuse - nested functions, rewriting e.g. [fun x -> fun y -> e] to [fun x y -> e]. This - fusion is allowed only when the [may_fuse_arity] field on *both* functions - involved is [true]. *) + (* [simplif.ml] (in the `simplif` function within `simplify_lets`) attempts to + fuse nested functions, rewriting e.g. [fun x -> fun y -> e] to + [fun x y -> e]. This fusion is allowed only when the [may_fuse_arity] field + on *both* functions involved is [true]. *) may_fuse_arity: bool; } From f4c27cb3e44211ed58bc3702df7fef3b80d1b747 Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Tue, 17 Oct 2023 15:29:34 +0800 Subject: [PATCH 197/402] add confusing error case --- .../tests/typing-misc/includeclass_errors.ml | 27 +++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/testsuite/tests/typing-misc/includeclass_errors.ml b/testsuite/tests/typing-misc/includeclass_errors.ml index 37948347eb5..cb77ed71bf5 100644 --- a/testsuite/tests/typing-misc/includeclass_errors.ml +++ b/testsuite/tests/typing-misc/includeclass_errors.ml @@ -87,6 +87,33 @@ Error: Signature mismatch: The classes do not have the same number of type parameters |}] +module Confusing: sig + class ['x, 'y] c: object end +end = struct + class ['y, 'x] c = object method private id (x : 'y) = x + 1 end +end +;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | class ['y, 'x] c = object method private id (x : 'y) = x + 1 end +5 | end +Error: Signature mismatch: + Modules do not match: + sig + class ['a, 'x] c : + object constraint 'a = int method private id : 'a -> int end + end + is not included in + sig class ['x, 'y] c : object end end + Class declarations do not match: + class ['a, 'x] c : + object constraint 'a = int method private id : 'a -> int end + does not match + class ['x, 'y] c : object end + A type parameter has type "int" but is expected to have type "'x" +|}] + module M: sig class ['a] c: object constraint 'a = int end end = struct From 67851ab4333bf80953df106bdaf44c28a735d95c Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Tue, 17 Oct 2023 14:02:10 +0800 Subject: [PATCH 198/402] Identify mismatched class type parameters by ordinal in error messages. --- Changes | 4 +++ .../tests/typing-misc/includeclass_errors.ml | 27 +++++++++++++++++-- typing/ctype.ml | 6 ++--- typing/ctype.mli | 2 +- typing/includeclass.ml | 7 ++--- utils/misc.ml | 8 ++++++ utils/misc.mli | 4 +++ 7 files changed, 49 insertions(+), 9 deletions(-) diff --git a/Changes b/Changes index d51563773a8..5d62bfbce35 100644 --- a/Changes +++ b/Changes @@ -291,6 +291,10 @@ Working version - #12622: Give hints about existential types appearing in error messages (Leo White, review by Gabriel Scherer and Florian Angeletti) +- #?????: When a class type parameter does not match, identify which type + parameter in the error message, instead of saying "A type parameter". + (Stefan Muenzel, review by ?????) + ### Internal/compiler-libs changes: - #12447: Remove 32-bit targets from X86_proc.system diff --git a/testsuite/tests/typing-misc/includeclass_errors.ml b/testsuite/tests/typing-misc/includeclass_errors.ml index cb77ed71bf5..b9dedce5da5 100644 --- a/testsuite/tests/typing-misc/includeclass_errors.ml +++ b/testsuite/tests/typing-misc/includeclass_errors.ml @@ -111,7 +111,7 @@ Error: Signature mismatch: object constraint 'a = int method private id : 'a -> int end does not match class ['x, 'y] c : object end - A type parameter has type "int" but is expected to have type "'x" + The 1st type parameter has type "int" but is expected to have type "'x" |}] module M: sig @@ -134,7 +134,30 @@ Error: Signature mismatch: class ['a] c : object end does not match class ['a] c : object constraint 'a = int end - A type parameter has type "'a" but is expected to have type "int" + The 1st type parameter has type "'a" but is expected to have type "int" +|}] + +module M: sig + class ['a, 'b] c: object constraint 'b = int end +end = struct + class ['a, 'b] c = object end +end +;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | class ['a, 'b] c = object end +5 | end +Error: Signature mismatch: + Modules do not match: + sig class ['a, 'b] c : object end end + is not included in + sig class ['a, 'b] c : object constraint 'b = int end end + Class declarations do not match: + class ['a, 'b] c : object end + does not match + class ['a, 'b] c : object constraint 'b = int end + The 2nd type parameter has type "'b" but is expected to have type "int" |}] module M: sig diff --git a/typing/ctype.ml b/typing/ctype.ml index 0178b19e477..c4fa0f4569f 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -4315,7 +4315,7 @@ let rec equal_private env params1 ty1 params2 ty2 = type class_match_failure = CM_Virtual_class | CM_Parameter_arity_mismatch of int * int - | CM_Type_parameter_mismatch of Env.t * equality_error + | 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 Env.t * moregen_error | CM_Val_type_mismatch of string * Env.t * comparison_error @@ -4556,11 +4556,11 @@ let match_class_declarations env patt_params patt_type subj_params subj_type = let ls = List.length subj_params in if lp <> ls then raise (Failure [CM_Parameter_arity_mismatch (lp, ls)]); - List.iter2 (fun p s -> + 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 - (env, expand_to_equality_error env trace !subst)])) + (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; diff --git a/typing/ctype.mli b/typing/ctype.mli index caccfa3b444..57fbd89652d 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -320,7 +320,7 @@ 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 Env.t * Errortrace.equality_error + | 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 Env.t * Errortrace.moregen_error | CM_Val_type_mismatch of string * Env.t * Errortrace.comparison_error diff --git a/typing/includeclass.ml b/typing/includeclass.ml index 3a2cd57694f..d7135da3492 100644 --- a/typing/includeclass.ml +++ b/typing/includeclass.ml @@ -56,12 +56,13 @@ let include_err mode ppf = | CM_Parameter_arity_mismatch _ -> fprintf ppf "The classes do not have the same number of type parameters" - | CM_Type_parameter_mismatch (env, err) -> + | CM_Type_parameter_mismatch (n, env, err) -> Printtyp.report_equality_error ppf mode env err (function ppf -> - fprintf ppf "A type parameter has type") + fprintf ppf "The %d%s type parameter has type" + n (Misc.ordinal_suffix n)) (function ppf -> - fprintf ppf "but is expected to have type") + fprintf ppf "but is expected to have type") | CM_Class_type_mismatch (env, cty1, cty2) -> Printtyp.wrap_printing_env ~error:true env (fun () -> fprintf ppf diff --git a/utils/misc.ml b/utils/misc.ml index e36861cc2b9..8a7883b4276 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -133,6 +133,14 @@ module Stdlib = struct 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 diff --git a/utils/misc.mli b/utils/misc.mli index b6cb93d7478..a280fd5ce05 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -131,6 +131,10 @@ module Stdlib : sig 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 {!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. From 304373834c7da183762da84adad97c8c9337b784 Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Tue, 17 Oct 2023 14:05:50 +0800 Subject: [PATCH 199/402] Update .depend --- .depend | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.depend b/.depend index ba3052d481a..334ab8274b9 100644 --- a/.depend +++ b/.depend @@ -728,6 +728,7 @@ typing/includeclass.cmo : \ typing/types.cmi \ typing/printtyp.cmi \ typing/path.cmi \ + utils/misc.cmi \ typing/ctype.cmi \ parsing/builtin_attributes.cmi \ typing/includeclass.cmi @@ -735,6 +736,7 @@ typing/includeclass.cmx : \ typing/types.cmx \ typing/printtyp.cmx \ typing/path.cmx \ + utils/misc.cmx \ typing/ctype.cmx \ parsing/builtin_attributes.cmx \ typing/includeclass.cmi From 20a5cb189b8708bfae766a4dd831e90888b26ea2 Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Tue, 17 Oct 2023 14:26:11 +0800 Subject: [PATCH 200/402] Identify mismatch class parameters by ordinal in error messages --- .../tests/typing-misc/includeclass_errors.ml | 25 ++++++++++++++++++- typing/ctype.ml | 11 +++++--- typing/ctype.mli | 2 +- typing/includeclass.ml | 5 ++-- 4 files changed, 35 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/typing-misc/includeclass_errors.ml b/testsuite/tests/typing-misc/includeclass_errors.ml index b9dedce5da5..0e234874f51 100644 --- a/testsuite/tests/typing-misc/includeclass_errors.ml +++ b/testsuite/tests/typing-misc/includeclass_errors.ml @@ -180,7 +180,30 @@ Error: Signature mismatch: class c : float -> object end does not match class c : int -> object end - A parameter has type "float" but is expected to have type "int" + The 1st parameter has type "float" but is expected to have type "int" +|}] + +module M: sig + class c : int -> int -> object end +end = struct + class c (_ : int) (x : float) = object end +end +;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | class c (_ : int) (x : float) = object end +5 | end +Error: Signature mismatch: + Modules do not match: + sig class c : int -> float -> object end end + is not included in + sig class c : int -> int -> object end end + Class declarations do not match: + class c : int -> float -> object end + does not match + class c : int -> int -> object end + The 2nd parameter has type "float" but is expected to have type "int" |}] class virtual foo: foo_t = diff --git a/typing/ctype.ml b/typing/ctype.ml index c4fa0f4569f..7551eaef025 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -4317,7 +4317,7 @@ type class_match_failure = | 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 Env.t * moregen_error + | 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 @@ -4385,7 +4385,7 @@ let match_class_sig_shape ~strict sign1 sign2 = else err) sign1.csig_vars errors -let rec moregen_clty trace type_pairs env cty1 cty2 = +let rec moregen_clty ?arrow_index trace type_pairs env cty1 cty2 = try match cty1, cty2 with | Cty_constr (_, _, cty1), _ -> @@ -4393,12 +4393,15 @@ let rec moregen_clty trace type_pairs env cty1 cty2 = | _, Cty_constr (_, _, cty2) -> moregen_clty true type_pairs env cty1 cty2 | Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 -> + let arrow_index = Option.value ~default:1 arrow_index in begin try moregen true type_pairs env ty1 ty2 with Moregen_trace trace -> raise (Failure [ - CM_Parameter_mismatch (env, expand_to_moregen_error env trace)]) + CM_Parameter_mismatch + (arrow_index, env, expand_to_moregen_error env trace)]) end; - moregen_clty false type_pairs env cty1' cty2' + moregen_clty + ~arrow_index:(arrow_index + 1) false type_pairs env cty1' cty2' | Cty_signature sign1, Cty_signature sign2 -> Meths.iter (fun lab (_, _, ty) -> diff --git a/typing/ctype.mli b/typing/ctype.mli index 57fbd89652d..78d991facfc 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -322,7 +322,7 @@ type class_match_failure = | 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 Env.t * Errortrace.moregen_error + | 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 diff --git a/typing/includeclass.ml b/typing/includeclass.ml index d7135da3492..39f00f9cf54 100644 --- a/typing/includeclass.ml +++ b/typing/includeclass.ml @@ -70,10 +70,11 @@ let include_err mode ppf = Printtyp.class_type cty1 "is not matched by the class type" Printtyp.class_type cty2) - | CM_Parameter_mismatch (env, err) -> + | CM_Parameter_mismatch (n, env, err) -> Printtyp.report_moregen_error ppf mode env err (function ppf -> - fprintf ppf "A parameter has type") + fprintf ppf "The %d%s parameter has type" + n (Misc.ordinal_suffix n)) (function ppf -> fprintf ppf "but is expected to have type") | CM_Val_type_mismatch (lab, env, err) -> From adba3715cbabbb866b09d98abc9e38604192a518 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 17 Oct 2023 09:39:11 +0100 Subject: [PATCH 201/402] Fix up test according to review --- .../tests/syntactic-arity/comparative_alloc.ml | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/syntactic-arity/comparative_alloc.ml b/testsuite/tests/syntactic-arity/comparative_alloc.ml index d2f526c9e4d..5f611787fd1 100644 --- a/testsuite/tests/syntactic-arity/comparative_alloc.ml +++ b/testsuite/tests/syntactic-arity/comparative_alloc.ml @@ -11,6 +11,15 @@ of arguments appearing directly following [fun]). *) +(* This function will need to change if the runtime representation of closures + changes. Currently, the arity is the first 8 bits of the second field of + a closure. +*) +let extract_arity_from_closure (closure : Obj.t) : int = + assert (Obj.closure_tag = Obj.tag closure); + let clos_info = Obj.raw_field (Obj.repr closure) 1 in + Nativeint.(to_int (shift_right clos_info (Sys.word_size - 8))) + type (_, _) raw_arity = | One : (int -> 'ret, 'ret) raw_arity | Succ : ('f, 'ret) raw_arity -> (int -> 'f, 'ret) raw_arity @@ -43,10 +52,7 @@ let arity_description (type a) (arity : a arity) = is subject to change. *) let runtime_arity (f : 'a -> 'b) : ('a -> 'b) arity = - let clos_info = Obj.raw_field (Obj.repr f) 1 in - let raw_arity = - Nativeint.(to_int (shift_right clos_info (Sys.word_size - 8))) - in + let raw_arity = extract_arity_from_closure (Obj.repr f) in if raw_arity < 0 then Tupled else let rec build_arity n = if n = 1 then Packed_raw_arity One From 17db5ecfc238a5daf625b1cc482998e6c0bde5ed Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 17 Oct 2023 09:40:21 +0100 Subject: [PATCH 202/402] Rename no-longer-alloc-related test --- .../{comparative_alloc.ml => measure_runtime_arity.ml} | 0 ...omparative_alloc.reference => measure_runtime_arity.reference} | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename testsuite/tests/syntactic-arity/{comparative_alloc.ml => measure_runtime_arity.ml} (100%) rename testsuite/tests/syntactic-arity/{comparative_alloc.reference => measure_runtime_arity.reference} (100%) diff --git a/testsuite/tests/syntactic-arity/comparative_alloc.ml b/testsuite/tests/syntactic-arity/measure_runtime_arity.ml similarity index 100% rename from testsuite/tests/syntactic-arity/comparative_alloc.ml rename to testsuite/tests/syntactic-arity/measure_runtime_arity.ml diff --git a/testsuite/tests/syntactic-arity/comparative_alloc.reference b/testsuite/tests/syntactic-arity/measure_runtime_arity.reference similarity index 100% rename from testsuite/tests/syntactic-arity/comparative_alloc.reference rename to testsuite/tests/syntactic-arity/measure_runtime_arity.reference From 3c4f2a69bf8e1c8acb7ba2f5a37f64aef3bc9f20 Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Tue, 17 Oct 2023 14:27:28 +0800 Subject: [PATCH 203/402] better treatment of arrow_index --- Changes | 7 ++++--- typing/ctype.ml | 16 ++++++++++------ 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/Changes b/Changes index 5d62bfbce35..3c2f4e7e166 100644 --- a/Changes +++ b/Changes @@ -291,9 +291,10 @@ Working version - #12622: Give hints about existential types appearing in error messages (Leo White, review by Gabriel Scherer and Florian Angeletti) -- #?????: When a class type parameter does not match, identify which type - parameter in the error message, instead of saying "A type parameter". - (Stefan Muenzel, review by ?????) +- #12671: When a class type parameter or class parameter does not match, + identify which parameter in the error message, instead of saying + "A type parameter" or "A parameter". + (Stefan Muenzel, review by Gabriel Scherer) ### Internal/compiler-libs changes: diff --git a/typing/ctype.ml b/typing/ctype.ml index 7551eaef025..48a60d59a54 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -4385,23 +4385,24 @@ let match_class_sig_shape ~strict sign1 sign2 = else err) sign1.csig_vars errors -let rec moregen_clty ?arrow_index trace type_pairs env cty1 cty2 = +(* [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 true type_pairs env cty1 cty2 + moregen_clty ~arrow_index true type_pairs env cty1 cty2 | _, Cty_constr (_, _, cty2) -> - moregen_clty true type_pairs env cty1 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 = Option.value ~default:1 arrow_index in + 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:(arrow_index + 1) false type_pairs env cty1' cty2' + moregen_clty ~arrow_index false type_pairs env cty1' cty2' | Cty_signature sign1, Cty_signature sign2 -> Meths.iter (fun lab (_, _, ty) -> @@ -4445,6 +4446,9 @@ let rec moregen_clty ?arrow_index trace type_pairs env cty1 cty2 = 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 From 3c014a569f1cb19d673d701256fb4d4b3e0dbcb3 Mon Sep 17 00:00:00 2001 From: Nick Barnes Date: Tue, 17 Oct 2023 13:58:33 +0100 Subject: [PATCH 204/402] Silence ocamldoc warning. --- utils/misc.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/misc.mli b/utils/misc.mli index a280fd5ce05..6deedc49349 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -132,7 +132,7 @@ module Stdlib : sig r1 is [List.map2 f l1 h1] and r2 is t2. *) val iteri2 : (int -> 'a -> 'b -> unit) -> 'a list -> 'b list -> unit - (** Same as {!iter2}, but the function is applied to the index of + (** 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 From f6cd6955a11ce026b6077d152021d3c5e0ef71b9 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 17 Oct 2023 14:28:41 +0100 Subject: [PATCH 205/402] Fix incorrect comment in tests --- testsuite/tests/syntactic-arity/measure_runtime_arity.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/syntactic-arity/measure_runtime_arity.ml b/testsuite/tests/syntactic-arity/measure_runtime_arity.ml index 5f611787fd1..a9203c7213b 100644 --- a/testsuite/tests/syntactic-arity/measure_runtime_arity.ml +++ b/testsuite/tests/syntactic-arity/measure_runtime_arity.ml @@ -85,7 +85,8 @@ let maybe_runtime_arity (type a) (x : a) : a arity option = (* The "nested arity" of a value is either: - the empty list, if the value isn't a function - x :: xs if the value is a function [f], where [x] is [f]'s arity, and - [xs] is the nested arity of the result of applying [f] to a value. + [xs] is the nested arity of the result of applying [f] to [x] many + values. "nested arity" isn't well-defined for a function that, say, returns a 2-ary function for some inputs and a 3-ary for others. None of the functions in From f40b31e1de99542cc11637e02a5279142415b25a Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 17 Oct 2023 14:46:54 +0100 Subject: [PATCH 206/402] Simplify opam pin command in HACKING.adoc Compiler's ocaml-variants.opam always includes the VERSION number, so there's no need to edit it further. --- HACKING.adoc | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/HACKING.adoc b/HACKING.adoc index e8bfdc47788..d054da28020 100644 --- a/HACKING.adoc +++ b/HACKING.adoc @@ -252,8 +252,7 @@ work locally) by pinning: ---- opam switch create my-switch-name --empty -# Replace $VERSION by the trunk version -opam pin add ocaml-variants.$VERSION+branch git+https://$REPO#branch +opam pin add ocaml-variants git+https://$REPO#branch ---- ==== Incremental builds with `opam` From 4042ca3b57fd513457162d9d2ac5dafd212514a3 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Tue, 17 Oct 2023 16:21:07 +0200 Subject: [PATCH 207/402] Re-enable ThreadSanitizer in the Inria CI (#12644) * Building the compiler with ThreadSanitizer and running the testsuite caused too many reports in OCaml 5 and was disabled (see #11040). Since then, the work on TSan support for OCaml programs has led to fix a number of those data races and temporarily silence the ones that are waiting to be investigated (see #11040 again). As a result, running the testsuite with `--enable-tsan` is now a cheap and effective way of detecting new data races that may be introduced in the runtime. A second good reason to restore the TSan CI is that it will detect early if a recent change has accidentally broken TSan instrumentation (as has happened before as an accidental consequence of removing a symbol https://github.com/ocaml/ocaml/pull/12383#pullrequestreview-1593390354), or other issues (e.g. a new test revealed a TSan limitation with signals https://github.com/ocaml/ocaml/pull/12561#issuecomment-1729862795). Adding this test to the Github Actions CI arguably lengthens the runs (a GHA run on amd64 Linux with TSan takes about 50 minutes). This PR therefore suggests the compromise of enabling it on the Inria CI which is run on every merge. * Disable tests parallel/catch_break with tsan * CI sanitizers: Use clang 14 clang 13 thread sanitizer produces different, less precise traces. Also, clang 14 is the default version in Ubuntu 22.04 LTS. --------- Co-authored-by: Xavier Leroy --- testsuite/tests/parallel/catch_break.ml | 1 + tools/ci/inria/sanitizers/script | 50 ++++++++++--------------- 2 files changed, 21 insertions(+), 30 deletions(-) diff --git a/testsuite/tests/parallel/catch_break.ml b/testsuite/tests/parallel/catch_break.ml index 250fe54e9f3..4c57c90fe55 100644 --- a/testsuite/tests/parallel/catch_break.ml +++ b/testsuite/tests/parallel/catch_break.ml @@ -2,6 +2,7 @@ hassysthreads; include systhreads; not-windows; +no-tsan; { bytecode; }{ diff --git a/tools/ci/inria/sanitizers/script b/tools/ci/inria/sanitizers/script index 8d849579d90..9c69f92fa50 100755 --- a/tools/ci/inria/sanitizers/script +++ b/tools/ci/inria/sanitizers/script @@ -48,18 +48,18 @@ else fi # A tool that makes error backtraces nicer -# Need to pick the one that matches clang-13 and is named "llvm-symbolizer" -# (/usr/bin/llvm-symbolizer-13 doesn't work, that would be too easy) -export ASAN_SYMBOLIZER_PATH=/usr/lib/llvm-13/bin/llvm-symbolizer +# Need to pick the one that matches clang-14 and is named "llvm-symbolizer" +# (/usr/bin/llvm-symbolizer-14 doesn't work, that would be too easy) +export ASAN_SYMBOLIZER_PATH=/usr/lib/llvm-14/bin/llvm-symbolizer export TSAN_SYMBOLIZER_PATH="$ASAN_SYMBOLIZER_PATH" ######################################################################### -echo "======== clang 13, address sanitizer, UB sanitizer ==========" +echo "======== clang 14, address sanitizer, UB sanitizer ==========" git clean -q -f -d -x -# # Use clang 13 +# # Use clang 14 # These are the undefined behaviors we want to check # Others occur on purpose e.g. signed arithmetic overflow @@ -82,7 +82,7 @@ sanitizers="-fsanitize=address -fsanitize-trap=$ubsan" # Don't optimize too much to get better backtraces of errors ./configure \ - CC=clang-13 \ + CC=clang-14 \ CFLAGS="-O1 -fno-omit-frame-pointer $sanitizers" \ --disable-stdlib-manpages --enable-dependency-generation @@ -110,34 +110,24 @@ ASAN_OPTIONS="detect_leaks=0,use_sigaltstack=0" $run_testsuite ######################################################################### -# Thread sanitizer is not working in OCaml 5: too many alarms that are -# probably benign races in the GC (#11040). Turn it off. +# Run the testsuite with ThreadSanitizer support (--enable-tsan) enabled. +# Initially intended to detect data races in OCaml programs and C stubs, it has +# proved effective at also detecting races in the runtime (see #11040). -# echo "======== clang 13, thread sanitizer ==========" +echo "======== clang 14, thread sanitizer ==========" -# git clean -q -f -d -x +git clean -q -f -d -x -# # Select thread sanitizer -# # Don't optimize too much to get better backtraces of errors +./configure \ + CC=clang-14 \ + --enable-tsan \ + --disable-stdlib-manpages --enable-dependency-generation -# ./configure \ -# CC=clang-13 \ -# CFLAGS="-O1 -fno-omit-frame-pointer -fsanitize=thread" \ -# --disable-stdlib-manpages --enable-dependency-generation - -# # Build the system -# TSAN_OPTIONS="detect_deadlocks=0" make $jobs - -# # ThreadSanitizer reports errors for the error case of unlocking an -# # error-checking mutex. -# # Exclude the corresponding test -# export OCAMLTEST_SKIP_TESTS="$OCAMLTEST_SKIP_TESTS \ -# tests/lib-threads/mutex_errors.ml" - -# # Run the testsuite. -# # ThreadSanitizer complains about fork() in threaded programs, -# # we ask it to just continue in this case. -# TSAN_OPTIONS="detect_deadlocks=0,die_after_fork=0" $run_testsuite +# Build the system +make $jobs + +# Run the testsuite. +TSAN_OPTIONS="" $run_testsuite ######################################################################### From 495a99fb8451e9985a0e88f805e3cac814ac2132 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 19 Oct 2023 11:49:05 +0200 Subject: [PATCH 208/402] Introduce the framework to build OCaml libraries --- Makefile.common | 122 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 107 insertions(+), 15 deletions(-) diff --git a/Makefile.common b/Makefile.common index 760318e8301..e753fa8fa3c 100644 --- a/Makefile.common +++ b/Makefile.common @@ -231,7 +231,14 @@ if_file_exists = ( test ! -f $(1) || $(2) && rm -f $(1) ) MERGEMANIFESTEXE = $(call if_file_exists, $(1).manifest, \ mt -nologo -outputresource:$(1) -manifest $(1).manifest) -# Macros and rules to compile OCaml programs +# Macros and rules to compile OCaml programs and libraries + +# The following variable is used to accumulate a list of all the CMX +# files that get built. Is is then used in the root Makefile to express +# the dependency on all these files on the native compiler, so that +# they get rebuilt if the native compiler is updated + +ALL_CMX_FILES = # We use secondary expansion here so that variables like # foo_LIBRARIES and foo_SOURCES can be defined after the calls @@ -240,27 +247,17 @@ MERGEMANIFESTEXE = $(call if_file_exists, $(1).manifest, \ .SECONDEXPANSION: -# Each program foo is characterised by the foo_LIBRARIES and foo_SOURCES -# variables. The following macros provide the infrastructure to build foo -# from the object files whose names are derived from these two -# varialbes. In particular, the following macros define several -# variables whose names are prefixed with foo_ to compute the -# different lists of files used to build foo. - -# The first macro, _OCAML_PROGRAM_BASE, is a private macro (hence the _ at the -# beginning of its name) which defines foo_ variables common to both -# bytecode and native programs. The next two macros, OCAML_BYTECODE_PROGRAM -# and OCAML_NATIVE_PROGRAM are used to define programs that are provided -# only in bytecode or native form, respectively. Programs provided -# in both forms should use OCAML_PROGRAM. +# Definitions that are common to both programs and libraries -define _OCAML_PROGRAM_BASE +define _OCAML_COMMON_BASE $(basename $(notdir $(1)))_C_FILES = \ $$(filter %.c, $$($(basename $(notdir $(1)))_SOURCES)) $(basename $(notdir $(1)))_MLI_FILES = \ $$(filter %.mli, \ $$(subst .mly,.mli,\ $$($(basename $(notdir $(1)))_SOURCES))) +$(basename $(notdir $(1)))_CMI_FILES = \ + $$(subst .mli,.cmi,$$($(basename $(notdir $(1)))_MLI_FILES)) $(basename $(notdir $(1)))_ML_FILES = \ $$(filter %.ml, \ $$(subst .ml.in,.ml,$$(subst .mll,.ml,$$(subst .mly,.ml,\ @@ -280,6 +277,26 @@ beforedepend:: $$$$($(basename $(notdir $(1)))_SECONDARY_FILES) $(basename $(notdir $(1)))_GENERATED_FILES = \ $$($(basename $(notdir $(1)))_SECONDARY_FILES) \ $$(patsubst %.mly,%.output, $$($(basename $(notdir $(1)))_MLY_FILES)) +endef # _OCAML_COMMON_BASE + +# Macros to build OCaml programs + +# Each program foo is characterised by the foo_LIBRARIES and foo_SOURCES +# variables. The following macros provide the infrastructure to build foo +# from the object files whose names are derived from these two +# varialbes. In particular, the following macros define several +# variables whose names are prefixed with foo_ to compute the +# different lists of files used to build foo. + +# The first macro, _OCAML_PROGRAM_BASE, is a private macro (hence the _ at the +# beginning of its name) which defines foo_ variables common to both +# bytecode and native programs. The next two macros, OCAML_BYTECODE_PROGRAM +# and OCAML_NATIVE_PROGRAM are used to define programs that are provided +# only in bytecode or native form, respectively. Programs provided +# in both forms should use OCAML_PROGRAM. + +define _OCAML_PROGRAM_BASE +$(eval $(call _OCAML_COMMON_BASE,$(1))) endef # _OCAML_PROGRAM_BASE LINK_BYTECODE_PROGRAM =\ @@ -323,6 +340,7 @@ $(basename $(notdir $(1)))_NO_FILES = \ $$(patsubst %.c,%.n.$(O), $$($(basename $(notdir $(1)))_C_FILES)) $(basename $(notdir $(1)))_CMX_FILES = \ $$(patsubst %.ml,%.cmx, $$($(basename $(notdir $(1)))_ML_FILES)) +ALL_CMX_FILES += $$($(basename $(notdir $(1)))_CMX_FILES) $(basename $(notdir $(1)))_NCOBJS = \ $$($(basename $(notdir $(1)))_CMXA_FILES) \ $$($(basename $(notdir $(1)))_NO_FILES) \ @@ -343,6 +361,80 @@ $(eval $(call _OCAML_BYTECODE_PROGRAM,$(1))) $(eval $(call _OCAML_NATIVE_PROGRAM,$(1).opt)) endef # OCAML_PROGRAM +# Macros for OCaml libraries, similar to those for OCaml programs + +define _OCAML_LIBRARY_BASE +$(eval $(call _OCAML_COMMON_BASE,$(1))) +endef # _OCAML_LIBRARY_BASE + +LINK_BYTECODE_LIBRARY =\ + $(CAMLC) $(OC_COMMON_LINKFLAGS) $(OC_BYTECODE_LINKFLAGS) + +# The _OCAML_BYTECODE_LIBRARY macro defines a bytecode library but assuming +# that _OCAML_LIBRARY_BASE has already been called. Its public counterpart +# does not rely on this assumption and rather does call _OCAML_LIBRARY_BASE +# itself. + +define _OCAML_BYTECODE_LIBRARY +$(basename $(notdir $(1)))_BYTE_CMI_FILES = \ + $$(foreach F,$$($(basename $(notdir $(1)))_CMI_FILES),\ + $$(if $$(findstring /native/,$$(F)),,$$(F))) +$(basename $(notdir $(1)))_BO_FILES = \ + $$(patsubst %.c,%.b.$(O), $$($(basename $(notdir $(1)))_C_FILES)) +$(basename $(notdir $(1)))_CMO_FILES = \ + $$(patsubst %.ml,%.cmo, \ + $$(foreach F,$$($(basename $(notdir $(1)))_ML_FILES),\ + $$(if $$(findstring /native/,$$(F)),,$$(F)))) +$(basename $(notdir $(1)))_BCOBJS = \ + $$($(basename $(notdir $(1)))_BO_FILES) \ + $$($(basename $(notdir $(1)))_CMO_FILES) +$(1).cma: \ + $$$$($(basename $(notdir $(1)))_BYTE_CMI_FILES) \ + $$$$($(basename $(notdir $(1)))_BCOBJS) + $$(V_LINKC)$$(LINK_BYTECODE_LIBRARY) -a -o $$@ \ + $$($(basename $(notdir $(1)))_BCOBJS) +endef # _OCAML_BYTECODE_LIBRARY + +define OCAML_BYTECODE_LIBRARY +$(eval $(call _OCAML_LIBRARY_BASE,$(1))) +$(eval $(call _OCAML_BYTECODE_LIBRARY,$(1))) +endef # OCAML_BYTECODE_LIBRARY + +LINK_NATIVE_LIBRARY =\ + $(CAMLOPT) $(OC_COMMON_LINKFLAGS) $(OC_NATIVE_LINKFLAGS) + +define _OCAML_NATIVE_LIBRARY +$(basename $(notdir $(1)))_NATIVE_CMI_FILES = \ + $$(foreach F,$$($(basename $(notdir $(1)))_CMI_FILES),\ + $$(if $$(findstring /byte/,$$(F)),,$$(F))) +$(basename $(notdir $(1)))_NO_FILES = \ + $$(patsubst %.c,%.n.$(O), $$($(basename $(notdir $(1)))_C_FILES)) +$(basename $(notdir $(1)))_CMX_FILES = \ + $$(patsubst %.ml,%.cmx, \ + $$(foreach F,$$($(basename $(notdir $(1)))_ML_FILES),\ + $$(if $$(findstring /byte/,$$(F)),,$$(F)))) +ALL_CMX_FILES += $$($(basename $(notdir $(1)))_CMX_FILES) +$(basename $(notdir $(1)))_NCOBJS = \ + $$($(basename $(notdir $(1)))_NO_FILES) \ + $$($(basename $(notdir $(1)))_CMX_FILES) +$(1).cmxa: \ + $$$$($(basename $(notdir $(1)))_NATIVE_CMI_FILES) \ + $$$$($(basename $(notdir $(1)))_NCOBJS) + $$(V_LINKOPT)$$(LINK_NATIVE_LIBRARY) -a -o $$@ \ + $$($(basename $(notdir $(1)))_NCOBJS) +endef # _OCAML_NATIVE_LIBRARY + +define OCAML_NATIVE_LIBRARY +$(eval $(call _OCAML_LIBRARY_BASE,$(1))) +$(eval $(call _OCAML_NATIVE_LIBRARY,$(1))) +endef # OCAML_NATIVE_LIBRARY + +define OCAML_LIBRARY +$(eval $(call _OCAML_LIBRARY_BASE,$(1))) +$(eval $(call _OCAML_BYTECODE_LIBRARY,$(1))) +$(eval $(call _OCAML_NATIVE_LIBRARY,$(1))) +endef # OCAML_LIBRARY + # Installing a bytecode executable, with debug information removed define INSTALL_STRIPPED_BYTE_PROG $(OCAMLRUN) $(ROOTDIR)/tools/stripdebug $(1) $(1).tmp \ From e1c292874e65d53e85f28ef2d718e168f4350ac9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 19 Oct 2023 11:45:34 +0200 Subject: [PATCH 209/402] Use the new framework to build compilerlibs --- Makefile | 48 ++ compilerlibs/Makefile.compilerlibs | 712 +++++++++++++---------------- 2 files changed, 375 insertions(+), 385 deletions(-) diff --git a/Makefile b/Makefile index 962d62f33a8..bd1f111b2ff 100644 --- a/Makefile +++ b/Makefile @@ -164,6 +164,46 @@ OCAML_NATIVE_PROGRAMS = ocamlnat tools/lintapidiff.opt $(foreach PROGRAM, $(OCAML_NATIVE_PROGRAMS),\ $(eval $(call OCAML_NATIVE_PROGRAM,$(PROGRAM)))) +# OCaml libraries that are compiled in both bytecode and native code + +# List of compilerlibs + +COMPILERLIBS = $(addprefix compilerlibs/, \ + ocamlbytecomp \ + ocamlcommon \ + ocamlmiddleend \ + ocamloptcomp \ + ocamltoplevel) + +# Since the compiler libraries are necessarily compiled with boot/ocamlc, +# make sure they *always are*, even when rebuilding a program compiled +# with ./ocamlc (e.g. ocamltex) + +$(COMPILERLIBS:=.cma): \ + CAMLC = $(BOOT_OCAMLC) $(BOOT_STDLIBFLAGS) -use-prims runtime/primitives + +# FIXME: how about making another target depend on $(ALL_CONFIG_CMO)? +compilerlibs/ocamlcommon.cma: $(ALL_CONFIG_CMO) + +OCAML_LIBRARIES = $(COMPILERLIBS) + +$(foreach LIBRARY, $(OCAML_LIBRARIES),\ + $(eval $(call OCAML_LIBRARY,$(LIBRARY)))) + +# OCaml libraries that are compiled only in bytecode + +OCAML_BYTECODE_LIBRARIES = + +$(foreach LIBRARY, $(OCAML_BYTECODE_LIBRARIES),\ + $(eval $(call OCAML_BYTECODE_LIBRARY,$(LIBRARY)))) + +# OCaml libraries that are compiled only in native code + +OCAML_NATIVE_LIBRARIES = + +$(foreach LIBRARY, $(OCAML_NATIVE_LIBRARIES),\ + $(eval $(call OCAML_NATIVE_LIBRARY,$(LIBRARY)))) + USE_RUNTIME_PRIMS = -use-prims ../runtime/primitives USE_STDLIB = -nostdlib -I ../stdlib @@ -2150,3 +2190,11 @@ config.status: @echo " make install" @echo "should work." @false + +# We need to express that all the CMX files depend on the native compiler, +# so that they get invalidated and rebuilt when the compiler is updated +# This dependency must appear after all the definitions of the +# _SOURCES variable so that GNU make's secondary expansion mechanism works +# This is why this dependency is kept at the very end of this file + +$(ALL_CMX_FILES): ocamlopt$(EXE) diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs index c31802a5da6..437d2621c7f 100644 --- a/compilerlibs/Makefile.compilerlibs +++ b/compilerlibs/Makefile.compilerlibs @@ -18,377 +18,346 @@ # This file is meant to be included from the root Makefile, not to be # executed directly (this is why it is not simply named Makefile). -# For each group of compilation units, we have a variable GROUP with -# only .cmo files, and a separate variable GROUP_CMI for .cmi files -# corresponding to the .mli-only modules only. These .cmi are not -# linked in the archive, but they are marked as dependencies to ensure -# that they are consistent with the interface digests in the archives. - -UTILS = \ - utils/config.cmo \ - utils/build_path_prefix_map.cmo \ - utils/misc.cmo \ - utils/identifiable.cmo \ - utils/numbers.cmo \ - utils/arg_helper.cmo \ - utils/local_store.cmo \ - utils/load_path.cmo \ - utils/clflags.cmo \ - utils/profile.cmo \ - utils/terminfo.cmo \ - utils/ccomp.cmo \ - utils/warnings.cmo \ - utils/consistbl.cmo \ - utils/strongly_connected_components.cmo \ - utils/targetint.cmo \ - utils/int_replace_polymorphic_compare.cmo \ - utils/domainstate.cmo \ - utils/binutils.cmo \ - utils/lazy_backtrack.cmo \ - utils/diffing.cmo \ - utils/diffing_with_keys.cmo -UTILS_CMI = - -PARSING = \ - parsing/location.cmo \ - parsing/unit_info.cmo \ - parsing/longident.cmo \ - parsing/docstrings.cmo \ - parsing/syntaxerr.cmo \ - parsing/ast_helper.cmo \ - parsing/camlinternalMenhirLib.cmo \ - parsing/parser.cmo \ - parsing/lexer.cmo \ - parsing/pprintast.cmo \ - parsing/parse.cmo \ - parsing/printast.cmo \ - parsing/ast_mapper.cmo \ - parsing/ast_iterator.cmo \ - parsing/attr_helper.cmo \ - parsing/builtin_attributes.cmo \ - parsing/ast_invariants.cmo \ - parsing/depend.cmo -PARSING_CMI = \ - parsing/asttypes.cmi \ - parsing/parsetree.cmi - -TYPING = \ - typing/ident.cmo \ - typing/path.cmo \ - typing/primitive.cmo \ - typing/type_immediacy.cmo \ - typing/shape.cmo \ - typing/types.cmo \ - typing/btype.cmo \ - typing/oprint.cmo \ - typing/subst.cmo \ - typing/predef.cmo \ - typing/datarepr.cmo \ - file_formats/cmi_format.cmo \ - typing/persistent_env.cmo \ - typing/env.cmo \ - typing/errortrace.cmo \ - typing/typedtree.cmo \ - typing/signature_group.cmo \ - typing/printtyped.cmo \ - typing/ctype.cmo \ - typing/printtyp.cmo \ - typing/includeclass.cmo \ - typing/mtype.cmo \ - typing/envaux.cmo \ - typing/includecore.cmo \ - typing/tast_iterator.cmo \ - typing/tast_mapper.cmo \ - typing/stypes.cmo \ - file_formats/cmt_format.cmo \ - typing/cmt2annot.cmo \ - typing/untypeast.cmo \ - typing/includemod.cmo \ - typing/includemod_errorprinter.cmo \ - typing/typetexp.cmo \ - typing/printpat.cmo \ - typing/patterns.cmo \ - typing/parmatch.cmo \ - typing/typedecl_properties.cmo \ - typing/typedecl_variance.cmo \ - typing/typedecl_unboxed.cmo \ - typing/typedecl_immediacy.cmo \ - typing/typedecl_separability.cmo \ - typing/typeopt.cmo \ - typing/typedecl.cmo \ - typing/rec_check.cmo \ - typing/typecore.cmo \ - typing/typeclass.cmo \ - typing/typemod.cmo -TYPING_CMI = \ - typing/annot.cmi \ - typing/outcometree.cmi - -LAMBDA = \ - lambda/debuginfo.cmo \ - lambda/lambda.cmo \ - lambda/printlambda.cmo \ - lambda/switch.cmo \ - lambda/matching.cmo \ - lambda/translobj.cmo \ - lambda/translattribute.cmo \ - lambda/translprim.cmo \ - lambda/translcore.cmo \ - lambda/translclass.cmo \ - lambda/translmod.cmo \ - lambda/tmc.cmo \ - lambda/simplif.cmo \ - lambda/runtimedef.cmo -LAMBDA_CMI = - -COMP = \ - bytecomp/meta.cmo \ - bytecomp/opcodes.cmo \ - bytecomp/bytesections.cmo \ - bytecomp/dll.cmo \ - bytecomp/symtable.cmo \ - driver/pparse.cmo \ - driver/compenv.cmo \ - driver/main_args.cmo \ - driver/compmisc.cmo \ - driver/makedepend.cmo \ - driver/compile_common.cmo -COMP_CMI = \ - file_formats/cmo_format.cmi \ - file_formats/cmx_format.cmi \ - file_formats/cmxs_format.cmi +utils_SOURCES = $(addprefix utils/, \ + config.mli config.ml \ + build_path_prefix_map.mli build_path_prefix_map.ml \ + misc.mli misc.ml \ + identifiable.mli identifiable.ml \ + numbers.mli numbers.ml \ + arg_helper.mli arg_helper.ml \ + local_store.mli local_store.ml \ + load_path.mli load_path.ml \ + clflags.mli clflags.ml \ + profile.mli profile.ml \ + terminfo.mli terminfo.ml \ + ccomp.mli ccomp.ml \ + warnings.mli warnings.ml \ + consistbl.mli consistbl.ml \ + strongly_connected_components.mli strongly_connected_components.ml \ + targetint.mli targetint.ml \ + int_replace_polymorphic_compare.mli int_replace_polymorphic_compare.ml \ + domainstate.mli domainstate.ml \ + binutils.mli binutils.ml \ + lazy_backtrack.mli lazy_backtrack.ml \ + diffing.mli diffing.ml \ + diffing_with_keys.mli diffing_with_keys.ml) + +parsing_SOURCES = $(addprefix parsing/, \ + location.mli location.ml \ + unit_info.mli unit_info.ml \ + asttypes.mli \ + longident.mli longident.ml \ + parsetree.mli \ + docstrings.mli docstrings.ml \ + syntaxerr.mli syntaxerr.ml \ + ast_helper.mli ast_helper.ml \ + camlinternalMenhirLib.mli camlinternalMenhirLib.ml \ + parser.mly \ + lexer.mll \ + pprintast.mli pprintast.ml \ + parse.mli parse.ml \ + printast.mli printast.ml \ + ast_mapper.mli ast_mapper.ml \ + ast_iterator.mli ast_iterator.ml \ + attr_helper.mli attr_helper.ml \ + builtin_attributes.mli builtin_attributes.ml \ + ast_invariants.mli ast_invariants.ml \ + depend.mli depend.ml) + +typing_SOURCES = \ +$(addprefix typing/,\ + annot.mli \ + ident.mli ident.ml \ + path.mli path.ml \ + primitive.mli primitive.ml \ + type_immediacy.mli type_immediacy.ml \ + outcometree.mli \ + shape.mli shape.ml \ + types.mli types.ml \ + btype.mli btype.ml \ + oprint.mli oprint.ml \ + subst.mli subst.ml \ + predef.mli predef.ml \ + datarepr.mli datarepr.ml) \ + file_formats/cmi_format.mli file_formats/cmi_format.ml \ +$(addprefix typing/, \ + persistent_env.mli persistent_env.ml \ + env.mli env.ml \ + errortrace.mli errortrace.ml \ + typedtree.mli typedtree.ml \ + signature_group.mli signature_group.ml \ + printtyped.mli printtyped.ml \ + ctype.mli ctype.ml \ + printtyp.mli printtyp.ml \ + includeclass.mli includeclass.ml \ + mtype.mli mtype.ml \ + envaux.mli envaux.ml \ + includecore.mli includecore.ml \ + tast_iterator.mli tast_iterator.ml \ + tast_mapper.mli tast_mapper.ml \ + stypes.mli stypes.ml) \ + file_formats/cmt_format.mli file_formats/cmt_format.ml \ +$(addprefix typing/, \ + cmt2annot.mli cmt2annot.ml \ + untypeast.mli untypeast.ml \ + includemod.mli includemod.ml \ + includemod_errorprinter.mli includemod_errorprinter.ml \ + typetexp.mli typetexp.ml \ + printpat.mli printpat.ml \ + patterns.mli patterns.ml \ + parmatch.mli parmatch.ml \ + typedecl_properties.mli typedecl_properties.ml \ + typedecl_variance.mli typedecl_variance.ml \ + typedecl_unboxed.mli typedecl_unboxed.ml \ + typedecl_immediacy.mli typedecl_immediacy.ml \ + typedecl_separability.mli typedecl_separability.ml \ + typeopt.mli typeopt.ml \ + typedecl.mli typedecl.ml \ + rec_check.mli rec_check.ml \ + typecore.mli typecore.ml \ + typeclass.mli typeclass.ml \ + typemod.mli typemod.ml) + +lambda_SOURCES = $(addprefix lambda/, \ + debuginfo.mli debuginfo.ml \ + lambda.mli lambda.ml \ + printlambda.mli printlambda.ml \ + switch.mli switch.ml \ + matching.mli matching.ml \ + translobj.mli translobj.ml \ + translattribute.mli translattribute.ml \ + translprim.mli translprim.ml \ + translcore.mli translcore.ml \ + translclass.mli translclass.ml \ + translmod.mli translmod.ml \ + tmc.mli tmc.ml \ + simplif.mli simplif.ml \ + runtimedef.mli runtimedef.ml) + +comp_SOURCES = \ +$(addprefix file_formats/, \ + cmo_format.mli \ + cmx_format.mli \ + cmxs_format.mli) \ +$(addprefix bytecomp/, \ + meta.mli meta.ml \ + opcodes.mli opcodes.ml \ + bytesections.mli bytesections.ml \ + dll.mli dll.ml \ + symtable.mli symtable.ml) \ +$(addprefix driver/, \ + pparse.mli pparse.ml \ + compenv.mli compenv.ml \ + main_args.mli main_args.ml \ + compmisc.mli compmisc.ml \ + makedepend.mli makedepend.ml \ + compile_common.mli compile_common.ml) # All file format descriptions (including cmx{,s}) are in the # ocamlcommon library so that ocamlobjinfo can depend on them. -COMMON_CMI = $(UTILS_CMI) $(PARSING_CMI) $(TYPING_CMI) $(LAMBDA_CMI) $(COMP_CMI) - -COMMON = $(UTILS) $(PARSING) $(TYPING) $(LAMBDA) $(COMP) - -BYTECOMP = \ - bytecomp/instruct.cmo \ - bytecomp/bytegen.cmo \ - bytecomp/printinstr.cmo \ - bytecomp/emitcode.cmo \ - bytecomp/bytelink.cmo \ - bytecomp/bytelibrarian.cmo \ - bytecomp/bytepackager.cmo \ - driver/errors.cmo \ - driver/compile.cmo \ - driver/maindriver.cmo -BYTECOMP_CMI = - -INTEL_ASM = \ - asmcomp/x86_proc.cmo \ - asmcomp/x86_dsl.cmo \ - asmcomp/x86_gas.cmo \ - asmcomp/x86_masm.cmo -INTEL_ASM_CMI = \ - asmcomp/x86_ast.cmi - -ARCH_SPECIFIC_ASMCOMP = -ARCH_SPECIFIC_ASMCOMP_CMI = +ocamlcommon_SOURCES = \ + $(utils_SOURCES) $(parsing_SOURCES) $(typing_SOURCES) \ + $(lambda_SOURCES) $(comp_SOURCES) + +ocamlbytecomp_SOURCES = \ +$(addprefix bytecomp/, \ + instruct.mli instruct.ml \ + bytegen.mli bytegen.ml \ + printinstr.mli printinstr.ml \ + emitcode.mli emitcode.ml \ + bytelink.mli bytelink.ml \ + bytelibrarian.mli bytelibrarian.ml \ + bytepackager.mli bytepackager.ml) \ +$(addprefix driver/, \ + errors.mli errors.ml \ + compile.mli compile.ml \ + maindriver.mli maindriver.ml) + +intel_SOURCES = \ + x86_ast.mli \ + x86_proc.mli x86_proc.ml \ + x86_dsl.mli x86_dsl.ml \ + x86_gas.mli x86_gas.ml \ + x86_masm.mli x86_masm.ml + +arch_specific_SOURCES = ifeq ($(ARCH),i386) -ARCH_SPECIFIC_ASMCOMP = $(INTEL_ASM) -ARCH_SPECIFIC_ASMCOMP_CMI = $(INTEL_ASM_CMI) +arch_specific_SOURCES = $(intel_SOURCES) endif ifeq ($(ARCH),amd64) -ARCH_SPECIFIC_ASMCOMP = $(INTEL_ASM) -ARCH_SPECIFIC_ASMCOMP_CMI = $(INTEL_ASM_CMI) +arch_specific_SOURCES = $(intel_SOURCES) endif -ASMCOMP = \ - $(ARCH_SPECIFIC_ASMCOMP) \ - asmcomp/arch.cmo \ - asmcomp/cmm.cmo \ - asmcomp/printcmm.cmo \ - asmcomp/reg.cmo \ - asmcomp/mach.cmo \ - asmcomp/proc.cmo \ - asmcomp/strmatch.cmo \ - asmcomp/cmmgen_state.cmo \ - asmcomp/cmm_helpers.cmo \ - asmcomp/afl_instrument.cmo \ - asmcomp/thread_sanitizer.cmo \ - asmcomp/cmmgen.cmo \ - asmcomp/cmm_invariants.cmo \ - asmcomp/interval.cmo \ - asmcomp/printmach.cmo \ - asmcomp/dataflow.cmo \ - asmcomp/polling.cmo \ - asmcomp/selectgen.cmo \ - asmcomp/selection.cmo \ - asmcomp/comballoc.cmo \ - asmcomp/CSEgen.cmo \ - asmcomp/CSE.cmo \ - asmcomp/liveness.cmo \ - asmcomp/spill.cmo \ - asmcomp/split.cmo \ - asmcomp/interf.cmo \ - asmcomp/coloring.cmo \ - asmcomp/linscan.cmo \ - asmcomp/reloadgen.cmo \ - asmcomp/reload.cmo \ - asmcomp/deadcode.cmo \ - asmcomp/stackframegen.cmo \ - asmcomp/stackframe.cmo \ - asmcomp/linear.cmo \ - asmcomp/printlinear.cmo \ - asmcomp/linearize.cmo \ - file_formats/linear_format.cmo \ - asmcomp/schedgen.cmo \ - asmcomp/scheduling.cmo \ - asmcomp/branch_relaxation.cmo \ - asmcomp/emitaux.cmo \ - asmcomp/emit.cmo \ - asmcomp/asmgen.cmo \ - asmcomp/asmlink.cmo \ - asmcomp/asmlibrarian.cmo \ - asmcomp/asmpackager.cmo \ - driver/opterrors.cmo \ - driver/optcompile.cmo \ - driver/optmaindriver.cmo -ASMCOMP_CMI = $(ARCH_SPECIFIC_ASMCOMP_CMI) +asmcomp_SOURCES = \ +$(addprefix asmcomp/, \ + $(arch_specific_SOURCES) \ + arch.mli arch.ml \ + cmm.mli cmm.ml \ + printcmm.mli printcmm.ml \ + reg.mli reg.ml \ + mach.mli mach.ml \ + proc.mli proc.ml \ + strmatch.mli strmatch.ml \ + cmmgen_state.mli cmmgen_state.ml \ + cmm_helpers.mli cmm_helpers.ml \ + afl_instrument.mli afl_instrument.ml \ + thread_sanitizer.mli thread_sanitizer.ml \ + cmmgen.mli cmmgen.ml \ + cmm_invariants.mli cmm_invariants.ml \ + interval.mli interval.ml \ + printmach.mli printmach.ml \ + dataflow.mli dataflow.ml \ + polling.mli polling.ml \ + selectgen.mli selectgen.ml \ + selection.mli selection.ml \ + comballoc.mli comballoc.ml \ + CSEgen.mli CSEgen.ml \ + CSE.mli CSE.ml \ + liveness.mli liveness.ml \ + spill.mli spill.ml \ + split.mli split.ml \ + interf.mli interf.ml \ + coloring.mli coloring.ml \ + linscan.mli linscan.ml \ + reloadgen.mli reloadgen.ml \ + reload.mli reload.ml \ + deadcode.mli deadcode.ml \ + stackframegen.mli stackframegen.ml \ + stackframe.mli stackframe.ml \ + linear.mli linear.ml \ + printlinear.mli printlinear.ml \ + linearize.mli linearize.ml) \ + file_formats/linear_format.mli file_formats/linear_format.ml \ +$(addprefix asmcomp/, \ + schedgen.mli schedgen.ml \ + scheduling.mli scheduling.ml \ + branch_relaxation.mli branch_relaxation.ml \ + emitaux.mli emitaux.ml \ + emit.mli emit.ml \ + asmgen.mli asmgen.ml \ + asmlink.mli asmlink.ml \ + asmlibrarian.mli asmlibrarian.ml \ + asmpackager.mli asmpackager.ml) \ +$(addprefix driver/, \ + opterrors.mli opterrors.ml \ + optcompile.mli optcompile.ml \ + optmaindriver.mli optmaindriver.ml) # Files under middle_end/ are not to reference files under asmcomp/. # This ensures that the middle end can be linked (e.g. for objinfo) even when # the native code compiler is not present for some particular target. -MIDDLE_END_CLOSURE = \ - middle_end/closure/closure.cmo \ - middle_end/closure/closure_middle_end.cmo -MIDDLE_END_CLOSURE_CMI = +middle_end_closure_SOURCES = $(addprefix middle_end/closure/, \ + closure.mli closure.ml \ + closure_middle_end.mli closure_middle_end.ml) # Owing to dependencies through [Compilenv], which would be # difficult to remove, some of the lower parts of Flambda (anything that is # saved in a .cmx file) have to be included in the [MIDDLE_END] stanza, below. -MIDDLE_END_FLAMBDA = \ - middle_end/flambda/import_approx.cmo \ - middle_end/flambda/lift_code.cmo \ - middle_end/flambda/closure_conversion_aux.cmo \ - middle_end/flambda/closure_conversion.cmo \ - middle_end/flambda/initialize_symbol_to_let_symbol.cmo \ - middle_end/flambda/lift_let_to_initialize_symbol.cmo \ - middle_end/flambda/find_recursive_functions.cmo \ - middle_end/flambda/invariant_params.cmo \ - middle_end/flambda/inconstant_idents.cmo \ - middle_end/flambda/alias_analysis.cmo \ - middle_end/flambda/lift_constants.cmo \ - middle_end/flambda/share_constants.cmo \ - middle_end/flambda/simplify_common.cmo \ - middle_end/flambda/remove_unused_arguments.cmo \ - middle_end/flambda/remove_unused_closure_vars.cmo \ - middle_end/flambda/remove_unused_program_constructs.cmo \ - middle_end/flambda/simplify_boxed_integer_ops.cmo \ - middle_end/flambda/simplify_primitives.cmo \ - middle_end/flambda/inlining_stats_types.cmo \ - middle_end/flambda/inlining_stats.cmo \ - middle_end/flambda/inline_and_simplify_aux.cmo \ - middle_end/flambda/remove_free_vars_equal_to_args.cmo \ - middle_end/flambda/extract_projections.cmo \ - middle_end/flambda/augment_specialised_args.cmo \ - middle_end/flambda/unbox_free_vars_of_closures.cmo \ - middle_end/flambda/unbox_specialised_args.cmo \ - middle_end/flambda/unbox_closures.cmo \ - middle_end/flambda/inlining_transforms.cmo \ - middle_end/flambda/inlining_decision.cmo \ - middle_end/flambda/inline_and_simplify.cmo \ - middle_end/flambda/ref_to_variables.cmo \ - middle_end/flambda/flambda_invariants.cmo \ - middle_end/flambda/traverse_for_exported_symbols.cmo \ - middle_end/flambda/build_export_info.cmo \ - middle_end/flambda/closure_offsets.cmo \ - middle_end/flambda/un_anf.cmo \ - middle_end/flambda/flambda_to_clambda.cmo \ - middle_end/flambda/flambda_middle_end.cmo -MIDDLE_END_FLAMBDA_CMI = \ - middle_end/flambda/inlining_decision_intf.cmi \ - middle_end/flambda/simplify_boxed_integer_ops_intf.cmi - -MIDDLE_END = \ - middle_end/internal_variable_names.cmo \ - middle_end/linkage_name.cmo \ - middle_end/compilation_unit.cmo \ - middle_end/variable.cmo \ - middle_end/flambda/base_types/closure_element.cmo \ - middle_end/flambda/base_types/closure_id.cmo \ - middle_end/symbol.cmo \ - middle_end/backend_var.cmo \ - middle_end/clambda_primitives.cmo \ - middle_end/printclambda_primitives.cmo \ - middle_end/clambda.cmo \ - middle_end/printclambda.cmo \ - middle_end/semantics_of_primitives.cmo \ - middle_end/convert_primitives.cmo \ - middle_end/flambda/base_types/id_types.cmo \ - middle_end/flambda/base_types/export_id.cmo \ - middle_end/flambda/base_types/tag.cmo \ - middle_end/flambda/base_types/mutable_variable.cmo \ - middle_end/flambda/base_types/set_of_closures_id.cmo \ - middle_end/flambda/base_types/set_of_closures_origin.cmo \ - middle_end/flambda/base_types/closure_origin.cmo \ - middle_end/flambda/base_types/var_within_closure.cmo \ - middle_end/flambda/base_types/static_exception.cmo \ - middle_end/flambda/pass_wrapper.cmo \ - middle_end/flambda/allocated_const.cmo \ - middle_end/flambda/parameter.cmo \ - middle_end/flambda/projection.cmo \ - middle_end/flambda/flambda.cmo \ - middle_end/flambda/flambda_iterators.cmo \ - middle_end/flambda/flambda_utils.cmo \ - middle_end/flambda/freshening.cmo \ - middle_end/flambda/effect_analysis.cmo \ - middle_end/flambda/inlining_cost.cmo \ - middle_end/flambda/simple_value_approx.cmo \ - middle_end/flambda/export_info.cmo \ - middle_end/flambda/export_info_for_pack.cmo \ - middle_end/compilenv.cmo \ - $(MIDDLE_END_CLOSURE) \ - $(MIDDLE_END_FLAMBDA) -MIDDLE_END_CMI = \ - middle_end/backend_intf.cmi \ - $(MIDDLE_END_CLOSURE_CMI) \ - $(MIDDLE_END_FLAMBDA_CMI) - -OPTCOMP = $(MIDDLE_END) $(ASMCOMP) -OPTCOMP_CMI = $(MIDDLE_END_CMI) $(ASMCOMP_CMI) - -TOPLEVEL = \ - toplevel/genprintval.cmo \ - toplevel/topcommon.cmo \ - toplevel/byte/topeval.cmo \ - toplevel/byte/trace.cmo \ - toplevel/toploop.cmo \ - toplevel/topprinters.cmo \ - toplevel/topdirs.cmo \ - toplevel/byte/topmain.cmo -TOPLEVEL_CMI = \ - toplevel/topcommon.cmi \ - toplevel/byte/topeval.cmi \ - toplevel/byte/trace.cmi \ - toplevel/toploop.cmi \ - toplevel/topprinters.cmi \ - toplevel/topdirs.cmi \ - toplevel/byte/topmain.cmi - -OPTTOPLEVEL = \ - toplevel/genprintval.cmo \ - toplevel/topcommon.cmo \ - toplevel/native/tophooks.cmo \ - toplevel/native/topeval.cmo \ - toplevel/native/trace.cmo \ - toplevel/toploop.cmo \ - toplevel/topprinters.cmo \ - toplevel/topdirs.cmo \ - toplevel/native/topmain.cmo -OPTTOPLEVEL_CMI = \ - toplevel/topcommon.cmi \ - toplevel/native/tophooks.cmi \ - toplevel/native/topeval.cmi \ - toplevel/native/trace.cmi \ - toplevel/toploop.cmi \ - toplevel/topprinters.cmi \ - toplevel/topdirs.cmi \ - toplevel/native/topmain.cmi +middle_end_flambda_SOURCES = \ +$(addprefix middle_end/flambda/, \ + import_approx.mli import_approx.ml \ + lift_code.mli lift_code.ml \ + closure_conversion_aux.mli closure_conversion_aux.ml \ + closure_conversion.mli closure_conversion.ml \ + initialize_symbol_to_let_symbol.mli initialize_symbol_to_let_symbol.ml \ + lift_let_to_initialize_symbol.mli lift_let_to_initialize_symbol.ml \ + find_recursive_functions.mli find_recursive_functions.ml \ + invariant_params.mli invariant_params.ml \ + inconstant_idents.mli inconstant_idents.ml \ + alias_analysis.mli alias_analysis.ml \ + lift_constants.mli lift_constants.ml \ + share_constants.mli share_constants.ml \ + simplify_common.mli simplify_common.ml \ + remove_unused_arguments.mli remove_unused_arguments.ml \ + remove_unused_closure_vars.mli remove_unused_closure_vars.ml \ + remove_unused_program_constructs.mli remove_unused_program_constructs.ml \ + simplify_boxed_integer_ops.mli simplify_boxed_integer_ops.ml \ + simplify_primitives.mli simplify_primitives.ml \ + inlining_stats_types.mli inlining_stats_types.ml \ + inlining_stats.mli inlining_stats.ml \ + inline_and_simplify_aux.mli inline_and_simplify_aux.ml \ + inlining_decision_intf.mli \ + remove_free_vars_equal_to_args.mli remove_free_vars_equal_to_args.ml \ + extract_projections.mli extract_projections.ml \ + augment_specialised_args.mli augment_specialised_args.ml \ + unbox_free_vars_of_closures.mli unbox_free_vars_of_closures.ml \ + unbox_specialised_args.mli unbox_specialised_args.ml \ + unbox_closures.mli unbox_closures.ml \ + inlining_transforms.mli inlining_transforms.ml \ + inlining_decision.mli inlining_decision.ml \ + inline_and_simplify.mli inline_and_simplify.ml \ + ref_to_variables.mli ref_to_variables.ml \ + flambda_invariants.mli flambda_invariants.ml \ + traverse_for_exported_symbols.mli traverse_for_exported_symbols.ml \ + build_export_info.mli build_export_info.ml \ + closure_offsets.mli closure_offsets.ml \ + un_anf.mli un_anf.ml \ + flambda_to_clambda.mli flambda_to_clambda.ml \ + flambda_middle_end.mli flambda_middle_end.ml \ + simplify_boxed_integer_ops_intf.mli) + +ocamlmiddleend_SOURCES = \ +$(addprefix middle_end/, \ + internal_variable_names.mli internal_variable_names.ml \ + linkage_name.mli linkage_name.ml \ + compilation_unit.mli compilation_unit.ml \ + variable.mli variable.ml \ + $(addprefix flambda/base_types/, \ + closure_element.mli closure_element.ml \ + closure_id.mli closure_id.ml) \ + symbol.mli symbol.ml \ + backend_var.mli backend_var.ml \ + clambda_primitives.mli clambda_primitives.ml \ + printclambda_primitives.mli printclambda_primitives.ml \ + clambda.mli clambda.ml \ + printclambda.mli printclambda.ml \ + semantics_of_primitives.mli semantics_of_primitives.ml \ + convert_primitives.mli convert_primitives.ml \ + $(addprefix flambda/, \ + $(addprefix base_types/, \ + id_types.mli id_types.ml \ + export_id.mli export_id.ml \ + tag.mli tag.ml \ + mutable_variable.mli mutable_variable.ml \ + set_of_closures_id.mli set_of_closures_id.ml \ + set_of_closures_origin.mli set_of_closures_origin.ml \ + closure_origin.mli closure_origin.ml \ + var_within_closure.mli var_within_closure.ml \ + static_exception.mli static_exception.ml) \ + pass_wrapper.mli pass_wrapper.ml \ + allocated_const.mli allocated_const.ml \ + parameter.mli parameter.ml \ + projection.mli projection.ml \ + flambda.mli flambda.ml \ + flambda_iterators.mli flambda_iterators.ml \ + flambda_utils.mli flambda_utils.ml \ + freshening.mli freshening.ml \ + effect_analysis.mli effect_analysis.ml \ + inlining_cost.mli inlining_cost.ml \ + simple_value_approx.mli simple_value_approx.ml \ + export_info.mli export_info.ml \ + export_info_for_pack.mli export_info_for_pack.ml) \ + compilenv.mli compilenv.ml \ + backend_intf.mli) \ + $(middle_end_closure_SOURCES) \ + $(middle_end_flambda_SOURCES) + +ocamloptcomp_SOURCES = $(ocamlmiddleend_SOURCES) $(asmcomp_SOURCES) + +ocamltoplevel_SOURCES = $(addprefix toplevel/, \ + genprintval.mli genprintval.ml \ + topcommon.mli topcommon.ml \ + native/tophooks.mli native/tophooks.ml \ + byte/topeval.mli byte/topeval.ml \ + native/topeval.mli native/topeval.ml \ + byte/trace.mli byte/trace.ml \ + native/trace.mli native/trace.ml \ + toploop.mli toploop.ml \ + topprinters.mli topprinters.ml \ + topdirs.mli topdirs.ml \ + byte/topmain.mli byte/topmain.ml \ + native/topmain.mli native/topmain.ml) TOPLEVEL_SHARED_MLIS = topeval.mli trace.mli topmain.mli TOPLEVEL_SHARED_CMIS = $(TOPLEVEL_SHARED_MLIS:%.mli=%.cmi) @@ -410,9 +379,6 @@ partialclean:: cd toplevel/byte ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS) cd toplevel/native ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS) -$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(OPTCOMP:.cmo=.cmx): ocamlopt$(EXE) -$(OPTTOPLEVEL:.cmo=.cmx): ocamlopt$(EXE) - ALL_CONFIG_CMO = utils/config_main.cmo utils/config_boot.cmo utils/config_%.mli: utils/config.mli @@ -420,43 +386,25 @@ utils/config_%.mli: utils/config.mli beforedepend:: utils/config_main.mli utils/config_boot.mli -# Since the compiler libraries are necessarily compiled with boot/ocamlc, -# make sure they *always are*, even when rebuilding a program compiled -# with ./ocamlc (e.g. ocamltex) - -$(addprefix compilerlibs/,\ - ocamlcommon.cma ocamlbytecomp.cma ocamloptcomp.cma ocamlmiddleend.cma \ - ocamltoplevel.cma): \ - CAMLC = $(BOOT_OCAMLC) $(BOOT_STDLIBFLAGS) -use-prims runtime/primitives +$(addprefix compilerlibs/ocamlcommon., cma cmxa): \ + OC_OCAML_COMMON_LDFLAGS = += -linkall -compilerlibs/ocamlcommon.cma: $(COMMON_CMI) $(ALL_CONFIG_CMO) $(COMMON) - $(V_LINKC)$(CAMLC) -a -linkall -o $@ $(COMMON) partialclean:: rm -f compilerlibs/ocamlcommon.cma -compilerlibs/ocamlcommon.cmxa: $(COMMON_CMI) $(COMMON:.cmo=.cmx) - $(V_LINKOPT)$(CAMLOPT) -a -linkall -o $@ $(COMMON:.cmo=.cmx) partialclean:: rm -f compilerlibs/ocamlcommon.cmxa \ compilerlibs/ocamlcommon.a compilerlibs/ocamlcommon.lib -compilerlibs/ocamlbytecomp.cma: $(BYTECOMP_CMI) $(BYTECOMP) - $(V_LINKC)$(CAMLC) -a -o $@ $(BYTECOMP) partialclean:: rm -f compilerlibs/ocamlbytecomp.cma -compilerlibs/ocamlbytecomp.cmxa: $(BYTECOMP_CMI) $(BYTECOMP:.cmo=.cmx) - $(V_LINKOPT)$(CAMLOPT) -a $(OCAML_NATDYNLINKOPTS) -o $@ $(BYTECOMP:.cmo=.cmx) partialclean:: rm -f compilerlibs/ocamlbytecomp.cmxa \ compilerlibs/ocamlbytecomp.a compilerlibs/ocamlbytecomp.lib -compilerlibs/ocamlmiddleend.cma: $(MIDDLE_END_CMI) $(MIDDLE_END) - $(V_LINKC)$(CAMLC) -a -o $@ $(MIDDLE_END) -compilerlibs/ocamlmiddleend.cmxa: $(MIDDLE_END_CMI) $(MIDDLE_END:%.cmo=%.cmx) - $(V_LINKOPT)$(CAMLOPT) -a -o $@ $(MIDDLE_END:%.cmo=%.cmx) partialclean:: rm -f compilerlibs/ocamlmiddleend.cma \ compilerlibs/ocamlmiddleend.cmxa \ @@ -464,25 +412,19 @@ partialclean:: compilerlibs/ocamlmiddleend.lib -compilerlibs/ocamloptcomp.cma: $(OPTCOMP_CMI) $(OPTCOMP) - $(V_LINKC)$(CAMLC) -a -o $@ $(OPTCOMP) partialclean:: rm -f compilerlibs/ocamloptcomp.cma -compilerlibs/ocamloptcomp.cmxa: $(OPTCOMP_CMI) $(OPTCOMP:.cmo=.cmx) - $(V_LINKOPT)$(CAMLOPT) -a -o $@ $(OPTCOMP:.cmo=.cmx) partialclean:: rm -f compilerlibs/ocamloptcomp.cmxa \ compilerlibs/ocamloptcomp.a compilerlibs/ocamloptcomp.lib -compilerlibs/ocamltoplevel.cma: $(TOPLEVEL_CMI) $(TOPLEVEL) - $(V_LINKC)$(CAMLC) -a -o $@ -I toplevel/byte $(TOPLEVEL) +compilerlibs/ocamltoplevel.cma: VPATH += toplevel/byte partialclean:: rm -f compilerlibs/ocamltoplevel.cma -compilerlibs/ocamltoplevel.cmxa: $(OPTTOPLEVEL_CMI) $(OPTTOPLEVEL:.cmo=.cmx) - $(V_LINKOPT)$(CAMLOPT) -a -o $@ -I toplevel/native $(OPTTOPLEVEL:.cmo=.cmx) +compilerlibs/ocamltoplevel.cmxa: VPATH += toplevel/native partialclean:: rm -f compilerlibs/ocamltoplevel.cmxa \ compilerlibs/ocamltoplevel.a compilerlibs/ocamltoplevel.lib From 5a7f52d2af8abbc5d246d44dbf60b8eac2050b6d Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Tue, 19 Sep 2023 14:46:42 +0200 Subject: [PATCH 210/402] Move the computation of architecture-specific sources to configure --- Makefile.build_config.in | 3 +++ compilerlibs/Makefile.compilerlibs | 8 -------- configure | 9 +++++++++ configure.ac | 6 ++++++ 4 files changed, 18 insertions(+), 8 deletions(-) diff --git a/Makefile.build_config.in b/Makefile.build_config.in index ccfb09b4128..88c71e2d5f3 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -151,6 +151,9 @@ runtime_ASM_OBJECTS = $(addprefix runtime/,@runtime_asm_objects@) # Platform-dependent module for ocamlyacc ocamlyacc_WSTR_MODULE = @ocamlyacc_wstr_module@ +# Architecture-specific modules, if any +arch_specific_SOURCES = @arch_specific_SOURCES@ + # ThreadSanitizer support enabled TSAN=@tsan@ # Contains TSan-specific runtime files, or nothing if TSan support is diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs index 437d2621c7f..82fbd4e12cb 100644 --- a/compilerlibs/Makefile.compilerlibs +++ b/compilerlibs/Makefile.compilerlibs @@ -180,14 +180,6 @@ intel_SOURCES = \ x86_gas.mli x86_gas.ml \ x86_masm.mli x86_masm.ml -arch_specific_SOURCES = -ifeq ($(ARCH),i386) -arch_specific_SOURCES = $(intel_SOURCES) -endif -ifeq ($(ARCH),amd64) -arch_specific_SOURCES = $(intel_SOURCES) -endif - asmcomp_SOURCES = \ $(addprefix asmcomp/, \ $(arch_specific_SOURCES) \ diff --git a/configure b/configure index 68c11e094d4..43a980f9d2f 100755 --- a/configure +++ b/configure @@ -883,6 +883,7 @@ native_cflags system model arch64 +arch_specific_SOURCES arch SO runtime_asm_objects @@ -3373,6 +3374,7 @@ OCAML_VERSION_SHORT=5.2 + # TODO: rename this variable @@ -15576,6 +15578,13 @@ fi ;; #( ;; esac +case $arch in #( + amd64) : + arch_specific_SOURCES='$(intel_SOURCES)' ;; #( + *) : + arch_specific_SOURCES='' ;; +esac + native_cflags='' native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}" diff --git a/configure.ac b/configure.ac index 7eb3ae9ad81..d4e4005ce0b 100644 --- a/configure.ac +++ b/configure.ac @@ -117,6 +117,7 @@ AC_SUBST([S]) AC_SUBST([runtime_asm_objects]) AC_SUBST([SO]) AC_SUBST([arch]) +AC_SUBST([arch_specific_SOURCES]) AC_SUBST([arch64]) AC_SUBST([model]) AC_SUBST([system]) @@ -1339,6 +1340,11 @@ AS_CASE([$host], [has_native_backend=yes; arch=riscv; model=riscv64; system=linux] ) +AS_CASE([$arch], + [amd64], + [arch_specific_SOURCES='$(intel_SOURCES)'], + [arch_specific_SOURCES='']) + native_cflags='' native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}" From da035ffaf2e8ce843ba2c2c45d9e87760a73d253 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Thu, 19 Oct 2023 11:27:43 +0200 Subject: [PATCH 211/402] Merge compilerlibs/Makefile.compilerlibs into the root Makefile --- Changes | 5 +- Makefile | 401 ++++++++++++++++++++++++++- compilerlibs/Makefile.compilerlibs | 422 ----------------------------- 3 files changed, 401 insertions(+), 427 deletions(-) delete mode 100644 compilerlibs/Makefile.compilerlibs diff --git a/Changes b/Changes index 4f0096d660f..c8cd1faf34c 100644 --- a/Changes +++ b/Changes @@ -382,8 +382,9 @@ Working version ### Build system: -- #12198, #12321: continue the merge of the sub-makefiles into the root Makefile - started with #11243, #11248, #11268, #11420 and #11675. +- #12198, #12321, #12586: continue the merge of the sub-makefiles + into the root Makefile started with #11243, #11248, #11268, #11420 + and #11675. (Sébastien Hinderer, review by David Allsopp and Florian Angeletti) - #12569, #12570: remove 'otherlibraries' as a prerequisite for 'runtop'; diff --git a/Makefile b/Makefile index bd1f111b2ff..c9095638ff7 100644 --- a/Makefile +++ b/Makefile @@ -60,8 +60,399 @@ TOPINCLUDES=$(addprefix -I otherlibs/,$(filter-out %threads,$(OTHERLIBRARIES))) expunge := expunge$(EXE) -# targets for the compilerlibs/*.{cma,cmxa} archives -include compilerlibs/Makefile.compilerlibs +# Targets and dependencies for the compilerlibs/*.{cma,cmxa} archives + +utils_SOURCES = $(addprefix utils/, \ + config.mli config.ml \ + build_path_prefix_map.mli build_path_prefix_map.ml \ + misc.mli misc.ml \ + identifiable.mli identifiable.ml \ + numbers.mli numbers.ml \ + arg_helper.mli arg_helper.ml \ + local_store.mli local_store.ml \ + load_path.mli load_path.ml \ + clflags.mli clflags.ml \ + profile.mli profile.ml \ + terminfo.mli terminfo.ml \ + ccomp.mli ccomp.ml \ + warnings.mli warnings.ml \ + consistbl.mli consistbl.ml \ + strongly_connected_components.mli strongly_connected_components.ml \ + targetint.mli targetint.ml \ + int_replace_polymorphic_compare.mli int_replace_polymorphic_compare.ml \ + domainstate.mli domainstate.ml \ + binutils.mli binutils.ml \ + lazy_backtrack.mli lazy_backtrack.ml \ + diffing.mli diffing.ml \ + diffing_with_keys.mli diffing_with_keys.ml) + +parsing_SOURCES = $(addprefix parsing/, \ + location.mli location.ml \ + unit_info.mli unit_info.ml \ + asttypes.mli \ + longident.mli longident.ml \ + parsetree.mli \ + docstrings.mli docstrings.ml \ + syntaxerr.mli syntaxerr.ml \ + ast_helper.mli ast_helper.ml \ + camlinternalMenhirLib.mli camlinternalMenhirLib.ml \ + parser.mly \ + lexer.mll \ + pprintast.mli pprintast.ml \ + parse.mli parse.ml \ + printast.mli printast.ml \ + ast_mapper.mli ast_mapper.ml \ + ast_iterator.mli ast_iterator.ml \ + attr_helper.mli attr_helper.ml \ + builtin_attributes.mli builtin_attributes.ml \ + ast_invariants.mli ast_invariants.ml \ + depend.mli depend.ml) + +typing_SOURCES = \ + typing/annot.mli \ + typing/ident.mli typing/ident.ml \ + typing/path.mli typing/path.ml \ + typing/primitive.mli typing/primitive.ml \ + typing/type_immediacy.mli typing/type_immediacy.ml \ + typing/outcometree.mli \ + typing/shape.mli typing/shape.ml \ + typing/types.mli typing/types.ml \ + typing/btype.mli typing/btype.ml \ + typing/oprint.mli typing/oprint.ml \ + typing/subst.mli typing/subst.ml \ + typing/predef.mli typing/predef.ml \ + typing/datarepr.mli typing/datarepr.ml \ + file_formats/cmi_format.mli file_formats/cmi_format.ml \ + typing/persistent_env.mli typing/persistent_env.ml \ + typing/env.mli typing/env.ml \ + typing/errortrace.mli typing/errortrace.ml \ + typing/typedtree.mli typing/typedtree.ml \ + typing/signature_group.mli typing/signature_group.ml \ + typing/printtyped.mli typing/printtyped.ml \ + typing/ctype.mli typing/ctype.ml \ + typing/printtyp.mli typing/printtyp.ml \ + typing/includeclass.mli typing/includeclass.ml \ + typing/mtype.mli typing/mtype.ml \ + typing/envaux.mli typing/envaux.ml \ + typing/includecore.mli typing/includecore.ml \ + typing/tast_iterator.mli typing/tast_iterator.ml \ + typing/tast_mapper.mli typing/tast_mapper.ml \ + typing/stypes.mli typing/stypes.ml \ + file_formats/cmt_format.mli file_formats/cmt_format.ml \ + typing/cmt2annot.mli typing/cmt2annot.ml \ + typing/untypeast.mli typing/untypeast.ml \ + typing/includemod.mli typing/includemod.ml \ + typing/includemod_errorprinter.mli typing/includemod_errorprinter.ml \ + typing/typetexp.mli typing/typetexp.ml \ + typing/printpat.mli typing/printpat.ml \ + typing/patterns.mli typing/patterns.ml \ + typing/parmatch.mli typing/parmatch.ml \ + typing/typedecl_properties.mli typing/typedecl_properties.ml \ + typing/typedecl_variance.mli typing/typedecl_variance.ml \ + typing/typedecl_unboxed.mli typing/typedecl_unboxed.ml \ + typing/typedecl_immediacy.mli typing/typedecl_immediacy.ml \ + typing/typedecl_separability.mli typing/typedecl_separability.ml \ + typing/typeopt.mli typing/typeopt.ml \ + typing/typedecl.mli typing/typedecl.ml \ + typing/rec_check.mli typing/rec_check.ml \ + typing/typecore.mli typing/typecore.ml \ + typing/typeclass.mli typing/typeclass.ml \ + typing/typemod.mli typing/typemod.ml + +lambda_SOURCES = $(addprefix lambda/, \ + debuginfo.mli debuginfo.ml \ + lambda.mli lambda.ml \ + printlambda.mli printlambda.ml \ + switch.mli switch.ml \ + matching.mli matching.ml \ + translobj.mli translobj.ml \ + translattribute.mli translattribute.ml \ + translprim.mli translprim.ml \ + translcore.mli translcore.ml \ + translclass.mli translclass.ml \ + translmod.mli translmod.ml \ + tmc.mli tmc.ml \ + simplif.mli simplif.ml \ + runtimedef.mli runtimedef.ml) + +comp_SOURCES = \ + file_formats/cmo_format.mli \ + file_formats/cmx_format.mli \ + file_formats/cmxs_format.mli \ + bytecomp/meta.mli bytecomp/meta.ml \ + bytecomp/opcodes.mli bytecomp/opcodes.ml \ + bytecomp/bytesections.mli bytecomp/bytesections.ml \ + bytecomp/dll.mli bytecomp/dll.ml \ + bytecomp/symtable.mli bytecomp/symtable.ml \ + driver/pparse.mli driver/pparse.ml \ + driver/compenv.mli driver/compenv.ml \ + driver/main_args.mli driver/main_args.ml \ + driver/compmisc.mli driver/compmisc.ml \ + driver/makedepend.mli driver/makedepend.ml \ + driver/compile_common.mli driver/compile_common.ml +# All file format descriptions (including cmx{,s}) are in the +# ocamlcommon library so that ocamlobjinfo can depend on them. + +ocamlcommon_SOURCES = \ + $(utils_SOURCES) $(parsing_SOURCES) $(typing_SOURCES) \ + $(lambda_SOURCES) $(comp_SOURCES) + +ocamlbytecomp_SOURCES = \ + bytecomp/instruct.mli bytecomp/instruct.ml \ + bytecomp/bytegen.mli bytecomp/bytegen.ml \ + bytecomp/printinstr.mli bytecomp/printinstr.ml \ + bytecomp/emitcode.mli bytecomp/emitcode.ml \ + bytecomp/bytelink.mli bytecomp/bytelink.ml \ + bytecomp/bytelibrarian.mli bytecomp/bytelibrarian.ml \ + bytecomp/bytepackager.mli bytecomp/bytepackager.ml \ + driver/errors.mli driver/errors.ml \ + driver/compile.mli driver/compile.ml \ + driver/maindriver.mli driver/maindriver.ml + +intel_SOURCES = \ + x86_ast.mli \ + x86_proc.mli x86_proc.ml \ + x86_dsl.mli x86_dsl.ml \ + x86_gas.mli x86_gas.ml \ + x86_masm.mli x86_masm.ml + +asmcomp_SOURCES = \ + $(addprefix asmcomp/, $(arch_specific_SOURCES)) \ + asmcomp/arch.mli asmcomp/arch.ml \ + asmcomp/cmm.mli asmcomp/cmm.ml \ + asmcomp/printcmm.mli asmcomp/printcmm.ml \ + asmcomp/reg.mli asmcomp/reg.ml \ + asmcomp/mach.mli asmcomp/mach.ml \ + asmcomp/proc.mli asmcomp/proc.ml \ + asmcomp/strmatch.mli asmcomp/strmatch.ml \ + asmcomp/cmmgen_state.mli asmcomp/cmmgen_state.ml \ + asmcomp/cmm_helpers.mli asmcomp/cmm_helpers.ml \ + asmcomp/afl_instrument.mli asmcomp/afl_instrument.ml \ + asmcomp/thread_sanitizer.mli asmcomp/thread_sanitizer.ml \ + asmcomp/cmmgen.mli asmcomp/cmmgen.ml \ + asmcomp/cmm_invariants.mli asmcomp/cmm_invariants.ml \ + asmcomp/interval.mli asmcomp/interval.ml \ + asmcomp/printmach.mli asmcomp/printmach.ml \ + asmcomp/dataflow.mli asmcomp/dataflow.ml \ + asmcomp/polling.mli asmcomp/polling.ml \ + asmcomp/selectgen.mli asmcomp/selectgen.ml \ + asmcomp/selection.mli asmcomp/selection.ml \ + asmcomp/comballoc.mli asmcomp/comballoc.ml \ + asmcomp/CSEgen.mli asmcomp/CSEgen.ml \ + asmcomp/CSE.mli asmcomp/CSE.ml \ + asmcomp/liveness.mli asmcomp/liveness.ml \ + asmcomp/spill.mli asmcomp/spill.ml \ + asmcomp/split.mli asmcomp/split.ml \ + asmcomp/interf.mli asmcomp/interf.ml \ + asmcomp/coloring.mli asmcomp/coloring.ml \ + asmcomp/linscan.mli asmcomp/linscan.ml \ + asmcomp/reloadgen.mli asmcomp/reloadgen.ml \ + asmcomp/reload.mli asmcomp/reload.ml \ + asmcomp/deadcode.mli asmcomp/deadcode.ml \ + asmcomp/stackframegen.mli asmcomp/stackframegen.ml \ + asmcomp/stackframe.mli asmcomp/stackframe.ml \ + asmcomp/linear.mli asmcomp/linear.ml \ + asmcomp/printlinear.mli asmcomp/printlinear.ml \ + asmcomp/linearize.mli asmcomp/linearize.ml \ + file_formats/linear_format.mli file_formats/linear_format.ml \ + asmcomp/schedgen.mli asmcomp/schedgen.ml \ + asmcomp/scheduling.mli asmcomp/scheduling.ml \ + asmcomp/branch_relaxation.mli asmcomp/branch_relaxation.ml \ + asmcomp/emitaux.mli asmcomp/emitaux.ml \ + asmcomp/emit.mli asmcomp/emit.ml \ + asmcomp/asmgen.mli asmcomp/asmgen.ml \ + asmcomp/asmlink.mli asmcomp/asmlink.ml \ + asmcomp/asmlibrarian.mli asmcomp/asmlibrarian.ml \ + asmcomp/asmpackager.mli asmcomp/asmpackager.ml \ + driver/opterrors.mli driver/opterrors.ml \ + driver/optcompile.mli driver/optcompile.ml \ + driver/optmaindriver.mli driver/optmaindriver.ml + +# Files under middle_end/ are not to reference files under asmcomp/. +# This ensures that the middle end can be linked (e.g. for objinfo) even when +# the native code compiler is not present for some particular target. + +middle_end_closure_SOURCES = $(addprefix middle_end/closure/, \ + closure.mli closure.ml \ + closure_middle_end.mli closure_middle_end.ml) + +# Owing to dependencies through [Compilenv], which would be +# difficult to remove, some of the lower parts of Flambda (anything that is +# saved in a .cmx file) have to be included in the [MIDDLE_END] stanza, below. +middle_end_flambda_SOURCES = \ +$(addprefix middle_end/flambda/, \ + import_approx.mli import_approx.ml \ + lift_code.mli lift_code.ml \ + closure_conversion_aux.mli closure_conversion_aux.ml \ + closure_conversion.mli closure_conversion.ml \ + initialize_symbol_to_let_symbol.mli initialize_symbol_to_let_symbol.ml \ + lift_let_to_initialize_symbol.mli lift_let_to_initialize_symbol.ml \ + find_recursive_functions.mli find_recursive_functions.ml \ + invariant_params.mli invariant_params.ml \ + inconstant_idents.mli inconstant_idents.ml \ + alias_analysis.mli alias_analysis.ml \ + lift_constants.mli lift_constants.ml \ + share_constants.mli share_constants.ml \ + simplify_common.mli simplify_common.ml \ + remove_unused_arguments.mli remove_unused_arguments.ml \ + remove_unused_closure_vars.mli remove_unused_closure_vars.ml \ + remove_unused_program_constructs.mli remove_unused_program_constructs.ml \ + simplify_boxed_integer_ops.mli simplify_boxed_integer_ops.ml \ + simplify_primitives.mli simplify_primitives.ml \ + inlining_stats_types.mli inlining_stats_types.ml \ + inlining_stats.mli inlining_stats.ml \ + inline_and_simplify_aux.mli inline_and_simplify_aux.ml \ + inlining_decision_intf.mli \ + remove_free_vars_equal_to_args.mli remove_free_vars_equal_to_args.ml \ + extract_projections.mli extract_projections.ml \ + augment_specialised_args.mli augment_specialised_args.ml \ + unbox_free_vars_of_closures.mli unbox_free_vars_of_closures.ml \ + unbox_specialised_args.mli unbox_specialised_args.ml \ + unbox_closures.mli unbox_closures.ml \ + inlining_transforms.mli inlining_transforms.ml \ + inlining_decision.mli inlining_decision.ml \ + inline_and_simplify.mli inline_and_simplify.ml \ + ref_to_variables.mli ref_to_variables.ml \ + flambda_invariants.mli flambda_invariants.ml \ + traverse_for_exported_symbols.mli traverse_for_exported_symbols.ml \ + build_export_info.mli build_export_info.ml \ + closure_offsets.mli closure_offsets.ml \ + un_anf.mli un_anf.ml \ + flambda_to_clambda.mli flambda_to_clambda.ml \ + flambda_middle_end.mli flambda_middle_end.ml \ + simplify_boxed_integer_ops_intf.mli) + +ocamlmiddleend_SOURCES = \ +$(addprefix middle_end/, \ + internal_variable_names.mli internal_variable_names.ml \ + linkage_name.mli linkage_name.ml \ + compilation_unit.mli compilation_unit.ml \ + variable.mli variable.ml \ + $(addprefix flambda/base_types/, \ + closure_element.mli closure_element.ml \ + closure_id.mli closure_id.ml) \ + symbol.mli symbol.ml \ + backend_var.mli backend_var.ml \ + clambda_primitives.mli clambda_primitives.ml \ + printclambda_primitives.mli printclambda_primitives.ml \ + clambda.mli clambda.ml \ + printclambda.mli printclambda.ml \ + semantics_of_primitives.mli semantics_of_primitives.ml \ + convert_primitives.mli convert_primitives.ml \ + $(addprefix flambda/, \ + $(addprefix base_types/, \ + id_types.mli id_types.ml \ + export_id.mli export_id.ml \ + tag.mli tag.ml \ + mutable_variable.mli mutable_variable.ml \ + set_of_closures_id.mli set_of_closures_id.ml \ + set_of_closures_origin.mli set_of_closures_origin.ml \ + closure_origin.mli closure_origin.ml \ + var_within_closure.mli var_within_closure.ml \ + static_exception.mli static_exception.ml) \ + pass_wrapper.mli pass_wrapper.ml \ + allocated_const.mli allocated_const.ml \ + parameter.mli parameter.ml \ + projection.mli projection.ml \ + flambda.mli flambda.ml \ + flambda_iterators.mli flambda_iterators.ml \ + flambda_utils.mli flambda_utils.ml \ + freshening.mli freshening.ml \ + effect_analysis.mli effect_analysis.ml \ + inlining_cost.mli inlining_cost.ml \ + simple_value_approx.mli simple_value_approx.ml \ + export_info.mli export_info.ml \ + export_info_for_pack.mli export_info_for_pack.ml) \ + compilenv.mli compilenv.ml \ + backend_intf.mli) \ + $(middle_end_closure_SOURCES) \ + $(middle_end_flambda_SOURCES) + +ocamloptcomp_SOURCES = $(ocamlmiddleend_SOURCES) $(asmcomp_SOURCES) + +ocamltoplevel_SOURCES = $(addprefix toplevel/, \ + genprintval.mli genprintval.ml \ + topcommon.mli topcommon.ml \ + native/tophooks.mli native/tophooks.ml \ + byte/topeval.mli byte/topeval.ml \ + native/topeval.mli native/topeval.ml \ + byte/trace.mli byte/trace.ml \ + native/trace.mli native/trace.ml \ + toploop.mli toploop.ml \ + topprinters.mli topprinters.ml \ + topdirs.mli topdirs.ml \ + byte/topmain.mli byte/topmain.ml \ + native/topmain.mli native/topmain.ml) + +TOPLEVEL_SHARED_MLIS = topeval.mli trace.mli topmain.mli +TOPLEVEL_SHARED_CMIS = $(TOPLEVEL_SHARED_MLIS:%.mli=%.cmi) +TOPLEVEL_SHARED_ARTEFACTS = $(TOPLEVEL_SHARED_MLIS) $(TOPLEVEL_SHARED_CMIS) + +$(addprefix toplevel/byte/, $(TOPLEVEL_SHARED_CMIS)):\ +toplevel/byte/%.cmi: toplevel/%.cmi + cp $< toplevel/$*.mli $(@D) + +$(addprefix toplevel/native/, $(TOPLEVEL_SHARED_CMIS)):\ +toplevel/native/%.cmi: toplevel/%.cmi + cp $< toplevel/$*.mli $(@D) + +beforedepend:: + cd toplevel ; cp $(TOPLEVEL_SHARED_MLIS) byte/ + cd toplevel ; cp $(TOPLEVEL_SHARED_MLIS) native/ + +partialclean:: + cd toplevel/byte ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS) + cd toplevel/native ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS) + +ALL_CONFIG_CMO = utils/config_main.cmo utils/config_boot.cmo + +utils/config_%.mli: utils/config.mli + cp $^ $@ + +beforedepend:: utils/config_main.mli utils/config_boot.mli + +$(addprefix compilerlibs/ocamlcommon., cma cmxa): \ + OC_OCAML_COMMON_LDFLAGS = += -linkall + +partialclean:: + rm -f compilerlibs/ocamlcommon.cma + +partialclean:: + rm -f compilerlibs/ocamlcommon.cmxa \ + compilerlibs/ocamlcommon.a compilerlibs/ocamlcommon.lib + + +partialclean:: + rm -f compilerlibs/ocamlbytecomp.cma + +partialclean:: + rm -f compilerlibs/ocamlbytecomp.cmxa \ + compilerlibs/ocamlbytecomp.a compilerlibs/ocamlbytecomp.lib + + +partialclean:: + rm -f compilerlibs/ocamlmiddleend.cma \ + compilerlibs/ocamlmiddleend.cmxa \ + compilerlibs/ocamlmiddleend.a \ + compilerlibs/ocamlmiddleend.lib + + +partialclean:: + rm -f compilerlibs/ocamloptcomp.cma + +partialclean:: + rm -f compilerlibs/ocamloptcomp.cmxa \ + compilerlibs/ocamloptcomp.a compilerlibs/ocamloptcomp.lib + + +compilerlibs/ocamltoplevel.cma: VPATH += toplevel/byte +partialclean:: + rm -f compilerlibs/ocamltoplevel.cma + +compilerlibs/ocamltoplevel.cmxa: VPATH += toplevel/native +partialclean:: + rm -f compilerlibs/ocamltoplevel.cmxa \ + compilerlibs/ocamltoplevel.a compilerlibs/ocamltoplevel.lib # The configuration file @@ -182,7 +573,11 @@ COMPILERLIBS = $(addprefix compilerlibs/, \ $(COMPILERLIBS:=.cma): \ CAMLC = $(BOOT_OCAMLC) $(BOOT_STDLIBFLAGS) -use-prims runtime/primitives -# FIXME: how about making another target depend on $(ALL_CONFIG_CMO)? +# The following dependency ensures that the two versions of the +# configuration module (the one for the bootstrap compiler and the +# one for the compiler to be installed) are compiled. This is to make +# sure these two versions remain in sync with each other + compilerlibs/ocamlcommon.cma: $(ALL_CONFIG_CMO) OCAML_LIBRARIES = $(COMPILERLIBS) diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs deleted file mode 100644 index 82fbd4e12cb..00000000000 --- a/compilerlibs/Makefile.compilerlibs +++ /dev/null @@ -1,422 +0,0 @@ -#************************************************************************** -#* * -#* 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. * -#* * -#************************************************************************** - -# Targets and dependencies for compilerlibs archives - -# This file is meant to be included from the root Makefile, not to be -# executed directly (this is why it is not simply named Makefile). - -utils_SOURCES = $(addprefix utils/, \ - config.mli config.ml \ - build_path_prefix_map.mli build_path_prefix_map.ml \ - misc.mli misc.ml \ - identifiable.mli identifiable.ml \ - numbers.mli numbers.ml \ - arg_helper.mli arg_helper.ml \ - local_store.mli local_store.ml \ - load_path.mli load_path.ml \ - clflags.mli clflags.ml \ - profile.mli profile.ml \ - terminfo.mli terminfo.ml \ - ccomp.mli ccomp.ml \ - warnings.mli warnings.ml \ - consistbl.mli consistbl.ml \ - strongly_connected_components.mli strongly_connected_components.ml \ - targetint.mli targetint.ml \ - int_replace_polymorphic_compare.mli int_replace_polymorphic_compare.ml \ - domainstate.mli domainstate.ml \ - binutils.mli binutils.ml \ - lazy_backtrack.mli lazy_backtrack.ml \ - diffing.mli diffing.ml \ - diffing_with_keys.mli diffing_with_keys.ml) - -parsing_SOURCES = $(addprefix parsing/, \ - location.mli location.ml \ - unit_info.mli unit_info.ml \ - asttypes.mli \ - longident.mli longident.ml \ - parsetree.mli \ - docstrings.mli docstrings.ml \ - syntaxerr.mli syntaxerr.ml \ - ast_helper.mli ast_helper.ml \ - camlinternalMenhirLib.mli camlinternalMenhirLib.ml \ - parser.mly \ - lexer.mll \ - pprintast.mli pprintast.ml \ - parse.mli parse.ml \ - printast.mli printast.ml \ - ast_mapper.mli ast_mapper.ml \ - ast_iterator.mli ast_iterator.ml \ - attr_helper.mli attr_helper.ml \ - builtin_attributes.mli builtin_attributes.ml \ - ast_invariants.mli ast_invariants.ml \ - depend.mli depend.ml) - -typing_SOURCES = \ -$(addprefix typing/,\ - annot.mli \ - ident.mli ident.ml \ - path.mli path.ml \ - primitive.mli primitive.ml \ - type_immediacy.mli type_immediacy.ml \ - outcometree.mli \ - shape.mli shape.ml \ - types.mli types.ml \ - btype.mli btype.ml \ - oprint.mli oprint.ml \ - subst.mli subst.ml \ - predef.mli predef.ml \ - datarepr.mli datarepr.ml) \ - file_formats/cmi_format.mli file_formats/cmi_format.ml \ -$(addprefix typing/, \ - persistent_env.mli persistent_env.ml \ - env.mli env.ml \ - errortrace.mli errortrace.ml \ - typedtree.mli typedtree.ml \ - signature_group.mli signature_group.ml \ - printtyped.mli printtyped.ml \ - ctype.mli ctype.ml \ - printtyp.mli printtyp.ml \ - includeclass.mli includeclass.ml \ - mtype.mli mtype.ml \ - envaux.mli envaux.ml \ - includecore.mli includecore.ml \ - tast_iterator.mli tast_iterator.ml \ - tast_mapper.mli tast_mapper.ml \ - stypes.mli stypes.ml) \ - file_formats/cmt_format.mli file_formats/cmt_format.ml \ -$(addprefix typing/, \ - cmt2annot.mli cmt2annot.ml \ - untypeast.mli untypeast.ml \ - includemod.mli includemod.ml \ - includemod_errorprinter.mli includemod_errorprinter.ml \ - typetexp.mli typetexp.ml \ - printpat.mli printpat.ml \ - patterns.mli patterns.ml \ - parmatch.mli parmatch.ml \ - typedecl_properties.mli typedecl_properties.ml \ - typedecl_variance.mli typedecl_variance.ml \ - typedecl_unboxed.mli typedecl_unboxed.ml \ - typedecl_immediacy.mli typedecl_immediacy.ml \ - typedecl_separability.mli typedecl_separability.ml \ - typeopt.mli typeopt.ml \ - typedecl.mli typedecl.ml \ - rec_check.mli rec_check.ml \ - typecore.mli typecore.ml \ - typeclass.mli typeclass.ml \ - typemod.mli typemod.ml) - -lambda_SOURCES = $(addprefix lambda/, \ - debuginfo.mli debuginfo.ml \ - lambda.mli lambda.ml \ - printlambda.mli printlambda.ml \ - switch.mli switch.ml \ - matching.mli matching.ml \ - translobj.mli translobj.ml \ - translattribute.mli translattribute.ml \ - translprim.mli translprim.ml \ - translcore.mli translcore.ml \ - translclass.mli translclass.ml \ - translmod.mli translmod.ml \ - tmc.mli tmc.ml \ - simplif.mli simplif.ml \ - runtimedef.mli runtimedef.ml) - -comp_SOURCES = \ -$(addprefix file_formats/, \ - cmo_format.mli \ - cmx_format.mli \ - cmxs_format.mli) \ -$(addprefix bytecomp/, \ - meta.mli meta.ml \ - opcodes.mli opcodes.ml \ - bytesections.mli bytesections.ml \ - dll.mli dll.ml \ - symtable.mli symtable.ml) \ -$(addprefix driver/, \ - pparse.mli pparse.ml \ - compenv.mli compenv.ml \ - main_args.mli main_args.ml \ - compmisc.mli compmisc.ml \ - makedepend.mli makedepend.ml \ - compile_common.mli compile_common.ml) -# All file format descriptions (including cmx{,s}) are in the -# ocamlcommon library so that ocamlobjinfo can depend on them. - -ocamlcommon_SOURCES = \ - $(utils_SOURCES) $(parsing_SOURCES) $(typing_SOURCES) \ - $(lambda_SOURCES) $(comp_SOURCES) - -ocamlbytecomp_SOURCES = \ -$(addprefix bytecomp/, \ - instruct.mli instruct.ml \ - bytegen.mli bytegen.ml \ - printinstr.mli printinstr.ml \ - emitcode.mli emitcode.ml \ - bytelink.mli bytelink.ml \ - bytelibrarian.mli bytelibrarian.ml \ - bytepackager.mli bytepackager.ml) \ -$(addprefix driver/, \ - errors.mli errors.ml \ - compile.mli compile.ml \ - maindriver.mli maindriver.ml) - -intel_SOURCES = \ - x86_ast.mli \ - x86_proc.mli x86_proc.ml \ - x86_dsl.mli x86_dsl.ml \ - x86_gas.mli x86_gas.ml \ - x86_masm.mli x86_masm.ml - -asmcomp_SOURCES = \ -$(addprefix asmcomp/, \ - $(arch_specific_SOURCES) \ - arch.mli arch.ml \ - cmm.mli cmm.ml \ - printcmm.mli printcmm.ml \ - reg.mli reg.ml \ - mach.mli mach.ml \ - proc.mli proc.ml \ - strmatch.mli strmatch.ml \ - cmmgen_state.mli cmmgen_state.ml \ - cmm_helpers.mli cmm_helpers.ml \ - afl_instrument.mli afl_instrument.ml \ - thread_sanitizer.mli thread_sanitizer.ml \ - cmmgen.mli cmmgen.ml \ - cmm_invariants.mli cmm_invariants.ml \ - interval.mli interval.ml \ - printmach.mli printmach.ml \ - dataflow.mli dataflow.ml \ - polling.mli polling.ml \ - selectgen.mli selectgen.ml \ - selection.mli selection.ml \ - comballoc.mli comballoc.ml \ - CSEgen.mli CSEgen.ml \ - CSE.mli CSE.ml \ - liveness.mli liveness.ml \ - spill.mli spill.ml \ - split.mli split.ml \ - interf.mli interf.ml \ - coloring.mli coloring.ml \ - linscan.mli linscan.ml \ - reloadgen.mli reloadgen.ml \ - reload.mli reload.ml \ - deadcode.mli deadcode.ml \ - stackframegen.mli stackframegen.ml \ - stackframe.mli stackframe.ml \ - linear.mli linear.ml \ - printlinear.mli printlinear.ml \ - linearize.mli linearize.ml) \ - file_formats/linear_format.mli file_formats/linear_format.ml \ -$(addprefix asmcomp/, \ - schedgen.mli schedgen.ml \ - scheduling.mli scheduling.ml \ - branch_relaxation.mli branch_relaxation.ml \ - emitaux.mli emitaux.ml \ - emit.mli emit.ml \ - asmgen.mli asmgen.ml \ - asmlink.mli asmlink.ml \ - asmlibrarian.mli asmlibrarian.ml \ - asmpackager.mli asmpackager.ml) \ -$(addprefix driver/, \ - opterrors.mli opterrors.ml \ - optcompile.mli optcompile.ml \ - optmaindriver.mli optmaindriver.ml) - -# Files under middle_end/ are not to reference files under asmcomp/. -# This ensures that the middle end can be linked (e.g. for objinfo) even when -# the native code compiler is not present for some particular target. - -middle_end_closure_SOURCES = $(addprefix middle_end/closure/, \ - closure.mli closure.ml \ - closure_middle_end.mli closure_middle_end.ml) - -# Owing to dependencies through [Compilenv], which would be -# difficult to remove, some of the lower parts of Flambda (anything that is -# saved in a .cmx file) have to be included in the [MIDDLE_END] stanza, below. -middle_end_flambda_SOURCES = \ -$(addprefix middle_end/flambda/, \ - import_approx.mli import_approx.ml \ - lift_code.mli lift_code.ml \ - closure_conversion_aux.mli closure_conversion_aux.ml \ - closure_conversion.mli closure_conversion.ml \ - initialize_symbol_to_let_symbol.mli initialize_symbol_to_let_symbol.ml \ - lift_let_to_initialize_symbol.mli lift_let_to_initialize_symbol.ml \ - find_recursive_functions.mli find_recursive_functions.ml \ - invariant_params.mli invariant_params.ml \ - inconstant_idents.mli inconstant_idents.ml \ - alias_analysis.mli alias_analysis.ml \ - lift_constants.mli lift_constants.ml \ - share_constants.mli share_constants.ml \ - simplify_common.mli simplify_common.ml \ - remove_unused_arguments.mli remove_unused_arguments.ml \ - remove_unused_closure_vars.mli remove_unused_closure_vars.ml \ - remove_unused_program_constructs.mli remove_unused_program_constructs.ml \ - simplify_boxed_integer_ops.mli simplify_boxed_integer_ops.ml \ - simplify_primitives.mli simplify_primitives.ml \ - inlining_stats_types.mli inlining_stats_types.ml \ - inlining_stats.mli inlining_stats.ml \ - inline_and_simplify_aux.mli inline_and_simplify_aux.ml \ - inlining_decision_intf.mli \ - remove_free_vars_equal_to_args.mli remove_free_vars_equal_to_args.ml \ - extract_projections.mli extract_projections.ml \ - augment_specialised_args.mli augment_specialised_args.ml \ - unbox_free_vars_of_closures.mli unbox_free_vars_of_closures.ml \ - unbox_specialised_args.mli unbox_specialised_args.ml \ - unbox_closures.mli unbox_closures.ml \ - inlining_transforms.mli inlining_transforms.ml \ - inlining_decision.mli inlining_decision.ml \ - inline_and_simplify.mli inline_and_simplify.ml \ - ref_to_variables.mli ref_to_variables.ml \ - flambda_invariants.mli flambda_invariants.ml \ - traverse_for_exported_symbols.mli traverse_for_exported_symbols.ml \ - build_export_info.mli build_export_info.ml \ - closure_offsets.mli closure_offsets.ml \ - un_anf.mli un_anf.ml \ - flambda_to_clambda.mli flambda_to_clambda.ml \ - flambda_middle_end.mli flambda_middle_end.ml \ - simplify_boxed_integer_ops_intf.mli) - -ocamlmiddleend_SOURCES = \ -$(addprefix middle_end/, \ - internal_variable_names.mli internal_variable_names.ml \ - linkage_name.mli linkage_name.ml \ - compilation_unit.mli compilation_unit.ml \ - variable.mli variable.ml \ - $(addprefix flambda/base_types/, \ - closure_element.mli closure_element.ml \ - closure_id.mli closure_id.ml) \ - symbol.mli symbol.ml \ - backend_var.mli backend_var.ml \ - clambda_primitives.mli clambda_primitives.ml \ - printclambda_primitives.mli printclambda_primitives.ml \ - clambda.mli clambda.ml \ - printclambda.mli printclambda.ml \ - semantics_of_primitives.mli semantics_of_primitives.ml \ - convert_primitives.mli convert_primitives.ml \ - $(addprefix flambda/, \ - $(addprefix base_types/, \ - id_types.mli id_types.ml \ - export_id.mli export_id.ml \ - tag.mli tag.ml \ - mutable_variable.mli mutable_variable.ml \ - set_of_closures_id.mli set_of_closures_id.ml \ - set_of_closures_origin.mli set_of_closures_origin.ml \ - closure_origin.mli closure_origin.ml \ - var_within_closure.mli var_within_closure.ml \ - static_exception.mli static_exception.ml) \ - pass_wrapper.mli pass_wrapper.ml \ - allocated_const.mli allocated_const.ml \ - parameter.mli parameter.ml \ - projection.mli projection.ml \ - flambda.mli flambda.ml \ - flambda_iterators.mli flambda_iterators.ml \ - flambda_utils.mli flambda_utils.ml \ - freshening.mli freshening.ml \ - effect_analysis.mli effect_analysis.ml \ - inlining_cost.mli inlining_cost.ml \ - simple_value_approx.mli simple_value_approx.ml \ - export_info.mli export_info.ml \ - export_info_for_pack.mli export_info_for_pack.ml) \ - compilenv.mli compilenv.ml \ - backend_intf.mli) \ - $(middle_end_closure_SOURCES) \ - $(middle_end_flambda_SOURCES) - -ocamloptcomp_SOURCES = $(ocamlmiddleend_SOURCES) $(asmcomp_SOURCES) - -ocamltoplevel_SOURCES = $(addprefix toplevel/, \ - genprintval.mli genprintval.ml \ - topcommon.mli topcommon.ml \ - native/tophooks.mli native/tophooks.ml \ - byte/topeval.mli byte/topeval.ml \ - native/topeval.mli native/topeval.ml \ - byte/trace.mli byte/trace.ml \ - native/trace.mli native/trace.ml \ - toploop.mli toploop.ml \ - topprinters.mli topprinters.ml \ - topdirs.mli topdirs.ml \ - byte/topmain.mli byte/topmain.ml \ - native/topmain.mli native/topmain.ml) - -TOPLEVEL_SHARED_MLIS = topeval.mli trace.mli topmain.mli -TOPLEVEL_SHARED_CMIS = $(TOPLEVEL_SHARED_MLIS:%.mli=%.cmi) -TOPLEVEL_SHARED_ARTEFACTS = $(TOPLEVEL_SHARED_MLIS) $(TOPLEVEL_SHARED_CMIS) - -$(addprefix toplevel/byte/, $(TOPLEVEL_SHARED_CMIS)):\ -toplevel/byte/%.cmi: toplevel/%.cmi - cp $< toplevel/$*.mli $(@D) - -$(addprefix toplevel/native/, $(TOPLEVEL_SHARED_CMIS)):\ -toplevel/native/%.cmi: toplevel/%.cmi - cp $< toplevel/$*.mli $(@D) - -beforedepend:: - cd toplevel ; cp $(TOPLEVEL_SHARED_MLIS) byte/ - cd toplevel ; cp $(TOPLEVEL_SHARED_MLIS) native/ - -partialclean:: - cd toplevel/byte ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS) - cd toplevel/native ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS) - -ALL_CONFIG_CMO = utils/config_main.cmo utils/config_boot.cmo - -utils/config_%.mli: utils/config.mli - cp $^ $@ - -beforedepend:: utils/config_main.mli utils/config_boot.mli - -$(addprefix compilerlibs/ocamlcommon., cma cmxa): \ - OC_OCAML_COMMON_LDFLAGS = += -linkall - -partialclean:: - rm -f compilerlibs/ocamlcommon.cma - -partialclean:: - rm -f compilerlibs/ocamlcommon.cmxa \ - compilerlibs/ocamlcommon.a compilerlibs/ocamlcommon.lib - - -partialclean:: - rm -f compilerlibs/ocamlbytecomp.cma - -partialclean:: - rm -f compilerlibs/ocamlbytecomp.cmxa \ - compilerlibs/ocamlbytecomp.a compilerlibs/ocamlbytecomp.lib - - -partialclean:: - rm -f compilerlibs/ocamlmiddleend.cma \ - compilerlibs/ocamlmiddleend.cmxa \ - compilerlibs/ocamlmiddleend.a \ - compilerlibs/ocamlmiddleend.lib - - -partialclean:: - rm -f compilerlibs/ocamloptcomp.cma - -partialclean:: - rm -f compilerlibs/ocamloptcomp.cmxa \ - compilerlibs/ocamloptcomp.a compilerlibs/ocamloptcomp.lib - - -compilerlibs/ocamltoplevel.cma: VPATH += toplevel/byte -partialclean:: - rm -f compilerlibs/ocamltoplevel.cma - -compilerlibs/ocamltoplevel.cmxa: VPATH += toplevel/native -partialclean:: - rm -f compilerlibs/ocamltoplevel.cmxa \ - compilerlibs/ocamltoplevel.a compilerlibs/ocamltoplevel.lib From 0e87534e0a6965290c7afa5c80489750a74ddf32 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Mon, 25 Sep 2023 19:04:39 +0200 Subject: [PATCH 212/402] Remove ocamltest's beforedepend constraint from the root Makefile This is captured by the generic framework and does thus not need to be written here. (Follow-up to PR #12321 merging ocamltest/Makefile into the root Makefile) --- Makefile | 2 -- 1 file changed, 2 deletions(-) diff --git a/Makefile b/Makefile index c9095638ff7..3a4ee9ae0ad 100644 --- a/Makefile +++ b/Makefile @@ -1756,8 +1756,6 @@ $(DEPDIR)/ocamltest: $(ocamltest_DEP_FILES): $(DEPDIR)/ocamltest/%.$(D): ocamltest/%.c $(V_CCDEPS)$(DEP_CC) $(OC_CPPFLAGS) $(CPPFLAGS) $< -MT '$*.$(O)' -MF $@ -beforedepend:: $(ocamltest_MLI_FILES) $(ocamltest_ML_FILES) - ocamltest/%: CAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS) ocamltest: ocamltest/ocamltest$(EXE) From ca9ba543b0366e6b6f0b0cc8dc88de4013107f00 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Fri, 29 Sep 2023 14:54:37 +0200 Subject: [PATCH 213/402] ocamldoc/Makefile.best_ocamldoc: get rid of OCAMLDOC_RUN_PLUGINS This variable was used in ocamldoc/Makefile, by the test targets that got removed in PR #12615. --- ocamldoc/Makefile.best_ocamldoc | 2 -- 1 file changed, 2 deletions(-) diff --git a/ocamldoc/Makefile.best_ocamldoc b/ocamldoc/Makefile.best_ocamldoc index 87010270166..a61c8048827 100644 --- a/ocamldoc/Makefile.best_ocamldoc +++ b/ocamldoc/Makefile.best_ocamldoc @@ -32,8 +32,6 @@ endif OCAMLDOC_RUN_OPT = ./$(OCAMLDOC_OPT) -OCAMLDOC_RUN_PLUGINS = $(OCAMLDOC_RUN_BYTE) - ifeq "$(wildcard $(OCAMLDOC_OPT))" "" OCAMLDOC_RUN = $(OCAMLDOC_RUN_BYTE) else From ff5923f54ec00b071f90153f78d2915e853149da Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Fri, 22 Sep 2023 15:14:51 +0200 Subject: [PATCH 214/402] Deprecate the WITH_OCAMLDOC build variable This commit introduces two private build variables: OCAMLDOC_TARGET and OCAMLDOC_OPT_TARGET. --- Makefile | 14 +++++++------- Makefile.build_config.in | 4 ++++ Makefile.config.in | 5 ++++- configure | 14 +++++++++++--- configure.ac | 12 +++++++++--- 5 files changed, 35 insertions(+), 14 deletions(-) diff --git a/Makefile b/Makefile index 3a4ee9ae0ad..2b51ed4e0ab 100644 --- a/Makefile +++ b/Makefile @@ -45,7 +45,6 @@ endif OC_OCAMLDEPDIRS = $(VPATH) -OCAMLDOC_OPT=$(WITH_OCAMLDOC:=.opt) OCAMLTEST_OPT=$(WITH_OCAMLTEST:=.opt) # This list is passed to expunge, which accepts both uncapitalized and @@ -743,13 +742,14 @@ ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true" $(MAKE) flexlink.opt$(EXE) endif $(MAKE) ocamlc.opt - $(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) \ + $(MAKE) otherlibraries $(WITH_DEBUGGER) $(OCAMLDOC_TARGET) \ $(WITH_OCAMLTEST) $(MAKE) ocamlopt.opt $(MAKE) otherlibrariesopt - $(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt $(OCAMLDOC_OPT) \ + $(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt \ + $(OCAMLDOC_OPT_TARGET) \ $(OCAMLTEST_OPT) othertools ocamlnat -ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true" +ifeq "$(build_ocamldoc)-$(STDLIB_MANPAGES)" "true-true" $(MAKE) manpages endif @@ -786,10 +786,10 @@ endif .PHONY: all all: coreall $(MAKE) ocaml - $(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) \ + $(MAKE) otherlibraries $(WITH_DEBUGGER) $(OCAMLDOC_TARGET) \ $(WITH_OCAMLTEST) $(MAKE) othertools -ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true" +ifeq "$(build_ocamldoc)-$(STDLIB_MANPAGES)" "true-true" $(MAKE) manpages endif @@ -2408,7 +2408,7 @@ endif ifeq "$(build_ocamldoc)" "true" $(MAKE) -C ocamldoc install endif -ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true" +ifeq "$(build_ocamldoc)-$(STDLIB_MANPAGES)" "true-true" $(MAKE) -C api_docgen install endif if test -n "$(WITH_DEBUGGER)"; then \ diff --git a/Makefile.build_config.in b/Makefile.build_config.in index 88c71e2d5f3..d09a5fab4bf 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -35,6 +35,10 @@ build_ocamldebug = @build_ocamldebug@ build_ocamldoc = @build_ocamldoc@ +OCAMLDOC_TARGET = @ocamldoc_target@ + +OCAMLDOC_OPT_TARGET = @ocamldoc_opt_target@ + build_ocamltex = @build_ocamltex@ lib_dynlink = @lib_dynlink@ diff --git a/Makefile.config.in b/Makefile.config.in index 5940dfa2c45..d959657ee42 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -205,7 +205,6 @@ RUNTIMED=@debug_runtime@ INSTRUMENTED_RUNTIME=@instrumented_runtime@ INSTRUMENTED_RUNTIME_LIBS=@instrumented_runtime_libs@ WITH_DEBUGGER=@with_debugger@ -WITH_OCAMLDOC=@ocamldoc@ WITH_OCAMLTEST=@ocamltest@ ASM_CFI_SUPPORTED=@asm_cfi_supported@ WITH_FRAME_POINTERS=@frame_pointers@ @@ -228,6 +227,10 @@ NAKED_POINTERS=false # Deprecated variables +## Variables deprecated since OCaml 5.2 + +WITH_OCAMLDOC=@with_ocamldoc@ + ## Variables deprecated since OCaml 5.0 UNIXLIB=unix diff --git a/configure b/configure index 43a980f9d2f..ab89dfc1e10 100755 --- a/configure +++ b/configure @@ -817,8 +817,10 @@ ASPP ocamltest documentation_tool_cmd documentation_tool +with_ocamldoc +ocamldoc_opt_target +ocamldoc_target build_ocamldoc -ocamldoc build_ocamltex build_ocamldebug with_debugger @@ -3417,6 +3419,8 @@ OCAML_VERSION_SHORT=5.2 + + @@ -19721,10 +19725,14 @@ fi if test x"$enable_ocamldoc" = "xno" then : - ocamldoc="" + ocamldoc_target="" + ocamldoc_opt_target="" + with_ocamldoc="" build_ocamldoc=false else $as_nop - ocamldoc=ocamldoc + ocamldoc_target=ocamldoc + ocamldoc_opt_target=ocamldoc.opt + with_ocamldoc=ocamldoc build_ocamldoc=true ac_config_files="$ac_config_files ocamldoc/META" diff --git a/configure.ac b/configure.ac index d4e4005ce0b..0b8eb736a62 100644 --- a/configure.ac +++ b/configure.ac @@ -182,8 +182,10 @@ AC_SUBST([as_has_debug_prefix_map]) AC_SUBST([with_debugger]) # TODO: rename this variable AC_SUBST([build_ocamldebug]) AC_SUBST([build_ocamltex]) -AC_SUBST([ocamldoc]) AC_SUBST([build_ocamldoc]) +AC_SUBST([ocamldoc_target]) +AC_SUBST([ocamldoc_opt_target]) +AC_SUBST([with_ocamldoc]) AC_SUBST([documentation_tool]) AC_SUBST([documentation_tool_cmd]) AC_SUBST([ocamltest]) @@ -2250,9 +2252,13 @@ AS_IF([test x"$enable_installing_source_artifacts" = "xno"], [install_source_artifacts=true]) AS_IF([test x"$enable_ocamldoc" = "xno"], - [ocamldoc="" + [ocamldoc_target="" + ocamldoc_opt_target="" + with_ocamldoc="" build_ocamldoc=false], - [ocamldoc=ocamldoc + [ocamldoc_target=ocamldoc + ocamldoc_opt_target=ocamldoc.opt + with_ocamldoc=ocamldoc build_ocamldoc=true AC_CONFIG_FILES([ocamldoc/META])]) From 55581106bd269c71ed367fefded7dc156b072ec2 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Fri, 22 Sep 2023 15:32:21 +0200 Subject: [PATCH 215/402] ocamldoc/Makefile.best_ocamldoc: remove useless ./ prefixes The ./ prefix in front of $(OCAMLDOC) and $(OCAMLDOC_OPT) is not useful since the definitions of these variables are already prefixed with $(ROOTDIR). --- ocamldoc/Makefile.best_ocamldoc | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ocamldoc/Makefile.best_ocamldoc b/ocamldoc/Makefile.best_ocamldoc index a61c8048827..504e62d1753 100644 --- a/ocamldoc/Makefile.best_ocamldoc +++ b/ocamldoc/Makefile.best_ocamldoc @@ -19,18 +19,18 @@ OCAMLDOC_OPT = $(ROOTDIR)/ocamldoc/ocamldoc.opt$(EXE) ifeq "$(TARGET)" "$(HOST)" ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true" OCAMLDOC_RUN_BYTE = $(NEW_OCAMLRUN) -I $(ROOTDIR)/otherlibs/unix \ - -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC) + -I $(ROOTDIR)/otherlibs/str $(OCAMLDOC) else # if shared-libraries are not supported, unix.cma and str.cma # are compiled with -custom, so ocamldoc also uses -custom, # and (ocamlrun ocamldoc) does not work. - OCAMLDOC_RUN_BYTE = ./$(OCAMLDOC) + OCAMLDOC_RUN_BYTE = $(OCAMLDOC) endif else - OCAMLDOC_RUN_BYTE = $(NEW_OCAMLRUN) ./$(OCAMLDOC) + OCAMLDOC_RUN_BYTE = $(NEW_OCAMLRUN) $(OCAMLDOC) endif -OCAMLDOC_RUN_OPT = ./$(OCAMLDOC_OPT) +OCAMLDOC_RUN_OPT = $(OCAMLDOC_OPT) ifeq "$(wildcard $(OCAMLDOC_OPT))" "" OCAMLDOC_RUN = $(OCAMLDOC_RUN_BYTE) From 7fb564cf318d5eb9e7ae417c41f395381c47ccb5 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Fri, 22 Sep 2023 16:23:43 +0200 Subject: [PATCH 216/402] Merge ocamldoc/Makefile.best_ocamldoc into Makefile.best_binaries Makefile.best_ocamldoc was included in two files: 1. In ocamldoc/Makefile, which also includes $(ROOTDIR)/Makefile.best_binaries So that the definitions which were in Makefile.best_ocamldoc remain available. 2. In api_docgen/ocamldoc/Makefile which also includes Makefile.best_binaries via api_docgen/Makefile.common --- Makefile.best_binaries | 25 +++++++++++++++++++++ api_docgen/ocamldoc/Makefile | 1 - ocamldoc/Makefile | 1 - ocamldoc/Makefile.best_ocamldoc | 39 --------------------------------- 4 files changed, 25 insertions(+), 41 deletions(-) delete mode 100644 ocamldoc/Makefile.best_ocamldoc diff --git a/Makefile.best_binaries b/Makefile.best_binaries index 4f05f698d15..d77cc1a63a0 100644 --- a/Makefile.best_binaries +++ b/Makefile.best_binaries @@ -57,3 +57,28 @@ BEST_OCAMLDEP := $(strip $(if \ $(call check_not_stale,boot/ocamlc,ocamlc.opt$(EXE)))), \ $(ROOTDIR)/ocamlc.opt$(EXE) -depend, \ $(BOOT_OCAMLC) -depend)) + +OCAMLDOC = $(ROOTDIR)/ocamldoc/ocamldoc$(EXE) +OCAMLDOC_OPT = $(ROOTDIR)/ocamldoc/ocamldoc.opt$(EXE) + +ifeq "$(TARGET)" "$(HOST)" + ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true" + OCAMLDOC_RUN_BYTE = $(NEW_OCAMLRUN) -I $(ROOTDIR)/otherlibs/unix \ + -I $(ROOTDIR)/otherlibs/str $(OCAMLDOC) + else + # if shared-libraries are not supported, unix.cma and str.cma + # are compiled with -custom, so ocamldoc also uses -custom, + # and (ocamlrun ocamldoc) does not work. + OCAMLDOC_RUN_BYTE = $(OCAMLDOC) + endif +else + OCAMLDOC_RUN_BYTE = $(NEW_OCAMLRUN) $(OCAMLDOC) +endif + +OCAMLDOC_RUN_OPT = $(OCAMLDOC_OPT) + +ifeq "$(wildcard $(OCAMLDOC_OPT))" "" + OCAMLDOC_RUN = $(OCAMLDOC_RUN_BYTE) +else + OCAMLDOC_RUN = $(OCAMLDOC_RUN_OPT) +endif diff --git a/api_docgen/ocamldoc/Makefile b/api_docgen/ocamldoc/Makefile index 3821836dcf5..5b1f8946d80 100644 --- a/api_docgen/ocamldoc/Makefile +++ b/api_docgen/ocamldoc/Makefile @@ -15,7 +15,6 @@ # Used by included Makefiles ROOTDIR = ../.. include ../Makefile.common -include ../../ocamldoc/Makefile.best_ocamldoc vpath %.mli ../../stdlib $(DOC_COMPILERLIBS_DIRS) $(DOC_STDLIB_DIRS) diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 2635864c37e..6efbf11ed1c 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -25,7 +25,6 @@ OCAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS) ############## programs := ocamldoc ocamldoc.opt -include Makefile.best_ocamldoc OCAMLDOC_LIBCMA=odoc_info.cma OCAMLDOC_LIBCMI=odoc_info.cmi diff --git a/ocamldoc/Makefile.best_ocamldoc b/ocamldoc/Makefile.best_ocamldoc deleted file mode 100644 index 504e62d1753..00000000000 --- a/ocamldoc/Makefile.best_ocamldoc +++ /dev/null @@ -1,39 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Florian Angeletti, 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. * -#* * -#************************************************************************** - -OCAMLDOC = $(ROOTDIR)/ocamldoc/ocamldoc$(EXE) -OCAMLDOC_OPT = $(ROOTDIR)/ocamldoc/ocamldoc.opt$(EXE) - -ifeq "$(TARGET)" "$(HOST)" - ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true" - OCAMLDOC_RUN_BYTE = $(NEW_OCAMLRUN) -I $(ROOTDIR)/otherlibs/unix \ - -I $(ROOTDIR)/otherlibs/str $(OCAMLDOC) - else - # if shared-libraries are not supported, unix.cma and str.cma - # are compiled with -custom, so ocamldoc also uses -custom, - # and (ocamlrun ocamldoc) does not work. - OCAMLDOC_RUN_BYTE = $(OCAMLDOC) - endif -else - OCAMLDOC_RUN_BYTE = $(NEW_OCAMLRUN) $(OCAMLDOC) -endif - -OCAMLDOC_RUN_OPT = $(OCAMLDOC_OPT) - -ifeq "$(wildcard $(OCAMLDOC_OPT))" "" - OCAMLDOC_RUN = $(OCAMLDOC_RUN_BYTE) -else - OCAMLDOC_RUN = $(OCAMLDOC_RUN_OPT) -endif From ac88609439e713be274ae68b4ce41e6f8c3efabe Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Thu, 19 Oct 2023 14:50:14 +0200 Subject: [PATCH 217/402] Merge ocamldoc/Makefile into the root Makefile --- .depend | 1014 +++++++++++++++++++++++++++++++++++++++++++++ Changes | 2 +- Makefile | 140 ++++++- ocamldoc/.depend | 965 ------------------------------------------ ocamldoc/Makefile | 254 ------------ 5 files changed, 1143 insertions(+), 1232 deletions(-) delete mode 100644 ocamldoc/.depend delete mode 100644 ocamldoc/Makefile diff --git a/.depend b/.depend index 334ab8274b9..8aa50b980ee 100644 --- a/.depend +++ b/.depend @@ -7946,6 +7946,1020 @@ debugger/unix_tools.cmx : \ debugger/unix_tools.cmi debugger/unix_tools.cmi : \ otherlibs/unix/unix.cmi +ocamldoc/odoc.cmo : \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_info.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_gen.cmi \ + ocamldoc/odoc_config.cmi \ + ocamldoc/odoc_args.cmi \ + ocamldoc/odoc_analyse.cmi \ + otherlibs/dynlink/dynlink.cmi \ + ocamldoc/odoc.cmi +ocamldoc/odoc.cmx : \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_info.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_gen.cmx \ + ocamldoc/odoc_config.cmx \ + ocamldoc/odoc_args.cmx \ + ocamldoc/odoc_analyse.cmx \ + otherlibs/dynlink/dynlink.cmi \ + ocamldoc/odoc.cmi +ocamldoc/odoc.cmi : +ocamldoc/odoc_analyse.cmo : \ + utils/warnings.cmi \ + parsing/unit_info.cmi \ + typing/types.cmi \ + typing/typemod.cmi \ + typing/typedtree.cmi \ + parsing/syntaxerr.cmi \ + driver/pparse.cmi \ + parsing/parse.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_text.cmi \ + ocamldoc/odoc_sig.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_merge.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_dep.cmi \ + ocamldoc/odoc_cross.cmi \ + ocamldoc/odoc_comments.cmi \ + ocamldoc/odoc_class.cmi \ + ocamldoc/odoc_ast.cmi \ + parsing/location.cmi \ + parsing/lexer.cmi \ + typing/env.cmi \ + driver/compmisc.cmi \ + utils/clflags.cmi \ + ocamldoc/odoc_analyse.cmi +ocamldoc/odoc_analyse.cmx : \ + utils/warnings.cmx \ + parsing/unit_info.cmx \ + typing/types.cmx \ + typing/typemod.cmx \ + typing/typedtree.cmx \ + parsing/syntaxerr.cmx \ + driver/pparse.cmx \ + parsing/parse.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_text.cmx \ + ocamldoc/odoc_sig.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_merge.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_dep.cmx \ + ocamldoc/odoc_cross.cmx \ + ocamldoc/odoc_comments.cmx \ + ocamldoc/odoc_class.cmx \ + ocamldoc/odoc_ast.cmx \ + parsing/location.cmx \ + parsing/lexer.cmx \ + typing/env.cmx \ + driver/compmisc.cmx \ + utils/clflags.cmx \ + ocamldoc/odoc_analyse.cmi +ocamldoc/odoc_analyse.cmi : \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_global.cmi +ocamldoc/odoc_args.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_texi.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_man.cmi \ + ocamldoc/odoc_latex.cmi \ + ocamldoc/odoc_html.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_gen.cmi \ + ocamldoc/odoc_dot.cmi \ + ocamldoc/odoc_config.cmi \ + driver/main_args.cmi \ + utils/config.cmi \ + driver/compenv.cmi \ + ocamldoc/odoc_args.cmi +ocamldoc/odoc_args.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_texi.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_man.cmx \ + ocamldoc/odoc_latex.cmx \ + ocamldoc/odoc_html.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_gen.cmx \ + ocamldoc/odoc_dot.cmx \ + ocamldoc/odoc_config.cmx \ + driver/main_args.cmx \ + utils/config.cmx \ + driver/compenv.cmx \ + ocamldoc/odoc_args.cmi +ocamldoc/odoc_args.cmi : \ + ocamldoc/odoc_gen.cmi +ocamldoc/odoc_ast.cmo : \ + parsing/unit_info.cmi \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_sig.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_env.cmi \ + ocamldoc/odoc_class.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_ast.cmi +ocamldoc/odoc_ast.cmx : \ + parsing/unit_info.cmx \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_sig.cmx \ + ocamldoc/odoc_parameter.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_env.cmx \ + ocamldoc/odoc_class.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_ast.cmi +ocamldoc/odoc_ast.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + ocamldoc/odoc_sig.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_module.cmi +ocamldoc/odoc_class.cmo : \ + typing/types.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_class.cmi +ocamldoc/odoc_class.cmx : \ + typing/types.cmx \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_parameter.cmx \ + ocamldoc/odoc_name.cmx \ + ocamldoc/odoc_class.cmi +ocamldoc/odoc_class.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_name.cmi +ocamldoc/odoc_comments.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_text.cmi \ + ocamldoc/odoc_see_lexer.cmi \ + ocamldoc/odoc_parser.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_merge.cmi \ + ocamldoc/odoc_lexer.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_cross.cmi \ + ocamldoc/odoc_comments_global.cmi \ + ocamldoc/odoc_comments.cmi +ocamldoc/odoc_comments.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_text.cmx \ + ocamldoc/odoc_see_lexer.cmx \ + ocamldoc/odoc_parser.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_merge.cmx \ + ocamldoc/odoc_lexer.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_cross.cmx \ + ocamldoc/odoc_comments_global.cmx \ + ocamldoc/odoc_comments.cmi +ocamldoc/odoc_comments.cmi : \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_module.cmi +ocamldoc/odoc_comments_global.cmo : \ + ocamldoc/odoc_comments_global.cmi +ocamldoc/odoc_comments_global.cmx : \ + ocamldoc/odoc_comments_global.cmi +ocamldoc/odoc_comments_global.cmi : +ocamldoc/odoc_config.cmo : \ + utils/config.cmi \ + ocamldoc/odoc_config.cmi +ocamldoc/odoc_config.cmx : \ + utils/config.cmx \ + ocamldoc/odoc_config.cmi +ocamldoc/odoc_config.cmi : +ocamldoc/odoc_cross.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_search.cmi \ + ocamldoc/odoc_scan.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + utils/misc.cmi \ + ocamldoc/odoc_cross.cmi +ocamldoc/odoc_cross.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_search.cmx \ + ocamldoc/odoc_scan.cmx \ + ocamldoc/odoc_parameter.cmx \ + ocamldoc/odoc_name.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_class.cmx \ + utils/misc.cmx \ + ocamldoc/odoc_cross.cmi +ocamldoc/odoc_cross.cmi : \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_module.cmi +ocamldoc/odoc_dag2html.cmo : \ + ocamldoc/odoc_info.cmi \ + ocamldoc/odoc_dag2html.cmi +ocamldoc/odoc_dag2html.cmx : \ + ocamldoc/odoc_info.cmx \ + ocamldoc/odoc_dag2html.cmi +ocamldoc/odoc_dag2html.cmi : \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_dep.cmo : \ + otherlibs/str/str.cmi \ + parsing/parsetree.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_print.cmi \ + ocamldoc/odoc_module.cmi \ + utils/misc.cmi \ + parsing/depend.cmi \ + ocamldoc/odoc_dep.cmi +ocamldoc/odoc_dep.cmx : \ + otherlibs/str/str.cmx \ + parsing/parsetree.cmi \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_print.cmx \ + ocamldoc/odoc_module.cmx \ + utils/misc.cmx \ + parsing/depend.cmx \ + ocamldoc/odoc_dep.cmi +ocamldoc/odoc_dep.cmi : \ + parsing/parsetree.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_module.cmi \ + utils/misc.cmi +ocamldoc/odoc_dot.cmo : \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_info.cmi \ + ocamldoc/odoc_dot.cmi +ocamldoc/odoc_dot.cmx : \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_info.cmx \ + ocamldoc/odoc_dot.cmi +ocamldoc/odoc_dot.cmi : \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_env.cmo : \ + typing/types.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + ocamldoc/odoc_name.cmi \ + typing/btype.cmi \ + ocamldoc/odoc_env.cmi +ocamldoc/odoc_env.cmx : \ + typing/types.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + ocamldoc/odoc_name.cmx \ + typing/btype.cmx \ + ocamldoc/odoc_env.cmi +ocamldoc/odoc_env.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_name.cmi +ocamldoc/odoc_exception.cmo : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_exception.cmi +ocamldoc/odoc_exception.cmx : \ + typing/types.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_name.cmx \ + ocamldoc/odoc_exception.cmi +ocamldoc/odoc_exception.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_name.cmi +ocamldoc/odoc_extension.cmo : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_name.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_extension.cmi +ocamldoc/odoc_extension.cmx : \ + typing/types.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_name.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_extension.cmi +ocamldoc/odoc_extension.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_name.cmi \ + parsing/asttypes.cmi +ocamldoc/odoc_gen.cmo : \ + ocamldoc/odoc_texi.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_man.cmi \ + ocamldoc/odoc_latex.cmi \ + ocamldoc/odoc_html.cmi \ + ocamldoc/odoc_dot.cmi \ + ocamldoc/odoc_gen.cmi +ocamldoc/odoc_gen.cmx : \ + ocamldoc/odoc_texi.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_man.cmx \ + ocamldoc/odoc_latex.cmx \ + ocamldoc/odoc_html.cmx \ + ocamldoc/odoc_dot.cmx \ + ocamldoc/odoc_gen.cmi +ocamldoc/odoc_gen.cmi : \ + ocamldoc/odoc_texi.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_man.cmi \ + ocamldoc/odoc_latex.cmi \ + ocamldoc/odoc_html.cmi \ + ocamldoc/odoc_dot.cmi +ocamldoc/odoc_global.cmo : \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_config.cmi \ + utils/clflags.cmi \ + ocamldoc/odoc_global.cmi +ocamldoc/odoc_global.cmx : \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_config.cmx \ + utils/clflags.cmx \ + ocamldoc/odoc_global.cmi +ocamldoc/odoc_global.cmi : \ + ocamldoc/odoc_types.cmi +ocamldoc/odoc_html.cmo : \ + otherlibs/str/str.cmi \ + middle_end/flambda/parameter.cmi \ + ocamldoc/odoc_text.cmi \ + ocamldoc/odoc_ocamlhtml.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_info.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_dag2html.cmi \ + utils/misc.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_html.cmi +ocamldoc/odoc_html.cmx : \ + otherlibs/str/str.cmx \ + middle_end/flambda/parameter.cmx \ + ocamldoc/odoc_text.cmx \ + ocamldoc/odoc_ocamlhtml.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_info.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_dag2html.cmx \ + utils/misc.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_html.cmi +ocamldoc/odoc_html.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_info.cmi \ + ocamldoc/odoc_dag2html.cmi \ + utils/misc.cmi +ocamldoc/odoc_info.cmo : \ + typing/printtyp.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_text.cmi \ + ocamldoc/odoc_str.cmi \ + ocamldoc/odoc_search.cmi \ + ocamldoc/odoc_scan.cmi \ + ocamldoc/odoc_print.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_dep.cmi \ + ocamldoc/odoc_config.cmi \ + ocamldoc/odoc_comments.cmi \ + ocamldoc/odoc_class.cmi \ + ocamldoc/odoc_analyse.cmi \ + parsing/location.cmi \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_info.cmx : \ + typing/printtyp.cmx \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_text.cmx \ + ocamldoc/odoc_str.cmx \ + ocamldoc/odoc_search.cmx \ + ocamldoc/odoc_scan.cmx \ + ocamldoc/odoc_print.cmx \ + ocamldoc/odoc_parameter.cmx \ + ocamldoc/odoc_name.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_dep.cmx \ + ocamldoc/odoc_config.cmx \ + ocamldoc/odoc_comments.cmx \ + ocamldoc/odoc_class.cmx \ + ocamldoc/odoc_analyse.cmx \ + parsing/location.cmx \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_info.cmi : \ + typing/types.cmi \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_search.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + parsing/location.cmi \ + parsing/asttypes.cmi +ocamldoc/odoc_latex.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_to_text.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_latex_style.cmi \ + ocamldoc/odoc_info.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_latex.cmi +ocamldoc/odoc_latex.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_to_text.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_latex_style.cmx \ + ocamldoc/odoc_info.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_latex.cmi +ocamldoc/odoc_latex.cmi : \ + typing/types.cmi \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_latex_style.cmo : \ + ocamldoc/odoc_latex_style.cmi +ocamldoc/odoc_latex_style.cmx : \ + ocamldoc/odoc_latex_style.cmi +ocamldoc/odoc_latex_style.cmi : +ocamldoc/odoc_lexer.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_parser.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_comments_global.cmi \ + ocamldoc/odoc_lexer.cmi +ocamldoc/odoc_lexer.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_parser.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_comments_global.cmx \ + ocamldoc/odoc_lexer.cmi +ocamldoc/odoc_lexer.cmi : \ + ocamldoc/odoc_parser.cmi +ocamldoc/odoc_man.cmo : \ + otherlibs/str/str.cmi \ + middle_end/flambda/parameter.cmi \ + ocamldoc/odoc_str.cmi \ + ocamldoc/odoc_print.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_info.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_man.cmi +ocamldoc/odoc_man.cmx : \ + otherlibs/str/str.cmx \ + middle_end/flambda/parameter.cmx \ + ocamldoc/odoc_str.cmx \ + ocamldoc/odoc_print.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_info.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_man.cmi +ocamldoc/odoc_man.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_merge.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + ocamldoc/odoc_merge.cmi +ocamldoc/odoc_merge.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_parameter.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_class.cmx \ + ocamldoc/odoc_merge.cmi +ocamldoc/odoc_merge.cmi : \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_module.cmi +ocamldoc/odoc_messages.cmo : \ + otherlibs/str/str.cmi \ + utils/config.cmi \ + ocamldoc/odoc_messages.cmi +ocamldoc/odoc_messages.cmx : \ + otherlibs/str/str.cmx \ + utils/config.cmx \ + ocamldoc/odoc_messages.cmi +ocamldoc/odoc_messages.cmi : +ocamldoc/odoc_misc.cmo : \ + otherlibs/unix/unix.cmi \ + typing/types.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_messages.cmi \ + parsing/longident.cmi \ + typing/btype.cmi \ + ocamldoc/odoc_misc.cmi +ocamldoc/odoc_misc.cmx : \ + otherlibs/unix/unix.cmx \ + typing/types.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_messages.cmx \ + parsing/longident.cmx \ + typing/btype.cmx \ + ocamldoc/odoc_misc.cmi +ocamldoc/odoc_misc.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + parsing/longident.cmi \ + parsing/asttypes.cmi +ocamldoc/odoc_module.cmo : \ + typing/types.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + utils/misc.cmi \ + ocamldoc/odoc_module.cmi +ocamldoc/odoc_module.cmx : \ + typing/types.cmx \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_name.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_class.cmx \ + utils/misc.cmx \ + ocamldoc/odoc_module.cmi +ocamldoc/odoc_module.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + utils/misc.cmi +ocamldoc/odoc_name.cmo : \ + parsing/unit_info.cmi \ + otherlibs/str/str.cmi \ + typing/path.cmi \ + ocamldoc/odoc_misc.cmi \ + typing/ident.cmi \ + ocamldoc/odoc_name.cmi +ocamldoc/odoc_name.cmx : \ + parsing/unit_info.cmx \ + otherlibs/str/str.cmx \ + typing/path.cmx \ + ocamldoc/odoc_misc.cmx \ + typing/ident.cmx \ + ocamldoc/odoc_name.cmi +ocamldoc/odoc_name.cmi : \ + typing/path.cmi \ + parsing/longident.cmi \ + typing/ident.cmi +ocamldoc/odoc_ocamlhtml.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_ocamlhtml.cmi +ocamldoc/odoc_ocamlhtml.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_ocamlhtml.cmi +ocamldoc/odoc_ocamlhtml.cmi : +ocamldoc/odoc_parameter.cmo : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_parameter.cmi +ocamldoc/odoc_parameter.cmx : \ + typing/types.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_parameter.cmi +ocamldoc/odoc_parameter.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi +ocamldoc/odoc_parser.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_comments_global.cmi \ + ocamldoc/odoc_parser.cmi +ocamldoc/odoc_parser.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_comments_global.cmx \ + ocamldoc/odoc_parser.cmi +ocamldoc/odoc_parser.cmi : \ + ocamldoc/odoc_types.cmi +ocamldoc/odoc_print.cmo : \ + typing/types.cmi \ + typing/printtyp.cmi \ + typing/btype.cmi \ + ocamldoc/odoc_print.cmi +ocamldoc/odoc_print.cmx : \ + typing/types.cmx \ + typing/printtyp.cmx \ + typing/btype.cmx \ + ocamldoc/odoc_print.cmi +ocamldoc/odoc_print.cmi : \ + typing/types.cmi +ocamldoc/odoc_scan.cmo : \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + ocamldoc/odoc_scan.cmi +ocamldoc/odoc_scan.cmx : \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_class.cmx \ + ocamldoc/odoc_scan.cmi +ocamldoc/odoc_scan.cmi : \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi +ocamldoc/odoc_search.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + ocamldoc/odoc_search.cmi +ocamldoc/odoc_search.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_class.cmx \ + ocamldoc/odoc_search.cmi +ocamldoc/odoc_search.cmi : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi +ocamldoc/odoc_see_lexer.cmo : \ + ocamldoc/odoc_parser.cmi \ + ocamldoc/odoc_see_lexer.cmi +ocamldoc/odoc_see_lexer.cmx : \ + ocamldoc/odoc_parser.cmx \ + ocamldoc/odoc_see_lexer.cmi +ocamldoc/odoc_see_lexer.cmi : \ + ocamldoc/odoc_parser.cmi +ocamldoc/odoc_sig.cmo : \ + parsing/unit_info.cmi \ + typing/types.cmi \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_merge.cmi \ + ocamldoc/odoc_global.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_env.cmi \ + ocamldoc/odoc_class.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/ctype.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_sig.cmi +ocamldoc/odoc_sig.cmx : \ + parsing/unit_info.cmx \ + typing/types.cmx \ + typing/typedtree.cmx \ + parsing/parsetree.cmi \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_parameter.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_merge.cmx \ + ocamldoc/odoc_global.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_env.cmx \ + ocamldoc/odoc_class.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/ctype.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_sig.cmi +ocamldoc/odoc_sig.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_env.cmi \ + ocamldoc/odoc_class.cmi \ + parsing/location.cmi +ocamldoc/odoc_str.cmo : \ + typing/types.cmi \ + typing/printtyp.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_print.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_str.cmi +ocamldoc/odoc_str.cmx : \ + typing/types.cmx \ + typing/printtyp.cmx \ + ocamldoc/odoc_value.cmx \ + ocamldoc/odoc_type.cmx \ + ocamldoc/odoc_print.cmx \ + ocamldoc/odoc_name.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_extension.cmx \ + ocamldoc/odoc_exception.cmx \ + ocamldoc/odoc_class.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_str.cmi +ocamldoc/odoc_str.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_value.cmi \ + ocamldoc/odoc_type.cmi \ + ocamldoc/odoc_extension.cmi \ + ocamldoc/odoc_exception.cmi \ + ocamldoc/odoc_class.cmi +ocamldoc/odoc_test.cmo : \ + ocamldoc/odoc_info.cmi \ + ocamldoc/odoc_gen.cmi \ + ocamldoc/odoc_args.cmi \ + ocamldoc/odoc_test.cmi +ocamldoc/odoc_test.cmx : \ + ocamldoc/odoc_info.cmx \ + ocamldoc/odoc_gen.cmx \ + ocamldoc/odoc_args.cmx \ + ocamldoc/odoc_test.cmi +ocamldoc/odoc_test.cmi : +ocamldoc/odoc_texi.cmo : \ + typing/types.cmi \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_to_text.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_info.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_texi.cmi +ocamldoc/odoc_texi.cmx : \ + typing/types.cmx \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_to_text.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_info.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_texi.cmi +ocamldoc/odoc_texi.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_text.cmo : \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_text_parser.cmi \ + ocamldoc/odoc_text_lexer.cmi \ + ocamldoc/odoc_text.cmi +ocamldoc/odoc_text.cmx : \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_text_parser.cmx \ + ocamldoc/odoc_text_lexer.cmx \ + ocamldoc/odoc_text.cmi +ocamldoc/odoc_text.cmi : \ + ocamldoc/odoc_types.cmi +ocamldoc/odoc_text_lexer.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_text_parser.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_text_lexer.cmi +ocamldoc/odoc_text_lexer.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_text_parser.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_text_lexer.cmi +ocamldoc/odoc_text_lexer.cmi : \ + ocamldoc/odoc_text_parser.cmi +ocamldoc/odoc_text_parser.cmo : \ + otherlibs/str/str.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_misc.cmi \ + ocamldoc/odoc_text_parser.cmi +ocamldoc/odoc_text_parser.cmx : \ + otherlibs/str/str.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_misc.cmx \ + ocamldoc/odoc_text_parser.cmi +ocamldoc/odoc_text_parser.cmi : \ + ocamldoc/odoc_types.cmi +ocamldoc/odoc_to_text.cmo : \ + otherlibs/str/str.cmi \ + middle_end/flambda/parameter.cmi \ + ocamldoc/odoc_str.cmi \ + ocamldoc/odoc_module.cmi \ + ocamldoc/odoc_messages.cmi \ + ocamldoc/odoc_info.cmi \ + ocamldoc/odoc_to_text.cmi +ocamldoc/odoc_to_text.cmx : \ + otherlibs/str/str.cmx \ + middle_end/flambda/parameter.cmx \ + ocamldoc/odoc_str.cmx \ + ocamldoc/odoc_module.cmx \ + ocamldoc/odoc_messages.cmx \ + ocamldoc/odoc_info.cmx \ + ocamldoc/odoc_to_text.cmi +ocamldoc/odoc_to_text.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_info.cmi +ocamldoc/odoc_type.cmo : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_name.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_type.cmi +ocamldoc/odoc_type.cmx : \ + typing/types.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_name.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_type.cmi +ocamldoc/odoc_type.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_name.cmi \ + parsing/asttypes.cmi +ocamldoc/odoc_types.cmo : \ + ocamldoc/odoc_messages.cmi \ + parsing/location.cmi \ + ocamldoc/odoc_types.cmi +ocamldoc/odoc_types.cmx : \ + ocamldoc/odoc_messages.cmx \ + parsing/location.cmx \ + ocamldoc/odoc_types.cmi +ocamldoc/odoc_types.cmi : \ + parsing/location.cmi +ocamldoc/odoc_value.cmo : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_name.cmi \ + ocamldoc/odoc_misc.cmi \ + parsing/asttypes.cmi \ + ocamldoc/odoc_value.cmi +ocamldoc/odoc_value.cmx : \ + typing/types.cmx \ + ocamldoc/odoc_types.cmx \ + ocamldoc/odoc_parameter.cmx \ + ocamldoc/odoc_name.cmx \ + ocamldoc/odoc_misc.cmx \ + parsing/asttypes.cmi \ + ocamldoc/odoc_value.cmi +ocamldoc/odoc_value.cmi : \ + typing/types.cmi \ + ocamldoc/odoc_types.cmi \ + ocamldoc/odoc_parameter.cmi \ + ocamldoc/odoc_name.cmi ocamltest/actions.cmo : \ ocamltest/variables.cmi \ ocamltest/result.cmi \ diff --git a/Changes b/Changes index c8cd1faf34c..aa7c869ed2b 100644 --- a/Changes +++ b/Changes @@ -382,7 +382,7 @@ Working version ### Build system: -- #12198, #12321, #12586: continue the merge of the sub-makefiles +- #12198, #12321, #12586, #12616: continue the merge of the sub-makefiles into the root Makefile started with #11243, #11248, #11268, #11420 and #11675. (Sébastien Hinderer, review by David Allsopp and Florian Angeletti) diff --git a/Makefile b/Makefile index 2b51ed4e0ab..0b1efafc58f 100644 --- a/Makefile +++ b/Makefile @@ -528,7 +528,7 @@ $(foreach PROGRAM, $(C_PROGRAMS),\ # OCaml programs that are compiled in both bytecode and native code OCAML_PROGRAMS = ocamlc ocamlopt lex/ocamllex $(TOOLS_NAT_PROGRAMS) \ - ocamltest/ocamltest + ocamldoc/ocamldoc ocamltest/ocamltest $(foreach PROGRAM, $(OCAML_PROGRAMS),\ $(eval $(call OCAML_PROGRAM,$(PROGRAM)))) @@ -581,6 +581,10 @@ compilerlibs/ocamlcommon.cma: $(ALL_CONFIG_CMO) OCAML_LIBRARIES = $(COMPILERLIBS) +ifeq "$(build_ocamldoc)" "true" +OCAML_LIBRARIES += ocamldoc/odoc_info +endif + $(foreach LIBRARY, $(OCAML_LIBRARIES),\ $(eval $(call OCAML_LIBRARY,$(LIBRARY)))) @@ -742,6 +746,9 @@ ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true" $(MAKE) flexlink.opt$(EXE) endif $(MAKE) ocamlc.opt +# TODO: introduce OPTIONAL_LIBRARIES and OPTIONAL_TOOLS variables to be +# computed at configure time to keep track of which tools and libraries +# need to be built $(MAKE) otherlibraries $(WITH_DEBUGGER) $(OCAMLDOC_TARGET) \ $(WITH_OCAMLTEST) $(MAKE) ocamlopt.opt @@ -1528,8 +1535,7 @@ clean:: # Dependencies -subdirs = stdlib $(addprefix otherlibs/, $(ALL_OTHERLIBS)) \ - ocamldoc +subdirs = stdlib $(addprefix otherlibs/, $(ALL_OTHERLIBS)) .PHONY: alldepend alldepend: depend @@ -1674,13 +1680,85 @@ partialclean:: partialclean-menhir # OCamldoc +# First define the odoc_info library used to build OCamldoc + +odoc_info_SOURCES = $(addprefix ocamldoc/,\ + odoc_config.mli odoc_config.ml \ + odoc_messages.mli odoc_messages.ml \ + odoc_global.mli odoc_global.ml \ + odoc_types.mli odoc_types.ml \ + odoc_misc.mli odoc_misc.ml \ + odoc_text_parser.mly \ + odoc_text_lexer.mli odoc_text_lexer.mll \ + odoc_text.mli odoc_text.ml \ + odoc_name.mli odoc_name.ml \ + odoc_parameter.mli odoc_parameter.ml \ + odoc_value.mli odoc_value.ml \ + odoc_type.mli odoc_type.ml \ + odoc_extension.mli odoc_extension.ml \ + odoc_exception.mli odoc_exception.ml \ + odoc_class.mli odoc_class.ml \ + odoc_module.mli odoc_module.ml \ + odoc_print.mli odoc_print.ml \ + odoc_str.mli odoc_str.ml \ + odoc_comments_global.mli odoc_comments_global.ml \ + odoc_parser.mly \ + odoc_lexer.mli odoc_lexer.mll \ + odoc_see_lexer.mli odoc_see_lexer.mll \ + odoc_env.mli odoc_env.ml \ + odoc_merge.mli odoc_merge.ml \ + odoc_sig.mli odoc_sig.ml \ + odoc_ast.mli odoc_ast.ml \ + odoc_search.mli odoc_search.ml \ + odoc_scan.mli odoc_scan.ml \ + odoc_cross.mli odoc_cross.ml \ + odoc_comments.mli odoc_comments.ml \ + odoc_dep.mli odoc_dep.ml \ + odoc_analyse.mli odoc_analyse.ml \ + odoc_info.mli odoc_info.ml) + +ocamldoc_LIBRARIES = \ + compilerlibs/ocamlcommon \ + $(addprefix otherlibs/,\ + unix/unix \ + str/str \ + dynlink/dynlink) \ + ocamldoc/odoc_info + +ocamldoc_SOURCES = $(addprefix ocamldoc/,\ + odoc_dag2html.mli odoc_dag2html.ml \ + odoc_to_text.mli odoc_to_text.ml \ + odoc_ocamlhtml.mli odoc_ocamlhtml.mll \ + odoc_html.mli odoc_html.ml \ + odoc_man.mli odoc_man.ml \ + odoc_latex_style.mli odoc_latex_style.ml \ + odoc_latex.mli odoc_latex.ml \ + odoc_texi.mli odoc_texi.ml \ + odoc_dot.mli odoc_dot.ml \ + odoc_gen.mli odoc_gen.ml \ + odoc_args.mli odoc_args.ml \ + odoc.mli odoc.ml) + +# OCamldoc files to install (a subset of what is built) + +OCAMLDOC_LIBMLIS = $(addprefix ocamldoc/,$(addsuffix .mli,\ + odoc_dep odoc_dot odoc_extension odoc_html odoc_info odoc_latex \ + odoc_latex_style odoc_man odoc_messages odoc_ocamlhtml odoc_parameter \ + odoc_texi odoc_text_lexer odoc_to_text odoc_type odoc_value)) +OCAMLDOC_LIBCMIS=$(OCAMLDOC_LIBMLIS:.mli=.cmi) +OCAMLDOC_LIBCMTS=$(OCAMLDOC_LIBMLIS:.mli=.cmt) $(OCAMLDOC_LIBMLIS:.mli=.cmti) + +ocamldoc/%: CAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS) + .PHONY: ocamldoc -ocamldoc: ocamlc ocamlyacc ocamllex otherlibraries - $(MAKE) -C ocamldoc all +ocamldoc: ocamldoc/ocamldoc$(EXE) ocamldoc/odoc_test.cmo + +ocamldoc/ocamldoc$(EXE): ocamlc ocamlyacc ocamllex .PHONY: ocamldoc.opt -ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex - $(MAKE) -C ocamldoc opt.opt +ocamldoc.opt: ocamldoc/ocamldoc.opt$(EXE) + +ocamldoc/ocamldoc.opt$(EXE): ocamlc.opt ocamlyacc ocamllex # OCamltest @@ -1803,7 +1881,14 @@ manpages: $(MAKE) -C api_docgen man partialclean:: - $(MAKE) -C ocamldoc clean + rm -f ocamldoc/\#*\# + rm -f ocamldoc/*.cm[aiotx] ocamldoc/*.cmxa ocamldoc/*.cmti \ + ocamldoc/*.a ocamldoc/*.lib ocamldoc/*.o ocamldoc/*.obj + rm -f ocamldoc/odoc_parser.output ocamldoc/odoc_text_parser.output + rm -f ocamldoc/odoc_lexer.ml ocamldoc/odoc_text_lexer.ml \ + ocamldoc/odoc_see_lexer.ml ocamldoc/odoc_ocamlhtml.ml + rm -f ocamldoc/odoc_parser.ml ocamldoc/odoc_parser.mli \ + ocamldoc/odoc_text_parser.ml ocamldoc/odoc_text_parser.mli partialclean:: $(MAKE) -C api_docgen clean @@ -1826,6 +1911,10 @@ otherlibraries: ocamltools otherlibrariesopt: $(MAKE) -C otherlibs allopt +otherlibs/unix/unix.cmxa: otherlibrariesopt +otherlibs/dynlink/dynlink.cmxa: otherlibrariesopt +otherlibs/str/str.cmxa: otherlibrariesopt + partialclean:: $(MAKE) -C otherlibs partialclean @@ -1844,6 +1933,7 @@ ocamldebug_LIBRARIES = compilerlibs/ocamlcommon \ otherlibs/unix/unix.cma: otherlibraries otherlibs/dynlink/dynlink.cma: otherlibraries +otherlibs/str/str.cma: otherlibraries debugger/%: VPATH += otherlibs/unix otherlibs/dynlink @@ -2276,7 +2366,7 @@ depend: beforedepend lambda file_formats middle_end/closure middle_end/flambda \ middle_end/flambda/base_types \ driver toplevel toplevel/byte toplevel/native lex tools debugger \ - ocamltest; \ + ocamldoc ocamltest; \ do \ $(OCAMLDEP) $(OC_OCAMLDEPFLAGS) -I $$d $(INCLUDES) \ $(OCAMLDEPFLAGS) $$d/*.mli $$d/*.ml \ @@ -2286,7 +2376,7 @@ depend: beforedepend .PHONY: distclean distclean: clean $(MAKE) -C manual distclean - $(MAKE) -C ocamldoc distclean + rm -f ocamldoc/META rm -f $(addprefix ocamltest/,ocamltest_config.ml ocamltest_unix.ml) $(MAKE) -C otherlibs distclean rm -f $(runtime_CONFIGURED_HEADERS) @@ -2406,7 +2496,20 @@ endif $(MAKE) -C otherlibs/$$i install || exit $$?; \ done ifeq "$(build_ocamldoc)" "true" - $(MAKE) -C ocamldoc install + $(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc" + $(INSTALL_PROG) $(OCAMLDOC) "$(INSTALL_BINDIR)" + $(INSTALL_DATA) \ + ocamldoc/ocamldoc.hva ocamldoc/*.cmi ocamldoc/odoc_info.cma \ + ocamldoc/META \ + "$(INSTALL_LIBDIR)/ocamldoc" + $(INSTALL_DATA) \ + $(OCAMLDOC_LIBCMIS) \ + "$(INSTALL_LIBDIR)/ocamldoc" +ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true" + $(INSTALL_DATA) \ + $(OCAMLDOC_LIBMLIS) $(OCAMLDOC_LIBCMTS) \ + "$(INSTALL_LIBDIR)/ocamldoc" +endif endif ifeq "$(build_ocamldoc)-$(STDLIB_MANPAGES)" "true-true" $(MAKE) -C api_docgen install @@ -2495,7 +2598,20 @@ endif $(ocamlopt_CMO_FILES) \ "$(INSTALL_COMPLIBDIR)" ifeq "$(build_ocamldoc)" "true" - $(MAKE) -C ocamldoc installopt + $(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc" + $(INSTALL_PROG) $(OCAMLDOC_OPT) "$(INSTALL_BINDIR)" + $(INSTALL_DATA) \ + $(OCAMLDOC_LIBCMIS) \ + "$(INSTALL_LIBDIR)/ocamldoc" +ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true" + $(INSTALL_DATA) \ + $(OCAMLDOC_LIBMLIS) $(OCAMLDOC_LIBCMTS) \ + "$(INSTALL_LIBDIR)/ocamldoc" +endif + $(INSTALL_DATA) \ + ocamldoc/ocamldoc.hva ocamldoc/*.cmx ocamldoc/odoc_info.$(A) \ + ocamldoc/odoc_info.cmxa \ + "$(INSTALL_LIBDIR)/ocamldoc" endif for i in $(OTHERLIBRARIES); do \ $(MAKE) -C otherlibs/$$i installopt || exit $$?; \ diff --git a/ocamldoc/.depend b/ocamldoc/.depend deleted file mode 100644 index 76a3681c366..00000000000 --- a/ocamldoc/.depend +++ /dev/null @@ -1,965 +0,0 @@ -odoc.cmo : \ - odoc_messages.cmi \ - odoc_info.cmi \ - odoc_global.cmi \ - odoc_gen.cmi \ - odoc_config.cmi \ - odoc_args.cmi \ - odoc_analyse.cmi \ - odoc.cmi -odoc.cmx : \ - odoc_messages.cmx \ - odoc_info.cmx \ - odoc_global.cmx \ - odoc_gen.cmx \ - odoc_config.cmx \ - odoc_args.cmx \ - odoc_analyse.cmx \ - odoc.cmi -odoc.cmi : -odoc_analyse.cmo : \ - ../utils/warnings.cmi \ - ../parsing/unit_info.cmi \ - ../typing/types.cmi \ - ../typing/typemod.cmi \ - ../typing/typedtree.cmi \ - ../parsing/syntaxerr.cmi \ - ../driver/pparse.cmi \ - ../parsing/parse.cmi \ - odoc_types.cmi \ - odoc_text.cmi \ - odoc_sig.cmi \ - odoc_module.cmi \ - odoc_misc.cmi \ - odoc_messages.cmi \ - odoc_merge.cmi \ - odoc_global.cmi \ - odoc_dep.cmi \ - odoc_cross.cmi \ - odoc_comments.cmi \ - odoc_class.cmi \ - odoc_ast.cmi \ - ../parsing/location.cmi \ - ../parsing/lexer.cmi \ - ../typing/env.cmi \ - ../driver/compmisc.cmi \ - ../utils/clflags.cmi \ - odoc_analyse.cmi -odoc_analyse.cmx : \ - ../utils/warnings.cmx \ - ../parsing/unit_info.cmx \ - ../typing/types.cmx \ - ../typing/typemod.cmx \ - ../typing/typedtree.cmx \ - ../parsing/syntaxerr.cmx \ - ../driver/pparse.cmx \ - ../parsing/parse.cmx \ - odoc_types.cmx \ - odoc_text.cmx \ - odoc_sig.cmx \ - odoc_module.cmx \ - odoc_misc.cmx \ - odoc_messages.cmx \ - odoc_merge.cmx \ - odoc_global.cmx \ - odoc_dep.cmx \ - odoc_cross.cmx \ - odoc_comments.cmx \ - odoc_class.cmx \ - odoc_ast.cmx \ - ../parsing/location.cmx \ - ../parsing/lexer.cmx \ - ../typing/env.cmx \ - ../driver/compmisc.cmx \ - ../utils/clflags.cmx \ - odoc_analyse.cmi -odoc_analyse.cmi : \ - odoc_module.cmi \ - odoc_global.cmi -odoc_args.cmo : \ - odoc_types.cmi \ - odoc_texi.cmi \ - odoc_messages.cmi \ - odoc_man.cmi \ - odoc_latex.cmi \ - odoc_html.cmi \ - odoc_global.cmi \ - odoc_gen.cmi \ - odoc_dot.cmi \ - odoc_config.cmi \ - ../driver/main_args.cmi \ - ../utils/config.cmi \ - ../driver/compenv.cmi \ - odoc_args.cmi -odoc_args.cmx : \ - odoc_types.cmx \ - odoc_texi.cmx \ - odoc_messages.cmx \ - odoc_man.cmx \ - odoc_latex.cmx \ - odoc_html.cmx \ - odoc_global.cmx \ - odoc_gen.cmx \ - odoc_dot.cmx \ - odoc_config.cmx \ - ../driver/main_args.cmx \ - ../utils/config.cmx \ - ../driver/compenv.cmx \ - odoc_args.cmi -odoc_args.cmi : \ - odoc_gen.cmi -odoc_ast.cmo : \ - ../parsing/unit_info.cmi \ - ../typing/types.cmi \ - ../typing/typedtree.cmi \ - ../typing/predef.cmi \ - ../typing/path.cmi \ - ../parsing/parsetree.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_sig.cmi \ - odoc_parameter.cmi \ - odoc_module.cmi \ - odoc_messages.cmi \ - odoc_global.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_env.cmi \ - odoc_class.cmi \ - ../parsing/location.cmi \ - ../typing/ident.cmi \ - ../typing/btype.cmi \ - ../parsing/asttypes.cmi \ - odoc_ast.cmi -odoc_ast.cmx : \ - ../parsing/unit_info.cmx \ - ../typing/types.cmx \ - ../typing/typedtree.cmx \ - ../typing/predef.cmx \ - ../typing/path.cmx \ - ../parsing/parsetree.cmi \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_sig.cmx \ - odoc_parameter.cmx \ - odoc_module.cmx \ - odoc_messages.cmx \ - odoc_global.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_env.cmx \ - odoc_class.cmx \ - ../parsing/location.cmx \ - ../typing/ident.cmx \ - ../typing/btype.cmx \ - ../parsing/asttypes.cmi \ - odoc_ast.cmi -odoc_ast.cmi : \ - ../typing/types.cmi \ - ../typing/typedtree.cmi \ - ../parsing/parsetree.cmi \ - odoc_sig.cmi \ - odoc_name.cmi \ - odoc_module.cmi -odoc_class.cmo : \ - ../typing/types.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_parameter.cmi \ - odoc_name.cmi \ - odoc_class.cmi -odoc_class.cmx : \ - ../typing/types.cmx \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_parameter.cmx \ - odoc_name.cmx \ - odoc_class.cmi -odoc_class.cmi : \ - ../typing/types.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_parameter.cmi \ - odoc_name.cmi -odoc_comments.cmo : \ - odoc_types.cmi \ - odoc_text.cmi \ - odoc_see_lexer.cmi \ - odoc_parser.cmi \ - odoc_misc.cmi \ - odoc_messages.cmi \ - odoc_merge.cmi \ - odoc_lexer.cmi \ - odoc_global.cmi \ - odoc_cross.cmi \ - odoc_comments_global.cmi \ - odoc_comments.cmi -odoc_comments.cmx : \ - odoc_types.cmx \ - odoc_text.cmx \ - odoc_see_lexer.cmx \ - odoc_parser.cmx \ - odoc_misc.cmx \ - odoc_messages.cmx \ - odoc_merge.cmx \ - odoc_lexer.cmx \ - odoc_global.cmx \ - odoc_cross.cmx \ - odoc_comments_global.cmx \ - odoc_comments.cmi -odoc_comments.cmi : \ - odoc_types.cmi \ - odoc_module.cmi -odoc_comments_global.cmo : \ - odoc_comments_global.cmi -odoc_comments_global.cmx : \ - odoc_comments_global.cmi -odoc_comments_global.cmi : -odoc_config.cmo : \ - ../utils/config.cmi \ - odoc_config.cmi -odoc_config.cmx : \ - ../utils/config.cmx \ - odoc_config.cmi -odoc_config.cmi : -odoc_cross.cmo : \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_search.cmi \ - odoc_scan.cmi \ - odoc_parameter.cmi \ - odoc_name.cmi \ - odoc_module.cmi \ - odoc_misc.cmi \ - odoc_messages.cmi \ - odoc_global.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - ../utils/misc.cmi \ - odoc_cross.cmi -odoc_cross.cmx : \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_search.cmx \ - odoc_scan.cmx \ - odoc_parameter.cmx \ - odoc_name.cmx \ - odoc_module.cmx \ - odoc_misc.cmx \ - odoc_messages.cmx \ - odoc_global.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_class.cmx \ - ../utils/misc.cmx \ - odoc_cross.cmi -odoc_cross.cmi : \ - odoc_types.cmi \ - odoc_module.cmi -odoc_dag2html.cmo : \ - odoc_info.cmi \ - odoc_dag2html.cmi -odoc_dag2html.cmx : \ - odoc_info.cmx \ - odoc_dag2html.cmi -odoc_dag2html.cmi : \ - odoc_info.cmi -odoc_dep.cmo : \ - ../parsing/parsetree.cmi \ - odoc_type.cmi \ - odoc_print.cmi \ - odoc_module.cmi \ - ../utils/misc.cmi \ - ../parsing/depend.cmi \ - odoc_dep.cmi -odoc_dep.cmx : \ - ../parsing/parsetree.cmi \ - odoc_type.cmx \ - odoc_print.cmx \ - odoc_module.cmx \ - ../utils/misc.cmx \ - ../parsing/depend.cmx \ - odoc_dep.cmi -odoc_dep.cmi : \ - ../parsing/parsetree.cmi \ - odoc_type.cmi \ - odoc_module.cmi \ - ../utils/misc.cmi -odoc_dot.cmo : \ - odoc_messages.cmi \ - odoc_info.cmi \ - odoc_dot.cmi -odoc_dot.cmx : \ - odoc_messages.cmx \ - odoc_info.cmx \ - odoc_dot.cmi -odoc_dot.cmi : \ - odoc_info.cmi -odoc_env.cmo : \ - ../typing/types.cmi \ - ../typing/predef.cmi \ - ../typing/path.cmi \ - odoc_name.cmi \ - ../typing/btype.cmi \ - odoc_env.cmi -odoc_env.cmx : \ - ../typing/types.cmx \ - ../typing/predef.cmx \ - ../typing/path.cmx \ - odoc_name.cmx \ - ../typing/btype.cmx \ - odoc_env.cmi -odoc_env.cmi : \ - ../typing/types.cmi \ - odoc_name.cmi -odoc_exception.cmo : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_name.cmi \ - odoc_exception.cmi -odoc_exception.cmx : \ - ../typing/types.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_name.cmx \ - odoc_exception.cmi -odoc_exception.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_name.cmi -odoc_extension.cmo : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_name.cmi \ - ../parsing/asttypes.cmi \ - odoc_extension.cmi -odoc_extension.cmx : \ - ../typing/types.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_name.cmx \ - ../parsing/asttypes.cmi \ - odoc_extension.cmi -odoc_extension.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_name.cmi \ - ../parsing/asttypes.cmi -odoc_gen.cmo : \ - odoc_texi.cmi \ - odoc_module.cmi \ - odoc_man.cmi \ - odoc_latex.cmi \ - odoc_html.cmi \ - odoc_dot.cmi \ - odoc_gen.cmi -odoc_gen.cmx : \ - odoc_texi.cmx \ - odoc_module.cmx \ - odoc_man.cmx \ - odoc_latex.cmx \ - odoc_html.cmx \ - odoc_dot.cmx \ - odoc_gen.cmi -odoc_gen.cmi : \ - odoc_texi.cmi \ - odoc_module.cmi \ - odoc_man.cmi \ - odoc_latex.cmi \ - odoc_html.cmi \ - odoc_dot.cmi -odoc_global.cmo : \ - odoc_types.cmi \ - odoc_messages.cmi \ - odoc_config.cmi \ - ../utils/clflags.cmi \ - odoc_global.cmi -odoc_global.cmx : \ - odoc_types.cmx \ - odoc_messages.cmx \ - odoc_config.cmx \ - ../utils/clflags.cmx \ - odoc_global.cmi -odoc_global.cmi : \ - odoc_types.cmi -odoc_html.cmo : \ - odoc_text.cmi \ - odoc_ocamlhtml.cmi \ - odoc_messages.cmi \ - odoc_info.cmi \ - odoc_global.cmi \ - odoc_dag2html.cmi \ - ../utils/misc.cmi \ - ../parsing/asttypes.cmi \ - odoc_html.cmi -odoc_html.cmx : \ - odoc_text.cmx \ - odoc_ocamlhtml.cmx \ - odoc_messages.cmx \ - odoc_info.cmx \ - odoc_global.cmx \ - odoc_dag2html.cmx \ - ../utils/misc.cmx \ - ../parsing/asttypes.cmi \ - odoc_html.cmi -odoc_html.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_parameter.cmi \ - odoc_info.cmi \ - odoc_dag2html.cmi \ - ../utils/misc.cmi -odoc_info.cmo : \ - ../typing/printtyp.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_text.cmi \ - odoc_str.cmi \ - odoc_search.cmi \ - odoc_scan.cmi \ - odoc_print.cmi \ - odoc_parameter.cmi \ - odoc_name.cmi \ - odoc_module.cmi \ - odoc_misc.cmi \ - odoc_global.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_dep.cmi \ - odoc_config.cmi \ - odoc_comments.cmi \ - odoc_class.cmi \ - odoc_analyse.cmi \ - ../parsing/location.cmi \ - odoc_info.cmi -odoc_info.cmx : \ - ../typing/printtyp.cmx \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_text.cmx \ - odoc_str.cmx \ - odoc_search.cmx \ - odoc_scan.cmx \ - odoc_print.cmx \ - odoc_parameter.cmx \ - odoc_name.cmx \ - odoc_module.cmx \ - odoc_misc.cmx \ - odoc_global.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_dep.cmx \ - odoc_config.cmx \ - odoc_comments.cmx \ - odoc_class.cmx \ - odoc_analyse.cmx \ - ../parsing/location.cmx \ - odoc_info.cmi -odoc_info.cmi : \ - ../typing/types.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_search.cmi \ - odoc_parameter.cmi \ - odoc_module.cmi \ - odoc_global.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - ../parsing/location.cmi \ - ../parsing/asttypes.cmi -odoc_latex.cmo : \ - odoc_to_text.cmi \ - odoc_messages.cmi \ - odoc_latex_style.cmi \ - odoc_info.cmi \ - ../parsing/asttypes.cmi \ - odoc_latex.cmi -odoc_latex.cmx : \ - odoc_to_text.cmx \ - odoc_messages.cmx \ - odoc_latex_style.cmx \ - odoc_info.cmx \ - ../parsing/asttypes.cmi \ - odoc_latex.cmi -odoc_latex.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_info.cmi -odoc_latex_style.cmo : \ - odoc_latex_style.cmi -odoc_latex_style.cmx : \ - odoc_latex_style.cmi -odoc_latex_style.cmi : -odoc_lexer.cmo : \ - odoc_parser.cmi \ - odoc_messages.cmi \ - odoc_global.cmi \ - odoc_comments_global.cmi \ - odoc_lexer.cmi -odoc_lexer.cmx : \ - odoc_parser.cmx \ - odoc_messages.cmx \ - odoc_global.cmx \ - odoc_comments_global.cmx \ - odoc_lexer.cmi -odoc_lexer.cmi : \ - odoc_parser.cmi -odoc_man.cmo : \ - odoc_str.cmi \ - odoc_print.cmi \ - odoc_misc.cmi \ - odoc_messages.cmi \ - odoc_info.cmi \ - ../parsing/asttypes.cmi \ - odoc_man.cmi -odoc_man.cmx : \ - odoc_str.cmx \ - odoc_print.cmx \ - odoc_misc.cmx \ - odoc_messages.cmx \ - odoc_info.cmx \ - ../parsing/asttypes.cmi \ - odoc_man.cmi -odoc_man.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_info.cmi -odoc_merge.cmo : \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_parameter.cmi \ - odoc_module.cmi \ - odoc_messages.cmi \ - odoc_global.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - odoc_merge.cmi -odoc_merge.cmx : \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_parameter.cmx \ - odoc_module.cmx \ - odoc_messages.cmx \ - odoc_global.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_class.cmx \ - odoc_merge.cmi -odoc_merge.cmi : \ - odoc_types.cmi \ - odoc_module.cmi -odoc_messages.cmo : \ - ../utils/config.cmi \ - odoc_messages.cmi -odoc_messages.cmx : \ - ../utils/config.cmx \ - odoc_messages.cmi -odoc_messages.cmi : -odoc_misc.cmo : \ - ../typing/types.cmi \ - ../typing/predef.cmi \ - ../typing/path.cmi \ - odoc_types.cmi \ - odoc_messages.cmi \ - ../parsing/longident.cmi \ - ../typing/btype.cmi \ - odoc_misc.cmi -odoc_misc.cmx : \ - ../typing/types.cmx \ - ../typing/predef.cmx \ - ../typing/path.cmx \ - odoc_types.cmx \ - odoc_messages.cmx \ - ../parsing/longident.cmx \ - ../typing/btype.cmx \ - odoc_misc.cmi -odoc_misc.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - ../parsing/longident.cmi \ - ../parsing/asttypes.cmi -odoc_module.cmo : \ - ../typing/types.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_name.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - ../utils/misc.cmi \ - odoc_module.cmi -odoc_module.cmx : \ - ../typing/types.cmx \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_name.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_class.cmx \ - ../utils/misc.cmx \ - odoc_module.cmi -odoc_module.cmi : \ - ../typing/types.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_name.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - ../utils/misc.cmi -odoc_name.cmo : \ - ../parsing/unit_info.cmi \ - ../typing/path.cmi \ - odoc_misc.cmi \ - ../typing/ident.cmi \ - odoc_name.cmi -odoc_name.cmx : \ - ../parsing/unit_info.cmx \ - ../typing/path.cmx \ - odoc_misc.cmx \ - ../typing/ident.cmx \ - odoc_name.cmi -odoc_name.cmi : \ - ../typing/path.cmi \ - ../parsing/longident.cmi \ - ../typing/ident.cmi -odoc_ocamlhtml.cmo : \ - odoc_ocamlhtml.cmi -odoc_ocamlhtml.cmx : \ - odoc_ocamlhtml.cmi -odoc_ocamlhtml.cmi : -odoc_parameter.cmo : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_parameter.cmi -odoc_parameter.cmx : \ - ../typing/types.cmx \ - odoc_types.cmx \ - odoc_parameter.cmi -odoc_parameter.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi -odoc_parser.cmo : \ - odoc_types.cmi \ - odoc_comments_global.cmi \ - odoc_parser.cmi -odoc_parser.cmx : \ - odoc_types.cmx \ - odoc_comments_global.cmx \ - odoc_parser.cmi -odoc_parser.cmi : \ - odoc_types.cmi -odoc_print.cmo : \ - ../typing/types.cmi \ - ../typing/printtyp.cmi \ - ../typing/btype.cmi \ - odoc_print.cmi -odoc_print.cmx : \ - ../typing/types.cmx \ - ../typing/printtyp.cmx \ - ../typing/btype.cmx \ - odoc_print.cmi -odoc_print.cmi : \ - ../typing/types.cmi -odoc_scan.cmo : \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_module.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - odoc_scan.cmi -odoc_scan.cmx : \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_module.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_class.cmx \ - odoc_scan.cmi -odoc_scan.cmi : \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_module.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi -odoc_search.cmo : \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_module.cmi \ - odoc_misc.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - odoc_search.cmi -odoc_search.cmx : \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_module.cmx \ - odoc_misc.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_class.cmx \ - odoc_search.cmi -odoc_search.cmi : \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_module.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi -odoc_see_lexer.cmo : \ - odoc_parser.cmi \ - odoc_see_lexer.cmi -odoc_see_lexer.cmx : \ - odoc_parser.cmx \ - odoc_see_lexer.cmi -odoc_see_lexer.cmi : \ - odoc_parser.cmi -odoc_sig.cmo : \ - ../parsing/unit_info.cmi \ - ../typing/types.cmi \ - ../typing/typedtree.cmi \ - ../parsing/parsetree.cmi \ - odoc_value.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_parameter.cmi \ - odoc_module.cmi \ - odoc_misc.cmi \ - odoc_messages.cmi \ - odoc_merge.cmi \ - odoc_global.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_env.cmi \ - odoc_class.cmi \ - ../parsing/longident.cmi \ - ../parsing/location.cmi \ - ../typing/ident.cmi \ - ../typing/ctype.cmi \ - ../typing/btype.cmi \ - ../parsing/asttypes.cmi \ - odoc_sig.cmi -odoc_sig.cmx : \ - ../parsing/unit_info.cmx \ - ../typing/types.cmx \ - ../typing/typedtree.cmx \ - ../parsing/parsetree.cmi \ - odoc_value.cmx \ - odoc_types.cmx \ - odoc_type.cmx \ - odoc_parameter.cmx \ - odoc_module.cmx \ - odoc_misc.cmx \ - odoc_messages.cmx \ - odoc_merge.cmx \ - odoc_global.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_env.cmx \ - odoc_class.cmx \ - ../parsing/longident.cmx \ - ../parsing/location.cmx \ - ../typing/ident.cmx \ - ../typing/ctype.cmx \ - ../typing/btype.cmx \ - ../parsing/asttypes.cmi \ - odoc_sig.cmi -odoc_sig.cmi : \ - ../typing/types.cmi \ - ../typing/typedtree.cmi \ - ../parsing/parsetree.cmi \ - odoc_types.cmi \ - odoc_type.cmi \ - odoc_name.cmi \ - odoc_module.cmi \ - odoc_env.cmi \ - odoc_class.cmi \ - ../parsing/location.cmi -odoc_str.cmo : \ - ../typing/types.cmi \ - ../typing/printtyp.cmi \ - odoc_value.cmi \ - odoc_type.cmi \ - odoc_print.cmi \ - odoc_name.cmi \ - odoc_misc.cmi \ - odoc_messages.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi \ - ../parsing/asttypes.cmi \ - odoc_str.cmi -odoc_str.cmx : \ - ../typing/types.cmx \ - ../typing/printtyp.cmx \ - odoc_value.cmx \ - odoc_type.cmx \ - odoc_print.cmx \ - odoc_name.cmx \ - odoc_misc.cmx \ - odoc_messages.cmx \ - odoc_extension.cmx \ - odoc_exception.cmx \ - odoc_class.cmx \ - ../parsing/asttypes.cmi \ - odoc_str.cmi -odoc_str.cmi : \ - ../typing/types.cmi \ - odoc_value.cmi \ - odoc_type.cmi \ - odoc_extension.cmi \ - odoc_exception.cmi \ - odoc_class.cmi -odoc_test.cmo : \ - odoc_info.cmi \ - odoc_gen.cmi \ - odoc_args.cmi \ - odoc_test.cmi -odoc_test.cmx : \ - odoc_info.cmx \ - odoc_gen.cmx \ - odoc_args.cmx \ - odoc_test.cmi -odoc_test.cmi : -odoc_texi.cmo : \ - ../typing/types.cmi \ - odoc_to_text.cmi \ - odoc_messages.cmi \ - odoc_info.cmi \ - ../parsing/asttypes.cmi \ - odoc_texi.cmi -odoc_texi.cmx : \ - ../typing/types.cmx \ - odoc_to_text.cmx \ - odoc_messages.cmx \ - odoc_info.cmx \ - ../parsing/asttypes.cmi \ - odoc_texi.cmi -odoc_texi.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_info.cmi -odoc_text.cmo : \ - odoc_types.cmi \ - odoc_text_parser.cmi \ - odoc_text_lexer.cmi \ - odoc_text.cmi -odoc_text.cmx : \ - odoc_types.cmx \ - odoc_text_parser.cmx \ - odoc_text_lexer.cmx \ - odoc_text.cmi -odoc_text.cmi : \ - odoc_types.cmi -odoc_text_lexer.cmo : \ - odoc_text_parser.cmi \ - odoc_misc.cmi \ - odoc_text_lexer.cmi -odoc_text_lexer.cmx : \ - odoc_text_parser.cmx \ - odoc_misc.cmx \ - odoc_text_lexer.cmi -odoc_text_lexer.cmi : \ - odoc_text_parser.cmi -odoc_text_parser.cmo : \ - odoc_types.cmi \ - odoc_misc.cmi \ - odoc_text_parser.cmi -odoc_text_parser.cmx : \ - odoc_types.cmx \ - odoc_misc.cmx \ - odoc_text_parser.cmi -odoc_text_parser.cmi : \ - odoc_types.cmi -odoc_to_text.cmo : \ - odoc_str.cmi \ - odoc_module.cmi \ - odoc_messages.cmi \ - odoc_info.cmi \ - odoc_to_text.cmi -odoc_to_text.cmx : \ - odoc_str.cmx \ - odoc_module.cmx \ - odoc_messages.cmx \ - odoc_info.cmx \ - odoc_to_text.cmi -odoc_to_text.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_info.cmi -odoc_type.cmo : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_name.cmi \ - ../parsing/asttypes.cmi \ - odoc_type.cmi -odoc_type.cmx : \ - ../typing/types.cmx \ - odoc_types.cmx \ - odoc_name.cmx \ - ../parsing/asttypes.cmi \ - odoc_type.cmi -odoc_type.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_name.cmi \ - ../parsing/asttypes.cmi -odoc_types.cmo : \ - odoc_messages.cmi \ - ../parsing/location.cmi \ - odoc_types.cmi -odoc_types.cmx : \ - odoc_messages.cmx \ - ../parsing/location.cmx \ - odoc_types.cmi -odoc_types.cmi : \ - ../parsing/location.cmi -odoc_value.cmo : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_parameter.cmi \ - odoc_name.cmi \ - odoc_misc.cmi \ - ../parsing/asttypes.cmi \ - odoc_value.cmi -odoc_value.cmx : \ - ../typing/types.cmx \ - odoc_types.cmx \ - odoc_parameter.cmx \ - odoc_name.cmx \ - odoc_misc.cmx \ - ../parsing/asttypes.cmi \ - odoc_value.cmi -odoc_value.cmi : \ - ../typing/types.cmi \ - odoc_types.cmi \ - odoc_parameter.cmi \ - odoc_name.cmi diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile deleted file mode 100644 index 6efbf11ed1c..00000000000 --- a/ocamldoc/Makefile +++ /dev/null @@ -1,254 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Maxence Guesdon, 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. * -#* * -#************************************************************************** - -ROOTDIR = .. - -include $(ROOTDIR)/Makefile.common -include $(ROOTDIR)/Makefile.best_binaries - -OCAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS) -OCAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS) - -# For installation -############## - -programs := ocamldoc ocamldoc.opt - -OCAMLDOC_LIBCMA=odoc_info.cma -OCAMLDOC_LIBCMI=odoc_info.cmi -OCAMLDOC_LIBCMXA=odoc_info.cmxa -OCAMLDOC_LIBA=odoc_info.$(A) - -OCAMLDOC_LIBMLIS=$(addsuffix .mli,\ - odoc_dep odoc_dot odoc_extension odoc_html odoc_info odoc_latex \ - odoc_latex_style odoc_man odoc_messages odoc_ocamlhtml odoc_parameter \ - odoc_texi odoc_text_lexer odoc_to_text odoc_type odoc_value) -OCAMLDOC_LIBCMIS=$(OCAMLDOC_LIBMLIS:.mli=.cmi) -OCAMLDOC_LIBCMTS=$(OCAMLDOC_LIBMLIS:.mli=.cmt) $(OCAMLDOC_LIBMLIS:.mli=.cmti) - -ODOC_TEST=odoc_test.cmo - -# Compilation -############# - - -INCLUDE_DIRS = $(addprefix $(ROOTDIR)/,\ - utils parsing typing driver bytecomp toplevel) -INCLUDES_DEP = $(addprefix -I ,$(INCLUDE_DIRS)) -INCLUDES_NODEP = $(addprefix -I $(ROOTDIR)/,\ - compilerlibs otherlibs/str otherlibs/dynlink \ - otherlibs/dynlink/native otherlibs/unix) - -OC_OCAMLDEPDIRS = $(INCLUDE_DIRS) -INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP) - -COMPFLAGS = \ - -g $(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error +A \ - -strict-sequence -strict-formats -bin-annot -principal - -LINKFLAGS = $(INCLUDES) - -CMOFILES=\ - odoc_config.cmo \ - odoc_messages.cmo \ - odoc_global.cmo \ - odoc_types.cmo \ - odoc_misc.cmo \ - odoc_text_parser.cmo \ - odoc_text_lexer.cmo \ - odoc_text.cmo \ - odoc_name.cmo \ - odoc_parameter.cmo \ - odoc_value.cmo \ - odoc_type.cmo \ - odoc_extension.cmo \ - odoc_exception.cmo \ - odoc_class.cmo \ - odoc_module.cmo \ - odoc_print.cmo \ - odoc_str.cmo \ - odoc_comments_global.cmo \ - odoc_parser.cmo \ - odoc_lexer.cmo \ - odoc_see_lexer.cmo \ - odoc_env.cmo \ - odoc_merge.cmo \ - odoc_sig.cmo \ - odoc_ast.cmo \ - odoc_search.cmo \ - odoc_scan.cmo \ - odoc_cross.cmo \ - odoc_comments.cmo \ - odoc_dep.cmo \ - odoc_analyse.cmo \ - odoc_info.cmo - -CMXFILES = $(CMOFILES:.cmo=.cmx) -CMIFILES = $(CMOFILES:.cmo=.cmi) - -EXECMOFILES=\ - $(CMOFILES) \ - odoc_dag2html.cmo \ - odoc_to_text.cmo \ - odoc_ocamlhtml.cmo \ - odoc_html.cmo \ - odoc_man.cmo \ - odoc_latex_style.cmo \ - odoc_latex.cmo \ - odoc_texi.cmo \ - odoc_dot.cmo \ - odoc_gen.cmo \ - odoc_args.cmo \ - odoc.cmo - -EXECMXFILES = $(EXECMOFILES:.cmo=.cmx) -EXECMIFILES = $(EXECMOFILES:.cmo=.cmi) - -LIBCMOFILES = $(CMOFILES) -LIBCMXFILES = $(LIBCMOFILES:.cmo=.cmx) -LIBCMIFILES = $(LIBCMOFILES:.cmo=.cmi) - -.PHONY: all -all: lib exe - -.PHONY: exe -exe: $(OCAMLDOC) - -.PHONY: lib -lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI) $(ODOC_TEST) - -.PHONY: opt.opt allopt # allopt and opt.opt are synonyms -opt.opt: exeopt libopt -allopt: opt.opt - -.PHONY: exeopt -exeopt: $(OCAMLDOC_OPT) - -.PHONY: libopt -libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) - -OCAMLDOC_LIBRARIES = ocamlcommon unix str dynlink - -OCAMLDOC_BCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cma) -OCAMLDOC_NCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cmxa) - -$(eval $(call PROGRAM_SYNONYM,ocamldoc)) - -$(OCAMLDOC): $(EXECMOFILES) - $(V_LINKC)$(OCAMLC) -o $@ -linkall $(LINKFLAGS) $(OCAMLDOC_BCLIBRARIES) $^ - -$(eval $(call PROGRAM_SYNONYM,ocamldoc.opt)) - -$(OCAMLDOC_OPT): $(EXECMXFILES) - $(V_LINKOPT)$(OCAMLOPT) -o $@ -linkall $(LINKFLAGS) $(OCAMLDOC_NCLIBRARIES) $^ - -$(OCAMLDOC_LIBCMA): $(LIBCMOFILES) - $(V_LINKC)$(OCAMLC) -a -o $@ $(LINKFLAGS) $^ - -$(OCAMLDOC_LIBCMXA): $(LIBCMXFILES) - $(V_LINKOPT)$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $^ - -# Lexers and parsers - -LEXERS = $(addsuffix .mll,\ - odoc_text_lexer odoc_lexer odoc_ocamlhtml odoc_see_lexer) - -PARSERS = $(addsuffix .mly,odoc_parser odoc_text_parser) - -DEPEND_PREREQS = $(LEXERS:.mll=.ml) \ - $(PARSERS:.mly=.mli) $(PARSERS:.mly=.ml) - -# generic rules : -################# - -%.cmo: %.ml - $(V_OCAMLC)$(OCAMLC) $(COMPFLAGS) -c $< - -%.cmi: %.mli - $(V_OCAMLC)$(OCAMLC) $(COMPFLAGS) -c $< - -%.cmx: %.ml - $(V_OCAMLOPT)$(OCAMLOPT) $(COMPFLAGS) -c $< - -# Installation targets -###################### - -# TODO: it may be good to split the following rule in several ones, e.g. -# install-programs, install-doc, install-libs - -.PHONY: install -install: - $(MKDIR) "$(INSTALL_BINDIR)" - $(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc" - $(INSTALL_PROG) $(OCAMLDOC) "$(INSTALL_BINDIR)" - $(INSTALL_DATA) \ - ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) META \ - "$(INSTALL_LIBDIR)/ocamldoc" - $(INSTALL_DATA) \ - $(OCAMLDOC_LIBCMIS) \ - "$(INSTALL_LIBDIR)/ocamldoc" -ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true" - $(INSTALL_DATA) \ - $(OCAMLDOC_LIBMLIS) $(OCAMLDOC_LIBCMTS) \ - "$(INSTALL_LIBDIR)/ocamldoc" -endif - -# Note: at the moment, $(INSTALL_MANODIR) is created even if the doc has -# not been built. This is not clean and should be changed. - -.PHONY: installopt -installopt: - if test -f $(OCAMLDOC_OPT); then $(MAKE) installopt_really ; fi - -.PHONY: installopt_really -installopt_really: - $(MKDIR) "$(INSTALL_BINDIR)" - $(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc" - $(INSTALL_PROG) $(OCAMLDOC_OPT) "$(INSTALL_BINDIR)" - $(INSTALL_DATA) \ - $(OCAMLDOC_LIBCMIS) \ - "$(INSTALL_LIBDIR)/ocamldoc" -ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true" - $(INSTALL_DATA) \ - $(OCAMLDOC_LIBMLIS) $(OCAMLDOC_LIBCMTS) \ - "$(INSTALL_LIBDIR)/ocamldoc" -endif - $(INSTALL_DATA) \ - ocamldoc.hva *.cmx $(OCAMLDOC_LIBA) $(OCAMLDOC_LIBCMXA) \ - "$(INSTALL_LIBDIR)/ocamldoc" - -# TODO: also split into several rules - -# backup, clean and depend : -############################ - -.PHONY: clean -clean: - rm -f \#*\# - rm -f $(programs) $(programs:=.exe) - rm -f *.cma *.cmxa *.cmo *.cmi *.cmx *.cmt *.cmti *.a *.lib *.o *.obj - rm -f odoc_parser.output odoc_text_parser.output - rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml - rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli - -.PHONY: distclean -distclean: clean - rm -f META - -.PHONY: depend -depend: $(DEPEND_PREREQS) - $(OCAMLDEP_CMD) *.mll *.mly *.ml *.mli > .depend - -include .depend From cb3e23055d410e8719058556fc78f4fb55c21f90 Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Thu, 19 Oct 2023 15:53:02 +0200 Subject: [PATCH 218/402] Rename the STDLIB_MANPAGES config var to build_libraries_manpages STDLIB_MANPAGES is still defined in Makefile.config.in for backwards compatibility, whereas build_libraries_manpages is defined in Maekfile.build_config.in and thus remains private. Co-authored-by: David Allsopp --- Makefile | 6 +++--- Makefile.build_config.in | 1 + Makefile.config.in | 2 +- configure | 6 +++--- configure.ac | 4 ++-- 5 files changed, 10 insertions(+), 9 deletions(-) diff --git a/Makefile b/Makefile index 0b1efafc58f..3ccc4ea1ddc 100644 --- a/Makefile +++ b/Makefile @@ -756,7 +756,7 @@ endif $(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt \ $(OCAMLDOC_OPT_TARGET) \ $(OCAMLTEST_OPT) othertools ocamlnat -ifeq "$(build_ocamldoc)-$(STDLIB_MANPAGES)" "true-true" +ifeq "$(build_ocamldoc)-$(build_libraries_manpages)" "true-true" $(MAKE) manpages endif @@ -796,7 +796,7 @@ all: coreall $(MAKE) otherlibraries $(WITH_DEBUGGER) $(OCAMLDOC_TARGET) \ $(WITH_OCAMLTEST) $(MAKE) othertools -ifeq "$(build_ocamldoc)-$(STDLIB_MANPAGES)" "true-true" +ifeq "$(build_ocamldoc)-$(build_libraries_manpages)" "true-true" $(MAKE) manpages endif @@ -2511,7 +2511,7 @@ ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true" "$(INSTALL_LIBDIR)/ocamldoc" endif endif -ifeq "$(build_ocamldoc)-$(STDLIB_MANPAGES)" "true-true" +ifeq "$(build_ocamldoc)-$(build_libraries_manpages)" "true-true" $(MAKE) -C api_docgen install endif if test -n "$(WITH_DEBUGGER)"; then \ diff --git a/Makefile.build_config.in b/Makefile.build_config.in index d09a5fab4bf..6d4442d2dc2 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -34,6 +34,7 @@ INSTALL_PROG ?= @INSTALL_PROGRAM@ build_ocamldebug = @build_ocamldebug@ build_ocamldoc = @build_ocamldoc@ +build_libraries_manpages = @build_libraries_manpages@ OCAMLDOC_TARGET = @ocamldoc_target@ diff --git a/Makefile.config.in b/Makefile.config.in index d959657ee42..4c49ad77a5d 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -222,13 +222,13 @@ AFL_INSTRUMENT=@afl@ FLAT_FLOAT_ARRAY=@flat_float_array@ FUNCTION_SECTIONS=@function_sections@ AWK=@AWK@ -STDLIB_MANPAGES=@stdlib_manpages@ NAKED_POINTERS=false # Deprecated variables ## Variables deprecated since OCaml 5.2 +STDLIB_MANPAGES=@build_libraries_manpages@ WITH_OCAMLDOC=@with_ocamldoc@ ## Variables deprecated since OCaml 5.0 diff --git a/configure b/configure index ab89dfc1e10..7b286bc204a 100755 --- a/configure +++ b/configure @@ -785,7 +785,7 @@ QS ocaml_libdir ocaml_bindir compute_deps -stdlib_manpages +build_libraries_manpages PACKLD mkexe_ldflags_exp mkdll_ldflags_exp @@ -20137,9 +20137,9 @@ esac if test x"$enable_stdlib_manpages" != "xno" then : - stdlib_manpages=true + build_libraries_manpages=true else $as_nop - stdlib_manpages=false + build_libraries_manpages=false fi # Do not permanently cache the result of flexdll.h diff --git a/configure.ac b/configure.ac index 0b8eb736a62..6e9337e8657 100644 --- a/configure.ac +++ b/configure.ac @@ -217,7 +217,7 @@ AC_SUBST([flexdll_chain]) AC_SUBST([mkdll_ldflags_exp]) AC_SUBST([mkexe_ldflags_exp]) AC_SUBST([PACKLD]) -AC_SUBST([stdlib_manpages]) +AC_SUBST([build_libraries_manpages]) AC_SUBST([compute_deps]) AC_SUBST([ocaml_bindir]) AC_SUBST([ocaml_libdir]) @@ -2448,7 +2448,7 @@ AS_CASE([$host], [AC_DEFINE([HAS_BROKEN_PRINTF])]) AS_IF([test x"$enable_stdlib_manpages" != "xno"], - [stdlib_manpages=true],[stdlib_manpages=false]) + [build_libraries_manpages=true],[build_libraries_manpages=false]) # Do not permanently cache the result of flexdll.h unset ac_cv_header_flexdll_h From 53f2a93e4f945e5e81c0141593beadc64cea9ace Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Thu, 19 Oct 2023 20:38:37 +0200 Subject: [PATCH 219/402] Make the build_libraries_manpages configuration variable more accurate Before this commit, the build_libraries_manpages variable (aka STDLIB_MANPAGES) was set to true if the build of the manpages for libraries was enabled at configure time, whether ocamldoc (which is required to build those manpages) was enabled or not. It was thus the build system's responsibility to determine whether the manpages for libraries should be built / installed, by testing both the build_ocamldoc and the build_libraries_manpages variables. However, it is known at configure time whether ocamldoc is available or not, which makes it possible to set build_libraries_manpages to true only if the manpages for libraries have been requested AND ocamldoc has been enabled. This is what is done in this commit, leading to a simplification on the build system's side since it becomes enough to test only one variable, namely build_libraries_manpages, rather than two like before. Co-authored-by: David Allsopp --- Makefile | 6 +++--- configure | 47 +++++++++++++++++++++++++++-------------------- configure.ac | 35 ++++++++++++++++++++--------------- 3 files changed, 50 insertions(+), 38 deletions(-) diff --git a/Makefile b/Makefile index 3ccc4ea1ddc..5453eace267 100644 --- a/Makefile +++ b/Makefile @@ -756,7 +756,7 @@ endif $(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt \ $(OCAMLDOC_OPT_TARGET) \ $(OCAMLTEST_OPT) othertools ocamlnat -ifeq "$(build_ocamldoc)-$(build_libraries_manpages)" "true-true" +ifeq "$(build_libraries_manpages)" "true" $(MAKE) manpages endif @@ -796,7 +796,7 @@ all: coreall $(MAKE) otherlibraries $(WITH_DEBUGGER) $(OCAMLDOC_TARGET) \ $(WITH_OCAMLTEST) $(MAKE) othertools -ifeq "$(build_ocamldoc)-$(build_libraries_manpages)" "true-true" +ifeq "$(build_libraries_manpages)" "true" $(MAKE) manpages endif @@ -2511,7 +2511,7 @@ ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true" "$(INSTALL_LIBDIR)/ocamldoc" endif endif -ifeq "$(build_ocamldoc)-$(build_libraries_manpages)" "true-true" +ifeq "$(build_libraries_manpages)" "true" $(MAKE) -C api_docgen install endif if test -n "$(WITH_DEBUGGER)"; then \ diff --git a/configure b/configure index 7b286bc204a..5f076d626c2 100755 --- a/configure +++ b/configure @@ -3773,7 +3773,7 @@ if test ${enable_ocamldoc+y} then : enableval=$enable_ocamldoc; else $as_nop - ocamldoc=auto + enable_ocamldoc='auto' fi @@ -3916,6 +3916,8 @@ fi if test ${enable_stdlib_manpages+y} then : enableval=$enable_stdlib_manpages; +else $as_nop + enable_stdlib_manpages='auto' fi @@ -4017,6 +4019,26 @@ else $as_nop build_ocamltex=true fi +if test x"$enable_ocamldoc" = "xno" +then : + if test x"$enable_stdlib_manpages" = "xyes" +then : + as_fn_error $? "--enable-stdlib-manpages requires ocamldoc" "$LINENO" 5 +fi + ocamldoc_target="" + ocamldoc_opt_target="" + with_ocamldoc="" + enable_stdlib_manpages=no + build_ocamldoc=false +else $as_nop + ocamldoc_target=ocamldoc + ocamldoc_opt_target=ocamldoc.opt + with_ocamldoc=ocamldoc + build_ocamldoc=true + ac_config_files="$ac_config_files ocamldoc/META" + +fi + # Initialization of libtool # Allow the MSVC linker to be found even if ld isn't installed. # User-specified LD still takes precedence. @@ -19723,19 +19745,11 @@ else $as_nop install_source_artifacts=true fi -if test x"$enable_ocamldoc" = "xno" +if test x"$enable_stdlib_manpages" != "xno" then : - ocamldoc_target="" - ocamldoc_opt_target="" - with_ocamldoc="" - build_ocamldoc=false + build_libraries_manpages=true else $as_nop - ocamldoc_target=ocamldoc - ocamldoc_opt_target=ocamldoc.opt - with_ocamldoc=ocamldoc - build_ocamldoc=true - ac_config_files="$ac_config_files ocamldoc/META" - + build_libraries_manpages=false fi documentation_tool_cmd='' @@ -20135,13 +20149,6 @@ case $host in #( ;; esac -if test x"$enable_stdlib_manpages" != "xno" -then : - build_libraries_manpages=true -else $as_nop - build_libraries_manpages=false -fi - # Do not permanently cache the result of flexdll.h unset ac_cv_header_flexdll_h @@ -21297,12 +21304,12 @@ do "otherlibs/runtime_events/META") CONFIG_FILES="$CONFIG_FILES otherlibs/runtime_events/META" ;; "stdlib/META") CONFIG_FILES="$CONFIG_FILES stdlib/META" ;; "native-symlinks") CONFIG_COMMANDS="$CONFIG_COMMANDS native-symlinks" ;; + "ocamldoc/META") CONFIG_FILES="$CONFIG_FILES ocamldoc/META" ;; "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;; "otherlibs/unix/META") CONFIG_FILES="$CONFIG_FILES otherlibs/unix/META" ;; "otherlibs/unix/unix.ml") CONFIG_LINKS="$CONFIG_LINKS otherlibs/unix/unix.ml:otherlibs/unix/unix_${unix_or_win32}.ml" ;; "otherlibs/str/META") CONFIG_FILES="$CONFIG_FILES otherlibs/str/META" ;; "otherlibs/systhreads/META") CONFIG_FILES="$CONFIG_FILES otherlibs/systhreads/META" ;; - "ocamldoc/META") CONFIG_FILES="$CONFIG_FILES ocamldoc/META" ;; "ocamltest/ocamltest_unix.ml") CONFIG_LINKS="$CONFIG_LINKS ocamltest/ocamltest_unix.ml:${ocamltest_unix_mod}" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; diff --git a/configure.ac b/configure.ac index 6e9337e8657..ccf9982313e 100644 --- a/configure.ac +++ b/configure.ac @@ -391,7 +391,7 @@ AC_ARG_ENABLE([ocamldoc], [AS_HELP_STRING([--disable-ocamldoc], [do not build the ocamldoc documentation system])], [], - [ocamldoc=auto]) + [enable_ocamldoc='auto']) AC_ARG_WITH([odoc], [AS_HELP_STRING([--with-odoc], @@ -471,7 +471,9 @@ AC_ARG_ENABLE([reserved-header-bits], AC_ARG_ENABLE([stdlib-manpages], [AS_HELP_STRING([--disable-stdlib-manpages], - [do not build or install the library man pages])]) + [do not build or install the library man pages])], + [], + [enable_stdlib_manpages='auto']) AC_ARG_ENABLE([warn-error], [AS_HELP_STRING([--enable-warn-error], @@ -528,6 +530,20 @@ AS_IF([test x"$enable_unix_lib" = "xno" || test x"$enable_str_lib" = "xno"], build_ocamltex=false])], [build_ocamltex=true]) +AS_IF([test x"$enable_ocamldoc" = "xno"], + [AS_IF([test x"$enable_stdlib_manpages" = "xyes"], + [AC_MSG_ERROR([--enable-stdlib-manpages requires ocamldoc])]) + ocamldoc_target="" + ocamldoc_opt_target="" + with_ocamldoc="" + enable_stdlib_manpages=no + build_ocamldoc=false], + [ocamldoc_target=ocamldoc + ocamldoc_opt_target=ocamldoc.opt + with_ocamldoc=ocamldoc + build_ocamldoc=true + AC_CONFIG_FILES([ocamldoc/META])]) + # Initialization of libtool # Allow the MSVC linker to be found even if ld isn't installed. # User-specified LD still takes precedence. @@ -2251,16 +2267,8 @@ AS_IF([test x"$enable_installing_source_artifacts" = "xno"], [install_source_artifacts=false], [install_source_artifacts=true]) -AS_IF([test x"$enable_ocamldoc" = "xno"], - [ocamldoc_target="" - ocamldoc_opt_target="" - with_ocamldoc="" - build_ocamldoc=false], - [ocamldoc_target=ocamldoc - ocamldoc_opt_target=ocamldoc.opt - with_ocamldoc=ocamldoc - build_ocamldoc=true - AC_CONFIG_FILES([ocamldoc/META])]) +AS_IF([test x"$enable_stdlib_manpages" != "xno"], + [build_libraries_manpages=true],[build_libraries_manpages=false]) documentation_tool_cmd='' AC_ARG_WITH([odoc], @@ -2447,9 +2455,6 @@ AS_CASE([$host], # as "Infinity" and "Inf" instead of the expected "inf" [AC_DEFINE([HAS_BROKEN_PRINTF])]) -AS_IF([test x"$enable_stdlib_manpages" != "xno"], - [build_libraries_manpages=true],[build_libraries_manpages=false]) - # Do not permanently cache the result of flexdll.h unset ac_cv_header_flexdll_h From dee097259d60cb75b5f16a80ceafd5fa547edf35 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 20 Oct 2023 14:04:56 +0200 Subject: [PATCH 220/402] Remove benign data race in parallel test (#12680) The data race shows up in TSan-enabled runs, and can be removed for a small cost. --- testsuite/tests/parallel/domain_parallel_spawn_burn.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/parallel/domain_parallel_spawn_burn.ml b/testsuite/tests/parallel/domain_parallel_spawn_burn.ml index 85f09bd98bf..5801f3afdbb 100644 --- a/testsuite/tests/parallel/domain_parallel_spawn_burn.ml +++ b/testsuite/tests/parallel/domain_parallel_spawn_burn.ml @@ -29,9 +29,9 @@ let test_parallel_spawn () = done let () = - let running = ref true in + let running = Atomic.make true in let rec run_until_stop fn () = - while !running do + while Atomic.get running do fn (); done in @@ -41,7 +41,7 @@ let () = test_parallel_spawn (); - running := false; + Atomic.set running false; join domain_minor_gc; join domain_major_gc; From 1ce30c7fcb52ee50f5fb857330af0902492c767b Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Tue, 20 Jun 2023 16:52:24 +0200 Subject: [PATCH 221/402] change the meaning of custom_minor_max_size --- runtime/caml/config.h | 2 +- runtime/custom.c | 24 ++++++------------------ stdlib/gc.mli | 8 +++----- 3 files changed, 10 insertions(+), 24 deletions(-) diff --git a/runtime/caml/config.h b/runtime/caml/config.h index 30df2c574b7..3fea87d8ebf 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -258,7 +258,7 @@ typedef uint64_t uintnat; /* Default setting for maximum size of custom objects counted as garbage in the minor heap. Documented in gc.mli */ -#define Custom_minor_max_bsz_def 8192 +#define Custom_minor_max_bsz_def 70000 /* Minimum amount of work to do in a major GC slice. */ #define Major_slice_work_min 512 diff --git a/runtime/custom.c b/runtime/custom.c index 7204454dd7a..5c70252518d 100644 --- a/runtime/custom.c +++ b/runtime/custom.c @@ -36,35 +36,26 @@ static value alloc_custom_gen (const struct custom_operations * ops, uintnat bsz, mlsize_t mem, mlsize_t max_major, - mlsize_t mem_minor, mlsize_t max_minor) { mlsize_t wosize; CAMLparam0(); CAMLlocal1(result); - /* [mem] is the total amount of out-of-heap memory, [mem_minor] is how much - of it should be counted against [max_minor]. */ - CAMLassert (mem_minor <= mem); - wosize = 1 + (bsz + sizeof(value) - 1) / sizeof(value); - if (wosize <= Max_young_wosize) { + if (wosize <= Max_young_wosize && mem <= caml_custom_minor_max_bsz) { result = caml_alloc_small(wosize, Custom_tag); Custom_ops_val(result) = ops; if (ops->finalize != NULL || mem != 0) { - if (mem > mem_minor) { - caml_adjust_gc_speed (mem - mem_minor, max_major); - } - /* The remaining [mem_minor] will be counted if the block survives a - minor GC */ + /* Record the extra resources in case the block gets promoted. */ add_to_custom_table (&Caml_state->minor_tables->custom, result, mem, max_major); /* Keep track of extra resources held by custom block in minor heap. */ - if (mem_minor != 0) { + if (mem != 0) { if (max_minor == 0) max_minor = 1; Caml_state->extra_heap_resources_minor += - (double) mem_minor / (double) max_minor; + (double) mem / (double) max_minor; if (Caml_state->extra_heap_resources_minor > 1.0) { caml_request_minor_gc (); } @@ -84,16 +75,13 @@ CAMLexport value caml_alloc_custom(const struct custom_operations * ops, mlsize_t mem, mlsize_t max) { - return alloc_custom_gen (ops, bsz, mem, max, mem, max); + return alloc_custom_gen (ops, bsz, mem, max, max); } CAMLexport value caml_alloc_custom_mem(const struct custom_operations * ops, uintnat bsz, mlsize_t mem) { - - mlsize_t mem_minor = - mem < caml_custom_minor_max_bsz ? mem : caml_custom_minor_max_bsz; mlsize_t max_major = /* The major ratio is a percentage relative to the major heap size. A complete GC cycle will be done every time 2/3 of that much memory @@ -107,7 +95,7 @@ CAMLexport value caml_alloc_custom_mem(const struct custom_operations * ops, caml_heap_size(Caml_state->shared_heap) / 150 * caml_custom_major_ratio; mlsize_t max_minor = Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio; - value v = alloc_custom_gen (ops, bsz, mem, max_major, mem_minor, max_minor); + value v = alloc_custom_gen (ops, bsz, mem, max_major, max_minor); return v; } diff --git a/stdlib/gc.mli b/stdlib/gc.mli index a1fca2c59cc..9cef53775b8 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -210,13 +210,11 @@ type control = custom_minor_max_size : int; (** Maximum amount of out-of-heap memory for each custom value - allocated in the minor heap. When a custom value is allocated - on the minor heap and holds more than this many bytes, only - this value is counted against [custom_minor_ratio] and the - rest is directly counted against [custom_major_ratio]. + allocated in the minor heap. Custom values that hold more + than this many bytes are allocated on the major heap. Note: this only applies to values allocated with [caml_alloc_custom_mem] (e.g. bigarrays). - Default: 8192 bytes. + Default: 70000 bytes. @since 4.08 *) } (** The GC parameters are given as a [control] record. Note that From ab631298dc09033448e92de325dad2928b80f28c Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Tue, 27 Jun 2023 15:13:53 +0200 Subject: [PATCH 222/402] make tests/lib-runtime-events/test_instrumented.ml more stable wrt GC behavior --- testsuite/tests/lib-runtime-events/test_instrumented.ml | 8 ++++++-- .../tests/lib-runtime-events/test_instrumented.reference | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/lib-runtime-events/test_instrumented.ml b/testsuite/tests/lib-runtime-events/test_instrumented.ml index 5c49db90af2..8b3e586bba2 100644 --- a/testsuite/tests/lib-runtime-events/test_instrumented.ml +++ b/testsuite/tests/lib-runtime-events/test_instrumented.ml @@ -29,6 +29,7 @@ let lost_events domain_id words = let () = Gc.full_major (); start (); + let minors_at_start = (Gc.quick_stat ()).Gc.minor_collections in let cursor = create_cursor None in for a = 0 to 1_000_000 do list_ref := (Sys.opaque_identity(ref 42)) :: !list_ref @@ -36,5 +37,8 @@ let () = Gc.full_major (); let callbacks = Callbacks.create ~runtime_end ~alloc ~lost_events () in ignore(read_poll cursor callbacks None); - Printf.printf "lost_event_words: %d, total_sizes: %d, total_minors: %d\n" - !lost_event_words !total_sizes !total_minors + let self_minors = + (Gc.quick_stat ()).Gc.minor_collections - minors_at_start + in + Printf.printf "lost_event_words: %d, total_sizes: %d, diff_minors: %d\n" + !lost_event_words !total_sizes (!total_minors - self_minors) diff --git a/testsuite/tests/lib-runtime-events/test_instrumented.reference b/testsuite/tests/lib-runtime-events/test_instrumented.reference index 2d9ac36c99b..231d7ec29ea 100644 --- a/testsuite/tests/lib-runtime-events/test_instrumented.reference +++ b/testsuite/tests/lib-runtime-events/test_instrumented.reference @@ -1 +1 @@ -lost_event_words: 0, total_sizes: 2000004, total_minors: 31 +lost_event_words: 0, total_sizes: 2000004, diff_minors: 0 From 9ae9928f10e975757f080787fc9bd8ae19c49fb2 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Wed, 28 Jun 2023 14:19:07 +0200 Subject: [PATCH 223/402] add Changes entry and documentation comment --- Changes | 5 +++++ runtime/caml/custom.h | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/Changes b/Changes index aa7c869ed2b..86546017fda 100644 --- a/Changes +++ b/Changes @@ -100,6 +100,11 @@ Working version (Guillaume Munch-Maccagnoni, review by Anil Madhavapeddy and KC Sivaramakrishnan) +- #12318: GC: simplify the meaning of custom_minor_max_size: blocks with + out-of-heap memory above this limit are now allocated directly in + the major heap. + (Damien Doligez, report by Stephen Dolan, review by Gabriel Scherer) + - #12408: `Domain.spawn` no longer leaks its functional argument for the whole duration of the children domain lifetime. (Guillaume Munch-Maccagnoni, review by Gabriel Scherer) diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h index e4b162c9bd8..61a158d7d81 100644 --- a/runtime/caml/custom.h +++ b/runtime/caml/custom.h @@ -57,6 +57,10 @@ CAMLextern value caml_alloc_custom(const struct custom_operations * ops, mlsize_t mem, /*resources consumed*/ mlsize_t max /*max resources*/); +/* [caml_alloc_custom_mem] allocates a custom block with dependent memory + (memory outside the heap that will be reclaimed when the block is + finalized). If [mem] is greater than [custom_minor_max_size] (see gc.mli) + the block is allocated directly in the major heap. */ CAMLextern value caml_alloc_custom_mem(const struct custom_operations * ops, uintnat size, /*size in bytes*/ mlsize_t mem /*memory consumed*/); From 26ebc3dae6254aa7f3f9b44391f124207729a122 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 30 Jun 2023 15:32:37 +0200 Subject: [PATCH 224/402] tweak test to work identically with and without flambda --- .../lib-runtime-events/test_instrumented.ml | 17 +++++++++-------- .../test_instrumented.reference | 2 +- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/testsuite/tests/lib-runtime-events/test_instrumented.ml b/testsuite/tests/lib-runtime-events/test_instrumented.ml index 8b3e586bba2..af5334a6e40 100644 --- a/testsuite/tests/lib-runtime-events/test_instrumented.ml +++ b/testsuite/tests/lib-runtime-events/test_instrumented.ml @@ -8,13 +8,12 @@ open Runtime_events let list_ref = ref [] -let total_sizes = ref 0 +let total_blocks = ref 0 let total_minors = ref 0 let lost_event_words = ref 0 -let alloc domain_id ts sizes = - let size_accum = Array.fold_left (fun x y -> x + y) 0 sizes in - total_sizes := !total_sizes + size_accum +let alloc domain_id ts counts = + total_blocks := Array.fold_left ( + ) !total_blocks counts let runtime_end domain_id ts phase = match phase with @@ -28,8 +27,8 @@ let lost_events domain_id words = let () = Gc.full_major (); + let stat1 = Gc.quick_stat () in start (); - let minors_at_start = (Gc.quick_stat ()).Gc.minor_collections in let cursor = create_cursor None in for a = 0 to 1_000_000 do list_ref := (Sys.opaque_identity(ref 42)) :: !list_ref @@ -37,8 +36,10 @@ let () = Gc.full_major (); let callbacks = Callbacks.create ~runtime_end ~alloc ~lost_events () in ignore(read_poll cursor callbacks None); + let stat2 = Gc.quick_stat () in let self_minors = - (Gc.quick_stat ()).Gc.minor_collections - minors_at_start + Sys.opaque_identity (stat2).Gc.minor_collections + - Sys.opaque_identity (stat1).Gc.minor_collections in - Printf.printf "lost_event_words: %d, total_sizes: %d, diff_minors: %d\n" - !lost_event_words !total_sizes (!total_minors - self_minors) + Printf.printf "lost_event_words: %d, total_blocks: %d, diff_minors: %d\n" + !lost_event_words !total_blocks (!total_minors - self_minors) diff --git a/testsuite/tests/lib-runtime-events/test_instrumented.reference b/testsuite/tests/lib-runtime-events/test_instrumented.reference index 231d7ec29ea..41e7dd50044 100644 --- a/testsuite/tests/lib-runtime-events/test_instrumented.reference +++ b/testsuite/tests/lib-runtime-events/test_instrumented.reference @@ -1 +1 @@ -lost_event_words: 0, total_sizes: 2000004, diff_minors: 0 +lost_event_words: 0, total_blocks: 2000008, diff_minors: 0 From 7b2c75972af5191f4b8830e23ed7e1a0d2427d9b Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Mon, 3 Jul 2023 16:31:49 +0200 Subject: [PATCH 225/402] make the test differential (probably more robust) --- .../lib-runtime-events/test_instrumented.ml | 47 ++++++++++++------- .../test_instrumented.reference | 2 +- 2 files changed, 31 insertions(+), 18 deletions(-) diff --git a/testsuite/tests/lib-runtime-events/test_instrumented.ml b/testsuite/tests/lib-runtime-events/test_instrumented.ml index af5334a6e40..b82217df0d6 100644 --- a/testsuite/tests/lib-runtime-events/test_instrumented.ml +++ b/testsuite/tests/lib-runtime-events/test_instrumented.ml @@ -25,21 +25,34 @@ let runtime_end domain_id ts phase = let lost_events domain_id words = lost_event_words := !lost_event_words + words +let callbacks = Callbacks.create ~runtime_end ~alloc ~lost_events () + +let reset cursor = + ignore (read_poll cursor callbacks None); + total_blocks := 0; + total_minors := 0 + +let loop n cursor = + Gc.full_major (); + reset cursor; + let minors_before = Gc.((quick_stat ()).minor_collections) in + for a = 1 to n do + list_ref := (Sys.opaque_identity(ref 42)) :: !list_ref + done; + Gc.full_major (); + ignore(read_poll cursor callbacks None); + let minors_after = Gc.((quick_stat ()).minor_collections) in + minors_after - minors_before + let () = - Gc.full_major (); - let stat1 = Gc.quick_stat () in - start (); - let cursor = create_cursor None in - for a = 0 to 1_000_000 do - list_ref := (Sys.opaque_identity(ref 42)) :: !list_ref - done; - Gc.full_major (); - let callbacks = Callbacks.create ~runtime_end ~alloc ~lost_events () in - ignore(read_poll cursor callbacks None); - let stat2 = Gc.quick_stat () in - let self_minors = - Sys.opaque_identity (stat2).Gc.minor_collections - - Sys.opaque_identity (stat1).Gc.minor_collections - in - Printf.printf "lost_event_words: %d, total_blocks: %d, diff_minors: %d\n" - !lost_event_words !total_blocks (!total_minors - self_minors) + start (); + let cursor = create_cursor None in + let self_minors_base = loop 0 cursor in + let blocks_base = !total_blocks in + let minors_base = !total_minors in + let self_minors = loop 1_000_000 cursor - self_minors_base in + let blocks = !total_blocks in + let minors = !total_minors in + Printf.printf "lost_event_words: %d, total_blocks: %d, diff_minors: %d\n" + !lost_event_words (blocks - blocks_base) + (minors - minors_base - self_minors) diff --git a/testsuite/tests/lib-runtime-events/test_instrumented.reference b/testsuite/tests/lib-runtime-events/test_instrumented.reference index 41e7dd50044..dfba60c1348 100644 --- a/testsuite/tests/lib-runtime-events/test_instrumented.reference +++ b/testsuite/tests/lib-runtime-events/test_instrumented.reference @@ -1 +1 @@ -lost_event_words: 0, total_blocks: 2000008, diff_minors: 0 +lost_event_words: 0, total_blocks: 2000000, diff_minors: 0 From a7cd0c6ee06b9ddc00cb78e85eb18dae04c43ce8 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Thu, 5 Oct 2023 16:43:05 +0200 Subject: [PATCH 226/402] alloc_custom_mem: do not convert memory size to heap proportion and later back to work units using a different heap size. When the heap is growing, this unduly accelerates the major GC, slowing down the program. --- runtime/caml/custom.h | 2 ++ runtime/custom.c | 25 +++++++++++++------------ runtime/gc_ctrl.c | 1 - runtime/memory.c | 1 + runtime/minor_gc.c | 18 ++++++++++++++++++ 5 files changed, 34 insertions(+), 13 deletions(-) diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h index 61a158d7d81..d3015b608ed 100644 --- a/runtime/caml/custom.h +++ b/runtime/caml/custom.h @@ -52,6 +52,8 @@ extern "C" { #endif +CAMLextern uintnat caml_custom_major_ratio; + CAMLextern value caml_alloc_custom(const struct custom_operations * ops, uintnat size, /*size in bytes*/ mlsize_t mem, /*resources consumed*/ diff --git a/runtime/custom.c b/runtime/custom.c index 5c70252518d..c925ee59508 100644 --- a/runtime/custom.c +++ b/runtime/custom.c @@ -32,6 +32,17 @@ uintnat caml_custom_major_ratio = Custom_major_ratio_def; uintnat caml_custom_minor_ratio = Custom_minor_ratio_def; uintnat caml_custom_minor_max_bsz = Custom_minor_max_bsz_def; +/* [mem] is an amount of out-of-heap resources, in the same units as + [max_major] and [max_minor]. When the cumulated amount of such + resources reaches [max_minor] (for resources held by the minor + heap) we do a minor collection; when it reaches [max_major] (for + resources held by the major heap), we guarantee that a major cycle + is done. + + If [max_major] is 0, then [mem] is a number of bytes and the actual + limit is [heap_size / 150 * caml_custom_major_ratio], computed at the + time when the custom block is promoted to the major heap. +*/ static value alloc_custom_gen (const struct custom_operations * ops, uintnat bsz, mlsize_t mem, @@ -75,6 +86,7 @@ CAMLexport value caml_alloc_custom(const struct custom_operations * ops, mlsize_t mem, mlsize_t max) { + if (max == 0) max = 1; return alloc_custom_gen (ops, bsz, mem, max, max); } @@ -82,20 +94,9 @@ CAMLexport value caml_alloc_custom_mem(const struct custom_operations * ops, uintnat bsz, mlsize_t mem) { - mlsize_t max_major = - /* The major ratio is a percentage relative to the major heap size. - A complete GC cycle will be done every time 2/3 of that much memory - is allocated for blocks in the major heap. Assuming constant - allocation and deallocation rates, this means there are at most - [M/100 * major-heap-size] bytes of floating garbage at any time. - The reason for a factor of 2/3 (or 1.5) is, roughly speaking, because - the major GC takes 1.5 cycles (previous cycle + marking phase) before - it starts to deallocate dead blocks allocated during the previous cycle. - [heap_size / 150] is really [heap_size * (2/3) / 100] (but faster). */ - caml_heap_size(Caml_state->shared_heap) / 150 * caml_custom_major_ratio; mlsize_t max_minor = Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio; - value v = alloc_custom_gen (ops, bsz, mem, max_major, max_minor); + value v = alloc_custom_gen (ops, bsz, mem, 0, max_minor); return v; } diff --git a/runtime/gc_ctrl.c b/runtime/gc_ctrl.c index 1b43aca8c86..9e559abbc69 100644 --- a/runtime/gc_ctrl.c +++ b/runtime/gc_ctrl.c @@ -45,7 +45,6 @@ extern uintnat caml_major_heap_increment; /* percent or words; see major_gc.c */ extern uintnat caml_percent_free; /* see major_gc.c */ extern uintnat caml_percent_max; /* see compact.c */ extern uintnat caml_allocation_policy; /* see freelist.c */ -extern uintnat caml_custom_major_ratio; /* see custom.c */ extern uintnat caml_custom_minor_ratio; /* see custom.c */ extern uintnat caml_custom_minor_max_bsz; /* see custom.c */ extern uintnat caml_minor_heap_max_wsz; /* see domain.c */ diff --git a/runtime/memory.c b/runtime/memory.c index dd9f83fc156..623f5905cd2 100644 --- a/runtime/memory.c +++ b/runtime/memory.c @@ -21,6 +21,7 @@ #include #include #include "caml/config.h" +#include "caml/custom.h" #include "caml/misc.h" #include "caml/fail.h" #include "caml/memory.h" diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index c7b654bb50b..9114f810e49 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -691,6 +691,24 @@ static void custom_finalize_minor (caml_domain_state * domain) value *v = &elt->block; if (Is_block(*v) && Is_young(*v)) { if (get_header_val(*v) == 0) { /* value copied to major heap */ + if (elt->max == 0){ + /* When [max] is proportional to heap size, use the current heap + size, not the (major) heap size at the time of allocation in + the minor heap. */ + /* The major ratio is a percentage relative to the major heap + size. A complete GC cycle will be done every time 2/3 of + that much memory is allocated for blocks in the major heap. + Assuming constant allocation and deallocation rates, this + means there are at most [M/100 * major-heap-size] bytes of + floating garbage at any time. The reason for a factor of + 2/3 (or 1.5) is, roughly speaking, because the major GC + takes 1.5 cycles (previous cycle + marking phase) before it + starts to deallocate dead blocks allocated during the + previous cycle. [heap_size / 150] is really [heap_size * + (2/3) / 100] (but faster). */ + elt->max = caml_heap_size(Caml_state->shared_heap) / 150 + * caml_custom_major_ratio; + } caml_adjust_gc_speed(elt->mem, elt->max); } else { void (*final_fun)(value) = Custom_ops_val(*v)->finalize; From 7ae91bc8cce3c59d53048bfb3d93531f19f6aabb Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 20 Oct 2023 20:16:44 +0200 Subject: [PATCH 227/402] fix runtime-events tests to be more robust to GC variations --- testsuite/tests/lib-runtime-events/test.ml | 2 ++ testsuite/tests/lib-runtime-events/test.reference | 2 +- testsuite/tests/lib-runtime-events/test_caml.ml | 1 + 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/lib-runtime-events/test.ml b/testsuite/tests/lib-runtime-events/test.ml index 2e7e1b90abc..4eb61ae717f 100644 --- a/testsuite/tests/lib-runtime-events/test.ml +++ b/testsuite/tests/lib-runtime-events/test.ml @@ -7,6 +7,7 @@ external start_runtime_events : unit -> unit = "start_runtime_events" external get_event_counts : unit -> (int * int) = "get_event_counts" let () = + Gc.full_major (); start_runtime_events (); for a = 0 to 2 do ignore(Sys.opaque_identity(ref 42)); @@ -21,4 +22,5 @@ let () = Gc.compact (); Runtime_events.pause () done; + let (minors, majors) = get_event_counts () in Printf.printf "minors: %d, majors: %d\n" minors majors diff --git a/testsuite/tests/lib-runtime-events/test.reference b/testsuite/tests/lib-runtime-events/test.reference index 1b81e9aba25..185f0174fed 100644 --- a/testsuite/tests/lib-runtime-events/test.reference +++ b/testsuite/tests/lib-runtime-events/test.reference @@ -1,2 +1,2 @@ minors: 9, majors: 0 -minors: 9, majors: 0 +minors: 18, majors: 0 diff --git a/testsuite/tests/lib-runtime-events/test_caml.ml b/testsuite/tests/lib-runtime-events/test_caml.ml index 518c7134ae0..f25013b3b15 100644 --- a/testsuite/tests/lib-runtime-events/test_caml.ml +++ b/testsuite/tests/lib-runtime-events/test_caml.ml @@ -78,6 +78,7 @@ let majors_per_epoch = 50 let conses_per_major = 10 let () = + Gc.full_major (); let list_ref = ref [] in start (); let cursor = create_cursor None in From 49ce7cf5320ac8bd22db47b128a48ab650fec4ae Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 5 May 2022 23:08:09 -0400 Subject: [PATCH 228/402] first implementation of Dyn_array --- manual/src/library/stdlib-blurb.etex | 2 + stdlib/.depend | 16 ++ stdlib/StdlibModules | 1 + stdlib/dyn_array.ml | 314 +++++++++++++++++++++++++++ stdlib/dyn_array.mli | 178 +++++++++++++++ stdlib/stdlib.ml | 1 + stdlib/stdlib.mli | 1 + 7 files changed, 513 insertions(+) create mode 100644 stdlib/dyn_array.ml create mode 100644 stdlib/dyn_array.mli diff --git a/manual/src/library/stdlib-blurb.etex b/manual/src/library/stdlib-blurb.etex index 7c90119eb42..3eb0d7ee10d 100644 --- a/manual/src/library/stdlib-blurb.etex +++ b/manual/src/library/stdlib-blurb.etex @@ -59,6 +59,7 @@ the above 4 modules \\ "Stack" & p.~\stdpageref{Stack} & last-in first-out stacks \\ "Queue" & p.~\stdpageref{Queue} & first-in first-out queues \\ "Buffer" & p.~\stdpageref{Buffer} & buffers that grow on demand \\ +"Dyn_array" & p.~\stdpageref{Dyn_array} & arrays that grow on demand \\ "Seq" & p.~\stdpageref{Seq} & functional iterators \\ "Lazy" & p.~\stdpageref{Lazy} & delayed evaluation \\ "Weak" & p.~\stdpageref{Weak} & references that don't prevent objects @@ -133,6 +134,7 @@ be called from C \\ \stddocitem{Condition}{condition variables to synchronize between threads} \stddocitem{Domain}{Domain spawn/join and domain local variables} \stddocitem{Digest}{MD5 message digest} +\stddocitem{Dyn_array}{Growable, mutable arrays} \stddocitem{Effect}{deep and shallow effect handlers} \stddocitem{Either}{either values} \stddocitem{Ephemeron}{Ephemerons and weak hash table} diff --git a/stdlib/.depend b/stdlib/.depend index 0aeabb685c5..b37cf14d084 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -228,6 +228,22 @@ stdlib__Domain.cmx : domain.ml \ stdlib__Array.cmx \ stdlib__Domain.cmi stdlib__Domain.cmi : domain.mli +stdlib__Dyn_array.cmo : dyn_array.ml \ + stdlib__Sys.cmi \ + stdlib__Seq.cmi \ + stdlib__Obj.cmi \ + stdlib__List.cmi \ + stdlib__Array.cmi \ + stdlib__Dyn_array.cmi +stdlib__Dyn_array.cmx : dyn_array.ml \ + stdlib__Sys.cmx \ + stdlib__Seq.cmx \ + stdlib__Obj.cmx \ + stdlib__List.cmx \ + stdlib__Array.cmx \ + stdlib__Dyn_array.cmi +stdlib__Dyn_array.cmi : dyn_array.mli \ + stdlib__Seq.cmi stdlib__Effect.cmo : effect.ml \ stdlib__Printf.cmi \ stdlib__Printexc.cmi \ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index 8e53530ea4b..aac3f60a9c8 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -67,6 +67,7 @@ STDLIB_MODULE_BASENAMES = \ stack \ queue \ buffer \ + dyn_array \ mutex \ condition \ semaphore \ diff --git a/stdlib/dyn_array.ml b/stdlib/dyn_array.ml new file mode 100644 index 00000000000..49caa845c91 --- /dev/null +++ b/stdlib/dyn_array.ml @@ -0,0 +1,314 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Simon Cruanes *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +type 'a t = { + mutable size : int; + mutable arr : 'a array; +} + +external as_float_arr : 'a array -> float array = "%identity" +external as_obj_arr : 'a array -> Obj.t array = "%identity" + +(* TODO: move to runtime *) +let set_junk_ (a:_ array) i : unit = + if Obj.(tag (repr a) = double_array_tag) then ( + Array.unsafe_set (as_float_arr a) i 0.; + ) else ( + Array.unsafe_set (as_obj_arr a) i (Obj.repr ()); + ) + +(* TODO: move to runtime *) +let fill_with_junk_ (a:_ array) i len : unit = + if Obj.(tag (repr a) = double_array_tag) then ( + Array.fill (as_float_arr a) i len 0.; + ) else ( + Array.fill (as_obj_arr a) i len (Obj.repr ()); + ) + +let create () = { + size = 0; + arr = [| |]; +} + +let make n x = { + size=n; + arr=Array.make n x; +} + +let init n f = { + size=n; + arr=Array.init n f; +} + +let blit v1 i1 v2 i2 len = + if i1<0 || i2<0 || i1+len >= v1.size || i2 + len >= v2.size then + invalid_arg "Dyn_array.blit"; + Array.blit v1.arr i1 v2.arr i2 len + +(* is the underlying array empty? *) +let[@inline] array_is_empty_ v = + Array.length v.arr = 0 + +(* next capacity, if current one is [n]. Roughly use [n * 1.5], because it + provides the good behavior of amortized O(1) number of allocations + without wasting too much memory in the worst case. *) +let[@inline] next_grow_ n = + min Sys.max_array_length (1 + n + n lsr 1) + +(* resize the underlying array using x to temporarily fill the array *) +let actually_resize_array_ a newcapacity ~dummy : unit = + assert (newcapacity >= a.size); + assert (not (array_is_empty_ a)); + let new_array = Array.make newcapacity dummy in + Array.blit a.arr 0 new_array 0 a.size; + fill_with_junk_ new_array a.size (newcapacity-a.size); + a.arr <- new_array + +(* grow the array, using [x] as a temporary dummy if required *) +let actually_grow_with_ a ~dummy : unit = + if array_is_empty_ a then ( + let len = 4 in + a.arr <- Array.make len dummy; + (* do not really use [x], it was just for knowing the type *) + fill_with_junk_ a.arr 0 len; + ) else ( + let n = Array.length a.arr in + let size = next_grow_ n in + if size = n then invalid_arg "Dyn_array: cannot grow the array"; + actually_resize_array_ a size ~dummy + ) + +(* v is not empty; ensure it has at least [size] slots. + + Use {!resize_} so that calling [ensure_capacity v (length v+1)] in a loop + is still behaving well. *) +let ensure_assuming_not_empty_ v ~size = + if size > Sys.max_array_length then ( + invalid_arg "arr.ensure: size too big" + ) else if size > Array.length v.arr then ( + let n = ref (Array.length v.arr) in + while !n < size do n := next_grow_ !n done; + let dummy = v.arr.(0) in + actually_resize_array_ v !n ~dummy; + ) + +let ensure_capacity_with v ~dummy size : unit = + if array_is_empty_ v then ( + v.arr <- Array.make size dummy; + fill_with_junk_ v.arr 0 size + ) else ( + ensure_assuming_not_empty_ v ~size + ) + +let ensure_capacity_nonempty v size : unit = + if array_is_empty_ v then + invalid_arg "Dyn_array.ensure_capacity_nonempty: empty"; + ensure_assuming_not_empty_ v ~size + +let[@inline] clear v = + v.size <- 0 + +let[@inline] is_empty v = v.size = 0 + +let[@inline] unsafe_push v x = + Array.unsafe_set v.arr v.size x; + v.size <- v.size + 1 + +let push v x = + if v.size = Array.length v.arr then actually_grow_with_ v ~dummy:x; + unsafe_push v x + +let append a b = + if array_is_empty_ a then ( + if array_is_empty_ b then () else ( + a.arr <- Array.copy b.arr; + a.size <- b.size + ) + ) else ( + ensure_assuming_not_empty_ a ~size:(a.size + b.size); + assert (Array.length a.arr >= a.size + b.size); + Array.blit b.arr 0 a.arr a.size b.size; + a.size <- a.size + b.size + ) + +let[@inline] get v i = + if i < 0 || i >= v.size then invalid_arg "Dyn_array.get"; + Array.unsafe_get v.arr i + +let[@inline] unsafe_get v i = + Array.unsafe_get v.arr i + +let[@inline] set v i x = + if i < 0 || i >= v.size then invalid_arg "Dyn_array.set"; + Array.unsafe_set v.arr i x + +let[@inline] unsafe_set v i x = + Array.unsafe_set v.arr i x + +let append_seq a seq = Seq.iter (fun x -> push a x) seq + +let append_array a b = + let len_b = Array.length b in + if array_is_empty_ a then ( + a.arr <- Array.copy b; + a.size <- len_b; + ) else ( + ensure_assuming_not_empty_ a ~size:(a.size + len_b); + Array.blit b 0 a.arr a.size len_b; + a.size <- a.size + len_b + ) + +let append_list a b = match b with + | [] -> () + | x :: _ -> + (* use [x] as the dummy, in case the array is empty. + We ensure capacity once, then we can skip the resizing checks + and use {!unsafe_push}. *) + let len_a = a.size in + let len_b = List.length b in + ensure_capacity_with ~dummy:x a (len_a + len_b); + List.iter (unsafe_push a) b + +let pop_exn v = + if v.size = 0 then invalid_arg "Dyn_array.pop_exn: empty"; + let new_size = v.size - 1 in + v.size <- new_size; + let x = v.arr.(new_size) in + set_junk_ v.arr new_size; (* remove pointer to (removed) last element *) + x + +let pop v = + try Some (pop_exn v) + with Invalid_argument _ -> None + + +let[@inline] copy v = { + size = v.size; + arr = Array.sub v.arr 0 v.size; +} + +let truncate v n = + let old_size = v.size in + if n < old_size then ( + v.size <- n; + (* free elements by erasing them *) + fill_with_junk_ v.arr n (old_size-n); + ) + +let shrink_capacity v : unit = + if v.size = 0 then ( + v.arr <- [| |] + ) else if v.size < Array.length v.arr then ( + v.arr <- Array.sub v.arr 0 v.size + ) + +let iter k v = + let n = v.size in + for i = 0 to n-1 do + k (Array.unsafe_get v.arr i) + done + +let iteri k v = + let n = v.size in + for i = 0 to n-1 do + k i (Array.unsafe_get v.arr i) + done + +let map f v = + if array_is_empty_ v + then create () + else ( + let arr = Array.init v.size (fun i -> f (Array.unsafe_get v.arr i)) in + { size=v.size; arr; } + ) + +let mapi f v = + if array_is_empty_ v + then create () + else ( + let arr = Array.init v.size (fun i -> f i (Array.unsafe_get v.arr i)) in + { size=v.size; arr; } + ) + +let fold_left f acc v = + let rec fold acc i = + if i = v.size then acc + else + let x = Array.unsafe_get v.arr i in + fold (f acc x) (i+1) + in fold acc 0 + +let exists p v = + let n = v.size in + let rec check i = + if i = n then false + else p v.arr.(i) || check (i+1) + in check 0 + +let for_all p v = + let n = v.size in + let rec check i = + if i = n then true + else p v.arr.(i) && check (i+1) + in check 0 + +let length v = v.size + +let of_seq seq = + let init = create() in + append_seq init seq; + init + +let to_seq v = + let rec aux i () = + if i>= length v then Seq.Nil + else Seq.Cons (v.arr.(i), aux (i+1)) + in + aux 0 + +let to_seq_rev v = + let rec aux i () = + if i<0 || i > length v then Seq.Nil + else Seq.Cons (v.arr.(i), aux (i-1)) + in + aux (length v-1) + +let of_array a = + if Array.length a = 0 + then create () + else { + size=Array.length a; + arr=Array.copy a; + } + +let of_list l = match l with + | [] -> create() + | [x] -> make 1 x + | [x;y] -> {size=2; arr=[| x; y |]} + | x::_ -> + let v = create() in + ensure_capacity_with v (List.length l) ~dummy:x; + List.iter (unsafe_push v) l; + v + +let to_array v = + Array.sub v.arr 0 v.size + +let to_list v = + let l = ref [] in + for i=length v-1 downto 0 do + l := unsafe_get v i :: !l + done; + !l diff --git a/stdlib/dyn_array.mli b/stdlib/dyn_array.mli new file mode 100644 index 00000000000..4804deac51c --- /dev/null +++ b/stdlib/dyn_array.mli @@ -0,0 +1,178 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Simon Cruanes *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(** Growable, mutable array. + + @since 5.1 +*) + +type 'a t +(** A dynamic array containing values of type ['a]. + + This contains an underlying {!array} along with a size. + Operations such as {!push}, {!append}, and {!append_seq}, extend the + size (and might reallocate the underlying array). + + Operations such as {!pop}, and {!truncate}, reduce the size. *) + +val create : unit -> 'a t +(** Create a new, empty array. *) + +val make : int -> 'a -> 'a t +(** [make n x] makes a array of size [n], filled with [x]. *) + +val init : int -> (int -> 'a) -> 'a t +(** Init the array with the given function and size. *) + +val clear : 'a t -> unit +(** Clear the content of the array. + This ensures that [length v = 0] but the underlying array is kept, + and possibly references to former elements, which are therefore + not garbage collectible. *) + +val ensure_capacity_with : 'a t -> dummy:'a -> int -> unit +(** Make sure that the array has at least the given capacity (underlying size). + + This is a more advanced operation that is only useful for performance + purposes. + + @param dummy an element used if the underlying array is empty, + to initialize it. It will not be retained anywhere. + @raise Invalid_arg if the size is not suitable (negative, or too big for OCaml arrays) +*) + +val ensure_capacity_nonempty : 'a t -> int -> unit +(** Make sure that the array has at least the given capacity (underlying size), + assuming it is non-empty. The first element is used as the filler. + + This is a more advanced operation that is only useful for performance + purposes. + + @raise Invalid_arg if the array is empty or + if the size is not suitable (negative, or too big for OCaml arrays) +*) + +val is_empty : 'a t -> bool +(** Is the array empty? This is synonymous to [length a = 0]. *) + +val push : 'a t -> 'a -> unit +(** Add an element at the end of the array. This might extend the underlying + array if it is full. + + Calling [push] [n] times is amortized O(n) complexity, + and O(ln(n)) reallocations of the underlying array. *) + +val unsafe_push : 'a t -> 'a -> unit +(** Push an element, assuming there is capacity for it + (e.g. using {!ensure_capacity}). + + It is unspecified what happens if the capacity is not enough. + This is for advanced used only. *) + +val append : 'a t -> 'a t -> unit +(** [append a b] adds all elements of [b] to [a]. [b] is not modified. *) + +val append_array : 'a t -> 'a array -> unit +(** Like {!append}, with an array. *) + +val append_seq : 'a t -> 'a Seq.t -> unit +(** Like {!append} but with an iterator. *) + +val append_list : 'a t -> 'a list -> unit +(** Like {!append} but with a list. *) + +val pop : 'a t -> 'a option +(** Remove and return the last element, or [None] if the + array is empty. *) + +val pop_exn : 'a t -> 'a +(** Remove the last element, or raise an exception if the + array is empty. + @raise Invalid_argument on an empty array. *) + +val copy : 'a t -> 'a t +(** Shallow copy. *) + +val truncate : 'a t -> int -> unit +(** Truncate to the given size (remove elements above this size). + Does nothing if the parameter is bigger than the current size. + + [truncate arr n] is similar to: + [while length arr > n do ignore (pop_exn arr) done] *) + +val shrink_capacity : 'a t -> unit +(** Shrink internal array to fit the size of the array. This can be useful + to make sure there is no memory wasted on a long-held array. *) + +val iter : ('a -> unit) -> 'a t -> unit +(** Iterate on the array's content. *) + +val iteri : (int -> 'a -> unit) -> 'a t -> unit +(** Iterate on the array, with indexes. *) + +val map : ('a -> 'b) -> 'a t -> 'b t +(** Map elements of the array, yielding a new array. *) + +val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t +(** [map f v] is just like {!map}, but it also passes in the index + of each element as the first argument to the function [f]. *) + +val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b +(** Fold on elements of the array *) + +val exists : ('a -> bool) -> 'a t -> bool + +val for_all : ('a -> bool) -> 'a t -> bool + +val get : 'a t -> int -> 'a +(** Access element by its index, or + @raise Invalid_argument if bad index. *) + +val set : 'a t -> int -> 'a -> unit +(** Modify element at given index, or + @raise Invalid_argument if the index is + invalid (i.e. not in [[0.. length v-1]]). *) + +val blit : 'a t -> int -> 'a t -> int -> int -> unit +(** [blit a i ab j len] copies [len] elements from [a], + starting at index [i], into [b], starting at index [j]. + + See {!Array.blit}. + @raise Invalid_argument if the indices or lengthts are not valid. +*) + +val length : _ t -> int +(** Number of elements in the array. *) + +val of_array : 'a array -> 'a t +(** [of_array a] returns a array corresponding to the array [a]. + Operates in [O(n)] time. *) + +val of_list : 'a list -> 'a t + +val to_array : 'a t -> 'a array +(** [to_array v] returns an array corresponding to the array [v]. *) + +val to_list : 'a t -> 'a list +(** Return a list with the elements contained in the array. *) + +val of_seq : 'a Seq.t -> 'a t +(** Convert an Iterator to a array. *) + +val to_seq : 'a t -> 'a Seq.t +(** Return an iterator with the elements contained in the array. *) + +val to_seq_rev : 'a t -> 'a Seq.t +(** Iterate over the array, starting from the last (top) element. *) diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml index e24e5a28201..23e8f01d7c2 100644 --- a/stdlib/stdlib.ml +++ b/stdlib/stdlib.ml @@ -597,6 +597,7 @@ module Complex = Complex module Condition = Condition module Digest = Digest module Domain = Domain +module Dyn_array = Dyn_array module Effect = Effect module Either = Either module Ephemeron = Ephemeron diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index 3d2ffe10e88..678f0d147e3 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -1406,6 +1406,7 @@ module Domain = Domain [@@alert unstable "The Domain interface may change in incompatible ways in the future." ] +module Dyn_array = Dyn_array module Effect = Effect [@@alert "-unstable"] [@@alert unstable From 60ae582162d919db06f4d38e95d58b9175e8014a Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 29 Jul 2023 18:10:23 +0200 Subject: [PATCH 229/402] update existing stamp-dependent tests after new Stdlib module --- .../tests/basic/patmatch_for_multiple.ml | 168 +++++++++--------- .../tests/match-side-effects/partiality.ml | 88 ++++----- .../match-side-effects/test_contexts_code.ml | 56 +++--- testsuite/tests/shapes/comp_units.ml | 2 +- testsuite/tests/shapes/functors.ml | 18 +- testsuite/tests/shapes/open_arg.ml | 2 +- testsuite/tests/shapes/recmodules.ml | 10 +- testsuite/tests/shapes/rotor_example.ml | 2 +- 8 files changed, 173 insertions(+), 173 deletions(-) diff --git a/testsuite/tests/basic/patmatch_for_multiple.ml b/testsuite/tests/basic/patmatch_for_multiple.ml index d3f3f1409ef..219afb611e6 100644 --- a/testsuite/tests/basic/patmatch_for_multiple.ml +++ b/testsuite/tests/basic/patmatch_for_multiple.ml @@ -26,15 +26,15 @@ match (3, 2, 1) with | _ -> false ;; [%%expect{| -(let (*match*/276 = 3 *match*/277 = 2 *match*/278 = 1) +(let (*match*/277 = 3 *match*/278 = 2 *match*/279 = 1) (catch (catch - (catch (if (!= *match*/277 3) (exit 3) (exit 1)) with (3) - (if (!= *match*/276 1) (exit 2) (exit 1))) + (catch (if (!= *match*/278 3) (exit 3) (exit 1)) with (3) + (if (!= *match*/277 1) (exit 2) (exit 1))) with (2) 0) with (1) 1)) -(let (*match*/276 = 3 *match*/277 = 2 *match*/278 = 1) - (catch (if (!= *match*/277 3) (if (!= *match*/276 1) 0 (exit 1)) (exit 1)) +(let (*match*/277 = 3 *match*/278 = 2 *match*/279 = 1) + (catch (if (!= *match*/278 3) (if (!= *match*/277 1) 0 (exit 1)) (exit 1)) with (1) 1)) - : bool = false |}];; @@ -47,26 +47,26 @@ match (3, 2, 1) with | _ -> false ;; [%%expect{| -(let (*match*/281 = 3 *match*/282 = 2 *match*/283 = 1) +(let (*match*/282 = 3 *match*/283 = 2 *match*/284 = 1) (catch (catch (catch - (if (!= *match*/282 3) (exit 6) - (let (x/285 =a (makeblock 0 *match*/281 *match*/282 *match*/283)) - (exit 4 x/285))) + (if (!= *match*/283 3) (exit 6) + (let (x/286 =a (makeblock 0 *match*/282 *match*/283 *match*/284)) + (exit 4 x/286))) with (6) - (if (!= *match*/281 1) (exit 5) - (let (x/284 =a (makeblock 0 *match*/281 *match*/282 *match*/283)) - (exit 4 x/284)))) + (if (!= *match*/282 1) (exit 5) + (let (x/285 =a (makeblock 0 *match*/282 *match*/283 *match*/284)) + (exit 4 x/285)))) with (5) 0) - with (4 x/279) (seq (ignore x/279) 1))) -(let (*match*/281 = 3 *match*/282 = 2 *match*/283 = 1) + with (4 x/280) (seq (ignore x/280) 1))) +(let (*match*/282 = 3 *match*/283 = 2 *match*/284 = 1) (catch - (if (!= *match*/282 3) - (if (!= *match*/281 1) 0 - (exit 4 (makeblock 0 *match*/281 *match*/282 *match*/283))) - (exit 4 (makeblock 0 *match*/281 *match*/282 *match*/283))) - with (4 x/279) (seq (ignore x/279) 1))) + (if (!= *match*/283 3) + (if (!= *match*/282 1) 0 + (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284))) + (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284))) + with (4 x/280) (seq (ignore x/280) 1))) - : bool = false |}];; @@ -76,8 +76,8 @@ let _ = fun a b -> | ((true, _) as _g) | ((false, _) as _g) -> () [%%expect{| -(function a/286[int] b/287 : int 0) -(function a/286[int] b/287 : int 0) +(function a/287[int] b/288 : int 0) +(function a/287[int] b/288 : int 0) - : bool -> 'a -> unit = |}];; @@ -96,8 +96,8 @@ let _ = fun a b -> match a, b with | (false, _) as p -> p (* outside, trivial *) [%%expect {| -(function a/290[int] b/291 (let (p/292 =a (makeblock 0 a/290 b/291)) p/292)) -(function a/290[int] b/291 (makeblock 0 a/290 b/291)) +(function a/291[int] b/292 (let (p/293 =a (makeblock 0 a/291 b/292)) p/293)) +(function a/291[int] b/292 (makeblock 0 a/291 b/292)) - : bool -> 'a -> bool * 'a = |}] @@ -106,8 +106,8 @@ let _ = fun a b -> match a, b with | ((false, _) as p) -> p (* inside, trivial *) [%%expect{| -(function a/294[int] b/295 (let (p/296 =a (makeblock 0 a/294 b/295)) p/296)) -(function a/294[int] b/295 (makeblock 0 a/294 b/295)) +(function a/295[int] b/296 (let (p/297 =a (makeblock 0 a/295 b/296)) p/297)) +(function a/295[int] b/296 (makeblock 0 a/295 b/296)) - : bool -> 'a -> bool * 'a = |}];; @@ -116,11 +116,11 @@ let _ = fun a b -> match a, b with | (false as x, _) as p -> x, p (* outside, simple *) [%%expect {| -(function a/300[int] b/301 - (let (x/302 =a[int] a/300 p/303 =a (makeblock 0 a/300 b/301)) - (makeblock 0 (int,*) x/302 p/303))) -(function a/300[int] b/301 - (makeblock 0 (int,*) a/300 (makeblock 0 a/300 b/301))) +(function a/301[int] b/302 + (let (x/303 =a[int] a/301 p/304 =a (makeblock 0 a/301 b/302)) + (makeblock 0 (int,*) x/303 p/304))) +(function a/301[int] b/302 + (makeblock 0 (int,*) a/301 (makeblock 0 a/301 b/302))) - : bool -> 'a -> bool * (bool * 'a) = |}] @@ -129,11 +129,11 @@ let _ = fun a b -> match a, b with | ((false as x, _) as p) -> x, p (* inside, simple *) [%%expect {| -(function a/306[int] b/307 - (let (x/308 =a[int] a/306 p/309 =a (makeblock 0 a/306 b/307)) - (makeblock 0 (int,*) x/308 p/309))) -(function a/306[int] b/307 - (makeblock 0 (int,*) a/306 (makeblock 0 a/306 b/307))) +(function a/307[int] b/308 + (let (x/309 =a[int] a/307 p/310 =a (makeblock 0 a/307 b/308)) + (makeblock 0 (int,*) x/309 p/310))) +(function a/307[int] b/308 + (makeblock 0 (int,*) a/307 (makeblock 0 a/307 b/308))) - : bool -> 'a -> bool * (bool * 'a) = |}] @@ -142,15 +142,15 @@ let _ = fun a b -> match a, b with | (false, x) as p -> x, p (* outside, complex *) [%%expect{| -(function a/316[int] b/317[int] - (if a/316 - (let (x/318 =a[int] a/316 p/319 =a (makeblock 0 a/316 b/317)) - (makeblock 0 (int,*) x/318 p/319)) - (let (x/320 =a b/317 p/321 =a (makeblock 0 a/316 b/317)) - (makeblock 0 (int,*) x/320 p/321)))) -(function a/316[int] b/317[int] - (if a/316 (makeblock 0 (int,*) a/316 (makeblock 0 a/316 b/317)) - (makeblock 0 (int,*) b/317 (makeblock 0 a/316 b/317)))) +(function a/317[int] b/318[int] + (if a/317 + (let (x/319 =a[int] a/317 p/320 =a (makeblock 0 a/317 b/318)) + (makeblock 0 (int,*) x/319 p/320)) + (let (x/321 =a b/318 p/322 =a (makeblock 0 a/317 b/318)) + (makeblock 0 (int,*) x/321 p/322)))) +(function a/317[int] b/318[int] + (if a/317 (makeblock 0 (int,*) a/317 (makeblock 0 a/317 b/318)) + (makeblock 0 (int,*) b/318 (makeblock 0 a/317 b/318)))) - : bool -> bool -> bool * (bool * bool) = |}] @@ -160,19 +160,19 @@ let _ = fun a b -> match a, b with -> x, p (* inside, complex *) [%%expect{| -(function a/322[int] b/323[int] +(function a/323[int] b/324[int] (catch - (if a/322 - (let (x/330 =a[int] a/322 p/331 =a (makeblock 0 a/322 b/323)) - (exit 10 x/330 p/331)) - (let (x/328 =a b/323 p/329 =a (makeblock 0 a/322 b/323)) - (exit 10 x/328 p/329))) - with (10 x/324[int] p/325) (makeblock 0 (int,*) x/324 p/325))) -(function a/322[int] b/323[int] + (if a/323 + (let (x/331 =a[int] a/323 p/332 =a (makeblock 0 a/323 b/324)) + (exit 10 x/331 p/332)) + (let (x/329 =a b/324 p/330 =a (makeblock 0 a/323 b/324)) + (exit 10 x/329 p/330))) + with (10 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326))) +(function a/323[int] b/324[int] (catch - (if a/322 (exit 10 a/322 (makeblock 0 a/322 b/323)) - (exit 10 b/323 (makeblock 0 a/322 b/323))) - with (10 x/324[int] p/325) (makeblock 0 (int,*) x/324 p/325))) + (if a/323 (exit 10 a/323 (makeblock 0 a/323 b/324)) + (exit 10 b/324 (makeblock 0 a/323 b/324))) + with (10 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326))) - : bool -> bool -> bool * (bool * bool) = |}] @@ -185,15 +185,15 @@ let _ = fun a b -> match a, b with | (false as x, _) as p -> x, p (* outside, onecase *) [%%expect {| -(function a/332[int] b/333[int] - (if a/332 - (let (x/334 =a[int] a/332 _p/335 =a (makeblock 0 a/332 b/333)) - (makeblock 0 (int,*) x/334 [0: 1 1])) - (let (x/336 =a[int] a/332 p/337 =a (makeblock 0 a/332 b/333)) - (makeblock 0 (int,*) x/336 p/337)))) -(function a/332[int] b/333[int] - (if a/332 (makeblock 0 (int,*) a/332 [0: 1 1]) - (makeblock 0 (int,*) a/332 (makeblock 0 a/332 b/333)))) +(function a/333[int] b/334[int] + (if a/333 + (let (x/335 =a[int] a/333 _p/336 =a (makeblock 0 a/333 b/334)) + (makeblock 0 (int,*) x/335 [0: 1 1])) + (let (x/337 =a[int] a/333 p/338 =a (makeblock 0 a/333 b/334)) + (makeblock 0 (int,*) x/337 p/338)))) +(function a/333[int] b/334[int] + (if a/333 (makeblock 0 (int,*) a/333 [0: 1 1]) + (makeblock 0 (int,*) a/333 (makeblock 0 a/333 b/334)))) - : bool -> bool -> bool * (bool * bool) = |}] @@ -202,11 +202,11 @@ let _ = fun a b -> match a, b with | ((false as x, _) as p) -> x, p (* inside, onecase *) [%%expect{| -(function a/338[int] b/339 - (let (x/340 =a[int] a/338 p/341 =a (makeblock 0 a/338 b/339)) - (makeblock 0 (int,*) x/340 p/341))) -(function a/338[int] b/339 - (makeblock 0 (int,*) a/338 (makeblock 0 a/338 b/339))) +(function a/339[int] b/340 + (let (x/341 =a[int] a/339 p/342 =a (makeblock 0 a/339 b/340)) + (makeblock 0 (int,*) x/341 p/342))) +(function a/339[int] b/340 + (makeblock 0 (int,*) a/339 (makeblock 0 a/339 b/340))) - : bool -> 'a -> bool * (bool * 'a) = |}] @@ -223,14 +223,14 @@ let _ =fun a b -> match a, b with | (_, _) as p -> p (* outside, tuplist *) [%%expect {| -(function a/351[int] b/352 +(function a/352[int] b/353 (catch - (if a/351 (if b/352 (let (p/353 =a (field_imm 0 b/352)) p/353) (exit 12)) + (if a/352 (if b/353 (let (p/354 =a (field_imm 0 b/353)) p/354) (exit 12)) (exit 12)) - with (12) (let (p/354 =a (makeblock 0 a/351 b/352)) p/354))) -(function a/351[int] b/352 - (catch (if a/351 (if b/352 (field_imm 0 b/352) (exit 12)) (exit 12)) - with (12) (makeblock 0 a/351 b/352))) + with (12) (let (p/355 =a (makeblock 0 a/352 b/353)) p/355))) +(function a/352[int] b/353 + (catch (if a/352 (if b/353 (field_imm 0 b/353) (exit 12)) (exit 12)) + with (12) (makeblock 0 a/352 b/353))) - : bool -> bool tuplist -> bool * bool tuplist = |}] @@ -239,20 +239,20 @@ let _ = fun a b -> match a, b with | ((_, _) as p) -> p (* inside, tuplist *) [%%expect{| -(function a/355[int] b/356 +(function a/356[int] b/357 (catch (catch - (if a/355 - (if b/356 (let (p/360 =a (field_imm 0 b/356)) (exit 13 p/360)) + (if a/356 + (if b/357 (let (p/361 =a (field_imm 0 b/357)) (exit 13 p/361)) (exit 14)) (exit 14)) - with (14) (let (p/359 =a (makeblock 0 a/355 b/356)) (exit 13 p/359))) - with (13 p/357) p/357)) -(function a/355[int] b/356 + with (14) (let (p/360 =a (makeblock 0 a/356 b/357)) (exit 13 p/360))) + with (13 p/358) p/358)) +(function a/356[int] b/357 (catch (catch - (if a/355 (if b/356 (exit 13 (field_imm 0 b/356)) (exit 14)) (exit 14)) - with (14) (exit 13 (makeblock 0 a/355 b/356))) - with (13 p/357) p/357)) + (if a/356 (if b/357 (exit 13 (field_imm 0 b/357)) (exit 14)) (exit 14)) + with (14) (exit 13 (makeblock 0 a/356 b/357))) + with (13 p/358) p/358)) - : bool -> bool tuplist -> bool * bool tuplist = |}] diff --git a/testsuite/tests/match-side-effects/partiality.ml b/testsuite/tests/match-side-effects/partiality.ml index cc17dbf7511..916524c4184 100644 --- a/testsuite/tests/match-side-effects/partiality.ml +++ b/testsuite/tests/match-side-effects/partiality.ml @@ -24,17 +24,17 @@ let f x = 0 type t = { a : bool; mutable b : int option; } (let - (f/279 = - (function x/281 : int - (if (field_int 0 x/281) - (let (*match*/285 =o (field_mut 1 x/281)) - (if *match*/285 - (if (seq (setfield_ptr 1 x/281 0) 0) 2 - (let (*match*/286 =o (field_mut 1 x/281)) - (field_imm 0 *match*/286))) + (f/280 = + (function x/282 : int + (if (field_int 0 x/282) + (let (*match*/286 =o (field_mut 1 x/282)) + (if *match*/286 + (if (seq (setfield_ptr 1 x/282 0) 0) 2 + (let (*match*/287 =o (field_mut 1 x/282)) + (field_imm 0 *match*/287))) 1)) 0))) - (apply (field_mut 1 (global Toploop!)) "f" f/279)) + (apply (field_mut 1 (global Toploop!)) "f" f/280)) val f : t -> int = |}] @@ -55,13 +55,13 @@ let f x = 0 type t = { a : bool; mutable b : int option; } (let - (f/290 = - (function x/291 : int - (if (field_int 0 x/291) - (let (*match*/295 =o (field_mut 1 x/291)) - (if *match*/295 (field_imm 0 *match*/295) 1)) + (f/291 = + (function x/292 : int + (if (field_int 0 x/292) + (let (*match*/296 =o (field_mut 1 x/292)) + (if *match*/296 (field_imm 0 *match*/296) 1)) 0))) - (apply (field_mut 1 (global Toploop!)) "f" f/290)) + (apply (field_mut 1 (global Toploop!)) "f" f/291)) val f : t -> int = |}] @@ -84,21 +84,21 @@ let f r = unsound here. *) [%%expect {| (let - (f/297 = - (function r/298 : int - (let (*match*/300 = (makeblock 0 r/298)) + (f/298 = + (function r/299 : int + (let (*match*/301 = (makeblock 0 r/299)) (catch - (if *match*/300 - (let (*match*/302 =o (field_mut 0 (field_imm 0 *match*/300))) - (if *match*/302 (exit 7) 0)) + (if *match*/301 + (let (*match*/303 =o (field_mut 0 (field_imm 0 *match*/301))) + (if *match*/303 (exit 7) 0)) (exit 7)) with (7) - (if (seq (setfield_ptr 0 r/298 0) 0) 1 - (if *match*/300 - (let (*match*/304 =o (field_mut 0 (field_imm 0 *match*/300))) - (field_imm 0 *match*/304)) + (if (seq (setfield_ptr 0 r/299 0) 0) 1 + (if *match*/301 + (let (*match*/305 =o (field_mut 0 (field_imm 0 *match*/301))) + (field_imm 0 *match*/305)) 3)))))) - (apply (field_mut 1 (global Toploop!)) "f" f/297)) + (apply (field_mut 1 (global Toploop!)) "f" f/298)) val f : int option ref -> int = |}] @@ -118,10 +118,10 @@ let test = function 0 type _ t = Int : int -> int t | Bool : bool -> bool t (let - (test/308 = - (function param/311 : int - (if param/311 (field_imm 0 (field_imm 0 param/311)) 0))) - (apply (field_mut 1 (global Toploop!)) "test" test/308)) + (test/309 = + (function param/312 : int + (if param/312 (field_imm 0 (field_imm 0 param/312)) 0))) + (apply (field_mut 1 (global Toploop!)) "test" test/309)) val test : int t option -> int = |}] @@ -139,11 +139,11 @@ let test = function 0 type _ t = Int : int -> int t | Bool : bool -> bool t (let - (test/316 = - (function param/318 : int - (let (*match*/319 =o (field_mut 0 param/318)) - (if *match*/319 (field_imm 0 (field_imm 0 *match*/319)) 0)))) - (apply (field_mut 1 (global Toploop!)) "test" test/316)) + (test/317 = + (function param/319 : int + (let (*match*/320 =o (field_mut 0 param/319)) + (if *match*/320 (field_imm 0 (field_imm 0 *match*/320)) 0)))) + (apply (field_mut 1 (global Toploop!)) "test" test/317)) val test : int t option ref -> int = |}] @@ -164,18 +164,18 @@ let test n = 0 type _ t = Int : int -> int t | Bool : bool -> bool t (let - (test/324 = - (function n/325 : int + (test/325 = + (function n/326 : int (let - (*match*/328 = + (*match*/329 = (makeblock 0 (makeblock 0 (makemutable 0 (int) 1) [0: 42]))) - (if *match*/328 + (if *match*/329 (let - (*match*/329 =a (field_imm 0 *match*/328) - *match*/331 =o (field_mut 0 (field_imm 0 *match*/329))) - (if *match*/331 (field_imm 0 (field_imm 1 *match*/329)) - (~ (field_imm 0 (field_imm 1 *match*/329))))) + (*match*/330 =a (field_imm 0 *match*/329) + *match*/332 =o (field_mut 0 (field_imm 0 *match*/330))) + (if *match*/332 (field_imm 0 (field_imm 1 *match*/330)) + (~ (field_imm 0 (field_imm 1 *match*/330))))) 3)))) - (apply (field_mut 1 (global Toploop!)) "test" test/324)) + (apply (field_mut 1 (global Toploop!)) "test" test/325)) val test : 'a -> int = |}] diff --git a/testsuite/tests/match-side-effects/test_contexts_code.ml b/testsuite/tests/match-side-effects/test_contexts_code.ml index 6ddb35d86d3..c2c679de02a 100644 --- a/testsuite/tests/match-side-effects/test_contexts_code.ml +++ b/testsuite/tests/match-side-effects/test_contexts_code.ml @@ -30,19 +30,19 @@ let example_1 () = Result.Error 3 | { a = true; b = Either.Left y } -> Result.Ok y;; (let - (example_1/309 = - (function param/333[int] - (let (input/311 = (makemutable 0 (int,*) 1 [0: 1])) - (if (field_int 0 input/311) - (let (*match*/336 =o (field_mut 1 input/311)) - (switch* *match*/336 + (example_1/310 = + (function param/334[int] + (let (input/312 = (makemutable 0 (int,*) 1 [0: 1])) + (if (field_int 0 input/312) + (let (*match*/337 =o (field_mut 1 input/312)) + (switch* *match*/337 case tag 0: - (if (seq (setfield_ptr 1 input/311 [1: 3]) 0) [1: 3] - (let (*match*/338 =o (field_mut 1 input/311)) - (makeblock 0 (int) (field_imm 0 *match*/338)))) + (if (seq (setfield_ptr 1 input/312 [1: 3]) 0) [1: 3] + (let (*match*/339 =o (field_mut 1 input/312)) + (makeblock 0 (int) (field_imm 0 *match*/339)))) case tag 1: [1: 2])) [1: 1])))) - (apply (field_mut 1 (global Toploop!)) "example_1" example_1/309)) + (apply (field_mut 1 (global Toploop!)) "example_1" example_1/310)) val example_1 : unit -> (bool, int) Result.t = |}] @@ -71,20 +71,20 @@ let example_2 () = Result.Error 3 | { a = true; b = { mut = Either.Left y } } -> Result.Ok y;; (let - (example_2/345 = - (function param/349[int] - (let (input/347 = (makeblock 0 (int,*) 1 (makemutable 0 [0: 1]))) - (if (field_int 0 input/347) - (let (*match*/353 =o (field_mut 0 (field_imm 1 input/347))) - (switch* *match*/353 + (example_2/346 = + (function param/350[int] + (let (input/348 = (makeblock 0 (int,*) 1 (makemutable 0 [0: 1]))) + (if (field_int 0 input/348) + (let (*match*/354 =o (field_mut 0 (field_imm 1 input/348))) + (switch* *match*/354 case tag 0: - (if (seq (setfield_ptr 0 (field_imm 1 input/347) [1: 3]) 0) + (if (seq (setfield_ptr 0 (field_imm 1 input/348) [1: 3]) 0) [1: 3] - (let (*match*/356 =o (field_mut 0 (field_imm 1 input/347))) - (makeblock 0 (int) (field_imm 0 *match*/356)))) + (let (*match*/357 =o (field_mut 0 (field_imm 1 input/348))) + (makeblock 0 (int) (field_imm 0 *match*/357)))) case tag 1: [1: 2])) [1: 1])))) - (apply (field_mut 1 (global Toploop!)) "example_2" example_2/345)) + (apply (field_mut 1 (global Toploop!)) "example_2" example_2/346)) val example_2 : unit -> (bool, int) Result.t = |}] @@ -111,16 +111,16 @@ let example_3 () = Result.Error 3 | { mut = (true, Either.Left y) } -> Result.Ok y;; (let - (example_3/362 = - (function param/366[int] - (let (input/364 =mut [0: 1 [0: 1]] *match*/367 =o *input/364) - (if (field_imm 0 *match*/367) - (switch* (field_imm 1 *match*/367) + (example_3/363 = + (function param/367[int] + (let (input/365 =mut [0: 1 [0: 1]] *match*/368 =o *input/365) + (if (field_imm 0 *match*/368) + (switch* (field_imm 1 *match*/368) case tag 0: - (if (seq (assign input/364 [0: 1 [1: 3]]) 0) [1: 3] - (makeblock 0 (int) (field_imm 0 (field_imm 1 *match*/367)))) + (if (seq (assign input/365 [0: 1 [1: 3]]) 0) [1: 3] + (makeblock 0 (int) (field_imm 0 (field_imm 1 *match*/368)))) case tag 1: [1: 2]) [1: 1])))) - (apply (field_mut 1 (global Toploop!)) "example_3" example_3/362)) + (apply (field_mut 1 (global Toploop!)) "example_3" example_3/363)) val example_3 : unit -> (bool, int) Result.t = |}] diff --git a/testsuite/tests/shapes/comp_units.ml b/testsuite/tests/shapes/comp_units.ml index c4da2e8b85e..b3ed56c0b40 100644 --- a/testsuite/tests/shapes/comp_units.ml +++ b/testsuite/tests/shapes/comp_units.ml @@ -25,7 +25,7 @@ module Mproj = Unit module F (X : sig type t end) = X [%%expect{| { - "F"[module] -> Abs<.4>(X/279, X/279<.3>); + "F"[module] -> Abs<.4>(X/280, X/280<.3>); } module F : functor (X : sig type t end) -> sig type t = X.t end |}] diff --git a/testsuite/tests/shapes/functors.ml b/testsuite/tests/shapes/functors.ml index fee5c96244e..a42beb1c4dc 100644 --- a/testsuite/tests/shapes/functors.ml +++ b/testsuite/tests/shapes/functors.ml @@ -17,7 +17,7 @@ module type S = sig type t val x : t end module Falias (X : S) = X [%%expect{| { - "Falias"[module] -> Abs<.4>(X/281, X/281<.3>); + "Falias"[module] -> Abs<.4>(X/282, X/282<.3>); } module Falias : functor (X : S) -> sig type t = X.t val x : t end |}] @@ -29,10 +29,10 @@ end { "Finclude"[module] -> Abs<.6> - (X/285, + (X/286, { - "t"[type] -> X/285<.5> . "t"[type]; - "x"[value] -> X/285<.5> . "x"[value]; + "t"[type] -> X/286<.5> . "t"[type]; + "x"[value] -> X/286<.5> . "x"[value]; }); } module Finclude : functor (X : S) -> sig type t = X.t val x : t end @@ -45,7 +45,7 @@ end [%%expect{| { "Fredef"[module] -> - Abs<.10>(X/292, { + Abs<.10>(X/293, { "t"[type] -> <.8>; "x"[value] -> <.9>; }); @@ -223,8 +223,8 @@ module Big_to_small1 : B2S = functor (X : Big) -> X [%%expect{| { "Big_to_small1"[module] -> - Abs<.40>(X/387, {<.39> - "t"[type] -> X/387<.39> . "t"[type]; + Abs<.40>(X/388, {<.39> + "t"[type] -> X/388<.39> . "t"[type]; }); } module Big_to_small1 : B2S @@ -234,8 +234,8 @@ module Big_to_small2 : B2S = functor (X : Big) -> struct include X end [%%expect{| { "Big_to_small2"[module] -> - Abs<.42>(X/390, { - "t"[type] -> X/390<.41> . "t"[type]; + Abs<.42>(X/391, { + "t"[type] -> X/391<.41> . "t"[type]; }); } module Big_to_small2 : B2S diff --git a/testsuite/tests/shapes/open_arg.ml b/testsuite/tests/shapes/open_arg.ml index ef98e68cf83..a66c190d31d 100644 --- a/testsuite/tests/shapes/open_arg.ml +++ b/testsuite/tests/shapes/open_arg.ml @@ -22,7 +22,7 @@ end = struct end [%%expect{| { - "Make"[module] -> Abs<.3>(I/281, { + "Make"[module] -> Abs<.3>(I/282, { }); } module Make : functor (I : sig end) -> sig end diff --git a/testsuite/tests/shapes/recmodules.ml b/testsuite/tests/shapes/recmodules.ml index f8523584367..bd2239c6ccf 100644 --- a/testsuite/tests/shapes/recmodules.ml +++ b/testsuite/tests/shapes/recmodules.ml @@ -43,8 +43,8 @@ and B : sig end = B [%%expect{| { - "A"[module] -> A/304<.11>; - "B"[module] -> B/305<.12>; + "A"[module] -> A/305<.11>; + "B"[module] -> B/306<.12>; } module rec A : sig type t = Leaf of B.t end and B : sig type t = int end @@ -82,12 +82,12 @@ end = Set.Make(A) "ASet"[module] -> { "compare"[value] -> - CU Stdlib . "Set"[module] . "Make"[module](A/326<.19>) . + CU Stdlib . "Set"[module] . "Make"[module](A/327<.19>) . "compare"[value]; "elt"[type] -> - CU Stdlib . "Set"[module] . "Make"[module](A/326<.19>) . "elt"[type]; + CU Stdlib . "Set"[module] . "Make"[module](A/327<.19>) . "elt"[type]; "t"[type] -> - CU Stdlib . "Set"[module] . "Make"[module](A/326<.19>) . "t"[type]; + CU Stdlib . "Set"[module] . "Make"[module](A/327<.19>) . "t"[type]; }; } module rec A : diff --git a/testsuite/tests/shapes/rotor_example.ml b/testsuite/tests/shapes/rotor_example.ml index 924d63b553c..f57824a7bb2 100644 --- a/testsuite/tests/shapes/rotor_example.ml +++ b/testsuite/tests/shapes/rotor_example.ml @@ -25,7 +25,7 @@ end [%%expect{| { "Pair"[module] -> - Abs<.9>(X/281, Y/282, { + Abs<.9>(X/282, Y/283, { "t"[type] -> <.5>; "to_string"[value] -> <.6>; }); From 59f156b638b1ba66fdf4e80e04c249d362701c51 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 6 May 2022 22:24:25 -0400 Subject: [PATCH 230/402] add some basic tests for Dyn_array --- testsuite/tests/lib-dynarray/test.ml | 171 ++++++++++++++++++++ testsuite/tests/lib-dynarray/test.reference | 1 + 2 files changed, 172 insertions(+) create mode 100644 testsuite/tests/lib-dynarray/test.ml create mode 100644 testsuite/tests/lib-dynarray/test.reference diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml new file mode 100644 index 00000000000..2e3e6e9e07a --- /dev/null +++ b/testsuite/tests/lib-dynarray/test.ml @@ -0,0 +1,171 @@ +(* TEST +*) + +module A = Dyn_array + +let () = + let a = A.create() in + A.push a 1; + A.push a 2; + assert (A.to_list a = [1;2]);; + +let () = + let a = A.create() in + A.push a 1; + A.push a 2; + A.push a 3; + assert (A.length a = 3);; + +let () = + let a = A.make 1 5 in + A.push a 6; + assert (A.to_list a = [5;6]);; + +let () = + List.iter + (fun l -> + let a = A.of_list l in + assert (A.to_list a = l)) + [ + []; + [1]; + [1;2]; + [1;2;3]; + [1;2;3;4]; + [1;2;3;4;5;6;7;8;9;10]; + ] +;; + +let () = + let a = A.create() in + A.push a 0.; A.push a 1.; + A.clear a; + A.push a 0.; A.push a 1.; A.push a 7.; A.push a 10.; A.push a 12.; + A.truncate a 2; + assert (1. = A.fold_left (+.) 0. a); + A.clear a; + assert (0 = A.length a); + A.push a 0.; A.push a 1.; A.push a 7.; A.push a 10.; A.push a 12.; + assert (1. +. 7. +. 10. +. 12. = A.fold_left (+.) 0. a);; + +let () = + let seq = Seq.(ints 0 |> take 10_000) in + let a = A.of_seq seq in + assert (Some 9999 = A.pop a); + assert (Some 9998 = A.pop a); + assert (Some 9997 = A.pop a); + assert (9997 = A.length a); + ();; + +let () = + let a = A.of_list [1;2] in + assert (Some 2 = A.pop a); + assert (Some 1 = A.pop a); + assert (None = A.pop a); + assert (None = A.pop a); + ();; + +let () = + let a = A.of_list [1;2;3] in + A.push a 4; + assert (A.to_list a = [1;2;3;4]);; + +let list_range start len : _ list = + Seq.ints start |> Seq.take len |> List.of_seq +;; + +let () = + let a1 = A.init 5 (fun i->i) + and a2 = A.init 5 (fun i->i+5) in + A.append a1 a2; + assert (A.to_list a1 = list_range 0 10);; + +let () = + let empty = A.create () + and a2 = A.init 5 (fun i->i) in + A.append empty a2; + assert (A.to_list empty = list_range 0 5);; + +let () = + let a1 = A.init 5 (fun i->i) and empty = A.create () in + A.append a1 empty; + assert (A.to_list a1 = list_range 0 5);; + +let () = + let a = A.init 3 (fun i->i) in + A.append a a; + assert (A.to_list a = [0; 1; 2; 0; 1; 2]);; + +let() = + let empty = A.create () in + A.append empty empty; + assert (A.to_list empty = []);; + +let () = + assert (A.of_list [1;2;3] |> A.copy |> A.to_list = [1;2;3]);; + +let () = + let a = A.create() in + for i=0 to 20 do A.push a i; done; + assert (A.to_list (A.copy a) = list_range 0 21);; + +let () = + assert (A.create() |> A.copy |> A.is_empty);; + + +let () = + let a = A.create() in + for i=0 to 20_000 do A.push a i; done; + List.iter + (fun size -> + A.truncate a size; + assert (A.to_list a = list_range 0 size)) + [ 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; + +let () = + let a = A.create() in + for i = 0 to 200 do + A.push a i; + done; + A.shrink_capacity a; + assert (A.length a = 201);; + +let () = + let a = A.of_list [1;2;3] in + assert (A.to_list @@ A.map string_of_int a = ["1"; "2"; "3"]);; + +let () = + let a = A.of_list [1;2;3] in + let a = A.mapi (fun i e -> Printf.sprintf "%i %i" i e) a in + assert (A.to_list a = ["0 1"; "1 2"; "2 3"]);; + +let () = + let a = A.of_list [1;2;3;4;5] in + assert (A.fold_left (+) 0 a = 15);; + +let () = + let l = list_range 0 300_000 in + let a = A.of_list l in + assert (A.to_list a = l);; + +let () = + let a = A.create() in + A.ensure_capacity_with ~dummy:42 a 200; + for i=1 to 200 do + A.unsafe_push a i + done; + assert (A.length a = 200); + assert (A.to_list a = list_range 1 200);; + +let () = + let a = A.create() in + A.push a 1; + A.ensure_capacity_nonempty a 200; + for i=2 to 200 do + A.unsafe_push a i + done; + assert (A.length a = 200); + assert (A.to_list a = list_range 1 200);; + +let () = print_endline "OK";; + diff --git a/testsuite/tests/lib-dynarray/test.reference b/testsuite/tests/lib-dynarray/test.reference new file mode 100644 index 00000000000..d86bac9de59 --- /dev/null +++ b/testsuite/tests/lib-dynarray/test.reference @@ -0,0 +1 @@ +OK From 6cbb5aba7281f258513c94671e70a7b6239eef65 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 24 Sep 2022 22:50:53 -0400 Subject: [PATCH 231/402] new design without Obj; rename dummy to filler --- stdlib/dyn_array.ml | 77 +++++++++++++--------------- stdlib/dyn_array.mli | 10 ++-- testsuite/tests/lib-dynarray/test.ml | 3 +- 3 files changed, 44 insertions(+), 46 deletions(-) diff --git a/stdlib/dyn_array.ml b/stdlib/dyn_array.ml index 49caa845c91..7cbc663b238 100644 --- a/stdlib/dyn_array.ml +++ b/stdlib/dyn_array.ml @@ -18,24 +18,13 @@ type 'a t = { mutable arr : 'a array; } -external as_float_arr : 'a array -> float array = "%identity" -external as_obj_arr : 'a array -> Obj.t array = "%identity" +(* TODO: move to runtime? bypass write barrier *) +let[@inline] fill_ (a:_ array) i ~filler : unit = + Array.unsafe_set a i filler -(* TODO: move to runtime *) -let set_junk_ (a:_ array) i : unit = - if Obj.(tag (repr a) = double_array_tag) then ( - Array.unsafe_set (as_float_arr a) i 0.; - ) else ( - Array.unsafe_set (as_obj_arr a) i (Obj.repr ()); - ) - -(* TODO: move to runtime *) -let fill_with_junk_ (a:_ array) i len : unit = - if Obj.(tag (repr a) = double_array_tag) then ( - Array.fill (as_float_arr a) i len 0.; - ) else ( - Array.fill (as_obj_arr a) i len (Obj.repr ()); - ) +(* TODO: move to runtime? bypass write barrier *) +let[@inline] fill_with_junk_ (a:_ array) i len ~filler : unit = + Array.fill a i len filler let create () = { size = 0; @@ -68,29 +57,27 @@ let[@inline] next_grow_ n = min Sys.max_array_length (1 + n + n lsr 1) (* resize the underlying array using x to temporarily fill the array *) -let actually_resize_array_ a newcapacity ~dummy : unit = +let actually_resize_array_ a newcapacity ~filler : unit = assert (newcapacity >= a.size); assert (not (array_is_empty_ a)); - let new_array = Array.make newcapacity dummy in + let new_array = Array.make newcapacity filler in Array.blit a.arr 0 new_array 0 a.size; - fill_with_junk_ new_array a.size (newcapacity-a.size); + fill_with_junk_ new_array a.size (newcapacity-a.size) ~filler; a.arr <- new_array -(* grow the array, using [x] as a temporary dummy if required *) -let actually_grow_with_ a ~dummy : unit = +(* grow the array, using [x] as a temporary filler if required *) +let actually_grow_with_ a ~filler : unit = if array_is_empty_ a then ( let len = 4 in - a.arr <- Array.make len dummy; - (* do not really use [x], it was just for knowing the type *) - fill_with_junk_ a.arr 0 len; + a.arr <- Array.make len filler; ) else ( let n = Array.length a.arr in let size = next_grow_ n in if size = n then invalid_arg "Dyn_array: cannot grow the array"; - actually_resize_array_ a size ~dummy + actually_resize_array_ a size ~filler ) -(* v is not empty; ensure it has at least [size] slots. +(* [v] is not empty; ensure it has at least [size] slots. Use {!resize_} so that calling [ensure_capacity v (length v+1)] in a loop is still behaving well. *) @@ -100,14 +87,13 @@ let ensure_assuming_not_empty_ v ~size = ) else if size > Array.length v.arr then ( let n = ref (Array.length v.arr) in while !n < size do n := next_grow_ !n done; - let dummy = v.arr.(0) in - actually_resize_array_ v !n ~dummy; + let filler = v.arr.(0) in + actually_resize_array_ v !n ~filler; ) -let ensure_capacity_with v ~dummy size : unit = +let ensure_capacity_with v ~filler size : unit = if array_is_empty_ v then ( - v.arr <- Array.make size dummy; - fill_with_junk_ v.arr 0 size + v.arr <- Array.make size filler; ) else ( ensure_assuming_not_empty_ v ~size ) @@ -127,7 +113,7 @@ let[@inline] unsafe_push v x = v.size <- v.size + 1 let push v x = - if v.size = Array.length v.arr then actually_grow_with_ v ~dummy:x; + if v.size = Array.length v.arr then actually_grow_with_ v ~filler:x; unsafe_push v x let append a b = @@ -173,12 +159,12 @@ let append_array a b = let append_list a b = match b with | [] -> () | x :: _ -> - (* use [x] as the dummy, in case the array is empty. + (* use [x] as the filler, in case the array is empty. We ensure capacity once, then we can skip the resizing checks and use {!unsafe_push}. *) let len_a = a.size in let len_b = List.length b in - ensure_capacity_with ~dummy:x a (len_a + len_b); + ensure_capacity_with ~filler:x a (len_a + len_b); List.iter (unsafe_push a) b let pop_exn v = @@ -186,7 +172,13 @@ let pop_exn v = let new_size = v.size - 1 in v.size <- new_size; let x = v.arr.(new_size) in - set_junk_ v.arr new_size; (* remove pointer to (removed) last element *) + if new_size = 0 then ( + v.arr <- [||]; (* free elements *) + ) else ( + (* remove pointer to (removed) last element *) + let filler = Array.unsafe_get v.arr 0 in + fill_ v.arr new_size ~filler; + ); x let pop v = @@ -201,10 +193,15 @@ let[@inline] copy v = { let truncate v n = let old_size = v.size in - if n < old_size then ( + if n = 0 then ( + v.size <- n; + (* free all elements *) + v.arr <- [||]; + ) else if n < old_size then ( + (* free elements by erasing them with the first element *) v.size <- n; - (* free elements by erasing them *) - fill_with_junk_ v.arr n (old_size-n); + let filler = Array.unsafe_get v.arr 0 in + fill_with_junk_ v.arr n (old_size-n) ~filler; ) let shrink_capacity v : unit = @@ -299,7 +296,7 @@ let of_list l = match l with | [x;y] -> {size=2; arr=[| x; y |]} | x::_ -> let v = create() in - ensure_capacity_with v (List.length l) ~dummy:x; + ensure_capacity_with v (List.length l) ~filler:x; List.iter (unsafe_push v) l; v diff --git a/stdlib/dyn_array.mli b/stdlib/dyn_array.mli index 4804deac51c..04759b858d8 100644 --- a/stdlib/dyn_array.mli +++ b/stdlib/dyn_array.mli @@ -42,15 +42,17 @@ val clear : 'a t -> unit and possibly references to former elements, which are therefore not garbage collectible. *) -val ensure_capacity_with : 'a t -> dummy:'a -> int -> unit +val ensure_capacity_with : 'a t -> filler:'a -> int -> unit (** Make sure that the array has at least the given capacity (underlying size). This is a more advanced operation that is only useful for performance purposes. - @param dummy an element used if the underlying array is empty, - to initialize it. It will not be retained anywhere. - @raise Invalid_arg if the size is not suitable (negative, or too big for OCaml arrays) + @param filler an element used if the underlying array is empty, + to initialize it. It will be retained until the array is totally + empty or until it is garbage collected. + @raise Invalid_arg if the size is not suitable (negative, or too big for + OCaml arrays) *) val ensure_capacity_nonempty : 'a t -> int -> unit diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 2e3e6e9e07a..ea5dcad2af9 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -150,7 +150,7 @@ let () = let () = let a = A.create() in - A.ensure_capacity_with ~dummy:42 a 200; + A.ensure_capacity_with ~filler:42 a 200; for i=1 to 200 do A.unsafe_push a i done; @@ -168,4 +168,3 @@ let () = assert (A.to_list a = list_range 1 200);; let () = print_endline "OK";; - From 3fd24538b1d7dc16832c4127cb4fc7ecf3809a60 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 26 Sep 2022 14:29:31 -0400 Subject: [PATCH 232/402] rename Dyn_array to Dynarray --- manual/src/library/stdlib-blurb.etex | 4 ++-- stdlib/.depend | 10 +++++----- stdlib/StdlibModules | 2 +- stdlib/{dyn_array.ml => dynarray.ml} | 12 ++++++------ stdlib/{dyn_array.mli => dynarray.mli} | 0 stdlib/stdlib.ml | 2 +- stdlib/stdlib.mli | 2 +- testsuite/tests/lib-dynarray/test.ml | 2 +- 8 files changed, 17 insertions(+), 17 deletions(-) rename stdlib/{dyn_array.ml => dynarray.ml} (95%) rename stdlib/{dyn_array.mli => dynarray.mli} (100%) diff --git a/manual/src/library/stdlib-blurb.etex b/manual/src/library/stdlib-blurb.etex index 3eb0d7ee10d..2f1f9ff5534 100644 --- a/manual/src/library/stdlib-blurb.etex +++ b/manual/src/library/stdlib-blurb.etex @@ -59,7 +59,7 @@ the above 4 modules \\ "Stack" & p.~\stdpageref{Stack} & last-in first-out stacks \\ "Queue" & p.~\stdpageref{Queue} & first-in first-out queues \\ "Buffer" & p.~\stdpageref{Buffer} & buffers that grow on demand \\ -"Dyn_array" & p.~\stdpageref{Dyn_array} & arrays that grow on demand \\ +"Dynarray" & p.~\stdpageref{Dynarray} & arrays that grow on demand \\ "Seq" & p.~\stdpageref{Seq} & functional iterators \\ "Lazy" & p.~\stdpageref{Lazy} & delayed evaluation \\ "Weak" & p.~\stdpageref{Weak} & references that don't prevent objects @@ -134,7 +134,7 @@ be called from C \\ \stddocitem{Condition}{condition variables to synchronize between threads} \stddocitem{Domain}{Domain spawn/join and domain local variables} \stddocitem{Digest}{MD5 message digest} -\stddocitem{Dyn_array}{Growable, mutable arrays} +\stddocitem{Dynarray}{Growable, mutable arrays} \stddocitem{Effect}{deep and shallow effect handlers} \stddocitem{Either}{either values} \stddocitem{Ephemeron}{Ephemerons and weak hash table} diff --git a/stdlib/.depend b/stdlib/.depend index b37cf14d084..4c23d3fb3b9 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -228,21 +228,21 @@ stdlib__Domain.cmx : domain.ml \ stdlib__Array.cmx \ stdlib__Domain.cmi stdlib__Domain.cmi : domain.mli -stdlib__Dyn_array.cmo : dyn_array.ml \ +stdlib__Dynarray.cmo : dynarray.ml \ stdlib__Sys.cmi \ stdlib__Seq.cmi \ stdlib__Obj.cmi \ stdlib__List.cmi \ stdlib__Array.cmi \ - stdlib__Dyn_array.cmi -stdlib__Dyn_array.cmx : dyn_array.ml \ + stdlib__Dynarray.cmi +stdlib__Dynarray.cmx : dynarray.ml \ stdlib__Sys.cmx \ stdlib__Seq.cmx \ stdlib__Obj.cmx \ stdlib__List.cmx \ stdlib__Array.cmx \ - stdlib__Dyn_array.cmi -stdlib__Dyn_array.cmi : dyn_array.mli \ + stdlib__Dynarray.cmi +stdlib__Dynarray.cmi : dynarray.mli \ stdlib__Seq.cmi stdlib__Effect.cmo : effect.ml \ stdlib__Printf.cmi \ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index aac3f60a9c8..484ac2ddd3f 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -67,7 +67,7 @@ STDLIB_MODULE_BASENAMES = \ stack \ queue \ buffer \ - dyn_array \ + dynarray \ mutex \ condition \ semaphore \ diff --git a/stdlib/dyn_array.ml b/stdlib/dynarray.ml similarity index 95% rename from stdlib/dyn_array.ml rename to stdlib/dynarray.ml index 7cbc663b238..e46c91fd4e7 100644 --- a/stdlib/dyn_array.ml +++ b/stdlib/dynarray.ml @@ -43,7 +43,7 @@ let init n f = { let blit v1 i1 v2 i2 len = if i1<0 || i2<0 || i1+len >= v1.size || i2 + len >= v2.size then - invalid_arg "Dyn_array.blit"; + invalid_arg "Dynarray.blit"; Array.blit v1.arr i1 v2.arr i2 len (* is the underlying array empty? *) @@ -73,7 +73,7 @@ let actually_grow_with_ a ~filler : unit = ) else ( let n = Array.length a.arr in let size = next_grow_ n in - if size = n then invalid_arg "Dyn_array: cannot grow the array"; + if size = n then invalid_arg "Dynarray: cannot grow the array"; actually_resize_array_ a size ~filler ) @@ -100,7 +100,7 @@ let ensure_capacity_with v ~filler size : unit = let ensure_capacity_nonempty v size : unit = if array_is_empty_ v then - invalid_arg "Dyn_array.ensure_capacity_nonempty: empty"; + invalid_arg "Dynarray.ensure_capacity_nonempty: empty"; ensure_assuming_not_empty_ v ~size let[@inline] clear v = @@ -130,14 +130,14 @@ let append a b = ) let[@inline] get v i = - if i < 0 || i >= v.size then invalid_arg "Dyn_array.get"; + if i < 0 || i >= v.size then invalid_arg "Dynarray.get"; Array.unsafe_get v.arr i let[@inline] unsafe_get v i = Array.unsafe_get v.arr i let[@inline] set v i x = - if i < 0 || i >= v.size then invalid_arg "Dyn_array.set"; + if i < 0 || i >= v.size then invalid_arg "Dynarray.set"; Array.unsafe_set v.arr i x let[@inline] unsafe_set v i x = @@ -168,7 +168,7 @@ let append_list a b = match b with List.iter (unsafe_push a) b let pop_exn v = - if v.size = 0 then invalid_arg "Dyn_array.pop_exn: empty"; + if v.size = 0 then invalid_arg "Dynarray.pop_exn: empty"; let new_size = v.size - 1 in v.size <- new_size; let x = v.arr.(new_size) in diff --git a/stdlib/dyn_array.mli b/stdlib/dynarray.mli similarity index 100% rename from stdlib/dyn_array.mli rename to stdlib/dynarray.mli diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml index 23e8f01d7c2..636a90420e9 100644 --- a/stdlib/stdlib.ml +++ b/stdlib/stdlib.ml @@ -597,7 +597,7 @@ module Complex = Complex module Condition = Condition module Digest = Digest module Domain = Domain -module Dyn_array = Dyn_array +module Dynarray = Dynarray module Effect = Effect module Either = Either module Ephemeron = Ephemeron diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index 678f0d147e3..81af56ce61d 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -1406,7 +1406,7 @@ module Domain = Domain [@@alert unstable "The Domain interface may change in incompatible ways in the future." ] -module Dyn_array = Dyn_array +module Dynarray = Dynarray module Effect = Effect [@@alert "-unstable"] [@@alert unstable diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index ea5dcad2af9..942e4e41007 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -1,7 +1,7 @@ (* TEST *) -module A = Dyn_array +module A = Dynarray let () = let a = A.create() in From 87319173a787c485f78881e307c7b0980607e909 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Sep 2022 10:12:52 -0400 Subject: [PATCH 233/402] rename pop_exn/pop to pop_last/pop_last_opt, add remove_last --- stdlib/dynarray.ml | 13 ++++++++----- stdlib/dynarray.mli | 21 ++++++++++++++------- 2 files changed, 22 insertions(+), 12 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index e46c91fd4e7..3140ce0ae54 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -167,8 +167,8 @@ let append_list a b = match b with ensure_capacity_with ~filler:x a (len_a + len_b); List.iter (unsafe_push a) b -let pop_exn v = - if v.size = 0 then invalid_arg "Dynarray.pop_exn: empty"; +let pop_last v = + if v.size = 0 then raise Not_found; let new_size = v.size - 1 in v.size <- new_size; let x = v.arr.(new_size) in @@ -181,10 +181,13 @@ let pop_exn v = ); x -let pop v = - try Some (pop_exn v) - with Invalid_argument _ -> None +let pop_last_opt v = + try Some (pop_last v) + with Not_found -> None +let remove_last v = + try ignore (pop_last v) + with Not_found -> () let[@inline] copy v = { size = v.size; diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 04759b858d8..c68e011fc48 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -28,16 +28,19 @@ type 'a t Operations such as {!pop}, and {!truncate}, reduce the size. *) val create : unit -> 'a t -(** Create a new, empty array. *) +(** [create ()] is a new, empty array. *) val make : int -> 'a -> 'a t -(** [make n x] makes a array of size [n], filled with [x]. *) +(** [make n x] makes a array of length [n], filled with [x]. *) val init : int -> (int -> 'a) -> 'a t -(** Init the array with the given function and size. *) +(** [init n f] is a new array of length [n], + such that [get (init n f) i] is [f i]. + + This is the equivalent of {!Array.init}. *) val clear : 'a t -> unit -(** Clear the content of the array. +(** [clear a] clears the content of [a], and sets its length to 0. This ensures that [length v = 0] but the underlying array is kept, and possibly references to former elements, which are therefore not garbage collectible. *) @@ -95,14 +98,18 @@ val append_seq : 'a t -> 'a Seq.t -> unit val append_list : 'a t -> 'a list -> unit (** Like {!append} but with a list. *) -val pop : 'a t -> 'a option +val pop_last_opt : 'a t -> 'a option (** Remove and return the last element, or [None] if the array is empty. *) -val pop_exn : 'a t -> 'a +val pop_last : 'a t -> 'a (** Remove the last element, or raise an exception if the array is empty. - @raise Invalid_argument on an empty array. *) + @raise Not_found on an empty array. *) + +val remove_last : 'a t -> unit +(** [remove_last a] removes the last element of [a], or does nothing + if [is_empty a]. *) val copy : 'a t -> 'a t (** Shallow copy. *) From bcd540fe9cc52c15c098befc2301bdc20943c675 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Sep 2022 10:21:49 -0400 Subject: [PATCH 234/402] use `push_last` instead of `push` --- stdlib/dynarray.ml | 12 ++++---- stdlib/dynarray.mli | 13 ++++---- testsuite/tests/lib-dynarray/test.ml | 46 ++++++++++++++-------------- 3 files changed, 36 insertions(+), 35 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 3140ce0ae54..14333878560 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -108,13 +108,13 @@ let[@inline] clear v = let[@inline] is_empty v = v.size = 0 -let[@inline] unsafe_push v x = +let[@inline] unsafe_push_last v x = Array.unsafe_set v.arr v.size x; v.size <- v.size + 1 -let push v x = +let push_last v x = if v.size = Array.length v.arr then actually_grow_with_ v ~filler:x; - unsafe_push v x + unsafe_push_last v x let append a b = if array_is_empty_ a then ( @@ -143,7 +143,7 @@ let[@inline] set v i x = let[@inline] unsafe_set v i x = Array.unsafe_set v.arr i x -let append_seq a seq = Seq.iter (fun x -> push a x) seq +let append_seq a seq = Seq.iter (fun x -> push_last a x) seq let append_array a b = let len_b = Array.length b in @@ -165,7 +165,7 @@ let append_list a b = match b with let len_a = a.size in let len_b = List.length b in ensure_capacity_with ~filler:x a (len_a + len_b); - List.iter (unsafe_push a) b + List.iter (unsafe_push_last a) b let pop_last v = if v.size = 0 then raise Not_found; @@ -300,7 +300,7 @@ let of_list l = match l with | x::_ -> let v = create() in ensure_capacity_with v (List.length l) ~filler:x; - List.iter (unsafe_push v) l; + List.iter (unsafe_push_last v) l; v let to_array v = diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index c68e011fc48..ea88b37209f 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -22,7 +22,7 @@ type 'a t (** A dynamic array containing values of type ['a]. This contains an underlying {!array} along with a size. - Operations such as {!push}, {!append}, and {!append_seq}, extend the + Operations such as {!push_last}, {!append}, and {!append_seq}, extend the size (and might reallocate the underlying array). Operations such as {!pop}, and {!truncate}, reduce the size. *) @@ -72,14 +72,15 @@ val ensure_capacity_nonempty : 'a t -> int -> unit val is_empty : 'a t -> bool (** Is the array empty? This is synonymous to [length a = 0]. *) -val push : 'a t -> 'a -> unit -(** Add an element at the end of the array. This might extend the underlying - array if it is full. +val push_last : 'a t -> 'a -> unit +(** [push_last a x] adds the element [x] at the end of the array [a]. - Calling [push] [n] times is amortized O(n) complexity, + This might grow the underlying storage of [a] if it is full. + + Calling [push_last a] n times is amortized O(n) complexity, and O(ln(n)) reallocations of the underlying array. *) -val unsafe_push : 'a t -> 'a -> unit +val unsafe_push_last : 'a t -> 'a -> unit (** Push an element, assuming there is capacity for it (e.g. using {!ensure_capacity}). diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 942e4e41007..89929112d53 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -5,20 +5,20 @@ module A = Dynarray let () = let a = A.create() in - A.push a 1; - A.push a 2; + A.push_last a 1; + A.push_last a 2; assert (A.to_list a = [1;2]);; let () = let a = A.create() in - A.push a 1; - A.push a 2; - A.push a 3; + A.push_last a 1; + A.push_last a 2; + A.push_last a 3; assert (A.length a = 3);; let () = let a = A.make 1 5 in - A.push a 6; + A.push_last a 6; assert (A.to_list a = [5;6]);; let () = @@ -38,36 +38,36 @@ let () = let () = let a = A.create() in - A.push a 0.; A.push a 1.; + A.push_last a 0.; A.push_last a 1.; A.clear a; - A.push a 0.; A.push a 1.; A.push a 7.; A.push a 10.; A.push a 12.; + A.push_last a 0.; A.push_last a 1.; A.push_last a 7.; A.push_last a 10.; A.push_last a 12.; A.truncate a 2; assert (1. = A.fold_left (+.) 0. a); A.clear a; assert (0 = A.length a); - A.push a 0.; A.push a 1.; A.push a 7.; A.push a 10.; A.push a 12.; + A.push_last a 0.; A.push_last a 1.; A.push_last a 7.; A.push_last a 10.; A.push_last a 12.; assert (1. +. 7. +. 10. +. 12. = A.fold_left (+.) 0. a);; let () = let seq = Seq.(ints 0 |> take 10_000) in let a = A.of_seq seq in - assert (Some 9999 = A.pop a); - assert (Some 9998 = A.pop a); - assert (Some 9997 = A.pop a); + assert (Some 9999 = A.pop_last_opt a); + assert (Some 9998 = A.pop_last_opt a); + assert (Some 9997 = A.pop_last_opt a); assert (9997 = A.length a); ();; let () = let a = A.of_list [1;2] in - assert (Some 2 = A.pop a); - assert (Some 1 = A.pop a); - assert (None = A.pop a); - assert (None = A.pop a); + assert (Some 2 = A.pop_last_opt a); + assert (Some 1 = A.pop_last_opt a); + assert (None = A.pop_last_opt a); + assert (None = A.pop_last_opt a); ();; let () = let a = A.of_list [1;2;3] in - A.push a 4; + A.push_last a 4; assert (A.to_list a = [1;2;3;4]);; let list_range start len : _ list = @@ -106,7 +106,7 @@ let () = let () = let a = A.create() in - for i=0 to 20 do A.push a i; done; + for i=0 to 20 do A.push_last a i; done; assert (A.to_list (A.copy a) = list_range 0 21);; let () = @@ -115,7 +115,7 @@ let () = let () = let a = A.create() in - for i=0 to 20_000 do A.push a i; done; + for i=0 to 20_000 do A.push_last a i; done; List.iter (fun size -> A.truncate a size; @@ -125,7 +125,7 @@ let () = let () = let a = A.create() in for i = 0 to 200 do - A.push a i; + A.push_last a i; done; A.shrink_capacity a; assert (A.length a = 201);; @@ -152,17 +152,17 @@ let () = let a = A.create() in A.ensure_capacity_with ~filler:42 a 200; for i=1 to 200 do - A.unsafe_push a i + A.unsafe_push_last a i done; assert (A.length a = 200); assert (A.to_list a = list_range 1 200);; let () = let a = A.create() in - A.push a 1; + A.push_last a 1; A.ensure_capacity_nonempty a 200; for i=2 to 200 do - A.unsafe_push a i + A.unsafe_push_last a i done; assert (A.length a = 200); assert (A.to_list a = list_range 1 200);; From 3e12b8d231f44aafb2dbea190189a536b5b10f3b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Sep 2022 11:55:56 -0400 Subject: [PATCH 235/402] remove uses of `Array.unsafe_{get,set}` in dynarray --- stdlib/dynarray.ml | 30 ++++++++++++------------------ 1 file changed, 12 insertions(+), 18 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 14333878560..53c706c91b5 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -20,7 +20,7 @@ type 'a t = { (* TODO: move to runtime? bypass write barrier *) let[@inline] fill_ (a:_ array) i ~filler : unit = - Array.unsafe_set a i filler + Array.set a i filler (* TODO: move to runtime? bypass write barrier *) let[@inline] fill_with_junk_ (a:_ array) i len ~filler : unit = @@ -109,7 +109,7 @@ let[@inline] clear v = let[@inline] is_empty v = v.size = 0 let[@inline] unsafe_push_last v x = - Array.unsafe_set v.arr v.size x; + Array.set v.arr v.size x; v.size <- v.size + 1 let push_last v x = @@ -131,17 +131,11 @@ let append a b = let[@inline] get v i = if i < 0 || i >= v.size then invalid_arg "Dynarray.get"; - Array.unsafe_get v.arr i - -let[@inline] unsafe_get v i = - Array.unsafe_get v.arr i + Array.get v.arr i let[@inline] set v i x = if i < 0 || i >= v.size then invalid_arg "Dynarray.set"; - Array.unsafe_set v.arr i x - -let[@inline] unsafe_set v i x = - Array.unsafe_set v.arr i x + Array.set v.arr i x let append_seq a seq = Seq.iter (fun x -> push_last a x) seq @@ -176,7 +170,7 @@ let pop_last v = v.arr <- [||]; (* free elements *) ) else ( (* remove pointer to (removed) last element *) - let filler = Array.unsafe_get v.arr 0 in + let filler = Array.get v.arr 0 in fill_ v.arr new_size ~filler; ); x @@ -203,7 +197,7 @@ let truncate v n = ) else if n < old_size then ( (* free elements by erasing them with the first element *) v.size <- n; - let filler = Array.unsafe_get v.arr 0 in + let filler = Array.get v.arr 0 in fill_with_junk_ v.arr n (old_size-n) ~filler; ) @@ -217,20 +211,20 @@ let shrink_capacity v : unit = let iter k v = let n = v.size in for i = 0 to n-1 do - k (Array.unsafe_get v.arr i) + k (Array.get v.arr i) done let iteri k v = let n = v.size in for i = 0 to n-1 do - k i (Array.unsafe_get v.arr i) + k i (Array.get v.arr i) done let map f v = if array_is_empty_ v then create () else ( - let arr = Array.init v.size (fun i -> f (Array.unsafe_get v.arr i)) in + let arr = Array.init v.size (fun i -> f (Array.get v.arr i)) in { size=v.size; arr; } ) @@ -238,7 +232,7 @@ let mapi f v = if array_is_empty_ v then create () else ( - let arr = Array.init v.size (fun i -> f i (Array.unsafe_get v.arr i)) in + let arr = Array.init v.size (fun i -> f i (Array.get v.arr i)) in { size=v.size; arr; } ) @@ -246,7 +240,7 @@ let fold_left f acc v = let rec fold acc i = if i = v.size then acc else - let x = Array.unsafe_get v.arr i in + let x = Array.get v.arr i in fold (f acc x) (i+1) in fold acc 0 @@ -309,6 +303,6 @@ let to_array v = let to_list v = let l = ref [] in for i=length v-1 downto 0 do - l := unsafe_get v i :: !l + l := get v i :: !l done; !l From 691ce714b7bad02f6da9407e21193f9912a6138c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Sep 2022 11:56:07 -0400 Subject: [PATCH 236/402] more docs --- stdlib/dynarray.ml | 2 +- stdlib/dynarray.mli | 18 +++++++++++++++--- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 53c706c91b5..c6f9d3344d9 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -155,7 +155,7 @@ let append_list a b = match b with | x :: _ -> (* use [x] as the filler, in case the array is empty. We ensure capacity once, then we can skip the resizing checks - and use {!unsafe_push}. *) + and use {!unsafe_push_last}. *) let len_a = a.size in let len_b = List.length b in ensure_capacity_with ~filler:x a (len_a + len_b); diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index ea88b37209f..ee8adc35960 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -81,14 +81,24 @@ val push_last : 'a t -> 'a -> unit and O(ln(n)) reallocations of the underlying array. *) val unsafe_push_last : 'a t -> 'a -> unit -(** Push an element, assuming there is capacity for it +(** [unsafe_push_last a x] pushes [x] as the last element of [a], + assuming there is capacity for it in [a] already (e.g. using {!ensure_capacity}). It is unspecified what happens if the capacity is not enough. - This is for advanced used only. *) + This is for advanced use cases only. *) val append : 'a t -> 'a t -> unit -(** [append a b] adds all elements of [b] to [a]. [b] is not modified. *) +(** [append a b] adds all elements of [b] at the end of [a], + in the order they appear in [b]. [b] is not modified. + + For example, [a] will contain [1,2,3,4,5,6] after this code runs: + {[ + let a = of_list [1;2;3];; + let b = of_list [4;5;6];; + let () = append a b;; + ]} + *) val append_array : 'a t -> 'a array -> unit (** Like {!append}, with an array. *) @@ -171,6 +181,8 @@ val of_array : 'a array -> 'a t Operates in [O(n)] time. *) val of_list : 'a list -> 'a t +(** [of_list l] is the array containing the elements of [l] in + the same order. *) val to_array : 'a t -> 'a array (** [to_array v] returns an array corresponding to the array [v]. *) From 7745f823b5ca8bc7187e08b139a0a9549cd6b2be Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Sep 2022 12:06:44 -0400 Subject: [PATCH 237/402] add filter/filter_map to dynarray --- stdlib/dynarray.ml | 14 ++++++++++++++ stdlib/dynarray.mli | 10 ++++++++++ 2 files changed, 24 insertions(+) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index c6f9d3344d9..22271ef8d6d 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -244,6 +244,20 @@ let fold_left f acc v = fold (f acc x) (i+1) in fold acc 0 +let filter f a = + let b = create() in + iter (fun x -> if f x then push_last b x) a; + b + +let filter_map f a = + let b = create() in + iter (fun x -> + match f x with + | None -> () + | Some y -> push_last b y) + a; + b + let exists p v = let n = v.size in let rec check i = diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index ee8adc35960..47653526249 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -149,6 +149,16 @@ val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t (** [map f v] is just like {!map}, but it also passes in the index of each element as the first argument to the function [f]. *) +val filter : ('a -> bool) -> 'a t -> 'a t +(** [filter f a] is an array containing all elements of [a] that satisfy [f] *) + +val filter_map : ('a -> 'b option) -> 'a t -> 'b t +(** [filter_map f a] is a new array [b], such that for each item [x] in [a]: + - if [f x = Some y], then [y] is in [b] + - if [f x = None], then no element is added to [b]. + + It is similar to {!List.filter_map}. *) + val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b (** Fold on elements of the array *) From 2cc8445dd2a92179413c9471cf08ba34db93b49e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Sep 2022 12:06:52 -0400 Subject: [PATCH 238/402] more docs --- stdlib/dynarray.ml | 4 ++-- stdlib/dynarray.mli | 23 +++++++++++++---------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 22271ef8d6d..fd0b4262e63 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -281,14 +281,14 @@ let of_seq seq = let to_seq v = let rec aux i () = - if i>= length v then Seq.Nil + if i >= length v then Seq.Nil else Seq.Cons (v.arr.(i), aux (i+1)) in aux 0 let to_seq_rev v = let rec aux i () = - if i<0 || i > length v then Seq.Nil + if i < 0 || i > length v then Seq.Nil else Seq.Cons (v.arr.(i), aux (i-1)) in aux (length v-1) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 47653526249..c0451ad25f6 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -167,16 +167,17 @@ val exists : ('a -> bool) -> 'a t -> bool val for_all : ('a -> bool) -> 'a t -> bool val get : 'a t -> int -> 'a -(** Access element by its index, or - @raise Invalid_argument if bad index. *) +(** [get a i] is the [i]-th element of [a]. + @raise Invalid_argument if the index is + invalid (i.e. not in [[0.. length a-1]]). *) val set : 'a t -> int -> 'a -> unit -(** Modify element at given index, or - @raise Invalid_argument if the index is - invalid (i.e. not in [[0.. length v-1]]). *) +(** [set a i x] sets the [i]-th element of [a] to be [x]. + Just like {!Array.set}, indexing starts at 0. + @raise Invalid_argument if the index is invalid. *) val blit : 'a t -> int -> 'a t -> int -> int -> unit -(** [blit a i ab j len] copies [len] elements from [a], +(** [blit a i b j len] copies [len] elements from [a], starting at index [i], into [b], starting at index [j]. See {!Array.blit}. @@ -195,16 +196,18 @@ val of_list : 'a list -> 'a t the same order. *) val to_array : 'a t -> 'a array -(** [to_array v] returns an array corresponding to the array [v]. *) +(** [to_array a] returns an array corresponding to the dynamic array [a]. + This always allocate a new array and copies item into it. *) val to_list : 'a t -> 'a list -(** Return a list with the elements contained in the array. *) +(** [to_list a] is a list with the elements contained in the array [a]. *) val of_seq : 'a Seq.t -> 'a t -(** Convert an Iterator to a array. *) +(** Convert a sequence of items to an array containing them in the + same order. *) val to_seq : 'a t -> 'a Seq.t -(** Return an iterator with the elements contained in the array. *) +(** [of_seq a] is the sequence of items [get a 0], [get a 1], etc. *) val to_seq_rev : 'a t -> 'a Seq.t (** Iterate over the array, starting from the last (top) element. *) From a49c1b66d572b0d0c679700892c22880ba9437d9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 29 Sep 2022 09:46:50 -0400 Subject: [PATCH 239/402] use add_last/unsafe_add_last for dynarray --- stdlib/dynarray.ml | 18 ++++++++-------- stdlib/dynarray.mli | 12 +++++------ testsuite/tests/lib-dynarray/test.ml | 32 ++++++++++++++-------------- 3 files changed, 31 insertions(+), 31 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index fd0b4262e63..da11d6fd225 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -108,13 +108,13 @@ let[@inline] clear v = let[@inline] is_empty v = v.size = 0 -let[@inline] unsafe_push_last v x = +let[@inline] unsafe_add_last v x = Array.set v.arr v.size x; v.size <- v.size + 1 -let push_last v x = +let add_last v x = if v.size = Array.length v.arr then actually_grow_with_ v ~filler:x; - unsafe_push_last v x + unsafe_add_last v x let append a b = if array_is_empty_ a then ( @@ -137,7 +137,7 @@ let[@inline] set v i x = if i < 0 || i >= v.size then invalid_arg "Dynarray.set"; Array.set v.arr i x -let append_seq a seq = Seq.iter (fun x -> push_last a x) seq +let append_seq a seq = Seq.iter (fun x -> add_last a x) seq let append_array a b = let len_b = Array.length b in @@ -155,11 +155,11 @@ let append_list a b = match b with | x :: _ -> (* use [x] as the filler, in case the array is empty. We ensure capacity once, then we can skip the resizing checks - and use {!unsafe_push_last}. *) + and use {!unsafe_add_last}. *) let len_a = a.size in let len_b = List.length b in ensure_capacity_with ~filler:x a (len_a + len_b); - List.iter (unsafe_push_last a) b + List.iter (unsafe_add_last a) b let pop_last v = if v.size = 0 then raise Not_found; @@ -246,7 +246,7 @@ let fold_left f acc v = let filter f a = let b = create() in - iter (fun x -> if f x then push_last b x) a; + iter (fun x -> if f x then add_last b x) a; b let filter_map f a = @@ -254,7 +254,7 @@ let filter_map f a = iter (fun x -> match f x with | None -> () - | Some y -> push_last b y) + | Some y -> add_last b y) a; b @@ -308,7 +308,7 @@ let of_list l = match l with | x::_ -> let v = create() in ensure_capacity_with v (List.length l) ~filler:x; - List.iter (unsafe_push_last v) l; + List.iter (unsafe_add_last v) l; v let to_array v = diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index c0451ad25f6..d89b9c2b5c3 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -22,7 +22,7 @@ type 'a t (** A dynamic array containing values of type ['a]. This contains an underlying {!array} along with a size. - Operations such as {!push_last}, {!append}, and {!append_seq}, extend the + Operations such as {!add_last}, {!append}, and {!append_seq}, extend the size (and might reallocate the underlying array). Operations such as {!pop}, and {!truncate}, reduce the size. *) @@ -72,16 +72,16 @@ val ensure_capacity_nonempty : 'a t -> int -> unit val is_empty : 'a t -> bool (** Is the array empty? This is synonymous to [length a = 0]. *) -val push_last : 'a t -> 'a -> unit -(** [push_last a x] adds the element [x] at the end of the array [a]. +val add_last : 'a t -> 'a -> unit +(** [add_last a x] adds the element [x] at the end of the array [a]. This might grow the underlying storage of [a] if it is full. - Calling [push_last a] n times is amortized O(n) complexity, + Calling [add_last a] n times is amortized O(n) complexity, and O(ln(n)) reallocations of the underlying array. *) -val unsafe_push_last : 'a t -> 'a -> unit -(** [unsafe_push_last a x] pushes [x] as the last element of [a], +val unsafe_add_last : 'a t -> 'a -> unit +(** [unsafe_add_last a x] pushes [x] as the last element of [a], assuming there is capacity for it in [a] already (e.g. using {!ensure_capacity}). diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 89929112d53..2596e9dd276 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -5,20 +5,20 @@ module A = Dynarray let () = let a = A.create() in - A.push_last a 1; - A.push_last a 2; + A.add_last a 1; + A.add_last a 2; assert (A.to_list a = [1;2]);; let () = let a = A.create() in - A.push_last a 1; - A.push_last a 2; - A.push_last a 3; + A.add_last a 1; + A.add_last a 2; + A.add_last a 3; assert (A.length a = 3);; let () = let a = A.make 1 5 in - A.push_last a 6; + A.add_last a 6; assert (A.to_list a = [5;6]);; let () = @@ -38,14 +38,14 @@ let () = let () = let a = A.create() in - A.push_last a 0.; A.push_last a 1.; + A.add_last a 0.; A.add_last a 1.; A.clear a; - A.push_last a 0.; A.push_last a 1.; A.push_last a 7.; A.push_last a 10.; A.push_last a 12.; + A.add_last a 0.; A.add_last a 1.; A.add_last a 7.; A.add_last a 10.; A.add_last a 12.; A.truncate a 2; assert (1. = A.fold_left (+.) 0. a); A.clear a; assert (0 = A.length a); - A.push_last a 0.; A.push_last a 1.; A.push_last a 7.; A.push_last a 10.; A.push_last a 12.; + A.add_last a 0.; A.add_last a 1.; A.add_last a 7.; A.add_last a 10.; A.add_last a 12.; assert (1. +. 7. +. 10. +. 12. = A.fold_left (+.) 0. a);; let () = @@ -67,7 +67,7 @@ let () = let () = let a = A.of_list [1;2;3] in - A.push_last a 4; + A.add_last a 4; assert (A.to_list a = [1;2;3;4]);; let list_range start len : _ list = @@ -106,7 +106,7 @@ let () = let () = let a = A.create() in - for i=0 to 20 do A.push_last a i; done; + for i=0 to 20 do A.add_last a i; done; assert (A.to_list (A.copy a) = list_range 0 21);; let () = @@ -115,7 +115,7 @@ let () = let () = let a = A.create() in - for i=0 to 20_000 do A.push_last a i; done; + for i=0 to 20_000 do A.add_last a i; done; List.iter (fun size -> A.truncate a size; @@ -125,7 +125,7 @@ let () = let () = let a = A.create() in for i = 0 to 200 do - A.push_last a i; + A.add_last a i; done; A.shrink_capacity a; assert (A.length a = 201);; @@ -152,17 +152,17 @@ let () = let a = A.create() in A.ensure_capacity_with ~filler:42 a 200; for i=1 to 200 do - A.unsafe_push_last a i + A.unsafe_add_last a i done; assert (A.length a = 200); assert (A.to_list a = list_range 1 200);; let () = let a = A.create() in - A.push_last a 1; + A.add_last a 1; A.ensure_capacity_nonempty a 200; for i=2 to 200 do - A.unsafe_push_last a i + A.unsafe_add_last a i done; assert (A.length a = 200); assert (A.to_list a = list_range 1 200);; From 9458313711e9a006845f3c30cd9b3f023184793a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 29 Sep 2022 16:38:49 -0400 Subject: [PATCH 240/402] rename shrink_capacity to fit_capacity; add append_iter; update doc --- stdlib/dynarray.ml | 16 ++++- stdlib/dynarray.mli | 104 +++++++++++++++++++-------- testsuite/tests/lib-dynarray/test.ml | 10 ++- 3 files changed, 96 insertions(+), 34 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index da11d6fd225..68e0ae293f4 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -137,7 +137,10 @@ let[@inline] set v i x = if i < 0 || i >= v.size then invalid_arg "Dynarray.set"; Array.set v.arr i x -let append_seq a seq = Seq.iter (fun x -> add_last a x) seq +let append_iter a iter b = + iter (fun x -> add_last a x) b + +let append_seq a seq = append_iter a Seq.iter seq let append_array a b = let len_b = Array.length b in @@ -201,7 +204,7 @@ let truncate v n = fill_with_junk_ v.arr n (old_size-n) ~filler; ) -let shrink_capacity v : unit = +let fit_capacity v : unit = if v.size = 0 then ( v.arr <- [| |] ) else if v.size < Array.length v.arr then ( @@ -274,6 +277,15 @@ let for_all p v = let length v = v.size +let rev a = + if is_empty a then create() + else ( + let old_arr = a.arr in + let n = Array.length old_arr in + let arr = Array.init n (fun i -> old_arr.(n - i - 1)) in + { size=a.size; arr} + ) + let of_seq seq = let init = create() in append_seq init seq; diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index d89b9c2b5c3..550d3daf7c4 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -46,7 +46,8 @@ val clear : 'a t -> unit not garbage collectible. *) val ensure_capacity_with : 'a t -> filler:'a -> int -> unit -(** Make sure that the array has at least the given capacity (underlying size). +(** [ensure_capacity_with a ~filler n] makes sure that [a] + has at least a capacity for storing [n] elements. This is a more advanced operation that is only useful for performance purposes. @@ -59,8 +60,9 @@ val ensure_capacity_with : 'a t -> filler:'a -> int -> unit *) val ensure_capacity_nonempty : 'a t -> int -> unit -(** Make sure that the array has at least the given capacity (underlying size), - assuming it is non-empty. The first element is used as the filler. +(** [ensure_capacity_nonempty a n] makes sure that [a] has at least the + capacity [n], assuming it is already non-empty. + The first element is used as the filler. This is a more advanced operation that is only useful for performance purposes. @@ -70,7 +72,10 @@ val ensure_capacity_nonempty : 'a t -> int -> unit *) val is_empty : 'a t -> bool -(** Is the array empty? This is synonymous to [length a = 0]. *) +(** [is_empty a] is [true] if [a] is empty, that is, if [length a = 0]. + + Note that an empty dynarray might still have non-0 underlying capacity + and therefore non-0 memory footprint. *) val add_last : 'a t -> 'a -> unit (** [add_last a x] adds the element [x] at the end of the array [a]. @@ -81,8 +86,8 @@ val add_last : 'a t -> 'a -> unit and O(ln(n)) reallocations of the underlying array. *) val unsafe_add_last : 'a t -> 'a -> unit -(** [unsafe_add_last a x] pushes [x] as the last element of [a], - assuming there is capacity for it in [a] already +(** [unsafe_add_last a x] adds [x] as the last element of [a], + assuming there is room for it in [a] already (e.g. using {!ensure_capacity}). It is unspecified what happens if the capacity is not enough. @@ -109,13 +114,24 @@ val append_seq : 'a t -> 'a Seq.t -> unit val append_list : 'a t -> 'a list -> unit (** Like {!append} but with a list. *) +val append_iter : + 'a t -> + (('a -> unit) -> 'x -> unit) -> + 'x -> unit +(** [append_iter a iter x] adds to [a] each element in [x]. It uses [iter] + to iterate over [x]. + + For example, [append_iter a List.iter [1;2;3]] would add elements + [1], [2], and [3] at the end of [a]. + [append_iter a Queue.iter q] adds elements from the queue [q]. *) + val pop_last_opt : 'a t -> 'a option -(** Remove and return the last element, or [None] if the - array is empty. *) +(** [pop_last_opt a] removes and returns the last element of [a], + or [None] if the array is empty. *) val pop_last : 'a t -> 'a -(** Remove the last element, or raise an exception if the - array is empty. +(** [pop_last a] removes and returns the last element of [a], assuming + [a] is not empty. @raise Not_found on an empty array. *) val remove_last : 'a t -> unit @@ -123,30 +139,41 @@ val remove_last : 'a t -> unit if [is_empty a]. *) val copy : 'a t -> 'a t -(** Shallow copy. *) +(** [copy a] is a shallow copy of [a], that can be modified independently. *) val truncate : 'a t -> int -> unit -(** Truncate to the given size (remove elements above this size). - Does nothing if the parameter is bigger than the current size. +(** [truncate a n] truncates [a] to have at most [n] elements. - [truncate arr n] is similar to: - [while length arr > n do ignore (pop_exn arr) done] *) + It removes elements whose index is great or equal than [n]. + It does nothing if [n >= length a]. + + It is similar to: + {[ + while length a > n do + remove_last a + done + ]} *) -val shrink_capacity : 'a t -> unit -(** Shrink internal array to fit the size of the array. This can be useful - to make sure there is no memory wasted on a long-held array. *) +val fit_capacity : 'a t -> unit +(** [fit_capacity a] shrinks the internal array to fit [length a] exactly, + with no additional empty space at the end. This can be useful + to make sure there is no memory wasted on a long-lived array. + This does nothing if [a] is already full. *) val iter : ('a -> unit) -> 'a t -> unit -(** Iterate on the array's content. *) +(** [iter f a] calls [f] on each element of [a], in increasing index order. *) val iteri : (int -> 'a -> unit) -> 'a t -> unit -(** Iterate on the array, with indexes. *) +(** [iteri f a] calls [f i x] for each [x] at index [i] in [a].. *) val map : ('a -> 'b) -> 'a t -> 'b t -(** Map elements of the array, yielding a new array. *) +(** [map f a] is a new array of length [length a], with elements mapped + from [a] using [f]. + + It is similar to [to_array a |> Array.map f |> of_array]. *) val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t -(** [map f v] is just like {!map}, but it also passes in the index +(** [mapi f v] is just like {!map}, but it also passes in the index of each element as the first argument to the function [f]. *) val filter : ('a -> bool) -> 'a t -> 'a t @@ -160,20 +187,25 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t It is similar to {!List.filter_map}. *) val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b -(** Fold on elements of the array *) +(** [fold_left f acc a] folds [f] over [a] starting with accumulator [acc]. + + It is similar to [Array.fold_left f acc (to_array a)]. *) val exists : ('a -> bool) -> 'a t -> bool +(** [exists f a] returns [true] if some element of [a] satisfies [f]. *) val for_all : ('a -> bool) -> 'a t -> bool +(** [for_all f a] returns [true] if all elements of [a] satisfie [f]. + This includes the case where [a] is empty. *) val get : 'a t -> int -> 'a -(** [get a i] is the [i]-th element of [a]. +(** [get a i] is the [i]-th element of [a], starting with index [0]. @raise Invalid_argument if the index is invalid (i.e. not in [[0.. length a-1]]). *) val set : 'a t -> int -> 'a -> unit (** [set a i x] sets the [i]-th element of [a] to be [x]. - Just like {!Array.set}, indexing starts at 0. + Just like {!get}, indexing starts at 0. @raise Invalid_argument if the index is invalid. *) val blit : 'a t -> int -> 'a t -> int -> int -> unit @@ -184,12 +216,18 @@ val blit : 'a t -> int -> 'a t -> int -> int -> unit @raise Invalid_argument if the indices or lengthts are not valid. *) +val rev : 'a t -> 'a t +(** [rev a] is a new array containing the same elements as [a], but in the + reverse order. *) + val length : _ t -> int -(** Number of elements in the array. *) +(** [length a] is the number of elements in the array. + The last element of [a], if not empty, is [get a (length a - 1)]. + This operation is constant time. *) val of_array : 'a array -> 'a t (** [of_array a] returns a array corresponding to the array [a]. - Operates in [O(n)] time. *) + Operates in [O(n)] time by making a copy. *) val of_list : 'a list -> 'a t (** [of_list l] is the array containing the elements of [l] in @@ -203,11 +241,15 @@ val to_list : 'a t -> 'a list (** [to_list a] is a list with the elements contained in the array [a]. *) val of_seq : 'a Seq.t -> 'a t -(** Convert a sequence of items to an array containing them in the - same order. *) +(** [of_seq seq] is an array containing the same elements as [seq]. + + It traverses [seq] only once and will terminate only if [seq] is finite. *) val to_seq : 'a t -> 'a Seq.t -(** [of_seq a] is the sequence of items [get a 0], [get a 1], etc. *) +(** [of_seq a] is the sequence of items [get a 0], [get a 1], etc. + This sequence can be safely reused multiple times as long as [a] + is not changed in the mean time. *) val to_seq_rev : 'a t -> 'a Seq.t -(** Iterate over the array, starting from the last (top) element. *) +(** [to_seq_rev a] is like [to_seq (rev a)]. + It yields the last element of [a] first. *) diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 2596e9dd276..48274172150 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -127,7 +127,7 @@ let () = for i = 0 to 200 do A.add_last a i; done; - A.shrink_capacity a; + A.fit_capacity a; assert (A.length a = 201);; let () = @@ -167,4 +167,12 @@ let () = assert (A.length a = 200); assert (A.to_list a = list_range 1 200);; +let () = + assert (A.of_list [1;2;3] |> A.rev |> A.to_list = [3;2;1]); + assert (A.of_list [1;2] |> A.rev |> A.to_list = [2;1]); + assert (A.of_list [1] |> A.rev |> A.to_list = [1]); + assert (A.of_list [] |> A.rev |> A.to_list = []); + assert (A.of_seq (Seq.ints 0 |> Seq.take 1000) |> A.rev |> A.length = 1000); + () + let () = print_endline "OK";; From 23747d174e0301e69dbad0116d873c5d5117f364 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 29 Sep 2022 16:44:40 -0400 Subject: [PATCH 241/402] fix doc --- stdlib/dynarray.mli | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 550d3daf7c4..afb1753b2f8 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -21,11 +21,11 @@ type 'a t (** A dynamic array containing values of type ['a]. - This contains an underlying {!array} along with a size. + This contains an underlying array along with a size. Operations such as {!add_last}, {!append}, and {!append_seq}, extend the size (and might reallocate the underlying array). - Operations such as {!pop}, and {!truncate}, reduce the size. *) + Operations such as {!pop_last}, and {!truncate}, reduce the size. *) val create : unit -> 'a t (** [create ()] is a new, empty array. *) @@ -88,7 +88,7 @@ val add_last : 'a t -> 'a -> unit val unsafe_add_last : 'a t -> 'a -> unit (** [unsafe_add_last a x] adds [x] as the last element of [a], assuming there is room for it in [a] already - (e.g. using {!ensure_capacity}). + (e.g. using {!ensure_capacity_with}). It is unspecified what happens if the capacity is not enough. This is for advanced use cases only. *) From 6256a2fa8bfa58e751e49a9cc943f0120d2364ed Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 9 Jan 2023 09:07:06 +0100 Subject: [PATCH 242/402] dynarray interface: a single `ensure_capacity` function --- stdlib/dynarray.ml | 11 +++-------- stdlib/dynarray.mli | 16 ++-------------- testsuite/tests/lib-dynarray/test.ml | 12 +----------- 3 files changed, 6 insertions(+), 33 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 68e0ae293f4..64e5d3d5719 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -91,18 +91,13 @@ let ensure_assuming_not_empty_ v ~size = actually_resize_array_ v !n ~filler; ) -let ensure_capacity_with v ~filler size : unit = +let ensure_capacity v ~filler size : unit = if array_is_empty_ v then ( v.arr <- Array.make size filler; ) else ( ensure_assuming_not_empty_ v ~size ) -let ensure_capacity_nonempty v size : unit = - if array_is_empty_ v then - invalid_arg "Dynarray.ensure_capacity_nonempty: empty"; - ensure_assuming_not_empty_ v ~size - let[@inline] clear v = v.size <- 0 @@ -161,7 +156,7 @@ let append_list a b = match b with and use {!unsafe_add_last}. *) let len_a = a.size in let len_b = List.length b in - ensure_capacity_with ~filler:x a (len_a + len_b); + ensure_capacity ~filler:x a (len_a + len_b); List.iter (unsafe_add_last a) b let pop_last v = @@ -319,7 +314,7 @@ let of_list l = match l with | [x;y] -> {size=2; arr=[| x; y |]} | x::_ -> let v = create() in - ensure_capacity_with v (List.length l) ~filler:x; + ensure_capacity v (List.length l) ~filler:x; List.iter (unsafe_add_last v) l; v diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index afb1753b2f8..ea82f7a2b4d 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -45,8 +45,8 @@ val clear : 'a t -> unit and possibly references to former elements, which are therefore not garbage collectible. *) -val ensure_capacity_with : 'a t -> filler:'a -> int -> unit -(** [ensure_capacity_with a ~filler n] makes sure that [a] +val ensure_capacity : 'a t -> filler:'a -> int -> unit +(** [ensure_capacity a ~filler n] makes sure that [a] has at least a capacity for storing [n] elements. This is a more advanced operation that is only useful for performance @@ -59,18 +59,6 @@ val ensure_capacity_with : 'a t -> filler:'a -> int -> unit OCaml arrays) *) -val ensure_capacity_nonempty : 'a t -> int -> unit -(** [ensure_capacity_nonempty a n] makes sure that [a] has at least the - capacity [n], assuming it is already non-empty. - The first element is used as the filler. - - This is a more advanced operation that is only useful for performance - purposes. - - @raise Invalid_arg if the array is empty or - if the size is not suitable (negative, or too big for OCaml arrays) -*) - val is_empty : 'a t -> bool (** [is_empty a] is [true] if [a] is empty, that is, if [length a = 0]. diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 48274172150..7abaccdd73f 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -150,23 +150,13 @@ let () = let () = let a = A.create() in - A.ensure_capacity_with ~filler:42 a 200; + A.ensure_capacity ~filler:42 a 200; for i=1 to 200 do A.unsafe_add_last a i done; assert (A.length a = 200); assert (A.to_list a = list_range 1 200);; -let () = - let a = A.create() in - A.add_last a 1; - A.ensure_capacity_nonempty a 200; - for i=2 to 200 do - A.unsafe_add_last a i - done; - assert (A.length a = 200); - assert (A.to_list a = list_range 1 200);; - let () = assert (A.of_list [1;2;3] |> A.rev |> A.to_list = [3;2;1]); assert (A.of_list [1;2] |> A.rev |> A.to_list = [2;1]); From fef721c099e87ff47dcac4aef42336772e7c5982 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 9 Jan 2023 09:15:28 +0100 Subject: [PATCH 243/402] dynarray interface: remove `blit` I think that it is natural for users to expect that 'blit' can be used on ranges that go past the current end of the array. We could warn about it in the documentation and have a clear error, or we could decide to support this use-case. I suffer from decision fatigue on this question, and I think that it is better to remove this rarely-used function. --- stdlib/dynarray.ml | 5 ----- stdlib/dynarray.mli | 8 -------- 2 files changed, 13 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 64e5d3d5719..f0a49643def 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -41,11 +41,6 @@ let init n f = { arr=Array.init n f; } -let blit v1 i1 v2 i2 len = - if i1<0 || i2<0 || i1+len >= v1.size || i2 + len >= v2.size then - invalid_arg "Dynarray.blit"; - Array.blit v1.arr i1 v2.arr i2 len - (* is the underlying array empty? *) let[@inline] array_is_empty_ v = Array.length v.arr = 0 diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index ea82f7a2b4d..cc5526c56c9 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -196,14 +196,6 @@ val set : 'a t -> int -> 'a -> unit Just like {!get}, indexing starts at 0. @raise Invalid_argument if the index is invalid. *) -val blit : 'a t -> int -> 'a t -> int -> int -> unit -(** [blit a i b j len] copies [len] elements from [a], - starting at index [i], into [b], starting at index [j]. - - See {!Array.blit}. - @raise Invalid_argument if the indices or lengthts are not valid. -*) - val rev : 'a t -> 'a t (** [rev a] is a new array containing the same elements as [a], but in the reverse order. *) From 4b54d610c855ce9eb5f7b096592561be230109fa Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 9 Jan 2023 09:20:32 +0100 Subject: [PATCH 244/402] dynarray interface: remove `rev` just use Dynarray.init --- stdlib/dynarray.ml | 9 --------- stdlib/dynarray.mli | 4 ---- testsuite/tests/lib-dynarray/test.ml | 8 -------- 3 files changed, 21 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index f0a49643def..7b9679ff347 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -267,15 +267,6 @@ let for_all p v = let length v = v.size -let rev a = - if is_empty a then create() - else ( - let old_arr = a.arr in - let n = Array.length old_arr in - let arr = Array.init n (fun i -> old_arr.(n - i - 1)) in - { size=a.size; arr} - ) - let of_seq seq = let init = create() in append_seq init seq; diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index cc5526c56c9..2681eb6c0ed 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -196,10 +196,6 @@ val set : 'a t -> int -> 'a -> unit Just like {!get}, indexing starts at 0. @raise Invalid_argument if the index is invalid. *) -val rev : 'a t -> 'a t -(** [rev a] is a new array containing the same elements as [a], but in the - reverse order. *) - val length : _ t -> int (** [length a] is the number of elements in the array. The last element of [a], if not empty, is [get a (length a - 1)]. diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 7abaccdd73f..579c352326d 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -157,12 +157,4 @@ let () = assert (A.length a = 200); assert (A.to_list a = list_range 1 200);; -let () = - assert (A.of_list [1;2;3] |> A.rev |> A.to_list = [3;2;1]); - assert (A.of_list [1;2] |> A.rev |> A.to_list = [2;1]); - assert (A.of_list [1] |> A.rev |> A.to_list = [1]); - assert (A.of_list [] |> A.rev |> A.to_list = []); - assert (A.of_seq (Seq.ints 0 |> Seq.take 1000) |> A.rev |> A.length = 1000); - () - let () = print_endline "OK";; From 7d190a3f3393e18b09b6c9c0a840433710078787 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 9 Jan 2023 09:25:00 +0100 Subject: [PATCH 245/402] dynarray interface: add 'reset' as in Buffer --- stdlib/dynarray.ml | 4 ++++ stdlib/dynarray.mli | 14 +++++++++++++- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 7b9679ff347..9b0b24129c2 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -96,6 +96,10 @@ let ensure_capacity v ~filler size : unit = let[@inline] clear v = v.size <- 0 +let[@inline] reset v = + v.size <- 0; + v.arr <- [| |] + let[@inline] is_empty v = v.size = 0 let[@inline] unsafe_add_last v x = diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 2681eb6c0ed..1bdd142fd92 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -43,7 +43,19 @@ val clear : 'a t -> unit (** [clear a] clears the content of [a], and sets its length to 0. This ensures that [length v = 0] but the underlying array is kept, and possibly references to former elements, which are therefore - not garbage collectible. *) + not garbage collectible. + + Similar to {!Buffer.clear}. +*) + +val reset : 'a t -> unit +(** [clear a] clears the content of [a], and sets its length to 0, + and reset the underlying array to be empty, allowing the previous + underlying array to be collected. + + Similar to {!Buffer.reset}. +*) + val ensure_capacity : 'a t -> filler:'a -> int -> unit (** [ensure_capacity a ~filler n] makes sure that [a] From a292aa906ddd15342ee7a766bb81b6507920dabe Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 9 Jan 2023 09:30:43 +0100 Subject: [PATCH 246/402] dynarray interface: optimize `add_last` and remove `unsafe_add_last` --- stdlib/dynarray.ml | 7 +++++-- stdlib/dynarray.mli | 8 -------- testsuite/tests/lib-dynarray/test.ml | 9 --------- 3 files changed, 5 insertions(+), 19 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 9b0b24129c2..0e5e8200fa4 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -107,8 +107,11 @@ let[@inline] unsafe_add_last v x = v.size <- v.size + 1 let add_last v x = - if v.size = Array.length v.arr then actually_grow_with_ v ~filler:x; - unsafe_add_last v x + if v.size < Array.length v.arr then unsafe_add_last v x + else begin + actually_grow_with_ v ~filler:x; + unsafe_add_last v x + end let append a b = if array_is_empty_ a then ( diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 1bdd142fd92..53cf2478a54 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -85,14 +85,6 @@ val add_last : 'a t -> 'a -> unit Calling [add_last a] n times is amortized O(n) complexity, and O(ln(n)) reallocations of the underlying array. *) -val unsafe_add_last : 'a t -> 'a -> unit -(** [unsafe_add_last a x] adds [x] as the last element of [a], - assuming there is room for it in [a] already - (e.g. using {!ensure_capacity_with}). - - It is unspecified what happens if the capacity is not enough. - This is for advanced use cases only. *) - val append : 'a t -> 'a t -> unit (** [append a b] adds all elements of [b] at the end of [a], in the order they appear in [b]. [b] is not modified. diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 579c352326d..be15ead8f98 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -148,13 +148,4 @@ let () = let a = A.of_list l in assert (A.to_list a = l);; -let () = - let a = A.create() in - A.ensure_capacity ~filler:42 a 200; - for i=1 to 200 do - A.unsafe_add_last a i - done; - assert (A.length a = 200); - assert (A.to_list a = list_range 1 200);; - let () = print_endline "OK";; From e838f6b2c7b8c6d7583a5abdf10bb0a6013a42a3 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 10 Jan 2023 13:08:51 +0100 Subject: [PATCH 247/402] Dynarray: more agressive resizing strategy --- stdlib/dynarray.ml | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 0e5e8200fa4..9db7089b048 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -45,11 +45,23 @@ let init n f = { let[@inline] array_is_empty_ v = Array.length v.arr = 0 -(* next capacity, if current one is [n]. Roughly use [n * 1.5], because it - provides the good behavior of amortized O(1) number of allocations - without wasting too much memory in the worst case. *) -let[@inline] next_grow_ n = - min Sys.max_array_length (1 + n + n lsr 1) +let next_grow_ n = + let n' = + (* For large values of n, we use 1.5 as our growth factor. + + For smaller values of n, we grow more aggressively to avoid + reallocating too much when accumulating elements into an empty + array. + + The constants "512 words" and "8 words" below are taken from + https://github.com/facebook/folly/blob/ + c06c0f41d91daf1a6a5f3fc1cd465302ac260459/folly/FBVector.h#L1128-L1157 + *) + if n <= 512 then n * 2 + else n + n / 2 + in + (* jump directly from 0 to 8 *) + min (max 8 n') Sys.max_array_length (* resize the underlying array using x to temporarily fill the array *) let actually_resize_array_ a newcapacity ~filler : unit = From 15924d2f7268cf2fbc263a1e5754135f8603616a Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 9 Jan 2023 11:09:29 +0100 Subject: [PATCH 248/402] Dynarray: boxed (non-reentrant) implementation, better documentation --- stdlib/.depend | 4 +- stdlib/StdlibModules | 2 +- stdlib/dynarray.ml | 807 +++++++++++++++++++++++++++++-------------- stdlib/dynarray.mli | 377 ++++++++++++++------ 4 files changed, 828 insertions(+), 362 deletions(-) diff --git a/stdlib/.depend b/stdlib/.depend index 4c23d3fb3b9..6441fc1ba90 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -231,14 +231,14 @@ stdlib__Domain.cmi : domain.mli stdlib__Dynarray.cmo : dynarray.ml \ stdlib__Sys.cmi \ stdlib__Seq.cmi \ - stdlib__Obj.cmi \ + stdlib__Printf.cmi \ stdlib__List.cmi \ stdlib__Array.cmi \ stdlib__Dynarray.cmi stdlib__Dynarray.cmx : dynarray.ml \ stdlib__Sys.cmx \ stdlib__Seq.cmx \ - stdlib__Obj.cmx \ + stdlib__Printf.cmx \ stdlib__List.cmx \ stdlib__Array.cmx \ stdlib__Dynarray.cmi diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index 484ac2ddd3f..efd654069e0 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -67,13 +67,13 @@ STDLIB_MODULE_BASENAMES = \ stack \ queue \ buffer \ - dynarray \ mutex \ condition \ semaphore \ domain \ camlinternalFormat \ printf \ + dynarray \ arg \ printexc \ fun \ diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 9db7089b048..af023126996 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -2,7 +2,7 @@ (* *) (* OCaml *) (* *) -(* Simon Cruanes *) +(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *) (* *) (* Copyright 2022 Institut National de Recherche en Informatique et *) (* en Automatique. *) @@ -14,38 +14,277 @@ (**************************************************************************) type 'a t = { - mutable size : int; - mutable arr : 'a array; + mutable length : int; + mutable arr : 'a slot array; } +(* {2 The type ['a t]} + + A dynamic array is represented using a backing array [arr] and + a [length]. It behaves as an array of size [length] -- the indices + from [0] to [length - 1] included contain user-provided values and + can be [get] and [set] -- but the length may also change in the + future by adding or removing elements at the end. + + We use the following concepts; + - capacity: the length of the backing array: + [Array.length arr] + - live space: the portion of the backing array with + indices from [0] to [length] excluded. + - empty space: the portion of the backing array + from [length] to the end of the backing array. + + {2 The type ['a slot]} + + We should not keep a user-provided value in the empty space, as + this could extend its lifetime and may result in memory leaks of + arbitrary size. Functions that remove elements from the dynamic + array, such as [pop_last] or [truncate], must really erase the + element from the backing array. + + This constraint makes it difficult to represent an dynamic array of + elements of type ['a] with a backing array of type ['a array]: what + valid value of type ['a] would we use in the empty space? Typical + choices include: + - accepting scenarios where we actually leak user-provided values + (but this can blowup memory usage in some cases, and is hard to debug) + - requiring a "dummy" value at creation of the dynamic array + or in the parts of the API that grow the empty space + (but users find this very inconvenient) + - using arcane Obj.magic tricks + (but experts don't agree on which tricks are safe to use and/or + should be used here) + - using a backing array of ['a option] values, using [None] + in the empty space + (but this gives a noticeably less efficient memory representation) + + In the present implementation, we use the ['a option] approach, + with a twist. With ['a option], calling [set a i x] must reallocate + a new [Some x] block: +{[ + let set a i x = + if i < 0 || i >= a.length then error "out of bounds"; + a.arr.(i) <- Some x +]} + Instead we use the type ['a slot] below, + which behaves as an option whose [Some] constructor + (called [Elem] here) has a _mutable_ argument. +*) +and 'a slot = +| Empty +| Elem of { mutable v: 'a } +(* + This gives an allocation-free implementation of [set] that calls + [Array.get] (instead of [Array.set]) on the backing array and then + mutates the [v] parameter. In pseudo-code: +{[ + let set a i x = + if i < 0 || i >= a.length then error "out of bounds"; + match a.arr.(i) with + | Empty -> error "invalid state: missing element" + | Elem s -> s.v <- x +]} + With this approach, accessing an element still pays the cost of an + extra indirection (compared to approaches that do not box elements + in the backing array), but only operations that add new elements at + the end of the array pay extra allocations. + + There are some situations where ['a option] is better: it makes + [pop_last_opt] more efficient as the underlying option can be + returned directly, and it also lets us use [Array.blit] to + implement [append]. We believe that optimzing [get] and [set] is + more important for dynamic arrays. + + {2 Invariants and valid states} + + We enforce the invariant that [length >= 0] at all times. + we rely on this invariant for optimization. + + The following conditions define what we call a "valid" dynarray: + - valid length: [length <= Array.length arr] + - no missing element in the live space: + forall i, [0 <= i <=length] implies [arr.(i) <> Empty] + - no element in the empty space: + forall i, [0 <= i < length] implies [arr.(i) = Empty] + + Unfortunately, we cannot easily enforce validity as an invariant in + presence of concurrent udpates. We can thus observe dynarrays in + "invalid states". Our implementation may raise exceptions or return + incorrect results on observing invalid states, but of course it + must preserve memory safety. +*) + +module Error = struct + let index_out_of_bounds f ~i ~length = + if length = 0 then + Printf.ksprintf invalid_arg + "Dynarray.%s: empty dynarray" + f + else + Printf.ksprintf invalid_arg + "Dynarray.%s: index %d out of bounds (0..%d)" + f i (length - 1) + + let negative_length f n = + Printf.ksprintf invalid_arg + "Dynarray.%s: negative length %d" + f n + + let negative_capacity f n = + Printf.ksprintf invalid_arg + "Dynarray.%s: negative capacity %d" + f n + + let requested_length_out_of_bounds f requested_length = + (* We do not consider this error as a programming error, + so we raise [Failure] instead of [Invalid_argument]. *) + Printf.ksprintf failwith + "Dynarray.%s: cannot grow to requested length %d (max_array_length is %d)" + f requested_length Sys.max_array_length + + (* When observing an invalid state ([missing_element], + [invalid_length]), we do not give the name of the calling function + in the error message, as the error is related to invalid operations + performed earlier, and not to the callsite of the function + itself. *) + + let missing_element ~i ~length = + Printf.ksprintf invalid_arg + "Dynarray: invalid array (missing element at position %d < length %d)" + i length + + let invalid_length ~length ~capacity = + Printf.ksprintf invalid_arg + "Dynarray: invalid array (length %d > capacity %d)" + length capacity + + (* When an [Empty] element is observed unexpectedly at index [i], + it may be either an out-of-bounds access or an invalid-state situation + depending on whether [i <= length]. *) + let unexpected_empty_element f ~i ~length = + if i < length then + missing_element ~i ~length + else + index_out_of_bounds f ~i ~length +end + +(** Careful unsafe access. *) + +(* Postcondition on non-exceptional return: + [length <= Array.length arr] *) +let check_valid_length length arr = + let capacity = Array.length arr in + if length > capacity then + Error.invalid_length ~length ~capacity + +(* Precondition: [0 <= i < length <= Array.length arr] -(* TODO: move to runtime? bypass write barrier *) -let[@inline] fill_ (a:_ array) i ~filler : unit = - Array.set a i filler + This precondition is typically guaranteed by knowing + [0 <= i < length] and calling [check_valid_length length arr].*) +let unsafe_get arr ~i ~length = + match Array.unsafe_get arr i with + | Empty -> Error.missing_element ~i ~length + | Elem {v} -> v -(* TODO: move to runtime? bypass write barrier *) -let[@inline] fill_with_junk_ (a:_ array) i len ~filler : unit = - Array.fill a i len filler + +(** {1:dynarrays Dynamic arrays} *) let create () = { - size = 0; + length = 0; arr = [| |]; } -let make n x = { - size=n; - arr=Array.make n x; -} +let make n x = + if n < 0 then Error.negative_length "make" n; + { + length = n; + arr = Array.init n (fun _ -> Elem {v = x}); + } + +let init n f = + if n < 0 then Error.negative_length "init" n; + { + length = n; + arr = Array.init n (fun i -> Elem {v = f i}); + } -let init n f = { - size=n; - arr=Array.init n f; +let get a i = + (* This implementation will propagate an [Invalid_arg] exception + from array lookup if the index is out of the backing array, + instead of using our own [Error.index_out_of_bounds]. This is + allowed by our specification, and more efficient -- no need to + check that [length a <= capacity a] in the fast path. *) + match a.arr.(i) with + | Elem s -> s.v + | Empty -> + Error.unexpected_empty_element "get" ~i ~length:a.length + +let set a i x = + (* See {!get} comment on the use of checked array + access without our own bound checking. *) + match a.arr.(i) with + | Elem s -> s.v <- x + | Empty -> + Error.unexpected_empty_element "set" ~i ~length:a.length + +let length a = a.length + +let is_empty a = (a.length = 0) + +let copy {length; arr} = { + length; + arr = + Array.map (function + | Empty -> Empty + | Elem {v} -> Elem {v} + ) arr; } -(* is the underlying array empty? *) -let[@inline] array_is_empty_ v = - Array.length v.arr = 0 +(** {1:removing Removing elements} *) + +let pop_last a = + let {arr; length} = a in + if length = 0 then raise Not_found; + let last = length - 1 in + (* We know [length > 0] so [last >= 0]. + See {!get} comment on the use of checked array + access without our own bound checking. + *) + match arr.(last) with + (* At this point we know that [last] is a valid index in [arr]. *) + | Empty -> + Error.missing_element ~i:last ~length + | Elem s -> + Array.unsafe_set arr last Empty; + a.length <- last; + s.v + +let pop_last_opt a = + match pop_last a with + | exception Not_found -> None + | x -> Some x + +let remove_last a = + let last = length a - 1 in + if last >= 0 then begin + a.length <- last; + a.arr.(last) <- Empty; + end + +let truncate a n = + if n < 0 then Error.negative_length "truncate" n; + let {arr; length} = a in + if length <= n then () + else begin + a.length <- n; + Array.fill arr n (length - n) Empty; + end + +let clear a = truncate a 0 -let next_grow_ n = + +(** {1:capacity Backing array and capacity} *) + +let next_capacity n = let n' = (* For large values of n, we use 1.5 as our growth factor. @@ -63,272 +302,338 @@ let next_grow_ n = (* jump directly from 0 to 8 *) min (max 8 n') Sys.max_array_length -(* resize the underlying array using x to temporarily fill the array *) -let actually_resize_array_ a newcapacity ~filler : unit = - assert (newcapacity >= a.size); - assert (not (array_is_empty_ a)); - let new_array = Array.make newcapacity filler in - Array.blit a.arr 0 new_array 0 a.size; - fill_with_junk_ new_array a.size (newcapacity-a.size) ~filler; - a.arr <- new_array - -(* grow the array, using [x] as a temporary filler if required *) -let actually_grow_with_ a ~filler : unit = - if array_is_empty_ a then ( - let len = 4 in - a.arr <- Array.make len filler; - ) else ( - let n = Array.length a.arr in - let size = next_grow_ n in - if size = n then invalid_arg "Dynarray: cannot grow the array"; - actually_resize_array_ a size ~filler - ) - -(* [v] is not empty; ensure it has at least [size] slots. - - Use {!resize_} so that calling [ensure_capacity v (length v+1)] in a loop - is still behaving well. *) -let ensure_assuming_not_empty_ v ~size = - if size > Sys.max_array_length then ( - invalid_arg "arr.ensure: size too big" - ) else if size > Array.length v.arr then ( - let n = ref (Array.length v.arr) in - while !n < size do n := next_grow_ !n done; - let filler = v.arr.(0) in - actually_resize_array_ v !n ~filler; - ) - -let ensure_capacity v ~filler size : unit = - if array_is_empty_ v then ( - v.arr <- Array.make size filler; - ) else ( - ensure_assuming_not_empty_ v ~size - ) - -let[@inline] clear v = - v.size <- 0 - -let[@inline] reset v = - v.size <- 0; - v.arr <- [| |] - -let[@inline] is_empty v = v.size = 0 - -let[@inline] unsafe_add_last v x = - Array.set v.arr v.size x; - v.size <- v.size + 1 - -let add_last v x = - if v.size < Array.length v.arr then unsafe_add_last v x +let ensure_capacity a requested_length = + let arr = a.arr in + let cur_capacity = Array.length arr in + if cur_capacity >= requested_length then + (* This is the fast path, the code up to here must do as little as + possible. (This is why we don't use [let {arr; length} = a] as + usual, the length is not needed in the fast path.)*) + () else begin - actually_grow_with_ v ~filler:x; - unsafe_add_last v x + if requested_length < 0 then + Error.negative_capacity "ensure_capacity" requested_length; + if requested_length > Sys.max_array_length then + Error.requested_length_out_of_bounds "ensure_capacity" requested_length; + let new_capacity = ref cur_capacity in + while !new_capacity < requested_length do + new_capacity := next_capacity !new_capacity + done; + let new_capacity = !new_capacity in + assert (new_capacity >= requested_length); + let new_arr = Array.make new_capacity Empty in + Array.blit arr 0 new_arr 0 a.length; + a.arr <- new_arr; + assert (0 <= requested_length); + assert (requested_length <= Array.length new_arr); end -let append a b = - if array_is_empty_ a then ( - if array_is_empty_ b then () else ( - a.arr <- Array.copy b.arr; - a.size <- b.size - ) - ) else ( - ensure_assuming_not_empty_ a ~size:(a.size + b.size); - assert (Array.length a.arr >= a.size + b.size); - Array.blit b.arr 0 a.arr a.size b.size; - a.size <- a.size + b.size - ) - -let[@inline] get v i = - if i < 0 || i >= v.size then invalid_arg "Dynarray.get"; - Array.get v.arr i - -let[@inline] set v i x = - if i < 0 || i >= v.size then invalid_arg "Dynarray.set"; - Array.set v.arr i x +let fit_capacity a = + if Array.length a.arr = a.length + then () + else a.arr <- Array.sub a.arr 0 a.length + +let reset a = + clear a; + fit_capacity a + + +(** {1:adding Adding elements} *) + +(* We chose an implementation of [add_last a x] that behaves correctly + in presence of aynchronous code execution around allocations and + poll points: if another thread or a callback gets executed on + allocation, we add the element at the new end of the dynamic array. + + (We do not give the same guarantees in presence of concurrent + updates, which are much more expansive to protect against.) +*) + +(* [add_last_if_room a elem] only writes the slot if there is room, and + returns [false] otherwise. + + It is sequentially atomic -- in absence of unsychronized concurrent + uses, the fields of [a.arr] and [a.length] will not be mutated + by any other code during execution of this function. +*) +let[@inline] add_last_if_room a elem = + (* BEGIN ATOMIC *) + let {arr; length} = a in + (* we know [0 <= length] *) + if length >= Array.length arr then false + else begin + (* we know [0 <= length < Array.length arr] *) + Array.unsafe_set arr length elem; + a.length <- length + 1; + true + end + (* END ATOMIC *) + +let add_last a x = + let elem = Elem {v = x} in + if add_last_if_room a elem then () + else begin + (* slow path *) + let rec grow_and_add a elem = + ensure_capacity a (length a + 1); + if not (add_last_if_room a elem) + then grow_and_add a elem + in grow_and_add a elem + end let append_iter a iter b = iter (fun x -> add_last a x) b -let append_seq a seq = append_iter a Seq.iter seq +let append_list a li = + append_iter a List.iter li + +let append_seq a seq = + append_iter a Seq.iter seq + +(* append_array: same [..._if_room] and loop logic as [add_last]. *) + +let append_array_if_room a b = + (* BEGIN ATOMIC *) + let {arr; length = length_a} = a in + let length_b = Array.length b in + if length_a + length_b > Array.length arr then false + else begin + a.length <- length_a + length_b; + (* END ATOMIC *) + (* Note: we intentionally update the length *before* filling the + elements. This "reserve before fill" approach provides better + behavior than "fill then notify" in presence of reentrant + modifications (which may occur below, on a poll point in the loop or + the [Elem] allocation): + + - If some code asynchronously adds new elements after this + length update, they will go after the space we just reserved, + and in particular no addition will be lost. If instead we + updated the length after the loop, any asynchronous addition + during the loop could be erased or erase one of our additions, + silently, without warning the user. + + - If some code asynchronously iterates on the dynarray, or + removes elements, or otherwise tries to access the + reserved-but-not-yet-filled space, it will get a clean "missing + element" error. This is worse than with the fill-then-notify + approach where the new elements would only become visible + (to iterators, for removal, etc.) alltogether at the end of + loop. + + To summarise, "reserve before fill" is better on add-add races, + and "fill then notify" is better on add-remove or add-iterate + races. But the key difference is the failure mode: + reserve-before fails on add-remove or add-iterate races with + a clean error, while notify-after fails on add-add races with + silently disappearing data. *) + for i = 0 to length_b - 1 do + let x = Array.unsafe_get b i in + Array.unsafe_set arr (length_a + i) (Elem {v = x}) + done; + true + end let append_array a b = - let len_b = Array.length b in - if array_is_empty_ a then ( - a.arr <- Array.copy b; - a.size <- len_b; - ) else ( - ensure_assuming_not_empty_ a ~size:(a.size + len_b); - Array.blit b 0 a.arr a.size len_b; - a.size <- a.size + len_b - ) - -let append_list a b = match b with - | [] -> () - | x :: _ -> - (* use [x] as the filler, in case the array is empty. - We ensure capacity once, then we can skip the resizing checks - and use {!unsafe_add_last}. *) - let len_a = a.size in - let len_b = List.length b in - ensure_capacity ~filler:x a (len_a + len_b); - List.iter (unsafe_add_last a) b - -let pop_last v = - if v.size = 0 then raise Not_found; - let new_size = v.size - 1 in - v.size <- new_size; - let x = v.arr.(new_size) in - if new_size = 0 then ( - v.arr <- [||]; (* free elements *) - ) else ( - (* remove pointer to (removed) last element *) - let filler = Array.get v.arr 0 in - fill_ v.arr new_size ~filler; - ); - x - -let pop_last_opt v = - try Some (pop_last v) - with Not_found -> None - -let remove_last v = - try ignore (pop_last v) - with Not_found -> () - -let[@inline] copy v = { - size = v.size; - arr = Array.sub v.arr 0 v.size; -} + if append_array_if_room a b then () + else begin + (* slow path *) + let rec grow_and_append a b = + ensure_capacity a (length a + Array.length b); + if not (append_array_if_room a b) + then grow_and_append a b + in grow_and_append a b + end + +(* append: same [..._if_room] and loop logic as [add_last], + same reserve-before-fill logic as [append_array]. *) + +(* Note: unlike [add_last_if_room], [append_if_room] is *not* atomic. *) +let append_if_room a b = + (* BEGIN ATOMIC *) + let {arr = arr_a; length = length_a} = a in + let {arr = arr_b; length = length_b} = b in + if length_a + length_b > Array.length arr_a then false + else begin + a.length <- length_a + length_b; + (* END ATOMIC *) + check_valid_length length_b arr_b; + for i = 0 to length_b - 1 do + let x = unsafe_get arr_b ~i ~length:length_b in + Array.unsafe_set arr_a (length_a + i) (Elem {v = x}) + done; + true + end + +let append a b = + if append_if_room a b then () + else begin + (* slow path *) + let rec grow_and_append a b = + ensure_capacity a (length a + length b); + if not (append_if_room a b) + then grow_and_append a b + in grow_and_append a b + end -let truncate v n = - let old_size = v.size in - if n = 0 then ( - v.size <- n; - (* free all elements *) - v.arr <- [||]; - ) else if n < old_size then ( - (* free elements by erasing them with the first element *) - v.size <- n; - let filler = Array.get v.arr 0 in - fill_with_junk_ v.arr n (old_size-n) ~filler; - ) - -let fit_capacity v : unit = - if v.size = 0 then ( - v.arr <- [| |] - ) else if v.size < Array.length v.arr then ( - v.arr <- Array.sub v.arr 0 v.size - ) - -let iter k v = - let n = v.size in - for i = 0 to n-1 do - k (Array.get v.arr i) + + +(** {1:iteration Iteration} *) + +(* The implementation choice that we made for iterators is the one + that maximizes efficiency by avoiding repeated bound checking: we + check the length of the dynamic array once at the beginning, and + then only operate on that portion of the dynarray, ignoring + elements added in the meantime. + + The specification says that it is unspecified which updates to the + dynarray happening during iteration will be observed by the + iterator. With our current implementation, they in fact have + a clear characterization, we: + - ignore all elements added during the iteration + - fail with a clean error if a removal occurs during iteration + - observe all [set] updates on the initial elements that have not + been visited yet. + + This is slightly stronger/simpler than typical unboxed + implementation, where "observing [set] updates" stops after the + first reallocation of the backing array. It is a coincidence that + our implementation shares the mutable Elem references between the + initial and the reallocated backing array, and thus also observes + update happening after reallocation. +*) + +let iter k a = + let {arr; length} = a in + check_valid_length length arr; + for i = 0 to length - 1 do + k (unsafe_get arr ~i ~length) done -let iteri k v = - let n = v.size in - for i = 0 to n-1 do - k i (Array.get v.arr i) +let iteri k a = + let {arr; length} = a in + check_valid_length length arr; + for i = 0 to length - 1 do + k i (unsafe_get arr ~i ~length) done -let map f v = - if array_is_empty_ v - then create () - else ( - let arr = Array.init v.size (fun i -> f (Array.get v.arr i)) in - { size=v.size; arr; } - ) - -let mapi f v = - if array_is_empty_ v - then create () - else ( - let arr = Array.init v.size (fun i -> f i (Array.get v.arr i)) in - { size=v.size; arr; } - ) - -let fold_left f acc v = - let rec fold acc i = - if i = v.size then acc +let map f a = + let {arr; length} = a in + check_valid_length length arr; + { + length; + arr = Array.init length (fun i -> + Elem {v = f (unsafe_get arr ~i ~length)}); + } + +let mapi f a = + let {arr; length} = a in + check_valid_length length arr; + { + length; + arr = Array.init length (fun i -> + Elem {v = f i (unsafe_get arr ~i ~length)}); + } + +let fold_left f acc a = + let {arr; length} = a in + check_valid_length length arr; + let rec fold acc arr i length = + if i = length then acc + else + let v = unsafe_get arr ~i ~length in + fold (f acc v) arr (i+1) length + in fold acc arr 0 length + +let exists p a = + let {arr; length} = a in + check_valid_length length arr; + let rec loop p arr i length = + if i = length then false else - let x = Array.get v.arr i in - fold (f acc x) (i+1) - in fold acc 0 + p (unsafe_get arr ~i ~length) + || loop p arr (i + 1) length + in loop p arr 0 length + +let for_all p a = + let {arr; length} = a in + check_valid_length length arr; + let rec loop p arr i length = + if i = length then true + else + p (unsafe_get arr ~i ~length) + && loop p arr (i + 1) length + in loop p arr 0 length let filter f a = - let b = create() in + let b = create () in iter (fun x -> if f x then add_last b x) a; b let filter_map f a = let b = create() in iter (fun x -> - match f x with - | None -> () - | Some y -> add_last b y) - a; + match f x with + | None -> () + | Some y -> add_last b y + ) a; b -let exists p v = - let n = v.size in - let rec check i = - if i = n then false - else p v.arr.(i) || check (i+1) - in check 0 -let for_all p v = - let n = v.size in - let rec check i = - if i = n then true - else p v.arr.(i) && check (i+1) - in check 0 +(** {1:conversions Conversions to other data structures} *) -let length v = v.size +(* The eager [to_*] conversion functions behave similarly to iterators + in presence of updates during computation. The [to_seq*] functions + obey their more permissive specification, which tolerates any + concurrent update. *) + +let of_array a = + let length = Array.length a in + { + length; + arr = Array.init length (fun i -> Elem {v = Array.unsafe_get a i}); + } + +let to_array a = + let {arr; length} = a in + check_valid_length length arr; + Array.init length (fun i -> unsafe_get arr ~i ~length) + +let of_list li = + let a = create () in + List.iter (fun x -> add_last a x) li; + a + +let to_list a = + let {arr; length} = a in + check_valid_length length arr; + let l = ref [] in + for i = length - 1 downto 0 do + l := unsafe_get arr ~i ~length :: !l + done; + !l let of_seq seq = let init = create() in append_seq init seq; init -let to_seq v = +let to_seq a = let rec aux i () = - if i >= length v then Seq.Nil - else Seq.Cons (v.arr.(i), aux (i+1)) + if i >= length a then Seq.Nil + else begin + Seq.Cons (get a i, aux (i + 1)) + end in aux 0 -let to_seq_rev v = +let to_seq_rev a = let rec aux i () = - if i < 0 || i > length v then Seq.Nil - else Seq.Cons (v.arr.(i), aux (i-1)) + if i < 0 then Seq.Nil + else if i >= length a then + (* If some elements have been removed in the meantime, we skip + those elements and continue with the new end of the array. *) + aux (length a - 1) () + else Seq.Cons (get a i, aux (i - 1)) in - aux (length v-1) - -let of_array a = - if Array.length a = 0 - then create () - else { - size=Array.length a; - arr=Array.copy a; - } - -let of_list l = match l with - | [] -> create() - | [x] -> make 1 x - | [x;y] -> {size=2; arr=[| x; y |]} - | x::_ -> - let v = create() in - ensure_capacity v (List.length l) ~filler:x; - List.iter (unsafe_add_last v) l; - v - -let to_array v = - Array.sub v.arr 0 v.size - -let to_list v = - let l = ref [] in - for i=length v-1 downto 0 do - l := get v i :: !l - done; - !l + aux (length a - 1) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 53cf2478a54..c94cab9f94b 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -3,7 +3,9 @@ (* OCaml *) (* *) (* Simon Cruanes *) +(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *) (* *) +(* Copyright 2022 Simon Cruanes. *) (* Copyright 2022 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) @@ -13,19 +15,55 @@ (* *) (**************************************************************************) -(** Growable, mutable array. +(** Dynamic arrays. + + The {!Array} module provide arrays of fixed length. In contrast, + the length of a dynamic array can change over time, we can add + more elements or remove elements at the end of the array. + + This is typically used to accumulate elements whose number is not + known in advance or changes during computation, while also + providing fast access to elements at arbitrary positions. + +{[ + let dynarray_of_list li = + let arr = Dynarray.create () in + List.iter (fun v -> Dynarray.add_last arr v) li; + arr +]} + + The {!Buffer} module provides similar features, but it is + specialized for accumulating characters into a dynamically-growing + string. + + The {!Stack} module provides a last-in first-out data structure + that can be easily implemented on top of dynamic arrays. @since 5.1 *) +(** {b Unsynchronized accesses} *) + +[@@@alert unsynchronized_accesses + "Unsynchronized accesses to dynamic arrays are a programming error." +] + +(** + Unsynchronized accesses to a dynamic array may lead to an invalid + dynamic array state. Thus, concurrent accesses to dynamic arrays + must be synchronized (for instance with a {!Mutex.t}). +*) + +(** {1:dynarrays Dynamic arrays} *) + type 'a t (** A dynamic array containing values of type ['a]. - This contains an underlying array along with a size. - Operations such as {!add_last}, {!append}, and {!append_seq}, extend the - size (and might reallocate the underlying array). - - Operations such as {!pop_last}, and {!truncate}, reduce the size. *) + A dynamic array [a] is an array, that is, it provides + constant-time [get] and [set] operation on indices between [0] and + [Dynarray.length a - 1] included. Its {b length} may change over + time by adding or removing elements to the end of the array. +*) val create : unit -> 'a t (** [create ()] is a new, empty array. *) @@ -34,77 +72,88 @@ val make : int -> 'a -> 'a t (** [make n x] makes a array of length [n], filled with [x]. *) val init : int -> (int -> 'a) -> 'a t -(** [init n f] is a new array of length [n], - such that [get (init n f) i] is [f i]. +(** [init n f] is a new array [a] of length [n], + such that [get a i] is [f i]. In other words, + [a] is the the array whose elements are + [f 0; f 1; f 2; ...; f (n - 1)]. - This is the equivalent of {!Array.init}. *) + This is similar to {!Array.init}. *) -val clear : 'a t -> unit -(** [clear a] clears the content of [a], and sets its length to 0. - This ensures that [length v = 0] but the underlying array is kept, - and possibly references to former elements, which are therefore - not garbage collectible. +val get : 'a t -> int -> 'a +(** [get a i] is the [i]-th element of [a], starting with index [0]. - Similar to {!Buffer.clear}. -*) + @raise Invalid_argument if the index is + invalid (not in [0 .. length a-1]). *) -val reset : 'a t -> unit -(** [clear a] clears the content of [a], and sets its length to 0, - and reset the underlying array to be empty, allowing the previous - underlying array to be collected. +val set : 'a t -> int -> 'a -> unit +(** [set a i x] sets the [i]-th element of [a] to be [x]. - Similar to {!Buffer.reset}. -*) + Just like {!get}, [i] must be between [0] and [length a - 1] + included. [set] does not add new elements to the array -- see + {!add_last} to add an element. + @raise Invalid_argument if the index is invalid. *) -val ensure_capacity : 'a t -> filler:'a -> int -> unit -(** [ensure_capacity a ~filler n] makes sure that [a] - has at least a capacity for storing [n] elements. +val length : _ t -> int +(** [length a] is the number of elements in the array. + The last element of [a], if not empty, is [get a (length a - 1)]. + This operation is constant time. *) - This is a more advanced operation that is only useful for performance - purposes. +val is_empty : 'a t -> bool +(** [is_empty a] is [true] if [a] is empty, that is, if [length a = 0]. *) - @param filler an element used if the underlying array is empty, - to initialize it. It will be retained until the array is totally - empty or until it is garbage collected. - @raise Invalid_arg if the size is not suitable (negative, or too big for - OCaml arrays) -*) +val copy : 'a t -> 'a t +(** [copy a] is a shallow copy of [a], that can be modified independently. *) -val is_empty : 'a t -> bool -(** [is_empty a] is [true] if [a] is empty, that is, if [length a = 0]. - Note that an empty dynarray might still have non-0 underlying capacity - and therefore non-0 memory footprint. *) +(** {1:adding Adding elements} -val add_last : 'a t -> 'a -> unit -(** [add_last a x] adds the element [x] at the end of the array [a]. + Note: all operations adding elements can raise [Failure] if the + length would need to grow beyond {!Sys.max_array_length}. - This might grow the underlying storage of [a] if it is full. + It is a programming error to mutate the dynamic array during the + execution of one of the [append*] functions, and the result is + unspecified in this case, in particular the array may end up in an + invalid state and the [append*] functions may raise + [Invalid_argument] in this situation. +*) - Calling [add_last a] n times is amortized O(n) complexity, - and O(ln(n)) reallocations of the underlying array. *) +val add_last : 'a t -> 'a -> unit +(** [add_last a x] adds the element [x] at the end of the array [a]. + The length of [a] increases by [1]. *) -val append : 'a t -> 'a t -> unit -(** [append a b] adds all elements of [b] at the end of [a], - in the order they appear in [b]. [b] is not modified. +val append_array : 'a t -> 'a array -> unit +(** [append_array a b] adds all elements of [b] at the end of [a], + in the order they appear in [b]. For example, [a] will contain [1,2,3,4,5,6] after this code runs: {[ let a = of_list [1;2;3];; - let b = of_list [4;5;6];; - let () = append a b;; + let () = append a [|4; 5; 6|];; ]} - *) +*) -val append_array : 'a t -> 'a array -> unit -(** Like {!append}, with an array. *) +val append_list : 'a t -> 'a list -> unit +(** Like {!append_array} but with a list. *) + +val append : 'a t -> 'a t -> unit +(** [append a b] is like [append_array a b], + but [b] is itself a dynamic arreay instead of a fixed-size array. + + Beware! Calling [append a a] iterates on [a] and adds elements to + it at the same time; it is a programming error and its behavior is + unspecified. In particular, if elements coming from + [a]-on-the-right become visible in [a]-on-the-left during the + iteration on [a], they may added again and again, resulting in an + infinite loop. +*) val append_seq : 'a t -> 'a Seq.t -> unit -(** Like {!append} but with an iterator. *) +(** Like {!append_array} but with a sequence. -val append_list : 'a t -> 'a list -> unit -(** Like {!append} but with a list. *) + Beware! Calling [append_seq a (to_seq a)] is unspecified and may + result in an infinite loop, see the {!append} comment above. +*) val append_iter : 'a t -> @@ -117,21 +166,30 @@ val append_iter : [1], [2], and [3] at the end of [a]. [append_iter a Queue.iter q] adds elements from the queue [q]. *) + +(** {1:removing Removing elements} *) + val pop_last_opt : 'a t -> 'a option (** [pop_last_opt a] removes and returns the last element of [a], or [None] if the array is empty. *) val pop_last : 'a t -> 'a -(** [pop_last a] removes and returns the last element of [a], assuming - [a] is not empty. +(** [pop_last a] removes and returns the last element of [a]. + @raise Not_found on an empty array. *) val remove_last : 'a t -> unit -(** [remove_last a] removes the last element of [a], or does nothing - if [is_empty a]. *) +(** [remove_last a] removes the last element of [a] , or does nothing + if [is_empty a]. +*) -val copy : 'a t -> 'a t -(** [copy a] is a shallow copy of [a], that can be modified independently. *) +val clear : 'a t -> unit +(** [clear a] removes all the elements of [a]. + + It is equivalent to [truncate a 0]. + + Similar to {!Buffer.clear}. +*) val truncate : 'a t -> int -> unit (** [truncate a n] truncates [a] to have at most [n] elements. @@ -139,49 +197,44 @@ val truncate : 'a t -> int -> unit It removes elements whose index is great or equal than [n]. It does nothing if [n >= length a]. - It is similar to: + It is equivalent to: {[ while length a > n do remove_last a done - ]} *) + ]} + + Similar to {!Buffer.truncate}. +*) -val fit_capacity : 'a t -> unit -(** [fit_capacity a] shrinks the internal array to fit [length a] exactly, - with no additional empty space at the end. This can be useful - to make sure there is no memory wasted on a long-lived array. - This does nothing if [a] is already full. *) + +(** {1:iteration Iteration} + + The iteration functions traverse the elements of a dynamic array. + + It is a programming error to mutate the dynamic array during the + traversal, and the result is unspecified in this case. In + particular, each mutation may or may not be observed by the + iteration function, the array may end up in an invalid state and + iterators may raise [Invalid_argument] in this situation. +*) val iter : ('a -> unit) -> 'a t -> unit (** [iter f a] calls [f] on each element of [a], in increasing index order. *) val iteri : (int -> 'a -> unit) -> 'a t -> unit -(** [iteri f a] calls [f i x] for each [x] at index [i] in [a].. *) +(** [iteri f a] calls [f i x] for each [x] at index [i] in [a]. *) val map : ('a -> 'b) -> 'a t -> 'b t (** [map f a] is a new array of length [length a], with elements mapped - from [a] using [f]. - - It is similar to [to_array a |> Array.map f |> of_array]. *) + from [a] using [f]. *) val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t (** [mapi f v] is just like {!map}, but it also passes in the index of each element as the first argument to the function [f]. *) -val filter : ('a -> bool) -> 'a t -> 'a t -(** [filter f a] is an array containing all elements of [a] that satisfy [f] *) - -val filter_map : ('a -> 'b option) -> 'a t -> 'b t -(** [filter_map f a] is a new array [b], such that for each item [x] in [a]: - - if [f x = Some y], then [y] is in [b] - - if [f x = None], then no element is added to [b]. - - It is similar to {!List.filter_map}. *) - -val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b -(** [fold_left f acc a] folds [f] over [a] starting with accumulator [acc]. - - It is similar to [Array.fold_left f acc (to_array a)]. *) +val fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc +(** [fold_left f acc a] folds [f] over [a] starting with accumulator [acc]. *) val exists : ('a -> bool) -> 'a t -> bool (** [exists f a] returns [true] if some element of [a] satisfies [f]. *) @@ -190,46 +243,154 @@ val for_all : ('a -> bool) -> 'a t -> bool (** [for_all f a] returns [true] if all elements of [a] satisfie [f]. This includes the case where [a] is empty. *) -val get : 'a t -> int -> 'a -(** [get a i] is the [i]-th element of [a], starting with index [0]. - @raise Invalid_argument if the index is - invalid (i.e. not in [[0.. length a-1]]). *) +val filter : ('a -> bool) -> 'a t -> 'a t +(** [filter f a] is an array containing all elements of [a] that satisfy [f] *) -val set : 'a t -> int -> 'a -> unit -(** [set a i x] sets the [i]-th element of [a] to be [x]. - Just like {!get}, indexing starts at 0. - @raise Invalid_argument if the index is invalid. *) +val filter_map : ('a -> 'b option) -> 'a t -> 'b t +(** [filter_map f a] is a new array [b], such that for each item [x] in [a]: + - if [f x = Some y], then [y] is in [b] + - if [f x = None], then no element is added to [b]. *) -val length : _ t -> int -(** [length a] is the number of elements in the array. - The last element of [a], if not empty, is [get a (length a - 1)]. - This operation is constant time. *) + +(** {1:conversions Conversions to other data structures} + + Note: the [of_*] functions can raise [Failure] if the length would + need to grow beyond {!Sys.max_array_length}. + + The [to_*] functions iterate on their dynarray argument. In + particular, except for [to_seq], it is a programming error + if the dynarray is mutated during their execution -- see the + (un)specification in the {!section:Iteration} section. +*) val of_array : 'a array -> 'a t -(** [of_array a] returns a array corresponding to the array [a]. - Operates in [O(n)] time by making a copy. *) +(** [of_array arr] returns a dynamic array corresponding to the + fixed-sized array [a]. Operates in [O(n)] time by making a copy. *) + +val to_array : 'a t -> 'a array +(** [to_array a] returns a fixed-sized array corresponding to the + dynamic array [a]. This always allocate a new array and copies + item into it. *) val of_list : 'a list -> 'a t (** [of_list l] is the array containing the elements of [l] in the same order. *) -val to_array : 'a t -> 'a array -(** [to_array a] returns an array corresponding to the dynamic array [a]. - This always allocate a new array and copies item into it. *) - val to_list : 'a t -> 'a list (** [to_list a] is a list with the elements contained in the array [a]. *) val of_seq : 'a Seq.t -> 'a t (** [of_seq seq] is an array containing the same elements as [seq]. - It traverses [seq] only once and will terminate only if [seq] is finite. *) + It traverses [seq] once and will terminate only if [seq] is finite. *) val to_seq : 'a t -> 'a Seq.t -(** [of_seq a] is the sequence of items [get a 0], [get a 1], etc. - This sequence can be safely reused multiple times as long as [a] - is not changed in the mean time. *) +(** [to_seq a] is the sequence of items + [get a 0], [get a 1]... [get a (length a - 1)]. + + Because sequences are computed on-demand, we have to assume that + the array may be modified in the meantime, and give a precise + specification for this case below. + + Demanding the [i]-th element of the resulting sequence (which can + happen zero, one or several times) will access the [i]-th element + of [a] at the time of the demand. The sequence stops if [a] has + less than [i] elements at this point. +*) val to_seq_rev : 'a t -> 'a Seq.t -(** [to_seq_rev a] is like [to_seq (rev a)]. - It yields the last element of [a] first. *) +(** [to_seq_rev a] is the sequence of items + [get a (l - 1)], [get a (l - 2)]... [get a 0], + where [l] is [length a] at the time [to_seq_rev] is invoked. + + Elements that have been removed from the array by the time they + are demanded in the sequence are skipped. +*) + + +(** {1:capacity Backing array and capacity} + + Internally, a dynamic array uses a {b backing array} (a fixed-size + array as provided by the {!Array} module) whose length is greater + or equal to the length of the dynamic array. We call {b capacity} + the length of the backing array. + + The capacity of a dynamic array is relevant in advanced scenarios, + when reasoning about the performance of dynamic array programs: + {ul + {- The memory usage of a dynamic array is proportional to its capacity, + rather than its length.} + {- Adding elements to the end of a dynamic array may require + allocating a new, larger backing array when its length + is already equal to its capacity, so there is no room + for more elements in the current backing array.}} + + The implementation uses a standard exponential reallocation + strategy which guarantees amortized constant-time operation: the + total capacity of all backing arrays allocated over the lifetime + of a dynamic array is proportional to the total number of elements + added or removed. + In other words, users need not care about capacity and reallocations, + and they will get reasonable behavior by default. However, in some + performance-sensitive scenarios the functions below can help control + memory usage or guarantee an optimal number of reallocations. +*) + +val ensure_capacity : 'a t -> int -> unit +(** [ensure_capacity a n] makes sure that [a] has capacity has least [n]. + + @raise Invalid_argument if the requested capacity is negative. + (We consider that this is a programming error.) + + @raise Failure if the requested capacity is above + {!Sys.max_array_length}. + (We consider that this is a valid failure mode in some exceptional + scenarios. In particular, all functions adding elements to a dynamic + array may propagate this exception.) + + An example use-case would be to implement [append_array]: +{[ + let append_array a arr = + ensure_capacity a (length a + Array.length arr); + Array.iter (fun v -> add_last a v) arr +]} + + Using [ensure_capacity] guarantees that at most one reallocation + will take place, instead of possibly several. + + Without this [ensure_capacity] hint, the number of resizes would + be logarithmic in the length of [arr], creating a constant-factor + slowdown noticeable when [a] is small and [arr] is large. +*) + +val fit_capacity : 'a t -> unit +(** [fit_capacity a] shrinks the backing array so that its capacity is + exactly [length a], with no additional empty space at the + end. This can be useful to make sure there is no memory wasted on + a long-lived array. + + Note that calling [fit_capacity] breaks the amortized complexity + guarantees provided by the default reallocation strategy, and may + result in more reallocations in the future. + + If you know that a dynamic array has reached its final length, + which will remain fixed in the future, it is sufficient to call + [to_array] and only keep the resulting fixed-size + array. [fit_capacity] is useful when you need to keep a dynamic + array for eventual future resizes. +*) + +val reset : 'a t -> unit +(** [reset a] clears [a] and replaces its backing array by an empty array. + + It is equivalent to [clear a; fit_capacity a]. + + Similar to {!Buffer.reset}. *) + +(** {b No leaks: preservation of memory liveness} + + The user-provided values reachable from a dynamic array [a] are + exactly the elements in the positions [0] to [length a - 1]. In + particular, no user-provided values are "leaked" by being present + in the backing array in position [length a] or later. +*) From ba9876180169f5d7ffe45f1ab82f2eda65e9497e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 9 Jan 2023 22:09:41 +0100 Subject: [PATCH 249/402] Dynarray: a reentrant (boxed) implementation --- stdlib/dynarray.ml | 292 +++++++++++---------------- stdlib/dynarray.mli | 31 ++- testsuite/tests/lib-dynarray/test.ml | 16 +- 3 files changed, 145 insertions(+), 194 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index af023126996..ba2952552fd 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -340,7 +340,7 @@ let reset a = (** {1:adding Adding elements} *) -(* We chose an implementation of [add_last a x] that behaves correctly +(* We want an implementation of [add_last a x] that behaves correctly in presence of aynchronous code execution around allocations and poll points: if another thread or a callback gets executed on allocation, we add the element at the new end of the dynamic array. @@ -381,189 +381,103 @@ let add_last a x = in grow_and_add a elem end -let append_iter a iter b = - iter (fun x -> add_last a x) b - -let append_list a li = - append_iter a List.iter li - -let append_seq a seq = - append_iter a Seq.iter seq - -(* append_array: same [..._if_room] and loop logic as [add_last]. *) - -let append_array_if_room a b = - (* BEGIN ATOMIC *) - let {arr; length = length_a} = a in - let length_b = Array.length b in - if length_a + length_b > Array.length arr then false - else begin - a.length <- length_a + length_b; - (* END ATOMIC *) - (* Note: we intentionally update the length *before* filling the - elements. This "reserve before fill" approach provides better - behavior than "fill then notify" in presence of reentrant - modifications (which may occur below, on a poll point in the loop or - the [Elem] allocation): - - - If some code asynchronously adds new elements after this - length update, they will go after the space we just reserved, - and in particular no addition will be lost. If instead we - updated the length after the loop, any asynchronous addition - during the loop could be erased or erase one of our additions, - silently, without warning the user. - - - If some code asynchronously iterates on the dynarray, or - removes elements, or otherwise tries to access the - reserved-but-not-yet-filled space, it will get a clean "missing - element" error. This is worse than with the fill-then-notify - approach where the new elements would only become visible - (to iterators, for removal, etc.) alltogether at the end of - loop. - - To summarise, "reserve before fill" is better on add-add races, - and "fill then notify" is better on add-remove or add-iterate - races. But the key difference is the failure mode: - reserve-before fails on add-remove or add-iterate races with - a clean error, while notify-after fails on add-add races with - silently disappearing data. *) - for i = 0 to length_b - 1 do - let x = Array.unsafe_get b i in - Array.unsafe_set arr (length_a + i) (Elem {v = x}) - done; - true - end +let rec append_list a li = + match li with + | [] -> () + | x :: xs -> add_last a x; append_list a xs let append_array a b = - if append_array_if_room a b then () - else begin - (* slow path *) - let rec grow_and_append a b = - ensure_capacity a (length a + Array.length b); - if not (append_array_if_room a b) - then grow_and_append a b - in grow_and_append a b - end - -(* append: same [..._if_room] and loop logic as [add_last], - same reserve-before-fill logic as [append_array]. *) - -(* Note: unlike [add_last_if_room], [append_if_room] is *not* atomic. *) -let append_if_room a b = - (* BEGIN ATOMIC *) - let {arr = arr_a; length = length_a} = a in - let {arr = arr_b; length = length_b} = b in - if length_a + length_b > Array.length arr_a then false - else begin - a.length <- length_a + length_b; - (* END ATOMIC *) - check_valid_length length_b arr_b; - for i = 0 to length_b - 1 do - let x = unsafe_get arr_b ~i ~length:length_b in - Array.unsafe_set arr_a (length_a + i) (Elem {v = x}) - done; - true - end + let len_b = Array.length b in + ensure_capacity a (length a + len_b); + for i = 0 to len_b - 1 do + add_last a (Array.unsafe_get b i) + done -let append a b = - if append_if_room a b then () - else begin - (* slow path *) - let rec grow_and_append a b = - ensure_capacity a (length a + length b); - if not (append_if_room a b) - then grow_and_append a b - in grow_and_append a b - end +let append_iter a iter b = + iter (fun x -> add_last a x) b +let append_seq a seq = + Seq.iter (add_last a) seq +(* [append] is below, after [iter] *) (** {1:iteration Iteration} *) -(* The implementation choice that we made for iterators is the one - that maximizes efficiency by avoiding repeated bound checking: we - check the length of the dynamic array once at the beginning, and - then only operate on that portion of the dynarray, ignoring - elements added in the meantime. - - The specification says that it is unspecified which updates to the +(* The specification says that it is unspecified which updates to the dynarray happening during iteration will be observed by the - iterator. With our current implementation, they in fact have - a clear characterization, we: - - ignore all elements added during the iteration - - fail with a clean error if a removal occurs during iteration - - observe all [set] updates on the initial elements that have not - been visited yet. - - This is slightly stronger/simpler than typical unboxed - implementation, where "observing [set] updates" stops after the - first reallocation of the backing array. It is a coincidence that - our implementation shares the mutable Elem references between the - initial and the reallocated backing array, and thus also observes - update happening after reallocation. + iterator. Our implmentation is in fact designed to give the best + possible guarantees: we observe all updates (insertion, removal, + modification) to parts of the array that we have not traversed yet. *) -let iter k a = - let {arr; length} = a in - check_valid_length length arr; - for i = 0 to length - 1 do - k (unsafe_get arr ~i ~length) +let iter f a = + let i = ref 0 in + while !i < length a do + f (get a !i); + incr i done -let iteri k a = - let {arr; length} = a in - check_valid_length length arr; - for i = 0 to length - 1 do - k i (unsafe_get arr ~i ~length) +let append a b = + ensure_capacity a (length a + length b); + append_iter a iter b + +let iteri f a = + let i = ref 0 in + while !i < length a do + f !i (get a !i); + incr i done let map f a = - let {arr; length} = a in - check_valid_length length arr; - { - length; - arr = Array.init length (fun i -> - Elem {v = f (unsafe_get arr ~i ~length)}); - } + let i = ref 0 in + let b = create () in + ensure_capacity b (length a); + (* Calls to [f] may add further elements to the array [a]; those + will get added in the final result as well. This means that the + capacity hint above is sometimes not sufficient to guarantee the + absence of further reallocations, but this is innocuous. *) + while !i < length a do + add_last b (f (get a !i)); + incr i + done; + b let mapi f a = - let {arr; length} = a in - check_valid_length length arr; - { - length; - arr = Array.init length (fun i -> - Elem {v = f i (unsafe_get arr ~i ~length)}); - } + let i = ref 0 in + let b = create () in + ensure_capacity b (length a); + while !i < length a do + add_last b (f !i (get a !i)); + incr i + done; + b let fold_left f acc a = - let {arr; length} = a in - check_valid_length length arr; - let rec fold acc arr i length = - if i = length then acc - else - let v = unsafe_get arr ~i ~length in - fold (f acc v) arr (i+1) length - in fold acc arr 0 length + let i = ref 0 in + let acc = ref acc in + while !i < length a do + acc := f !acc (get a !i); + incr i + done; + !acc let exists p a = - let {arr; length} = a in - check_valid_length length arr; - let rec loop p arr i length = - if i = length then false - else - p (unsafe_get arr ~i ~length) - || loop p arr (i + 1) length - in loop p arr 0 length + let i = ref 0 in + let stop = ref false in + while not !stop && !i < length a do + if p (get a !i) then stop := true; + incr i; + done; + !stop let for_all p a = - let {arr; length} = a in - check_valid_length length arr; - let rec loop p arr i length = - if i = length then true - else - p (unsafe_get arr ~i ~length) - && loop p arr (i + 1) length - in loop p arr 0 length + let i = ref 0 in + let continue = ref true in + while !continue && !i < length a do + if not (p (get a !i)) then continue := false; + incr i; + done; + !continue let filter f a = let b = create () in @@ -587,6 +501,19 @@ let filter_map f a = obey their more permissive specification, which tolerates any concurrent update. *) +let of_list li = + let a = create () in + List.iter (fun x -> add_last a x) li; + a + +let[@tail_mod_cons] rec to_list_from a i = + if i >= length a then [] + else + let x = get a i in + x :: to_list_from a (i + 1) + +let to_list a = to_list_from a 0 + let of_array a = let length = Array.length a in { @@ -595,23 +522,34 @@ let of_array a = } let to_array a = - let {arr; length} = a in - check_valid_length length arr; - Array.init length (fun i -> unsafe_get arr ~i ~length) - -let of_list li = - let a = create () in - List.iter (fun x -> add_last a x) li; - a - -let to_list a = - let {arr; length} = a in - check_valid_length length arr; - let l = ref [] in - for i = length - 1 downto 0 do - l := unsafe_get arr ~i ~length :: !l - done; - !l + let initial_length = length a in + if initial_length = 0 then [| |] + else begin + let x0 = get a 0 in + let dst = Array.make initial_length x0 in + let i = ref 1 in + let arr = a.arr in + check_valid_length initial_length arr; + while !i < initial_length && !i < length a do + Array.unsafe_set dst !i (unsafe_get arr ~i:!i ~length:initial_length); + incr i; + done; + (* At this point we know that either [!i = initial_length] + or we have observed [!i >= length a]. *) + if !i < initial_length then begin + (* In this case we must have observed [!i >= length a]: + we reached the end of [a]. *) + Array.sub dst 0 !i + end else if !i < length a then begin + (* In this case we know [!i = initial_length < length a]: + the array has grown during our iteration. + Aim for simplicity rather than efficiency in this weird corner case. *) + Array.append dst (Array.of_list (to_list_from a !i)) + end else begin + (* we know [!i = initial_length] and have observed [!i >= length a] *) + dst + end + end let of_seq seq = let init = create() in diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index c94cab9f94b..c12e2932f78 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -111,11 +111,11 @@ val copy : 'a t -> 'a t Note: all operations adding elements can raise [Failure] if the length would need to grow beyond {!Sys.max_array_length}. - It is a programming error to mutate the dynamic array during the - execution of one of the [append*] functions, and the result is - unspecified in this case, in particular the array may end up in an - invalid state and the [append*] functions may raise - [Invalid_argument] in this situation. + For the [append*] functions adding several elements to a dynamic + array, it is unspecified at which point during the execution of + the [append*] function the element becomes visible in the dynamic + array -- when [length] is updated. For example, they may become + visible one by one during computation, or all at once at the end. *) val add_last : 'a t -> 'a -> unit @@ -141,11 +141,10 @@ val append : 'a t -> 'a t -> unit but [b] is itself a dynamic arreay instead of a fixed-size array. Beware! Calling [append a a] iterates on [a] and adds elements to - it at the same time; it is a programming error and its behavior is - unspecified. In particular, if elements coming from - [a]-on-the-right become visible in [a]-on-the-left during the - iteration on [a], they may added again and again, resulting in an - infinite loop. + it at the same time; its behavior is unspecified. In particular, + if elements coming from [a]-on-the-right become visible in + [a]-on-the-left during the iteration on [a], they may added again + and again, resulting in an infinite loop. *) val append_seq : 'a t -> 'a Seq.t -> unit @@ -212,11 +211,11 @@ val truncate : 'a t -> int -> unit The iteration functions traverse the elements of a dynamic array. - It is a programming error to mutate the dynamic array during the - traversal, and the result is unspecified in this case. In - particular, each mutation may or may not be observed by the - iteration function, the array may end up in an invalid state and - iterators may raise [Invalid_argument] in this situation. + If the array gets modified (by setting existing elements or adding + or removing elements) during traversal, it is unspecified which of + the modifications will be observed by the traversal. For example, + some modifications may not be observed while later modifications + are observed. *) val iter : ('a -> unit) -> 'a t -> unit @@ -258,7 +257,7 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t need to grow beyond {!Sys.max_array_length}. The [to_*] functions iterate on their dynarray argument. In - particular, except for [to_seq], it is a programming error + particular, except for [to_seq], their behavior is under-specified if the dynarray is mutated during their execution -- see the (un)specification in the {!section:Iteration} section. *) diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index be15ead8f98..4f8c9f75682 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -93,7 +93,21 @@ let () = let () = let a = A.init 3 (fun i->i) in - A.append a a; + A.append a (A.copy a); + (** Note: [A.append a a] is unspecified, and in particular it + loops infinitely with the following natural implementation: +{[ + let append a b = + append_iter a iter b + + let iter f a = + let i = ref 0 in + while !i < length a do + f (get a !i); + incr i + done +]} + *) assert (A.to_list a = [0; 1; 2; 0; 1; 2]);; let() = From 35c9c8ae6ac0356cf6f065b7ba338a0e985bacdb Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 5 Mar 2023 20:53:35 +0100 Subject: [PATCH 250/402] Dynarray: an implementation that purposedly fails on iterator invalidation --- stdlib/dynarray.ml | 350 ++++++++++++++++++++++++++++++-------------- stdlib/dynarray.mli | 37 ++--- 2 files changed, 255 insertions(+), 132 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index ba2952552fd..4dfba46a480 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -157,6 +157,11 @@ module Error = struct "Dynarray: invalid array (length %d > capacity %d)" length capacity + let iterator_invalidation ~expected ~observed = + Printf.ksprintf invalid_arg + "Dynarray: iterator invalidated by a length change from %d to %d" + expected observed + (* When an [Empty] element is observed unexpectedly at index [i], it may be either an out-of-bounds access or an invalid-state situation depending on whether [i <= length]. *) @@ -167,6 +172,16 @@ module Error = struct index_out_of_bounds f ~i ~length end +(* Detecting iterator invalidation. + + See {!iter} below for a detailed usage example. +*) +let check_same_length a ~length = + let length_a = a.length in + if length <> length_a then + Error.iterator_invalidation + ~expected:length ~observed:length_a + (** Careful unsafe access. *) (* Postcondition on non-exceptional return: @@ -340,7 +355,7 @@ let reset a = (** {1:adding Adding elements} *) -(* We want an implementation of [add_last a x] that behaves correctly +(* We chose an implementation of [add_last a x] that behaves correctly in presence of aynchronous code execution around allocations and poll points: if another thread or a callback gets executed on allocation, we add the element at the new end of the dynamic array. @@ -386,98 +401,230 @@ let rec append_list a li = | [] -> () | x :: xs -> add_last a x; append_list a xs -let append_array a b = - let len_b = Array.length b in - ensure_capacity a (length a + len_b); - for i = 0 to len_b - 1 do - add_last a (Array.unsafe_get b i) - done - let append_iter a iter b = iter (fun x -> add_last a x) b let append_seq a seq = Seq.iter (add_last a) seq -(* [append] is below, after [iter] *) +(* append_array: same [..._if_room] and loop logic as [add_last]. *) + +let append_array_if_room a b = + (* BEGIN ATOMIC *) + let {arr; length = length_a} = a in + let length_b = Array.length b in + if length_a + length_b > Array.length arr then false + else begin + a.length <- length_a + length_b; + (* END ATOMIC *) + (* Note: we intentionally update the length *before* filling the + elements. This "reserve before fill" approach provides better + behavior than "fill then notify" in presence of reentrant + modifications (which may occur below, on a poll point in the loop or + the [Elem] allocation): + + - If some code asynchronously adds new elements after this + length update, they will go after the space we just reserved, + and in particular no addition will be lost. If instead we + updated the length after the loop, any asynchronous addition + during the loop could be erased or erase one of our additions, + silently, without warning the user. + + - If some code asynchronously iterates on the dynarray, or + removes elements, or otherwise tries to access the + reserved-but-not-yet-filled space, it will get a clean "missing + element" error. This is worse than with the fill-then-notify + approach where the new elements would only become visible + (to iterators, for removal, etc.) alltogether at the end of + loop. + + To summarise, "reserve before fill" is better on add-add races, + and "fill then notify" is better on add-remove or add-iterate + races. But the key difference is the failure mode: + reserve-before fails on add-remove or add-iterate races with + a clean error, while notify-after fails on add-add races with + silently disappearing data. *) + for i = 0 to length_b - 1 do + let x = Array.unsafe_get b i in + Array.unsafe_set arr (length_a + i) (Elem {v = x}) + done; + true + end + +let append_array a b = + if append_array_if_room a b then () + else begin + (* slow path *) + let rec grow_and_append a b = + ensure_capacity a (length a + Array.length b); + if not (append_array_if_room a b) + then grow_and_append a b + in grow_and_append a b end + +(* append: same [..._if_room] and loop logic as [add_last], + same reserve-before-fill logic as [append_array]. *) + +(* Note: unlike [add_last_if_room], [append_if_room] is *not* atomic. + + It is a programming error to mutate the length of [b] during a call + to [append a b]. To detect this mistake we keep track of the length + of [b] throughout the computation and check it that does not + change. +*) +let append_if_room a b ~length_b = + (* BEGIN ATOMIC *) + let {arr = arr_a; length = length_a} = a in + if length_a + length_b > Array.length arr_a then false + else begin + a.length <- length_a + length_b; + (* END ATOMIC *) + let arr_b = b.arr in + check_valid_length length_b arr_b; + for i = 0 to length_b - 1 do + let x = unsafe_get arr_b ~i ~length:length_b in + Array.unsafe_set arr_a (length_a + i) (Elem {v = x}) + done; + check_same_length b ~length:length_b; + true + end + +let append a b = + let length_b = length b in + if append_if_room a b ~length_b then () + else begin + (* slow path *) + let rec grow_and_append a b ~length_b = + ensure_capacity a (length a + length_b); + (* Eliding the [check_same_length] call below would be wrong in + the case where [a] and [b] are aliases of each other, we + would get into an infinite loop instead of failing. + + We could push the call to [append_if_room] itself, but we + prefer to keep it in the slow path. *) + check_same_length b ~length:length_b; + if not (append_if_room a b ~length_b) + then grow_and_append a b ~length_b + in grow_and_append a b ~length_b + end + + (** {1:iteration Iteration} *) -(* The specification says that it is unspecified which updates to the - dynarray happening during iteration will be observed by the - iterator. Our implmentation is in fact designed to give the best - possible guarantees: we observe all updates (insertion, removal, - modification) to parts of the array that we have not traversed yet. +(* The implementation choice that we made for iterators is the one + that maximizes efficiency by avoiding repeated bound checking: we + check the length of the dynamic array once at the beginning, and + then only operate on that portion of the dynarray, ignoring + elements added in the meantime. + + The specification states that it is a programming error to mutate + the length of the array during iteration. We check for this and + raise an error on size change. + Note that we may still miss some transient state changes that cancel + each other and leave the length unchanged at the next check. *) -let iter f a = - let i = ref 0 in - while !i < length a do - f (get a !i); - incr i - done +let iter k a = + let {arr; length} = a in + (* [check_valid_length length arr] is used for memory safety, it + guarantees that the backing array has capacity at least [length], + allowing unsafe array access. + + [check_same_length] is used for correctness, it lets the function + fail more often if we discover the programming error of mutating + the length during iteration. + + We could, naively, call [check_same_length] at each iteration of + the loop (before or after, or both). However, notice that this is + not necessary to detect the removal of elements from [a]: if + elements have been removed by the time the [for] loop reaches + them, then [unsafe_get] will itself fail with an [Invalid_arg] + exception. We only need to detect the addition of new elements to + [a] during iteration, and for this it suffics to call + [check_same_length] once at the end. + + Calling [check_same_length] more often could catch more + programming errors, but the only errors that we miss with this + optimization are those that keep the array size constant -- + additions and deletions that cancel each other. We consider this + an acceptable tradeoff. + *) + check_valid_length length arr; + for i = 0 to length - 1 do + k (unsafe_get arr ~i ~length); + done; + check_same_length a ~length -let append a b = - ensure_capacity a (length a + length b); - append_iter a iter b -let iteri f a = - let i = ref 0 in - while !i < length a do - f !i (get a !i); - incr i - done +let iteri k a = + let {arr; length} = a in + check_valid_length length arr; + for i = 0 to length - 1 do + k i (unsafe_get arr ~i ~length); + done; + check_same_length a ~length let map f a = - let i = ref 0 in - let b = create () in - ensure_capacity b (length a); - (* Calls to [f] may add further elements to the array [a]; those - will get added in the final result as well. This means that the - capacity hint above is sometimes not sufficient to guarantee the - absence of further reallocations, but this is innocuous. *) - while !i < length a do - add_last b (f (get a !i)); - incr i - done; - b + let {arr; length} = a in + check_valid_length length arr; + let res = { + length; + arr = Array.init length (fun i -> + Elem {v = f (unsafe_get arr ~i ~length)}); + } in + check_same_length a ~length; + res + let mapi f a = - let i = ref 0 in - let b = create () in - ensure_capacity b (length a); - while !i < length a do - add_last b (f !i (get a !i)); - incr i - done; - b + let {arr; length} = a in + check_valid_length length arr; + let res = { + length; + arr = Array.init length (fun i -> + Elem {v = f i (unsafe_get arr ~i ~length)}); + } in + check_same_length a ~length; + res let fold_left f acc a = - let i = ref 0 in - let acc = ref acc in - while !i < length a do - acc := f !acc (get a !i); - incr i - done; - !acc + let {arr; length} = a in + check_valid_length length arr; + let rec fold acc arr i length = + if i = length then acc + else + let v = unsafe_get arr ~i ~length in + fold (f acc v) arr (i+1) length + in + let res = fold acc arr 0 length in + check_same_length a ~length; + res let exists p a = - let i = ref 0 in - let stop = ref false in - while not !stop && !i < length a do - if p (get a !i) then stop := true; - incr i; - done; - !stop + let {arr; length} = a in + check_valid_length length arr; + let rec loop p arr i length = + if i = length then false + else + p (unsafe_get arr ~i ~length) + || loop p arr (i + 1) length + in + let res = loop p arr 0 length in + check_same_length a ~length; + res let for_all p a = - let i = ref 0 in - let continue = ref true in - while !continue && !i < length a do - if not (p (get a !i)) then continue := false; - incr i; - done; - !continue + let {arr; length} = a in + check_valid_length length arr; + let rec loop p arr i length = + if i = length then true + else + p (unsafe_get arr ~i ~length) + && loop p arr (i + 1) length + in + let res = loop p arr 0 length in + check_same_length a ~length; + res let filter f a = let b = create () in @@ -501,19 +648,6 @@ let filter_map f a = obey their more permissive specification, which tolerates any concurrent update. *) -let of_list li = - let a = create () in - List.iter (fun x -> add_last a x) li; - a - -let[@tail_mod_cons] rec to_list_from a i = - if i >= length a then [] - else - let x = get a i in - x :: to_list_from a (i + 1) - -let to_list a = to_list_from a 0 - let of_array a = let length = Array.length a in { @@ -522,34 +656,28 @@ let of_array a = } let to_array a = - let initial_length = length a in - if initial_length = 0 then [| |] - else begin - let x0 = get a 0 in - let dst = Array.make initial_length x0 in - let i = ref 1 in - let arr = a.arr in - check_valid_length initial_length arr; - while !i < initial_length && !i < length a do - Array.unsafe_set dst !i (unsafe_get arr ~i:!i ~length:initial_length); - incr i; - done; - (* At this point we know that either [!i = initial_length] - or we have observed [!i >= length a]. *) - if !i < initial_length then begin - (* In this case we must have observed [!i >= length a]: - we reached the end of [a]. *) - Array.sub dst 0 !i - end else if !i < length a then begin - (* In this case we know [!i = initial_length < length a]: - the array has grown during our iteration. - Aim for simplicity rather than efficiency in this weird corner case. *) - Array.append dst (Array.of_list (to_list_from a !i)) - end else begin - (* we know [!i = initial_length] and have observed [!i >= length a] *) - dst - end - end + let {arr; length} = a in + check_valid_length length arr; + let res = Array.init length (fun i -> + unsafe_get arr ~i ~length) + in + check_same_length a ~length; + res + +let of_list li = + let a = create () in + List.iter (fun x -> add_last a x) li; + a + +let to_list a = + let {arr; length} = a in + check_valid_length length arr; + let l = ref [] in + for i = length - 1 downto 0 do + l := unsafe_get arr ~i ~length :: !l + done; + check_same_length a ~length; + !l let of_seq seq = let init = create() in diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index c12e2932f78..e53d11f49f6 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -109,14 +109,7 @@ val copy : 'a t -> 'a t (** {1:adding Adding elements} Note: all operations adding elements can raise [Failure] if the - length would need to grow beyond {!Sys.max_array_length}. - - For the [append*] functions adding several elements to a dynamic - array, it is unspecified at which point during the execution of - the [append*] function the element becomes visible in the dynamic - array -- when [length] is updated. For example, they may become - visible one by one during computation, or all at once at the end. -*) + length would need to grow beyond {!Sys.max_array_length}. *) val add_last : 'a t -> 'a -> unit (** [add_last a x] adds the element [x] at the end of the array [a]. @@ -141,10 +134,8 @@ val append : 'a t -> 'a t -> unit but [b] is itself a dynamic arreay instead of a fixed-size array. Beware! Calling [append a a] iterates on [a] and adds elements to - it at the same time; its behavior is unspecified. In particular, - if elements coming from [a]-on-the-right become visible in - [a]-on-the-left during the iteration on [a], they may added again - and again, resulting in an infinite loop. + it at the same time; it is a programming error and fails with + [Invalid_argument]. *) val append_seq : 'a t -> 'a Seq.t -> unit @@ -211,11 +202,10 @@ val truncate : 'a t -> int -> unit The iteration functions traverse the elements of a dynamic array. - If the array gets modified (by setting existing elements or adding - or removing elements) during traversal, it is unspecified which of - the modifications will be observed by the traversal. For example, - some modifications may not be observed while later modifications - are observed. + It is a programming error to modify the length of an array + (by adding or removing elements) during an iteration on the + array. Any iteration function will fail with [Invalid_argument] + if it detects such a length change. *) val iter : ('a -> unit) -> 'a t -> unit @@ -256,10 +246,15 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t Note: the [of_*] functions can raise [Failure] if the length would need to grow beyond {!Sys.max_array_length}. - The [to_*] functions iterate on their dynarray argument. In - particular, except for [to_seq], their behavior is under-specified - if the dynarray is mutated during their execution -- see the - (un)specification in the {!section:Iteration} section. + The [to_*] functions, expect for {!to_seq}, iterate on their + dynarray argument. In particular it is a programming error if the + length of the dynarray changes during their execution, and the + conversion functions raise [Invalid_argument] if they observe such + a change. + + {!to_seq} produces an on-demand sequence of values, and is expected + to be called with effects happening in-between. Its specification + tolerates changes of length. (See below.) *) val of_array : 'a array -> 'a t From 49643349b9c33d2ae2daa2a2ddd3a22172ca0bbc Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 6 Mar 2023 15:40:03 +0100 Subject: [PATCH 251/402] test iterator-invalidation examples in the testsuite --- testsuite/tests/lib-dynarray/test.ml | 56 ++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 4f8c9f75682..01169e9e37c 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -162,4 +162,60 @@ let () = let a = A.of_list l in assert (A.to_list a = l);; + +(* Iterator invalidation *) +let raises_invalid_argument f = + match f () with + | exception Invalid_argument _ -> true + | exception _ | _ -> false + +let () = + let a = A.of_list [1; 2; 3] in + assert (raises_invalid_argument (fun () -> + A.append a a + )) + +let () = + let a = A.of_list [1; 2; 3] in + assert (raises_invalid_argument (fun () -> + a |> A.iter (fun i -> + A.add_last a (10 + i) + ) + )) + +let () = + let a = A.of_list [1; 2; 3] in + assert (raises_invalid_argument (fun () -> + a |> A.iter (fun i -> + if i >= 2 then A.remove_last a + ) + )) + +let does_not_raise_invalid_argument f = + not (raises_invalid_argument f) + +(* The spec says that this is a programming error, but currently we accept + the following without an error. *) +let () = + let a = A.of_list [1; 2; 3] in + A.ensure_capacity a 10; + assert (does_not_raise_invalid_argument (fun () -> + a |> A.iter (fun i -> + A.add_last a i; + A.remove_last a + ) + )) + +(* Even with a capacity increase in the middle, + we still accept this although the spec would let us reject. *) +let () = + let a = A.of_list [1; 2; 3] in + A.fit_capacity a; + assert (does_not_raise_invalid_argument (fun () -> + a |> A.iter (fun i -> + A.add_last a i; + A.remove_last a + ) + )) + let () = print_endline "OK";; From 71b34a6aebc8b0e030024ec931f5937d3264c187 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 6 Mar 2023 17:16:19 +0100 Subject: [PATCH 252/402] dynarray.mli review: explain the current memory layout --- stdlib/dynarray.mli | 43 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 37 insertions(+), 6 deletions(-) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index e53d11f49f6..523882c509e 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -17,9 +17,9 @@ (** Dynamic arrays. - The {!Array} module provide arrays of fixed length. In contrast, - the length of a dynamic array can change over time, we can add - more elements or remove elements at the end of the array. + The {!Array} module provide arrays of fixed length. {!Dynarray} + provides array whose length can change over time, by adding or + removing elements at the end of the array. This is typically used to accumulate elements whose number is not known in advance or changes during computation, while also @@ -33,12 +33,16 @@ ]} The {!Buffer} module provides similar features, but it is - specialized for accumulating characters into a dynamically-growing + specialized for accumulating characters into a dynamically-resized string. The {!Stack} module provides a last-in first-out data structure that can be easily implemented on top of dynamic arrays. + {b Warning.} In their current implementation, the memory layout + of dynamic arrays differs from the one of {!Array}s. See the + {{!section:memory_layout} Memory Layout} section for more information. + @since 5.1 *) @@ -302,7 +306,9 @@ val to_seq_rev : 'a t -> 'a Seq.t *) -(** {1:capacity Backing array and capacity} +(** {1:advanced Advanced topics for performance} *) + +(** {2:capacity Backing array, capacity} Internally, a dynamic array uses a {b backing array} (a fixed-size array as provided by the {!Array} module) whose length is greater @@ -381,10 +387,35 @@ val reset : 'a t -> unit Similar to {!Buffer.reset}. *) -(** {b No leaks: preservation of memory liveness} +(** {2:noleaks No leaks: preservation of memory liveness} The user-provided values reachable from a dynamic array [a] are exactly the elements in the positions [0] to [length a - 1]. In particular, no user-provided values are "leaked" by being present in the backing array in position [length a] or later. *) + +(** {2:memory_layout Memory layout of dynarrays} + + In the current implementation, the backing array of an + ['a Dynarray.t] is not an ['a array], but something closer to an + ['a option array] in terms of memory layout -- with a mutable field, + so that we allocate only when adding new elements to the array. + + Using a ['a array] would be delicate, as there is no obvious + type-correct way to represent the empty space at the end of the + backing array -- using user-provided values would either + complicate the API or violate the {{!section:noleaks}no leaks} + guarantee. The constraint of remaining memory-safe under + unsynchronized concurrent usage makes it even more + difficult. Various unsafe ways to do this have been discussed, + with no consensus for a standard implementation so far. + + On a realistic automated-theorem-proving program that relies + heavily on dynamic arrays, we measured the overhead of this extra + "boxing" as at most 25%. We believe that the overhead for most + uses of dynarray is much smaller, neglectible in most cases, but + you may still prefer to use your own, customized implementation + for performance. +*) + From af126ade4aa862d474d4db900946d578f3a85dbd Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 7 Mar 2023 10:13:57 +0100 Subject: [PATCH 253/402] dynarray.mli code review --- stdlib/dynarray.mli | 53 +++++++++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 523882c509e..31950cf2aeb 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -63,57 +63,58 @@ type 'a t (** A dynamic array containing values of type ['a]. - A dynamic array [a] is an array, that is, it provides - constant-time [get] and [set] operation on indices between [0] and - [Dynarray.length a - 1] included. Its {b length} may change over - time by adding or removing elements to the end of the array. + A dynamic array [a] provides constant-time [get] and [set] + operation on indices between [0] and [Dynarray.length a - 1] + included. Its {!length} may change over time by adding or removing + elements to the end of the array. + + We say that an index into a dynarray [a] is valid if it is in + [0 .. length a - 1] and invalid otherwise. *) val create : unit -> 'a t (** [create ()] is a new, empty array. *) val make : int -> 'a -> 'a t -(** [make n x] makes a array of length [n], filled with [x]. *) +(** [make n x] is a new array of length [n], filled with [x]. *) val init : int -> (int -> 'a) -> 'a t (** [init n f] is a new array [a] of length [n], such that [get a i] is [f i]. In other words, - [a] is the the array whose elements are - [f 0; f 1; f 2; ...; f (n - 1)]. + the elements of [a] are [f 0], then [f 1], + then [f 2]... and [f (n - 1)] last, evaluated + in that order. This is similar to {!Array.init}. *) val get : 'a t -> int -> 'a (** [get a i] is the [i]-th element of [a], starting with index [0]. - @raise Invalid_argument if the index is - invalid (not in [0 .. length a-1]). *) + @raise Invalid_argument if the index is invalid *) val set : 'a t -> int -> 'a -> unit (** [set a i x] sets the [i]-th element of [a] to be [x]. - Just like {!get}, [i] must be between [0] and [length a - 1] - included. [set] does not add new elements to the array -- see - {!add_last} to add an element. + Just like {!get}, [i] must be a valid index. [set] does not add + new elements to the array -- see {!add_last} to add an element. @raise Invalid_argument if the index is invalid. *) val length : _ t -> int -(** [length a] is the number of elements in the array. - The last element of [a], if not empty, is [get a (length a - 1)]. - This operation is constant time. *) +(** [length a] is the number of elements in the array. *) val is_empty : 'a t -> bool (** [is_empty a] is [true] if [a] is empty, that is, if [length a = 0]. *) val copy : 'a t -> 'a t -(** [copy a] is a shallow copy of [a], that can be modified independently. *) +(** [copy a] is a shallow copy of [a], a fresh array + containing the same elements as [a]. *) (** {1:adding Adding elements} - Note: all operations adding elements can raise [Failure] if the - length would need to grow beyond {!Sys.max_array_length}. *) + Note: all operations adding elements raise [Failure] if the + length needs to grow beyond {!Sys.max_array_length}. *) val add_last : 'a t -> 'a -> unit (** [add_last a x] adds the element [x] at the end of the array [a]. @@ -337,10 +338,10 @@ val to_seq_rev : 'a t -> 'a Seq.t *) val ensure_capacity : 'a t -> int -> unit -(** [ensure_capacity a n] makes sure that [a] has capacity has least [n]. +(** [ensure_capacity a n] makes sure that the capacity of [a] + is at least [n]. @raise Invalid_argument if the requested capacity is negative. - (We consider that this is a programming error.) @raise Failure if the requested capacity is above {!Sys.max_array_length}. @@ -348,7 +349,7 @@ val ensure_capacity : 'a t -> int -> unit scenarios. In particular, all functions adding elements to a dynamic array may propagate this exception.) - An example use-case would be to implement [append_array]: + A use case would be to implement {!append_array}: {[ let append_array a arr = ensure_capacity a (length a + Array.length arr); @@ -384,8 +385,7 @@ val reset : 'a t -> unit (** [reset a] clears [a] and replaces its backing array by an empty array. It is equivalent to [clear a; fit_capacity a]. - - Similar to {!Buffer.reset}. *) +*) (** {2:noleaks No leaks: preservation of memory liveness} @@ -398,9 +398,10 @@ val reset : 'a t -> unit (** {2:memory_layout Memory layout of dynarrays} In the current implementation, the backing array of an - ['a Dynarray.t] is not an ['a array], but something closer to an - ['a option array] in terms of memory layout -- with a mutable field, - so that we allocate only when adding new elements to the array. + ['a Dynarray.t] is not an ['a array], but something with the same + representation as an ['a option array] or ['a ref array]. + Each element is in a "box", allocated when the element is first + added to the array -- see the implementation for more details. Using a ['a array] would be delicate, as there is no obvious type-correct way to represent the empty space at the end of the From 144e667b67b8d7909318442295e4dbfae5a6ee3f Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 7 Mar 2023 10:46:11 +0100 Subject: [PATCH 254/402] dynarray.mli code review --- stdlib/dynarray.mli | 49 +++++++++++++++++++-------------------------- 1 file changed, 21 insertions(+), 28 deletions(-) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 31950cf2aeb..72c9a3f4b67 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -95,8 +95,8 @@ val get : 'a t -> int -> 'a val set : 'a t -> int -> 'a -> unit (** [set a i x] sets the [i]-th element of [a] to be [x]. - Just like {!get}, [i] must be a valid index. [set] does not add - new elements to the array -- see {!add_last} to add an element. + [i] must be a valid index. [set] does not add new elements to the + array -- see {!add_last} to add an element. @raise Invalid_argument if the index is invalid. *) @@ -107,7 +107,7 @@ val is_empty : 'a t -> bool (** [is_empty a] is [true] if [a] is empty, that is, if [length a = 0]. *) val copy : 'a t -> 'a t -(** [copy a] is a shallow copy of [a], a fresh array +(** [copy a] is a shallow copy of [a], a new array containing the same elements as [a]. *) @@ -117,17 +117,17 @@ val copy : 'a t -> 'a t length needs to grow beyond {!Sys.max_array_length}. *) val add_last : 'a t -> 'a -> unit -(** [add_last a x] adds the element [x] at the end of the array [a]. - The length of [a] increases by [1]. *) +(** [add_last a x] adds the element [x] at the end of the array [a]. *) val append_array : 'a t -> 'a array -> unit (** [append_array a b] adds all elements of [b] at the end of [a], in the order they appear in [b]. - For example, [a] will contain [1,2,3,4,5,6] after this code runs: + For example: {[ - let a = of_list [1;2;3];; - let () = append a [|4; 5; 6|];; + let a = Dynarray.of_list [1;2] + let () = Dynarray.append a [|3; 4|] + let () = assert (Dynarray.to_list a = [1; 2; 3; 4]) ]} *) @@ -154,11 +154,11 @@ val append_iter : 'a t -> (('a -> unit) -> 'x -> unit) -> 'x -> unit -(** [append_iter a iter x] adds to [a] each element in [x]. It uses [iter] - to iterate over [x]. +(** [append_iter a iter x] adds each element of [x] to the end of [a]. + This is [iter (add_last a) x]. For example, [append_iter a List.iter [1;2;3]] would add elements - [1], [2], and [3] at the end of [a]. + [1], [2], and then [3] at the end of [a]. [append_iter a Queue.iter q] adds elements from the queue [q]. *) @@ -174,32 +174,24 @@ val pop_last : 'a t -> 'a @raise Not_found on an empty array. *) val remove_last : 'a t -> unit -(** [remove_last a] removes the last element of [a] , or does nothing - if [is_empty a]. -*) +(** [remove_last a] removes the last element of [a], if any. + It does nothing if [a] is empty. *) val clear : 'a t -> unit -(** [clear a] removes all the elements of [a]. - - It is equivalent to [truncate a 0]. - - Similar to {!Buffer.clear}. -*) +(** [clear a] is [truncate a 0], it removes all the elements of [a]. *) val truncate : 'a t -> int -> unit (** [truncate a n] truncates [a] to have at most [n] elements. - It removes elements whose index is great or equal than [n]. + It removes elements whose index is greater or equal to [n]. It does nothing if [n >= length a]. - It is equivalent to: + [truncate a n] is equivalent to: {[ while length a > n do remove_last a done ]} - - Similar to {!Buffer.truncate}. *) @@ -231,14 +223,15 @@ val fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc (** [fold_left f acc a] folds [f] over [a] starting with accumulator [acc]. *) val exists : ('a -> bool) -> 'a t -> bool -(** [exists f a] returns [true] if some element of [a] satisfies [f]. *) +(** [exists f a] is [true] if some element of [a] satisfies [f]. *) val for_all : ('a -> bool) -> 'a t -> bool -(** [for_all f a] returns [true] if all elements of [a] satisfie [f]. +(** [for_all f a] is [true] if all elements of [a] satisfy [f]. This includes the case where [a] is empty. *) val filter : ('a -> bool) -> 'a t -> 'a t -(** [filter f a] is an array containing all elements of [a] that satisfy [f] *) +(** [filter f a] is a new array containing + all elements of [a] that satisfy [f]. *) val filter_map : ('a -> 'b option) -> 'a t -> 'b t (** [filter_map f a] is a new array [b], such that for each item [x] in [a]: @@ -251,7 +244,7 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t Note: the [of_*] functions can raise [Failure] if the length would need to grow beyond {!Sys.max_array_length}. - The [to_*] functions, expect for {!to_seq}, iterate on their + The [to_*] functions, except for {!to_seq}, iterate on their dynarray argument. In particular it is a programming error if the length of the dynarray changes during their execution, and the conversion functions raise [Invalid_argument] if they observe such From b7a2903cc280c7ebe2396a0ce2d6fe36dcb75968 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 8 Mar 2023 08:27:38 +0100 Subject: [PATCH 255/402] dynarray.mli: rework iterators documentation --- stdlib/dynarray.mli | 67 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 54 insertions(+), 13 deletions(-) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 72c9a3f4b67..25e154b7727 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -198,6 +198,8 @@ val truncate : 'a t -> int -> unit (** {1:iteration Iteration} The iteration functions traverse the elements of a dynamic array. + Traversals of [a] are computed in increasing index order: from + the element of index [0] to the element of index [length a - 1]. It is a programming error to modify the length of an array (by adding or removing elements) during an iteration on the @@ -206,38 +208,77 @@ val truncate : 'a t -> int -> unit *) val iter : ('a -> unit) -> 'a t -> unit -(** [iter f a] calls [f] on each element of [a], in increasing index order. *) +(** [iter f a] calls [f] on each element of [a]. *) val iteri : (int -> 'a -> unit) -> 'a t -> unit (** [iteri f a] calls [f i x] for each [x] at index [i] in [a]. *) val map : ('a -> 'b) -> 'a t -> 'b t -(** [map f a] is a new array of length [length a], with elements mapped - from [a] using [f]. *) +(** [map f a] is a new array of elements of the form [f x] + for each element [x] of [a]. + + For example, if the elements of [a] are [x0, x1, x2], + then the elements of [b] are [f x0, f x1, f x2]. +*) val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t -(** [mapi f v] is just like {!map}, but it also passes in the index - of each element as the first argument to the function [f]. *) +(** [mapi f a] is a new array of elements of the form [f i x] + for each element [x] of [a] at index [i]. + + For example, if the elements of [a] are [x0, x1, x2], + then the elements of [b] are [f 0 x0, f 1 x1, f 2 x2]. +*) val fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc -(** [fold_left f acc a] folds [f] over [a] starting with accumulator [acc]. *) +(** [fold_left f acc a] folds [f] over [a] in order, + starting with accumulator [acc]. + + For example, if the elements of [a] are [x0, x1], + then [fold f acc a] is + {[ + let acc = f acc x0 in + let acc = f acc x1 in + acc + ]} +*) val exists : ('a -> bool) -> 'a t -> bool -(** [exists f a] is [true] if some element of [a] satisfies [f]. *) +(** [exists f a] is [true] if some element of [a] satisfies [f]. + + For example, if the elements of [a] are [x0, x1, x2], then + [exists f a] is [f x0 || f x1 || f x2]. +*) val for_all : ('a -> bool) -> 'a t -> bool (** [for_all f a] is [true] if all elements of [a] satisfy [f]. - This includes the case where [a] is empty. *) + This includes the case where [a] is empty. + + For example, if the elements of [a] are [x0, x1], then + [exists f a] is [f x0 && f x1 && f x2]. +*) val filter : ('a -> bool) -> 'a t -> 'a t -(** [filter f a] is a new array containing - all elements of [a] that satisfy [f]. *) +(** [filter f a] is a new array of all the elements of [a] that satisfy [f]. + In other words, it is an array [b] such that, for each element [x] + in [a] in order, [x] is added to [b] if [f x] is [true]. + + For example, [filter (fun x -> x >= 0) a] is a new array + of all non-negative elements of [a], in order. +*) val filter_map : ('a -> 'b option) -> 'a t -> 'b t -(** [filter_map f a] is a new array [b], such that for each item [x] in [a]: - - if [f x = Some y], then [y] is in [b] - - if [f x = None], then no element is added to [b]. *) +(** [filter_map f a] is a new array of elements [y] + such that [f x] is [Some y] for an element [x] of [a]. + In others words, it is an array [b] such that, for each element + [x] of [a] in order: + {ul + {- if [f x = Some y], then [y] is added to [b],} + {- if [f x = None], then no element is added to [b].}} + For example, [filter_map int_of_string_opt inputs] returns + a new array of integers read from the strings in [inputs], + ignoring strings that cannot be converted to integers. +*) (** {1:conversions Conversions to other data structures} From 10bac6b2a8ffaa03d1273bda908cc7f66ec9d2a4 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 8 Mar 2023 08:27:52 +0100 Subject: [PATCH 256/402] dynarray.mli: use 'element' rather than 'item' --- stdlib/dynarray.mli | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 25e154b7727..f280f5e4379 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -303,7 +303,7 @@ val of_array : 'a array -> 'a t val to_array : 'a t -> 'a array (** [to_array a] returns a fixed-sized array corresponding to the dynamic array [a]. This always allocate a new array and copies - item into it. *) + elements into it. *) val of_list : 'a list -> 'a t (** [of_list l] is the array containing the elements of [l] in @@ -318,7 +318,7 @@ val of_seq : 'a Seq.t -> 'a t It traverses [seq] once and will terminate only if [seq] is finite. *) val to_seq : 'a t -> 'a Seq.t -(** [to_seq a] is the sequence of items +(** [to_seq a] is the sequence of elements [get a 0], [get a 1]... [get a (length a - 1)]. Because sequences are computed on-demand, we have to assume that @@ -332,7 +332,7 @@ val to_seq : 'a t -> 'a Seq.t *) val to_seq_rev : 'a t -> 'a Seq.t -(** [to_seq_rev a] is the sequence of items +(** [to_seq_rev a] is the sequence of elements [get a (l - 1)], [get a (l - 2)]... [get a 0], where [l] is [length a] at the time [to_seq_rev] is invoked. From 6f638e885a3957a826ece170f3bcb758382282c2 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 8 Mar 2023 09:25:54 +0100 Subject: [PATCH 257/402] Dynarray.ensure_extra_capacity --- stdlib/dynarray.ml | 29 ++++++++++++++++------------- stdlib/dynarray.mli | 44 +++++++++++++++++++++++++++++--------------- 2 files changed, 45 insertions(+), 28 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 4dfba46a480..fb34580eeed 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -317,32 +317,35 @@ let next_capacity n = (* jump directly from 0 to 8 *) min (max 8 n') Sys.max_array_length -let ensure_capacity a requested_length = +let ensure_capacity a capacity_request = let arr = a.arr in let cur_capacity = Array.length arr in - if cur_capacity >= requested_length then + if cur_capacity >= capacity_request then (* This is the fast path, the code up to here must do as little as possible. (This is why we don't use [let {arr; length} = a] as usual, the length is not needed in the fast path.)*) () else begin - if requested_length < 0 then - Error.negative_capacity "ensure_capacity" requested_length; - if requested_length > Sys.max_array_length then - Error.requested_length_out_of_bounds "ensure_capacity" requested_length; + if capacity_request < 0 then + Error.negative_capacity "ensure_capacity" capacity_request; + if capacity_request > Sys.max_array_length then + Error.requested_length_out_of_bounds "ensure_capacity" capacity_request; let new_capacity = ref cur_capacity in - while !new_capacity < requested_length do + while !new_capacity < capacity_request do new_capacity := next_capacity !new_capacity done; let new_capacity = !new_capacity in - assert (new_capacity >= requested_length); + assert (new_capacity >= capacity_request); let new_arr = Array.make new_capacity Empty in Array.blit arr 0 new_arr 0 a.length; a.arr <- new_arr; - assert (0 <= requested_length); - assert (requested_length <= Array.length new_arr); + assert (0 <= capacity_request); + assert (capacity_request <= Array.length new_arr); end +let ensure_extra_capacity a extra_capacity_request = + ensure_capacity a (length a + extra_capacity_request) + let fit_capacity a = if Array.length a.arr = a.length then () @@ -390,7 +393,7 @@ let add_last a x = else begin (* slow path *) let rec grow_and_add a elem = - ensure_capacity a (length a + 1); + ensure_extra_capacity a 1; if not (add_last_if_room a elem) then grow_and_add a elem in grow_and_add a elem @@ -456,7 +459,7 @@ let append_array a b = else begin (* slow path *) let rec grow_and_append a b = - ensure_capacity a (length a + Array.length b); + ensure_extra_capacity a (Array.length b); if not (append_array_if_room a b) then grow_and_append a b in grow_and_append a b end @@ -494,7 +497,7 @@ let append a b = else begin (* slow path *) let rec grow_and_append a b ~length_b = - ensure_capacity a (length a + length_b); + ensure_extra_capacity a length_b; (* Eliding the [check_same_length] call below would be wrong in the case where [a] and [b] are aliases of each other, we would get into an infinite loop instead of failing. diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index f280f5e4379..afcce6e67c9 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -355,16 +355,15 @@ val to_seq_rev : 'a t -> 'a Seq.t {ul {- The memory usage of a dynamic array is proportional to its capacity, rather than its length.} - {- Adding elements to the end of a dynamic array may require - allocating a new, larger backing array when its length - is already equal to its capacity, so there is no room - for more elements in the current backing array.}} + {- When then is no empty space left at the end of the backing array. + adding elements requires allocating a new, larger backing array.}} The implementation uses a standard exponential reallocation strategy which guarantees amortized constant-time operation: the total capacity of all backing arrays allocated over the lifetime - of a dynamic array is proportional to the total number of elements - added or removed. + of a dynamic array is at worst proportional to the total number of + elements added. + In other words, users need not care about capacity and reallocations, and they will get reasonable behavior by default. However, in some performance-sensitive scenarios the functions below can help control @@ -383,19 +382,32 @@ val ensure_capacity : 'a t -> int -> unit scenarios. In particular, all functions adding elements to a dynamic array may propagate this exception.) - A use case would be to implement {!append_array}: -{[ - let append_array a arr = - ensure_capacity a (length a + Array.length arr); + A use case would be to implement {!of_array} (without using {!init} directly): + {[ + let of_array arr = + let a = Dynarray.create () in + Dynarray.ensure_capacity a (Array.length arr); Array.iter (fun v -> add_last a v) arr -]} + ]} Using [ensure_capacity] guarantees that at most one reallocation will take place, instead of possibly several. Without this [ensure_capacity] hint, the number of resizes would be logarithmic in the length of [arr], creating a constant-factor - slowdown noticeable when [a] is small and [arr] is large. + slowdown noticeable when [arr] is large. +*) + +val ensure_extra_capacity : 'a t -> int -> unit +(** [ensure_extra_capacity a n] is [ensure_capacity a (length a + n)], + it makes sure that [a] has room for [n] extra items. + + A use case would be to implement {!append_array}: + {[ + let append_array a arr = + ensure_extra_capacity a (Array.length arr); + Array.iter (fun v -> add_last a v) arr + ]} *) val fit_capacity : 'a t -> unit @@ -449,8 +461,10 @@ val reset : 'a t -> unit On a realistic automated-theorem-proving program that relies heavily on dynamic arrays, we measured the overhead of this extra "boxing" as at most 25%. We believe that the overhead for most - uses of dynarray is much smaller, neglectible in most cases, but - you may still prefer to use your own, customized implementation - for performance. + uses of dynarray is much smaller, neglectible in many cases, but + you may still prefer to use your own specialized implementation + for performance. (If you know that you do not need the + {{:noleaks}no leaks} guarantee, you can also speed up deleting + elements.) *) From 54ebac40f30f83d102c02a52378218f236dc3595 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 8 Mar 2023 21:35:32 +0100 Subject: [PATCH 258/402] new function Dynarray.truncate_capacity : 'a Dynarray.t -> int -> unit --- stdlib/dynarray.ml | 13 ++++++++++--- stdlib/dynarray.mli | 20 ++++++++++++++++++-- testsuite/tests/lib-dynarray/test.ml | 9 +++++++++ 3 files changed, 37 insertions(+), 5 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index fb34580eeed..95d758c561b 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -351,10 +351,17 @@ let fit_capacity a = then () else a.arr <- Array.sub a.arr 0 a.length -let reset a = - clear a; - fit_capacity a +let truncate_capacity a n = + if n >= Array.length a.arr then () + else if n < 0 then + Error.negative_capacity "truncate_capacity" n + else begin + a.length <- n; + a.arr <- Array.sub a.arr 0 n; + end +let reset a = + truncate_capacity a 0 (** {1:adding Adding elements} *) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index afcce6e67c9..5fb1839506c 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -417,8 +417,9 @@ val fit_capacity : 'a t -> unit a long-lived array. Note that calling [fit_capacity] breaks the amortized complexity - guarantees provided by the default reallocation strategy, and may - result in more reallocations in the future. + guarantees provided by the default reallocation strategy. Calling + it repeatedly on an array may have quadratic complexity, both in + time and in total number of allocations. If you know that a dynamic array has reached its final length, which will remain fixed in the future, it is sufficient to call @@ -427,6 +428,21 @@ val fit_capacity : 'a t -> unit array for eventual future resizes. *) +val truncate_capacity : 'a t -> int -> unit +(** [truncate_capacity a n] shrinks the backing array to have + capacity at most [n]; in particular, like [truncate a n], + all elements of index [n] or greater are removed. + + This is equivalent to [truncate a n; fit_capacity a] but more + efficient: [truncate a n] needs to overwrite the removed elements + to preserve the {{!section:noleaks} no leaks} guarantee. + + Like {!fit_capacity}, this function breaks the amortized + complexity guarantees provided by the reallocation + strategy. Calling it repeatedly on an array may have quadratic + complexity, both in time and in total number of allocations. +*) + val reset : 'a t -> unit (** [reset a] clears [a] and replaces its backing array by an empty array. diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 01169e9e37c..ff7cedb4c38 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -136,6 +136,15 @@ let () = assert (A.to_list a = list_range 0 size)) [ 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; +let () = + let a = A.create() in + for i=0 to 20_000 do A.add_last a i; done; + List.iter + (fun size -> + A.truncate_capacity a size; + assert (A.to_list a = list_range 0 size)) + [ 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; + let () = let a = A.create() in for i = 0 to 200 do From 7377d9d1c78e7b1898fb8dbe7c2903567a17addd Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 8 Mar 2023 21:40:40 +0100 Subject: [PATCH 259/402] dynarray: change the ensure_capacity growth strategy to be 'exact' in most cases --- stdlib/dynarray.ml | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 95d758c561b..57dfdba6b7e 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -330,12 +330,22 @@ let ensure_capacity a capacity_request = Error.negative_capacity "ensure_capacity" capacity_request; if capacity_request > Sys.max_array_length then Error.requested_length_out_of_bounds "ensure_capacity" capacity_request; - let new_capacity = ref cur_capacity in - while !new_capacity < capacity_request do - new_capacity := next_capacity !new_capacity - done; - let new_capacity = !new_capacity in - assert (new_capacity >= capacity_request); + let new_capacity = + (* We use either the next exponential-growth strategy, + or the requested strategy, whichever is bigger. + + Compared to only using the exponential-growth strategy, this + lets us use less memory by avoiding any overshoot whenever + the capacity request is noticeably larger than the current + capacity. + + Compared to only using the requested capacity, this avoids + losing the amortized guarantee: we allocated "exponentially + or more", so the amortization holds. In particular, notice + that repeated calls to [ensure_capacity a (length a + 1)] + will have amortized-linear rather than quadratic complexity. + *) + max (next_capacity cur_capacity) capacity_request in let new_arr = Array.make new_capacity Empty in Array.blit arr 0 new_arr 0 a.length; a.arr <- new_arr; From b850cee15219e3644f43e6e757cda591b0bd77ca Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 9 Mar 2023 10:12:17 +0100 Subject: [PATCH 260/402] dynarray: display iterator function name on invalidation error --- stdlib/dynarray.ml | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 57dfdba6b7e..a4240494391 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -157,10 +157,10 @@ module Error = struct "Dynarray: invalid array (length %d > capacity %d)" length capacity - let iterator_invalidation ~expected ~observed = + let iterator_invalidation f ~expected ~observed = Printf.ksprintf invalid_arg - "Dynarray: iterator invalidated by a length change from %d to %d" - expected observed + "Dynarray.%s: iterator invalidated by a length change from %d to %d" + f expected observed (* When an [Empty] element is observed unexpectedly at index [i], it may be either an out-of-bounds access or an invalid-state situation @@ -176,10 +176,10 @@ end See {!iter} below for a detailed usage example. *) -let check_same_length a ~length = +let check_same_length f a ~length = let length_a = a.length in if length <> length_a then - Error.iterator_invalidation + Error.iterator_invalidation f ~expected:length ~observed:length_a (** Careful unsafe access. *) @@ -504,7 +504,7 @@ let append_if_room a b ~length_b = let x = unsafe_get arr_b ~i ~length:length_b in Array.unsafe_set arr_a (length_a + i) (Elem {v = x}) done; - check_same_length b ~length:length_b; + check_same_length "append" b ~length:length_b; true end @@ -521,7 +521,7 @@ let append a b = We could push the call to [append_if_room] itself, but we prefer to keep it in the slow path. *) - check_same_length b ~length:length_b; + check_same_length "append" b ~length:length_b; if not (append_if_room a b ~length_b) then grow_and_append a b ~length_b in grow_and_append a b ~length_b @@ -544,7 +544,7 @@ let append a b = each other and leave the length unchanged at the next check. *) -let iter k a = +let iter_ f k a = let {arr; length} = a in (* [check_valid_length length arr] is used for memory safety, it guarantees that the backing array has capacity at least [length], @@ -573,8 +573,10 @@ let iter k a = for i = 0 to length - 1 do k (unsafe_get arr ~i ~length); done; - check_same_length a ~length + check_same_length f a ~length +let iter k a = + iter_ "iter" k a let iteri k a = let {arr; length} = a in @@ -582,7 +584,7 @@ let iteri k a = for i = 0 to length - 1 do k i (unsafe_get arr ~i ~length); done; - check_same_length a ~length + check_same_length "iteri" a ~length let map f a = let {arr; length} = a in @@ -592,7 +594,7 @@ let map f a = arr = Array.init length (fun i -> Elem {v = f (unsafe_get arr ~i ~length)}); } in - check_same_length a ~length; + check_same_length "map" a ~length; res @@ -604,7 +606,7 @@ let mapi f a = arr = Array.init length (fun i -> Elem {v = f i (unsafe_get arr ~i ~length)}); } in - check_same_length a ~length; + check_same_length "mapi" a ~length; res let fold_left f acc a = @@ -617,7 +619,7 @@ let fold_left f acc a = fold (f acc v) arr (i+1) length in let res = fold acc arr 0 length in - check_same_length a ~length; + check_same_length "fold_left" a ~length; res let exists p a = @@ -630,7 +632,7 @@ let exists p a = || loop p arr (i + 1) length in let res = loop p arr 0 length in - check_same_length a ~length; + check_same_length "exists" a ~length; res let for_all p a = @@ -643,17 +645,17 @@ let for_all p a = && loop p arr (i + 1) length in let res = loop p arr 0 length in - check_same_length a ~length; + check_same_length "for_all" a ~length; res let filter f a = let b = create () in - iter (fun x -> if f x then add_last b x) a; + iter_ "filter" (fun x -> if f x then add_last b x) a; b let filter_map f a = let b = create() in - iter (fun x -> + iter_ "filter_map" (fun x -> match f x with | None -> () | Some y -> add_last b y @@ -681,7 +683,7 @@ let to_array a = let res = Array.init length (fun i -> unsafe_get arr ~i ~length) in - check_same_length a ~length; + check_same_length "to_array" a ~length; res let of_list li = @@ -696,7 +698,7 @@ let to_list a = for i = length - 1 downto 0 do l := unsafe_get arr ~i ~length :: !l done; - check_same_length a ~length; + check_same_length "to_list" a ~length; !l let of_seq seq = From 1e16db9ec1509500009cb48055b2d3e967675cdc Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 9 Mar 2023 10:15:27 +0100 Subject: [PATCH 261/402] dynarray: raise Invalid_argument instead of Failure above Sys.max_array_length --- stdlib/dynarray.ml | 4 +--- stdlib/dynarray.mli | 15 +++++---------- 2 files changed, 6 insertions(+), 13 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index a4240494391..784ff1a3c86 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -135,9 +135,7 @@ module Error = struct f n let requested_length_out_of_bounds f requested_length = - (* We do not consider this error as a programming error, - so we raise [Failure] instead of [Invalid_argument]. *) - Printf.ksprintf failwith + Printf.ksprintf invalid_arg "Dynarray.%s: cannot grow to requested length %d (max_array_length is %d)" f requested_length Sys.max_array_length diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 5fb1839506c..d06c78aeb40 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -113,7 +113,7 @@ val copy : 'a t -> 'a t (** {1:adding Adding elements} - Note: all operations adding elements raise [Failure] if the + Note: all operations adding elements raise [Invalid_argument] if the length needs to grow beyond {!Sys.max_array_length}. *) val add_last : 'a t -> 'a -> unit @@ -282,8 +282,8 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t (** {1:conversions Conversions to other data structures} - Note: the [of_*] functions can raise [Failure] if the length would - need to grow beyond {!Sys.max_array_length}. + Note: the [of_*] functions raise [Invalid_argument] if the + length needs to grow beyond {!Sys.max_array_length}. The [to_*] functions, except for {!to_seq}, iterate on their dynarray argument. In particular it is a programming error if the @@ -374,13 +374,8 @@ val ensure_capacity : 'a t -> int -> unit (** [ensure_capacity a n] makes sure that the capacity of [a] is at least [n]. - @raise Invalid_argument if the requested capacity is negative. - - @raise Failure if the requested capacity is above - {!Sys.max_array_length}. - (We consider that this is a valid failure mode in some exceptional - scenarios. In particular, all functions adding elements to a dynamic - array may propagate this exception.) + @raise Invalid_argument if the requested capacity is + outside the range [0 .. Sys.max_array_length]. A use case would be to implement {!of_array} (without using {!init} directly): {[ From a442f2feceb89433f32870bd14ce53ad73724250 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 9 Mar 2023 21:52:38 +0100 Subject: [PATCH 262/402] Dynarray.capacity : 'a Dynarray.t -> int --- stdlib/dynarray.ml | 6 ++++-- stdlib/dynarray.mli | 3 +++ 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 784ff1a3c86..c5936c43817 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -297,6 +297,8 @@ let clear a = truncate a 0 (** {1:capacity Backing array and capacity} *) +let capacity a = Array.length a.arr + let next_capacity n = let n' = (* For large values of n, we use 1.5 as our growth factor. @@ -355,12 +357,12 @@ let ensure_extra_capacity a extra_capacity_request = ensure_capacity a (length a + extra_capacity_request) let fit_capacity a = - if Array.length a.arr = a.length + if capacity a = a.length then () else a.arr <- Array.sub a.arr 0 a.length let truncate_capacity a n = - if n >= Array.length a.arr then () + if n >= capacity a then () else if n < 0 then Error.negative_capacity "truncate_capacity" n else begin diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index d06c78aeb40..d8292f2ca51 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -370,6 +370,9 @@ val to_seq_rev : 'a t -> 'a Seq.t memory usage or guarantee an optimal number of reallocations. *) +val capacity : 'a t -> int +(** [capacity a] is the length of [a]'s backing array. *) + val ensure_capacity : 'a t -> int -> unit (** [ensure_capacity a n] makes sure that the capacity of [a] is at least [n]. From cdf478657a2b8e1142c1f0d0228ba8e06f61338c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 9 Mar 2023 22:01:31 +0100 Subject: [PATCH 263/402] dynarray.mli: mutable priority queue as a documentation example MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Daniel Bünzli --- stdlib/dynarray.mli | 118 ++++++++++++++++++++++ testsuite/tests/lib-dynarray/heap_sort.ml | 98 ++++++++++++++++++ 2 files changed, 216 insertions(+) create mode 100644 testsuite/tests/lib-dynarray/heap_sort.ml diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index d8292f2ca51..798e287896e 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -482,3 +482,121 @@ val reset : 'a t -> unit elements.) *) + + +(** {1:examples Code examples} + +{2:example_min_heap Min-heaps for mutable priority queues} + +We can use dynamic arrays to implement a mutable priority +queue. A priority queue provides a function to add elements, and +a function to extract the minimum element -- according to some +comparison function. + +{[ +(* We present our priority queues as a functor + parametrized on the comparison function. *) +module Heap (Elem : Map.OrderedType) : sig + type t + val create : unit -> t + val add : t -> Elem.t -> unit + val pop_min : t -> Elem.t option +end = struct + + (* Our priority queues are implemented using the standard "min heap" + data structure, a dynamic array representing a binary tree. *) + type t = Elem.t Dynarray.t + let create = Dynarray.create + + (* The node of index [i] has as children the nodes of index [2 * i + 1] + and [2 * i + 2] -- if they are valid indices in the dynarray. *) + let left_child i = 2 * i + 1 + let right_child i = 2 * i + 2 + let parent_node i = (i - 1) / 2 + + (* We use indexing operators for convenient notations. *) + let ( .!() ) = Dynarray.get + let ( .!()<- ) = Dynarray.set + + (* Auxiliary functions to compare and swap two elements + in the dynamic array. *) + let order h i j = + Elem.compare h.!(i) h.!(j) + + let swap h i j = + let v = h.!(i) in + h.!(i) <- h.!(j); + h.!(j) <- v + + (* We say that a heap respects the "heap ordering" if the value of + each node is smaller than the value of its children. The + algorithm manipulates arrays that respect the heap algorithm, + except for one node whose value may be too small or too large. + + The auxiliary functions [heap_up] and [heap_down] take + such a misplaced value, and move it "up" (respectively: "down") + the tree by permuting it with its parent value (respectively: + a children's value) until the heap ordering is restored. *) + + let rec heap_up h i = + if i = 0 then () else + let parent = parent_node i in + if order h i parent < 0 then + (swap h i parent; heap_up h parent) + + and heap_down h ~len i = + let left, right = left_child i, right_child i in + if left >= len then () (* no child, stop *) else + let smallest = + if right >= len then left (* no right child *) else + if order h left right < 0 then left else right + in + if order h i smallest > 0 then + (swap h i smallest; heap_down h ~len smallest) + + let add h s = + let i = Dynarray.length h in + Dynarray.add_last h s; + heap_up h i + + let pop_min h = + if Dynarray.is_empty h then None + else begin + (* Standard trick: swap the 'best' value at index 0 + with the last value of the array. *) + let last = Dynarray.length h - 1 in + swap h 0 last; + (* At this point [pop_last] returns the 'best' value, + and leaves a heap with one misplaced element at position 0. *) + let best = Dynarray.pop_last h in + (* Restore the heap ordering -- does nothing if the heap is empty. *) + heap_down h ~len:last 0; + Some best + end +end +]} + +The production code from which this example was inspired includes +logic to free the backing array when the heap becomes empty, only in +the case where the capacity is above a certain threshold. This can be +done by calling the following function from [pop]: + +{[ +let shrink h = + if Dynarray.length h = 0 && Dynarray.capacity h > 1 lsl 18 then + Dynarray.truncate_capacity h 0 +]} + +The [Heap] functor can be used to implement a sorting function, by +adding all elements into a priority queue and then extracting them in +order. + +{[ +let heap_sort (type a) cmp li = + let module Heap = Heap(struct type t = a let compare = cmp end) in + let heap = Heap.create () in + List.iter (Heap.add heap) li; + List.map (fun _ -> Heap.pop_min heap |> Option.get) li +]} + +*) diff --git a/testsuite/tests/lib-dynarray/heap_sort.ml b/testsuite/tests/lib-dynarray/heap_sort.ml new file mode 100644 index 00000000000..8fb1939b406 --- /dev/null +++ b/testsuite/tests/lib-dynarray/heap_sort.ml @@ -0,0 +1,98 @@ +(* TEST *) + +(* We present our priority queues as a functor + parametrized on the comparison function. *) +module Heap (Elem : Map.OrderedType) : sig + type t + val create : unit -> t + val add : t -> Elem.t -> unit + val pop_min : t -> Elem.t option +end = struct + + (* Our priority queues are implemented using the standard "min heap" + data structure, a dynamic array representing a binary tree. *) + type t = Elem.t Dynarray.t + let create = Dynarray.create + + (* The node of index [i] has as children the nodes of index [2 * i + 1] + and [2 * i + 2] -- if they are valid indices in the dynarray. *) + let left_child i = 2 * i + 1 + let right_child i = 2 * i + 2 + let parent_node i = (i - 1) / 2 + + (* We use indexing operators for convenient notations. *) + let ( .!() ) = Dynarray.get + let ( .!()<- ) = Dynarray.set + + (* Auxiliary functions to compare and swap two elements + in the dynamic array. *) + let order h i j = + Elem.compare h.!(i) h.!(j) + + let swap h i j = + let v = h.!(i) in + h.!(i) <- h.!(j); + h.!(j) <- v + + (* We say that a heap respects the "heap ordering" if the value of + each node is smaller than the value of its children. The + algorithm manipulates arrays that respect the heap algorithm, + except for one node whose value may be too small or too large. + + The auxiliary functions [heap_up] and [heap_down] take + such a misplaced value, and move it "up" (respectively: "down") + the tree by permuting it with its parent value (respectively: + a children's value) until the heap ordering is restored. *) + + let rec heap_up h i = + if i = 0 then () else + let parent = parent_node i in + if order h i parent < 0 then + (swap h i parent; heap_up h parent) + + and heap_down h ~len i = + let left, right = left_child i, right_child i in + if left >= len then () (* no child, stop *) else + let smallest = + if right >= len then left (* no right child *) else + if order h left right < 0 then left else right + in + if order h i smallest > 0 then + (swap h i smallest; heap_down h ~len smallest) + + let add h s = + let i = Dynarray.length h in + Dynarray.add_last h s; + heap_up h i + + let pop_min h = + if Dynarray.is_empty h then None + else begin + (* Standard trick: swap the 'best' value at index 0 + with the last value of the array. *) + let last = Dynarray.length h - 1 in + swap h 0 last; + (* At this point [pop_last] returns the 'best' value, + and leaves a heap with one misplaced element at position 0. *) + let best = Dynarray.pop_last h in + (* Restore the heap ordering -- does nothing if the heap is empty. *) + heap_down h ~len:last 0; + Some best + end +end + +let heap_sort (type a) cmp li = + let module Heap = Heap(struct type t = a let compare = cmp end) in + let heap = Heap.create () in + List.iter (Heap.add heap) li; + List.map (fun _ -> Heap.pop_min heap |> Option.get) li + +let () = + let rev cmp x y = cmp y x in + assert (heap_sort compare [3; 1; 2; 7; 2; 5] = [1; 2; 2; 3; 5; 7]); + assert (heap_sort (rev compare) [3; 1; 2; 7; 2; 5] = [7; 5; 3; 2; 2; 1]); + for i = 1 to 1_000 do + let li = List.init 10 (fun _ -> Random.int 10) in + assert (heap_sort compare li = List.sort compare li); + assert (heap_sort (rev compare) li = List.sort (rev compare) li); + done From 6e06a79b44863d2ac36c766205354a3e1530628b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 10 Mar 2023 10:54:00 +0100 Subject: [PATCH 264/402] dynarray: restructure the testsuite --- testsuite/tests/lib-dynarray/test.ml | 282 ++++++++++++++------ testsuite/tests/lib-dynarray/test.reference | 1 - 2 files changed, 200 insertions(+), 83 deletions(-) delete mode 100644 testsuite/tests/lib-dynarray/test.reference diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index ff7cedb4c38..d8bfe754cf1 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -1,78 +1,79 @@ -(* TEST -*) +(* TEST *) + +let list_range start len : _ list = + Seq.ints start |> Seq.take len |> List.of_seq module A = Dynarray +(** {1:dynarrays Dynamic arrays} *) + +(** create, add_last *) + let () = let a = A.create() in A.add_last a 1; A.add_last a 2; + assert (A.length a = 2); assert (A.to_list a = [1;2]);; -let () = - let a = A.create() in - A.add_last a 1; - A.add_last a 2; - A.add_last a 3; - assert (A.length a = 3);; + +(** make *) let () = - let a = A.make 1 5 in + let a = A.make 3 5 in A.add_last a 6; - assert (A.to_list a = [5;6]);; + assert (A.to_list a = [5; 5; 5; 6]);; + + +(** init *) let () = - List.iter - (fun l -> - let a = A.of_list l in - assert (A.to_list a = l)) - [ - []; - [1]; - [1;2]; - [1;2;3]; - [1;2;3;4]; - [1;2;3;4;5;6;7;8;9;10]; - ] -;; + let test_init n f = + assert (A.init n f |> A.to_array = Array.init n f) in + for i = 0 to 1024 do + test_init i Fun.id + done;; + + +(** is_empty *) let () = - let a = A.create() in - A.add_last a 0.; A.add_last a 1.; - A.clear a; - A.add_last a 0.; A.add_last a 1.; A.add_last a 7.; A.add_last a 10.; A.add_last a 12.; - A.truncate a 2; - assert (1. = A.fold_left (+.) 0. a); - A.clear a; - assert (0 = A.length a); - A.add_last a 0.; A.add_last a 1.; A.add_last a 7.; A.add_last a 10.; A.add_last a 12.; - assert (1. +. 7. +. 10. +. 12. = A.fold_left (+.) 0. a);; + let a = A.create () in + assert (A.is_empty a); + A.ensure_capacity a 256; + assert (A.is_empty a);; + + +(** length is tested below *) + +(** copy, add_last *) let () = - let seq = Seq.(ints 0 |> take 10_000) in - let a = A.of_seq seq in - assert (Some 9999 = A.pop_last_opt a); - assert (Some 9998 = A.pop_last_opt a); - assert (Some 9997 = A.pop_last_opt a); - assert (9997 = A.length a); - ();; + assert (A.of_list [1;2;3] |> A.copy |> A.to_list = [1;2;3]);; let () = - let a = A.of_list [1;2] in - assert (Some 2 = A.pop_last_opt a); - assert (Some 1 = A.pop_last_opt a); - assert (None = A.pop_last_opt a); - assert (None = A.pop_last_opt a); - ();; + let a = A.create() in + for i=0 to 20 do A.add_last a i; done; + assert (A.to_list (A.copy a) = list_range 0 21);; let () = - let a = A.of_list [1;2;3] in - A.add_last a 4; - assert (A.to_list a = [1;2;3;4]);; + assert (A.create() |> A.copy |> A.is_empty);; -let list_range start len : _ list = - Seq.ints start |> Seq.take len |> List.of_seq -;; +let () = + let a = A.of_list [1; 2; 3] in + let b = A.copy a in + for i = 4 to 1024 do + A.add_last b i + done; + assert (A.fold_left (+) 0 a = (1 + 2 + 3)); + assert (A.fold_left (+) 0 b = (1024 * 1025) / 2);; + + +(** {1:adding Adding elements} *) + +(** add_last was tested above *) + +(** append *) let () = let a1 = A.init 5 (fun i->i) @@ -115,64 +116,139 @@ let() = A.append empty empty; assert (A.to_list empty = []);; -let () = - assert (A.of_list [1;2;3] |> A.copy |> A.to_list = [1;2;3]);; + +(** dynarrays with floats *) let () = let a = A.create() in - for i=0 to 20 do A.add_last a i; done; - assert (A.to_list (A.copy a) = list_range 0 21);; + A.add_last a 0.; A.add_last a 1.; + assert (0. = A.get a 0); + assert (1. = A.get a 1); + assert (1. = A.fold_left (+.) 0. a); + A.clear a; + A.add_last a 0.; A.add_last a 1.; A.add_last a 7.; A.add_last a 10.; A.add_last a 12.; + A.truncate a 2; + assert (1. = A.fold_left (+.) 0. a); + A.clear a; + assert (0 = A.length a); + A.add_last a 0.; A.add_last a 1.; A.add_last a 7.; A.add_last a 10.; A.add_last a 12.; + A.set a 2 8.; + assert (0. +. 1. +. 8. +. 10. +. 12. = A.fold_left (+.) 0. a);; + + +(** {1:removing Removing elements} *) + + +(** pop_last_opt, length *) let () = - assert (A.create() |> A.copy |> A.is_empty);; + let seq = Seq.(ints 0 |> take 10_000) in + let a = A.of_seq seq in + assert (Some 9999 = A.pop_last_opt a); + assert (Some 9998 = A.pop_last_opt a); + assert (Some 9997 = A.pop_last_opt a); + assert (9997 = A.length a); + ();; + +let () = + let a = A.of_list [1;2] in + assert (Some 2 = A.pop_last_opt a); + assert (Some 1 = A.pop_last_opt a); + assert (None = A.pop_last_opt a); + assert (None = A.pop_last_opt a); + ();; +(** truncate *) + let () = let a = A.create() in - for i=0 to 20_000 do A.add_last a i; done; + let max_length = 20_000 in + for i = 0 to max_length - 1 do A.add_last a i; done; List.iter (fun size -> A.truncate a size; - assert (A.to_list a = list_range 0 size)) - [ 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; + let result_size = min max_length size in + assert (A.to_list a = list_range 0 result_size)) + [ 30_000; 20_000; 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; -let () = - let a = A.create() in - for i=0 to 20_000 do A.add_last a i; done; - List.iter - (fun size -> - A.truncate_capacity a size; - assert (A.to_list a = list_range 0 size)) - [ 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; -let () = - let a = A.create() in - for i = 0 to 200 do - A.add_last a i; - done; - A.fit_capacity a; - assert (A.length a = 201);; + +(** {1:iteration Iteration} *) + +(** map *) let () = let a = A.of_list [1;2;3] in assert (A.to_list @@ A.map string_of_int a = ["1"; "2"; "3"]);; + +(** mapi *) + let () = let a = A.of_list [1;2;3] in let a = A.mapi (fun i e -> Printf.sprintf "%i %i" i e) a in assert (A.to_list a = ["0 1"; "1 2"; "2 3"]);; + +(** Iterator invalidation *) + +let raises_invalid_argument f = + match f () with + | exception Invalid_argument _ -> true + | exception _ | _ -> false + let () = - let a = A.of_list [1;2;3;4;5] in - assert (A.fold_left (+) 0 a = 15);; + let a = A.of_list [1; 2; 3] in + assert (raises_invalid_argument (fun () -> + A.append a a + )) let () = - let l = list_range 0 300_000 in - let a = A.of_list l in - assert (A.to_list a = l);; + let a = A.of_list [1; 2; 3] in + assert (raises_invalid_argument (fun () -> + a |> A.iter (fun i -> + A.add_last a (10 + i) + ) + )) +let () = + let a = A.of_list [1; 2; 3] in + assert (raises_invalid_argument (fun () -> + a |> A.iter (fun i -> + if i >= 2 then A.remove_last a + ) + )) + +let does_not_raise_invalid_argument f = + not (raises_invalid_argument f) + +(* The spec says that this is a programming error, but currently we accept + the following without an error. *) +let () = + let a = A.of_list [1; 2; 3] in + A.ensure_capacity a 10; + assert (does_not_raise_invalid_argument (fun () -> + a |> A.iter (fun i -> + A.add_last a i; + A.remove_last a + ) + )) + +(* Even with a capacity increase in the middle, + we still accept this although the spec would let us reject. *) +let () = + let a = A.of_list [1; 2; 3] in + A.fit_capacity a; + assert (does_not_raise_invalid_argument (fun () -> + a |> A.iter (fun i -> + A.add_last a i; + A.remove_last a + ) + )) + +(** Iterator invalidation *) -(* Iterator invalidation *) let raises_invalid_argument f = match f () with | exception Invalid_argument _ -> true @@ -227,4 +303,46 @@ let () = ) )) -let () = print_endline "OK";; + +(** {1:conversions Conversions to other data structures} *) + +(** {of,to}_{list,array,seq} *) + +let () = + for i = 0 to 1024 do + let ints = List.init i Fun.id in + assert ((ints |> A.of_list |> A.to_list) = ints); + let arr = Array.of_list ints in + assert ((arr |> A.of_array |> A.to_array) = arr); + let seq = Array.to_seq arr in + assert ((seq |> A.of_seq |> A.to_seq) |> Array.of_seq = arr); + done;; +;; + + +(** {1:advanced Advanced topics for performance} *) + +(** truncate_capacity *) + +let () = + let a = A.create() in + let max_length = 20_000 in + for i = 0 to max_length - 1 do A.add_last a i; done; + List.iter + (fun size -> + A.truncate_capacity a size; + let result_size = min max_length size in + assert (A.to_list a = list_range 0 result_size)) + [ 30_000; 20_000; 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; + + +(** fit_capacity, capacity *) + +let () = + let a = A.create() in + for i = 0 to 200 do + A.add_last a i; + done; + A.fit_capacity a; + assert (A.length a = 201); + assert (A.length a = A.capacity a); diff --git a/testsuite/tests/lib-dynarray/test.reference b/testsuite/tests/lib-dynarray/test.reference deleted file mode 100644 index d86bac9de59..00000000000 --- a/testsuite/tests/lib-dynarray/test.reference +++ /dev/null @@ -1 +0,0 @@ -OK From 6a5e0e5d98c90ad792167d0a24d8647bd5db7878 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 16 May 2023 08:38:16 +0200 Subject: [PATCH 265/402] dynarray.mli: specify more exceptions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reviewed-by: Clément Allain --- stdlib/dynarray.mli | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 798e287896e..16b4c2ad792 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -76,7 +76,10 @@ val create : unit -> 'a t (** [create ()] is a new, empty array. *) val make : int -> 'a -> 'a t -(** [make n x] is a new array of length [n], filled with [x]. *) +(** [make n x] is a new array of length [n], filled with [x]. + + @raise Invalid_argument if [n < 0]. +*) val init : int -> (int -> 'a) -> 'a t (** [init n f] is a new array [a] of length [n], @@ -85,7 +88,10 @@ val init : int -> (int -> 'a) -> 'a t then [f 2]... and [f (n - 1)] last, evaluated in that order. - This is similar to {!Array.init}. *) + This is similar to {!Array.init}. + + @raise Invalid_argument if [n < 0]. +*) val get : 'a t -> int -> 'a (** [get a i] is the [i]-th element of [a], starting with index [0]. @@ -177,9 +183,6 @@ val remove_last : 'a t -> unit (** [remove_last a] removes the last element of [a], if any. It does nothing if [a] is empty. *) -val clear : 'a t -> unit -(** [clear a] is [truncate a 0], it removes all the elements of [a]. *) - val truncate : 'a t -> int -> unit (** [truncate a n] truncates [a] to have at most [n] elements. @@ -188,12 +191,17 @@ val truncate : 'a t -> int -> unit [truncate a n] is equivalent to: {[ + if n < 0 then invalid_argument "..."; while length a > n do remove_last a done ]} + + @raise Invalid_argument if [n < 0]. *) +val clear : 'a t -> unit +(** [clear a] is [truncate a 0], it removes all the elements of [a]. *) (** {1:iteration Iteration} @@ -439,6 +447,8 @@ val truncate_capacity : 'a t -> int -> unit complexity guarantees provided by the reallocation strategy. Calling it repeatedly on an array may have quadratic complexity, both in time and in total number of allocations. + + @raise Invalid_argument if [n < 0]. *) val reset : 'a t -> unit From f9c10928955150f9e7685b7e0b23cbe1432fce6c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 17 May 2023 09:02:56 +0200 Subject: [PATCH 266/402] =?UTF-8?q?integrate=20review=20comments=20from=20?= =?UTF-8?q?Cl=C3=A9ment=20Allain?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- stdlib/dynarray.ml | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index c5936c43817..3e882e29ec4 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -320,14 +320,14 @@ let next_capacity n = let ensure_capacity a capacity_request = let arr = a.arr in let cur_capacity = Array.length arr in - if cur_capacity >= capacity_request then + if capacity_request < 0 then + Error.negative_capacity "ensure_capacity" capacity_request + else if cur_capacity >= capacity_request then (* This is the fast path, the code up to here must do as little as possible. (This is why we don't use [let {arr; length} = a] as usual, the length is not needed in the fast path.)*) () else begin - if capacity_request < 0 then - Error.negative_capacity "ensure_capacity" capacity_request; if capacity_request > Sys.max_array_length then Error.requested_length_out_of_bounds "ensure_capacity" capacity_request; let new_capacity = @@ -349,6 +349,7 @@ let ensure_capacity a capacity_request = let new_arr = Array.make new_capacity Empty in Array.blit arr 0 new_arr 0 a.length; a.arr <- new_arr; + (* postcondition: *) assert (0 <= capacity_request); assert (capacity_request <= Array.length new_arr); end @@ -366,12 +367,13 @@ let truncate_capacity a n = else if n < 0 then Error.negative_capacity "truncate_capacity" n else begin - a.length <- n; + a.length <- min a.length n; a.arr <- Array.sub a.arr 0 n; end let reset a = - truncate_capacity a 0 + a.length <- 0; + a.arr <- [||] (** {1:adding Adding elements} *) @@ -381,7 +383,7 @@ let reset a = allocation, we add the element at the new end of the dynamic array. (We do not give the same guarantees in presence of concurrent - updates, which are much more expansive to protect against.) + updates, which are much more expensive to protect against.) *) (* [add_last_if_room a elem] only writes the slot if there is room, and @@ -392,17 +394,20 @@ let reset a = by any other code during execution of this function. *) let[@inline] add_last_if_room a elem = - (* BEGIN ATOMIC *) + (* BEGIN ATOMIC: the code in this section + does not contain any poll point (backedge, + allocation or function call) in native code, + as can be checked when reading the -dcmm output. *) let {arr; length} = a in (* we know [0 <= length] *) if length >= Array.length arr then false else begin (* we know [0 <= length < Array.length arr] *) - Array.unsafe_set arr length elem; a.length <- length + 1; + Array.unsafe_set arr length elem; + (* END ATOMIC *) true end - (* END ATOMIC *) let add_last a x = let elem = Elem {v = x} in @@ -436,7 +441,12 @@ let append_array_if_room a b = if length_a + length_b > Array.length arr then false else begin a.length <- length_a + length_b; - (* END ATOMIC *) + (* END ATOMIC + + Notice that, unlike for [add_last], the atomic section here + lasts until the length is extended, but stops before the + elements are added, so one could observe missing elements if + the code yields. *) (* Note: we intentionally update the length *before* filling the elements. This "reserve before fill" approach provides better behavior than "fill then notify" in presence of reentrant From ce14a79d041f608f6fdfee65eba28a6258533570 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 30 May 2023 17:57:35 +0200 Subject: [PATCH 267/402] Changes --- Changes | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Changes b/Changes index aa7c869ed2b..4c0ea56cb32 100644 --- a/Changes +++ b/Changes @@ -156,6 +156,13 @@ Working version ### Standard library: +- #11563: Add the Dynarray module to the stdlib. Dynamic arrays are + arrays whose length can be changed by adding or removing elements at + the end, similar to 'vectors' in C++ or Rust. + (Gabriel Scherer, Simon Cruanes and Florian Angeletti, review by + Daniel Bünzli, Guillaume Munch-Maccagnoni, Clément Allain, + Damien Doligez, Wiktor Kuchta and Pieter Goetschalckx) + * #10775, #12499: Half-precision floating-point elements in Bigarray. (Anton Yabchinskiy, review by Xavier Leroy and Nicolás Ojeda Bär) From 2e1f3e4bdaf007238dfba86570c5560a29d34854 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 5 Jun 2023 17:19:15 +0200 Subject: [PATCH 268/402] acting on the review by Damien Doligez --- stdlib/dynarray.ml | 28 ++++++++------ stdlib/dynarray.mli | 14 +++---- testsuite/tests/lib-dynarray/test.ml | 56 ---------------------------- 3 files changed, 24 insertions(+), 74 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 3e882e29ec4..e2092181969 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -117,8 +117,8 @@ module Error = struct let index_out_of_bounds f ~i ~length = if length = 0 then Printf.ksprintf invalid_arg - "Dynarray.%s: empty dynarray" - f + "Dynarray.%s: index %d out of bounds (empty dynarray)" + f i else Printf.ksprintf invalid_arg "Dynarray.%s: index %d out of bounds (0..%d)" @@ -221,7 +221,7 @@ let init n f = } let get a i = - (* This implementation will propagate an [Invalid_arg] exception + (* This implementation will propagate an [Invalid_argument] exception from array lookup if the index is out of the backing array, instead of using our own [Error.index_out_of_bounds]. This is allowed by our specification, and more efficient -- no need to @@ -378,12 +378,14 @@ let reset a = (** {1:adding Adding elements} *) (* We chose an implementation of [add_last a x] that behaves correctly - in presence of aynchronous code execution around allocations and - poll points: if another thread or a callback gets executed on - allocation, we add the element at the new end of the dynamic array. + in presence of aynchronous / re-entrant code execution around + allocations and poll points: if another thread or a callback gets + executed on allocation, we add the element at the new end of the + dynamic array. (We do not give the same guarantees in presence of concurrent - updates, which are much more expensive to protect against.) + parallel updates, which are much more expensive to protect + against.) *) (* [add_last_if_room a elem] only writes the slot if there is room, and @@ -568,9 +570,9 @@ let iter_ f k a = the loop (before or after, or both). However, notice that this is not necessary to detect the removal of elements from [a]: if elements have been removed by the time the [for] loop reaches - them, then [unsafe_get] will itself fail with an [Invalid_arg] + them, then [unsafe_get] will itself fail with an [Invalid_argument] exception. We only need to detect the addition of new elements to - [a] during iteration, and for this it suffics to call + [a] during iteration, and for this it is enough to call [check_same_length] once at the end. Calling [check_same_length] more often could catch more @@ -720,7 +722,8 @@ let to_seq a = let rec aux i () = if i >= length a then Seq.Nil else begin - Seq.Cons (get a i, aux (i + 1)) + let v = get a i in + Seq.Cons (v, aux (i + 1)) end in aux 0 @@ -732,6 +735,9 @@ let to_seq_rev a = (* If some elements have been removed in the meantime, we skip those elements and continue with the new end of the array. *) aux (length a - 1) () - else Seq.Cons (get a i, aux (i - 1)) + else begin + let v = get a i in + Seq.Cons (v, aux (i - 1)) + end in aux (length a - 1) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 16b4c2ad792..c0ff4f63c67 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -43,12 +43,12 @@ of dynamic arrays differs from the one of {!Array}s. See the {{!section:memory_layout} Memory Layout} section for more information. - @since 5.1 + @since 5.2 *) (** {b Unsynchronized accesses} *) -[@@@alert unsynchronized_accesses +[@@@alert unsynchronized_access "Unsynchronized accesses to dynamic arrays are a programming error." ] @@ -106,7 +106,7 @@ val set : 'a t -> int -> 'a -> unit @raise Invalid_argument if the index is invalid. *) -val length : _ t -> int +val length : 'a t -> int (** [length a] is the number of elements in the array. *) val is_empty : 'a t -> bool @@ -132,7 +132,7 @@ val append_array : 'a t -> 'a array -> unit For example: {[ let a = Dynarray.of_list [1;2] - let () = Dynarray.append a [|3; 4|] + let () = Dynarray.append_array a [|3; 4|] let () = assert (Dynarray.to_list a = [1; 2; 3; 4]) ]} *) @@ -388,7 +388,7 @@ val ensure_capacity : 'a t -> int -> unit @raise Invalid_argument if the requested capacity is outside the range [0 .. Sys.max_array_length]. - A use case would be to implement {!of_array} (without using {!init} directly): + An example would be to reimplement {!of_array} without using {!init}: {[ let of_array arr = let a = Dynarray.create () in @@ -546,7 +546,7 @@ end = struct The auxiliary functions [heap_up] and [heap_down] take such a misplaced value, and move it "up" (respectively: "down") the tree by permuting it with its parent value (respectively: - a children's value) until the heap ordering is restored. *) + a child value) until the heap ordering is restored. *) let rec heap_up h i = if i = 0 then () else @@ -594,7 +594,7 @@ done by calling the following function from [pop]: {[ let shrink h = if Dynarray.length h = 0 && Dynarray.capacity h > 1 lsl 18 then - Dynarray.truncate_capacity h 0 + Dynarray.reset h ]} The [Heap] functor can be used to implement a sorting function, by diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index d8bfe754cf1..ba6513eef46 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -193,62 +193,6 @@ let () = (** Iterator invalidation *) -let raises_invalid_argument f = - match f () with - | exception Invalid_argument _ -> true - | exception _ | _ -> false - -let () = - let a = A.of_list [1; 2; 3] in - assert (raises_invalid_argument (fun () -> - A.append a a - )) - -let () = - let a = A.of_list [1; 2; 3] in - assert (raises_invalid_argument (fun () -> - a |> A.iter (fun i -> - A.add_last a (10 + i) - ) - )) - -let () = - let a = A.of_list [1; 2; 3] in - assert (raises_invalid_argument (fun () -> - a |> A.iter (fun i -> - if i >= 2 then A.remove_last a - ) - )) - -let does_not_raise_invalid_argument f = - not (raises_invalid_argument f) - -(* The spec says that this is a programming error, but currently we accept - the following without an error. *) -let () = - let a = A.of_list [1; 2; 3] in - A.ensure_capacity a 10; - assert (does_not_raise_invalid_argument (fun () -> - a |> A.iter (fun i -> - A.add_last a i; - A.remove_last a - ) - )) - -(* Even with a capacity increase in the middle, - we still accept this although the spec would let us reject. *) -let () = - let a = A.of_list [1; 2; 3] in - A.fit_capacity a; - assert (does_not_raise_invalid_argument (fun () -> - a |> A.iter (fun i -> - A.add_last a i; - A.remove_last a - ) - )) - -(** Iterator invalidation *) - let raises_invalid_argument f = match f () with | exception Invalid_argument _ -> true From dc68213c89acf69ed0c4255010dd70310c49ec98 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 6 Jun 2023 10:02:16 +0200 Subject: [PATCH 269/402] Dynarray.fold_right --- stdlib/dynarray.ml | 25 +++++++++++++++++-------- stdlib/dynarray.mli | 6 ++++++ testsuite/tests/lib-dynarray/test.ml | 3 +++ 3 files changed, 26 insertions(+), 8 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index e2092181969..c7a9bde3d09 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -624,15 +624,24 @@ let mapi f a = let fold_left f acc a = let {arr; length} = a in check_valid_length length arr; - let rec fold acc arr i length = - if i = length then acc - else - let v = unsafe_get arr ~i ~length in - fold (f acc v) arr (i+1) length - in - let res = fold acc arr 0 length in + let r = ref acc in + for i = 0 to length - 1 do + let v = unsafe_get arr ~i ~length in + r := f !r v; + done; check_same_length "fold_left" a ~length; - res + !r + +let fold_right f a acc = + let {arr; length} = a in + check_valid_length length arr; + let r = ref acc in + for i = length - 1 downto 0 do + let v = unsafe_get arr ~i ~length in + r := f v !r; + done; + check_same_length "fold_right" a ~length; + !r let exists p a = let {arr; length} = a in diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index c0ff4f63c67..233e391cfd9 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -250,6 +250,12 @@ val fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc ]} *) +val fold_right : ('a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc +(** [fold_right f a acc] computes + [f x0 (f x1 (... (f xn acc) ...))] + where [x0, x1, ..., xn] are the elements of [a]. +*) + val exists : ('a -> bool) -> 'a t -> bool (** [exists f a] is [true] if some element of [a] satisfies [f]. diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index ba6513eef46..bd54c64de29 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -68,6 +68,9 @@ let () = assert (A.fold_left (+) 0 a = (1 + 2 + 3)); assert (A.fold_left (+) 0 b = (1024 * 1025) / 2);; +let () = + let a = A.of_list [1; 2; 3] in + assert (A.fold_right List.cons a [] = [1; 2; 3]);; (** {1:adding Adding elements} *) From 42388efe93d5acfbe4628d8a6ecf18bb83644f00 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 24 Jul 2023 10:39:58 +0200 Subject: [PATCH 270/402] acting on the review by Wiktor Kuchta --- stdlib/dynarray.ml | 8 +++---- stdlib/dynarray.mli | 58 ++++++++++++++++++++++++--------------------- 2 files changed, 35 insertions(+), 31 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index c7a9bde3d09..cf0e36fec02 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -107,7 +107,7 @@ and 'a slot = forall i, [0 <= i < length] implies [arr.(i) = Empty] Unfortunately, we cannot easily enforce validity as an invariant in - presence of concurrent udpates. We can thus observe dynarrays in + presence of concurrent updates. We can thus observe dynarrays in "invalid states". Our implementation may raise exceptions or return incorrect results on observing invalid states, but of course it must preserve memory safety. @@ -155,9 +155,9 @@ module Error = struct "Dynarray: invalid array (length %d > capacity %d)" length capacity - let iterator_invalidation f ~expected ~observed = + let length_change_during_iteration f ~expected ~observed = Printf.ksprintf invalid_arg - "Dynarray.%s: iterator invalidated by a length change from %d to %d" + "Dynarray.%s: a length change from %d to %d occurred during iteration" f expected observed (* When an [Empty] element is observed unexpectedly at index [i], @@ -177,7 +177,7 @@ end let check_same_length f a ~length = let length_a = a.length in if length <> length_a then - Error.iterator_invalidation f + Error.length_change_during_iteration f ~expected:length ~observed:length_a (** Careful unsafe access. *) diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 233e391cfd9..8778f393396 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -18,7 +18,7 @@ (** Dynamic arrays. The {!Array} module provide arrays of fixed length. {!Dynarray} - provides array whose length can change over time, by adding or + provides arrays whose length can change over time, by adding or removing elements at the end of the array. This is typically used to accumulate elements whose number is not @@ -131,9 +131,9 @@ val append_array : 'a t -> 'a array -> unit For example: {[ - let a = Dynarray.of_list [1;2] - let () = Dynarray.append_array a [|3; 4|] - let () = assert (Dynarray.to_list a = [1; 2; 3; 4]) + let a = Dynarray.of_list [1;2] in + Dynarray.append_array a [|3; 4|]; + assert (Dynarray.to_list a = [1; 2; 3; 4]) ]} *) @@ -142,18 +142,22 @@ val append_list : 'a t -> 'a list -> unit val append : 'a t -> 'a t -> unit (** [append a b] is like [append_array a b], - but [b] is itself a dynamic arreay instead of a fixed-size array. + but [b] is itself a dynamic array instead of a fixed-size array. - Beware! Calling [append a a] iterates on [a] and adds elements to - it at the same time; it is a programming error and fails with + Warning: [append a a] is a programming error because it iterates + on [a] and adds elements to it at the same time -- see the + {{!sec:iteration} Iteration} section below. It fails with [Invalid_argument]. *) val append_seq : 'a t -> 'a Seq.t -> unit (** Like {!append_array} but with a sequence. - Beware! Calling [append_seq a (to_seq a)] is unspecified and may - result in an infinite loop, see the {!append} comment above. + Warning: [append_seq a (to_seq a)] simultaneously traverses [a] + and adds element to it; the ordering of those operations is + unspecified, and may result in an infinite loop -- the new + elements may in turn be produced by [to_seq a] and get added again + and again. *) val append_iter : @@ -209,7 +213,7 @@ val clear : 'a t -> unit Traversals of [a] are computed in increasing index order: from the element of index [0] to the element of index [length a - 1]. - It is a programming error to modify the length of an array + It is a programming error to change the length of an array (by adding or removing elements) during an iteration on the array. Any iteration function will fail with [Invalid_argument] if it detects such a length change. @@ -225,23 +229,23 @@ val map : ('a -> 'b) -> 'a t -> 'b t (** [map f a] is a new array of elements of the form [f x] for each element [x] of [a]. - For example, if the elements of [a] are [x0, x1, x2], - then the elements of [b] are [f x0, f x1, f x2]. + For example, if the elements of [a] are [x0], [x1], [x2], + then the elements of [b] are [f x0], [f x1], [f x2]. *) val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t (** [mapi f a] is a new array of elements of the form [f i x] for each element [x] of [a] at index [i]. - For example, if the elements of [a] are [x0, x1, x2], - then the elements of [b] are [f 0 x0, f 1 x1, f 2 x2]. + For example, if the elements of [a] are [x0], [x1], [x2], + then the elements of [b] are [f 0 x0], [f 1 x1], [f 2 x2]. *) val fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc (** [fold_left f acc a] folds [f] over [a] in order, starting with accumulator [acc]. - For example, if the elements of [a] are [x0, x1], + For example, if the elements of [a] are [x0], [x1], then [fold f acc a] is {[ let acc = f acc x0 in @@ -253,13 +257,13 @@ val fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc val fold_right : ('a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc (** [fold_right f a acc] computes [f x0 (f x1 (... (f xn acc) ...))] - where [x0, x1, ..., xn] are the elements of [a]. + where [x0], [x1], ..., [xn] are the elements of [a]. *) val exists : ('a -> bool) -> 'a t -> bool (** [exists f a] is [true] if some element of [a] satisfies [f]. - For example, if the elements of [a] are [x0, x1, x2], then + For example, if the elements of [a] are [x0], [x1], [x2], then [exists f a] is [f x0 || f x1 || f x2]. *) @@ -267,7 +271,7 @@ val for_all : ('a -> bool) -> 'a t -> bool (** [for_all f a] is [true] if all elements of [a] satisfy [f]. This includes the case where [a] is empty. - For example, if the elements of [a] are [x0, x1], then + For example, if the elements of [a] are [x0], [x1], then [exists f a] is [f x0 && f x1 && f x2]. *) @@ -336,7 +340,7 @@ val to_seq : 'a t -> 'a Seq.t [get a 0], [get a 1]... [get a (length a - 1)]. Because sequences are computed on-demand, we have to assume that - the array may be modified in the meantime, and give a precise + the array may be modified in the meantime. We give a precise specification for this case below. Demanding the [i]-th element of the resulting sequence (which can @@ -423,15 +427,15 @@ val ensure_extra_capacity : 'a t -> int -> unit *) val fit_capacity : 'a t -> unit -(** [fit_capacity a] shrinks the backing array so that its capacity is - exactly [length a], with no additional empty space at the - end. This can be useful to make sure there is no memory wasted on - a long-lived array. +(** [fit_capacity a] reallocates a backing array if necessary, so that + the resulting capacity is exactly [length a], with no additional + empty space at the end. This can be useful to make sure there is + no memory wasted on a long-lived array. Note that calling [fit_capacity] breaks the amortized complexity guarantees provided by the default reallocation strategy. Calling it repeatedly on an array may have quadratic complexity, both in - time and in total number of allocations. + time and in total number of words allocated. If you know that a dynamic array has reached its final length, which will remain fixed in the future, it is sufficient to call @@ -479,19 +483,19 @@ val reset : 'a t -> unit Each element is in a "box", allocated when the element is first added to the array -- see the implementation for more details. - Using a ['a array] would be delicate, as there is no obvious + Using an ['a array] would be delicate, as there is no obvious type-correct way to represent the empty space at the end of the backing array -- using user-provided values would either complicate the API or violate the {{!section:noleaks}no leaks} guarantee. The constraint of remaining memory-safe under unsynchronized concurrent usage makes it even more difficult. Various unsafe ways to do this have been discussed, - with no consensus for a standard implementation so far. + with no consensus on a standard implementation so far. On a realistic automated-theorem-proving program that relies heavily on dynamic arrays, we measured the overhead of this extra "boxing" as at most 25%. We believe that the overhead for most - uses of dynarray is much smaller, neglectible in many cases, but + uses of dynarray is much smaller, negligible in many cases, but you may still prefer to use your own specialized implementation for performance. (If you know that you do not need the {{:noleaks}no leaks} guarantee, you can also speed up deleting From 96f4c8894bf13533a880e4727543d7650aa28874 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 24 Jul 2023 10:55:00 +0200 Subject: [PATCH 271/402] truncate_capacity => set_capacity MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Suggested-by: Daniel Bünzli Suggested-by: Damien Doligez --- stdlib/dynarray.ml | 18 ++++++++++++------ stdlib/dynarray.mli | 18 +++++++++--------- testsuite/tests/lib-dynarray/test.ml | 4 ++-- 3 files changed, 23 insertions(+), 17 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index cf0e36fec02..d83d3a7af0c 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -362,13 +362,19 @@ let fit_capacity a = then () else a.arr <- Array.sub a.arr 0 a.length -let truncate_capacity a n = - if n >= capacity a then () - else if n < 0 then - Error.negative_capacity "truncate_capacity" n - else begin +let set_capacity a n = + if n < 0 then + Error.negative_capacity "set_capacity" n; + let arr = a.arr in + let cur_capacity = Array.length arr in + if n < cur_capacity then begin a.length <- min a.length n; - a.arr <- Array.sub a.arr 0 n; + a.arr <- Array.sub arr 0 n; + end + else if n > cur_capacity then begin + let new_arr = Array.make n Empty in + Array.blit arr 0 new_arr 0 a.length; + a.arr <- new_arr; end let reset a = diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 8778f393396..2f1b72e48dc 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -444,19 +444,19 @@ val fit_capacity : 'a t -> unit array for eventual future resizes. *) -val truncate_capacity : 'a t -> int -> unit -(** [truncate_capacity a n] shrinks the backing array to have - capacity at most [n]; in particular, like [truncate a n], +val set_capacity : 'a t -> int -> unit +(** [set_capacity a n] reallocates a backing array if necessary, + so that the resulting capacity is exactly [n]. In particular, all elements of index [n] or greater are removed. - This is equivalent to [truncate a n; fit_capacity a] but more - efficient: [truncate a n] needs to overwrite the removed elements - to preserve the {{!section:noleaks} no leaks} guarantee. - Like {!fit_capacity}, this function breaks the amortized complexity guarantees provided by the reallocation strategy. Calling it repeatedly on an array may have quadratic - complexity, both in time and in total number of allocations. + complexity, both in time and in total number of words allocated. + + This is an advanced function; in particular, {!ensure_capacity} + should be preferred to increase the capacity, as it preserves + those amortized guarantees. @raise Invalid_argument if [n < 0]. *) @@ -464,7 +464,7 @@ val truncate_capacity : 'a t -> int -> unit val reset : 'a t -> unit (** [reset a] clears [a] and replaces its backing array by an empty array. - It is equivalent to [clear a; fit_capacity a]. + It is equivalent to [set_capacity a 0] or [clear a; fit_capacity a]. *) (** {2:noleaks No leaks: preservation of memory liveness} diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index bd54c64de29..bbc4ded15b3 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -269,7 +269,7 @@ let () = (** {1:advanced Advanced topics for performance} *) -(** truncate_capacity *) +(** set_capacity *) let () = let a = A.create() in @@ -277,7 +277,7 @@ let () = for i = 0 to max_length - 1 do A.add_last a i; done; List.iter (fun size -> - A.truncate_capacity a size; + A.set_capacity a size; let result_size = min max_length size in assert (A.to_list a = list_range 0 result_size)) [ 30_000; 20_000; 19_999; 2000; 100; 50; 4; 4; 3; 2; 1; 0];; From 000315084066f56ab1aaff3e3b1578484c1ba713 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 29 Jul 2023 14:53:04 +0200 Subject: [PATCH 272/402] acting on the review by Pieter Goetschalckx --- stdlib/dynarray.ml | 35 +++++++++++++++++++---------------- stdlib/dynarray.mli | 23 +++++++++++++---------- 2 files changed, 32 insertions(+), 26 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index d83d3a7af0c..78ee218df43 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -29,7 +29,7 @@ type 'a t = { - capacity: the length of the backing array: [Array.length arr] - live space: the portion of the backing array with - indices from [0] to [length] excluded. + indices from [0] to [length - 1] included. - empty space: the portion of the backing array from [length] to the end of the backing array. @@ -91,7 +91,7 @@ and 'a slot = There are some situations where ['a option] is better: it makes [pop_last_opt] more efficient as the underlying option can be returned directly, and it also lets us use [Array.blit] to - implement [append]. We believe that optimzing [get] and [set] is + implement [append]. We believe that optimizing [get] and [set] is more important for dynamic arrays. {2 Invariants and valid states} @@ -102,9 +102,9 @@ and 'a slot = The following conditions define what we call a "valid" dynarray: - valid length: [length <= Array.length arr] - no missing element in the live space: - forall i, [0 <= i <=length] implies [arr.(i) <> Empty] + forall i, [0 <= i < length] implies [arr.(i) <> Empty] - no element in the empty space: - forall i, [0 <= i < length] implies [arr.(i) = Empty] + forall i, [length <= i < Array.length arr] implies [arr.(i) = Empty] Unfortunately, we cannot easily enforce validity as an invariant in presence of concurrent updates. We can thus observe dynarrays in @@ -243,14 +243,17 @@ let length a = a.length let is_empty a = (a.length = 0) -let copy {length; arr} = { - length; - arr = - Array.map (function - | Empty -> Empty - | Elem {v} -> Elem {v} - ) arr; -} +let copy {length; arr} = + check_valid_length length arr; + (* use [length] as the new capacity to make + this an O(length) operation. *) + { + length; + arr = Array.init length (fun i -> + let v = unsafe_get arr ~i ~length in + Elem {v} + ); + } (** {1:removing Removing elements} *) @@ -384,7 +387,7 @@ let reset a = (** {1:adding Adding elements} *) (* We chose an implementation of [add_last a x] that behaves correctly - in presence of aynchronous / re-entrant code execution around + in presence of asynchronous / re-entrant code execution around allocations and poll points: if another thread or a callback gets executed on allocation, we add the element at the new end of the dynamic array. @@ -397,7 +400,7 @@ let reset a = (* [add_last_if_room a elem] only writes the slot if there is room, and returns [false] otherwise. - It is sequentially atomic -- in absence of unsychronized concurrent + It is sequentially atomic -- in absence of unsynchronized concurrent uses, the fields of [a.arr] and [a.length] will not be mutated by any other code during execution of this function. *) @@ -438,7 +441,7 @@ let append_iter a iter b = iter (fun x -> add_last a x) b let append_seq a seq = - Seq.iter (add_last a) seq + Seq.iter (fun x -> add_last a x) seq (* append_array: same [..._if_room] and loop logic as [add_last]. *) @@ -681,7 +684,7 @@ let filter f a = b let filter_map f a = - let b = create() in + let b = create () in iter_ "filter_map" (fun x -> match f x with | None -> () diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 2f1b72e48dc..d3bffeebed6 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -64,7 +64,7 @@ type 'a t (** A dynamic array containing values of type ['a]. A dynamic array [a] provides constant-time [get] and [set] - operation on indices between [0] and [Dynarray.length a - 1] + operations on indices between [0] and [Dynarray.length a - 1] included. Its {!length} may change over time by adding or removing elements to the end of the array. @@ -78,7 +78,7 @@ val create : unit -> 'a t val make : int -> 'a -> 'a t (** [make n x] is a new array of length [n], filled with [x]. - @raise Invalid_argument if [n < 0]. + @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length]. *) val init : int -> (int -> 'a) -> 'a t @@ -90,7 +90,7 @@ val init : int -> (int -> 'a) -> 'a t This is similar to {!Array.init}. - @raise Invalid_argument if [n < 0]. + @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length]. *) val get : 'a t -> int -> 'a @@ -148,6 +148,9 @@ val append : 'a t -> 'a t -> unit on [a] and adds elements to it at the same time -- see the {{!sec:iteration} Iteration} section below. It fails with [Invalid_argument]. + If you really want to append a copy of [a] to itself, you can use + [Dynarray.append_array a (Dynarray.to_array a)] which copies [a] + into a temporary array. *) val append_seq : 'a t -> 'a Seq.t -> unit @@ -365,22 +368,22 @@ val to_seq_rev : 'a t -> 'a Seq.t Internally, a dynamic array uses a {b backing array} (a fixed-size array as provided by the {!Array} module) whose length is greater - or equal to the length of the dynamic array. We call {b capacity} - the length of the backing array. + or equal to the length of the dynamic array. We define the {b + capacity} of a dynamic array as the length of its backing array. The capacity of a dynamic array is relevant in advanced scenarios, when reasoning about the performance of dynamic array programs: {ul {- The memory usage of a dynamic array is proportional to its capacity, rather than its length.} - {- When then is no empty space left at the end of the backing array. + {- When there is no empty space left at the end of the backing array, adding elements requires allocating a new, larger backing array.}} The implementation uses a standard exponential reallocation - strategy which guarantees amortized constant-time operation: the - total capacity of all backing arrays allocated over the lifetime - of a dynamic array is at worst proportional to the total number of - elements added. + strategy which guarantees amortized constant-time operation; in + particular, the total capacity of all backing arrays allocated + over the lifetime of a dynamic array is at worst proportional to + the total number of elements added. In other words, users need not care about capacity and reallocations, and they will get reasonable behavior by default. However, in some From 792bf6ca92bb7a1344b0f35dd97b0532283f7679 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 29 Jul 2023 15:55:34 +0200 Subject: [PATCH 273/402] offer both to_seq{,_rev} and to_seq{,_rev}_reentrant Suggested-by: Guillaume Munch-Maccagnoni Suggested-by: Simon Cruanes --- stdlib/dynarray.ml | 30 +++++++++++- stdlib/dynarray.mli | 40 +++++++-------- testsuite/tests/lib-dynarray/test.ml | 73 ++++++++++++++++++++++++++-- 3 files changed, 119 insertions(+), 24 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 78ee218df43..20846cc215e 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -737,7 +737,20 @@ let of_seq seq = init let to_seq a = - let rec aux i () = + let {arr; length} = a in + check_valid_length length arr; + let rec aux i = fun () -> + check_same_length "to_seq" a ~length; + if i >= length then Seq.Nil + else begin + let v = unsafe_get arr ~i ~length in + Seq.Cons (v, aux (i + 1)) + end + in + aux 0 + +let to_seq_reentrant a = + let rec aux i = fun () -> if i >= length a then Seq.Nil else begin let v = get a i in @@ -747,7 +760,20 @@ let to_seq a = aux 0 let to_seq_rev a = - let rec aux i () = + let {arr; length} = a in + check_valid_length length arr; + let rec aux i = fun () -> + check_same_length "to_seq_rev" a ~length; + if i < 0 then Seq.Nil + else begin + let v = unsafe_get arr ~i ~length in + Seq.Cons (v, aux (i - 1)) + end + in + aux (length - 1) + +let to_seq_rev_reentrant a = + let rec aux i = fun () -> if i < 0 then Seq.Nil else if i >= length a then (* If some elements have been removed in the meantime, we skip diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index d3bffeebed6..7e7aed5d8a6 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -156,11 +156,11 @@ val append : 'a t -> 'a t -> unit val append_seq : 'a t -> 'a Seq.t -> unit (** Like {!append_array} but with a sequence. - Warning: [append_seq a (to_seq a)] simultaneously traverses [a] - and adds element to it; the ordering of those operations is - unspecified, and may result in an infinite loop -- the new - elements may in turn be produced by [to_seq a] and get added again - and again. + Warning: [append_seq a (to_seq_reentrant a)] simultaneously + traverses [a] and adds element to it; the ordering of those + operations is unspecified, and may result in an infinite loop -- + the new elements may in turn be produced by [to_seq_reentrant a] + and get added again and again. *) val append_iter : @@ -306,15 +306,11 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t Note: the [of_*] functions raise [Invalid_argument] if the length needs to grow beyond {!Sys.max_array_length}. - The [to_*] functions, except for {!to_seq}, iterate on their - dynarray argument. In particular it is a programming error if the - length of the dynarray changes during their execution, and the - conversion functions raise [Invalid_argument] if they observe such - a change. - - {!to_seq} produces an on-demand sequence of values, and is expected - to be called with effects happening in-between. Its specification - tolerates changes of length. (See below.) + The [to_*] functions, except those specifically marked + "reentrant", iterate on their dynarray argument. In particular it + is a programming error if the length of the dynarray changes + during their execution, and the conversion functions raise + [Invalid_argument] if they observe such a change. *) val of_array : 'a array -> 'a t @@ -340,11 +336,12 @@ val of_seq : 'a Seq.t -> 'a t val to_seq : 'a t -> 'a Seq.t (** [to_seq a] is the sequence of elements - [get a 0], [get a 1]... [get a (length a - 1)]. + [get a 0], [get a 1]... [get a (length a - 1)]. *) - Because sequences are computed on-demand, we have to assume that - the array may be modified in the meantime. We give a precise - specification for this case below. +val to_seq_reentrant : 'a t -> 'a Seq.t +(** [to_seq_reentrant a] is a reentrant variant of {!to_seq}, in the + sense that one may still access its elements after the length of + [a] has changed. Demanding the [i]-th element of the resulting sequence (which can happen zero, one or several times) will access the [i]-th element @@ -355,7 +352,12 @@ val to_seq : 'a t -> 'a Seq.t val to_seq_rev : 'a t -> 'a Seq.t (** [to_seq_rev a] is the sequence of elements [get a (l - 1)], [get a (l - 2)]... [get a 0], - where [l] is [length a] at the time [to_seq_rev] is invoked. + where [l] is [length a] at the time [to_seq_rev] is invoked. *) + +val to_seq_rev_reentrant : 'a t -> 'a Seq.t +(** [to_seq_rev_reentrant a] is a reentrant variant of {!to_seq_rev}, + in the sense that one may still access its elements after the + length of [a] has changed. Elements that have been removed from the array by the time they are demanded in the sequence are skipped. diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index bbc4ded15b3..9442dc24f99 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -253,7 +253,7 @@ let () = (** {1:conversions Conversions to other data structures} *) -(** {of,to}_{list,array,seq} *) +(** {of,to}_{list,array,seq{,_rev}{,_rentrant}} *) let () = for i = 0 to 1024 do @@ -262,9 +262,76 @@ let () = let arr = Array.of_list ints in assert ((arr |> A.of_array |> A.to_array) = arr); let seq = Array.to_seq arr in - assert ((seq |> A.of_seq |> A.to_seq) |> Array.of_seq = arr); + [A.to_seq; A.to_seq_reentrant] |> List.iter (fun dynarray_to_seq -> + assert ((seq |> A.of_seq |> dynarray_to_seq) |> Array.of_seq = arr) + ); + [A.to_seq_rev; A.to_seq_rev_reentrant] |> List.iter (fun dynarray_to_seq_rev -> + assert ((seq |> A.of_seq |> dynarray_to_seq_rev) + |> List.of_seq |> List.rev + = ints) + ); done;; -;; + +(** reentrancy for to_seq{,_rev}_reentrant *) +let () = + let a = A.of_list [1; 2; 3; 4] in + let seq = A.to_seq a in + let srq = A.to_seq_reentrant a in + let elems_a = A.to_seq_reentrant a in + + let (i, seq) = Option.get (Seq.uncons seq) in assert (i = 1); + let (i, srq) = Option.get (Seq.uncons srq) in assert (i = 1); + + (* setting an element in the middle is observed by both versions *) + A.set a 1 12; + assert (List.of_seq elems_a = [1; 12; 3; 4]); + let (i, seq) = Option.get (Seq.uncons seq) in assert (i = 12); + let (i, srq) = Option.get (Seq.uncons srq) in assert (i = 12); + + (* adding or removing elements invalidates [seq] but works with [srq] *) + A.remove_last a; + assert (List.of_seq elems_a = [1; 12; 3]); + assert (match Seq.uncons seq with + | exception (Invalid_argument _) -> true + | _ -> false + ); + let (i, srq) = Option.get (Seq.uncons srq) in assert (i = 3); + + A.add_last a 4; + assert (List.of_seq elems_a = [1; 12; 3; 4]); + let (i, srq) = Option.get (Seq.uncons srq) in assert (i = 4); + assert (Seq.is_empty srq) + +let () = + let a = A.of_list [1; 2; 3; 4; 5] in + let seq = A.to_seq_rev a in + let srq = A.to_seq_rev_reentrant a in + + let (i, seq) = Option.get (Seq.uncons seq) in assert (i = 5); + let (i, srq) = Option.get (Seq.uncons srq) in assert (i = 5); + + (* setting an element in the middle is observed by both versions *) + A.set a 3 14; + assert (A.to_list a = [1; 2; 3; 14; 5]); + let (i, seq) = Option.get (Seq.uncons seq) in assert (i = 14); + let (i, srq) = Option.get (Seq.uncons srq) in assert (i = 14); + + (* adding elements invalidates [seq] but is ignored by [srq] *) + A.add_last a 6; + assert (A.to_list a = [1; 2; 3; 14; 5; 6]); + assert (match Seq.uncons seq with + | exception (Invalid_argument _) -> true + | _ -> false + ); + (* just check the head, no popping *) + let (i, _) = Option.get (Seq.uncons srq) in assert (i = 3); + let (i, _) = Option.get (Seq.uncons srq) in assert (i = 3); + + (* [srq] skips removed elements *) + A.truncate a 1; + assert (A.to_list a = [1]); + let (i, srq) = Option.get (Seq.uncons srq) in assert (i = 1); + assert (Seq.is_empty srq) (** {1:advanced Advanced topics for performance} *) From 352e946dc7b1d19e50e62f63ecccbd2da84c22a7 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 3 Aug 2023 15:34:04 +0200 Subject: [PATCH 274/402] act on a review by Guillaume Munch-Maccagnoni --- manual/src/library/stdlib-blurb.etex | 4 ++-- stdlib/dynarray.ml | 6 +++--- stdlib/dynarray.mli | 13 +++++++++---- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/manual/src/library/stdlib-blurb.etex b/manual/src/library/stdlib-blurb.etex index 2f1f9ff5534..41cf39f0737 100644 --- a/manual/src/library/stdlib-blurb.etex +++ b/manual/src/library/stdlib-blurb.etex @@ -59,7 +59,7 @@ the above 4 modules \\ "Stack" & p.~\stdpageref{Stack} & last-in first-out stacks \\ "Queue" & p.~\stdpageref{Queue} & first-in first-out queues \\ "Buffer" & p.~\stdpageref{Buffer} & buffers that grow on demand \\ -"Dynarray" & p.~\stdpageref{Dynarray} & arrays that grow on demand \\ +"Dynarray" & p.~\stdpageref{Dynarray} & dynamic arrays: arrays that grow on demand \\ "Seq" & p.~\stdpageref{Seq} & functional iterators \\ "Lazy" & p.~\stdpageref{Lazy} & delayed evaluation \\ "Weak" & p.~\stdpageref{Weak} & references that don't prevent objects @@ -134,7 +134,7 @@ be called from C \\ \stddocitem{Condition}{condition variables to synchronize between threads} \stddocitem{Domain}{Domain spawn/join and domain local variables} \stddocitem{Digest}{MD5 message digest} -\stddocitem{Dynarray}{Growable, mutable arrays} +\stddocitem{Dynarray}{Dynamic arrays} \stddocitem{Effect}{deep and shallow effect handlers} \stddocitem{Either}{either values} \stddocitem{Ephemeron}{Ephemerons and weak hash table} diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 20846cc215e..144c43d3ecb 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -696,9 +696,9 @@ let filter_map f a = (** {1:conversions Conversions to other data structures} *) (* The eager [to_*] conversion functions behave similarly to iterators - in presence of updates during computation. The [to_seq*] functions - obey their more permissive specification, which tolerates any - concurrent update. *) + in presence of updates during computation. The [*_reentrant] + functions obey their more permissive specification, which tolerates + any concurrent update. *) let of_array a = let length = Array.length a in diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 7e7aed5d8a6..6597068c0fb 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -53,9 +53,11 @@ ] (** - Unsynchronized accesses to a dynamic array may lead to an invalid - dynamic array state. Thus, concurrent accesses to dynamic arrays - must be synchronized (for instance with a {!Mutex.t}). + Concurrent accesses to dynamic arrays must be synchronized + (for instance with a {!Mutex.t}). Unsynchronized accesses to + a dynamic array are a programming error that may lead to an invalid + dynamic array state, on which some operations would fail with an + [Invalid_argument] exception. *) (** {1:dynarrays Dynamic arrays} *) @@ -146,7 +148,7 @@ val append : 'a t -> 'a t -> unit Warning: [append a a] is a programming error because it iterates on [a] and adds elements to it at the same time -- see the - {{!sec:iteration} Iteration} section below. It fails with + {{!section:iteration} Iteration} section below. It fails with [Invalid_argument]. If you really want to append a copy of [a] to itself, you can use [Dynarray.append_array a (Dynarray.to_array a)] which copies [a] @@ -423,6 +425,9 @@ val ensure_extra_capacity : 'a t -> int -> unit (** [ensure_extra_capacity a n] is [ensure_capacity a (length a + n)], it makes sure that [a] has room for [n] extra items. + @raise Invalid_argument if the total requested capacity is + outside the range [0 .. Sys.max_array_length]. + A use case would be to implement {!append_array}: {[ let append_array a arr = From 217b06be1b23fd20eb9af0bc7ec46fb126cd1412 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 3 Aug 2023 15:57:19 +0200 Subject: [PATCH 275/402] dynarray: remove atomicity claims --- stdlib/dynarray.ml | 25 ++----------------------- 1 file changed, 2 insertions(+), 23 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 144c43d3ecb..07937ca570a 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -398,17 +398,8 @@ let reset a = *) (* [add_last_if_room a elem] only writes the slot if there is room, and - returns [false] otherwise. - - It is sequentially atomic -- in absence of unsynchronized concurrent - uses, the fields of [a.arr] and [a.length] will not be mutated - by any other code during execution of this function. -*) + returns [false] otherwise. *) let[@inline] add_last_if_room a elem = - (* BEGIN ATOMIC: the code in this section - does not contain any poll point (backedge, - allocation or function call) in native code, - as can be checked when reading the -dcmm output. *) let {arr; length} = a in (* we know [0 <= length] *) if length >= Array.length arr then false @@ -416,7 +407,6 @@ let[@inline] add_last_if_room a elem = (* we know [0 <= length < Array.length arr] *) a.length <- length + 1; Array.unsafe_set arr length elem; - (* END ATOMIC *) true end @@ -446,18 +436,11 @@ let append_seq a seq = (* append_array: same [..._if_room] and loop logic as [add_last]. *) let append_array_if_room a b = - (* BEGIN ATOMIC *) let {arr; length = length_a} = a in let length_b = Array.length b in if length_a + length_b > Array.length arr then false else begin a.length <- length_a + length_b; - (* END ATOMIC - - Notice that, unlike for [add_last], the atomic section here - lasts until the length is extended, but stops before the - elements are added, so one could observe missing elements if - the code yields. *) (* Note: we intentionally update the length *before* filling the elements. This "reserve before fill" approach provides better behavior than "fill then notify" in presence of reentrant @@ -505,20 +488,16 @@ let append_array a b = (* append: same [..._if_room] and loop logic as [add_last], same reserve-before-fill logic as [append_array]. *) -(* Note: unlike [add_last_if_room], [append_if_room] is *not* atomic. - - It is a programming error to mutate the length of [b] during a call +(* It is a programming error to mutate the length of [b] during a call to [append a b]. To detect this mistake we keep track of the length of [b] throughout the computation and check it that does not change. *) let append_if_room a b ~length_b = - (* BEGIN ATOMIC *) let {arr = arr_a; length = length_a} = a in if length_a + length_b > Array.length arr_a then false else begin a.length <- length_a + length_b; - (* END ATOMIC *) let arr_b = b.arr in check_valid_length length_b arr_b; for i = 0 to length_b - 1 do From 08e29f843bb1c27770b6c312de646527660ecde1 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 3 Aug 2023 22:21:52 +0200 Subject: [PATCH 276/402] prevent inlining of error functions (cold paths) to reduce code size --- stdlib/dynarray.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 07937ca570a..5298e75a0be 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -114,7 +114,7 @@ and 'a slot = *) module Error = struct - let index_out_of_bounds f ~i ~length = + let[@inline never] index_out_of_bounds f ~i ~length = if length = 0 then Printf.ksprintf invalid_arg "Dynarray.%s: index %d out of bounds (empty dynarray)" @@ -124,17 +124,17 @@ module Error = struct "Dynarray.%s: index %d out of bounds (0..%d)" f i (length - 1) - let negative_length f n = + let[@inline never] negative_length f n = Printf.ksprintf invalid_arg "Dynarray.%s: negative length %d" f n - let negative_capacity f n = + let[@inline never] negative_capacity f n = Printf.ksprintf invalid_arg "Dynarray.%s: negative capacity %d" f n - let requested_length_out_of_bounds f requested_length = + let[@inline never] requested_length_out_of_bounds f requested_length = Printf.ksprintf invalid_arg "Dynarray.%s: cannot grow to requested length %d (max_array_length is %d)" f requested_length Sys.max_array_length @@ -145,17 +145,17 @@ module Error = struct performed earlier, and not to the callsite of the function itself. *) - let missing_element ~i ~length = + let[@inline never] missing_element ~i ~length = Printf.ksprintf invalid_arg "Dynarray: invalid array (missing element at position %d < length %d)" i length - let invalid_length ~length ~capacity = + let[@inline never] invalid_length ~length ~capacity = Printf.ksprintf invalid_arg "Dynarray: invalid array (length %d > capacity %d)" length capacity - let length_change_during_iteration f ~expected ~observed = + let[@inline never] length_change_during_iteration f ~expected ~observed = Printf.ksprintf invalid_arg "Dynarray.%s: a length change from %d to %d occurred during iteration" f expected observed @@ -163,7 +163,7 @@ module Error = struct (* When an [Empty] element is observed unexpectedly at index [i], it may be either an out-of-bounds access or an invalid-state situation depending on whether [i <= length]. *) - let unexpected_empty_element f ~i ~length = + let[@inline never] unexpected_empty_element f ~i ~length = if i < length then missing_element ~i ~length else From 1d38d605d8e70698561bd412f683140e3279456b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 29 Jul 2023 17:05:55 +0200 Subject: [PATCH 277/402] Dynarray: get_last, find_last --- stdlib/dynarray.ml | 34 ++++++++++++++++++++++------ stdlib/dynarray.mli | 11 ++++++++- testsuite/tests/lib-dynarray/test.ml | 17 +++++++++++++- 3 files changed, 53 insertions(+), 9 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index 5298e75a0be..d9595d6ab7d 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -168,6 +168,10 @@ module Error = struct missing_element ~i ~length else index_out_of_bounds f ~i ~length + + let[@inline never] empty_dynarray f = + Printf.ksprintf invalid_arg + "Dynarray.%s: empty array" f end (* Detecting iterator invalidation. @@ -184,7 +188,7 @@ let check_same_length f a ~length = (* Postcondition on non-exceptional return: [length <= Array.length arr] *) -let check_valid_length length arr = +let[@inline always] check_valid_length length arr = let capacity = Array.length arr in if length > capacity then Error.invalid_length ~length ~capacity @@ -193,7 +197,7 @@ let check_valid_length length arr = This precondition is typically guaranteed by knowing [0 <= i < length] and calling [check_valid_length length arr].*) -let unsafe_get arr ~i ~length = +let[@inline always] unsafe_get arr ~i ~length = match Array.unsafe_get arr i with | Empty -> Error.missing_element ~i ~length | Elem {v} -> v @@ -255,17 +259,33 @@ let copy {length; arr} = ); } +let get_last a = + let {arr; length} = a in + check_valid_length length arr; + (* We know [length <= capacity a]. *) + if length = 0 then Error.empty_dynarray "get_last"; + (* We know [length > 0]. *) + unsafe_get arr ~i:(length - 1) ~length + +let find_last a = + let {arr; length} = a in + check_valid_length length arr; + (* We know [length <= capacity a]. *) + if length = 0 then None + else + (* We know [length > 0]. *) + Some (unsafe_get arr ~i:(length - 1) ~length) + (** {1:removing Removing elements} *) let pop_last a = let {arr; length} = a in + check_valid_length length arr; + (* We know [length <= capacity a]. *) if length = 0 then raise Not_found; let last = length - 1 in - (* We know [length > 0] so [last >= 0]. - See {!get} comment on the use of checked array - access without our own bound checking. - *) - match arr.(last) with + (* We know [length > 0] so [last >= 0]. *) + match Array.unsafe_get arr last with (* At this point we know that [last] is a valid index in [arr]. *) | Empty -> Error.missing_element ~i:last ~length diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli index 6597068c0fb..cf0d326651e 100644 --- a/stdlib/dynarray.mli +++ b/stdlib/dynarray.mli @@ -114,11 +114,20 @@ val length : 'a t -> int val is_empty : 'a t -> bool (** [is_empty a] is [true] if [a] is empty, that is, if [length a = 0]. *) +val get_last : 'a t -> 'a +(** [get_last a] is the element of [a] at index [length a - 1]. + + @raise Invalid_argument if [a] is empty. +*) + +val find_last : 'a t -> 'a option +(** [find_last a] is [None] if [a] is empty + and [Some (get_last a)] otherwise. *) + val copy : 'a t -> 'a t (** [copy a] is a shallow copy of [a], a new array containing the same elements as [a]. *) - (** {1:adding Adding elements} Note: all operations adding elements raise [Invalid_argument] if the diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml index 9442dc24f99..4e1205b99fb 100644 --- a/testsuite/tests/lib-dynarray/test.ml +++ b/testsuite/tests/lib-dynarray/test.ml @@ -43,9 +43,24 @@ let () = A.ensure_capacity a 256; assert (A.is_empty a);; - (** length is tested below *) +(** get_last, find_last *) +let () = + let a = A.of_list [1; 2] in + assert (A.get_last a = 2); + assert (A.find_last a = Some 2); + + A.remove_last a; + assert (A.to_list a = [1]); + assert (A.get_last a = 1); + assert (A.find_last a = Some 1); + + A.remove_last a; + assert (A.to_list a = []); + assert (match A.get_last a with exception _ -> true | _ -> false); + assert (A.find_last a = None) + (** copy, add_last *) let () = From 125bc717e413f0f7312cd5d3a990a6a02648acce Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 4 Aug 2023 16:17:32 +0200 Subject: [PATCH 278/402] dynarray: error message clarifications --- stdlib/dynarray.ml | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml index d9595d6ab7d..eebd2a0bfa8 100644 --- a/stdlib/dynarray.ml +++ b/stdlib/dynarray.ml @@ -124,14 +124,14 @@ module Error = struct "Dynarray.%s: index %d out of bounds (0..%d)" f i (length - 1) - let[@inline never] negative_length f n = + let[@inline never] negative_length_requested f n = Printf.ksprintf invalid_arg - "Dynarray.%s: negative length %d" + "Dynarray.%s: negative length %d requested" f n - let[@inline never] negative_capacity f n = + let[@inline never] negative_capacity_requested f n = Printf.ksprintf invalid_arg - "Dynarray.%s: negative capacity %d" + "Dynarray.%s: negative capacity %d requested" f n let[@inline never] requested_length_out_of_bounds f requested_length = @@ -145,14 +145,19 @@ module Error = struct performed earlier, and not to the callsite of the function itself. *) + let invalid_state_description = + "Invalid dynarray (unsynchronized concurrent length change)" + let[@inline never] missing_element ~i ~length = Printf.ksprintf invalid_arg - "Dynarray: invalid array (missing element at position %d < length %d)" + "%s: missing element at position %d < length %d" + invalid_state_description i length let[@inline never] invalid_length ~length ~capacity = Printf.ksprintf invalid_arg - "Dynarray: invalid array (length %d > capacity %d)" + "%s: length %d > capacity %d" + invalid_state_description length capacity let[@inline never] length_change_during_iteration f ~expected ~observed = @@ -211,14 +216,14 @@ let create () = { } let make n x = - if n < 0 then Error.negative_length "make" n; + if n < 0 then Error.negative_length_requested "make" n; { length = n; arr = Array.init n (fun _ -> Elem {v = x}); } let init n f = - if n < 0 then Error.negative_length "init" n; + if n < 0 then Error.negative_length_requested "init" n; { length = n; arr = Array.init n (fun i -> Elem {v = f i}); @@ -307,7 +312,7 @@ let remove_last a = end let truncate a n = - if n < 0 then Error.negative_length "truncate" n; + if n < 0 then Error.negative_length_requested "truncate" n; let {arr; length} = a in if length <= n then () else begin @@ -344,7 +349,7 @@ let ensure_capacity a capacity_request = let arr = a.arr in let cur_capacity = Array.length arr in if capacity_request < 0 then - Error.negative_capacity "ensure_capacity" capacity_request + Error.negative_capacity_requested "ensure_capacity" capacity_request else if cur_capacity >= capacity_request then (* This is the fast path, the code up to here must do as little as possible. (This is why we don't use [let {arr; length} = a] as @@ -387,7 +392,7 @@ let fit_capacity a = let set_capacity a n = if n < 0 then - Error.negative_capacity "set_capacity" n; + Error.negative_capacity_requested "set_capacity" n; let arr = a.arr in let cur_capacity = Array.length arr in if n < cur_capacity then begin From 41169a484de7816071bb4fe068aaae6c31569d08 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Thu, 31 May 2018 16:57:52 +0100 Subject: [PATCH 279/402] Simplify calls to `caml_int_compare` (and similar functions). --- Changes | 126 ++++++++++++++++++ asmcomp/cmmgen.ml | 58 ++++++++ .../tests/translprim/comparison_optim.ml | 95 +++++++++++++ .../translprim/comparison_optim.reference | 80 +++++++++++ 4 files changed, 359 insertions(+) create mode 100644 testsuite/tests/translprim/comparison_optim.ml create mode 100644 testsuite/tests/translprim/comparison_optim.reference diff --git a/Changes b/Changes index aa7c869ed2b..515f3e7ce30 100644 --- a/Changes +++ b/Changes @@ -154,6 +154,9 @@ Working version - #12551: Propagate classification of recursive bindings from Rec_check (Vincent Laviron, review by Gabriel Scherer) +- #1809: rewrite `compare x y op 0` to `x op y` when values are integers + (Xavier Clerc, review by Gabriel Scherer and Vincent Laviron) + ### Standard library: * #10775, #12499: Half-precision floating-point elements in Bigarray. @@ -858,6 +861,129 @@ Some of those changes will benefit all OCaml packages. - #11134: Optimise 'include struct' in more cases (Stephen Dolan, review by Leo White and Vincent Laviron) +### Standard library: + +* #11565: Enable -strict-formats by default. Some incorrect format + specifications (for `printf`) where silently ignored and now fail. + Those new failures occur at compile-time, except if you use advanced + format features like `%(...%)` that parse format strings dynamically. + Pass -no-strict-formats to revert to the previous lenient behavior. + (Nicolás Ojeda Bär, review by David Allsopp) + +- #11883, #11884: Update documentation for In_channel and Out_channel + with examples and sections to group related functions. + (Kiran Gopinathan, review by Daniel Bünzli and Xavier Leroy) + +- #11878, #11965: Prevent seek_in from marking buffer data as valid after + closing the channel. This could lead to inputting uninitialized bytes. + (Samuel Hym, review by Xavier Leroy and Olivier Nicole) + +- #11848: Add `List.find_mapi`, `List.find_index`, `Seq.find_mapi`, + `Seq.find_index`, `Array.find_mapi`, `Array.find_index`, + `Float.Array.find_opt`, `Float.Array.find_index`, `Float.Array.find_map`, + `Float.Array.find_mapi`. + (Sima Kinsart, review by Daniel Bünzli and Nicolás Ojeda Bär) + +- #11859: Make Stdlib.(@) and List.append tail-recursive and faster. + (Jeremy Yallop, review by Daniel Bünzli, Anil Madhavapeddy, and Bannerets) + +- #11856: Rewrite List.concat_map using TRMC, making it faster + as well as tail-recursive. + (Jeremy Yallop, review by Nicolás Ojeda Bär and Gabriel Scherer) + +- #11836, #11837: Add `Array.map_inplace`, `Array.mapi_inplace`, + `Float.Array.mapi_inplace` and `Float.Array.mapi_inplace`. + (Léo Andrès, review by Gabriel Scherer, KC Sivaramakrishnan and + Nicolás Ojeda Bär) + +- #11410: Add Set.to_list, Map.to_list, Map.of_list, Map.add_to_list, + (Daniel Bünzli, review by Nicolás Ojeda Bär and Gabriel Scherer) + +- #11128: Add In_channel.isatty, Out_channel.isatty. + (Nicolás Ojeda Bär, review by Gabriel Scherer and Florian Angeletti) + +- #10859: Add `Format.pp_print_iter` and `Format.pp_print_array`. + (Léo Andrès and Daniel Bünzli, review by David Allsopp and Hugo Heuzard) + +- #10789: Add `Stack.drop` + (Léo Andrès, review by Gabriel Scherer) + +* #10899: Change Stdlib.nan from signaling NaN to quiet NaN. + (Greta Yorsh, review by Xavier Leroy, Guillaume Melquiond and + Gabriel Scherer) + +- #10967: Add Filename.temp_dir. + (David Turner, review by Anil Madhavapeddy, Valentin Gatien-Baron, Nicolás + Ojeda Bär, Gabriel Scherer, and Daniel Bünzli) + +- #11026, #11667, #11858: Rename the type of the accumulator + of fold functions to 'acc: + fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc + fold_right : ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc + fold_left_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list + ... + (Valentin Gatien-Baron and Francois Berenger, + review by Gabriel Scherer and Nicolás Ojeda Bär) + +- #11246: Add "hash" and "seeded_hash" functions to Bool, Int, Char, Float, + Int32, Int64, and Nativeint. + (Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer) + +- #11354: Hashtbl.find_all is now tail-recursive. + (Fermín Reig, review by Gabriel Scherer) + +- #11500: Make Hashtbl.mem non-allocating. + (Simmo Saan, review by Nicolás Ojeda Bär) + +- #11362: Rewrite List.map, List.mapi and List.map2 using TRMC, making them + faster as well as tail-recursive. + (Nicolás Ojeda Bär, review by Gabriel Scherer) + +- #11412: Add Sys.is_regular_file + (Xavier Leroy, review by Anil Madhavapeddy, Nicolás Ojeda Bär, David Allsopp) + +- #11402: Rewrite List.init, List.filter, List.filteri, List.filter_map and + List.of_seq using TRMC instead of an accumulator, making them faster and + halving memory usage while remaining tail-recursive. + (Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer) + +- #11476: Add examples in documentation of Hashtbl, Queue, Atomic, Format + (Simon Cruanes, review by Yotam Barnoy, Gabriel Scherer, Daniel Bünzli, + Ulugbek Abdullaev, and Nicolás Ojeda Bär) + +- #11488: Add Mutex.protect for resource-safe critical sections protected by + a mutex. + (Simon Cruanes, review by Gabriel Scherer, Xavier Leroy, + Guillaume Munch-Maccagnoni) + +- #11581: Add type equality witness `type (_, _) eq = Equal: ('a, 'a) eq` in a + new module Stdlib.Type. + (Nicolás Ojeda Bär, review by Daniel Bünzli, Jacques Garrigue, Florian + Angeletti, Alain Frisch, Gabriel Scherer, Jeremy Yallop and Xavier Leroy) + +- #11322, #11329: serialization functions Random.State.{of,to}_binary_string + between Random.State.t and string + (Gabriel Scherer, report by Yotam Barnoy, + review by Daniel Bünzli, Damien Doligez, Hugo Heuzard and Xavier Leroy) + +- #11830: Add Type.Id + (Daniel Bünzli, review by Jeremy Yallop, Gabriel Scherer, Wiktor Kuchta, + Nicolás Ojeda Bär) + +- #11843: Add `In_channel.input_lines` and `In_channel.fold_lines`. + (Xavier Leroy, review by Nicolás Ojeda Bär and Wiktor Kuchta). + +- #11892: Document the semantic differences of Unix.exec* between Unix and + Windows. + (Boris Yakobowski, review by Daniel Bünzli, Gabriel Scherer and Nicolás Ojeda + Bär) + +- #12006, #12064: Add `Marshal.Compression` flag to `Marshal.to_*` functions, + causing marshaled data to be compressed using ZSTD. + (Xavier Leroy, review by Edwin Török and Gabriel Scherer, fix by Damien + Doligez) +>>>>>>> 9fc99e9985 (Simplify calls to `caml_int_compare` (and similar functions).) + ### Other libraries: - #11374: Remove pointer cast to a type with stricter alignment requirements diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index c41cfd7efb7..97bb55b451f 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -580,6 +580,64 @@ let rec transl env e = tag_int (Cop(mk_load_mut Word_int, [field_address (transl env b) dim_ofs dbg], dbg)) dbg + | (Pintcomp _ as comp, + [Uprim(Pccall { prim_name = "caml_int_compare"; _ }, + [arg1; arg2], + _); + Uconst(Uconst_int 0)]) -> + transl env (Uprim (comp, [arg1; arg2], dbg)) + | (Pintcomp comp, + [Uprim(Pccall { prim_name = ("caml_int32_compare" + | "caml_int32_compare_unboxed"); _ }, + [arg1; arg2], + _); + Uconst(Uconst_int 0)]) -> + transl env (Uprim (Pbintcomp (Pint32, comp), [arg1; arg2], dbg)) + | (Pintcomp comp, + [Uprim(Pccall { prim_name = ("caml_int64_compare" + | "caml_int64_compare_unboxed"); _ }, + [arg1; arg2], + _); + Uconst(Uconst_int 0)]) -> + transl env (Uprim (Pbintcomp (Pint64, comp), [arg1; arg2], dbg)) + | (Pintcomp comp, + [Uprim(Pccall { prim_name = ("caml_nativeint_compare" + | "caml_nativeint_compare_unboxed"); _ }, + [arg1; arg2], + _); + Uconst(Uconst_int 0)]) -> + transl env (Uprim (Pbintcomp (Pnativeint, comp), [arg1; arg2], dbg)) + | (Pintcomp comp, + [Uconst(Uconst_int 0); + Uprim(Pccall { prim_name = "caml_int_compare"; _ }, + [arg1; arg2], + _)]) -> + let comp = Lambda.swap_integer_comparison comp in + transl env (Uprim (Pintcomp comp, [arg1; arg2], dbg)) + | (Pintcomp comp, + [Uconst(Uconst_int 0); + Uprim(Pccall { prim_name = ("caml_int32_compare" + | "caml_int32_compare_unboxed"); _ }, + [arg1; arg2], + _)]) -> + let comp = Lambda.swap_integer_comparison comp in + transl env (Uprim (Pbintcomp (Pint32, comp), [arg1; arg2], dbg)) + | (Pintcomp comp, + [Uconst(Uconst_int 0); + Uprim(Pccall { prim_name = ("caml_int64_compare" + | "caml_int64_compare_unboxed"); _ }, + [arg1; arg2], + _)]) -> + let comp = Lambda.swap_integer_comparison comp in + transl env (Uprim (Pbintcomp (Pint64, comp), [arg1; arg2], dbg)) + | (Pintcomp comp, + [Uconst(Uconst_int 0); + Uprim(Pccall { prim_name = ("caml_nativeint_compare" + | "caml_nativeint_compare_unboxed"); _ }, + [arg1; arg2], + _)]) -> + let comp = Lambda.swap_integer_comparison comp in + transl env (Uprim (Pbintcomp (Pnativeint, comp), [arg1; arg2], dbg)) | (p, [arg]) -> transl_prim_1 env p arg dbg | (p, [arg1; arg2]) -> diff --git a/testsuite/tests/translprim/comparison_optim.ml b/testsuite/tests/translprim/comparison_optim.ml new file mode 100644 index 00000000000..a94dda91e14 --- /dev/null +++ b/testsuite/tests/translprim/comparison_optim.ml @@ -0,0 +1,95 @@ +(* TEST *) + +let check_list name list = + Printf.printf "testing %S...\n" name; + List.iteri + (fun i (x, y) -> + Printf.printf " #%d: %s\n" + i + (if x = y then "OK" else "KO")) + list; + Printf.printf "\n%!" + +let () = check_list "int" [ + compare 1 2 <= 0, true; + compare 3 3 <= 0, true; + compare 1 min_int <= 0, false; + compare 1 2 < 0, true; + compare 3 3 < 0, false; + compare 1 min_int < 0, false; + compare max_int (-1) >= 0, true; + compare 3 3 >= 0, true; + compare 2 min_int >= 0, true; + compare max_int (-1) > 0, true; + compare 3 3 > 0, false; + compare 2 min_int > 0, true; + compare min_int min_int = 0, true; + compare max_int max_int = 0, true; + compare 1 2 = 0, false; + compare min_int min_int <> 0, false; + compare max_int max_int <> 0, false; + compare 1 2 <> 0, true; +] + +let () = check_list "int32" [ + compare 1l 2l <= 0, true; + compare 3l 3l <= 0, true; + compare 1l Int32.min_int <= 0, false; + compare 1l 2l < 0, true; + compare 3l 3l < 0, false; + compare 1l Int32.min_int < 0, false; + compare Int32.max_int (-1l) >= 0, true; + compare 3l 3l >= 0, true; + compare 2l Int32.min_int >= 0, true; + compare Int32.max_int (-1l) > 0, true; + compare 3l 3l > 0, false; + compare 2l Int32.min_int > 0, true; + compare Int32.min_int Int32.min_int = 0, true; + compare Int32.max_int Int32.max_int = 0, true; + compare 1l 2l = 0, false; + compare Int32.min_int Int32.min_int <> 0, false; + compare Int32.max_int Int32.max_int <> 0, false; + compare 1l 2l <> 0, true; +] + +let () = check_list "int64" [ + compare 1L 2L <= 0, true; + compare 3L 3L <= 0, true; + compare 1L Int64.min_int <= 0, false; + compare 1L 2L < 0, true; + compare 3L 3L < 0, false; + compare 1L Int64.min_int < 0, false; + compare Int64.max_int (-1L) >= 0, true; + compare 3L 3L >= 0, true; + compare 2L Int64.min_int >= 0, true; + compare Int64.max_int (-1L) > 0, true; + compare 3L 3L > 0, false; + compare 2L Int64.min_int > 0, true; + compare Int64.min_int Int64.min_int = 0, true; + compare Int64.max_int Int64.max_int = 0, true; + compare 1L 2L = 0, false; + compare Int64.min_int Int64.min_int <> 0, false; + compare Int64.max_int Int64.max_int <> 0, false; + compare 1L 2L <> 0, true; +] + +let () = check_list "nativeint" [ + compare 1n 2n <= 0, true; + compare 3n 3n <= 0, true; + compare 1n Nativeint.min_int <= 0, false; + compare 1n 2n < 0, true; + compare 3n 3n < 0, false; + compare 1n Nativeint.min_int < 0, false; + compare Nativeint.max_int (-1n) >= 0, true; + compare 3n 3n >= 0, true; + compare 2n Nativeint.min_int >= 0, true; + compare Nativeint.max_int (-1n) > 0, true; + compare 3n 3n > 0, false; + compare 2n Nativeint.min_int > 0, true; + compare Nativeint.min_int Nativeint.min_int = 0, true; + compare Nativeint.max_int Nativeint.max_int = 0, true; + compare 1n 2n = 0, false; + compare Nativeint.min_int Nativeint.min_int <> 0, false; + compare Nativeint.max_int Nativeint.max_int <> 0, false; + compare 1n 2n <> 0, true; +] diff --git a/testsuite/tests/translprim/comparison_optim.reference b/testsuite/tests/translprim/comparison_optim.reference new file mode 100644 index 00000000000..d1a54215e02 --- /dev/null +++ b/testsuite/tests/translprim/comparison_optim.reference @@ -0,0 +1,80 @@ +testing "int"... + #0: OK + #1: OK + #2: OK + #3: OK + #4: OK + #5: OK + #6: OK + #7: OK + #8: OK + #9: OK + #10: OK + #11: OK + #12: OK + #13: OK + #14: OK + #15: OK + #16: OK + #17: OK + +testing "int32"... + #0: OK + #1: OK + #2: OK + #3: OK + #4: OK + #5: OK + #6: OK + #7: OK + #8: OK + #9: OK + #10: OK + #11: OK + #12: OK + #13: OK + #14: OK + #15: OK + #16: OK + #17: OK + +testing "int64"... + #0: OK + #1: OK + #2: OK + #3: OK + #4: OK + #5: OK + #6: OK + #7: OK + #8: OK + #9: OK + #10: OK + #11: OK + #12: OK + #13: OK + #14: OK + #15: OK + #16: OK + #17: OK + +testing "nativeint"... + #0: OK + #1: OK + #2: OK + #3: OK + #4: OK + #5: OK + #6: OK + #7: OK + #8: OK + #9: OK + #10: OK + #11: OK + #12: OK + #13: OK + #14: OK + #15: OK + #16: OK + #17: OK + From efd03d9be411d735418d8e3a203ce2171c8f753e Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Thu, 13 Apr 2023 21:37:25 +0800 Subject: [PATCH 280/402] Update for primitive operations --- asmcomp/cmmgen.ml | 56 +----- .../tests/translprim/comparison_optim.ml | 160 +++++++++--------- 2 files changed, 87 insertions(+), 129 deletions(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 97bb55b451f..885edd7adb0 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -581,63 +581,13 @@ let rec transl env e = [field_address (transl env b) dim_ofs dbg], dbg)) dbg | (Pintcomp _ as comp, - [Uprim(Pccall { prim_name = "caml_int_compare"; _ }, - [arg1; arg2], - _); + [Uprim(Pcompare_ints, [arg1; arg2], _); Uconst(Uconst_int 0)]) -> transl env (Uprim (comp, [arg1; arg2], dbg)) | (Pintcomp comp, - [Uprim(Pccall { prim_name = ("caml_int32_compare" - | "caml_int32_compare_unboxed"); _ }, - [arg1; arg2], - _); + [Uprim(Pcompare_bints b, [arg1; arg2], _); Uconst(Uconst_int 0)]) -> - transl env (Uprim (Pbintcomp (Pint32, comp), [arg1; arg2], dbg)) - | (Pintcomp comp, - [Uprim(Pccall { prim_name = ("caml_int64_compare" - | "caml_int64_compare_unboxed"); _ }, - [arg1; arg2], - _); - Uconst(Uconst_int 0)]) -> - transl env (Uprim (Pbintcomp (Pint64, comp), [arg1; arg2], dbg)) - | (Pintcomp comp, - [Uprim(Pccall { prim_name = ("caml_nativeint_compare" - | "caml_nativeint_compare_unboxed"); _ }, - [arg1; arg2], - _); - Uconst(Uconst_int 0)]) -> - transl env (Uprim (Pbintcomp (Pnativeint, comp), [arg1; arg2], dbg)) - | (Pintcomp comp, - [Uconst(Uconst_int 0); - Uprim(Pccall { prim_name = "caml_int_compare"; _ }, - [arg1; arg2], - _)]) -> - let comp = Lambda.swap_integer_comparison comp in - transl env (Uprim (Pintcomp comp, [arg1; arg2], dbg)) - | (Pintcomp comp, - [Uconst(Uconst_int 0); - Uprim(Pccall { prim_name = ("caml_int32_compare" - | "caml_int32_compare_unboxed"); _ }, - [arg1; arg2], - _)]) -> - let comp = Lambda.swap_integer_comparison comp in - transl env (Uprim (Pbintcomp (Pint32, comp), [arg1; arg2], dbg)) - | (Pintcomp comp, - [Uconst(Uconst_int 0); - Uprim(Pccall { prim_name = ("caml_int64_compare" - | "caml_int64_compare_unboxed"); _ }, - [arg1; arg2], - _)]) -> - let comp = Lambda.swap_integer_comparison comp in - transl env (Uprim (Pbintcomp (Pint64, comp), [arg1; arg2], dbg)) - | (Pintcomp comp, - [Uconst(Uconst_int 0); - Uprim(Pccall { prim_name = ("caml_nativeint_compare" - | "caml_nativeint_compare_unboxed"); _ }, - [arg1; arg2], - _)]) -> - let comp = Lambda.swap_integer_comparison comp in - transl env (Uprim (Pbintcomp (Pnativeint, comp), [arg1; arg2], dbg)) + transl env (Uprim (Pbintcomp (b, comp), [arg1; arg2], dbg)) | (p, [arg]) -> transl_prim_1 env p arg dbg | (p, [arg1; arg2]) -> diff --git a/testsuite/tests/translprim/comparison_optim.ml b/testsuite/tests/translprim/comparison_optim.ml index a94dda91e14..ebadbe8b4b1 100644 --- a/testsuite/tests/translprim/comparison_optim.ml +++ b/testsuite/tests/translprim/comparison_optim.ml @@ -10,86 +10,94 @@ let check_list name list = list; Printf.printf "\n%!" -let () = check_list "int" [ - compare 1 2 <= 0, true; - compare 3 3 <= 0, true; - compare 1 min_int <= 0, false; - compare 1 2 < 0, true; - compare 3 3 < 0, false; - compare 1 min_int < 0, false; - compare max_int (-1) >= 0, true; - compare 3 3 >= 0, true; - compare 2 min_int >= 0, true; - compare max_int (-1) > 0, true; - compare 3 3 > 0, false; - compare 2 min_int > 0, true; - compare min_int min_int = 0, true; - compare max_int max_int = 0, true; - compare 1 2 = 0, false; - compare min_int min_int <> 0, false; - compare max_int max_int <> 0, false; - compare 1 2 <> 0, true; +let check_int () = check_list "int" [ + compare (Sys.opaque_identity 1) 2 <= 0, true; + compare (Sys.opaque_identity 3) 3 <= 0, true; + compare (Sys.opaque_identity 1) min_int <= 0, false; + compare (Sys.opaque_identity 1) 2 < 0, true; + compare (Sys.opaque_identity 3) 3 < 0, false; + compare (Sys.opaque_identity 1) min_int < 0, false; + compare (Sys.opaque_identity max_int) (-1) >= 0, true; + compare (Sys.opaque_identity 3) 3 >= 0, true; + compare (Sys.opaque_identity 2) min_int >= 0, true; + compare (Sys.opaque_identity max_int) (-1) > 0, true; + compare (Sys.opaque_identity 3) 3 > 0, false; + compare (Sys.opaque_identity 2) min_int > 0, true; + compare (Sys.opaque_identity min_int) min_int = 0, true; + compare (Sys.opaque_identity max_int) max_int = 0, true; + compare (Sys.opaque_identity 1) 2 = 0, false; + compare (Sys.opaque_identity min_int) min_int <> 0, false; + compare (Sys.opaque_identity max_int) max_int <> 0, false; + compare (Sys.opaque_identity 1) 2 <> 0, true; ] -let () = check_list "int32" [ - compare 1l 2l <= 0, true; - compare 3l 3l <= 0, true; - compare 1l Int32.min_int <= 0, false; - compare 1l 2l < 0, true; - compare 3l 3l < 0, false; - compare 1l Int32.min_int < 0, false; - compare Int32.max_int (-1l) >= 0, true; - compare 3l 3l >= 0, true; - compare 2l Int32.min_int >= 0, true; - compare Int32.max_int (-1l) > 0, true; - compare 3l 3l > 0, false; - compare 2l Int32.min_int > 0, true; - compare Int32.min_int Int32.min_int = 0, true; - compare Int32.max_int Int32.max_int = 0, true; - compare 1l 2l = 0, false; - compare Int32.min_int Int32.min_int <> 0, false; - compare Int32.max_int Int32.max_int <> 0, false; - compare 1l 2l <> 0, true; +let () = check_int () + +let check_int32 () = check_list "int32" [ + compare (Sys.opaque_identity 1l) 2l <= 0, true; + compare (Sys.opaque_identity 3l) 3l <= 0, true; + compare (Sys.opaque_identity 1l) Int32.min_int <= 0, false; + compare (Sys.opaque_identity 1l) 2l < 0, true; + compare (Sys.opaque_identity 3l) 3l < 0, false; + compare (Sys.opaque_identity 1l) Int32.min_int < 0, false; + compare (Sys.opaque_identity Int32.max_int) (-1l) >= 0, true; + compare (Sys.opaque_identity 3l) 3l >= 0, true; + compare (Sys.opaque_identity 2l) Int32.min_int >= 0, true; + compare (Sys.opaque_identity Int32.max_int) (-1l) > 0, true; + compare (Sys.opaque_identity 3l) 3l > 0, false; + compare (Sys.opaque_identity 2l) Int32.min_int > 0, true; + compare (Sys.opaque_identity Int32.min_int) Int32.min_int = 0, true; + compare (Sys.opaque_identity Int32.max_int) Int32.max_int = 0, true; + compare (Sys.opaque_identity 1l) 2l = 0, false; + compare (Sys.opaque_identity Int32.min_int) Int32.min_int <> 0, false; + compare (Sys.opaque_identity Int32.max_int) Int32.max_int <> 0, false; + compare (Sys.opaque_identity 1l) 2l <> 0, true; ] -let () = check_list "int64" [ - compare 1L 2L <= 0, true; - compare 3L 3L <= 0, true; - compare 1L Int64.min_int <= 0, false; - compare 1L 2L < 0, true; - compare 3L 3L < 0, false; - compare 1L Int64.min_int < 0, false; - compare Int64.max_int (-1L) >= 0, true; - compare 3L 3L >= 0, true; - compare 2L Int64.min_int >= 0, true; - compare Int64.max_int (-1L) > 0, true; - compare 3L 3L > 0, false; - compare 2L Int64.min_int > 0, true; - compare Int64.min_int Int64.min_int = 0, true; - compare Int64.max_int Int64.max_int = 0, true; - compare 1L 2L = 0, false; - compare Int64.min_int Int64.min_int <> 0, false; - compare Int64.max_int Int64.max_int <> 0, false; - compare 1L 2L <> 0, true; +let () = check_int32 () + +let check_int64 () = check_list "int64" [ + compare (Sys.opaque_identity 1L) 2L <= 0, true; + compare (Sys.opaque_identity 3L) 3L <= 0, true; + compare (Sys.opaque_identity 1L) Int64.min_int <= 0, false; + compare (Sys.opaque_identity 1L) 2L < 0, true; + compare (Sys.opaque_identity 3L) 3L < 0, false; + compare (Sys.opaque_identity 1L) Int64.min_int < 0, false; + compare (Sys.opaque_identity Int64.max_int) (-1L) >= 0, true; + compare (Sys.opaque_identity 3L) 3L >= 0, true; + compare (Sys.opaque_identity 2L) Int64.min_int >= 0, true; + compare (Sys.opaque_identity Int64.max_int) (-1L) > 0, true; + compare (Sys.opaque_identity 3L) 3L > 0, false; + compare (Sys.opaque_identity 2L) Int64.min_int > 0, true; + compare (Sys.opaque_identity Int64.min_int) Int64.min_int = 0, true; + compare (Sys.opaque_identity Int64.max_int) Int64.max_int = 0, true; + compare (Sys.opaque_identity 1L) 2L = 0, false; + compare (Sys.opaque_identity Int64.min_int) Int64.min_int <> 0, false; + compare (Sys.opaque_identity Int64.max_int) Int64.max_int <> 0, false; + compare (Sys.opaque_identity 1L) 2L <> 0, true; ] -let () = check_list "nativeint" [ - compare 1n 2n <= 0, true; - compare 3n 3n <= 0, true; - compare 1n Nativeint.min_int <= 0, false; - compare 1n 2n < 0, true; - compare 3n 3n < 0, false; - compare 1n Nativeint.min_int < 0, false; - compare Nativeint.max_int (-1n) >= 0, true; - compare 3n 3n >= 0, true; - compare 2n Nativeint.min_int >= 0, true; - compare Nativeint.max_int (-1n) > 0, true; - compare 3n 3n > 0, false; - compare 2n Nativeint.min_int > 0, true; - compare Nativeint.min_int Nativeint.min_int = 0, true; - compare Nativeint.max_int Nativeint.max_int = 0, true; - compare 1n 2n = 0, false; - compare Nativeint.min_int Nativeint.min_int <> 0, false; - compare Nativeint.max_int Nativeint.max_int <> 0, false; - compare 1n 2n <> 0, true; +let () = check_int64 () + +let check_nativeint () = check_list "nativeint" [ + compare (Sys.opaque_identity 1n) 2n <= 0, true; + compare (Sys.opaque_identity 3n) 3n <= 0, true; + compare (Sys.opaque_identity 1n) Nativeint.min_int <= 0, false; + compare (Sys.opaque_identity 1n) 2n < 0, true; + compare (Sys.opaque_identity 3n) 3n < 0, false; + compare (Sys.opaque_identity 1n) Nativeint.min_int < 0, false; + compare (Sys.opaque_identity Nativeint.max_int) (-1n) >= 0, true; + compare (Sys.opaque_identity 3n) 3n >= 0, true; + compare (Sys.opaque_identity 2n) Nativeint.min_int >= 0, true; + compare (Sys.opaque_identity Nativeint.max_int) (-1n) > 0, true; + compare (Sys.opaque_identity 3n) 3n > 0, false; + compare (Sys.opaque_identity 2n) Nativeint.min_int > 0, true; + compare (Sys.opaque_identity Nativeint.min_int) Nativeint.min_int = 0, true; + compare (Sys.opaque_identity Nativeint.max_int) Nativeint.max_int = 0, true; + compare (Sys.opaque_identity 1n) 2n = 0, false; + compare (Sys.opaque_identity Nativeint.min_int) Nativeint.min_int <> 0, false; + compare (Sys.opaque_identity Nativeint.max_int) Nativeint.max_int <> 0, false; + compare (Sys.opaque_identity 1n) 2n <> 0, true; ] + +let () = check_nativeint () From fd8fa160c01de25274086ab0bb1331212ddc5b0b Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Thu, 13 Apr 2023 21:50:17 +0800 Subject: [PATCH 281/402] Changes --- Changes | 127 +------------------------------------------------------- 1 file changed, 2 insertions(+), 125 deletions(-) diff --git a/Changes b/Changes index 515f3e7ce30..d5f1208e1be 100644 --- a/Changes +++ b/Changes @@ -154,8 +154,8 @@ Working version - #12551: Propagate classification of recursive bindings from Rec_check (Vincent Laviron, review by Gabriel Scherer) -- #1809: rewrite `compare x y op 0` to `x op y` when values are integers - (Xavier Clerc, review by Gabriel Scherer and Vincent Laviron) +- #1809, #12181: rewrite `compare x y op 0` to `x op y` when values are integers + (Xavier Clerc, Stefan Muenzel, review by Gabriel Scherer and Vincent Laviron) ### Standard library: @@ -861,129 +861,6 @@ Some of those changes will benefit all OCaml packages. - #11134: Optimise 'include struct' in more cases (Stephen Dolan, review by Leo White and Vincent Laviron) -### Standard library: - -* #11565: Enable -strict-formats by default. Some incorrect format - specifications (for `printf`) where silently ignored and now fail. - Those new failures occur at compile-time, except if you use advanced - format features like `%(...%)` that parse format strings dynamically. - Pass -no-strict-formats to revert to the previous lenient behavior. - (Nicolás Ojeda Bär, review by David Allsopp) - -- #11883, #11884: Update documentation for In_channel and Out_channel - with examples and sections to group related functions. - (Kiran Gopinathan, review by Daniel Bünzli and Xavier Leroy) - -- #11878, #11965: Prevent seek_in from marking buffer data as valid after - closing the channel. This could lead to inputting uninitialized bytes. - (Samuel Hym, review by Xavier Leroy and Olivier Nicole) - -- #11848: Add `List.find_mapi`, `List.find_index`, `Seq.find_mapi`, - `Seq.find_index`, `Array.find_mapi`, `Array.find_index`, - `Float.Array.find_opt`, `Float.Array.find_index`, `Float.Array.find_map`, - `Float.Array.find_mapi`. - (Sima Kinsart, review by Daniel Bünzli and Nicolás Ojeda Bär) - -- #11859: Make Stdlib.(@) and List.append tail-recursive and faster. - (Jeremy Yallop, review by Daniel Bünzli, Anil Madhavapeddy, and Bannerets) - -- #11856: Rewrite List.concat_map using TRMC, making it faster - as well as tail-recursive. - (Jeremy Yallop, review by Nicolás Ojeda Bär and Gabriel Scherer) - -- #11836, #11837: Add `Array.map_inplace`, `Array.mapi_inplace`, - `Float.Array.mapi_inplace` and `Float.Array.mapi_inplace`. - (Léo Andrès, review by Gabriel Scherer, KC Sivaramakrishnan and - Nicolás Ojeda Bär) - -- #11410: Add Set.to_list, Map.to_list, Map.of_list, Map.add_to_list, - (Daniel Bünzli, review by Nicolás Ojeda Bär and Gabriel Scherer) - -- #11128: Add In_channel.isatty, Out_channel.isatty. - (Nicolás Ojeda Bär, review by Gabriel Scherer and Florian Angeletti) - -- #10859: Add `Format.pp_print_iter` and `Format.pp_print_array`. - (Léo Andrès and Daniel Bünzli, review by David Allsopp and Hugo Heuzard) - -- #10789: Add `Stack.drop` - (Léo Andrès, review by Gabriel Scherer) - -* #10899: Change Stdlib.nan from signaling NaN to quiet NaN. - (Greta Yorsh, review by Xavier Leroy, Guillaume Melquiond and - Gabriel Scherer) - -- #10967: Add Filename.temp_dir. - (David Turner, review by Anil Madhavapeddy, Valentin Gatien-Baron, Nicolás - Ojeda Bär, Gabriel Scherer, and Daniel Bünzli) - -- #11026, #11667, #11858: Rename the type of the accumulator - of fold functions to 'acc: - fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc - fold_right : ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc - fold_left_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list - ... - (Valentin Gatien-Baron and Francois Berenger, - review by Gabriel Scherer and Nicolás Ojeda Bär) - -- #11246: Add "hash" and "seeded_hash" functions to Bool, Int, Char, Float, - Int32, Int64, and Nativeint. - (Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer) - -- #11354: Hashtbl.find_all is now tail-recursive. - (Fermín Reig, review by Gabriel Scherer) - -- #11500: Make Hashtbl.mem non-allocating. - (Simmo Saan, review by Nicolás Ojeda Bär) - -- #11362: Rewrite List.map, List.mapi and List.map2 using TRMC, making them - faster as well as tail-recursive. - (Nicolás Ojeda Bär, review by Gabriel Scherer) - -- #11412: Add Sys.is_regular_file - (Xavier Leroy, review by Anil Madhavapeddy, Nicolás Ojeda Bär, David Allsopp) - -- #11402: Rewrite List.init, List.filter, List.filteri, List.filter_map and - List.of_seq using TRMC instead of an accumulator, making them faster and - halving memory usage while remaining tail-recursive. - (Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer) - -- #11476: Add examples in documentation of Hashtbl, Queue, Atomic, Format - (Simon Cruanes, review by Yotam Barnoy, Gabriel Scherer, Daniel Bünzli, - Ulugbek Abdullaev, and Nicolás Ojeda Bär) - -- #11488: Add Mutex.protect for resource-safe critical sections protected by - a mutex. - (Simon Cruanes, review by Gabriel Scherer, Xavier Leroy, - Guillaume Munch-Maccagnoni) - -- #11581: Add type equality witness `type (_, _) eq = Equal: ('a, 'a) eq` in a - new module Stdlib.Type. - (Nicolás Ojeda Bär, review by Daniel Bünzli, Jacques Garrigue, Florian - Angeletti, Alain Frisch, Gabriel Scherer, Jeremy Yallop and Xavier Leroy) - -- #11322, #11329: serialization functions Random.State.{of,to}_binary_string - between Random.State.t and string - (Gabriel Scherer, report by Yotam Barnoy, - review by Daniel Bünzli, Damien Doligez, Hugo Heuzard and Xavier Leroy) - -- #11830: Add Type.Id - (Daniel Bünzli, review by Jeremy Yallop, Gabriel Scherer, Wiktor Kuchta, - Nicolás Ojeda Bär) - -- #11843: Add `In_channel.input_lines` and `In_channel.fold_lines`. - (Xavier Leroy, review by Nicolás Ojeda Bär and Wiktor Kuchta). - -- #11892: Document the semantic differences of Unix.exec* between Unix and - Windows. - (Boris Yakobowski, review by Daniel Bünzli, Gabriel Scherer and Nicolás Ojeda - Bär) - -- #12006, #12064: Add `Marshal.Compression` flag to `Marshal.to_*` functions, - causing marshaled data to be compressed using ZSTD. - (Xavier Leroy, review by Edwin Török and Gabriel Scherer, fix by Damien - Doligez) ->>>>>>> 9fc99e9985 (Simplify calls to `caml_int_compare` (and similar functions).) - ### Other libraries: - #11374: Remove pointer cast to a type with stricter alignment requirements From a5cd2ee90f70ab37543aae464b6a97a1c43100b2 Mon Sep 17 00:00:00 2001 From: sheeraSearch82 Date: Sat, 21 Oct 2023 17:02:31 +0530 Subject: [PATCH 282/402] Annotate Domain.self with noalloc --- stdlib/domain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stdlib/domain.ml b/stdlib/domain.ml index 6cb6ef34c84..c39cb960123 100644 --- a/stdlib/domain.ml +++ b/stdlib/domain.ml @@ -37,7 +37,7 @@ module Raw = struct external spawn : (unit -> 'a) -> 'a term_sync -> t = "caml_domain_spawn" external self : unit -> t - = "caml_ml_domain_id" + = "caml_ml_domain_id" [@@noalloc] external cpu_relax : unit -> unit = "caml_ml_domain_cpu_relax" external get_recommended_domain_count: unit -> int From b7872b937f538f5613a87ea0c1d5175e5fcb2122 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 17 Oct 2023 12:13:29 +0100 Subject: [PATCH 283/402] Add regression test --- .../tests/typing-extensions/disambiguation.ml | 32 +++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/testsuite/tests/typing-extensions/disambiguation.ml b/testsuite/tests/typing-extensions/disambiguation.ml index 65040ee0cb4..aa0c06ab4c8 100644 --- a/testsuite/tests/typing-extensions/disambiguation.ml +++ b/testsuite/tests/typing-extensions/disambiguation.ml @@ -247,3 +247,35 @@ The first one was selected. Please disambiguate if this is wrong. val x : b = Unique |}] + +(* Optional argument defaults *) +module M = struct + type t = A | B +end;; + +let f1 ?(x : M.t = A) () = ();; +let f2 ?x:(_ : M.t = A) () = ();; +let f3 ?x:((_ : M.t) = A) () = ();; + +[%%expect {| +module M : sig type t = A | B end +Line 5, characters 19-20: +5 | let f1 ?(x : M.t = A) () = ();; + ^ +Warning 41 [ambiguous-name]: A belongs to several types: M/5.y u x +The first one was selected. Please disambiguate if this is wrong. +Lines 1-3, characters 0-3: + Definition of module M +Line 4, characters 0-46: + Definition of module M/5 + +Line 5, characters 9-16: +5 | let f1 ?(x : M.t = A) () = ();; + ^^^^^^^ +Error: This pattern matches values of type "M.t" + but a pattern was expected which matches values of type "M/5.y" + Lines 1-3, characters 0-3: + Definition of module "M" + Line 4, characters 0-46: + Definition of module "M/5" +|}] From b4369a696f78166a5ae27b28cbb93a6c5de9206c Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 17 Oct 2023 12:08:57 +0100 Subject: [PATCH 284/402] Implement a possible fix + update test --- .../tests/typing-extensions/disambiguation.ml | 22 +++---------------- typing/typecore.ml | 10 +++++++++ 2 files changed, 13 insertions(+), 19 deletions(-) diff --git a/testsuite/tests/typing-extensions/disambiguation.ml b/testsuite/tests/typing-extensions/disambiguation.ml index aa0c06ab4c8..f74935ff105 100644 --- a/testsuite/tests/typing-extensions/disambiguation.ml +++ b/testsuite/tests/typing-extensions/disambiguation.ml @@ -259,23 +259,7 @@ let f3 ?x:((_ : M.t) = A) () = ();; [%%expect {| module M : sig type t = A | B end -Line 5, characters 19-20: -5 | let f1 ?(x : M.t = A) () = ();; - ^ -Warning 41 [ambiguous-name]: A belongs to several types: M/5.y u x -The first one was selected. Please disambiguate if this is wrong. -Lines 1-3, characters 0-3: - Definition of module M -Line 4, characters 0-46: - Definition of module M/5 - -Line 5, characters 9-16: -5 | let f1 ?(x : M.t = A) () = ();; - ^^^^^^^ -Error: This pattern matches values of type "M.t" - but a pattern was expected which matches values of type "M/5.y" - Lines 1-3, characters 0-3: - Definition of module "M" - Line 4, characters 0-46: - Definition of module "M/5" +val f1 : ?x:M.t -> unit -> unit = +val f2 : ?x:M.t -> unit -> unit = +val f3 : ?x:M.t -> unit -> unit = |}] diff --git a/typing/typecore.ml b/typing/typecore.ml index 473ef12fee5..7c12b059a35 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -4564,6 +4564,16 @@ and type_function 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 From 18f0eeea6719022acca509257d815f914b0bdad6 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 17 Oct 2023 14:34:46 +0100 Subject: [PATCH 285/402] Add Changes --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 4c0ea56cb32..21fb774b05b 100644 --- a/Changes +++ b/Changes @@ -339,7 +339,7 @@ Working version in Typecore in favor of local mutable state. (Nick Roberts, review by Takafumi Saikawa) -- #12236, #12386, #12391, #12496: Use syntax as the sole determiner of fun arity +- #12236, #12386, #12391, #12496, #12673: Use syntax as sole determiner of arity This changes function arity to be based solely on the source program's parsetree. Previously, the heuristic for arity had more subtle heuristics that involved type information about patterns. Function arity is important From 7fd42b77d978b2c8240331ddfeb1ebd81b56a2ad Mon Sep 17 00:00:00 2001 From: Stefan Muenzel Date: Mon, 23 Oct 2023 19:04:11 +0700 Subject: [PATCH 286/402] clarify meaning of "non-path module type" (#12679) --- Changes | 4 ++ .../extensions/signaturesubstitution.etex | 40 ++++++++++++-- .../module_type_substitution.ml | 52 ++++++++++++++++++- typing/typemod.ml | 13 ++++- 4 files changed, 101 insertions(+), 8 deletions(-) diff --git a/Changes b/Changes index 21fb774b05b..6f4df140d83 100644 --- a/Changes +++ b/Changes @@ -303,6 +303,10 @@ Working version "A type parameter" or "A parameter". (Stefan Muenzel, review by Gabriel Scherer) +- #12679: Add more detail to the error message and manual in case of + invalid module type substitutions. + (Stefan Muenzel, review by Gabriel Scherer and Florian Angeletti) + ### Internal/compiler-libs changes: - #12639: parsing: Attach a location to the RHS of Ptyp_alias diff --git a/manual/src/refman/extensions/signaturesubstitution.etex b/manual/src/refman/extensions/signaturesubstitution.etex index 29df6a84117..1b7d6d3c093 100644 --- a/manual/src/refman/extensions/signaturesubstitution.etex +++ b/manual/src/refman/extensions/signaturesubstitution.etex @@ -56,7 +56,7 @@ module type CompareInt = ComparableInt with type t := int \subsection{ss:local-substitution}{Local substitution declarations} -(Introduced in OCaml 4.08) +(Introduced in OCaml 4.08, module type substitution introduced in 4.13) \begin{syntax} specification: @@ -100,6 +100,29 @@ module type S = sig end [@@expect error];; \end{caml_example} + +Local substitutions can also be used to give a local name to a type or +a module type introduced by a functor application: + +\begin{caml_example}{toplevel} +module type F = sig + type set := Set.Make(Int).t + + module type Type = sig type t end + module Nest : Type -> sig module type T = Type end + + module type T := Nest(Int).T + + val set: set + val m : (module T) +end;; +\end{caml_example} + + +Local module type substitutions are subject to the same limitations as module +type substitutions, see section \ref{ss:module-type-substitution}. + + \subsection{ss:module-type-substitution}{Module type substitutions} (Introduced in OCaml 4.13) @@ -151,11 +174,20 @@ from the signature \begin{caml_example}{toplevel} module type ENDO' = ENDO with module type T := ENDO;; \end{caml_example} -If the right hand side of the substitution is not a path, then the destructive -substitution is only valid if the left-hand side of the substitution is never -used as the type of a first-class module in the original module type. + +\subsubsection*{ss:module-type-substitution-limitations}{Limitations} + +If the right hand side of a module type substitution or a local module +type substitution is not a @modtype-path@, +then the destructive substitution is only valid if the left-hand side of the +substitution is never used as the type of a first-class module in the original +module type. \begin{caml_example}{verbatim}[error] module type T = sig module type S val x: (module S) end module type Error = T with module type S := sig end \end{caml_example} + +\begin{caml_example}{verbatim}[error] +module type T = sig module type S := sig end val x: (module S) end +\end{caml_example} diff --git a/testsuite/tests/typing-modules/module_type_substitution.ml b/testsuite/tests/typing-modules/module_type_substitution.ml index 2ba51928889..3eb6561cd42 100644 --- a/testsuite/tests/typing-modules/module_type_substitution.ml +++ b/testsuite/tests/typing-modules/module_type_substitution.ml @@ -184,6 +184,7 @@ Line 1, characters 25-58: 1 | module type fst_erased = fst with module type t := sig end ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This "with" constraint "t := sig end" makes a packed module ill-formed. + (see manual section 12.7.3) |}] module type fst_ok = fst with module type t = sig end @@ -205,6 +206,7 @@ Line 8, characters 16-49: 8 | module type R = S with module type M.T := sig end ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This "with" constraint "M.T := sig end" makes a packed module ill-formed. + (see manual section 12.7.3) |}] @@ -222,6 +224,7 @@ Line 8, characters 16-49: 8 | module type R = S with module type M.T := sig end ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This "with" constraint "T := sig end" makes a packed module ill-formed. + (see manual section 12.7.3) |}] @@ -253,7 +256,51 @@ Error: Multiple definition of the type name "a". Names must be unique in a given structure or signature. |}] -module type fst = sig +(* Only local module type substitutions resulting in paths may + be used in first class modules. *) + +module X = struct + module type s = sig type t end + module Y(Z : s) = struct + module type Ys = sig end + end +end + +module type fcm_path = sig + module type t_s := X.s + module Z : sig type t end + module type t_Ys := X.Y(Z).Ys + + module F : functor (Z : module type of Z) -> sig + module type t_F = sig type ff end + end + + module type t_FF := F(Z).t_F + + val x_s: (module t_s) + val x_sY: (module t_Ys) + val x_sFF : (module t_FF) +end + +[%%expect {| +module X : + sig + module type s = sig type t end + module Y : functor (Z : s) -> sig module type Ys = sig end end + end +module type fcm_path = + sig + module Z : sig type t end + module F : + functor (Z : sig type t end) -> + sig module type t_F = sig type ff end end + val x_s : (module X.s) + val x_sY : (module X.Y(Z).Ys) + val x_sFF : (module F(Z).t_F) + end +|}] + +module type fcm_signature = sig module type t := sig end val x: (module t) end @@ -262,7 +309,8 @@ Line 3, characters 2-19: 3 | val x: (module t) ^^^^^^^^^^^^^^^^^ Error: The module type "t" is not a valid type for a packed module: - it is defined as a local substitution for a non-path module type. + it is defined as a local substitution (temporary name) + for an anonymous module type. (see manual section 12.7.3) |}] diff --git a/typing/typemod.ml b/typing/typemod.ml index aa2f25a722e..c0312daedc2 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -3314,14 +3314,18 @@ let report_error ~loc _env = function 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 () = Format.fprintf ppf "%s := %a" (Path.name p) Printtyp.modtype mty in Location.errorf ~loc - "This %a constraint@ %a@ makes a packed module ill-formed." + "This %a constraint@ %a@ makes a packed module ill-formed.@ %a" Style.inline_code "with" (Style.as_inline_code pp_constraint) () + Misc.print_see_manual manual_ref | Repeated_name(kind, name) -> Location.errorf ~loc "@[Multiple definition of the %s name %a.@ \ @@ -3447,10 +3451,15 @@ let report_error ~loc _env = function Location.errorf ~loc "Only type synonyms are allowed on the right of %a" Style.inline_code ":=" | Unpackable_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 for a non-path module type." + 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 From be5bbed3beb8426f34a4a754fa5371eeb75b08d5 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 19 Oct 2023 16:42:59 +0200 Subject: [PATCH 287/402] Make sure false positive from #12282 is silenced --- runtime/weak.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/runtime/weak.c b/runtime/weak.c index e41fff4ab08..fbe160c9858 100644 --- a/runtime/weak.c +++ b/runtime/weak.c @@ -183,6 +183,11 @@ static void clean_field (value e, mlsize_t offset) CAMLreally_no_tsan /* This function performs volatile writes, which we consider to be non-racy, but TSan reports data races, so we never instrument it with TSan. */ +#if defined(WITH_THREAD_SANITIZER) +Caml_noinline /* Unfortunately, Clang disregards the no_tsan attribute on + inlined functions, so we prevent inlining of this one when + tsan is enabled. */ +#endif static void do_set (value e, mlsize_t offset, value v) { if (Is_block(v) && Is_young(v)) { From 5c74c3ce39fde778aaf899e9ce8d9688dda50cfa Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 23 Oct 2023 16:08:30 +0200 Subject: [PATCH 288/402] fix locations filename in AST produced by the `-pp` option (#12684) Test: $ echo "let x = 1" > test.ml $ ocamlc -dparsetree -pp cat test.ml Result before: [ structure_item (/tmp/ocamlpp1775ad[1,0+0]..[1,0+9]) Pstr_value Nonrec [ pattern (/tmp/ocamlpp1775ad[1,0+4]..[1,0+5]) Ppat_var "x" (/tmp/ocamlpp1775ad[1,0+4]..[1,0+5]) expression (/tmp/ocamlpp1775ad[1,0+8]..[1,0+9]) Pexp_constant PConst_int (1,None) ] ] Problem: the locations in the AST refer to the temporary file created for preprocessing, which has since been removed. Result after: [ structure_item (test.ml[1,0+0]..[1,0+9]) Pstr_value Nonrec [ pattern (test.ml[1,0+4]..[1,0+5]) Ppat_var "x" (test.ml[1,0+4]..[1,0+5]) expression (test.ml[1,0+8]..[1,0+9]) Pexp_constant PConst_int (1,None) ] ] --- Changes | 3 +++ driver/pparse.ml | 8 ++++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index ba4322f6e4a..56fa11fe263 100644 --- a/Changes +++ b/Changes @@ -503,6 +503,9 @@ Working version (Fabrice Buoro and Olivier Nicole, report by Jan Midtgaard and Miod Vallat, review by Gabriel Scherer) +- #12684: fix locations filename in AST produced by the `-pp` option + (Gabriel Scherer, review by Florian Angeletti) + OCaml 5.1.1 ----------- diff --git a/driver/pparse.ml b/driver/pparse.ml index 2fa6e5eca87..27d72b40a47 100644 --- a/driver/pparse.ml +++ b/driver/pparse.ml @@ -165,7 +165,7 @@ let parse (type a) (kind : a ast_kind) lexbuf : a = | Structure -> Parse.implementation lexbuf | Signature -> Parse.interface lexbuf -let file_aux ~tool_name inputfile (type a) parse_fun invariant_fun +let file_aux ~tool_name ~sourcefile inputfile (type a) parse_fun invariant_fun (kind : a ast_kind) : a = let ast = let ast_magic = magic_of_kind kind in @@ -194,7 +194,7 @@ let file_aux ~tool_name inputfile (type a) parse_fun invariant_fun In_channel.input_all ic in let lexbuf = Lexing.from_string source in - Location.init lexbuf inputfile; + Location.init lexbuf sourcefile; Location.input_lexbuf := Some lexbuf; Profile.record_call "parser" (fun () -> parse_fun lexbuf) end @@ -204,7 +204,7 @@ let file_aux ~tool_name inputfile (type a) parse_fun invariant_fun ) let file ~tool_name inputfile parse_fun ast_kind = - file_aux ~tool_name inputfile parse_fun ignore ast_kind + file_aux ~tool_name ~sourcefile:inputfile inputfile parse_fun ignore ast_kind let report_error ppf = function | CannotRun cmd -> @@ -227,7 +227,7 @@ let parse_file ~tool_name invariant_fun parse kind sourcefile = Misc.try_finally (fun () -> Profile.record_call "parsing" @@ fun () -> - file_aux ~tool_name inputfile parse invariant_fun kind) + file_aux ~tool_name ~sourcefile inputfile parse invariant_fun kind) ~always:(fun () -> remove_preprocessed inputfile) let parse_implementation ~tool_name sourcefile = From e8e5b2f8e581fc3e1afd5f9401d3f2c139f85533 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Mon, 23 Oct 2023 16:10:38 +0200 Subject: [PATCH 289/402] Use proper C99 flexible array members (#12685) Pre-C99 compilers used to support FAM as an extension, with a different syntax and sizeof semantics. --- runtime/caml/bigarray.h | 11 +---------- runtime/caml/lf_skiplist.h | 6 +----- runtime/caml/skiplist.h | 6 +----- runtime/lf_skiplist.c | 5 ----- runtime/memory.c | 9 --------- runtime/skiplist.c | 4 ---- 6 files changed, 3 insertions(+), 38 deletions(-) diff --git a/runtime/caml/bigarray.h b/runtime/caml/bigarray.h index 104b8869dd6..5b488831d62 100644 --- a/runtime/caml/bigarray.h +++ b/runtime/caml/bigarray.h @@ -85,20 +85,11 @@ struct caml_ba_array { intnat num_dims; /* Number of dimensions */ intnat flags; /* Kind of element array + memory layout + allocation status */ struct caml_ba_proxy * proxy; /* The proxy for sub-arrays, or NULL */ - /* PR#5516: use C99's flexible array types if possible */ -#if (__STDC_VERSION__ >= 199901L) intnat dim[] /*[num_dims]*/; /* Size in each dimension */ -#else - intnat dim[1] /*[num_dims]*/; /* Size in each dimension */ -#endif }; -/* Size of struct caml_ba_array, in bytes, without dummy first dimension */ -#if (__STDC_VERSION__ >= 199901L) +/* Size of struct caml_ba_array, in bytes, without [dim] array */ #define SIZEOF_BA_ARRAY sizeof(struct caml_ba_array) -#else -#define SIZEOF_BA_ARRAY (sizeof(struct caml_ba_array) - sizeof(intnat)) -#endif #define Caml_ba_array_val(v) ((struct caml_ba_array *) Data_custom_val(v)) diff --git a/runtime/caml/lf_skiplist.h b/runtime/caml/lf_skiplist.h index db6544c8671..1ba106158af 100644 --- a/runtime/caml/lf_skiplist.h +++ b/runtime/caml/lf_skiplist.h @@ -48,11 +48,7 @@ struct lf_skipcell { uintnat top_level; void *stat_block; struct lf_skipcell *_Atomic garbage_next; -#if (__STDC_VERSION__ >= 199901L) - struct lf_skipcell *_Atomic forward[]; /* variable-length array */ -#else - struct lf_skipcell *_Atomic forward[1]; /* variable-length array */ -#endif + struct lf_skipcell *_Atomic forward[]; /* flexible array member */ }; /* Initialize a skip list */ diff --git a/runtime/caml/skiplist.h b/runtime/caml/skiplist.h index 1e8284dd7ee..b022d09c2db 100644 --- a/runtime/caml/skiplist.h +++ b/runtime/caml/skiplist.h @@ -39,11 +39,7 @@ struct skiplist { struct skipcell { uintnat key; uintnat data; -#if (__STDC_VERSION__ >= 199901L) - struct skipcell * forward[]; /* variable-length array */ -#else - struct skipcell * forward[1]; /* variable-length array */ -#endif + struct skipcell * forward[]; /* flexible array member */ }; /* Initialize a skip list, statically */ diff --git a/runtime/lf_skiplist.c b/runtime/lf_skiplist.c index 59434fee82d..5b65142aaf7 100644 --- a/runtime/lf_skiplist.c +++ b/runtime/lf_skiplist.c @@ -50,12 +50,7 @@ #include /* Size of struct lf_skipcell, in bytes, without the forward array */ -#if (__STDC_VERSION__ >= 199901L) #define SIZEOF_LF_SKIPCELL sizeof(struct lf_skipcell) -#else -#define SIZEOF_LF_SKIPCELL \ - (sizeof(struct lf_skipcell) - sizeof(struct lf_skipcell *)) -#endif /* Generate a random level for a new node: 0 with probability 3/4, 1 with probability 3/16, 2 with probability 3/64, etc. diff --git a/runtime/memory.c b/runtime/memory.c index dd9f83fc156..f1c92478ab6 100644 --- a/runtime/memory.c +++ b/runtime/memory.c @@ -479,19 +479,10 @@ struct pool_block { #endif struct pool_block *next; struct pool_block *prev; - /* Use C99's flexible array types if possible */ -#if (__STDC_VERSION__ >= 199901L) union max_align data[]; /* not allocated, used for alignment purposes */ -#else - union max_align data[1]; -#endif }; -#if (__STDC_VERSION__ >= 199901L) #define SIZEOF_POOL_BLOCK sizeof(struct pool_block) -#else -#define SIZEOF_POOL_BLOCK offsetof(struct pool_block, data) -#endif static struct pool_block *pool = NULL; static caml_plat_mutex pool_mutex = CAML_PLAT_MUTEX_INITIALIZER; diff --git a/runtime/skiplist.c b/runtime/skiplist.c index f81d520b31e..ad77c9f5a54 100644 --- a/runtime/skiplist.c +++ b/runtime/skiplist.c @@ -26,11 +26,7 @@ #include "caml/skiplist.h" /* Size of struct skipcell, in bytes, without the forward array */ -#if (__STDC_VERSION__ >= 199901L) #define SIZEOF_SKIPCELL sizeof(struct skipcell) -#else -#define SIZEOF_SKIPCELL (sizeof(struct skipcell) - sizeof(struct skipcell *)) -#endif /* Generate a random level for a new node: 0 with probability 3/4, 1 with probability 3/16, 2 with probability 3/64, etc. From 7b651cc772a53fe60111bf9d852c8ab1f900aaae Mon Sep 17 00:00:00 2001 From: Seb Hinderer Date: Mon, 23 Oct 2023 13:57:22 +0200 Subject: [PATCH 290/402] Use unique delimiters to quote strings representing magic numbers This commit replaces the double quotes that start magic numbers by {magic| and those that end them by |magic}. Such quotes make it easier to automate the bumping process for magic numbers. --- utils/config.common.ml | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/utils/config.common.ml b/utils/config.common.ml index 224ab2d95b6..8050272957a 100644 --- a/utils/config.common.ml +++ b/utils/config.common.ml @@ -28,26 +28,26 @@ let standard_library = with Not_found -> standard_library_default -let exec_magic_number = "Caml1999X033" +let exec_magic_number = {magic|Caml1999X033|magic} (* exec_magic_number is duplicated in runtime/caml/exec.h *) -and cmi_magic_number = "Caml1999I033" -and cmo_magic_number = "Caml1999O033" -and cma_magic_number = "Caml1999A033" +and cmi_magic_number = {magic|Caml1999I033|magic} +and cmo_magic_number = {magic|Caml1999O033|magic} +and cma_magic_number = {magic|Caml1999A033|magic} and cmx_magic_number = if flambda then - "Caml1999y033" + {magic|Caml1999y033|magic} else - "Caml1999Y033" + {magic|Caml1999Y033|magic} and cmxa_magic_number = if flambda then - "Caml1999z033" + {magic|Caml1999z033|magic} else - "Caml1999Z033" -and ast_impl_magic_number = "Caml1999M033" -and ast_intf_magic_number = "Caml1999N033" -and cmxs_magic_number = "Caml1999D033" -and cmt_magic_number = "Caml1999T033" -and linear_magic_number = "Caml1999L033" + {magic|Caml1999Z033|magic} +and ast_impl_magic_number = {magic|Caml1999M033|magic} +and ast_intf_magic_number = {magic|Caml1999N033|magic} +and cmxs_magic_number = {magic|Caml1999D033|magic} +and cmt_magic_number = {magic|Caml1999T033|magic} +and linear_magic_number = {magic|Caml1999L033|magic} let safe_string = true let default_safe_string = true From f7d02698f7cfb27ad10116ff2ef6d3dd6a42e6e1 Mon Sep 17 00:00:00 2001 From: Guillaume Munch-Maccagnoni Date: Mon, 23 Oct 2023 16:32:22 +0100 Subject: [PATCH 291/402] Make tests/parallel/catch_break.ml more robust (#12618) --- testsuite/tests/parallel/catch_break.ml | 98 ++++++++++++++++++------- 1 file changed, 73 insertions(+), 25 deletions(-) diff --git a/testsuite/tests/parallel/catch_break.ml b/testsuite/tests/parallel/catch_break.ml index 4c57c90fe55..7febd0454c2 100644 --- a/testsuite/tests/parallel/catch_break.ml +++ b/testsuite/tests/parallel/catch_break.ml @@ -10,6 +10,27 @@ no-tsan; } *) +(* PR #11307. The following program deadlocks when input in the + toplevel and interrupted by the user with Ctrl-C, by busy-waiting + on signals to be processed. + + {[ +let break_trap s = + (try while true do () done + with Sys.Break -> print_endline "[Sys.Break caught]" ) ; + print_endline s + +let () = + Sys.catch_break true ; + let d = Domain.spawn (fun () -> break_trap "Domain 1") in + break_trap "Domain 0 - 1" ; + Domain.join d ; + break_trap "Domain 0 - 2"; + print_endline "Success." + ]} + +*) + let verbose = false (* Expected when verbose (depending on scheduling and platform): @@ -24,43 +45,70 @@ Success. *) +let delay = 0.001 (* 1 ms *) +let fuel = Atomic.make 1000 (* = 1s max retry duration *) + let print = if verbose then print_endline else fun _ -> () +(* start sending interrupts when reaches 1 or 2 *) +let ready_count = Atomic.make 0 + +(* Does not poll *) + +let sleep () = + if Atomic.get fuel <= 0 then ( + print "[Reached max attempts without succeeding]"; + Unix._exit 1 + ); + Atomic.decr fuel; + Unix.sleepf delay + +let rec wait n = + if Atomic.get ready_count <> n then ( + sleep (); + wait n + ) + +(* We busy-wait because other synchronisation mechanisms involve + blocking calls, which may exercise other parts of the async + callback implementation than we want.*) let break_trap s = begin - try while true do () done - with Sys.Break -> print "[Sys.Break caught]"; + try Atomic.incr ready_count; while true do () done + with Sys.Break -> print "[Sys.Break caught]" end; - print s + print s; + Atomic.decr ready_count + +(* Simulate repeated Ctrl-C from a parallel thread *) +let interruptor_domain () = + Domain.spawn @@ fun () -> + ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigint]); + let kill () = sleep () ; Unix.kill (Unix.getpid ()) Sys.sigint in + wait 2; + kill (); (* interrupt Domain 1 or Domain 0-1 *) + wait 1; + kill (); (* interrupt the other one of Domain 1 or Domain 0-1 *) + wait 2; + kill () (* interrupt Domain 0-2 *) let run () = - (* Goal: joining the domain [d] must be achievable by Ctrl-C *) - let d = Domain.spawn (fun () -> break_trap "Domain 1") - in - let finished = Atomic.make false in - (* Simulate repeated Ctrl-C *) - let d2 = Domain.spawn (fun () -> - ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigint]); - let pid = Unix.getpid () in - let rec kill n = - if n = 0 then ( - print "[Kill thread reached max attempts without succeeding]"; - Unix._exit 1 - ); - Unix.sleepf 0.05; - Unix.kill pid Sys.sigint; - if not (Atomic.get finished) then kill (n - 1) - in - kill 10) - in + (* We simulate the user pressing Ctrl-C repeatedly. Goal: joining + the domain [d] must be achievable by Ctrl-C. This tests proper + reception of SIGINT. *) + let d = Domain.spawn (fun () -> break_trap "Domain 1") in + let d2 = interruptor_domain () in break_trap "Domain 0 - 1"; Domain.join d; + assert (Atomic.get ready_count = 0); + Atomic.incr ready_count; (* Make sure it reaches 2 *) break_trap "Domain 0 - 2"; - Atomic.set finished true; Domain.join d2 let () = Sys.catch_break true; - (try run () with Sys.Break -> ()); - (try print "Success." with Sys.Break -> ()); + (try run () with Sys.Break -> + print ("Test could not complete due to scheduling hazard" + ^ " (possible false positive).")); + print "Success."; exit 0 From 631ed8d3e5342825e07d38a0e692bc5d937646a6 Mon Sep 17 00:00:00 2001 From: favonia Date: Mon, 23 Oct 2023 13:14:14 -0500 Subject: [PATCH 292/402] Update the logic of detecting NO_COLOR The specification has silently changed; now setting the environment variable `NO_COLOR` with an empty string does not count. The value must be a non-empty string to prevent ANSI coloring. See https://no-color.org/ --- driver/compmisc.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/driver/compmisc.ml b/driver/compmisc.ml index 01eb83f761f..dea87b479a9 100644 --- a/driver/compmisc.ml +++ b/driver/compmisc.ml @@ -88,10 +88,12 @@ let set_from_env flag Clflags.{ parse; usage; env_var } = let read_clflags_from_env () = set_from_env Clflags.color Clflags.color_reader; - if - Option.is_none !Clflags.color && - Option.is_some (Sys.getenv_opt "NO_COLOR") - then + let no_color () = (* See https://no-color.org/ *) + match Sys.getenv_opt "NO_COLOR" with + | None | Some "" -> false + | _ -> true + in + if Option.is_none !Clflags.color && no_color () then Clflags.color := Some Misc.Color.Never; set_from_env Clflags.error_style Clflags.error_style_reader; () From 2c3cc706d0eb0340d4f11fb0eb90db6635fad9ba Mon Sep 17 00:00:00 2001 From: favonia Date: Mon, 23 Oct 2023 14:39:37 -0500 Subject: [PATCH 293/402] Add an entry in Changes --- Changes | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Changes b/Changes index 56fa11fe263..eba4a2bf948 100644 --- a/Changes +++ b/Changes @@ -245,6 +245,14 @@ Working version input files are specified to build an executable. (Antonin Décimo, review by Sébastien Hinderer) +- #12688: Setting the env variable `NO_COLOR` with an empty value no longer + has effects. Previously, setting `NO_COLOR` with any value, including + the empty value, would disable colors (unless `OCAML_COLOR` is also set). + After this change, the user must set `NO_COLOR` with an non-empty value + to disable colors. This reflects a specification clarification/change + from the upstream website at https://no-color.org. + (Favonia, review by Gabriel Scherer) + ### Manual and documentation: - #12338: clarification of the documentation of process related function in From 1bc8ff248279021e0ae33ece769bc167c16096e3 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 3 Aug 2023 17:03:59 +0200 Subject: [PATCH 294/402] CI: Check relevance of parsetree-change label The parsetree-change label is useful for PPX-related maintainance, this new CI check enforces that parsetree-change is equivalent to a change in parsetree.mli Unfortunately, a change in the documentation comments will need a parsetree-change label. Signed-off-by: Paul-Elliot --- .github/workflows/hygiene.yml | 14 +++++ tools/ci/actions/check-parsetree-modified.sh | 54 ++++++++++++++++++++ 2 files changed, 68 insertions(+) create mode 100755 tools/ci/actions/check-parsetree-modified.sh diff --git a/.github/workflows/hygiene.yml b/.github/workflows/hygiene.yml index 725e46c398b..61f4a4961b4 100644 --- a/.github/workflows/hygiene.yml +++ b/.github/workflows/hygiene.yml @@ -47,6 +47,20 @@ jobs: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} if: github.event_name == 'pull_request' + - name: Parsetree updated + run: >- + tools/ci/actions/check-parsetree-modified.sh + '${{ github.event.pull_request.issue_url }}' + '${{ github.ref }}' + 'pull_request' + '${{ github.event.pull_request.base.ref }}' + '${{ github.event.pull_request.base.sha }}' + '${{ github.event.pull_request.head.ref }}' + '${{ github.event.pull_request.head.sha }}' + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + if: github.event_name == 'pull_request' + - name: configure correctly generated run: >- tools/ci/actions/check-configure.sh diff --git a/tools/ci/actions/check-parsetree-modified.sh b/tools/ci/actions/check-parsetree-modified.sh new file mode 100755 index 00000000000..3438bb9c8ac --- /dev/null +++ b/tools/ci/actions/check-parsetree-modified.sh @@ -0,0 +1,54 @@ +#!/usr/bin/env bash +#************************************************************************** +#* * +#* OCaml * +#* * +#* Paul-Elliot Anglès d'Auriac, Tarides * +#* * +#* Copyright 2023 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. * +#* * +#************************************************************************** + +set -e + +# Hygiene Checks: check that whenever the parsetree.mli file has been modified, +# the parsetree-change label has been applied to the PR + +# Exactly of the following must be true: +# - No commit in the PR alters the parsetree.mli file +# - The parsetree-change label is applied to the PR + +API_URL="$1" +shift 1 + +AUTH="authorization: Bearer $GITHUB_TOKEN" + +# We need all the commits in the PR to be available +. tools/ci/actions/deepen-fetch.sh + +COMMIT_RANGE="$MERGE_BASE..$PR_HEAD" + +LABEL='parsetree-change' + +if ! git diff "$COMMIT_RANGE" --name-only --exit-code parsing/parsetree.mli \ + > /dev/null; then + echo -e "The parsetree has been modified." + if curl --silent --header "$AUTH" "$API_URL/labels" | grep -q "$LABEL"; then + echo -e "Label $LABEL is assigned to the PR." + else + echo -e "Please assign the label $LABEL to the PR" + exit 1 + fi +else + echo -e "The parsetree has not been modified." + if curl --silent --header "$AUTH" "$API_URL/labels" | grep -q "$LABEL"; then + echo -e "Please remove the label $LABEL to the PR" + exit 1 + else + echo -e "Label $LABEL is not assigned to the PR" + fi +fi From 8b2fdc910a28000bf519d7847cf4f55625b799ef Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 24 Oct 2023 11:18:12 +0200 Subject: [PATCH 295/402] runtime_events: introduce primitives `caml_ml_runtime_events_{start,pause,resume}` These are wrappers for `caml_runtime_events_{start,pause,resume}` but with types appropriate for calling from the bytecode interpreter. --- otherlibs/runtime_events/runtime_events.ml | 6 +++--- runtime/runtime_events.c | 15 +++++++++++++++ 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/otherlibs/runtime_events/runtime_events.ml b/otherlibs/runtime_events/runtime_events.ml index b07b0c206ff..4e7a1fb098a 100644 --- a/otherlibs/runtime_events/runtime_events.ml +++ b/otherlibs/runtime_events/runtime_events.ml @@ -297,9 +297,9 @@ module Callbacks = struct end -external start : unit -> unit = "caml_runtime_events_start" -external pause : unit -> unit = "caml_runtime_events_pause" -external resume : unit -> unit = "caml_runtime_events_resume" +external start : unit -> unit = "caml_ml_runtime_events_start" +external pause : unit -> unit = "caml_ml_runtime_events_pause" +external resume : unit -> unit = "caml_ml_runtime_events_resume" external create_cursor : (string * int) option -> cursor = "caml_ml_runtime_events_create_cursor" diff --git a/runtime/runtime_events.c b/runtime/runtime_events.c index d42665a5a5b..f02e898319f 100644 --- a/runtime/runtime_events.c +++ b/runtime/runtime_events.c @@ -449,6 +449,21 @@ CAMLprim value caml_runtime_events_resume(void) { return Val_unit; } + +/* Make the three functions above callable from OCaml */ + +CAMLprim value caml_ml_runtime_events_start(value vunit) { + caml_runtime_events_start(); return Val_unit; +} + +CAMLprim value caml_ml_runtime_events_pause(value vunit) { + caml_runtime_events_pause(); return Val_unit; +} + +CAMLprim value caml_ml_runtime_events_resume(value vunit) { + caml_runtime_events_resume(); return Val_unit; +} + static struct runtime_events_buffer_header *get_ring_buffer_by_domain_id (int domain_id) { return ( From c48fb71f60c093d7186c9654b2b3d87a2784061b Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 24 Oct 2023 11:21:01 +0200 Subject: [PATCH 296/402] Intermediate bootstrap while fixing the runtime_events primitives --- boot/ocamlc | Bin 3195717 -> 3190969 bytes boot/ocamllex | Bin 392500 -> 392236 bytes 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/boot/ocamlc b/boot/ocamlc index 02675bc831fc30e19c5e842934b28ad3527a91d5..b1801c8c33f168d204df0dcde159f8ad603fcd76 100755 GIT binary patch delta 326799 zcmbrn3tW`d)<5okZp`S6&N$$JfG~i9q6vA!#Dvt;)CBK&h1AmW0%fJC32CKAOz1(D zmKL0>w6q}9M^9Q%R+=|BSy^d8Y3WIi&`m4L|93qz14zD~-}`?4Q``OQwb#C{z1G@m zUwHq?_r%`XcSWhiLHlylKt0TnBzjT$C$dXl>Ij4zp^tC|>ZcqdL@&LvO|2Xe*p5d_Q+nqhdrt(_n{i;|?WkUl(^}7CwKG)q-tSv8b-z!315iMFwZPB7d1bjRE zR&dkc`skjJ7exm0by3~YAd8+794C_Wwe3UonDz(pITSR`l9fzY7$CpNvR`Lw_XvxLFDOo zbqK}34|N!VfA@C?Rr7!_j&hTNTzXxHVmss8P&2M=lD;`&GMeyPM7)sZ3Yy;~x&sw= z4N%I5dcrg@w|rLYbVVfSi4Hf_38CmU@du<5L9f3h+O3bYBv5{zSVgbv8fbqGxz6_G z`hxE4<`TM|+0EVY*(UJyO};lY`QE4}c5{oO^2ObrlEt8Mk@%r3rs;=zPFJS^YcZ9a zjdSTKy^?&v#B$-*^L0hv&?}gd+p0FI8!Q~OX_2r|-k)-?exY{^QPX%h{@txtFLG1T3r=)rQq1xMM059WG)iyL3E`Ga!mXNx zul#lG8V|M~|182y(^n(R1mTZ=8{yVX!mlChXbej&vi01>qp0HEfIvN`Z?JP1;+s}? z0PWqYzr54=*{W9|{YAf7 zTd3$qsZyAWQqHN0+6Q>3l?nAc(%z*P-`3Uc&xohi1pV{dx(9I^CAdy-G8`wnmFf@L z-IN?2V$)Lwt`q~x-ye9bok-D3zHn2{?ZQGMK4@ntzcA^7f*$#NdNf&13Y%`p7z(;e z&)_Cjc6EnRLbR&r`v6VV%kB=E+}Q2x`c75&tbH2vTbn;y3`L7%;Jk65dFmUYL! z>G(HY&t3L|7_HBHte+UeJ*HPYHdNpGSg;l9z2spY9FUXjGK^7BtjXep+b zr{<$0GDvI|E`8`ToAjQ~IP|o9hn_!Np@fe$i|)`@>Svw_)U!@0`gVPbUZ_WwXBAEq zVy2#&A3?=&nvK%_six>Xiw5Zj*GE!Kd&x!#Q=JyQ<~bYXyrkOoZ5v&BG9~LZg@FvP zlqb+oo47~MjtHfU*W4C;(~FD5y%=@yy=TFAD_*vhr)AANILkC>d>YLzYms|d@(`j#a{&Lj#DGVLwb6lyL{oP5wbqz z6bPriu&7L}UgSqiWUSiRdAg($qM`z5aqYA_g0Kh4?`d%P?AQ%IYOH(A)sgm9{9t z98((6TWp~`1uf1|0jhalp~yZWfi`JkB8}BVR#9)vU^C6nnh2zfB$33yxkj2rbd|(t zTGmp8s-sa4S+DLNO%*N0l0k(|v9CR-Gml{jq2h|jrp{sFOYs!d-X^&zEL_AuLr4u5(@6<$ti3|} z!o@`IK#{{O6r*bgFODC%nT%@9iM(Iy^o&UV4g;|7^=CR$44XKLf;fX2`Mji0wRe)gl1|3GOdE>OIs z^(E)vz-UUi2}H-G_h}a2yIFkCX7N25<3l)oA{?`P1&)7AajU65LByKbcc;wP14GTv zo2cX+XEYUe13@{|00))Ygo5r&lpz+AjFLprO3=BxphoPuS*$YEBfpqRqLDqsXU#x~ zJ;h}7+S;DJqB>GRPZ4bv71Q_`t=G17QSma>K^Y4`t~rXZq0rP`!Y%&MK>2`pl0-aB z?A3(!eQ4CPcO(5I0GQrK41ibPTTExKkLV81Oun^`ZyI<3_Y)>Ups5(z$$1epkc*z?hI++d!=k5frsvyj@pqK}E$j+=yOS_`I{a*Nn1R_i5K z+(rFFuo)dhm0tveQpMr63RUb6bf9BK_5+!&rrdt0-)buBC;GrU&mmBn~=A0xIY)`iW=!GZG5(Ne5L;l9i%cg#|fTZ#DDn>-FZ`D&p-- z5Akqb8YlrMNcRWftNw4Qy;Ver)dpJlnTF~7`Cv>hNSfP4bohE8vHr@vFaz4j{qX(0 zvVu}?2WFAU^q@W@aJy~?6;PuL=*lzHHl%UHEVOcn$f214Q6&GY2_S(C&m zO*{|Qjm&Si-~f_7$Mag_0ZIDq8}WSWuu zpg1Fmt%m1e@rMxGjPONbpzLkTQ(}Q}euS54V#N*;-%C*0ySr?Z91vttdtpRgr|b$?OYwKzpd=BiL@}3hA{+q>iu?x)z z)r-TiR#*h4YYrlg z|CH`}%$yg+!p2;XX9ShLh=EAiB4&n+1?9z|o$y+;YeIozS-^{(RJ}#?3m@GCi92Pt z50N!6gF3$?BAk1CAYO>bNuDlEh3#CARSlZL!W<;Qg@3!)1e=O{6YTF=}=TnY zjslHqQU%wvCdarYeQ4}H2*$8|C~M_Dl)8w&{M8Aj3cy4)Rqq2Is^X|C`%s~eeI=jp z`JZ?z^r#;80lNQm#~u4>4k?~Q_LAxrJfAy-znlX>BYA1_HC74-b)atA6M5vUkP zJ{FsV7)PmRRhORiDR}uO0L(NzpNcnxI8W7|A-8^HJqdX-&FFkmyeNrnbo2}GrgN0| zC1m_L8uleBxQ*6&y=t!)bjk!4ylQdL+*2Y&{D*d&0xfPoC2T79+y$zfuY^+C(qP5T z)#M*{#5pSap(P~tVWCjiX-L9zlzLjYO$Gj(flu(?i$?#i#b*KHzgPl7=697WM#}dB z%hXGH=Eevk=bQ*`E$Z~LESItUSCQ9}8TA?P*qXP(6iO4)Ca~;_Lc)Tg-aGe}E0lE! zijks84#Wj%(r`umNSQ6AQ1O!~fC^hmSH;g>$S)>;KhR1VVHLj`&LHVQySUs~mC`6l zX(g^u;y=|0<3u;fuIOsNou9~vn+nnV%wb|O%#$MsPz!hffi*-DPo1OH&gmj_^f`pM?+nd z*4+j1H3Rm$6%;;Gnheb*^G+2EX(sx>_g!&Q2lT`&^w|o^92V7w@@Gj~yc(jOIx~Xm zW=N5==pHE$@oVpqhQs^(9_dBsG|TRl`U#aXw_tTsb+1$`G$VVqG=OJf*?s7wB&xkn zT8B{f{nEYgKEGd@Zf3kdFL=sDrCA`@tl3hap3zgGxpSp_FRIIM%#$hv#6j|7y@i8?q&v*^vQMFj{fZzHC%}HC1P0 z#NcHFpo9mcU=@qJ&W`{l>@;qXWCXPahvA_=51)TL_wOUmVzAWKG>1LAQMOoe2|D>G z#!EROJ0LYw#W?pU$P0Qy{Sqk}UeHqXbTVZxmE2MrL2uWq?Tcn<7TUg4$^pFFGAS0` zxMk9E5K!hTnu{_XCPe^2M1aEqVIj0AGP%RKq+(<| zCB?K6QC>nw*cN6hTGGa1lom+`TGGlQq{?{*tuKD8lR`EBl#-1TB~qS53ri4Fx&^a1 zV~aFfP|YooEsg)aB;6he?mFx(37qa<(iJhzz<2jHfMq`!>v|>cBZ;{$f5Z5VdFlN& z>JCeJvbfn;c3g5I_ zdTAy&-4Pk zm&2`p%Yh<=tXQwhVgT(Cav;=|qu?ty%q~JtXzQTJ_tE{4mm@I-lDtr)&^TFsg~rOD zVVfc^1@~C3$k76`dxt8oL$JRlcbA+ie02yzwOI(=W-PPFupADgi&l9C(9&DV!v$Ti z!hW!|m3#m^YMu=(SYZged=1$dqK!O8NVf}`=8$irnt~u3RsGgcp{)+tCWg>1hujBP z7ahn=45jq8@+eAcD@VRk(N-4X4x`c~!yitfog7bff$|_a5Gco)D*s5z43b|EcXHh1 zpi!tP>p5)cW%V-+VH;(-*+p4h&{HdDSy$PhP4RLK;_(d@zryHz6Sz1{=^_WxiSF`HF`mK`9Gk$X%!iD=yrH1K{|_8qqlFpD4S&PXZGJ41furC$#kV8?)9X;gxB`E`&H$CO{ zG(y27Pw6cup-GE-%kNQeZLB;K6<6fshNU`^pd%#@W7dD-@aT_?!NVE2fMrmTNs*_l59#6Ek19AgrDHX(65#ZAQcJz!)`l%X&`NS;aZ z1XOVGBso?rq>@Q;AN3)#W9t8OMHfxRq&ztZBpNwcR@6rj(TbeCp)!Wer4n`pfXG2WV|8C$(Yq}vd3-^*WDMl z{04Ct;k#v5Uw<}1KGfVBpmI&Q2(D>E@noGLudy;y#{Vrmrac}ClpJhw))rLVGuTaM zX2@AVY(qA2;PWORD+@_9XC@{dEK%7qTex=3lm}p{=<_4nQChn$FvgN|mK^GQ0tuN_ z@fw4x@Fex0Wm4Efvt)zKUH8ZX#8bw+dzdE{QuV#yaw(KOTmBM}Y$z)luUIH+j=UA& zko#md`kD5#!u#YiD0lJwn8vGU|NTgxO`f^(I_qj*k%G3(mEWVK^W-#ZQ3LG#d4AZ7 z4Y1nzJ{WCXAlr(v*)uQmXGStxfml~J2s@~Mj|mO?j3c?jGL!}buE zQXz?l{T_Ji!*Yz>U(a~10A)WcyBa{<0J1iMRw5V)=P^Mhw|o%X^6JBKiZ^4Z=8yPt zWZVR}M5???H0H>iVQmC4)PeRhXF9& zWah}aOc^;iE0D2Lj-iB=`1*N;oLux$OT}2VQr;;W>P*%a=<)j*Q!F1|@d`xNZ`?w81}! zuA*qSLRU9Ha%EHHMi7#3tsnfXd{PpJjrvXUdn^fdJrCgovGaoLU30}#>P*=M?6og| z^Q|^I7R$$F>4>0PFUsu<+ZK6~B979wt;o?v7q>zlA4LnG&&Tp5= zejG8ZC2;=7XzdQ9*+!>#$nmI%^>s){E;NAZ54R1a;Tc(HfItNC6c{xg)X?lFaeUWm{E4iX=*+)9YB>@D;QtSMqn+wTh6oo8$j>)h3|nX zdv&*L!SGhrV!e`O$YVu5od(=`;yN_zCk?^om^62fnS+^I*S!t78O3{{_QB@3_icHy zQS}xgXyIG(Sc=>SsXyf|2#A#ZauS`~C(oo)`{iU>v|nBY0|};n@Z0j(BBY?mlbyXA zy`~|f9|nHvJMuv1Y1D>C_$#0PHI==C8B@cZk7d_2tW(nlb%6Et9XW?B^qG}%AF0;6 z(&a-G&|R)XV_&lp>eV)~z6%{?8)d!=5x0#Jr-DYdzbju5-_XYQFaS3Ca$JbDEENeC+ItXShr@9HhUdmh3YT4-9;@!F<=MeBDRF1KDEEOF_<| z9t`pavIA|({Xj0aUI3a&yhi^I<>wUZMPK+B)gG2(eJVxSxQ;H0ge?K75|7By_WuH_ zv96g%FfSL->LXBVFH!1Id0sy`;XoxdY^-MCQ5ak(7rIC>mx{12)>E{6u0(+z2vt@0RqOY&5K-xbox zDlpDMO8pu0d}Wm!3G-bgK(wU_>y>l(N48!=A!Cv5Wy)UTbQL`Z>9p$C&RFA|kQJ$g zL{Co@?I`jSOxz zRcG_5zgQgl;KOeDpU79Nl0P*Sd@A>_$_>GzpJG*@(6G3;EBK%W4zrBS@-wIZ!;w$jkHb}w!?q6v;sPoryAFC5!Z<%wx28V0g5Ul)K z{@Utl2!fME(7_rxg^FuTcIK>=*N7n6TnqBtREv^_zK%V+np!9tZVLYf1apj1zmX?X z*f)sW`VC|rI4T1+eIv(kwrD8)eTKpZzFOpvR4og5jc4pyJ9;BkucqP!N z`%X@l>`@5wOkuM^OUnHg=c&@p%S)ZnfU`(YRVRmfy8J(|9XOIFyGAmr=O1Upv#BeRHLzh{TofbVHxQ2dpc`=f zmEhUH@m?<0xn7QN-h}AuxnMy(xY{7<&)zXYC^j*nIg+oeNaW?8*@?huXfT~e>X4fO zx^dCrKg!Y09==?e61w zcnM}yWZ}{i9><>eUr;)>{3XYc?HY8nGyFAzzhdx@Uh@cqb3cobhk&4&*T9t{g<@I1 zPZ_&@ixOyCW2vKY2bd)ZrkJ-n2PFaU1(0 zlr&)<1%RLEj!=k4S!Yjc0y;^%Jj#;9bby%kGGFl4HibpOae~`PbOmE{B(feHtwf63sVrIv6=Ufrd*jR@r?id= zHb!C~=ptj#?(yEp3D-v^)7Tg#j84WVGie`xWyL5Cn%z-JkhTiC^I~j!+B9A2N;Mso zrJ%g2os|2)Z}x~%W4O!ro4 z09BlVoL^1-yP*Fj(~d4mANv&FfSA2c^<9)ubt*vjQFRx^WuJymp7q|?#CTM0I*p81 zdVrjBR0x)feSqws)M?-jnMP_7s*BBwlD_Z<8`!$V=JDO$(MSL(LsDV6l&Wl1XCOZq zo)d5~vMMS@G3rv4V&0ndrK}&KykXr(v}H?I5%R8=mh$v(K8QBq4g+G<04vy+2KP&N>TK=N>DeIn$Ls zlrdeg@Rg0f3SFJ3qE@y@_oC3!wjC(rKiCttWq=MqKN;A?z5wlq&bySD8;*Io!&sJ~yrw`|?mSBgwaQ>7yejjM*wG#=^-bUACS}c1vV?5Z&Qc5s29U%o z^uMuvjP6DLBsKRO1;gp^M?6-JB z6Kn>wy~yNFwJVeeN*EM~rOjfDmT8uu)H-a2=Pg#Y!v@p$QBcQGI{hg6#X-M4ivEXT zW=Ye~<|WE<0K=Dp;Eq!IQp~EO#{Q)MLO<{S80f}E%N|pr;gvk5co%XqW&Row%O~)$ zI9{%#P=&7Gki~LEVH57)9Az@5SqXb9j6ZX5+yOLVeH_HLjY{TVp%L~tMs)!ldR)1L zYM~Xe|0l0{rAY;etNxGaZdi~nv+5`Rk9q$8ti=C0`Tse=^{sX0DNixYO~3)6?Rm;v zVVb$Dl-O6ohWgVWQ;hG^APgJrhv&1tWiG+ibXB-eiGs}N3@`Hy|oL){rLf?v`xxZ?6&>3Nr|Q_n;^5}HbZ)cZB}gN-rU2KzF9GxO>LLlv)M+-^U6C4 z&X{<$cV00p!gnfs{&9G5lekAoyr__A#$@Ko&MV)xy{O<+O(C6sNzoxXO5(sT5?+Q> zSxq}$1~*Eg%9p{Uv;M%1z@-m??L@u;N>jP-Y*fixR;A0ay|HMk+2sXW6?X{7nd}*b z@b7jwuCt)Zt>{2uoZhPRlgum>O5J70-4_=mV9IOCSVXRWO(C4apl+{&-N5kwFAV7H z*OhblPJe@CF?(*RcmvvxpxQS;6-(%sHz4s4I*e;e`E8V<^-+q~xMYkhRgUwyDKnph zH=)Z2s(uqKs)=@b^%XN5?MJbcE1SGk(`yH#m~v&6KWfTOWgqv)E@c2^?1sj)&%kiy z?1JD(G5|%>eC5>bRtiIwqWjra!VA6ma6BZ-c!;ouh{7F(T}q&p7YGc0jH(Sx=H27@mDg zSfb(8 z;u}&AB+o73uofLuk`cA+pb`OZ^FfTWKV$?QQu?%n$~E$1Y>dA*Y&8qHKD8A&m5wl$GX|46mA_s5Z+3p8Xb1wnv_G zIH>NvNSHtCls(9IWIYHqr5M?fE0P4}he4U3^eHA}~ zxVr8R45X_4Z5he=6Z)mlKs|6cqUJ{>kSeZ87NhECWjpj7T6S3(F8xEI|89}mi#28* zdd+(5BwSIF>C9!Ir~M9_{gf-p&y;cn!I{5-lAk8e@1WUrlzIhqn)tgCY|jVLFgX^$ zw^QZ@kmNI7rWN@IGAR9BNwDi2=j-f3y7)WStN|wvP1*5>@`mhO53~+IYh0n4s6{5K z0Xx49W;x)*0f%Xlf9CkDuT8Y-;MHH3S$QNPx}lY`o+pGoj92CIg^Y5kYltKX`dffh#D zJvzCJ;!rh?;}3fhZeA&9;YhpJw64hDUO=UC1#%^j4(8$qlYIh;MBGIv1UF|8j zyBgDND~jOGY|08a%&XCD&Em#U*^4m|ycW>wsub(14Yk|Y9oesdl^RQvF)((Q4#5(% z^lW=!T0w$}>t6{f?_lw_wX|sz z_8>1qbJ>1-09FOjSaDoPP&e4ifYQLzjDke0msH+I4x{j!QG%nV8VK3cqJ^G6Adr%K zstM2{=Jix3!#mVd#nCrYKZ2Lt%LHaV*%>NQFLj~yP2|j!DACB?YBVhx9EOvi7Ra@< zIpG$gxVJh}7P}1f78MJ*-E4kz8%z7CiX;rm?XO0wdypPy_r}8rysy7%Q}-h5q|D_G zmr>JSohv#21pxQC2aadhTgKEBl@zg$ei@_=z@3+FL)Awp=Np(sO9!hlV0WJkR+k8| zpVEh@!XJoTY)$4yNo0v6$w= z)G#1DGz>J8N$ZEHJ*@8_Q}2wb9;S{l&%!T2{;VZ6&hwHxRGfgm1H)BeE?o7RgE*IX zhidzu@w;Oyzxoa})Koe+$Hv_LyaWBeg6HakZjZ-~wej)pp$u8shY z-H{GPR^?^2u$^ETJ07nfq#T0nDjj+|j%T3q-Kvq6doBfzf1KaH0ZZWkejNT7VY3%W z+=*?)x_@XEBV#nE4pZZaF=|8z?*MToQJexlp30m6iEg~vZjI!>i@P9YbT=GNmMpfb@x4i5&ausBV(Q;O!Q4zKkp6k&)axT zPA4X+fo9WhgwJz~e_nhs4aI$m;_e6Nx_N}~jgm9n^RF>EExbz&bT*xnX7zlh_|m7D z(=L1xJlsC@hNgN$%hc5V5)2SVx zfiJz&@sxM=WQ|mnqA3ubr@i2>yx=KQ)Zo8O)vu8glM^iLZ)@(NZJ@w}V%(Ix0UaHk zV$u=Loq_@5dY))XD6mw%4Z*;zZsogVJk=y*bNp&h%Kvu!{@$S-Ymxl_IUd*dZ}v2^ z4@;)0tl?Hp2NjHvaRjC6JPxooU~2NC9Et(sQO_-(f%GSuO> zR438%2j%ug$~|h52&wnw`lHYP$>;xU6x<75*ZCKOxq?mSB!^js{n|9nxHwy#AZ~0B zB^aP_m+L+?1=5_qjf(r!K;gNJ4DLlnPr`9q_?t6ky5pu78r9(e@xq9lr|wg5E$Vc( z8ZZ4O>C;+wFybCigC#tIkh)NP4%ch09p=xH?o4I8nP2xdF$dyHN`0b%};&irY>Ii!GXD@Phx5}32#Lh zdTs5K>Tz6RDtijm(5RX{oUmihLe5q2U=L)kC8e|1in7_WQ2~2)Dr2uTRkPQI>Q_OP zdJZ+SzLpQU$DJ5$o3CL4)q3Oe8Dj86StKm6UT;ogS=Sa zUILDw!{<1ucuN3}@ zdm5F>xE77;h)<(tLpf;HaVf{nL=ab~mOYK0VW_o}uebVB<w_ z0JN6-F~#Sn`uy9t7XbIu(m;e+ptEEAK{DOBPVJJ)^ununhTY*yJKX1wfY0$f&i;Hx z`r_{N`JZ5G99=-pX|Y(gZ`BkZ z$lQ$ROrFy?j&X|Am}UyGeS_*YS8d!><{n-Jh;>uQ@L?O&h|a9_a*V0f;d=qTnKAmq z{sU&%%-x_4w`Zez4V^@l3hs&2;2|8!O2WafEW8Ioj*aR>SjgvWG>rvx5Im7W*_%x5WAi4}yA>n!#4MD&2^ty}rkk*icm(M}DgBHS7QM~tPzZYF zA=R~5@fUA~Z760l4Ep;vV^-p7(Ps4>v6u>;N3k}-DhB0f*yOBu!l~H(J>=C(ocjVG zHH)H@q8HRD9sTPrp3ErE9OFm1V0@eS-0PJ2f~g!WdqIsbmp5&wa*XOS52biBJ^g|j zd)+Dw$$WZHNHJDnEUBziP!fPgiflOckW;Llvo1q9Olxb6>=N~`Bt0h6v6rOwG;s^M ze+YfPMJ>nqg0(Nf*07wqy{z7E%|Qw-@EDc6tPXeP`Z9oLR{U}L^JO){zQT`%LS;(b zi8-G9iW-N}ne_@7)k?FN4m9_5aJ5oIbY@cK+i7udT=70|3=3`!Be7L=_2(#Fu{B5M z3EvzR*&Igc$U@~T!YTJ@Y|W*;t|%gla<{4j%o)J5wSlgw8rY~fNIDcNfj}SzZTnv! z;{NM4HPZ70iZT0(djk2!!f9~r;JgD@yG`}(_y%ET$&CYruR_1WMZ;IkNm1}B^xr}t z^TdmW^D5AluYw$s==7^5k&D;-v<^FR4K|EZUQ-Lr6?+GyVD867@ph7xQs-jDzFiGA z*@1_0e~SVwZdWt9J&EcyOjp#Fd6S=UK7}}@6K(2?c7xx<+{)w1 z4zN}N!&}d7Z>j_7>YJ)V`aq_?-oyedt{kdA?nah_&T+94Uib>E7#>HVQE*IK2a(*b zrGp!nWBqyvAiqq)1*e_rghXB{1p?ax=f`deAOP#9jNfhbu<)w{6jIYNoMA*Hft-fs0l zc(uFL$@Zg2vbkV!M^a-WEtwwvA z6UV2%)-`5WupTFPM$}+fOW#(#H+8@pZ-I7j?rrsyDd}61=NYU*bN+>sMm6tX7ia-J zQ~~4l0@_ib#`kS*1LVBfF~xDq{q{X(yDU+-r@bTRti&RF8&&_=7EjGoLTAH5_2|1$ zUb1OfwH8W__h6=4L5c5y$FHD~@2Rhu*O*vAmCfg@HQVY!K8c68SU^UTGcblL^3WkQdim$RL2Jq}d6qHJeQ|@h zF21-gZx9#mi#v6LIHxb}^!0J%Dsl!RJYZItQ^3#FWaQ4l$Y zZ(s+k0TQ>fkg^Yh%xkIgFnZw|I(=B})dO(@Bnsy>j9qz;* zo5swFy7I% zA6MNH9xeMvCU|bjajbgrrb|bc@7_!VZ;au3=W%c~bAmug`42Ae?W=-DiaA}auA#Bj zY8tr0OVy_GVqUhXtM*5KjO?oat-b+-+>b%3g|zWwEYKIw-jCHDrta!ja+oQaIx~qA z>b<4`Rio_wxNDE6p)E+i_5`L&674#H`M82Eo`7M2Dc-y#p=bXLE$S0>ZV+>J?k48; z{;7YNNCaD8cRS92fBq=$|HlO#Tidc7rF@EhxJ>Dvg1cX) zvQO2}@GIy{lU{(vN?ucy{x>@RsT%G4z3FJ7#^b2uU3VW!3BbN%a#&~FZ2nB0Nj84S zBM)ysVNFqJ6r5CF!wVUvEq92K{)LJ=&dhyQpa}jkYo7tvTJd5qL^HAocnajbkpwYPf$n{1;$;Acf5U%BYZWd9m#@M}P0&;U68 zd80}`jDr^QwYo~YMxTET!D*wBH6SeleaFosbS|={&e1}V_m&sSWACy1|R|717mwa!c@>6D1^*uNNw61d)t`(Gi4*S$N zM%4=TtDWc6nd&yw%}$;eN3@Z0Uc~_|LHqxsF0e}&3cm(}7c%Cwb=zft{7qkBO#K05 zKq)Vyr}&9xa)bn0)bYqIf(mRQcoz5RVC<5v0gpYR#8@ayxGkp5k-OhUWiR1z{JBY3 zUZgC-jH?QjEc#L%i;aH-d5_-Va9W)jO*O-19FCrEF-~1z`3#ZYFDRNa0${{-{HVt1 zHSb}g0|#3`Lph%WmtL^__6ykvT-FF{&B|4MA*HtH^6tPv3P>TtXXWTQcu5n)B! zI^e0mtH^CiJ&4gP3;vF;f%%e^{kQk!Jp~%vt9PSK=vmuAaN5;jAc+O@V6I0 zYH1~4fngyy^SO+sURGm0<53v1I)94jX5n*G*%oss@@a>|+}>wF!+M8rFJ|{|>K4h` z0Hhs%K&|=}@%-aC{wtN;q+y%>514tIp_xtcp3V!uv+y53ULRlIEPU?za8!%0uLrdFv|0El&6yMvk@!|K@cL%q zQO&{~XpW=}i2Anv`sVCu7Jj^*K9aO9()@b*Rnq1M-HG_7-8~p#DDf|7uBe*2>s$67 z!cBW>XC1vRYaOJOb#x4V&{$tQ3l<(7Obk4=Ar#HsnK|1-2&TaCj|rV&S@2Wf_-Dc> zRna2Uzb>I9-T8!z7AcxdIfNjk&9g*O)`!l8l;1nb(q;62udj?1VW!t^aDMVY0WDTs zq&rou%ivxYuWyXISy;JneSG;3*M|!c#vSw9-4RqFx+wO6$eSCGgy>uxRa1!11oometyn!~#8dRWGj9TnQ6X_2>mbpHChmNg3xY8LK+ zaMQ8+&pB!zpmkEqF@al==Yf{cG+&Fs@rzrr--~yP0yJ0HU*CJX&|ha}@Bi_^sA`lH zsLn(POZW%eZrqBj4$wm5u6}nt`5Zu)%VqV{PXlWJqpAgJp|RDX;SXEj0$oeZpyC9m z8kR?$!L+B97D=TqM8U{Dbx;=j~5+PNmq z(eWu?o=yE*0poJ{#~Zb`8>vn$*01fB;MN{Fc7(=JX^1w~ew_p`AOWsP5cAG(O^5eV zxCUDSC=q{Fz}ePS)Ike|xUb(4)q_TK(1zl>wxT^wbpr0&`L2vmLfKqH=Q?OMtGOGF z8bsltGpyADBeXE=h$lv9eQqGzj8zd@g2t*wc^K|vcGU1@ARg&)LIvrh@w;xR+uXQ2 zQezJ+iq!^rD;dqNC0LBCSgn|!7ISvd`oSC7MSBPF_IQ-@cj3t8Oc6#!SM7|rz8VHZ z>|rw>nAxZ}Q7iNb&Fm4_VNFTY@NmJ+TBNV3xry2kDxQfqf*jca7Nh274e!Iv##vLX zI~pnaXxLcksm0+1mGeEdXmQf8_tJ<>JGoeI=v6uR;~>4YNG~e1C?mTM`aJw3x{GO- z*AidB@v8R|IG%ea$#1h7>>0Eo`2kec4!HId*C|2@!XDv8wm6iv|Zc|UY~P2mBcHQuo%BJzVQ!y&X_af%7B7HB5?LSRv#a zvL&47H8-1=M%)FQmA}jER67h-!2!Atf|97C|(>A_vqB$$m#JAn<>-04x&0m$rE${m42 zooOSqo{fKq34fYtI<^iIM{2`C56ebsL(KC@TmkN?X>j~Pp5Joj?OD)BKZ?AQx!^Fo zROpx+iht}VIxQVsa4=oG6@M(JDzOXBgb(c!T+|OADQCI4^Kl=x>Lr{ScYFs5o^mI6 zbHbR|V5<5Fv5sCiC~)HO*7$>6ixo>zT^tsC^IS^9YCMV(2e)zAd5gl|uN}zK)q{QN z%uvPJKp0f{F6{g}+pB@J{j}53u^kdH!{uRTlO+H6P{s9~TYV=6B|k7&3FpkwWOFV4 z_d#%u!bsfatV>9U+e_*2lb?X_I%}14$qqGTD z7GGS%%T(Pb8YYjCZ1Nb?1$RaYG^O*yuu3qsEP!L`VH##^e_j8H__zEfI05H|QcKO;aTN*@s(C;)R?B zh?6&uZZObQX%z6>x-iM(jg6;*-E%%@QdNI6^9b%+uBN{kTzyVD8}3oKad7^* z$GENF{wG`>HylpdiCy@LA3DSC_D>gX!heq!xAy%Db_|F^XRyo820VWbP8unzp}20X zQ1KHm(%EY9>a00IYDz$NrSCZSlto#(=HfScTFjy967(a3O`B5?u7C!+LV^*+b>rqT z>uAiq;Q3gWwE+Z{7U3$o8zz|)KAl|!7DZJLgUE{)D@p?y_ibt(@;A4EW_`tQBmASx z#d5ddp{e7MUY2Q+R0QqGMKPzAhg<$eXQiV+mnT)svbfP2(Wa2hcR;-V={ z7V98~$YnTdXF1spmW;&#HtTEt;iUbeHSe=;K~y;!YBP_25S7ewx)ON;`sa=bMwrLe zKkk2vr~11>-5vei`M2n%$;mSsB2**K{n%R1N^~pcUKvY{j&M9!UJm3Oqm7}Q_fYw) z4&jQGhlcyoPMgPIdfMd;S`yA9<$x;1FF!%LmvVp^t*jjR{ zIrwa2E&vc{sT5Am(JsL6m}qP64oshxRyNu!8Vj#8{%Fr z0~*-ON~9s|UjT9keE)}U)dgf8X@B>!`1inZ&aC+a!EuRsH#@oEO`WE>%}EIBR3LUL@}^;N74AP? z(G6|t1$Vn|5P2@=;eb=O+c+1X{iOM9=;7l|E%6_KiGT8_B z5fdE$n22~{Gt=`E5wnjZoXpoIqiSWrI0IC-pNH&g?x(x8nGF?VnadTMa9zd9?$#b` zKymv}re24VI>W5{)EU|<-h~EL9Eb9lHanOlY`2*jZ=|Eo`p~ACST$k6k=O-_*KO@= zdc`EHCrzN?oTc3>n`gBo%8iCPzWpH>^^0d~fp$K?<)0(i{Ftphf(Nnt&e1Nlq$&$o zZo(1`fBJ5rmL&%<>Mf`xE3N$F9?7DzN3?!HoiGELz^217E%VH2OJWf^H;X)rFlIbN z`134}Tkwk2@^(0dy9mRbMY|ShW32D`=PNlEYh&<;&n)(yAW@Fj@GdOYwqx|n?<0#L zJ^kO0Lc2Br`QAv|5^ZS5q9zrPkS$lLDeT{vT{tuT15PO9FVXN&v(a~{)=CQA2y-h> zdp{fDE}07$<)4d)qm_?=%J7)ZHr~8>OzTM-Cd4?T+AH+>V_F9aTn-6#n4I?pxFr1w zwSL+W1qHmV?XKIJ8C;cS;qPH^WuEgGhMdWYdyao!0p2ux2;rs-{$Es!KSE3=mTSQs z*C38Xm%rB^MVK4i6n`o?b0EHlVHF!N3Wr(a!YDsSi&6iA-E}sJ*ETil*+7dpKm}`{ zMO5TrA#pGbYpl6XX+1k~oo9eXhQMce#NnB~F!N6i&!V+YX>R))_~ak6^W8X4t}PLd z8{Jl6hWI!`b{{;~ldvoti>z_jT1~j6bD$CY4{fY4wU$66^Y|Q-@B*BHhtOR>yVk%4 zQAlUkfETPFYaVD23@1-}&fGa~p^L$Ifh)f?)`Q=|yp*sO<{Op@EhrTa5K!G!T+?t= z!LU)Y1%fwgt(Jl0)oYq1vZmB6x>7t}~Z z*n6-zuEI*@f*pUFB~pj2Wj5{5(LT07qAsJ!QwR@d#|ky zm$duEG2t%PYHQmEuB_5b7TUBId;y7=Mt0nXm%vd=yU2nfVMR3tDVEj2aaRnrm^ z@}8(rR+^enmR1^&mYSLn%F@(?(iFu6Z`(=}GE4IYsioxw%6j!p3tqceX@0-8_dd8G zd;j0%c|M+JGiTP^*37I~vu0+^nvP5AvGA!6!cwX0GHWi-Ybb}zpD+TQ7oQdsLKl}| z$d9Mrmsy{NGx-gmsrhiYc()UmyWg;`({j6|Ff$%cYJ7s1gO-D{ETW(l))+WFS6Gh< zn^gam)+4;LQnw2HbTM69WewK$*_gYxrtCe~-AO2hBtAv$R*azn><5;hKQssXrX>j4 zLhqHJdioV7ihs)*k9HgRmNhKMJN@u5K>KS_6?+WE1v`Gl~nLi+FGj=%b7D5X^n3fz65+4CTJP{%`~UazHH$@8=wl+9D$;ldmZ@msqlyY(4kb5XkY{ZXWgY%Nt-HJ zWYo*eE4B91Qgd(c8jDfo_RuPkUIhv}D6>sT!z@HSc}b3H=h=$Z9sQ5^QOZbt4) zcr!6$ChVEkuZRHyS#J&0R1mx!$IZJ7$mw(-Z?LN9t-TvS;D_nb1`y>kN-RU0o9T$t zd~BrQPM=AcWf02vCzS8c#DsNV=H(?H4Qb%W+?s#$0?jKfvwsSemRV!uCe%l#%dEkg z!V!z?Tz!to1q6_7qcyBay%$j8MsOPFhi}C4UY8$XJQr7sM?r~p>qcyY8f2LZbBVS` zjNGy?JsCvFvqBO+{?pK<*mt$T-1l8;WaD7=P*o*F)!cVANnzo;)@j-hU;&JW$&Ky} z-DF*4TaV$&LY{A7$>d1%M$IM+`UTouxrB0TyF>0Q*SKYNIhfc2Dq#n_v)mdWdmCGC zo`!M_7r6p-jjQt&;P8+qE6_zR(c}uuFD;n5Bhg`16<~`-$GbOU;AywyazGLlo2|p~ zjHYdi^;0N=)@;FC*AdGj?xQ$-m}q`i0{o6+M8U%BR$j;XKo(5cYW0nH9zaGU5g+%) zP<)(DAH8W?t@H7^F^m*m+zM&xFfH4r)norQ%yAD=#CB`1w%Lfyt)o>3F84n7Dbvwe z^eMw}(|fx$AoM}}WP0}UomwOKFm2p!jrm(}U1RX2?bZV*{XG?Pb)1^H0}g7h3C?Z- z%l*o?pp=pDJ_Omr>d5!4qb&X`YcdAE8hOm3y*oku3uxvp?E5cPakJRLmfRwCLkhsT z_-^ZE_!d@LXK`Q^+S8!5hTGaftFTys=G{lu6Fvyd`~=;B$a$Y)qhGtD97#R)Sx*4L ziv8e2`TMQ7PqrVN-vqD?!lIR%;s%TlBalG9HsT!#jV(!+_TzNLP}MIEy$!Dm`(aBe z^)oA*NPgxsl#O>V4`@RfPNZ#gV*!~u6e{~TyEURH$ZAig2UI$4m_z6R6IrZry!e~f>2 zpsV?{^*8ufL8-953ew+c?ZhqWXJ|*&Whl8P zEI0!uW&AGFe9K1jLni8R);bQQm7E31%%YyP8tR#~U^FlVQHz?N z$CZ2tqP4YJp*`!Ys!^%rJ5ee3H(0l`cBg}q^B^83e1kKAS?ZnNSf>a^yr^8P&T?(w z$JO6rdB7`w>}B8H28qvMiL+RZI>)k6SGw~%YmT;XWj4dRMu@2?J~P((-d+u&@cQ9< zpoycEw*zpu_4?5^7<#@ zH@BKj=@Yt%X9ew+cps{2i<6*??qW*BJcRSQCmJ7*>RW*TGZjv=fcAG6`H^m+hqzpb zR9E&8g9UzIJ_K)Pih)$y6Pset7m~#(LOXTj zzfd}&W%m|)`^6xqu)>NLamx85mO|CN#p$>~3nCnOn^p7|ds}X|7M^*jCDp#phidmByd$Nhz)E|@ePSD7 zp8E2AB2K7FDPn-QJSqW&ur%nwhdE2@yF|de^nmABE<>C4;s9}+a0h2IMd(CTDdNA8 zLFqsduOrf-fnqN_jwn9>=Pq^N10u|ub>TMTqbwxDg|$KA0Y6?T+wnF96iM7`p+i}n zDwYA`nQ7uIp&KmPh~L`oM!`&s7;HVofTF=-0)(u@!QxRA<~Kx)gaz8RL&U*Il^h}9 z3_BA`F~Zumc!)UOuO~Mb_B=ooo}uE@8)uVsL&YwZd#vE6(xr#QQNq3IeWS$3`MH&fbn&P*hVI1{A?R@)m5c_F9^`6k+zgZFD7N|DPs1v4Qzy6dsqy%J<#ZlcmxeGNPX@RagS9&An_SL;Ka>grtam_-;uRZC&>J%5&%Y8z^xGK((E5-D+*Q8Y6= z?&9Hw-)8tn7=B18TKGt+m@Rhqe+Xcf09eZ47Q^g1Ta5M}Wq>)g4o-Yo9IR>A#OUTr zw!SQG)tH^O13<+VTt@QL@u}ZptO1K(5d-y5sv>Jx(UW+Z=;ABlI#AG(IbtU``{#&p zS`2|2F0}|&-E&2c$Vcys#29UiS*hV5XlQFYcjI|hcUrkf4DQAfRw@u|F(NIP*H@;k=+>s@E%VX_445aWtax;)9cNOO0vfAKT2IK?C!}I68MdAh58SwF(Bc z$4j?=;;^ke9|WFBwgT};P$_a^5{$yfeZU2ls+S7Hi55*-YDxZ|xnl~ms(g!Hih;<@ zt+Zk>(!*-T2yD;yNQ{6Tl22UFWGKR1;^wDdQnj(RVJJ;eP z6&jqIET5`oz*_XxRpM6I`mQJzdqb)AmtqX(anzwi91BuiSR&@!L`ey|GGc#hUp?~{ zX1ZBw#M|P0L3oTxSBq!;9_Q99j2ahAtJfgXc)GMkjMQHHxEE;fV4Z*%uv)!F3=3i` zz2GMRX3B(JU<84IPF^bpH;FM3G4y_2@{SnUmh14ck>@0D5MT=d^G@fJ>Et_NC(Dyo zy7e8g)oteTrWi?Bj`G5JR4|HJdVB+kmfm1Sk6A27$=0LzX<=Z(kz#X1GpeT%)PH9Ft7yI?*jWqh_uX=d;S!rS;<1EKM!KhHH5n9MgJ!#l~Iz2C)`_ zHDzGu=+}+nD*tDZcNnnauIGv1CCYqP+$~Q7xN)@bJq0WuHi_do%cpRtwR4k3R;M?K zn*{&qh|3kd!3rv7vwA><=)tjpq5gnyy(j7_FndDs+bqtPpGT;P&hnvmb#SxjlwW94 zy8jk2Ql9a5(9FMq{9iPK&{~*n-UmC(4Gw0zYzw!DgW#OrA`Z~**Cqog?wK5<;tJfT zaNn)sG;Gb^*cj6|29>OVvSEH2P8N#;FuG5D0zH80Y3-oW_-B|@SotH4Q@4rJ{qvBJ znY<4^<{vLn={9kI|16`JrtM_oodDjODW<6HB0u_)wjC|>5*2L6;CzX;ZRa6Fqg8Q` zJlnuXmo>FJ(ABCqPJ4h8LAbZ%|DK3v8u8PqX73OOTcG%`_kD2=oPi%;_I1*uA3(Z< z)$N^-Z?G=hDU!BF*8)%2@%HX6v1^cb!-1RTWn|0Q^~1Uz6VAhQAtIg9>+bVI6|9k_?n@axZ)$RjsF583#Jr3i<*zns|yYA4dUsr zM;u@rc;HDPtXhxQp%c*%?JK{AxSW(Z$UU@i4{j_iGLkp8lX`Lws5CSma3+*EeEhe& zQPU)OFXq`P00okNAE=g=?*%)ar9S$JI86`===7%$J6>lejE3wJd8;gYpUBE;a01lo zePXPg921q-L_>}5fOtZ~Di%*Uw8W{)Vhn=bYn1<+hIk!+d`747DI$3y4+J;E$XTtFa;9p7p&d1 zE%2-+KlG(q^7E|=XT%qv*GVGg70&&6p$%K>8QVHSLY4PX0Q{J?(& zf|%ZTk)mU?|ESn2Y9+ut^Kkbu(Z6X#yFr@Qdcquc(lK#*+f_yw@6vkX7aOn}qv7;1 z4BZmSJ1z$Jzh#6r4ngX09D@JbT4=Y`%|lHC)GIo!G2%4JRT?W!J}6`R<+vE4UB~7s zwZq4Q+RFmlk^dKv{r*4P^^4T50HQw{*L5$^AzT4Oo)^Br*v56tFU4R@5eRR@4TefZ zk1s{ZR*V$fzQ57HFU3JYE8*o1W!(6W8O&Q$@ue8;_b>d!@W_F@RsW^v#C@r20E57z zPJpqlq(di=y&fs*KvZziNiB|i5}bVs^*o8FD=G6NB#f0p;qA*>QTa&_*T1OZD0Yo| zg!()E*k%n(sXYblz5H_+Vlc~qSEZh8?}ls<`xW{Dch%R3+es1&X83n)4(77J_DlCxqjKOj?g zPAn8G>#X|ou?xNz11cx?8;7llvn zvBV1y7kSU$D_k=;i!v{uS+Z!}1x#CIRCNKf-$r(@V!R6*Y+2NB0c7#69_WnQ3p2Vy%MR7ywtIo{j{Vjj%m z{v^H)^|z{xJ^|{EpTrO!VJp@ASDaGirrY$TJ+WRY=YJbOihK*yZS-*)_m{Jq}z;t|x z(*6KB7XOZB(#Wx}4qMzAwK2Y$*B4&!li$SH@9fC_#aa9a} zlh&tAK+#oH=KNJLT*JsaBzY%`3%W5hqppF_$CLkGSXzyz3Jb*EtJlQ9n}bROX)N`> z23l&G;?#95MZ zk+gmY!A5o%9O3c6NIDpXZGjX&X{-Exlc=&)n(zOC8HC0kN_i)I!PXXnFIHNmbpM@y zi;(;!PD}cTQmzoR3xV7b%r2N#nakh~+#(;aZb=Hq36;M3Xbh(an-mF+kDfM(F9%ob zgYN1Ko8-M}lyDTWdvaO-eVm=wqr2-7OiAzbPNUuL+p77lz` ztoHu6PN4JDM zg-{z55LdRsQXodkN8G6P8d(WCUlZ^^7u5j*1`Wbd8%c1Npk}tK0>R0fv*9d4eT)(-y`_V+#rO~ z?w5MQHgDccPb6N4!xm8G{gOxcnd>kUY`&RjR z6t3LekAV6Vus^7&v~0!P-YwCjfl|E9ePbavP#R_X0cz=uIfkj82P8>54ZOb%ZYqv- zJJr-d;GD>&AQgyw0v!yjB|I6>$*E42*g}Q2(-o42QF52sHck50S2#zuVbUlZK~xO` zH>r;d2%*$rk|a+8;@T9Ydbb7`5hvAr>>mJoI8md}VFxeBQj{65ub^4W`IvG0jA~?z*!OWTEd>Ov zH)5EvS%%%{b^$^2j3Cayi`a8)NI}iH9YJ0+5PFM0{0>tz3;bq0E<0)A8bw7jJR08;~L?NdO>?L!0bZd8;Y2K1a_#4w{Z#(3n7#$ zX2t}>N=6KiDaI8;p*hL~`!@+=rGWd68bQ&fpgjhxjS035Ff$3QZRRIkF*<8KR45i_ zNS>T_%_2DAcbGD~1|4T}$NmVvxl_-=Z>G5;@SA&fH~i*aEr;LKqZZiFFK8VG*<`an zF1Tk(fjLhihPetu;5TE`7k)EFcfoJQs2%)fj9S8P#z=(Uj1imQFk#g4mh%8K9|b4a z4o4Ttcv$M3vjO3}GWK@%O8CtPz6QS;!Cd&w2tEbB8NqSzn-LrazZpTc`OyTyy8&p9 zAXMs(y90v4jUY3AGL<|6>n4A}^arOhqxO>lGox2)z|1J_Ll#m%;Cl!%=Uf6mtQxdg zN*Uu=&V3=!ozodGb8EDP-&|xc{N~~$_{~NA0ShGN*0>12xi!wfZ)%NOs^K>^23;Q~ z`O)e&VS%xmjSw@&ZyPW(hFGXSDg|_V*$6TtH`#!h5gY@UIm>$~YCVh{J0FwU=Aw4PZ*Gio_|4_5gx_4&Lio*%F#~>cV@!hI)EJgqMpMOOU@|F`c3RTNwLPtS zJ=~eu5)sXV>S{B?C>Pl6SwPm|K2*Gyj{-{Ih?e9~ZlyppXDm zp?-qoYq|X=df*A^R!RuLExZ|ZP|`b3QBO#5!dvV>3+yQ1Sx-Q|OE&;10IXm@OC3-> z5rBhx{UzZGs^OHy>|mX6haCrO6A^KQ4k&&d5mNxLT)n6l+P}cAm?n`h89R5J$Jc*SR= z_Lc?zp)tStwX;0;9}TAt=Cp&6*3{m&{0n|_|8}CfNm8dMN3&>u!h(!B+C@svhe9V? z-{K2RzH0hpDcmX?QlEQT`pFkMqr!6-R)=ZkbO^UcyuOMl*zR^Of^eSu8g$84OqW80 z>ZXCGtnR|{?!JYdub`&!oYY^a@rJK_4zl#;UZ4ED^tfDOMO4nfZz| z#e$cQG$j{lp0}ANnhZX>krP8axKDFdbqQTA5LU9@B`Q#q5YS;0EmBW3aVcq zg$t+j0@^H;a;)@EI+DQWs;_>a6~|`U!t&?Zw4F3;Ik&QZG6<0~;2( z_hKR5pQNsU=8^O%U6~1J#!@MRLUQq|{%-7Go?0p$6NGQoiZ`U?7P>gsn{NC{DV

Kn&sI{+(tZiL+3_7<)@fe9G7l<>GtlvGDDKEjAhAW^ z*^otA&g@j7ExH@OAuod|h~-XZ2`FhMHN6Qn zxtdPDsf>j+9r2bDZD;e%?KzahBS}~jy`|W?r68eY1w%|NNXY~u0)l5e1r{V01G zt>3RiXBLAaFhx(m){7!ho5UbEiV8<|bjNcN79H1#6;%YW{X(&CD<1ovW`CVJP{rGr zIWD05x6ui2pt&4fO%Ecn4>5V%ex6=b&%^{e#*vFoGfx|n$3w;MAfFSI`3{Jm(rAwM z(`-ccT|fKFiuUt7L)A>Iq`e&7N1rfHvB~45h8an29N%yq0C5bZaWs%dAhP!`dGNIc zE(`v1Cbp&Z9G#}!%=7(E{<4y({s4FmQwtOSO^$;g)|$lb#tX$(nIMab+sA4P7TZcH zL<(^?m2fnd)^hsEW`cC8K8VbRPy-XO3(ZkH+1~|^)8y$zu6Mz6j&gy;Y2Rr~Ja*Dw zyGspX>;V(ZHY+d&vDI!bQ!OWamJV{lwI*jjY-uQN`+X+Z-vDv=BK|$_UQYu#%BRVQ zVslI$J{81o_h>-o=~Tg-ooO2)yTjzXoC@Dl+-YY{_$$eN*H+C2jx~!jx+@@~XUTO) z@kA~MnU#*oB?07llzT`?932jFpz413V%Vhys&Z62w%3w+SNWULa zCg9TN=murt(7f-?oeS)Vul{gh2~P#V6@aZ?!s$u@cOdaTT5J}bZBRV%R|3Psq9uVI zfCIZ@N9z4PW+>lN;rlRk2Wb(Y$fu8=7t_IjNSA;^21AvZ>(^_y(U9v zlcCOp6HNFu6YgTd`%Jj|Kfv#p^fZ&s7hSlVt|t7U0guGxJrnVX$g&E$X7M?I>K~O<%J@+!@;^Ujp=O=1P^r3dQo*(5QtI|I7QHbv`)B24<2(S*6B4MY zC?1QYm$6?G_r23e%{Rqi#ony!LQbPw;DO6&f&0pM_98+h!M#w%e$PWLu0TZ#Gz$ys z7IxZ{vG2oU9M`&sAJf6$`W4z_l!}90jqMfRq1$n2_E&fVae~KimDHWXMTJABl&x?M zP{|+4NNK4=KW&tvU~oA7_oy2*Ffu+`UGum%;z3MRz*t7%AKQU~2M#Gr| zT?qANVSf~fm~lVdE~yJp=1EC?7@rHW(0ZAoK47=6YK2|x)o5W~-3s^apw4fHA?m3p z^(&Qtj-ldSU9t5atv1W}x(6GYUQrTP`&oe7lO|Qg3(m<2W|;$y#hP5d5Ix7 zevqNAaclt#n{eZm^omS%x@4R)jG@?`5S%kh4O7^)?<*gKdlXq}1{Rfbvs8QshxTWw zd|87%5{Qa>8_2@@yI}{kw|ZN`R^-eohsdb)wjlU9ESZPK;98&!YtOvdu{OQxQgwzb zp4ZiW>U9DiCcq}1M_=4uRU}bMWdqej^#$aCqt_F#Ke}h28mevw?4rUYPPg7TP@N;W zb^yUG!ZwP#*-m|0j!KGnk$xM33ujMI+HiFNm41oM#hRgN68xt}hN^c7p;P`abtF$% zhpBgk??NuTOt}uB8ZXa%V>u^%0vrd2tHTh%%i{N|Q0ea}wt#tg@x)~G^$}34c69p) zXw+0%Jwoke-;GTDy{Tb@Iu7c#;!4#6-(Buq$SChhl@F1z(eX9zgLm>u6(7+GX2F85 zNmVLu>8Oa8so_dBI-HwkK57?eF4~hAsZN95>b=Nv<|uWr;V@|J z^qd7wRjFus&2f7ag(V0 zLEKs?9iuAhUc7A%1RJzM34lkBbGC|G544Tbz_%gM~^# zzM6+S6}9=0{M+2^flA?xf(iHxSI&NT2lCahp~mQg#1jyB^1`Bc2N|)%auE2BGd}=a z4g>gO_#j}*2&>fekmk_~u7Z-GcicBl^+sxtH0P1P3Gm1Ln)%@&9H)AWwp;>`$5;am zc5IZt9_^_dkMFwhSsE*)KUM5_wZGvD#OdK0FMMm`ak~je$HzlpILS61?Tv3tT@5o< zLes7`I%~_-s{b=J@G8X zNoqPoQaercsPCd#{c0X>r8lf4%Hq28N8msIn;R+K`=3*A7vn#F3UMvUID`~88(rz5 zW$;xj{tHOa(3-+=L9NUq-TBuVy)E_{MEHV}ADZTeN;tyl`fKoxIJAEa2J!ci8}F9z zDSw=*`@raK>S16V)bd55hmLN8K|12^g&+ERPSI%CqN!?}_{fj`*pHq%RZVexf|Qof zRjQb(rUz-r!KtQ(kTMP0_ctBrLs{b#d`avFeEt9*kui=va$|gojQ@wmxQL)WLkhoW z|0h8eUuy`X`dW+zqS7lTjfO3YJB3o)Fwr`kewoZ}c0 zTbqH4$#uPvIP-e+U4O^q5%zl6IgM6aj~vl#e&{$jjaxrfCo_zUzjN1xVdH=Nbk%9N z?gK54zc(+Mu8xiT90jxS`ofGG&A17t2-NBJF9EXFJ%;beKtf+p$qZEOYg#`;{ebpO zS5s)sOm)2d_yugVc!nCI=iH$75z>zm-855;(pTMxm+kg5__!j09f)BzvCV-r{p2i+ zVHe-wBkXy)Y0gb*4u)8M*6VIUTZk6@$jxeq=J*8}u`)l1csjZ6#~3tqe6o{HRN@;f zHFGfa$>aZ$?o)TUeg#kK$ze7rR8i8wU3tH{*mVjdORD<~QgM05XxDESMLT{EL{roK z>U-)RK;c6$52|iQCURye|9KvjVWLi-N2Qyn|C~o%Vxs;!k4iI9XU?N~n5eVoQK=^C zzvofiP1Lzol)amY!nKKIXjefk%XrpHO%JOc&dzoOUALK!qnH_#G$pq1r z9sn~BIZW-~2YKeqpwrLHj~sCAaydS+vS${?%#IZQFy7uxxg3R2AxGg<#!)A#<_O;; z;V6PL@!|@xSdJ));yJ=WkL8%0#$btpxfkk7rOQ>D8f(DZ{8R-Pej=_O)$y~}|J=yW zaYn@|SKu+;kB;N#1pjjmKPUR13-}oy_~C3y`MHb#xr(2=`k(9gIobc*$j>RpbLAs= z?B++u@pE_oa}GbJ@-r;mxkOxie*~xBdiaTpL8MK~(YKfwrd*Winhg#PmdvJ5ONBak$y9I#+ftrau`Qi;5gPm5n09Rt z?P}ooS~gdP#mhX`nYCa%!v!Xc$bbvwHv0BQ)m)|R^(N&Si7vU_mVleJYGcq??^uI@ zo2PQKsNtRVZbu?AX`O*l{$zaQY$^_NW-<#~6=Rlz=lOVM18l);fUHS{G3TM;w^HB^ zSfloEOh+|Zg+cWSF19y5jO*7$eQ*G{s4te-&b9c&>Z`bRSn)U@jWCnP88i)-`Rnd;DGp0U{*m3aCj{qwDif5-C)BAkt#t?YUKD0D z;2bU$&j!CK_dxpG{{wwqFrDhhscz#GpuY;oo={U;*DNT&UlK)DVa>v$shujSLlUVj z6z9-NtJLq?&PR@{f;~I=KA+dgw|G?;6+Q2^=^LxnHIh^$)4NYeQTn8fD((M zF3Q=WJ0|8EV37I2=TY!O%KtPIPGH zR<%5BA!^jxi%~%~O_se}1X`fIyp#5BRXve+nP_eyPRdHnW_K~21le8!vZ)*9srsxX zcLQg&2phL0L2zjhTowf169nHI1TPJO?+buY9R2*fYNwo^a1iDYeDp!Dxa+bwcT?XuoE8aS19vE zwLjSBzNp@csOd#@itAORveuja>W|ieuKOFhY+8rJ%EdUa)TqOq%2T6Is@Q>3^k;M| zr0eyxU08X9{~PIe%4$P6FOkCC>d5fdE=sBg33Ca@OR8>uPoTIH7CuK`QpaP%FY{%L zE3n`r_NX@-?n-292x=B$?vlndc^v2&v4SUu3t~Y@WwD)gO{wr!?w_ttPXTIhInWLa2%58Mv zhR`c&9A&Kx3G+F}DfIm->QO_MZ7Kdy$g=b$7VxX;pT>-pv+%#*H+3oob!s@<(XE%) zt5tmIIrB9PZYBEY*VGVUh|Y;io)A|FzKMtdlP`EXX`q48cfOAOGL@@3i89|*KQJC= zll?7qN-Se1qND@_{dc#{N3|XJt2g$yTSG43dhH{JTZX>_3)O$ac zot!S8TwzHb<8cfv+OK+-ykiPA(1x;Rb3Z$95gPjjn0D|Yv{;k&?nP+4+~RcaT}UH$ zr7N5o!|^G-jJMUJjzb`G@ePRaO(a(gzCJxT0ar}kQBz#+1Ih2V8i7aq1QNDroFsh* ziv9uBzXMSmrep7@*{&ntWUB*N8>N1T6IC#}tz)V5kxc)6RZBRJ5g&6(e3amTnzH1R zpyZzh!Jh@eM}y#FLGb56@E1XFV*orE1OK3ds@>iMq+vJw9O zm8y2TVIr|BAI(>BsAdTEjE+94*&=yznTh~~Zu2od=fyg)2?0K#nh^e>8LSj=dla=R zdjcMmJpMI_h?lW_b6|HDTvjkz_sq+1a9O)MPOq8Ojq#@8H`kMSMm9v`yi6jn-3`AS6V$ens0^IgEy2j*oyn^1iwSJY^pkI=KD=b)2y$nFu~sFfI@G#t!3f zf{Je%;fq1|Q5_o+tT>DnM^D;$7;API&BHwLN8>I6{{&z0DXd|RsB^-3l;^6)Bk;>} ztF%z{5o5i7@Cde3S+-nQ;E>uvXOF0!PMnzkEE3myv7mQXwCzMWA7a#Rq5Kaq>K~`t z57p?{AJEr0f6Jx?uC0Hh;~%Ptt`lJ4YH&{6<*%mde|xeiCj|T917f=26K@}>GaM%a zx$v=1^);1!Bni~=8IJJRe5~T*N&}5epIklvQxzX<;km-SVBtTW7feU6$|<4R&mgLw z^iMuh&q=+1M&|7D;Wet|I%)>anndwSvre+aTnK)NIljPdWeeCCH3)(KOkuJ^ChrS% znRtpm`2y1({G?1H_6=~Mr4eG*@Rc@ooP-ZJo&6Hkz_&4nVOMsP4sU$US8AT)7i7vU zWQfG?#i{uUW)0^nSIEYXUKww<%qY=c<>`3lD*E+Ee2ozqpXB*kjW*0lA}Fm*jh8|G zZMx#}F*LT|Yc$$=D*hVV*Bfc>c&!(HSqdMCt{JakA9x2mMu)yulOkCJoGJlhUF4 zBVS7yIZvyF7E|$uA<-^N-KoKGox#eVl%+%8pIr(hOvB-Rg|J_XLxGDZES zM)myDg3sJVZ3o_7p~bdYPw!=$9{$*uU5s!gCp=o zaCPuAo3~I3LVt#zwFqR>&7Zlj3VH@`yMTgM0_IL&(eD7vJ>P<-k!XnOg-gep)76MO z3m~=9dQh&=JWJjTy2>y%2v&mNUvVjcJ%&~hPX}F67#9R@3Az&CyAV!j^WcSuHl;!E z0y;iB#G5%Y2t73j9v1|6q|9SB@8qv=K_F0~Zv*D)TT+82ws``$K&jpiI8chCg7V1b zJpA`Z@Plc`Y}r)v2!1xHv=Fn+g$?1M3GW0Q>Ax=s9^XPYN!n$XMgkuw%b##oKM>vp zcor(ilarMQY&!lc8&_n8ZUl|tb5L)N**Nk`@p#Ix0L(98!4hDegIKT(7+;HBi0$rC zvKA4(6!`@T;V!^fPCcQy6FT8BP==>*%s;T2Km1J3$y#UWrJw0t#E}n~^gtO;18z3e zPYQLXv1PjrHOWEXKkl%M<2{)i1pc#db1Czi2)Dyhwk*!s=eo~L3l;o=!#Nz~$8SB_ z;;85?*KJgOX@af$GMtqUtlS{;?0gU8YBeefYqR?VjZwAkLvIc``aU`c?iY0Q{W$Dr zpfKJBJd5(L@OY_CbjOlk)k3A)f1saKtrJfAf1+vLe!s&8^Bb`fo?~lb!|kM?9XM7I zv-|_|{^&Set7$!@H;g!e3hwWsNSH!&{@K=v4r!Y0@;1mhFva%oFNE(5f@cE`luq3D z6cwU%Rgc3~;lRT!ZL#OICCN!em#Ip|9Y8X3pxCm2V^e1p%H}W5#L=O#QkeR$Z;=XF zc|6J@JW}~eXISMoAxcV5K!F zD}PrqmW-2DW6YVAp@nu~w=HC5%$kQHzQTOwm|?EvFv@R-Pg*X_&@x=i&$uhCm}=W; z_CyHOcxTP#Y8Q~seD96?GFa=&yxI;eyghh3BR!&kYUFp-7PvY9 zcfq8K#9B=E${QVFFD7d?+2sU-RrTdaA4jfn?C9bTfoF8r!eU)P42fW3{ozC*RM=hn z%J_UeAOq!}8F0m>3cap}_O-aM-Z~~3uS%|t$kkdP7?VLN%ha~xFfq>|ibvs~MNTGu z4rf+REzIQ(;Pp!pyu+w!27b`aSsY^18+&Twg*^;x>@nEuE9-y*wOLvi)(dm9v_uF0 z6bzd!L)Ij+HEbhhX({j(9S0eaqqpX@cLJCHrE+hBBk<5TxFtsQ)(Y&N3kl5+!H;o> z2@!uM_{#5wXXO!mIe+S<+8Re>aLMyAb1u%-vL*Zk-`$sYoJSFTv=gx(pmN;jcsBDn z0uK#G5V$%YP<&sFPuTVDt38j@-}Ke8;i+g@i2dJ;C~Z6~>!+;~QF@pD+7c-;_`65Z zW)=6--htXUY*V`~!wKx3wD~gR5<^XwY3cajw`-8rAFJungS5N+5q^DVkT#3HPs5K& z){Mo5_zCR9&B@V19jr_V2yERt>-XhoI==s{4;+jP;7M6DMB9!-Dah7CLxyUjM1o#1 zRKt%;CQ$rv{MOZ;E3|SPPBEV64AXYta0;H!xw@d5+;%--OO0()${eA2R7S(Gij+95 zVr05>gqGu9FvT24GZbB=DI$dO$D+JbBeWDX1SxQY>Pju!&o$#ptp{A`!MP>-bNl*A zZFpdEJkK4e-HRhIEh9A_K5Z4>G2vGFbCh-$JYJ9UMgo?*$$;b~;G%f4d-AS|B;WPY)#%TkL^`VVi!prIbQ4Uuls;S@HQ5$ z^4Ms|)!Gbm;amGFj$IzQn(aU3PSBzwS+}_HSefS_bVo3|KggmBO`D)?F*L9ZmF45i zVBAElj|k_{p6g?Qw zhubTT45Z@JY|3P+=!VlQdDmz$s8``~H$Iqsjbw6Iz8){D1??T!bV{bp) zB=!f<(sgDY5Cjhlf-eh#@%u;DLp4haw7A@yAX;t^e0dN&I0zm>O$F#Z@G}--Fu{So zj_|wW6v8m|q@jgcdSA;)$Zuw;I#(W=Wc;x*u)6c?D;|L@f!}kvtx((U7>e>3#ch8D z%|*RO3CxSnbkX!B#)a&WVAJ6?n2fda?Jpzg7Gsc1<|3_^xK3ZYNP9+# zEHJ5sW_-OFPp8R?wdsx-0B0dFXE2lYFV>!qyuswS(Tr!A@ob!S)_%3$WP-`V55!ND(GrqeuX(Vact}MJ?pvhc9g#@!T%Kt^QQd&>i zFngJmMn6fIwi)wreDnBoHGOq6<{8c5_{vA0wOT2J(Ncp+a>k@s8}-N!kDwE4F{znO zr`Kw?BAWXz$iaXT@k1}65%{5CtpJ*k|Clz+$h3{Gum^s%mlUG`%LQnX8eE|FVlBEuHi=QgY?D|T6(vK zfDYCk&h%juZw$YH6R7w#9PP`f(jvl^n^~-Y)DAp1HFvJ|0@7#o^Zu zYpb;6@N$s37ouYuy|4msJO3}ooY;mhk%m@lS&m16WR3N=;^=B^ki!>@!g8@%v*B0h zc2{ft?W;g$`|rO(A+5$rVTRgyU?t}cG;4=70P`xF`#)WT#zr4)Ze;a1J@}-y0XJyV zHfX7lY>BweERMB-DXDk^hOmE8{uYc1dp2Nhh&u3d`H8l0AI!!@6x&8E3p1O68@1Ff zJZOa>56f6`zC54feAgjg|0}Q92wf?Ip0Bs1&7F=i%==~`EAuW{--2ijm{1tu$r~E0j6723%n%g**$#UYB;@)Kq3EWp0 z#~HH>tBf^4Tu-ZuSD5qyyYgU-mE33 zF=a3)yp}Ocm06aRg2lACHOJpJYr}d!3y@{YfyrA;GAF@5zeJ(RED3f3u_TJ9_*vM; ztzhLO+o<|k2pl_AyrEcn4}Q?RpafqxZeEAq2y1*+3p4i5EM?^s&$ZUUu?3y(c{3yY zg6$S9y=|=tzVQFB_cm}+j{D>PnQeCN`<{o)wp+W^rrFwRV`(BR!lY=^Vmi{pv5sAZ z9ATq#giV{ru-I(vl_P9~9E&Y!LXOE}5w;_QusJz$gzX5S_`g5b%=f23#5GS0eo_`P|{Ag>*&mM$}UaI;4+WiyZQtE#! znoHobl5}j7RH*aGo*`pn`{-qmrO8kk2NRRKIhbzmyo~g@ypt*H9nBNjKxc)bwI*&L zSxIR{0D34NnI-{B0qW(^{E1T;LmqObN}k8bBO5`cTGCIbQ4cu=Xe=RFWH3)gtBLR| zMD9j}bXvOEc}28YftXk~qMNbGi>1ee=<_p`?O{jec0th>2^}O%FRR(JFkwzB2o9u?pv(@)Oj|zC%sBXC)Q4me!%4{f&-^o@Wvts|AgYp_aX?xBvR(agp1m7aObmI9Gx-&DE?)%Mi7eM@b=zamc(19q zA9LL0X^K9L4DXs{?2fgq86R54S^kgK{xB*1&!qIGr1VEg>3@+H5>IB%u=nJuHh##Of6NPc zC?s$--~ITct5=?czuA6wzWczfyl(|wrt4IB&qrqMKhZ`66G{5Z$l9lEvx`|=U)B7S zBe&~UWQx(;Uq>68OJpGdT1r*7uY}hB zJF@@p?dtvK^1BV(K|KNLkUts3&cu32_vIs)LOS(>w68;-r2QDJ_IGOFzv16&7Npq^ zkm5E5)ZQ4=cqfn|W8|8Eryys7D}gNB5}#%}rmKM~k#G6#!%#wZ(UGpZcz{8gO3>+X@)h=S#{f2E^Tg`ag4s5vXis0j+hxvw%o+gCa;2YC%DKR;5kj~enE zMJnd^$g1@b0=%Lr+w9zz&Lo~C{bcCsy=Rcm*1Ul9@pZg<^Ya!maAnB>M{QdfZ~Djj#-qM9Ki3^^@z-*{W+$Jc5-b4x$2q9 z!!JNq6EKG5h```SEPKlfF#HE|kqH?pUWAw#v`bCg1xd?eZHFf0I&9ZmMG37O9$$3r z|3}O)0f{3c^Gn!rNgbtTz6zmQzuIA1M@Q>htroAQCpD`bIo2^Lo&{1o8To9xf1pm513KgIwI7GKwh>+hVd~N2pg`a`etSfyarhk0dSSOJen_jF&kvPHdYz zscrJ))+7!u*ov`rGlD#m?H*fxV%x4aGxf9+z58Xy!99K-Efw3Wy~r)Zzchb}Eb9Km z@LsS6uq;~xWp`?HolnG_LIeF6dD+i4Ru&biY>mU)L#Q;txiM5YF4}~~yK3vwjzp6> z)396PckM87y7ls(CcqHIH8rmQ1EsBbS%>Zta9g0{kCAM_m&tKPYmV08+sY!@$|In4 zrcSA1`iM<0+}Xs)gL-+;@+xTM>`4A|WW)9((wc7M+{pIz`EXN^e&aW&pPwf%O(37! zv6Dp-=gnKhnCXNjp@i%h8vV%R>vy58uQ>*!*(R&Jf54xgucpY?1#0C#pfoNFz5Nf! zs*DP1hzTbmRL#!USp%+)Sm)^3YI!$_DkYbkbCPR%sC*rDk!|rCP}=%tM^q7SB8Z=^ zhP(+Kg6-#<$Ofi|o_bR<;;675!58-dtVd~rs%^dFOS$ariv9DusLHodNFAhBzs*L#?*y*bCI}YWU5}jlb)f?*cv3;{cP49rIGA`nUthbC+iJO7z?GC(u2PBn80BvYRoEZu$Tu zdb#@S17>x)I;z>xTl*o*q#v@CWE)jdS8QIYG1qi-PoK`CqgCFrZeaVPu!9bNhS((B z3=aN~kRNgfLNmG}>f7je#B)Wod}Pvx9MTt{`_N%(#|T0}&qNUC|B!Qfdgzc39p~6Q zGuq_Ot3qB{WnpUG^iM~wr>f1%*$3uR*(Nr2$55Y5A{07E9rBUm;yyFU7L%|E8+0n; zkon-J4tpr$F}Sn}Q{*ilMI=`DX5wSbV_7m`JdMzle>vV2vF74qa=NQ<6&HL?-psI) z9%QK#6)Nsn*VkNez`^tdJ|JzLT$Zv5xpk3L_Z9w(c1cQkpA+9}C}(d4~q z$XAXdGwzEf@8^3m{XIr4{*sez(N~C%Gb; zd`gXy z@@19r9mzG(pm^uLqRpC+ZZB&9!Vo1XBy&)Yuu-4{vemZbF7r1XE1 z(qAT}x21>9-sy1KJaS}B;v?t`Vf>GdGXy(nto9?wIQqNriwyIzTw{?fBi#|15l8gf zP;b}_?v@KZo@RhNtcBy!=8FnMozkzfSPZX;q7fQyI6xICjH zm1-=^ktbN0sKZBNh39S97Yem3&8)LJ*=zmaT5n|>VLE9=du!qr`uTy&%{jAK`kW}1aX?_o*&{{%U?`Xpcsh}U0b^Qpx{jKi>O z`ecZ4Ax2H(kChHAQd5Q+L(_XxRrlJ(SJ3nYn4~ogHKxHM(?=XoeD=_!VNCdOeG(D)_MF7mL7@{*G7Ot49%kgKij$d$ zL813fHc-Y^s_CPQtKhS3zc>DA9ZC}d9Ue96C?m7(6vJ;jObtAR#a^V+M;kr4NvzLk z;}l8_>46t;V>!A=)st;E+L)AnxQtolJ-|}>PBo@twlylF*LihgjGVM19P01;cj==1 zV_4nDbJaYCfTqhw8s7VNj3LnPV6}6saajMOq!M}{a28twfkjz^qZ8k$)5jSfaDCWO zaymWp55{>>B((Jp##r02p%JGU=Wu;(XmP30Pwp$0 z?`3~92tzhB)cFjFMa%=-uAbg4U&Aq@lj-j~LZ zNE|LgWI;z2e1vHd^d(Dn937J9bNO&cv_3yR`h2yTd8V|AGM#LzAIR?Oa zt&tUZt5zxmP#17b^OkElZx^Y#*BJ-%wfZ_^f1QIkYM*t=4tZx8vkZ>s+io$sA0>^S zOh02slC0}EIw%5iSzFyXzI*eTz$cNf8>P11V(dR~JlP9)1(fI+_(M|qw4`*YI}pZ5bRx? z?eh2*wX%|nwRYTPEJa+hxZW7b6qz zb=8FO?lG&FJgbha|q1$1wm)d@ePfL$TP}R;%0YGrISY(Ow;Ga8lxHp2^Znv2)ei_ZbJL z{mG$DDzJAsFuB(AqQw%Q3-n9T$&oT`2GFL5YUce$cG~%oY(hGc?2}lN)N(;m$9z2V z5M9a0Y}5Y>ld{G7Um^V`GEt))!>>h#*ES_ozR0*S%{D#s+20`H5E-m(U}Djdv!_8ZX1l4eIZ!B3KGAc4IqVAY@N|1P^Du38`I^$vdTI&2n3p8C zsfIkt<7ufMUz+;yWxG6H@B}nmRd#k{2OP@hsU~j_8d($`ca-*-1_!=Kxg?=fRq#&inG z*6F}U@aYxmfya!I{bxj*iovv=NnYpk;gxPHqOtF>464ddCoW^RR;t;{AQvjtW6O;D zqYJyS4-v{`=A~F3Di!Rnwl$^YD0`KebzBusV<&V>g`Gu4>B`I$?_$Tom5J}vl#N{6 zTYYktSzC6Yx7ODQ4kT!r{olvwRt``pBp>O8!ABr!e?D@CJVTybwYFmpXV*bE1=WNg zB&v=A3Uilv%({L1+C5j%R*Y1_8cYKGH21_3Xw`mrxm3MPYd#25Rko;$y|!=yHVXSf zE{Eq*kMHhoIVw1~8xiQ<>BuSaHs)6T$~^QQ@8l%r{mf=RM9et)@R1Hr;3Jq{(k7qr zd}Nlo@DboWfX^sCc`EM{!df&`rWdG|4S96@RBjlRQVuobEUq2ha#y-(f0rRD?_J%p zRMD`0Zk6>Czq~f?1NAOKrBHSa20-3>;NJ?q!*-=$IQN6CSq2jqFrX>xHxW4{d?*T* zvhLYtMyvx44j*QP4rDxT4AA!Bj?k3l(Dslx&p!d;#pU}+$Z3Z<>q+QyM~Gl_cnoBy zfe(s>*;7z%SF1lirK!oso-&S1>wFFM32@8!;~O+RZ1l^xHgU0O`BY`=xi2SknDcmI z*r+)5x@cK}oYu1Z_VJMok78AC8iA@==R`B8G}GDV4f~&@u!g0^Pe&DJKq?sMn)K~CQgKy z&l*{stD~9P?(c!m8W&nO@k+`W>VapWX>N|@Y%^J*_ntLI+HALk`ae(a=*d|x7++u> zcIt~TO7qmp7wK$`dhbO@yxH>AU5#GFI?PkIt)kpK_0cNhp7eRlR|i$zhkMuSSHt_y z3q7>jILvOlRa0}zUNt7BrPVsr-<%oUR8o0;lm2E?9|YNa5Nj zg*8(x{!tvWNoUlNH)ikItjt}}XKev!<2o3IdNuP6BeU~@XpT0}s|LPdoNT*W=Q#YH zR5@tF$48KuOvu7$ol~i9VcwJ~e;cX^Db<0ubyJOR8#$3G zkVe1GSva_BhC5w?OyaF_5pso^P53}bK(7ojwz`8V1wta#_IU>$Z@QZPPL#$aQ0TkH z1iiHd#>8k$*<9187lljWJ-E=1DNLNt`6vs5cd;MaJRbNy zbvC_cxI0TWfrLChllaI8K2}@bGy1jv3O&bLy|Yy5`$k1xE%^l_p2J5V!vdP*PoVx@ zeiMTEuJp{h4~%--eW3*(7$eiV3NXnjDvLiB*K@%|@{DNc%i(cz5A1Dr-iV92Y!+Fw zSYD+zK7fyC{!4am#vhYh(2G_1hpbA=x7{HCGxxRUN+B6nMpDKP@F9m==0?VPtG|85 zGf6Jx!%54DA8WHHDP5S9ziU$ZBmBl?HooKUtYeb27_k@Kbstvn>lKtpk?7J5_S?EzgB)kZxUe`WSYI#oJxgIPK?^H7<7?}eH@JNbh^O5gkqu(dBG_J+t#66 zoi&APS1wUUm0|(gkd>CJ)*lLCX`Ywwu3dUh5PJ3%gCMy8jqgSr5>A8HJ%{ zj?E^z9@J>f8?XSCUmCf@AHVHODD{r&y)QXmFk9RPl@^Wkn=cUI%yjR``^@p zZN|IU(MD?%Os2{Y&gqFJ&8V?8sKdX85)tQKSt=QO4j*Y4?ZnqccGtvL;*(89(bsqI zT6+wnp&c`@@%E$g4SoYT7yDJJn!iN^ESD99D!wtc+dzB+zvDdk7*!QWul`$P1{&$r zZp19Jtht|EC+#FT@V+&2BABz*R>s@GNO0@F;~oU}75QeHng)=X`JHiCq_D~xoYOt> zKB)-^lOiLlhqNfekkJb9BHuPXGU|`jkneQ|%fILR`&do?-Z)Jo-&g^G&`8G5zK6+^ zx^Ut1!g&OD7?JKHCVT|NNLif^4r04eh(WH9-qU*6sc`WQBa^RD!}2rhb}*RDJB(c2 zqZr~B8L#w6058%|-cFA92`b|UL^%`G;xu^89Xk5EXozVnbhK2sitd1J;SiI13040pJC zPI+(QYz{lj(u~GkG7Nc(xL3mrv&zj zhh<{$&10D)OC4vKFLquUO-gC`lMVZr%5$10dlDZllSkQVj?)~?@Q1j}>^heji2S@H z`b0IkOmQ`mx2n)>7Dj)ED%|EgBRxb5qt)6sjO@BKopH3uGKeb9_^TB9FU3He48OAat&;yd9GRO4y zd6LpX6v`avlBB!vyBD7ru^3WobIeEgv^{pzc5DNi>-%C|*@uv--fre3-An0R>=Wsw zt(Q4KRo&d1mF#9tlotA${gl54kw7MQH?w2_-Sq$t$TbfpRi10!&lf43s~}?q-IcDl zc3*Kzm>zL!MWy?iHM)7pBf}D2I@)~C$go=T?&xU_Zj(1&?}@%xy@yFZ^DsV>na@=N zPw&GXJqz>{{wu=Z@LXJmDy9;MuxU8Y{GrTT)tqgXv_At%>g#Lvu6v2y9PVYhNx#y| zyeslJ)*7kVeUcw0cEO*GD6MK4$8FW=FzwB~&1rj3L)&UC8IqnS6qsFzCDzq)EB_sc zC~EqdHRR1J&|qad)a>2kDe|@g9KYoV5Co(5vl?=!d0wcwz}#VLXXIP=Gp|dk@$Wxf zV^N{m)LxAmntZ327_A;-x=TTs5kOz6e}hdbmy*jypoEOF4`-Bl1` z(3f=MlD4&v!dUsr`k_J%nnmfh_mwrqJk3U=(lG#hOV3OMKVwYOGnwg%A^uhJ^8Tpx z(D`Fc+-pKNjWs{*Zd)0;^kVZ1JNKR0E@k>xtLf9s!)(vSQj0Hyaq`}R%&F>Tj_3K) z%pBWuZC`G1cnPFwul2oyqT*7s*!Fzv{T-LmuNPt|&t>L0wik6uN8taR%EOMN zSBow)eYRE6oT2wFGrzFW6|KeDunARt)5?x!-E?!iI2E9J4tcLI%{1G~k%Yg>EOFS@ zgr;9>UYLf1fmS`6*PFvS*j|m);XW)KVdR5^Uh)rsCaJ2Xm#-zfYNw&s64% zTv?^_m(4TFY;T76&A{FYE&i){dm5o(^*dc=(j8{0?QQ*_HcZTq<~z(1E?|x|Mx}R} zxmvfwEi-52Ah^BLjF=_#MipY-udNn@1nz~Cy^$FT-es;&v%RY;2nFso*V}Yquj;YT z9BSJTVvbM|z87gw)XKB&Gizit8|NY=Eqs6i??)!c_cyabmo-9j|7N~yvwfh-8_Y-3 zn*r8bR5d*_>l#dZ$p4Tz*w$ks59R#&F#7$^==UbRT|`?<%MR5)Y=&)~k9Z(>GGb+( z@l*$5#59`2tbfIxt5+J$emy=Ui~I>HxRlSSe8{2sj1TdDF<-YNOB$bEpfC&t8(lfr zwe|42Lj_ArHzI#^$WrqbzMfwSFhXuVW{NWO#K+8$eBJh#c}(;|xx9mIJ#`pnnMLWE zL+NWQa+d)D2dTNs%#%CHq1Bs@4Dn-!`s0b|T~tFyI7V*>*lK>6I4$d5>yQOv2Am1| z6*4bGP`ff@p2LR4fU$5nkg+**)^fI(Dw@Oj)%*gYf$-x%$G`P-YqN6y2XYzge0zqp z^J#2GAWu4|#aDH}F1Uo&s-7^jtSzyZp*x;1GaV{Ck2+CsLe7TGRjTo?pqq-bSl;C; z&3e1-iwHbayucEqwK!^DUDc)TP9U~qm06$)?~IjQ^JP~vG=G)p>!1qmHgiMkUp5yK zc+sJ*c*PuJ+osrPy_Nq82DIZ9R{fFC;jfz6hUY6f6C(gW44wXlKv+~szV0okmdNkW zob_fFVHh2uzrAbrGF{(LYBb}#r=M-^BmH|2BprFRcWJi0Zj)K>+0NU2dCM2jHss)a zxom5b>9u*j-StJwM`lerK>~W&yUH1q-%%n%O_}WEc)vqp`EKZfN@9P@ z*M5=jQxz#Z#hR+hPDNT$ROBjEWuJl<#~p5EslpnkPi19t$yYevH4TY#`IqKc)jS`W zOZ~guL5@qAvHb6t>ZU;)eLK3ie0AUEnX0tj?N$Cf3!j$LdlGv!&xwop7iPW=wCYtE zw_t@-(}@y|1q50w9Bbj?`7c+Q3Z7(Dsrs>2NnN3PRj6Vs=ux$d^%TynxAK#lHD7iW zsH(F)?z+32qgCTYRJ8oxJ<%Av%J?hByJ-6WM%1_s+O5UM+p1Tgv%EjxYwi8g9E_)i zt4KAc(TVtYiZ)>h6nwOo-6K?wOt*aRqZa%Xb-aHf<2{5_Zq-SJeD5&njT{I9zF zs&OuIpt5_RMl}Rfp6$s|^-HY5YTy zSmuu_!=B~lpkQTxyIQz}nb3t>wo=#N?|dACpAwsQ{!wi2;{91;0riYzP@j}A|BVM) zsAsa6wDm5a#(zFg8i#!VxmXqMG*?7sc=FjE^mJKPmUAdwksY%GEp3IXubOkHCtsE9 z1nE@&VCL5?rqYV9g%av$fx&ix@2swZuBBfhQIT=Uw`@bkx73LllLv775lUjETK%IK zYAkd!tnT!%><4$2tllYBD7oUPOXz%A2gXwW5wKKnCNAVvohVo`14#4U02D0z)S0CM zHj<@hkt{mgm8Ir&mtsG-ib$M)yIUQMUX2`9k4PjOTF3S{ZxRV7% z$ZuutpT_(BndVBDHBL2MN~Y%f+_}o^;0h+ph5vOn-{jkz!<4s@xk#$tvv>8|Jh`g) zdH1kg`rj7zrXA`Ttm=ORKzdgu;d12&2|>5 z`YcP>O96(Ezq56F$V=|j{Q%^{qUuNyqunt)`mJRlr zsg{4-%@zo^Et#RoreSqXzjB}EW<5JVPlb;KMO4*!hAICIyzs4M>#s8U2w?w9!I(HS{4J*y)vfDmU7g&I zUuK@$*}%#BiyJg7Z)itxz> zv?^6uA-g?Q?M&|=)tGMCIX7*UoSTBfRn=#v9S7zip1zrC%|Q?hUO(-GuW*{R6&FFM zeh>By3&m2{Lu6tHSzeCNnFn!vOw4n8HC^49!|4%t70_7Io3pmjZ-H9QVCU&`Wb+Vf zqNbp@JA&QsoeU8^=kHLo-tBm;Re$7mLmebFU*l&vTfQM@<4FFcZu%gXSzGlf#P5@C zoDz<;3OerOoD{?$G}R9d^?AtEO*I|uD$%DX-G1m`Yv}(7tzjMdzlhdI>Wro}N|>Vgm)2^NkyBPx zoaP#wFt`GkT3aF z@lL9V6}G-z^yB-=EL4H>!H)jb%mX;FP*vZA`$5aaP}YrpSFVMuM>Esh@l`D3LvIGx zJi?l$n!f?>t$D#+#1i-;6iTU_g@ZGJndTg~PnDv2ig1v=e}H?hE`~>om#>)N_R9fF zSVZBfH78Ut#+6lfKD0^27<9F|K-DO+Z5RNht@)s$+vsf79iU0Q7d6dYGSgY23hM#T zs*zMzx=6bCq_aTP980vM>UzP}!#xv~Kg_en70v+1?t=5(J=Mf3pwud^q`ijEIIJrM zVC=^)Q*AllT?959veKEU>^nL^{?~xJYfhy0#+$H_EgAv%wQw$|Sxth)r}3}xWDnHt z7iMLs=_D(d7RMDmWPitaWBC?QkRaf6U?*d4xlnymkp)asbgvb|v|Gy2wp1(ool??d zNanqhG?}T2z@SHIIGOQ2?TyHytPp}?=VeoCU7Ue|a_1reu}WDrSl`QmM>d$fo6JHo zjViO^G}OK?xriR$g>}>W1`a=Axx2O3xXVzVALZ;85ir!8%$bTrsxkq({58M{m9dE9 zl89==4Ia+OrvI>{!93QwX+}pZ48~i9F&RU&2d(0>uI$anQeX)R+&MP0WF z`%(x^^t2@jNJ@j&u)1<5?EW;@8mv;?!8+42HQQ^~Y_IZu;3^4)XLt&1Dv)dayrT-) z;KT082|KL%6%N0~0VxP0m2-U`iIu_j8NAKRho5jwRKwPSOd7c=Mb#hgiW5HGTK|(g zDhJ6#h#wmVLfN}uniRy?Zss?m0mVSrj~REvS@7zJ`Ig|HluAI=dOWHvTM}VNt@zq> z>#M&s1ggBNq3xQ!LIK!30SQRz8e86Ee}*T5>{>TzM35@yO-38G2r$l2qh@efCiUg3 z%|~=54BlA~hDk?Hal#z8*QL61cGsgp@y@i1G2HA*)D8Vy>_!otF;fKzvbgZ4NTW0c zigT$NueR4C85Ae^xt2Z6W2o;YSlxCvV@b$*)=kKIy&WuXyP`P)4WDNXP@`W3PLM^j zi_QbJSBG3&MEAWpE^=-MYT?e?kvgW@K<#h1b0c`F&4zQ=oe!HCU*=S-z7~&O#ze&T zx0Z*-C$SY*h^RdkW-nz%Ec01&|*cvo<2Xfq+N=%X(Lum1rr<#Rm8x-l-& zICRHUI=ZSmi{5+`v_#-Qt3*9F)moDU?nAxVkaK^-eMB2~T$aGq zlWI#)(Ugp1jdBOUeTJ1QUpRc0@*ePfxDTBFthKHjRd}hjP!)_7=_ERty6&!EgtXHN zqOvdDrEywWZ*P!#K&@EDD*CU1dyPvo0`onkYSv9u-k6O~N6SO(!NQ`xUfU4DRQJzT zVd1mKErKqqxJp`ED0H+4FZ|2dqw|jTR3!*bA{1J&dz>m%E{LWl0oTCYPbJyL8*rIrbwTZ>R{XQF4?!^yTL*dPDssbF#zBSQY zEuj}R5272|{u^hWsX!E7Y)0td(I#_=tlw#6BvaJi4fIWl&;}xd6KQN7PA6f%yYX<2m*D9W~cW0u4rD305<9m)we|9;lNe*~MNte7!O9LKEcNz70y zSMTLMil)fKE+M2HC2Wif~@_e|PT!L>dFK z9y!W=ogm_W9dCnufYGcvR;%<**r^Hyc$N*tMs3lZ{AwvB za}D?WsA`voFwr#}#u|b(VANDI*Xyf@k`}CkA4`JeRNcs(Ons#bTm^NnA|&%&DOl$V zCa?4`L>ZNR*gY+0?2Dx8A7H}yZ_%md$6Y{F2@q5HARDmZR*P^RDx(gmT+05Ifq%dT z!y<^FKA$mEO{bT|+X=`Kyvv%}E?71A*mdonl)Q{$Ef zdf(iLUaPD&Hg%gD2?^rsONr7-o;51h@;b#)+pr+TY)bC}R{?@8MRcrboYS-oS3`z4 z@7dE{jq66#vf?}Fn&0K(=(pTib-gWbZQ~K3w432uS3K>^sVe{xHVuP;ZNYCqRc~PY z6>>uR3*1}O8aYB+8j;8cThJ6X7t!^`XPJ4rK1fy8SxZy)z5Xnam&RbTPUe_scz^-q z&ZDZm*huKvylVbj*0C&)nbiAr-kr>v|5|{s;zByxatd|{Yh-p)ZQ9MBxvP^8M-Aw) z#X~oLHE^#HVbk>ts%kC*nC5>_U(-Yktr{{RN?vD(^}WFwyYGNkr12Y`V=ncuixpd@ zxtu-OQ_VimJ+ggpFJ$AYZLf%HVN3(4eD6S4q1=7QIwlcC34V_&^ecyQe(OEflt&ea zWoU5-bKH2WJD3VYM)zlTEUIzmq-%mhZ9K*UHj)kA(t~AP6u@r0;$VzCR(#Fz&@vv7 zs9E8{(dG%rzy~d#rz5mZOc0DNJmA7kVn0eQeF*4HK&AIEsb&{8L#l&pc_(L3Ro!om zPPsIdvpEl_)q8iWvBvL_q z*Q@QlI3n88j0sfUmK-`BJ3PfqBjZZwt*R#at0}(lcbE)oIEfqJXl>};RBMS1gm`^$ zA6XOf=5}lLo{e(3=|ZSP^yvkvUU7~t>d&J3*1Jb*fde9mf>8Zps}w7Uhuzau%bUD) z52Kj>Zj?;uF96|QjH&DbkbBi90OY(YoQ0}t0El|l)9kS34OVI0azJ44NYkXi1)7MD3 z#y#kA*V%xDZ5f=oHE$qk=wzrnmsp4e*MOkBvw(xiHvx~;qudy=tr2qK1a_OoNZ~2Y zL26T9NYFwE4pmbJ{$6uAHxV?S!*(wopD%R&sJ<9_Run;u4!#nI^yg6H_6}f&!0T3n zmC4o@Pp5s<%(ZZg;q^2+Pl(nPOWBK!pPA?w*U{UWNzMWl=*zR89zoV`I)cu>!U($j zrX$Gy6-JQrn~tFCuP}mczv&3N{|Y0>{Y^*E<5w8LzQ5@Rdj1L{@cpJE$omyW(CarH zLGNE-1o^+|2>SdABk22^j-cPKFoJ^LbOil>g%Rxcn~q@rUtt7=zv&1L_!UNQ;BPvD z0edlmP_VPpZ&TY(@l37T3}2g5Eh4S!T?nD;ppTIlcs*izBvJ&ScXvYVstIRN6Y|drRW$}e*n6a_M1?y$!@qi4#R(dHd<1^Navrmhf$*-{D8+v+da4Rx zp5uSQqw`quS)H6Bm>6|4+RC^Ja9h3;jbNH5Ypipvsrm0qB2`7@pq^_fnyZga<|YPBlc z*`lW1fNZ_`DG^>5Bb3|Ffd<3U^p5NJ=gnt=X&UiwfBqp$WHn~F$I*0A#MBC1IOD(G zg}v3EJo&0B6Gl{vN?Qgn6BRy8?uu_fXYTu!Nod|r)&?6oRq=21roQ29y$V11@Jc9% zhzu7!?<^Htn_xoqMP;zAYtq@Gf#=+C#BWhSt5{Su^>S{mJCKS~HRd~&QH)#1L^Tg1 ziylB#Ka0&i(HfS}#O_Cs@6bWzk{XLjR38Lk8l>$ z{R;@wvWZ^`B)|=AT2M6?1D%a;gD-Xk37nLiK%F-8(who%z^sTSsQ!T% z`Jj&;x4Vy2EhE^6(s9*XOSQpkJ1zy@8}D_2m1lyk z8t1YHS_aWn^H2o+NxG!mLx6nWP-iaM0%n);Rz80EDwFmyx=46AD7{KNv>6SHO2F3rkT#SO4!-}bhr`youZ-zG?e?R8>O z)M`@2jcrqI?TWbd?*y~i@eE3VvT{s+TDF)`JH=LWGi^rK#wt`T2oMad0WF#;eT}_r zp5YAI2CBR#h<#9T1|}QJ)yy-T+?cc0gtl zX_csYnUZM}oWsQPtUwiIisnOHDFbJrd#$4w^;!zN;zR>oFtzaKL!-v^kL?&Xdc+X>V79XaQ5d2Y zjK#ioZw8}XqIXP#a;#bm1Y;;?_r&7NN!5eYQB$1VF|F1P(E?~F#PXG>0XL@o&vo6L3AZBF9J6s0-)7M@1XXuTB>CUOi>#faMP`DRGOta>n;2PJe zM~0~V3=sEqXWM(vqnGusLXtFp4D7G@ycgyzD@3m~gC=ASRMjQG@3=!;S+_0+aKTBc z`EpD_LTbtktj?M)aZXb^W;lmoS~jH0d6;UcWVej#$1G{H5z&5QHZpLyQzguj?jD|N z7-4mQuMgLvUH1z2>b?Opv--PWj{KcrBDP%3j5Xa0bhI=A;Cs+-*&?dsW;|l50wA7T zJ7r5Rcjl%aq7nVZ!>r7@abj^2A6l3p?diCtGcI44T~~8A?Gzj!W`nJ3AD{G!MPNhh zDPRqw%KKd=z3F(j8%HKK<$g#&li*|yuR~K|wssB34`aRCI;srbgVug= zL+ItRT%%QE2IwxlUs~2&H<-+S5i1DK+KMl7=GF;|65au$pd&Ff90o|>23w?d zY{LqsX(xi5oc@INzS`^Z!W7KD!Pzf{3)bA=oCqKcyb+XH^eiGC%}e9@=2uM_(h$um z_kCI~W|yU;UB{>>3z z&SF(Rzy)2f2J};LI@qtN#<^4+L;NYlK%Ce(C0)G;6%Mtfg-3pny zrW#i&e?RCK9V?~jR$6p-0~>3j*UA5YeX8C{wDn9Ix6^fiJc9-z+CKHSL6EY2&JHJ5H5f?>t!h@hba|gzOsp zvdb;;mhQpWMM$vPEsIQ*|3X)<8ng~%nTwSx8S@ZqN;8dBOv8$AOmE$JICaM{(%y7B zzX0#*!1Vsm8vBDZ+wJ+_H=JdvaSn$Yo>AZ_`3Gl*A!g=@^ zi2J6U&{;_wM*_D_svsC?y|V1E{;(k5fFm^RJ?}s)oxJ^B!y>K{v%ZH0Lv#rx z(rV_7SQ=Z?&GbsUya?^40-td%`oxhm*e#o7`5dZ3hxzc{Prl}^%;?||9vpvaXt4<@LSIL7S*_aBd&_=u7TFi!Ze<}}wW?8czlu8?8VS)(# z2q56ZK_9cJYTgO`i4^d-B;R3WYZkJy8R~!sz>!T{bfg;Pria{n0biud#R*(eTW8M7 zBQWtRtYGaWU{74~8uuBkI2=-O(R$E$;6cV$e;&REITd}~s_<`8N;nxUV2W>$1Ow}p zc%-zkat21u#nRLNg=R5EJp%VI?gC7Ci~UT#{~@Nl;$x5-=FCMAgxT~ELumX{8$Lo) zA?=2YiG_3#Vy@zLz@cif7H&ynSQwrEh{X5Gp*ij4UvQjrY8-CCQd3^Y$F}c!s2hBE z3MC8;(!04>AbHc-e+{3~#lT|d_##bhjVfZZmo8>v#9gONlbyw&Pc%5^@@c)}Ol@@% zFmcUdNEtm+?CWz>Zda1}e5hLD+@7#lnx%C{SX$zX6sYFA*`XD`chxBGg#gd|$DFv6 z;~;7ht9@@;Cwpk} za_7V}?iROQZq10#UBv4yMv>)hu^CEn6#GFG!r-o&}}(~=?b3IpR>8bf`LEG zMH~)^y;1d&NM2STJqW3-E1cPUEe<<-t4$+ipAE-iI>{lp^h=6*S4QZ>m4N=Fm#Lwp zgk1p{hI8K1}O+(LaXI!u$rE@VnCan{Ei*M_Qcg`};ODCgQ&sJcRyhF3i6U`fmO}XI6%wEeY@@^27+YuG!$pU17m0 zUPH~OcO`c1uR|7XnZa(&RW{jt;U56z;AOOv^vmx@YNI(hM3PAOQf$-b5(upL4%LBm zDjPw=;U`%n-vv3|+A5sU_Hd{wFwuoj6ZLD|NBCDXzRD@0xjg?2Fa(j-1lVT2?i`vh zq++$>HAI>5-a>q@12@Gni{7)ltkW#ja-FL%VQ;i6k0R{jPQt`{$AeCT9RS`Ww?i%3 zEE0kz{4SH5RAt64A}%#^j4M-%V6a2S>uNm*W{P?_`ld{9j!fPRYZOktHVL}Rkqu> z@T&10j$BCL5d_}Y@($}4BcC83!~;a1zes)XO+CjdlYw$r$BBBGyVL{4&9RxaOEJDk z*uy05Ha@z*XC@@HgtZjDgOJ$}Gz+&uYSdrm;an2jl>eaIE@SjdD)eMEs+T{E=JraE`d=!@WIt1Y0kvOOjwrDDX zB#6l@wJ-p)3MqjE@%NxiJ%uqn51OybwQ-S;SO6`|Ho@&cvF*^70dZC? z@@BbPMT7C8(3WjOkr3dMb=yBFnka7RqUmUSp%1h7ISn@b$0>0mKlzWdCttcFxnEMU zmA9xZsfA1@T4vqDJT}u^lM|S4tts#d)z3^q_zj|i!OOs(;Yv&iaA5-Hk3z*?akMO+ zK+V(&^3{mL7D5I%VK;k6NBSB(9}AViQ%Gvljoh!uQZz*}f2+@i1R(;qLO{b1b?iIm z$#lB>J5G(~_TwVD#-nmgRr3M#Jo7(HJbC%`9ds4akHX}*q7@+)rm2tsnJd-l-@sKv zC!)@95`3_}JF#56w@KJvS;v?tpslq?o3SG^P4f^V;UeHki*1??W83)0FyiWUyMyxI6Ih#x+yhCPey@TML7!|7gc4Bc~X8xk^pm5v0K z;B_C^iIgO9X|mPQonSODLjlU6iEa8={{x(-Xya0beK}kNb_ro$CO+$)CpIR`byS%I z670eBAut2ZTKljt(IRY7863;x z7o4oxR3@?PRw3L3^y5_C7IAs=*ZNEy(xB!BGy@F|rvB=d0(?IB#o6$-!*yE3Zbkd2 zM_fcwgz?Zcz~H&G8JF&91m``6nCRd0j>6 zVz-BT+F1ONH;Bnmk=vESE#{-#u922p1R?KxshM6^Cf9sF?soN4n-_PX9kN+HqVIdC z+1b4a6z10CXdI(m0PzSpn>%Ni4J=8|8tGDu92$Eb^3EvhdW>$O|5MtY0NQ{ayTouT7 zAIM<91y@5&7N}8Ut(Ozd65)AOV1EFrF^y6!-sY=+$lbTqFkV<*mNp5 zNkiGL{Sv~CF{DIhJ9YJYH|V{YpkFJmjwyu^n#i3vb1E;w6qInsrj?nV6yUjSJY`Wh ze{CKaUo%zNWVyB7qG+C@f%pzh%S;zdwkls$`vqv=RjKmzzfb?qAQ6gA_(OdOXR14u&)r=o40EFSbC^;eVf+;~*$7@zP? z(;$v;WroB!x<4`73px|p&M@q@2i4+2*ML?#6KKYO3p6ef+1i--xLVD8ripMHF`Nax z-+YU6vRXKR6S|_S6(Pj6fyOS;+tf-w2aKsk9q8O&Z5Rj*5u=$nz9fKt=~$~cv}mAf z5CO_kM~hF2+cf%1XGO9}K#aB^0`Fug6s-lrwS2uRArb2}->6(PH)s({$55QrNd zsMu8)!vxsj!1(+LG+Q`A+X&3OhI1%5!j%td7*zslNQ&2u?00Gc6%auXuQ&%qBJcz{ zi0&a8Cj6({Trsk*2_duKGXxvCC7{b)+SJT><7C&>s%aZ@S96tXTxyh>GPGU90Hjz9 zK*s7~DLKdyNgU)JTv2mEsv?yN_N{dnv}<89Qp)aiDAbbOl~Q{{-VjA~Vnj|BmJpzg zkGaiI%_!IC4)MP0`clXWr(A{@vSKvC@gxhmX(z%pmyL%7UUw>Dz1B%+ucGN=h%`Xf zLAzAc*7{VOo>awH^3{)_1rd1()I&|Q-v2Xs46SMr;{0(O_L2`ug$RTDw+ASQcDpP8 zX(%_^n(jvKCThEi8M|0$D&6;Z@tAccTxzWE?NALn|KJ*#DxS3>U?;Q3h}tPQdz_2N zAg3|Tcr@&q7a%+0^DHQLw^t$%;f-Mn4R<7;{36$!_e1bcp4tV0U`mZHSeiez3PFjTn$+nb7EHC#$ATHo2aSfAEb3x zE#>f=IzaWJCE(s>x$-DUD-a)d+f{FO@1Dpm+=K9<_K2l!QZ!3V(CwmOM*|bPk0q|@ zo(TSpTS`VT^s1$36^5P2j%c3f5-Yxpvjjh*^^a)X=QX;^5{O8Rns>RQh30nE;s>MP7YR59*VQfF)NGL3NzlhCYS3J=awd8Dvl8 zlVC{km~2{jHtAXD(W(of)RWG^SOnjKm?&sUc zR=B5=02OHDdG>7E$!g{l*Zy+R^TpT*z5rBziag{zKpPYqRE;tEHYw7fR19xR|N zVmVbL1^I6E^hmnOE@k;Me`fg!KePPApIQE_pIQFwpIQE#pILs=&n$oL&n*9^pIQFA zpILtL&n$ob&n$nz&n$o8o|oSxx_nBGfQZJRjhP+nq53Ob`3W}{sGl|%4etY&TXqd( zSgXP;`Q}6{81{hrU7H0x7pK0obXDxtQ$*rUL4@x`>6ETJ#66e=ZPk_(;yBE6;^rQw zC}UxSi8hv~;J2p>p4>;R-HuaQSzk2aEfVUsUT)nB_eDQZb4m{s`O`#WehkkR-iqzb zfiRiaA)?Kd*+a>P68Hin|NqOTYcD37z{ak1xb`{cBv2o%B+!2){HSbW+8qzK-)tt#& zSS-uioyU%9R5`9Hc#|O|{SZ*S`cPy)O=Hl}`O=`az4fl#x;og!*qwq{8=QgQHBNxW zWtzIR9s43vAN&GFX>dMc9od==jYKOQJ*uZy+3haYNcK)VD4#X}YRN?PSRcS9v*t0B z(#z=(7ky#6+#BPSnDm?I;i!P*`o{1B?55`1=~?qcwp2V^@tQ?#4D@21%2kDBRw135 zGSrQ&)J(#X2GH~98*e+R@;?#|zory}w3e|B`~7qN>O$RJB$dk*YZYtJYgFGSX2h+n z5~H4tobHM0c%zmQ3482T6PIBH60H4^sWWYOE>eACWG4b`-gHVOU=LWKY6Vq}lDE zvb$aLY!P{PY&`<5{&YwL=<%6JjHA2pCNO1ih_gO|Tw}dTnjW7TycE9J`v(O4x_@OI zu;8wFrytsD@n&n@$AvrSvK++!W9gCiOw3mTCBR16d6?wa*wE)p?%C7SVdbZNor56i zK9?`#y&s{Pjo_zDsjZ({yMJ1yD)G}qSqN!oc#&&ObY{C!(~f)bR$es^AxdFAfTh*q zIIXe7C&QolX9A4{)kqTc84(-C-oTUsrZ%W?4Y2!&7zO<$p(~d}?i*{7i*Z|U7^tfuKz;lQw7nbSw1kQ;{huAWUKw&km;94mJZ92vQoYft;+LI}ViOmOHsQ8Vx6a&R$2j9y zwtmY}=xoAXVO>|=8xV5iuh{Y)0@C1_D6i`ew%o|gPG9AED-x*}S98v$Xy~V$$aU^p zu11mKeF`w50=6I9jo zp>v}0AIQm>`>q&|obMc#z#8w(s;b5fkae;3EK|)F(vkmDTl<>5+5mgIwXfZ)+S@{5 z#8UCU-`dyhRojb(xEfS*C(pFhdc{dDJrZFrF0pB+jQNd_A zT68ZSn#1Dd6$Tdg^Umn+uKU6@NChs1dk^PBB5NQ1@b~8ER_!r7bKBS(Vt&-FbRa>> z()gn(UJxm6O9PkWReLT>W%Cy?wI0bx1|J5lYUu^fppCb<8>B#aQAH7Z6J{=02{o#( zZQag=>$__I8ZOH;GbDI|*f@(xntW%gQD3@_q)#_}nPA0*i%~zSU4Ju9IOaB2nFiRT zP*&pK)E8eP*iBrjpxgyu?#`a*lYgQcG^Z{7aNn{Tp!YmO3AV*vBwDf{s^Zr0q|4tV-`i1WJ z&UKEB1(NU3T|$iw|<0tcthv@!t9ncKqXE%v-MI zlx9upla?t)G-(b@f6JXehJ0kMen zOdtol)Tjy9|D~)6=4P=G?JZ%MP=(Tl_Q2<`$j#MUkTW$hWm(nE{74Yyva5*JRx`n) zgBah6Bh~ytWLkk!4!}kfSD*M49VoJpF_7xv9imW@q7khJ z--Afcjkj70MMP4h7JVp(sa!-=c00kO;x+}XQhl}XZ3d%Vi}1(B;V>#dHPxKC2z0BK zxDcQ9b7F8Db;`!Ka~eoJHpaUB*h5-oilbq!D(>r?+I};!Ft!k+6A8BwJ25y9`{Q*h zmwnX+5Kq<*qEY{KnA@z{+BHiR6}X$#bN!rHNxjYqkRx$UbRWb=PUcznA-Ilrr2+Q8 z7M$wCB4-I$N1Il)PW^ui7&&!??oHa#GFO#<1MCe_^nA&F{KEuviiyuc`q!SkoOWr+q@p_5%h}Ob*Bfr=J<*gBvhY;IfWE81&fc#~Ea>Mu z3Eh#w=)`w6gyGwu4$A*3j65>CqSinzxpi+K$eOeh%XrQ3`0dPASrMlE(~fX2SA#!; zGSW`NQI9+B(>{^|C1Kx5po)<9Bj=#BQ1}>kOPXv8%u9cHpIAM>M#TW@(;-+^h$k+# z8Pg)MAyb7Jh%?l?zbdvUFN$26M1ZOT18RW5!;2+K5x)RhEm$Y_HL}0Cm#g*a*2$-V zoN7MD^~S$~qK(B&rue*D-J^6^u39_-l}aq?8t&(p5~C()?~QtN1Rx)=<-!Fl?*we< z^$||Ik`s7?Q|$@vehD`@PI{E^F5!bbS)q9&-EN89_tc@D?zlp)EO8G_mjEHV253{U z03o=Zv=g$gZah%cdSol#9Z)UphL8(La0Nnfjdl-E%O?UVlSku?F=sSqW|r8WHI8$O zeelL1p5YN>x1)^ZnfmRy|-RJDW&W#Be(jD&u3T14cFSHn zpP&Y~3P%I^-2@@%QWD5d)ewkK#p21cLVd^+4`J}%48A~BKEO1U9gE^n>rH~4JQG#( zcz2cfLYKBTc%V=)-kuvwW29}OAzOKf>lo&rfEQyU7ne5VFrrDDK!(245qUJ72MXny zVs01v(mA<3BfULvESZc02U?#q+{H9E_8nZ*>#N}`tT_?L^-drH0U_SZy2(P_egWIL<0KGL%~`-c zvEuX%%uxUjzRd)412f65g%V&GA%;o4T6Y`lQUB&HXbw1!xV%Do^?oi`};G2ZWYe&+d&3-FZJM6Zb#bA()eqBe<(iE01$>4b}#3%7e zZ;4debWTT5duNX8YB6|E5{IM^s-!S0(UpcTg4g(&9V=T&1d(u%1x@b9*XE#v855D^ zZtcT8wWGoq^sK-WsO8U~@a4bv!7WbZ1llL!S zE=+DAFeabCDzBmCPUVPL1GB(v9Be}?`Wg4=WMQ_9{M;UnIB)ueol3)^7b zDP~>}?%XbW90l`CC?S3oG;JUhxxAA=UVFwB;fW80BWGL=2Vvp4-AHt%|4|4VTU9y) z`m9fg6|WItbS*!Ik+8s0aSj}BQG_Wo68TvS`N`?#2aG5#Z0E}S+|B69+0nnSf%B#q zp%h@s8QBmLQT|%Yvi30d$cLoyw1uN|%Tm;h{=12Z{CCpP>S;{u{)_40rw=MhN9-i5 z&X$`v$`%Ld_ze@bMtRmW3Qy3)IFpBRQatOGaNKk=4R>;wQ?Ng*kf1(e7oztn*O&La z-FQU}ryBYw-A*OLl&xv=m$E_izZ-Dm%10(Psud1om6t+!D@G^cNl9lgeonaqBcHiF z?rJjK=3x*{K2zuA_;u$btf>*Jxd-nQiY{zBCP1+Vu`XY@2<=hX;#vdUGH)3wAI-{z zg7YajPmPH*E!>66OB@CYW5(PsF~+n(dV6$63=0<_el$=MKWC1p1@!dts|sfq@c^kY zMxea+?vcmo=|9N@YT|!57ju{X&*vg?`Tuk-B9=SlLN&XG=|*0JfqpQ_s!P7yfFEf< zA1+^N%y&MZv8BF=eWF>(7#J_k#0yx>)7`BZxw!FGzCD0|;*c6$%~A6qtRQ{E-0fW-HCa?hi+)pt!e zBmO?jRcS#;DQ<-*>$*bn-8yPEQ{h4iJh2uIJ4xAQDmN2?mMB5}1J7xHA_*xjSBk4^ytol^+tR$fmP!su}ixG|U04x6!mB z3#)gdY`z_J?gC6P)}dfWd}t2LEX1@q>qAuLmfJ{q;pb?&2vTbYmfJ4Q(}n3OQrFFIPV1BkDIDz1rH z>pm+?nYgeCdjs#7u>Je}>LaOhL3LP+)g8jtjL7Xq%8ExvDK8pQ$j5kMKAUH@8$@J0 zuofgruFmqKb>%lFmtTP-?*ZfsApVWYT&Aha<^P~E>T!q(hd6>R5 zFsigQ#hKqUzDTfg0y#OXzcXT6 z%h#1ak!KOhNUIv|$l%_vMFl68VN?-*=dG7L)4~ zZm7#v^Zw0^?h*F1V$9Deu{T=Hz0Kw=6#ZlMNQ`n#Mmx@Y=NpuvJnrK0EE{Zd>*SSw zKKho0h*)aeXw_-h%!Zyuf0ftGKykh2^4KaJnY*$R(V-7$e$K}eC z?wA_5+dJQv4dR=jiwbX}`Z22M`>4nk_<1@WRDen8CT3Q}d5Co`Z!iwrBO8v(;|ans zakl={gHGDvhNi1**Vto@fGAZIbAnHG)r?j?z+5X<52KSQxIR7UcavGZ5=)uwXV!$q z&%K8ONpdTadzaOknq4E;tSg%c+;N=^Un^V##h;4{66sC=wEx4qCb36jo_lj@wI74C zhw32aOY;zW@Ks~QV&pUTk2I_}CJJTul9g%qzd6uvt82i4l~@>5bC>d6x<}ESmmlr_doxJ6BKT+1 ze~Osql#@GnIGE1v!jMC@emSms!d``Fw}ItVOp|%OfTJ5_2La;lU`Yu3Dlm30L7S1= zUd62-fQ9`MuCv~<6xT1}g%KQVzlck)3R^rq+NQqFrN z!#qq(4HO*rK+1z1p`*-Uz#9@M~P?bZ{-6?&EpU3}(I^U?t)hGX% zI^R?&bNlFknqzIcWPIESU0)Kx@l1y`g-~0xah0cXCS{t zIRA5qu+nqbppJ44bya=(Z~|o;6DzT7loAfVO~KZ~h^;thhE!Q;Y9w@6nPR9=4aNIZ zR}Z0<%Wq}WJ0+|}M4xSUDuXhujvYEjtGCjPIC!4?e{V9Tl#Ob_p$l|&Ze`C4zpmmW zNny^`2~RYnoRwJPa_n$cI$qiQlhy_$pXG^D(OJ^sKG zGRpnWleuE9p{HN_G5YL>+FVfPW;DvAEj$%pikpY8qY4v!pc1TDi5L8+U;$oE=y4rg zn(s&m!P$M#F<2zVZm)Cb_Z2>6!2sN*p)mv|yM^bb=igVmc?ydOAbzd?sG@I~b18$AyVosW6Mcb|eZC$>7 zD1W^<5_KPS$2>uEft%wpwfYrrey!9F_HK0cPxB7v{X&8Chc9Lb!7Z_LChyZm^^TNh zoboMWw4n!vLHWV{*ztPTJWgBh|9Z!0@xkiNsrWv0B$FUlw=016xDrl3qYJix=S9QRh-fKZ3$N&Nc8f1uWOC&0{M)R^P^otR*G#(eZ>= z12G2Y;a+qVOBfC0^E$DDB~m-|=5@<<&g1TXC)(}*akQx?&7+iqG8Ih}Bjn;yW?&Nt zcW*`NnvSd;DmAX$q0yZ?D>1Gtx@PLCblCFfovjm^#XHB<#k=$;Ippzr1;@|IZ4Z^5 z7Fc#`a*(UZ!6W7e&=q_Y?4xdVke`6#DWE*;qWCp+J=~%J@&ODh2`9}%{yVog(7UADWA7Ig^jU&A*J!YvBUCf*AP$ z?w?MCiqn}kF+#yu^l`ND9X4oyd*7L@uC-8PMk=x6{NY-Wb;DWoG4j66M8Z@VTS?m4 zx74uU+&(W}S9mUAKT4^RM;X4Vyq5!&_j0iEUcRopmqV5Ja=7wdj#S>u(aL-Irt)6$ zEAOSC@?O5Jyq9B@_j0`QUQSfr%XgLc@_psKoUFW;Qvp|sl1opEAQn-<-Pn-c`r9B@8woSUdku)%Il-AVs7uecu4YL zTRfM5`=V!IYKP4hFhjJ%7SC%NFtRMn#(XjBby&L+hrkNrIM9Jbbbg{d?ZZ%Grhp}e z#BMN;7B{axLOB#rzk`L3PGOGS#9~rUau8lnFw=o1mT_2X$(xAH<~<^D4OSkFj>OW< zzUnau3clAhi4jxbZgaFm_-?HieM^+oe&)L zl#wRTh-b|>faHAk0_PzTD3%Wb;;wAS$xmj*34#+hz`~D6!gF`Zs#`rmBTZ$t zOPgc8lU?4jl0Z>~)w@#mU>F@`b71~(h-&db7TP_?(!D@Dz~nGk;$=5^Ke=-YKQI!< zFz}`m48~DNZEiN+ly$td3Z2i_sRnm~vEMw{GJ+0V!C{KSy|8|0GGgf_ZLp=4^7JC& z4O2F@$)%>+de=nVPDAsQZzz(7 zRJqS%$wa-S0WXH(>JwyDZW|Obt1h1LzKM@7u#K9r(=nw zY->z~FCcTjTYkyS+Qqp1W3UZ7bGBoTY@&#h>sRk$8@=OD2jQ4Rd3ABL6<)K$#$Z0r z5KVF3ZVz3v<9x2H!p&yvnYZnRko>w>`N5t4#IJl|ihLc+J-!a6lYRhDQ7Jy^1wi@Q zF8P)YT*=Y-iwPDys9IhyT&QI#v~0^rnaE)GQ#?9~@`@=pphKJBEMDSCxOum(kf5>JDA^6pMMVD+t{G4#$@yxVZF(>x!=hzN(=0h06nA zhO7MzuSwv>bjWBf5U6h#e`$4a!grq)hAb| zJ{?oO=9Ksp)UZQ`Vt?=RP}mQtPrSpPk3~r6vl~{;;|((>vwFVmT2O1%K)%=yYRW zLv2{ov3)!1Jqz~tr(=QZZ~O?SarXJ%>lO@W+0P^IvyrVOc#<7Y*;M>ybzvw(A%8YT z<)+gZP&$IdzSKX_zhNspdb;aoTw2@~BVxSmjLj=m&`2C_O5*@=CI+K;t`k-mzD%P> zOHgBZ)js8Q%xC7mj?rWOJPY44m3OD6M@AO!Y2X_h@VIj@rJVONW)dPFXs+H_^L(@X zymO%Pyz~6Ikp7e{*!)mzg0L=|ixJ|TZ!mo4r>B)0m9aw!TbKDp<#y^*&UkgK9!edF z!|sbw=oFIvz`$ef>kw}>HR&QuI>G#Oxg7T4Iw%Lvo&i=e;Vv*rS%8^s^S3PZ-TWYj zyh+|qd8gS|d8ax0vM&l@9(-?j3j^<=OX2(ETgXwuI-c1rhV4nd>$!ZXwR|e4Sg>#d z92Hi@0Uou;tqPN4_Ud;(b6XP;8DM6qCwB4d}lo zsQICOM*IAgmZ2W7_D$Sk@yXl_g9n~dz)u|Au(ZMp@$&Dq&6a3ko4sJOM{u;KOzcKiMg4 zu}l!WIqa2yY+EgRg@F`jt38&Yx4|f0{u_PCHcN!!BZ%^=N!VVx#bUNM-)_kgYTA(u zf24#*XKwi9RKab9&rT&f_!1^qGlVW(9t3f)fexfUNK;*RA|0g_P; zx#el07%gO zwyZX^_EE>6Rgh60?fL@dQL=XQ?5E@LXP%6Sg99=Wd!Ro*Vu|((04f^Z_>YHafq=Q( z7E#>eNZy7kRZW>kEeW-20$(3^jL+rhYU$u06ZINe&7Tr}sf!C>j#`QZzhJPibU0EN z0+@qNq^Q)&UqKHQ#HU}+|x2+@4dTvD*WWIcvU4dpUz>nPg90E01O1d2W77zAEr z&OK%^x^9D53lv|qMgX;IkE?Bpk697~p#cp#0by)N6Th=Gq}&shZbAgPePUomP8uh_iI!$R@}1?jAVkueXDrQVXiQb~8g0=Mtfwrd@F*>(E|jKP znmy)}rK>?`#-X$nno`~w2;2-hcgEsVvnf0#Bid5@jfU%J7>n>*B->ewhoQMC^C778< zUzCGbchS;Tjk08SUECgW*%B6gI@ie_nvOTDeRa$8SvEr9XeQgx1+z@-S&8a9Zz;DCRedhu5m& z(o!CkzO07Aa{M-p{>>7UTb8Na z^`8&_S~v$VM?VH1XM&?2q~NGpvBlCrP#HK92Seu1il-MfxQ0Jdhhj@@VL8PYTSA3m zYX7ZYP{@X>&e1K4v8Zj67lPYbfN}H~s&Amb$ zN-X~2M=mS=UsY*xE>&ET26v58ODrDADVLm6Jxm9;(ZN1|Ia$wWg1U53!Hv-1K2vee zYH%+Br>&4DFP4(W@0O6{eHWAfxK)^RM`1zvJ zWT#Yh(J|D~!LB;^mqI1+Yc+}5uHx2da4EoPbKkQJX03(4dSwU&7IpB2ADjc&t%Kjw z!O4KRsvJ_nk}z1sX{DnDGip<2*1_MOccyOw%mIIa&rw}tbUa;kaHI})SHl>9Fx(x1 z96U#D{;WkD;e`Fz5m>BQX*KVL*n|GxRI_ zxqBK+iBG{#{hJoE+f;y@)?SqJj;BYh1}eA#C`Rwc$FXzk+H#7<-?aGG4m;(XU84@Z zbduKJwAA+Qeo_f~f*J;wZ}pRO0kj5|?-kla4eiKx3hpHhZozld_?D%C;o}oD_!e^h z({Y-4%i?dyK2A#*pM8w>Gydqe^fU0uuY9Y7F%4mG`VXpMar)bfqrz zxPudnW?#z*;o|b(ur2{Qc$W@dp@V1Y;Nd#BgBE7BQ%j2g{NRu-0Xle>4ql;yXX@bL zI=F)dmepP@4Fd7IJos9d03Ezb2d~h4ql;y zXX@bLI=Dj_%)L1NYLy`r_`v~P0(9_p9lRJYw>SxH+M!6}4^XeWP#+(DMbqzE{96zE zO5r&JKIZjMdAW7Es5A$TRl}D33jaA07D8)2=Kw)s@7@~k{`=_xqA=|IlKk&k{M$V9 zrQ+299_IDa@D}Y;XjN32zlQeQJ{k}I2J=3e2iJS+UWGSM<$>dpx|gfTeE?9$mcMsLLZ)uvmCr{yL?Z@e~s61RGT|v_-tT2_gx+a`obDen(0p@V5 z;9<9(CcIfHtr&QfR=up-xxbr^-nTqn>$hD>0KcnD;hF$u@1n*J&<&j1Nl!mOy*AlN zGasO^PVAs1aBID_L-BiC_1jqEH)IEW%YHMq(=E8(e{NHFBUK(aF8j7o<5Cp*7?s9z zDTgdI*ha%aGaT7U(@POfu3h12t>GDBUsPMH z-RAli3aKtgTqf;Q7B2sJDy^zYYp9%}V%Oo6O%?!~fD|j2szRUnO?Y5dBn-4jf1>MV~5x zMXCH_XGzX6PpH*?qRQ@M5`~fnJ_6TCFS_wHyxIe-Vr{^9%$Dk%Zn;rj#bTn!EG;KzzztwtKC;JUkbY8d}quP}OPaGO<}Lq~z+@}i3K z(eTwfri1xO5?1F`;~BE+lt1xOX$CF}ts4(9>{hl)UR4-i~+a4W>7Fm)65g-jwc4 zpRR*@0_Hp|*W}kn$MZ*;a~OMca0XxwgL_AId#mmTf(vzb7u^gWzC-=pkto|cG#ze@ zDQ`Om*ye5e1o-5&3!L$jba0FguAzeq=R5ni>)_csc&Ia+?9#v);UehZZ{Bi_;6oie zSqFF5!QMLf=Xu)jFmT@Pgm7`0ql1S7<|1CHsV<9(%hKQuzNrlu)vJT2=-}=Q^T3^z zC;!#aG5k5#IlyB&c#RI8378YQN0X>v9ZxkKoV;p|b0m-J;EQiK(?8R}-F0wn9h^Jc z**`hM$u2FN5ia?&oISjxgFSWdx!0ZfKhwdBba0XrJQ8+OCj{)VI@ntW-+IkC!m~Pf zn+{&_8Z{QtC;phKRL@yW^}Mg*&S-FPz-jxOhAPiF4bRCGXP(b>aEcBdkW$*oDbOZ5 zhH5(aLb8(Bi<(F`CzHE`jEqxh8$n}vyQ1>2ZVpvx4jf1>Kg?9Z+NAPd)$nJkGzX6P z2dcOnmH%fAzcjP7tt{lnRpKui;`$lRr7}wgKRtuaBLh#|Nm3HDRP_tT<$V?Rn+Er+ ziaQM)XS776aYl<@r4CjU#^P6<<9rz~^KRFK^SF-3s)LKBD}Huq{ConORtl1Ia8Jcg zvdf1WPq(Kj0kH<)MBG(roZwGXnga)t%NP~6PvyU_;SW)14jl7eoT`MsU*#_qx|NUp zmZ-#^R3aN99pl0lplNd>>ELryXoU@>`T7)RzF|7Jr4F{~;9p*G_Wz|0Ua5npIm69d z`Zyz88tLF_I=JX%8dC#vk+7GQk~yiCAeYvj$+VtnhRF(z#mF&#SU!n|jFtPQ|v{k`rCC%cSrM!2-q!L@bp?a|Hwp4Y*f zb?_1$Ji!SzVjX=nedvWj&A|lcfJq0>)WLmpa2p*g>EK(V9xk2Dz^SF9SmTzIBTx}o zD%8P4b#O}^TuTSL>fkFcltn0qzqbrl;&;g^L&$WO89I2d4sNM~J#}!&^Ue_-)xjS- zU^RZ1xekO9zsvJF_;DQ^q=WB`bdKGTQHwHTgoUem7>fi-B z_(dJuM+Z08!2y6ptvbFlh|c>%Hl7+pf5C0AYM_#nX_{1zR&mocxS9j0LxAY-eSCnz zpQNF^JAlT6mi!cG+PDH#-lsIYr}{hdWCP}sOx5r_ui_d5$F$c~8XOm+O6#fN&+8|L z5$e)ggPf!wU1n==5&ft^AQGC}SBZ2IXdJ-;l?RT?Uwxbtct!_*0hs;F)r9-1ihEOo zYop@kX>hlnmi^M+K+&uACIH&fO3}f?o~FMzvG?MX2#06_+N$ETEp@DlOV{v)sknt2 z+__jKyk|7HjlgNsGDqcEWWWw1$7m#4MP_O|{?%Iv>^TkYYv8njt=7S*s-G7$etN06 z!5W-Z_J`KvXgt?@IS0H;2fwF-$LQcLI@ntWm-KWFe-Fd$P}hzGEY~q4=-|dW_)l8y zF9tpRK@aC}U)8}qbZ|W#e5bp!|6|>$LlCSs=boZx;kLQ{q*4i7F)W%{Y9YdLd0M5B zN?WC&?dnFmf}ji9b)(a8+vIgs!udeu;i2Kvz-cS9smilU!*k;aY8(vRFzN}#f3AiW z@&pZM+UPC{ZI6cL(}ms!?XjMn71}-xtr~FJc=vU3hSNIH`Ctrdk3UZCA#i;kr^nbG z5kt?yP5wMu2{SG~SWw%77!ExEt(K*iPIyfFM`WM7x30`uk7^PuIcmLOXH~h4LET*4bk}z?{+pYKkwErP#$~WE*GR?m9R~ z2Ui8mVI5Y(x}piIS8F*eWzi8lE-hNqCrD6@)K<=sB($Q_z>itf(ixuwm;?V-4g8uW z@O6(l^QHl2-s39ouNvOm7S6mMwV>f)kohJ$yg>&aYp#U(jT#oW#W$MMC-B>=w@N#v zp-C$4cMa}nGv~NJ2F&SvOT#m>8F|+cYr7RURcP}`s404Qr>NlD8rD8dX-pj?{dAOb zu#0tY0$`5joW}3{NZJO!4JJh@v>!CIYAUW!gWKPP9)Q2;ye7_Z4bs6)b#Rp?^i*BQ z-MYrk{$AF>Pv~F)FsHc$X<*lct<9|U0lIwD$T_SRbZ{%c?8i~&H*ltZ z-GDx+hfd>X-`IPrCX(}sDYzB7D82d~$`X*zg}4(?hGs5T?oKfV%X4ee{lTbrc@6%2QXvGdfJ6SyWm*4ehs3dVn~R$Avm) zroIloTicnwK?lF0gL~-Urhqx^UTWN2peI7g!c;Q6F@#oxqZWpS&^EZqw}KT<4m}#B zNq7cm+S*7|d3n1&N2KMosWbO zn^xIcqm;%r68)+?fgf`kiBVOi+e&FWV@&w*J!77>mQwY`z}%Hesa|7XV(?=KV=jxO zG^Mc^;xkHA^8BMF&y7Ib1oogLi$ZLq7FIt^VKuarQYkY{H!Dn$D$@WBQ@FX5dN&bU zS9!L2DZSN145{*mJHlp6BmDS_m|u*g^bTXf@Z%6;zNk`4zcJ=FLn$?E3QQ_~^ll2wHUa5j zOb`6n#F*JGNDpIt@Iz`Qwl>6;(o@Yal)dnP#y1n&7y=&9dWJXNr=tvCxkv8J0Z+Y0 zjhh3`xl3ah?sS*lW;p3D`kG?1As-_YKs5A$T`K>DM zHBA@?epkY6uEC8|aV^Sm`1L#WYKd`kOo`&5WjWDhT`|pMnpmvRxScsBX-j^iPg-JW z|In`r&C&KaLH&NEE1((tuH*I&xXrIoW4MF+{G#x7)P(c(&k8OYIBv^BR2oFsB|)Xd zX!x)Hr0_qk!M*eot#5^S#kH#nt+N`|Vog{*R9Y96_MV3J*^l%9>FbbxMe*NN<#7}! zr=*GcZVd(e+eL*o zPfgQmm50;RU8Oyt@fQf3Hl06RaE9}A@LC=GrZb%EG6o1v@LEkIf{I(G!DSaIeCsv1 z=_>AH4X%NT+n~Ya7b<=?YH%qs4ySKE(IDFw((i3B>st4NbFNZ!@Gu?RMhE-o;H&4I z!`q{S7dykrF4LS5F1>WHRR^Cr=N!QX9Xv+|57ohSoL~(53{D6vYo2wE;0qm`p@S#s z;66GyQU_bKa2Lo!(HZ9mKh?ntba1>5?r?_Aw}XHWIjz+Fmzrv}skr?b+-Ij0zOOX6 z!N6&Sy`{=C4m>Qghg4o}EZa^h{+FnA85Eq<7nkwd+j6SuPH2 zm+J8wO`s3HQ)s&>s-x&pH%A4v4S51^+B81#9o6UnrMUhCJqEXi?SwP^!f_hY0p&9A zxDxafHQMhq(VjV`&>T2U?guLFfXaVT!{1n?9aL$jG_;~`m9Vr~U;XWadUBqRsEiyz zoXU7qgS%2d4LTyRj}<6^FpbNqKoh~de1+z~aachr?ng~ne|+Oy5QhMBSezk8uk)db z`$>Zv{>_7AnNb@-eO+L#s>drDkK2zb5oi-JUd3J2@P(;3ZKUUqXcLR}xCIDK?OBb- zS5@3O4X(b5JFmg*JgoTrL4$i*#T9CB#fKEWA`R|s#tlQn7c@vumGPnmxBP3x^9>E| zc@_7E1{VmNR$i|kq*^hM*SLf9INUK?4k+QIYy8Yqaauj!5jbr)fhvy?E2EC;{QfH? zELY&T@JuR=+v}TO(a{)ekBHUqIQ#{xxT>14F7H>uDn`2WVJ+BCjUUH=+h;#L1-H$% zFU!ko9bYT4*q$s60f!|ov-3* zX!6nlIBnSl=-|71WO}*P>C7Jc@J^z?5W*)``50#>d?EPwY$+d8WjrFlssGf+Ymhy% zi+EB}X9GL@t6EGi_b-+^q^MP^) z{5)W}Y7|_utY)89k&gUw#2r-}r{3W?Ld8|r;QUmaHqlj8oHpS%a+Qd+i7(1cR*>2p z98(#!x!AAbv^m+T;y5>s1a44q{LZWcw^GGJ;tm62}IOgMX3N9^GWT1wzfr_iC!PNqe@+Y{Cvu8aih8f)2 z;!H3f&7Va_x{J@i4BM!O*vYLeFf48tXjOvfVV~baye8N#0KtV<8y`R2(Td*eCDs#~ zP);wgA;kuG;f=UnVsrBK!>{_i#m<)Y2%PJbxtmZ(KR+Kz>n(-}7btIp=s^d1i|z2+ z*2dLCehcI=su?SG_u_cCGDGn>e7B|o(U+n53tfln+qKD9d(g(t6L{dX~0#v(ywiR1`J$&%&DHzzz!g9baww5?nR z4#8wq!`X_Wg2702Q))j%^r6ThqM7~}EViS*L&Qi#i<rl~C!9^$HhLScEGZZyrr(r{poK7@j4!mRyl}qH* zP_Y?Zn&yw&%!k2K^f1vRgwvD5!~j3OY=E^mYj$pC4A+BOn`}cNBM--kD_e$%5yP}C zgEQF%ANLUb@v(N{qUnq_R~_zfd`Zv@Ok*`@z~_j|5jWR)7w|J)&I8^cL@r(B^ig^T z4 z$RV>5e6BqoIGBg;U3^RMy^n7_zI=R_@Lj{ls+(0cR|*S~Ts~aclpavuM|hG_$BUt^ zG8d(eMiYumtbtpTMvD=3*xQr%s%X98cO85zo1D)lm3x5l^Q)QU%PSo9$gEv~gmPEB8K6Qqe-ZZkjz#ocfQG z(fyw#qs4e}0)-70!(6%F3nt4%5pRr5hE7kJAf_NTAyEv1qh>fRQ4DYm17}?dDYArS zN>IHA649Qc2aBePf(WF(6UA7!aCj-Jcn`{*C`N~Hj~IuKn-y!OsrY8$TZQi{e8(u{ zC8(6NQMgWaLoC|N;TObU2%+#Y8g%iuxLP)4frLVTNi-Uo3iRuE(Vs@tMn`$=B`~+! zn&#!Yu~U8|Ud8gw5ir-Z?xZ#av!Ubh7S7lMzam#f|vUu_a5BBrcKqS+SAFg}MW z^QDqWVkm8xBw7XacVXFYpRxipx^h1dLOIMlZnByzuYo|a5@B5o5m#iI(kDajt)-2V zq2$VVqa3^(^C*0rLZ@~Bm{Z;gpRDwF><}u~hZ_reFg{n>Iax`7*^e8Bj57J!FHp(M6sS9ms>DCSA47v zIV4V92-(sDJS^PG9FbWmen%A#GEea^p~ym}$lW;)R48!@6i^bqJVhLUSdUB*pOJ4k zRAOy0Rh)q58`n%lZ{TM?GF5C_MZV~&3fVplLFb<&8f*4c6*T+ctFs)9csSrBdrXoj zRYAaU$zq1=wHigGLKsH0^}=;gLwtsbWJogA_-l<)tE>G7UHRq@tzU$@ZG)BZtkUQ5PRlEC0zEw8y-L5rM52 zkX*Hln}L#?OQ};$9vQiFA>glzfwtcNf*xBTJ#&`W%@Ajz^SjO75Uu!GqKDtp;7mX) ztfc#>zd6>m6m=Fa<{o$&SCM7Uf?Thqyjjq4eW_%Y=mY4;8)6e`H5;8-KlVmZ?W{bM z$(fBtk~mwe@7iC7_Av}7i@IpG7!Wd0jgF%pgx{QDN54^)1P_XQL-dt9%%(Ikt%eUS z?esBvRYRq=2LBWI*#BTTviM!ffb0$E=^>hgwsjqH*n`dJ~m+fx5hj;pa2- z-kaj9ZX*x|XX+r;oG0FPi!TS?5_j94b%27>Kh>s~o<@(%`SLim{e0F0_CfQJD}*{@ z0lKv$XxWV5WTQQQ0meeYNJYH|zXM<`4SGjx24}%L;tz0MOcT$z@rh0@-|>`prD_vO zNf+~#E8vjWzp4dL%B}h)p(@>f7Ye;9c+DhaAe;QNI<5NF*8{|!z_>96iFK(%FZQ!x zD0Wsbw|*XoXyESP<6?UO@Hn`O@Nu5Gvbg-XB{8109OJ9fkqmK&mv-{{QE6!@lOUZ7 z#d@xb047j;e_MbnkBB-_)MK?h$n>4n?3xIYNCoS|e8~Ep)hG|G;vTpAKTOTshvi*At4j(t@xheOFNCc1e`k+H8FbFj^d{_ zk|h+EiE>B*di0{WYUnmP23za&0myollY+8z>8A5F?Jfe$NKf$a3&$_HJR$8ozzM;} zRWynO5|3pJ%s01=0LX!Hibh{AEuD|A@he=F8~G~U z{%kd-s<}oxM96J80ph|lx*1C?mWUq+`RAlwXA_(yHFx9@K6nbZ8Q#u7Y|Tu~JNM zogvdg!f~&D;YtjrXDaDW=JeyDyHz3{ygz^^5!SweD<`wF#F2&+6U~g3{3&vk7%QZ5 zP(H$IWg+6)(nv|9nM;jTskk^01Nl{AU*UCX@xIv6Z5ATq;YA=t%`pX0c3dc43w|H7 z>)C2b-%#B-a05wL$D`5nxTPK_6i-y^xANf^u8Leu5TR zF^sFf7KNP2VPnX*8spE{wc=`l=;m6~>SFt&{)MVEvo_=H#nxP($Z++r>?kMIS6xy z>`gGAyiX@Kp=>X$7ID3Dwm6ki)?myyHyh*LHMA~U?C$m*@%^dXOevYXtXBo;tZvI?&>!{#Uae(W3ge?oGv z&&9s3pM%FnMPC3O`h_@B_(Dk^-m$SG8+X1yp>9!7TN%|GcT>t4*sjTE_C=I`z8%_T z2VJ*AfOj&nUS^05Hw3SRw%f&U*P6RIE|et;=SqBRdf={vYdn|owxD~?lYP<%$T^+8 zigq5kRa_mvN1G8{;q0w|<|v$f70?`o^QD%i6i$zA;yz(N*|v)xxqbz*jbe78T=KVz zTcD%f+=21N0cyQVtVf4;pj-}8$u3Bgb*GpOa^6nN;J+rfU67(f%r!+gOgX#I;Epig z5aFo3=WehF-%wm0LS36Ht`+j__n@GULhC-x3MrlqJ^cVywXmZr3l zh%d!3%L(9lR3ne~`dsd}g(9-M>?6!jK zB5<7AOR9UBt{)Kh+ODYJkE(l>@(zmIYy6~wKdbI9CVKm8ab}HcDtujae>G99L*gC^ zTk2=E7axKifoae62&OMHsL>H9=NS}t1hx8`qExe28;own@H-AEd6jYkgnAS^!OK{c zMZCmBza9}EbNgMT*QcCU!s}7rqvAlJHf=nL&@gg4Dh@H+Fj3=g#Ca5(4|VTBC6j~d z;XY*_%-4M}@9?!^`fgeX(_p^QYP9@;;CMvEttyk!+n8`=YQC6gxM`w2`QmWPEzr4> zV|p6dW(GlZZ3s3|-vY6|_iYfFK=^nP%O!ZnMDG@e@B9C$(lUSx#^>lq{xaEneJd^z zgu4WZh6R3{WHQ`CK^+%gak~#s+{ObbHL7aEj9}dOfA~1`%mc>r5JFX)Jx-vrF9p&{ zsprrf4xbP=;I@Zp--(+Hf*XkwB!7G7@1d;z#r3i2C&jk}1JyhwzAjXuRj0&XaI@=z z(-;-GQq&o=qpGz0jJQ{*M)7B19W>FovuMU{G_e@k(0UF%vpdbW$ld8VDDmp-2l%V# zT7Az$p_wW52eC<}Me?Pj^O(?B$aWcRK6bfi%v=hl?DJwYB^5yb-8qkujD(wJp&lZC zfS@2_KR|^BA3+x*BW#SA1S<>;PJ47|B!%-6Xi5mFF+K$IKe@*BOZ@Tq+P&N z$D2I_(X|U=n&88XLtq*}GFp=L61qb_B}qxG1Mtj35jvZcOBi+fQ(UkV1j{`9`cVEQ zbUlI0*hi?zPFLD+8NFUDC0>v*$-gX)q_bzCc<&*nlyC*v59Sh8%EO*@1)5w4p*25> zUqN0=&Z8R(<@^TNv#xT(2(y3w6D*%X9qRcD(i?f1)3OdhHU9+(s%r=KIROnK=NcMJ zeF`}tHnT@u7n=*Pf5!ic&>GORUon7bNU6VJlEqCXf`3Au>$)1L+iyrvqjFkf{<#@8 zS=nzS^(;mMisFjxgEsnQF)Sj@nC3yJ8$TwtK+=C|Gg`(?88}Evvyn7*OJT(c%=V+L{ z-KbY?JcA&%1T!+Dw=ABuedN*~ILkzivg6&J&9F{7pwAoQcWQZ$SH zG_ix^Aq=3BQe=1F=QX8Kf-s0?3(_RanEw={AbE!GLh(6uV1Y15BZR?}ZjjEvtngwL zX}2(x8X2XP!Z12wlr{^)Db-c_1ylVOt4hhj2)bTX8bE=6K_YrolkN%6Qd~<3h6|Gv zh7~aUu1EQ|P&+$J(ojs@{oJGpG}R*N(hGo>#r z(hry^tr4Z}m?@QrQd`WF8cEUw%#@Z(QWMOSj!4pWI&75CG_6u+;bl5um3j-WD9#jm z*@lvuN^e>b!Zd18L;66NP6ZxP0HpMKsZX4zWEYZ^>I(FdnsaaCC4~wpa>->LM+3|9lICO9)5u$@hgr`#Z{%j2x6}Q9;6Ny6-Kmw7r3{;whzLLNYf3(XfCnOiAbju9xgbOoy_#j_7c7@<2$FpL zmLQ4TX?4LDjL#weOPPC;uuM^X%V}aTYH$T@3`P~Lr27nIF^f7pmxry1AyS~QiWY=O z9Wk*u5`xP9z}~(#a?TU?P^lB<6stnv^Fww*GsBR-kEnH+)Wmfyl3}HyP?owdgtCs7 zhe>0N>w%`|B)kI=Tt~{qyr8HK3Sa}ZuPe0_Hga>p$ml7orKW7-iB=z&lCyq*aOBpN z&U&#`lZST+>c`sW6UwP4HFMjfRt$R4aLFUHK3YOHrG_InN%bKEIph{DO%Xn2)G=W* z^=p8d{ft&MK#o2qTSJsS#`XSexI&E5Vp!8wO44}fou0E>d6D8-OJ$a<7HP@dVn~ABvzP;kV(Y8x6nj z>rKJyLSfa~VKiB8v2P@bx1wML>S@s&IOsPuDwgpmDn~8Y$fA zYot3}r7**vNM|?cg5fVWGCU~_uX`6voWXmldmpYo{SV4}R?m#cVJ6DGj?sATlakp` zDtFXaq@}p0AcO*a`IPiJMx=3FARSexpg-g%_w^ch5N0%%TxG+NQNdd6HoUbk%!-FV zZiE`?Y>)Qma0xUJ<&zu3EW=L6BhcZmvj*mjw8L1T)blwixy|aZWn2an+>6` zi2G91W)vNF%Jzsj>41Q-YkD83L=S4+2c3ea0(min=L;H0ri|E&&}M9K8-LOQgIg-B ziGh73UsrDgDbmjGe9)NsN|6}HruLQUx%vVvQTz|E1m-fEpA3f_tOx5vU-X3jKE$<*{~#@GR_v{UoCyz@2ujHhR0V6?X=u_LF@4nClgQA^4ud*OE!VO{ScFQc#qG zTnA|G0GUPh{YY;@e<{FK_C_K7(fz~H*ZoWF2HNhv zc$jD{nqH_$9NXkL`%pkuT&#lCs(IjMP-O}ObyZsD3TUjSII=Dk&{#Dy?FnZZP5RW;i(*HF8|?>1p-1xT3VMC;At^F{ zHwR4dm#YNTe$oM|%bBo6pZ)7d)x4`Z(0?jDxRyxK<&lRi(^pHm~_Ai@1qN;FJNv3 zEVXQ=Dr*gNZj5v&yq`+eRu;4J9}kNhmMx5u$4X5s{k80583#qct9r@c#8Q~N|CB?T z0o*haj*9`|1GGNWime6~{&R}Jo;pr?&Oj%hlgz>!R5BjJ+!-`%0wh^>Lh0}Xd9+?K z0h67kG;AV9jWg)WL}Yyi{iHaSi5O+bN%hEl3C5df-#}x=h_=RZ{uvWx{#AJOk)~9TSOYIS&yYMHT3a85m=mbv zZgpPYFPZ@@9kI@U5!DRo;dS@~9dA(7=ttyd%p>q)DQYGZ_F8&!rqnP*n*~P`8U~+U zC{ejoDJR^+1G8M!Q{GI7=8IH>Ak=)N`!xun#6zJ*%zHzU%g}Kz*f3Ta0|R41vSf9g zAg9~0e;`>3s+stR^i7mG9i@>B9gIC4DbNK8R3}9W_4*MhGvN!t=jeH{^)Cg}E?Mx< zXQW7d{a#Xo=fYTWuz41LY=X)3J!}=53I;Y4morRz12eg4RP+W0r_?TC7>3NGopa$gnd-a=Cxuqclb)dwdnL15 z7GmJ~O(kI-%u=s0X)H`5>1hZ(>@8`aFpFlqg+cLb3Rxfxq1>aMp3w9g=VKs0hf!l; z8-dp#+OPo3Z_==J@EG{ElnuMck+)&pd5b2#gE{JaTJsLNg#}dd4yL7VQ03#unW*C|c0#G}tY>|<#cH{&A`8Jv_CAxa$8RZO$R=r_@BxLa z0&o6e3~ZAYV>rLM4AB|(5(lw4r5r|jKBSygD8j6F(fwt;hoQ_zl)f5>d+$j-AX+)^ zBj<(bAf_xqce;+f`*1v1r(Gf?2zO+H5LAB)Dcnu4+)ur`XPyyBvASDWf5p3`Cx`LaNW^6gBI$P zzqbNYwauLJP)b>e{C`F{D^cU0D;W#Sg3m9MlqH@+PzhO5Ec77?GcLA4wo`~iw|w-R&G z2bh)QQqFo**R>C%)mTqOQTLV?l9XBItQ;xOYY+0yYKOmC__)49spJQg`?xhypew6_ zDA-BDQ8q=0di5IQ-1AdZfV}o}H8}`n)H}dPmq4)Xb+k}NXjG6dHq6MKWR~YC`{>CJ zr3r>FF@!(s;Z6A;N^`NuI_M)v_E)s-BUp0|DD5h7t#l2R9kemF?BuKi!yyvZ1HwWo zH@tD{VNg86xnuK=jJmcSHSrBLHh?SNzUpJ1fftb1M$BoyrS~?X*E>dAH)05OoQgJr z=L9>UH1HFY<#)8;6X`iR`2q4}+=SllBr;;5^iNQDDVrdV)@tYnJ8y!u;*=Amhj5yX zY(f`zhVE~|boeaAWJB|u!{!4txbx(eBLx|LaHrvSJpHM24yvS(R^>>YT#FD)4YJ*+ zjR^k0;;-k?sQ?RG)A~t zj-&cHh%sfGG}Le#^NMZoaYvQ9ZIW4D?flc7#%zbLzjXM!?)2Ao=>@lY4yhqwHwrvy z2gKsOoDd4!DMcF|p!{}9Pvc4kS(>NrLWSh-lorF#GI|$Azyem)WkU;~W>}Den99vI zdpDXx6$<&1HT6z3R&y>y#7I$}12HQX668t;bEUW3s-pAdF33j0UL+tf4@T5#9H|76OZ92iK7>?w2rHmzW-niu z6F|pGjoGU?Yzh;PKv?T3r51b?!dhSBJ?SV)JDl>4qMjPCGnTTyL5dnG{KemZKZ5xK zXv1?j2v8j0g`&*|2hIy|B4VvxR@!nHom^v0uvxtR4XiH)2y8oe76)RQP@MuKKC&z& zI6P7SiHf2+-y)|?FfED>^L4E+wuz8#f(C)LYbj-7@y-;+{`+v8;-8gdp5w7OR?d7eU5=bKaIsk z(`nSw@qDBu`ZS_`g0TazxEOUB^<+JRIJzmnWBK=!%I`G({S?KWL)?eYpq{$pB~}PS z4|ZS?Itx@!g)Eo%N$^v2mSlu|0G_%Fy*Zo!S|*~34xB^z#gcFy@y5wjU{5@cqJ{;a z;0Ng|L!auj%j)e-*@b9EeW_8A)G)IMopnDueohe#{i{>01?U@c7hmZU52BVbZ-i%gl@WN#6lGNOF2yj*^iAB3w zc1cRa!ldQ0^p$NG(D!!{Ya6R#jC!|B{lXgKq) zAVbg4^(z=ij!=@2^&`d&@tWlHxC(v#tOjxTDk|hTs`(Sfm?Jry*D018*2teRJb8f* z{*1OhO2Z$W4nuJ4FH#ET83n&UYDP1$Ar>@yUPFH~mS$YTfOj0z0w{7&T{ETi@_?#p z>={h?eW2y6*QFjc9Wy~Lv=@lnI(4 z?Nr&^`B zp{V%aD6e*2Z-FK+)g!|4+MO8X6=a(alJk6URTSECyR|;hYBwaaZNWovMve5xBGzv7 z#vF0f+xmzR3ES3r&dh@N4(Rx&iMZr29+JNHhh%b113@HSd$gtVPiMA{c>FnWjVspo zZc1h^ZdC97J(H&`0}QN^%5#}>Q>tfM2()wIgf#OC!d`+fseod!RWN z_nWt&)8DY4fKP+%m5ZgNhRfI@kMG=-($c+l%U@UxbzcH+Yyj{Kqw(viHKoG0OjrfG zEA{nS3oM%kxdC&U7&h6%?@1R8m?~RJC30H|&rCW<8%v?Yg6Jn;g}gHQU>!Tnc=LR_B}>os4gEjn{ynbBV*3Nf+pvMXg)Pr*a}f{_ z5mZp{lA4f^ntIfPyyp#4OH&Hc(oz!A@{%TmvNSazt*o@5+wP(Tr+cYEYH4XfS!!v) zsm{sL{Jz)h=YeN$=$y~*_51$u<>lk-S+i!%%$hZ8*4#68O6Xz&q!>5;0+CH@l(%A2 zcU4CSM1@VtaNO+c9z?kpZ!XxRp|Szux^~ZAW!j}^0p>IDt>6N?)Ys0lQ7l!k!?JMZ zBqLP`3TKI}M2-Y6S%mS&IFHi>yR;K|-q1mc_S*%F2x?s2Q3b>j2!5UHfHNSwy};uf zPk0ng>;w)AmV#VGfzt05=aUGX2jcu02@azA{aDW`dQ9s;&pD*ex<6$mVewp^*<%h9 zYbccU3f5ac=qN3gpZ2Ei8XGJHSh_!Bj^st~S#y|sQD&1Q9kMq?HzVUmLir zaU#!|3F(ROh?n{Myg7^$+2ySACIi+FqS!%@)|3ZhA~8NF9fspQSs{>#d@2Z$5`?hf zj)4#y^TLe;A<|GsHHff!0vLo z6V_7?d&M)XlUVTz(F0xPK&lRvdZR3jp%O3XMTJRmtdGJ_vV1gXoZkcgaID_%8I(K&mQp2BPGgpJX|UT-JNDAF74geB?m_Irl8i^S{n%)mZ**}VX@I3`L;nv&56~nlKR-!xfJtKBA$9~`NB}XHH4-8)(`#xkJR_tDgx3QEm2s141j5M?F zW0GT}o;=aQc==s%7^x~0J3G$56lwG0h4ekxO$CHn+7SZ@sij&t4%S@!$C?Sd++(D^ zJc8a7fGrC-VH#z{f`5m>r${{E2w=t+u^N@6DpFZWJ`Q_-?PvA-1fiZ9>{2W=Se+Rh z+eNwqDVBDTdivFy1LQc?;awz~-=|(+&S*M9!)uX4&gAv@*c#wIN-s{FG@f(Y8SS|t z4t0fv^Yv;pO|K4a5D#7+11(m*Jd?hj8dKwOvY?w3=JOfGPR)Lu zXyN2;5UOs{y#GP7z8h$M?z-Gfit|M-VtYtG!;yPR+uRPe?bSLGDdr)`M)~(*+!K@} z6(MLtlJqs4ykzNpKhAYWDoB<_P*E>wvG518e+U)zg^`lcTUrI&#?($w4ari98!Dwp z`G6LuNH4mb1oswzs@1a9wJ=pm;`~@%b*QwrpY(y96X9jop;X-i7Glm{*yPd><4i11 z^O0!Ea;YELu9mh~YF(9AON%T5Jq+l>sW= zWlCwla$G0k&cBZ1(uM1!1$vy^JJD~q#;G}swpSO1lSA8wN*O>sH5A3KrR-r6tR*@( zOoAOk6Nd{jd5uw_)HGc1J@Cg>rTmxA|av!ob`c?@Iq{8y}4bQmqt z&l@8+<`^rj){$#hLSVASimHgZLF5~a7$foA9w#l~+>Ddn(jyc!Mq%ekmNZZI zH$RBfVy-piBZwLX!YIqH$6nB))CjDnXG{G+MNN_h}ytEMD zed9%2*fBv=rlm3(#@0lMC&|B?D6N1qcamV?Ym)?<`cD>k2PO*CIBKfk zYvojFBjTmrKUQ4gvIx7x@`piGr5-@bScm`mX_43~JwuA5l12E> zE3|HwRDqlo*TcoZabomy+%Bi;sR-U?5nkL8wQt1#L9E=bx zt8||9K5(bb7e#$-zM${8P2?o|Ha*utRGW+D{=sdckvF!2vu_4?$^vu%P+bdJu$viN zwLoCY3tPaYvjJYSP=G5JN|Qx)f+%&41ihMzTG>BaP|D8J86Jc=VK97eo-|#@l}AXb zE9Q1-xerp@kuP%FoG&dA!5vtC>D<^`AWZ;@G>$BB8b$7wKv{ zgsSI)KvFT}>ilA9iqM;E`CU)VcbNk~`MbMxtr_Chn(OZtZK?KdQKjKar2ha(UaF_- zY*7nK0lv6YuL~#TT_+8u^VdQroF5`}6~%B;^L418ir2cJFWm;|jJcPayleBl61EQ4 zx-Kq5?Z8bhlvetJT5XZ2!nMWHU=iQik``3ZL`X*6QkW7fQC5Nq>PzeIcW3o}y`fu4 z9*deO8V1>ExCzZE>rO0Bm8_JKK>ff<=^;IG<4`viCbL%w343{!5UoKEw4iJl2R7xT zfrj)WmH|>K!)@gc3Jq8AplIJ09u!S^)M}VJpx!KX8bK*@rEYY1CjOJwO0SB^Qs1ZrWRwuS?Pr{#mk?p$B9Lp5%@rl?#T1^qm)N5&WBP$C4GiPO*j?>qKgJp#>7}znCSthA=3ox!lXmVL*Z#BI7v}gR$ z@UsnwVdi8xuB>Xhty5=!%>1^&&*t{=KssFH6EgQtOx2jPaKX!e0)BJ+m*D4#BOX?< zRPk4G>dF-^68}AdaGw7%ia3YkQ}t*&EVNBhka7+D=JW!;rTaEXedIphc*6Hl?ItM# zCyPDFy-pW4Nvr3FBSjWqo(bWUc+R)}qAvz&`VGDa(E$&^_Vx z=VlAGfz_Q1M+@HSYjri0OEIzTZoFtOCW6vll_czK=m1kP0;j^KyeetswP^D-kD*H# zRtwcw(ixj!w{L}XImt4>7U8OTRoWdH{|s)0Ftf7|ewH$usbCYR_F6yOE_MtGYb#YB zL&Lh03gRN7%WCFp^!qWi_=UgH%>Q7Jkn))n>3q~nnJkCD1EkPL4fpX1`u<<;8Ssz**;ov%t$ghDwiPtd>eIA4h9GN8cSs zJ3K~yC(xQ-`PrRjqKV#OnmBU}WbysyzX9@daHt0YhXD z7NfdO^Vq1z&GySc@9E{#Gm+74&`!2Ni){+Qic69Pi+8OYY z3PX{vX#OdwZ}+be7ymrwnz+StUK`9|Bo1lkmn)FxQ_@QooHRM`HF~U|*#S1}O2F?~ z-M=+QfUcMXBHU=1*lBYZ6*Qt}&2NyT?%$c=UU9xRhneD>F~hy$oHd7;;+!+Xz2f{} z4&yjOc=^5&6=Ns)8&s2>(!Y@sR{Utj(`g*n%Xhw=uzEf0LOWrZde~3xgeB`?KYNDV zC>UzomeJ%HD8h{CujY2bcsR@z@h@|js8!dPZ>8xzxYXk5@1!Aop8DJwDbD8)TyAq# zy0`N$W_%QSB51I}VOqZi(vxSUZa%-Ee>p47blPEa0YzL=WULtMq0DnqU%x*9M^E(# zG-JhRj8{v}Nr^uH4y4!5NzaIB(FCfEz%>9xKS+^~(H%cXAKU+fq`8OtkP3c8EdctX zG%Nmh0}6_mO&5u=l$mEs_FyFxQ#H(?)P@F33R zGD2L1&5GyqrkV4CWkpJ16`mUAm6 z7Tnemy$#;$E++A9PwkZTEBMU}rvYJcDV5rwsu)f7-YcAIGZ_)W?aO? zv>l*%6q^FuagS@qMd=rdIHj|S8nGFhVv5jvH@y{P6*q^n^6rX{C;n7??#aLUKPA<# zgNY1X{u3jTKv(7^>1V4w2qC=AHGl?Lr z%?a&ADVn6YwgkuvE!g@q)**+wBJJ{a3zfW$`H3-+_^+;m++b;RRR_x3fa3y=YK4`V zE6btS5hNVh?cj0%2C8mHb30DA6T%Kg=ZdUhr(miAV%UeK$WPgi3lkJI*n{Yn-IKXvBSg3U@ep20hzcAjrqsnpCMqG$R`M!4CIjhMw`xbcF z3<;w82!GXnyY9uw!3>M$D$wLbKHAPdJT1#j@KgRJzc7+QK_XP=VHw4S$}RK43qz54 zG}usiwA;aKQmEVyzs0n1Ogb(-Na+}WDUL7!ZA{bRX#3TjrLr81=W@P=t@Tovyb1W2 ztc{?G>oHk2FI=Fu0!n6KqNFBVehFv=-}|esHJ#*nR!e{jlf6qiaNHqsU)T2TvdyP^ z7_#XtssIU54L66m_3G)KvgAYg2f}e1?|AH1>e@@z?5wKTpjkk*ZN-aS)|QruB3{19EiKrSFXS^!j69Ow-y8xUyU7T#=_DtIm7*Xs_XCo`56vJ zrbAsNgXARk$fM*4hGCA~)pU(~$qPnc;1o|Z2E~Z8xu2!W>wxb655-P?*~irSI#I4^=oH>Ip9$m&`;N}gcv-pR}*z400*LWDU?XuYzM zyR1%DPu#}1(}~5${ynbb@sJa*w2*mh8lE6afLBkD2e2~{M-=jJz%;ZpQRZ?$QRD2z zMA?SlT-`KsqC5t_D|1xl74T=pj)ZNPgjBd4@Za5D{?(K^NmlKz0L&T!k<-zoR82;8 zGl65DKuKcVoRyCWCK)7<| zLufEUtxQlNTt{z{hgneZg?Vy>BUX>VeaS@!Hh}(2>%5AMEvliFTWR~QbwK}BzJEUW*LF|>6)r+ zEVd%|J%D0lP0xK#fQ;NHwV@!4?7CS{Khg+)>npd*Sw5EKuIzl-*T;`921CCefoZM$ zJLPnvRzfM~EP}}OW>D|)62xy%egTx3ae&3{M^_TjCTM`RqY*yfA1m#A(M zNnc=wcn>vikjJmM)~F5e-+V{vkiUUv{0%%4aKjQdY^<)x7*`38nAym=u5H|2LZXMZ z4G{2QfO~EjYJON&Gl%~T`t^SUAJK+P?y>-Eqsm3y)qL)2b&Lc;OLvE}E3h>RU28YW zZ&<=d=|R^c|7OF@54SeqLiVbw{UkcM4gK@_Qu(C(4{vPOJ&(veeH^1b5~$uJk8q6f z0AbLHHJ#1!X~$S^_%g>09-ys2#Xi%Q%h5WrXfDa49oax&so(=}uz(+dgr6lj!+xU< z|B6z#$Vcqs;bjpGB#R%Glw!8ZRxu($qdm&}*eZwFC$zR^r6u2%Y0*|Xk z*x;_sTag+2Bpnt^l@Zt_leH_tMhmyeHQ2YByj|WUPeC{<$f>$}6Lup(uyIcCL2SXQ z*db5pJ`F)^V-CZ|e_Sf=6S?b*#mBWIU=;h9yc!!=pMFdp9X!=#tjaB3fH=iI zBv;7~K~?OilE-82x48-?z-(7$wfu&!BL@kxl)Dj|k7LLZ^Rk@f%mtinAm$o}iIzbu zeXcDpqX(0327*y0cVPB8Ie|{TBHKhxt-_!ehCGgIx#R`0jP(FWb-~BXoDB+|ZKV21 z+$V7UCo62m_i=o=$|c)kS@&@!IK~|OHfGaWGgW^xMy%&ua*=bc9`32KieHt7IB(H| zJhPm;n-hFhPIBI=hkGi)#@C=gafj*{=R7?ej)@>VV@qKA}-vapV~(iqbDc6wj@Um9NV~k-Zh%NYN;#k%%@94AP~|AoZe|CL1QoAMo^f);=(w`VK_W<&MVyeTKiOAyuI z7)yB&<@)!)GWGcg8|=46o>578OAeEl0?$(%Ao1>vw(<8MjCDneT;n$n^`XJUAH!$U zj<@79I8*}50=wKh`A={))yP#o?RBKnixbC?^p2e2xK}S2^Q;4QTd@9khld}_Tsz*C z7vUCqm;8~ujBlgQ{LU|d>TZazx?Vjj&+)Mr>QMuzHl;gO*Xv<&+((D%uJ(Vi!8^&wVWSyFUC(F7t=BnsG{AS3_cke=0Tu&wiqZPoLqdpOIY@5ZxV>t4Ik?o*2HW6NBCOraFXYDiz}=7 zCsya)j_O*LQ7@H$BX_0!KVa@4z%}(pSd8@2d0f&Pb3v9|ITz&hHcPzg!f*08Uzn2V z7hxR6yEb2x19=Qod0CEYb;Kwr<}dWs`!BZ)i(CL4w^-J>E?$vwt=mJcT#NEE{FLph z^tG=;_Sk}nrPK+b?#uVqyE)ExTJp(Oj1(wqlMR!_zKYEP?$?iTMwDf2#W^`YWw%}% zR8hn8SANQANXg6oN*QneE!_u!o^Dst@H@6s=xC}Kg{=!YA(1v5l?7egjwaz|=Ex4p z7GTtO;;E$$iiY2o2*j+A0&K4YD!9*m9SsV?>mr<2Y{}zG<=0Vdg%h_t9mhazO^_l1 zur)~GYs+2>QU(jm1S)kXgK-*Hq?F}wXX9&JU{~Q#l5jlNfX8541TrsmR3Z^SxuX&X zC%dDPz)rA&1^$l81ov;4v4cBft|VBAaRZjYITWl6g(FK!oM2~HuoEYBCZT0lbi|bU zI+`IVI-*XXDjb(XM#@T>&w3l>nh4q$g#3i2+8=4lH&_ z6EOGE5TZ12=0cT4jFEr|)-hqqCdgi6m|Nyh$-Uu4{f=hFlr9T_5KQ6yEs?U#wKz_x zum~PHk(XGiJr3I@C0<#Dv(Q2gQ)X)#HN-2+5f_=qknCAZV=V8ctOua}nMll%B`95G zW{02vDy$DhUdG`hHAcEDBee<2MmX7t%0qBYB?{o>L{W{I-2v=Fhq^1%;B@bSFrraC zlsE@#2;R#l3_{$rg|#^;75fECdMN#v+S7Qhs-cH6oqu!D7nb0NR7nZ8OD*SLOM5C~ z1RtHabPT)y1y%%ElazkcbVLrLtRy#MIc`OgvPws8^vA;>X~{}gWG6Qn>?@?wWaUf5 zk6nrC%TciKSkg-fWOXly58!JX-{3tliiq<%Cw2q4V zDMJvuwx6QnEV^iGP5ngUZX6s28PQ$<44!>K}tU)L?YaC94W?^2+yawp8gH4q>Fxu z7T3ZI1;grflzyGk)4>*UI7;R2Q{_(B<6AUHSx6bWZ^vk1^@j_;MBh=`J*12;3p$rMY zq5aBi1V07>9-~ic9D|!Yvaa|@)bB<`5(ab#rPgABp~2#7bLHQtykv3iM6|!LgvU%k zOQ~o>ws?ZF3nCUjQRypJBGkx_+g>T1i0Uk)!imryh4jQkWn=fpfyA@z{qV8TVsxsz zydvZFpa*dUVE!a!qWTiyjgD`WRk?hWneMy?4ER~-|SUXIN`2x2x)=W{XDAK!Alp%tbK9tG4OzDGT zds02_AWfO71j)~ULR-rW`0pBk&%w{7ejctE#o{*$jCOND6PJP`QjF{Y?8a4EWcep5P#SQV1R5cUIZ9ly`Q%P_h02&v`P_6C?w9JA& zEu_3zN~mBkFA;X3${Fa%D`qM45M0K}w79&SmI^4y5jC?T zM;Rchq!Sek3r{G|RR(6ih4jtMs|J1+tXe%^9)nlF*xG9-XbE$sYpAvzf=vQ6|eD0c_^V$CNr(QIijP zfe*pY%sLFWZ7ak~fJ!IlD8uAWyyDfl$<=#-Kh?<{X^)(%U@ojp=TSY(v%pW^0)qs@ z!keSjc$OgZh~=0b!=ol?$Lg@q^5|Gx5FZwSosRbf;GFR2IGde|^BH0|sPc5j(Egv} zrw4x!%p$F#C-lTUwGJv_vit?7g6OTvNRG#mW!!-o zB!7u8Psxd$uk`JI5?~LNis+mhD?Uzvb8`wf_-7)U{WZ>S3$kCeAu9%NS+j9z=)&F+ zHdoVp<&wquHPE;^J(42JLS?+OK@ajQ&-{f-g4~E8!=`b!;>v}}0Qs9XU>pF#xObOd zSXs#?yf2ccSmkelo|A%6$3SvtR`^xKt)33uM3R{NS)I|M8;yyBFn)L3Fr4xmx){ha0N?&mao9Q@L%>B|Rk%sYc2yqFjwe zpMDv5p4Hks42R`U-l^Ea|MCt)JTZqrl?SlqFD+6u`3i76(r_O?tQZgTzF{KHljJN? z=E;oWSs5o5!BDdR>={`!yNq8$t(3MHov;r=J-SPhmn*p5>OQ6(ha;OMi(w7=0?V^< z-d&7FUw|O6gfbVxHVX1z=M`>DHt5ICIT$%pf;S_ty z7Z;r1Hc~mDOb0EmWICWiIq8za}JL*w9={DX2 zy%CHc=A^OCg8TOi&|+8Z)39c>0_%ra_hKw5(*yS^(N0CD=!& zq@QycB0F^q&wN)-$HgYomnk;Up>Q3s7%~pmONgGkR^=@iwS5^F6^by=0)bHjoMG)I z1NPu1=EJg0oSF{@j%U@BE>{*McLLa~@FL*HKheA+@xxPGQwtR}H40!4ZUEhEo^|#P z$MwcWO-CcFO#yIeMN3V`0HNKQjwoNESVc)LVl zSsV8RqG$H1S1QZoB!E4ti_%vqJ!$DOB}iDTYv>;MyZ7=&14XV?rq24F#W5Q84_+pC zAptdpdw=BKZBn#6phUYU&(yE7o7tmbKqtkx<)K0_VUG1)JKn$C8?I@||*DsV9O1zj;OkIi~` z2JLEpYw9pi@$L(Fxxy&*@HVMnC?8Er*I`QUdh&Y+%5DTum=T@=oc<67S|jx!Pd#|g zL&`MgC_Tti0iJsZz2!d;oWcgaR&3Xc*VQKIE3ZSe3!Y=k_ueeg}~gQv9% z#zM5n<_v^-@($U=V%zZuYk8^CPoCK(ym_OF1HqLcHpfsDfvtM?jTyzInEJy#^rcWl zvk;4`*h5mt@rW`sJg2=NpvF=4G;B{<{)mz!=K{x5zt+BwQT4$`FeG=g2DdYb?9XnK zJybn*k$sNsiy3KnmqR@Bm|upekvTy1G_{1?yS)tN)Lew&pQ%Dx<}}WhDFfwO5a^kq z)J^CuZv~i(=^3?f6U_g4fO(|my1WS!@!jVG&du4d7`Ul3m$<*a%^cRUt3OCy0Jvuz zrSft?MLA|p7t(=pWoJ|#Q1Gv{0QhaJBKlD7Mn%;%bSc56=tGsVCBjul3f>0kLuUjYW)1B^hb z?H&b(rDsCc@Gj#MajtReEXa!MeUbL$3isID6mwTsf zWERW)0d59kk8XD#w7gxI@hAj3{=@@{3N#ctdVhNGr;1xL7E zeL~T!xIFjJ)8K9zRi8yG-h0f~R{jB+LceE}-S#3-K))Wv)mBi<&=#j!DL>2;9*uQzLog6GFkR{ z0g9t=jTo&*tRjxXEO;Yg`f+F=WscPFjMZ~W5WwNjVS#2P4T2+9HMo;tx}0&wwo&C2 zXQ+d%9E0QzT=fZ=(N}2>KBuf{d20^aqp!>Zs=>?6_>Bt@o>yjL9a^Z0BsTeKQn?EV2BR@*-X)jmgAKZew1; z{F=c4Ac;b(qkCRL5qHqmm#_rtWhwH?v3i(*Zx(eP<0(qGj5`~*b&cH6% zzF#SEJZMM@_Wib0g#NR*3l{&94k=@h>*D^HpICngE2@25mk%jNumg(f z>%kFD3(VmKxs6@n*Oy>vIh7JRlXvmESF5t*;vu=b>A#`a&$O z)qkOo8IjY%eBPI6UOQZkUn;6q4|ST`jiFW`-IwvYN=gH|z}0RcY3kaIm)EL&V#27f zL7Dtt+Dmz(Xk2I~(A$lQHI{4LY2uS1rR^oR#v?hbrzTLtTUY>H9*j*5#~YQjzi$E4 zzfnqX-8Rc~SiYZuyQauMl6e;h6Tw5`x~9XO2C-=+W}baNZgI03xw*I1wKjw)?P-Yu}GbFe{P+ z=arpsW?aC+d>Wm*Abe|oQijB*fwM?U#AWWb>!<2%oz(K5u~p@SEBC|j5f<0^CQJzX z#9QgBoqi$ZzbIk$Qc$@X1n>~|FUpI4;brjiFfNU|Df}5??%ot<4+V(PH<5f%`P^?a zm$$4wJ)*3rj}^NN9DhJl69cLC7HmV!_ybEgTNpQ#rvHH|z{BT%Dr$Eou~kp`QMgwW`xVKvV zXB;DZr=A(ZUjaWiX~SO$Kg*%ve;j`9_znLq_}LhM-(MuSn~MEaHT?;|jnTG&`=kyt z>Vxz5lnyiJaSzoqiKq1-I4#LNqr=Qud{&2aI160+r&(%Lb#SIxyH%GBaBFCn( z`uqRq_g1^Q;J=VSFs>QvpeFtu&LEaEZj%O6p3`&R&jfp3hjHUK@Tw>?5KO7ogSd|} zf?m*JET0DKMIFXF^bOccuwy{tWj$!HDd-g)mS%#vbXd9x_9``kg#9%=Xb6>V>=;^> z^F}141gWofe_e+UH${0vhh1-i?I+m*G6(dakyMQej~!*gcuNoZhY42W%5|tCaLWYk1vAc5z zjfztH!YPbWL*al9UMY`4Yu-VY&H@zPS>=62wZDc8ru@!o3_?mfs{@1%;u&zx2>-b= za;mc$-Od)Q*iE>1DP>@^m6D>>k!}*0^k0B(a{FI#Y?)L>t33g)Pls{Z5UuvZ@7Nn~ z(N#?m%+r(@aA*hR{fxa$3uDwZqFd#zbRj-|@rhgKd*BRb0-K0pRW*D$YYzO4z{h5% zp-}fwdaOFY{ywm;1vrrEi+s>U#;ThA1Hdu>`@O7wJ{GxR)up&ZZ%`MgFdRho>(Q4| zPWj`8dS1qUwTl`ibS-xWoGQ+o;q@K)Bakqx41MK4PVLzq=EuM^MkQ`caiMO`woq$( z=m*;nuKXF7zowK$S~0(IC=Q}?h%Usbqj4Z+P*-)ExS})+8FNp#GOfK1Gd>v`*Cw>uQxnyi0aAZCkH3=>gl{!?~JR zHylO*%(J7PxDLgupIdzD9Q2ise+cEocZG?Qpz`w|xY_`=XQG;Duh(NeiVb@ZR8bEY zOnfq6-`uY^~4Li?W3)%0WiDY$GBRwu?FzVEk#D?x_ zXnU1)qFCcmQK<4|Tlb zGZW9shslF=BC9ZEeBlP#|YsdOGjL!Z;ABsG#!lhE9c^KX8GvU*5Z zG$kdgxVw=8Y~{&nkO?TBZcc{A!FkeT^=-0-s<@XwBSfS8UQiHUux^`;LnOcTQhVCJ z)N^E~?!DDAYN(I3Id}}o{R&sie3D=9gcYO8Fc^g{EF;=d)WxXi!W8J8dfJ+zCWNyT za2sZRoYd)YZLKGHJPekUzhbaA@%=!YqfAjX#C4>qO9q*lYe;|@X7u>XbkAzF?85#@ zk7Q1zqJ4ek*4Yj3`3F6+$Qos)#TonBBSvN)^yPc#fj(+)M*~8*!xznlYWqNt#R(gg zY<<=3;%E++E{;-%VNT$KzUn&^^S)|};&y82dPd-!GAmGW-XMDk=4F1TAS@iN!zDCz zvtiVp{Rum-@`prVSf7I9UsX><2T{NNYFJs(S{qI1uMULizoEbSJZ_s#zgm3**|>PM zx)aXU0qPZY1|n}`>CixRoOt`J2U21M&pF}L$GTDnsb?%k_KO}39Z2(@@W(xMgQ3=O z0$>ot=J;SW#rU0=rsn(cR!Rr%qjU1DQq^hdcyas)`a$&etUSbtUCh;`yX9;mZ#z#{ zvp@xBa>XWhKAL+vU6ll}t0;3d&i_i+suC_RiM)dN{r(h$;5TN4t{ty)UTUYTA^tXOZm<9^OF=A|XmNJo>Jj&Z4hsN&5 zX?P~k6CY=MkC%TlP0UoI{pJANkt}#Ebp;QW4D8D|CeJd@e*XK(%YWR<|4;Z)&n@xS zz;DbQ8#L#6#fgBQi^h1kRfhtvQ|4(r#u2WBTI1S3Ih)0Z}&NHOWR5cn~ z00s_KC2@?(Y^;6Px2!XiI|3?hd08r7W5|zZ zH!a0@c+Uv+QcF4`aSz1@{jfv4WH_z|I6qR&haArsrM{t`=_&2fHJW1bgRQQNe?UC( zq)x$T^;tBBs4*}+(kL4}By6x5V<1auWI2rs&2X@GjLMHZW{y=q!CgWuQspl?tgfUR zR52I+-8l7YI}c>Upn_^|4dqCUS!$>sGa1(p-qS^ON!grUA6Mp$YF`{Jrn@GnKVxtI z+==Q?F@J@#mhWTEpk|^PiO^FMp=t0s{8SiX(j>L3n58l*g_(!5?^D#c@<~y+YhaR^ z=u_sPH|I!rD7hn8QZ-4nIe7rf>^3*t9du}tx(Mb>=45pnoKut4hy0k&K9ss3TBV{X zs?C%vj&My;rS{V<!Vfmp| zd*bz2HB6MM)-l9rWaM^#;!@IcA`qms9r{q5y*1IWzv2+iq(6XQ(MY=NY>Hr$L1L3!T{ zw#}wP?8EzYH^XEoBl~PruiMAc_}H_y5GtCjmZ1BS=cwbs=E8GW99TX_wI% zJEZ4lUGm)>ZT4KmE~J9n)d)Mc2Zq8sDjIoNsM=`nT=X#5kUtkK4o@%N0u|$4*rJ?U zFdE?3V;3Sy9FPHY8AKQTVWreWR(kf@Z1aAb~0{@#;X8F(A88O$4lqu=c$YB zO~?or!A|q%gF2SY=Bqf@&n3|vcaGzmfyjDPQ z_?Ttfhat9GVqC=wkd8ZFPuc&~l6-caNWLHs2AN1cj(*R>=*q;k_+Nm{8qAyr_H!N# zxL_kcaf_^At>||3IPSE0;12amAE<%cJE0#xbfqqWLiPF8;reQ^+M|U>70jdQ$FW9{ za<^J!|E(o!uiXuX<3j1XQA=rb@oo&W^c+rE(wf7HCF&j|F>0y03n^Y$iX{A)6L@Sr z5cd;q*@SnYYVL*ASw@Zbst;MpTzSi&=-@UkSAXo_^KXai@M`ric-Ot^YxgmPxxYJdCA~Gj*2`)=POCnUgQEhvB-DRLL zy;d}={lDn^3t;?f1><)&vOJ6luDTM`ntRynWNU}{<53#CU5^ctNu}yYQ8!q;8SAH} za-KLPPRJ|MS6KjOGKL~`v-vgKYD*YYmV9MBn&ce-ESq7S?^;-W3OMnSQ`QIq&|3+c9{Evj3?W5FfRW&)J{V;Pr zL;p8QSR0hu_i)43rO7>l%5SmS9{B}5*KNVpZ)be0;9Bho%Qh%S zH$N$|Otm>Y8l7wGHg%&f!cRR0y&gc}JJA6JV5bIVqyy;OPIZWwml%L~Kg_;mRG@Am zF?!VE#4<{h_=(5nWBpuDRHz@b1yb<1x&l#~A6Kazs|xcKcpsn$XB7AEYS&W2@#s+c zbr)tf`_S0kLLrpyR%cmGQ}b>N0C4lp6X*m2DEkSFA_H8NPpH3epMg$9b?w=s*7>+G zv9|my=H<)iiD%K1m(gW7eryXy(Aag6IFq_posKR;u7XY2uon}E?t8l^e;>vw0-ivd zor1M zj;tvAEp_PsPhcK-VCF!ofwkIZpvL6>zk}eas8xTp;8jb@`_P|t*%-A1GAE*_Uu2?u!eJz%F zHyS#xHi_e1AXoOsYJ!g=0ZoS60h>|}y5FQ}h(R_h4ykKUvoJIgTv>-z+`H=b5IjjZ z36E8P>2;WG0J#2Bb++qZJxfG@i#-PLsVzsb3Brv)`Q1aT<)48Yg3bt6+UM$oAk1Zy zehZlnqULYW>VhcwG=w>g3Qxlb45A&UA*;f!pzJeo*g`lMV@T;cq$J{DKi&6gP+7@n zsDt6y$C>dR`j|9q1A)mOM1|i$-qYyVcY+j>@kWpN9t#R-H1>OeZXjr>iC_sEA%=Cy zR=zPO++Ei=+{3~674}9Cs{LM#3pd+8+~xNKDtFi)(&g`wg*_B?hBb-{*MR^U1^gRp9Xlg& z!^OSMG|GR`ft|wX5C+DRJOh@`y(Va+x*LBX_Q;FX7FH4WD*gxefFbv|9dl1E1>&W*;D zMmDlgH5~_4Paebz%_TkjrLrvvXbwkkEMvmIFd-tngJqW-tJOM|`N!)?#!?*{_zYwH z#Rd`EhM1~rf#GM%Z^L$+Z@{SdUyy6$Q`!-&jwXB^c&q3^xx zP1(PQ-UL@khSKg|R4uz1`8Bf6Vv=lbfDkDjPsQNFPf--c=RPe~_p`0R*Kzhtqi|_@1fEA22l-rnNzIb`GYYb0D21zC zr!J{q^1iJD7H#O}OIi(v-S`<`5pzFyKkzpQ&`BSy3aw;=uQpBezqlCetstIkvRJic z2q?5_31aGqC*Frq?2hi3FV>LvgI28w;bZ-@hv1xmqtAoYe~ekU<^I}wfb9X=PB>2o zXdB@SvIz&1GDz2^?MK#%OEH3}vTHp5@UC4O4^VgqZ3KL|9W=f?;y?$@Jy#V-u}%zB zn>qlujQj!xE}~--St_nK%@5S(0sTav#tXRiAdPPUYz?jm5=p!qB%;|JB8hB=HVd?> z9as*#`9EZ6UXx8$M8f)#?j@q-%WC z53sY`bwSel@~Amh(Ppu!QLJgZ#L5I$3!aI-m(4V%HcxDi0Z5FqxaDygLWxkVQyan+ z5TeC-PPV0oXzs0ge$?C%yqLGXbCAclm!)z5m4;{wkgv;#4>GZ#S~Q%@P)%*OAo?Ak zMWI?EW~3@JHPy906jh7&n$hgyC?{N#Fe_FN4l-k@G+gTm2Y0yk)He+_e~c}PMN_qo z6w*oShOqQb1}5OVyMB2mP;mFt<+c2>$R2GVHFeU=PXb!0VJ8mN^Ygcq5uuF%=Qc!$ zI&?&$M$0HYQriY#t8WO684w#p=L7Jd^C0hsDQ#8^E@WKlDcRO z?n2>0Rcr*HlsK(|t%^8s9p*eQy##gDBE<|g?w%D#TmK~oxh8Z)L_6=jhc$Ld<2s8#T; zq{^NeuMB1O)CSAk7xAAEDg4F@#h)bb20$Gt*Aa(K?~m^2YkF!y94inDo0ocO^Yo_B zjbg5`29;lpUS)fdc1dh(a!_sWh*0q}gt8+#tFD8|8XisE{XP~hv+m^X^0owPIM0dj zTr77EtdjXRuTJ6Bz}{MdU?uKSUWcn*miE?Gv8eXuR_jVmLFu@ZsoH=xV-xh`e+$Oa zWdNin|6M#hb14;KF!BRrD5j5gTCcb4NbGH_*$V|6(^p##e&TNA1e($psC9j{gUn#O zU+3E2PqX>JV_6arM`y1VwSWNquH=J*HM|!!1W!ukBw^ck8J!xSJ!N3;8K~u8ehte4 zI5##(V{@rs5QK0r$u|JR7eUdSkJK1y7-VE1&Q)}chRq`)@zyl*S=!UIU4SE(+u$oq z*A~HPPS^N4;mm8%1ceV{m}`X=O&_97Mip)zq8)M9zgq6!88f^YXbe~!$`JabIRkQB zW@wjDnOXvT1)1QyX!c8lq$*{N!$Zp*82_bR2aSnW%&&tMVrfO+crEsn4D+eXSfJz?{yk_HXLp(AFASFi zEh|5%BhX=$(LE#3%W}#VDy`NcHcQZbb${Y|ESMN0wFsYUJC@zhFNE?(vI2D-7^z{r zmG7z@g`S*IMr+&jRlIE6qE1btA&Gq`Zwz`BF^x%;xT%SnP-Fh?Q3l;GE1_37H{Eu- zK(dU5gbxuTIXmZ@?XC>=#!=B&G?C0!;kR7psvN7Sym1RN5UT5gaoR{r>QqGFzm@pL z`n=U?r0`vJ)oQpq>bj-!BqaZ_|BKGw3@E3}Y}DIOnvo58s{0Bnu6wi5aSd|=Y6@|Q z(6E{Ssr*K5q~CC1Go=>bah6-CI071AShg016LBJPPDm$PIMY42=holYZsI?Y&O874 z^E%3`!G(kSWhj&erZu9KRxiqwFrT`AJklNMrX|&5$8g#Wov?9ZhQHM^NGYR?=!`n$(pf3yVBrWchn~*Po-5K|%;r8E*X<9zQ zs;6mhKq&I2yLIf^8QM@Ja%cu*L!TeJAEN`I+k0r|jji_oiumv*oaj(uA zH31-U8%LE%@pw$gZGS~F(j4fmJ}&U#R$WOZP|PiC#!}-guq$C)-3oKAHTO7Fa;vtO z3pr22Hr+JZe493)ZDwFZ-Uf^02F{Vo$V~pQuDBI#0Thf#7&p3$=HAagA>C z9a@5%rPm`XLzeVxO1%@Sr&&=@wHf(Zl6<3%U|8VesW2b9dIA;RsU^7T^0j^z`$U5X zHO~uHm$tZ*;VLc{r9 zYzq*&;9H2#m@EB%BUoIzZNYI&$WqB-(X(-yn8=wi33GwcU0Q~o4Fgnk7gQ{au)DPg z*Pgqe|4}9Ih+6zVESP$th#Ts$d>T}Kj~3>0Q%Ab?f^P_=+@od1+W+l7X~Z@Tt4lU{ zxKEjfk6~Dayay)V!}hM0 zNclW|vC+;G3H;ZHMKiGEQ@8U^xATHhBRUKbbfSuR*+?N>^y=*neV<%FOPU;Ahn9 zbyQ~B<2r1F3HFE%Gcv|_E2$YIEsM#o2s}7}{5f8@awUP1i?mSdR74O=c8Mo3W{KE{YjhI*+;Lz>2=k4&r&u0=*fsL;Wyf%eo`d%AYg$Y$i-yB@4#;^-!{rD zhCT8pGB=NMi?vYaOkgnY%-K0X8;Z5KWaY&xS7Pwl5X@b;K{OLlm`P?>Uus@pQ!SUM zxfpEy0`E66Mpsj;T7J{fNH*dOg{A5pOjzK~@t6P6Hj_w4T?4c*nF6w3aR)D0Pw^WEPWD9Ts9j z_cLJBcrIRb9&2zXW=5%^+|_8sk0PjiUH~4A^~Y>N#ogG@TCrM-9G?Gm+eY*S_>V+d zG8M1m7@72kKhPBZD_Pb+eVlVUU%Q=Sl)eU*|8JZ2>7{L zHsNEpT&KkX!_V32!`L z<{BIZzo{0k`uAt<^dxf|`IK@Wf+VgI&WcyAHptUmQUnoK+-gnIG%1PU^9E+IcNPnUYNpW4pgd{swJx|TAs1e2 zbR8FTwOym_4`YtB@Dt>aDi3$SjbaaDyznD6KMZqvzi`4g9QNdS0sNdVn|NSN&h!e7 z!POhkH%(N?PK|K-uRG*PV>yTYWTr}o>3ozpQCi8YF2r( zb+1_&_k_)jAVm){i|$1#K#--u?Yu7>`MHlht>Dc9ykZ%^oRS5N%nB%YJ4It_o&;8a!J4cBRM8~TTi`?DK&#Z?9}8?GFwlL`5c z_uYiUbQqkg4gtn>#kh7I&c%8S@IW0NXo6P)&UMH5K_>WGz#UgX0ds)E6p)VqLvx$? zHW_fn&A`X*Pr4hU$K_Uk@jW+ArXHr3@~SQ-oYgwcb&N9y|265zS9F)FfD`DdM`Gos zB9c)Ga~17+*Hbd@gx@Tg+3;ggauaI04}Kb^Wr$9i8RrYQp~*r`@OR&Fm&MSGMkR0@ z(!>1pta3cga+2=$)ah`IcLpxH>pnt!;lFC!+it?KK;ph$ygvpv79SH~W(hd$+oXji z$LqA1zkmJHv+IA)%l|6&Cqc*Ifh{=lVz1DVl)4#=NCKGC;Yv2dTGC;x$_?1BwQfAd zHDJfvfxV%_n7IbtW9{JG?}l}38Ns7qSKUJO$dlg~gmoyZ|8yD+E7!u(`{-rndKrse zz^t6!LhoQSfWbN**U37-nQiXlG;%itan5V;u?z4}+|zxsTpQSBxE^-3?#|NP5xRSg zg?inb7}CM;kHR~>X97Yj<0+3|ZuZjAQmAlCXee%}+ecbxDra+sPk6QT#z>OtNv8(~a(tnSw6?oB$$Z>TXdA=LhZ4*ry)auP#n z)9gfvv<-=2K2a8W^U1_+6tq?Q-Ljkf9@Pe{*saH%s=L#4cZTjx)ZNLtYv4`S{n@%} zFymI;zd(0y*WE?BTi^*_ag~vv;m*_%a&(us_;aCG=VDS9oRLGi`>pPN2bTxa+wk!pw;kpR4W%G*hjKO#; z0@QWHHkOzxo&4$cvIPI~cO|UO?$Ca2Vd$FAwZZ~|ac6cW6X76xU_2WE= zJ==9+xAsP$eGbAifcHC9{u!;hs;aap0UGZ!G>GzVZflf3hAp{QwLO-(xKBts;@4&= z757QJsr?6wB4TN>=z45R%i$A_O=s~6bXrM-?UfpBj<4lbcR0UWLq%_EQ!Mk`+^9K& zRhIm3;;gPqZ)+u%4)c+<2}t>_2>L2q>5OrAaF~1>fUMnH%1bS0-WDK;6;NwX?gO~n zyy;n_Q?<2Ykh~BGtWH`Hic@hjbk&J&3eCI^PY0L0r^U#5ZOC9d?gHoS0J8}2u&b4T zcwzC5HZk~xMR6->K7x!D3-@k!+)<7FM<=llE9L`jp{0NN;3WsmE zuL+Kk@7Ad?+)XX@rC{zPN%e#lMwy=v*J7XWs-osdwTHzIc zq@{@DpOC|yl>3R+TP_B-j5gw4wR zB|m^*bM0=Y>N?c!la%_U)>D2Eq4?KQvD-7O%acdIz3o(Z1fqQQ6+Frv#FbI^AX2X?4d$n+xT{f>{FN6|z z>wDDQ`gS4||5}(|LU~_mOIFkZ^d-Iv_&R_m@%Zxbt;Y8RJ{P{v@m;{@3r-Kjw;tc4 z`1auYC%$9&e#aLKu6M?lj4vJESbR(IJ&2Dx?F#QKp!=PDQj4XfpQ5ppP-%H^bod$| zvPyYeFAdin3rh)!o5UMVLRhpTU~9?dOuR*vL15aLQ{X|$caY7IZv`jGyAhS68NyqF z&D+7)sc{NV>dbo@(lw<483JX=-}7TV^6#FSc&L`+)1w~4NkH=E>x; z14`O(P74a>3fk8$PUeTuVPhJ>;+o@{HHwKd@^kGX7dDEGQl+b~5MS{va-Fdy*eX8{ zT+bSTGQt(T+k&ljo@`FQhf6|dLY}!$aux7B3PtGHv9iA{ILwdnacY84qZy&j|A(`0 zfs3l@`hLzhBVZsi4Cf{wGlGJG32Lc{33*RVNJ~pJNJ}d%sO<8n3E9O=3m%lEDG6m| z7Yn+bE?Q7oT3S$=T3S$Anx>GNS`y!X?K204%lo|F_wn<1=Ir}kd)@ZhYwsQCsz6$Q z#tuAc262Mx^^Qx*Ss$7NSeC61jd8uvQRBwA-s~uN5ZMofPjS43xG<_)6zvAu<{pAy z+uLFQNeooV;qX+O(Uoqm3{?={csM+PDi4Rp+TQUG8}53yUE3ht;Q6e>L!vqv7ws(q z3cB8Fmr4-AyeHwxe$E9K%<^A=Snpd1)T|ej?g%v*#}*XO8bCrSCH@LdQ%Ge|;4~9{ z4IfBreqgF1=ndd191#4Yz}Vz6G|G7-Jdx&^0YVy8wkuTxSG5bS`vTby90}K4A9WlT zc@(HsuoZOdoCy*Z2=FnIwnl)Azrt}H&`~%DvD(huyffvVX6ajtOxlJ}CkQfGh0k5( z=O`-jH-PSwcBKHoag=ue3Cbh*{8FTnwppO7H~<_g{S6&W`4+UlW>0u5)&7pgt^d9o z8g~rf`P5XFAo!0#u_5e6KnoTfgJSg`s;dokW4+P!1u!#-*^J0`oU?sqW?RnL;C*=< zJ|HV8_jq`8QRQ8BFZv?ZvYAY``(R}8u166TLv_c)2bq+#1My5r7P&u4-Wa}=@OOA$ zes0#1Z`P7>0;BghE7ov=KM`(seSxejdM)bDr>YkbSNk`7R#%(|*SrrR(u2pEWbJI1 zVcUuDLG6<5YL_hPB%E@-r0j-pw>RHcC<||98(+0coqRJ~Wy(*&mk4U)PXJzZ4ZJ_| zHiv4-)kw_EwVM0@elxG&6$37;rfodsKI_w9zV_8)DI3s>>%p3qP;vs`mGmmO(l_mr zG;9Vyw%0??UQ*=x7F+w4#o1lE+f=fU8cyLPbx#B62Z!M@d{Z0X{=UcT@Iti9gU9Od zx4v4eJ}e~HOXy_cGeE*ED8swRm%#%2-i|W3=>pdQ|M@?#iSo@O7~6%E@dx}V_P1%? zeT(RwZ3Alfy7Mm47^P0{0g(=9LuyjDftZip?^ZOe_!qp6HWSr zwO52JG5BW;QOGwE(C~XzSIB#pHlUDo*K6cnwwnc;B zJ8y>eqeFj&&$j*IWAS%T_Sx_eu3wRq%dyIuN4dWNCcDqV4}3ml*yMhCCZZYoM|`Dn ztGOe$P}(`TtldQwVK@gO?;NH!N0G#zlixyuxmKSG&(eQG9Lsmk&Tp%6w@|WyDO15; zKnKrXU}p7$dP2!P2mZeOJmmhd|GRu1*KuF_S_%eBp6>b`!5q{ws9XPnL;VR~YO6PJ zDcylVj{F-fmn`X|U!p?F(+HwJCc-lnsS-vu@ zW}RtMCeGC2W@(LR)@-v`f3|6sRfN^7v+asNv!=VwwP{S2iL>vV1Gpmp37;*UH5V*d*%8y~PW0^CTRUa+cuC`}&ok!K*z0=h(B5b6L>I2cSV195Af!qXSnL$Qr(L ze}GO=ei&n)>gj1OJ_NlmYh$ca*pmKf*P`6@JTZS0tSd>9b8OgiC^V@olcczl$kI$w zGfa|7w8^nl&o6jFtjtnVbJvQMKV(w*rf&%rJo-`4`WJly3#UH$;Oo~PPw+Gm$Xx;i5c z|C(Eib}%zZb;$9qfHwJNQPc|{)ttq++&FJrXs{fJ1WW-I>zj(-xP&4G1srh5gQXzK zh()8O;;vgX9urJEjqNNCc6C8M|ISZgtR6(4TmXtrq5T(N=$c|;ZDfEPj_W{}m?*sw z;}icGATW<{c?tn3$5VBH>~w{;DKNt{+f66eKjA%bkfPj~QUd{Xr!SqwBQoGi3JC7| z2jVKj?0Nkjm{9fwqV-`W5Hnaoj;66eaw4s15()Enz}em>e;+iyZ4x+BK%`a}a7ZjzgpZRd&Kr8M+z}y9;`#`Vw3GYCJV`k?(S8 zZOR`{+1=zgsOYkXwp=6!N;>8L13L(kvlw~hjnH6ts0%UDt$kKu3<{PxN&Z1dnuvBu z1V1kbmNi#o$8puc@<1ty>bhdw$5T{@9E0IY3z2WY{&a!KsVoLIr_%R;=I4H87WxE!6}W%`@ojR9GILBab5st-D#tmOJjK-; z>HL+_D=7PXw3i+TlY6=PAkLp+hqH-mgew8T_$M9)^>C_j%Mq@`cBvcPasp+!49>`P*iEcPTY$<7T1fnbL%Gpi(7 zo+1q}sWpX4WOoNrUH|kPKD?#(w${?jug$6txYLe@v zKCMp&E)5doN{gImHX!i&!5OdT7+87G1ol1h#Mz$*~Em9ti!UTsI z)lsZUpG3;>R+7=}k}$2J__A3z=@Wz+Nm&j#FlY?Y3FuOV2dr*I6ks&g6hLqm{sszg zaCbS?HZGJNIN(;KBs%(I=q%daT~4QmWEp1_II(-DFC|CIF}Crcba7p1_n^KQXAd3+ zr3GQ6oOPk$U3hBG`tSrZ4YKS)7PPh@TAoaEF9x};f42u{_C&X?^y&{djkmroG*(LB zi5<@L`w51C1gi2tN>8LJFZ7V4l{jl6j?%p7RWi-+0@PP=Of&*3YC|J};JhPhoMeU8 zd67Ha>>Dnp>mg5-Gkj3OOE60>-Z9khBSlYyoVg=xSByk4e62_3={M6J6w|y z;?FC(n-+uMAECizO$0}&_41DTw?aL1Bu1VKp(`YM1OqgNR>XoHu0aw0EJdTVDX6tR zR*tk?YXUn+Lu)*EaHu0X1iy4l)e6qSggq6R{gow|l_eP2ddhYOFW|*c#uM03Tc72$ z7iEpbNhUqzOl+qSjR>Q(Uh+EIb)muvFNM;XUUD1+UQ`@jPE*KT-=_Rf%8ir1kfzhH zczLMfDXb(psP1LpMtT*vetEn+)|QDjZ+9!?>@A1;Qe@l%lV(b9ITFjti+jt_V)xEW z{@D+!$D4aYr_7={er59)M!AnXGRnGLh>_(+w4?QcWMLoqHf+^w?1RS6rVPf7)C7?D zP5iqbZ*fbI2iWF>(m!KVY~KCb7LJ)}sNFUVt1k=%sVRX@nvw{5yOjeX zq}!-5Q6Avhgi6^E)dLS(BIcRNYZK9l`J7~gbi0`W(??N|9EknaedYMxIlcjHUT#Hp zmdUW73tVXqr^5Qsxa3?Uw^rmjS_;3jZ9JtlAlqGSgHd`fJk}iK?zZt}wgqj2+hn_^ zZM>Q7-nPMQvfbA<-pqD?+u%0Y{@pg-%(k#?aGPw4+QysN7Pk#@m3>9xyf?0>p?`Z1Zyd+jDwf9 zD@|1LP{+X!cO3jk+u$N;FZ87|U^|=o%GO<&-XT(SQE9Qg$diNJeBLm7PhRq63}H;M zCcMi~R_o^H_s4yS>Hq0$UQzm3+q%d*0L&HElmYSxc{yUOb%&Oou0;yhX`2j9>pzM~W6}blCD(ZpI6CR+g17%fgl*BgDrrvHk zJ`lA3EHw_4H_)m(RcFs18(VvVzKL(<)CqVbJVp2pq1+_9`;t8TWF~4w<=~s^x4uW? zoBb#FoBuAsw@YM|W&E^yZzX@5GA@5e@|*WkGa&)ax-+tWzwj#`H2FrF^hf;9$D37(6w zy=xMle>F5UW#f4d&nMVjb{NlVr<$66!ZY-A)3r?}uuJZ5Jj?!UYI+&Zmw0}~Gxcm! zQ{uU%rV)6`&o?zyRTr(}1ThPNANR=Po?Y;MsxaC^Za{BWz(8sOw<4 zo2v;y%rz}gG*DF-mLEJ%IB_&Zu_G|#3BYv<5|ppRf8_cNN3P@z#`GJfBMp|H#4BTn ze3$ej<<64hjN?P(SU$+Xl_Jj)w?D9I%>%`FwwxYLk;fypCIu1z_e$_~{NQ17pt#$D zahpe5q{I(q;mpc;>s9-rIr$Q)M!7VUAFpO>=c5+f}FITuM8tiLIOWvwf5LNrU zt~5EWgJ4l)W|};~k%@XjDQz1DsWMHj#csi}E6^!%E>A-7>l)nEuZV=ud$m)bxb(^b zo5ex_vk{P}xR7cD;Jci1N66EWd)Em0W4sDS0-h;UGeI5{)Y8_FQBZDidC({U<;A0* z8RC!*dYqa;5B2k93k#Mizn|NIC>;$37o0w z-+)Kj`q7xw<94sHfc!h7F$&9R+i1}`Z-}DN)(hPONE;)MM9XH3ktcJ~G4dPedhWx3 z^nGLH(`FEkMLMLyIp-(kvur~C)n^zycdxd*XfBKbfKCNsCmM8*agHbd*W)v@#y(-+CLt; z6jwKpsxq;m-#I}Z=vTeBZy;tz6GYAPCm@G_J**fLz(NJ&NBDB5&4hMdzYLBMNfYH* z5qJsZe}E&6b0&)HizhlSH2cT^>S=uN7(Ez&f7(0#3q8 zPnYvB5H;z53_X8u?xmN?6Fh2D>jnj-LY1Ctw5>dry~YYWl$K_@W(|ui)X?j6*(1a z**sPjl{7OKH;tW&0r9beJfy?#$EM0-@T$Q}bk;#NS46118a)ew&&-=K4b55KPY%|( zT&5uw>&$-x@NgOccN(Y+$FxtAU&Do6i?2he|Lr!(`s?NYa+~BU)6oZuk)TRn9XKNe zv#<|%qT|GYYqitmHCQg?h7xX(91FmSLH)1S?3IdEg`-Snyq4Mogr5lx0uDXXB=xB% z^T15`K9qUQ4e}|(;1){UKc6K4h#UF%MoPa6^@_9QWjt_sI9+FBHqb4T>ek~ZX6H~f zo|0~a+FxRfx)D4B&H`vKbM~@Xg6D`PADAVtK!Is?;7Z40`w8nXp zyw8`U_-3$q3}birMkL)Vr{MSen+5n^ycu+l)#2ePPI{YzT74jyFb9^G6e^p8xePeX zEg*EyT;MZv-r#1=i&Ju{y!PT-#SK$FwPjFWC4C@T*ekxAQsO=mOOL^~W9!kAFDzK>b4zRFWTj z947GkTjd;7n0=f4s9-AW9gI^g6^Fa|vlo@&xN7pulMB#|ih1%Zt7nPx(X&k4J}G~Q zptRcsZRe&deCCq$JK(nJcKIBW*ZsJSsd`T=+7b`JSbhg+9Be!Xe5QnM$q{n7BnMIl z+4%MZGq+KjBPa1aQ?5H1J&eA0%4(35X^dJZKgvYEYY_~lt4tIW4!dI)%k>D)e*h3p z-3d%he*guDfQ5J^e+m`^MPrG)RNx_73>Xhva6CIkQH{zaa#km#10R@#SME~T1cg9b zTy6svT)GrCQ#4>H#Mp8Qc}V^nPzZV$;>aA++~sU^*#{Of@?oSDas?vNSoyFV7l2bD z%Kp;SRvyYi92f^zK;!mBivy)t1>hEnXvsWSDuj}cMYxUBC*&;*1Zln^zy@d=i3M^J z9|1DsKk^;iy#Ig?fHkjzsdU*17+ai0Fc>fw8DL71f@Q#}N(qLKE#Gy;QBp;)CuJII zi{w!AUeO@RzsC->V3mL($^qpV-qrFkt~i9u@#0}lAz*C^{Z2x=TfD}q7t1GWSSd2j ztN|IfQXg7?-uRRtMejNvoSC(G$@KlYOQvw$sddjK)%VDR(FT8MJV@vEW(m zT@GbGCvbD^bAmCw^_)Cev>ru>GFo)AsORND0;Zshx8OaU^SluF`OnKSB6uj}K7^h) z2L%TjpF9s*lTwUJHo-F0j1>f|fNRm;kd^7(aMWkkv~ar-_!3kxS)7N|rpgqf@nyM) zHRi%sR_*QuEN-GNn=r2e>QIOjE=yu=~N!!Z1r72N`j)N*+vlT*F|PF~(k zwHJTHo|0}*WZ>&ihDwZyugf1Y>W93|lx$q`wv0P)ms8Mta)h|gj|Yvr&iMF<4!)*X6g^*d15dIQf?Zc z;h7E{G3i4&T#TuO7i<6a{#?lI$IP$IpYs5$_Cjn`c2Vr8BKZrE44DSdgr9JbV8Is{S;3hE=-|io zh3Nm*F9hSNNQ59?bR{g!Xv*Iw3NHruLQG zuN87p;bt(8#AV1T#m5!%km^9e(e}b`g_`j0w}N~czZFAX zvkz2|w^uZM=|%wu_gV$OVQ`&;; z=C;xy(cV#q|_lP_|^c9ORxay4N9f7&QVv7uY!C`6h5qXJKhUeiJI0_t(S`2w2aD@U;k-EL@U&rx}}5C5vlA)c}-aYkvMo+sqbOnnh2ai0`30BEKvm7Wx;|F)AtDz{e^DYagH2sa#Ws~6TH z5DY8%D4Fd9^BXV#ITZ2-I#5Er%@=e^w=wMxsI=00I(iD_rWoGSm~|mT;q}0V^z+3krU;Zxj<DoZUqk>BqOlJ*gJw zXI|mY!BBM<(E`^+3P5ZOyGYr<&^Z{a#EFcF$iQsxT0EtABs_vTaQl`r9S|zK8T+XQAixLC`j@cdO^Z+e)*Gyer)7%j|l+f8(+K1_K?Dm50k z(f266Ub8#eGy)HUk4?(_XST5_oB?AT3|HQlq%vBopv)AbMo}iW!Ccla+(uTUvK{D4 zy`u%9RYeQvHbg5U&^W=1JaKBck>ycpdHh!^G!iHkMpRhkvCn=S zZN4xn9fRvn(?=<=FJ7sH8+pT&awIX5hbwWC^qg56u1ICn6GK*-s^kIBylKiD*YiGY z0TRhaU~AI^Q>aM;ouPZFxZGsy6-uJOXy~$IJ4e$eLu8H0uMim8dxSEJ22Mjj-mBf6 z#+xG)%u#&0#Nbi*$TVIYrTlD#8EEWSa}eM^*E7&ve5Jx_x6nPZt`vy=@RiD=2nrdm zyo}eo;|0)N6O<V$MLvWe3;$^&*p-kuLvuld-nGag7 z8gSzJDL|?cL%K$J(nn)Apal)r1NUDd*K}nakhNwkW}%-z138h~k^Tn8nWxtq84UELm4s?Fq9RDK`V^9Var@&Q+Fj z$q))LlsZqS&Ej`nFB}l<+zdy=`{pTZA@dmvDtiC!hoFL8vvfiD>+!me=j8}!j$SOHUs~~W(tYL@V&|7ng8!XytT|C(U-&)xf*Yw_}q=><6Kljw{R|as)N|iyyUxi_& zbHB1mNM(3F{96p|xPOD2a$(&F;tBd$84P`;|5n)a1=ceMjnD556XZ^~A5zjHC0LM= zu&SVurWBdD2#iix!!ge{!BDLD z3}?eS4bH>xn?`mj%~JwJGsCE%7}ncLd?Rj0p0Wh5#czkHC@4E0qL!^3cB+$LB`D7q zU3@nm(kcZ<3W_7KpIyEjsUo7}^K0){-IOyZz8%(hA&VTFedKccV^zVD;JZ4;~+?_w`$-ou!? z`ou%d%a~-YdQ@3sWgWQ;HQ*41WrB&9J&W0X=}6dQO-|!|42l5H7=$Ua>M`X7(Z_$m zRD*TWyyeOiU!QTuYqa#LVDN_Xalp|({53N?YlRYS^4nf8wDtguz6;an!jC<9c3krv zL-q*>F99YL{-nYdY0S8xK|ZMrL>lj^=*h)z;*8~jyTA@gZ|{XUYyou3662OaA(RZl@fV9TnlDEU(uI0`zkRiWW2!5&cSEPS!`9;SH^@jB5M zVV~c!PN0(*?E~wS!OhDW)=V7Yo0l~PuV)V5tcOC|TMy8c(CYQdSsutwfaj5)qb0AD zD2F)V(@Km`b6F>5HTN1kJX!99$Hak}r-2$JG;D(sCqxt?{xyPZZIeE@jztn!e+e2jV$oVfF5IP4glVH*V}%H0TIjypCt zLY;V>Q8Jn;r{X%zyyuh^lJtfV@&e`&C|xQ?vr1^lCglda)@~9quwj$(p(MRY6)!18 z{)*dMrcwj7Orr_0O0ZG+GO!>0Y0=!?Zkr^1voe;GK#9XK2(N+w0ixHymYVC9%YnyO zRV!C`foM-TxCdqu6^beZ%;o4cj}=dpOfERA0t^D&vI30+2EDGlfg;bm4nAODFjI@l zGSuQjUeD@MAad3l3LCN)zX5q5deV!krt|FhO=Y&@9ZpWtS+M`4x0JzFKMLMZ1{&pW z0k;rR^|k;fUhqdVfJ@;9x(ozN=`I4;cOWAaaB*6>R*ut!SA^K~%pLxCx+r;A4hCMP=L7qRK`lI6?69J`j|F-wC3cepL1uG=UO2 z{DE?^8SzF?MiW+a>pz6V1Ous5?zNQ!)67Ky3RPAri3t0>5;MjCT3LmbET`YA0M-%; z`bdbSz8?uPnD~)sSN=ypFksY2Nvqh#UG1m(mv+&#sYq!OyCJD zke>*(dH*Lun!C0EGX(d?H5}W}k#|ib`(&FE-pW!t7jSJcdiiFKHHV?sdp=dn)lt?{ zIEh%Bp@wboV8oYVK`s4LWfAJw^(m&AtOBr2oYM-nfFGApev%6(znp-*Kj|}NMF-}a zU7sn#QG}oc&vt=NQF~DL-P^(3q33N^7Mia~v}lK@?fed9DP!m7$_uQ>HM|Z04c>)W zMM^(V7*4xEUAW-F$k_!29SH;tZTganHtN0vod6r6sxczVjjh$7cO)70HH1S;BjSxI z-zeKT0!@h%Y>9QA=AO|td%*qQ0YMuDd(0_L#kYbE8^4AAyM_AhRVIsUynM}bTa!-~ z?uC$9PUrV3pW#)tPiUZf_OZq&q;xT^^r3?NO1uE3WuR=ScGrF}vX1WrO!B`In!tJ;0N9F|mlCf**u>nERIs zPHRA29?nq>KMKXqGWavW&Zt$60XG|ld$2rRXDUKC-%M!~7;_ALVCw`REurhQ-EX%CCY_98{%2;mA1-_FqLc$C3Rbe#I1(XM>|{fEZ7q z-oFEYDL9Y=4Etkx_jhG_Q1h~rxeAwb0%(^>^G^tQyV87ZJ|Pri_+<%iCuSPbNkOQf zNKj`qyP2F+>}ErX8hb_1l#@a-&p(O50gI_u2KDBe_>X65EJNe*u&I;Jmt{MGMT59N zqaJLWgV|nh4Zp}v8F%$@yR4{|9932hE~s@5;h|Wt2cFx`25@K7-2_N*NrMu~3v_XVp6aae_|J1na3%0hF!fU?8(4fw zOvE>z64-O}lu%bDo)*BIe_BBCvD26YF@{=`Aj>unia0HDN1YL``_K5qy+UORqF95j zI3py&!83q8gcp)g<~<7T?70o+WaRuQ8oKyTO~fxq$E-!DDja`Gp5 z{ii@DoIM`iMWyhwN{-OB=2Egf7OQ1* z@+da^pJVxGO(AQ}iS9M<3+Q~lS+!0Zg?WG0c_j&@6rKm>K_;D7hKI0PVolYtIP(+c zFG+tvP|TvLV=8V|`3uH2PJ#TcRNfcjjoH^o-1H~8jhue~ z6!c(g6GpqdNx&Mvr%NSo>FP~{Y%dIs^Bt;zSI^F>X$j>jxJA~?8TRYWDr<37ossY}x<5d@P1??{sg!gfAW*2j+znQz z*hF~~9{w}cs_Z~DMt~{-L0()7hPl?pK$X2_sshz$yy^ngK_Ufbg5ldLCku3(jChz*6H{k#CAObSt_h&zZo zQDIu3YLtekb6M^NIaO#NG|Z`f11{onsW0QT)ule#j8_(Wf@f2h`XOTTUs2tyJUW|G z7{lD^WR^RH;duMHb|GAS2sPx(>Yxs=c?VX_IaX1DgLF_)S&DeOsSC|OpiDQ|Pn?~* zr;t-qP1!Sqs@}rPJ4sVDfm{kTe5}E6tN|FDO;@K2^;vjUV7O-CF~_+<@2LE-0vAQ8 zm_$E@HK^3%@Lcs&;3$;TacbcIP}sN#bp!4aYo1@=GF>qX(IeI72|Fw`Q+$HlT#~2X zBUNT0J)=~ZGmLRj46sZp>8`2}X>hm#r|7Plu8yHJ@kKa^I-}Kn0Lsy5bvjLXPSJ|$ zmwa=s0)33-rEJbvvVhwu{5t*AOZ&!WhX+%^Qvq~6L^-@LtTN|fA4`td_ft1 zDmXIaQY;hH=PPz&LX4U&Njur#39V6uINTDe3VFb`hsYyZc=5j@G{f0b#jFM-@hw!g zdA-y;F0dE4hOZ8o=NHjKFGGvV+K!uwE8_&x7N%j=>Wo)e3`NDO%#$nPRkq2%mk@XT z#H%eXd=^#v=DLx+RSkt-(p&HxSc*o7l_y~zB5ytx4r_aha(%9nY-SL>_4H9$vCZg& zyAR*#qk1|NSZI77RqX)XHRDH5}+)4+lJeA9SzB>?ZusTJmW~u5f-iBgQ*Wo^b)FDVvL-|8ccjc!DoyP%R zbHE4(pJEB);ZIn)Ixs|?ChEjaw?Di%Tj??kBwIf2K@#S+OnJBO1dS1Z-@S4j& zrr*%Jm#J)Ng=&bt4OORv?1nsNj|SnXL%Bm$ce9-oX3{1riVrbeie#}=71cR9WRFj& z+=1Xu=KYO%1@O73AF6r;zw1GAir^-IA~SM8_6rk!urdr&1ADWU;V&6@k&P8P4(FLr zGk2q^VWub;=Hs^ADE~ZqrCkmzgDkunTsb}11&qI3WjmZeL0If!DfLD8ss#=gSnM5+ zLc}V|BxHg;5^TU^@zuitU}0X4C{9%~@pDG1nt+!uRIX1|N8)!~D!|W8`xiC|VHv!< zF~E1ZTnSy1rVd3CP#Pm_mHE|}CdATBSBRqE**{el{vs$L22XQODfuTjLOVwYg7=O9 zsbLv_6x{mtRyH3`;HRwEPIq1 z(M-}U)vX+*j%W^U8CY1<*cux&S{>kG;P4;o_hyk3N2^msCO!eEWr+~(FF3PjGzJx; zGFlyuZg|J2_u{p7420P%Ix|LnAEm;jpYaaME%)LzZk&mJ?9di}C2*9-5~63kiUSz( z;n%q6N{m1Wt-KOtd~32|`*<~_-A$pmr0LSm?hxzZLT)Ntg~zKub92&R{Y!cTE@L?p zR5oGXKLPFY&7pT9NYvVosvNz*c_*mmlxF}*SD{q}0WiGII}Dp>Y6d%`PQwPuq=|wn z4Vx&sGGn5^Gf_+VL^X+PoG7?s<3!bT3s0u($z9=9F&LOJ?<#etuTe(&BoriSPvY84 zR8BGzR|a4$LwJgb9Sz9urcx)wN#Q9g6}Z*V9NsknP`pWWn6+cRUIk(ZkS>$>bV5J_xgAiuI8Hx z^7nCyEmPHkR>>K$Ir+ZkvLE*rYza$0#KG#U)xjlj6?$vaDE zJJ-z;1C>9EtrN6*7F6{EoWWg`^dQ#zW~;NMgXVYbc6;&DlHDlaF!={GfQN>e{|H}O z;36_GEFq}nv+QOyqNsclR+I)}=3D-Lh@C3oNW|UriwSO>gVoHMn*}%Fpf# zSs>7!IcRE$(KrWy3S!3wKH77Hn4C#D#*4S8cVU)fMBS$Dm0Ulfc@}dqk0Z|5j#*CS z6S0t=YwS2LWN05ibUySsUTzygb(?!ZWty*QQMJfA*ViMKrd*8GrA<^eA0mc>alhnQ z;C|NFfMBC`zB*Wv>L}w5(ArPt>u2+I$b20(U%!~IU&YII1pBD(P_MNe#oN|d!8xZ` zPD#&Er`UcAHE-$LlA{I&aczuknEiZ!+p3P4WgItOzniZU=If+*$@S<$Dsr5|V|Aq` z<>z9I+q{gex$2KLTSKVv^xf)AiO(in060EEx%UWe{oFmknOEujJpg?)dGA%-wm*EW zop7&ux9wCYeRQvSJ>sJ7gP@pBRb!y*&b|-4_f=YapBfi*@tx)+Nx{^x5MG?0+y^H5 z0PW$_A>_Cp3i$}S=6-dmbO~*~Umfole-GaR#=9)Z`ERISchdd;MpK@p&HqMIzBQzU zYA2h}uWUtSnb^&+SUoPify?R8?AML_2SBz#r>*`|#-q6Ad){)mTb? zN#o%>^;x^^47yU?shctKVKvxp`!kfTeoP&0I~z(*J*GZrI~Pjbm#Ytwb_dw*E6dfv zw!eJCaseNd&cOpS;O3D2xat8jJw~_LTZK<{sytQYSfh92ZdCKwxp! zI>-g{DCXbqx2we~Bpj6cE{^I+`mw9sF#`$vQ^`7%05*1SoLi4U2y;KibjIeNSSxL;-8Sk zT;!#A{sk|36`n&7#4a=GybWrim}3P~#vlg{UEiSIC%J4$V9g^;+8k1*PIq(8iTWCy}Tqgq8ZTpQ+gbw-pWHOzv_Zh`{!$}{TVApyQ@%)y&0 z!tYo-ATyDVX)O@xTJsNV{Pxo2&#ITXg4&gz-MJ4|fS*-^U0o1onS0E-YaYQ#2G!5{ zCXUbzZ^f;p7aLs!-mf1Gri-K<+aQ?0O3Jt{Xfq1ZaxQW9xn(>0# zFG@!=e|GaFlkvNyk{4ensrL__q2;DfIB&mnXK7>2qZJP*TjC-I=aSkt+ z-ven{k4f2!YJw{U!IsOpIl^^6MY@w?+XkZqZmoq{JrQrYqnp{hFQK$v2yO!|l;(;< zaO=ABUs8w5@d#!<+XY+$+X(i~bKBg3i5!2@v+|zAV%m?A(G4>^l}^6JQj7!M3fTRJkAkPCljw2fUCXir?l*JC}=NQzm<0D+s~yyo29Xw}aP9 zhR}ce8esW8^$~tXd16U{hr#Ls++PfJiIiaEzN4;_x+nUz1gZYj6AuHM@u9DiZl4#R z{O2w)b)A88*=pB!wj1-_Q|lX}-BV!!(RAM@YQ5Btl7EBF zlebMx3`(+EOmA&do4A_Y*l1DxsX8zyxj8E2GiYv@*?$H-4mQuv)C5~2r0RC{7i3`1 zNz!%*YX|n(VjJ2HHJIh)#4k(}>1U{`dYooA%D;dW2RX#@_Jy6$3IKjy`(Ct5OgjGW zf$sVWK!@t~6*S@j(wGpoNUzI;c+SeR)SwNXE>GnKCm(M#kZc0`NKi zL7iulQ+=6Q)kV8%)o3}b!zigvjR?5{QC96MsdpW$O(ST29ojy!!%Q{RU4aL6Y9(gw zSj?GYz9NdMCt-H93${?t&#>y`P|u$+F_>il^Z{6cHeNiWZs>&IaYrztn#CgmBkWS% z+jB(SIAj#6VlcJhsQC8a;l0p2GZbDzcyl_2G!NY*+I&=9Dvf3^e1l>g$J7BKV_NlS z)G=-cuQl;hrr{XYJAA8vImfYNf}7-fyWOs_$kTfGs*c03V8+Vhe9dbuWV2mvY|r{# zEl2SoC!h`oQ1%I-=W&rCSGH<~ROWFT@0 zx;P3Cb4aUoR`_UyG1r`66+^B*IHx(WK~0Zpn`WYwMxb!=cFA2-KMV8N2G}G(#|`TH zAy@e)DN4@4?yZ>;%!B8^ZL9xK!~6P|X$e+dlaqYynB-poxlXAGx_@+ft7vWlIe&(V zp1zrVHczRsAsMYwRGb1L3V5g?SGS7E_zo_7NvF|tU-abm(WS{au;jog%zJ!krgWGF z$C^I?!;ABbs>#BTM!(Ca3aTlH4EXbCq*tejP#!UKP11YUGl=somjy#-Au%W zd1L)wm}at0azTw_x!dQ0+DpiE%+$K8{erA^!lrpa?dM`?KMqZ??5jTYCH>K;RN*Y4 zBF@TUI!j;!Y)nyJf4l2uG{=fEmCW2mDE@P(un~Gt0By!Ac`g$1ESA+EYf8F=`;5O4 zco+<~`1)&#KG&cqTC1;%vh4v6ZhDr{vs>gT3Iz7YI*nEP=1i)65gHx>MR>M~pP< zt+%uv8MLcyTC^~lYLq-1`rw*kxLMcQv>caz&$v{ug-%*R2f=9$P3<692#H$(4y&;y zTpKDq@QeLe4UF=4cexf7F#P$C!FU_IEwng&UK@yW5{{lvxps~H9Lnt4WKlQI7I+NW zw6t|_b4yzXiLyV1BU0p}ivTZV8pS;B=hVS$jy>Q@LwA9@pR@Jp3m{ zfV=@MCpSz8&~kVy)Yd@lUJN;=4Om>+44rF2kT$l*9jG`S`Iu9%f|AqbJJ(771lknJ zdo3W4j$8!ZUmK)3gYHB!t}2Mm2Wi8H+~xaZAg@3$w~D9J!}0XSW05A?;*g}7yKSP} zE@){GJ={f$aovqlEbe6vSMsBQaC*4}&MmcFv_RJaB(RDy6Yzm+lzwZd!-H^^_B;wa zM)$N!TDaYVvx;wu!>vT?aAtkpBpjzyaFMnTHyF4y4P5&mlvvMXyAuIr!N4`XSC0Rf z47jhEbTAko%%N*SwA-M3R)uJBcuCdRah7Q`hG=jsgS9nO`wS&`yP?SXP@wZPrxr=6 zPVE)odxl#ZK}jwR3!aqk(h^vhr*wy5)uo9IcP@?9>+CRXs@W9uD&0%EtUc+t572N^-At^jRm$1~ z6ppi(mLTm)1+9exgsQ!7*2p~?qG@-*7P(o|9_KGzo79uZktgsLc<)Dntk(Q8a&D_P~BJXxMTIFpIu)CNJA83_qbG$Z-MNn98?Q`w| zyDgmVt+Cl4ALmxlgg)9dRR3HbEn4tn9VIXgGW}UYgpG=Qv|qWE+Y+_2cx~;gy@mqj zU#yJ?;coNzn(Sli#oD97oXUH7yj1vhw+LfyKTX2`8Tm=tbl*Vn(xTX4=jkt+BIeG) z;P*yee=U$_oY?OWN96;wL~i^K1GMfKhQOk!iiQ_t7s`Wy8VQfgfRLf(f zyJ`@qO}x;-!P?zGfU3c$96>{{k#6u1;6w>sH$kBPMOAwgDB@4b_V1NM9+KHYWB7r+4OoP)k#^0whcxrv2?(U{AhWn-!Ah z8woMem!VVLpucfTLLXXf4*kt4sr_ z;XymT565FEeYAF;u-kX0{0zI>$Qz@$W>2a#SJ#e~QqSE7TNRCp!GNX$2>a4^g*wb6EH`^nfVTr1wjnwdc@>&~ z%%MYR%@$jZz75WqstKjy2dnRz4JQnc~Y#|VV0d(thT!QSOa&w2u5 zBJ-!m+kCH}x(p~{D-qnvCO}mW0v*#+umYZVwU%|s6G+fXB|}+kBw^;m8UvU8B+^(| zY6_OBtFke@flzBH{fE3 z)V{plek~}uKl~Cv)$vmy3w*y-dwX__j2juSt*+G(IHZ0f;FMBtu)pg^^# zejFy&)3nG|r%`bS18{CsKpc&og2Anw2At_nzoSqb`R2F|;=4cXx=ys*bv;I)$k%(G zAu$j~Q(0g5@>K7HT_Edv&DlZe`PXX;1$p!#X}UJFgB0L%(KK(mmefImKh=HL+ zEuNv3GrOGui19e&Q_T!bm5Y5DS|dy23=AhoY^D|=lP`rOaZPl}n5li`T7#%o6hg^2 zXwj~<2yUG^`v&b-$0lwURlVy_iwdwJk&~qjMjaRz>}$z_@I^QCBCy1htwnl83z5DD z9!Aus+SMe~R_F01R$#=r! zU%nYz@%oduhsW(OWmWQxz_S1QiS! zQmv=l*;<6R1hp`&cf!N;_;j1^4W=Ete51{7D`jP;8&x{MaI?;^!{ux(6UaUBCP?{A zy8k99d6`s(mq2wVW!wbmPqz>o(|0L1h3N4`qMKpQjDSN$XYf(5xcbKTmsHG~`Kh^?K2K4QFd%LU21$!Ex|* z%!quY734<*7vBM?nqs)_&<3$}ziblr8Uz^Gx!N~f(78r?RCEYq3IB0z@S_23yJ zf06cu%||U6OMDD0-}rrrcCwT7tZ{Iu_Ki*2NEMH0(eiU>YIkG?&uBp}!in!OFlKcI zm^{%iy=Ce6bt}#_OHTz4o$#oZB0rCeOtL)n;@VC6DtT0kNqzxQtq2p*EP=QV#;Q$- zZ%t@rXPoXOFa9stUTT{SMX}(rkoD#NCH|HF5)VpSBD%2=iIPw#ligr6c!(?(xXffQ|_$R)76*}#{+hPxibpdZX!W_!7eq@ezwAM z)2M4oiSPRvn$hhPwZ4Muxfg=f^%a=g6XHKe8U8xT`xs;uXO^2xqdg8p{ zGA*9+p4QFF|+Iuk5#wm?kZUc2B{oyvpU&a0s>=>>b2ysvv-$U#}8{q}_d)5hd{yc0jfY0F< zw3lJ30Ql|@ll_-qAIYSZFG04MYmmt&VauuQi8ZzAm$WHD^Pi5E#8Ba?u(+a}+XIcv zm!ZfYQ^;m*DWF`qSzBil6QHhC7lYXWkAGLnKZ6yEta7MS=6Bj;8zx@mT08)Fu$sCgXzz0Q5F61M`_A zN)xdJ?0H8UEcPR?OtA1+*cbS~4VW+A5w@h#69}>e+^j#X z+yb-%M7DqwOX%np?JLps2=dN`Mw|K;97vCB736+?t1w4-KM?auNLv_@Sg!Y{j1Mr+ zhLQgRt;uW*4w(253_yU3DvAS;@?0tl4@~)IG4r1AiB<_h4%r5U4D>t<_v@x_!w|r!+6*ee%OTvYsqVvI zHzMk`!KP9~<35E|E7REVDU4cDB~9D`SR&UBXx^M0*dkP1LEz}Y4d&!X?B%Q+3M)b7 z4k$^pC@q2a=3|Fv@pgws_RpEW&^4a}ZHj2~=f26&6p|i>E?xV%HbJz-MHQbz4}umJ zkD0RbVOXEDzQB+o%NM?B)3sFbHVm4zUqIn3qG3DHIskd6HdVAvW8mPiRQycZwNslU zqIlaX>*g&{$-5vPizt5=28%IlCe`c&0=%*dN^ub#+y!MhlU!fI_*5ly-{Lpmi@WSg zZ41z2)K|)#CfDO7%Uv;Uf%abjo5<_vGk}u9v1H1=j3F%0EzQkb0C#Ao6T@;9|QQv4&P+#sh z=*XwE`5R~t44%GJ7=ZnEk-N26pm^GDL0tFm*5(LI&!Vb-J1{Q$JWlZ~QN;tXZo{(& z!-pM=^S_0`S6EYp`I`@)O4-;p!0yXsDsGjCaeY29?({F5GOJkl?SzbozS?obs&`+4CyB@L+qKW_*skT>%S7n zgTREsAodTpv_cpMTTa==6$fUO?;XjisRbGPVI~FwPQs+=mBQt zrSb?qNf_q48x?ymUV*esnilN+!_2XuiyHuB4p)4q3R7-_7T0qpNQa$Ec|HU>X|)2{ z8{f=1u=V+y?rx*HK`WJ{U6gxDyI1xfU278QgR`~s2OHUV=g;8Nnn&m4+-ZJB;%Q!h zz$NSuL0?kcX>g!|$01QmPiyA!$g(eeo3vkXS`{1J&Y#Bk*WkWpu==lQ#u-?=zhTOV zmUdIxpW64}R#9iQlX!)kLk1WNI_uHWBgUw6u(ad4?XBm99@z1b=(OW66x5%N{sn#) zZ1nwGds3)qj37KfC;rhcrN~At3%h$3H-d-krL~P{!9JSt4-A$*RPv>~8k;oIn$XPe za7M586^iY!(nrk0Je=!g`|3q{xYU1jp*}_mervxzz$Sf9A)WL|$po^_Lty#oDryec;=_`Uqh=a{Oxm@~fLPYbHEHkyV4jyd$liSh~yxFD4$Y*_pa9dgm zIqcG-|4a4xFF*-R3e$t-bH3~rFE!hc5vC6Xcq%wqDJMJcOV)b1y(&yk=)l6;Qu<#V zmY(eXU$Xt(VYV{2Zd!8%!Hl7#Icv#di8a}vHS*=xeatLPugHUwLv-vagXik{%ehAtsd)d1l4 zNL7#R$+_~;0G0#Xs7}7DtxH|0>T~|ffC+rD`*OC%mo!ZuFYtx;rgnfYEx`g`9KJ&S zKk=orFZ=(3F9E(}|Bv_**kS4aE4~DEn609l{d;CrKA! zSGGRD5sdh`R1qP?6-VlU*e``p9FAM#u#5XJyNd7s{Kx#lMVpcO(D_c}Vd-y~6J7Y` zQ4YhqRp$}LY{HJml00stX@v!dV@_k072Y-;Yi4{*SrnSQk+P$7HCb+(q)ib@+jx?S zx>_s~69t@wjNKksqH2hO(9%fnuHTEY3%f(E_}I}$(O3=Yt`8ih`^sX|I&fTYx^5kW zMRX7rNomn~zn~~YnJ9XHG(;ZD2(gCSoi<17F#`XYR+-f@U>K0m$N~$;0_?EA5Up2R zs^}q)es>2hbe4MoP8#*<^Pukc?xBwnn&-7tbpaLxR-${@<4`f0v;Cmv9ve`id`o`&yG%1*=0z6Dg6ixHcP>l3-|-c+{N>CWhbpH`V&al@j2 zVSnKEMgQ+&d~?>metEveO^yC(-p18My1UmR1as0PzoetvB#l2wua31TX_dJ6(Z7gS z+I;inkpA)6ZN8@(Wq0aJr7nGZV?I`)+yBz~6i0N!I#(VRQ*x$u!#Llq$4jGdg^AM* z7Ui|~!RfNwbd9RVbel~nTb(#5Zh`(#-=IxsF)JNCD7k+Zx8ZzNFAb&%-(ohlYHC0v z)z0mK>FjaX@|+vs-j+T9857I(k#^}OBlk`HWVp27$ljqp+1dLUuAlU8_JjE535x~o zL~>Q@gMubwgcwqha9?q|C!X~U534Iy%AE-FFX<&;8h?~}1Y^g=_@mU_R8g(F9T|w~ zLWOZ)SGCnpN}lx%qdz*0C8FI7W;)mJ{*?fHa(CKQbxwRYL7oCfY^G_T%tM^Bz zOoaJ2`?5CQWyj1s{^<1JZ>{spz&CfRpC357lJvFi4*LxEiTW2`delUxKXBKmfB3#O z-xY1XA8GTw$XNU}&yyi~JWzs+}IiT70)M9V8N13tbRoG6DHck5F_5`lPv zJwr+!nE)wO1eNxEMt_sp25m--Ujd@K-KHfq8p%&CyT9WM6>!J!c>8KTG@; zM%v1~x(8Y7kX1^esD1h%M>5j6$V$hth5HZ-hlYK69IoGNk?vNb7E{oE2)2!sykB>R z_&0YkWgtihxqIlA{ow2aY2|**y|6L*pdLZNc4u($cltnFNx$_weIbtS)%mJ={H7j* zQIr34X-J#z%Um$K*t#35zK0qCdsxW<{ZY*6dLD#S9g4IUQASiBc)8S~uUQB6L?Cn; z-aW?l3`0H^1aoZk!Az|eRe#9hCEI2Xxd@@x;z0uJ zF_zwhe_z(u7@?$}bi1R56*cni55uvQa+p1c5sF7^80G(@NAzU|G1nKwwlbCm%($8Q zSk3g0TPU2cVArdu!=Y34KLKyLkn}UO5atFL{pQsDfIk8F=90Js-Xr}Kisp)W?HLD4 zOv8+ZgO?-Ns$?$B|5+bEZ~hEcci?a^)^^^&S;Wiw!04X$M2xxdNcf1wQTAWm-N0Ju zknYBX=oMeU?peJC3pC|>VgJZ{zH?+0LuCP$2Kdc-#N_}_3vTBh0v5)94U1^fr}(e@ z5CA`ko%K-8A$_+1TPLar4#1MmL>Qo|59{+>H$pM5DS)7k#n_)>;Ku{DSFu z4eV-qf^KEvc8E;qFppL+75d>6J1&T`_#D)kH2ag;D1tu@!lK7%5H#0&5mmXcevx!W zFOY^ARcBzZag0Fog6aRT_T_O^Ro&m6>qRdLcCUcInYc^>iV9+msNg&cX`1B#si~<2 zWu=7*HfV_op)4ykC@U*1DDzmUL64P|6*Svp1wEBkTF~&MWnJMQDE`lIrytLNONQDZ%SIsT&ixZP2GJ{jhEMafWRxE- zpjS`dMwQ*1L8UKugm%{pF=0kdpbY;4;zSW8M&e<7ABh?is=V74 zTH@~HEX{GoQ2uDS3k`P4FG|%$qf>_E*lOzDNxsKt3(t8+!7H@fQ27A{)+%L*;?g&_(WQT!@r!wMkA%J6}!ZeQ-#*wX0l#->z;>n4d|Mhts}pa+)ajN~%nh zqdBk;MeR#jOqfChI?Z}}vh zx-TS{oEP{4z}=wXX(w&=%^9$HH;f9_M|Y!|vGPco6)3kgoPFfOZQwfNSbuqrw1mp@ zV}p#00rFvP==%1!-j#F=99UYa+~8jfPvwk)J45HX$4? zJS1Zg-ntY!h#5y245Q?JNGR=N7rvw9BpVucdW<{_Vaa1Rp#Mwl zK3K(+Zw2Lk-Zr!(>293FPm*hF$eDh%{29O=K3O*KY1CdLLsuL~IZeI=uWi#fmTtdR zeq9WmgOaCth7PzqUEYDX$gUV{G$)vH4ur?k78h>PHAHrDQ^rhSR(w3vNb5MFY;vcz z^n6x$$Gz9fF!xwZ)%nPnH&Z?-O2+A-i4-wZF-u-10wMoOlyOaZww%T&QZPq;nqNuC zm^xQp>-8J8Yiz6QF(>|;2Pozo3U?Su^8o(9@tB89`*~;&!w`=g7dXKy=p#?iM6aN) zsInXuh8dEj^X2g_c9Ow#ipi>ngwLEW<3Quxj&^@$eLYK2@qDHubYwnA&35C5`7#!O zxwK-T+%wkRY%ev~WV>1GzZ)Ku51oVBg>ulUubb_hjyC&#)nvIfudHj$Fx@Nc+GhNB zGQPPFR&}xXW~f--vZoB1bCVo0;&U+P-ieRm+dFYJzIlzaGVjH=H>3P0=NEg$@OJpg zY zH~V(un;Y2ME6*P%FZS>OKn^&2Z-6X0;oGHDM=nh$tkb3%^Xic8sw@iM)7GkMddhYV2S|V zPn|A6`%1{Q8e{66s_c&_XG#7V2q9L>C#5PQ_Z}wLRmOYw%5X@>XQN$dcVXMmz4yyS ztcg>+MviVWUTHb`v3j)`z3XVyu90E9y@X~yAgAC}`~VtOLhn5wuL3A1JSd;=XTUQe zMNz?iFp3%Lk7=&aB4*H`~B(D5c~XA;qAN zqDV%oQI!1#_FWkd$!Ad8m=Z8O7|u;dl1JS)$sgc#eiJ~EN0FPcfQwfUZP_fZrEfLa zZKRdTM=|6^;1(H15K#KV$ckiFJtEJiIyV-hnwy~CyYCTsD=X41+>Z4!fF9l^v*PZt zZRkN$;O_0nijHrWNxFgNJqFB}LuVfY!;?n^Wx%Ww+Eykn@?&T?OR{gp)}dUsn`50E z1Z}R0gWy8b%H@xxxkkw2@(`ORElIOtBg}NJ4sEcZ*&%O5X@j1`Y?+7qhe`yb;Mgw; zWyXM~pkyxU0C<3J;$bxRDEw6a*3M&(?FtHfS{_n53#e20lsww3ilb3<<5Ti$cnCj-`T*K`!RSd5n3Ui`wXcXEFU*S{v#e%ySoi zygjvaY)k0uvy82V_8f4A!L&<$9WOC8a(2t{{`1ifE);s@yX6%BDj*8WuVMP87o;G+ z@0L$_lK1srV5Kx7U*M61h5iblQZH)Uix&jE<6wR}ze3JHJw|OMXs0PpNe*T^%rD7R z3En-iFx@-s5-gKLqOse2h9^`^X z>JK=HEqgoAj%FNtRX&0E>eu9-ScP-<>vDt-RpO=C1J3%_pn|^rB~cdplW0(POl9Fn_ZvTJVwpKyogP0V?ymc0p%xrEZ+!n{5}GvAUY!|-0^TXM7* zv|x`$U&d9~UyR=b;cxyAc01DfzYS`88_j!L?kUoBqWYP!5aYcq$HV^8vA02?meQcZ zg1D?WEJ((~{MCypHK^1zOvm9s!(lntj}H}aCH5?&9qJKzyx;BIW{O-5n;rQ_Mq(fjrP}CT3(C&n>^LAD{_l zK;zdi*H={|C)%WC#_12`fwqpzQHX^+JKNIsA*xInpU8PlTm?79RBO8nY59{;XFcB0 zn=4tT@>97c@NVxYgIe1}jpqy8Ito!@;T#MLH%Lmv2#?9o;5Eza+LktlN} zuxBSFe=CRD)-`R;mN3*(HWlXAZ{sA1txvLePJ5ZCp(29>1cLbK{8S#1T+0ym(@COk6@zp(L} z9HTAn31^4d`+Mu4@FHe)&pVvi;f*MXITNe2wUl{E?kkw-ZU|=T$x$q3b5MCiR8V*3 zvs*+ViN$jl`LxaT7A8Q$DLFWk^L0f!YsuvzS!m1ocmTMX|CNSYTkKPI@ro627_B!XywjEzipK*kwq|;hdIRyb0gDf#B`b zB^XPyaY4T5XRyFKsQPDYM>ZoFCojdDlO>Sr7dax5;Sq*UpJBka1#6J+8|gxZIIKnGBa(t`F`BY!;4B=svQBIdvT-e6tH4AU9Ndg(6&Z7 zLcr>OCEHuX2RY(_&kfP4&_AU*%{qJ$!|3AI^b4H$4W4(_B+mX z%k~80AmTSUt;K!Noyg@&#$CV5w~4JdF1GH6m*cI!%WDIlK{9KB0M-3No)h@2S56Sp zKjd+)=MZEO7^bxf!Ey|)DNTam?ElJnwq))m7sGJ0h%y76yUkN#7YeY#Jq3KZ8d@oJ zXXI4Tq@fgfR_-RSv$bM|qX-K;Gb#71tn}x#pZ}~F&g!NGEB8zn2@pm))zim}2E5AOk9_l|?{BR2lgfz=`AfxSD~Mmap9 z$~y&euvQXdGv}^u7Ux~^8{To0-6tBR0sNG-aGq2wG~!PG%O_2_hPztJ{FE75^Ansy zKIt0$lzRf-^a(0xtHcGqt0czTG^`;ca34GTpY#r5iP=d6h-a#m>3m)z`m;4^N0+eyF?<0vt zrx+R5dL_e8fiF9#AONL#^CS$q54=iWkKVD;lh)Gt042`vL#~Xn z|BVB)bQo~T2vnTOOtr$yWFH~kB1cwZcsI+a!U74tKb`}R^-52vtx+AQ;3nV42KdC+ zC2U9|k&$FVsj1R+6NUPf#B77c5)1h|*e0ZW9nhYeSU8@K0N*k748wU2nKKp0o^}&&_r^@cU9b z%b$wG5p)1f#A`y80G|xU{vm@qObK&+fkgP{Rbu3x1klW4;k*o_-Qe9snf$vf%41TADD{Ea}HLrj~Zf zZIMLOtrmcS)hSA0vrtwOM;omvVUP`E zYsyQ~NfBJqfV;Fwy0Xk+`vFRcU6k#90bsD(Q{)p@DkVi&y&Cdi&PpALEB;k;qk`e! z0R~>HTsWgXl>_Tl6>-WGp<#Iq6}OGRId;5K2Zc>3LHQ3}u!xMH?y9}CD=0S$i``JY zV)5(j_73Ss!qG2`w*|Okpag`%b|phQspiKnaDmZP87)C>daRpLf^wE5isCZ6D{O)B z_U_8lcol37nM^r7kZ=yY(nA^5if*W@r}7+R(g%7f9=FTERNoa6kcOVhaRk4Yq?mqu za20Ky0!P?8-~p4**6ydsWaS0Eh$8M%H6$x4e{}4nM2XH`LDk`qBaZK-6x!z4=qpD% zo!oW^-m}(qw3nu!No@Eql&acywsXcCQ+QW7bvEsPB9%41JGiaRZfmxs!VbDmQ>aM%vu)UAe_>q^2r|Ja@4BQ*A&j z1W?D}tHeE6akk>DCVjA?h>K5|sGQX$cpfrE=7vn7fnZ&l-GgPE079jufm92a45oq_n3E|=SBe5pV{%!&96<$pJF$zF z^r6c2T+a5P%2?@V4~|x)Lh6m1>)7AdLQBa#Oj&08#YK+{Q-*TVuZAg6{GL^CW#tiLp-$U9uA5!JJK6Hxu65sE|H2jjj);jwn7@F}xg;bvryP&VS#I6|3?SLR6N zCloknl=7!P-_2wah6CL80XTX~!(>dmITBh>qm`XH-=pT`i21guc$nPJ!Q<&CMU7Er z3CM*ZERq^;2bLAJhuAUeX1*mjM%lp~nK)LtA87H(Sf!^(%%c%aQZkfe+~btq9!Q2! z!2~EbEFKTMz+BCppo|i8++LCn!FA096HQ^bvl9-t8zv}x5f4V)6skHE4SC_WAbaB{ zDsHG6fkI)R>NGTiFNoKq!;F{nGc1hx=OHYwn24+p{r1J(`G$$g4pde<9p;pr66i(6 zB;{T%w?Bm785zpb%iOZ79)kGaGelb9L}*i{!ngj7pEH#%k{`p=kJ6{{9Gn5cUeaVm zSfs=JAIt#RKKatjHDLYe_++IJZMe$MUV5!E7qYX)^>DnJf31?!Y*8tHHc~8AzDp`w*1hUi z%m$yO7?m)i!c&l$8)lHWV&-hE{Uii0KjVZhZ@S_T61&YlB>9n}3gB^0~#C3w01Kp}h-w7@LL z6CD0u1T&xWXNx+vU8lsYV#boG+AuSh)wB`#W@eas$1Lj^WN!@$oR{Oz{zLpe_G>=;yS+D+innC@6fo0onO#V`qJ#wpHFJc4A#2hk`GSHnrIVfTz_;|!&* zzy>7rN*N*{C6~)w_9YC+X1g&B|A8Q#4J?KDWO3PA6rS7-JVo8z5nxzng3aTje9YY@ z9&`r|Kfw#M8VssG7B?!nt`?ZtrnQQ&lm1Z#CF%k5OCBDsza8mX8xgV<9uft^MeTvGpEnkpd>dQ9vJ@P_L-!mcb2jM zm2S&Y`nvp)m51D#fG~A=Rt@sM^vM;3v^OhgHc0t6?X0;kBA^A}Iv~C8@Viz7l^Br`mb!@2FJyIF2+^=XDK8U=k>M=ax(jYlJheW0krB z+D^)AqTgL9G6j5>o2|KJJOocRSvM<5F7{W$)PwPdXARVwZ&v2`v(7D})i8?u3U(k8 zZ^7_Y)0kV7izot}#0e}c+es=VKM&zc&0H94$(RK-;EELqb}GwJoD9B|Z8dARkU1j` zGva&frq1Oky99^A3mC8H)*x(SKhT(Bxk?yk{xMgH0$c-cRSdk|yjAHY&7{U#l_4D2 z>o(4xheCreuZ!!TJ(m9?UzrONY?My@;1(tWop*GfA7 z?u-1wv|r90N)dibcPhejOpiO2zwil5g>d1t3>y=Zj^r#;GVr^48F%c7tiUNk<$voXU(nvbD=mUaTb30S2Biw1>I@i`Qe=7ibHj8!NL zet&pO3ReNj=3rDIF@9HG9}I%93L7Mzn!y-d#!t^EV`Nrwt@)5;2$M;OvDlRd=|Db4 zHkw=oSZZQCuUP6{fO#m)6GoVZ2#wqV;FYTjz`#=}&V0uk{qIqpX5IPv`<2i96A;W> zum`AmjWWd5)dbq5mD{yexgO$#C2N&GUEL6C4YY^yx!kT$xKxVt7He^BiAd>7BP$=}z3_0-?nsJ%%@~HpBv2~%670x|M#5`s#YsEPdLL9At{yE)cD)m&@p|GoME~d4>O@Wqq&`2X&J;|T>Cq0VI?&l3!hFpH zB(`+wL>(pBiJ|OnBxE9Dd}>GPD0phdb-m+HML}Nua$Cn$lUhk+?H9TDjON9QLMjh* z4idFzHjn0u>JUcU1&Vzr8rDRsK7kMBqUS-AYZe1)Sz9{WyK^&_q8w&gd7|)YZ=vrU z_-!rZ-SIogv*g$Oaizm`H7fHNFsjUi>yd_+AVEkYCEhg|34BMcmOx^sv>tp->%mi7 z1Pc=5+@kdMpN2SY=@D|h+ZIg228c&4efv-MiT1zF_w#!1PdD!Yyt2-0`fS_{K}$w; zTYKOvgk2&_xgSCxla`M)YS-i74~iaEQu~+weevQFTtKPDqh7dpaW0->Jp1v0{b|w| zPsgT_i9|O%SSqhbq~vvBL4n>ur%DQzD|BiVZtXe7Kv0|%1>;<^Df1DfL?}ykpvGt0 zh3{ctU|te7oYXWp|>3Pbj+KcuX1J9*VM& zrxn;4eMadQX>IZt7Q9kM;BE0!eByHj726;(%37eo)59~$0-OIFfQ6T|O_aGyS>r#~ zgd7aK>{8x^YHaaOU~DRwQTu#1Sfv{cvNMy|9r7uI!Gl!%%xX1+DO-XwLSbXivN<*_U^7bmDMay{k8wQ8q z?ShQDy&yFxFmj&)yG!tO_7YfyjC0V*uX;t<=x9eoe*;jb!EH&2K0t;9GCSzm!Kkf!GloQcj^P z?M=kMcA($e3NDe|#2nxWX%WK<+QpywIcdfbrAAuJ;SnVbV?c2p^0Sg6ZqxDd%j-QO6!Rl6Yk2@n`Tn25;Lb6Y{DR#LlE2pg z?g~~izl~JL-Uw+ZeqS9GRGNEq?s?m>3l^aM4mgT zwozFGw>E=*#j6*ce zv(4#Lvf<;-7XAERj#ay{;&-N`&Nq`czJ-}tBdMF9z{)$S z(gSVaqva#W{|asDGRfcYYop@IVJfZ%XmEjNR~=@?f+W|#l8O`u<=NFD;q|jKnrJOn zsigU-q5b(NgRS5+1v58on4ji!p?Ei?qb0~LoN@6A(-h3vsr*6s-%MKp zA$5g{-5>1C`l;8ix(-qNXYq-*ThIXk;t9>bn~G-wp6Pf7;hB%eVx!tJQN?pk#~9rp(5sd7zSJ?BY9gI z(@u?s_Q{fVDqoge-%cF{q^w1t3GU(tu)PUzsLKMEqbzQSXS-hPP{)B_e(6wC@N)U9 z&q;R~2mIAvY|`Cg{7bX03@b@252n<_r~tzrsP@BU45sqYly#+=fvtY!mFnHlrWHXM zPBlha#X%7?<2D>eY;~$`AF}bTl+WdQ_MLQc8Y~Icxzukd?XVJ7(y+>oOD)K;nxr80 zb>684sRr^d4^|(Q?%_Ic<`SajOZQS`2x9KzR|Ku?tZsoX_Q+7=S%aIU>L_U~C4{LZ z;tF0odfNsMGcymcI0N#7t7GlbPUAF^Fj+2;)hAGyC_YV5^J%V44Wp#2uAo*cV{l>A z9~Ws=b!Y$9mMR{M;dq#NF9dMY@a8}MUXO1=vsOo;di6#l!qD55U7#97%EN5a3*ToSGtb))T4r z1{|gq#;Iy6?1hj=)WoTExZr@AZsS!owky+?dDOp~`k3?xReuFkC|ZmSWz9qwMsX&p z!-dV{D_}+x$772V;jle8ga`H+6<5EQ*hdQ1X zbXL_;U50^{9x5*8!Zv?Tm5+T~N$B#&J%O+&qemw*XpL1=MUtB8;^T5Y-n4cr57PN0 zbrOZK|y1KQ9_eM|5R*nYl>B`7Ba zJ#vStDixKZn1B@3P5V;Rcz~upMg4#|naVzDhc;dlu)lf&p|1=;3t}aZ4`!zM;omHw z=!u6Z>vlXx@O(@4r=o-WA8Q)5nSG$@Rh7zaQHH2tLbagox6Ux%nW|<3f`Gv)Ecvqj0Vg6PQfVva%gDrLe=i6`;e%j?%C5#;>ZG&K6*)dc?dM-^)n;gE zDl=r1JXHNt^jxCMr(tX%?GZ5i`F8M@8IQBnZe*0b^zF8|%{xqu4`;55DWipU*5(4x z7^Z$L`9E$IFOa-+IP3sa^##^cjZi-~xtHw5&>*8?B&Z6A-I&qppO-m~jFdyiQP~(Z zOnTySvK%2SOR59U=$zdKw~Rk+XAcxtvd}^%4Y0F34z5It4uBFS#lo5eQ0XkR&l+w8 zINYBrVMgItHJ}YxDC+T%(#5Enpf)(j9^NUKjz5mOKS!skX9SY*LdlB)7Ygh;iu08U zKX~D+`^4oeJ;!&G`uI5v=e25BTd^o$B~)PfH-kBJ;mCCEEcMV#1|I)$DHb5D-@In= z@7Aaw)1e(EV430I6)X}Dhd*hC!)1;NYr+-J0oYq-t4D25b@EuM$j?&O`hEZ5#fw)^ zZW>Hmy0cZsm{rBzu8^!gU!Ad;+wl|)x;1RNC$3IU+_DQYEDq@d^OIs=!=UNoyRYA?le7v;J|1E z?fL5B#ra=fym&i(IbT&qJkso%`7NeFDQ_^XMsn}(GJIRZ(2es`fY&J^h$pftyrK&*gpBXWblH{_A8LOq+)q+N!j}jI@1#ypTt#A13R@qRs9Qbab3(3 z5F~q0$dvDV0hNaDKuX_-^QDZ1YVh>6-}=Vi+3b4`z8P>_n?R@+kbq^ z$)^Jg)nN(WAPG`7jc!J>WGlb%%#mj(;U@Gi;2RoyllnOJ$)|4uL;b9gyhxqIYNL_s zwDFeoCV)P9x$cGs39LO%f49Tf zm9Gw$qza?4Kz&JgblisH%&L3TRAe}R5BOtnJ@Oi64!sLXRVV2G?W#ru%^a$_AZj2crjvj%B>6Z8=S6h~7!=4rjtG*wr!?pLT!2|QA&NbLw;BLB(E$ZksYGMeVoN!T0Z!Z;D-wtYSTi2*6(!R1rRYbD> zW-`VUkyLp3Ed37dE5XOX@H|z-g1H^N7Epk<)V1nQ$i4glbuwP>J@Ajc6DzP!?`X_} zz!?>{GO)!5=2l)~SN!42A~d$v-*=2rKqXJR&J_J?rPKQxBm|tHZEeT?oPs zCa_Rtlkae93P)arq71kJw5gD07p)QhE$adi%$DrZWmBG4lB6xI0PlTHmK}g zI(wrUir4au>Ib4NFmHGW$94@TaDus@NQ^{dF?i*gKXAxXR-~SkdFWWS$3w^MT3}X; zk$=2coro%tVVYHQ))R!7 z0Y)9(r1r+|^P8BjrsT~6V`pv_U&Wi%`3O9_S=}g<4Ff3o1hl)#O4Ygk7Q&7sDU!9Y z{*6hSL||wuJzI^OOdNtgNKX>>Q5aynnsA(_fF*_&t#}SSsdixAG;C2>e@=T?9cX*e zWPfrVR^ywpvH)U{35*Ag-4CntZPH5=vQ-@-cu?=L^x(0;g8Z#uzh@ZrTh*^^D8BkJ z^(8UGVQ%seHdRHv;=uovshj-wfOPWYoD5elIG(IKkF%RyG@%?onN7>f0od6D9|v&o z^D2xWxVJ+acGnE-eCo>4ao5Yp-2u6|e=I3dV{~oQ zn8{j+$DsoDd0ScCyF-n!Nqfk(22^g>{x;6iN^Dv(PMW8!_fqbStP+$Q?kFi64lFqc zLYeoJ8erRNf~o8&_2Ur3Z2!ZIJoxj#pz)_r#n|yQh#eRbhzf-kqWvL)46X>y@-S_l zQJ)ha4nZCZ=RA2`&k9LH?Xzmr#x3VLbt`Ch;4W;Gk@?}>n0hxDwY$~d7`WmfyAD2S z@H=-uu)69G2euHu*zCsmN)=Y4Kv1BnOi3@RdD1IhiUzNGe%HOMZW0t90`;*tNzd{_ zPmA^fNoN>u?p0IR+k}NHF_iSGnudVfS3ySL*ydGrh?rqEs_e^F7vrGvpYfWy)C|mp z=TXY}7J#jLO<+CT!J{SnQHE%2H0{G~r39wg;noZLj$jVapg+dhI@9IZo)#~EN0~m%hfbxtr1Q_rH{B9!d)cp;0Tx*xix4Z%2 z2NYu8P@|i%v625$LnE0kFpcJEz~j^6+nD|@6;>4wnt1SjB0YaPx-%sn14;Cd&C(k~ z0!qpzVVS)dCr??&)Br??MI-+hNGZH$9K+HKLv~w19Kya(XLM#LSPKN|7ZrmLJ@|z> zKtSj^kE4_0U#LPQO?sUP$07*mpw>B1pr&T&3NdS5g+B3SocrxLEEMh|%Nn3-ApF0yqFGmsJQk%f z^FRsI^#+1@qFySh`T|52@KIBzrnnB7z_X-cZ_@2`nE7u}J-^=O7iM)GT7FmrX-CZB zc+Lw=3%vdCutet_((2V#@20vBd52^dJc z6Ja2|huqd8=ILCG6^1fNJl~3p_P~%^AOtNp(9M=bk_XSq{H)@cp2Eo>_ zdy0hf*9als`akQN)|yo}0US-`Mb!fFhyM`&QS0&7H5Kr2>j|3TKlz9FPn*ZX2B#V% z?%{Q$NY?%>`&NxTQavfLBknP8{kggVFb z>Pbn-pr8v*s)^wzkesLAN%Q>!-VBTc+I>iK9AhT@$$X!}8~>X10Ine}ImobJ z<(>^+C}vozCH&SRX?iu7qKXyppIY@Jq_IMm85djTc8VeQPuNgF zh4d%zj63MzpH#)4Th#+CfyK7#V}nych}!WNp4O1GLV zqYxcMnNO%VwmGHd*#6szK0Kw~Wc!nkP}QlfGtJXetprs%UUfvLd0O)DpG7);|An_T zTpp5H|GgZlan#?4vX&n18)p?gfxJ-(4l@flk2fN{2GW&>flO@Q6|3p{;5u`DR)fPY zn5kKYz-9A^AD5Lt+kS@JdLI^6M`gNmKMfWO7S{G#?<^-smx z&EovGxG%AlwMDO$@F$+B@Vo~%|25a-#p;FXmNo| z7&GammOec4m95# z@ov#JDt;AwPgWzO8}LWbh(jLGlt#=c?y}n~(Ss1IsjgjV7UnbyvmoR_tK?t78em+0 zRXv*8)>`DD5t_@)+{w)B+ojscz+rcKOh8H1RtVECggQ{v55KAr-MK9cLGB&*EXXV; zxYb5Ps(zuRPqxQy{|6P(|CR1B2 z>8jsRl4d5+FJIE8pkV6$v)Unq+iA6102$wIs+4@Sc|mPeM44 z01G|1S=IezmTXl~)zEQxNV8w#bFJomcax8l2wyGI_4L zOn4uJ```vOPVE$w-uE)e`&}lye~V(WC&1lB*^3=>Pre-X)P+PAKx|Z|Cl+wMP|19LhirSex@av znSV2pHMac?K?b(B;uw4Bd9^~bglw?@p0!;YisBgWuvg|C;V`PafNgNj7Q4eXJczz} z*H5N~aER~ASbeXd8tx}YaFTA)Ncxg9jH0s_u!n_6B@X&$c^7fW&fDim_%ep$th$Rr zGMRo8gihx!Vs4J!9I1^H($Nr9%H)Kx8nn4cb4z13S86yo-~667O&IQB(D8^e zp|_~>ShU#}!;4QtA1dwkNCz#Jw9%pk*RW48tYDIsf&G4@P3sF{Ki#Hzwx*XxB>Q*l zb+*{FfF{#k=DI6zjFF#lZXBxQJU-+L-)=m(Sn&w@*I?7qps1GIMuV+K-fH?&`RkhE z&mCltz&C^g!tH#!HiM-FU)ePsr^)B-T12E!YeX_J5Xi|3Eprjp>IQM50wH&XpT_6G zwZA|lnZv)w(+WTB7B1~)KTY_{_PU-ToSo*(U`gMNkl56;)iMNNVCnZwzR9~6s#$66 zG|%ORD+sq)qCF{>w$rYKdBFGDX)q5+=i6!5O9{qwhjyie&-AI-UFZ92%edCR{Iv&# zz?w%W5_&!m<(0M9wuDbG!Nuz@cZ47A9F)a6Xm{Es2GQUFp?X;Xxj*SfFoV z0h(KgqAfTu({1GTySFCkXqg4p$ID4mIi;r^mPO@*j*cc2!B zm-H#iakVaCr5&~5{)U+zS1v*^{8=3V%!9O~qZTb4G>SWF8`+v~q*J>^)YG1l&&VlM z^{U%VC!LxTT8n3$+7Ljazf1cF27d!PX>r{rq0dYgnDep(BiGVB2~eI=+>sUnnhW`zI?g$#2t)r0^Fa7P@1aZjbd&f23P%);_a<32HW zDG-znbOuOMjqf^ZDH0rcMk+WAND9;7mx|z*>P};Sm^RnuiRdYGcPuG2XGdj<7Njr@ z;=gHlB$SP(Ok`T<>K*l4hQoUu;DP~gMm9b>fO3HK9w^aXY%%l#= zbVh-j(zG!DsR-jNU%_>Z7UVyz>2ryu4YXa0iSb;!&Qzs=YE37XuB`*IZPNj0T)@+{ z>jRmRbTzBpM*Sl&tRjdSBVd{$Cqi=oEtf|Ckzsc~Li60Z1L<)=srXccmS`e$WEO;A zNp8)-(|CYeE5*Rqx-qYWosbgOTS}=0lZQo-m_zXO9;r>j96BHAJC!ISN=q^exEhBf zHYo2!X#tmSqZAM4>lqul;8muazbn;lY#T~jb?n%4qP2d0d_M^)T61w{zbaZAFWTFm za>0ves1zySf}Bi}m{(&ycLqwg zh8$!mJ}gei@m&;oI1~p&hue8BWX$wVhFR2`ii2RQqVN}Jj1IWbJLu5`l#bfOj$$s=wFs5udX%wp3xPN&Rgu_ERF?iQ1LaCc3(kbb1Q zHkOC$`|eG57}HO+iJ+vDxIdlL0|4{f3l#%+H_BwGLnkVK2pmC84=qM85R(wb^qT8L zRZReZpY)zuidYSJ7Qun_4%kY{>Z!#G`FC4#EkKjXdTMSo!FZ#m)?R{X@7k3*92zBQ z;t(uZ`wYiT2#P4pz=>i;VVr2b-b=e0R|#@^X+6cbz+ecY!2VuZp_EP4g(xBEUk-=} zQnb9w5KY6`TTA6Dw8q4%w5~QxrsaLLIW896b>qh3VZhIz(|xr?=E-0BV(2gLf?`=- zKS38C=%+pEe}g$+{f+MZF&SE`j#sepVO_9s8lX8$Mj(AsYy|BZpd~?h?aKj}obwDg z1c~-o+z9oYj;5t*S)zXd6xq`T1)E2~7#~j64oP!q{UGg6jTbovEsu&d0=&R-%MJKE z0^f9y4h(KKN1a2oc*!6vYEY^e0w^35zl|M3G$?Vy`AZu36&RfV0@@y7>Do!?!Ae6h z-7&k^L%BF56X(%pO?(Ur$EvWhIvm^M+cb3RGny}2`vT@7hCuMoJ1Fj9*a{vmIq znXs*4E=1KI4NLfT0TfzUwA3_<_X%12*y!4D@%w2{DuRaos^XVA!@@!K;LZfg6(lm+B%%g+IE2A ziKug6wyKL8jbY@cKbtLBkLON zUa#NKTAT_-)2woF5j^p%ovJ1J=U`GYbsa{HSHihk%~Z@HCTe$5c?NK_fxkr>YCM9K z-#HD$!#vQ-m?nn3`bS-%rPH*X3?cnmO&0mvl4YG~k9i`O{V*$=90$H6Rly)c{B#T~ zN}7%t1XYpgS~TbXYPv}*?Nq(f6)J9bVN|cv{%tiq_s&XJB=Oo%}VDAkec1T*#2RaUgQVd`-N85+nCrxBIjSm5wa{;S7 zT0R#@0E_2ywPEIE7}sG?`G9%aQqkqEFpZAOYg^}Oj%Hjz-Q;aP|2GG%x1|XY}&&TM)jQ-AOY>%FW&?;@d zcBnN9&0KW;0ibf?0xiRJ8(_<`g13FleNUqG3%~(GqBsQlGgbN6JJl@!k!nZP{SnY_ zp;iPI%iJBEUFg{d+@$@9t0T#aFhy^tF^jZO(j8R12;}QdI=u*`EhB9)i0X1$vKU`? z(YD24&F)6cE|_TG(U{)GUXu1Q0DDho*g#pV*#X_aCCIXZW-igX`K?4+Csd;1(4@tf zn5&EfOSBhk7{Mhu+HJT+QJ3#@5J<%5DC#dry;(5YO^j~k5eTeYVpser0) zLrcwVT+LFg0%KorJ5~U(#l$hi?P3ODi;1oC?b?=*)u@+ghsFIjouP)7PSAO~P<{tc z;2sZ7C6(jw`*^zm=oR0IT6y{mUZ!J(a20R@zRec9qhTWe;|Q3n zGA9pQqCNqZBOiQN04>P}STEsV6Z&mk+y!@NAHun5Qh^pjqf@jns`?229@zYnv_qa74yfiz={me$(#ZVi|Ws38u= z)w7dpw397}Big!FdjUys>5TBI|2GbJiW2Ow4E7*EB?Ky=rPl!)^B>g8fYJpwtK0d)I1Eka}dpV?go1XGJqc$gXUB&l4djf1xJ`E{CNe-IfZ*1Mg+MAK|Ph>&A}3$ zD2go72F891&0A)^-FU31(O>!|ZKQ%CEqYZsbc2~OvkD%JZ|@S_&Av2Wn7&#b*4cj|y2@aKL5kFNt_eLQpOYTyHH@cY;4q=UQ+n`rvYKi5A)Uwzbt3k3$xUuTh=i?j@ReDUKHe{PC2& z22Tne*6w9dO)%b<%E+xTuWoYln}VBV=W4C&zLJz`E4z=_rdf6_*2>OHL{l{kfE0hh zoFO=h%CCb=ET>k@qmy$qkK$V)#0BL1P)#-Q=tiumjX#5jIQ*enWZoES{2QER&PQq$ zz?l3o6uP0v`>{GuP%MYXov5i;$b{7XiJF?gl(QG=1v4`~(teuQM8buY$+J{_=C^FtD&W4X4ygJ^vZ%6$Y}b^Z$QOI5fA zSsLzVH)?iiJ3Vf|Jkdtc^IE(=Hm$E1T6CLI4JyTlhr})`S+ELM`gh`BAniFndr8&^ zJKRHMZwL3EHW_=Ed#l?yY0p_~c`8ox5#m+B$X1QD?c>*AGoz>)Tl}Ng>lmZ=YdeGk zsn;PjDLSCdAom)Whe#ZNamhJ|P5wON{6TG9+mf1-V2!@zYou?YfV6Rbj*^=1!RB3$ z`+HS4fGf>^uN_1xC&4^aJ*+uO-_mj@YXDnKiidRYTm-J1tbI${L#Zh!dH?N5+YkdK z-uze4pNx4B0p*;Jc9aIdfMxz_e_TG>=MJN+In0vwwL^)TjZE!-Tgw5D+5ND#k@DxD zz^wI9PN+GI{bw&Kp3B;n8^he>yb|h>Nk_D0fm;B4#zvmY_fz@X9Yaf3L$SQ(h?XTi zOv&$H3G77$?`Ze<^UUYbgwxh2R{VZLb+n=|X^ehX+iDy06mABM!=0rY@!W-{0M9-= ze648_o=QBY@O%az@3ChtUd+d{7f&you^q)T?5~R#Z^QE#b$=ggU_52MuZ7wif74Cx zYhC>xL8Do0Mj$Ju2(hm)Vpvjli=EEAuT2qiNdLYXXJpAWDcRGkP z8lyeWPDXoPLodm+5Du@SU9gL*fyfwieC3B)6m6-2&;t`Kr4wu{l-pD)tJRJp)$#8Ttk zFj8hg++pK1d|w8%}l|6&s}pK3Gwb|QIu3j7SLJ*I3~XK2oxfTM@Hhv4#| z=rhgv4^?slKm1Jl-rOig#$fAN^SPFX!i0ux&0Qf$xD^S!AODsXApF=o%B&G)#3G!M zetrxsWHN>mi>Y1VE6b3+(4MfF+n*Kx1s_@!4bJ)8am`Kni-DNd=UTz~t)^VNzmV8$ z|5B5=F|U59eI=qWvgbSDdgE7GZ+58qT^%-<)ik0WyWnbCQm;M6kni}7wo)4O6kzZ^ zo+RmtE7suov<>JPw(IBc^af-15uTs1awcL)oQvmOJip<&fX6|}H?|L=4Ebw;{pbZe)Fn{STeeA|0$#bHzxi-ixgHufs@h%^}IdWo|Vd{!V*a zk|rD3Cm{I(U&kVf(kme}+j0_<>ja%Wsg0w$UQu@1^M{VjWia;m6$6z^qmL^VXS7h` z-XFBNk^pXhsw@f%D*Xupj_tJkC+&LCvVl~5A2hf=pXeX3_moy=!!E1-XKj=~7zbNB z1HJnN(vARH{|ioz0!VAnrdfwAgF>Q>tqr`VUP{k2f=k>^e>7@Cu$gUR7oC$Ry%W&# z(__q&$C#Z3G|+s^Nw|Iju_VYK4E*n^#*SN^N5lFF(7pW34mQRS9M0DUCr^Qk|z zL{6>G(&0|{jJ7XC1EKJqt4y8XY;P=_sk_f=VVrotS#0nA0~ci2F}*{@XCafDM`QlN zQ3jCa{=c-V+ge3#ZqUUF+e6Y329cth4F)fL(SQojA*1ZS*^^ z9_HG0kFDZV)IGv$|MG-q-%z-rlfyV=*Bfk9bsNN9b?tPw^rRs<^dW7;;Du3fH#k-q z-(C-(t;d-v&&0WBeg}PuiFKKII1EjihCN(E2R)vfEeGhj&2JLOMq8?%4k30%M|}%@ zeuoye_e%X+o5&M-8}YRFa)22$72RSKXI6J-D{;&@aNINAaYnVS2f;!I!b5~*6*}eCYcK;2MCuno zQ0h~4=K6<#2?s0lgj-C~#4>ciI`wav$ zRdITZ|Ffu`lL-Uh(d3NRlY~6Sx+?^GlvhGR;JGh?f>*tQvxlOty2p;COzG{gB}f|$RL)qT+NDIw{LS8tW`u-+F>}bod6le9Y*-P^wOA9E%(j5@vh8?7zoQ@E0jJ4Y5p!$_K@XBXfJvoVb22|wYIZx_um_d6i!hnGdwSBNyFOLygvS5`yom9rSS+R~+C3#fj95_s=48hE z{$NwO>%ws1P~1In^w4MU?vwASE$gAHVo+d?<8LS|Wh?}vk#!KRrqdF^l$1RVXYlS- zU`on9-0 z>V6rbn7U+v(bT?|eiMi}ymZ5RMK4`U^S!ma5ng8_8EC{X=BheQj?gLoKfG}E*6pGZlOrsv znr!mksOhc4u)=dB_0fe?zDFP36W@c<=L2jD`sgv7Z$lsbE|EV4G|Syr_t191Yf$lE z9o{Sd4X94(tE=cfERCl?Faiw*P`u?3jaBv4Gh}8?m~n~4gXK&(6k$|H>0SHj!odHh z{q(W$w;9=ApBBr>LlMnAvM`O;W#3cyZTcU^{;`7X9wymagIziG1Ali%xiFDo0STxC}#A0DG#@+AO*$s|B@uuh#jO? zaNnZ_>$CWc*7l*JR|BduG+eq(x&~s@Qn_yNxK8wQB->&%yZn0 z1LDuxgyN=}G*a(t&8_hx^=rk^D4%awTda{@<0SadlFD_VC0VZp;0j0}HUJ}a50Sir zYU6=e0i*N)(XM+a`x6JQy^Yd6rw;*?xe~szE4~X1prxbqc(icaDBVLcWZHH;JZIHd zX~U@TKDZ*PNe0}VJKEVxs{XK-j@F%`;J#GOnu>+@!kJUjXtQ)UsLX&F(J7;K&jEcX zRgVY`Dop~dD;uqs!FpHn>sZBh^iOcof-$JwM#W?FZc-to4}g->l%Anslrs=Jt#e~M zB&+>ceXIbS2bWxbf;wmP0e5-y*;t2>KUTk1Nn}BKkf_IwIiTVN{pmEbgy^|yc&!Vxs!L7iu!|zIS`RPU5Ch07(tDdCK zhFCZzya%CIC+qij>;Ut6$ZhU&jEPh9tEFT{FN+@X z?umbMt5~ebbdl@1R2Sj}8Et(HO5TGr_rzPZ0Q>dlU~-`16KqA*J}}ME@CxL!8B;x@ zJZq{RC1@;47QI_ewGKXIpQ;~{E>QIwv3$OX)iHk>mY|nBd?H(8p)=ETr!95hgV;=EK$>^Q|(jX5TTEtek(muus#5OuM z8^k)C0<-j<(nT7SrT4X;!v2-&q)uUiix-nAjH*9Ee|Kf+yLfD_%QjgX3yByvaltPe zNWi1x8+;&Je_PyAw+2n51_W3D1x+$r=b)CBRE+8ybX>RpfR4@8`+ALCc8Si1DBb4) zptx^5Pfy_nJva}{uHoU>aRz5EIY*fFH-dYbgN?ao=J2_WYX>;C{2M{gMYm)sxTQ-s z%3284>yqp$89sJ&HhW^_>w$JQ-)}F}zrvl@Z8zydq!{}0CIImVaxKEwdCFX*dlV@8 zQsg+$gNlWaz?3c0*Z6MZ{C}V*M7} zWldh9^Yz7TOZ54H*5!$BG*gv zgGT1+H;TLZ*gQ6obMAUIRp+8#QS?VHSXTev=&O;PJ5$!J(GUgQs*4TOtXuUP19^Tk zHDC(zs!@BZK1>o}Tn~r6Mv+VPC;ayVwfS%&iPC3+ajILYZ}G``fRGiE<|$xQ%Wl{A z2OdNQCM6z`j;j=;KK~9q*re|1FJLcLaffaf_U3&1#Nv+J7?@sjet_Epb$93v>2>M%Ik@j#u^g++zv$RvT41}y%*xRs-sYSev{WSk9uYA zOKylL?QX~z%2w$~42-5Fgz{g7S>CL{eqi^0=Brp`#v8$}xQumvAVevD-(tFa9cd-~7s(WlVT33`~v zQP{oMd@vncP30?b7eD7Kh&qq{2IH*xAK5Wh_v*p1rKf$5eEjh3jUt@AJ=G4y)~)Vd zeHS>8_4nz9&xCo0GVj+v3w#$1Y&lIFE`I>I8CF_TrZo^ev<9qy&r=sKVh^YJ!yw8U zJ?k=LA$_f$;@=1pLyRmC?#NjFiq`7m8Qx#5)vxp0hd2n!S44z{Pe+n&JluE+5PS(W zYyW^dfVB_ksokd_9K4ReKfDCySgb|M<)rZe{ZX!I!-M+!xHLU;ogN*s4VHjfLa*Kq zgevM9j1A*D-EGp1$PcxiG=2+&(gB6~0`I_`g*# zI|8i<#VYG@I6D9_%LjH-R*{|~8V%;RE4p{GNMFj(m{qK=6!0(BH?;p6rh&Mz2*2YY zy;oou3=LU;cTqtK#OGym-KkX86}z^oEx3GC^C0$38Ta7VuIJpah*qKx_b_GH$d>3w z>G(7q2BKmK%3xE z{apc>9#k9v$hfzfYlSc_G6X7HY}sO~9%hbtP%^xNT?9v6x7FmN zw&@;EX=3Q9d>2!wZF-ESx;Sz^?zRi6wiq(*-xB_GiVCc4D@^6RC z>_IBuu0P7E7PGKD&Uj4E;Zb|zF}(-Be|=2v3Z_ge(v z|IVfCE8Q?5szY>_^SI6$r1a3^x;TB<`?%hRzkhz*!)ZM7gdPPj9C$*|S)=0)eS_G~ zZhsOyIt)!b3Cw4|U=GTKw*{)p18LsxVr@Z=3gIZG39N_3f7~oA9#82{i{r8s%KX-a zF?qpR!2^(rb6i3cNC_yjgk?@oV`O<@T_9GB(%sNdu9<){v$|E-#2-gN zqB&Pk{R`Lu+IQ+<&Fldt>;&VIKudN)z{9gzrrmqpo^7y9OAg`SuLhaSQ7!1|7g~~Y zGnmX2M=-gc!K#SO*fZEFn&*sAqDZBhXRz;N-F~28Mrd^Dv%KRr0-wd!4eVU^=k)9S zKf=&(-{E26Ik2=Jd#zMhVAv~S!*fkC)ba-$;%s5oE-@y?>Ro^};Pc6D-Q&p+BESle zk-F>H1Kjhv5FKxS*_7#+oB2<8Gam=j@OmLAl=gzIbYif@qY;e39y&o|U(l!O3nH|afP;6a=Noi%04ncC86@*!*R_cWm@FZloJL=)+CBGM> zB@NXeHpeUV(Y_^gqq0C)`_6h1JLgYXYYysFnSg@xUm#G0_v61)FY0?}?QQL$!THkv zqwGuIsw&$5yKq6Sf^xmA0(a(IL{Lz{eN9NsT|q5Vu^_WFm!MS>6-v``2_$*U#GtG! zm!Pa`r3Gy+sexK)sV|h3y>8HIrSktibMC>*(y#Z=$K$!@%$!-CdFGjCn`c0jcDBXY zlWA|a@utPknZ2p13#@(_v%zuq`4p#I1v~?FW$xD~K$gKanff})&h7;-nh+#dW}!d4 z&WcK5g zmszw+2unYcD$l~YQ}ebRg#RP(#qmyid#@6tXp}dPk3w|X**(0_33A%x;G*)24qFrp zY)nVk!+_2IOlOQLGEk7BF{JIX2S)|DvP^Yl!F0c2q$>-PdPcKCnzjoP69k)G_U?Ws zTr)x0XDR(Wb~BfKgcUFM7@Jyl*#}^!OW$|wgS=Qy@g-9!=;xe7SaZrIg8?3J3F3Fv zWsF19|02wR?hxSf02l)BE8m4R z;5a@m=npGfzB#dmC-|&_2cT10c`C8AFv7YzRFH;Dmo<53u}LpOEsrev|VO zd_)bEd;~T3PuRiuk^NS$|8g2>ci{M*if$0&l0UYGSkAdV5LAhpE$16PUZ{V>!RZJV z|1sFei#EFb6MH+4ORjs3>t5@+|LnT|;=2Fpy8q_7|L(f~;ksXT-T&0@aEZX&yz3L# zDz_QGJg&I%T(!}TPwo9YuG#3npW5vd{vq=E?*(Ug19jXBZJ3Fk+za~cL9g=7llJq? zOh56>i!A$a^QMk`Ye7GKiklBvIL$&&?z2B&YDri30mg}+pjh*MG$ECLZMMVlA!7s( zJ$XMAMt+pOA4t%eUfpkh95GBgAAt51!rUR;uZe^->~1|5O~hA zWA+$|J7^DpX)@^`^a-I9=tG7NOrTi2P~QA((IkB^(BBN&SZXCj8{! z8_a#j?EVFeE;SV>Ka$E1!${JeZ>nBQug|eE0#z#PQ%xQ8TeNsfF94*zWcmVcGrq8A;f$c1FYWoz`l%Zn z==fx-ep z#eAOP3A|0>`UdGQ4*EueT|0pf{40#_i@t;jR(@?CO>_8Nz_bwH*GBj(#C>f~G!3D- zUt{PIrS6!$H>Fl02l@u^9RrNzHz1<2QV^j8f}cMWgwh`Ubm}pgAy+CG-=o2p?G#{G1)UEf@S z1-{mSI7r{>x`R8vwd-325Ck|D8?(wLV@=rkt=+$iyO_sh`8v0AUHs!!(8VP+-r=Qo zuT=E_Y;q@n1sndIeF(Q>&3Afx4u5AKsTfE9Hs-t?412+Yy@9)-u{PW0*01>2BN`w&aw(HFGUyZ^P>z`EMA@s zNHZ_`FrN7xLpclaYj{ugMcB*W5Yig5YuppC>115Q{7t32i_nVe$JLZ~(}D|T_?j*C zfw0LspE;h3_Lx9p>o+gZEEaLmGpO?=`y>~H20A(g|3kQOCD9+eWKUJ1iG`9@Z~*V> z5X{gT`)->5B@EFawf58qcRrfsFJ^+6XV#gWyjn0;*xgWT@9i~$*Z%yx^)4I;`PpTV z@~6!1ootl)vpriO@Xrbv=KccBQz0$;#V!&I+Y9sKTrOKZxI+xDM{)6c1D0xND8~f- zOpOhiQqIrsM&RzirM}nw==;nKl9W6b3N7P5xbqyb2AE!^^k3~idQHR_`cl#$xVe_~ zii8j2WC!@5-@t-wp;N!vMc^&Sz`$kZW{9ioEoA*2nS{JVX&#TWtzXcbuMw?+B* z7I;Ack?}Xsu;O=nACE}^)aA#JcGUh4H6_ZQl{PEKy^BG4%s{f7v4#9DLoIh5>uNuT ziY@Un(Bn4e(98BwED+`WX&;Auz14r(7XlZj{iVS7&|lEY>-v<^R&9fwWq;utH642+ zxGrSW8edqD6T@+Ew)qN_U+$1H)IA8cdZk$-hv@<~+3mgpP2E#8>nhg!r|8M6_E@Ds z>yKvh@EAi@Nc*qae?&7&uc2XC&i&Uw#XP12(8Yo9u9lfFuN#Wf!gYCKoN4O1YSEp$ zwF%or;@|;+nH9Q83I$RY&Ky*G4aUFhaNaj&5*rcHGQvYF(FJl(p{sDmL!S???CfW- z-=oS?C`-;7v*==)MtjVns}iu4B!>d8)3_UM7*CaExPWJU=IPHk*~LqY)P=chFEIeE z+T$gr=IgtNiNx%JsUbQgbkxmE7aN;pIJ83akTO>WXY2)gg^GO zUT6VeY@y7SAvP5(mN7%4%4}eHvX9WMzaf;e*3)L#Oc(oz`+*0wK7u71%_8zuD?+H) ziv8jTErP>zs#$)rt@J@OECD6Ab6QIgsUY}RE8$QGr{)c%%#}80Su6A%UtRST`flVl zRGbPop7@1e28a8JgD4=dH5%&0u}YxHT?E&*nQhQK7X~IkvzXgP=>9k@sdfssD(Cu( zWYw~P`FU@H{d$947?#4nz{e_Px}khwMMN|eS%ojddxurrtv>2Pm0pkwa{EE<%|49n zO+(s>RVoD$PqEAuT!Rx&*>mvbEhzz-JZH!DA)C0(-6fB*14OFn4(F)=fhZKdbRkgu z4Z!^rB*FsSiJL)4x=`(2*m4rHAbLtqnCugSg>GKZSJwI}Ayl+Bb8FuX7H{D0oEIWG zm_5=0@=x~+qLOmpZArKoOSg{_Z7F+{=s_8y#AvD+1?hHGglG@(sWd`_4g8?48CN-s zKhMvbaTyrX+}yt;I7FSDs3&kn4pzi-}xD2rholCbK3cE4;^dH>$pH<;;I@CAZ*W z@sQPJ^U!}5pZPsEj4SfM#T1g|ViQ?~2=?PF#u#;`q#@A=3f%?X+wxWTxTXqVXE}A0 z;yWIR)|z;XxvV^gP)f%)9O3|v)Z$3N4tDffq|jX)I-^h=ySfN280&ju1FdW?ws3|6 z?M0V=@Jn{KjuLHk8ry|Z2EhN)|65>5#{1y6k~;|HwsN3@IIOT#F&^EW715w?XwQil zA=HXGf$PP^eP+NL9m7Fk{d{97v7=B-))O7Y6Qs zys2i8&NdZi+oM}vUnc3sI5D1cuZFK2i)B9t@R8S^<0^f!&8q&vakCI-SLb-A1HEf|I|?y0{F zABMGQ3r!m)_69bIq5xtCH@i>0Yz1dy0Q})13t6pqL3?%nb!fxR4;Q|QYBPajLSYcP zZsa#Yg!$bAVDNmp9Tx%<%&-Mx6Kv)@9E)wd#p4LE5?uDx5#kOw98Vi5KKGmHK8$1< z774+5nFf({FZ!M~N^A?9g&aItnPBn6|0sEqcL| zJ(8;1g58wk#Q@ioVctXi)IEdTekxJN;7GXH*yaGoO!Ybhk4Cfg*Nk!Su~e3u8yk97 z5+^0(oA(te7V1B#J11x%VN zPnsVv&3~$hbNRcn!>OuY^*q1!Ntmps0tdnDP8GwrDIZQ1oq$^xriuwDD=AexXOxBd zh8R_io~EjLXPOA}xDNv}8rCY8i`uGwKuG`F#cf>Ly|)WBuh-lzMm8f{G9y-ShZv%o z#1Pjg^O9e%^R7FDkB66{EL6G_T`QZ5?XyMiW5&e7%XC}1IIoy3Y$JZx8VdtMusM*K zFQx^I(TsOIri-ZhPGQqHrd$pld1mk$odLYzC0AuZ+6q!3>Qp5AZj@Bg&W7nxS=82+ zkm1aXJ+r39&Va82kXT@j72$45>KX5B_goKh*r!4>$Qb=`PW| z<0E)&Fa_?R4|$66@)m@PfiRy6?-F4{pD^hx1#b083s3}uvA((Z&Abj5!M%R8NzK;x z{lfTYQ}Bi}gpYM$;{qsUIYhV7GlcI5mTCu}5FT!>pmDJ0EPQM5c8%N5d=JJ;eTN7O zGlb1j|2Y-=B8mwjq0RvDVPxQz)>oopvsxE5E}K+%^2JU1lXN%47cK<55@w3v1pHFv zEkVxa8l8>z4F`DO?+C1!Jg1FMU=Gq)$YP{4@@yvU9*k9ehvAl*WXeS=aj3Ff7P5 z@v5HybI7eJSO-TJ-&w+^X^3i@by?#^(U>nFJtzK&T?1*eK)SG1WsV55K7o7=pG!9 zJ#n`1jcPmyPoh}vy0M1pMQ6_b=OWO~PiBijjR3$+4}7ZG!jk5Q=h3?AIY8Bw$kAZ3 zQDqKm?5aTM5>G(Di@(xB1>s<_)Ply$72U0?@J++!<;@i~r7-%xrq*hF)(~LTRqg&M zI=FRBliU&W#B4e~9WXN{raLXnZPF;rqOi$qLFB2Jhvddn$3Q^V4)UC@pRS-Z>;``` zE}j=_@h!8NOuw#UW9R!sY{I{Nn%|@sOnOtEY1~+p?B1Dm|B_zNIGyso3Jk{h6z`V- z{>|2DUEkyzMK&ucJG!MB%W(@W`iES_?zv1axR;D07~Sdt{<=TC^`av-mW5!Xkapq9YlOhbjFMLvTbuN7f z+_;Kn=8lJNQ2G)DLhEDj)+^eo!4UI^=z)(kyoXU5lqdVW)-b>v27&Yc1+%werOoVI z@d)IEq&NSe={uWwZ?Go~N%O$pg2TMtLiU+t_4H*-(H01`dzLrJXD@)F3MYnb3>-&k zL!r6#e^i)N2!ddA-k=vM{#10qYPhT?KPq~JzK!AxqR_B51r{fjKB~ZS=ut7%Zx`2% z!Wh4{P{K)Y+ld$0DA)>%K=MK?{YDWC?{|>94JCL+g%#{;$vXY3TX^?QEcTVB-7i9v zehkNK$MUH}3n3-FN0or9>vi6*;1~vEi2!4OcDn&TjMisC`!o4wd;)~JYr9Oy1F z2s!96e2N|b0?u3lwdoc@!vUZiaQ!-f0AZ-SziVf1g3uqib!EB^4(!6-3sqdvW5T~t zw^ZjpR%3*$g)eLWk`=za7*1rJ_P9X&OCZBUbk1O%_mXL;=-x~fUi%oyux*hgxuib#;f~R~^#GpZ@=WIH+!B7aQFQ4&>5;0w9 z)su|BPEg?K95Ia(EGJ!+o-*ij-<4vV$LRn%{GxXUxcg$3{fG9f6vL9LkaHqRW!lN0 zuXa5%vhee_u4h*3^7D7DXI268^BEetN;IDFNq>gh;E++h6iR%b3GH}#ZEu<@f$<6J z_AewUICR(hfS2(erLOXdLs#LX9z3ac<=ya6=WZi3gG08jpjOQny0Y34_*FRZ!tpF<5EKTxN$Lf!*-i zzzCpaCb&tC-UgPAyJM&}nSO9n*m=N4#j~*yXWKSt*PxtxdzKDc zxZWAgx!Yk21bIP#1-SLLm#t~dcI+>gueFA!(QB=N+OJ_#ebwtC*P|}Ld4GwR#}KQ2 z1FUEvb$k;IMQdW(PFnkb883?8RDCah6QXz_LS_UpKq?19#;p=?gNxe<&X4W*Q1fN% z#5z$(&+Y_uLj=^F>ci@t%9dL_Fj(JUfrth}v7IXUE%n`^w}2;w&OL7l!JNXWcSLk^ zipIWtNaMTWcynpsot^RTi7U!edynYdOrBB?3B|%5F}xXe8j%!(3*HyQJ1e9Ds2LNO z%c(~+*E^<5_3tQY3@ntZ-bW`~NLBH^xJzN;P3+c=q5MGTdy8(w5nKpvnEL@NxY$&E z4MQ&X!adr*O!&0rN_n<1hUr!tognxj}D>~Yysi2B0$22;XEZ87c2L^zN8`(?tR zaAg#}jl`9Ri~qQs>GWrrGWJg^*NugX%Y`}*q4kI2UjBO1gfOMr-SnY2qA+qCzKWy^ z$LcqfR}!=_yFU~GwC^J^oDy?w=KM5vYg^I*`{;w=u%9>#>ts=eWHd3H3LgF#s8%$| z+Z-_j1u~73xEOZaO=IV88_KB;3NGlZ2RpFulAUymr~fBH-!#*X($k`&sq7(W-FJQ> zP9pec-lssT4fM{ZVmakz!*M!!E1a_G_moq~CNHxW2Wm3Wo=?H6@p2hXr7Z#P(J9d( z>NrU+_BgVTH5=XpzWczk6pe=W*ANX`Xh)BPHO;>m=F*dcLPFpLn!Zm&szVnTo{SU* zjb$51Ycfs2#+H(OqKAc_F+6NS``X)9upgLQNM8GeP}Y*x`XQ!OXK?;>@_sSI%LIx( zlS~Eh5GmO&^gxu4Q9`RW@Caac<+KBktyp>9mausNFAs_cOt6b9B?AzQMwLPjCJgV%_)aih z9~J>#-Y5Y*903(w_~+sboHtDs!WP=ZVT@Nl{0*T>n$8!JSr>p5W-#7h54G5>#S5Zs$90nHYwK{-34Yz0R|9|hbtRGW^XlJN|nJb6U9 z#5mtLB5pESd|VLlrK?AUiUGsjWT1^aCJv~%sJe^ISwHxKQ~W|yfZUqC1b#x!dku7a zz?Tqw%PHkcaa1*YGMVmxh@bcsSdWg-HHmMU*{fQsVVhO%anat@*Ye{5nEkgwOL6A7 zSb-Ymo)C}YR(nDWQjO?EIo=V<72wvdMJK=Mz-=&euKBWc?IFRdc=_ z;(%Ph5TbeIm&7lgaOYMNrsyyn2jyFB&CZj*umP`)>-BG9H>_pTeg{vpnIisxBY}TC z1cv@0x~dZkxkiL(o(LSv{R2G8HV_F9(sJNd)h8muCi?g4*_3iTP& zK_*`e2mUnB_336Z{Uv@h>;d`MaUpMne?W47w9fZ$tmIkw<)BH4S1}{Y9`Z3elm8as zd;qf6E_f88D8Qtb7KHuEK@65*uDFoa6`l|_mcdJCK%L;&zqNHr!&QBMP}sVOGFdrh z3Nqb~(~WjZC_vU-kZkS*_p?OdbUUg}F$WiPZG+GqCfOc<);#1r9eMo=adm`gEn@?} z8-Y8oordJ}6k)BOiW%+aDVM7-yWme%_qprA=(?3kGeDSjd&-$SqdSjoczZkE zJwc`xl6j(}N8lYN4`4%8Mk^>A{Y|0p6}Cw1Osa4Nb?>cWU~r2Tw~)Qm%G?DdATHm1 zP%3w%$`(?2P}_YFei6Cm`AB8f-sB^1M+I6pgvs!?NMGeRWweV?fPa@$f<;bHiyGVF z7;r|C>IP|n*ic-8&q2KQSoE3@sQ|%=T1sPIE*}!$Olv9o=)N^wsGPv1?Dmy9yMxW{ zqXQ#5ae3Tu28#(7SMUA~kFIyr$xkZcdb6MGppLlW0p^RpF$8HIzK{k;Umgf@xy27{ z-9m5q$ykLxy(#B47}v8ugL7Y%PaAVVYpHW(1Jw@u{IXmG({3#*7<4#3+>CCw>R{esl^r0td|{Owgu~KSGBcdiRzA+S%i3G`BbGrRE40Za z{JlLu@}|qA0I9+?%?ptI6w#Tf_B`h2rhsz^&<`W|GC;nd+TKzR0+1X83;b{&iAbV> zGC=M5H#kIIFx?j4(}8;9x&+Db&2YVWL2@=WkGRpYV2LoVABYg*Bg>t;gQdR--8d8? z$0?iuiBjWb*f4dRsJe-eIL<1{EOHnmfcSF zFu;AVolLbF9@YkKA!5f4(A&{rGTamaV9KxpJEmIN>jCYlBuuUXBQh{t>S31Jk+Dbf zwQ!vR7##7%aQOmqvL8XHyLpNy@-m?Et+=e<^AUl-_xzx3!YUi=eW)wmf&rwlmjzm|xQL&U^pn!X%9M+MW!s{SUT6a8X!c|c^ zhx1R=@X#Rnr*Cc@C1A|9sY=M`5F7ngd9X>dbV=Z&+p=(_TJ}+o|@l zdoviNMWHmij!`91GC&bngDbpFf^ooJ82uV0Ct|clbdX^xrVJ}jm>3uYhed%tlrt7G z^0v0^5elh;AZABO?~JY6S#h#G7wL9BowXDjsk6U_XaAh%5wREL#3@qJS>B|7HKEZ5IETe0 zq4{=^N=C5P=M`Q|G%~2LiwvuuC>e7~C^u6cl^YQfu&mCYSG&uFpwglpu#>m*s1a+v~h3wQ)LkLiEN13vCw%VDbOR@c0GJ)L`H?zDkPEjOZZ zgSg#p1vQ(8ho?cF{Pei6{F;xzy7ZO95oa;UTMNsVkQ$Ho#Tu+X7xXiJ2Im)L`{rkN zGn=qkmBr7J&ETbW{({A)tQ)p^ulUXN3)==6B}{ROU{icxxVd1jhH2DK1}y398hOP; z0gOz06L9s!)uovKP=+!Wd9(cnmkjl<@2T;)fxwLI>B*&nwj8#2x^$DcYcY3$8_HFdOAEghJ z4`6p=>CIS01~_X6N{C>E&e}mBla|HP>*}7ywcFV-3D7r{P|8g*61yLfE!es0CW#Gw z>z(OCB&4N}XVlf*LWhRR?@Tx9r46D(H_KtBw#@*{P1%jntRvbS~9e;NkTxsj@e%iy*Pkb`qG3E(dI{)bwQkoLeYP9ro8o|%un z9~Y;4P|{=Y5`FfrFCI7Wu(6F?YD1}Ry#%Z|b<5DHz{>G^Whcn#J z56`^9aytKAIf-=2`#jX<7>}RsNi!Rr3vvEyT3qSbF8%pN=RX`d(Xfga8a*$^vwOL> z;+Z>b0HY(Gd9oVMS14zswDml2yy0i9T+a-B0}|~PG=#(v+CNf?CH=qBKXuRA7g>!? zXMCvxY?WKB-+a-qy3g^IXu^H!rg0gawb#}p)J!U&H{N;_)uaaN6zC8j0cVE{c) z|Gi7<>IUZ5)osL8ybgGY>!X6Yx^uYZ684g;udB;@wytjV#=5#$o9pV@yUV$4jMmdvv^94BqF@@p2_3QpBsp$;1<6u1iypGzqc25+_Q1 zqeBP^z^<34Az^2?f)1l>q8y?$uvSW%1;egf19n&5BJX0k>{clXu7c6V*NJrY7O?Rh zop`wtd#T{2EvNH|hzV05?D^7+DRQ9-uyQw7fQuo|I#?ckh6lK~Yg1$=z1T3?Hx5xn zlBc=^m~muHhvR+OHK~VDy@3>)S2R@`M|D*nfgBs3DtFc&H5yznO)-jSP#DGWS;dLd zq`&I)KNJV9(f^f=(jHbcf@GyK3AST@uXAA$xx0;;?j(5c+y)b0jOVUYXYgJnt`2-VfX zkY)&Xq|BMJd!teJrF}CcyR<9Lv;8cY$lbkr7P`xP58|9p?4*0kD{h@~engwf%no1% zV!5l2=rx zd+WfDq$_jeWyBQtZLazzZywAA8_TeLC4L52tea`XJOxO+XU87}!(o(gAE3kyMeK>k z5Nj&yKB-!><~~`VG;h(QZEf3|(lX?b`r|dQ`zaFwV_62u#U6zWiH*59fb4#}i@P7Q zQ~iF#b--8UexG1tv*y?LOJ#rzdO)sqm7d~<&GH{VAX8c9d{DI<1uk@c{Gg0uLAmxJ zxe&Lx4?}{dj~{1YgWmfCZ)&W3C>MK)%xh;2Qs~Ah2rHUuK+r~1_RuU{#+xsa&upPTB?ZP zUq21aUm}@uWxk67yY2C*Jm?86P_FF5t+A{HiBp?-Y&3kWF1$ayR!%`_&LeB3hjBQG z_9E2kX|Ka}TJwyQ{TLQQTy0~lWa8BWcZQ7zF6RH#WN4DlIdYx6ld1Lg0_Zu^Inl_A z5E?6S@M(M^tQXF0UP3e6-aBKiUOUptw6j-Zazsx1+qbzBi@L@w`9_=7$SCaxu z*0MkwK$G+WNc0T4N^*7swHCJybNd|hgt_ab9^7prm2QV^rfj{uOKD*GArB}`9S7xl z0+L|zvoZtY%#i~+Hi;a-$cI1H9x}dh`HWDlDPf-psJ#J-1RV9f0dhj@x=8>;2hiW&-H~(R`|2xmge3b0k?LT89uSg?x@l^$hUS9|l z;hp|Ax>C%c(RzdAR}`w|s4f5go20SjA5^*TCMa17ok(fnp>M=5Dw0`@T=rsl1WR>o zv1|IUkj~?6OdqC2*g^J&ryJNOzaZ~W#NC@rH-ZtWctQGdS*KsXQUh;~7o~0$97mO( zz-U_WHrAxX77@C8jEn7HK7lsAC=-D+r(TrLD_rP7#kT{L@GRaemn$4ky6$-6M^{Nc8jIB>HPB~OcBEH1 zpy*A-J3;HRUV}Cgk+xq0uTf5ZTVNXH>#m70v!r~|e$(%{pGIDSSR%WIEs^0vh16W#K2To;B&)4O5%2?+LQP8IZ zD~`Tqm2!xJMB+_3B`&pN5?vh+j={fgN0=H*Osq z?u%4?UG#?RO1@bLl~U!2cptmokej)wx4#K<)E>@`zep;Mf-be>P5GcA|4Deq_{(&x z36jw5JLOYY;c${oEDog!^L5I%fPpS{PWuqMc8l)BKJ(nsf$TX^>{O^lue~kpO3!F0 zm>I)hm~+Zl1)&f;Mp4Q+90MSo@-|m-)uGWKYfdP&|EH3;XK+86XC3dt1}2U@QL-eH z7q)R{KM6BkO@uYTS+NU}1BR}4H5QEIcjd+O5SN?1QiZQqs<&cSY9dLQN z(kK2)`Yr#Ge(Uvg?;CWF&&>BQuA6E5dot2G>3Xs&wYVH{!B}M*xH^W%Hjg3=7 zaZ+e#SIYHniwIYj;3nGVs5f^0@0JoE%-bz(YHubBJiL1H9}mQ4dS^GL>Sj8%8xw9b zUEM9in(W284b5TM5HM9A=?xyZM@A~kv|S8vTD7I`H&W4HaBoO=bEN9sY&hRyuC?D3Gd5T>m5yA|4;k0(wbCK`o0WaV!-=m zw1Zb8ZcjS0HUJLZwa3LChz3gC*|-%*a|grpe@VYfPjBfq0x2KJ$F%`KhGbklQQi#X zVIhcDOCDW)6pB+|5iRLvGY8(?Y`Rt^2P=aue}qNjmC4aS7t`%wwt{jQ z(qM#mbx^p4i3Jj(*ZF!!uxb2Cx}-rH=F>S;~63=f>$Y`XTL ztD=U@ikO4kJdSgl{c4f%6>_+DW?r+oEB_()ea+@hx&S6J{(w}$<9rYWG608nz6`!B+75E_h~A&46w~5~%be8K(VvHr@(Q@UisyAF}c;fWVAq`;hW6 zq&Th&A*Rb&1pQbJ&@z#gbwMp~^~80*>zPRxKR-YbpGeVQ+k(PawO2fW5jO|9xQC2R zOjdZzc#s}MNllSF?-Q6h-RI`@(mFOSjZ1l`*;3$2)LUU9a<~um!_DS4Wr8Ki{S>Ao z<*5($;Zs<feo7jsALh23EHw36nitmT!NQ#eK)_^ z@3ei8Q})o9eehm!?>P5vL9<`v?URE7A8j@X9Y=(tA6uITE=0OP#oZAQrRseFaT$o; z#uVZ_K}H&l*)L-oz?<=xF9ri=?S{MNdUka$tJxN5#jV5Ox~$-c4DN7T)a(bwRO+F2 zzco|O;$}Zn-eV;P>IbplGuhs<1X&r5+0^+n*|lYk>+!KbYW-nACxmQ~=D^3BEza~T zM4ONl58ovIekt-WA7L22ZozNH=bpHhA&v7qfqN5t#`|bW`5I-#AC%?>+st{P;qR6= z_g%d+TtI_wxK93NMYG@JEdmiLJ1F(7X2{|OY`6|XXQ?kFT3>`5mCxGEz|YQyWVDqD z53e=#ya<@X5E$FP0@Ilc*MwDvWVq#iMBHUVmnWrv?E&6KtVul&?2wavmp2|dABpr0%RkR z5>DtE_d8EOOS4*+Nc>OnK7kXmLTemoiFIuTiRB5JN|j&3a?m(ifGeB9;(#^#22g5{ zjS{|b`KH`LdG9z7Mf_4!h;!*T@;vL{Gfyk-GEcvio`yt@b4|l+!Op7F7+q%HFaF1+ z@x6hP&Lc)>$wA&58;0<3iB%BF7(AUQDZv`tatNBkt;I(>svwu?Nh;#z$tstAz7uJk zu&sX>vKh>fTekR6K8Ly51z{BXsTT*B)CKX|t93`B#np1GOXF_6td1^l{!lGnR*hZr zozw%&^dJ?Lx#B;eh>Y@Rkbiz!n3)ov4)L|H)`MHwky0Luh=ib?a0V*bj_%vBuVn#IeN56I=nQZXiCSkTT9nawtiqtU&D#3&riBGdgM>?UZwTo+0P`M$vle*2DxW|x5slNE+5x*Jxy6OfCbk7 z>KNN>Q&#;~&gcF%ZbRZZU3EY5oLtQ52hK@7!0b2*>=9;!?ny|2sUZ0_*oWfJ%lXjh zRbGNHU3MNighCuzD{SX#7{t}$FuvzG#2tGQiIt*&Ol812mmuf()X$@Vygu#b) zv_>kYqp>y0`O~?$2IeOWGn%%QO+dH&BFCu;5oz$Aj<$lMo-lg+B7K#rk0Hq;?l!vL z{vsW2Q9rHUvP}IebQ@*N)%^32(RKB@? zfscYU?JsDcSt*c7h?x>bXaADED%f2nKp2gSMK%6owFi3{+(y>Fv8X^HcLj4Uk5aCH zf~}=YzLjIEh0<@mg|q?>>}^pYRsFBRe+_%)M&mTg#H+BB=mtv4E&#R3W8lZN%HB>YXDavji{4H@pheE)A4@} zS|Q|3Wv@i!K^j(@thVMe9SeBb0M1zVLq96?&MlpTJWKF|DI_Jhev{qs^KPx1nZjC2o~wZ6P;#te30Y zdHJPp3p#k2ceZ&#{#Gu~nGfr@k8< z!fWi`Fxcl;9_dbLEwvSW7oV)FYXt|F-*CNGRafVzuB&_G+q$}OKh)JtM`gwg=f1Nz z#j~EfQ%+hdEiCF2oW;cLGrGjTEjZyR7I*$z`4?)V+Q$*Sb^o6(j}OW`?`Ok?jl5Qx zZSt94Q9m;B2mJBvcy{kxP^0G`e`%Orgl8t0J>AME|CuXI-y9Ha;bOVjJ*cy<7K?Mf zC;Mt)UKzEh6o>bi!B4GgZAL)%JiLaV^LD=dLi>F+;rD!v?%BY-g$)(2VveG>ap)a4 z)M)S%$mZVQiFl^O6fLA@w?-*pt^$oOEsdV1pyZbMwJ;8E^wWGSL3rf45eNGT_$ZY5 zX~``&0GU{@9X^6KrA9kwKx-|;*o6B&JjgRzYeP)WQQmSbn&dSz96%>KaCGf`{=Nlm zwDqQq3QL_k+hE!>vA)1i>aSh$D|F#2(<^Ka>JPWO8mkuXx2f@ah-~p~TGQdDLcM8b zTWz@C^KLnMQ}u!l*bTA)Tl}ipY8yk#uw*dU8m<~Q+<L#6hnDT-HvU=*R@GKd0?&BLyD zJXR=1)9$do=o&&pi=XODcW8q>6uY8|poBE+5h-i0Nt^&(-CmodR>x(!XGC(8b{874 z=pOX7>QirDXH^uMf!+hK;OsFB&ctYKOZ}UYZDGCz`vc9+kd7L5Sfx5Y>7+faZ_m1c zrp*$;uVln&{64d@hB(Kml+#5!hed2|S8Wh(+q)unDh-U+mIu1K>T`dX=mpc61&=9;>nGf)&Ihs$;4$u~&#=wCZ@z%WUgFr_is4JsXRifq# zKwn7If^qXo(!N2C>LhgA=%8#HVXk)*4@Mk$Y(T0ShAqPW4`Q=$(O``a+ye4Xu*?F+ zu}pS%Nqe~0K7*48I_NN9_%!6BnWCMEgRV^Ts|48={zz9jVE*bD2ALcs|`v#dAQ(%f_J7-JG>!G*9l)Z)3Hu{9ZC> z46;q8MYpvBw>Am^?6Y^m>gS)VZDazoBUyU`do$Bhcmy(N(RfVWRGfmMk>zFMd)OB> z=G^GziQ0|^t!M@KupE-*oOKJ=+>Na7@s5I9wK&&rXW6aVT^<&u=ltiO^y9EyCQjB? znO@Pyn*)3oJfsaF8R`?Vt_EjRmD~n0nLI`7;R0=D6na=RMN=M7uT9a|Iihlk#;3by zPSx(g?Zi|q61S^UwOA{ksm7}TQy#SR$e(*l|wAyDQlAWmv5ub;7SpG!^C!VN{t z=g~IaOrE98UhrD&F=@*N)=mcc-=$3(`AxYOkA=Ol_s|k)gpYb3u){69E32 zyENT6If9$->YU3J?buyfGJpb&3L5g?2n5{q#26>v<&B2S&{8q5@66DIGOV-kumo2f z{;(`(MW zncABkE(W=>6Ehz}aZp;?Y|z*Fs@N4C*9G`2mF{-iJc5 z!S_CG7~1~qeXdEDN$fgPkf9xOZ^8KtqXk&t*S7VsYJ3&V;|_ z>PG?In`rVv?LF0iHdML@tVmpzc3Z?v05mV-JQJ7-GTs|&ah9_&T-i0~fv#dXnee$Xp8dZ6qHNNK4QxLg&Nv|Jl!dV_h;uFde6m3YmS ztxzq9TA|gse2FUm3qh>nCb&nW?ZIAWCWUbRdK%h-v?qaNSv2=aZIqfxUTS-9zWl?C zBfSu5@9dMB?3RJ-yKs4d$?T77Ij#aoOKm+NPUBjP%ZaN7R|;TvmpT9ao7>UEr@#vP z(%h%Csj6&Gr4-Gtv6#JPp|k~5dbeha;E`8T3!Rtv&6AZWCBK_N+DfcClPG;ybR=c3 z)WXSU3Krrlzg8f8D>1f;UBK!{lUFg5N~>34gcWCi6QR#STM)MzD0_rzKLO)7aWxwB z4$WPStQl0iT6@u*XE@&@6ujRWum-ItZw(+>OXX{{!8#i;j7C4Lv3lakr&T?Bp4ReJ z_?ySjObwTTD%UxJ(hCrQvU9Z<>z$xWEMyva^g*X8J9{UMv9_ce``Y_8Pb!z7Po;T4 zo>V%NrwPoS3whcSJf#l+)|ZS93vd>#1ssq~TZg$)l@C!QiArz6?~=;){-zGD-_M}+ zP{1NSdcivUET)0$v{;Yvf76a%V(heH9Uv1=#dwFq>kq9%?~l>db*K<0J{Q3eExv%c z9y(FLXz28UfC`>~tn0C`e@iLrk-vy?`1T}~uGa=Dj@bjjg2P0?k5Kj3lp_v*{gxGWN!_Yeyx|YC{5dUDmzoSq;z_RFCNES(gpk6otMx5je+&A>M$M zd=^!20EgsD)1CtnQ>+R0xId>=;9RS`jhfAG*&n*R%_wyfm2O1+2dSEGzGN-bK4WTn zx=`C>dQ+F-)^B3U%SNqM`KGVHFFddL^yJ4F6u_Gz53H!t4YN^W5T!bjwQZ zpblZY%gXu|k_@!gli>Lgtdibtl2m%3jiC8O+I*9fYKy?yxnh>?a(}YCgYUT3cPXV< zGvYdO*fB(Ubo(k|H}Y|d8ru^0;QdUh{kxS7<#W{1i1+^?=LhaN5!DmhsdI#{vfwdD zRN;D<&oZiArGgT2bjQG-n32UFPY@PZxV7a*j!Gl`W1}KIG&0l&h-{SMqb3j z`u-JH6w>RT>s4*h{4Iumfd;=x@Jh*xqI9$M^}Jk_se*F0fJ7r`Cjzi4j~VWVd)pX; zd*P}?6B>tXjr3zLL6+S)2bQYq6R1JT(FQ5pV_s7fyXElcZ+H+*r&Pt+sLsjXPy zHq*3iT5u?L6P$+P3Jkvy3@6Kke~rvGGiyJnnQ6hvT;pcV-VU> z^#{H-#fFFJr@;Dd2hoS)!YeI;o0(5Z+kq`QdgDadxp?Z#qsEJY#Knt%(LDF&7&w4( zw`(@9lL{wIuflqj=8IiOHK!0ys-})lu2|>iTd+gp7;9cTu!?2Tm>r<$YGPCQGl&V8 zjnoFFe^%r%!^)%3lmKkU=dK2Ool+f6f8UD)q7OnkX zw1ad1r}2m)D)SdOncNGyxvJN}bG4v^$3=h{|_Yi77f6uH^Uua%3AaY zK4H$2+x8ujjM{3c^wwxw1m3C=nR5n{tA4YT&hY26Ya(nB?455=InKsd%Z<=o#nTJ1 zPv#5?#)-7+!53zX@$ylO%p>`w8=wJuA{yT6Z(;*n)dM*Br))Jg6JIF>6mi1L8=6Ss zo^dbTd&^_a6&k%|fbk!*PyEinM}FUiwD({am`7R}G{+m?(0mnq4SB~X;!gA}h?1hA z#w>XQ?&%e0TbLu*XhtS|Z}+YE?c=)Cd+fT`gkoK}zuW@VXG(YzTJowyCt;{N5?hp7@eMiN0=HO74;F#`6Ts$H9j|s0I71y+|nSP_pkKlKoyc6O2cz_mC z`UUv!pQ6m2SS$H}v4zMy7}ssMxTlG@1TMxi9(6{JA6<3A2EyZ5mWdg>B3byV9b#B_ z(`;d?bVxURw)8W9K!>zy0My|AZ$UAFo&-?Zv(W#>yrsGIhK7)%2nhPb`kLi^v+mUywA(M(Ab+aPZB z!9YI#fTx_IHt5$j9{%B)PeCpYIxBfwi}A?!qp^`8c8V+OfHz-CGwq&h*c z{=PRZMkhvRMyFeGaZh^UI*)Q0-MKuDOK8H~fonRhP)eC%v*o95gZ*Ft$Y{kbt$kmE zw*A{|NByc$9(A4*4jS=}78%jF9kH&uxPIsb--AvniwfU?x(oZcl_`TsiqS%FYbb=O zIFwvA&*O~!P&RJ+4Bm{F8GrrX1wY2!RfGd~?k)qL2a>B$bc<^LVq*;ay&-iEd>3^Y znmg0{yzcC@;(elX=bx-?%;{<4b(#jp4>xh$mrju^x!pP^RgTH~+8wUNvQ~v7|y50i#S=x%MDDBzk^W zZ};GRg869^%>~aP?$ovqp(AJQQcJ4dWD72^AP8gp4lD{aA8G+^n+vUNasFvZ0(8o( z4t2(Vq#O8HOS%@Zl5#)R&U5hh^i?)N8$X2w<`><)!WG!1y<1ugWt_qeql~>!4*kke zU?M60ly^(o6d&kKyZ36Nn_-k|?bv?PV;>A^O?gt4R`el9#F8s z%j_&W3JU~sTffl0vHSrzFab!V-@ZUzoc&qZmUl5Ge5vI#-hTR}_89Vx_zJeIe7gD- z)Sda1a2)b&8I3s(3!Z8WWw!E##U}=$OKueo9NBjqt^;M%@dQS#8!b4Y39mBHgH~iM z$5zOa6OgS^oqJB86ri~2B$Tl=Uu(}O`{@ES#zCfi(8z552IiMSC(;G0>$Owb1l*F~ zGgNRdRQvI7VRvM%1Eizq6yOG*vQt`jMcCmIv9`6%%CqvatAD2%hE$nqvN`2xt;_?> zs;+|eGN1gawfk^eR1M{B8I@OSk=*Yes`*E&vwODer>zfMq(?3Q(*YqVto!gKei0JIfF5YY#$kQCqL^gk(C$i!?WupRv5u zKj+g=7olyRPDz(APXE*G&?V^hnUC?z*EVCNoXaMLS`ASMYtX0`w4erP+JgLQ(d8Dj ztX4s-bO=zQ$Q!<5WiNaAI%{gRG>-<<;&wDD3*m6VoUEdUer?v!i?i&*NN$Tnc&lH5 zT=hebCI&QM_L>+8t5$+V)z1S5BP}XAD=2X#m zbWmm>!mH(aI1*8KrH5m1TTXfyNd{|@3GJZCV)3p?`Z+wlEtmV z^DBITt|xiv_i`iy-7~!$JRu9c99?lcq~ET3IUZ=Hk;bU(v1RYIAs+#gPX16h9o%+jP~n<`suP z9J>b%ififE)yVI?wxxr8SQ1(}x;9Fg+sZLYkwJvkJqRJMqLm}2QI_i;cNjuIBZjeaqs=kE6ZRXJ2eAc~<5XS_a?~hy%X$Lk zB34WTc;HxO;mra)abXX72*$%@C7&4L7>zyW#UYMyrrVsgA&#TmBD7&SRlUY>FvA@y zjMii&X+F-;5suODPoZapBh1Znp!^)1rBm6Yy$~)(U;uO9n%E9#9)B&YDMPoWR*z@Z0qQVQO+aWO#~6Ch8IuxnHVrek??Z3@}zf&&b7!^_5iBN>;T;F z)%PF>wzTxW3I z`CeU}KO$_U;JO>v`A>AqBH^*0h|(Xznot=%Z5-kZ}oOWTQWbbt2=4iQH6$s_aK8~M5KgPRXag}^lS2y%vUENcM5uomK_zY8ZU$hoS zEA(?rw@f;Ypl!Gwq(%K4-Ayl1X+OvEP~M%wsxB4-Ssdt2mtW| z9N|4*#Ips-v78ToxvtQF@%YW}cvv3CJNGz|*x(J=|ERnI{VqWJc3IM_9`g)hph9)xiK zDM$nzQcno=+6TlSIT3i;@O_#cYT|e&IG>G86RQ#(vQhqR?NQEvBuDu5_nApp+8UNx z_HzhWu_VWQlgAcsvVZ2~plzlw-c?dK7(?8e$_G0hFtu>@9D;^g+Mr_$!2Ogt)G;d5 zACEkhd*QOWlGfoj`~>!Shnd<^?NC6?Mt(OtCV2z|(Y!CCI}svGm~{au-#QOuCf8Gc zG*P9aeOP|RM7SuvXbPa3n;q>v0)y!N0#7^jxv>Ql3daMa#{RTEB^x2m<8o8wHq)luSU5g0gbV++cegsplN{Y{XVrm^e#6i0y4 ziU&}NpVj7^GsO|_9V(5%$0v+Mn(<82Zie69!8Au7Pt=nWfGwrl$^(7#PnP&l++B_< zR95BZzpkWhd%cR1cN_uEtQn4p9;REd56tl%W7=4(*~t$=HJNp+11tx3`uLbUsC*`{ z@rW~JmSd`?VvRwfl-Sk__ek0^2P>a0x{{o$xQCSc0PM2mKG?j-)F^GP8ooty9Sc=| zO#hFtD}jru>f*j(24|Gf8CeEo8|E#z3+BEgq^9NuW@?EEp{b<_?WG2!mYN!ba;!9= zO)D+1J0U{Vs3LJ$GNuJ@?#m&!yDEG0{}I z9Wvd@9H&`z--b@WB8Yg2+I|8%cYbs{t-4(>J+;8|fH(bU>Yw9b%jei8;~dF>LxB9Y zuE>(5R-6muXag9S%Y;%3b3GrJ=-%5sk(72M*s9)nrzgdN1hF@VV)lKWNI}992cnDt zwa9aantwk^4q)R#t=F&(52cd}!Fp==_bGodCfKOO7_M6udj`{n#hwG}+_1WkmItl? zr)T+?z}jXT8-;vNMyj!)W+@O)9BxVGJWk{4&IpLWC&JByyBlsf94~~-!DwR`Kd_yd zXM#S|WSg1Rp2rNY{;RcB+gkI$~!g!Wxr;OS?PF<|iA%X+g5 z>RB}fSX)`l*ovyI3kxlI5JMj-^ACc|f+xX8>khoi^`NJx_7l&?y=#xBd^N&cvcxl1 zQ{m;~E}m&T9uj?%w7(IA3m{888%iF+>~MF2ai5f>p3GodCzL^}llsC+Ogvj>1Ew0j zDw??jgCb;=ri9`($`&#KPQpTGA}58JMp3k5U7$dwO}N++Z8FX+LGZ355C&_Gnob@y$TCf9(cHgqz~z3@vkI1jw>|0k-15ws zOP5~5OS>MiPj{4ySA6a(Ce!@4{b&DsUiM%7;Wc!4gXf;SXW`w|8>7{G=lwZ?=5xy7M(B#O3&$?Jv01f#O zC8#V5IG9`U78;}aAvOIeY%Ap+XhdF_5_zkKzrJui;pflVG;H#WaVEjrxZ&(&S)7|a zBdI*1HLkz1@b~BYoxxOIih-Ampcv=cF!Ba1D)U4;d$sI+Ma$m3TlVhLvUlH>z56xu zuF7cNlPXC>8F2-gsSnRfpai$yn$(qug-nO^RS?i4xase;f5d# zbIS}jh65AeSpvh}*rY+Q|D4C2JQTs0ZD9(-*`@@*sR8g+Bs`C54uf~IuAPEw4q`}x zMhZ}Lqa?$dg{}Cb9ag3?41?rPYEO1`k%)4l_=ZaY7rE>2C_7Li>H(Gnr0~#yx{5S9MjAjb}%4;+Tw|Hj%|k1 zqKs?iUG;+JZRdD+`;YL|FQQBn;O)=WJ0-WPxNwviq7hGsGp$)_THB;I^G4hB1O+WZ z@935|v{p{K0cVO1OY2DQ8+g@kK@WUvLI=mX(hgxIPrJ;`dh6O|DQ8u(Qv76?4BNTY z+dRXZli}?@w9D9gN?^i-s_Nvzy&Z=k zX)i+@2afk;PrTnypNfc@K-MoS=PRB~;n(XZL%ibc_77k2JQ{w3j^dNd#saEy%RTLd z@M${Ezm%&hJY6j};lvO2qKDv^wYtJ%4$t`4ppY0=YzOPqX*+hL(-DlxCi4e8&u#?F z6qFZ)zHl@2Wc-KiecQpQOy^`=;h8Ol$o)lz$alLZvU4bo9J##Q;G7Dlnx)6_?}X%6 zJySX#!R=$74D5R8!Ee%o`?prbtDb(^lQcY`c?cW9v-RNq!`k_pXIS{me?!4M<7*yw z_^cKSR`D97GdKSm3ePyc?nxUl8+hNAoCBC=5SPj*IB#hT@-tUYk6XL3pQ-G1Pfx!= zbW4lbHoT5aAhaysz_#R88vTYR-Z?KI|M_&^8=l1Q+w}N65Sy}j{SD8xsSETN25HaH zVdk`WEaV2HcspQYY;aOJG+Om6ao!OS>`pqSdJ>a)tH^)D;FvCQ0XV0=aCZU6u-_P` zK07?|;dkpO{~~{4V!>S2+HIlyV1laa-x!4$m;Z#=Tch z#poaJG`#*zj~ITRj$#g|soh{5Ms?l~lz)tZWC#iCUxutB|1D4dOfB=4tuNS}&C_EU5r{tZWsY{yWyLcx?<u7^Jycj`OZi|dlkABRp^$)OtP3=2{F8v3dMWdIC zFI*m<*UEJH0Ih=l18@Ehyydd^JW#;P27nakKk(N7z}qf|NB*taTrL3cZT|xw@*jBn zW$@uVL)rxfply3_I^`ws`F2hlpZl7Ao^ASR-`kXK)6a2DKj%07T;23@Thq^dO+U{z{j~3E zO1J6fxTc@;n|@{mcZt>nwFXzy1MTilfs=oXiT4ZAvsnT_-#Nbs~TiI z87Th+w=5a=3(BiKNvXYnV>)gyEm!EU!O->w%#)d2U${Qa(n_fD^b7AB5Un3zJ0;9* zA1(LSQ7jwbp*28%oXAAKAgi+7_>T5I0P^r z0z_7$uhdaSRzr2z$SOsLnL9V6d|ati`1?0d!53J3uY$M#T3_*nr{CyddMZXP!*$rm zWrPlMF1}57HT?begvt9oS2#yD^R7725vRTTJyz!^;QULFTZp^+nNMPe#}b<^$by+e zuEgkOVXNvqV)8Zcz8pU?CJ;|GM-gpopf_^hMZl=!xIjEXjuB0c!#H=@dcY$&$0IKyy}X2DRkc;NST!G#GFI zvy*Zd8{xv2p!~A;Af(wiqh{oE@8?GEX9foyDr8dGA;iz3Du!J?K(q$}@!n{8 zf!+bp@&obSXa#}Z0nr`|#B0&$Ji1mN)3&3H%Nr948hf-6H9Y`T+Jvg`L-mw3Mj{~Z zl`ZEz>R4k2*B|rGdqWdyTL7xQ2_<~f7^|w*Gc2zN`S6m*SGIUTdQ68|ubtsy9S+yw zwK~iz1moA~FjESKOLW*+4@id%Qn_A-^;IWAqt=hZ)1RI}pp3(`O)fLvn#T;+wv%-7 z+s4{o__nbgMXO;YwfA?Pq`Zwt=W@*UQ~!bA^dI=r%j5G}m0dnStEc}1|IB~jpS>*p zidLyVcq9ANUvk1OMXX@x5BTbol_Swg%#< z>?fF*tUMTGc5VaCkj#1+^NQo1{ZTK&+mD$+okX}+lw2u->-)hI8TAUn_^~2-y=_$S zRZwVnInaKqD$t1}Btz4{eZtc_xdQmh4Z7`tco=o;f};VJkGu-p<(7cg0`bgP=m#XP z1Lwa!H?l+8YZL|-{RYDMPp-0GVCA=bo`|=PfAoYUs0hF$z?iZ-bl8}(Z_>ISJ=f;F zrF-)%XZN-aC+qM|9qz8fyL7m-4!@(rvJSti!_2aAdX+kCP@*aw)+y1%R`2N^;d+Gk zb=V+9ALy__iayj~qh25Buu-p%>CKa#c++kdwd-z)p!$u zeby{pR???VKY2POd=8wi(55;7uA$tYJhPL(fcNFb;{HIqcPwiB-T~nJss&pf(d1r@ zd##zLJ>8PO42+8!`jUsQ0`Wd+9}G+z`sAKO&mnmG*6MHoe8ffHd;)VP?vNVE>RWB&{_L@4cdg_?HxmqF%|-Iho?@Qdf9 zP)ob&p-qsjHq?9CnuR*L_`7GM={pz2ec|e&=A84yv@w0}qR*Z)byT-p@|+1a9d}U= zvcfD&u$YN7ovlUDvIWh93)AsX4#-)D>z!$>#i^zryaCk@T8oo#+eHf!YZKo_W`}L! zG?VFstN5Ef5hb&r%X=o4CuoS6gcOTH#9mdGU5>C>Ja4|l11r}~r`Qi;HABXer-tgmzaf&_+7jLz3wV3#b#kn`& z;z9%X>7-M*n_S%yTF;pgqC*fSsJSk&pG|84Gi`H=(fZGQZg@8)KoujyG{rtMm3k~8 z#pM%lw+p7NMkR>DgS8kYDoPZy<;EDumTBD_ID=+4;wbflh(tA|lV}bysyR6rI!#^0 zFq7~TOfrhU1!;-eXl}B&Q2$xCGe%THdWmyP_6tar|9Ea+po$()kDRj>`e@Jg7S}pY zW4JLDegA4`fa2SQ>Rw0RXY>)5o6flC<(?*mGBY5-b@Ua7+s-01C)1jy_Z5rL3k`k6 zu9S4#=_N5g>uA>fWx1q>YEq#BS3e2yGf&`QtPQO@So4^YGWF%ZVQ}0BzvwY}4O|JB zsVo06p8JboUMCIz5%_Hg78dBgXF%e>MA8Gtf5YK8PFFY-s1@{MSsj!{ZuW$0)GfTe zrCh116lR1AU%*w3{GAwY{PK>y!8atHMMQ{{UATsJ^g-B)EPV*N5+_WF9muf?`ZS07 zdk5g?f#?mP2W=cKUZI{JDuxA_es!tshKXwgp@$0J873%HU%Xn}PpdAmqSRX4Cvlt= z&712-ib1qCSk(Mr94rHNoMXm_kx*;K;S(;mtOaXXKc)*b`;J4qQqvNo0vsx+`D4XV z0&QuHsI}w7nU+}?R_(PL@RTuL9FEeILG{d%jixeb-fH!Du~IPo0g|;8+L!K?Fth0h z#l@)dG_h1L{fU|XV`N8l-b7I{v01xGVo#Ipyxtm69e<{?t2k#Zlt!jQ%`v4P6wS)p zLV2L{M%>nLOc9UUE;NR%O6rUg{l^6>ta2wz6-5-LU_iJFuc)R*M~YXCMi)isU1fCb zoq+lGw@8GiE_ZFV?#DyrZv5sU!9(bOE*js-9DydS+Zr9J?wBg(3tH23pn^5t;~zEi z22>V}pO7Jb8if4M&JYt#JtF9VckG_x+687@=}P#>CF0r=OfIIp2j$z85;RDDrZ`Us zrYhXuEXfibWc~^_)ZAHOHzYAGOFT&H_pmkCwi1korb{8V#TaSVqevlC-~`#jbwI0~ zmva&B2DnMZS$&{fmL;N%`Z&#Y7TisS3xk7=y@BD;#r0FoQk+}TgNxkC(< z-Y%Kx*_mRblf_P*kQX-{=i80;%@p&vGP6V%G`ebvKqKmVV+JgpCB_&Y?oH4GwEm4d z2KBqF=5X#89!K0S!{At>C6dbSj{=>)SzHPou=#UDbok9;f1x|o+yOa5*laYJi&AHc zV<;^P)^#(BptTxPX~KQs+2SPAUoN_FT$qR4-{Y!d(j0NH&`CuiZ3Vh_eCJ52ti<8R zhPmQYI^IWg)6rKDD&`h(71Zle^Tb4|z6C3TM9EJvPbuDYuJZHs(0F!8%ac3J^p+v4*?YF7)l9*~Y{w82AL5 zo+A#T@`rGP^yoS8q&u&|EtrfQP*vPIGQx`5`NUU;+#%lD+G0knQYrVT_)xX-epDEP z^Ws9W*k;jN7!MmK%TRkhfkg7h^0m4};vrkGfmO>Ei$4k$9_Z1O@DvY@Q5bJK^T3zH zQSME$%f<^W_gQPzo-Zyj30Ae}K`}_M+4MA8Q`JiyT*b>l+$xudX}CAwTq-WanzwqX zDCWf@COd9$t|Ko}yx?$8_lM)f2n0&Yp{<@G4>E(I@$copyWx1iWy5hiU#i9($$pyJ zD89UKa$W)!v1!){&XQ%I@H_J>ucQ^AHNr9&TT`5G}pBV-+^>V`wY}tStn@P`gaNIcP?N%d5xE;#Ft74cqlwq({KZ8YS-j^Vn<>?9L;tg*&iVM?W zndLFjjV90r_wM4>-igqFqP8|G9eNBCb!wc;QBsWB zo96(kPJ+%>=23oWz8LF5ZN3bS`4GUFwy(;!2fI?q8H)e#=OcW)5;llyIickjhT&RTx2-7z8*7g3yv zJ=EPBu)E+IJS8rnzrTmBdHs2`ab>p242|KMr^KH0_cxub#n#7TiVHDR+{eK$ReF$d z(k3y5&acI-iL}pPc0wzMVjH z6r+m^QG(j<>|v_=CDCo7L%FEE_W0AxZ73Ggd2UZ!IoKx77CNe@wuuLWp<`Y3nmA3s zrGlD~Sog}GHJL3j2-=CV>Mfya+8dzoAn{GexJD$Es#vGvy>lRC2WXs|igt*1U|GXw zC{?xtQA7(lOg0Z9F|ic!z$qrh^0&npo22{6>^Ib==wPBZNaRig>7@I0hM5!bZ7TdS z&TLCTGE5HIQq7I_(2}jVs8SsnjPBfpSyep&JW9qckm~BkK-ANAfp$45YZoFPNHaM~ z((xv0|98aRwAY0hX}vBQi~NZQ+#ae1Y1(OGOGXVyaO*qbQrg`S*99uuW7rnHD|Q;f z0vTQ+nTYVx&dYiil&?R&#`4bug=Zgc8UYIR%l+W+OjPg| z>^upTVxrKKI#*(qOsmB$jC&OroJ`se-Yv5d6Cx!CB`EEut#b_v!(AGq&{fY^+bK~) zPv`@!ssu&AQaL>ct8JBNmVFD%93mIEn{PZW93@m?2iBMe?U)U6mGP0K6BUB^M|DSd z?zbKR@jO&ih51xI8_Va(Dsil3I0Ch&*vHYi8SjCm%BEBAiTB|8W7hjx^|1CqR+J8| zvwA<~SyGWKskQHmCxc*5Hhm(he*9zbdCA^!Rvq2mY~w!e54VM~lJOE&J8S zrDlF6_GXztLph8%RN=6)a7!5I%1@ZZ);Z3mr@ON0;^$y&vT0m3Z&ua1YOM3x{y0RP zyI*Y0hKh0ziqYZyPzolvDRBJ9E!JNxJBS%-8=$uwYzZ6^AI09G;IQ~TZ-r(Z6>rsr zA?laM#E(tFK%T}B%hZaUghBkfA61XFTGhxpGz~6Ur++7^wjoA(s`Go0XlQ(=zm2C1 z%s+^SgrVN42<>l-kXxV5<9F;|H_%xYu4fk)La&2j}~W#V~_ zmuOAGNtmh0IRnx#j8lr&o)z%28L8p0E4QdSrdi5a@c^1H{AUoe;WX}NtWnxU_FJj? zXDqBa5LAg1Y$J@y5-J-_Gk-y8uBL_t5GqH#ct#jWXktl#T+<)-~_a+XK4u3h%w1O|VAs`p4^GA{=vcobGs}8|}RsG@&UCY+ZRj{n$<5%x0iB9V3Iy zc!#UvcMLSxIDQZWMeYrEamGFiaQ=J@a#?{(?#7Sn`^+s{DhN9YVFsdnCzzbvs zNy}|F7+AF-NSY>uv!X7iGtD+tGD@1~I`ITx}JLy`Bwl(Kd9b-W2 z7cNV=9PTj5stbEkX9i=6#9;YL3zOU!5xHT~NNxTGQP}_(Ua1a~c8BxO(>7p8u!*7E z7LE*iP*DWh2p^XeTH=zx;;8sJfjN}ANaKIh5%xx-JyOEBjp5BwUv3wc&8(Q2kwl(n!=CA zDev>HE^e3(q7^Km9s`h4%5FO{{|T#p>CK6_d%Fyqf|M&dx~aBr4D2N)Lo9Uk3kY0G zJveG992;(q<$5tM!h8tlmg!q)V&mS>sJS?^0aGf? zX)fs`;ZlkdmQQLY@;grLF@BS(!p*i`NR9`0dn)@CN4S+|1#=r?D?Tfd{;7!RNclss z;%7u-3uQim&7xx)=49qQ3c9BQ?5UQ5_kuBtT1)7Eg23T<=s2Gy?!rzA-; zwJD7K%bXxs2uYGEF>&!ACU`TkB-WY`di~{@G;dT@7uehO?nAJ!FFg ze0o}y#j4i#k~Z)u#p>SD4CZC9JK1Ev)rihShN^0Vz|Z%Uj$$=sCX+^;0^P0bC#C3R z5{BcLp>`q$bjDZ=Lv2*&j0P7p`1x>aasGm^;`%sq$xe`B@9JHoy>E6L;+yjRQhzOx zwy;YZZDAsbmj{<3kHWT*F_bm{^k6=0Nk}76G_)+H+CV7;hGpS3h$?Tu3@#ifb%HLD z7O8e1o*;OU8U{*HMXv+`qEW?HP%*E}^oq4=-oeUymz&y5c^h#?h0`XhM#are> z^4%Hxx7P+qYdbe`DhO8G6W>h6)!*dQRn z$4IXVTAlGc@;%W|>x*MsS7W7o#^$C;n*~c;1PV$G77Ika6D0|Z98I1mbpeGfm?*vE zWy|ookOcD|M*maRwbGaJ7&?4HCkLJbESS(KJ}Mkjm3f}7a7;a|fcxVM0q10_HIpfQGSSfKTCqv2XZ2RCmb|Z+isZ+*wxI z<`JTWF=U@AT}vTTCF}J@kz){qN1M?U4#40_8{wbudIi%#1Ah!KGXe&@7cdK44fq|Z znktFrjqoPN?U7-c4PNyR|KiP|ikzs>a1q{IJRT@U{J&|y^-^A+u{$nZf^Vbuo^zKj z%>nFN$qn%Hg&(G~*Gtji3*hbBxu4@5NtkynHigEH$IrGtsipwt%()P;Bn(5pW!@lJ z`^3ZFH|2A@-DmZ&3aFp-VvUc7SO*P;OQlmK{K033OeKFO4n0T+JsPxiwA_;J8ok6~~|nR~*o4GHJ5o68xD z?PW@qWKO8Xo4Xv4M-6|k_K8pd9L!4(M+A2;M6IQFw=uUHp$FjJSbl=mWT7-Ex*xar z%Rl&+>;b?`ALqg`_i{HDEuNQb;-VGRO$iN6y%|9mbq`Sdy%%4`df*toPxrqcUtST| zzb%|mvF&)jNeYdec--5s#v;Id_vQDOE|q*_4vSriAI7M^PLIn0=CVK4{n5ddH%9m7 zT3iEf-~NpN%*``J55r^N9G)!ZB)O=J8Z~(|uETN;b;Lo^g;W#|E_^q%o=9^w>02~gOJ~5`kwZovw8t+sjptqt(^Jh z9)!t{n2otEZXrw;gz=4&!Eq>gN^of2JUuG6ZEr;7;r0M3!rwgoo3DQh^zVcEcL~0} zeeu>Y|Gp^=fF}mP!;f9M#ji7y5Wu$uqXQxc0r3Bh`e%3+FgN2YIR4Is<0j^wyMmlI zW8WEeb-Sfh-Zcs*1v9OVWF~Phl2IZdf^q)_M8hy2U?CDlC$Rg7*sTU+y19Q4-Rmndh!j~m#x@4iHK zoE86F0X&!RHaPy~z!|mp<|}V{A@JixgYl{Qce(yut$**rj`o%TWaX%xl+e2 z_f>mq;oI}sx?fv8JU3!eHQlz*)sa#L+pUpYRZj2$JpeDV^`BwFC7o^)mbXy%<+*hu zd;=TtF*IT}aMR%)h2zn_6r(u>-}7+Bpl3X_GT>RII1Ev2Iu1n|iWk`uBM~d2aDoxM-xd zl2fd_bZHUXF1QPDPruhRP}johq;L1G0PH(-S1@|zdPaQTfCcenBzXHhvV@Pt;aR;;NqC{uzK-r+CbX^Ldr zW;qHMZ~Oc7&H~9JyhU{jq(Qb1;WYqmnJVWa@+;6B!tX&K)94ao$r*` zhGF`h(ja)2-6@6YA5D181xSJ8Kc3YO(VjacHu)ERm-M}M zOsQ$X(BZoqQuZ8z1v2n^5GGT7Tc|PA-YumFH&MbpICI-EP{Qfre!JPi$|N^YQKdCr zSgzt!q_xR%6DC{#;;KH;chb%eu`InyUI-DRR=*iIkUzUn zN;Fy6V0Kp^+nAH_<*gdCIfX6Yc+@kls0AF;M#eqniz9i7l&u;0Or(OXk*?y*AE9Bi zL~`hU>7{trwHC0w*eBXTy0}Dg<*kJmk0#&JCF{AYYXQey%q1vk0cX^TTEH=<#_`ts z1yeB`?J6^ccS5_Y>l+v{+ypz!K2bp`}4kD>b^&%M}+Xr@cWmP z^NXZX`xf6goU*Ir0S`>7eu^nwxQZ+Jm~=Ayg?~>ar&!9dzxW@isP47U*b0B?-;+sO zhr(=amJF4@YIl@$hAq*g5=horNP~BO_M$3#~(;?N6E zf>`5q$S0-K_8stT9FCOmuoRta*xhBS&7<-y1nGn?FH;P^9RTlC!#Cpe!?Y`sKKmZp z4mXB4o`NoybgxF)6Da*k99UIulDY}+(AiB=SJS(Cz<+A&!IYBTem&Kfn_w#Uw)SD< zUIx9Nq&_%dD<5kLDXz~3!S4>;Fn1XaO)EKPO3lW+Nb3vFQDst+rAqTGtBZB1Ys;`I zSl-h-(giT_XP%ZK^WF#CSVf&~cGc_hK?^uZ$9>oWj(IC?gO6IkVYFztkNt5SH7aCG z@!h^i%H58;aPD{* zW3MmHn@8;{@op+ygC`%Kk<6X<`34Ax{FyJVrO2QA1_+2;?Thn9u6`bK5m)0kOM^Ps z_@V=%e&LI27IoHsU$h>T6(zVc4zz$Xlm@7a( z9}EnJs76yC^2If_RtzN#$N6OaR=as~$`dtyS@r9dku?R}{nci@B%!1vVAg%5BN2u=4K1^R3sLK4rn z&|nrnD9q(mX95U?ZaLU%kzB8Q$w%lsP1Uw5o`oOskw)!ieI#uf!7to#*CoKsf#XuK zQqkSIANR(0sHZ_L7U?6+Snt0F4o{Y|E#Tv<@H4~y1AI6YFD0%DPjFG~Q5;4Wek|d1 z|6^%A%2e|N%<$%Pfzp5JZmBT#1fnoKMOn0A_@fUD71BKrh-B`OB0VR4{CT*Z3V?r# zq#Hkx2GRip?r=H)c?M_jd!#EpX9N6y4uF5r5}DYcKES^rlHU6S@qZ2Q|1ALiT`xq& zrzpg^0OTK$^w6hBg0jc_{$d zitPKOp(Y`UZrLMsp>Cf_Nwj63GzV9HFeOgz!BaGYKa;xgq3$i8Ndx(N;}?>La_(yv z^4M)Sls}7?xoSU?UNh-;x03hah3oSBpl?xGBW=*b_tlUl%3TUAgCv3-y7~l+g~~6$ zx$!Lu+!uTc?{#e1FYVB7RbaaU_N=TgUjqFQTG06ir2G~U?l1oZQTcC(%&%IGQF2f^ zq?M&LrO$#E!})_!y)SG%EEVdt=|O{o6>GC9jl~N-B}b&!y0gAJi#d2g@dW7)$F;?=7pS?g);_(5!zPk>dCp@wGHisG{_*z1}x}E%lAy6q#`Qr%2lkTv&75 zKS)N4$69g$@x~w3alC2=;GQyYtRv`;Q-3}xy#;jvO)-^rehbE>7hRl%SNv+BJh7PU zwbC=dR@8#RF+CDU7;B2=duMc}R!Y+p5=ErSj>Q4oF3=jS!=4yBya(#Y#z zYWNMe2t$rb*6!9QZ)VydhF$=sXg2sWMH>poox^^3%i}n9ZEb-{0my&s9TEWB1K@T6 zaQgt*5db>_;12$9UaL@lk5*v;aCiV55dgaa;K%?tDgf^22j^i2?dJh)%K$hw0FDcQ z;{#xK0Gtp2dwgM@9-^-YU@1zy=D2i=g(jVrVra)H(5FSGC5d+PudV#+5dS*LzfLw{ z&-1UrXW(c33BTs?uSou-#puMp#vYeK)c!w#N66!@UKfyWNdQa%@cIDw@c{UV0QkuO zctaDc?mr`?2ifPL6a(ORg5U|L2I(H#7YM}QG)n(fa@qF#g9jSHBF28%2x@`9@&^w# zf?D81ji46zus?XD5!3>I-3V%dkNShh8bK}aH;tec_*;Llwh`0<*END#;P3pw?;Ala z@bN}a3;csWc%l)k`Ca-{{?P!Ln&FSh54SMy@(o@G`gP~9iv)92_Xk@0B%(|L`fAvj zke)G}ic*8m<9@K^a3nmbZoMO#I$e;?LjaZVKj~Uq4^e+iY z{Mrqu(30sgNZ{YnUa*pHUX*Yd&wDe)JXlypChu-)qE}*IK^Q``e{${c+_h1RHCIRhEn(qpWf!UN3yX zDrY0DhGkHrPgw_zsd}@FS9@%7Zv;deb=6s1D!0iYrk|tuW|s$kbvF5+Hv|+7+n~r= z=tLUcR(9~3IJvESb)er@ZRHZvFHxF_hc?D80bxH2!DX?uzeTW`Bjm^cOkZy*xIcR% z8r5x=Gwr-G8zOphOP*x=RY$C$eJ(DJnj4A4kPJFYRCh*U(Aj@O7=!PBh|;6wYc+XtXUh6t z980rzMQdd{6^+7kW7??dXMWHy#@p*L@62|zoV?z4&WNj?i<1}Vt?fee#cp{)!XE|} z6QB7F-rTT+YB(Iz(v_+`LB7MdQJVTWHiC{(GDI!>UQ?wZC@Pr{8Ddifo(f&IHHD8WW`aW{E?kk-5~kB|mc z%lcQ5+q@)sumxr6dgJUXkF+cUu?(gf0;$O9D{s*bJh%&(A!Qjd7bK1ORnfshN<-V=YWL$vc}H4wh?CP};$fucq^d$(W8t)@aw{86 zP@yB7KR^!i>jz$mxcc6H5GDzb0}hZ+>Rp)y`zKU6P+o+V95P6LL^w}n`B-0S2g#B) zwPi%*mgFS(WQdc)U8Z{6sZSa#j}o5shA$i}r`iA3M}v0Bn(Cfti&q0L31-zX1mg-V zU38^3(a;TJ0A0Ki1pKg?HB=52w2RG5SQ98W7LRA0$%Bsjh7>srQ?MdMzC-I^llRTW z6g%E8!ev^C@>4PG57X86o#7lS}O zJ5rvccc?*Hrh=5s9VJKG_$m{3UN2fbN*)uw1wXl=d5RhvBXA;p9ib(o<=z%XM;MYI z+(S5wt#j=x*f7Z)EyHS$K)Kh*n~|-yAc0%3QtvTxwEzPs!!T;J>xJ&I@=Sg0E;^0t zGaJUrhipNOr6}74a#J`?o*Kn@@t&1e4&KAEt}x?D z#SD2YFQMPekRxnPz5K8cGy{u?F3TL8i4l!eH&cFF=)+PE9)~<$jEj$r<0rx^5n((R zXP6$&Ye;}HZ$dh#!cFq~0?coGjNx5=7Lwq!Y^))n$T}6_tyC9|o0v((G3F>fA?F2z z)0qs{1CHf0IaHRdHK}tZScOKmot~Phkq1mUmo|EF0pc{C7n>!|vxgZq<0hfH?vdfN zW|sUQsIv2Bd5rT}OfN36QL`MHf3rLc*JmqkmP2jfdgMK{?`ApC!ms|eriSlu8O$+T z4uPB`b~YF^eXdWPjdA1^8dK?PdA&Zvt2)9UL)sh+dR)UFCX19bF3gNe_yu#&uaWfT z9C?B*O3z1AE4;!4Yi?Jb4T_+Qx$;cmcB-0-MFAQ$bLHaE8=*`2JlqY?*Q`AYZ5g;o zC_HzAn+P`#ZXMkFaP@G#p(maLcLDAo^xuEMn`9%PNi-69X=9o9owryRFp!w^lm zw<4n$D&mi~ae4ebf<BbvEQMQ?0(9BaaC}R>Ga~kCteJ#0^3VE*7~bCSZ+z(~1+vyX5?YI3taKc@}T@ zQ{7#dBw*CuV={0KE6Uhc!4;Iw#UWMsY1kdfJQrbA)9#kn2jT9Ba~3AMTaE#>OmT#$ z?)$O2=r?7OSHOf&$|7`6G>u+_is#VWMQ9l})jWrB%C~LN&sB@$Vx*Jstt^)8wWFlJ zfa;guBjcRnNxWNKe;%XR{XIxt_3KzDONZdTXW_?qjDF{0EP*hVuvqSAOVG={Ms+>_ z?o#kjRvx}0Rpf#8N>uQG60gSO%Y|IxntM^=$|dr748@xJAdRh^8Eh3~N_ZCwmSVJm zDlEfnH3nVMLvn9hqLB+BmuSlWmba@9$vbVG8WHIa%Oh=_8^N-NF}{rTH&{@L~0NQC?sh)HpgYibT9C1vVxr0!&|K zD8_fjOL9GB=3#S|xfN@Dc^;N|&VLQ`aj@;}L3&cL+t4vrQtmbo$-(saHW0j_RI^R) zYD;NMA2AZC+skOrR9f~jCISo!yo^mPAMe?ytd9+{i&tc;cHGBYb__La)podxUy-9* zRNERx+g?GZ!*a>J3YPd+jjsXQwYFQl9W!gBe|WUrRNJUVzw}qJ!F-5z zy(&)#*OazUC$5*Vif_bI?sBnKU9>Kx5hEe^RT!~DJUI$k*T0Q$Z8q{`;o+efy zRc3o?8&#Qw^EIlxS!)=cVw|)gj?r7Bbcehfm&P;(if_A9;hW%gc*^5)DXbt-{hL_Z zu={uugBj1>zJ<)zQ0iM6q(8FD&+~?_iS%yUMk5bioi&(}^Ua}+1YFvw>8#5*eSc5V^Lu~6z8GF z#cf9o|HCD2CehmSz=l-8VA|I}gohn*B_`~mo$}Zy=31BwV9uAP$GFA@tlKGXN*Hf| z0c*|#!=J#I&$gvCg3foayrt8gcQEEBYLvPAwFWXEjY;t5naEkUQ2b=Bj!}Fr+I9bu z&Sb-%UVm2}1W820yE4pr^q>!`WHDiifelD)s^L$z_b?;1Rg>i!>)ykty`B!gCoizv zfH0|4^L(37HS>Kr$z+?RM_R)R2{@R!c(}6sLu{Qj^+lA?V9vPQUgqrBhhUPt6F2=M zIa-xI0$tTTs*d5-YtF|y^9!le%UGSZevJKbFY3M3jkj_lUT7h0m@O2% z4gU~e{u>F$jPneHVY2G0CpcKgWwwAz)^S-a;FuxjG;i|auJlXP(BI2$AtFy;jyTg7 z=T*2nx>vq8Zilk_+@w}4|w1*bQ=1suFI+?*D0h9=5fe;n=KCl}dofoEfD zQtoGH;9LE}`IT#43pk^J=C^<|+UK?wa7Ozq@W)YTi8Gus?}8?S`*S%XFUKFP702kW z+!k;~ac*w`XB6j-7H~#!?)1lbi{q#U4{?`Q2moWLm`l~*Id#q?r4+U`GCv2ySj)am zOIHYmynz+gT_f*B*t0eAl!UvHxME?OA@|FCOEl&@1V%+h9DR_AM|VI}btJzmm=!lCy0O8fBoY!(iE$ zP}yPZ4wvG+68T3gSsDWz_O+a8Th^F|=C}T9`B^mbkfU;?!0j%sHB zj~|sML_LfkeEt-qPm$$~sR_sAM{Fw^L9FfZR9gZ296OH5Nw$>+LTxw(!8uBe{lg&J zBZjwDKouPNA|YxOJbm+6?HdRzP@fJkBsc~QQ3o;0*g7yoym`W$XC^wy2GUw5YkDD& zrH%IvD~Kq=Vb!2=p&26EKJj5CgCVv}`VO74hK76xwq*@X|Bj{I>K=Sp-wDERya8?o zLsUBhTDy)yn9$7pK~4jz;s;r5lZwgTM)AB(US$uLv9*Ep6XEhdV$XQ5|c-2XuiYIYiRDKrXHkdp3S-#fxSYuqx zx?cUy8XHyd3&x-}$smoamqVNyH-WZfZb_S4x)`S(M?|oRSg)~@b*FKcv$9^BpL^;d ze?T646-`^B0c=?>+SUO6tA|?Gz`F<*-PzP_zsV%niuF?HhCa&2C%B8#o_A=vVVt#{ z>V8Jcr${FA=E`%jAgraTKd`Q2h5i%Ltix1bQKG4|7FOrn=aIiIa2R|Z+pQk7;=KH> zg?X>mRJ6Q(V#yk4`{ZAc=Kyu;0`?)%bl?Bb+APtv6<19I`@1a`<|6+mFE?Vni4MyD z3o)7q5B4Q#Fg)e>Th7o$0h(Z?H7rA7W4hsQ$hUgXvA^Yafz?D)Xa145Q0?O|?=t5f zZ98Z9p5YLYa;SRd681nS%`!n5<6MU(VTQ#OjDZ20 z^2*0NH_O^8E*lx%RMl4boD&UEuC=Xi?7y=iO0n=b71)(&-X5kpyArMMmkS0(G~;}e z+9{)G)IkUembO#YHWO^IAXej@)a3R`qM#Z5u#sl?tk$W7(Y$aaQZ02TcWQ=4Iww zfk$B2-HcJvFaVNc6_-|@j#RWBlQ=V0F>9Q&amO`Ov2%u zZfC4A%Kjvp%izH=VB(Ze%LaHkC}AO+T8mR+Kou&M$Af6aDdx@_jn?(q(Q+3(1%DPW z8bU@;l00mM%HtGAvk42m3}n+ea31?^k_}NZZ-Q5oJs#EM8wG8t;(fd&n`yy*xbQYj3->T@uSbDp>0{Yg>ORU6X43j9@lhHr(aXU*bZyvj*(h~6)Ce>C zD(eySLSH3Y=%r5Yhj!L3ZP=(lvAT-OzqZo60a{C}7@$0AE7x0{joTwD$TSC{OSX`( z52A=2PS_nQ9jHj~|8O8^yuO&GZ3Iugb&%rLmk{;%AO**HUaY1v6fy+s2`J_0z6WB<)0( zMIJD#`d|m}KvyX-&h02WQvgGx7frjaQXcV%W~EgtVyx=CVahyB@T;e0rN|>Vn9ctQ zXW=0uv>DZOmY?)CETCtOKnq3F;t|RwBo}+N@*Bpzb0iuFbsVj9)hA}cT5vh}BT;s} zTA9}-AXhv7X&*y1_aCg)AT zP|yjE+E}X#Qnukj|;odW-|a~cNcTVB#oIDuKr45iS{1b{DvyWuQUFdZ6eA7m)^ zVvG%$js;H}o5*Gg$YS}8%5I$(E#fC$3uj<1_n_BjC`)vfETIIufV52HgVlEn-YF@} zRQ6h$)$MJ+x>fv%+Yj@~VL~zGs#sjqy;(V=vBy|n_#Sb}xJdH=UowRSy@^cW_vJ}w z!)%PyHIzI@naz^$ISR|HAfJXF#~h7t+2$%EwN~I`7Ea4fRkJ|VbLKWK0!5jC3+IAD zWl+UjB{72Kna#N}7)DT_#iu%NQ5Kqz%j$W`Agx=%scHgJsGWx)q)Ey4Yg!)K`c6eR zLl2>LzT&p+Y^0uGc85~ocF6t4-li<)DZ+Y{XKqt+Y`YrA*{lW11lv1}AP&kP?p>gq z)Vi!I6^z5>=-M2OG~j;BLTwL->OrtA?Bd?soq!4VoCS*^ui&*2FvD1$s|=^Lf5qV? z5*NhN^_ig9?%TodduO3$>h)c9*X?LaTP1R4-FPe2xa2|VoI62~EmiQup_>aL$m4f| z%3#qzTdQ7c%wVrOpxrfdrkM+s5Pi_(E>wDIk1A=iy0{1&$j*gW_P0=OyVjwNmQs0+ z^VTjzy|57b72!P|)i|9q$ANR)fK$WFUNF3xb1N3hoW)>Z-lxL+JH%6D zfx<`4;|i2`C!fp518s1igK2RAwj|6*;7Gj-t{0XUpdcAk@SyTOKDZj{qKqZVSp0rr ziSmec8aE9Ih`1Pr&}mCCAhESyrr?2}rI=f20)7sF+(%Hy%Be5|=EYJ{0eHx?T$}E( znYZRoJfz&OEqZ2hR$)k$9|omJdRQq$A5=Z8v=&SsQ;^Tp1p_ zg3X&8zI16CTq{^X>4pLcaQt^CrLRy#+irc3L7#91R;@ks!V2Y4)5Z%lz7h}dET#07 z%C)g45H}r0Sb~nif*IT`F#EzIoEtBis#YqYQOnNz+dnA!(+jtQu|?hs^vfZ2|bCUyq55=>=NoT0_#8CFXwj@a8#!YAfXp)(ac zqD%>2frED*TAU>R<()>Zl>A3RXvr!iGU{&K)|QcD{VCnf7S%lJ2<`qnK&Ho^7!!?| zBfv~4cz-k(j;qKFUB}|G3|IJ4Jpm)ZS%4u`*%TZKyXh6Hl<0&%VIGT_J|o0wz=+-m zAE2|Vl%ai&pYR4VP+a>o-Oq^H1+Z`BU_^g4_E(?7HWie32YEt;=couieNy1#8*n?+ z7<}RBfVoV*nVIPrqS}6h)`K?t=;CU0eodsiGe zY$kJY`EVG;{vt9&*r!H4p|s~S1S|*8HAoJN!R}0BlK2)P&hQm8M)`A3Dmc7UFFvX4 z2UDlkJf+|&)@Q1-O!+oQ_*`vx7L0&UP56eYqn=kHgAh3D1+2t$=j|p(aqU|;QGE%s zp*Iy>1JdRYETCJ3uDzsV@wF%6%E^FxaVAu;1-L*S(@7(wV*{FqNM}qM2gH5%8iS*-`QX z+kY=^Z5He>H4VP?*{yO!-WXV`UsZZy z@a=k4$#Whj583c;h18ybUvvBXw#XTtT7D_&btz*h3N|^n7q`>nmhxhs9d<=q|(zTv6N)i+2 zQ2u$WdF5|Il6PV{A;1kV308s+o;9(rfP$9qQlv zlr78$35o~rv{fs^nH{)T!;5S$b;N#17laLzbpRY{0acvCl2!OJ`0w%q;CRM*J<7L3 zyEE-evLh^BKU z)Pt)97&|Y25oF?M*D$^=nEFcs?8~S{XOui9yUw4nZSyj`YVFU;Zd2@!NZ6QIylC;1 z;FjS5vq=500VGH(5`=~yz|isUzbcW=lZeB^j|-v2X*P8lzJ<3K`y1{Q=EOg69WbLL zxD2>OaF4(}1NR!-$8a{pbHVk3yAmz~ZVsiI5_zySJ_4)en-W*~9~UKA5;M_EMV3TX zD=3h`JRh|r9>55w2u?g5B>bdt$t8C{#}E3_R<*iKBBU4D>X48`RlxH~c&gwJ!K_VR z0peb#YrO6lq=Kt!+8I8orm!YHhDuzPY`m`@NI3kc;t?mW09aJN@4=xjiLQce41Gop4-^?|O&35WNXB`(ye3AIq6`dHXF;>3q< zC0fy9X^!cXw&(~wjaRY$RryoG%JH7Y&8V6^dElNI7hx&(mOB!X90#SMmyz30++lJk z-5GQ|BcJp#^cO^&MSvX|jdzMuvKW6~59Yk^`6Gj(`X8Ni(UB(HS`T zeT-Q=B1{R;m5<_li4R6%JH>OSDOO1Dui6L<->bZ6h+7u+H@XA4qCaw6h2il6`9x!Q z1{m3{AAUsp%AVHHBMSx?KF`;vg923Y37+ljcvj{QFfwG~NbItIF@&8v+Xfg(BX)r= zsP=Y;L%pltP^jNOQ%T26fDFxFyO=|g2V=D_`G|Z9yOw<}vzIU|D2m5Wst%BXg9jQu z$9@?*5M?v z6LzK*7T-)5o0@4ln}#h_nf0&&T}=a3SSKqip_wo?6%$QtCXB-y!`v}pli(MEyM$q_ zKX%)>X3>}FlQd0XiRKRm_HVtT?Mnpaiwj#(jbbt-DHrnauUdCFJDbE zo=_~$ahJTIGpd?w1XEa^Cf=Y05@UjkYX|Bl8v$1UCBGE2Mpq!j;U*VODMA)+VSk|d zsU9Xh#zjdQKnwKI(gjuiQ1rcn-_yLOgw zl{dqV114xCJubx|fSI$=Hf?0dY{i+=FEWhuHo)QsQnCnH#nwUF$mWaG@DaM$csEXp ze(r#al95th;G6}QD?iUciZiZi8|&X?u953k#5O@63-2zm-Ud=4N2S8qVLn+k*9f{Y zLD(D#{RCSxFG@AJ%92bo%t9ptr{FyYj+!|6oBZ&we1+&Z2hw#ZhG2F|<8 z2z#>ZT9J~=jHzh)-Ip2HxG3CPNue(bi%!;IMl)lc;Z}CgHZp&nk==!vb0Hx!x5fH$ zyz|G}Q%e@4YMzl%7)@s^D)*LBoOA>cWYlby5l#Z_RvTur~)8Fi|4ym69urVP*(k6l=dlLzb z#KwYOXE>lK9%BP_%a98;Iy=O5&yY9fB;cF=AB_({<@9TeT-7_-uuN~HINrp}eakh* zLho_F{IODwOK6cX)cb?-&|W{#D=1^GGt$ay<|a#7jo;~_4ZVjfyEYMbwJkC-Pfa6x z!z>sD4%~q6^_kZiX)UCPj&!ZDxS81EzRt*LA<}S14_SMi(Fg5Zzb-LQeegPHo37iT zA+{37*R3*8y(DL&_4OSn2uT_`E#!2$6>?v zn}ID%MuvYNf}-uMb@CNbb71PT#K`EEim3_{qIj|+#@j*8<3%&Im>=msO`xfU2~ z-EB}FjX{nn)k|)GX!G<0LvhTj!a5T8DRxuJ15~8Wk#8|7tn2C zv|7F@!`yD0q%1RL*)p^onAnFCjv6n0<)wR^8*Vgw{yfCC#}3W&3)ZyH@aLc6J@!V- z^kDnD(a0??E5Ov>h5OWAyvgV;zIOs{|11zpaXuN2V+}r=+++m(G$oR`N5knJJn$yS zW!rlgyj2YV4RW+WiZI-e!u$vp#KdFrTPg!@hW_uB+RqXKQG^zqty(>!>4l*ZNI zrLh*=Y7F!A10gJZqU^pE#sh2$y$#j)o~*si=!VDc+mO5Full(#C>^`a7~F_7cDd2b z^&awVBYSRxz7@o>OruZAX-Jdx)IX|_^*969xXn+|$i?IA8f?y>%ZV(B;pC*v7{V^uZyN$oemfOimL(o3HiSid?o(Bn0>7JiID?ztAu9&hbJFpR$` zQokWHpgNOJswTz-Wbqv!Rb>4g23Oy*g=EXM_%d?f9(*V%xC%!z)YQeh@qIjhr7{w}xQRep~soMnefp3*DN~zrxM`1Vz9Q)Bsd;x;m zT`J2~Vd}0(mWlx>f%2kK2-(lkH%evCD)7mWsA^j+jysKB>1S9qIy5RsX)&_)(yfOcaGuzZ#=d_tnOW*bs;J zVO?rYHvL?8AK+*~yoll0eU%*WPsJ;%i@lY@C~nyPI}SddllM;&NuZu}l=cwv>e(e;sHpl^*Lb;VqTX>x@}6-f3v>I?Q6vM#34m z^Dh}{_j;qR(%zfMZzRc#nIttc@}-vRtJXu7FvkbQUzURH1E*)WWdC~O(fl#d#G;wd zm`X%5J|!Ppc5F0`gv5Zl@CSE!!2&ENm;`Q~DJ5Sd25`J6gJfDJJ~{ftaC*nZ#=8UM z+9}XNaJZis-ztiR$bxS>2HKN2YLcX#H9tN>o)@DNFhh46Lz@|@7TgWfXKW?DCizJb zY^A*iG5|5}Q8hW_9*ny6a?w4g-g^1@UQT3WGs4sigqd=nVFzXlvA{)52tRa>5mctw zAqXOUli?`hb=@*0RT9j$?==Eye%=$IjVw@%ER{EBJB{Ag-V3@KsB~M}w&+gchr1no3HDNNEA0*Pxe^R(951>h&mLU%qmv|>zOu$@j#pTS#c<;GUwehrg zw;EHsOo7*QVBG7_6?R^9EclUE&XwXp@i1g=HJ)*#oDT%5C3rN{#j(E2j!GY7^MRDo2y^$~L=vFxX&H&7)7g%^?a~*v;qA$JB z@@5oOSc~kt05jT*7Q!#K!b@5R&$q&7wh#_)rr*BRtXKr>O~B{v%*rI*Fliq$OSC^pNy z7Qzdx@cAu-+s$%$3*qqA&2mL7f^HV)4kKAL1m{l7j6XI6nhI@%7AxL?7F(d2Map&< zPLBr_%?{W_mi)0}P(@x3umFxfM!vEUy)7$ogXMo!hIH6#^i*-Exfa0j$2bca2dfyK zFp|>00L)ss+9JA<$4hn^!SntYTNbM_&$Xgm(?U3x(lFUYErc5~A6>{}tC1P93Ltjg zD+bQlW!2Q3NTC3ZKN5buCVbj1V?Y)Q%Z@t?E?VcI+So;^b}4zjf0r6G9gi7?yt578 zf9wp;ldq6ri4BfLA|&^Q7RW8M!k4xX&bV}CvEjNv2Oh)c9*o_O8GV!#-;Bk4Xlm#z zl_>Qx+59-Dg-NW^n4lVLHIgcT$v$#|b@wbY|}`uyAaK4LB;qZ(oCdQsDfHo5ke$sF&CS@*c#Jj9i zY_*_NN}j~`2Nr5Jf}?r3R8~D{bW4vOd>PEi7E>yh+9wsmeD$Q!OC`Y20yzGNv5pLr zt13)n;4V}|!4AWxP|Fcq0LLFuHz-sUv>ado9DfWF&2~yodan-2&c)G z@gHm<9NsGYq2|M7WQxx(3!hQ?LgDl1br0(%uYAVfWc#USEZyNEq*DOLAFCLP&oF{) z__L9us+H1&-rKEgnyLA#EtE%EM!D2Nd9+y+Rjq%tPge54hBcMIXRD)oHx z;T@EcPXb-=3CZ!kcl-MmiFIjZpk`Z*<^i+!(Ubeg&nPJuQ=+&>pQVsOUNPj*YOZ93C;kHt> zw}tRREBf|e0U=(y%UR|S!wnji5;V^wIci7g1GEA-{ut$5 zA_e8(BS6agtFc_MT`ubo7J|PTNs7@r0ZN?{r0Usj78AZ>wD2i?m_9?7l;LL z{IS?aEPR%i6C!d{e>lv7UWCZQIe#x2m*7$RA}lg>;&@5hTwX$3SX0}NSlc*54-+M# zzXTQk=<`up$OQQrov}f*4w0-Ej9{Uy@iR|W%%`z*TNTIQf#ILUhD+#WV~}duu#By- z6#CQTmYQfKizO+5uUWPf7weg^ojL6QAHFw|`=kO~=PO~EDOC7276(iYy z%p#+)**WYi{VJ9^i+Wo?f89d3Eug8g&$6E-8w{G_OSOned6JIrwRY4$m+a zs{K!sJ?I$??GH)-Hhj29MpU-%kIfe#=`|xyHOh^^DS+dT+5M!mQ-YxMHKPEmSM?f7 zb&}l}Ur~1AJe(u18Tyn|T6!4iXDbsjJFapn;+F5%A(v-L`s>DJ>AxVD7IcaRDi9$! zno;)3=GTn}kVD}KSN`;0q!{0d~-)@5HUMf(g3Lj&1FJg5zk1y{?8{l*{_|0V7+CA@1`Lo6sd@ut+$%4=VT@PR zG83qrd9&LxN~xG{8dxe=l!nFI%dt;$$8+&MZ7yH(CRT{XfimK)m+4EH^qWX}+sj6h z7o~|RZ{3?lw;oR5a;g(;Q=_8C61rl-CQ0!h(gNiLSKzRX15l3=Y)Y3MFlMDB0-F>z z&7`Cj4OR3B){~c2r#d&>)Crs4YmM$H?v}7e=6evtIhNi1Y$-xTmt?h$4VU+7jr&vD zG@Ih8w~V1?5`tK$=t7cArsjdpcyE?&pgkX8z^=>)16CC<#R;MKI zYzu+15=S!lv3MitY3vv{cD}>yUjmBQ71?bH;X2EtqX~m#)HgU`d*1*o_tYrw*9t{sFlekj?+VkfY4}5_;Ddq%JCk@W^`C7@3}o^0Nu} zAsBzEnc4Se%93|6bf(D8cVSqGja(}D4ur3Q7pEqv#X~Sf9aI*x(Fd_4hhHpMdKwPn zC3GPeZPN!1AI?awdJoe4z(M1HtgMYs@^8Xk3?g=eW9G{wWZ=Z!?|wCX__9vqr6y3= zq&CVwer^i80J9s};YaWZl)c}E`DK+XV#DhIvt4cY9P5)Q2W)Ct-|8bd32od`@NkZ^eBbE<%1gUC6Bu#Wzvb{hjjp{f$3e{O<4lOZV!+Ym zJAS-r_(jL%aH=!al@0&aQu1${mwDuQEQUDHD<>15(e=;-XLv7&qqH;gWQ7;i+jYlfxV1ivv{Nv%}!@L{740VOb=<4_ZpZkc^;gKa-tWwcH@qe zq%0=c9gfdlG0$|VU60ROpPv~>Du2i9EVKWJosXNYPjjn9my9t6?hH7}9sUAvz2Rul zNRyI7Mj$H^W%q~1pne%G#A_%BNVx%NG%Z|@BSz4h85Pwn#Yc>Q`bbMF8>^!e9A&4jjwOhp zgvSuxe;${Wsg||yqV$0*3fY8e0F|7MfD7>C&n_y%n~(sqMAZ=LEL4YuVccj36(!pu zYOn06GXimGnX>C`FGjRFBgvD~B+SKpu~h6V$VFaZfL$tMK_njej!CU2ryH9P##Chd>r4&wWL^z}Ib(7?yAv~R| ze4$hxrFcGy)c~teXEysNe{I)oEo*^-V%L6w*}7_s=2;KX8`>jP3O}*t_NO;ece`Db z%?SMe`T&?~(~nH4P?DJxD+5N^6`ypraj+}W2##Qca40^^y zfLGH9fZ1dV@g#n){}F$-g`XFLFWWvhG8I4EBg;NjW5J=%jSMB|#v;zCg3kYi^}S@A zJ%$vcU!lX#|H8=rA7@KG)eT##H6_+7`>3J=+wt{ElhD8Z59zT^aD=FeSzYljV|=`$ zzPkP^U(3u(C2Y zL*q0wUPDD1D%Q|B8k(S?i5i-up~)ILS3^@Ybe@LJ*U(fAP1DeH4PBt23pF%DLnRuT zsi9dKnysOWG<30oQZ8wx;^%0@xf=0O4PB<8c^aCpq02RNg@*8j7;T9a0IJHa)X-HL zTBxC`HS|XfU8A8z8oE|P*k{XBuGi3F4K2~o4H{aip)w6E)6k6?x=BMfYv>jY-KwG6 zG_+hpD>Mh*uAw`0*h&qp(qVTJ!Ys9KILEUZHANA;SKjLz&c!xiMdn%^?Jf-6X}Qp(D{Ql4#|z*-lLA zhKDm8_cdbJUF`m*7+Z9T6*|Q~Y3KnBZPn0&8hS`W4{Hc(uGnPTHS~yv9@Wqe4eiv> zE)6}Vs#iAl3unsK?qQ$fapmuQ!lFm7?X1{}b-my93x{RPFY!)%Gg1Yu)=500AlZ0Y z7}twoHKI~_@32b#m*{d~N&Z=3EQ>!aT%a)1sgdBXLEzw3waN23NWIl4SlO~_)bILYv?~3`me@3p`jl%^rMD; z($Gl_{j8y1H1w;6u-|M5IM5-EA?OQn8j9DDQ$sEdC1@y7Lv9UuG=w9Jm`WQBC27d3 zp|%=ory-w){2FSnp@4>xHI$+usH{vgs3B}gCX}wB4jRhPP$ssMqX%=$Tw`%$R+cSu zR1d~cGmM?B@pCj3(oiQ23ab5O@gCd&uMKw=%j6qQjTzMz?5=*qUpy*i(z2szA71LCUwKYfl$Agn5S7W z`!^GFfF@_4R18NWpRS=n8XByjAsRZPu_~_x86;(Bbb=XZ7Bv zwA8{%aMc87>!inMXsm|Dsbtg&hK*J-9H6*k$kv{hNZrirK!{$;5XAWma~f~uME{k5 zb7fB zGz3kCz4ihPU8tcM8Y+duRL{eCqv2s>SYTz%ZvpFa_!mmy_Kbk{3adW! zC|32hH=wqQ3_+Tc;g~)<307j0wzN?g1&;p#gW#3gWB8~rP8hS07OGN7=_rl|!_j@N z(dApD{a+mwE>iwD$p9EhLx8bVW0dLC7LCTRr^e5lbp_p`gKyOpbeo2j>#!9X!g-(U zVRvX~rG{2%=uRDPwT9McXsw3s(ongE)@f+HhBjzO6y(`xRncBiOm(-$xkuyNO9(x0 zT%5Cd$GGrwacVj|A2mYW-Gr!oZpM?%l?$g@5zToy-WhhEg>yfiG$BUgTw&pCv2ZHz zq(L?sr_{pvlg8=V>H)m)t5r180t;!YmC%FL-gCmM<8glW=1GtS56kXJ;a{=FTrv0d z>e|WSU|=+*Cyiue0_uaL++HSYm!c4UESVk7I1D3|4Ste;X*i%hO*1*t)(`}ACP6bL z?T-!qvf$FNwlegQ;+xyi!c<}V^p|DYr`GnVkSgutxGb#qL3FedZIYSfBN!=-zAVgL z4GU~!ayThSX+lAT9o*LnPHhrgYX`Ft89Tj6uw!1>P!m&}9qg`XWxYYo$9-89zESC?BQ9c2Zxxf_GCuCRj7vVvLjjlp9P zj2c+du~fiG>o)l}vq-;(-RU15;slYDh(PUa5%u`<3Bt zpvrNTRYCl~MPzULEd_s8v_162GS&)ef*Bo2B*| zt21^*)ad@fF@UwoHs?G0wQ7IyFH$s^i^Aus?dJTNz>q{)wMfouPB2wfWv znzWXtS?GLcMS0-5!SPr1PrXGC=3bzyqTK>-wn)=jS$nP3A~##X*?2aVycV%hxG#W( zhyOZF@O5D>Y+0+J?bn4z0;<;#9)ar2>%%XyPU;q0dH1vuZ^B*TU&7?7%_ZRs*t4rg zEDPVpZ6EvBtIWP%&pN0MZ3usxpbSu9*?Cekjd@(EeZz48Jt--M_GhPlS;j8xim&4uEy$zR1 z$vPZf^W@9n!D?6ACg9sL0et#OxLXRpX2!#tbl9}iOW`ZXVFzfSsN5;@Ux8e}7w%WW zS2%Ww|JCp{D)}p9?V}xXaS(Di+>dgQ>Cno_aly75Q&uXLMEGXB+r~u|F5bOpkH@6n z-f*ujmB=m{lTy@9Ws9APtk@f#;J8-~?G4|gwsa#v#o8wGUkjhBuFs zUcjk%TjB$*yr=}(I?Qu29MwI$FzluDXC_Zd-Rt3C7m7pMn{`0$Vickgo*56VPAc+o zfM?}vIA4B7#}H1z_*;fs4OmGMnhMH&`@GH+8=EQ~-`OsH@t@NH_go(``E6(OJ{Xv= z0Cr#a?37*zbpeZ`*DNc>Gzskon_;v~^%-hwaxV#`V)I)sS++m?tmi2dk*qm+y#q(6 z9$y3F$(-uxZ-fWMrDUR}L8&5}L6+T#)40>_!F9N$@%Uao2Lb|z8Wa`cbm}8X__xxBq7LM+2Ua-}> zt50n+*I6zL`h#*}DeedDZeJYIIcg9e7-@tts=xZ54_^*iAXlK1!UaGdD2_U~cv3AWKXp5wdTaHGG?%%d{bhx6VB;%55FyK=#9Za2OXzuE z!r3Fpx|DsYQ zLk>(1V{OX2kbYRTOn=zW_`n(Ee87f=N7gG=dL-v2D?PF+vxH%dD0`bhA#)N1);6G| zzYY{~4Mzr2WCz3ihG6f0D+Sg=YZ?1KX0>mqkkFe5i5^NOqw<&l*^lWT&}g+WXoWFo zZz(j-+g3gp3J;>YzN388{|;XgM`03891MM={aq{A9TN=8AA{esf@$N8jtx^FgWtD; zS%~Oh*ai{oI3(}A2hM|S5Rm6X3)v}k@1YK0BZRNN4!+TKa6n4_iKws{GW6q^&_C-? z*bo`|NlfUUbSP|!2u=UY%FkvLyIEjlM6l-z1ZyrG{XVJ-#zsc^(uzc-D!N3lJ|Z~l zD?1XJs4xZvCP}97jgia~oITDskpm@HwQDoT% zm^QZY0VKm@uI4;W| zZlYAo2xL&SPx5EWv{jIYn?AV2V+i}w@j>34?bgE18I3zk`*_B+dFbdcC z_N_xj;-ad%p|ee^gTTVr)X|?YkQ~U4%dW@Fxh|<2oCEGMNC1jdW=cVEvPnhPcj7h0 zbzu&33qHm9nV%zB5A#J?c>0ago|pRJETGodY--jT7l#0J9F5^siA#UjewG z;iULte|GtSv$SqRQthB7Xo!+4p=Z3fo$!8~Zc;P~gUNxX65Rb9zY&8R!5;~Tv+&f4 zJz19Lhkp4S4wNmpwY^iFHp5D=Tf;32hQwh2%*7=zn@+-O-3 zQOY~mus=-iBQrLuW1e|dYx$O^u|}y6?uIz|F&ggG>zqj&iaGj?$K{=QNAdY+)1#e| zhLEiIXtJ0X9C?W9EGvSUP_A`_V-p79$hqyL-oVKkHK$|P+;Km2nLaeLZ@Hteaprm{r?k{8R zhxeOO+cPUe7JVMh!5DD&=i%HQPSiA|7#(w=`kl{QESO@%X1Q%rhbVr#pWK4gl!`E^ zJCF;z>=)=>m&%YY&_Vl2eH<3u9zTR{b&KE1#Z^=Y^tkL+m5MLIXYTCAC~7CER_`X))8 z2Rj^g#N*oB$}hvoSu7+Oo1)3qi<#ndIDEYQGCUq9VdWnS2mI{U3}HEWij+gv?!&6y zEw`D@EHWdRj$y=O;}B-bb7jGZ#J~m@q+%mq?ek*!vG3^)3G&Oy%#L#47@FZ~sXqpd z>iCTa+VT{R{T+2lT2lFrC2pBLDJNNS?)E#CaABA7|BspD^o;XTF#)j|y8M}h&hpGx z;l(Da+~z>`vjnsVb(gtt(Iyxi39=O@36|EQ{mQ-$cXlNLv7PMU*)TJHMSJf18njD! zzAv!h8>sft>5`L}wp&8qga_f+*Ja;?v(?cKt@+vupX92(!Kj#oB-`pF3%-FoIC-NJ zwR1e2>F`$fIF8X1Qj}CwgNp7BIra`OJsyQ+pU1m*a*y~3IiN5~GO)s#V_TcQAjRXY zFqYQlYugWAx|wmakw@Q$o&6Yx$=Mt< z4)1ItI>zOZNE}Nzws_#kWdmi;wI<>(^P-%SIy$B1-?%ZUU~R5b9kRtJoE+xBk(HPX z$54BsJRIVw>=4H6@Uz||#{&|o!D*P4|HuKw3pzMWsve!-IFi{Eu!2Yde|Cwm0DLVD zq%W9^Gi`Hj&pgDiSF%)*i4-@~p@woe|%AF>I=LX$gwoqf>?u)V7vg|EPrsn+z zpJZliOm+I3h%#hwx_z>4#eblVEx}D=;dfC+H4}xJREqUXp%dY&)ahzVkvi@$orAHz z@KyC*?$uKLUlVSodDV5 z`xz4c6{&g?SCZxZ+v!YYJw|s%c8m5M)!CTPM$sXIvJY`&@WjrT!TpT!C39j5_6Yn1 zLt*AG_~3Mg_`4sU#}Qw) zbj9$e@~im<*Us(uCJj0F=?r0-(;*2PYwDhWc6DGIRFHz#(3{FeO7RQv*#3658|Rn4 zi7EK8b@9-DE{Ox{ENTlQ-)*=cX!*mq>9rrW5>e4)@O04Hp z6p}4>0o-D#7|4aX>*L&B`q}M*9Sj|CC&RS9$;lfg@}kXlnK+TwVRn}T7xUcEbKrNd zZ5mXKH_@>x@8j;xI1}`QI-?g1M4#Qlb;dZRYDXyO$duZ)xQHtTcVb^yXo}*@%&fUk zRgk%|`A{0st%hGJp2MW#t3U=W>BF5CLwJS6-En3H`0}YZvs+dWMIp)2UB;eJ-t6ql??;q4oac}m?D-Gn@qTNU3~6S%Y~=^xSH7iJn&cJWh~EnV zwU+wJQv(~^W?D*HY?~paS)iQHj(E0_ij_I2u)8vy-b!qNVP?un-Nmke85iYc=Wz#5 z6$Bb#{>E{mj4a4=2J#E=%9OK_GEut2vAFyl!M+$i+0E>vzLdIeAv^~!%>hH+j3bOU zIues`pM=X}4)qjThu7jJ!0~Yb9Bo|UF>_r9al$N)KYiIBaP7itTXCEj2n@W$I(L?t z+I7Wet_An7p1ts7=HxgR;$Q;~51^%r@FotSZH;pi69bMHB)_#8OnJmQxE6&`kyw&U zEbedyQjVf9*#Nl(Wfq+3U23}R<={p#=ykR1Zf$l0CvqaLLfD`>#NWmoTJ9T!^ZQz3 zQcNNKH{2+P10UPQ1@rIVE4)Z6vn`9cY;JxGe7bX7 zs;$|_wHS?u3qn_6q$&FuL_Bx7nY5I{eLJ|}aO`X&;MfrvpJn5x4|d2LI6mpe^^R=Q zhV%imgLZ;ro!IqqClaPV<4}uaUhE-MFRZlUP|yYK%nb8oOIi@mRzITf)JKg$h=+S0 zdEnoXkr<>--i%KoMSsY2&Zo}EDklZZ?H)9b!+K|mELBX-jVU6`rg%CMVH4UE4{t7> zIFh02tmJfY<=>&WgTj0~?f2z) zCyoJ!itW>o5F6Ldj1q`QcD0fb_+vPZuKoJY*{P5lbK7IEFO^%`o4G0c0z`6{id{on zWjBI6cEXF~3q(jMzyc6TCZ=smCy%5D%s%N)Sv+(Kf0F;P7yUU*+?rt=cI9Zs0ccVB ze`6e$T9;5){V5Db#=)3R`mH&FU0PJl zdIB#Nw`)_}O%pG&6o2W2)O^hCbA15Cz$3-8u@&{e!|kCbxTonF> z_*2b3o-jz`81R9NO*J1@mpG9nbEPD?L!jChG%FJwJ*)S0G~-=TbC)|=4(6K4P+Gsr zHAkx35HrgCFXO^aEHjfSow3WabRXKcC=qv-96s8$y=>}io&@^Z*|^uZbah(JhL;oZ z6|;*upy9q=yTA0VHoKZ_;<2Q5&*^4x!xOlwuE;bw8Qf!tTWAEGqI*e%>MC? zh>BHSbAz+GvWNM3Tzg(W#~#S!*|)oOR42JQ5^?<$x}c+64&}pOJWamO$AI1umryr%wr<-lp? z6i0rw+273OeQ~1)n)k}_V;z!Jec^z(SK44x_nqmO!Q6x|x1~jH--iEUK6Ct0>`GsA z16nHQqYkZg^({Qz9OLLis>=jjKgVSh=ierlxoH{60=eeD#pPaL)v?L6PicJ!D1d<>AU&Nq8G21?dcK&Q)) zselH_d_sd|6`>)ro6s3@h|th#?=%xPgB8g9>1d+D>J`(?KJhqRo4HHPjkp5n;0$w( zXPA}!R9R4BUga5XQzKuMm_K0wG0~r%WlnUtZb`$SEwwjeRlu6FuzGdTlbtZxL^-Or z%rTe8JI+$L)dlm+8dqo}(kVcx_#?-Rih)N<=t{E>786gp(tN^oHbcd~1ALuxmAOr| zZKhOA!Y6^FSD80^#xzj1V4*qHF_t-HRDZtE+!_yVtG&m>nYN3}d7J=xmzdR7{K7W^ zy{b+O-* z+|Kl$5Kh^~KE*MSzht;svi3skGRfJ2Dn2p}%~W&?rlDoOVuCk3-NX#ulbI>U4@b7XuqF?8WKn9f z^bi6cuEX>UJQJGQ@CrZsZBjvO^bo26PCj9INZKymFf0h z5EFi(%w1*n^3RCzE|Klge z=<=utM7kmd#>zTG3N487zA^^BifDliYfZOfA<4@Ol6qxLl#WsknqD6Y`5w*3w9t3BSor`*Bs5ZBY=FS z?+U3{hq*zHK$Uxh90PmNdNWNeUc)zq2f*_)5;1-(_N1kScE;qmD<;Rss&|VSALpo) zJ$IYk;;L*tOX?nJ57qP|3;>;pTg#_ojv*?mcC*uXvb(vh|cGuqx# z^+()fQ?ScS_It59xI2huJ@eN|F4_gbG)V5o!@nmcG(`^WLg&U=#e94!S&y07t{>m$ z1ycDJ#|NB?4#754vk#Ru})LDJ2tP;E{lt3$JU&F&*|Dskl71w$hvm3p(W1m{QkZIoS^rCEtT+ z?0MJWYeZ!su4r9XW%|-z`smkRumASfU+;i>74AJa4=iXdWwmte{hqZ_Qs@Z8&G}y5 z7$294o$`*yVFApu$fTyzfmnDZN&Z7^GRj|lBT0Q>=cMo(q}2vbT-BQt3iv6qwp#`| zswEvTqr^vs($Ykyr#E2Er=F_b{VqT-#}jV*Sc z`w5s`?@IAj1{@33OUka=1Zz8m6_2Tb@zw|rdFaK6J@^AIZ zZy_N3)!zx<`#a&U{YLmw4hpaT1_HzP{Z9D)-wA)C<#4&`Y16M(%`cY~Pn#Lm>-NUi zy^XJ5G`@PO8*t6W*U^oya~oe*G`^N3;5MxTx4NAE_drwAo}{jO`)Bjs?>F!LLG#{+ zn)g23y!VHvc-KB_8vY~jra_{iV~VN2hqJls;}QCEREKoayr)JtfMJ z=OAZ3fj2FsjhQcd&dl(CdI~o3#o&K$(3wR83WWyc|7WK}=cThvP(E)Saa zAc{Q#|MwJJ#R@0j-AuJ9{j=;ztm}F1<4$Qye*hK-=!X39&N0DO8h`wq@SlDs{N!(k z_ipv`ZzHt&B{p1&KZGsw$ZpdYRsG_7zM*A8&o{Kpo;~JBe;n) zJ~ybe221D_m@1h45N3~CFy1ngqqEsTSb6j(0>0VJ!$OS@-i0FEP9_~R_5H1VQD}aW zN{}T7&1bV-u#7WQlE_Wb)+1aO-!8&q8P*nJ3(Ko#CMT&cb|`&UPr$>*p{-_^EcpRn zH29s~PMcCD2hJtMmtmbx*^UH!LOKXbLHGND?(!{{!yuZQ0~664EcZF?#XcOYD|Vq} zW@L7PF=;4t#O{Ae#ag3lpcXxA5y%<3B2d3!l>&`2kaG@-r2cTYmi(XQ6_R#M z4i-H86EpvI^8G(gDSFoXW^gP&sYOp+iVBfDDS+8~nKf4iQG(ep zK6GNUkUaUm8OEZTL+_j2QWC+5OoBDbz_PC%4hYy>>agZ(-C1Vkv zl-6SP?(z4~9Zvk10`uQ~7y_qU3aj;&!)E7nlJXxcWMFA+si^o!mfhpaDBrTdS$*;_ zY(k!=fWd~s+V1;lhWQNgtY}@Xv%2gER)Z`hZ*#(f&qGbxl>TN5{^MKlFKWS`joe)N z>sqy1+HAl%Ekxk{;pP&W(t`i_E%;As@L$@<#VqmshJdF2v}87y@f9ujm$u-)Al4uG zw_?Uu#s*maSGC~3um%6CTk!v53;s*5X(3=y3;xSm@L$n_|BWs9->Lo2Jca4jw-8}N z3;wI6qza!8j^|=!{+gp^o)X5bu!hqNQkEY+YM!IKQe?rGkk195T7yoy_&+ndsh~jP zYjWdjw$y)(FQLhwS`t6hm;e(V_o?{@6}t=ld(rESPt7y3V_m4_`-0!(yhkJ=RY%_R;l$=l&jagMq2tw-BDOo|A_(egU>B` z1}Z<9aVD%}Nne;xb|fFoLQc`lN-0GV4QdX5p{eWmFLP!VaZe{za1`Z@c&%CulDaR< zY>$oxp{4WD1KYpM!8x&UIr7-ZgYYh8Uz(Y+Wf#^4PWjSIW=&lFrP*7R=?tm;)a)-g z55bmoOL!tfo{O(X2UUnd~NzzmUF%~&v$J@Ik7D2YgnN4>)M;Kwq!;@ifYZTzc$ZO zSxr?XW2|xCn5oJOS5DoCZv~}~#Q9|9H&$CtCl3YXxo^xg#V|9Gyu~mlzA*==h)Www zRMz;qiWLgu`Ehfw!V(q496Q!q40@A<{%uw7&5f_OG``-}_+*6(Hu_Z$eDgY4 zZ|0~Z|7{iGx<<6?8()_+zAkQjy`j9SePI0nN76tJe;$l?^YFx?kyaPL(LzQh91V8~ zVQ`Zgweh5C!%;XS6^|tc%a62ox`=kVlsF@~&|mVug(`<7&xL82ZQW-${ijBBJd+UI z@HZ?0U;ZtaO=%Po`VNz}7Lg5L{@3{x`G1+aB^&PB^md-KdJ98l{ znT3@d)VY!0;o~XifF0& zuPIIFKMR@W%GeW_^hOs;dtVE0rHE0Xs$J<+B|7n%CFIy|F6A7?dY%ifU*vZDzi_O?~bIVfpk0US?Yh%7oAE1JuWV97+~RcUU= z!17f?gZ?kM7#6r3qQL5{4om&7W*`n99nSbFJ{8|1ia+xPWZi1qLUI#O+ey_6FrF^_ zIL+r6zkYrMS6r`O70JL&-zC|Y(rr1?o5^dded8bLU_Z0}U&t%TZ`jF2of+ZGTikpj+k#H6=!;I>UB5?t4E)4_`FP)juE%ZviL|JMG7Y$ zD`bCsWTZC?>o`N*a9t(jjAW;T@kFPQ^y&&M&P!Ftd2ZkRfpkz{;rDI5|B$VO*m zx#p4n{$!xG0V?ajGGy;dG^F6^3^zZ{xFP}7&zLIvnQi6KK_T*~9dsIkQ;=Fy+xoKn z1YF2{Q(S^{NQj)~Pdz0&7zi`e0UE4L-4a!1Am9%I6O*1O!f4TI4l}J;%u{GfKLxG! z*0xxvx(BATp6KA5?QrHp8p!Q2^mIV2yCca1qnphxaewu0Lp%|qUo@)C5Yc{&o{i{DtE*&e1cbcKJubVj*W@`*Wbi2`_T?ZJNAJd}sComs zPxsc5Op6=;KkAwbbxy78y{#h|$_(O@;xSkwb7V=Jb3>bmUN)O4dk$bLX38|1(sMV6pdfC$^as`AG?q=_gga7N2BD^eqNfIPisob3u8EJW@Q!St<=>#_! zj+{b~nk!y!qz|wPy^&ssv%nh(hB_k~c478SD!?>uaDK!Qi}l+@{3YnhIk^$1)OaH~ zh*#&0%mN*?X^>OX+D5oNR@Y_-_$m$A**21G6}Gl*F4Vl&tgJfeS6m+BE?CQvZjRt7G z_K{>2&M)}U;U1~I&oI<^Lo8H7kSu5);Rdsv?IS_68^|Fk-SOm@pqdm7#o>~g0AXfc zBqfh_3Sh~hBM`|=?`g&A6&njTh9zP&3`C|uo!c3R1l6|P)>3y{Tdv(d1Rrl6BH3L7 zN5>{df?e{h^m<#*KC$VN8o}3aLvoh;oi0{nUzwkbF;Zkza%2M1u0ulpnb1~xBGB&D zI6*ASh- znjf7`&ly%KrIM8v8Opjt&%>%?Oh?wFMGAB$8md$-N+V8U z2Cz6QGE$~IgnORK1_Yh{E~r{Ew_VkVvgEKU=>G}Y=TLa_M-md{=PYzBut!Jq*U?DL z9_CbknqZ00Jz3b7)CT0DT2)n0{Z~c6suqa{75OBQeiX3n@h_O}qy^@s^>F*i? zueNM(uxCzW8kzEqoJc3E(yh+{6$RoAsfVc_BSMk>{;`O|vC!65_R6YI@F1!Xt z`7K={X)bmg?9c9vf$2b(h+7Rz9JKaaCF!jlm`RNCWUOBCQHKj zA~Gc$NlI_1AK;)=imnD6o_0`ZMuJNBR_zarOW-JK8Z)X3gLiw%&*4b0$2n*h3PxL5 z<}`=t=D;EARu{oF#$@7DB|4%h=9!o`wvnsN$RK|-ReEIEV@CR@eykc3iI9C*iEYFa zfl{|v3L}x#&8Sm#44ok9-6H4uU&E}EncJeJT9$Q#e(@;0hr*jbCdu-XW&@7p;E(=L zBfCYqW!WYnvK`SnS;5rt+soQ7pe?z78enfvTEWy>om&g!C`k=YK*x4s%%@VbA5`EOAkl*%K$A~zS? zVvkh!MUo@o*j6NqQs^u=yQh%z*$ND^8I>Yt7#tax?dlS5KBjxDUppxr_5_v5fj$$D z3pb}3f#fW^4O!?EpxQjG>}ukF7E1tUya27VGCwjvPUPTiqqj}chTaieG4Ogyl7AcG zux=YD!QK(fW9?i?2&5|KkDSjD!6N4z}1 zta?rA{6P^OU3>SS$RO`zbQ_x$J4@Z5$fL6S04j0ttVEo(H#m~%J&t(%5$m|r4vyr; zotrJctnbu8d_y96pbB<`Y&=SaL>^Z50cu%f23EUjS@8}H48@+A>1UuaalH9Zs6ZWH zH=zOnGt=j4b)>lzRuc*{yVJ}7%t8?6uRCBSnIt9qa6HfQp^+rlTU-Xo>-Iu3v7I;? zI|nei(oXHaQuQ#V=!;*$M*A&&VbH34Bi%WW&A&9pB$FDm0J7e)t=M$@l`9d;{kK4< z4|BP(?_z(y#B3}tbY+H!!fsN4<%eYVE^syhPhv-J>+-@m0q-2Vu{O!lI6w1Z*uCH24unT$eWm?6pjGrs@{0h|JMD?v!G8+L2^#18j_9!Y0rubPoD{4+N3)= zbdMPz`DZ~xTs|?&7dIta4sY~zs4g9e!2)z$J4#K*w~vZ^3uyD`NH?XIB+LHMk?XD3 zv44PqH%%7&AySRXHqVZn+j=^(rtVXfP=5IGRM~QNWN}nGw3c7)PfU;*Vq1r9&*XJ@K=RLaL*SvZ!5nN+K}H#M+q@<_usqWr(V= zs0*E46MLYYT{D!}TI#8kq?90iaxuF$3DiZR)$5d!&pd?`a9prqEVel=TZ-S#)?YKY zuec2o&4F{`Fd1yI)cabyW~AXnHQ2njUhndOr3$yyrZrrOqXTQiDV5w*sd&&B+CID zrz@q!Fgd8v0w%2D$U^buVPDA@ehkhm^10=MO3pdYi41U&l(tg;Jj~C|gIJZ5`2)83 zA2}zI1}3kq?h=rs39z=!7IOmT2^XRIS=tdcom}wpuO~c zp6uvGZ`eOE65KElOG-XSgsQS8GugdiQlzhk^>GGVYn(2DY>FmDeEy4(KD)g=CZpR= z!hq3JQYNd>@4?9te9@iCGjT>ief@5{-=|IxAwGw9)*Z)j{?5YW3RCpT#1KA3JdY{* zb5DESI81WETvS)lWE|5w?|pn0-%^dU4Q8CcCRpFOJTYY#G@i=NSkZL6EZ6C}1XIB_ z66%JJntI8Le=2UHTyu7=d&3kcT0N!Tlt}*+F47^7kttX`B;$2iHU*0KH)JIIYe!|1>W$~Y1gUmK zKyA)Ny+3!pvWdQTJ_Jy2`T2Z|$K|po1>a)wrbae8rpVr@k@r`bxxLrC6U3X z$f^?PV3%smxn@Bdr)17Vjr5d@W?E(yB-%vTzRa2&{)BWZXGS&wR~a#9%!(Y1dQYyN zHydn({c-qUI}`zR7e$PeaoD55)}gMp8jf`_pMwex6?qg)$zoaGZi+6BI8(~0aNx(* zv|AKAZ+He<*~PG5O_x3Yud{1`kE*!(IlFiB4v>T-kPxyV**xwhJ2yNO0>a(AAdrwi zf-j`&O>&d0>?7}KTv{N$J$DkRx22)TVLB+QRzdgts>g`{M4%TQ){iLrS;MN z`u*o_Hbg$ZUw^-Ef4|+i=ggTiGiS~@b7t<{x&3lcUZuDv1`;tf3n@XOI6HXT%ky%n zky{3^Jp4?=SH@klyyR2L3rOm*lXaY_-T(O{lUp|0a9zG0}nB}q|-h8BI z;wy$uTnk#9>pdXnruji8z!d)a0QT7{Ve5EiF2#g9OwYqLbsoio9LgY?jBUa}EY5@m zO^+lB_^!9+=cWl4VZpbE|KxZ)g2dDY$cz;Sep-}I; z<(lk-X&c=}E7tH&epZre+$C8KPQvs=r6T)O=WuG#R->p>NMU+W;ozDkS%_!u#7D49 zuoVx<65vD&It(^xQ)~=RZ8?lS*toU_xA&}Dq4{li9JW+EktjY1Rzi%zQ76=D4|i{s zONxImX zL@^v4>qF}<0!p;x;>j!_1@RF>8s__b*!vdLhIi#zA6knn;=FRa-|f{|1-JO+a$}F{ z5Qs~05HO|()sGt~crU77wr>&zjSe7NxS52S2xcn2;v;Z^P8gqxulOYB&cL-Q5cni; zIB_$Kb+|MnFGV$H3}FE~%C`*}yQX`G5Sv~y`AEu;5m<K#-X@ndPd}o>Kw~t7ISZXgbTKg? z31t-33RMy;1(@*980t zZx6}^%LH0%kxrpaad#@3CfEz>U4rlB7>BRXaP2}ooDmJmnM)EprdK1z_ln7}Gyd5M zxC~!GV~jWdB#5a>bnMh|f*%QC2W`5bQE2K6?o)^DY_5eMEo0dDPoBaNm}4P$AmiNd z%~*lq$Z*^&49nK6D<|6{I7|H4`QrJNuq@?>cb$kSBoXXR6!SO6E%|&W3YA`kLPEYG zSo0$l+Oq}U#5)qM;)lanBVElu3d0DliDeDTyK`grTq9pZv4-p94HTQ$Ex(nKGdmUK zXC#?M{*pw`dsCAxw#W9}Dt{v4=CS=U9vS%o4EJe%?GNPp^8U1bVT;GFg&fX6K-=!< z_4|6Y5a0Df`C^`OhkOqA+#zp^{r4Smk*O-J!tD#`0iWiv>VbeiP;Yg5t*utg6VSE3 z?bd#`&mA1p`&Py1F8RvB*uEq3=9JhaPsv+TX)N}aWAeIu)5Il}u#16^WTl-@giH{lrq2)GU6x z<$}&=-H;Xtx_tx8qmSqThu7mF)5ykeL|^mG=(}Q<7Sw8%)O(vmHAx3!AI__-`CC@H zYVQPZ&FdQ0JTW=j@x=Pnxh;YO`#GPx98vn5A3Wc&duDByKw3JHXQq_YSd-@1pS9tU zuBe4Bpsb&XbSq^pUyIa3nWuLm^-`uyz&^?>6|kQ&i$pp^nRz1JMwuBR4NxYDG)Ng= z@zeYcHez9hGz||DNArFWub^>>jeH=OG;bVnY4``eCvg>t7M z-61WMu1>p-Oq|a5?R4au)7AJz?AT7no4NeKO2?mL_wRL(X|(0rH>x-8b>6sFjY^r6 z@$>4D+lyl{Vs5GB)7HeZ*V5OXvwNa^* za@Gc-(gMmk&@$$XO68RMB1Y6kv$gi6jiK#By2IxWcr}lE#}eHoU{^rzjY^f2cV$CV zs-nC=!HdZPN=8Up$Z;wg}Wnae!Z+4W_yVgae#WW)m$R(6@*OnWNB1Q*9FT}l=`dKk((Vm8fLz-$uNdjw;IN9Uu^A5j%OXS z4<)(OQr80O@(A2TM$X=dDvk5S$!sM(&TrV{DCE~CGntNY^~u`8Syr2-ZaGQ#6n{IJ zIq+t_>=b63d%voVtCcowr&?pvBI7?$1;gy9^cC+&VZ~Tedy$MnB}&sH6SY11fZJz< z0tDP6>FU?P$b?<@^(8WIQ){O|w$jMN0_zGD-^ihh)zXzy&B4D<#*HfD6*s6=>Sobi zb=5QyD&n(K86z8SN@dm9oAISG8xAHyQpE2~WjCjGV5CiCcJg&;thoGdXGNtHO3rGF zN~x6G4JeILA0LiN>6H2|kQtQvHs77b7G!)Fj!M~-n$&-jl|Pxro*SJ@$qbICkdh@N zMUryf=Mu(P>*$!2$Cv!S{ z&T=vnv}pyIj`BZdusmAH|DM5?;FzVFOqN1?+YFXZNwKSEu&495)5h}nKslSi;^S#C zbve}uTZhlH-8w!|XYJK|)*js&_Jy>80lm)=9|AQ^<%i2zd75f9C~X>-Y^)xCaav_# zwbakOHg+djd2R)(OTG*Y(`xx!6|7bqmIU{~+cY!Lu&>b2~AZ`buEHtPm;QdZDt{7l@2Y;-R<@Fs9WxU~FC_!@why^`UMWO(! zh64V+aPP^A9str77E?x|)K7t#UehDfYI=+>tzwrpdr#@WGbnOO2aW;twGRB@6t=JM ze^+6YUN_o4`j#M{-u8EanAY|W0NOE6)(-iNnL5$fkASxc_cJBTPXs5Ad+SuUPfTn7 z=Yp$0kSP66WF7JW;s>kQ<#;!_Lx$<6;RrFfiY)$pnJvUd(ovbcf;SWyd8PbiJG%;J zqMcvEx^M*812yb?9PBV-POXjC*D@z{$9C4Tn~3~;7GoEfcRO*2*3sHIGs{|i)`a)4 zm^t6|o+F<>%-A#YUMK0D4N;5v4U#@O3+bCA9bb?1k0hPoKUA2!^v`6Tz0vTd7V}4B zI{jP7{VSPNQR-td$vco9C)2ubBmIO-n?{j-N~ZjnrH*Z(`DUV*&y89niIV=%fYd@s z_pXOKw!jG_{hD90kQKxhWueFX_J!>I8C@=0Q1|rLMzN^OyqVv$h^@A^wN%)&p&`%q zYFj`bHm-!dXWfQ5VLoNO$iG|!QFZXz#jFv}Uu;{RAYa?_AERXjg3ea`uiwzl?41uodQ+S!Y&w_0XWd&zJ^I@B@CfoZjMp@-sF0 zo|Z8+GQl?tv5Hvd5c_UU{t|z{>h=Xgny**44r>9o*5lEG{KHGxnvBUYQq{E6`1dYj z3(IZ6X|n@jlZo=~K^;SR==_BJ(VP6V%h~3Jf?bG|LJ=?8ATJKhvaJ9$}O%a7`0(2WlesCX~f09XPah2QGk60JwgYE&J777P+ zqj;RW!lC(m{ty~ApE7oCL|Q@_m+}wyu~lhyGTkCDHGI)HD=Tu~ZV%MT#E7;ch%zZe z$~sKb7Slq$ZJe#8rLjlG*<7Mx{$d0mUf8&wy=~^7-pz9O*sp3+>ZMN;CaS8n>gE*- zS7M4gIW1$lh24&is}%x?Y50&QZotyNxqc@r!5=)XxRWi$Eco!9Yy+mh%pb9KJh*f2 zk5~=0@vDBsZorOV{$0#Rmx-j3AG(XJ!Qql8?qV%4`XdKeKHrERdVsqRu(R;;F`#Vp zJO17Q)+xP)x;Z`{V_C-&4Mwo|8Q*`9HD;MkqD&V4$wAgpQ7{cv=v1f7 z-&8y;!^->bW*u2<8VYhd#B%u`?q+IM^ECV#zF>k~hmF;HCRh*lSF#VWuB>aP5nL|{ zHkrQMvJ8a zvK;J;N^{8aJ;W0TaZ1jKs0de!DD`qa{v>1kxhK(15z}P8+A3n?%y(OD-Tsi~sYKKs za%-N*M0I0FduMA~v*_+bWqP}_yKzmrx^N0>3r^x96XlKFXQ!*iZ)Bok?WXq5u5@)W zjY;O4(RZ$fqYR?o&nMmeP#BbS!HZiw#)5qu-;25GJ_>d*kaA z5f{xkwlOlXN=Ukd*FVjwvZ9icvR;MHZlJ7p_|KkZ^-J0*!?LLiVUDOODs@u&dmTpS zH&Xg5-!iVcDg7ZtW1A@bE+l7C`aWLuTefVpN|rl2x@0+Bow|xlC_uG#x1QN-HTq@U z{HsP4@x+$;balz8SvEJ&k%=1MYgevsUR_#Rntq$=m=4-XD^`f*@k$7)#o5{>q>E^~ z8rKT}K&Vk^n9^G?Di>1vJOra7ls;IM+OX#Kh`Gd3*^Vg7qg$iW_bKHJaJZdPX7U+FS-C@s zQ1WZQ?5E@xTPyn9!|pykGGS|QHi^EemBxiF7?loC@)Iq*?? z*B~q_klEDS;@s5MZT%HgW1`%ks+)#}J)vL(Q`T*&P598#$mEix`hu``2>l5dMS-lD zLfHB+Hg+gjfM0!#Wsa^LR}}%dM+|yo!xc{~5jJSIHtGFZ*b@pGmIhP(W^`oYG=u!q zpLF&Az(=JQ$UL(fY8c5EO8+96j%A%P{3ya9t$s{3p zgXrH#-X!|69kOj}Zt1QcpQyBMY+bzuSLkM)fwO6oD4Ujk%M0v`nCk_$uIT(R%)EJI zKHei-g!%q~a%}&EgnuyqHmOlK2=hx9Rr~Y{vEuay5ONfe`OEcX*cU0&M|>h6l5(Lt zSOBGUM=>B`2_$v42!g0s|7fxFkC`Kx-i$3f!8V&|AOFthaK5{7M}^HUa-JjXd(2tx zAJTo5ZeOn_+=mFtO_r_v#*G(%@KA7Puuc}_2t}YS_v49T|lP9dh^aL_8u~J0eeR}^Sx=J2O*hIBa z>ObU1Ceq6Ild@vNQFTbl_#C^Ew``Hsij~TwZB<(p>qVmeZ$P3r!^U1PWbGZ)0#=#t zwku^b)&GrLQLLbNoG8I?8YcFFU2#a}rhnr#Mv79zOB7|v%re_%rFNNCyTe&~uFE0E z`V{4v46?@RRw&Q5o0ct#(Y4C&DXY{mwHB8c|KoLv6Q=>|yOpK<+}%n#HHqtQjT%u| zBpx$1spW`p;6NtBERp9IKO@kVMLpX?P%Q5d6Bh%z54(7j^uc+?Ufax;(;FtSg2aUl zCu~+ChJ~w<$o#ub5gE-_jB(aH9)GW^FYNVhcj63@>y;g;A7HBoPYZ@(_gt@J6HeoN z{03!p>IIk)6f!@|XYNrP$RM-XFAA5aV;VGuH7#<2!x_Qb0 zrI(h+JO>nC3L-7GU%8Aw^}L)N`$bf_oh(LQx$8bpsO|uCKvORBRHbK8RZ{ z_eZGY+UF)e>X_^d47dh$&yXG<$*MYm2!;}fx&4Y+&4Aw5W$nP{UrRyiqkn*Si*_K-4r=@zu5N+3OM-&QI)8#FZn z6p^?#fR>c_RA)nD92wM&9mF6NW$?ofDRZRXsLm!X*Rw+Y*+WX*X!1Y6&DJPJl%%KC zhQ{WWvC2jd=JbIeNkc+P5K*Jo?SiL9G(cI$fT(Wth87xOI%PMbGC>haP-Hh4&29us z-8W40=1hTZk4`0FROk?yfLx=f*z5Pv{7O_kRwdA0cd(a=A4Dw`jecLhdw|S6Xmc|v zg|)eZp&kz<$37t$#i-2{DAGiK#pe;+!Ui$Z11kid-dkWqmvEj&WAo-pLqEcW_CfkCZTry0G- zx3%`^z7Su08mvc+8hY?hG>2jult!&HCiB8SF~x~o<5E89boEc({^lk z^+2UU0sK&MJ1A^zVr!pL2hjzLN1I>kb79wbkR)a_&fezl)jX~s>_aEX1~yd!Bet+9 z`2ZN8h;IN<2RfR32yl5jx&r6AFy(yM$$A{RuP`xVJGXI2JX=h0tkKt_4GsZm4EOCsxXO zKV=;Oi|WqA)I^z^)dn~hAh1;k>WteaTOdM1AAAYMm`W@tWH%6=_~;hADWqm#Fm#mT zQX9uM$6*MFX5E1{#W@(WE6uzC#y3{k8SwWD^Og39j#Y2e5$q4@P>kH$M1hUiuXKBj zb{2kWh^cE(6Haa?kN#ZAo9_luWtZDKiYO!sh3Bk0=e;^cjCd$*VnMI!W9zi84@= zk|@`L4)`>$PNq-zTPRZhi0I1{+m^V4GhHM^HdQ9COj$cROK_>^61otiY$0P? zSGWi2mUWYnVXS1R;6ngaUE94Ou?C?ccn}C?th#GEbQ3NkK*!zr_^j2IJ<$HoKv$$?Sd2Lq^fQ`;5FR2bgQA~AT8_m_EOv@ zb6yecw#U(NUs<>Zgz_XtIH}YCEs{XW(XZ=zsD0MVByPZkNv*&f4)82rGGgRDMNp3{sU$<=8 Kva^*%i~a{BGfo=- diff --git a/boot/ocamllex b/boot/ocamllex index 9471acb6b18885bb42c1d6145cce1d7cc7a3dc89..84a14f4d33fe3f45501fa2683e49ad87eabb5b47 100755 GIT binary patch delta 20011 zcmb_^4_uYS@;CeJKFU#!oZ|rx2nYxWh$y6FUNs>!^{OdqYAFdSS4mA&yjf~uWob%* zk2-m+)LY&3rU}>T(bCki)RLRr@}{LFm8F#?uf=a7#7K9D%6%yRYi?2g-0lH~rYH)9Wz)c?756HgiI+?c#O(|XDlP01Oqxs0`~1DAzO@`H@W!{X6pL)cjHl93zf7F~?k z@MtJ4D?CN;kP&qBH5q7UIq}aklXQpMaP$o{wuc9bT!`I8$3K_K$ZOp}WYiC2#J7&u z;)U_ZfL2yZ{S-Qgc1Bg}Xpv#WMz}=0AtIu&E`DxjWJGkw;L{`Ki#Ve;VsiLP7?;P4 zMQumj9ED}e({#~+QW-=`XUiBmS|A!M7NZPtYgb!eH1R427+JSQWYj~zP65`2!gU}Dii=$O z3jD$^M}w&5%Znh|a^&kJErBaIKNIYyKPsYW*C|aISI%SPEw&3?!OzILxZ3*Lmv-5; z7^8Pxm(Zq=OfN`?e=IeYZ__QMb$yxs(51a#mXjhl+w=zAP>bvPdLJMuD(nyYKSQnplG>M~aU;)c~5L#B-jO2s1_(bFl<^zKMY6Vd@A| zH5IcVDsx^l@r5wb9Lna~H%+l`I??hVF$A_-RZU#ViA1A?iQl6 z&a0Vblz;3dN3bXcMI-E|9<1{P89@^qf@QJIAzt`4kMw-yfr}WHG!Ediu4&v@cog!i*QU7kg2`y1qx% zt%Deg$}+7CI^uyW+pLnuz^c=bGAK9ZTliP9D&7=`^OcP*s!S7kIE z&_s}p@jRbq6m_rYPE#}yVq@>Y_#Dc894=u$#l9)sRCKQhGSZd=ib+)YsBnq3|8Mh( zw&q27#B)h*6 z+@}%Tq7htuwPFADjo?Qb!O0EbwgIvsB4E#zh7A8j~r2)?@!oX`lq0IT)a&%Q?Rs0J`Xz(62; zfy6VA#H}cQr_%+(E%HhKi-;~fdcmV&f3^=pZvOC;MsOd%Y@}g+vekj}Hk&PRkG)QY7ZmIeNWC`MYo`>%$milb5Yi(=bLXyI0qDksCC%`FsxdJDjF8t;M8%Wg z0$!o%g$M)k-hqcMnJogTg0bsqH@b=qbPQE&8anfd%<+E)%0E$9`mcKHjZ`~ZbY3}A zDBC74>NT>@q`AiYg zEfQ_4AQrx_TVNyl^Nlv;*MNg)`m=B?(2WY`etgaNJMjLBeTEkFQPE-=#TG*b2fu|3 zmY&BP>s2dSQu;*YrnDTWIp#}E(eQ~Xgo<_oJo!5`b21W|*;9?$k=>12^ExWGQI66>-+X^4d9_6M@hjJ^yot1l#7Rzh=LjyI^=L=&rftGC{EUEObaQE#)lQ__9F&9|(P-u_B8A;M+%C&{I97>=_)C>v;!GQe~-OZ=yj~gj^dm{sR zwGsT>|2GTRjwQ1NG^w|MczZ9%!6)$-Qb^DgBdyNdx7HCx0*?Zl&R1%n#(-__Vg>pqY{xonHO{d)0C{q6K! zzqZ@_+Sotcg5vM1-UH0WyT@C<&&E4A>H~nhAQmwGV&GS0K`5w*|Em?NH12!P+8k3bq1 zjy?;l3sU(4>*Bg&fpxjU{c)JsZ@&Mi7^#UNX4FDKLVQSXJR!P@kId6g2&st!RJ%yH zvp(1r^7JXW-(<4@r#mT%5mf~%CMqSR6`(#AJ?HrhT^St{J-OQqs* zP3JSSDW#Sn`aeLWWjOH<(92~a+iD1;(`BNU_c6V^{&Cjz$8F_eu=ei&dhHR}I`m^O z%S5R|Vbvc*8Bgox% z7>6T*%)Gb77$yE|RE~4e!JWA8eMU7y;o8sb6m{b8b@UN(216n-yTw48_}rZOp_pl> zVVou~K|%rYh}KAx@Y_bZund$|xyF;|@;(Lx6OmWh>2$*9+wK1BN>1u9Nm&TdL-C7zCg_K`} zIOUoOmr7ikKd+rG&PDUGi@k3Ofq+F>R6_=UDUb9Awnq>o(()wIM>Q4WK{&O}3`8_FA5BnzikW#7b*1?t&^zpRF^!}Wt!Jn>neUDXBRC_ zT%jWjUG+e}Gn7bU(3#>hw0IhFix#8>2Lo-}a;yW*!`- z4G9rL&Dcq>KQWY0N0>tjwUA&S3ub$e4?Tn(Gt}JwkhVs`dlb&oT!A#{X)SE!KQR5W zr?n8XVxhK3(8-s$d~l_p46SVM->^xm4AN$w#!Mzo{F+q92GB4xd! zA#L~;RKM{p%XyuCOS=ZH=IQO)FoA3$2*!$JTKA6DRcGeSsXRkwn=w1JNFmx&&s|VT zidnh~4nlM=H|^G>5UEu8E(YyLvF~XqNJ|cSPg^6>7@0z0d$hDr->Vym8FGxn?}36S z=RNG`xqGyIw$6a30H5Z;O?hAI;p_q&dlKHz+$Y1__P%zp1*Tg0sYX)VO8pPBzcs55 zLxzwGYLjBV(9QuDdX#ZpY11)nG-ZCJrO|C)!gF?`tgo>CXZiV0p69wRwJ_vpoL^~f zeJF+;LG~K07fty}iwx(WkHeNI6koQFW2d3C4&>r?+V&L=_+FHLT>Dud^;M&d7Fjf} z21Z|EuBy={YgG5M7G{(^ttjSOtv7r8Z?*SeGIaZQT5EEAr*$xkPH4M$`sv?meQ_6i z=zA~;HV=J|bT5L?V<)lkOX#6f(2n))BazOXf^n44^dHzNDCZ1>ob;pC1&%HEN9Z`1 zQh(BZ)cauWEvRNG>?iXyP9V>V6RJC{jq>!u8D&j-lb5Z8kxc(KL)dr&DjfJSo7_zi1z!+V(5t(AP{qhoc9rC(g5V zl#qTA=n|TD5xb)wIqNKFaUGj4BO~nWA2CnMa{E)(C2g|!vuEqZoWO1L;3cge))RhN z>x>?QE~9w>ZM%$ZP(sHpYjdngdftZ6`rGlssN^>-2yLamVIBi1>xwoL&>L5vok8Zy zS2e^3cUkOLHjxNqu4xrY45r<>jHBn294>}Xt&-zKjt4bcm;K(_DnQBQ1-?g3j<}G7(u0hvMY_UVJczYAZbw%C_}&v!`)|{!bl#YGbTJJSWZT@Em*!7Iu_m7Ke25u#`6f&w^EHmy5{@9 zPCzl2{F{(Qd)vm{q%G9jHvT4UJX7X5p;6o2z;U{CLO=jXr&R=qf7bL{RvG5FTI>CA(x-2rl0xO+-(z#%d!BTeMImyC5aF~tRIV01DYup6K+VdG$NUb3=DFodKHMq)8ES2-QUZJQ(Q%L!tow6y*cc+Q_9DJhj!{siLxE@mwSL`9|;y zRM|$lonau4Md7;^M^I2}8~K=%MZ>WQA6=}>5_4*_%;v3F83XZ@P*sfVg=%+#bgyhH z@oFMg_CR2i)fTDiqHrJ<#mcQ7#1c;xM`zp07_8VCC%*!!Hck#e)iWLnffI_C(WuHj zRi&q@j+diBlA2(V3y{x0Z|bcuw17kQi`;n-VcC(Iz{R{5ZKk@nvz2hi}YvV$euR~iX# zeIs~7Blw?$NG!ViKoAFv9mK0GEzp0&1TL>>{DbCcZ`ApH`9?(axf}jU374i4Ahx_ARQY8 zL2foz+ynKB3OaPJBxfaBI4t0CDwsPt7b8l~?5*$~MA37jvBVb<6C-FnI$DNdTIWY& z0SIcw$nL00$6%F+ZF1!_RI763$Z)=nvdJZ&up8r_$NX&f!As&0yHBRTtK{A%zp(!c zWBQ!YV(K#%9xQ{ZP=&Iui9=yC<##C_7KM3OVK6PslY7M$s+@`y=H<&ph#zZ;5WQ{P zfaorAoE+7Jt^9!idSRSwZAI{&?$3{teQg}EJPwXAM)eWb%JG)rVz+n2DR|F#NG^^x zjE83}rK}0^72E5ewxmO`6Xi(AE&nfaA{r|T^qDdy>hBtny?ci@{zI2Tkl5AN{>O|$cfwDH6hGTg!Z2B+&U1y54W-gI$fG3hj|}! ziezW&QPJWe`I~JIII;R7srr7rru7B=R54vTU=O>eLt^h!_zann{DGI$|NQVd_r3mY zGf8sEFB{|$|MZy{;ouCJ>D=#aR$#iea2*Xlk+CV*fX~Fyj>{&CJwUl9cUZFRp^B9+HXHZbU0~W6c@iBFDor z2)&~omT~rjpu9e{K@VfFYD%30ukat5K1aHc|2X|H_TZ-;z9Jv*cBCWoPFRpjdmKd+RUg*j#x2qW~KUPoF106UXS- zJQ?leUBz!ES^A!BVSfbvF_?Nj!kf!VO2lkMH1`O$#+Ovi*sna*adZD85+795(A5QS z++S1rqq3{*8w}^w(W8hxCQ(Y%TA483!~sTn1~SG^Ah~q#33dc0 zL0|7t@O(FAy{@^;xr^i|zPTM*ET`E|0e@YRIZw&)p+4`*UW@kxpSwTM{-@+8_8&pb z9>}xA4NK%$=TF{2EEJvtD18U4puD?>zDf!rZ{`ej<|fi^Mpn-5AYmye0jW@R~Cv+YVf z&n!cxIIjZqkD-32d4`O(U-MC+mh70L`8^FCFl3UAKlt;kC2P5K+u6JO>~J*20%a5a z6meoS6)cx2nx@gR2+xsdNLXdX6n#8Z z!7BL;5?}rQh6N)F_cz#dAT9oz{29bD%g--U`7Z2RFY0K0bBYhuW%uR-h(FWVSw2_ zJm!+WM?PZ@_d{)`t9#^}^wvQ6_PcdAM-L7^cwN*mrsuo6k(AHWB9 z<{=s;L2GvaGlTNLh;O}jrpV35tq_Tm_Nd>^zsW-okmw1vQT zKu~R0`gAYu8L|8vK{5N}1mtJ%46nWq_?OL^eekoQIXOQB)8=OX4<+vJ_&DbySZXtx z{t;|5j+`ONWv>574%G1O`+Sw`YESU4nx{XMy8T;5B(wwSet>+=j78~)!YfV$-giqI zN)Le)>6#V)hR$8I|KD%*IDheEJ23Hh9|Z)FK`KF$*eE?$sQG^|@bf}77q*UA2Wtp- z9Zhw$b*cwzHPs38h?S}@HXP!ozQ{;bO69`3-k0iCCDLhnpz0<5PL+Xb4X`;jHAjeB zsH&M702>c)uI7Yx20uO_Shl{8P@mxr4^m8!N&;E`AaMSL%7gHV97)$8aK!##s69FD zsh1Q3v zNI3PX5H(h`qSR1`vX8Y@XjCYewx9)Y#NF;hf8N8HDEwph(igZ)2JmCJA7Gy_n*g?Q zBYg2PkB6!lK@~yx#6-C<+!=~>!#Ej{z+8P<6g+wYCwPqccn(2fj@F$m(HVuuwkZ7b zpjWvSUzQHJEg_wEW8Jtjg+WngXj7ObI%oKl=&!uiXy%Q~Yw}6LhhrZzpUPvP zp7;S%eCj(DI;Tp>l*2F|I3`nOR}ia}J}Mn%wb(W(Q5MXPvZ z7Ojnu<1y>mj2h}e4fCLI(^Yg7c>8dF8zy^<>U5*-T{I>}#nj)U*#KDhjTPLTO8UW< zT#120YEF7A6z>)O-G403KM>A{|Eq9L$65l2Y72J>`-(&GRMb`-^gJWmOzYxQFZ)O= zkG-#FuBYQHf!gD*_sNS_b8%Cdo{RT4J@K{Cm3Wng&Z!A%n0*vFvwA$8OB1Zln-WyY zAMB&k3D!QcwF7&orkw>9v{TXc5*Uha-&lKcFg6fw?Xj2TAx} zyi^mt^(1dyXxdZYS(5Ju?9;Sww=m4{!DRn7v#;kCEUwM){R!SjoE?vwO)vkcVkT~y+Y27NeySE~ zj|T;1V8>p-;ZvK9Y2jNhRo6{+_x5{o^4AJl)BjBvq7tN}N>4n~^HSOxHViI^O z{R@Q&=7E6gN4)iXZ(U*@>#a6xkXdP8^`cln>HXArall;B4>m(f`{Iz;(_i&K;!ONm zEuo|=>}KZkDEc>cHv=ekfV%!-C=+D7$sfN7DdV{;yh&SoZ`%_$X^Zi;J$aM1P)}R? zfJHZH^tr;t{%tgMfcgqc8#EA$JwUStBB(k*>xNlSjR#pf41O?vkm_Q43SC(RNCppr z@3RPzn;Zl)IzXU?yYxI;U1IJ+nBI^Eco&u3rEZHl05(pPwkRCqu|${Dvp;bcPr$Sf zRuhFKaoQRxgKTW+Ot{n&7pxzmreJ{39JSfflRXY?%*r>4fuGF$) zipqv6<(qQFP;2_uln)P818t@C)4(d-)O(m3<5>nv=(?tKlA-IXPSn zu{~YSD(h}F4IL`)Rw>SBd{~$+XEfTpQUu$$3rFw_6SbZ@XOM*9!6+KeZh( zR(JIDR_~!2G)AqiCv&XKRYi94l0J*N4VACN@lcklO2E{4pBliaque}> z_RM*C5IlJ7$X5ewtLi829H+8%o?vrh_h=VQ8K>sj|Ay9}`Z=B-r*?wf8{^@L5Nnh> zF~so+*nrmEGTBe1%=`Z6n`wztw1daUkz@V;8uq+1%-2wY_GT`NYI}v zP*=orRQnh8tL=G^a!Tn1sy&CS)g-mvx`FHFrb#$Ht>-|p->){~UoGyqUo8=9%>I+r z06GR_sWMPa$~sMF}w!|Fk})ciS?>zy@6y;={M z8FSg`tTRtMqDD8tr5w@5PPB?AFxE7)^ajzgkLf4CGl24QWhXkk zL=DF~!PKSTxQ31_#SQp`nOut9B3?4fpH{(=lGdxRWe1hHy<8OwdVPZmGy56p+a@C2 zO#K@&2}lQYTa6Csv~D$ymJ@VrHI%o;yt-Q9!_8Ox@)Jcbs1BawMKg2V%j#_*)>G~) z>LVIhp&}`42F~p|p*hUr^(s?{e|mZz+@uCl*gw^67%%6a3f};}TF=r!Wv{6abJ9kI zm&zOK=^w{jK-%3z>vkbF)i(rDQ3V!}Zl0)66E#o`+5+28r`=l+#-*F#ud7dln2%4W zqbcZ3Rj0oOWkgc#Tgbm=zM{+yrg~N&&zb%P{$ca+yMpN3t*}}fYN+NmmTWRYT-kf6#W{%~cNN($#_ zkAG~o{NltHOs+8(>{5M|s4(~MQLo~kOVX^p*t{=-M5i5lRie#$1Q>^Z_2OE&PsLov z(AB*v!k&#rmWiiN&OSB&|43nq{TR@@?*>(=!JbERT@@#((kbd=TpiQt<&WXa)6GjC zbG`=HYFK_cO|8apvBq3c%>nrutO@(RK5H@FJCQXcK0y*C-OT?4hn%RSmp?_=_b-b5 z8QR_T1H8<+Pt{@P7IbfeE*zNg{440#Aw~G0tl=w)HvqGve)9(M=l`pQC7X@Nw|dF9 z-9V0iw1XEYpDBlUi+X+ryMCK0KT{7nw}Y}i3(V`G1sgHZA&1ov=MJ>7x_l}53aUJe z8{j)Y^C|C{w)2Q`*>^TTr5{lfox6bI1#*<{q1c+xafgoEf$#c^WHf z^l0aMjj=}gml4LUN0luNBplZ4q4LjhJAWU9d0#n$k#Y;tElHUYP0QQw0f3u9w4wUf2*Qx z2kWs_-@;v2(V!EstSXv!0zIp#=7f3$uRu|`Y3+Bouvby_cdAqBC+OyTlVN>>fMMIB z@Q+RFQ~!2K{T_FfDq2^E2rBPKr0R;kSCO$iUHlgigTfZe%R1Dc-=^=OhW`RpFKjyX zJ@!-;6`aJ}KSK+zsESHYs_x0mkM9(0U9C`f7xP>W1J5{)Fg*gOJ*g5Kkh8J+$d7o* zud6=ml#1^2InXRz$kv+a7l4`jQ7<{)qb=^NL;T`Uctyw1UT+Wd@+mbL(|7)WwCW0>Z+u!0u+=n-(>O2GE7 z!QuKF)A}~f!Ty9Gf2zCR=A z3_F8}>Su0DwBG%k^`k2~qbfu#(+x((1SB(s_?1qaRoTvS7?PEn(bS`~^VF>tF>e)Z zsI@HjP^}_yfww^fE&2tK`^Cmv0{6pTRUSTtY-lByX!ozUlU}A{zalnDr^0j4VLFwb zLvWQ&`gvS2U&Of0DgC_K>3uwZUPW7v!Fye z?eXPP?M3uzLg96Yu$xkT9fDwMzjhD3*)9#F+B%g&b1$hy)Zr2=vEOC9OG>(g2{ERb2*gn5PQ&RIMrXH)Y-#fsN+B z-y#9CujIXyjWPno=QW}l(Y681dox`1lOR4>czp{3rZv49z7cgo{+T9KotSiamJn+B|F z#abOP>53zIB3^w7fvPhl3%$G6MbdqRSZK@_a0W|-j_+H|LqeBA=O{_1b#LKAt2#}8 z2}bw4)Ke@pK7i;5e{o#u+ZnC&uBZ+veK2lA3A!G=vWXr>V{|LJ?$KVZ;t*PE!za49` zV_cZTn5KG|-s?KNw5cASo(b6JMS1z{P<&d>0wM`8R%HEHSa(oOQ+=$+rmR4Ha=K5H zzT?6Na}dDPy}_ZuskI_kkB(|g)yJQTtVrTcpl*yL`ZmV;A_>}V(_`>u^f8;>$=)AS z*Uu7!5fRj-nI47@q6an8$G_QJ#}#LLGadi(I!N!Q^Ma+hKS+0bu%d`6o9Qkw-BZo* zR5R(2U5~c;PTmBg@&T9WXaPmyUs+cLLn1Yl>d?n#&BEY5X-t9O_eEffe{y z(6DqK^qVNt!WZIt5Br6UIP@Sfn@&6QVekuCPR#BA-Q(2z+W9WZKUUfT+JqLp0w{rN zGR)oy%@B)$ey3peQZF1?o z1ik|gg#aoD(Po@pjd5&L?$Y@muUYL6`?W{V>mj;BJWub3V5~X5mW)uHKbg6QtGPa8 zc_`+}j$cr2D2AKoYp7weDWtd3SBpnzT`T=DDs$`jrq-<|;cY{X8{2)mTaUE<*AKmT z@pQ_q$N7P=VE|boY+8ZT2Ou2;3$ci7VHj#LmAfIrrzk57D_g>lizbEXkx<*hFnzLE zO0`T^YC6O9rLLwE3TKYbpE1FFrh~pj1dc15m_K7i{zGQ-j(VPG>Vxj>r2pF7c{}uW zIUpcw5&muY7l8pSx|{cP*Z&d-`*}ZG-w>ak#XUO~K2TUZc4~g{jKbMo%+&nJ1zrq2 z&|6RB2s?nvd+WIz*jPXMp|?KE!khQ@(StPe>Arg4X7M!91-%WvU48R{-fMnUW>#5Z z_Oz)*`QwX)R+)K6cJH$I?3o1srX4((S(Y%cV0OU_p*;_}c6gpx@PN=N4suicp!~uI zgj~ukgJ%^N%|f4Zz$bfvafLI5EY8fjqpaPK{24Qu$pW+{4J)27wqSN)v5=*iSzWSw z_bF=!)Re+;Q!TD39$@U)tQp8K)PQ;Fbqr)70$!x`7xiR#r2kyh+ar*;dQrc<)mgCa z=p*c1II&h#d?UwF1@zQ#KXrxZMpKea$;Q)oV#;Y3%|=}Dm#AgUj#{{zLh z;vc?jr~jY{mit?s9^dgBe~Lk~iVJ3ofS-AR=|0|fD%lT|yaM9r4EF&M*44qND7ICVlzbe5D{n$3!fz1#!KO=Fyw%M2`F)UIl_&i zh*c2x$%q+Zxl!eI8O82gE0>RYmF=P*i=6Dq7)v9Q!MH7Qd{h-0;pSrj?SQS3c+A;G zLR1{ImKT*Sxa(-@y-NmbE@3?6Of(z=gN?mW!QwvX&_%f?q%w-zbrPMq7bCe{vX&@} zKMaYmh}?Bwkz^ch7YBxfXqQMdM06ZR!ucd4C%PBiN8|6@_5<;E zpOrt}-n27U2qwyt?`&+28>24=C6%iGqg=Zk@nJ%HP#Axl*M4`ugb*!?#WTgr%>#SL zm)|`l>8cbD?k-IkqC{KEpmsPzU~(Z;{16PdKK+2UNzfl=iwI+Hr$P1&s65$Q`3b|B z;j&jYqx{Jz$#9D`MxP9Kl+ld7u33KV?)e!7L1MH~*L6JprsWjqqftDc5(dLC*5{;x zxGyJPj5Nd@-E93(#8Vt(C~hy}PK`-4-S} zWmcwGzWa$;6Ydd#lpQD10mj9N2>>;5n8nO+Wo)er0oo8J;*9s|QkgGabP<8Ov)?Mv zP7Y(Wox-=ZJ=V0RGc%RU(crcun zw9<>S@%Q*ew6xpyV>h&7TX@SCMU($Xh(V1%6h%P$MW`?ou9XB~b#T;<>QQz}W%b$|bG|?eg7B4%* zc5l5?7v1J!rwA54hjv)embRi3xU3py+M>h_^Ow#s}Hb8TY|rFaCfR z_VdCrFD&qbcN^k1H%*)(9M1EXZ`|OfW_Vf3jS>_sJS4&>xR;36l3E$huZ%Erdx`TM z>AeY<>)FRdFvXZMlHxy6Q1e9bI1PG0IE?)d1k;g;VvD$s%1g1Z&(}I2y2daOCvvE9 zu5gWG@0pIo&xxOJ+-Q!Qe)wWPJl_v*=ZBxCk)5@;gt^ySHhYI3o@_Kub}ia?@x~1v z1P=xl7tnC6WvwbdyuTkF?uQFM{JpC!+k3nvz9`_HmV|&LKm5X#mJQVU;pB%;_QQMn z;cr3BH>E8D0)9_blY~p#5%vF6N9qMJ{oig1lnk=R~dOsw(i%?opF5LQ~AO}$6!=elAe@OJREoU50ASKKaZXt{%my@V)mY7F-r^22? zrolh0oiDOz#56I-_E&K7wrx`NDuI}6qErbl0$+y2Pbd;citKin&nh!&F1skQObilF zQ%RYK7SGVBX{f!n47*AFG!a4v%CJU?%S4FSMTZ|$(cw9$`yA38NL#&d8#$+oZnnRB z(d|?;UF3@$M&oR^aXwzruIZR%8)}#?qK$s@9ip7F3ffh{l zV`Q*!8r41Bv^5&C*>h2b(UuMz=M0XgS#v$SkmKwS;J(V-5aY}q(idDvjq7MRBUuwJ^ejuw%1Sjx{{}+;P zpua)671V&nWv|>cro29WWqX^|<1sg{x35`Qj<1ZID}~$nDvH?HUh~5JY;;{{^#TzS zTLT))h~>vTuOs<}Hh|t-Ad*yH6dAem!^Aqv7{yZK;;cC5SU-~+W|^GmK}G+PE@RN_ z5KLJ7PNXCs^|Py2{p@Hba9X@iA*PrqBL5#8goEbYEgi;%--qdUVzdz?9u_X~hPkam ztWgNGdi)OpHI95Av0`w2sdXUAUdr)1&LwfAmWi(70L8Y~+-Bi2k*kSe=DOvAgm{zE zR*G)o-)6~5A+?BFG|v{=+k2nFA=Ml~uda~otnkx(d=(-ZQ9wN^g(>bg8!HjQi-T0P zMvM}p&C6@V)0$p|N`X}M7^2Kt5(f63TEcNO-zo^A5<~R$W}m&8ZMd1uSda5Z9aXFs z(cy2Qtz4u_NUW{5ktR^yBf=ft9a$bPKTUZmdIV}XyB;xrEjc$}TeONyWUmTw$h4FA zFi0FWihk!dul)s55&to>w}@_S#5;y_y31VnyvPa_M~sBI(dNN@0wItf+ZTTk zVb2x6E(C%DCW!aQ87kc7`ZvT-n|R+mbx6#%iw~@Zr+p+MTZ<3Lxn0DW&zu&=gg9p8 z9gW*K180COUx|6TI8M&LVRPtoOaz;`=fsZI;v=K_0oTUMh$csT1ZP;>Rwy(6GR`OB zgs()LG^?+OHNoN&Gf!&crTEmW3e>g>QEv_l)`YX7WnYkC+u0zWe6{hagJ{BCw zx7C*8ierjP8!y@zRey6Ciyu%_@6zUYP+Gi9h0xkWc<;qwS~6Il4MWY&v?N>`1?+gZ zHUywUg!VLubrD)G@mbUE9Piei6rWS$5aBY9xV5o35||n7P%oBGHylaxdA9=T9;6^7 zUiDv?Rngi4O`K+{e3}n-?X}(Xj6?HGomR(b3vZtO#8)isbSjM3W{NXrO}w^S4{ty- zY^=8<@x#X2&N|FR@n3qfBN|)LQS)4<6o$YiqUdx-EnUQrGevXhF&JNfarBsrdZ%a; z#n)5?s%Xtujp25bvA6Lq1gr57qtOvZA*tHX4&R{2>bu!Ondq&;twti{Q)961wzHpQ zBm5dkQsZBw%N~JjjFxp?=)?+Ef^f!YG0%3X&1$Z-~^d`NOO?mu%?XMOhr$o zX)&TLo!Y6ntVTp%TGtABWs_mXuJJ03eIrMp+;4lNKqUV$Mu8SgB?>ZS-JUh7Uv=f^ z$Z;j#`Iam5a0VlB1-1lkh(*a0>VTxv=``r)YjWNOO?*S=#>qGuTZ_463B*aobqdko zKI95-(^LYtumob@A+n8ejOsvYgTyYrm`?o}cZ2(Xqs*nZX@x>N7eIgC1Xp%GT`Q(b znOcZBwv%?iVvht(&;)!LBftLVI(xU~$z``I-k@_kf>0 zO&!S5lIh4Ac!nK!Xvv`>z&zSt`>vG`W=)~?jV3e_BeZBCJwSPY?g4=opo7D;OJ>$c ztuRa!m`kQW%JAlZ(dMp)w6IVR-<iEerv>Zm zkK3AJIeMkYky@m=YlU_#5WdSAM7W2uevK9;BFu|xwBc@gdz^ z@9&1{;0Q0jsI39I@+B=(b5?jq$P1c95^vU-+6*BQsK?9N1h8#>8QxPQQp3NrcSI6Z zy{2W-+E<{-kiC|d9=2DzfmY37uWG{u?u)=MUUVR_U+boGadONc~V;{(;AFh*aM%8LRwZTxGA7~`86>K}s8;hC! z5o8Ft0GhP;gmwY6xhI*{h3ubdV?iG!|5VGu?T3}W#Q8fs`O)=Sr07QF^_m-V zqq{%V2G9}EqBz*)qj4;f&yVoRE+BDAbBmr7bxM0!^rCgAwC`w3z1E3#e1>NG(8SiYj0?My|kHMX`Rd?Uuye#{OitW1EKWeXE5Y8 zW=?|^Bt$Ot`5Fryo8Z?_kM*7)g+_b>>!_fk->_Lw^>>i+inCf*98&k4g_7G)otV3u4;oYiTPKxE~v5dDvAeE)HN7?1@*b6 zEwBbTpTtxIMj^TI&h^)@)GFxQHH>2rRbAI+0}KCI`%Vlt^&8qxLj1<-ID%xDnJVNi zg^R(2AelthbU8u{rJ_JNK@9Vdjs?m=;h7H0HOF96X6oxd;HSiDqZ>3lna(Ba&}H-3uCvmCbV@@*M1N zm)zZbR#bwUSBIR95$|-!sQ^(<`ShYOU}eX|)gJX$V=uzh#@?bV(_1#~7G-hXviomQ z7Va$@-?A*w8fR-d>Xa_=D2;3@SHT&cYAd?{guCQZHV)$0F{Dslyc|xBFqtJvC@)M# ziw9^NfO7&k*iCSx!o!|OE5l?r$f_nxnjAz<HLI-Tr?Pw~Sa z^5JwbS{igPMi$cQ7}=Y`V&z&7x-}MPR(l_Mpgqu`aX@3@Wr&k6zY>r*n&Lweq7{jIGqkM4xrHkoEUp%|n@Tj>P>7D8t2O2EEK9T`)B5FM>YlEF;V< zIkKLQ6HB_uOpKtqn|xS*3iEG`Eeofv-0re#k1akqLndqt{DPQ`1Hi)n>W4q=!>O#h z>_Ujg!qy!M+1NvN63>|#J>(cEwwfz@%Srrdrg0!dn@Kr?U^9W{(Lr*m6x+-`L**MR zaPeDAu)-YoTlu*Xe>d}n%iYSh9qn_V{<=|J<|4;vm{0@NL@JkcFvL~kXz8-?NrDHM zKq4Ev{dpY`=K9exMr=2$M`Nvu?G$?-w7H#n+$ReFK*jCGeKJ_*_JgUE@8H&{{EwR3$nB?$U0oDi8!J2MRUo&bjB#*u4K#8b#*av3oa_aF z(03ES%KPOEfXnyGQBlloL*hu8JsCe9Q=Bp$Enxo|FVo>z_KlYx+n-05K7aHmJzESX z)|oO&=;+oGn0~6f;fLwvQymH(LQRGuttP3Z|(SdC7 z(*x+|39=mz#yf)R6XZY}M=MJ~iZ_lPcTw>~%ZRc3yCM2{c_Jj2NVZaV*FREKseI11 z3+x=%?VzFuWr3}_39XqVCxOX13DkcyQ7xw3O=xqb7n`VH8U+oYu!|WoMIw;=r&;q5 z_7-6h;BcBY72aj>Ls)kUpTi5AwbNu*vB$qCwG35A?xm&3i;>T=n|%1UY|msf53(GaUH zhO(#0Xw<=X0QV_!%$5$ALc(m!u!iQ(mg#A)dpVo$9$b@G-W$!!=86W5H~?n=E98XXxUu&oCbP! zu4UPW=gQsow@`%}-hgB?D}N_(#(djL+d&x%WQw&8QHpg~(+Gz$bAjXlzG8t)vL6EH z&7tjFfX)t6mw52?=|q}zE6XiMpp{y~0-tDHWIWSlb*6*#f@ zJ&Uqz5!_@O+PsJtmUZhAzX$Q$BCLv!sFA53d%y`ZZL!2>2PbLVBk2WazB$g~8P6mHtG24-BpR9>*vH!+`FCcD^9HK9?D$_3&x+5lkx z+(!k}sALC1%&g@y3}fuST)t-GsD@W>fRUZ!rt`~Xh?%tl9>Dnp3YuIA@*}D0CCz1? zSSd&IIW1?EoMAr=`b{xbuaXn2`x#Izcg5?0jq*!MTP@$Ue+4?b9?$%2m2$lO3`pFG zhcvfRX4)D+vi1&2SPgfywo-;Uzwyz$4W4B|7`qD8#y`o4&T}YbZ|@7rzNNW;f+)WO z+0*Vze}YRn--O!N$WLvJO(>j4oRRuU2*t0JU2Wet(Z{VtSo8xmtc82MKt-J(xYTtr zS6rki>kxeIpvrY{-9J);2eUs0>?a>q`IvkJccV@N9@uuNsm-eOGTnI@D9_LrI$fcY z>t&q%s*ej$vj2@U>O&QE+8|SH*L-DEwL!Y=?8JR0H=34!WV_y+BT0;=H#f+1?Po#X zZ;+jF)HFM8ly_@3?vxF6I4yZxl1%_*H}asF@C3U{jh6k{iW{EwfH(gvKgZ3&woRCD zXF9wI=Bub-ll%_Y@h5@lbn!_<4i)C$%^Wx*dcj8-xY%2F5W3s)6heA@M)4Guvd{al zBM74M2!+qGw#W-2$V{lhK!5Z=APjLRP)L4Uc>LvAl-B+CMBdu>D;X99J`LnOfNFPtk8#nVq zo8=ca%kOBGKhZ27a=_{`;ebqua$q*>tejrh)(c%`$pNUt9tNC^gzbMP)x0U!*u$HV z_RzS0%LUmHAo-Sf0qo}8V`KRoiLIn7*=iA(MAH0PINh%NMIIfim0iOJ zqcS(d$D>3fu9Qm&2N470T1$0tXN7CnQwL!i?O1&U2reuvhOutcwGIc2Sk6b&;yO8z z)*gfrINk#FuV&s`aH#@D^ETQGGPk`gaYD!O;1Dd;Mn@09Hsh!~9I6gJEQe}%^*Qn# z+0CAS8L$j^*2Q$U}trHi7`%lYVxX~&9649d-4>-tvNqSzEv@(k>$?t;fRjA8jPDHX((Gua> zP^=c>{-^3uT%~Q~pVHIs6r&8T)=}l;nQkl3w zTB6iIEGgW(4#d@yQ&%p`u7j?&E0IA*ZFp7o6ggX|r$DW4r4|TrJ7t8ZAu#g!A!)o(6syDBZHYyH1mbXz|Y*}c< zfhU^_$c*#QTwGtfC-6LVASd)gRz zFGthZMIv~kLv=;?oa0d4P@&AB3V`i%s7HY1IaPkkFRN&sQ@NdNPbo;gGk%vQMTX(> z;IvaEv1Qs^Dms=~IpAh{n~cx|*LC(HtU!c+<_%u2&l7u=OS z!9-k>g@f3gPBF2E2kS|F!c`aA6Q;V-GvO-6-p4C4o~KTS!&S7nlNwMlwl7L@LFI@2 zMs5qvj0iPegi~b%1e|BBB-#@JMcL^T{Iq@-m|K&GQ0X?Fw{`!)2P-qzt>QTrD2c=n z8)!+Sa;NdBid}*4mIPVL09Y4`kPky*U0CO_6eqjkL?nJZ_`cxW)g{NLv*xU zr+Jrd6O%AMeAkO$|xTZ^bf_Ed5?? z4}c@82kQ}MVfQk?9b6o|Q3Y*_Q_IC*e1!=O{>EeZLuhV1WIoh`4fB}nv3QkCL*rE^ zniH-Ze2&HIumqKCFKl7#WeF~8Gh~nJ8SbzS zmK4iS;;Xa21GbAcM)^25)!&J$+p!&07Ro9+s^Rt#sO;PP7Sg$nR%LsNO8=FmG%Uqh zN>ftMJhbD%-b_((cD@PlEgfrJ7GSOArNVS@&ylJMqDG=Cc0c!c;V3U0P5V;S1lzqp z*@8CF(c3WX`*0_(hMo&0)E@qJ@B27c$VrFMga)`=%LRE*TvM1b7b57oqSmhqBeJBRk z`#sedfb3qVGo6M3{G!gymY4Lh>Xh_>L53`q!L|$xoyV6#OMXV^f20>SIZ*4t{edE>i!t4_BriSL6g%F_h^M#3#{ zhXBsL7+3tADxS{tX&Oi~Iyd<%V~e@j3ffH4ExpjGJ7JKXc6HWLAUW^BokDJ3tMy@h zVFA`G;_MS41fSnVCw;MF9iqd1t?JkNV$JyXY~+o=tw*j3vl?zi&NX;DaejiLExFBy zj={L;L@wNY(=07ga-Kzk+HmYRfa6(wK4K#XBu^z-T4Cc#q?$^VVvk350+L7XHF+xE zHUpDkbO+h*YA(T&yOb-OHOCf}fHW1!Q*Y&6i1{o-Y1tzST}-7u`IgaH1DcuNd0$7)pY&ip#ev0=Loik6D|bed?f7~JWa;K2@iPV~0?D(nmG@IA)=zm_)2RzM zukY%o9F|w&fj6nmMfLquvUP81(aGLljj?Q<*Tf_wUQrygad8GM>96v8&V-z}6Mosm zF09-Sp9P%hv%PSR7tYn_lm4n*;53x|BY=MFuM*AN0cwXvF+;G49Qz}Jy8R!>R2nfD zAuw)p2dfF9*1R~FeM&9G4ne?D%Lmz2i)ztC5E5&HyZQsVU|BTZ=!XDj_ps;|Wx3w6 z#kVNqI-Hi=qU<(LSwz79+@dg^oI?@C`21$Lx1FW8VCAuLAIqAT(cz)$Q_OJZFig0X z-XCVoSB$i&bkw!#yD1mBG_ zSS`)HTfGp@RoI$1?BUiu_Ss`N)_*O{AAWP}TShAN*hxj_hb!fqgJXm>A8QWXN2sB; zl}+QqwB7W~2sPF-FBaKNA&t37^vzSz*^z1lbKRpx+5XtnPSrhX2B^+aD&4utM}=ui zj5U!GMng))qg1YKHOhF3m9%XX+(Rv$Mh)Aad^IR)G@C0`j8?M&8b>R`w#Hj!Emhu& zLt!nQDv>VTGE!>17m<6dx$HjdiYPfeMvbwp^YTAN*<+OnYQtFd2Efj7I2&0!xVyby z&7`IGV&k|#xEMNrzgmoD%EzlAeCM>UgyTi?WC^5;8nF}95Zi{PA(l^2`8w;PwNW$1 zMTaJ+h4zgo4FSnBs*w}bYiKUK6z&P3N@H7WV7U*%i#E_;e7>&pnFbe4526^S91nQn zLA5H1&`d50FCp;)4}b*OKyboP(9?)X>Kc9-QZ!lpV0!|reE;+pD*6%47f(@Jt>d~f z?GIt!wemq!HdVbK{!Fpc)GD#b+%`>34c4DTO}qvBQp7#BTA97)@|kO@IqrArLp_{* z8ecLbBC(lq=Tm9$LiI5GY|TQ;AHTm)ZEwQN4HfDIO>8#%FIHm$#a}pBc@3o{%hBUh z^W1XfQaIg<)oPKbrzNY^BYHjB44|6(WhQm6ge`5N%1X4jiF*7AN9KBS<)5%d#1^x0 zjS7{b$`poLBXDiAZoRr1C^F2-O}KNw#laI#f-i%_X4p|Z_1O%aZ8FDgR--ihkf7-z z!#who>J(&&!)A)-)GGqNFW9$Ly)B-#m`vPu;Pc48d1_?6poY@C?W#Nasot(W7WCp% zD#qNpQ_U1&YZK2>^o!zN=J^-YUO_9isTj)I&M|y78p|;I|3gjEz_as3m~jRryo4|> z!<_$;dRJIK_KKrvrn;p69ny}WqGB!1$bC+ktM{nK1wP$$p2us8BU|y(Y|y_DW(QN= zMf`AS@$^W#@GmH9JB7cZy4l}nG2&qry-#JY!aiocqI&z$Uw%b(v43JQdRRZ9%S>un zyU%`wZ+iDChvrv+W)f;>=CvsTws)-5H=zC(W}QKY|BD@9lX>yK9IS7`q_DP|ZZ&*C)Fvu<4|gXSX3cxpx5Q4; zKR}@OJS{m7^~Rrtg^lg`dTLopuz4(juvqO@HgH-B+a4V<0rKYqb}{X;c8 zZMPr$i(dAZe!*T6uDfXUG35~dq|L`*(Xqzr*syu_^NgatR*zfnB#YOCqGb$#5M~i;}@kng4JmRA*>e(Bh zhW~=pBy1YofJIeDZ#H1)@1le!R7d9;RIfB{kB<>-UJ*#VjM>iL1D$E%NS^r@eXUYj zu(P%L*x&cE-&B3o*D7w<2Ou|JMIQp^){lAFeQ%z8(nvxX&*(VHo9w|SDJofpBkJRw z@nR|K8Gse4`QvCSc6{}x;3*X%HR(Y)_e7{32*;yc@n@5py*mpI3K1-Nnn%WNUOqyFEk ze0)pkF@T&PPfv~X#P^79>&W(lW!*VH;G^j8d8I_tnI90N|KPW3a8SIUik%m{?O=^s zBfdxp7jcyRk@{RjaFjuH7opS)I(HG#RR)#*h_hxDSn+Q1NA;RFJMt$LXJzr3^F`s> zco7HkwLjq);xQGxAU^pM26c&SmsGlTS)=E_Qthbl66AY@#$8e=+EtCdy`|1x4~Ni~-d1Y0Y*SNN^gv7(|Y7=TU{ zR}jtydO(l|1Y3X>UQsJ(;#Jj;LaxGQUPKPD&E>0*g_AO_p;}uHaCtzO1t{#AN~I^S zsjUOtkYMu_83~-dDX+GCqFE|ZfYxQgZRG0uUMA~$H-MZ#y#TMomIdm3pb-8_XM^?R?B2kA8!yYCBa%s6jg0?{;l52ZS{e6 zKBV%)TC5P&73NvZ53kJ56_PMZR&QnyF)ks+wOj@H2VX(A1IvS?C zY|mg1@Z6oA3qy@svWM$^#avnv0deghgs4gSA@pOze~+L?`^taUtUQ{+A|Rb7@Dnuj z^{}sGLxj#>-@MFVo{!iVfwA&NAZT9%x|{DS$a8~j3YEI`P2%??BK1ea0$LWSr;CMD z9f_gfquNN_9sUQey!!I|@vsaRSw;F{E~1xE$7uyM=!Ihn=G3SmQct33QTSQeGK(AE zQ&&YHOe~Dj!{{K>PtxfqeX3YNMeQ)Km1cQ6eYMMMdpo|TH~*HY7YQ>oTmP)Jvjdd$ zV?aROd^nRs!2xa3O|6gqV6YfVQ~K-M=#Bw;3Y8Af@1?f}=;da=fqIaZYU?;<`kc~P z(@Unsm(H3sV^+`jyt4Sg@g>t{m6lALAOGN#=~HG;E}hud95PrBej)ykM?6pN+RphU zWz&3h2h5mNR)RzIcA9-j@4KijH*al9{*1DjB@^ZdZD;OX`Tf===g%$$GWE!j+_fEs zmd-1kCA25N*Ae+irPGDB11;ySO&(S3vxS_Qn|IgR zj)f(&W^*GIC`}zcXX5zMc~j;HxiUA8vM)nUC$X`f7;7%;w;^!&*Jb_A z`@TV)+firQln2I-?>A*q>1=cp#LeEM&M4!N1boY*%JT6Jm@=(&dP!NS&?aMqnLhHM zlG&5zJTOgY8Fcp*JvDqM>SXu|2Tz}KM^_QBht{A7X1eE!o*e#3bBMrn~B#K*(UCv{1UVM3cI@S1)hF)Fg(&_dpO1NsdeI-FtQ-Ghf=>EGTj QZ$ut`cin?xuIrKi2Vz{kz5oCK diff --git a/testsuite/tests/typing-misc/variance.ml b/testsuite/tests/typing-misc/variance.ml index d95282886f6..a41db4f27a0 100644 --- a/testsuite/tests/typing-misc/variance.ml +++ b/testsuite/tests/typing-misc/variance.ml @@ -36,3 +36,90 @@ type !'a t = (module s with type t = 'a);; module type s = sig type t end type 'a t = (module s with type t = 'a) |}] + +(* Composition *) +type -'a n +type +'a p +type !'a i + +type +'a error_np = 'a n p;; +[%%expect{| +type -'a n +type +'a p +type !'a i +Line 5, characters 0-26: +5 | type +'a error_np = 'a n p;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, expected parameter variances are not satisfied. + The 1st type parameter was expected to be covariant, + but it is contravariant. +|}] + + +type +'a error_pn = 'a p n;; +[%%expect{| +Line 1, characters 0-26: +1 | type +'a error_pn = 'a p n;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, expected parameter variances are not satisfied. + The 1st type parameter was expected to be covariant, + but it is contravariant. +|}] + +type -'a error_pp = 'a p p;; +[%%expect{| +Line 1, characters 0-26: +1 | type -'a error_pp = 'a p p;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, expected parameter variances are not satisfied. + The 1st type parameter was expected to be contravariant, + but it is covariant. +|}] + +type -'a error_nn = 'a n n;; +[%%expect{| +Line 1, characters 0-26: +1 | type -'a error_nn = 'a n n;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, expected parameter variances are not satisfied. + The 1st type parameter was expected to be contravariant, + but it is covariant. +|}] + +type !'a inj_in = 'a i n +[%%expect{| +Line 1, characters 0-24: +1 | type !'a inj_in = 'a i n + ^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, expected parameter variances are not satisfied. + The 1st type parameter was expected to be injective invariant, + but it is invariant. +|}] + +type !'a inj_in = 'a n i +[%%expect{| +Line 1, characters 0-24: +1 | type !'a inj_in = 'a n i + ^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, expected parameter variances are not satisfied. + The 1st type parameter was expected to be injective invariant, + but it is invariant. +|}] + +module Make_covariant(M: sig type 'a t end): sig + type 'a i = 'a + type +'a t = 'a i M.t +end = struct + type 'a i = 'a + type +'a t = 'a i M.t +end + +module Positive_ref = Make_covariant(struct type 'a t = 'a ref end) +[%%expect {| +Line 6, characters 2-23: +6 | type +'a t = 'a i M.t + ^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, expected parameter variances are not satisfied. + The 1st type parameter was expected to be covariant, + but it is invariant. +|}] diff --git a/typing/types.ml b/typing/types.ml index 3fa389dac19..ac1497e3dbc 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -186,7 +186,7 @@ module Variance = struct 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_pos v1 && mem May_neg v2 + 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 From acf58ab5709d8d5c636e7c476634560263a0ceac Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Wed, 4 Oct 2023 11:27:16 +0200 Subject: [PATCH 133/402] Revert "Merge pull request #12588 from gasche/frame-pointers-test-more-robust" This reverts commit 24e51a9038bb6f7b5d1fc75b75e3ee63ac09b364, reversing changes made to 69b62949cef18298ecc159492a46fa11ed95b9fd. --- .../tests/frame-pointers/c_call.reference | 6 ++++ .../tests/frame-pointers/effects.reference | 10 +++++++ .../exception_handler.reference | 8 +++++ .../tests/frame-pointers/filter-locations.sh | 2 +- testsuite/tests/frame-pointers/fp_backtrace.c | 29 ++++--------------- .../tests/frame-pointers/reperform.reference | 2 ++ .../frame-pointers/stack_realloc.reference | 2 ++ .../frame-pointers/stack_realloc2.reference | 2 ++ 8 files changed, 36 insertions(+), 25 deletions(-) diff --git a/testsuite/tests/frame-pointers/c_call.reference b/testsuite/tests/frame-pointers/c_call.reference index 65cde20adcd..92fb40a2389 100644 --- a/testsuite/tests/frame-pointers/c_call.reference +++ b/testsuite/tests/frame-pointers/c_call.reference @@ -4,12 +4,18 @@ camlC_call.f camlC_call.entry caml_program caml_start_program +caml_main/caml_startup +main caml_c_call camlC_call.f camlC_call.entry caml_program caml_start_program +caml_main/caml_startup +main camlC_call.f camlC_call.entry caml_program caml_start_program +caml_main/caml_startup +main diff --git a/testsuite/tests/frame-pointers/effects.reference b/testsuite/tests/frame-pointers/effects.reference index 9052ef04d0f..c8bd0a391a5 100644 --- a/testsuite/tests/frame-pointers/effects.reference +++ b/testsuite/tests/frame-pointers/effects.reference @@ -4,12 +4,16 @@ caml_runstack camlEffects.entry caml_program caml_start_program +caml_main/caml_startup +main # perform effect (E 0) # caught effect (E 0). continuing... camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program +caml_main/caml_startup +main # perform returns 1 camlEffects.f caml_runstack @@ -17,15 +21,21 @@ camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program +caml_main/caml_startup +main # done 2 camlEffects.v_retc camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program +caml_main/caml_startup +main # continue returns 3 camlEffects.h_effect_e camlEffects.entry caml_program caml_start_program +caml_main/caml_startup +main # result=4 diff --git a/testsuite/tests/frame-pointers/exception_handler.reference b/testsuite/tests/frame-pointers/exception_handler.reference index 9292c32117d..513ca488b92 100644 --- a/testsuite/tests/frame-pointers/exception_handler.reference +++ b/testsuite/tests/frame-pointers/exception_handler.reference @@ -3,18 +3,26 @@ camlException_handler.bare camlException_handler.entry caml_program caml_start_program +caml_main/caml_startup +main camlException_handler.handler camlException_handler.bare camlException_handler.entry caml_program caml_start_program +caml_main/caml_startup +main camlException_handler.handler camlException_handler.nested camlException_handler.entry caml_program caml_start_program +caml_main/caml_startup +main camlException_handler.handler camlException_handler.nested camlException_handler.entry caml_program caml_start_program +caml_main/caml_startup +main diff --git a/testsuite/tests/frame-pointers/filter-locations.sh b/testsuite/tests/frame-pointers/filter-locations.sh index b532087451c..31c7fc3189d 100755 --- a/testsuite/tests/frame-pointers/filter-locations.sh +++ b/testsuite/tests/frame-pointers/filter-locations.sh @@ -5,7 +5,7 @@ set -eu program="${1}" # https://stackoverflow.com/questions/29613304/is-it-possible-to-escape-regex-metacharacters-reliably-with-sed/29626460#29626460 program_escaped=$(echo ${program} | sed 's/[^^\\]/[&]/g; s/\^/\\^/g; s/\\/\\\\/g') -regex_backtrace='^.*(\(.*\)+0x[[:xdigit:]]*) *[0x[[:xdigit:]]*]$' +regex_backtrace='^.*(\(.*\)+0x[[:xdigit:]]*)[0x[[:xdigit:]]*]$' regex_trim_fun='^\(caml.*\)_[[:digit:]]*$' # - Ignore backtrace not coming from the program binary diff --git a/testsuite/tests/frame-pointers/fp_backtrace.c b/testsuite/tests/frame-pointers/fp_backtrace.c index 2b2541877ef..a521218a387 100644 --- a/testsuite/tests/frame-pointers/fp_backtrace.c +++ b/testsuite/tests/frame-pointers/fp_backtrace.c @@ -2,9 +2,7 @@ #include #include #include -#include #include -#include #define ARRSIZE(a) (sizeof(a) / sizeof(*(a))) @@ -79,19 +77,13 @@ static int safe_read(const struct frame_info* fi, struct frame_info** prev, return ret; } -static char *get_symbol(void* addr) +static void print_location(void* addr) { if (!addr) - return NULL; + return; - char **symbols = backtrace_symbols(&addr, 1); - if (symbols == NULL) - return NULL; - - char *symb = strdup(symbols[0]); - free(symbols); - - return symb; + /* This requires the binary to be linked with '-rdynamic' */ + backtrace_symbols_fd(&addr, 1, STDOUT_FILENO); } void fp_backtrace(void) @@ -107,18 +99,7 @@ void fp_backtrace(void) if (safe_read(fi, &next, &retaddr) != 0) return; - char *symbol = get_symbol(retaddr); - if (symbol != NULL) { - /* stop before entering C code */ - if ( strstr(symbol, "caml_main") - || strstr(symbol, "caml_startup")) - { - free(symbol); - return; - } - printf("%s\n", symbol); fflush(stdout); - free(symbol); - } + print_location(retaddr); /* Detect the simplest kind of infinite loop */ if (fi == next) { diff --git a/testsuite/tests/frame-pointers/reperform.reference b/testsuite/tests/frame-pointers/reperform.reference index dfda92514bc..9ac6681d4b1 100644 --- a/testsuite/tests/frame-pointers/reperform.reference +++ b/testsuite/tests/frame-pointers/reperform.reference @@ -16,3 +16,5 @@ caml_runstack camlReperform.entry caml_program caml_start_program +caml_main/caml_startup +main diff --git a/testsuite/tests/frame-pointers/stack_realloc.reference b/testsuite/tests/frame-pointers/stack_realloc.reference index 078d923d7be..016a03550a3 100644 --- a/testsuite/tests/frame-pointers/stack_realloc.reference +++ b/testsuite/tests/frame-pointers/stack_realloc.reference @@ -8,3 +8,5 @@ caml_runstack camlStack_realloc.entry caml_program caml_start_program +caml_main/caml_startup +main diff --git a/testsuite/tests/frame-pointers/stack_realloc2.reference b/testsuite/tests/frame-pointers/stack_realloc2.reference index a0480da25d7..ae492abd882 100644 --- a/testsuite/tests/frame-pointers/stack_realloc2.reference +++ b/testsuite/tests/frame-pointers/stack_realloc2.reference @@ -8,3 +8,5 @@ caml_runstack camlStack_realloc2.entry caml_program caml_start_program +caml_main/caml_startup +main From 343782f33513f80fa822c120223d92c4c9e4433a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Wed, 4 Oct 2023 15:15:08 +0200 Subject: [PATCH 134/402] Fix ARM build with mixed-endian fp doubles --- runtime/intern.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/intern.c b/runtime/intern.c index aa7b1ccc1f2..7b7a2696988 100644 --- a/runtime/intern.c +++ b/runtime/intern.c @@ -263,7 +263,7 @@ static void readfloat(struct caml_intern_state* s, #else /* Host is neither big nor little; permute as appropriate */ if (code == CODE_DOUBLE_LITTLE) - Permute_64(dest, ARCH_FLOAT_ENDIANNESS, dest, 0x01234567) + Permute_64(dest, ARCH_FLOAT_ENDIANNESS, dest, 0x01234567); else Permute_64(dest, ARCH_FLOAT_ENDIANNESS, dest, 0x76543210); #endif From 5d417433b5f06ec2a3d6cf66608b4016a6eaa3f3 Mon Sep 17 00:00:00 2001 From: Leo White Date: Wed, 4 Oct 2023 14:25:19 +0100 Subject: [PATCH 135/402] Give hints about existential types appearing in error messages (#12622) --- Changes | 3 + manual/src/tutorials/gadtexamples.etex | 10 +- .../tests/printing-types/existentials.ml | 112 ++++++++++++++++++ .../tests/typing-gadts/dynamic_frisch.ml | 4 +- testsuite/tests/typing-gadts/or_patterns.ml | 5 +- testsuite/tests/typing-gadts/pr6980.ml | 3 +- testsuite/tests/typing-gadts/pr7222.ml | 5 +- testsuite/tests/typing-gadts/test.ml | 13 +- .../typing-gadts/unexpected_existentials.ml | 12 +- testsuite/tests/typing-short-paths/errors.ml | 10 +- typing/btype.ml | 4 + typing/btype.mli | 1 + typing/ctype.ml | 37 ++++-- typing/ctype.mli | 4 +- typing/env.ml | 4 +- typing/predef.ml | 4 +- typing/printtyp.ml | 107 +++++++++++++---- typing/typeclass.ml | 4 +- typing/typecore.ml | 26 ++-- typing/typecore.mli | 2 +- typing/typedecl.ml | 16 +-- typing/typemod.ml | 2 +- typing/types.ml | 9 +- typing/types.mli | 9 +- utils/misc.ml | 6 + utils/misc.mli | 2 + 26 files changed, 309 insertions(+), 105 deletions(-) create mode 100644 testsuite/tests/printing-types/existentials.ml diff --git a/Changes b/Changes index 44a19c000b8..bfbb292c642 100644 --- a/Changes +++ b/Changes @@ -266,6 +266,9 @@ Working version module (e.g `module M = Int(Int)`) (Florian Angeletti, review by Gabriel Scherer) +- #12622: Give hints about existential types appearing in error messages + (Leo White, review by Gabriel Scherer and Florian Angeletti) + ### Internal/compiler-libs changes: - #12447: Remove 32-bit targets from X86_proc.system diff --git a/manual/src/tutorials/gadtexamples.etex b/manual/src/tutorials/gadtexamples.etex index bc93d15cfd0..44726845177 100644 --- a/manual/src/tutorials/gadtexamples.etex +++ b/manual/src/tutorials/gadtexamples.etex @@ -237,18 +237,12 @@ existential types using compiler-generated names. Currently, the compiler generates these names according to the following nomenclature: \begin{itemize} \item First, types whose name starts with a "$" are existentials. -\item "$Constr_'a" denotes an existential type introduced for the type -variable "'a" of the GADT constructor "Constr": +\item "$a" denotes an existential type introduced for the type +variable "'a" of a GADT constructor: \begin{caml_example}{verbatim}[error] type any = Any : 'name -> any let escape (Any x) = x \end{caml_example} -\item "$Constr" denotes an existential type introduced for an anonymous %$ -type variable in the GADT constructor "Constr": -\begin{caml_example}{verbatim}[error] -type any = Any : _ -> any -let escape (Any x) = x -\end{caml_example} \item "$'a" if the existential variable was unified with the type %$ variable "'a" during typing: \begin{caml_example}{verbatim}[error] diff --git a/testsuite/tests/printing-types/existentials.ml b/testsuite/tests/printing-types/existentials.ml new file mode 100644 index 00000000000..464881f6d7c --- /dev/null +++ b/testsuite/tests/printing-types/existentials.ml @@ -0,0 +1,112 @@ +(* TEST + expect; +*) + +type foo1 = + | Foo : ('a * 'b * 'c * 'd * 'e * 'f) -> foo1 + +let bar1 x = + match x with + | Foo a -> a + 1 + | _ -> 0 +;; +[%%expect {| +type foo1 = Foo : ('a * 'b * 'c * 'd * 'e * 'f) -> foo1 +Line 6, characters 13-14: +6 | | Foo a -> a + 1 + ^ +Error: This expression has type "$a * $b * $c * $d * $e * $f" + but an expression was expected of type "int" + Hint: "$a", "$b", "$c", "$d", "$e" and "$f" are existential types + bound by the constructor "Foo". +|}] + +type foo2 = + | Foo1 : 'a -> foo2 + | Foo2 : 'a -> foo2 + | Foo3 : 'a -> foo2 + | Foo4 : 'a -> foo2 + | Foo5 : 'a -> foo2 + | Foo6 : 'a -> foo2 + | Foo7 : 'a -> foo2 + +let bar2 x = + match x with + | Foo1 a1, Foo2 a2, Foo3 a3, Foo4 a4, Foo5 a5, Foo6 a6, Foo7 a7 -> + let x = (a1, a2, a3, a4, a5, a6, a7) in x + 1 + | _ -> 0 +;; +[%%expect {| +type foo2 = + Foo1 : 'a -> foo2 + | Foo2 : 'a -> foo2 + | Foo3 : 'a -> foo2 + | Foo4 : 'a -> foo2 + | Foo5 : 'a -> foo2 + | Foo6 : 'a -> foo2 + | Foo7 : 'a -> foo2 +Line 13, characters 46-47: +13 | let x = (a1, a2, a3, a4, a5, a6, a7) in x + 1 + ^ +Error: This expression has type "$a * $a1 * $a2 * $a3 * $a4 * $a5 * $a6" + but an expression was expected of type "int" + Hint: "$a" is an existential type bound by the constructor "Foo1". + Hint: "$a1" is an existential type bound by the constructor "Foo2". + Hint: "$a2" is an existential type bound by the constructor "Foo3". + Hint: "$a3" is an existential type bound by the constructor "Foo4". + Hint: "$a4" is an existential type bound by the constructor "Foo5". + Hint: "$a5" is an existential type bound by the constructor "Foo6". + Hint: "$a6" is an existential type bound by the constructor "Foo7". +|}] + +type foo3 = + | Foo1 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo2 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo3 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo4 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo5 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo6 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo7 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + +let bar2 x = + match x with + | Foo1 a1, Foo2 a2, Foo3 a3, Foo4 a4, Foo5 a5, Foo6 a6, Foo7 a7 -> + let x = (a1, a2, a3, a4, a5, a6, a7) in x + 1 + | _ -> 0 +;; +[%%expect {| +type foo3 = + Foo1 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo2 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo3 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo4 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo5 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo6 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 + | Foo7 : ('a * 'b * 'c * 'd * 'e * 'f) -> foo3 +Line 13, characters 46-47: +13 | let x = (a1, a2, a3, a4, a5, a6, a7) in x + 1 + ^ +Error: This expression has type + "($a * $b * $c * $d * $e * $f) * + ($a1 * $b1 * $c1 * $d1 * $e1 * $f1) * + ($a2 * $b2 * $c2 * $d2 * $e2 * $f2) * + ($a3 * $b3 * $c3 * $d3 * $e3 * $f3) * + ($a4 * $b4 * $c4 * $d4 * $e4 * $f4) * + ($a5 * $b5 * $c5 * $d5 * $e5 * $f5) * + ($a6 * $b6 * $c6 * $d6 * $e6 * $f6)" + but an expression was expected of type "int" + Hint: "$a", "$b", "$c", "$d", "$e" and "$f" are existential types + bound by the constructor "Foo1". + Hint: "$a1", "$b1", "$c1", "$d1", "$e1" and "$f1" are existential types + bound by the constructor "Foo2". + Hint: "$a2", "$b2", "$c2", "$d2", "$e2" and "$f2" are existential types + bound by the constructor "Foo3". + Hint: "$a3", "$b3", "$c3", "$d3", "$e3" and "$f3" are existential types + bound by the constructor "Foo4". + Hint: "$a4", "$b4", "$c4", "$d4", "$e4" and "$f4" are existential types + bound by the constructor "Foo5". + Hint: "$a5", "$b5", "$c5", "$d5", "$e5" and "$f5" are existential types + bound by the constructor "Foo6". + Hint: "$a6", "$b6", "$c6", "$d6", "$e6" and "$f6" are existential types + bound by the constructor "Foo7". +|}] diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml b/testsuite/tests/typing-gadts/dynamic_frisch.ml index f24cd9ada31..c77b2043c59 100644 --- a/testsuite/tests/typing-gadts/dynamic_frisch.ml +++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml @@ -605,9 +605,9 @@ Line 7, characters 41-58: 7 | | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p))) ^^^^^^^^^^^^^^^^^ Error: This pattern matches values of type "a * a vlist" - but a pattern was expected which matches values of type - "$Tdyn_'a" = "$0 * $1" + but a pattern was expected which matches values of type "$a" = "$0 * $1" Type "a" is not compatible with type "$0" + Hint: "$a" is an existential type bound by the constructor "Tdyn". |}];; (* Define Sum using object instead of record for first-class polymorphism *) diff --git a/testsuite/tests/typing-gadts/or_patterns.ml b/testsuite/tests/typing-gadts/or_patterns.ml index 5f6e8e2db41..fda50eb1834 100644 --- a/testsuite/tests/typing-gadts/or_patterns.ml +++ b/testsuite/tests/typing-gadts/or_patterns.ml @@ -761,6 +761,7 @@ let f = function Line 2, characters 6-7: 2 | | A x ^ -Error: This pattern matches values of type "$A_'a" - The type constructor "$A_'a" would escape its scope +Error: This pattern matches values of type "$a" + The type constructor "$a" would escape its scope + Hint: "$a" is an existential type bound by the constructor "A". |}] diff --git a/testsuite/tests/typing-gadts/pr6980.ml b/testsuite/tests/typing-gadts/pr6980.ml index 127cc2a17ec..d04db3dff10 100644 --- a/testsuite/tests/typing-gadts/pr6980.ml +++ b/testsuite/tests/typing-gadts/pr6980.ml @@ -26,6 +26,7 @@ Line 11, characters 27-29: ^^ Error: This expression has type "[< `Bar | `Foo > `Bar ]" but an expression was expected of type "[< `Bar | `Foo ]" - The second variant type is bound to "$Aux_'a", + The second variant type is bound to "$a", it may not allow the tag(s) "`Bar" + Hint: "$a" is an existential type bound by the constructor "Aux". |}];; diff --git a/testsuite/tests/typing-gadts/pr7222.ml b/testsuite/tests/typing-gadts/pr7222.ml index 5b356a0ccf4..b27ca51e9ab 100644 --- a/testsuite/tests/typing-gadts/pr7222.ml +++ b/testsuite/tests/typing-gadts/pr7222.ml @@ -23,8 +23,9 @@ type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t Line 9, characters 11-18: 9 | let Cons(Elt dim, _) = sh in () ^^^^^^^ -Error: This pattern matches values of type "($Cons_'x, 'a -> $Cons_'x) elt" +Error: This pattern matches values of type "($x, 'a -> $x) elt" but a pattern was expected which matches values of type - "($Cons_'x, 'a -> $'b -> nil) elt" + "($x, 'a -> $'b -> nil) elt" The type constructor "$'b" would escape its scope + Hint: "$x" is an existential type bound by the constructor "Cons". |}];; diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml index bd38fafd945..adc0faabf4a 100644 --- a/testsuite/tests/typing-gadts/test.ml +++ b/testsuite/tests/typing-gadts/test.ml @@ -293,9 +293,10 @@ module Existential_escape = Line 5, characters 21-22: 5 | let eval (D x) = x ^ -Error: This expression has type "$D_'a t" - but an expression was expected of type "'a" - The type constructor "$D_'a" would escape its scope +Error: This expression has type "$a t" but an expression was expected of type + "'a" + The type constructor "$a" would escape its scope + Hint: "$a" is an existential type bound by the constructor "D". |}];; module Rectype = @@ -1353,10 +1354,11 @@ module M : Line 9, characters 4-5: 9 | z#b ^ -Error: This expression has type "$C_'a" = "< b : bool >" +Error: This expression has type "$a" = "< b : bool >" but an expression was expected of type "< b : 'a; .. >" This instance of "< b : bool >" is ambiguous: it would escape the scope of its equation + Hint: "$a" is an existential type bound by the constructor "C". |}] (* Check got/expected when the order changes *) @@ -1380,8 +1382,9 @@ module M : Line 9, characters 4-5: 9 | z#b ^ -Error: This expression has type "$C_'a" = "< b : bool >" +Error: This expression has type "$a" = "< b : bool >" but an expression was expected of type "< b : 'a; .. >" This instance of "< b : bool >" is ambiguous: it would escape the scope of its equation + Hint: "$a" is an existential type bound by the constructor "C". |}] diff --git a/testsuite/tests/typing-gadts/unexpected_existentials.ml b/testsuite/tests/typing-gadts/unexpected_existentials.ml index b764d9d38a7..e176cc92359 100644 --- a/testsuite/tests/typing-gadts/unexpected_existentials.ml +++ b/testsuite/tests/typing-gadts/unexpected_existentials.ml @@ -14,7 +14,7 @@ Line 1, characters 4-9: 1 | let Any x = Any () ^^^^^ Error: Existential types are not allowed in toplevel bindings, - but this pattern introduces the existential type "$Any_'a". + but the constructor "Any" introduces existential types. |}] let () = @@ -25,7 +25,7 @@ Line 2, characters 6-11: 2 | let Any x = Any () and () = () in ^^^^^ Error: Existential types are not allowed in "let ... and ..." bindings, - but this pattern introduces the existential type "$Any_'a". + but the constructor "Any" introduces existential types. |}] @@ -37,7 +37,7 @@ Line 2, characters 10-15: 2 | let rec Any x = Any () in ^^^^^ Error: Existential types are not allowed in recursive bindings, - but this pattern introduces the existential type "$Any_'a". + but the constructor "Any" introduces existential types. |}] @@ -49,7 +49,7 @@ Line 2, characters 18-23: 2 | let[@attribute] Any x = Any () in ^^^^^ Error: Existential types are not allowed in presence of attributes, - but this pattern introduces the existential type "$Any_'a". + but the constructor "Any" introduces existential types. |}] @@ -59,7 +59,7 @@ Line 1, characters 8-15: 1 | class c (Any x) = object end ^^^^^^^ Error: Existential types are not allowed in class arguments, - but this pattern introduces the existential type "$Any_'a". + but the constructor "Any" introduces existential types. |}] class c = object(Any x)end @@ -68,7 +68,7 @@ Line 1, characters 16-23: 1 | class c = object(Any x)end ^^^^^^^ Error: Existential types are not allowed in self patterns, - but this pattern introduces the existential type "$Any_'a". + but the constructor "Any" introduces existential types. |}] type other = Any: _ -> other diff --git a/testsuite/tests/typing-short-paths/errors.ml b/testsuite/tests/typing-short-paths/errors.ml index 67c5ae70bbf..f083789370e 100644 --- a/testsuite/tests/typing-short-paths/errors.ml +++ b/testsuite/tests/typing-short-paths/errors.ml @@ -51,8 +51,8 @@ type pair = Pair : 'a ty * 'a -> pair Line 9, characters 22-23: 9 | | Pair (Char, x) -> x + 1 ^ -Error: This expression has type "$Pair_'a" - but an expression was expected of type "int" +Error: This expression has type "$a" but an expression was expected of type "int" + Hint: "$a" is an existential type bound by the constructor "Pair". |}] type _ ty = Char : char ty @@ -68,8 +68,8 @@ type pair = Pair : 'a ty * 'a -> pair Line 7, characters 35-36: 7 | | Pair (Char, x) -> if true then x else 'd' ^ -Error: This expression has type "$Pair_'a" - but an expression was expected of type "'a" - This instance of "$Pair_'a" is ambiguous: +Error: This expression has type "$a" but an expression was expected of type "'a" + This instance of "$a" is ambiguous: it would escape the scope of its equation + Hint: "$a" is an existential type bound by the constructor "Pair". |}] diff --git a/typing/btype.ml b/typing/btype.ml index 89e71f622cb..f3b9594088c 100644 --- a/typing/btype.ml +++ b/typing/btype.ml @@ -127,6 +127,10 @@ 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 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 dummy_method = "*dummy method*" diff --git a/typing/btype.mli b/typing/btype.mli index d3720957ca0..fb8676a867a 100644 --- a/typing/btype.mli +++ b/typing/btype.mli @@ -79,6 +79,7 @@ val is_Tunivar: type_expr -> bool val is_Tconstr: type_expr -> bool val dummy_method: label val type_kind_is_abstract: type_declaration -> bool +val type_origin : type_declaration -> type_origin (**** polymorphic variants ****) diff --git a/typing/ctype.ml b/typing/ctype.ml index 00be1e3eec4..0178b19e477 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1272,7 +1272,7 @@ let get_new_abstract_name env s = let index = Misc.find_first_mono check in name index -let new_local_type ?(loc = Location.none) ?manifest_and_scope () = +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 @@ -1281,7 +1281,7 @@ let new_local_type ?(loc = Location.none) ?manifest_and_scope () = { type_params = []; type_arity = 0; - type_kind = Type_abstract Abstract_def; + type_kind = Type_abstract origin; type_private = Public; type_manifest = manifest; type_variance = []; @@ -1295,10 +1295,16 @@ let new_local_type ?(loc = Location.none) ?manifest_and_scope () = type_uid = Uid.mk ~current_unit:(Env.get_unit_name ()); } -let existential_name cstr ty = - match get_desc ty with - | Tvar (Some name) -> "$" ^ cstr.cstr_name ^ "_'" ^ name - | _ -> "$" ^ cstr.cstr_name +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 @@ -1306,6 +1312,7 @@ type existential_treatment = 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 @@ -1313,8 +1320,8 @@ let instance_constructor existential_treatment cstr = fun existential -> let env = penv.env in let fresh_constr_scope = penv.equations_scope in - let decl = new_local_type () in - let name = existential_name cstr existential 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 @@ -2200,7 +2207,7 @@ 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 () 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 *) @@ -2521,8 +2528,16 @@ let add_gadt_equation uenv source destination = 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) () in + new_local_type + ~manifest_and_scope:(destination, expansion_scope) + type_origin + in set_env uenv (Env.add_local_type source decl env); cleanup_abbrev () end @@ -5385,7 +5400,7 @@ let nondep_type_decl env mid is_covariant decl = 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 Abstract_def + with Nondep_cannot_erase _ when is_covariant -> Type_abstract Definition and tm, priv = match decl.type_manifest with | None -> None, decl.type_private diff --git a/typing/ctype.mli b/typing/ctype.mli index b38894b334e..caccfa3b444 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -173,8 +173,8 @@ 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) -> unit -> type_declaration -val existential_name: constructor_description -> type_expr -> string + ?manifest_and_scope:(type_expr * int) -> + type_origin -> type_declaration module Pattern_env : sig type t = private diff --git a/typing/env.ml b/typing/env.ml index 2eeca2231ac..7bd8e037e21 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -1136,7 +1136,7 @@ let rec find_type_data path env = | decl -> { tda_declaration = decl; - tda_descriptions = Type_abstract Abstract_def; + tda_descriptions = Type_abstract (Btype.type_origin decl); tda_shape = Shape.leaf decl.type_uid; } | exception Not_found -> begin @@ -2024,7 +2024,7 @@ and store_type_infos ~tda_shape id info env = let tda = { tda_declaration = info; - tda_descriptions = Type_abstract Abstract_def; + tda_descriptions = Type_abstract (Btype.type_origin info); tda_shape } in diff --git a/typing/predef.ml b/typing/predef.ml index 453f61a4472..7344be15fc2 100644 --- a/typing/predef.ml +++ b/typing/predef.ml @@ -135,7 +135,7 @@ 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 Abstract_def) env = + ?(immediate=Type_immediacy.Unknown) ?(kind=Type_abstract Definition) env = let decl = {type_params = []; type_arity = 0; @@ -158,7 +158,7 @@ let mk_add_type add_type type_ident ?manifest 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 Abstract_def) env = + ~variance ~separability ?(kind=fun _ -> Type_abstract Definition) env = let param = newgenvar () in let decl = {type_params = [param]; diff --git a/typing/printtyp.ml b/typing/printtyp.ml index ed511fb5d46..3cb5f616fc4 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -829,6 +829,70 @@ let printer_iter_type_expr f ty = | _ -> 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@}:@ %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@}:@ %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 @@ -906,11 +970,7 @@ end = struct || String.Set.mem name !named_weak_vars let rec new_name () = - let name = - if !name_counter < 26 - then String.make 1 (Char.chr(97 + !name_counter)) - else String.make 1 (Char.chr(97 + !name_counter mod 26)) ^ - Int.to_string(!name_counter / 26) in + let name = Misc.letter_of_int !name_counter in incr name_counter; if name_is_already_used name then new_name () else name @@ -1063,7 +1123,7 @@ let reset_loop_marks () = visited_objects := []; aliased := []; delayed := []; printed_aliases := [] let reset_except_context () = - Names.reset_names (); reset_loop_marks () + Names.reset_names (); reset_loop_marks (); Internal_names.reset () let reset () = Conflicts.reset (); @@ -1119,9 +1179,10 @@ let rec tree_of_typexp mode ty = let tyl' = apply_subst s tyl in if is_nth s && not (tyl'=[]) then tree_of_typexp mode (List.hd tyl') - else - let tpath = tree_of_best_type_path p p' in - Otyp_constr (tpath, tree_of_typlist mode 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 = @@ -1867,7 +1928,7 @@ let dummy = { type_params = []; type_arity = 0; - type_kind = Type_abstract Abstract_def; + type_kind = Type_abstract Definition; type_private = Public; type_manifest = None; type_variance = []; @@ -2285,7 +2346,11 @@ let explain_fixed_row pos expl = match expl with | Reified p -> dprintf "The %a variant type is bound to %a" Errortrace.print_pos pos - (Style.as_inline_code (fun ppf p -> print_path p ppf)) p + (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 @@ -2436,19 +2501,20 @@ let warn_on_missing_def env ppf t = match get_desc t with | Tconstr (p,_,_) -> begin match Env.find_type p env with - | { type_kind = Type_abstract Abstract_rec_check_regularity; _ } -> - fprintf ppf - "@,@[Type %a was considered abstract@ when checking\ - @ constraints@ in this@ recursive type definition.@]" - (Style.as_inline_code path) p | exception Not_found -> fprintf ppf "@,@[Type %a is abstract because@ no corresponding\ @ cmi file@ was found@ in path.@]" (Style.as_inline_code path) p - | {type_kind = - Type_abstract Abstract_def | Type_record _ | Type_variant _ | Type_open } - -> () - end + | { type_manifest = Some _; _ } -> () + | { type_manifest = None; _ } as decl -> + match type_origin decl with + | Rec_check_regularity -> + fprintf ppf + "@,@[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 @@ -2503,6 +2569,7 @@ let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation = (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 -> diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 42920e4b293..d8ee4d3dd8b 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -1448,7 +1448,7 @@ let temp_abbrev loc arity uid = let ty_td = {type_params = !params; type_arity = arity; - type_kind = Type_abstract Abstract_def; + type_kind = Type_abstract Definition; type_private = Public; type_manifest = Some ty; type_variance = Variance.unknown_signature ~injective:false ~arity; @@ -1672,7 +1672,7 @@ let class_infos define_class kind { type_params = obj_params; type_arity = arity; - type_kind = Type_abstract Abstract_def; + type_kind = Type_abstract Definition; type_private = Public; type_manifest = Some obj_ty; type_variance = Variance.unknown_signature ~injective:false ~arity; diff --git a/typing/typecore.ml b/typing/typecore.ml index c927145f32d..473ef12fee5 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -169,7 +169,7 @@ type error = | Modules_not_allowed | Cannot_infer_signature | Not_a_packed_module of type_expr - | Unexpected_existential of existential_restriction * string * string list + | Unexpected_existential of existential_restriction * string | Invalid_interval | Invalid_for_loop_index | No_value_clauses @@ -752,7 +752,7 @@ let solve_constructor_annotation let ids = List.map (fun name -> - let decl = new_local_type ~loc:name.loc () in + let decl = new_local_type ~loc:name.loc Definition in let (id, new_env) = Env.enter_type ~scope:expansion_scope name.txt decl !!penv in Pattern_env.set_env penv new_env; @@ -1703,10 +1703,9 @@ and type_pat_aux in begin match no_existentials, constr.cstr_existentials with | None, _ | _, [] -> () - | Some r, (_ :: _ as exs) -> - let exs = List.map (Ctype.existential_name constr) exs in + | Some r, (_ :: _) -> let name = constr.cstr_name in - raise (Error (loc, !!penv, Unexpected_existential (r, name, exs))) + raise (Error (loc, !!penv, Unexpected_existential (r, name))) end; let sarg', existential_styp = match sarg with @@ -4393,7 +4392,7 @@ and type_newtype (* Use [with_local_level] just for scoping *) with_local_level begin fun () -> (* Create a fake abstract type declaration for [name]. *) - let decl = new_local_type ~loc () in + let decl = new_local_type ~loc Definition in let scope = create_scope () in let (id, new_env) = Env.enter_type ~scope name decl env in @@ -6744,7 +6743,7 @@ let report_error ~loc env = function 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, types) -> + | Unexpected_existential (reason, name) -> let reason_str = match reason with | In_class_args -> @@ -6765,16 +6764,9 @@ let report_error ~loc env = function dprintf "Existential types are not allowed in presence of attributes" in - begin match List.find (fun ty -> ty <> "$" ^ name) types with - | example -> - Location.errorf ~loc - "%t,@ but this pattern introduces the existential type %a." - reason_str Style.inline_code example - | exception Not_found -> - Location.errorf ~loc - "%t,@ but the constructor %a introduces existential types." - reason_str Style.inline_code name - end + 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.@]" diff --git a/typing/typecore.mli b/typing/typecore.mli index 4f2bff38cec..3c0c7a78a5c 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -203,7 +203,7 @@ type error = | Modules_not_allowed | Cannot_infer_signature | Not_a_packed_module of type_expr - | Unexpected_existential of existential_restriction * string * string list + | Unexpected_existential of existential_restriction * string | Invalid_interval | Invalid_for_loop_index | No_value_clauses diff --git a/typing/typedecl.ml b/typing/typedecl.ml index fcee399fdd2..5fce1591e88 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -116,17 +116,17 @@ let enter_type ?abstract_abbrevs rec_flag env sdecl (id, uid) = in let arity = List.length sdecl.ptype_params in if not needed then env else - let abstract_reason, type_manifest = + let abstract_source, type_manifest = match sdecl.ptype_manifest, abstract_abbrevs with - | None, _ -> Abstract_def, None - | Some _, None -> Abstract_def, Some (Btype.newgenvar ()) + | None, _ -> Definition, None + | Some _, None -> Definition, Some (Btype.newgenvar ()) | 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_reason; + type_kind = Type_abstract abstract_source; type_private = sdecl.ptype_private; type_manifest = type_manifest; type_variance = Variance.unknown_signature ~injective:false ~arity; @@ -374,7 +374,7 @@ let transl_declaration env sdecl (id, uid) = in let (tkind, kind) = match sdecl.ptype_kind with - | Ptype_abstract -> Ttype_abstract, Type_abstract Abstract_def + | 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 @@ -1140,7 +1140,7 @@ let transl_type_decl env rec_flag sdecl_list = cannot be expanded (#12334, #12368) *) let abs_env = List.fold_left2 - (enter_type ~abstract_abbrevs:Abstract_rec_check_regularity rec_flag) + (enter_type ~abstract_abbrevs:Rec_check_regularity rec_flag) env sdecl_list ids_list in List.iter (check_abbrev_regularity ~abs_env new_env id_loc_list to_check) @@ -1709,7 +1709,7 @@ let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env if arity_ok && man <> None then sig_decl.type_kind, sig_decl.type_unboxed_default else - Type_abstract Abstract_def, false + Type_abstract Definition, false in let new_sig_decl = { type_params = params; @@ -1792,7 +1792,7 @@ let abstract_type_decl ~injective arity = Ctype.with_local_level ~post:generalize_decl begin fun () -> { type_params = make_params arity; type_arity = arity; - type_kind = Type_abstract Abstract_def; + type_kind = Type_abstract Definition; type_private = Public; type_manifest = None; type_variance = Variance.unknown_signature ~injective ~arity; diff --git a/typing/typemod.ml b/typing/typemod.ml index 84e8f85b512..55365987bec 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -499,7 +499,7 @@ let merge_constraint initial_env loc sg lid constr = type_params = List.map (fun _ -> Btype.newgenvar()) sdecl.ptype_params; type_arity = arity; - type_kind = Type_abstract Abstract_def; + type_kind = Type_abstract Definition; type_private = Private; type_manifest = None; type_variance = diff --git a/typing/types.ml b/typing/types.ml index ac1497e3dbc..997e78d4923 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -250,14 +250,15 @@ type type_declaration = and type_decl_kind = (label_declaration, constructor_declaration) type_kind and ('lbl, 'cstr) type_kind = - Type_abstract of abstract_reason + Type_abstract of type_origin | Type_record of 'lbl list * record_representation | Type_variant of 'cstr list * variant_representation | Type_open -and abstract_reason = - Abstract_def - | Abstract_rec_check_regularity +and type_origin = + Definition + | Rec_check_regularity + | Existential of string and record_representation = Record_regular (* All fields are boxed / tagged *) diff --git a/typing/types.mli b/typing/types.mli index 209c059eb9e..7ed7fc971ee 100644 --- a/typing/types.mli +++ b/typing/types.mli @@ -486,14 +486,15 @@ type type_declaration = and type_decl_kind = (label_declaration, constructor_declaration) type_kind and ('lbl, 'cstr) type_kind = - Type_abstract of abstract_reason + Type_abstract of type_origin | Type_record of 'lbl list * record_representation | Type_variant of 'cstr list * variant_representation | Type_open -and abstract_reason = - Abstract_def - | Abstract_rec_check_regularity (* See Typedecl.transl_type_decl *) +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 *) diff --git a/utils/misc.ml b/utils/misc.ml index d19b5cdc9d5..bd34e66cc9b 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -398,6 +398,12 @@ let no_overflow_mul a b = 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 = diff --git a/utils/misc.mli b/utils/misc.mli index e75e2aab0ad..9dd6351b012 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -307,6 +307,8 @@ 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}, From 16499659bc45529c652c4c3a282f863a4901a0dc Mon Sep 17 00:00:00 2001 From: Vincent Laviron Date: Wed, 4 Oct 2023 15:31:15 +0200 Subject: [PATCH 136/402] Remove the Closure module from Obj (#12625) This module was introduced in #9691, for use in CamlinternalMod, but rendered obsolete by #10205. --- Changes | 3 +++ stdlib/.depend | 2 -- stdlib/obj.ml | 27 --------------------------- stdlib/obj.mli | 8 -------- 4 files changed, 3 insertions(+), 37 deletions(-) diff --git a/Changes b/Changes index bfbb292c642..a4045463e3c 100644 --- a/Changes +++ b/Changes @@ -187,6 +187,9 @@ Working version (Guillaume Munch-Maccagnoni, review by KC Sivaramakrishnan and Gabriel Scherer) +- #12625: Remove the Closure module from Obj + (Vincent Laviron, review by Xavier Leroy) + ### Other libraries: - #12213: Dynlink library, improve legibility of error messages diff --git a/stdlib/.depend b/stdlib/.depend index 35298eda380..0aeabb685c5 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -532,12 +532,10 @@ stdlib__Nativeint.cmx : nativeint.ml \ stdlib__Nativeint.cmi : nativeint.mli stdlib__Obj.cmo : obj.ml \ stdlib__Sys.cmi \ - stdlib__Nativeint.cmi \ stdlib__Int32.cmi \ stdlib__Obj.cmi stdlib__Obj.cmx : obj.ml \ stdlib__Sys.cmx \ - stdlib__Nativeint.cmx \ stdlib__Int32.cmx \ stdlib__Obj.cmi stdlib__Obj.cmi : obj.mli \ diff --git a/stdlib/obj.ml b/stdlib/obj.ml index f2a7e3fa052..0393fc58858 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -68,33 +68,6 @@ let int_tag = 1000 let out_of_heap_tag = 1001 let unaligned_tag = 1002 -module Closure = struct - type info = { - arity: int; - start_env: int; - } - - let info_of_raw (info : nativeint) = - let open Nativeint in - let arity = - (* signed: negative for tupled functions *) - if Sys.word_size = 64 then - to_int (shift_right info 56) - else - to_int (shift_right info 24) - in - let start_env = - (* start_env is unsigned, but we know it can always fit an OCaml - integer so we use [to_int] instead of [unsigned_to_int]. *) - to_int (shift_right_logical (shift_left info 8) 9) in - { arity; start_env } - - (* note: we expect a closure, not an infix pointer *) - let info (obj : t) = - assert (tag obj = closure_tag); - info_of_raw (raw_field obj 1) -end - module Extension_constructor = struct type t = extension_constructor diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 4e3bad8b66e..8f3cb245647 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -92,14 +92,6 @@ val int_tag : int val out_of_heap_tag : int val unaligned_tag : int (* should never happen @since 3.11 *) -module Closure : sig - type info = { - arity: int; - start_env: int; - } - val info : t -> info -end - module Extension_constructor : sig type t = extension_constructor From 155724d29a5ebe3cd717410a34e65fadfa2729ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Mon, 25 Sep 2023 18:12:58 +0200 Subject: [PATCH 137/402] Make ocamlc/ocamlopt fail when not given input files An invocation such as `ocamlc` (without any command-line parameters), or `ocamlc -o a.out` will now fail with an error message and an error code. --- Changes | 4 ++++ driver/compenv.ml | 12 ++++++++---- .../test-no-input-file.compilers.reference | 2 ++ .../tool-command-line/test-no-input-file.ml | 16 ++++++++++++++++ 4 files changed, 30 insertions(+), 4 deletions(-) create mode 100644 testsuite/tests/tool-command-line/test-no-input-file.compilers.reference create mode 100644 testsuite/tests/tool-command-line/test-no-input-file.ml diff --git a/Changes b/Changes index a4045463e3c..7b298ddd467 100644 --- a/Changes +++ b/Changes @@ -221,6 +221,10 @@ Working version - #12615: ocamldoc: get rid of the odoc_literate and odoc_todo generators. (Sébaistien Hinderer, review by Gabriel Scherer and Florian Angeletti) +* #12497, #12613: Make ocamlc/ocamlopt fail with an error when no + input files are specified to build an executable. + (Antonin Décimo, review by Sébastien Hinderer) + ### Manual and documentation: - #12338: clarification of the documentation of process related function in diff --git a/driver/compenv.ml b/driver/compenv.ml index 866cc2360da..17e52d885c3 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -687,10 +687,14 @@ let process_deferred_actions env = fatal "Options -c -o are incompatible with compiling multiple files" end; end; - if !make_archive && List.exists (function - | ProcessOtherFile name -> Filename.check_suffix name ".cmxa" - | _ -> false) !deferred_actions then - fatal "Option -a cannot be used with .cmxa input files."; + if !make_archive then begin + if List.exists (function + | ProcessOtherFile name -> Filename.check_suffix name ".cmxa" + | _ -> false) !deferred_actions then + fatal "Option -a cannot be used with .cmxa input files." + end + else if !deferred_actions = [] then + fatal "No input files"; List.iter (process_action env) (List.rev !deferred_actions); output_name := final_output_name; stop_early := diff --git a/testsuite/tests/tool-command-line/test-no-input-file.compilers.reference b/testsuite/tests/tool-command-line/test-no-input-file.compilers.reference new file mode 100644 index 00000000000..ad3071c5dfb --- /dev/null +++ b/testsuite/tests/tool-command-line/test-no-input-file.compilers.reference @@ -0,0 +1,2 @@ +No input files +No input files diff --git a/testsuite/tests/tool-command-line/test-no-input-file.ml b/testsuite/tests/tool-command-line/test-no-input-file.ml new file mode 100644 index 00000000000..b3279496496 --- /dev/null +++ b/testsuite/tests/tool-command-line/test-no-input-file.ml @@ -0,0 +1,16 @@ +(* TEST + setup-ocamlopt.opt-build-env; + all_modules = ""; + compile_only = "true"; + ocamlopt_opt_exit_status = "2"; + flags = ""; + ocamlopt.opt; + flags = "-o test.exe"; + ocamlopt.opt; + check-ocamlopt.opt-output; +*) + +(* + This file is just a test driver, the test does not contain any + real OCaml code + *) From e07e4334da5aac5200c0f9fb59570efe4b9cd184 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Wed, 27 Sep 2023 16:33:12 +0200 Subject: [PATCH 138/402] Capitalize error message for consistency --- driver/compenv.ml | 2 +- .../tool-command-line/test-unknown-file.compilers.reference | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/driver/compenv.ml b/driver/compenv.ml index 17e52d885c3..921c0565500 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -647,7 +647,7 @@ let process_action | Some start_from -> Location.input_name := name; impl ~start_from name - | None -> raise(Arg.Bad("don't know what to do with " ^ name)) + | None -> raise(Arg.Bad("Don't know what to do with " ^ name)) let action_of_file name = diff --git a/testsuite/tests/tool-command-line/test-unknown-file.compilers.reference b/testsuite/tests/tool-command-line/test-unknown-file.compilers.reference index 9182c8a7201..9099e9e4ae2 100644 --- a/testsuite/tests/tool-command-line/test-unknown-file.compilers.reference +++ b/testsuite/tests/tool-command-line/test-unknown-file.compilers.reference @@ -1 +1 @@ -don't know what to do with unknown-file +Don't know what to do with unknown-file From 6a0a0a469315eeafc926f148debd52b52da2bea0 Mon Sep 17 00:00:00 2001 From: Fabrice Date: Fri, 6 Oct 2023 10:04:54 +0200 Subject: [PATCH 139/402] Update framepointers tests to avoid false positive with inlined C functions (#11594) Another attempt to ignore potentially inlined C functions while still checking reasonable behavior In frame-pointers tests, the backtrace post-processing is performed directly in fp_backtrace, and so, no longer depends on filter-locations.sh (that was using sed and awk scripts). --- testsuite/tests/frame-pointers/c_call.ml | 14 +- .../tests/frame-pointers/c_call.reference | 9 - testsuite/tests/frame-pointers/c_call.run | 4 - testsuite/tests/frame-pointers/c_call_.c | 14 +- testsuite/tests/frame-pointers/effects.ml | 12 +- .../tests/frame-pointers/effects.reference | 15 -- testsuite/tests/frame-pointers/effects.run | 4 - .../tests/frame-pointers/exception_handler.ml | 4 +- .../exception_handler.reference | 12 -- .../frame-pointers/exception_handler.run | 4 - .../tests/frame-pointers/filter-locations.sh | 23 --- testsuite/tests/frame-pointers/fp_backtrace.c | 185 +++++++++++------- testsuite/tests/frame-pointers/reperform.ml | 4 +- .../tests/frame-pointers/reperform.reference | 3 - testsuite/tests/frame-pointers/reperform.run | 4 - .../tests/frame-pointers/stack_realloc.ml | 4 +- .../frame-pointers/stack_realloc.reference | 3 - .../tests/frame-pointers/stack_realloc.run | 4 - .../tests/frame-pointers/stack_realloc2.ml | 4 +- .../frame-pointers/stack_realloc2.reference | 3 - .../tests/frame-pointers/stack_realloc2.run | 4 - 21 files changed, 143 insertions(+), 190 deletions(-) delete mode 100644 testsuite/tests/frame-pointers/c_call.run delete mode 100644 testsuite/tests/frame-pointers/effects.run delete mode 100644 testsuite/tests/frame-pointers/exception_handler.run delete mode 100755 testsuite/tests/frame-pointers/filter-locations.sh delete mode 100644 testsuite/tests/frame-pointers/reperform.run delete mode 100644 testsuite/tests/frame-pointers/stack_realloc.run delete mode 100644 testsuite/tests/frame-pointers/stack_realloc2.run diff --git a/testsuite/tests/frame-pointers/c_call.ml b/testsuite/tests/frame-pointers/c_call.ml index 7d48b4947da..f552b0df8f4 100644 --- a/testsuite/tests/frame-pointers/c_call.ml +++ b/testsuite/tests/frame-pointers/c_call.ml @@ -5,20 +5,20 @@ native; *) -external fp_backtrace : unit -> unit = "fp_backtrace" -external fp_backtrace_no_alloc : unit -> unit = "fp_backtrace" [@@noalloc] -external fp_backtrace_many_args : int -> int -> int -> int -> int -> int -> int - -> int -> int -> int -> int -> unit = +external fp_backtrace : string -> unit = "fp_backtrace" +external fp_backtrace_no_alloc : string -> unit = "fp_backtrace" [@@noalloc] +external fp_backtrace_many_args : string -> int -> int -> int -> int -> int + -> int -> int -> int -> int -> int -> int -> unit = "fp_backtrace_many_args_argv" "fp_backtrace_many_args" let[@inline never] f () = (* Check backtrace through caml_c_call_stack_args *) - fp_backtrace_many_args 1 2 3 4 5 6 7 8 9 10 11; + fp_backtrace_many_args Sys.argv.(0) 1 2 3 4 5 6 7 8 9 10 11; (* Check backtrace through caml_c_call. * Also check that caml_c_call_stack_args correctly restores rbp register *) - fp_backtrace (); + fp_backtrace Sys.argv.(0); (* Check caml_c_call correctly restores rbp register *) - fp_backtrace_no_alloc (); + fp_backtrace_no_alloc Sys.argv.(0); 42 let () = ignore (f ()) diff --git a/testsuite/tests/frame-pointers/c_call.reference b/testsuite/tests/frame-pointers/c_call.reference index 92fb40a2389..23095e7431c 100644 --- a/testsuite/tests/frame-pointers/c_call.reference +++ b/testsuite/tests/frame-pointers/c_call.reference @@ -3,19 +3,10 @@ caml_c_call_stack_args camlC_call.f camlC_call.entry caml_program -caml_start_program -caml_main/caml_startup -main caml_c_call camlC_call.f camlC_call.entry caml_program -caml_start_program -caml_main/caml_startup -main camlC_call.f camlC_call.entry caml_program -caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/c_call.run b/testsuite/tests/frame-pointers/c_call.run deleted file mode 100644 index e96b5ea13a1..00000000000 --- a/testsuite/tests/frame-pointers/c_call.run +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -${program} 2>&1 \ - | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/frame-pointers/c_call_.c b/testsuite/tests/frame-pointers/c_call_.c index 634c4dd9371..a75100b2137 100644 --- a/testsuite/tests/frame-pointers/c_call_.c +++ b/testsuite/tests/frame-pointers/c_call_.c @@ -16,10 +16,10 @@ #include #include "caml/mlvalues.h" -void fp_backtrace(void); +void fp_backtrace(value); -value fp_backtrace_many_args(value a, value b, value c, value d, value e, - value f, value g, value h, value i, value j, value k) +value fp_backtrace_many_args(value argv0, value a, value b, value c, + value d, value e, value f, value g, value h, value i, value j, value k) { assert(Int_val(a) == 1); assert(Int_val(b) == 2); @@ -33,15 +33,15 @@ value fp_backtrace_many_args(value a, value b, value c, value d, value e, assert(Int_val(j) == 10); assert(Int_val(k) == 11); - fp_backtrace(); + fp_backtrace(argv0); return Val_unit; } -value fp_bactrace_many_args_argv(value *argv, int argc) +value fp_bactrace_many_args_argv(value argv0, value *argv, int argc) { assert(argc == 11); - return fp_backtrace_many_args(argv[0], argv[1], argv[2], argv[3], argv[4], - argv[5], argv[6], argv[7], argv[8], argv[9], argv[10]); + return fp_backtrace_many_args(argv0, argv[0], argv[1], argv[2], argv[3], + argv[4], argv[5], argv[6], argv[7], argv[8], argv[9], argv[10]); } diff --git a/testsuite/tests/frame-pointers/effects.ml b/testsuite/tests/frame-pointers/effects.ml index 2aa70126065..ac304683fee 100644 --- a/testsuite/tests/frame-pointers/effects.ml +++ b/testsuite/tests/frame-pointers/effects.ml @@ -9,26 +9,26 @@ open Printf open Effect open Effect.Deep -external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc] +external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc] type _ t += E : int -> int t let[@inline never] f () = printf "# computation f\n%!"; - fp_backtrace (); + fp_backtrace Sys.argv.(0); printf "# perform effect (E 0)\n%!"; let v = perform (E 0) in printf "# perform returns %d\n%!" v; - fp_backtrace (); + fp_backtrace Sys.argv.(0); v + 1 let h (type a) (eff : a t) : ((a, 'b) continuation -> 'b) option = let[@inline never] h_effect_e v k = printf "# caught effect (E %d). continuing...\n%!" v; - fp_backtrace (); + fp_backtrace Sys.argv.(0); let v = continue k (v + 1) in printf "# continue returns %d\n%!" v; - fp_backtrace (); + fp_backtrace Sys.argv.(0); v + 1 in match eff with @@ -39,7 +39,7 @@ let h (type a) (eff : a t) : ((a, 'b) continuation -> 'b) option = let v = let[@inline never] v_retc v = printf "# done %d\n%!" v; - fp_backtrace (); + fp_backtrace Sys.argv.(0); v + 1 in match_with f () diff --git a/testsuite/tests/frame-pointers/effects.reference b/testsuite/tests/frame-pointers/effects.reference index c8bd0a391a5..8ae3fc26dfb 100644 --- a/testsuite/tests/frame-pointers/effects.reference +++ b/testsuite/tests/frame-pointers/effects.reference @@ -3,39 +3,24 @@ camlEffects.f caml_runstack camlEffects.entry caml_program -caml_start_program -caml_main/caml_startup -main # perform effect (E 0) # caught effect (E 0). continuing... camlEffects.h_effect_e camlEffects.entry caml_program -caml_start_program -caml_main/caml_startup -main # perform returns 1 camlEffects.f caml_runstack camlEffects.h_effect_e camlEffects.entry caml_program -caml_start_program -caml_main/caml_startup -main # done 2 camlEffects.v_retc camlEffects.h_effect_e camlEffects.entry caml_program -caml_start_program -caml_main/caml_startup -main # continue returns 3 camlEffects.h_effect_e camlEffects.entry caml_program -caml_start_program -caml_main/caml_startup -main # result=4 diff --git a/testsuite/tests/frame-pointers/effects.run b/testsuite/tests/frame-pointers/effects.run deleted file mode 100644 index e96b5ea13a1..00000000000 --- a/testsuite/tests/frame-pointers/effects.run +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -${program} 2>&1 \ - | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/frame-pointers/exception_handler.ml b/testsuite/tests/frame-pointers/exception_handler.ml index 6bf5bf470dd..19773f78de8 100644 --- a/testsuite/tests/frame-pointers/exception_handler.ml +++ b/testsuite/tests/frame-pointers/exception_handler.ml @@ -6,7 +6,7 @@ *) (* https://github.com/ocaml/ocaml/pull/11031 *) -external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc] +external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc] exception Exn1 exception Exn2 @@ -36,7 +36,7 @@ let[@inline never] handler () = let _ = Sys.opaque_identity x0 in let _ = Sys.opaque_identity x1 in let _ = Sys.opaque_identity x2 in - fp_backtrace () + fp_backtrace Sys.argv.(0) let[@inline never] nested i = begin diff --git a/testsuite/tests/frame-pointers/exception_handler.reference b/testsuite/tests/frame-pointers/exception_handler.reference index 513ca488b92..e012fb6d4ff 100644 --- a/testsuite/tests/frame-pointers/exception_handler.reference +++ b/testsuite/tests/frame-pointers/exception_handler.reference @@ -2,27 +2,15 @@ camlException_handler.handler camlException_handler.bare camlException_handler.entry caml_program -caml_start_program -caml_main/caml_startup -main camlException_handler.handler camlException_handler.bare camlException_handler.entry caml_program -caml_start_program -caml_main/caml_startup -main camlException_handler.handler camlException_handler.nested camlException_handler.entry caml_program -caml_start_program -caml_main/caml_startup -main camlException_handler.handler camlException_handler.nested camlException_handler.entry caml_program -caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/exception_handler.run b/testsuite/tests/frame-pointers/exception_handler.run deleted file mode 100644 index e96b5ea13a1..00000000000 --- a/testsuite/tests/frame-pointers/exception_handler.run +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -${program} 2>&1 \ - | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/frame-pointers/filter-locations.sh b/testsuite/tests/frame-pointers/filter-locations.sh deleted file mode 100755 index 31c7fc3189d..00000000000 --- a/testsuite/tests/frame-pointers/filter-locations.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -set -eu - -program="${1}" -# https://stackoverflow.com/questions/29613304/is-it-possible-to-escape-regex-metacharacters-reliably-with-sed/29626460#29626460 -program_escaped=$(echo ${program} | sed 's/[^^\\]/[&]/g; s/\^/\\^/g; s/\\/\\\\/g') -regex_backtrace='^.*(\(.*\)+0x[[:xdigit:]]*)[0x[[:xdigit:]]*]$' -regex_trim_fun='^\(caml.*\)_[[:digit:]]*$' - -# - Ignore backtrace not coming from the program binary -# - Discard the number suffix from OCaml function name -# - Remove strange '[0x.....]' entries inserted by some implementation -# of backtrace_symbols_fd -# - Keep the other lines -sed -e \ - "/${regex_backtrace}/ { - /^${program_escaped}/ ! d - s/${regex_backtrace}/\1/ - s/${regex_trim_fun}/\1/ - s;caml_\(main\|startup\);caml_main/caml_startup; - }" \ - -e '/^\[0x/d' diff --git a/testsuite/tests/frame-pointers/fp_backtrace.c b/testsuite/tests/frame-pointers/fp_backtrace.c index a521218a387..693e3ea7d5b 100644 --- a/testsuite/tests/frame-pointers/fp_backtrace.c +++ b/testsuite/tests/frame-pointers/fp_backtrace.c @@ -1,10 +1,17 @@ #include -#include -#include -#include +#include +#include #include +#include +#include -#define ARRSIZE(a) (sizeof(a) / sizeof(*(a))) +#include "caml/mlvalues.h" + +#define ARR_SIZE(a) (sizeof(a) / sizeof(*(a))) + +#define RE_FUNC_NAME "^.*\\((.+)\\+0x[[:xdigit:]]+\\) \\[0x[[:xdigit:]]+\\]$" +#define RE_TRIM_FUNC "(caml.*)_[[:digit:]]+" +#define CAML_ENTRY "caml_program" typedef struct frame_info { @@ -12,99 +19,137 @@ typedef struct frame_info void* retaddr; /* rip */ } frame_info; -jmp_buf resume_buf; +/* + * A backtrace symbol looks like: + * ./path/to/binary(camlModule_fn_123+0xAABBCC) [0xAABBCCDDEE] + */ +static const char* backtrace_symbol(const struct frame_info* fi) +{ + char** symbols = backtrace_symbols(&fi->retaddr, 1); + if (!symbols) { + perror("backtrace_symbols"); + return NULL; + } + + const char* symbol = strdup(symbols[0]); + free(symbols); + return symbol; +} -static void signal_handler(int signum) +static bool is_from_executable(const char* symbol, const char* execname) { - /* Should be safe to be called from a signal handler. - * See 21.2.1 "Performing a nonlocal goto from a signal handler" from - * The Linux Programming Interface, Michael Kerrisk */ - siglongjmp(resume_buf, 1); + return strncmp(symbol, execname, strlen(execname)) == 0; } -static int install_signal_handlers(const int signals[], struct sigaction - handlers[], int count) +static regmatch_t func_name_from_symbol(const char* symbol) { - for (int i = 0; i < count; i++) { - struct sigaction action = { 0 }; - action.sa_handler = signal_handler; - sigemptyset(&action.sa_mask); - action.sa_flags = 0; - - if (sigaction(signals[i], &action, &handlers[i]) != 0) { - perror("sigaction"); - return -1; - } + regex_t regex; + regmatch_t match[2] = { {-1, -1}, {-1, -1}}; + char errbuf[128]; + int err; + + err = regcomp(®ex, RE_FUNC_NAME, REG_EXTENDED); + if (err) { + regerror(err, ®ex, errbuf, ARR_SIZE(errbuf)); + fprintf(stderr, "regcomp: %s\n", errbuf); + return match[0]; } - return 0; + + err = regexec(®ex, symbol, ARR_SIZE(match), match, 0); + if (err == REG_NOMATCH) + return match[0]; + + return match[1]; } -static int restore_signal_handlers(const int signals[], struct sigaction - handlers[], int count) +static bool is_caml_entry(const char* symbol, const regmatch_t* funcname) { - for (int i = 0; i < count; i++) { - if (sigaction(signals[i], &handlers[i], NULL) != 0) { - perror("sigaction"); - return -1; - } - } - return 0; + size_t len = funcname->rm_eo - funcname->rm_so; + return strncmp(symbol + funcname->rm_so, CAML_ENTRY, len) == 0; } -static int safe_read(const struct frame_info* fi, struct frame_info** prev, - void** retaddr) +static regmatch_t trim_func_name(const char* symbol, const regmatch_t* funcname) { - /* Signals to ignore while attempting to read frame_info members */ - const int signals[] = { SIGSEGV, SIGBUS }; - /* Store original signal handers */ - struct sigaction handlers[ARRSIZE(signals)] = { 0 }; - int ret = 0; - - if (install_signal_handlers(signals, handlers, ARRSIZE(signals)) != 0) - return -1; - - if (!sigsetjmp(resume_buf, 1)) { - *prev = fi->prev; - *retaddr = fi->retaddr; - } else { - ret = -1; + regex_t regex; + regmatch_t match[2] = { {-1, -1}, {-1, -1}}; + char errbuf[128]; + int err; + + err = regcomp(®ex, RE_TRIM_FUNC, REG_EXTENDED); + if (err) { + regerror(err, ®ex, errbuf, ARR_SIZE(errbuf)); + fprintf(stderr, "regcomp: %s\n", errbuf); + return match[0]; } - if (restore_signal_handlers(signals, handlers, ARRSIZE(signals)) != 0) - return -1; + match[0] = *funcname; + err = regexec(®ex, symbol, ARR_SIZE(match), match, REG_STARTEND); + if (err == REG_NOMATCH) { + /* match[0] has already been overwritten to hold the function full name for + regexec */ + return match[1]; + } - return ret; + return match[1]; } -static void print_location(void* addr) +static void print_symbol(const char* symbol, const regmatch_t* match) { - if (!addr) - return; + regoff_t off = match->rm_so; + regoff_t len = match->rm_eo - match->rm_so; - /* This requires the binary to be linked with '-rdynamic' */ - backtrace_symbols_fd(&addr, 1, STDOUT_FILENO); + fprintf(stdout, "%.*s\n", len, symbol + off); + fflush(stdout); } -void fp_backtrace(void) +void fp_backtrace(value argv0) { - struct frame_info *fi; - struct frame_info* next; - void* retaddr; + const char* execname = String_val(argv0); + struct frame_info* next = NULL; + const char* symbol = NULL; - fi = __builtin_frame_address(0); - retaddr = __builtin_extract_return_addr(__builtin_return_address(0)); - - for (; fi; fi = next) { - if (safe_read(fi, &next, &retaddr) != 0) - return; - - print_location(retaddr); + for (struct frame_info* fi = __builtin_frame_address(0); fi; fi = next) { + next = fi->prev; /* Detect the simplest kind of infinite loop */ if (fi == next) { - printf("fp_backtrace: loop detected\n"); - return; + fprintf(stderr, "fp_backtrace: loop detected\n"); + break; } + + symbol = backtrace_symbol(fi); + if (!symbol) + continue; + + /* Skip entries not from the test */ + if (!is_from_executable(symbol, execname)) + goto skip; + + /* Exctract the full function name */ + regmatch_t funcname = func_name_from_symbol(symbol); + if (funcname.rm_so == -1) + goto skip; + + /* Trim numeric suffix from caml functions */ + regmatch_t functrimmed = trim_func_name(symbol, &funcname); + + /* Use the trimmed caml name if available, otherwise use the full function + name */ + const regmatch_t* match = (functrimmed.rm_so != -1) ? + &functrimmed : &funcname; + + print_symbol(symbol, match); + + /* Stop the backtrace at caml_program */ + if (is_caml_entry(symbol, &funcname)) + break; + +skip: + free((void*)symbol); + symbol = NULL; } + + if (symbol) + free((void*)symbol); } diff --git a/testsuite/tests/frame-pointers/reperform.ml b/testsuite/tests/frame-pointers/reperform.ml index ec5393907c0..7a3b09162b5 100644 --- a/testsuite/tests/frame-pointers/reperform.ml +++ b/testsuite/tests/frame-pointers/reperform.ml @@ -8,7 +8,7 @@ open Effect open Effect.Deep -external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc] +external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc] type _ Effect.t += E : unit t | F : unit t @@ -19,7 +19,7 @@ let rec foo n = if n = 5 then begin perform E; print_endline "# resumed..."; - fp_backtrace () + fp_backtrace Sys.argv.(0) end; foo (n + 1) + n end diff --git a/testsuite/tests/frame-pointers/reperform.reference b/testsuite/tests/frame-pointers/reperform.reference index 9ac6681d4b1..e215f771692 100644 --- a/testsuite/tests/frame-pointers/reperform.reference +++ b/testsuite/tests/frame-pointers/reperform.reference @@ -15,6 +15,3 @@ camlReperform.bar caml_runstack camlReperform.entry caml_program -caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/reperform.run b/testsuite/tests/frame-pointers/reperform.run deleted file mode 100644 index e96b5ea13a1..00000000000 --- a/testsuite/tests/frame-pointers/reperform.run +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -${program} 2>&1 \ - | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/frame-pointers/stack_realloc.ml b/testsuite/tests/frame-pointers/stack_realloc.ml index fc4e9e9d3b2..cacc43c2165 100644 --- a/testsuite/tests/frame-pointers/stack_realloc.ml +++ b/testsuite/tests/frame-pointers/stack_realloc.ml @@ -10,7 +10,7 @@ open Effect.Deep type _ t += E : int -> int t -external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc] +external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc] external c_fun : unit -> int = "c_fun" let[@inline never][@local never] f x = x @@ -39,7 +39,7 @@ let[@inline never] consume_stack () = let[@inline never] callback () = consume_stack (); - fp_backtrace (); + fp_backtrace Sys.argv.(0); 0 let _ = Callback.register "callback" callback diff --git a/testsuite/tests/frame-pointers/stack_realloc.reference b/testsuite/tests/frame-pointers/stack_realloc.reference index 016a03550a3..e61d4104e0d 100644 --- a/testsuite/tests/frame-pointers/stack_realloc.reference +++ b/testsuite/tests/frame-pointers/stack_realloc.reference @@ -7,6 +7,3 @@ camlStack_realloc.f_comp caml_runstack camlStack_realloc.entry caml_program -caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/stack_realloc.run b/testsuite/tests/frame-pointers/stack_realloc.run deleted file mode 100644 index e96b5ea13a1..00000000000 --- a/testsuite/tests/frame-pointers/stack_realloc.run +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -${program} 2>&1 \ - | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/frame-pointers/stack_realloc2.ml b/testsuite/tests/frame-pointers/stack_realloc2.ml index a4aea249ea1..b2a602fa4a5 100644 --- a/testsuite/tests/frame-pointers/stack_realloc2.ml +++ b/testsuite/tests/frame-pointers/stack_realloc2.ml @@ -10,7 +10,7 @@ open Effect.Deep type _ t += E : int -> int t -external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc] +external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc] external c_fun : unit -> int = "c_fun" let[@inline never][@local never] f x = x @@ -38,7 +38,7 @@ let[@inline never] consume_stack () = ignore (gobbler count) let[@inline never] callback () = - fp_backtrace (); + fp_backtrace Sys.argv.(0); 0 let _ = Callback.register "callback" callback diff --git a/testsuite/tests/frame-pointers/stack_realloc2.reference b/testsuite/tests/frame-pointers/stack_realloc2.reference index ae492abd882..0051f3bad06 100644 --- a/testsuite/tests/frame-pointers/stack_realloc2.reference +++ b/testsuite/tests/frame-pointers/stack_realloc2.reference @@ -7,6 +7,3 @@ camlStack_realloc2.f_comp caml_runstack camlStack_realloc2.entry caml_program -caml_start_program -caml_main/caml_startup -main diff --git a/testsuite/tests/frame-pointers/stack_realloc2.run b/testsuite/tests/frame-pointers/stack_realloc2.run deleted file mode 100644 index e96b5ea13a1..00000000000 --- a/testsuite/tests/frame-pointers/stack_realloc2.run +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -${program} 2>&1 \ - | ${test_source_directory}/filter-locations.sh ${program} >${output} From 0814bec3de3eaedbe5ab3bdd11748a2cf92e86b5 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 5 Oct 2023 13:26:45 +0100 Subject: [PATCH 140/402] Avoid pointer arithmetic over void * --- otherlibs/unix/read_unix.c | 2 +- otherlibs/unix/read_win32.c | 4 ++-- otherlibs/unix/write_unix.c | 2 +- otherlibs/unix/write_win32.c | 4 ++-- runtime/io.c | 4 ++-- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/otherlibs/unix/read_unix.c b/otherlibs/unix/read_unix.c index f1f3e9058a4..d4ec6e08880 100644 --- a/otherlibs/unix/read_unix.c +++ b/otherlibs/unix/read_unix.c @@ -48,7 +48,7 @@ CAMLprim value caml_unix_read_bigarray(value fd, value vbuf, ofs = Long_val(vofs); len = Long_val(vlen); caml_enter_blocking_section(); - ret = read(Int_val(fd), buf + ofs, len); + ret = read(Int_val(fd), (char *) buf + ofs, len); caml_leave_blocking_section(); if (ret == -1) caml_uerror("read_bigarray", Nothing); CAMLreturn(Val_long(ret)); diff --git a/otherlibs/unix/read_win32.c b/otherlibs/unix/read_win32.c index 981a6824031..ad26f1e76e1 100644 --- a/otherlibs/unix/read_win32.c +++ b/otherlibs/unix/read_win32.c @@ -78,7 +78,7 @@ CAMLprim value caml_unix_read_bigarray(value fd, value vbuf, SOCKET s = Socket_val(fd); if (len > INT_MAX) len = INT_MAX; caml_enter_blocking_section(); - ret = recv(s, buf + ofs, len, 0); + ret = recv(s, (char *)buf + ofs, len, 0); if (ret == SOCKET_ERROR) err = WSAGetLastError(); caml_leave_blocking_section(); numread = ret; @@ -86,7 +86,7 @@ CAMLprim value caml_unix_read_bigarray(value fd, value vbuf, HANDLE h = Handle_val(fd); if (len > 0xFFFFFFFF) len = 0xFFFFFFFF; caml_enter_blocking_section(); - if (! ReadFile(h, buf + ofs, len, &numread, NULL)) + if (! ReadFile(h, (char *)buf + ofs, len, &numread, NULL)) err = GetLastError(); caml_leave_blocking_section(); } diff --git a/otherlibs/unix/write_unix.c b/otherlibs/unix/write_unix.c index ac9b91f1ee9..063f3422304 100644 --- a/otherlibs/unix/write_unix.c +++ b/otherlibs/unix/write_unix.c @@ -68,7 +68,7 @@ CAMLprim value caml_unix_write_bigarray(value fd, value vbuf, written = 0; caml_enter_blocking_section(); while (len > 0) { - ret = write(Int_val(fd), buf + ofs, len); + ret = write(Int_val(fd), (char *) buf + ofs, len); if (ret == -1) { if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break; caml_leave_blocking_section(); diff --git a/otherlibs/unix/write_win32.c b/otherlibs/unix/write_win32.c index ce0f9a347ea..029ec233e8d 100644 --- a/otherlibs/unix/write_win32.c +++ b/otherlibs/unix/write_win32.c @@ -82,7 +82,7 @@ CAMLprim value caml_unix_write_bigarray(value fd, value vbuf, SOCKET s = Socket_val(fd); numbytes = len > INT_MAX ? INT_MAX : len; caml_enter_blocking_section(); - ret = send(s, buf + ofs, numbytes, 0); + ret = send(s, (char *)buf + ofs, numbytes, 0); if (ret == SOCKET_ERROR) err = WSAGetLastError(); caml_leave_blocking_section(); if (ret == SOCKET_ERROR && err == WSAEWOULDBLOCK && written > 0) break; @@ -91,7 +91,7 @@ CAMLprim value caml_unix_write_bigarray(value fd, value vbuf, HANDLE h = Handle_val(fd); DWORD numbytes = len > 0xFFFFFFFF ? 0xFFFFFFFF : len; caml_enter_blocking_section(); - if (! WriteFile(h, buf + ofs, numbytes, &numwritten, NULL)) + if (! WriteFile(h, (char *)buf + ofs, numbytes, &numwritten, NULL)) err = GetLastError(); caml_leave_blocking_section(); } diff --git a/runtime/io.c b/runtime/io.c index ed14cc09240..0eceee6f965 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -885,7 +885,7 @@ CAMLprim value caml_ml_output_bigarray(value vchannel, value vbuf, intnat len = Long_val(vlen); caml_channel_lock(channel); - caml_really_putblock(channel, Caml_ba_data_val(vbuf) + pos, len); + caml_really_putblock(channel, (char *)Caml_ba_data_val(vbuf) + pos, len); caml_channel_unlock(channel); CAMLreturn (Val_unit); @@ -1013,7 +1013,7 @@ CAMLprim value caml_ml_input_bigarray(value vchannel, value vbuf, intnat n; caml_channel_lock(channel); - n = caml_getblock(channel, Caml_ba_data_val(vbuf) + pos, len); + n = caml_getblock(channel, (char *)Caml_ba_data_val(vbuf) + pos, len); caml_channel_unlock(channel); CAMLreturn (Val_long(n)); From 072b133385110ec158a95cfeb47397463814c325 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 20 Mar 2023 10:44:49 +0000 Subject: [PATCH 141/402] Implement Caml_state in MASM domain_state.tbl is pre-processed to remove comments and evaluate conditionals. The result can be included directly in the backend files for MASM which both simplifies the overall appearance of the code and also eliminates the two awk scripts which were used previously. --- .gitignore | 3 +- Makefile | 17 ++-- runtime/amd64nt.asm | 128 ++++++++++++++++------------- runtime/gen_domain_state32_inc.awk | 36 -------- runtime/gen_domain_state64_inc.awk | 33 -------- 5 files changed, 80 insertions(+), 137 deletions(-) delete mode 100644 runtime/gen_domain_state32_inc.awk delete mode 100644 runtime/gen_domain_state64_inc.awk diff --git a/.gitignore b/.gitignore index fe97b1e3588..9e34847ba68 100644 --- a/.gitignore +++ b/.gitignore @@ -235,6 +235,7 @@ META /parsing/camlinternalMenhirLib.ml /parsing/camlinternalMenhirLib.mli +/runtime/domain_state.inc /runtime/caml/jumptbl.h /runtime/caml/m.h /runtime/caml/s.h @@ -250,8 +251,6 @@ META /runtime/.gdb_history /runtime/build_config.h /runtime/sak -/runtime/domain_state32.inc -/runtime/domain_state64.inc /stdlib/camlheader /stdlib/target_camlheader diff --git a/Makefile b/Makefile index a12048719c3..962d62f33a8 100644 --- a/Makefile +++ b/Makefile @@ -1031,21 +1031,16 @@ runtime/%.i.o: runtime/%.S runtime/%_libasmrunpic.o: runtime/%.S $(V_ASM)$(ASPP) $(OC_ASPPFLAGS) $(SHAREDLIB_CFLAGS) -o $@ $< -runtime/domain_state64.inc: \ - runtime/gen_domain_state64_inc.awk runtime/caml/domain_state.tbl - $(V_GEN)$(AWK) -f $^ > $@ +runtime/domain_state.inc: runtime/caml/domain_state.tbl + $(V_GEN)$(CPP) $< > $@ -runtime/domain_state32.inc: \ - runtime/gen_domain_state32_inc.awk runtime/caml/domain_state.tbl - $(V_GEN)$(AWK) -f $^ > $@ - -runtime/amd64nt.obj: runtime/amd64nt.asm runtime/domain_state64.inc +runtime/amd64nt.obj: runtime/amd64nt.asm runtime/domain_state.inc $(V_ASM)$(ASM)$@ $< -runtime/amd64nt.d.obj: runtime/amd64nt.asm runtime/domain_state64.inc +runtime/amd64nt.d.obj: runtime/amd64nt.asm runtime/domain_state.inc $(V_ASM)$(ASM)$@ $(ocamlrund_CPPFLAGS) $< -runtime/amd64nt.i.obj: runtime/amd64nt.asm runtime/domain_state64.inc +runtime/amd64nt.i.obj: runtime/amd64nt.asm runtime/domain_state.inc $(V_ASM)$(ASM)$@ $(ocamlruni_CPPFLAGS) $< runtime/%_libasmrunpic.obj: runtime/%.asm @@ -1081,7 +1076,7 @@ clean:: ocamlrun.exe ocamlrund.exe ocamlruni.exe ocamlruns.exe sak.exe) rm -f runtime/primitives runtime/primitives.new runtime/prims.c \ $(runtime_BUILT_HEADERS) - rm -f runtime/domain_state*.inc + rm -f runtime/domain_state.inc rm -rf $(DEPDIR) rm -f stdlib/libcamlrun.a stdlib/libcamlrun.lib diff --git a/runtime/amd64nt.asm b/runtime/amd64nt.asm index fea922e8a98..f7ac3082188 100644 --- a/runtime/amd64nt.asm +++ b/runtime/amd64nt.asm @@ -25,9 +25,27 @@ EXTRN caml_apply3: NEAR EXTRN caml_program: NEAR EXTRN caml_array_bound_error_asm: NEAR - EXTRN caml_stash_backtrace: NEAR + EXTRN caml_stash_backtrace: NEAR -INCLUDE domain_state64.inc +; Load caml/domain_state.tbl (via domain_state.inc, to remove C-style comments) + domain_curr_field = 0 +DOMAIN_STATE MACRO _type:REQ, name:REQ + domain_field_caml_&name EQU domain_curr_field + domain_curr_field = domain_curr_field + 1 + ; Returning a value turns DOMAIN_STATE into a macro function, which + ; causes the bracketed parameters to be both required and correctly + ; parsed. Returning an empty string allows this to be used as though + ; it were a macro procedure. + EXITM <> +ENDM + +INCLUDE domain_state.inc + +; Caml_state(field) expands to the address of field in Caml_state, which is +; always stored in r14. +Caml_state MACRO field:REQ + EXITM @CatStr(<[r14+>, %(domain_field_caml_&field), <*8]>) +ENDM .CODE @@ -43,16 +61,16 @@ caml_system__code_begin: caml_call_gc: ; Record lowest stack address and return address mov r11, [rsp] - Store_last_return_address r11 + mov Caml_state(last_return_address), r11 lea r11, [rsp+8] - Store_bottom_of_stack r11 + mov Caml_state(bottom_of_stack), r11 ; Touch the stack to trigger a recoverable segfault ; if insufficient space remains sub rsp, 01000h mov [rsp], r11 add rsp, 01000h ; Save young_ptr - Store_young_ptr r15 + mov Caml_state(young_ptr), r15 ; Build array of registers, save it into Caml_state(gc_regs) push rbp push r11 @@ -67,7 +85,7 @@ caml_call_gc: push rdi push rbx push rax - Store_gc_regs rsp + mov Caml_state(gc_regs), rsp ; Save floating-point registers sub rsp, 16*8 movsd QWORD PTR [rsp + 0*8], xmm0 @@ -122,7 +140,7 @@ caml_call_gc: pop r11 pop rbp ; Restore Caml_state(young_ptr) - Load_young_ptr r15 + mov r15, Caml_state(young_ptr) ; Return to caller ret @@ -130,7 +148,7 @@ caml_call_gc: ALIGN 16 caml_alloc1: sub r15, 16 - Cmp_young_limit r15 + cmp r15, Caml_state(young_limit) jb caml_call_gc ret @@ -138,7 +156,7 @@ caml_alloc1: ALIGN 16 caml_alloc2: sub r15, 24 - Cmp_young_limit r15 + cmp r15, Caml_state(young_limit) jb caml_call_gc ret @@ -146,14 +164,14 @@ caml_alloc2: ALIGN 16 caml_alloc3: sub r15, 32 - Cmp_young_limit r15 + cmp r15, Caml_state(young_limit) jb caml_call_gc ret PUBLIC caml_allocN ALIGN 16 caml_allocN: - Cmp_young_limit r15 + cmp r15, Caml_state(young_limit) jb caml_call_gc ret @@ -164,19 +182,19 @@ caml_allocN: caml_c_call: ; Record lowest stack address and return address pop r12 - Store_last_return_address r12 - Store_bottom_of_stack rsp + mov Caml_state(last_return_address), r12 + mov Caml_state(bottom_of_stack), rsp ; Touch the stack to trigger a recoverable segfault ; if insufficient space remains sub rsp, 01000h mov [rsp], rax add rsp, 01000h ; Make the alloc ptr available to the C code - Store_young_ptr r15 + mov Caml_state(young_ptr), r15 ; Call the function (address in rax) call rax ; Reload alloc ptr - Load_young_ptr r15 + mov r15, Caml_state(young_ptr) ; Return to caller push r12 ret @@ -214,29 +232,29 @@ caml_start_program: L106: ; Build a callback link sub rsp, 8 ; stack 16-aligned - Push_gc_regs - Push_last_return_address - Push_bottom_of_stack + push Caml_state(gc_regs) + push Caml_state(last_return_address) + push Caml_state(bottom_of_stack) ; Setup alloc ptr - Load_young_ptr r15 + mov r15, Caml_state(young_ptr) ; Build an exception handler lea r13, L108 push r13 - Push_exception_pointer - Store_exception_pointer rsp + push Caml_state(exception_pointer) + mov Caml_state(exception_pointer), rsp ; Call the OCaml code call r12 L107: ; Pop the exception handler - Pop_exception_pointer + pop Caml_state(exception_pointer) pop r12 ; dummy register L109: ; Update alloc ptr - Store_young_ptr r15 + mov Caml_state(young_ptr), r15 ; Pop the callback restoring, link the global variables - Pop_bottom_of_stack - Pop_last_return_address - Pop_gc_regs + pop Caml_state(bottom_of_stack) + pop Caml_state(last_return_address) + pop Caml_state(gc_regs) add rsp, 8 ; Restore callee-save registers. movapd xmm6, OWORD PTR [rsp + 0*16] @@ -271,55 +289,55 @@ L108: PUBLIC caml_raise_exn ALIGN 16 caml_raise_exn: - Load_backtrace_active r11 + mov r11, Caml_state(backtrace_active) test r11, 1 jne L110 - Load_exception_pointer rsp ; Cut stack + mov rsp, Caml_state(exception_pointer) ; Cut stack ; Recover previous exception handler - Pop_exception_pointer + pop Caml_state(exception_pointer) ret ; Branch to handler L110: - mov r12, rax ; Save exception bucket in r12 - mov rcx, rax ; Arg 1: exception bucket - mov rdx, [rsp] ; Arg 2: PC of raise - lea r8, [rsp+8] ; Arg 3: SP of raise - Load_exception_pointer r9 ; Arg 4: SP of handler - sub rsp, 32 ; Reserve 32 bytes on stack + mov r12, rax ; Save exception bucket + mov rcx, rax ; Arg 1: exception bucket + mov rdx, [rsp] ; Arg 2: PC of raise + lea r8, [rsp+8] ; Arg 3: SP of raise + mov r9, Caml_state(exception_pointer) ; Arg 4: SP of handler + sub rsp, 32 ; Reserve 32 bytes on stack call caml_stash_backtrace - mov rax, r12 ; Recover exception bucket - Load_exception_pointer rsp ; Cut stack + mov rax, r12 ; Recover exception bucket + mov rsp, Caml_state(exception_pointer) ; Cut stack ; Recover previous exception handler - Pop_exception_pointer - ret ; Branch to handler + pop Caml_state(exception_pointer) + ret ; Branch to handler ; Raise an exception from C PUBLIC caml_raise_exception ALIGN 16 caml_raise_exception: - mov r14, rcx ; First argument is Caml_state - Load_backtrace_active r11 + mov r14, rcx ; First arg is Caml_state + mov r11, Caml_state(backtrace_active) test r11, 1 jne L112 - mov rax, rdx ; Second argument is exn bucket - Load_exception_pointer rsp + mov rax, rdx ; Second arg is exn bucket + mov rsp, Caml_state(exception_pointer) ; Recover previous exception handler - Pop_exception_pointer - Load_young_ptr r15 ; Reload alloc ptr + pop Caml_state(exception_pointer) + mov r15, Caml_state(young_ptr) ; Reload alloc ptr ret L112: - mov r12, rdx ; Save exception bucket in r12 - mov rcx, rdx ; Arg 1: exception bucket - Load_last_return_address rdx ; Arg 2: PC of raise - Load_bottom_of_stack r8 ; Arg 3: SP of raise - Load_exception_pointer r9 ; Arg 4: SP of handler - sub rsp, 32 ; Reserve 32 bytes on stack + mov r12, rdx ; Save exception bucket + mov rcx, rdx ; Arg 1: exception bucket + mov rdx, Caml_state(last_return_address) ; Arg 2: PC of raise + mov r8, Caml_state(bottom_of_stack) ; Arg 3: SP of raise + mov r9, Caml_state(exception_pointer) ; Arg 4: SP of handler + sub rsp, 32 ; Reserve 32 bytes on stack call caml_stash_backtrace - mov rax, r12 ; Recover exception bucket - Load_exception_pointer rsp + mov rax, r12 ; Recover exception bucket + mov rsp, Caml_state(exception_pointer) ; Recover previous exception handler - Pop_exception_pointer - Load_young_ptr r15; Reload alloc ptr + pop Caml_state(exception_pointer) + mov r15, Caml_state(young_ptr) ; Reload alloc ptr ret ; Callback from C to OCaml diff --git a/runtime/gen_domain_state32_inc.awk b/runtime/gen_domain_state32_inc.awk deleted file mode 100644 index f84090232c5..00000000000 --- a/runtime/gen_domain_state32_inc.awk +++ /dev/null @@ -1,36 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* KC Sivaramakrishnan, Indian Institute of Technology, Madras * -#* * -#* Copyright 2019 Indian Institute of Technology, Madras * -#* * -#* 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. * -#* * -#************************************************************************** - -BEGIN{FS="[,)] *";count=0}; -/DOMAIN_STATE/{ - print "Store_" $2 " MACRO reg1, reg2"; - print " mov [reg1+" count "], reg2"; - print "ENDM"; - print "Load_" $2 " MACRO reg1, reg2"; - print " mov reg2, [reg1+" count "]"; - print "ENDM"; - print "Push_" $2 " MACRO reg1"; - print " push [reg1+" count "]"; - print "ENDM"; - print "Pop_" $2 " MACRO reg1"; - print " pop [reg1+" count "]"; - print "ENDM"; - print "Cmp_" $2 " MACRO reg1, reg2"; - print " cmp reg2, [reg1+" count "]"; - print "ENDM"; - print "Sub_" $2 " MACRO reg1, reg2"; - print " sub reg2, [reg1+" count "]"; - print "ENDM"; - count+=8 -} diff --git a/runtime/gen_domain_state64_inc.awk b/runtime/gen_domain_state64_inc.awk deleted file mode 100644 index 8280d4d19f3..00000000000 --- a/runtime/gen_domain_state64_inc.awk +++ /dev/null @@ -1,33 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* KC Sivaramakrishnan, Indian Institute of Technology, Madras * -#* * -#* Copyright 2019 Indian Institute of Technology, Madras * -#* * -#* 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. * -#* * -#************************************************************************** - -BEGIN{FS="[,)] *";count=0}; -/DOMAIN_STATE/{ - print "Store_" $2 " MACRO reg"; - print " mov [r14+" count "], reg"; - print "ENDM"; - print "Load_" $2 " MACRO reg"; - print " mov reg, [r14+" count "]"; - print "ENDM"; - print "Push_" $2 " MACRO"; - print " push [r14+" count "]"; - print "ENDM"; - print "Pop_" $2 " MACRO"; - print " pop [r14+" count "]"; - print "ENDM"; - print "Cmp_" $2 " MACRO reg"; - print " cmp reg, [r14+" count "]"; - print "ENDM"; - count+=8 -} From 4d7dc7d1eb961a5605cbb832385d3db30f3b3bc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 5 Oct 2023 13:48:25 +0200 Subject: [PATCH 142/402] feat: `caml_fatal_error` on misuse of deserialize functions These should only be called from within a `caml_input_*` entrypoint context. Otherwise, the field `intern_src` of `struct caml_intern_state` won't have been populated, and a null pointer dereference occurs. --- Changes | 3 +++ runtime/intern.c | 26 +++++++++++++++++++------- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/Changes b/Changes index 7b298ddd467..3ce13047993 100644 --- a/Changes +++ b/Changes @@ -386,6 +386,9 @@ Working version (Alexander Skvortsov, report by Török Edwin, design by Gabriel Scherer, Xavier Leroy) +- #12635: Fix get_intern_state potential NULL dereference. + (Antonin Décimo, review by KC Sivaramakrishnan) + - #12032, #12059: Bug fixes related to compilation of recursive definitions (Vincent Laviron, report by Victoire Noizet, review by Gabriel Scherer) diff --git a/runtime/intern.c b/runtime/intern.c index 7b7a2696988..b25080897db 100644 --- a/runtime/intern.c +++ b/runtime/intern.c @@ -95,8 +95,7 @@ struct caml_intern_state { /* 1 if the compressed format is in use, 0 otherwise */ }; -/* Allocates the domain local intern state if needed */ -static struct caml_intern_state* get_intern_state (void) +static struct caml_intern_state* init_intern_state (void) { Caml_check_caml_state(); struct caml_intern_state* s; @@ -118,6 +117,19 @@ static struct caml_intern_state* get_intern_state (void) return s; } +static struct caml_intern_state* get_intern_state (void) +{ + Caml_check_caml_state(); + + if (Caml_state->intern_state == NULL) + caml_fatal_error ( + "intern_state not initialized: it is likely that a caml_deserialize_* " + "function was called without going through caml_input_*." + ); + + return Caml_state->intern_state; +} + void caml_free_intern_state (void) { if (Caml_state->intern_state != NULL) @@ -827,7 +839,7 @@ value caml_input_val(struct channel *chan) struct marshal_header h; char * block; value res; - struct caml_intern_state* s = get_intern_state (); + struct caml_intern_state* s = init_intern_state (); if (! caml_channel_binary_mode(chan)) caml_failwith("input_value: not a binary channel"); @@ -901,7 +913,7 @@ CAMLexport value caml_input_val_from_bytes(value str, intnat ofs) CAMLparam1 (str); CAMLlocal1 (obj); struct marshal_header h; - struct caml_intern_state* s = get_intern_state (); + struct caml_intern_state* s = init_intern_state (); /* Initialize global state */ intern_init(s, &Byte_u(str, ofs), NULL); @@ -939,7 +951,7 @@ static value input_val_from_block(struct caml_intern_state* s, CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs) { struct marshal_header h; - struct caml_intern_state* s = get_intern_state (); + struct caml_intern_state* s = init_intern_state (); intern_init(s, data + ofs, data); caml_parse_header(s, "input_value_from_malloc", &h); @@ -950,7 +962,7 @@ CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs) CAMLexport value caml_input_value_from_block(const char * data, intnat len) { struct marshal_header h; - struct caml_intern_state* s = get_intern_state (); + struct caml_intern_state* s = init_intern_state (); /* Initialize global state */ intern_init(s, data, NULL); @@ -980,7 +992,7 @@ CAMLprim value caml_marshal_data_size(value buff, value ofs) uint32_t magic; int header_len; uintnat data_len; - struct caml_intern_state *s = get_intern_state (); + struct caml_intern_state *s = init_intern_state (); s->intern_src = &Byte_u(buff, Long_val(ofs)); magic = read32u(s); From 932c7a8a89ac28aa48b77a89be2bd21f02cf6def Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Fri, 6 Oct 2023 12:57:44 +0200 Subject: [PATCH 143/402] feat: refactor `intern_free_stack` Split out `init_extern_stack` into a separate function, so that the code for initializing and resetting the intern_state stack is not duplicated. --- runtime/intern.c | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/runtime/intern.c b/runtime/intern.c index b25080897db..6e332e7b771 100644 --- a/runtime/intern.c +++ b/runtime/intern.c @@ -95,6 +95,13 @@ struct caml_intern_state { /* 1 if the compressed format is in use, 0 otherwise */ }; +static void init_intern_stack(struct caml_intern_state* s) +{ + /* (Re)initialize the globals for next time around */ + s->intern_stack = s->intern_stack_init; + s->intern_stack_limit = s->intern_stack + INTERN_STACK_INIT_SIZE; +} + static struct caml_intern_state* init_intern_state (void) { Caml_check_caml_state(); @@ -109,9 +116,8 @@ static struct caml_intern_state* init_intern_state (void) s->intern_input = NULL; s->obj_counter = 0; s->intern_obj_table = NULL; - s->intern_stack = s->intern_stack_init; - s->intern_stack_limit = s->intern_stack + INTERN_STACK_INIT_SIZE; s->intern_dest = NULL; + init_intern_stack(s); Caml_state->intern_state = s; return s; @@ -132,9 +138,10 @@ static struct caml_intern_state* get_intern_state (void) void caml_free_intern_state (void) { - if (Caml_state->intern_state != NULL) + if (Caml_state->intern_state != NULL) { caml_stat_free(Caml_state->intern_state); - Caml_state->intern_state = NULL; + Caml_state->intern_state = NULL; + } } static char * intern_resolve_code_pointer(unsigned char digest[16], @@ -236,9 +243,7 @@ static void intern_free_stack(struct caml_intern_state* s) { if (s->intern_stack != s->intern_stack_init) { caml_stat_free(s->intern_stack); - /* Reinitialize the globals for next time around */ - s->intern_stack = s->intern_stack_init; - s->intern_stack_limit = s->intern_stack + INTERN_STACK_INIT_SIZE; + init_intern_stack(s); } } From 0bd5c19dc8b107c08835630ee071b865cf4504fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Fri, 6 Oct 2023 12:59:31 +0200 Subject: [PATCH 144/402] Make extern.c consistent with changes in intern.c --- Changes | 2 +- runtime/extern.c | 23 +++++++++++------------ 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/Changes b/Changes index 3ce13047993..963900653a2 100644 --- a/Changes +++ b/Changes @@ -382,7 +382,7 @@ Working version - #11931: Fix tricky typing bug with type substitutions (Stephen Dolan, review by Leo White and Jacques Garrigue) -- #12037: get_extern_state potential NULL dereference. +- #12037, #12171: Fix get_extern_state potential NULL dereference. (Alexander Skvortsov, report by Török Edwin, design by Gabriel Scherer, Xavier Leroy) diff --git a/runtime/extern.c b/runtime/extern.c index 402663d354d..d7bf239b082 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -120,14 +120,14 @@ struct caml_extern_state { struct output_block * extern_output_block; }; -static void extern_init_stack(struct caml_extern_state* s) +static void init_extern_stack(struct caml_extern_state* s) { /* (Re)initialize the globals for next time around */ s->extern_stack = s->extern_stack_init; s->extern_stack_limit = s->extern_stack + EXTERN_STACK_INIT_SIZE; } -static struct caml_extern_state* prepare_extern_state (void) +static struct caml_extern_state* init_extern_state (void) { Caml_check_caml_state(); struct caml_extern_state* s; @@ -141,7 +141,7 @@ static struct caml_extern_state* prepare_extern_state (void) s->obj_counter = 0; s->size_32 = 0; s->size_64 = 0; - extern_init_stack(s); + init_extern_stack(s); Caml_state->extern_state = s; return s; @@ -153,8 +153,8 @@ static struct caml_extern_state* get_extern_state (void) if (Caml_state->extern_state == NULL) caml_fatal_error ( - "extern_state not initialized:" - "this function can only be called from a `caml_output_*` entrypoint." + "extern_state not initialized: it is likely that a caml_serialize_* " + "function was called without going through caml_output_*." ); return Caml_state->extern_state; @@ -186,9 +186,8 @@ static void extern_free_stack(struct caml_extern_state* s) /* Free the extern stack if needed */ if (s->extern_stack != s->extern_stack_init) { caml_stat_free(s->extern_stack); + init_extern_stack(s); } - - extern_init_stack(s); } static struct extern_item * extern_resize_stack(struct caml_extern_state* s, @@ -1077,7 +1076,7 @@ void caml_output_val(struct channel *chan, value v, value flags) char header[MAX_INTEXT_HEADER_SIZE]; int header_len; struct output_block * blk, * nextblk; - struct caml_extern_state* s = prepare_extern_state (); + struct caml_extern_state* s = init_extern_state (); if (! caml_channel_binary_mode(chan)) caml_failwith("output_value: not a binary channel"); @@ -1115,7 +1114,7 @@ CAMLprim value caml_output_value_to_bytes(value v, value flags) intnat data_len, ofs; value res; struct output_block * blk, * nextblk; - struct caml_extern_state* s = prepare_extern_state (); + struct caml_extern_state* s = init_extern_state (); init_extern_output(s); data_len = extern_value(s, v, flags, header, &header_len); @@ -1148,7 +1147,7 @@ CAMLexport intnat caml_output_value_to_block(value v, value flags, char header[MAX_INTEXT_HEADER_SIZE]; int header_len; intnat data_len; - struct caml_extern_state* s = prepare_extern_state (); + struct caml_extern_state* s = init_extern_state (); /* At this point we don't know the size of the header. Guess that it is small, and fix up later if not. */ @@ -1185,7 +1184,7 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags, intnat data_len; char * res; struct output_block * blk, * nextblk; - struct caml_extern_state* s = prepare_extern_state (); + struct caml_extern_state* s = init_extern_state (); init_extern_output(s); data_len = extern_value(s, v, flags, header, &header_len); @@ -1345,7 +1344,7 @@ CAMLprim value caml_obj_reachable_words(value v) struct extern_item * sp; uintnat h = 0; uintnat pos = 0; - struct caml_extern_state *s = prepare_extern_state (); + struct caml_extern_state *s = init_extern_state (); s->obj_counter = 0; s->extern_flags = 0; From fe2b0bd3e17165a0aca2012d9c92a24ec08bbf4b Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 6 Oct 2023 15:06:08 +0200 Subject: [PATCH 145/402] parsing: Attach a location to the RHS of Ptyp_alias --- boot/menhir/parser.ml | 6612 ++++++++++++++++++++-------------------- parsing/ast_helper.ml | 6 +- parsing/ast_helper.mli | 3 +- parsing/ast_mapper.ml | 4 +- parsing/parser.mly | 2 +- parsing/parsetree.mli | 2 +- parsing/pprintast.ml | 2 +- parsing/printast.ml | 2 +- tools/eqparsetree.ml | 2 +- typing/printtyped.ml | 2 +- typing/typedtree.ml | 2 +- typing/typedtree.mli | 2 +- typing/typetexp.ml | 8 +- 13 files changed, 3336 insertions(+), 3313 deletions(-) diff --git a/boot/menhir/parser.ml b/boot/menhir/parser.ml index 43c2a51043d..4e6e26ade90 100644 --- a/boot/menhir/parser.ml +++ b/boot/menhir/parser.ml @@ -1508,14 +1508,14 @@ module Tables = struct let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in let { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = tyvar; - MenhirLib.EngineTypes.startp = _startpos_tyvar_; - MenhirLib.EngineTypes.endp = _endpos_tyvar_; + MenhirLib.EngineTypes.semv = _1_inlined1; + MenhirLib.EngineTypes.startp = _startpos__1_inlined1_; + MenhirLib.EngineTypes.endp = _endpos__1_inlined1_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _3; - MenhirLib.EngineTypes.startp = _startpos__3_; - MenhirLib.EngineTypes.endp = _endpos__3_; + MenhirLib.EngineTypes.semv = _1; + MenhirLib.EngineTypes.startp = _startpos__1_; + MenhirLib.EngineTypes.endp = _endpos__1_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _2; @@ -1531,33 +1531,53 @@ module Tables = struct }; }; } = _menhir_stack in - let tyvar : (Asttypes.label) = Obj.magic tyvar in - let _3 : unit = Obj.magic _3 in + let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in + let _1 : unit = Obj.magic _1 in let _2 : unit = Obj.magic _2 in let ty : (Parsetree.core_type) = Obj.magic ty in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_ty_ in - let _endpos = _endpos_tyvar_ in + let _endpos = _endpos__1_inlined1_ in let _v : (Parsetree.core_type) = let _1 = - let _1 = + let _1 = + let tyvar = + let _2 = + let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 956 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 1553 "parsing/parser.ml" + + in + +# 3413 "parsing/parser.mly" + ( _2 ) +# 1559 "parsing/parser.ml" + + in + # 3468 "parsing/parser.mly" ( Ptyp_alias(ty, tyvar) ) -# 1546 "parsing/parser.ml" - in - let (_endpos__1_, _startpos__1_) = (_endpos_tyvar_, _startpos_ty_) in +# 1565 "parsing/parser.ml" + + in + let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_ty_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1555 "parsing/parser.ml" +# 1575 "parsing/parser.ml" in # 3470 "parsing/parser.mly" ( _1 ) -# 1561 "parsing/parser.ml" +# 1581 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1606,7 +1626,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 1610 "parsing/parser.ml" +# 1630 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in @@ -1615,7 +1635,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 1619 "parsing/parser.ml" +# 1639 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -1627,7 +1647,7 @@ module Tables = struct let attrs = attrs1 @ attrs2 in mklb ~loc:_sloc false body attrs ) -# 1631 "parsing/parser.ml" +# 1651 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1652,7 +1672,7 @@ module Tables = struct let _v : (Longident.t) = # 3852 "parsing/parser.mly" ( _1 ) -# 1656 "parsing/parser.ml" +# 1676 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1677,7 +1697,7 @@ module Tables = struct let _v : (Longident.t) = # 3853 "parsing/parser.mly" ( Lident _1 ) -# 1681 "parsing/parser.ml" +# 1701 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1702,7 +1722,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3601 "parsing/parser.mly" ( type_ ) -# 1706 "parsing/parser.ml" +# 1726 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1733,18 +1753,18 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1737 "parsing/parser.ml" +# 1757 "parsing/parser.ml" in let tys = # 3634 "parsing/parser.mly" ( [] ) -# 1743 "parsing/parser.ml" +# 1763 "parsing/parser.ml" in # 3605 "parsing/parser.mly" ( Ptyp_constr (tid, tys) ) -# 1748 "parsing/parser.ml" +# 1768 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -1753,13 +1773,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1757 "parsing/parser.ml" +# 1777 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 1763 "parsing/parser.ml" +# 1783 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1797,18 +1817,18 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1801 "parsing/parser.ml" +# 1821 "parsing/parser.ml" in let tys = # 3636 "parsing/parser.mly" ( [ ty ] ) -# 1807 "parsing/parser.ml" +# 1827 "parsing/parser.ml" in # 3605 "parsing/parser.mly" ( Ptyp_constr (tid, tys) ) -# 1812 "parsing/parser.ml" +# 1832 "parsing/parser.ml" in let _startpos__1_ = _startpos_ty_ in @@ -1818,13 +1838,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1822 "parsing/parser.ml" +# 1842 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 1828 "parsing/parser.ml" +# 1848 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1877,7 +1897,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1881 "parsing/parser.ml" +# 1901 "parsing/parser.ml" in let tys = @@ -1885,24 +1905,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 1889 "parsing/parser.ml" +# 1909 "parsing/parser.ml" in # 1139 "parsing/parser.mly" ( xs ) -# 1894 "parsing/parser.ml" +# 1914 "parsing/parser.ml" in # 3638 "parsing/parser.mly" ( tys ) -# 1900 "parsing/parser.ml" +# 1920 "parsing/parser.ml" in # 3605 "parsing/parser.mly" ( Ptyp_constr (tid, tys) ) -# 1906 "parsing/parser.ml" +# 1926 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -1912,13 +1932,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1916 "parsing/parser.ml" +# 1936 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 1922 "parsing/parser.ml" +# 1942 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1956,18 +1976,18 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1960 "parsing/parser.ml" +# 1980 "parsing/parser.ml" in let tys = # 3634 "parsing/parser.mly" ( [] ) -# 1966 "parsing/parser.ml" +# 1986 "parsing/parser.ml" in # 3609 "parsing/parser.mly" ( Ptyp_class (cid, tys) ) -# 1971 "parsing/parser.ml" +# 1991 "parsing/parser.ml" in let _startpos__1_ = _startpos__2_ in @@ -1977,13 +1997,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1981 "parsing/parser.ml" +# 2001 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 1987 "parsing/parser.ml" +# 2007 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2028,18 +2048,18 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2032 "parsing/parser.ml" +# 2052 "parsing/parser.ml" in let tys = # 3636 "parsing/parser.mly" ( [ ty ] ) -# 2038 "parsing/parser.ml" +# 2058 "parsing/parser.ml" in # 3609 "parsing/parser.mly" ( Ptyp_class (cid, tys) ) -# 2043 "parsing/parser.ml" +# 2063 "parsing/parser.ml" in let _startpos__1_ = _startpos_ty_ in @@ -2049,13 +2069,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2053 "parsing/parser.ml" +# 2073 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 2059 "parsing/parser.ml" +# 2079 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2115,7 +2135,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2119 "parsing/parser.ml" +# 2139 "parsing/parser.ml" in let tys = @@ -2123,24 +2143,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2127 "parsing/parser.ml" +# 2147 "parsing/parser.ml" in # 1139 "parsing/parser.mly" ( xs ) -# 2132 "parsing/parser.ml" +# 2152 "parsing/parser.ml" in # 3638 "parsing/parser.mly" ( tys ) -# 2138 "parsing/parser.ml" +# 2158 "parsing/parser.ml" in # 3609 "parsing/parser.mly" ( Ptyp_class (cid, tys) ) -# 2144 "parsing/parser.ml" +# 2164 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -2150,13 +2170,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2154 "parsing/parser.ml" +# 2174 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 2160 "parsing/parser.ml" +# 2180 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2201,13 +2221,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2205 "parsing/parser.ml" +# 2225 "parsing/parser.ml" in # 3613 "parsing/parser.mly" ( Ptyp_open (mod_ident, type_) ) -# 2211 "parsing/parser.ml" +# 2231 "parsing/parser.ml" in let _endpos__1_ = _endpos_type__ in @@ -2217,13 +2237,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2221 "parsing/parser.ml" +# 2241 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 2227 "parsing/parser.ml" +# 2247 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2256,7 +2276,7 @@ module Tables = struct let _1 = # 3615 "parsing/parser.mly" ( Ptyp_var ident ) -# 2260 "parsing/parser.ml" +# 2280 "parsing/parser.ml" in let _endpos__1_ = _endpos_ident_ in let _endpos = _endpos__1_ in @@ -2265,13 +2285,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2269 "parsing/parser.ml" +# 2289 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 2275 "parsing/parser.ml" +# 2295 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2297,7 +2317,7 @@ module Tables = struct let _1 = # 3617 "parsing/parser.mly" ( Ptyp_any ) -# 2301 "parsing/parser.ml" +# 2321 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -2305,13 +2325,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2309 "parsing/parser.ml" +# 2329 "parsing/parser.ml" in # 3619 "parsing/parser.mly" ( _1 ) -# 2315 "parsing/parser.ml" +# 2335 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2337,7 +2357,7 @@ module Tables = struct let _1 = # 4035 "parsing/parser.mly" ( _1 ) -# 2341 "parsing/parser.ml" +# 2361 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -2345,13 +2365,13 @@ module Tables = struct # 986 "parsing/parser.mly" ( mkloc _1 (make_loc _sloc) ) -# 2349 "parsing/parser.ml" +# 2369 "parsing/parser.ml" in # 4037 "parsing/parser.mly" ( _1 ) -# 2355 "parsing/parser.ml" +# 2375 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2391,7 +2411,7 @@ module Tables = struct let _1 = # 4036 "parsing/parser.mly" ( _1 ^ "." ^ _3.txt ) -# 2395 "parsing/parser.ml" +# 2415 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -2400,13 +2420,13 @@ module Tables = struct # 986 "parsing/parser.mly" ( mkloc _1 (make_loc _sloc) ) -# 2404 "parsing/parser.ml" +# 2424 "parsing/parser.ml" in # 4037 "parsing/parser.mly" ( _1 ) -# 2410 "parsing/parser.ml" +# 2430 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2455,7 +2475,7 @@ module Tables = struct # 4041 "parsing/parser.mly" ( Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 2459 "parsing/parser.ml" +# 2479 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2480,7 +2500,7 @@ module Tables = struct let _v : (Parsetree.class_expr) = # 1971 "parsing/parser.mly" ( _1 ) -# 2484 "parsing/parser.ml" +# 2504 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2521,7 +2541,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 2525 "parsing/parser.ml" +# 2545 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -2530,7 +2550,7 @@ module Tables = struct # 1973 "parsing/parser.mly" ( wrap_class_attrs ~loc:_sloc _3 _2 ) -# 2534 "parsing/parser.ml" +# 2554 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2572,7 +2592,7 @@ module Tables = struct # 1975 "parsing/parser.mly" ( class_of_let_bindings ~loc:_sloc _1 _3 ) -# 2576 "parsing/parser.ml" +# 2596 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2637,7 +2657,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2641 "parsing/parser.ml" +# 2661 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined2_ in @@ -2646,13 +2666,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 2650 "parsing/parser.ml" +# 2670 "parsing/parser.ml" in let _3 = # 3960 "parsing/parser.mly" ( Fresh ) -# 2656 "parsing/parser.ml" +# 2676 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in @@ -2662,7 +2682,7 @@ module Tables = struct ( 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)) ) -# 2666 "parsing/parser.ml" +# 2686 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2734,7 +2754,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2738 "parsing/parser.ml" +# 2758 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in @@ -2743,13 +2763,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 2747 "parsing/parser.ml" +# 2767 "parsing/parser.ml" in let _3 = # 3961 "parsing/parser.mly" ( Override ) -# 2753 "parsing/parser.ml" +# 2773 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in @@ -2759,7 +2779,7 @@ module Tables = struct ( 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)) ) -# 2763 "parsing/parser.ml" +# 2783 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2791,7 +2811,7 @@ module Tables = struct let _v : (Parsetree.class_expr) = # 1981 "parsing/parser.mly" ( Cl.attr _1 _2 ) -# 2795 "parsing/parser.ml" +# 2815 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2826,18 +2846,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2830 "parsing/parser.ml" +# 2850 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 2835 "parsing/parser.ml" +# 2855 "parsing/parser.ml" in # 1984 "parsing/parser.mly" ( Pcl_apply(_1, _2) ) -# 2841 "parsing/parser.ml" +# 2861 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -2847,13 +2867,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 2851 "parsing/parser.ml" +# 2871 "parsing/parser.ml" in # 1987 "parsing/parser.mly" ( _1 ) -# 2857 "parsing/parser.ml" +# 2877 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2879,7 +2899,7 @@ module Tables = struct let _1 = # 1986 "parsing/parser.mly" ( Pcl_extension _1 ) -# 2883 "parsing/parser.ml" +# 2903 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -2887,13 +2907,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 2891 "parsing/parser.ml" +# 2911 "parsing/parser.ml" in # 1987 "parsing/parser.mly" ( _1 ) -# 2897 "parsing/parser.ml" +# 2917 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2948,7 +2968,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 2952 "parsing/parser.ml" +# 2972 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined2_ in @@ -2957,13 +2977,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 2961 "parsing/parser.ml" +# 2981 "parsing/parser.ml" in let _2 = # 3960 "parsing/parser.mly" ( Fresh ) -# 2967 "parsing/parser.ml" +# 2987 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in @@ -2972,7 +2992,7 @@ module Tables = struct # 2036 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs ) -# 2976 "parsing/parser.ml" +# 2996 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3034,7 +3054,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 3038 "parsing/parser.ml" +# 3058 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in @@ -3043,13 +3063,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 3047 "parsing/parser.ml" +# 3067 "parsing/parser.ml" in let _2 = # 3961 "parsing/parser.mly" ( Override ) -# 3053 "parsing/parser.ml" +# 3073 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in @@ -3058,7 +3078,7 @@ module Tables = struct # 2036 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs ) -# 3062 "parsing/parser.ml" +# 3082 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3101,7 +3121,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 3105 "parsing/parser.ml" +# 3125 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -3113,7 +3133,7 @@ module Tables = struct ( let v, attrs = _2 in let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs ) -# 3117 "parsing/parser.ml" +# 3137 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3156,7 +3176,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 3160 "parsing/parser.ml" +# 3180 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -3168,7 +3188,7 @@ module Tables = struct ( let meth, attrs = _2 in let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs ) -# 3172 "parsing/parser.ml" +# 3192 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3216,7 +3236,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 3220 "parsing/parser.ml" +# 3240 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in @@ -3225,7 +3245,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 3229 "parsing/parser.ml" +# 3249 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -3235,7 +3255,7 @@ module Tables = struct # 2047 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs ) -# 3239 "parsing/parser.ml" +# 3259 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3283,7 +3303,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 3287 "parsing/parser.ml" +# 3307 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in @@ -3292,7 +3312,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 3296 "parsing/parser.ml" +# 3316 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -3302,7 +3322,7 @@ module Tables = struct # 2050 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs ) -# 3306 "parsing/parser.ml" +# 3326 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3336,7 +3356,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 3340 "parsing/parser.ml" +# 3360 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -3347,7 +3367,7 @@ module Tables = struct # 2053 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs ) -# 3351 "parsing/parser.ml" +# 3371 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3373,7 +3393,7 @@ module Tables = struct let _1 = # 2056 "parsing/parser.mly" ( Pcf_attribute _1 ) -# 3377 "parsing/parser.ml" +# 3397 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -3381,13 +3401,13 @@ module Tables = struct # 1007 "parsing/parser.mly" ( mkcf ~loc:_sloc _1 ) -# 3385 "parsing/parser.ml" +# 3405 "parsing/parser.ml" in # 2057 "parsing/parser.mly" ( _1 ) -# 3391 "parsing/parser.ml" +# 3411 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3419,7 +3439,7 @@ module Tables = struct let _v : (Parsetree.class_expr) = # 1951 "parsing/parser.mly" ( _2 ) -# 3423 "parsing/parser.ml" +# 3443 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3466,7 +3486,7 @@ module Tables = struct let _1 = # 1954 "parsing/parser.mly" ( Pcl_constraint(_4, _2) ) -# 3470 "parsing/parser.ml" +# 3490 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in let _endpos = _endpos__1_ in @@ -3475,13 +3495,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3479 "parsing/parser.ml" +# 3499 "parsing/parser.ml" in # 1957 "parsing/parser.mly" ( _1 ) -# 3485 "parsing/parser.ml" +# 3505 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3514,7 +3534,7 @@ module Tables = struct let _1 = # 1956 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) ) -# 3518 "parsing/parser.ml" +# 3538 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -3523,13 +3543,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3527 "parsing/parser.ml" +# 3547 "parsing/parser.ml" in # 1957 "parsing/parser.mly" ( _1 ) -# 3533 "parsing/parser.ml" +# 3553 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3569,7 +3589,7 @@ module Tables = struct let _1 = # 2012 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) ) -# 3573 "parsing/parser.ml" +# 3593 "parsing/parser.ml" in let _endpos__1_ = _endpos_e_ in let _endpos = _endpos__1_ in @@ -3578,13 +3598,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3582 "parsing/parser.ml" +# 3602 "parsing/parser.ml" in # 2013 "parsing/parser.mly" ( _1 ) -# 3588 "parsing/parser.ml" +# 3608 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3617,7 +3637,7 @@ module Tables = struct let _1 = # 2012 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) ) -# 3621 "parsing/parser.ml" +# 3641 "parsing/parser.ml" in let _endpos__1_ = _endpos_e_ in let _endpos = _endpos__1_ in @@ -3626,13 +3646,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3630 "parsing/parser.ml" +# 3650 "parsing/parser.ml" in # 2013 "parsing/parser.mly" ( _1 ) -# 3636 "parsing/parser.ml" +# 3656 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3657,7 +3677,7 @@ module Tables = struct let _v : (Longident.t) = # 3842 "parsing/parser.mly" ( _1 ) -# 3661 "parsing/parser.ml" +# 3681 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3699,7 +3719,7 @@ module Tables = struct # 2021 "parsing/parser.mly" ( reloc_pat ~loc:_sloc _2 ) -# 3703 "parsing/parser.ml" +# 3723 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3753,7 +3773,7 @@ module Tables = struct let _1 = # 2023 "parsing/parser.mly" ( Ppat_constraint(_2, _4) ) -# 3757 "parsing/parser.ml" +# 3777 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in let _endpos = _endpos__1_ in @@ -3762,13 +3782,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 3766 "parsing/parser.ml" +# 3786 "parsing/parser.ml" in # 2024 "parsing/parser.mly" ( _1 ) -# 3772 "parsing/parser.ml" +# 3792 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3789,7 +3809,7 @@ module Tables = struct # 2026 "parsing/parser.mly" ( ghpat ~loc:_sloc Ppat_any ) -# 3793 "parsing/parser.ml" +# 3813 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3828,7 +3848,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 2151 "parsing/parser.mly" ( _2 ) -# 3832 "parsing/parser.ml" +# 3852 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3847,7 +3867,7 @@ module Tables = struct let _1 = # 2152 "parsing/parser.mly" ( Ptyp_any ) -# 3851 "parsing/parser.ml" +# 3871 "parsing/parser.ml" in let _endpos__1_ = _endpos__0_ in let _endpos = _endpos__1_ in @@ -3856,13 +3876,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 3860 "parsing/parser.ml" +# 3880 "parsing/parser.ml" in # 2153 "parsing/parser.mly" ( _1 ) -# 3866 "parsing/parser.ml" +# 3886 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3910,7 +3930,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 3914 "parsing/parser.ml" +# 3934 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in @@ -3919,7 +3939,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 3923 "parsing/parser.ml" +# 3943 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -3929,7 +3949,7 @@ module Tables = struct # 2161 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs ) -# 3933 "parsing/parser.ml" +# 3953 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3989,7 +4009,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 3993 "parsing/parser.ml" +# 4013 "parsing/parser.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 @@ -4002,7 +4022,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 4006 "parsing/parser.ml" +# 4026 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined3_ in @@ -4012,7 +4032,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 4016 "parsing/parser.ml" +# 4036 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -4020,7 +4040,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4024 "parsing/parser.ml" +# 4044 "parsing/parser.ml" in @@ -4029,7 +4049,7 @@ module Tables = struct let mut, virt = flags in label, mut, virt, ty ) -# 4033 "parsing/parser.ml" +# 4053 "parsing/parser.ml" in let _2 = @@ -4037,7 +4057,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 4041 "parsing/parser.ml" +# 4061 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -4047,7 +4067,7 @@ module Tables = struct # 2164 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs ) -# 4051 "parsing/parser.ml" +# 4071 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4107,7 +4127,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 4111 "parsing/parser.ml" +# 4131 "parsing/parser.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 @@ -4120,7 +4140,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 4124 "parsing/parser.ml" +# 4144 "parsing/parser.ml" in let _endpos__7_ = _endpos__1_inlined4_ in @@ -4129,7 +4149,7 @@ module Tables = struct # 3431 "parsing/parser.mly" ( _1 ) -# 4133 "parsing/parser.ml" +# 4153 "parsing/parser.ml" in let _4 = @@ -4137,7 +4157,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 4141 "parsing/parser.ml" +# 4161 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -4145,7 +4165,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4149 "parsing/parser.ml" +# 4169 "parsing/parser.ml" in let _2 = @@ -4153,7 +4173,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 4157 "parsing/parser.ml" +# 4177 "parsing/parser.ml" in let _endpos = _endpos__7_ in @@ -4164,7 +4184,7 @@ module Tables = struct ( let (p, v) = _3 in let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_method (_4, p, v, _6)) ~attrs:(_2@_7) ~docs ) -# 4168 "parsing/parser.ml" +# 4188 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4212,7 +4232,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 4216 "parsing/parser.ml" +# 4236 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in @@ -4221,7 +4241,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 4225 "parsing/parser.ml" +# 4245 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -4231,7 +4251,7 @@ module Tables = struct # 2172 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs ) -# 4235 "parsing/parser.ml" +# 4255 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4265,7 +4285,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 4269 "parsing/parser.ml" +# 4289 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -4276,7 +4296,7 @@ module Tables = struct # 2175 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs ) -# 4280 "parsing/parser.ml" +# 4300 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4302,7 +4322,7 @@ module Tables = struct let _1 = # 2178 "parsing/parser.mly" ( Pctf_attribute _1 ) -# 4306 "parsing/parser.ml" +# 4326 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -4310,13 +4330,13 @@ module Tables = struct # 1005 "parsing/parser.mly" ( mkctf ~loc:_sloc _1 ) -# 4314 "parsing/parser.ml" +# 4334 "parsing/parser.ml" in # 2179 "parsing/parser.mly" ( _1 ) -# 4320 "parsing/parser.ml" +# 4340 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4347,25 +4367,25 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4351 "parsing/parser.ml" +# 4371 "parsing/parser.ml" in let tys = let tys = # 2137 "parsing/parser.mly" ( [] ) -# 4358 "parsing/parser.ml" +# 4378 "parsing/parser.ml" in # 2143 "parsing/parser.mly" ( tys ) -# 4363 "parsing/parser.ml" +# 4383 "parsing/parser.ml" in # 2120 "parsing/parser.mly" ( Pcty_constr (cid, tys) ) -# 4369 "parsing/parser.ml" +# 4389 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -4374,13 +4394,13 @@ module Tables = struct # 1003 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 4378 "parsing/parser.ml" +# 4398 "parsing/parser.ml" in # 2123 "parsing/parser.mly" ( _1 ) -# 4384 "parsing/parser.ml" +# 4404 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4433,7 +4453,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4437 "parsing/parser.ml" +# 4457 "parsing/parser.ml" in let tys = @@ -4442,30 +4462,30 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 4446 "parsing/parser.ml" +# 4466 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 4451 "parsing/parser.ml" +# 4471 "parsing/parser.ml" in # 2139 "parsing/parser.mly" ( params ) -# 4457 "parsing/parser.ml" +# 4477 "parsing/parser.ml" in # 2143 "parsing/parser.mly" ( tys ) -# 4463 "parsing/parser.ml" +# 4483 "parsing/parser.ml" in # 2120 "parsing/parser.mly" ( Pcty_constr (cid, tys) ) -# 4469 "parsing/parser.ml" +# 4489 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -4475,13 +4495,13 @@ module Tables = struct # 1003 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 4479 "parsing/parser.ml" +# 4499 "parsing/parser.ml" in # 2123 "parsing/parser.mly" ( _1 ) -# 4485 "parsing/parser.ml" +# 4505 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4507,7 +4527,7 @@ module Tables = struct let _1 = # 2122 "parsing/parser.mly" ( Pcty_extension _1 ) -# 4511 "parsing/parser.ml" +# 4531 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -4515,13 +4535,13 @@ module Tables = struct # 1003 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 4519 "parsing/parser.ml" +# 4539 "parsing/parser.ml" in # 2123 "parsing/parser.mly" ( _1 ) -# 4525 "parsing/parser.ml" +# 4545 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4578,12 +4598,12 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 4582 "parsing/parser.ml" +# 4602 "parsing/parser.ml" in # 2157 "parsing/parser.mly" ( _1 ) -# 4587 "parsing/parser.ml" +# 4607 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -4592,13 +4612,13 @@ module Tables = struct # 951 "parsing/parser.mly" ( extra_csig _startpos _endpos _1 ) -# 4596 "parsing/parser.ml" +# 4616 "parsing/parser.ml" in # 2147 "parsing/parser.mly" ( Csig.mk _1 _2 ) -# 4602 "parsing/parser.ml" +# 4622 "parsing/parser.ml" in let _2 = @@ -4606,7 +4626,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 4610 "parsing/parser.ml" +# 4630 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -4615,7 +4635,7 @@ module Tables = struct # 2125 "parsing/parser.mly" ( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) ) -# 4619 "parsing/parser.ml" +# 4639 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4672,12 +4692,12 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 4676 "parsing/parser.ml" +# 4696 "parsing/parser.ml" in # 2157 "parsing/parser.mly" ( _1 ) -# 4681 "parsing/parser.ml" +# 4701 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -4686,13 +4706,13 @@ module Tables = struct # 951 "parsing/parser.mly" ( extra_csig _startpos _endpos _1 ) -# 4690 "parsing/parser.ml" +# 4710 "parsing/parser.ml" in # 2147 "parsing/parser.mly" ( Csig.mk _1 _2 ) -# 4696 "parsing/parser.ml" +# 4716 "parsing/parser.ml" in let _2 = @@ -4700,7 +4720,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 4704 "parsing/parser.ml" +# 4724 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in @@ -4708,7 +4728,7 @@ module Tables = struct # 2127 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 4712 "parsing/parser.ml" +# 4732 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4740,7 +4760,7 @@ module Tables = struct let _v : (Parsetree.class_type) = # 2129 "parsing/parser.mly" ( Cty.attr _1 _2 ) -# 4744 "parsing/parser.ml" +# 4764 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4805,7 +4825,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4809 "parsing/parser.ml" +# 4829 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined2_ in @@ -4814,13 +4834,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 4818 "parsing/parser.ml" +# 4838 "parsing/parser.ml" in let _3 = # 3960 "parsing/parser.mly" ( Fresh ) -# 4824 "parsing/parser.ml" +# 4844 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in @@ -4830,7 +4850,7 @@ module Tables = struct ( 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)) ) -# 4834 "parsing/parser.ml" +# 4854 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4902,7 +4922,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4906 "parsing/parser.ml" +# 4926 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in @@ -4911,13 +4931,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 4915 "parsing/parser.ml" +# 4935 "parsing/parser.ml" in let _3 = # 3961 "parsing/parser.mly" ( Override ) -# 4921 "parsing/parser.ml" +# 4941 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in @@ -4927,7 +4947,7 @@ module Tables = struct ( 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)) ) -# 4931 "parsing/parser.ml" +# 4951 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4966,7 +4986,7 @@ module Tables = struct let _v : (Parsetree.class_expr) = # 1991 "parsing/parser.mly" ( _2 ) -# 4970 "parsing/parser.ml" +# 4990 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5007,7 +5027,7 @@ module Tables = struct # 1993 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 5011 "parsing/parser.ml" +# 5031 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5038,25 +5058,25 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5042 "parsing/parser.ml" +# 5062 "parsing/parser.ml" in let tys = let tys = # 2137 "parsing/parser.mly" ( [] ) -# 5049 "parsing/parser.ml" +# 5069 "parsing/parser.ml" in # 2143 "parsing/parser.mly" ( tys ) -# 5054 "parsing/parser.ml" +# 5074 "parsing/parser.ml" in # 1996 "parsing/parser.mly" ( Pcl_constr(cid, tys) ) -# 5060 "parsing/parser.ml" +# 5080 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -5065,13 +5085,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5069 "parsing/parser.ml" +# 5089 "parsing/parser.ml" in # 2003 "parsing/parser.mly" ( _1 ) -# 5075 "parsing/parser.ml" +# 5095 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5124,7 +5144,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5128 "parsing/parser.ml" +# 5148 "parsing/parser.ml" in let tys = @@ -5133,30 +5153,30 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 5137 "parsing/parser.ml" +# 5157 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 5142 "parsing/parser.ml" +# 5162 "parsing/parser.ml" in # 2139 "parsing/parser.mly" ( params ) -# 5148 "parsing/parser.ml" +# 5168 "parsing/parser.ml" in # 2143 "parsing/parser.mly" ( tys ) -# 5154 "parsing/parser.ml" +# 5174 "parsing/parser.ml" in # 1996 "parsing/parser.mly" ( Pcl_constr(cid, tys) ) -# 5160 "parsing/parser.ml" +# 5180 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -5166,13 +5186,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5170 "parsing/parser.ml" +# 5190 "parsing/parser.ml" in # 2003 "parsing/parser.mly" ( _1 ) -# 5176 "parsing/parser.ml" +# 5196 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5231,12 +5251,12 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 5235 "parsing/parser.ml" +# 5255 "parsing/parser.ml" in # 2030 "parsing/parser.mly" ( _1 ) -# 5240 "parsing/parser.ml" +# 5260 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -5245,13 +5265,13 @@ module Tables = struct # 950 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 5249 "parsing/parser.ml" +# 5269 "parsing/parser.ml" in # 2017 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 5255 "parsing/parser.ml" +# 5275 "parsing/parser.ml" in let _2 = @@ -5259,7 +5279,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 5263 "parsing/parser.ml" +# 5283 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in @@ -5267,7 +5287,7 @@ module Tables = struct # 1998 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 5271 "parsing/parser.ml" +# 5291 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -5277,13 +5297,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5281 "parsing/parser.ml" +# 5301 "parsing/parser.ml" in # 2003 "parsing/parser.mly" ( _1 ) -# 5287 "parsing/parser.ml" +# 5307 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5337,7 +5357,7 @@ module Tables = struct let _1 = # 2000 "parsing/parser.mly" ( Pcl_constraint(_2, _4) ) -# 5341 "parsing/parser.ml" +# 5361 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in let _endpos = _endpos__1_ in @@ -5346,13 +5366,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5350 "parsing/parser.ml" +# 5370 "parsing/parser.ml" in # 2003 "parsing/parser.mly" ( _1 ) -# 5356 "parsing/parser.ml" +# 5376 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5409,7 +5429,7 @@ module Tables = struct # 2002 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 5413 "parsing/parser.ml" +# 5433 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -5419,13 +5439,13 @@ module Tables = struct # 1009 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5423 "parsing/parser.ml" +# 5443 "parsing/parser.ml" in # 2003 "parsing/parser.mly" ( _1 ) -# 5429 "parsing/parser.ml" +# 5449 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5482,12 +5502,12 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 5486 "parsing/parser.ml" +# 5506 "parsing/parser.ml" in # 2030 "parsing/parser.mly" ( _1 ) -# 5491 "parsing/parser.ml" +# 5511 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -5496,13 +5516,13 @@ module Tables = struct # 950 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 5500 "parsing/parser.ml" +# 5520 "parsing/parser.ml" in # 2017 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 5506 "parsing/parser.ml" +# 5526 "parsing/parser.ml" in let _2 = @@ -5510,7 +5530,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 5514 "parsing/parser.ml" +# 5534 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -5519,7 +5539,7 @@ module Tables = struct # 2005 "parsing/parser.mly" ( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) ) -# 5523 "parsing/parser.ml" +# 5543 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5544,7 +5564,7 @@ module Tables = struct let _v : (Parsetree.class_type) = # 2108 "parsing/parser.mly" ( _1 ) -# 5548 "parsing/parser.ml" +# 5568 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5592,12 +5612,12 @@ module Tables = struct let label = # 3494 "parsing/parser.mly" ( Optional label ) -# 5596 "parsing/parser.ml" +# 5616 "parsing/parser.ml" in # 2114 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 5601 "parsing/parser.ml" +# 5621 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -5607,13 +5627,13 @@ module Tables = struct # 1003 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5611 "parsing/parser.ml" +# 5631 "parsing/parser.ml" in # 2115 "parsing/parser.mly" ( _1 ) -# 5617 "parsing/parser.ml" +# 5637 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5662,7 +5682,7 @@ module Tables = struct let label : ( # 774 "parsing/parser.mly" (string) -# 5666 "parsing/parser.ml" +# 5686 "parsing/parser.ml" ) = Obj.magic label in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_label_ in @@ -5672,12 +5692,12 @@ module Tables = struct let label = # 3496 "parsing/parser.mly" ( Labelled label ) -# 5676 "parsing/parser.ml" +# 5696 "parsing/parser.ml" in # 2114 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 5681 "parsing/parser.ml" +# 5701 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -5687,13 +5707,13 @@ module Tables = struct # 1003 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5691 "parsing/parser.ml" +# 5711 "parsing/parser.ml" in # 2115 "parsing/parser.mly" ( _1 ) -# 5697 "parsing/parser.ml" +# 5717 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5734,12 +5754,12 @@ module Tables = struct let label = # 3498 "parsing/parser.mly" ( Nolabel ) -# 5738 "parsing/parser.ml" +# 5758 "parsing/parser.ml" in # 2114 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 5743 "parsing/parser.ml" +# 5763 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in @@ -5749,13 +5769,13 @@ module Tables = struct # 1003 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5753 "parsing/parser.ml" +# 5773 "parsing/parser.ml" in # 2115 "parsing/parser.mly" ( _1 ) -# 5759 "parsing/parser.ml" +# 5779 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5840,7 +5860,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 5844 "parsing/parser.ml" +# 5864 "parsing/parser.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 @@ -5858,7 +5878,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 5862 "parsing/parser.ml" +# 5882 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -5870,7 +5890,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5874 "parsing/parser.ml" +# 5894 "parsing/parser.ml" in let attrs1 = @@ -5878,7 +5898,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 5882 "parsing/parser.ml" +# 5902 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -5893,19 +5913,19 @@ module Tables = struct ext, Ci.mk id csig ~virt ~params ~attrs ~loc ~docs ) -# 5897 "parsing/parser.ml" +# 5917 "parsing/parser.ml" in # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 5903 "parsing/parser.ml" +# 5923 "parsing/parser.ml" in # 2241 "parsing/parser.mly" ( _1 ) -# 5909 "parsing/parser.ml" +# 5929 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5930,7 +5950,7 @@ module Tables = struct let _v : (Longident.t) = # 3839 "parsing/parser.mly" ( _1 ) -# 5934 "parsing/parser.ml" +# 5954 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5951,7 +5971,7 @@ module Tables = struct let _1 : ( # 760 "parsing/parser.mly" (string * char option) -# 5955 "parsing/parser.ml" +# 5975 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -5959,7 +5979,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3722 "parsing/parser.mly" ( let (n, m) = _1 in Pconst_integer (n, m) ) -# 5963 "parsing/parser.ml" +# 5983 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5980,7 +6000,7 @@ module Tables = struct let _1 : ( # 719 "parsing/parser.mly" (char) -# 5984 "parsing/parser.ml" +# 6004 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -5988,7 +6008,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3723 "parsing/parser.mly" ( Pconst_char _1 ) -# 5992 "parsing/parser.ml" +# 6012 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6009,7 +6029,7 @@ module Tables = struct let _1 : ( # 812 "parsing/parser.mly" (string * Location.t * string option) -# 6013 "parsing/parser.ml" +# 6033 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -6017,7 +6037,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3724 "parsing/parser.mly" ( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) ) -# 6021 "parsing/parser.ml" +# 6041 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6038,7 +6058,7 @@ module Tables = struct let _1 : ( # 739 "parsing/parser.mly" (string * char option) -# 6042 "parsing/parser.ml" +# 6062 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -6046,7 +6066,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3725 "parsing/parser.mly" ( let (f, m) = _1 in Pconst_float (f, m) ) -# 6050 "parsing/parser.ml" +# 6070 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6078,7 +6098,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3796 "parsing/parser.mly" ( "[]" ) -# 6082 "parsing/parser.ml" +# 6102 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6110,7 +6130,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3797 "parsing/parser.mly" ( "()" ) -# 6114 "parsing/parser.ml" +# 6134 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6135,7 +6155,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3798 "parsing/parser.mly" ( "false" ) -# 6139 "parsing/parser.ml" +# 6159 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6160,7 +6180,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3799 "parsing/parser.mly" ( "true" ) -# 6164 "parsing/parser.ml" +# 6184 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6181,7 +6201,7 @@ module Tables = struct let _1 : ( # 825 "parsing/parser.mly" (string) -# 6185 "parsing/parser.ml" +# 6205 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -6189,7 +6209,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3802 "parsing/parser.mly" ( _1 ) -# 6193 "parsing/parser.ml" +# 6213 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6228,12 +6248,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3793 "parsing/parser.mly" ( "::" ) -# 6232 "parsing/parser.ml" +# 6252 "parsing/parser.ml" in # 3803 "parsing/parser.mly" ( _1 ) -# 6237 "parsing/parser.ml" +# 6257 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6258,7 +6278,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3804 "parsing/parser.mly" ( _1 ) -# 6262 "parsing/parser.ml" +# 6282 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6283,7 +6303,7 @@ module Tables = struct let _v : (Longident.t) = # 3807 "parsing/parser.mly" ( _1 ) -# 6287 "parsing/parser.ml" +# 6307 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6336,12 +6356,12 @@ module Tables = struct let _v : (Longident.t) = let _3 = # 3793 "parsing/parser.mly" ( "::" ) -# 6340 "parsing/parser.ml" +# 6360 "parsing/parser.ml" in # 3808 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 6345 "parsing/parser.ml" +# 6365 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6380,12 +6400,12 @@ module Tables = struct let _v : (Longident.t) = let _1 = # 3793 "parsing/parser.mly" ( "::" ) -# 6384 "parsing/parser.ml" +# 6404 "parsing/parser.ml" in # 3809 "parsing/parser.mly" ( Lident _1 ) -# 6389 "parsing/parser.ml" +# 6409 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6410,7 +6430,7 @@ module Tables = struct let _v : (Longident.t) = # 3810 "parsing/parser.mly" ( Lident _1 ) -# 6414 "parsing/parser.ml" +# 6434 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6449,7 +6469,7 @@ module Tables = struct let _v : (Parsetree.core_type * Parsetree.core_type) = # 2197 "parsing/parser.mly" ( _1, _3 ) -# 6453 "parsing/parser.ml" +# 6473 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6476,24 +6496,24 @@ module Tables = struct let xs = # 1095 "parsing/parser.mly" ( [ x ] ) -# 6480 "parsing/parser.ml" +# 6500 "parsing/parser.ml" in # 253 "" ( List.rev xs ) -# 6485 "parsing/parser.ml" +# 6505 "parsing/parser.ml" in # 1115 "parsing/parser.mly" ( xs ) -# 6491 "parsing/parser.ml" +# 6511 "parsing/parser.ml" in # 3297 "parsing/parser.mly" ( Pcstr_tuple tys ) -# 6497 "parsing/parser.ml" +# 6517 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6534,24 +6554,24 @@ module Tables = struct let xs = # 1099 "parsing/parser.mly" ( x :: xs ) -# 6538 "parsing/parser.ml" +# 6558 "parsing/parser.ml" in # 253 "" ( List.rev xs ) -# 6543 "parsing/parser.ml" +# 6563 "parsing/parser.ml" in # 1115 "parsing/parser.mly" ( xs ) -# 6549 "parsing/parser.ml" +# 6569 "parsing/parser.ml" in # 3297 "parsing/parser.mly" ( Pcstr_tuple tys ) -# 6555 "parsing/parser.ml" +# 6575 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6590,7 +6610,7 @@ module Tables = struct let _v : (Parsetree.constructor_arguments) = # 3299 "parsing/parser.mly" ( Pcstr_record _2 ) -# 6594 "parsing/parser.ml" +# 6614 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6615,7 +6635,7 @@ module Tables = struct let _v : (Parsetree.constructor_declaration list) = # 3213 "parsing/parser.mly" ( [] ) -# 6619 "parsing/parser.ml" +# 6639 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6640,12 +6660,12 @@ module Tables = struct let _v : (Parsetree.constructor_declaration list) = let cs = # 1200 "parsing/parser.mly" ( List.rev xs ) -# 6644 "parsing/parser.ml" +# 6664 "parsing/parser.ml" in # 3215 "parsing/parser.mly" ( cs ) -# 6649 "parsing/parser.ml" +# 6669 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6670,12 +6690,12 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = # 3456 "parsing/parser.mly" ( _1 ) -# 6674 "parsing/parser.ml" +# 6694 "parsing/parser.ml" in # 3446 "parsing/parser.mly" ( _1 ) -# 6679 "parsing/parser.ml" +# 6699 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6707,7 +6727,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3448 "parsing/parser.mly" ( Typ.attr _1 _2 ) -# 6711 "parsing/parser.ml" +# 6731 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6732,7 +6752,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3596 "parsing/parser.mly" ( _1 ) -# 6736 "parsing/parser.ml" +# 6756 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6757,7 +6777,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3596 "parsing/parser.mly" ( _1 ) -# 6761 "parsing/parser.ml" +# 6781 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6782,7 +6802,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3596 "parsing/parser.mly" ( _1 ) -# 6786 "parsing/parser.ml" +# 6806 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6821,7 +6841,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3549 "parsing/parser.mly" ( type_ ) -# 6825 "parsing/parser.ml" +# 6845 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6888,7 +6908,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 6892 "parsing/parser.ml" +# 6912 "parsing/parser.ml" in let attrs = @@ -6898,13 +6918,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 6902 "parsing/parser.ml" +# 6922 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 6908 "parsing/parser.ml" +# 6928 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -6913,7 +6933,7 @@ module Tables = struct # 3551 "parsing/parser.mly" ( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc package_type) attrs ) -# 6917 "parsing/parser.ml" +# 6937 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6953,7 +6973,7 @@ module Tables = struct let _1 = # 3554 "parsing/parser.mly" ( Ptyp_variant([ field ], Closed, None) ) -# 6957 "parsing/parser.ml" +# 6977 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -6962,13 +6982,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 6966 "parsing/parser.ml" +# 6986 "parsing/parser.ml" in # 3571 "parsing/parser.mly" ( _1 ) -# 6972 "parsing/parser.ml" +# 6992 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7018,24 +7038,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7022 "parsing/parser.ml" +# 7042 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 7027 "parsing/parser.ml" +# 7047 "parsing/parser.ml" in # 3648 "parsing/parser.mly" ( _1 ) -# 7033 "parsing/parser.ml" +# 7053 "parsing/parser.ml" in # 3556 "parsing/parser.mly" ( Ptyp_variant(fields, Closed, None) ) -# 7039 "parsing/parser.ml" +# 7059 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -7045,13 +7065,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 7049 "parsing/parser.ml" +# 7069 "parsing/parser.ml" in # 3571 "parsing/parser.mly" ( _1 ) -# 7055 "parsing/parser.ml" +# 7075 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7108,24 +7128,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7112 "parsing/parser.ml" +# 7132 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 7117 "parsing/parser.ml" +# 7137 "parsing/parser.ml" in # 3648 "parsing/parser.mly" ( _1 ) -# 7123 "parsing/parser.ml" +# 7143 "parsing/parser.ml" in # 3558 "parsing/parser.mly" ( Ptyp_variant(field :: fields, Closed, None) ) -# 7129 "parsing/parser.ml" +# 7149 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -7135,13 +7155,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 7139 "parsing/parser.ml" +# 7159 "parsing/parser.ml" in # 3571 "parsing/parser.mly" ( _1 ) -# 7145 "parsing/parser.ml" +# 7165 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7191,24 +7211,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7195 "parsing/parser.ml" +# 7215 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 7200 "parsing/parser.ml" +# 7220 "parsing/parser.ml" in # 3648 "parsing/parser.mly" ( _1 ) -# 7206 "parsing/parser.ml" +# 7226 "parsing/parser.ml" in # 3560 "parsing/parser.mly" ( Ptyp_variant(fields, Open, None) ) -# 7212 "parsing/parser.ml" +# 7232 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -7218,13 +7238,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 7222 "parsing/parser.ml" +# 7242 "parsing/parser.ml" in # 3571 "parsing/parser.mly" ( _1 ) -# 7228 "parsing/parser.ml" +# 7248 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7257,7 +7277,7 @@ module Tables = struct let _1 = # 3562 "parsing/parser.mly" ( Ptyp_variant([], Open, None) ) -# 7261 "parsing/parser.ml" +# 7281 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -7266,13 +7286,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 7270 "parsing/parser.ml" +# 7290 "parsing/parser.ml" in # 3571 "parsing/parser.mly" ( _1 ) -# 7276 "parsing/parser.ml" +# 7296 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7322,24 +7342,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7326 "parsing/parser.ml" +# 7346 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 7331 "parsing/parser.ml" +# 7351 "parsing/parser.ml" in # 3648 "parsing/parser.mly" ( _1 ) -# 7337 "parsing/parser.ml" +# 7357 "parsing/parser.ml" in # 3564 "parsing/parser.mly" ( Ptyp_variant(fields, Closed, Some []) ) -# 7343 "parsing/parser.ml" +# 7363 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -7349,13 +7369,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 7353 "parsing/parser.ml" +# 7373 "parsing/parser.ml" in # 3571 "parsing/parser.mly" ( _1 ) -# 7359 "parsing/parser.ml" +# 7379 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7420,18 +7440,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7424 "parsing/parser.ml" +# 7444 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 7429 "parsing/parser.ml" +# 7449 "parsing/parser.ml" in # 3676 "parsing/parser.mly" ( _1 ) -# 7435 "parsing/parser.ml" +# 7455 "parsing/parser.ml" in let fields = @@ -7439,24 +7459,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7443 "parsing/parser.ml" +# 7463 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 7448 "parsing/parser.ml" +# 7468 "parsing/parser.ml" in # 3648 "parsing/parser.mly" ( _1 ) -# 7454 "parsing/parser.ml" +# 7474 "parsing/parser.ml" in # 3569 "parsing/parser.mly" ( Ptyp_variant(fields, Closed, Some tags) ) -# 7460 "parsing/parser.ml" +# 7480 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -7466,13 +7486,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 7470 "parsing/parser.ml" +# 7490 "parsing/parser.ml" in # 3571 "parsing/parser.mly" ( _1 ) -# 7476 "parsing/parser.ml" +# 7496 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7497,7 +7517,7 @@ module Tables = struct let _v : (Asttypes.direction_flag) = # 3905 "parsing/parser.mly" ( Upto ) -# 7501 "parsing/parser.ml" +# 7521 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7522,7 +7542,7 @@ module Tables = struct let _v : (Asttypes.direction_flag) = # 3906 "parsing/parser.mly" ( Downto ) -# 7526 "parsing/parser.ml" +# 7546 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7540,7 +7560,7 @@ module Tables = struct let _v : (string Asttypes.loc option) = # 4061 "parsing/parser.mly" ( None ) -# 7544 "parsing/parser.ml" +# 7564 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7572,7 +7592,7 @@ module Tables = struct let _v : (string Asttypes.loc option) = # 4062 "parsing/parser.mly" ( Some _2 ) -# 7576 "parsing/parser.ml" +# 7596 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7618,7 +7638,7 @@ module Tables = struct let _v : (Parsetree.extension) = # 4074 "parsing/parser.mly" ( (_2, _3) ) -# 7622 "parsing/parser.ml" +# 7642 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7639,7 +7659,7 @@ module Tables = struct let _1 : ( # 814 "parsing/parser.mly" (string * Location.t * string * Location.t * string option) -# 7643 "parsing/parser.ml" +# 7663 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -7650,7 +7670,7 @@ module Tables = struct # 4076 "parsing/parser.mly" ( mk_quotedext ~loc:_sloc _1 ) -# 7654 "parsing/parser.ml" +# 7674 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7705,7 +7725,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 7709 "parsing/parser.ml" +# 7729 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined3_ in @@ -7717,7 +7737,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7721 "parsing/parser.ml" +# 7741 "parsing/parser.ml" in let cid = @@ -7728,7 +7748,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7732 "parsing/parser.ml" +# 7752 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in @@ -7738,7 +7758,7 @@ module Tables = struct # 3366 "parsing/parser.mly" ( let info = symbol_info _endpos in Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info ) -# 7742 "parsing/parser.ml" +# 7762 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7786,7 +7806,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 7790 "parsing/parser.ml" +# 7810 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined2_ in @@ -7798,7 +7818,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7802 "parsing/parser.ml" +# 7822 "parsing/parser.ml" in let cid = @@ -7808,14 +7828,14 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7812 "parsing/parser.ml" +# 7832 "parsing/parser.ml" in let _startpos_cid_ = _startpos__1_ in let _1 = # 3879 "parsing/parser.mly" ( () ) -# 7819 "parsing/parser.ml" +# 7839 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos_cid_ in @@ -7824,7 +7844,7 @@ module Tables = struct # 3366 "parsing/parser.mly" ( let info = symbol_info _endpos in Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info ) -# 7828 "parsing/parser.ml" +# 7848 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7850,7 +7870,7 @@ module Tables = struct let _1 = # 3587 "parsing/parser.mly" ( Ptyp_extension ext ) -# 7854 "parsing/parser.ml" +# 7874 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_ext_, _startpos_ext_) in let _endpos = _endpos__1_ in @@ -7859,13 +7879,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 7863 "parsing/parser.ml" +# 7883 "parsing/parser.ml" in # 3589 "parsing/parser.mly" ( _1 ) -# 7869 "parsing/parser.ml" +# 7889 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7915,7 +7935,7 @@ module Tables = struct # 4049 "parsing/parser.mly" ( mark_symbol_docs _sloc; Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 7919 "parsing/parser.ml" +# 7939 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7933,12 +7953,12 @@ module Tables = struct let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params = # 2137 "parsing/parser.mly" ( [] ) -# 7937 "parsing/parser.ml" +# 7957 "parsing/parser.ml" in # 1962 "parsing/parser.mly" ( params ) -# 7942 "parsing/parser.ml" +# 7962 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7979,24 +7999,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7983 "parsing/parser.ml" +# 8003 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 7988 "parsing/parser.ml" +# 8008 "parsing/parser.ml" in # 2139 "parsing/parser.mly" ( params ) -# 7994 "parsing/parser.ml" +# 8014 "parsing/parser.ml" in # 1962 "parsing/parser.mly" ( params ) -# 8000 "parsing/parser.ml" +# 8020 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8044,18 +8064,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 8048 "parsing/parser.ml" +# 8068 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 8053 "parsing/parser.ml" +# 8073 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 8059 "parsing/parser.ml" +# 8079 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -8066,13 +8086,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8070 "parsing/parser.ml" +# 8090 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8076 "parsing/parser.ml" +# 8096 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -8089,7 +8109,7 @@ module Tables = struct Pfunction_body (mkexp_attrs ~loc:_sloc (mkfunction [] None cases) _2) ) -# 8093 "parsing/parser.ml" +# 8113 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8114,7 +8134,7 @@ module Tables = struct let _v : (Parsetree.function_body) = # 2748 "parsing/parser.mly" ( Pfunction_body _1 ) -# 8118 "parsing/parser.ml" +# 8138 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8139,7 +8159,7 @@ module Tables = struct let _v : (Parsetree.expression) = # 2395 "parsing/parser.mly" ( _1 ) -# 8143 "parsing/parser.ml" +# 8163 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8219,7 +8239,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 8223 "parsing/parser.ml" +# 8243 "parsing/parser.ml" in let _3 = @@ -8229,19 +8249,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8233 "parsing/parser.ml" +# 8253 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8239 "parsing/parser.ml" +# 8259 "parsing/parser.ml" in # 2431 "parsing/parser.mly" ( Pexp_letmodule(_4, _5, _7), _3 ) -# 8245 "parsing/parser.ml" +# 8265 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -8252,7 +8272,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8256 "parsing/parser.ml" +# 8276 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8339,7 +8359,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8343 "parsing/parser.ml" +# 8363 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -8350,7 +8370,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 8354 "parsing/parser.ml" +# 8374 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -8360,7 +8380,7 @@ module Tables = struct # 3277 "parsing/parser.mly" ( let vars, args, res = _2 in Te.decl _1 ~vars ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) ) -# 8364 "parsing/parser.ml" +# 8384 "parsing/parser.ml" in let _3 = @@ -8370,19 +8390,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8374 "parsing/parser.ml" +# 8394 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8380 "parsing/parser.ml" +# 8400 "parsing/parser.ml" in # 2433 "parsing/parser.mly" ( Pexp_letexception(_4, _6), _3 ) -# 8386 "parsing/parser.ml" +# 8406 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -8393,7 +8413,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8397 "parsing/parser.ml" +# 8417 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8465,26 +8485,26 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8469 "parsing/parser.ml" +# 8489 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8475 "parsing/parser.ml" +# 8495 "parsing/parser.ml" in let _3 = # 3960 "parsing/parser.mly" ( Fresh ) -# 8481 "parsing/parser.ml" +# 8501 "parsing/parser.ml" in # 2435 "parsing/parser.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, _7), _4 ) -# 8488 "parsing/parser.ml" +# 8508 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -8495,7 +8515,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8499 "parsing/parser.ml" +# 8519 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8574,26 +8594,26 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8578 "parsing/parser.ml" +# 8598 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8584 "parsing/parser.ml" +# 8604 "parsing/parser.ml" in let _3 = # 3961 "parsing/parser.mly" ( Override ) -# 8590 "parsing/parser.ml" +# 8610 "parsing/parser.ml" in # 2435 "parsing/parser.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, _7), _4 ) -# 8597 "parsing/parser.ml" +# 8617 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -8604,7 +8624,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8608 "parsing/parser.ml" +# 8628 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8676,13 +8696,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8680 "parsing/parser.ml" +# 8700 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8686 "parsing/parser.ml" +# 8706 "parsing/parser.ml" in @@ -8690,7 +8710,7 @@ module Tables = struct ( let body_constraint = Option.map (fun x -> Pconstraint x) _4 in mkfunction _3 body_constraint _6, _2 ) -# 8694 "parsing/parser.ml" +# 8714 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -8701,7 +8721,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8705 "parsing/parser.ml" +# 8725 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8764,18 +8784,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 8768 "parsing/parser.ml" +# 8788 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 8773 "parsing/parser.ml" +# 8793 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 8779 "parsing/parser.ml" +# 8799 "parsing/parser.ml" in let _2 = @@ -8785,19 +8805,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8789 "parsing/parser.ml" +# 8809 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8795 "parsing/parser.ml" +# 8815 "parsing/parser.ml" in # 2445 "parsing/parser.mly" ( Pexp_match(_3, _5), _2 ) -# 8801 "parsing/parser.ml" +# 8821 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -8808,7 +8828,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8812 "parsing/parser.ml" +# 8832 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8871,18 +8891,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 8875 "parsing/parser.ml" +# 8895 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 8880 "parsing/parser.ml" +# 8900 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 8886 "parsing/parser.ml" +# 8906 "parsing/parser.ml" in let _2 = @@ -8892,19 +8912,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8896 "parsing/parser.ml" +# 8916 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8902 "parsing/parser.ml" +# 8922 "parsing/parser.ml" in # 2447 "parsing/parser.mly" ( Pexp_try(_3, _5), _2 ) -# 8908 "parsing/parser.ml" +# 8928 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -8915,7 +8935,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8919 "parsing/parser.ml" +# 8939 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8980,19 +9000,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 8984 "parsing/parser.ml" +# 9004 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 8990 "parsing/parser.ml" +# 9010 "parsing/parser.ml" in # 2449 "parsing/parser.mly" ( syntax_error() ) -# 8996 "parsing/parser.ml" +# 9016 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -9003,7 +9023,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9007 "parsing/parser.ml" +# 9027 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9080,12 +9100,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 9084 "parsing/parser.ml" +# 9104 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9089 "parsing/parser.ml" +# 9109 "parsing/parser.ml" in let _5 = @@ -9093,12 +9113,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 9097 "parsing/parser.ml" +# 9117 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9102 "parsing/parser.ml" +# 9122 "parsing/parser.ml" in let _2 = @@ -9108,19 +9128,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9112 "parsing/parser.ml" +# 9132 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9118 "parsing/parser.ml" +# 9138 "parsing/parser.ml" in # 2451 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, Some _7), _2 ) -# 9124 "parsing/parser.ml" +# 9144 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -9131,7 +9151,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9135 "parsing/parser.ml" +# 9155 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9232,18 +9252,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 9236 "parsing/parser.ml" +# 9256 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 9241 "parsing/parser.ml" +# 9261 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 9247 "parsing/parser.ml" +# 9267 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -9254,13 +9274,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9258 "parsing/parser.ml" +# 9278 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9264 "parsing/parser.ml" +# 9284 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -9280,13 +9300,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 9284 "parsing/parser.ml" +# 9304 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9290 "parsing/parser.ml" +# 9310 "parsing/parser.ml" in let _5 = @@ -9294,12 +9314,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 9298 "parsing/parser.ml" +# 9318 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9303 "parsing/parser.ml" +# 9323 "parsing/parser.ml" in let _2 = @@ -9309,19 +9329,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9313 "parsing/parser.ml" +# 9333 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9319 "parsing/parser.ml" +# 9339 "parsing/parser.ml" in # 2451 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, Some _7), _2 ) -# 9325 "parsing/parser.ml" +# 9345 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -9332,7 +9352,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9336 "parsing/parser.ml" +# 9356 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9430,12 +9450,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 9434 "parsing/parser.ml" +# 9454 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9439 "parsing/parser.ml" +# 9459 "parsing/parser.ml" in let _5 = @@ -9446,18 +9466,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 9450 "parsing/parser.ml" +# 9470 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 9455 "parsing/parser.ml" +# 9475 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 9461 "parsing/parser.ml" +# 9481 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -9468,13 +9488,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9472 "parsing/parser.ml" +# 9492 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9478 "parsing/parser.ml" +# 9498 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -9494,13 +9514,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 9498 "parsing/parser.ml" +# 9518 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9504 "parsing/parser.ml" +# 9524 "parsing/parser.ml" in let _2 = @@ -9510,19 +9530,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9514 "parsing/parser.ml" +# 9534 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9520 "parsing/parser.ml" +# 9540 "parsing/parser.ml" in # 2451 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, Some _7), _2 ) -# 9526 "parsing/parser.ml" +# 9546 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined6_ in @@ -9533,7 +9553,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9537 "parsing/parser.ml" +# 9557 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9655,18 +9675,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 9659 "parsing/parser.ml" +# 9679 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 9664 "parsing/parser.ml" +# 9684 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 9670 "parsing/parser.ml" +# 9690 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -9677,13 +9697,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9681 "parsing/parser.ml" +# 9701 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9687 "parsing/parser.ml" +# 9707 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -9703,13 +9723,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 9707 "parsing/parser.ml" +# 9727 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9713 "parsing/parser.ml" +# 9733 "parsing/parser.ml" in let _5 = @@ -9720,18 +9740,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 9724 "parsing/parser.ml" +# 9744 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 9729 "parsing/parser.ml" +# 9749 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 9735 "parsing/parser.ml" +# 9755 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -9742,13 +9762,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9746 "parsing/parser.ml" +# 9766 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9752 "parsing/parser.ml" +# 9772 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -9768,13 +9788,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 9772 "parsing/parser.ml" +# 9792 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9778 "parsing/parser.ml" +# 9798 "parsing/parser.ml" in let _2 = @@ -9784,19 +9804,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9788 "parsing/parser.ml" +# 9808 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9794 "parsing/parser.ml" +# 9814 "parsing/parser.ml" in # 2451 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, Some _7), _2 ) -# 9800 "parsing/parser.ml" +# 9820 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_inlined1_ in @@ -9807,7 +9827,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9811 "parsing/parser.ml" +# 9831 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9870,12 +9890,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 9874 "parsing/parser.ml" +# 9894 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 9879 "parsing/parser.ml" +# 9899 "parsing/parser.ml" in let _2 = @@ -9885,19 +9905,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 9889 "parsing/parser.ml" +# 9909 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 9895 "parsing/parser.ml" +# 9915 "parsing/parser.ml" in # 2453 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, None), _2 ) -# 9901 "parsing/parser.ml" +# 9921 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -9908,7 +9928,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9912 "parsing/parser.ml" +# 9932 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9995,18 +10015,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 9999 "parsing/parser.ml" +# 10019 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 10004 "parsing/parser.ml" +# 10024 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 10010 "parsing/parser.ml" +# 10030 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -10017,13 +10037,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10021 "parsing/parser.ml" +# 10041 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10027 "parsing/parser.ml" +# 10047 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -10043,13 +10063,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 10047 "parsing/parser.ml" +# 10067 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 10053 "parsing/parser.ml" +# 10073 "parsing/parser.ml" in let _2 = @@ -10059,19 +10079,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10063 "parsing/parser.ml" +# 10083 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10069 "parsing/parser.ml" +# 10089 "parsing/parser.ml" in # 2453 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, None), _2 ) -# 10075 "parsing/parser.ml" +# 10095 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -10082,7 +10102,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 10086 "parsing/parser.ml" +# 10106 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10150,7 +10170,7 @@ module Tables = struct let _4 = # 2466 "parsing/parser.mly" ( e ) -# 10154 "parsing/parser.ml" +# 10174 "parsing/parser.ml" in let _2 = let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in @@ -10159,19 +10179,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10163 "parsing/parser.ml" +# 10183 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10169 "parsing/parser.ml" +# 10189 "parsing/parser.ml" in # 2455 "parsing/parser.mly" ( Pexp_while(_3, _4), _2 ) -# 10175 "parsing/parser.ml" +# 10195 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_inlined1_ in @@ -10182,7 +10202,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 10186 "parsing/parser.ml" +# 10206 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10254,7 +10274,7 @@ module Tables = struct # 2468 "parsing/parser.mly" ( unclosed "do" _loc__1_ "done" _loc__2_ ) -# 10258 "parsing/parser.ml" +# 10278 "parsing/parser.ml" in let _2 = @@ -10264,19 +10284,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10268 "parsing/parser.ml" +# 10288 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10274 "parsing/parser.ml" +# 10294 "parsing/parser.ml" in # 2455 "parsing/parser.mly" ( Pexp_while(_3, _4), _2 ) -# 10280 "parsing/parser.ml" +# 10300 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_inlined1_ in @@ -10287,7 +10307,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 10291 "parsing/parser.ml" +# 10311 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10383,7 +10403,7 @@ module Tables = struct let _8 = # 2466 "parsing/parser.mly" ( e ) -# 10387 "parsing/parser.ml" +# 10407 "parsing/parser.ml" in let _2 = let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in @@ -10392,19 +10412,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10396 "parsing/parser.ml" +# 10416 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10402 "parsing/parser.ml" +# 10422 "parsing/parser.ml" in # 2458 "parsing/parser.mly" ( Pexp_for(_3, _5, _7, _6, _8), _2 ) -# 10408 "parsing/parser.ml" +# 10428 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_inlined1_ in @@ -10415,7 +10435,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 10419 "parsing/parser.ml" +# 10439 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10515,7 +10535,7 @@ module Tables = struct # 2468 "parsing/parser.mly" ( unclosed "do" _loc__1_ "done" _loc__2_ ) -# 10519 "parsing/parser.ml" +# 10539 "parsing/parser.ml" in let _2 = @@ -10525,19 +10545,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10529 "parsing/parser.ml" +# 10549 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10535 "parsing/parser.ml" +# 10555 "parsing/parser.ml" in # 2458 "parsing/parser.mly" ( Pexp_for(_3, _5, _7, _6, _8), _2 ) -# 10541 "parsing/parser.ml" +# 10561 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_inlined1_ in @@ -10548,7 +10568,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 10552 "parsing/parser.ml" +# 10572 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10599,19 +10619,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10603 "parsing/parser.ml" +# 10623 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10609 "parsing/parser.ml" +# 10629 "parsing/parser.ml" in # 2460 "parsing/parser.mly" ( Pexp_assert _3, _2 ) -# 10615 "parsing/parser.ml" +# 10635 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -10622,7 +10642,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 10626 "parsing/parser.ml" +# 10646 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10673,19 +10693,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 10677 "parsing/parser.ml" +# 10697 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 10683 "parsing/parser.ml" +# 10703 "parsing/parser.ml" in # 2462 "parsing/parser.mly" ( Pexp_lazy _3, _2 ) -# 10689 "parsing/parser.ml" +# 10709 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -10696,7 +10716,7 @@ module Tables = struct # 2397 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 10700 "parsing/parser.ml" +# 10720 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10731,18 +10751,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 10735 "parsing/parser.ml" +# 10755 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 10740 "parsing/parser.ml" +# 10760 "parsing/parser.ml" in # 2472 "parsing/parser.mly" ( Pexp_apply(_1, _2) ) -# 10746 "parsing/parser.ml" +# 10766 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -10752,13 +10772,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10756 "parsing/parser.ml" +# 10776 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 10762 "parsing/parser.ml" +# 10782 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10787,24 +10807,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 10791 "parsing/parser.ml" +# 10811 "parsing/parser.ml" in # 1139 "parsing/parser.mly" ( xs ) -# 10796 "parsing/parser.ml" +# 10816 "parsing/parser.ml" in # 2787 "parsing/parser.mly" ( es ) -# 10802 "parsing/parser.ml" +# 10822 "parsing/parser.ml" in # 2474 "parsing/parser.mly" ( Pexp_tuple(_1) ) -# 10808 "parsing/parser.ml" +# 10828 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in @@ -10814,13 +10834,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10818 "parsing/parser.ml" +# 10838 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 10824 "parsing/parser.ml" +# 10844 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10858,13 +10878,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 10862 "parsing/parser.ml" +# 10882 "parsing/parser.ml" in # 2476 "parsing/parser.mly" ( Pexp_construct(_1, Some _2) ) -# 10868 "parsing/parser.ml" +# 10888 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -10874,13 +10894,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10878 "parsing/parser.ml" +# 10898 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 10884 "parsing/parser.ml" +# 10904 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10913,7 +10933,7 @@ module Tables = struct let _1 = # 2478 "parsing/parser.mly" ( Pexp_variant(_1, Some _2) ) -# 10917 "parsing/parser.ml" +# 10937 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -10922,13 +10942,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10926 "parsing/parser.ml" +# 10946 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 10932 "parsing/parser.ml" +# 10952 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10962,7 +10982,7 @@ module Tables = struct let op : ( # 750 "parsing/parser.mly" (string) -# 10966 "parsing/parser.ml" +# 10986 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -10974,19 +10994,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 10978 "parsing/parser.ml" +# 10998 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 10983 "parsing/parser.ml" +# 11003 "parsing/parser.ml" in let op = let _1 = # 3766 "parsing/parser.mly" ( op ) -# 10990 "parsing/parser.ml" +# 11010 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -10995,13 +11015,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10999 "parsing/parser.ml" +# 11019 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11005 "parsing/parser.ml" +# 11025 "parsing/parser.ml" in let _startpos__1_ = _startpos_e1_ in @@ -11011,13 +11031,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11015 "parsing/parser.ml" +# 11035 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11021 "parsing/parser.ml" +# 11041 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11072,7 +11092,7 @@ module Tables = struct let op : ( # 750 "parsing/parser.mly" (string) -# 11076 "parsing/parser.ml" +# 11096 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11087,18 +11107,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 11091 "parsing/parser.ml" +# 11111 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 11096 "parsing/parser.ml" +# 11116 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 11102 "parsing/parser.ml" +# 11122 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -11109,13 +11129,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 11113 "parsing/parser.ml" +# 11133 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 11119 "parsing/parser.ml" +# 11139 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -11135,20 +11155,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 11139 "parsing/parser.ml" +# 11159 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11145 "parsing/parser.ml" +# 11165 "parsing/parser.ml" in let op = let _1 = # 3766 "parsing/parser.mly" ( op ) -# 11152 "parsing/parser.ml" +# 11172 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11157,13 +11177,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11161 "parsing/parser.ml" +# 11181 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11167 "parsing/parser.ml" +# 11187 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -11173,13 +11193,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11177 "parsing/parser.ml" +# 11197 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11183 "parsing/parser.ml" +# 11203 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11213,7 +11233,7 @@ module Tables = struct let op : ( # 751 "parsing/parser.mly" (string) -# 11217 "parsing/parser.ml" +# 11237 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11225,19 +11245,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 11229 "parsing/parser.ml" +# 11249 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11234 "parsing/parser.ml" +# 11254 "parsing/parser.ml" in let op = let _1 = # 3767 "parsing/parser.mly" ( op ) -# 11241 "parsing/parser.ml" +# 11261 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11246,13 +11266,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11250 "parsing/parser.ml" +# 11270 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11256 "parsing/parser.ml" +# 11276 "parsing/parser.ml" in let _startpos__1_ = _startpos_e1_ in @@ -11262,13 +11282,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11266 "parsing/parser.ml" +# 11286 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11272 "parsing/parser.ml" +# 11292 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11323,7 +11343,7 @@ module Tables = struct let op : ( # 751 "parsing/parser.mly" (string) -# 11327 "parsing/parser.ml" +# 11347 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11338,18 +11358,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 11342 "parsing/parser.ml" +# 11362 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 11347 "parsing/parser.ml" +# 11367 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 11353 "parsing/parser.ml" +# 11373 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -11360,13 +11380,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 11364 "parsing/parser.ml" +# 11384 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 11370 "parsing/parser.ml" +# 11390 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -11386,20 +11406,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 11390 "parsing/parser.ml" +# 11410 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11396 "parsing/parser.ml" +# 11416 "parsing/parser.ml" in let op = let _1 = # 3767 "parsing/parser.mly" ( op ) -# 11403 "parsing/parser.ml" +# 11423 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11408,13 +11428,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11412 "parsing/parser.ml" +# 11432 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11418 "parsing/parser.ml" +# 11438 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -11424,13 +11444,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11428 "parsing/parser.ml" +# 11448 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11434 "parsing/parser.ml" +# 11454 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11464,7 +11484,7 @@ module Tables = struct let op : ( # 752 "parsing/parser.mly" (string) -# 11468 "parsing/parser.ml" +# 11488 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11476,19 +11496,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 11480 "parsing/parser.ml" +# 11500 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11485 "parsing/parser.ml" +# 11505 "parsing/parser.ml" in let op = let _1 = # 3768 "parsing/parser.mly" ( op ) -# 11492 "parsing/parser.ml" +# 11512 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11497,13 +11517,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11501 "parsing/parser.ml" +# 11521 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11507 "parsing/parser.ml" +# 11527 "parsing/parser.ml" in let _startpos__1_ = _startpos_e1_ in @@ -11513,13 +11533,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11517 "parsing/parser.ml" +# 11537 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11523 "parsing/parser.ml" +# 11543 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11574,7 +11594,7 @@ module Tables = struct let op : ( # 752 "parsing/parser.mly" (string) -# 11578 "parsing/parser.ml" +# 11598 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11589,18 +11609,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 11593 "parsing/parser.ml" +# 11613 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 11598 "parsing/parser.ml" +# 11618 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 11604 "parsing/parser.ml" +# 11624 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -11611,13 +11631,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 11615 "parsing/parser.ml" +# 11635 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 11621 "parsing/parser.ml" +# 11641 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -11637,20 +11657,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 11641 "parsing/parser.ml" +# 11661 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11647 "parsing/parser.ml" +# 11667 "parsing/parser.ml" in let op = let _1 = # 3768 "parsing/parser.mly" ( op ) -# 11654 "parsing/parser.ml" +# 11674 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11659,13 +11679,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11663 "parsing/parser.ml" +# 11683 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11669 "parsing/parser.ml" +# 11689 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -11675,13 +11695,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11679 "parsing/parser.ml" +# 11699 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11685 "parsing/parser.ml" +# 11705 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11715,7 +11735,7 @@ module Tables = struct let op : ( # 753 "parsing/parser.mly" (string) -# 11719 "parsing/parser.ml" +# 11739 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11727,19 +11747,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 11731 "parsing/parser.ml" +# 11751 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11736 "parsing/parser.ml" +# 11756 "parsing/parser.ml" in let op = let _1 = # 3769 "parsing/parser.mly" ( op ) -# 11743 "parsing/parser.ml" +# 11763 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11748,13 +11768,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11752 "parsing/parser.ml" +# 11772 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11758 "parsing/parser.ml" +# 11778 "parsing/parser.ml" in let _startpos__1_ = _startpos_e1_ in @@ -11764,13 +11784,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11768 "parsing/parser.ml" +# 11788 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11774 "parsing/parser.ml" +# 11794 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11825,7 +11845,7 @@ module Tables = struct let op : ( # 753 "parsing/parser.mly" (string) -# 11829 "parsing/parser.ml" +# 11849 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11840,18 +11860,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 11844 "parsing/parser.ml" +# 11864 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 11849 "parsing/parser.ml" +# 11869 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 11855 "parsing/parser.ml" +# 11875 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -11862,13 +11882,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 11866 "parsing/parser.ml" +# 11886 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 11872 "parsing/parser.ml" +# 11892 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -11888,20 +11908,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 11892 "parsing/parser.ml" +# 11912 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11898 "parsing/parser.ml" +# 11918 "parsing/parser.ml" in let op = let _1 = # 3769 "parsing/parser.mly" ( op ) -# 11905 "parsing/parser.ml" +# 11925 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11910,13 +11930,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11914 "parsing/parser.ml" +# 11934 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11920 "parsing/parser.ml" +# 11940 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -11926,13 +11946,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11930 "parsing/parser.ml" +# 11950 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 11936 "parsing/parser.ml" +# 11956 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11966,7 +11986,7 @@ module Tables = struct let op : ( # 754 "parsing/parser.mly" (string) -# 11970 "parsing/parser.ml" +# 11990 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -11978,19 +11998,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 11982 "parsing/parser.ml" +# 12002 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 11987 "parsing/parser.ml" +# 12007 "parsing/parser.ml" in let op = let _1 = # 3770 "parsing/parser.mly" ( op ) -# 11994 "parsing/parser.ml" +# 12014 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -11999,13 +12019,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12003 "parsing/parser.ml" +# 12023 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12009 "parsing/parser.ml" +# 12029 "parsing/parser.ml" in let _startpos__1_ = _startpos_e1_ in @@ -12015,13 +12035,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12019 "parsing/parser.ml" +# 12039 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12025 "parsing/parser.ml" +# 12045 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12076,7 +12096,7 @@ module Tables = struct let op : ( # 754 "parsing/parser.mly" (string) -# 12080 "parsing/parser.ml" +# 12100 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -12091,18 +12111,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 12095 "parsing/parser.ml" +# 12115 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 12100 "parsing/parser.ml" +# 12120 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 12106 "parsing/parser.ml" +# 12126 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -12113,13 +12133,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 12117 "parsing/parser.ml" +# 12137 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 12123 "parsing/parser.ml" +# 12143 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -12139,20 +12159,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 12143 "parsing/parser.ml" +# 12163 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12149 "parsing/parser.ml" +# 12169 "parsing/parser.ml" in let op = let _1 = # 3770 "parsing/parser.mly" ( op ) -# 12156 "parsing/parser.ml" +# 12176 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in @@ -12161,13 +12181,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12165 "parsing/parser.ml" +# 12185 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12171 "parsing/parser.ml" +# 12191 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -12177,13 +12197,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12181 "parsing/parser.ml" +# 12201 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12187 "parsing/parser.ml" +# 12207 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12226,19 +12246,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 12230 "parsing/parser.ml" +# 12250 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12235 "parsing/parser.ml" +# 12255 "parsing/parser.ml" in let op = let _1 = # 3771 "parsing/parser.mly" ("+") -# 12242 "parsing/parser.ml" +# 12262 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -12246,13 +12266,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12250 "parsing/parser.ml" +# 12270 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12256 "parsing/parser.ml" +# 12276 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -12262,13 +12282,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12266 "parsing/parser.ml" +# 12286 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12272 "parsing/parser.ml" +# 12292 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12335,18 +12355,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 12339 "parsing/parser.ml" +# 12359 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 12344 "parsing/parser.ml" +# 12364 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 12350 "parsing/parser.ml" +# 12370 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -12357,13 +12377,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 12361 "parsing/parser.ml" +# 12381 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 12367 "parsing/parser.ml" +# 12387 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -12383,20 +12403,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 12387 "parsing/parser.ml" +# 12407 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12393 "parsing/parser.ml" +# 12413 "parsing/parser.ml" in let op = let _1 = # 3771 "parsing/parser.mly" ("+") -# 12400 "parsing/parser.ml" +# 12420 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -12404,13 +12424,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12408 "parsing/parser.ml" +# 12428 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12414 "parsing/parser.ml" +# 12434 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -12420,13 +12440,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12424 "parsing/parser.ml" +# 12444 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12430 "parsing/parser.ml" +# 12450 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12469,19 +12489,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 12473 "parsing/parser.ml" +# 12493 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12478 "parsing/parser.ml" +# 12498 "parsing/parser.ml" in let op = let _1 = # 3772 "parsing/parser.mly" ("+.") -# 12485 "parsing/parser.ml" +# 12505 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -12489,13 +12509,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12493 "parsing/parser.ml" +# 12513 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12499 "parsing/parser.ml" +# 12519 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -12505,13 +12525,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12509 "parsing/parser.ml" +# 12529 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12515 "parsing/parser.ml" +# 12535 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12578,18 +12598,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 12582 "parsing/parser.ml" +# 12602 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 12587 "parsing/parser.ml" +# 12607 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 12593 "parsing/parser.ml" +# 12613 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -12600,13 +12620,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 12604 "parsing/parser.ml" +# 12624 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 12610 "parsing/parser.ml" +# 12630 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -12626,20 +12646,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 12630 "parsing/parser.ml" +# 12650 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12636 "parsing/parser.ml" +# 12656 "parsing/parser.ml" in let op = let _1 = # 3772 "parsing/parser.mly" ("+.") -# 12643 "parsing/parser.ml" +# 12663 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -12647,13 +12667,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12651 "parsing/parser.ml" +# 12671 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12657 "parsing/parser.ml" +# 12677 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -12663,13 +12683,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12667 "parsing/parser.ml" +# 12687 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12673 "parsing/parser.ml" +# 12693 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12712,19 +12732,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 12716 "parsing/parser.ml" +# 12736 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12721 "parsing/parser.ml" +# 12741 "parsing/parser.ml" in let op = let _1 = # 3773 "parsing/parser.mly" ("+=") -# 12728 "parsing/parser.ml" +# 12748 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -12732,13 +12752,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12736 "parsing/parser.ml" +# 12756 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12742 "parsing/parser.ml" +# 12762 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -12748,13 +12768,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12752 "parsing/parser.ml" +# 12772 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12758 "parsing/parser.ml" +# 12778 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12821,18 +12841,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 12825 "parsing/parser.ml" +# 12845 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 12830 "parsing/parser.ml" +# 12850 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 12836 "parsing/parser.ml" +# 12856 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -12843,13 +12863,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 12847 "parsing/parser.ml" +# 12867 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 12853 "parsing/parser.ml" +# 12873 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -12869,20 +12889,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 12873 "parsing/parser.ml" +# 12893 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12879 "parsing/parser.ml" +# 12899 "parsing/parser.ml" in let op = let _1 = # 3773 "parsing/parser.mly" ("+=") -# 12886 "parsing/parser.ml" +# 12906 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -12890,13 +12910,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12894 "parsing/parser.ml" +# 12914 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12900 "parsing/parser.ml" +# 12920 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -12906,13 +12926,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12910 "parsing/parser.ml" +# 12930 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 12916 "parsing/parser.ml" +# 12936 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12955,19 +12975,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 12959 "parsing/parser.ml" +# 12979 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 12964 "parsing/parser.ml" +# 12984 "parsing/parser.ml" in let op = let _1 = # 3774 "parsing/parser.mly" ("-") -# 12971 "parsing/parser.ml" +# 12991 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -12975,13 +12995,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 12979 "parsing/parser.ml" +# 12999 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 12985 "parsing/parser.ml" +# 13005 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -12991,13 +13011,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12995 "parsing/parser.ml" +# 13015 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13001 "parsing/parser.ml" +# 13021 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13064,18 +13084,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 13068 "parsing/parser.ml" +# 13088 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 13073 "parsing/parser.ml" +# 13093 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 13079 "parsing/parser.ml" +# 13099 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -13086,13 +13106,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 13090 "parsing/parser.ml" +# 13110 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 13096 "parsing/parser.ml" +# 13116 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -13112,20 +13132,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 13116 "parsing/parser.ml" +# 13136 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13122 "parsing/parser.ml" +# 13142 "parsing/parser.ml" in let op = let _1 = # 3774 "parsing/parser.mly" ("-") -# 13129 "parsing/parser.ml" +# 13149 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13133,13 +13153,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13137 "parsing/parser.ml" +# 13157 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13143 "parsing/parser.ml" +# 13163 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -13149,13 +13169,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13153 "parsing/parser.ml" +# 13173 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13159 "parsing/parser.ml" +# 13179 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13198,19 +13218,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 13202 "parsing/parser.ml" +# 13222 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13207 "parsing/parser.ml" +# 13227 "parsing/parser.ml" in let op = let _1 = # 3775 "parsing/parser.mly" ("-.") -# 13214 "parsing/parser.ml" +# 13234 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13218,13 +13238,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13222 "parsing/parser.ml" +# 13242 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13228 "parsing/parser.ml" +# 13248 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -13234,13 +13254,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13238 "parsing/parser.ml" +# 13258 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13244 "parsing/parser.ml" +# 13264 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13307,18 +13327,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 13311 "parsing/parser.ml" +# 13331 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 13316 "parsing/parser.ml" +# 13336 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 13322 "parsing/parser.ml" +# 13342 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -13329,13 +13349,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 13333 "parsing/parser.ml" +# 13353 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 13339 "parsing/parser.ml" +# 13359 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -13355,20 +13375,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 13359 "parsing/parser.ml" +# 13379 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13365 "parsing/parser.ml" +# 13385 "parsing/parser.ml" in let op = let _1 = # 3775 "parsing/parser.mly" ("-.") -# 13372 "parsing/parser.ml" +# 13392 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13376,13 +13396,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13380 "parsing/parser.ml" +# 13400 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13386 "parsing/parser.ml" +# 13406 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -13392,13 +13412,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13396 "parsing/parser.ml" +# 13416 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13402 "parsing/parser.ml" +# 13422 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13441,19 +13461,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 13445 "parsing/parser.ml" +# 13465 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13450 "parsing/parser.ml" +# 13470 "parsing/parser.ml" in let op = let _1 = # 3776 "parsing/parser.mly" ("*") -# 13457 "parsing/parser.ml" +# 13477 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13461,13 +13481,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13465 "parsing/parser.ml" +# 13485 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13471 "parsing/parser.ml" +# 13491 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -13477,13 +13497,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13481 "parsing/parser.ml" +# 13501 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13487 "parsing/parser.ml" +# 13507 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13550,18 +13570,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 13554 "parsing/parser.ml" +# 13574 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 13559 "parsing/parser.ml" +# 13579 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 13565 "parsing/parser.ml" +# 13585 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -13572,13 +13592,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 13576 "parsing/parser.ml" +# 13596 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 13582 "parsing/parser.ml" +# 13602 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -13598,20 +13618,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 13602 "parsing/parser.ml" +# 13622 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13608 "parsing/parser.ml" +# 13628 "parsing/parser.ml" in let op = let _1 = # 3776 "parsing/parser.mly" ("*") -# 13615 "parsing/parser.ml" +# 13635 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13619,13 +13639,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13623 "parsing/parser.ml" +# 13643 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13629 "parsing/parser.ml" +# 13649 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -13635,13 +13655,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13639 "parsing/parser.ml" +# 13659 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13645 "parsing/parser.ml" +# 13665 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13684,19 +13704,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 13688 "parsing/parser.ml" +# 13708 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13693 "parsing/parser.ml" +# 13713 "parsing/parser.ml" in let op = let _1 = # 3777 "parsing/parser.mly" ("%") -# 13700 "parsing/parser.ml" +# 13720 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13704,13 +13724,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13708 "parsing/parser.ml" +# 13728 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13714 "parsing/parser.ml" +# 13734 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -13720,13 +13740,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13724 "parsing/parser.ml" +# 13744 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13730 "parsing/parser.ml" +# 13750 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13793,18 +13813,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 13797 "parsing/parser.ml" +# 13817 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 13802 "parsing/parser.ml" +# 13822 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 13808 "parsing/parser.ml" +# 13828 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -13815,13 +13835,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 13819 "parsing/parser.ml" +# 13839 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 13825 "parsing/parser.ml" +# 13845 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -13841,20 +13861,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 13845 "parsing/parser.ml" +# 13865 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13851 "parsing/parser.ml" +# 13871 "parsing/parser.ml" in let op = let _1 = # 3777 "parsing/parser.mly" ("%") -# 13858 "parsing/parser.ml" +# 13878 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13862,13 +13882,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13866 "parsing/parser.ml" +# 13886 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13872 "parsing/parser.ml" +# 13892 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -13878,13 +13898,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13882 "parsing/parser.ml" +# 13902 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13888 "parsing/parser.ml" +# 13908 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13927,19 +13947,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 13931 "parsing/parser.ml" +# 13951 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 13936 "parsing/parser.ml" +# 13956 "parsing/parser.ml" in let op = let _1 = # 3778 "parsing/parser.mly" ("=") -# 13943 "parsing/parser.ml" +# 13963 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -13947,13 +13967,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 13951 "parsing/parser.ml" +# 13971 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 13957 "parsing/parser.ml" +# 13977 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -13963,13 +13983,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 13967 "parsing/parser.ml" +# 13987 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 13973 "parsing/parser.ml" +# 13993 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14036,18 +14056,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 14040 "parsing/parser.ml" +# 14060 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 14045 "parsing/parser.ml" +# 14065 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 14051 "parsing/parser.ml" +# 14071 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -14058,13 +14078,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 14062 "parsing/parser.ml" +# 14082 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 14068 "parsing/parser.ml" +# 14088 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -14084,20 +14104,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 14088 "parsing/parser.ml" +# 14108 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14094 "parsing/parser.ml" +# 14114 "parsing/parser.ml" in let op = let _1 = # 3778 "parsing/parser.mly" ("=") -# 14101 "parsing/parser.ml" +# 14121 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14105,13 +14125,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14109 "parsing/parser.ml" +# 14129 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14115 "parsing/parser.ml" +# 14135 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -14121,13 +14141,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14125 "parsing/parser.ml" +# 14145 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14131 "parsing/parser.ml" +# 14151 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14170,19 +14190,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 14174 "parsing/parser.ml" +# 14194 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14179 "parsing/parser.ml" +# 14199 "parsing/parser.ml" in let op = let _1 = # 3779 "parsing/parser.mly" ("<") -# 14186 "parsing/parser.ml" +# 14206 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14190,13 +14210,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14194 "parsing/parser.ml" +# 14214 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14200 "parsing/parser.ml" +# 14220 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -14206,13 +14226,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14210 "parsing/parser.ml" +# 14230 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14216 "parsing/parser.ml" +# 14236 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14279,18 +14299,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 14283 "parsing/parser.ml" +# 14303 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 14288 "parsing/parser.ml" +# 14308 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 14294 "parsing/parser.ml" +# 14314 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -14301,13 +14321,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 14305 "parsing/parser.ml" +# 14325 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 14311 "parsing/parser.ml" +# 14331 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -14327,20 +14347,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 14331 "parsing/parser.ml" +# 14351 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14337 "parsing/parser.ml" +# 14357 "parsing/parser.ml" in let op = let _1 = # 3779 "parsing/parser.mly" ("<") -# 14344 "parsing/parser.ml" +# 14364 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14348,13 +14368,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14352 "parsing/parser.ml" +# 14372 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14358 "parsing/parser.ml" +# 14378 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -14364,13 +14384,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14368 "parsing/parser.ml" +# 14388 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14374 "parsing/parser.ml" +# 14394 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14413,19 +14433,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 14417 "parsing/parser.ml" +# 14437 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14422 "parsing/parser.ml" +# 14442 "parsing/parser.ml" in let op = let _1 = # 3780 "parsing/parser.mly" (">") -# 14429 "parsing/parser.ml" +# 14449 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14433,13 +14453,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14437 "parsing/parser.ml" +# 14457 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14443 "parsing/parser.ml" +# 14463 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -14449,13 +14469,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14453 "parsing/parser.ml" +# 14473 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14459 "parsing/parser.ml" +# 14479 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14522,18 +14542,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 14526 "parsing/parser.ml" +# 14546 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 14531 "parsing/parser.ml" +# 14551 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 14537 "parsing/parser.ml" +# 14557 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -14544,13 +14564,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 14548 "parsing/parser.ml" +# 14568 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 14554 "parsing/parser.ml" +# 14574 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -14570,20 +14590,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 14574 "parsing/parser.ml" +# 14594 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14580 "parsing/parser.ml" +# 14600 "parsing/parser.ml" in let op = let _1 = # 3780 "parsing/parser.mly" (">") -# 14587 "parsing/parser.ml" +# 14607 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14591,13 +14611,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14595 "parsing/parser.ml" +# 14615 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14601 "parsing/parser.ml" +# 14621 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -14607,13 +14627,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14611 "parsing/parser.ml" +# 14631 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14617 "parsing/parser.ml" +# 14637 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14656,19 +14676,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 14660 "parsing/parser.ml" +# 14680 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14665 "parsing/parser.ml" +# 14685 "parsing/parser.ml" in let op = let _1 = # 3781 "parsing/parser.mly" ("or") -# 14672 "parsing/parser.ml" +# 14692 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14676,13 +14696,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14680 "parsing/parser.ml" +# 14700 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14686 "parsing/parser.ml" +# 14706 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -14692,13 +14712,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14696 "parsing/parser.ml" +# 14716 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14702 "parsing/parser.ml" +# 14722 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14765,18 +14785,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 14769 "parsing/parser.ml" +# 14789 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 14774 "parsing/parser.ml" +# 14794 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 14780 "parsing/parser.ml" +# 14800 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -14787,13 +14807,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 14791 "parsing/parser.ml" +# 14811 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 14797 "parsing/parser.ml" +# 14817 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -14813,20 +14833,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 14817 "parsing/parser.ml" +# 14837 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14823 "parsing/parser.ml" +# 14843 "parsing/parser.ml" in let op = let _1 = # 3781 "parsing/parser.mly" ("or") -# 14830 "parsing/parser.ml" +# 14850 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14834,13 +14854,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14838 "parsing/parser.ml" +# 14858 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14844 "parsing/parser.ml" +# 14864 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -14850,13 +14870,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14854 "parsing/parser.ml" +# 14874 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14860 "parsing/parser.ml" +# 14880 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14899,19 +14919,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 14903 "parsing/parser.ml" +# 14923 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 14908 "parsing/parser.ml" +# 14928 "parsing/parser.ml" in let op = let _1 = # 3782 "parsing/parser.mly" ("||") -# 14915 "parsing/parser.ml" +# 14935 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -14919,13 +14939,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 14923 "parsing/parser.ml" +# 14943 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 14929 "parsing/parser.ml" +# 14949 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -14935,13 +14955,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 14939 "parsing/parser.ml" +# 14959 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 14945 "parsing/parser.ml" +# 14965 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15008,18 +15028,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 15012 "parsing/parser.ml" +# 15032 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 15017 "parsing/parser.ml" +# 15037 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 15023 "parsing/parser.ml" +# 15043 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -15030,13 +15050,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 15034 "parsing/parser.ml" +# 15054 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 15040 "parsing/parser.ml" +# 15060 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -15056,20 +15076,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 15060 "parsing/parser.ml" +# 15080 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15066 "parsing/parser.ml" +# 15086 "parsing/parser.ml" in let op = let _1 = # 3782 "parsing/parser.mly" ("||") -# 15073 "parsing/parser.ml" +# 15093 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -15077,13 +15097,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 15081 "parsing/parser.ml" +# 15101 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 15087 "parsing/parser.ml" +# 15107 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -15093,13 +15113,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15097 "parsing/parser.ml" +# 15117 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15103 "parsing/parser.ml" +# 15123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15142,19 +15162,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 15146 "parsing/parser.ml" +# 15166 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15151 "parsing/parser.ml" +# 15171 "parsing/parser.ml" in let op = let _1 = # 3783 "parsing/parser.mly" ("&") -# 15158 "parsing/parser.ml" +# 15178 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -15162,13 +15182,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 15166 "parsing/parser.ml" +# 15186 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 15172 "parsing/parser.ml" +# 15192 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -15178,13 +15198,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15182 "parsing/parser.ml" +# 15202 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15188 "parsing/parser.ml" +# 15208 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15251,18 +15271,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 15255 "parsing/parser.ml" +# 15275 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 15260 "parsing/parser.ml" +# 15280 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 15266 "parsing/parser.ml" +# 15286 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -15273,13 +15293,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 15277 "parsing/parser.ml" +# 15297 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 15283 "parsing/parser.ml" +# 15303 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -15299,20 +15319,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 15303 "parsing/parser.ml" +# 15323 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15309 "parsing/parser.ml" +# 15329 "parsing/parser.ml" in let op = let _1 = # 3783 "parsing/parser.mly" ("&") -# 15316 "parsing/parser.ml" +# 15336 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -15320,13 +15340,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 15324 "parsing/parser.ml" +# 15344 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 15330 "parsing/parser.ml" +# 15350 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -15336,13 +15356,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15340 "parsing/parser.ml" +# 15360 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15346 "parsing/parser.ml" +# 15366 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15385,19 +15405,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 15389 "parsing/parser.ml" +# 15409 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15394 "parsing/parser.ml" +# 15414 "parsing/parser.ml" in let op = let _1 = # 3784 "parsing/parser.mly" ("&&") -# 15401 "parsing/parser.ml" +# 15421 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -15405,13 +15425,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 15409 "parsing/parser.ml" +# 15429 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 15415 "parsing/parser.ml" +# 15435 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -15421,13 +15441,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15425 "parsing/parser.ml" +# 15445 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15431 "parsing/parser.ml" +# 15451 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15494,18 +15514,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 15498 "parsing/parser.ml" +# 15518 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 15503 "parsing/parser.ml" +# 15523 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 15509 "parsing/parser.ml" +# 15529 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -15516,13 +15536,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 15520 "parsing/parser.ml" +# 15540 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 15526 "parsing/parser.ml" +# 15546 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -15542,20 +15562,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 15546 "parsing/parser.ml" +# 15566 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15552 "parsing/parser.ml" +# 15572 "parsing/parser.ml" in let op = let _1 = # 3784 "parsing/parser.mly" ("&&") -# 15559 "parsing/parser.ml" +# 15579 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -15563,13 +15583,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 15567 "parsing/parser.ml" +# 15587 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 15573 "parsing/parser.ml" +# 15593 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -15579,13 +15599,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15583 "parsing/parser.ml" +# 15603 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15589 "parsing/parser.ml" +# 15609 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15628,19 +15648,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 15632 "parsing/parser.ml" +# 15652 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15637 "parsing/parser.ml" +# 15657 "parsing/parser.ml" in let op = let _1 = # 3785 "parsing/parser.mly" (":=") -# 15644 "parsing/parser.ml" +# 15664 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -15648,13 +15668,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 15652 "parsing/parser.ml" +# 15672 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 15658 "parsing/parser.ml" +# 15678 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in @@ -15664,13 +15684,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15668 "parsing/parser.ml" +# 15688 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15674 "parsing/parser.ml" +# 15694 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15737,18 +15757,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 15741 "parsing/parser.ml" +# 15761 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 15746 "parsing/parser.ml" +# 15766 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 15752 "parsing/parser.ml" +# 15772 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -15759,13 +15779,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 15763 "parsing/parser.ml" +# 15783 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 15769 "parsing/parser.ml" +# 15789 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -15785,20 +15805,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 15789 "parsing/parser.ml" +# 15809 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15795 "parsing/parser.ml" +# 15815 "parsing/parser.ml" in let op = let _1 = # 3785 "parsing/parser.mly" (":=") -# 15802 "parsing/parser.ml" +# 15822 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -15806,13 +15826,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 15810 "parsing/parser.ml" +# 15830 "parsing/parser.ml" in # 2480 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 15816 "parsing/parser.ml" +# 15836 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in @@ -15822,13 +15842,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15826 "parsing/parser.ml" +# 15846 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15832 "parsing/parser.ml" +# 15852 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15864,19 +15884,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 15868 "parsing/parser.ml" +# 15888 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 15873 "parsing/parser.ml" +# 15893 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2482 "parsing/parser.mly" ( mkuminus ~oploc:_loc__1_ _1 _2 ) -# 15880 "parsing/parser.ml" +# 15900 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -15886,13 +15906,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 15890 "parsing/parser.ml" +# 15910 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 15896 "parsing/parser.ml" +# 15916 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15952,18 +15972,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 15956 "parsing/parser.ml" +# 15976 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 15961 "parsing/parser.ml" +# 15981 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 15967 "parsing/parser.ml" +# 15987 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -15974,13 +15994,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 15978 "parsing/parser.ml" +# 15998 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 15984 "parsing/parser.ml" +# 16004 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -16000,20 +16020,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 16004 "parsing/parser.ml" +# 16024 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16010 "parsing/parser.ml" +# 16030 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2482 "parsing/parser.mly" ( mkuminus ~oploc:_loc__1_ _1 _2 ) -# 16017 "parsing/parser.ml" +# 16037 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -16023,13 +16043,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 16027 "parsing/parser.ml" +# 16047 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 16033 "parsing/parser.ml" +# 16053 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16065,19 +16085,19 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 16069 "parsing/parser.ml" +# 16089 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16074 "parsing/parser.ml" +# 16094 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2484 "parsing/parser.mly" ( mkuplus ~oploc:_loc__1_ _1 _2 ) -# 16081 "parsing/parser.ml" +# 16101 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -16087,13 +16107,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 16091 "parsing/parser.ml" +# 16111 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 16097 "parsing/parser.ml" +# 16117 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16153,18 +16173,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 16157 "parsing/parser.ml" +# 16177 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 16162 "parsing/parser.ml" +# 16182 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 16168 "parsing/parser.ml" +# 16188 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -16175,13 +16195,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 16179 "parsing/parser.ml" +# 16199 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 16185 "parsing/parser.ml" +# 16205 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -16201,20 +16221,20 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 16205 "parsing/parser.ml" +# 16225 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16211 "parsing/parser.ml" +# 16231 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2484 "parsing/parser.mly" ( mkuplus ~oploc:_loc__1_ _1 _2 ) -# 16218 "parsing/parser.ml" +# 16238 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -16224,13 +16244,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 16228 "parsing/parser.ml" +# 16248 "parsing/parser.ml" in # 2400 "parsing/parser.mly" ( _1 ) -# 16234 "parsing/parser.ml" +# 16254 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16272,7 +16292,7 @@ module Tables = struct # 2402 "parsing/parser.mly" ( expr_of_let_bindings ~loc:_sloc _1 _3 ) -# 16276 "parsing/parser.ml" +# 16296 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16314,7 +16334,7 @@ module Tables = struct let _1 : ( # 756 "parsing/parser.mly" (string) -# 16318 "parsing/parser.ml" +# 16338 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -16326,7 +16346,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16330 "parsing/parser.ml" +# 16350 "parsing/parser.ml" in let _startpos_pbop_op_ = _startpos__1_ in @@ -16340,7 +16360,7 @@ module Tables = struct 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}) ) -# 16344 "parsing/parser.ml" +# 16364 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16381,12 +16401,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 16385 "parsing/parser.ml" +# 16405 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16390 "parsing/parser.ml" +# 16410 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -16397,7 +16417,7 @@ module Tables = struct # 2410 "parsing/parser.mly" ( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) ) -# 16401 "parsing/parser.ml" +# 16421 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16462,18 +16482,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 16466 "parsing/parser.ml" +# 16486 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 16471 "parsing/parser.ml" +# 16491 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 16477 "parsing/parser.ml" +# 16497 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -16484,13 +16504,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 16488 "parsing/parser.ml" +# 16508 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 16494 "parsing/parser.ml" +# 16514 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -16510,13 +16530,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 16514 "parsing/parser.ml" +# 16534 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16520 "parsing/parser.ml" +# 16540 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -16527,7 +16547,7 @@ module Tables = struct # 2410 "parsing/parser.mly" ( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) ) -# 16531 "parsing/parser.ml" +# 16551 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16562,7 +16582,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 16566 "parsing/parser.ml" +# 16586 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -16572,12 +16592,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 16576 "parsing/parser.ml" +# 16596 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16581 "parsing/parser.ml" +# 16601 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -16585,7 +16605,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 16589 "parsing/parser.ml" +# 16609 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -16593,7 +16613,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16597 "parsing/parser.ml" +# 16617 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -16602,7 +16622,7 @@ module Tables = struct # 2412 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) ) -# 16606 "parsing/parser.ml" +# 16626 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16658,7 +16678,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 16662 "parsing/parser.ml" +# 16682 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -16671,18 +16691,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 16675 "parsing/parser.ml" +# 16695 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 16680 "parsing/parser.ml" +# 16700 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 16686 "parsing/parser.ml" +# 16706 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -16693,13 +16713,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 16697 "parsing/parser.ml" +# 16717 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 16703 "parsing/parser.ml" +# 16723 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -16719,13 +16739,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 16723 "parsing/parser.ml" +# 16743 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16729 "parsing/parser.ml" +# 16749 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -16733,7 +16753,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 16737 "parsing/parser.ml" +# 16757 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -16741,7 +16761,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16745 "parsing/parser.ml" +# 16765 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -16750,7 +16770,7 @@ module Tables = struct # 2412 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) ) -# 16754 "parsing/parser.ml" +# 16774 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16805,12 +16825,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 16809 "parsing/parser.ml" +# 16829 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16814 "parsing/parser.ml" +# 16834 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined2_ in @@ -16822,7 +16842,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16826 "parsing/parser.ml" +# 16846 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -16831,7 +16851,7 @@ module Tables = struct # 2414 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) ) -# 16835 "parsing/parser.ml" +# 16855 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16910,18 +16930,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 16914 "parsing/parser.ml" +# 16934 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 16919 "parsing/parser.ml" +# 16939 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 16925 "parsing/parser.ml" +# 16945 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -16932,13 +16952,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 16936 "parsing/parser.ml" +# 16956 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 16942 "parsing/parser.ml" +# 16962 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -16958,13 +16978,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 16962 "parsing/parser.ml" +# 16982 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 16968 "parsing/parser.ml" +# 16988 "parsing/parser.ml" in let _endpos__5_ = _endpos_xs_ in @@ -16976,7 +16996,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16980 "parsing/parser.ml" +# 17000 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -16985,7 +17005,7 @@ module Tables = struct # 2414 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) ) -# 16989 "parsing/parser.ml" +# 17009 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17056,24 +17076,24 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 17060 "parsing/parser.ml" +# 17080 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 17065 "parsing/parser.ml" +# 17085 "parsing/parser.ml" in # 2415 "parsing/parser.mly" (Some v) -# 17071 "parsing/parser.ml" +# 17091 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 17077 "parsing/parser.ml" +# 17097 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in @@ -17083,7 +17103,7 @@ module Tables = struct # 2416 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 17087 "parsing/parser.ml" +# 17107 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17178,18 +17198,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 17182 "parsing/parser.ml" +# 17202 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 17187 "parsing/parser.ml" +# 17207 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 17193 "parsing/parser.ml" +# 17213 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -17200,13 +17220,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 17204 "parsing/parser.ml" +# 17224 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 17210 "parsing/parser.ml" +# 17230 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -17226,25 +17246,25 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 17230 "parsing/parser.ml" +# 17250 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 17236 "parsing/parser.ml" +# 17256 "parsing/parser.ml" in # 2415 "parsing/parser.mly" (Some v) -# 17242 "parsing/parser.ml" +# 17262 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 17248 "parsing/parser.ml" +# 17268 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -17254,7 +17274,7 @@ module Tables = struct # 2416 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 17258 "parsing/parser.ml" +# 17278 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17325,24 +17345,24 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 17329 "parsing/parser.ml" +# 17349 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 17334 "parsing/parser.ml" +# 17354 "parsing/parser.ml" in # 2415 "parsing/parser.mly" (Some v) -# 17340 "parsing/parser.ml" +# 17360 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 17346 "parsing/parser.ml" +# 17366 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in @@ -17352,7 +17372,7 @@ module Tables = struct # 2416 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 17356 "parsing/parser.ml" +# 17376 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17447,18 +17467,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 17451 "parsing/parser.ml" +# 17471 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 17456 "parsing/parser.ml" +# 17476 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 17462 "parsing/parser.ml" +# 17482 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -17469,13 +17489,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 17473 "parsing/parser.ml" +# 17493 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 17479 "parsing/parser.ml" +# 17499 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -17495,25 +17515,25 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 17499 "parsing/parser.ml" +# 17519 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 17505 "parsing/parser.ml" +# 17525 "parsing/parser.ml" in # 2415 "parsing/parser.mly" (Some v) -# 17511 "parsing/parser.ml" +# 17531 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 17517 "parsing/parser.ml" +# 17537 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -17523,7 +17543,7 @@ module Tables = struct # 2416 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 17527 "parsing/parser.ml" +# 17547 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17594,24 +17614,24 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 17598 "parsing/parser.ml" +# 17618 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 17603 "parsing/parser.ml" +# 17623 "parsing/parser.ml" in # 2415 "parsing/parser.mly" (Some v) -# 17609 "parsing/parser.ml" +# 17629 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 17615 "parsing/parser.ml" +# 17635 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in @@ -17621,7 +17641,7 @@ module Tables = struct # 2416 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 17625 "parsing/parser.ml" +# 17645 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17716,18 +17736,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 17720 "parsing/parser.ml" +# 17740 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 17725 "parsing/parser.ml" +# 17745 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 17731 "parsing/parser.ml" +# 17751 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -17738,13 +17758,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 17742 "parsing/parser.ml" +# 17762 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 17748 "parsing/parser.ml" +# 17768 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -17764,25 +17784,25 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 17768 "parsing/parser.ml" +# 17788 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 17774 "parsing/parser.ml" +# 17794 "parsing/parser.ml" in # 2415 "parsing/parser.mly" (Some v) -# 17780 "parsing/parser.ml" +# 17800 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 17786 "parsing/parser.ml" +# 17806 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -17792,7 +17812,7 @@ module Tables = struct # 2416 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 17796 "parsing/parser.ml" +# 17816 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17854,7 +17874,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 17858 "parsing/parser.ml" +# 17878 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -17867,41 +17887,41 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 17871 "parsing/parser.ml" +# 17891 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 17876 "parsing/parser.ml" +# 17896 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 17882 "parsing/parser.ml" +# 17902 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 17888 "parsing/parser.ml" +# 17908 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 17894 "parsing/parser.ml" +# 17914 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 17899 "parsing/parser.ml" +# 17919 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 17905 "parsing/parser.ml" +# 17925 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in @@ -17911,7 +17931,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 17915 "parsing/parser.ml" +# 17935 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17994,7 +18014,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 17998 "parsing/parser.ml" +# 18018 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -18010,18 +18030,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 18014 "parsing/parser.ml" +# 18034 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 18019 "parsing/parser.ml" +# 18039 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 18025 "parsing/parser.ml" +# 18045 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -18032,13 +18052,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 18036 "parsing/parser.ml" +# 18056 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 18042 "parsing/parser.ml" +# 18062 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -18058,42 +18078,42 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 18062 "parsing/parser.ml" +# 18082 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 18068 "parsing/parser.ml" +# 18088 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 18074 "parsing/parser.ml" +# 18094 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 18080 "parsing/parser.ml" +# 18100 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 18086 "parsing/parser.ml" +# 18106 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 18091 "parsing/parser.ml" +# 18111 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 18097 "parsing/parser.ml" +# 18117 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -18103,7 +18123,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 18107 "parsing/parser.ml" +# 18127 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18177,7 +18197,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 18181 "parsing/parser.ml" +# 18201 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -18193,24 +18213,24 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 18197 "parsing/parser.ml" +# 18217 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 18202 "parsing/parser.ml" +# 18222 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 18208 "parsing/parser.ml" +# 18228 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 18214 "parsing/parser.ml" +# 18234 "parsing/parser.ml" in let d = let _1 = @@ -18218,24 +18238,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 18222 "parsing/parser.ml" +# 18242 "parsing/parser.ml" in # 126 "" ( Some x ) -# 18227 "parsing/parser.ml" +# 18247 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 18233 "parsing/parser.ml" +# 18253 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 18239 "parsing/parser.ml" +# 18259 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in @@ -18245,7 +18265,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 18249 "parsing/parser.ml" +# 18269 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18340,7 +18360,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 18344 "parsing/parser.ml" +# 18364 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -18359,18 +18379,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 18363 "parsing/parser.ml" +# 18383 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 18368 "parsing/parser.ml" +# 18388 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 18374 "parsing/parser.ml" +# 18394 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -18381,13 +18401,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 18385 "parsing/parser.ml" +# 18405 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 18391 "parsing/parser.ml" +# 18411 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -18407,25 +18427,25 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 18411 "parsing/parser.ml" +# 18431 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 18417 "parsing/parser.ml" +# 18437 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 18423 "parsing/parser.ml" +# 18443 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 18429 "parsing/parser.ml" +# 18449 "parsing/parser.ml" in let d = let _1 = @@ -18433,24 +18453,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 18437 "parsing/parser.ml" +# 18457 "parsing/parser.ml" in # 126 "" ( Some x ) -# 18442 "parsing/parser.ml" +# 18462 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 18448 "parsing/parser.ml" +# 18468 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 18454 "parsing/parser.ml" +# 18474 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -18460,7 +18480,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 18464 "parsing/parser.ml" +# 18484 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18522,7 +18542,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 18526 "parsing/parser.ml" +# 18546 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -18535,41 +18555,41 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 18539 "parsing/parser.ml" +# 18559 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 18544 "parsing/parser.ml" +# 18564 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 18550 "parsing/parser.ml" +# 18570 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 18556 "parsing/parser.ml" +# 18576 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 18562 "parsing/parser.ml" +# 18582 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 18567 "parsing/parser.ml" +# 18587 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 18573 "parsing/parser.ml" +# 18593 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in @@ -18579,7 +18599,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 18583 "parsing/parser.ml" +# 18603 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18662,7 +18682,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 18666 "parsing/parser.ml" +# 18686 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -18678,18 +18698,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 18682 "parsing/parser.ml" +# 18702 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 18687 "parsing/parser.ml" +# 18707 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 18693 "parsing/parser.ml" +# 18713 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -18700,13 +18720,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 18704 "parsing/parser.ml" +# 18724 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 18710 "parsing/parser.ml" +# 18730 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -18726,42 +18746,42 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 18730 "parsing/parser.ml" +# 18750 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 18736 "parsing/parser.ml" +# 18756 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 18742 "parsing/parser.ml" +# 18762 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 18748 "parsing/parser.ml" +# 18768 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 18754 "parsing/parser.ml" +# 18774 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 18759 "parsing/parser.ml" +# 18779 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 18765 "parsing/parser.ml" +# 18785 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -18771,7 +18791,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 18775 "parsing/parser.ml" +# 18795 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18845,7 +18865,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 18849 "parsing/parser.ml" +# 18869 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -18861,24 +18881,24 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 18865 "parsing/parser.ml" +# 18885 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 18870 "parsing/parser.ml" +# 18890 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 18876 "parsing/parser.ml" +# 18896 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 18882 "parsing/parser.ml" +# 18902 "parsing/parser.ml" in let d = let _1 = @@ -18886,24 +18906,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 18890 "parsing/parser.ml" +# 18910 "parsing/parser.ml" in # 126 "" ( Some x ) -# 18895 "parsing/parser.ml" +# 18915 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 18901 "parsing/parser.ml" +# 18921 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 18907 "parsing/parser.ml" +# 18927 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in @@ -18913,7 +18933,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 18917 "parsing/parser.ml" +# 18937 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19008,7 +19028,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 19012 "parsing/parser.ml" +# 19032 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -19027,18 +19047,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 19031 "parsing/parser.ml" +# 19051 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 19036 "parsing/parser.ml" +# 19056 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 19042 "parsing/parser.ml" +# 19062 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -19049,13 +19069,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 19053 "parsing/parser.ml" +# 19073 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 19059 "parsing/parser.ml" +# 19079 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -19075,25 +19095,25 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 19079 "parsing/parser.ml" +# 19099 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 19085 "parsing/parser.ml" +# 19105 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 19091 "parsing/parser.ml" +# 19111 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 19097 "parsing/parser.ml" +# 19117 "parsing/parser.ml" in let d = let _1 = @@ -19101,24 +19121,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 19105 "parsing/parser.ml" +# 19125 "parsing/parser.ml" in # 126 "" ( Some x ) -# 19110 "parsing/parser.ml" +# 19130 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 19116 "parsing/parser.ml" +# 19136 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 19122 "parsing/parser.ml" +# 19142 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -19128,7 +19148,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 19132 "parsing/parser.ml" +# 19152 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19190,7 +19210,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 19194 "parsing/parser.ml" +# 19214 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -19203,41 +19223,41 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 19207 "parsing/parser.ml" +# 19227 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 19212 "parsing/parser.ml" +# 19232 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 19218 "parsing/parser.ml" +# 19238 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 19224 "parsing/parser.ml" +# 19244 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 19230 "parsing/parser.ml" +# 19250 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 19235 "parsing/parser.ml" +# 19255 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 19241 "parsing/parser.ml" +# 19261 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in @@ -19247,7 +19267,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 19251 "parsing/parser.ml" +# 19271 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19330,7 +19350,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 19334 "parsing/parser.ml" +# 19354 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -19346,18 +19366,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 19350 "parsing/parser.ml" +# 19370 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 19355 "parsing/parser.ml" +# 19375 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 19361 "parsing/parser.ml" +# 19381 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -19368,13 +19388,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 19372 "parsing/parser.ml" +# 19392 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 19378 "parsing/parser.ml" +# 19398 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -19394,42 +19414,42 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 19398 "parsing/parser.ml" +# 19418 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 19404 "parsing/parser.ml" +# 19424 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 19410 "parsing/parser.ml" +# 19430 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 19416 "parsing/parser.ml" +# 19436 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 19422 "parsing/parser.ml" +# 19442 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 19427 "parsing/parser.ml" +# 19447 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 19433 "parsing/parser.ml" +# 19453 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -19439,7 +19459,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 19443 "parsing/parser.ml" +# 19463 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19513,7 +19533,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 19517 "parsing/parser.ml" +# 19537 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -19529,24 +19549,24 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 19533 "parsing/parser.ml" +# 19553 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 19538 "parsing/parser.ml" +# 19558 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 19544 "parsing/parser.ml" +# 19564 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 19550 "parsing/parser.ml" +# 19570 "parsing/parser.ml" in let d = let _1 = @@ -19554,24 +19574,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 19558 "parsing/parser.ml" +# 19578 "parsing/parser.ml" in # 126 "" ( Some x ) -# 19563 "parsing/parser.ml" +# 19583 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 19569 "parsing/parser.ml" +# 19589 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 19575 "parsing/parser.ml" +# 19595 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in @@ -19581,7 +19601,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 19585 "parsing/parser.ml" +# 19605 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19676,7 +19696,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 19680 "parsing/parser.ml" +# 19700 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -19695,18 +19715,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 19699 "parsing/parser.ml" +# 19719 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 19704 "parsing/parser.ml" +# 19724 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 19710 "parsing/parser.ml" +# 19730 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -19717,13 +19737,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 19721 "parsing/parser.ml" +# 19741 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 19727 "parsing/parser.ml" +# 19747 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -19743,25 +19763,25 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 19747 "parsing/parser.ml" +# 19767 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 19753 "parsing/parser.ml" +# 19773 "parsing/parser.ml" in # 2417 "parsing/parser.mly" (Some v) -# 19759 "parsing/parser.ml" +# 19779 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 19765 "parsing/parser.ml" +# 19785 "parsing/parser.ml" in let d = let _1 = @@ -19769,24 +19789,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 19773 "parsing/parser.ml" +# 19793 "parsing/parser.ml" in # 126 "" ( Some x ) -# 19778 "parsing/parser.ml" +# 19798 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 19784 "parsing/parser.ml" +# 19804 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 19790 "parsing/parser.ml" +# 19810 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in @@ -19796,7 +19816,7 @@ module Tables = struct # 2418 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 19800 "parsing/parser.ml" +# 19820 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19828,7 +19848,7 @@ module Tables = struct let _v : (Parsetree.expression) = # 2420 "parsing/parser.mly" ( Exp.attr _1 _2 ) -# 19832 "parsing/parser.ml" +# 19852 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19854,7 +19874,7 @@ module Tables = struct # 2423 "parsing/parser.mly" ( not_expecting _loc__1_ "wildcard \"_\"" ) -# 19858 "parsing/parser.ml" +# 19878 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19900,7 +19920,7 @@ module Tables = struct let _v : (Parsetree.function_param list) = let ty_params = # 2633 "parsing/parser.mly" ( xs ) -# 19904 "parsing/parser.ml" +# 19924 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in @@ -19920,7 +19940,7 @@ module Tables = struct (fun x -> { pparam_loc = loc; pparam_desc = Pparam_newtype x }) ty_params ) -# 19924 "parsing/parser.ml" +# 19944 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19950,7 +19970,7 @@ module Tables = struct ( let a, b, c = _1 in [ { pparam_loc = make_loc _sloc; pparam_desc = Pparam_val (a, b, c) } ] ) -# 19954 "parsing/parser.ml" +# 19974 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19976,18 +19996,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 19980 "parsing/parser.ml" +# 20000 "parsing/parser.ml" in # 1079 "parsing/parser.mly" ( xs ) -# 19985 "parsing/parser.ml" +# 20005 "parsing/parser.ml" in # 2783 "parsing/parser.mly" ( _1 ) -# 19991 "parsing/parser.ml" +# 20011 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20012,7 +20032,7 @@ module Tables = struct let _v : (Parsetree.expression) = # 2310 "parsing/parser.mly" ( _1 ) -# 20016 "parsing/parser.ml" +# 20036 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20044,7 +20064,7 @@ module Tables = struct let _v : (Parsetree.expression) = # 2311 "parsing/parser.mly" ( _1 ) -# 20048 "parsing/parser.ml" +# 20068 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20084,7 +20104,7 @@ module Tables = struct let _1 = # 2313 "parsing/parser.mly" ( Pexp_sequence(_1, _3) ) -# 20088 "parsing/parser.ml" +# 20108 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -20093,13 +20113,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 20097 "parsing/parser.ml" +# 20117 "parsing/parser.ml" in # 2314 "parsing/parser.mly" ( _1 ) -# 20103 "parsing/parser.ml" +# 20123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20157,7 +20177,7 @@ module Tables = struct ( let seq = mkexp ~loc:_sloc (Pexp_sequence (_1, _5)) in let payload = PStr [mkstrexp seq []] in mkexp ~loc:_sloc (Pexp_extension (_4, payload)) ) -# 20161 "parsing/parser.ml" +# 20181 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20182,7 +20202,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3482 "parsing/parser.mly" ( ty ) -# 20186 "parsing/parser.ml" +# 20206 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20230,17 +20250,17 @@ module Tables = struct let domain = # 954 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 20234 "parsing/parser.ml" +# 20254 "parsing/parser.ml" in let label = # 3494 "parsing/parser.mly" ( Optional label ) -# 20239 "parsing/parser.ml" +# 20259 "parsing/parser.ml" in # 3488 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 20244 "parsing/parser.ml" +# 20264 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -20250,13 +20270,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 20254 "parsing/parser.ml" +# 20274 "parsing/parser.ml" in # 3490 "parsing/parser.mly" ( _1 ) -# 20260 "parsing/parser.ml" +# 20280 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20305,7 +20325,7 @@ module Tables = struct let label : ( # 774 "parsing/parser.mly" (string) -# 20309 "parsing/parser.ml" +# 20329 "parsing/parser.ml" ) = Obj.magic label in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_label_ in @@ -20315,17 +20335,17 @@ module Tables = struct let domain = # 954 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 20319 "parsing/parser.ml" +# 20339 "parsing/parser.ml" in let label = # 3496 "parsing/parser.mly" ( Labelled label ) -# 20324 "parsing/parser.ml" +# 20344 "parsing/parser.ml" in # 3488 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 20329 "parsing/parser.ml" +# 20349 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -20335,13 +20355,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 20339 "parsing/parser.ml" +# 20359 "parsing/parser.ml" in # 3490 "parsing/parser.mly" ( _1 ) -# 20345 "parsing/parser.ml" +# 20365 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20382,17 +20402,17 @@ module Tables = struct let domain = # 954 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 20386 "parsing/parser.ml" +# 20406 "parsing/parser.ml" in let label = # 3498 "parsing/parser.mly" ( Nolabel ) -# 20391 "parsing/parser.ml" +# 20411 "parsing/parser.ml" in # 3488 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 20396 "parsing/parser.ml" +# 20416 "parsing/parser.ml" in let _endpos__1_ = _endpos_codomain_ in @@ -20402,13 +20422,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 20406 "parsing/parser.ml" +# 20426 "parsing/parser.ml" in # 3490 "parsing/parser.mly" ( _1 ) -# 20412 "parsing/parser.ml" +# 20432 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20441,7 +20461,7 @@ module Tables = struct # 1365 "parsing/parser.mly" ( _startpos, Unit ) -# 20445 "parsing/parser.ml" +# 20465 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20499,14 +20519,14 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 20503 "parsing/parser.ml" +# 20523 "parsing/parser.ml" in let _startpos = _startpos__1_ in # 1368 "parsing/parser.mly" ( _startpos, Named (x, mty) ) -# 20510 "parsing/parser.ml" +# 20530 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20525,7 +20545,7 @@ module Tables = struct Parsetree.core_type option) = # 3281 "parsing/parser.mly" ( ([],Pcstr_tuple [],None) ) -# 20529 "parsing/parser.ml" +# 20549 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20558,7 +20578,7 @@ module Tables = struct Parsetree.core_type option) = # 3282 "parsing/parser.mly" ( ([],_2,None) ) -# 20562 "parsing/parser.ml" +# 20582 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20605,7 +20625,7 @@ module Tables = struct Parsetree.core_type option) = # 3284 "parsing/parser.mly" ( ([],_2,Some _4) ) -# 20609 "parsing/parser.ml" +# 20629 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20668,24 +20688,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 20672 "parsing/parser.ml" +# 20692 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 20677 "parsing/parser.ml" +# 20697 "parsing/parser.ml" in # 3417 "parsing/parser.mly" ( _1 ) -# 20683 "parsing/parser.ml" +# 20703 "parsing/parser.ml" in # 3287 "parsing/parser.mly" ( (_2,_4,Some _6) ) -# 20689 "parsing/parser.ml" +# 20709 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20718,7 +20738,7 @@ module Tables = struct Parsetree.core_type option) = # 3289 "parsing/parser.mly" ( ([],Pcstr_tuple [],Some _2) ) -# 20722 "parsing/parser.ml" +# 20742 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20767,24 +20787,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 20771 "parsing/parser.ml" +# 20791 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 20776 "parsing/parser.ml" +# 20796 "parsing/parser.ml" in # 3417 "parsing/parser.mly" ( _1 ) -# 20782 "parsing/parser.ml" +# 20802 "parsing/parser.ml" in # 3291 "parsing/parser.mly" ( (_2,Pcstr_tuple [],Some _4) ) -# 20788 "parsing/parser.ml" +# 20808 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20835,7 +20855,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 20839 "parsing/parser.ml" +# 20859 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined2_ in @@ -20847,7 +20867,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 20851 "parsing/parser.ml" +# 20871 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in @@ -20861,7 +20881,7 @@ module Tables = struct let loc = make_loc _sloc in cid, vars, args, res, attrs, loc, info ) -# 20865 "parsing/parser.ml" +# 20885 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20905,7 +20925,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 20909 "parsing/parser.ml" +# 20929 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined1_ in @@ -20916,14 +20936,14 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 20920 "parsing/parser.ml" +# 20940 "parsing/parser.ml" in let _startpos_cid_ = _startpos__1_ in let _1 = # 3879 "parsing/parser.mly" ( () ) -# 20927 "parsing/parser.ml" +# 20947 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos_cid_ in @@ -20936,7 +20956,7 @@ module Tables = struct let loc = make_loc _sloc in cid, vars, args, res, attrs, loc, info ) -# 20940 "parsing/parser.ml" +# 20960 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21009,7 +21029,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 21013 "parsing/parser.ml" +# 21033 "parsing/parser.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 @@ -21024,7 +21044,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 21028 "parsing/parser.ml" +# 21048 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -21033,24 +21053,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 21037 "parsing/parser.ml" +# 21057 "parsing/parser.ml" in # 1040 "parsing/parser.mly" ( xs ) -# 21042 "parsing/parser.ml" +# 21062 "parsing/parser.ml" in # 3134 "parsing/parser.mly" ( _1 ) -# 21048 "parsing/parser.ml" +# 21068 "parsing/parser.ml" in let kind_priv_manifest = # 3169 "parsing/parser.mly" ( _2 ) -# 21054 "parsing/parser.ml" +# 21074 "parsing/parser.ml" in let id = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -21060,20 +21080,20 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21064 "parsing/parser.ml" +# 21084 "parsing/parser.ml" in let flag = # 3899 "parsing/parser.mly" ( Recursive ) -# 21070 "parsing/parser.ml" +# 21090 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in # 4058 "parsing/parser.mly" ( _1 ) -# 21077 "parsing/parser.ml" +# 21097 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -21089,7 +21109,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 21093 "parsing/parser.ml" +# 21113 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21168,7 +21188,7 @@ module Tables = struct let _1_inlined3 : ( # 774 "parsing/parser.mly" (string) -# 21172 "parsing/parser.ml" +# 21192 "parsing/parser.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 @@ -21184,7 +21204,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 21188 "parsing/parser.ml" +# 21208 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined5_ in @@ -21193,24 +21213,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 21197 "parsing/parser.ml" +# 21217 "parsing/parser.ml" in # 1040 "parsing/parser.mly" ( xs ) -# 21202 "parsing/parser.ml" +# 21222 "parsing/parser.ml" in # 3134 "parsing/parser.mly" ( _1 ) -# 21208 "parsing/parser.ml" +# 21228 "parsing/parser.ml" in let kind_priv_manifest = # 3169 "parsing/parser.mly" ( _2 ) -# 21214 "parsing/parser.ml" +# 21234 "parsing/parser.ml" in let id = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in @@ -21220,7 +21240,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21224 "parsing/parser.ml" +# 21244 "parsing/parser.ml" in let flag = @@ -21231,7 +21251,7 @@ module Tables = struct # 3901 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 21235 "parsing/parser.ml" +# 21255 "parsing/parser.ml" in let attrs1 = @@ -21239,7 +21259,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 21243 "parsing/parser.ml" +# 21263 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -21255,7 +21275,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 21259 "parsing/parser.ml" +# 21279 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21321,7 +21341,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 21325 "parsing/parser.ml" +# 21345 "parsing/parser.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 @@ -21336,7 +21356,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 21340 "parsing/parser.ml" +# 21360 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -21345,18 +21365,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 21349 "parsing/parser.ml" +# 21369 "parsing/parser.ml" in # 1040 "parsing/parser.mly" ( xs ) -# 21354 "parsing/parser.ml" +# 21374 "parsing/parser.ml" in # 3134 "parsing/parser.mly" ( _1 ) -# 21360 "parsing/parser.ml" +# 21380 "parsing/parser.ml" in let id = @@ -21367,20 +21387,20 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21371 "parsing/parser.ml" +# 21391 "parsing/parser.ml" in let flag = # 3895 "parsing/parser.mly" ( Recursive ) -# 21377 "parsing/parser.ml" +# 21397 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in # 4058 "parsing/parser.mly" ( _1 ) -# 21384 "parsing/parser.ml" +# 21404 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -21396,7 +21416,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 21400 "parsing/parser.ml" +# 21420 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21468,7 +21488,7 @@ module Tables = struct let _1_inlined3 : ( # 774 "parsing/parser.mly" (string) -# 21472 "parsing/parser.ml" +# 21492 "parsing/parser.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 @@ -21484,7 +21504,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 21488 "parsing/parser.ml" +# 21508 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -21493,18 +21513,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 21497 "parsing/parser.ml" +# 21517 "parsing/parser.ml" in # 1040 "parsing/parser.mly" ( xs ) -# 21502 "parsing/parser.ml" +# 21522 "parsing/parser.ml" in # 3134 "parsing/parser.mly" ( _1 ) -# 21508 "parsing/parser.ml" +# 21528 "parsing/parser.ml" in let id = @@ -21515,20 +21535,20 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21519 "parsing/parser.ml" +# 21539 "parsing/parser.ml" in let flag = # 3896 "parsing/parser.mly" ( Nonrecursive ) -# 21525 "parsing/parser.ml" +# 21545 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in # 4058 "parsing/parser.mly" ( _1 ) -# 21532 "parsing/parser.ml" +# 21552 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -21544,7 +21564,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 21548 "parsing/parser.ml" +# 21568 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21565,7 +21585,7 @@ module Tables = struct let _1 : ( # 825 "parsing/parser.mly" (string) -# 21569 "parsing/parser.ml" +# 21589 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -21573,7 +21593,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3738 "parsing/parser.mly" ( _1 ) -# 21577 "parsing/parser.ml" +# 21597 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21594,7 +21614,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 21598 "parsing/parser.ml" +# 21618 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -21602,7 +21622,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3739 "parsing/parser.mly" ( _1 ) -# 21606 "parsing/parser.ml" +# 21626 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21634,7 +21654,7 @@ module Tables = struct let _v : (Parsetree.structure) = # 1232 "parsing/parser.mly" ( _1 ) -# 21638 "parsing/parser.ml" +# 21658 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21652,7 +21672,7 @@ module Tables = struct let _v : (string) = # 3788 "parsing/parser.mly" ( "" ) -# 21656 "parsing/parser.ml" +# 21676 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21684,7 +21704,7 @@ module Tables = struct let _v : (string) = # 3789 "parsing/parser.mly" ( ";.." ) -# 21688 "parsing/parser.ml" +# 21708 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21716,7 +21736,7 @@ module Tables = struct let _v : (Parsetree.signature) = # 1239 "parsing/parser.mly" ( _1 ) -# 21720 "parsing/parser.ml" +# 21740 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21762,7 +21782,7 @@ module Tables = struct let _v : (Parsetree.extension) = # 4079 "parsing/parser.mly" ( (_2, _3) ) -# 21766 "parsing/parser.ml" +# 21786 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21783,7 +21803,7 @@ module Tables = struct let _1 : ( # 816 "parsing/parser.mly" (string * Location.t * string * Location.t * string option) -# 21787 "parsing/parser.ml" +# 21807 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -21794,7 +21814,7 @@ module Tables = struct # 4081 "parsing/parser.mly" ( mk_quotedext ~loc:_sloc _1 ) -# 21798 "parsing/parser.ml" +# 21818 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21842,7 +21862,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 21846 "parsing/parser.ml" +# 21866 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -21853,7 +21873,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 21857 "parsing/parser.ml" +# 21877 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in @@ -21862,7 +21882,7 @@ module Tables = struct # 3435 "parsing/parser.mly" ( _1 ) -# 21866 "parsing/parser.ml" +# 21886 "parsing/parser.ml" in let _2 = @@ -21870,7 +21890,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 21874 "parsing/parser.ml" +# 21894 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -21878,7 +21898,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21882 "parsing/parser.ml" +# 21902 "parsing/parser.ml" in let _startpos__2_ = _startpos__1_inlined1_ in @@ -21892,7 +21912,7 @@ module Tables = struct # 3308 "parsing/parser.mly" ( let info = symbol_info _endpos in Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info ) -# 21896 "parsing/parser.ml" +# 21916 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21954,7 +21974,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 21958 "parsing/parser.ml" +# 21978 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -21965,7 +21985,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 21969 "parsing/parser.ml" +# 21989 "parsing/parser.ml" in let _endpos__7_ = _endpos__1_inlined4_ in @@ -21974,7 +21994,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 21978 "parsing/parser.ml" +# 21998 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in @@ -21983,7 +22003,7 @@ module Tables = struct # 3435 "parsing/parser.mly" ( _1 ) -# 21987 "parsing/parser.ml" +# 22007 "parsing/parser.ml" in let _2 = @@ -21991,7 +22011,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 21995 "parsing/parser.ml" +# 22015 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -21999,7 +22019,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22003 "parsing/parser.ml" +# 22023 "parsing/parser.ml" in let _startpos__2_ = _startpos__1_inlined1_ in @@ -22017,7 +22037,7 @@ module Tables = struct | None -> symbol_info _endpos in Type.field _2 _4 ~mut:_1 ~attrs:(_5 @ _7) ~loc:(make_loc _sloc) ~info ) -# 22021 "parsing/parser.ml" +# 22041 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22042,7 +22062,7 @@ module Tables = struct let _v : (Parsetree.label_declaration list) = # 3302 "parsing/parser.mly" ( [_1] ) -# 22046 "parsing/parser.ml" +# 22066 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22067,7 +22087,7 @@ module Tables = struct let _v : (Parsetree.label_declaration list) = # 3303 "parsing/parser.mly" ( [_1] ) -# 22071 "parsing/parser.ml" +# 22091 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22099,7 +22119,7 @@ module Tables = struct let _v : (Parsetree.label_declaration list) = # 3304 "parsing/parser.mly" ( _1 :: _2 ) -# 22103 "parsing/parser.ml" +# 22123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22120,7 +22140,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 22124 "parsing/parser.ml" +# 22144 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22133,7 +22153,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22137 "parsing/parser.ml" +# 22157 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -22142,13 +22162,13 @@ module Tables = struct # 2363 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 22146 "parsing/parser.ml" +# 22166 "parsing/parser.ml" in # 2355 "parsing/parser.mly" ( x ) -# 22152 "parsing/parser.ml" +# 22172 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22183,7 +22203,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 22187 "parsing/parser.ml" +# 22207 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22196,7 +22216,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22200 "parsing/parser.ml" +# 22220 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -22205,7 +22225,7 @@ module Tables = struct # 2363 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 22209 "parsing/parser.ml" +# 22229 "parsing/parser.ml" in let _startpos_x_ = _startpos__1_ in @@ -22217,7 +22237,7 @@ module Tables = struct ( let lab, pat = x in lab, mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) ) -# 22221 "parsing/parser.ml" +# 22241 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22242,7 +22262,7 @@ module Tables = struct let _v : (Longident.t) = # 3820 "parsing/parser.mly" ( _1 ) -# 22246 "parsing/parser.ml" +# 22266 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22267,7 +22287,7 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression) = # 2616 "parsing/parser.mly" ( (Nolabel, _1) ) -# 22271 "parsing/parser.ml" +# 22291 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22295,7 +22315,7 @@ module Tables = struct let _1 : ( # 761 "parsing/parser.mly" (string) -# 22299 "parsing/parser.ml" +# 22319 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22303,7 +22323,7 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression) = # 2618 "parsing/parser.mly" ( (Labelled _1, _2) ) -# 22307 "parsing/parser.ml" +# 22327 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22330,7 +22350,7 @@ module Tables = struct let label : ( # 774 "parsing/parser.mly" (string) -# 22334 "parsing/parser.ml" +# 22354 "parsing/parser.ml" ) = Obj.magic label in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -22341,7 +22361,7 @@ module Tables = struct # 2620 "parsing/parser.mly" ( let loc = _loc_label_ in (Labelled label, mkexpvar ~loc label) ) -# 22345 "parsing/parser.ml" +# 22365 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22388,7 +22408,7 @@ module Tables = struct let label : ( # 774 "parsing/parser.mly" (string) -# 22392 "parsing/parser.ml" +# 22412 "parsing/parser.ml" ) = Obj.magic label in let _2 : unit = Obj.magic _2 in let _1 : unit = Obj.magic _1 in @@ -22401,7 +22421,7 @@ module Tables = struct # 2623 "parsing/parser.mly" ( (Labelled label, mkexp_constraint ~loc:(_startpos__2_, _endpos) (mkexpvar ~loc:_loc_label_ label) ty) ) -# 22405 "parsing/parser.ml" +# 22425 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22428,7 +22448,7 @@ module Tables = struct let label : ( # 774 "parsing/parser.mly" (string) -# 22432 "parsing/parser.ml" +# 22452 "parsing/parser.ml" ) = Obj.magic label in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -22439,7 +22459,7 @@ module Tables = struct # 2626 "parsing/parser.mly" ( let loc = _loc_label_ in (Optional label, mkexpvar ~loc label) ) -# 22443 "parsing/parser.ml" +# 22463 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22467,7 +22487,7 @@ module Tables = struct let _1 : ( # 791 "parsing/parser.mly" (string) -# 22471 "parsing/parser.ml" +# 22491 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22475,7 +22495,7 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression) = # 2629 "parsing/parser.mly" ( (Optional _1, _2) ) -# 22479 "parsing/parser.ml" +# 22499 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22530,13 +22550,13 @@ module Tables = struct # 2351 "parsing/parser.mly" ( _1 ) -# 22534 "parsing/parser.ml" +# 22554 "parsing/parser.ml" in # 2325 "parsing/parser.mly" ( (Optional (fst _3), _4, snd _3) ) -# 22540 "parsing/parser.ml" +# 22560 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22563,7 +22583,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 22567 "parsing/parser.ml" +# 22587 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -22578,7 +22598,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22582 "parsing/parser.ml" +# 22602 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -22587,13 +22607,13 @@ module Tables = struct # 2363 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 22591 "parsing/parser.ml" +# 22611 "parsing/parser.ml" in # 2327 "parsing/parser.mly" ( (Optional (fst _2), None, snd _2) ) -# 22597 "parsing/parser.ml" +# 22617 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22642,7 +22662,7 @@ module Tables = struct let _1 : ( # 791 "parsing/parser.mly" (string) -# 22646 "parsing/parser.ml" +# 22666 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22652,13 +22672,13 @@ module Tables = struct # 2351 "parsing/parser.mly" ( _1 ) -# 22656 "parsing/parser.ml" +# 22676 "parsing/parser.ml" in # 2329 "parsing/parser.mly" ( (Optional _1, _4, _3) ) -# 22662 "parsing/parser.ml" +# 22682 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22686,7 +22706,7 @@ module Tables = struct let _1 : ( # 791 "parsing/parser.mly" (string) -# 22690 "parsing/parser.ml" +# 22710 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22694,7 +22714,7 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = # 2331 "parsing/parser.mly" ( (Optional _1, None, _2) ) -# 22698 "parsing/parser.ml" +# 22718 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22740,7 +22760,7 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = # 2333 "parsing/parser.mly" ( (Labelled (fst _3), None, snd _3) ) -# 22744 "parsing/parser.ml" +# 22764 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22767,7 +22787,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 22771 "parsing/parser.ml" +# 22791 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -22782,7 +22802,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22786 "parsing/parser.ml" +# 22806 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -22791,13 +22811,13 @@ module Tables = struct # 2363 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 22795 "parsing/parser.ml" +# 22815 "parsing/parser.ml" in # 2335 "parsing/parser.mly" ( (Labelled (fst _2), None, snd _2) ) -# 22801 "parsing/parser.ml" +# 22821 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22825,7 +22845,7 @@ module Tables = struct let _1 : ( # 761 "parsing/parser.mly" (string) -# 22829 "parsing/parser.ml" +# 22849 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22833,7 +22853,7 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = # 2337 "parsing/parser.mly" ( (Labelled _1, None, _2) ) -# 22837 "parsing/parser.ml" +# 22857 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22858,7 +22878,7 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = # 2339 "parsing/parser.mly" ( (Nolabel, None, _1) ) -# 22862 "parsing/parser.ml" +# 22882 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22885,7 +22905,7 @@ module Tables = struct Parsetree.value_constraint option * bool) = # 2668 "parsing/parser.mly" ( let p,e,c = _1 in (p,e,c,false) ) -# 22889 "parsing/parser.ml" +# 22909 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22914,7 +22934,7 @@ module Tables = struct # 2671 "parsing/parser.mly" ( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1, None, true) ) -# 22918 "parsing/parser.ml" +# 22938 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22951,13 +22971,13 @@ module Tables = struct # 2636 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 22955 "parsing/parser.ml" +# 22975 "parsing/parser.ml" in # 2640 "parsing/parser.mly" ( (_1, _2, None) ) -# 22961 "parsing/parser.ml" +# 22981 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23008,7 +23028,7 @@ module Tables = struct # 2636 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 23012 "parsing/parser.ml" +# 23032 "parsing/parser.ml" in @@ -23022,7 +23042,7 @@ module Tables = struct in (v, _4, Some t) ) -# 23026 "parsing/parser.ml" +# 23046 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23093,24 +23113,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 23097 "parsing/parser.ml" +# 23117 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 23102 "parsing/parser.ml" +# 23122 "parsing/parser.ml" in # 3417 "parsing/parser.mly" ( _1 ) -# 23108 "parsing/parser.ml" +# 23128 "parsing/parser.ml" in # 3421 "parsing/parser.mly" ( Ptyp_poly(_1, _3) ) -# 23114 "parsing/parser.ml" +# 23134 "parsing/parser.ml" in let _startpos__3_ = _startpos_xs_ in @@ -23121,7 +23141,7 @@ module Tables = struct # 2636 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 23125 "parsing/parser.ml" +# 23145 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in @@ -23131,7 +23151,7 @@ module Tables = struct let t = ghtyp ~loc:(_loc__3_) _3 in (_1, _5, Some (Pvc_constraint { locally_abstract_univars = []; typ=t })) ) -# 23135 "parsing/parser.ml" +# 23155 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23206,7 +23226,7 @@ module Tables = struct Parsetree.value_constraint option) = let _4 = # 2633 "parsing/parser.mly" ( xs ) -# 23210 "parsing/parser.ml" +# 23230 "parsing/parser.ml" in let _1 = let _endpos = _endpos__1_ in @@ -23215,7 +23235,7 @@ module Tables = struct # 2636 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 23219 "parsing/parser.ml" +# 23239 "parsing/parser.ml" in @@ -23224,7 +23244,7 @@ module Tables = struct Pvc_constraint { locally_abstract_univars=_4; typ = _6} in (_1, _8, Some constraint') ) -# 23228 "parsing/parser.ml" +# 23248 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23264,7 +23284,7 @@ module Tables = struct Parsetree.value_constraint option) = # 2662 "parsing/parser.mly" ( (_1, _3, None) ) -# 23268 "parsing/parser.ml" +# 23288 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23318,7 +23338,7 @@ module Tables = struct Parsetree.value_constraint option) = # 2664 "parsing/parser.mly" ( (_1, _5, Some(Pvc_constraint { locally_abstract_univars=[]; typ=_3 })) ) -# 23322 "parsing/parser.ml" +# 23342 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23382,7 +23402,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 23386 "parsing/parser.ml" +# 23406 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in @@ -23391,7 +23411,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 23395 "parsing/parser.ml" +# 23415 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -23403,13 +23423,13 @@ module Tables = struct let attrs = attrs1 @ attrs2 in mklbs ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 23407 "parsing/parser.ml" +# 23427 "parsing/parser.ml" in # 2681 "parsing/parser.mly" ( _1 ) -# 23413 "parsing/parser.ml" +# 23433 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23441,7 +23461,7 @@ module Tables = struct let _v : (let_bindings) = # 2682 "parsing/parser.mly" ( addlb _1 _2 ) -# 23445 "parsing/parser.ml" +# 23465 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23498,7 +23518,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 23502 "parsing/parser.ml" +# 23522 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in @@ -23507,13 +23527,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 23511 "parsing/parser.ml" +# 23531 "parsing/parser.ml" in let ext = # 4065 "parsing/parser.mly" ( None ) -# 23517 "parsing/parser.ml" +# 23537 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in @@ -23524,13 +23544,13 @@ module Tables = struct let attrs = attrs1 @ attrs2 in mklbs ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 23528 "parsing/parser.ml" +# 23548 "parsing/parser.ml" in # 2681 "parsing/parser.mly" ( _1 ) -# 23534 "parsing/parser.ml" +# 23554 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23601,7 +23621,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 23605 "parsing/parser.ml" +# 23625 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -23610,7 +23630,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 23614 "parsing/parser.ml" +# 23634 "parsing/parser.ml" in let ext = @@ -23621,7 +23641,7 @@ module Tables = struct # 4067 "parsing/parser.mly" ( not_expecting _loc "extension" ) -# 23625 "parsing/parser.ml" +# 23645 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -23633,13 +23653,13 @@ module Tables = struct let attrs = attrs1 @ attrs2 in mklbs ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 23637 "parsing/parser.ml" +# 23657 "parsing/parser.ml" in # 2681 "parsing/parser.mly" ( _1 ) -# 23643 "parsing/parser.ml" +# 23663 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23671,7 +23691,7 @@ module Tables = struct let _v : (let_bindings) = # 2682 "parsing/parser.mly" ( addlb _1 _2 ) -# 23675 "parsing/parser.ml" +# 23695 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23696,7 +23716,7 @@ module Tables = struct let _v : (Parsetree.pattern) = # 2367 "parsing/parser.mly" ( _1 ) -# 23700 "parsing/parser.ml" +# 23720 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23736,7 +23756,7 @@ module Tables = struct let _1 = # 2369 "parsing/parser.mly" ( Ppat_constraint(_1, _3) ) -# 23740 "parsing/parser.ml" +# 23760 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -23745,13 +23765,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 23749 "parsing/parser.ml" +# 23769 "parsing/parser.ml" in # 2370 "parsing/parser.mly" ( _1 ) -# 23755 "parsing/parser.ml" +# 23775 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23787,13 +23807,13 @@ module Tables = struct # 2636 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 23791 "parsing/parser.ml" +# 23811 "parsing/parser.ml" in # 2708 "parsing/parser.mly" ( (pat, exp) ) -# 23797 "parsing/parser.ml" +# 23817 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23821,7 +23841,7 @@ module Tables = struct # 2711 "parsing/parser.mly" ( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1) ) -# 23825 "parsing/parser.ml" +# 23845 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23875,7 +23895,7 @@ module Tables = struct # 2713 "parsing/parser.mly" ( let loc = (_startpos_pat_, _endpos_typ_) in (ghpat ~loc (Ppat_constraint(pat, typ)), exp) ) -# 23879 "parsing/parser.ml" +# 23899 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23914,7 +23934,7 @@ module Tables = struct let _v : (Parsetree.pattern * Parsetree.expression) = # 2716 "parsing/parser.mly" ( (pat, exp) ) -# 23918 "parsing/parser.ml" +# 23938 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23940,7 +23960,7 @@ module Tables = struct # 2720 "parsing/parser.mly" ( let let_pat, let_exp = body in let_pat, let_exp, [] ) -# 23944 "parsing/parser.ml" +# 23964 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23974,7 +23994,7 @@ module Tables = struct let _1 : ( # 757 "parsing/parser.mly" (string) -# 23978 "parsing/parser.ml" +# 23998 "parsing/parser.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 @@ -23987,7 +24007,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 23991 "parsing/parser.ml" +# 24011 "parsing/parser.ml" in let _endpos = _endpos_body_ in @@ -24000,7 +24020,7 @@ module Tables = struct 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 ) -# 24004 "parsing/parser.ml" +# 24024 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24018,7 +24038,7 @@ module Tables = struct let _v : (Parsetree.class_declaration list) = # 211 "" ( [] ) -# 24022 "parsing/parser.ml" +# 24042 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24084,7 +24104,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 24088 "parsing/parser.ml" +# 24108 "parsing/parser.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 @@ -24099,7 +24119,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 24103 "parsing/parser.ml" +# 24123 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -24111,7 +24131,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24115 "parsing/parser.ml" +# 24135 "parsing/parser.ml" in let attrs1 = @@ -24119,7 +24139,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 24123 "parsing/parser.ml" +# 24143 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -24134,13 +24154,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs ) -# 24138 "parsing/parser.ml" +# 24158 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 24144 "parsing/parser.ml" +# 24164 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24158,7 +24178,7 @@ module Tables = struct let _v : (Parsetree.class_description list) = # 211 "" ( [] ) -# 24162 "parsing/parser.ml" +# 24182 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24231,7 +24251,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 24235 "parsing/parser.ml" +# 24255 "parsing/parser.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 @@ -24246,7 +24266,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 24250 "parsing/parser.ml" +# 24270 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -24258,7 +24278,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24262 "parsing/parser.ml" +# 24282 "parsing/parser.ml" in let attrs1 = @@ -24266,7 +24286,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 24270 "parsing/parser.ml" +# 24290 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -24281,13 +24301,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs ) -# 24285 "parsing/parser.ml" +# 24305 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 24291 "parsing/parser.ml" +# 24311 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24305,7 +24325,7 @@ module Tables = struct let _v : (Parsetree.class_type_declaration list) = # 211 "" ( [] ) -# 24309 "parsing/parser.ml" +# 24329 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24378,7 +24398,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 24382 "parsing/parser.ml" +# 24402 "parsing/parser.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 @@ -24393,7 +24413,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 24397 "parsing/parser.ml" +# 24417 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -24405,7 +24425,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24409 "parsing/parser.ml" +# 24429 "parsing/parser.ml" in let attrs1 = @@ -24413,7 +24433,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 24417 "parsing/parser.ml" +# 24437 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -24428,13 +24448,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs ) -# 24432 "parsing/parser.ml" +# 24452 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 24438 "parsing/parser.ml" +# 24458 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24452,7 +24472,7 @@ module Tables = struct let _v : (Parsetree.module_binding list) = # 211 "" ( [] ) -# 24456 "parsing/parser.ml" +# 24476 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24515,7 +24535,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 24519 "parsing/parser.ml" +# 24539 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -24527,7 +24547,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24531 "parsing/parser.ml" +# 24551 "parsing/parser.ml" in let attrs1 = @@ -24535,7 +24555,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 24539 "parsing/parser.ml" +# 24559 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -24550,13 +24570,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Mb.mk name body ~attrs ~loc ~text ~docs ) -# 24554 "parsing/parser.ml" +# 24574 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 24560 "parsing/parser.ml" +# 24580 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24574,7 +24594,7 @@ module Tables = struct let _v : (Parsetree.module_declaration list) = # 211 "" ( [] ) -# 24578 "parsing/parser.ml" +# 24598 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24644,7 +24664,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 24648 "parsing/parser.ml" +# 24668 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -24656,7 +24676,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24660 "parsing/parser.ml" +# 24680 "parsing/parser.ml" in let attrs1 = @@ -24664,7 +24684,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 24668 "parsing/parser.ml" +# 24688 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -24679,13 +24699,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Md.mk name mty ~attrs ~loc ~text ~docs ) -# 24683 "parsing/parser.ml" +# 24703 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 24689 "parsing/parser.ml" +# 24709 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24703,7 +24723,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 211 "" ( [] ) -# 24707 "parsing/parser.ml" +# 24727 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24735,7 +24755,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 213 "" ( x :: xs ) -# 24739 "parsing/parser.ml" +# 24759 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24753,7 +24773,7 @@ module Tables = struct let _v : (Parsetree.type_declaration list) = # 211 "" ( [] ) -# 24757 "parsing/parser.ml" +# 24777 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24820,7 +24840,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 24824 "parsing/parser.ml" +# 24844 "parsing/parser.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 @@ -24835,7 +24855,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 24839 "parsing/parser.ml" +# 24859 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -24844,18 +24864,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 24848 "parsing/parser.ml" +# 24868 "parsing/parser.ml" in # 1040 "parsing/parser.mly" ( xs ) -# 24853 "parsing/parser.ml" +# 24873 "parsing/parser.ml" in # 3134 "parsing/parser.mly" ( _1 ) -# 24859 "parsing/parser.ml" +# 24879 "parsing/parser.ml" in let id = @@ -24866,7 +24886,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24870 "parsing/parser.ml" +# 24890 "parsing/parser.ml" in let attrs1 = @@ -24874,7 +24894,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 24878 "parsing/parser.ml" +# 24898 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -24890,13 +24910,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text ) -# 24894 "parsing/parser.ml" +# 24914 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 24900 "parsing/parser.ml" +# 24920 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24914,7 +24934,7 @@ module Tables = struct let _v : (Parsetree.type_declaration list) = # 211 "" ( [] ) -# 24918 "parsing/parser.ml" +# 24938 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24988,7 +25008,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 24992 "parsing/parser.ml" +# 25012 "parsing/parser.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 @@ -25003,7 +25023,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 25007 "parsing/parser.ml" +# 25027 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -25012,24 +25032,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 25016 "parsing/parser.ml" +# 25036 "parsing/parser.ml" in # 1040 "parsing/parser.mly" ( xs ) -# 25021 "parsing/parser.ml" +# 25041 "parsing/parser.ml" in # 3134 "parsing/parser.mly" ( _1 ) -# 25027 "parsing/parser.ml" +# 25047 "parsing/parser.ml" in let kind_priv_manifest = # 3169 "parsing/parser.mly" ( _2 ) -# 25033 "parsing/parser.ml" +# 25053 "parsing/parser.ml" in let id = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -25039,7 +25059,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 25043 "parsing/parser.ml" +# 25063 "parsing/parser.ml" in let attrs1 = @@ -25047,7 +25067,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 25051 "parsing/parser.ml" +# 25071 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -25063,13 +25083,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text ) -# 25067 "parsing/parser.ml" +# 25087 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25073 "parsing/parser.ml" +# 25093 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25087,7 +25107,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 211 "" ( [] ) -# 25091 "parsing/parser.ml" +# 25111 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25119,7 +25139,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 213 "" ( x :: xs ) -# 25123 "parsing/parser.ml" +# 25143 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25137,7 +25157,7 @@ module Tables = struct let _v : (Parsetree.signature_item list list) = # 211 "" ( [] ) -# 25141 "parsing/parser.ml" +# 25161 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25172,19 +25192,19 @@ module Tables = struct # 966 "parsing/parser.mly" ( text_sig _startpos ) -# 25176 "parsing/parser.ml" +# 25196 "parsing/parser.ml" in # 1738 "parsing/parser.mly" ( _1 ) -# 25182 "parsing/parser.ml" +# 25202 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25188 "parsing/parser.ml" +# 25208 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25219,19 +25239,19 @@ module Tables = struct # 964 "parsing/parser.mly" ( text_sig _startpos @ [_1] ) -# 25223 "parsing/parser.ml" +# 25243 "parsing/parser.ml" in # 1738 "parsing/parser.mly" ( _1 ) -# 25229 "parsing/parser.ml" +# 25249 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25235 "parsing/parser.ml" +# 25255 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25249,7 +25269,7 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = # 211 "" ( [] ) -# 25253 "parsing/parser.ml" +# 25273 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25284,12 +25304,12 @@ module Tables = struct let items = # 1026 "parsing/parser.mly" ( [] ) -# 25288 "parsing/parser.ml" +# 25308 "parsing/parser.ml" in # 1477 "parsing/parser.mly" ( items ) -# 25293 "parsing/parser.ml" +# 25313 "parsing/parser.ml" in let xs = @@ -25297,25 +25317,25 @@ module Tables = struct # 962 "parsing/parser.mly" ( text_str _startpos ) -# 25301 "parsing/parser.ml" +# 25321 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 25307 "parsing/parser.ml" +# 25327 "parsing/parser.ml" in # 1493 "parsing/parser.mly" ( _1 ) -# 25313 "parsing/parser.ml" +# 25333 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25319 "parsing/parser.ml" +# 25339 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25369,12 +25389,12 @@ module Tables = struct let attrs = # 4054 "parsing/parser.mly" ( _1 ) -# 25373 "parsing/parser.ml" +# 25393 "parsing/parser.ml" in # 1484 "parsing/parser.mly" ( mkstrexp e attrs ) -# 25378 "parsing/parser.ml" +# 25398 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -25382,7 +25402,7 @@ module Tables = struct # 960 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 25386 "parsing/parser.ml" +# 25406 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -25392,19 +25412,19 @@ module Tables = struct # 979 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 25396 "parsing/parser.ml" +# 25416 "parsing/parser.ml" in # 1028 "parsing/parser.mly" ( x ) -# 25402 "parsing/parser.ml" +# 25422 "parsing/parser.ml" in # 1477 "parsing/parser.mly" ( items ) -# 25408 "parsing/parser.ml" +# 25428 "parsing/parser.ml" in let xs = @@ -25412,25 +25432,25 @@ module Tables = struct # 962 "parsing/parser.mly" ( text_str _startpos ) -# 25416 "parsing/parser.ml" +# 25436 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 25422 "parsing/parser.ml" +# 25442 "parsing/parser.ml" in # 1493 "parsing/parser.mly" ( _1 ) -# 25428 "parsing/parser.ml" +# 25448 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25434 "parsing/parser.ml" +# 25454 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25465,19 +25485,19 @@ module Tables = struct # 960 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 25469 "parsing/parser.ml" +# 25489 "parsing/parser.ml" in # 1493 "parsing/parser.mly" ( _1 ) -# 25475 "parsing/parser.ml" +# 25495 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25481 "parsing/parser.ml" +# 25501 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25495,7 +25515,7 @@ module Tables = struct let _v : (Parsetree.class_type_field list list) = # 211 "" ( [] ) -# 25499 "parsing/parser.ml" +# 25519 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25529,13 +25549,13 @@ module Tables = struct # 974 "parsing/parser.mly" ( text_csig _startpos @ [_1] ) -# 25533 "parsing/parser.ml" +# 25553 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25539 "parsing/parser.ml" +# 25559 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25553,7 +25573,7 @@ module Tables = struct let _v : (Parsetree.class_field list list) = # 211 "" ( [] ) -# 25557 "parsing/parser.ml" +# 25577 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25587,13 +25607,13 @@ module Tables = struct # 972 "parsing/parser.mly" ( text_cstr _startpos @ [_1] ) -# 25591 "parsing/parser.ml" +# 25611 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25597 "parsing/parser.ml" +# 25617 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25611,7 +25631,7 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = # 211 "" ( [] ) -# 25615 "parsing/parser.ml" +# 25635 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25645,13 +25665,13 @@ module Tables = struct # 960 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 25649 "parsing/parser.ml" +# 25669 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25655 "parsing/parser.ml" +# 25675 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25669,7 +25689,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase list list) = # 211 "" ( [] ) -# 25673 "parsing/parser.ml" +# 25693 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25704,30 +25724,30 @@ module Tables = struct let _1 = # 1026 "parsing/parser.mly" ( [] ) -# 25708 "parsing/parser.ml" +# 25728 "parsing/parser.ml" in # 1279 "parsing/parser.mly" ( _1 ) -# 25713 "parsing/parser.ml" +# 25733 "parsing/parser.ml" in # 183 "" ( x ) -# 25719 "parsing/parser.ml" +# 25739 "parsing/parser.ml" in # 1291 "parsing/parser.mly" ( _1 ) -# 25725 "parsing/parser.ml" +# 25745 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25731 "parsing/parser.ml" +# 25751 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25781,18 +25801,18 @@ module Tables = struct let attrs = # 4054 "parsing/parser.mly" ( _1 ) -# 25785 "parsing/parser.ml" +# 25805 "parsing/parser.ml" in # 1484 "parsing/parser.mly" ( mkstrexp e attrs ) -# 25790 "parsing/parser.ml" +# 25810 "parsing/parser.ml" in # 970 "parsing/parser.mly" ( Ptop_def [_1] ) -# 25796 "parsing/parser.ml" +# 25816 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -25800,37 +25820,37 @@ module Tables = struct # 968 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 25804 "parsing/parser.ml" +# 25824 "parsing/parser.ml" in # 1028 "parsing/parser.mly" ( x ) -# 25810 "parsing/parser.ml" +# 25830 "parsing/parser.ml" in # 1279 "parsing/parser.mly" ( _1 ) -# 25816 "parsing/parser.ml" +# 25836 "parsing/parser.ml" in # 183 "" ( x ) -# 25822 "parsing/parser.ml" +# 25842 "parsing/parser.ml" in # 1291 "parsing/parser.mly" ( _1 ) -# 25828 "parsing/parser.ml" +# 25848 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25834 "parsing/parser.ml" +# 25854 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25864,25 +25884,25 @@ module Tables = struct let _1 = # 970 "parsing/parser.mly" ( Ptop_def [_1] ) -# 25868 "parsing/parser.ml" +# 25888 "parsing/parser.ml" in let _startpos = _startpos__1_ in # 968 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 25874 "parsing/parser.ml" +# 25894 "parsing/parser.ml" in # 1291 "parsing/parser.mly" ( _1 ) -# 25880 "parsing/parser.ml" +# 25900 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25886 "parsing/parser.ml" +# 25906 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25920,26 +25940,26 @@ module Tables = struct # 979 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 25924 "parsing/parser.ml" +# 25944 "parsing/parser.ml" in let _startpos = _startpos__1_ in # 968 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 25931 "parsing/parser.ml" +# 25951 "parsing/parser.ml" in # 1291 "parsing/parser.mly" ( _1 ) -# 25937 "parsing/parser.ml" +# 25957 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 25943 "parsing/parser.ml" +# 25963 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25978,7 +25998,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = # 124 "" ( None ) -# 25982 "parsing/parser.ml" +# 26002 "parsing/parser.ml" in let x = let label = @@ -25988,7 +26008,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 25992 "parsing/parser.ml" +# 26012 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -26010,13 +26030,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:constraint_loc pat octy ) -# 26014 "parsing/parser.ml" +# 26034 "parsing/parser.ml" in # 1216 "parsing/parser.mly" ( [x], None ) -# 26020 "parsing/parser.ml" +# 26040 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26062,7 +26082,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = # 126 "" ( Some x ) -# 26066 "parsing/parser.ml" +# 26086 "parsing/parser.ml" in let x = let label = @@ -26072,7 +26092,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26076 "parsing/parser.ml" +# 26096 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -26094,13 +26114,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:constraint_loc pat octy ) -# 26098 "parsing/parser.ml" +# 26118 "parsing/parser.ml" in # 1216 "parsing/parser.mly" ( [x], None ) -# 26104 "parsing/parser.ml" +# 26124 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26165,7 +26185,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26169 "parsing/parser.ml" +# 26189 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -26187,13 +26207,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:constraint_loc pat octy ) -# 26191 "parsing/parser.ml" +# 26211 "parsing/parser.ml" in # 1218 "parsing/parser.mly" ( [x], Some y ) -# 26197 "parsing/parser.ml" +# 26217 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26251,7 +26271,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26255 "parsing/parser.ml" +# 26275 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -26273,14 +26293,14 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:constraint_loc pat octy ) -# 26277 "parsing/parser.ml" +# 26297 "parsing/parser.ml" in # 1222 "parsing/parser.mly" ( let xs, y = tail in x :: xs, y ) -# 26284 "parsing/parser.ml" +# 26304 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26319,7 +26339,7 @@ module Tables = struct let _v : (Parsetree.case) = # 2756 "parsing/parser.mly" ( Exp.case _1 _3 ) -# 26323 "parsing/parser.ml" +# 26343 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26372,7 +26392,7 @@ module Tables = struct let _v : (Parsetree.case) = # 2758 "parsing/parser.mly" ( Exp.case _1 ~guard:_3 _5 ) -# 26376 "parsing/parser.ml" +# 26396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26412,7 +26432,7 @@ module Tables = struct # 2760 "parsing/parser.mly" ( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) ) -# 26416 "parsing/parser.ml" +# 26436 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26475,7 +26495,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 26479 "parsing/parser.ml" +# 26499 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -26486,7 +26506,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 26490 "parsing/parser.ml" +# 26510 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in @@ -26495,7 +26515,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 26499 "parsing/parser.ml" +# 26519 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in @@ -26504,14 +26524,14 @@ module Tables = struct # 3435 "parsing/parser.mly" ( _1 ) -# 26508 "parsing/parser.ml" +# 26528 "parsing/parser.ml" in let _1 = let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 26515 "parsing/parser.ml" +# 26535 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -26519,7 +26539,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26523 "parsing/parser.ml" +# 26543 "parsing/parser.ml" in let _endpos = _endpos__6_ in @@ -26534,13 +26554,13 @@ module Tables = struct in let attrs = add_info_attrs info (_4 @ _6) in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 26538 "parsing/parser.ml" +# 26558 "parsing/parser.ml" in # 3682 "parsing/parser.mly" ( let (f, c) = tail in (head :: f, c) ) -# 26544 "parsing/parser.ml" +# 26564 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26583,13 +26603,13 @@ module Tables = struct # 3712 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 26587 "parsing/parser.ml" +# 26607 "parsing/parser.ml" in # 3682 "parsing/parser.mly" ( let (f, c) = tail in (head :: f, c) ) -# 26593 "parsing/parser.ml" +# 26613 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26645,7 +26665,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 26649 "parsing/parser.ml" +# 26669 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -26656,7 +26676,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 26660 "parsing/parser.ml" +# 26680 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in @@ -26665,7 +26685,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 26669 "parsing/parser.ml" +# 26689 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in @@ -26674,14 +26694,14 @@ module Tables = struct # 3435 "parsing/parser.mly" ( _1 ) -# 26678 "parsing/parser.ml" +# 26698 "parsing/parser.ml" in let _1 = let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 26685 "parsing/parser.ml" +# 26705 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -26689,7 +26709,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26693 "parsing/parser.ml" +# 26713 "parsing/parser.ml" in let _endpos = _endpos__6_ in @@ -26704,13 +26724,13 @@ module Tables = struct in let attrs = add_info_attrs info (_4 @ _6) in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 26708 "parsing/parser.ml" +# 26728 "parsing/parser.ml" in # 3685 "parsing/parser.mly" ( [head], Closed ) -# 26714 "parsing/parser.ml" +# 26734 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26746,13 +26766,13 @@ module Tables = struct # 3712 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 26750 "parsing/parser.ml" +# 26770 "parsing/parser.ml" in # 3685 "parsing/parser.mly" ( [head], Closed ) -# 26756 "parsing/parser.ml" +# 26776 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26794,7 +26814,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 26798 "parsing/parser.ml" +# 26818 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -26805,7 +26825,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 26809 "parsing/parser.ml" +# 26829 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in @@ -26814,14 +26834,14 @@ module Tables = struct # 3435 "parsing/parser.mly" ( _1 ) -# 26818 "parsing/parser.ml" +# 26838 "parsing/parser.ml" in let _1 = let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 26825 "parsing/parser.ml" +# 26845 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -26829,7 +26849,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26833 "parsing/parser.ml" +# 26853 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -26840,13 +26860,13 @@ module Tables = struct ( let info = symbol_info _endpos in let attrs = add_info_attrs info _4 in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 26844 "parsing/parser.ml" +# 26864 "parsing/parser.ml" in # 3688 "parsing/parser.mly" ( [head], Closed ) -# 26850 "parsing/parser.ml" +# 26870 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26875,13 +26895,13 @@ module Tables = struct # 3712 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 26879 "parsing/parser.ml" +# 26899 "parsing/parser.ml" in # 3688 "parsing/parser.mly" ( [head], Closed ) -# 26885 "parsing/parser.ml" +# 26905 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26906,7 +26926,7 @@ module Tables = struct let _v : (Parsetree.object_field list * Asttypes.closed_flag) = # 3690 "parsing/parser.mly" ( [], Open ) -# 26910 "parsing/parser.ml" +# 26930 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26953,7 +26973,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 26957 "parsing/parser.ml" +# 26977 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let private_ : (Asttypes.private_flag) = Obj.magic private_ in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -26967,7 +26987,7 @@ module Tables = struct # 3431 "parsing/parser.mly" ( _1 ) -# 26971 "parsing/parser.ml" +# 26991 "parsing/parser.ml" in let label = @@ -26975,7 +26995,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 26979 "parsing/parser.ml" +# 26999 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -26983,23 +27003,23 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26987 "parsing/parser.ml" +# 27007 "parsing/parser.ml" in let attrs = # 4058 "parsing/parser.mly" ( _1 ) -# 26993 "parsing/parser.ml" +# 27013 "parsing/parser.ml" in let _1 = # 3957 "parsing/parser.mly" ( Fresh ) -# 26998 "parsing/parser.ml" +# 27018 "parsing/parser.ml" in # 2078 "parsing/parser.mly" ( (label, private_, Cfk_virtual ty), attrs ) -# 27003 "parsing/parser.ml" +# 27023 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27039,7 +27059,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 27043 "parsing/parser.ml" +# 27063 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -27053,7 +27073,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 27057 "parsing/parser.ml" +# 27077 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -27061,18 +27081,18 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27065 "parsing/parser.ml" +# 27085 "parsing/parser.ml" in let _2 = # 4058 "parsing/parser.mly" ( _1 ) -# 27071 "parsing/parser.ml" +# 27091 "parsing/parser.ml" in let _1 = # 3960 "parsing/parser.mly" ( Fresh ) -# 27076 "parsing/parser.ml" +# 27096 "parsing/parser.ml" in # 2080 "parsing/parser.mly" @@ -27080,7 +27100,7 @@ module Tables = struct 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 ) -# 27084 "parsing/parser.ml" +# 27104 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27126,7 +27146,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 27130 "parsing/parser.ml" +# 27150 "parsing/parser.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 @@ -27141,7 +27161,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 27145 "parsing/parser.ml" +# 27165 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -27149,7 +27169,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27153 "parsing/parser.ml" +# 27173 "parsing/parser.ml" in let _2 = @@ -27157,13 +27177,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 27161 "parsing/parser.ml" +# 27181 "parsing/parser.ml" in let _1 = # 3961 "parsing/parser.mly" ( Override ) -# 27167 "parsing/parser.ml" +# 27187 "parsing/parser.ml" in # 2080 "parsing/parser.mly" @@ -27171,7 +27191,7 @@ module Tables = struct 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 ) -# 27175 "parsing/parser.ml" +# 27195 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27232,7 +27252,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 27236 "parsing/parser.ml" +# 27256 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -27246,7 +27266,7 @@ module Tables = struct # 3431 "parsing/parser.mly" ( _1 ) -# 27250 "parsing/parser.ml" +# 27270 "parsing/parser.ml" in let _startpos__6_ = _startpos__1_inlined2_ in @@ -27255,7 +27275,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 27259 "parsing/parser.ml" +# 27279 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -27263,18 +27283,18 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27267 "parsing/parser.ml" +# 27287 "parsing/parser.ml" in let _2 = # 4058 "parsing/parser.mly" ( _1 ) -# 27273 "parsing/parser.ml" +# 27293 "parsing/parser.ml" in let _1 = # 3960 "parsing/parser.mly" ( Fresh ) -# 27278 "parsing/parser.ml" +# 27298 "parsing/parser.ml" in # 2086 "parsing/parser.mly" @@ -27282,7 +27302,7 @@ module Tables = struct let loc = (_startpos__6_, _endpos__8_) in ghexp ~loc (Pexp_poly(_8, Some _6)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 27286 "parsing/parser.ml" +# 27306 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27349,7 +27369,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 27353 "parsing/parser.ml" +# 27373 "parsing/parser.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 @@ -27364,7 +27384,7 @@ module Tables = struct # 3431 "parsing/parser.mly" ( _1 ) -# 27368 "parsing/parser.ml" +# 27388 "parsing/parser.ml" in let _startpos__6_ = _startpos__1_inlined3_ in @@ -27373,7 +27393,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 27377 "parsing/parser.ml" +# 27397 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -27381,7 +27401,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27385 "parsing/parser.ml" +# 27405 "parsing/parser.ml" in let _2 = @@ -27389,13 +27409,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 27393 "parsing/parser.ml" +# 27413 "parsing/parser.ml" in let _1 = # 3961 "parsing/parser.mly" ( Override ) -# 27399 "parsing/parser.ml" +# 27419 "parsing/parser.ml" in # 2086 "parsing/parser.mly" @@ -27403,7 +27423,7 @@ module Tables = struct let loc = (_startpos__6_, _endpos__8_) in ghexp ~loc (Pexp_poly(_8, Some _6)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 27407 "parsing/parser.ml" +# 27427 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27485,7 +27505,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 27489 "parsing/parser.ml" +# 27509 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -27497,7 +27517,7 @@ module Tables = struct Parsetree.attributes) = let _7 = # 2633 "parsing/parser.mly" ( xs ) -# 27501 "parsing/parser.ml" +# 27521 "parsing/parser.ml" in let _startpos__7_ = _startpos_xs_ in let _4 = @@ -27505,7 +27525,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 27509 "parsing/parser.ml" +# 27529 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -27513,20 +27533,20 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27517 "parsing/parser.ml" +# 27537 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined1_ in let _2 = # 4058 "parsing/parser.mly" ( _1 ) -# 27524 "parsing/parser.ml" +# 27544 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in let _1 = # 3960 "parsing/parser.mly" ( Fresh ) -# 27530 "parsing/parser.ml" +# 27550 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in let _endpos = _endpos__11_ in @@ -27553,7 +27573,7 @@ module Tables = struct ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 27557 "parsing/parser.ml" +# 27577 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27641,7 +27661,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 27645 "parsing/parser.ml" +# 27665 "parsing/parser.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 @@ -27654,7 +27674,7 @@ module Tables = struct Parsetree.attributes) = let _7 = # 2633 "parsing/parser.mly" ( xs ) -# 27658 "parsing/parser.ml" +# 27678 "parsing/parser.ml" in let _startpos__7_ = _startpos_xs_ in let _4 = @@ -27662,7 +27682,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 27666 "parsing/parser.ml" +# 27686 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -27670,7 +27690,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27674 "parsing/parser.ml" +# 27694 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined2_ in @@ -27679,14 +27699,14 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 27683 "parsing/parser.ml" +# 27703 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in let _1 = # 3961 "parsing/parser.mly" ( Override ) -# 27690 "parsing/parser.ml" +# 27710 "parsing/parser.ml" in let _endpos = _endpos__11_ in let _symbolstartpos = if _startpos__1_ != _endpos__1_ then @@ -27712,7 +27732,7 @@ module Tables = struct ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 27716 "parsing/parser.ml" +# 27736 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27733,7 +27753,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 27737 "parsing/parser.ml" +# 27757 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -27741,7 +27761,7 @@ module Tables = struct let _v : (Longident.t) = # 3813 "parsing/parser.mly" ( Lident _1 ) -# 27745 "parsing/parser.ml" +# 27765 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27774,7 +27794,7 @@ module Tables = struct let _3 : ( # 774 "parsing/parser.mly" (string) -# 27778 "parsing/parser.ml" +# 27798 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -27784,7 +27804,7 @@ module Tables = struct let _v : (Longident.t) = # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 27788 "parsing/parser.ml" +# 27808 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27805,7 +27825,7 @@ module Tables = struct let _1 : ( # 825 "parsing/parser.mly" (string) -# 27809 "parsing/parser.ml" +# 27829 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -27813,7 +27833,7 @@ module Tables = struct let _v : (Longident.t) = # 3813 "parsing/parser.mly" ( Lident _1 ) -# 27817 "parsing/parser.ml" +# 27837 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27846,7 +27866,7 @@ module Tables = struct let _3 : ( # 825 "parsing/parser.mly" (string) -# 27850 "parsing/parser.ml" +# 27870 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -27856,7 +27876,7 @@ module Tables = struct let _v : (Longident.t) = # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 27860 "parsing/parser.ml" +# 27880 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27881,12 +27901,12 @@ module Tables = struct let _v : (Longident.t) = let _1 = # 3851 "parsing/parser.mly" ( _1 ) -# 27885 "parsing/parser.ml" +# 27905 "parsing/parser.ml" in # 3813 "parsing/parser.mly" ( Lident _1 ) -# 27890 "parsing/parser.ml" +# 27910 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27926,18 +27946,18 @@ module Tables = struct let _1 = # 3793 "parsing/parser.mly" ( "::" ) -# 27930 "parsing/parser.ml" +# 27950 "parsing/parser.ml" in # 3851 "parsing/parser.mly" ( _1 ) -# 27935 "parsing/parser.ml" +# 27955 "parsing/parser.ml" in # 3813 "parsing/parser.mly" ( Lident _1 ) -# 27941 "parsing/parser.ml" +# 27961 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27962,12 +27982,12 @@ module Tables = struct let _v : (Longident.t) = let _1 = # 3851 "parsing/parser.mly" ( _1 ) -# 27966 "parsing/parser.ml" +# 27986 "parsing/parser.ml" in # 3813 "parsing/parser.mly" ( Lident _1 ) -# 27971 "parsing/parser.ml" +# 27991 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28008,13 +28028,13 @@ module Tables = struct # 3851 "parsing/parser.mly" ( _1 ) -# 28012 "parsing/parser.ml" +# 28032 "parsing/parser.ml" in # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 28018 "parsing/parser.ml" +# 28038 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28068,18 +28088,18 @@ module Tables = struct let _1 = # 3793 "parsing/parser.mly" ( "::" ) -# 28072 "parsing/parser.ml" +# 28092 "parsing/parser.ml" in # 3851 "parsing/parser.mly" ( _1 ) -# 28077 "parsing/parser.ml" +# 28097 "parsing/parser.ml" in # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 28083 "parsing/parser.ml" +# 28103 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28120,13 +28140,13 @@ module Tables = struct # 3851 "parsing/parser.mly" ( _1 ) -# 28124 "parsing/parser.ml" +# 28144 "parsing/parser.ml" in # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 28130 "parsing/parser.ml" +# 28150 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28151,7 +28171,7 @@ module Tables = struct let _v : (Longident.t) = # 3813 "parsing/parser.mly" ( Lident _1 ) -# 28155 "parsing/parser.ml" +# 28175 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28190,7 +28210,7 @@ module Tables = struct let _v : (Longident.t) = # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 28194 "parsing/parser.ml" +# 28214 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28211,7 +28231,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 28215 "parsing/parser.ml" +# 28235 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -28219,7 +28239,7 @@ module Tables = struct let _v : (Longident.t) = # 3813 "parsing/parser.mly" ( Lident _1 ) -# 28223 "parsing/parser.ml" +# 28243 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28252,7 +28272,7 @@ module Tables = struct let _3 : ( # 774 "parsing/parser.mly" (string) -# 28256 "parsing/parser.ml" +# 28276 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -28262,7 +28282,7 @@ module Tables = struct let _v : (Longident.t) = # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 28266 "parsing/parser.ml" +# 28286 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28283,7 +28303,7 @@ module Tables = struct let _1 : ( # 825 "parsing/parser.mly" (string) -# 28287 "parsing/parser.ml" +# 28307 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -28291,7 +28311,7 @@ module Tables = struct let _v : (Longident.t) = # 3813 "parsing/parser.mly" ( Lident _1 ) -# 28295 "parsing/parser.ml" +# 28315 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28324,7 +28344,7 @@ module Tables = struct let _3 : ( # 825 "parsing/parser.mly" (string) -# 28328 "parsing/parser.ml" +# 28348 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -28334,7 +28354,7 @@ module Tables = struct let _v : (Longident.t) = # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 28338 "parsing/parser.ml" +# 28358 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28359,7 +28379,7 @@ module Tables = struct let _v : (Longident.t) = # 3813 "parsing/parser.mly" ( Lident _1 ) -# 28363 "parsing/parser.ml" +# 28383 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28398,7 +28418,7 @@ module Tables = struct let _v : (Longident.t) = # 3814 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 28402 "parsing/parser.ml" +# 28422 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28423,7 +28443,7 @@ module Tables = struct let _v : (Longident.t) = # 3829 "parsing/parser.mly" ( _1 ) -# 28427 "parsing/parser.ml" +# 28447 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28472,7 +28492,7 @@ module Tables = struct # 3831 "parsing/parser.mly" ( lapply ~loc:_sloc _1 _3 ) -# 28476 "parsing/parser.ml" +# 28496 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28512,7 +28532,7 @@ module Tables = struct # 3833 "parsing/parser.mly" ( expecting _loc__3_ "module path" ) -# 28516 "parsing/parser.ml" +# 28536 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28537,7 +28557,7 @@ module Tables = struct let _v : (Longident.t) = # 3826 "parsing/parser.mly" ( _1 ) -# 28541 "parsing/parser.ml" +# 28561 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28569,7 +28589,7 @@ module Tables = struct let _v : (Parsetree.module_expr) = # 1553 "parsing/parser.mly" ( me ) -# 28573 "parsing/parser.ml" +# 28593 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28602,7 +28622,7 @@ module Tables = struct # 1555 "parsing/parser.mly" ( expecting _loc__1_ "=" ) -# 28606 "parsing/parser.ml" +# 28626 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28649,7 +28669,7 @@ module Tables = struct let _1 = # 1558 "parsing/parser.mly" ( Pmod_constraint(me, mty) ) -# 28653 "parsing/parser.ml" +# 28673 "parsing/parser.ml" in let _endpos__1_ = _endpos_me_ in let _endpos = _endpos__1_ in @@ -28658,13 +28678,13 @@ module Tables = struct # 999 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 28662 "parsing/parser.ml" +# 28682 "parsing/parser.ml" in # 1562 "parsing/parser.mly" ( _1 ) -# 28668 "parsing/parser.ml" +# 28688 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28698,7 +28718,7 @@ module Tables = struct # 1560 "parsing/parser.mly" ( let (_, arg) = arg_and_pos in Pmod_functor(arg, body) ) -# 28702 "parsing/parser.ml" +# 28722 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in let _endpos = _endpos__1_ in @@ -28707,13 +28727,13 @@ module Tables = struct # 999 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 28711 "parsing/parser.ml" +# 28731 "parsing/parser.ml" in # 1562 "parsing/parser.mly" ( _1 ) -# 28717 "parsing/parser.ml" +# 28737 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28745,7 +28765,7 @@ module Tables = struct let _v : (Parsetree.module_type) = # 1805 "parsing/parser.mly" ( mty ) -# 28749 "parsing/parser.ml" +# 28769 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28778,7 +28798,7 @@ module Tables = struct # 1807 "parsing/parser.mly" ( expecting _loc__1_ ":" ) -# 28782 "parsing/parser.ml" +# 28802 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28812,7 +28832,7 @@ module Tables = struct # 1810 "parsing/parser.mly" ( let (_, arg) = arg_and_pos in Pmty_functor(arg, body) ) -# 28816 "parsing/parser.ml" +# 28836 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in let _endpos = _endpos__1_ in @@ -28821,13 +28841,13 @@ module Tables = struct # 1001 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 28825 "parsing/parser.ml" +# 28845 "parsing/parser.ml" in # 1813 "parsing/parser.mly" ( _1 ) -# 28831 "parsing/parser.ml" +# 28851 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28875,7 +28895,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 28879 "parsing/parser.ml" +# 28899 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -28884,7 +28904,7 @@ module Tables = struct # 1391 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_structure s) ) -# 28888 "parsing/parser.ml" +# 28908 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28932,7 +28952,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 28936 "parsing/parser.ml" +# 28956 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in @@ -28940,7 +28960,7 @@ module Tables = struct # 1393 "parsing/parser.mly" ( unclosed "struct" _loc__1_ "end" _loc__4_ ) -# 28944 "parsing/parser.ml" +# 28964 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28973,7 +28993,7 @@ module Tables = struct # 1395 "parsing/parser.mly" ( expecting _loc__1_ "struct" ) -# 28977 "parsing/parser.ml" +# 28997 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29028,7 +29048,7 @@ module Tables = struct # 1357 "parsing/parser.mly" ( _1 ) -# 29032 "parsing/parser.ml" +# 29052 "parsing/parser.ml" in let attrs = @@ -29036,7 +29056,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 29040 "parsing/parser.ml" +# 29060 "parsing/parser.ml" in let _endpos = _endpos_me_ in @@ -29049,7 +29069,7 @@ module Tables = struct mkmod ~loc:(startpos, _endpos) (Pmod_functor (arg, acc)) ) me args ) ) -# 29053 "parsing/parser.ml" +# 29073 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29074,7 +29094,7 @@ module Tables = struct let _v : (Parsetree.module_expr) = # 1403 "parsing/parser.mly" ( me ) -# 29078 "parsing/parser.ml" +# 29098 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29106,7 +29126,7 @@ module Tables = struct let _v : (Parsetree.module_expr) = # 1405 "parsing/parser.mly" ( Mod.attr me attr ) -# 29110 "parsing/parser.ml" +# 29130 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29137,13 +29157,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 29141 "parsing/parser.ml" +# 29161 "parsing/parser.ml" in # 1409 "parsing/parser.mly" ( Pmod_ident x ) -# 29147 "parsing/parser.ml" +# 29167 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -29152,13 +29172,13 @@ module Tables = struct # 999 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 29156 "parsing/parser.ml" +# 29176 "parsing/parser.ml" in # 1420 "parsing/parser.mly" ( _1 ) -# 29162 "parsing/parser.ml" +# 29182 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29191,7 +29211,7 @@ module Tables = struct let _1 = # 1412 "parsing/parser.mly" ( Pmod_apply(me1, me2) ) -# 29195 "parsing/parser.ml" +# 29215 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_me2_, _startpos_me1_) in let _endpos = _endpos__1_ in @@ -29200,13 +29220,13 @@ module Tables = struct # 999 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 29204 "parsing/parser.ml" +# 29224 "parsing/parser.ml" in # 1420 "parsing/parser.mly" ( _1 ) -# 29210 "parsing/parser.ml" +# 29230 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29246,7 +29266,7 @@ module Tables = struct let _1 = # 1415 "parsing/parser.mly" ( Pmod_apply_unit me ) -# 29250 "parsing/parser.ml" +# 29270 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me_) in let _endpos = _endpos__1_ in @@ -29255,13 +29275,13 @@ module Tables = struct # 999 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 29259 "parsing/parser.ml" +# 29279 "parsing/parser.ml" in # 1420 "parsing/parser.mly" ( _1 ) -# 29265 "parsing/parser.ml" +# 29285 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29287,7 +29307,7 @@ module Tables = struct let _1 = # 1418 "parsing/parser.mly" ( Pmod_extension ex ) -# 29291 "parsing/parser.ml" +# 29311 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_ex_, _startpos_ex_) in let _endpos = _endpos__1_ in @@ -29296,13 +29316,13 @@ module Tables = struct # 999 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 29300 "parsing/parser.ml" +# 29320 "parsing/parser.ml" in # 1420 "parsing/parser.mly" ( _1 ) -# 29306 "parsing/parser.ml" +# 29326 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29323,7 +29343,7 @@ module Tables = struct let x : ( # 825 "parsing/parser.mly" (string) -# 29327 "parsing/parser.ml" +# 29347 "parsing/parser.ml" ) = Obj.magic x in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_x_ in @@ -29331,7 +29351,7 @@ module Tables = struct let _v : (string option) = # 1374 "parsing/parser.mly" ( Some x ) -# 29335 "parsing/parser.ml" +# 29355 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29356,7 +29376,7 @@ module Tables = struct let _v : (string option) = # 1377 "parsing/parser.mly" ( None ) -# 29360 "parsing/parser.ml" +# 29380 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29416,7 +29436,7 @@ module Tables = struct let _1_inlined2 : ( # 825 "parsing/parser.mly" (string) -# 29420 "parsing/parser.ml" +# 29440 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let ext : (string Asttypes.loc option) = Obj.magic ext in @@ -29429,7 +29449,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 29433 "parsing/parser.ml" +# 29453 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -29441,7 +29461,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 29445 "parsing/parser.ml" +# 29465 "parsing/parser.ml" in let uid = @@ -29452,7 +29472,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 29456 "parsing/parser.ml" +# 29476 "parsing/parser.ml" in let attrs1 = @@ -29460,7 +29480,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 29464 "parsing/parser.ml" +# 29484 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -29474,7 +29494,7 @@ module Tables = struct let docs = symbol_docs _sloc in Ms.mk uid body ~attrs ~loc ~docs, ext ) -# 29478 "parsing/parser.ml" +# 29498 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29527,7 +29547,7 @@ module Tables = struct let _1_inlined2 : ( # 825 "parsing/parser.mly" (string) -# 29531 "parsing/parser.ml" +# 29551 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let _2 : (string Asttypes.loc option) = Obj.magic _2 in @@ -29543,7 +29563,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 29547 "parsing/parser.ml" +# 29567 "parsing/parser.ml" in let _3 = @@ -29551,14 +29571,14 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 29555 "parsing/parser.ml" +# 29575 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in # 1850 "parsing/parser.mly" ( expecting _loc__6_ "module path" ) -# 29562 "parsing/parser.ml" +# 29582 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29606,7 +29626,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 29610 "parsing/parser.ml" +# 29630 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -29615,7 +29635,7 @@ module Tables = struct # 1687 "parsing/parser.mly" ( mkmty ~loc:_sloc ~attrs (Pmty_signature s) ) -# 29619 "parsing/parser.ml" +# 29639 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29663,7 +29683,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 29667 "parsing/parser.ml" +# 29687 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in @@ -29671,7 +29691,7 @@ module Tables = struct # 1689 "parsing/parser.mly" ( unclosed "sig" _loc__1_ "end" _loc__4_ ) -# 29675 "parsing/parser.ml" +# 29695 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29704,7 +29724,7 @@ module Tables = struct # 1691 "parsing/parser.mly" ( expecting _loc__1_ "sig" ) -# 29708 "parsing/parser.ml" +# 29728 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29759,7 +29779,7 @@ module Tables = struct # 1357 "parsing/parser.mly" ( _1 ) -# 29763 "parsing/parser.ml" +# 29783 "parsing/parser.ml" in let attrs = @@ -29767,7 +29787,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 29771 "parsing/parser.ml" +# 29791 "parsing/parser.ml" in let _endpos = _endpos_mty_ in @@ -29780,7 +29800,7 @@ module Tables = struct mkmty ~loc:(startpos, _endpos) (Pmty_functor (arg, acc)) ) mty args ) ) -# 29784 "parsing/parser.ml" +# 29804 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29835,7 +29855,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 29839 "parsing/parser.ml" +# 29859 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -29844,7 +29864,7 @@ module Tables = struct # 1701 "parsing/parser.mly" ( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) ) -# 29848 "parsing/parser.ml" +# 29868 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29883,7 +29903,7 @@ module Tables = struct let _v : (Parsetree.module_type) = # 1703 "parsing/parser.mly" ( _2 ) -# 29887 "parsing/parser.ml" +# 29907 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29924,7 +29944,7 @@ module Tables = struct # 1705 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 29928 "parsing/parser.ml" +# 29948 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29956,7 +29976,7 @@ module Tables = struct let _v : (Parsetree.module_type) = # 1707 "parsing/parser.mly" ( Mty.attr _1 _2 ) -# 29960 "parsing/parser.ml" +# 29980 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29987,13 +30007,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 29991 "parsing/parser.ml" +# 30011 "parsing/parser.ml" in # 1710 "parsing/parser.mly" ( Pmty_ident _1 ) -# 29997 "parsing/parser.ml" +# 30017 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -30002,13 +30022,13 @@ module Tables = struct # 1001 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 30006 "parsing/parser.ml" +# 30026 "parsing/parser.ml" in # 1723 "parsing/parser.mly" ( _1 ) -# 30012 "parsing/parser.ml" +# 30032 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30055,7 +30075,7 @@ module Tables = struct let _1 = # 1712 "parsing/parser.mly" ( Pmty_functor(Unit, _4) ) -# 30059 "parsing/parser.ml" +# 30079 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in let _endpos = _endpos__1_ in @@ -30064,13 +30084,13 @@ module Tables = struct # 1001 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 30068 "parsing/parser.ml" +# 30088 "parsing/parser.ml" in # 1723 "parsing/parser.mly" ( _1 ) -# 30074 "parsing/parser.ml" +# 30094 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30110,7 +30130,7 @@ module Tables = struct let _1 = # 1715 "parsing/parser.mly" ( Pmty_functor(Named (mknoloc None, _1), _3) ) -# 30114 "parsing/parser.ml" +# 30134 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -30119,13 +30139,13 @@ module Tables = struct # 1001 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 30123 "parsing/parser.ml" +# 30143 "parsing/parser.ml" in # 1723 "parsing/parser.mly" ( _1 ) -# 30129 "parsing/parser.ml" +# 30149 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30167,18 +30187,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 30171 "parsing/parser.ml" +# 30191 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 30176 "parsing/parser.ml" +# 30196 "parsing/parser.ml" in # 1717 "parsing/parser.mly" ( Pmty_with(_1, _3) ) -# 30182 "parsing/parser.ml" +# 30202 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -30188,13 +30208,13 @@ module Tables = struct # 1001 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 30192 "parsing/parser.ml" +# 30212 "parsing/parser.ml" in # 1723 "parsing/parser.mly" ( _1 ) -# 30198 "parsing/parser.ml" +# 30218 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30220,7 +30240,7 @@ module Tables = struct let _1 = # 1721 "parsing/parser.mly" ( Pmty_extension _1 ) -# 30224 "parsing/parser.ml" +# 30244 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -30228,13 +30248,13 @@ module Tables = struct # 1001 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 30232 "parsing/parser.ml" +# 30252 "parsing/parser.ml" in # 1723 "parsing/parser.mly" ( _1 ) -# 30238 "parsing/parser.ml" +# 30258 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30303,7 +30323,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 30307 "parsing/parser.ml" +# 30327 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -30315,7 +30335,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30319 "parsing/parser.ml" +# 30339 "parsing/parser.ml" in let attrs1 = @@ -30323,7 +30343,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 30327 "parsing/parser.ml" +# 30347 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -30337,7 +30357,7 @@ module Tables = struct let docs = symbol_docs _sloc in Mtd.mk id ?typ ~attrs ~loc ~docs, ext ) -# 30341 "parsing/parser.ml" +# 30361 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30413,7 +30433,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 30417 "parsing/parser.ml" +# 30437 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -30425,7 +30445,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30429 "parsing/parser.ml" +# 30449 "parsing/parser.ml" in let attrs1 = @@ -30433,7 +30453,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 30437 "parsing/parser.ml" +# 30457 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -30447,7 +30467,7 @@ module Tables = struct let docs = symbol_docs _sloc in Mtd.mk id ~typ ~attrs ~loc ~docs, ext ) -# 30451 "parsing/parser.ml" +# 30471 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30472,7 +30492,7 @@ module Tables = struct let _v : (Longident.t) = # 3836 "parsing/parser.mly" ( _1 ) -# 30476 "parsing/parser.ml" +# 30496 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30490,7 +30510,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag) = # 3917 "parsing/parser.mly" ( Immutable ) -# 30494 "parsing/parser.ml" +# 30514 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30515,7 +30535,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag) = # 3918 "parsing/parser.mly" ( Mutable ) -# 30519 "parsing/parser.ml" +# 30539 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30533,7 +30553,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = # 3926 "parsing/parser.mly" ( Immutable, Concrete ) -# 30537 "parsing/parser.ml" +# 30557 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30558,7 +30578,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = # 3928 "parsing/parser.mly" ( Mutable, Concrete ) -# 30562 "parsing/parser.ml" +# 30582 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30583,7 +30603,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = # 3930 "parsing/parser.mly" ( Immutable, Virtual ) -# 30587 "parsing/parser.ml" +# 30607 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30615,7 +30635,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = # 3933 "parsing/parser.mly" ( Mutable, Virtual ) -# 30619 "parsing/parser.ml" +# 30639 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30647,7 +30667,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = # 3933 "parsing/parser.mly" ( Mutable, Virtual ) -# 30651 "parsing/parser.ml" +# 30671 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30679,7 +30699,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3888 "parsing/parser.mly" ( _2 ) -# 30683 "parsing/parser.ml" +# 30703 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30700,7 +30720,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 30704 "parsing/parser.ml" +# 30724 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -30712,13 +30732,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30716 "parsing/parser.ml" +# 30736 "parsing/parser.ml" in # 221 "" ( [ x ] ) -# 30722 "parsing/parser.ml" +# 30742 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30746,7 +30766,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 30750 "parsing/parser.ml" +# 30770 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -30758,13 +30778,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30762 "parsing/parser.ml" +# 30782 "parsing/parser.ml" in # 223 "" ( x :: xs ) -# 30768 "parsing/parser.ml" +# 30788 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30785,7 +30805,7 @@ module Tables = struct let s : ( # 812 "parsing/parser.mly" (string * Location.t * string option) -# 30789 "parsing/parser.ml" +# 30809 "parsing/parser.ml" ) = Obj.magic s in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_s_ in @@ -30793,12 +30813,12 @@ module Tables = struct let _v : (string list) = let x = # 3884 "parsing/parser.mly" ( let body, _, _ = s in body ) -# 30797 "parsing/parser.ml" +# 30817 "parsing/parser.ml" in # 221 "" ( [ x ] ) -# 30802 "parsing/parser.ml" +# 30822 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30826,7 +30846,7 @@ module Tables = struct let s : ( # 812 "parsing/parser.mly" (string * Location.t * string option) -# 30830 "parsing/parser.ml" +# 30850 "parsing/parser.ml" ) = Obj.magic s in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_s_ in @@ -30834,12 +30854,12 @@ module Tables = struct let _v : (string list) = let x = # 3884 "parsing/parser.mly" ( let body, _, _ = s in body ) -# 30838 "parsing/parser.ml" +# 30858 "parsing/parser.ml" in # 223 "" ( x :: xs ) -# 30843 "parsing/parser.ml" +# 30863 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30864,12 +30884,12 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3913 "parsing/parser.mly" ( Public ) -# 30868 "parsing/parser.ml" +# 30888 "parsing/parser.ml" in # 3143 "parsing/parser.mly" ( (Ptype_abstract, priv, Some ty) ) -# 30873 "parsing/parser.ml" +# 30893 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30901,12 +30921,12 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3914 "parsing/parser.mly" ( Private ) -# 30905 "parsing/parser.ml" +# 30925 "parsing/parser.ml" in # 3143 "parsing/parser.mly" ( (Ptype_abstract, priv, Some ty) ) -# 30910 "parsing/parser.ml" +# 30930 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30931,24 +30951,24 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3913 "parsing/parser.mly" ( Public ) -# 30935 "parsing/parser.ml" +# 30955 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 30941 "parsing/parser.ml" +# 30961 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 30946 "parsing/parser.ml" +# 30966 "parsing/parser.ml" in # 3147 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 30952 "parsing/parser.ml" +# 30972 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30980,24 +31000,24 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3914 "parsing/parser.mly" ( Private ) -# 30984 "parsing/parser.ml" +# 31004 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 30990 "parsing/parser.ml" +# 31010 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 30995 "parsing/parser.ml" +# 31015 "parsing/parser.ml" in # 3147 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 31001 "parsing/parser.ml" +# 31021 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31036,31 +31056,31 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3913 "parsing/parser.mly" ( Public ) -# 31040 "parsing/parser.ml" +# 31060 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 31047 "parsing/parser.ml" +# 31067 "parsing/parser.ml" in # 126 "" ( Some x ) -# 31052 "parsing/parser.ml" +# 31072 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31058 "parsing/parser.ml" +# 31078 "parsing/parser.ml" in # 3147 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 31064 "parsing/parser.ml" +# 31084 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31106,31 +31126,31 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3914 "parsing/parser.mly" ( Private ) -# 31110 "parsing/parser.ml" +# 31130 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 31117 "parsing/parser.ml" +# 31137 "parsing/parser.ml" in # 126 "" ( Some x ) -# 31122 "parsing/parser.ml" +# 31142 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31128 "parsing/parser.ml" +# 31148 "parsing/parser.ml" in # 3147 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 31134 "parsing/parser.ml" +# 31154 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31155,24 +31175,24 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3913 "parsing/parser.mly" ( Public ) -# 31159 "parsing/parser.ml" +# 31179 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 31165 "parsing/parser.ml" +# 31185 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31170 "parsing/parser.ml" +# 31190 "parsing/parser.ml" in # 3151 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 31176 "parsing/parser.ml" +# 31196 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31204,24 +31224,24 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3914 "parsing/parser.mly" ( Private ) -# 31208 "parsing/parser.ml" +# 31228 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 31214 "parsing/parser.ml" +# 31234 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31219 "parsing/parser.ml" +# 31239 "parsing/parser.ml" in # 3151 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 31225 "parsing/parser.ml" +# 31245 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31260,31 +31280,31 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3913 "parsing/parser.mly" ( Public ) -# 31264 "parsing/parser.ml" +# 31284 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 31271 "parsing/parser.ml" +# 31291 "parsing/parser.ml" in # 126 "" ( Some x ) -# 31276 "parsing/parser.ml" +# 31296 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31282 "parsing/parser.ml" +# 31302 "parsing/parser.ml" in # 3151 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 31288 "parsing/parser.ml" +# 31308 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31330,31 +31350,31 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3914 "parsing/parser.mly" ( Private ) -# 31334 "parsing/parser.ml" +# 31354 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 31341 "parsing/parser.ml" +# 31361 "parsing/parser.ml" in # 126 "" ( Some x ) -# 31346 "parsing/parser.ml" +# 31366 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31352 "parsing/parser.ml" +# 31372 "parsing/parser.ml" in # 3151 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 31358 "parsing/parser.ml" +# 31378 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31393,24 +31413,24 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3913 "parsing/parser.mly" ( Public ) -# 31397 "parsing/parser.ml" +# 31417 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 31403 "parsing/parser.ml" +# 31423 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31408 "parsing/parser.ml" +# 31428 "parsing/parser.ml" in # 3155 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 31414 "parsing/parser.ml" +# 31434 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31456,24 +31476,24 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3914 "parsing/parser.mly" ( Private ) -# 31460 "parsing/parser.ml" +# 31480 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 31466 "parsing/parser.ml" +# 31486 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31471 "parsing/parser.ml" +# 31491 "parsing/parser.ml" in # 3155 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 31477 "parsing/parser.ml" +# 31497 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31526,31 +31546,31 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3913 "parsing/parser.mly" ( Public ) -# 31530 "parsing/parser.ml" +# 31550 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 31537 "parsing/parser.ml" +# 31557 "parsing/parser.ml" in # 126 "" ( Some x ) -# 31542 "parsing/parser.ml" +# 31562 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31548 "parsing/parser.ml" +# 31568 "parsing/parser.ml" in # 3155 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 31554 "parsing/parser.ml" +# 31574 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31610,31 +31630,31 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = # 3914 "parsing/parser.mly" ( Private ) -# 31614 "parsing/parser.ml" +# 31634 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 31621 "parsing/parser.ml" +# 31641 "parsing/parser.ml" in # 126 "" ( Some x ) -# 31626 "parsing/parser.ml" +# 31646 "parsing/parser.ml" in # 3159 "parsing/parser.mly" ( _1 ) -# 31632 "parsing/parser.ml" +# 31652 "parsing/parser.ml" in # 3155 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 31638 "parsing/parser.ml" +# 31658 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31674,7 +31694,7 @@ module Tables = struct let _1 = # 3577 "parsing/parser.mly" ( let (f, c) = meth_list in Ptyp_object (f, c) ) -# 31678 "parsing/parser.ml" +# 31698 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -31683,13 +31703,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 31687 "parsing/parser.ml" +# 31707 "parsing/parser.ml" in # 3581 "parsing/parser.mly" ( _1 ) -# 31693 "parsing/parser.ml" +# 31713 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31722,7 +31742,7 @@ module Tables = struct let _1 = # 3579 "parsing/parser.mly" ( Ptyp_object ([], Closed) ) -# 31726 "parsing/parser.ml" +# 31746 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -31731,13 +31751,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 31735 "parsing/parser.ml" +# 31755 "parsing/parser.ml" in # 3581 "parsing/parser.mly" ( _1 ) -# 31741 "parsing/parser.ml" +# 31761 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31792,7 +31812,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 31796 "parsing/parser.ml" +# 31816 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in @@ -31801,13 +31821,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 31805 "parsing/parser.ml" +# 31825 "parsing/parser.ml" in let override = # 3960 "parsing/parser.mly" ( Fresh ) -# 31811 "parsing/parser.ml" +# 31831 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in @@ -31820,7 +31840,7 @@ module Tables = struct let docs = symbol_docs _sloc in Opn.mk me ~override ~attrs ~loc ~docs, ext ) -# 31824 "parsing/parser.ml" +# 31844 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31882,7 +31902,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 31886 "parsing/parser.ml" +# 31906 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -31891,13 +31911,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 31895 "parsing/parser.ml" +# 31915 "parsing/parser.ml" in let override = # 3961 "parsing/parser.mly" ( Override ) -# 31901 "parsing/parser.ml" +# 31921 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in @@ -31910,7 +31930,7 @@ module Tables = struct let docs = symbol_docs _sloc in Opn.mk me ~override ~attrs ~loc ~docs, ext ) -# 31914 "parsing/parser.ml" +# 31934 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31965,7 +31985,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 31969 "parsing/parser.ml" +# 31989 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -31977,7 +31997,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31981 "parsing/parser.ml" +# 32001 "parsing/parser.ml" in let attrs1 = @@ -31985,13 +32005,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 31989 "parsing/parser.ml" +# 32009 "parsing/parser.ml" in let override = # 3960 "parsing/parser.mly" ( Fresh ) -# 31995 "parsing/parser.ml" +# 32015 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in @@ -32004,7 +32024,7 @@ module Tables = struct let docs = symbol_docs _sloc in Opn.mk id ~override ~attrs ~loc ~docs, ext ) -# 32008 "parsing/parser.ml" +# 32028 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32066,7 +32086,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 32070 "parsing/parser.ml" +# 32090 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -32078,7 +32098,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32082 "parsing/parser.ml" +# 32102 "parsing/parser.ml" in let attrs1 = @@ -32086,13 +32106,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 32090 "parsing/parser.ml" +# 32110 "parsing/parser.ml" in let override = # 3961 "parsing/parser.mly" ( Override ) -# 32096 "parsing/parser.ml" +# 32116 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in @@ -32105,7 +32125,7 @@ module Tables = struct let docs = symbol_docs _sloc in Opn.mk id ~override ~attrs ~loc ~docs, ext ) -# 32109 "parsing/parser.ml" +# 32129 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32126,7 +32146,7 @@ module Tables = struct let _1 : ( # 798 "parsing/parser.mly" (string) -# 32130 "parsing/parser.ml" +# 32150 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32134,7 +32154,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3752 "parsing/parser.mly" ( _1 ) -# 32138 "parsing/parser.ml" +# 32158 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32155,7 +32175,7 @@ module Tables = struct let _1 : ( # 756 "parsing/parser.mly" (string) -# 32159 "parsing/parser.ml" +# 32179 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32163,7 +32183,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3753 "parsing/parser.mly" ( _1 ) -# 32167 "parsing/parser.ml" +# 32187 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32184,7 +32204,7 @@ module Tables = struct let _1 : ( # 757 "parsing/parser.mly" (string) -# 32188 "parsing/parser.ml" +# 32208 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32192,7 +32212,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3754 "parsing/parser.mly" ( _1 ) -# 32196 "parsing/parser.ml" +# 32216 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32234,7 +32254,7 @@ module Tables = struct let _1 : ( # 755 "parsing/parser.mly" (string) -# 32238 "parsing/parser.ml" +# 32258 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32242,7 +32262,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3755 "parsing/parser.mly" ( "."^ _1 ^"(" ^ _3 ^ ")" ) -# 32246 "parsing/parser.ml" +# 32266 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32291,7 +32311,7 @@ module Tables = struct let _1 : ( # 755 "parsing/parser.mly" (string) -# 32295 "parsing/parser.ml" +# 32315 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32299,7 +32319,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3756 "parsing/parser.mly" ( "."^ _1 ^ "(" ^ _3 ^ ")<-" ) -# 32303 "parsing/parser.ml" +# 32323 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32341,7 +32361,7 @@ module Tables = struct let _1 : ( # 755 "parsing/parser.mly" (string) -# 32345 "parsing/parser.ml" +# 32365 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32349,7 +32369,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3757 "parsing/parser.mly" ( "."^ _1 ^"[" ^ _3 ^ "]" ) -# 32353 "parsing/parser.ml" +# 32373 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32398,7 +32418,7 @@ module Tables = struct let _1 : ( # 755 "parsing/parser.mly" (string) -# 32402 "parsing/parser.ml" +# 32422 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32406,7 +32426,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3758 "parsing/parser.mly" ( "."^ _1 ^ "[" ^ _3 ^ "]<-" ) -# 32410 "parsing/parser.ml" +# 32430 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32448,7 +32468,7 @@ module Tables = struct let _1 : ( # 755 "parsing/parser.mly" (string) -# 32452 "parsing/parser.ml" +# 32472 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32456,7 +32476,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3759 "parsing/parser.mly" ( "."^ _1 ^"{" ^ _3 ^ "}" ) -# 32460 "parsing/parser.ml" +# 32480 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32505,7 +32525,7 @@ module Tables = struct let _1 : ( # 755 "parsing/parser.mly" (string) -# 32509 "parsing/parser.ml" +# 32529 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32513,7 +32533,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3760 "parsing/parser.mly" ( "."^ _1 ^ "{" ^ _3 ^ "}<-" ) -# 32517 "parsing/parser.ml" +# 32537 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32534,7 +32554,7 @@ module Tables = struct let _1 : ( # 809 "parsing/parser.mly" (string) -# 32538 "parsing/parser.ml" +# 32558 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -32542,7 +32562,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3761 "parsing/parser.mly" ( _1 ) -# 32546 "parsing/parser.ml" +# 32566 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32567,7 +32587,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3762 "parsing/parser.mly" ( "!" ) -# 32571 "parsing/parser.ml" +# 32591 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32588,7 +32608,7 @@ module Tables = struct let op : ( # 750 "parsing/parser.mly" (string) -# 32592 "parsing/parser.ml" +# 32612 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in @@ -32596,12 +32616,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3766 "parsing/parser.mly" ( op ) -# 32600 "parsing/parser.ml" +# 32620 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32605 "parsing/parser.ml" +# 32625 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32622,7 +32642,7 @@ module Tables = struct let op : ( # 751 "parsing/parser.mly" (string) -# 32626 "parsing/parser.ml" +# 32646 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in @@ -32630,12 +32650,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3767 "parsing/parser.mly" ( op ) -# 32634 "parsing/parser.ml" +# 32654 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32639 "parsing/parser.ml" +# 32659 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32656,7 +32676,7 @@ module Tables = struct let op : ( # 752 "parsing/parser.mly" (string) -# 32660 "parsing/parser.ml" +# 32680 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in @@ -32664,12 +32684,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3768 "parsing/parser.mly" ( op ) -# 32668 "parsing/parser.ml" +# 32688 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32673 "parsing/parser.ml" +# 32693 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32690,7 +32710,7 @@ module Tables = struct let op : ( # 753 "parsing/parser.mly" (string) -# 32694 "parsing/parser.ml" +# 32714 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in @@ -32698,12 +32718,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3769 "parsing/parser.mly" ( op ) -# 32702 "parsing/parser.ml" +# 32722 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32707 "parsing/parser.ml" +# 32727 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32724,7 +32744,7 @@ module Tables = struct let op : ( # 754 "parsing/parser.mly" (string) -# 32728 "parsing/parser.ml" +# 32748 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in @@ -32732,12 +32752,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3770 "parsing/parser.mly" ( op ) -# 32736 "parsing/parser.ml" +# 32756 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32741 "parsing/parser.ml" +# 32761 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32762,12 +32782,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3771 "parsing/parser.mly" ("+") -# 32766 "parsing/parser.ml" +# 32786 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32771 "parsing/parser.ml" +# 32791 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32792,12 +32812,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3772 "parsing/parser.mly" ("+.") -# 32796 "parsing/parser.ml" +# 32816 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32801 "parsing/parser.ml" +# 32821 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32822,12 +32842,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3773 "parsing/parser.mly" ("+=") -# 32826 "parsing/parser.ml" +# 32846 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32831 "parsing/parser.ml" +# 32851 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32852,12 +32872,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3774 "parsing/parser.mly" ("-") -# 32856 "parsing/parser.ml" +# 32876 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32861 "parsing/parser.ml" +# 32881 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32882,12 +32902,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3775 "parsing/parser.mly" ("-.") -# 32886 "parsing/parser.ml" +# 32906 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32891 "parsing/parser.ml" +# 32911 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32912,12 +32932,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3776 "parsing/parser.mly" ("*") -# 32916 "parsing/parser.ml" +# 32936 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32921 "parsing/parser.ml" +# 32941 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32942,12 +32962,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3777 "parsing/parser.mly" ("%") -# 32946 "parsing/parser.ml" +# 32966 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32951 "parsing/parser.ml" +# 32971 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32972,12 +32992,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3778 "parsing/parser.mly" ("=") -# 32976 "parsing/parser.ml" +# 32996 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 32981 "parsing/parser.ml" +# 33001 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33002,12 +33022,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3779 "parsing/parser.mly" ("<") -# 33006 "parsing/parser.ml" +# 33026 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 33011 "parsing/parser.ml" +# 33031 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33032,12 +33052,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3780 "parsing/parser.mly" (">") -# 33036 "parsing/parser.ml" +# 33056 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 33041 "parsing/parser.ml" +# 33061 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33062,12 +33082,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3781 "parsing/parser.mly" ("or") -# 33066 "parsing/parser.ml" +# 33086 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 33071 "parsing/parser.ml" +# 33091 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33092,12 +33112,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3782 "parsing/parser.mly" ("||") -# 33096 "parsing/parser.ml" +# 33116 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 33101 "parsing/parser.ml" +# 33121 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33122,12 +33142,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3783 "parsing/parser.mly" ("&") -# 33126 "parsing/parser.ml" +# 33146 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 33131 "parsing/parser.ml" +# 33151 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33152,12 +33172,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3784 "parsing/parser.mly" ("&&") -# 33156 "parsing/parser.ml" +# 33176 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 33161 "parsing/parser.ml" +# 33181 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33182,12 +33202,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3785 "parsing/parser.mly" (":=") -# 33186 "parsing/parser.ml" +# 33206 "parsing/parser.ml" in # 3763 "parsing/parser.mly" ( _1 ) -# 33191 "parsing/parser.ml" +# 33211 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33212,7 +33232,7 @@ module Tables = struct let _v : (bool) = # 3667 "parsing/parser.mly" ( true ) -# 33216 "parsing/parser.ml" +# 33236 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33230,7 +33250,7 @@ module Tables = struct let _v : (bool) = # 3668 "parsing/parser.mly" ( false ) -# 33234 "parsing/parser.ml" +# 33254 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33248,7 +33268,7 @@ module Tables = struct let _v : (unit option) = # 114 "" ( None ) -# 33252 "parsing/parser.ml" +# 33272 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33273,7 +33293,7 @@ module Tables = struct let _v : (unit option) = # 116 "" ( Some x ) -# 33277 "parsing/parser.ml" +# 33297 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33291,7 +33311,7 @@ module Tables = struct let _v : (unit option) = # 114 "" ( None ) -# 33295 "parsing/parser.ml" +# 33315 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33316,7 +33336,7 @@ module Tables = struct let _v : (unit option) = # 116 "" ( Some x ) -# 33320 "parsing/parser.ml" +# 33340 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33334,7 +33354,7 @@ module Tables = struct let _v : (string Asttypes.loc option) = # 114 "" ( None ) -# 33338 "parsing/parser.ml" +# 33358 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33361,7 +33381,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 33365 "parsing/parser.ml" +# 33385 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -33376,19 +33396,19 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 33380 "parsing/parser.ml" +# 33400 "parsing/parser.ml" in # 183 "" ( x ) -# 33386 "parsing/parser.ml" +# 33406 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33392 "parsing/parser.ml" +# 33412 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33406,7 +33426,7 @@ module Tables = struct let _v : (Parsetree.core_type option) = # 114 "" ( None ) -# 33410 "parsing/parser.ml" +# 33430 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33438,12 +33458,12 @@ module Tables = struct let _v : (Parsetree.core_type option) = let x = # 183 "" ( x ) -# 33442 "parsing/parser.ml" +# 33462 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33447 "parsing/parser.ml" +# 33467 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33461,7 +33481,7 @@ module Tables = struct let _v : (Parsetree.core_type option) = # 114 "" ( None ) -# 33465 "parsing/parser.ml" +# 33485 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33493,12 +33513,12 @@ module Tables = struct let _v : (Parsetree.core_type option) = let x = # 183 "" ( x ) -# 33497 "parsing/parser.ml" +# 33517 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33502 "parsing/parser.ml" +# 33522 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33516,7 +33536,7 @@ module Tables = struct let _v : (Parsetree.expression option) = # 114 "" ( None ) -# 33520 "parsing/parser.ml" +# 33540 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33551,24 +33571,24 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 33555 "parsing/parser.ml" +# 33575 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 33560 "parsing/parser.ml" +# 33580 "parsing/parser.ml" in # 183 "" ( x ) -# 33566 "parsing/parser.ml" +# 33586 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33572 "parsing/parser.ml" +# 33592 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33627,18 +33647,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 33631 "parsing/parser.ml" +# 33651 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 33636 "parsing/parser.ml" +# 33656 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 33642 "parsing/parser.ml" +# 33662 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -33649,13 +33669,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 33653 "parsing/parser.ml" +# 33673 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 33659 "parsing/parser.ml" +# 33679 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -33675,25 +33695,25 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 33679 "parsing/parser.ml" +# 33699 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 33685 "parsing/parser.ml" +# 33705 "parsing/parser.ml" in # 183 "" ( x ) -# 33691 "parsing/parser.ml" +# 33711 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33697 "parsing/parser.ml" +# 33717 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33711,7 +33731,7 @@ module Tables = struct let _v : (Parsetree.module_type option) = # 114 "" ( None ) -# 33715 "parsing/parser.ml" +# 33735 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33743,12 +33763,12 @@ module Tables = struct let _v : (Parsetree.module_type option) = let x = # 183 "" ( x ) -# 33747 "parsing/parser.ml" +# 33767 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33752 "parsing/parser.ml" +# 33772 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33766,7 +33786,7 @@ module Tables = struct let _v : (Parsetree.pattern option) = # 114 "" ( None ) -# 33770 "parsing/parser.ml" +# 33790 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33798,12 +33818,12 @@ module Tables = struct let _v : (Parsetree.pattern option) = let x = # 183 "" ( x ) -# 33802 "parsing/parser.ml" +# 33822 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33807 "parsing/parser.ml" +# 33827 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33821,7 +33841,7 @@ module Tables = struct let _v : (Parsetree.expression option) = # 114 "" ( None ) -# 33825 "parsing/parser.ml" +# 33845 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33853,12 +33873,12 @@ module Tables = struct let _v : (Parsetree.expression option) = let x = # 183 "" ( x ) -# 33857 "parsing/parser.ml" +# 33877 "parsing/parser.ml" in # 116 "" ( Some x ) -# 33862 "parsing/parser.ml" +# 33882 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33876,7 +33896,7 @@ module Tables = struct let _v : (Parsetree.type_constraint option) = # 114 "" ( None ) -# 33880 "parsing/parser.ml" +# 33900 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33901,7 +33921,7 @@ module Tables = struct let _v : (Parsetree.type_constraint option) = # 116 "" ( Some x ) -# 33905 "parsing/parser.ml" +# 33925 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33922,7 +33942,7 @@ module Tables = struct let _1 : ( # 791 "parsing/parser.mly" (string) -# 33926 "parsing/parser.ml" +# 33946 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -33930,7 +33950,7 @@ module Tables = struct let _v : (string) = # 3972 "parsing/parser.mly" ( _1 ) -# 33934 "parsing/parser.ml" +# 33954 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33964,7 +33984,7 @@ module Tables = struct let _2 : ( # 774 "parsing/parser.mly" (string) -# 33968 "parsing/parser.ml" +# 33988 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -33973,7 +33993,7 @@ module Tables = struct let _v : (string) = # 3973 "parsing/parser.mly" ( _2 ) -# 33977 "parsing/parser.ml" +# 33997 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34029,7 +34049,7 @@ module Tables = struct # 1429 "parsing/parser.mly" ( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) ) -# 34033 "parsing/parser.ml" +# 34053 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34084,7 +34104,7 @@ module Tables = struct # 1431 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 34088 "parsing/parser.ml" +# 34108 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34123,7 +34143,7 @@ module Tables = struct let _v : (Parsetree.module_expr) = # 1434 "parsing/parser.mly" ( me (* TODO consider reloc *) ) -# 34127 "parsing/parser.ml" +# 34147 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34164,7 +34184,7 @@ module Tables = struct # 1436 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 34168 "parsing/parser.ml" +# 34188 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34220,18 +34240,18 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 34224 "parsing/parser.ml" +# 34244 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 34229 "parsing/parser.ml" +# 34249 "parsing/parser.ml" in # 1453 "parsing/parser.mly" ( e ) -# 34235 "parsing/parser.ml" +# 34255 "parsing/parser.ml" in let attrs = @@ -34239,7 +34259,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 34243 "parsing/parser.ml" +# 34263 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -34248,7 +34268,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 34252 "parsing/parser.ml" +# 34272 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34328,18 +34348,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 34332 "parsing/parser.ml" +# 34352 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 34337 "parsing/parser.ml" +# 34357 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 34343 "parsing/parser.ml" +# 34363 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -34350,13 +34370,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 34354 "parsing/parser.ml" +# 34374 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 34360 "parsing/parser.ml" +# 34380 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -34376,19 +34396,19 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 34380 "parsing/parser.ml" +# 34400 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 34386 "parsing/parser.ml" +# 34406 "parsing/parser.ml" in # 1453 "parsing/parser.mly" ( e ) -# 34392 "parsing/parser.ml" +# 34412 "parsing/parser.ml" in let attrs = @@ -34396,7 +34416,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 34400 "parsing/parser.ml" +# 34420 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -34405,7 +34425,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 34409 "parsing/parser.ml" +# 34429 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34481,7 +34501,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 34485 "parsing/parser.ml" +# 34505 "parsing/parser.ml" in let _endpos_ty_ = _endpos__1_inlined1_ in @@ -34489,12 +34509,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 34493 "parsing/parser.ml" +# 34513 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 34498 "parsing/parser.ml" +# 34518 "parsing/parser.ml" in let _startpos_e_ = _startpos__1_ in @@ -34504,7 +34524,7 @@ module Tables = struct # 1455 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) ) -# 34508 "parsing/parser.ml" +# 34528 "parsing/parser.ml" in let attrs = @@ -34512,7 +34532,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 34516 "parsing/parser.ml" +# 34536 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -34521,7 +34541,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 34525 "parsing/parser.ml" +# 34545 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34618,7 +34638,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 34622 "parsing/parser.ml" +# 34642 "parsing/parser.ml" in let _endpos_ty_ = _endpos__1_inlined3_ in @@ -34629,18 +34649,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 34633 "parsing/parser.ml" +# 34653 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 34638 "parsing/parser.ml" +# 34658 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 34644 "parsing/parser.ml" +# 34664 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -34651,13 +34671,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 34655 "parsing/parser.ml" +# 34675 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 34661 "parsing/parser.ml" +# 34681 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -34677,13 +34697,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 34681 "parsing/parser.ml" +# 34701 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 34687 "parsing/parser.ml" +# 34707 "parsing/parser.ml" in let _startpos_e_ = _startpos__1_ in @@ -34693,7 +34713,7 @@ module Tables = struct # 1455 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) ) -# 34697 "parsing/parser.ml" +# 34717 "parsing/parser.ml" in let attrs = @@ -34701,7 +34721,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 34705 "parsing/parser.ml" +# 34725 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -34710,7 +34730,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 34714 "parsing/parser.ml" +# 34734 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34800,7 +34820,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 34804 "parsing/parser.ml" +# 34824 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_inlined2_ in @@ -34814,19 +34834,19 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 34818 "parsing/parser.ml" +# 34838 "parsing/parser.ml" in let e = let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 34825 "parsing/parser.ml" +# 34845 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 34830 "parsing/parser.ml" +# 34850 "parsing/parser.ml" in let _startpos_e_ = _startpos__1_ in @@ -34836,7 +34856,7 @@ module Tables = struct # 1457 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) ) -# 34840 "parsing/parser.ml" +# 34860 "parsing/parser.ml" in let attrs = @@ -34844,7 +34864,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 34848 "parsing/parser.ml" +# 34868 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -34853,7 +34873,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 34857 "parsing/parser.ml" +# 34877 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34964,7 +34984,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 34968 "parsing/parser.ml" +# 34988 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_inlined4_ in @@ -34978,7 +34998,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 34982 "parsing/parser.ml" +# 35002 "parsing/parser.ml" in let e = @@ -34988,18 +35008,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 34992 "parsing/parser.ml" +# 35012 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 34997 "parsing/parser.ml" +# 35017 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 35003 "parsing/parser.ml" +# 35023 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -35010,13 +35030,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35014 "parsing/parser.ml" +# 35034 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 35020 "parsing/parser.ml" +# 35040 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -35036,13 +35056,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 35040 "parsing/parser.ml" +# 35060 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35046 "parsing/parser.ml" +# 35066 "parsing/parser.ml" in let _startpos_e_ = _startpos__1_ in @@ -35052,7 +35072,7 @@ module Tables = struct # 1457 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) ) -# 35056 "parsing/parser.ml" +# 35076 "parsing/parser.ml" in let attrs = @@ -35060,7 +35080,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35064 "parsing/parser.ml" +# 35084 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -35069,7 +35089,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 35073 "parsing/parser.ml" +# 35093 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35145,7 +35165,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 35149 "parsing/parser.ml" +# 35169 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_inlined1_ in @@ -35153,12 +35173,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 35157 "parsing/parser.ml" +# 35177 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35162 "parsing/parser.ml" +# 35182 "parsing/parser.ml" in let _startpos_e_ = _startpos__1_ in @@ -35168,7 +35188,7 @@ module Tables = struct # 1459 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) ) -# 35172 "parsing/parser.ml" +# 35192 "parsing/parser.ml" in let attrs = @@ -35176,7 +35196,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35180 "parsing/parser.ml" +# 35200 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -35185,7 +35205,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 35189 "parsing/parser.ml" +# 35209 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35282,7 +35302,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 35286 "parsing/parser.ml" +# 35306 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_inlined3_ in @@ -35293,18 +35313,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 35297 "parsing/parser.ml" +# 35317 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 35302 "parsing/parser.ml" +# 35322 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 35308 "parsing/parser.ml" +# 35328 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -35315,13 +35335,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35319 "parsing/parser.ml" +# 35339 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 35325 "parsing/parser.ml" +# 35345 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -35341,13 +35361,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 35345 "parsing/parser.ml" +# 35365 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35351 "parsing/parser.ml" +# 35371 "parsing/parser.ml" in let _startpos_e_ = _startpos__1_ in @@ -35357,7 +35377,7 @@ module Tables = struct # 1459 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) ) -# 35361 "parsing/parser.ml" +# 35381 "parsing/parser.ml" in let attrs = @@ -35365,7 +35385,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35369 "parsing/parser.ml" +# 35389 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -35374,7 +35394,7 @@ module Tables = struct # 1440 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 35378 "parsing/parser.ml" +# 35398 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35436,12 +35456,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 35440 "parsing/parser.ml" +# 35460 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35445 "parsing/parser.ml" +# 35465 "parsing/parser.ml" in let _3 = @@ -35449,7 +35469,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35453 "parsing/parser.ml" +# 35473 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in @@ -35457,7 +35477,7 @@ module Tables = struct # 1442 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 35461 "parsing/parser.ml" +# 35481 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35543,18 +35563,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 35547 "parsing/parser.ml" +# 35567 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 35552 "parsing/parser.ml" +# 35572 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 35558 "parsing/parser.ml" +# 35578 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -35565,13 +35585,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35569 "parsing/parser.ml" +# 35589 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 35575 "parsing/parser.ml" +# 35595 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -35591,13 +35611,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 35595 "parsing/parser.ml" +# 35615 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35601 "parsing/parser.ml" +# 35621 "parsing/parser.ml" in let _3 = @@ -35605,7 +35625,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35609 "parsing/parser.ml" +# 35629 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in @@ -35613,7 +35633,7 @@ module Tables = struct # 1442 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 35617 "parsing/parser.ml" +# 35637 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35675,12 +35695,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 35679 "parsing/parser.ml" +# 35699 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35684 "parsing/parser.ml" +# 35704 "parsing/parser.ml" in let _3 = @@ -35688,7 +35708,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35692 "parsing/parser.ml" +# 35712 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in @@ -35696,7 +35716,7 @@ module Tables = struct # 1444 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 35700 "parsing/parser.ml" +# 35720 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35782,18 +35802,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 35786 "parsing/parser.ml" +# 35806 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 35791 "parsing/parser.ml" +# 35811 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 35797 "parsing/parser.ml" +# 35817 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -35804,13 +35824,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35808 "parsing/parser.ml" +# 35828 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 35814 "parsing/parser.ml" +# 35834 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -35830,13 +35850,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 35834 "parsing/parser.ml" +# 35854 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35840 "parsing/parser.ml" +# 35860 "parsing/parser.ml" in let _3 = @@ -35844,7 +35864,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35848 "parsing/parser.ml" +# 35868 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in @@ -35852,7 +35872,7 @@ module Tables = struct # 1444 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 35856 "parsing/parser.ml" +# 35876 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35907,12 +35927,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 35911 "parsing/parser.ml" +# 35931 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 35916 "parsing/parser.ml" +# 35936 "parsing/parser.ml" in let _3 = @@ -35920,7 +35940,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 35924 "parsing/parser.ml" +# 35944 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in @@ -35928,7 +35948,7 @@ module Tables = struct # 1446 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 35932 "parsing/parser.ml" +# 35952 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36007,18 +36027,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 36011 "parsing/parser.ml" +# 36031 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 36016 "parsing/parser.ml" +# 36036 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 36022 "parsing/parser.ml" +# 36042 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -36029,13 +36049,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 36033 "parsing/parser.ml" +# 36053 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 36039 "parsing/parser.ml" +# 36059 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -36055,13 +36075,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 36059 "parsing/parser.ml" +# 36079 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 36065 "parsing/parser.ml" +# 36085 "parsing/parser.ml" in let _3 = @@ -36069,7 +36089,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 36073 "parsing/parser.ml" +# 36093 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in @@ -36077,7 +36097,7 @@ module Tables = struct # 1446 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 36081 "parsing/parser.ml" +# 36101 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36109,7 +36129,7 @@ module Tables = struct let _v : (Longident.t) = # 1347 "parsing/parser.mly" ( _1 ) -# 36113 "parsing/parser.ml" +# 36133 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36141,7 +36161,7 @@ module Tables = struct let _v : (Longident.t) = # 1332 "parsing/parser.mly" ( _1 ) -# 36145 "parsing/parser.ml" +# 36165 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36173,7 +36193,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 1307 "parsing/parser.mly" ( _1 ) -# 36177 "parsing/parser.ml" +# 36197 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36205,7 +36225,7 @@ module Tables = struct let _v : (Parsetree.expression) = # 1312 "parsing/parser.mly" ( _1 ) -# 36209 "parsing/parser.ml" +# 36229 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36237,7 +36257,7 @@ module Tables = struct let _v : (Longident.t) = # 1337 "parsing/parser.mly" ( _1 ) -# 36241 "parsing/parser.ml" +# 36261 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36269,7 +36289,7 @@ module Tables = struct let _v : (Longident.t) = # 1342 "parsing/parser.mly" ( _1 ) -# 36273 "parsing/parser.ml" +# 36293 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36301,7 +36321,7 @@ module Tables = struct let _v : (Parsetree.module_expr) = # 1302 "parsing/parser.mly" ( _1 ) -# 36305 "parsing/parser.ml" +# 36325 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36333,7 +36353,7 @@ module Tables = struct let _v : (Parsetree.module_type) = # 1297 "parsing/parser.mly" ( _1 ) -# 36337 "parsing/parser.ml" +# 36357 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36365,7 +36385,7 @@ module Tables = struct let _v : (Longident.t) = # 1322 "parsing/parser.mly" ( _1 ) -# 36369 "parsing/parser.ml" +# 36389 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36397,7 +36417,7 @@ module Tables = struct let _v : (Parsetree.pattern) = # 1317 "parsing/parser.mly" ( _1 ) -# 36401 "parsing/parser.ml" +# 36421 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36429,7 +36449,7 @@ module Tables = struct let _v : (Longident.t) = # 1327 "parsing/parser.mly" ( _1 ) -# 36433 "parsing/parser.ml" +# 36453 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36473,13 +36493,13 @@ module Tables = struct # 2872 "parsing/parser.mly" ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) ) -# 36477 "parsing/parser.ml" +# 36497 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36483 "parsing/parser.ml" +# 36503 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36511,12 +36531,12 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = # 2874 "parsing/parser.mly" ( Pat.attr _1 _2 ) -# 36515 "parsing/parser.ml" +# 36535 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36520 "parsing/parser.ml" +# 36540 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36541,12 +36561,12 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = # 2876 "parsing/parser.mly" ( _1 ) -# 36545 "parsing/parser.ml" +# 36565 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36550 "parsing/parser.ml" +# 36570 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36593,13 +36613,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36597 "parsing/parser.ml" +# 36617 "parsing/parser.ml" in # 2879 "parsing/parser.mly" ( Ppat_alias(_1, _3) ) -# 36603 "parsing/parser.ml" +# 36623 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -36609,19 +36629,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 36613 "parsing/parser.ml" +# 36633 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 36619 "parsing/parser.ml" +# 36639 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36625 "parsing/parser.ml" +# 36645 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36664,7 +36684,7 @@ module Tables = struct # 2881 "parsing/parser.mly" ( expecting _loc__3_ "identifier" ) -# 36668 "parsing/parser.ml" +# 36688 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36674,19 +36694,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 36678 "parsing/parser.ml" +# 36698 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 36684 "parsing/parser.ml" +# 36704 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36690 "parsing/parser.ml" +# 36710 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36713,7 +36733,7 @@ module Tables = struct let _1 = # 2883 "parsing/parser.mly" ( Ppat_tuple(List.rev _1) ) -# 36717 "parsing/parser.ml" +# 36737 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -36721,19 +36741,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 36725 "parsing/parser.ml" +# 36745 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 36731 "parsing/parser.ml" +# 36751 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36737 "parsing/parser.ml" +# 36757 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36776,7 +36796,7 @@ module Tables = struct # 2885 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 36780 "parsing/parser.ml" +# 36800 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36786,19 +36806,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 36790 "parsing/parser.ml" +# 36810 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 36796 "parsing/parser.ml" +# 36816 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36802 "parsing/parser.ml" +# 36822 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36839,7 +36859,7 @@ module Tables = struct let _1 = # 2887 "parsing/parser.mly" ( Ppat_or(_1, _3) ) -# 36843 "parsing/parser.ml" +# 36863 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -36848,19 +36868,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 36852 "parsing/parser.ml" +# 36872 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 36858 "parsing/parser.ml" +# 36878 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36864 "parsing/parser.ml" +# 36884 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36903,7 +36923,7 @@ module Tables = struct # 2889 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 36907 "parsing/parser.ml" +# 36927 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36913,19 +36933,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 36917 "parsing/parser.ml" +# 36937 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 36923 "parsing/parser.ml" +# 36943 "parsing/parser.ml" in # 2860 "parsing/parser.mly" ( _1 ) -# 36929 "parsing/parser.ml" +# 36949 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36975,13 +36995,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 36979 "parsing/parser.ml" +# 36999 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 36985 "parsing/parser.ml" +# 37005 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -36990,7 +37010,7 @@ module Tables = struct # 2862 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2) -# 36994 "parsing/parser.ml" +# 37014 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37029,7 +37049,7 @@ module Tables = struct let _v : (Parsetree.pattern list) = # 2989 "parsing/parser.mly" ( _3 :: _1 ) -# 37033 "parsing/parser.ml" +# 37053 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37068,7 +37088,7 @@ module Tables = struct let _v : (Parsetree.pattern list) = # 2990 "parsing/parser.mly" ( [_3; _1] ) -# 37072 "parsing/parser.ml" +# 37092 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37108,7 +37128,7 @@ module Tables = struct # 2991 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 37112 "parsing/parser.ml" +# 37132 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37147,7 +37167,7 @@ module Tables = struct let _v : (Parsetree.pattern list) = # 2989 "parsing/parser.mly" ( _3 :: _1 ) -# 37151 "parsing/parser.ml" +# 37171 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37186,7 +37206,7 @@ module Tables = struct let _v : (Parsetree.pattern list) = # 2990 "parsing/parser.mly" ( [_3; _1] ) -# 37190 "parsing/parser.ml" +# 37210 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37226,7 +37246,7 @@ module Tables = struct # 2991 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 37230 "parsing/parser.ml" +# 37250 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37251,7 +37271,7 @@ module Tables = struct let _v : (Parsetree.pattern) = # 2895 "parsing/parser.mly" ( _1 ) -# 37255 "parsing/parser.ml" +# 37275 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37289,13 +37309,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37293 "parsing/parser.ml" +# 37313 "parsing/parser.ml" in # 2898 "parsing/parser.mly" ( Ppat_construct(_1, Some ([], _2)) ) -# 37299 "parsing/parser.ml" +# 37319 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -37305,13 +37325,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37309 "parsing/parser.ml" +# 37329 "parsing/parser.ml" in # 2904 "parsing/parser.mly" ( _1 ) -# 37315 "parsing/parser.ml" +# 37335 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37373,7 +37393,7 @@ module Tables = struct let newtypes = # 2633 "parsing/parser.mly" ( xs ) -# 37377 "parsing/parser.ml" +# 37397 "parsing/parser.ml" in let constr = let _endpos = _endpos__1_ in @@ -37382,13 +37402,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37386 "parsing/parser.ml" +# 37406 "parsing/parser.ml" in # 2901 "parsing/parser.mly" ( Ppat_construct(constr, Some (newtypes, pat)) ) -# 37392 "parsing/parser.ml" +# 37412 "parsing/parser.ml" in let _endpos__1_ = _endpos_pat_ in @@ -37398,13 +37418,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37402 "parsing/parser.ml" +# 37422 "parsing/parser.ml" in # 2904 "parsing/parser.mly" ( _1 ) -# 37408 "parsing/parser.ml" +# 37428 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37437,7 +37457,7 @@ module Tables = struct let _1 = # 2903 "parsing/parser.mly" ( Ppat_variant(_1, Some _2) ) -# 37441 "parsing/parser.ml" +# 37461 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -37446,13 +37466,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37450 "parsing/parser.ml" +# 37470 "parsing/parser.ml" in # 2904 "parsing/parser.mly" ( _1 ) -# 37456 "parsing/parser.ml" +# 37476 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37502,13 +37522,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 37506 "parsing/parser.ml" +# 37526 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 37512 "parsing/parser.ml" +# 37532 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -37517,7 +37537,7 @@ module Tables = struct # 2906 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2) -# 37521 "parsing/parser.ml" +# 37541 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37561,13 +37581,13 @@ module Tables = struct # 2872 "parsing/parser.mly" ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) ) -# 37565 "parsing/parser.ml" +# 37585 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37571 "parsing/parser.ml" +# 37591 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37599,12 +37619,12 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = # 2874 "parsing/parser.mly" ( Pat.attr _1 _2 ) -# 37603 "parsing/parser.ml" +# 37623 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37608 "parsing/parser.ml" +# 37628 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37629,12 +37649,12 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = # 2876 "parsing/parser.mly" ( _1 ) -# 37633 "parsing/parser.ml" +# 37653 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37638 "parsing/parser.ml" +# 37658 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37681,13 +37701,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37685 "parsing/parser.ml" +# 37705 "parsing/parser.ml" in # 2879 "parsing/parser.mly" ( Ppat_alias(_1, _3) ) -# 37691 "parsing/parser.ml" +# 37711 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -37697,19 +37717,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37701 "parsing/parser.ml" +# 37721 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 37707 "parsing/parser.ml" +# 37727 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37713 "parsing/parser.ml" +# 37733 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37752,7 +37772,7 @@ module Tables = struct # 2881 "parsing/parser.mly" ( expecting _loc__3_ "identifier" ) -# 37756 "parsing/parser.ml" +# 37776 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37762,19 +37782,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37766 "parsing/parser.ml" +# 37786 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 37772 "parsing/parser.ml" +# 37792 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37778 "parsing/parser.ml" +# 37798 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37801,7 +37821,7 @@ module Tables = struct let _1 = # 2883 "parsing/parser.mly" ( Ppat_tuple(List.rev _1) ) -# 37805 "parsing/parser.ml" +# 37825 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -37809,19 +37829,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37813 "parsing/parser.ml" +# 37833 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 37819 "parsing/parser.ml" +# 37839 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37825 "parsing/parser.ml" +# 37845 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37864,7 +37884,7 @@ module Tables = struct # 2885 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 37868 "parsing/parser.ml" +# 37888 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37874,19 +37894,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37878 "parsing/parser.ml" +# 37898 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 37884 "parsing/parser.ml" +# 37904 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37890 "parsing/parser.ml" +# 37910 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37927,7 +37947,7 @@ module Tables = struct let _1 = # 2887 "parsing/parser.mly" ( Ppat_or(_1, _3) ) -# 37931 "parsing/parser.ml" +# 37951 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -37936,19 +37956,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37940 "parsing/parser.ml" +# 37960 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 37946 "parsing/parser.ml" +# 37966 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 37952 "parsing/parser.ml" +# 37972 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37991,7 +38011,7 @@ module Tables = struct # 2889 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 37995 "parsing/parser.ml" +# 38015 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -38001,19 +38021,19 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38005 "parsing/parser.ml" +# 38025 "parsing/parser.ml" in # 2890 "parsing/parser.mly" ( _1 ) -# 38011 "parsing/parser.ml" +# 38031 "parsing/parser.ml" in # 2867 "parsing/parser.mly" ( _1 ) -# 38017 "parsing/parser.ml" +# 38037 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38034,7 +38054,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 38038 "parsing/parser.ml" +# 38058 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -38048,13 +38068,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38052 "parsing/parser.ml" +# 38072 "parsing/parser.ml" in # 2344 "parsing/parser.mly" ( Ppat_var _1 ) -# 38058 "parsing/parser.ml" +# 38078 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -38063,13 +38083,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38067 "parsing/parser.ml" +# 38087 "parsing/parser.ml" in # 2346 "parsing/parser.mly" ( _1 ) -# 38073 "parsing/parser.ml" +# 38093 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38095,7 +38115,7 @@ module Tables = struct let _1 = # 2345 "parsing/parser.mly" ( Ppat_any ) -# 38099 "parsing/parser.ml" +# 38119 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -38103,13 +38123,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38107 "parsing/parser.ml" +# 38127 "parsing/parser.ml" in # 2346 "parsing/parser.mly" ( _1 ) -# 38113 "parsing/parser.ml" +# 38133 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38134,7 +38154,7 @@ module Tables = struct let _v : (Parsetree.payload) = # 4084 "parsing/parser.mly" ( PStr _1 ) -# 38138 "parsing/parser.ml" +# 38158 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38166,7 +38186,7 @@ module Tables = struct let _v : (Parsetree.payload) = # 4085 "parsing/parser.mly" ( PSig _2 ) -# 38170 "parsing/parser.ml" +# 38190 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38198,7 +38218,7 @@ module Tables = struct let _v : (Parsetree.payload) = # 4086 "parsing/parser.mly" ( PTyp _2 ) -# 38202 "parsing/parser.ml" +# 38222 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38230,7 +38250,7 @@ module Tables = struct let _v : (Parsetree.payload) = # 4087 "parsing/parser.mly" ( PPat (_2, None) ) -# 38234 "parsing/parser.ml" +# 38254 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38276,7 +38296,7 @@ module Tables = struct let _v : (Parsetree.payload) = # 4088 "parsing/parser.mly" ( PPat (_2, Some _4) ) -# 38280 "parsing/parser.ml" +# 38300 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38301,7 +38321,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3425 "parsing/parser.mly" ( _1 ) -# 38305 "parsing/parser.ml" +# 38325 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38344,24 +38364,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 38348 "parsing/parser.ml" +# 38368 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 38353 "parsing/parser.ml" +# 38373 "parsing/parser.ml" in # 3417 "parsing/parser.mly" ( _1 ) -# 38359 "parsing/parser.ml" +# 38379 "parsing/parser.ml" in # 3421 "parsing/parser.mly" ( Ptyp_poly(_1, _3) ) -# 38365 "parsing/parser.ml" +# 38385 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in @@ -38371,13 +38391,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 38375 "parsing/parser.ml" +# 38395 "parsing/parser.ml" in # 3427 "parsing/parser.mly" ( _1 ) -# 38381 "parsing/parser.ml" +# 38401 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38402,12 +38422,12 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = # 3456 "parsing/parser.mly" ( _1 ) -# 38406 "parsing/parser.ml" +# 38426 "parsing/parser.ml" in # 3425 "parsing/parser.mly" ( _1 ) -# 38411 "parsing/parser.ml" +# 38431 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38448,31 +38468,31 @@ module Tables = struct let _3 = # 3456 "parsing/parser.mly" ( _1 ) -# 38452 "parsing/parser.ml" +# 38472 "parsing/parser.ml" in let _1 = let _1 = let xs = # 253 "" ( List.rev xs ) -# 38459 "parsing/parser.ml" +# 38479 "parsing/parser.ml" in # 1058 "parsing/parser.mly" ( xs ) -# 38464 "parsing/parser.ml" +# 38484 "parsing/parser.ml" in # 3417 "parsing/parser.mly" ( _1 ) -# 38470 "parsing/parser.ml" +# 38490 "parsing/parser.ml" in # 3421 "parsing/parser.mly" ( Ptyp_poly(_1, _3) ) -# 38476 "parsing/parser.ml" +# 38496 "parsing/parser.ml" in let _startpos__1_ = _startpos_xs_ in @@ -38482,13 +38502,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 38486 "parsing/parser.ml" +# 38506 "parsing/parser.ml" in # 3427 "parsing/parser.mly" ( _1 ) -# 38492 "parsing/parser.ml" +# 38512 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38537,7 +38557,7 @@ module Tables = struct # 4045 "parsing/parser.mly" ( Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 38541 "parsing/parser.ml" +# 38561 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38620,7 +38640,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 38624 "parsing/parser.ml" +# 38644 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -38632,7 +38652,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38636 "parsing/parser.ml" +# 38656 "parsing/parser.ml" in let attrs1 = @@ -38640,7 +38660,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 38644 "parsing/parser.ml" +# 38664 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -38653,7 +38673,7 @@ module Tables = struct let docs = symbol_docs _sloc in Val.mk id ty ~prim ~attrs ~loc ~docs, ext ) -# 38657 "parsing/parser.ml" +# 38677 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38671,12 +38691,12 @@ module Tables = struct let _v : (Asttypes.private_flag) = let _1 = # 3913 "parsing/parser.mly" ( Public ) -# 38675 "parsing/parser.ml" +# 38695 "parsing/parser.ml" in # 3910 "parsing/parser.mly" ( _1 ) -# 38680 "parsing/parser.ml" +# 38700 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38701,12 +38721,12 @@ module Tables = struct let _v : (Asttypes.private_flag) = let _1 = # 3914 "parsing/parser.mly" ( Private ) -# 38705 "parsing/parser.ml" +# 38725 "parsing/parser.ml" in # 3910 "parsing/parser.mly" ( _1 ) -# 38710 "parsing/parser.ml" +# 38730 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38724,7 +38744,7 @@ module Tables = struct let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = # 3936 "parsing/parser.mly" ( Public, Concrete ) -# 38728 "parsing/parser.ml" +# 38748 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38749,7 +38769,7 @@ module Tables = struct let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = # 3937 "parsing/parser.mly" ( Private, Concrete ) -# 38753 "parsing/parser.ml" +# 38773 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38774,7 +38794,7 @@ module Tables = struct let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = # 3938 "parsing/parser.mly" ( Public, Virtual ) -# 38778 "parsing/parser.ml" +# 38798 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38806,7 +38826,7 @@ module Tables = struct let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = # 3939 "parsing/parser.mly" ( Private, Virtual ) -# 38810 "parsing/parser.ml" +# 38830 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38838,7 +38858,7 @@ module Tables = struct let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = # 3940 "parsing/parser.mly" ( Private, Virtual ) -# 38842 "parsing/parser.ml" +# 38862 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38856,7 +38876,7 @@ module Tables = struct let _v : (Asttypes.rec_flag) = # 3891 "parsing/parser.mly" ( Nonrecursive ) -# 38860 "parsing/parser.ml" +# 38880 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38881,7 +38901,7 @@ module Tables = struct let _v : (Asttypes.rec_flag) = # 3892 "parsing/parser.mly" ( Recursive ) -# 38885 "parsing/parser.ml" +# 38905 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38907,12 +38927,12 @@ module Tables = struct (Longident.t Asttypes.loc * Parsetree.expression) list) = let eo = # 124 "" ( None ) -# 38911 "parsing/parser.ml" +# 38931 "parsing/parser.ml" in # 2792 "parsing/parser.mly" ( eo, fields ) -# 38916 "parsing/parser.ml" +# 38936 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38953,18 +38973,18 @@ module Tables = struct let x = # 191 "" ( x ) -# 38957 "parsing/parser.ml" +# 38977 "parsing/parser.ml" in # 126 "" ( Some x ) -# 38962 "parsing/parser.ml" +# 38982 "parsing/parser.ml" in # 2792 "parsing/parser.mly" ( eo, fields ) -# 38968 "parsing/parser.ml" +# 38988 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38994,12 +39014,12 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info ) -# 38998 "parsing/parser.ml" +# 39018 "parsing/parser.ml" in # 1189 "parsing/parser.mly" ( [x] ) -# 39003 "parsing/parser.ml" +# 39023 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39029,12 +39049,12 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39033 "parsing/parser.ml" +# 39053 "parsing/parser.ml" in # 1192 "parsing/parser.mly" ( [x] ) -# 39038 "parsing/parser.ml" +# 39058 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39071,12 +39091,12 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39075 "parsing/parser.ml" +# 39095 "parsing/parser.ml" in # 1196 "parsing/parser.mly" ( x :: xs ) -# 39080 "parsing/parser.ml" +# 39100 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39107,18 +39127,18 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Te.decl cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39111 "parsing/parser.ml" +# 39131 "parsing/parser.ml" in # 3349 "parsing/parser.mly" ( _1 ) -# 39116 "parsing/parser.ml" +# 39136 "parsing/parser.ml" in # 1189 "parsing/parser.mly" ( [x] ) -# 39122 "parsing/parser.ml" +# 39142 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39143,12 +39163,12 @@ module Tables = struct let _v : (Parsetree.extension_constructor list) = let x = # 3351 "parsing/parser.mly" ( _1 ) -# 39147 "parsing/parser.ml" +# 39167 "parsing/parser.ml" in # 1189 "parsing/parser.mly" ( [x] ) -# 39152 "parsing/parser.ml" +# 39172 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39179,18 +39199,18 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Te.decl cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39183 "parsing/parser.ml" +# 39203 "parsing/parser.ml" in # 3349 "parsing/parser.mly" ( _1 ) -# 39188 "parsing/parser.ml" +# 39208 "parsing/parser.ml" in # 1192 "parsing/parser.mly" ( [x] ) -# 39194 "parsing/parser.ml" +# 39214 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39215,12 +39235,12 @@ module Tables = struct let _v : (Parsetree.extension_constructor list) = let x = # 3351 "parsing/parser.mly" ( _1 ) -# 39219 "parsing/parser.ml" +# 39239 "parsing/parser.ml" in # 1192 "parsing/parser.mly" ( [x] ) -# 39224 "parsing/parser.ml" +# 39244 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39258,18 +39278,18 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Te.decl cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39262 "parsing/parser.ml" +# 39282 "parsing/parser.ml" in # 3349 "parsing/parser.mly" ( _1 ) -# 39267 "parsing/parser.ml" +# 39287 "parsing/parser.ml" in # 1196 "parsing/parser.mly" ( x :: xs ) -# 39273 "parsing/parser.ml" +# 39293 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39301,12 +39321,12 @@ module Tables = struct let _v : (Parsetree.extension_constructor list) = let x = # 3351 "parsing/parser.mly" ( _1 ) -# 39305 "parsing/parser.ml" +# 39325 "parsing/parser.ml" in # 1196 "parsing/parser.mly" ( x :: xs ) -# 39310 "parsing/parser.ml" +# 39330 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39336,12 +39356,12 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Te.decl cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39340 "parsing/parser.ml" +# 39360 "parsing/parser.ml" in # 1189 "parsing/parser.mly" ( [x] ) -# 39345 "parsing/parser.ml" +# 39365 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39371,12 +39391,12 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Te.decl cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39375 "parsing/parser.ml" +# 39395 "parsing/parser.ml" in # 1192 "parsing/parser.mly" ( [x] ) -# 39380 "parsing/parser.ml" +# 39400 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39413,12 +39433,12 @@ module Tables = struct let cid, vars, args, res, attrs, loc, info = d in Te.decl cid ~vars ~args ?res ~attrs ~loc ~info ) -# 39417 "parsing/parser.ml" +# 39437 "parsing/parser.ml" in # 1196 "parsing/parser.mly" ( x :: xs ) -# 39422 "parsing/parser.ml" +# 39442 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39436,7 +39456,7 @@ module Tables = struct let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = # 1034 "parsing/parser.mly" ( [] ) -# 39440 "parsing/parser.ml" +# 39460 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39495,19 +39515,19 @@ module Tables = struct # 2193 "parsing/parser.mly" ( _1, _3, make_loc _sloc ) -# 39499 "parsing/parser.ml" +# 39519 "parsing/parser.ml" in # 183 "" ( x ) -# 39505 "parsing/parser.ml" +# 39525 "parsing/parser.ml" in # 1036 "parsing/parser.mly" ( x :: xs ) -# 39511 "parsing/parser.ml" +# 39531 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39532,7 +39552,7 @@ module Tables = struct let _v : (Parsetree.function_param list) = # 1067 "parsing/parser.mly" ( List.rev x ) -# 39536 "parsing/parser.ml" +# 39556 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39564,7 +39584,7 @@ module Tables = struct let _v : (Parsetree.function_param list) = # 1069 "parsing/parser.mly" ( List.rev_append x xs ) -# 39568 "parsing/parser.ml" +# 39588 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39589,7 +39609,7 @@ module Tables = struct let _v : ((Lexing.position * Parsetree.functor_parameter) list) = # 1048 "parsing/parser.mly" ( [ x ] ) -# 39593 "parsing/parser.ml" +# 39613 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39621,7 +39641,7 @@ module Tables = struct let _v : ((Lexing.position * Parsetree.functor_parameter) list) = # 1050 "parsing/parser.mly" ( x :: xs ) -# 39625 "parsing/parser.ml" +# 39645 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39646,7 +39666,7 @@ module Tables = struct let _v : ((Asttypes.arg_label * Parsetree.expression) list) = # 1048 "parsing/parser.mly" ( [ x ] ) -# 39650 "parsing/parser.ml" +# 39670 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39678,7 +39698,7 @@ module Tables = struct let _v : ((Asttypes.arg_label * Parsetree.expression) list) = # 1050 "parsing/parser.mly" ( x :: xs ) -# 39682 "parsing/parser.ml" +# 39702 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39703,7 +39723,7 @@ module Tables = struct let _v : (Asttypes.label list) = # 1048 "parsing/parser.mly" ( [ x ] ) -# 39707 "parsing/parser.ml" +# 39727 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39735,7 +39755,7 @@ module Tables = struct let _v : (Asttypes.label list) = # 1050 "parsing/parser.mly" ( x :: xs ) -# 39739 "parsing/parser.ml" +# 39759 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39773,19 +39793,19 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 39777 "parsing/parser.ml" +# 39797 "parsing/parser.ml" in # 3413 "parsing/parser.mly" ( _2 ) -# 39783 "parsing/parser.ml" +# 39803 "parsing/parser.ml" in # 1048 "parsing/parser.mly" ( [ x ] ) -# 39789 "parsing/parser.ml" +# 39809 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39830,19 +39850,19 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 39834 "parsing/parser.ml" +# 39854 "parsing/parser.ml" in # 3413 "parsing/parser.mly" ( _2 ) -# 39840 "parsing/parser.ml" +# 39860 "parsing/parser.ml" in # 1050 "parsing/parser.mly" ( x :: xs ) -# 39846 "parsing/parser.ml" +# 39866 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39867,12 +39887,12 @@ module Tables = struct let _v : (Parsetree.case list) = let _1 = # 124 "" ( None ) -# 39871 "parsing/parser.ml" +# 39891 "parsing/parser.ml" in # 1160 "parsing/parser.mly" ( [x] ) -# 39876 "parsing/parser.ml" +# 39896 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39906,13 +39926,13 @@ module Tables = struct # 126 "" ( Some x ) -# 39910 "parsing/parser.ml" +# 39930 "parsing/parser.ml" in # 1160 "parsing/parser.mly" ( [x] ) -# 39916 "parsing/parser.ml" +# 39936 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39951,7 +39971,7 @@ module Tables = struct let _v : (Parsetree.case list) = # 1164 "parsing/parser.mly" ( x :: xs ) -# 39955 "parsing/parser.ml" +# 39975 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39977,18 +39997,18 @@ module Tables = struct let x = # 3456 "parsing/parser.mly" ( _1 ) -# 39981 "parsing/parser.ml" +# 40001 "parsing/parser.ml" in # 1095 "parsing/parser.mly" ( [ x ] ) -# 39986 "parsing/parser.ml" +# 40006 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 39992 "parsing/parser.ml" +# 40012 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40028,18 +40048,18 @@ module Tables = struct let x = # 3456 "parsing/parser.mly" ( _1 ) -# 40032 "parsing/parser.ml" +# 40052 "parsing/parser.ml" in # 1099 "parsing/parser.mly" ( x :: xs ) -# 40037 "parsing/parser.ml" +# 40057 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40043 "parsing/parser.ml" +# 40063 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40064,12 +40084,12 @@ module Tables = struct let _v : (Parsetree.with_constraint list) = let xs = # 1095 "parsing/parser.mly" ( [ x ] ) -# 40068 "parsing/parser.ml" +# 40088 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40073 "parsing/parser.ml" +# 40093 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40108,12 +40128,12 @@ module Tables = struct let _v : (Parsetree.with_constraint list) = let xs = # 1099 "parsing/parser.mly" ( x :: xs ) -# 40112 "parsing/parser.ml" +# 40132 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40117 "parsing/parser.ml" +# 40137 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40138,12 +40158,12 @@ module Tables = struct let _v : (Parsetree.row_field list) = let xs = # 1095 "parsing/parser.mly" ( [ x ] ) -# 40142 "parsing/parser.ml" +# 40162 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40147 "parsing/parser.ml" +# 40167 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40182,12 +40202,12 @@ module Tables = struct let _v : (Parsetree.row_field list) = let xs = # 1099 "parsing/parser.mly" ( x :: xs ) -# 40186 "parsing/parser.ml" +# 40206 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40191 "parsing/parser.ml" +# 40211 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40212,12 +40232,12 @@ module Tables = struct let _v : (Parsetree.core_type list) = let xs = # 1095 "parsing/parser.mly" ( [ x ] ) -# 40216 "parsing/parser.ml" +# 40236 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40221 "parsing/parser.ml" +# 40241 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40256,12 +40276,12 @@ module Tables = struct let _v : (Parsetree.core_type list) = let xs = # 1099 "parsing/parser.mly" ( x :: xs ) -# 40260 "parsing/parser.ml" +# 40280 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40265 "parsing/parser.ml" +# 40285 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40286,12 +40306,12 @@ module Tables = struct let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs = # 1095 "parsing/parser.mly" ( [ x ] ) -# 40290 "parsing/parser.ml" +# 40310 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40295 "parsing/parser.ml" +# 40315 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40330,12 +40350,12 @@ module Tables = struct let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs = # 1099 "parsing/parser.mly" ( x :: xs ) -# 40334 "parsing/parser.ml" +# 40354 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40339 "parsing/parser.ml" +# 40359 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40360,12 +40380,12 @@ module Tables = struct let _v : (Parsetree.core_type list) = let xs = # 1095 "parsing/parser.mly" ( [ x ] ) -# 40364 "parsing/parser.ml" +# 40384 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40369 "parsing/parser.ml" +# 40389 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40404,12 +40424,12 @@ module Tables = struct let _v : (Parsetree.core_type list) = let xs = # 1099 "parsing/parser.mly" ( x :: xs ) -# 40408 "parsing/parser.ml" +# 40428 "parsing/parser.ml" in # 1103 "parsing/parser.mly" ( xs ) -# 40413 "parsing/parser.ml" +# 40433 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40448,7 +40468,7 @@ module Tables = struct let _v : (Parsetree.core_type list) = # 1126 "parsing/parser.mly" ( x :: xs ) -# 40452 "parsing/parser.ml" +# 40472 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40487,7 +40507,7 @@ module Tables = struct let _v : (Parsetree.core_type list) = # 1130 "parsing/parser.mly" ( [ x2; x1 ] ) -# 40491 "parsing/parser.ml" +# 40511 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40527,18 +40547,18 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 40531 "parsing/parser.ml" +# 40551 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40536 "parsing/parser.ml" +# 40556 "parsing/parser.ml" in # 1126 "parsing/parser.mly" ( x :: xs ) -# 40542 "parsing/parser.ml" +# 40562 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40603,18 +40623,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 40607 "parsing/parser.ml" +# 40627 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 40612 "parsing/parser.ml" +# 40632 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 40618 "parsing/parser.ml" +# 40638 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -40625,13 +40645,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 40629 "parsing/parser.ml" +# 40649 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 40635 "parsing/parser.ml" +# 40655 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -40651,19 +40671,19 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 40655 "parsing/parser.ml" +# 40675 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40661 "parsing/parser.ml" +# 40681 "parsing/parser.ml" in # 1126 "parsing/parser.mly" ( x :: xs ) -# 40667 "parsing/parser.ml" +# 40687 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40704,30 +40724,30 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 40708 "parsing/parser.ml" +# 40728 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40713 "parsing/parser.ml" +# 40733 "parsing/parser.ml" in let x1 = let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 40720 "parsing/parser.ml" +# 40740 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40725 "parsing/parser.ml" +# 40745 "parsing/parser.ml" in # 1130 "parsing/parser.mly" ( [ x2; x1 ] ) -# 40731 "parsing/parser.ml" +# 40751 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40792,18 +40812,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 40796 "parsing/parser.ml" +# 40816 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 40801 "parsing/parser.ml" +# 40821 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 40807 "parsing/parser.ml" +# 40827 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -40814,13 +40834,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 40818 "parsing/parser.ml" +# 40838 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 40824 "parsing/parser.ml" +# 40844 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -40840,31 +40860,31 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 40844 "parsing/parser.ml" +# 40864 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40850 "parsing/parser.ml" +# 40870 "parsing/parser.ml" in let x1 = let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 40857 "parsing/parser.ml" +# 40877 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40862 "parsing/parser.ml" +# 40882 "parsing/parser.ml" in # 1130 "parsing/parser.mly" ( [ x2; x1 ] ) -# 40868 "parsing/parser.ml" +# 40888 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40926,12 +40946,12 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 40930 "parsing/parser.ml" +# 40950 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40935 "parsing/parser.ml" +# 40955 "parsing/parser.ml" in let x1 = @@ -40941,18 +40961,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 40945 "parsing/parser.ml" +# 40965 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 40950 "parsing/parser.ml" +# 40970 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 40956 "parsing/parser.ml" +# 40976 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -40963,13 +40983,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 40967 "parsing/parser.ml" +# 40987 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 40973 "parsing/parser.ml" +# 40993 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -40989,19 +41009,19 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 40993 "parsing/parser.ml" +# 41013 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 40999 "parsing/parser.ml" +# 41019 "parsing/parser.ml" in # 1130 "parsing/parser.mly" ( [ x2; x1 ] ) -# 41005 "parsing/parser.ml" +# 41025 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41087,18 +41107,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 41091 "parsing/parser.ml" +# 41111 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 41096 "parsing/parser.ml" +# 41116 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 41102 "parsing/parser.ml" +# 41122 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -41109,13 +41129,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 41113 "parsing/parser.ml" +# 41133 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 41119 "parsing/parser.ml" +# 41139 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -41135,13 +41155,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 41139 "parsing/parser.ml" +# 41159 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41145 "parsing/parser.ml" +# 41165 "parsing/parser.ml" in let x1 = @@ -41151,18 +41171,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 41155 "parsing/parser.ml" +# 41175 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 41160 "parsing/parser.ml" +# 41180 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 41166 "parsing/parser.ml" +# 41186 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -41173,13 +41193,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 41177 "parsing/parser.ml" +# 41197 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 41183 "parsing/parser.ml" +# 41203 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -41199,19 +41219,19 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 41203 "parsing/parser.ml" +# 41223 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41209 "parsing/parser.ml" +# 41229 "parsing/parser.ml" in # 1130 "parsing/parser.mly" ( [ x2; x1 ] ) -# 41215 "parsing/parser.ml" +# 41235 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41250,7 +41270,7 @@ module Tables = struct let _v : (Parsetree.core_type list) = # 1126 "parsing/parser.mly" ( x :: xs ) -# 41254 "parsing/parser.ml" +# 41274 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41289,7 +41309,7 @@ module Tables = struct let _v : (Parsetree.core_type list) = # 1130 "parsing/parser.mly" ( [ x2; x1 ] ) -# 41293 "parsing/parser.ml" +# 41313 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41314,7 +41334,7 @@ module Tables = struct let _v : (Parsetree.row_field) = # 3652 "parsing/parser.mly" ( _1 ) -# 41318 "parsing/parser.ml" +# 41338 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41342,7 +41362,7 @@ module Tables = struct # 3654 "parsing/parser.mly" ( Rf.inherit_ ~loc:(make_loc _sloc) _1 ) -# 41346 "parsing/parser.ml" +# 41366 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41367,24 +41387,24 @@ module Tables = struct let _v : (Parsetree.expression list) = let _2 = # 124 "" ( None ) -# 41371 "parsing/parser.ml" +# 41391 "parsing/parser.ml" in let x = let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 41377 "parsing/parser.ml" +# 41397 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41382 "parsing/parser.ml" +# 41402 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 41388 "parsing/parser.ml" +# 41408 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41416,24 +41436,24 @@ module Tables = struct let _v : (Parsetree.expression list) = let _2 = # 126 "" ( Some x ) -# 41420 "parsing/parser.ml" +# 41440 "parsing/parser.ml" in let x = let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 41426 "parsing/parser.ml" +# 41446 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41431 "parsing/parser.ml" +# 41451 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 41437 "parsing/parser.ml" +# 41457 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41479,7 +41499,7 @@ module Tables = struct let _v : (Parsetree.expression list) = let _2 = # 124 "" ( None ) -# 41483 "parsing/parser.ml" +# 41503 "parsing/parser.ml" in let x = let _1 = @@ -41488,18 +41508,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 41492 "parsing/parser.ml" +# 41512 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 41497 "parsing/parser.ml" +# 41517 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 41503 "parsing/parser.ml" +# 41523 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -41510,13 +41530,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 41514 "parsing/parser.ml" +# 41534 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 41520 "parsing/parser.ml" +# 41540 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -41536,19 +41556,19 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 41540 "parsing/parser.ml" +# 41560 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41546 "parsing/parser.ml" +# 41566 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 41552 "parsing/parser.ml" +# 41572 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41601,7 +41621,7 @@ module Tables = struct let _v : (Parsetree.expression list) = let _2 = # 126 "" ( Some x ) -# 41605 "parsing/parser.ml" +# 41625 "parsing/parser.ml" in let x = let _1 = @@ -41610,18 +41630,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 41614 "parsing/parser.ml" +# 41634 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 41619 "parsing/parser.ml" +# 41639 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 41625 "parsing/parser.ml" +# 41645 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -41632,13 +41652,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 41636 "parsing/parser.ml" +# 41656 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 41642 "parsing/parser.ml" +# 41662 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -41658,19 +41678,19 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 41662 "parsing/parser.ml" +# 41682 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41668 "parsing/parser.ml" +# 41688 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 41674 "parsing/parser.ml" +# 41694 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41710,18 +41730,18 @@ module Tables = struct let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 41714 "parsing/parser.ml" +# 41734 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41719 "parsing/parser.ml" +# 41739 "parsing/parser.ml" in # 1151 "parsing/parser.mly" ( x :: xs ) -# 41725 "parsing/parser.ml" +# 41745 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41786,18 +41806,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 41790 "parsing/parser.ml" +# 41810 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 41795 "parsing/parser.ml" +# 41815 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 41801 "parsing/parser.ml" +# 41821 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -41808,13 +41828,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 41812 "parsing/parser.ml" +# 41832 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 41818 "parsing/parser.ml" +# 41838 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -41834,19 +41854,19 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 41838 "parsing/parser.ml" +# 41858 "parsing/parser.ml" in # 2427 "parsing/parser.mly" ( _1 ) -# 41844 "parsing/parser.ml" +# 41864 "parsing/parser.ml" in # 1151 "parsing/parser.mly" ( x :: xs ) -# 41850 "parsing/parser.ml" +# 41870 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41874,7 +41894,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 41878 "parsing/parser.ml" +# 41898 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -41882,14 +41902,14 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = # 124 "" ( None ) -# 41886 "parsing/parser.ml" +# 41906 "parsing/parser.ml" in let x = let label = let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 41893 "parsing/parser.ml" +# 41913 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -41897,7 +41917,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 41901 "parsing/parser.ml" +# 41921 "parsing/parser.ml" in @@ -41911,13 +41931,13 @@ module Tables = struct label, e in label, e ) -# 41915 "parsing/parser.ml" +# 41935 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 41921 "parsing/parser.ml" +# 41941 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41952,7 +41972,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 41956 "parsing/parser.ml" +# 41976 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -41960,14 +41980,14 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = # 126 "" ( Some x ) -# 41964 "parsing/parser.ml" +# 41984 "parsing/parser.ml" in let x = let label = let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 41971 "parsing/parser.ml" +# 41991 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -41975,7 +41995,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 41979 "parsing/parser.ml" +# 41999 "parsing/parser.ml" in @@ -41989,13 +42009,13 @@ module Tables = struct label, e in label, e ) -# 41993 "parsing/parser.ml" +# 42013 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 41999 "parsing/parser.ml" +# 42019 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42037,7 +42057,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 42041 "parsing/parser.ml" +# 42061 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -42047,7 +42067,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 42051 "parsing/parser.ml" +# 42071 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -42055,7 +42075,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42059 "parsing/parser.ml" +# 42079 "parsing/parser.ml" in @@ -42069,13 +42089,13 @@ module Tables = struct label, e in label, e ) -# 42073 "parsing/parser.ml" +# 42093 "parsing/parser.ml" in # 1151 "parsing/parser.mly" ( x :: xs ) -# 42079 "parsing/parser.ml" +# 42099 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42100,12 +42120,12 @@ module Tables = struct let _v : (Parsetree.pattern list) = let _2 = # 124 "" ( None ) -# 42104 "parsing/parser.ml" +# 42124 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 42109 "parsing/parser.ml" +# 42129 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42139,13 +42159,13 @@ module Tables = struct # 126 "" ( Some x ) -# 42143 "parsing/parser.ml" +# 42163 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 42149 "parsing/parser.ml" +# 42169 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42184,7 +42204,7 @@ module Tables = struct let _v : (Parsetree.pattern list) = # 1151 "parsing/parser.mly" ( x :: xs ) -# 42188 "parsing/parser.ml" +# 42208 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42223,7 +42243,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = # 124 "" ( None ) -# 42227 "parsing/parser.ml" +# 42247 "parsing/parser.ml" in let x = let label = @@ -42233,7 +42253,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42237 "parsing/parser.ml" +# 42257 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -42251,13 +42271,13 @@ module Tables = struct (_startpos_c_, _endpos), label, e in label, mkexp_opt_constraint ~loc:constraint_loc e c ) -# 42255 "parsing/parser.ml" +# 42275 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 42261 "parsing/parser.ml" +# 42281 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42303,7 +42323,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = # 126 "" ( Some x ) -# 42307 "parsing/parser.ml" +# 42327 "parsing/parser.ml" in let x = let label = @@ -42313,7 +42333,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42317 "parsing/parser.ml" +# 42337 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -42331,13 +42351,13 @@ module Tables = struct (_startpos_c_, _endpos), label, e in label, mkexp_opt_constraint ~loc:constraint_loc e c ) -# 42335 "parsing/parser.ml" +# 42355 "parsing/parser.ml" in # 1147 "parsing/parser.mly" ( [x] ) -# 42341 "parsing/parser.ml" +# 42361 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42395,7 +42415,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42399 "parsing/parser.ml" +# 42419 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -42413,13 +42433,13 @@ module Tables = struct (_startpos_c_, _endpos), label, e in label, mkexp_opt_constraint ~loc:constraint_loc e c ) -# 42417 "parsing/parser.ml" +# 42437 "parsing/parser.ml" in # 1151 "parsing/parser.mly" ( x :: xs ) -# 42423 "parsing/parser.ml" +# 42443 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42444,12 +42464,12 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = # 2283 "parsing/parser.mly" ( _1 ) -# 42448 "parsing/parser.ml" +# 42468 "parsing/parser.ml" in # 2321 "parsing/parser.mly" ( _1 ) -# 42453 "parsing/parser.ml" +# 42473 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42498,18 +42518,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 42502 "parsing/parser.ml" +# 42522 "parsing/parser.ml" in # 1172 "parsing/parser.mly" ( xs ) -# 42507 "parsing/parser.ml" +# 42527 "parsing/parser.ml" in # 2752 "parsing/parser.mly" ( xs ) -# 42513 "parsing/parser.ml" +# 42533 "parsing/parser.ml" in let _endpos__3_ = _endpos_xs_ in @@ -42520,13 +42540,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 42524 "parsing/parser.ml" +# 42544 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 42530 "parsing/parser.ml" +# 42550 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -42546,13 +42566,13 @@ module Tables = struct let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in mkexp_attrs ~loc:_sloc desc _2 ) -# 42550 "parsing/parser.ml" +# 42570 "parsing/parser.ml" in # 2321 "parsing/parser.mly" ( _1 ) -# 42556 "parsing/parser.ml" +# 42576 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42622,7 +42642,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 42626 "parsing/parser.ml" +# 42646 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined4_ in @@ -42631,7 +42651,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 42635 "parsing/parser.ml" +# 42655 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -42643,7 +42663,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42647 "parsing/parser.ml" +# 42667 "parsing/parser.ml" in let attrs1 = @@ -42651,7 +42671,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 42655 "parsing/parser.ml" +# 42675 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in @@ -42666,7 +42686,7 @@ module Tables = struct Te.mk_exception ~attrs (Te.decl id ~vars ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs) , ext ) -# 42670 "parsing/parser.ml" +# 42690 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42692,7 +42712,7 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 42696 "parsing/parser.ml" +# 42716 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in @@ -42700,13 +42720,13 @@ module Tables = struct # 949 "parsing/parser.mly" ( extra_sig _startpos _endpos _1 ) -# 42704 "parsing/parser.ml" +# 42724 "parsing/parser.ml" in # 1729 "parsing/parser.mly" ( _1 ) -# 42710 "parsing/parser.ml" +# 42730 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42740,7 +42760,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 42744 "parsing/parser.ml" +# 42764 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -42751,7 +42771,7 @@ module Tables = struct # 1744 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) ) -# 42755 "parsing/parser.ml" +# 42775 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42777,7 +42797,7 @@ module Tables = struct let _1 = # 1748 "parsing/parser.mly" ( Psig_attribute _1 ) -# 42781 "parsing/parser.ml" +# 42801 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -42785,13 +42805,13 @@ module Tables = struct # 997 "parsing/parser.mly" ( mksig ~loc:_sloc _1 ) -# 42789 "parsing/parser.ml" +# 42809 "parsing/parser.ml" in # 1750 "parsing/parser.mly" ( _1 ) -# 42795 "parsing/parser.ml" +# 42815 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42817,7 +42837,7 @@ module Tables = struct let _1 = # 1753 "parsing/parser.mly" ( psig_value _1 ) -# 42821 "parsing/parser.ml" +# 42841 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -42825,13 +42845,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 42829 "parsing/parser.ml" +# 42849 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 42835 "parsing/parser.ml" +# 42855 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42857,7 +42877,7 @@ module Tables = struct let _1 = # 1755 "parsing/parser.mly" ( psig_value _1 ) -# 42861 "parsing/parser.ml" +# 42881 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -42865,13 +42885,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 42869 "parsing/parser.ml" +# 42889 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 42875 "parsing/parser.ml" +# 42895 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42908,24 +42928,24 @@ module Tables = struct let _1 = # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 42912 "parsing/parser.ml" +# 42932 "parsing/parser.ml" in # 3089 "parsing/parser.mly" ( _1 ) -# 42917 "parsing/parser.ml" +# 42937 "parsing/parser.ml" in # 3072 "parsing/parser.mly" ( _1 ) -# 42923 "parsing/parser.ml" +# 42943 "parsing/parser.ml" in # 1757 "parsing/parser.mly" ( psig_type _1 ) -# 42929 "parsing/parser.ml" +# 42949 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -42935,13 +42955,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 42939 "parsing/parser.ml" +# 42959 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 42945 "parsing/parser.ml" +# 42965 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42978,24 +42998,24 @@ module Tables = struct let _1 = # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 42982 "parsing/parser.ml" +# 43002 "parsing/parser.ml" in # 3089 "parsing/parser.mly" ( _1 ) -# 42987 "parsing/parser.ml" +# 43007 "parsing/parser.ml" in # 3077 "parsing/parser.mly" ( _1 ) -# 42993 "parsing/parser.ml" +# 43013 "parsing/parser.ml" in # 1759 "parsing/parser.mly" ( psig_typesubst _1 ) -# 42999 "parsing/parser.ml" +# 43019 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -43005,13 +43025,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43009 "parsing/parser.ml" +# 43029 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43015 "parsing/parser.ml" +# 43035 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43098,14 +43118,14 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 43102 "parsing/parser.ml" +# 43122 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let cs = # 1200 "parsing/parser.mly" ( List.rev xs ) -# 43109 "parsing/parser.ml" +# 43129 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -43115,20 +43135,20 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43119 "parsing/parser.ml" +# 43139 "parsing/parser.ml" in let _4 = # 3899 "parsing/parser.mly" ( Recursive ) -# 43125 "parsing/parser.ml" +# 43145 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in # 4058 "parsing/parser.mly" ( _1 ) -# 43132 "parsing/parser.ml" +# 43152 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -43140,19 +43160,19 @@ module Tables = struct let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 43144 "parsing/parser.ml" +# 43164 "parsing/parser.ml" in # 3329 "parsing/parser.mly" ( _1 ) -# 43150 "parsing/parser.ml" +# 43170 "parsing/parser.ml" in # 1761 "parsing/parser.mly" ( psig_typext _1 ) -# 43156 "parsing/parser.ml" +# 43176 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -43162,13 +43182,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43166 "parsing/parser.ml" +# 43186 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43172 "parsing/parser.ml" +# 43192 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43262,14 +43282,14 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 43266 "parsing/parser.ml" +# 43286 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in let cs = # 1200 "parsing/parser.mly" ( List.rev xs ) -# 43273 "parsing/parser.ml" +# 43293 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in @@ -43279,7 +43299,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43283 "parsing/parser.ml" +# 43303 "parsing/parser.ml" in let _4 = @@ -43290,7 +43310,7 @@ module Tables = struct # 3901 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 43294 "parsing/parser.ml" +# 43314 "parsing/parser.ml" in let attrs1 = @@ -43298,7 +43318,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 43302 "parsing/parser.ml" +# 43322 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -43310,19 +43330,19 @@ module Tables = struct let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 43314 "parsing/parser.ml" +# 43334 "parsing/parser.ml" in # 3329 "parsing/parser.mly" ( _1 ) -# 43320 "parsing/parser.ml" +# 43340 "parsing/parser.ml" in # 1761 "parsing/parser.mly" ( psig_typext _1 ) -# 43326 "parsing/parser.ml" +# 43346 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -43332,13 +43352,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43336 "parsing/parser.ml" +# 43356 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43342 "parsing/parser.ml" +# 43362 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43364,7 +43384,7 @@ module Tables = struct let _1 = # 1763 "parsing/parser.mly" ( psig_exception _1 ) -# 43368 "parsing/parser.ml" +# 43388 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -43372,13 +43392,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43376 "parsing/parser.ml" +# 43396 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43382 "parsing/parser.ml" +# 43402 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43443,7 +43463,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 43447 "parsing/parser.ml" +# 43467 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -43455,7 +43475,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43459 "parsing/parser.ml" +# 43479 "parsing/parser.ml" in let attrs1 = @@ -43463,7 +43483,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 43467 "parsing/parser.ml" +# 43487 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -43477,13 +43497,13 @@ module Tables = struct let docs = symbol_docs _sloc in Md.mk name body ~attrs ~loc ~docs, ext ) -# 43481 "parsing/parser.ml" +# 43501 "parsing/parser.ml" in # 1765 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_module body, ext) ) -# 43487 "parsing/parser.ml" +# 43507 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -43493,13 +43513,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43497 "parsing/parser.ml" +# 43517 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43503 "parsing/parser.ml" +# 43523 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43571,7 +43591,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 43575 "parsing/parser.ml" +# 43595 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -43584,7 +43604,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43588 "parsing/parser.ml" +# 43608 "parsing/parser.ml" in let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in @@ -43594,7 +43614,7 @@ module Tables = struct # 1833 "parsing/parser.mly" ( Mty.alias ~loc:(make_loc _sloc) id ) -# 43598 "parsing/parser.ml" +# 43618 "parsing/parser.ml" in let name = @@ -43605,7 +43625,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43609 "parsing/parser.ml" +# 43629 "parsing/parser.ml" in let attrs1 = @@ -43613,7 +43633,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 43617 "parsing/parser.ml" +# 43637 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -43627,13 +43647,13 @@ module Tables = struct let docs = symbol_docs _sloc in Md.mk name body ~attrs ~loc ~docs, ext ) -# 43631 "parsing/parser.ml" +# 43651 "parsing/parser.ml" in # 1767 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_module body, ext) ) -# 43637 "parsing/parser.ml" +# 43657 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -43643,13 +43663,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43647 "parsing/parser.ml" +# 43667 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43653 "parsing/parser.ml" +# 43673 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43675,7 +43695,7 @@ module Tables = struct let _1 = # 1769 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_modsubst body, ext) ) -# 43679 "parsing/parser.ml" +# 43699 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -43683,13 +43703,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43687 "parsing/parser.ml" +# 43707 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43693 "parsing/parser.ml" +# 43713 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43777,7 +43797,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 43781 "parsing/parser.ml" +# 43801 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -43789,7 +43809,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43793 "parsing/parser.ml" +# 43813 "parsing/parser.ml" in let attrs1 = @@ -43797,7 +43817,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 43801 "parsing/parser.ml" +# 43821 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -43811,25 +43831,25 @@ module Tables = struct let docs = symbol_docs _sloc in ext, Md.mk name mty ~attrs ~loc ~docs ) -# 43815 "parsing/parser.ml" +# 43835 "parsing/parser.ml" in # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 43821 "parsing/parser.ml" +# 43841 "parsing/parser.ml" in # 1856 "parsing/parser.mly" ( _1 ) -# 43827 "parsing/parser.ml" +# 43847 "parsing/parser.ml" in # 1771 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_recmodule l, ext) ) -# 43833 "parsing/parser.ml" +# 43853 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -43839,13 +43859,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43843 "parsing/parser.ml" +# 43863 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43849 "parsing/parser.ml" +# 43869 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43871,7 +43891,7 @@ module Tables = struct let _1 = # 1773 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_modtype body, ext) ) -# 43875 "parsing/parser.ml" +# 43895 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -43879,13 +43899,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43883 "parsing/parser.ml" +# 43903 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43889 "parsing/parser.ml" +# 43909 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43911,7 +43931,7 @@ module Tables = struct let _1 = # 1775 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_modtypesubst body, ext) ) -# 43915 "parsing/parser.ml" +# 43935 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -43919,13 +43939,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43923 "parsing/parser.ml" +# 43943 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43929 "parsing/parser.ml" +# 43949 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43951,7 +43971,7 @@ module Tables = struct let _1 = # 1777 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_open body, ext) ) -# 43955 "parsing/parser.ml" +# 43975 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -43959,13 +43979,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 43963 "parsing/parser.ml" +# 43983 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 43969 "parsing/parser.ml" +# 43989 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44023,7 +44043,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 44027 "parsing/parser.ml" +# 44047 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in @@ -44032,7 +44052,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 44036 "parsing/parser.ml" +# 44056 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -44046,13 +44066,13 @@ module Tables = struct let docs = symbol_docs _sloc in Incl.mk thing ~attrs ~loc ~docs, ext ) -# 44050 "parsing/parser.ml" +# 44070 "parsing/parser.ml" in # 1779 "parsing/parser.mly" ( psig_include _1 ) -# 44056 "parsing/parser.ml" +# 44076 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined2_ in @@ -44062,13 +44082,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 44066 "parsing/parser.ml" +# 44086 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 44072 "parsing/parser.ml" +# 44092 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44147,7 +44167,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 44151 "parsing/parser.ml" +# 44171 "parsing/parser.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 @@ -44167,7 +44187,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 44171 "parsing/parser.ml" +# 44191 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -44179,7 +44199,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 44183 "parsing/parser.ml" +# 44203 "parsing/parser.ml" in let attrs1 = @@ -44187,7 +44207,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 44191 "parsing/parser.ml" +# 44211 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -44202,25 +44222,25 @@ module Tables = struct ext, Ci.mk id cty ~virt ~params ~attrs ~loc ~docs ) -# 44206 "parsing/parser.ml" +# 44226 "parsing/parser.ml" in # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 44212 "parsing/parser.ml" +# 44232 "parsing/parser.ml" in # 2202 "parsing/parser.mly" ( _1 ) -# 44218 "parsing/parser.ml" +# 44238 "parsing/parser.ml" in # 1781 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_class l, ext) ) -# 44224 "parsing/parser.ml" +# 44244 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -44230,13 +44250,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 44234 "parsing/parser.ml" +# 44254 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 44240 "parsing/parser.ml" +# 44260 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44262,7 +44282,7 @@ module Tables = struct let _1 = # 1783 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_class_type l, ext) ) -# 44266 "parsing/parser.ml" +# 44286 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -44270,13 +44290,13 @@ module Tables = struct # 1014 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 44274 "parsing/parser.ml" +# 44294 "parsing/parser.ml" in # 1785 "parsing/parser.mly" ( _1 ) -# 44280 "parsing/parser.ml" +# 44300 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44301,7 +44321,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3728 "parsing/parser.mly" ( _1 ) -# 44305 "parsing/parser.ml" +# 44325 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44328,7 +44348,7 @@ module Tables = struct let _2 : ( # 760 "parsing/parser.mly" (string * char option) -# 44332 "parsing/parser.ml" +# 44352 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -44337,7 +44357,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3729 "parsing/parser.mly" ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) ) -# 44341 "parsing/parser.ml" +# 44361 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44364,7 +44384,7 @@ module Tables = struct let _2 : ( # 739 "parsing/parser.mly" (string * char option) -# 44368 "parsing/parser.ml" +# 44388 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -44373,7 +44393,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3730 "parsing/parser.mly" ( let (f, m) = _2 in Pconst_float("-" ^ f, m) ) -# 44377 "parsing/parser.ml" +# 44397 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44400,7 +44420,7 @@ module Tables = struct let _2 : ( # 760 "parsing/parser.mly" (string * char option) -# 44404 "parsing/parser.ml" +# 44424 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -44409,7 +44429,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3731 "parsing/parser.mly" ( let (n, m) = _2 in Pconst_integer (n, m) ) -# 44413 "parsing/parser.ml" +# 44433 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44436,7 +44456,7 @@ module Tables = struct let _2 : ( # 739 "parsing/parser.mly" (string * char option) -# 44440 "parsing/parser.ml" +# 44460 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -44445,7 +44465,7 @@ module Tables = struct let _v : (Parsetree.constant) = # 3732 "parsing/parser.mly" ( let (f, m) = _2 in Pconst_float(f, m) ) -# 44449 "parsing/parser.ml" +# 44469 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44490,14 +44510,14 @@ module Tables = struct ( let fields, closed = _1 in let closed = match closed with Some () -> Open | None -> Closed in fields, closed ) -# 44494 "parsing/parser.ml" +# 44514 "parsing/parser.ml" in # 2972 "parsing/parser.mly" ( let (fields, closed) = _2 in Ppat_record(fields, closed) ) -# 44501 "parsing/parser.ml" +# 44521 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -44507,13 +44527,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 44511 "parsing/parser.ml" +# 44531 "parsing/parser.ml" in # 2986 "parsing/parser.mly" ( _1 ) -# 44517 "parsing/parser.ml" +# 44537 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44558,7 +44578,7 @@ module Tables = struct ( let fields, closed = _1 in let closed = match closed with Some () -> Open | None -> Closed in fields, closed ) -# 44562 "parsing/parser.ml" +# 44582 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in @@ -44566,7 +44586,7 @@ module Tables = struct # 2975 "parsing/parser.mly" ( unclosed "{" _loc__1_ "}" _loc__3_ ) -# 44570 "parsing/parser.ml" +# 44590 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -44576,13 +44596,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 44580 "parsing/parser.ml" +# 44600 "parsing/parser.ml" in # 2986 "parsing/parser.mly" ( _1 ) -# 44586 "parsing/parser.ml" +# 44606 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44623,13 +44643,13 @@ module Tables = struct let _2 = # 2995 "parsing/parser.mly" ( ps ) -# 44627 "parsing/parser.ml" +# 44647 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in # 2977 "parsing/parser.mly" ( fst (mktailpat _loc__3_ _2) ) -# 44633 "parsing/parser.ml" +# 44653 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -44639,13 +44659,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 44643 "parsing/parser.ml" +# 44663 "parsing/parser.ml" in # 2986 "parsing/parser.mly" ( _1 ) -# 44649 "parsing/parser.ml" +# 44669 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44686,14 +44706,14 @@ module Tables = struct let _2 = # 2995 "parsing/parser.mly" ( ps ) -# 44690 "parsing/parser.ml" +# 44710 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2979 "parsing/parser.mly" ( unclosed "[" _loc__1_ "]" _loc__3_ ) -# 44697 "parsing/parser.ml" +# 44717 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -44703,13 +44723,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 44707 "parsing/parser.ml" +# 44727 "parsing/parser.ml" in # 2986 "parsing/parser.mly" ( _1 ) -# 44713 "parsing/parser.ml" +# 44733 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44750,12 +44770,12 @@ module Tables = struct let _2 = # 2995 "parsing/parser.mly" ( ps ) -# 44754 "parsing/parser.ml" +# 44774 "parsing/parser.ml" in # 2981 "parsing/parser.mly" ( Ppat_array _2 ) -# 44759 "parsing/parser.ml" +# 44779 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -44765,13 +44785,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 44769 "parsing/parser.ml" +# 44789 "parsing/parser.ml" in # 2986 "parsing/parser.mly" ( _1 ) -# 44775 "parsing/parser.ml" +# 44795 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44804,7 +44824,7 @@ module Tables = struct let _1 = # 2983 "parsing/parser.mly" ( Ppat_array [] ) -# 44808 "parsing/parser.ml" +# 44828 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -44813,13 +44833,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 44817 "parsing/parser.ml" +# 44837 "parsing/parser.ml" in # 2986 "parsing/parser.mly" ( _1 ) -# 44823 "parsing/parser.ml" +# 44843 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44860,14 +44880,14 @@ module Tables = struct let _2 = # 2995 "parsing/parser.mly" ( ps ) -# 44864 "parsing/parser.ml" +# 44884 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2985 "parsing/parser.mly" ( unclosed "[|" _loc__1_ "|]" _loc__3_ ) -# 44871 "parsing/parser.ml" +# 44891 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -44877,13 +44897,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 44881 "parsing/parser.ml" +# 44901 "parsing/parser.ml" in # 2986 "parsing/parser.mly" ( _1 ) -# 44887 "parsing/parser.ml" +# 44907 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44925,7 +44945,7 @@ module Tables = struct # 2489 "parsing/parser.mly" ( reloc_exp ~loc:_sloc _2 ) -# 44929 "parsing/parser.ml" +# 44949 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44966,7 +44986,7 @@ module Tables = struct # 2491 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 44970 "parsing/parser.ml" +# 44990 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45015,7 +45035,7 @@ module Tables = struct # 2493 "parsing/parser.mly" ( mkexp_constraint ~loc:_sloc _2 _3 ) -# 45019 "parsing/parser.ml" +# 45039 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45069,12 +45089,12 @@ module Tables = struct let r = # 2494 "parsing/parser.mly" ( None ) -# 45073 "parsing/parser.ml" +# 45093 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 45078 "parsing/parser.ml" +# 45098 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45084,7 +45104,7 @@ module Tables = struct # 2495 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 45088 "parsing/parser.ml" +# 45108 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45138,12 +45158,12 @@ module Tables = struct let r = # 2494 "parsing/parser.mly" ( None ) -# 45142 "parsing/parser.ml" +# 45162 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 45147 "parsing/parser.ml" +# 45167 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45153,7 +45173,7 @@ module Tables = struct # 2495 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 45157 "parsing/parser.ml" +# 45177 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45207,12 +45227,12 @@ module Tables = struct let r = # 2494 "parsing/parser.mly" ( None ) -# 45211 "parsing/parser.ml" +# 45231 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 45216 "parsing/parser.ml" +# 45236 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45222,7 +45242,7 @@ module Tables = struct # 2495 "parsing/parser.mly" ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 ) -# 45226 "parsing/parser.ml" +# 45246 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45270,7 +45290,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 45274 "parsing/parser.ml" +# 45294 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -45280,29 +45300,29 @@ module Tables = struct let r = # 2496 "parsing/parser.mly" ( None ) -# 45284 "parsing/parser.ml" +# 45304 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 45289 "parsing/parser.ml" +# 45309 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 45295 "parsing/parser.ml" +# 45315 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 45300 "parsing/parser.ml" +# 45320 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 45306 "parsing/parser.ml" +# 45326 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45312,7 +45332,7 @@ module Tables = struct # 2497 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 45316 "parsing/parser.ml" +# 45336 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45372,7 +45392,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 45376 "parsing/parser.ml" +# 45396 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -45384,12 +45404,12 @@ module Tables = struct let r = # 2496 "parsing/parser.mly" ( None ) -# 45388 "parsing/parser.ml" +# 45408 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 45393 "parsing/parser.ml" +# 45413 "parsing/parser.ml" in let d = let _1 = @@ -45397,24 +45417,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 45401 "parsing/parser.ml" +# 45421 "parsing/parser.ml" in # 126 "" ( Some x ) -# 45406 "parsing/parser.ml" +# 45426 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 45412 "parsing/parser.ml" +# 45432 "parsing/parser.ml" in # 2375 "parsing/parser.mly" ( array, d, Paren, i, r ) -# 45418 "parsing/parser.ml" +# 45438 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45424,7 +45444,7 @@ module Tables = struct # 2497 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 45428 "parsing/parser.ml" +# 45448 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45472,7 +45492,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 45476 "parsing/parser.ml" +# 45496 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -45482,29 +45502,29 @@ module Tables = struct let r = # 2496 "parsing/parser.mly" ( None ) -# 45486 "parsing/parser.ml" +# 45506 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 45491 "parsing/parser.ml" +# 45511 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 45497 "parsing/parser.ml" +# 45517 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 45502 "parsing/parser.ml" +# 45522 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 45508 "parsing/parser.ml" +# 45528 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45514,7 +45534,7 @@ module Tables = struct # 2497 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 45518 "parsing/parser.ml" +# 45538 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45574,7 +45594,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 45578 "parsing/parser.ml" +# 45598 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -45586,12 +45606,12 @@ module Tables = struct let r = # 2496 "parsing/parser.mly" ( None ) -# 45590 "parsing/parser.ml" +# 45610 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 45595 "parsing/parser.ml" +# 45615 "parsing/parser.ml" in let d = let _1 = @@ -45599,24 +45619,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 45603 "parsing/parser.ml" +# 45623 "parsing/parser.ml" in # 126 "" ( Some x ) -# 45608 "parsing/parser.ml" +# 45628 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 45614 "parsing/parser.ml" +# 45634 "parsing/parser.ml" in # 2377 "parsing/parser.mly" ( array, d, Brace, i, r ) -# 45620 "parsing/parser.ml" +# 45640 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45626,7 +45646,7 @@ module Tables = struct # 2497 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 45630 "parsing/parser.ml" +# 45650 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45674,7 +45694,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 45678 "parsing/parser.ml" +# 45698 "parsing/parser.ml" ) = Obj.magic _2 in let array : (Parsetree.expression) = Obj.magic array in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -45684,29 +45704,29 @@ module Tables = struct let r = # 2496 "parsing/parser.mly" ( None ) -# 45688 "parsing/parser.ml" +# 45708 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 45693 "parsing/parser.ml" +# 45713 "parsing/parser.ml" in let d = let _1 = # 124 "" ( None ) -# 45699 "parsing/parser.ml" +# 45719 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 45704 "parsing/parser.ml" +# 45724 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 45710 "parsing/parser.ml" +# 45730 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45716,7 +45736,7 @@ module Tables = struct # 2497 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 45720 "parsing/parser.ml" +# 45740 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45776,7 +45796,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 45780 "parsing/parser.ml" +# 45800 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1 : unit = Obj.magic _1 in @@ -45788,12 +45808,12 @@ module Tables = struct let r = # 2496 "parsing/parser.mly" ( None ) -# 45792 "parsing/parser.ml" +# 45812 "parsing/parser.ml" in let i = # 2827 "parsing/parser.mly" ( es ) -# 45797 "parsing/parser.ml" +# 45817 "parsing/parser.ml" in let d = let _1 = @@ -45801,24 +45821,24 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 45805 "parsing/parser.ml" +# 45825 "parsing/parser.ml" in # 126 "" ( Some x ) -# 45810 "parsing/parser.ml" +# 45830 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 45816 "parsing/parser.ml" +# 45836 "parsing/parser.ml" in # 2379 "parsing/parser.mly" ( array, d, Bracket, i, r ) -# 45822 "parsing/parser.ml" +# 45842 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in @@ -45828,7 +45848,7 @@ module Tables = struct # 2497 "parsing/parser.mly" ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 ) -# 45832 "parsing/parser.ml" +# 45852 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45884,13 +45904,13 @@ module Tables = struct # 2384 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Paren _loc__e_ ) -# 45888 "parsing/parser.ml" +# 45908 "parsing/parser.ml" in # 2498 "parsing/parser.mly" ( _1 ) -# 45894 "parsing/parser.ml" +# 45914 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45946,13 +45966,13 @@ module Tables = struct # 2386 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Brace _loc__e_ ) -# 45950 "parsing/parser.ml" +# 45970 "parsing/parser.ml" in # 2498 "parsing/parser.mly" ( _1 ) -# 45956 "parsing/parser.ml" +# 45976 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46008,13 +46028,13 @@ module Tables = struct # 2388 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ ) -# 46012 "parsing/parser.ml" +# 46032 "parsing/parser.ml" in # 2498 "parsing/parser.mly" ( _1 ) -# 46018 "parsing/parser.ml" +# 46038 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46062,7 +46082,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 46066 "parsing/parser.ml" +# 46086 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -46072,18 +46092,18 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 46076 "parsing/parser.ml" +# 46096 "parsing/parser.ml" in let _2 = let _1 = # 124 "" ( None ) -# 46082 "parsing/parser.ml" +# 46102 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 46087 "parsing/parser.ml" +# 46107 "parsing/parser.ml" in let _loc__p_ = (_startpos__p_, _endpos__p_) in @@ -46091,13 +46111,13 @@ module Tables = struct # 2384 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Paren _loc__e_ ) -# 46095 "parsing/parser.ml" +# 46115 "parsing/parser.ml" in # 2499 "parsing/parser.mly" ( _1 ) -# 46101 "parsing/parser.ml" +# 46121 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46157,7 +46177,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 46161 "parsing/parser.ml" +# 46181 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1_inlined1 : unit = Obj.magic _1_inlined1 in @@ -46169,7 +46189,7 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 46173 "parsing/parser.ml" +# 46193 "parsing/parser.ml" in let _2 = let _1 = @@ -46177,18 +46197,18 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 46181 "parsing/parser.ml" +# 46201 "parsing/parser.ml" in # 126 "" ( Some x ) -# 46186 "parsing/parser.ml" +# 46206 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 46192 "parsing/parser.ml" +# 46212 "parsing/parser.ml" in let _loc__p_ = (_startpos__p_, _endpos__p_) in @@ -46196,13 +46216,13 @@ module Tables = struct # 2384 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Paren _loc__e_ ) -# 46200 "parsing/parser.ml" +# 46220 "parsing/parser.ml" in # 2499 "parsing/parser.mly" ( _1 ) -# 46206 "parsing/parser.ml" +# 46226 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46250,7 +46270,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 46254 "parsing/parser.ml" +# 46274 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -46260,18 +46280,18 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 46264 "parsing/parser.ml" +# 46284 "parsing/parser.ml" in let _2 = let _1 = # 124 "" ( None ) -# 46270 "parsing/parser.ml" +# 46290 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 46275 "parsing/parser.ml" +# 46295 "parsing/parser.ml" in let _loc__p_ = (_startpos__p_, _endpos__p_) in @@ -46279,13 +46299,13 @@ module Tables = struct # 2386 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Brace _loc__e_ ) -# 46283 "parsing/parser.ml" +# 46303 "parsing/parser.ml" in # 2499 "parsing/parser.mly" ( _1 ) -# 46289 "parsing/parser.ml" +# 46309 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46345,7 +46365,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 46349 "parsing/parser.ml" +# 46369 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1_inlined1 : unit = Obj.magic _1_inlined1 in @@ -46357,7 +46377,7 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 46361 "parsing/parser.ml" +# 46381 "parsing/parser.ml" in let _2 = let _1 = @@ -46365,18 +46385,18 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 46369 "parsing/parser.ml" +# 46389 "parsing/parser.ml" in # 126 "" ( Some x ) -# 46374 "parsing/parser.ml" +# 46394 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 46380 "parsing/parser.ml" +# 46400 "parsing/parser.ml" in let _loc__p_ = (_startpos__p_, _endpos__p_) in @@ -46384,13 +46404,13 @@ module Tables = struct # 2386 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Brace _loc__e_ ) -# 46388 "parsing/parser.ml" +# 46408 "parsing/parser.ml" in # 2499 "parsing/parser.mly" ( _1 ) -# 46394 "parsing/parser.ml" +# 46414 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46438,7 +46458,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 46442 "parsing/parser.ml" +# 46462 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -46448,18 +46468,18 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 46452 "parsing/parser.ml" +# 46472 "parsing/parser.ml" in let _2 = let _1 = # 124 "" ( None ) -# 46458 "parsing/parser.ml" +# 46478 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 46463 "parsing/parser.ml" +# 46483 "parsing/parser.ml" in let _loc__p_ = (_startpos__p_, _endpos__p_) in @@ -46467,13 +46487,13 @@ module Tables = struct # 2388 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ ) -# 46471 "parsing/parser.ml" +# 46491 "parsing/parser.ml" in # 2499 "parsing/parser.mly" ( _1 ) -# 46477 "parsing/parser.ml" +# 46497 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46533,7 +46553,7 @@ module Tables = struct let _2 : ( # 755 "parsing/parser.mly" (string) -# 46537 "parsing/parser.ml" +# 46557 "parsing/parser.ml" ) = Obj.magic _2 in let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in let _1_inlined1 : unit = Obj.magic _1_inlined1 in @@ -46545,7 +46565,7 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 46549 "parsing/parser.ml" +# 46569 "parsing/parser.ml" in let _2 = let _1 = @@ -46553,18 +46573,18 @@ module Tables = struct let x = # 2391 "parsing/parser.mly" (_2) -# 46557 "parsing/parser.ml" +# 46577 "parsing/parser.ml" in # 126 "" ( Some x ) -# 46562 "parsing/parser.ml" +# 46582 "parsing/parser.ml" in # 2391 "parsing/parser.mly" ( _1, _2 ) -# 46568 "parsing/parser.ml" +# 46588 "parsing/parser.ml" in let _loc__p_ = (_startpos__p_, _endpos__p_) in @@ -46572,13 +46592,13 @@ module Tables = struct # 2388 "parsing/parser.mly" ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ ) -# 46576 "parsing/parser.ml" +# 46596 "parsing/parser.ml" in # 2499 "parsing/parser.mly" ( _1 ) -# 46582 "parsing/parser.ml" +# 46602 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46634,13 +46654,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 46638 "parsing/parser.ml" +# 46658 "parsing/parser.ml" in # 2508 "parsing/parser.mly" ( e.pexp_desc, (ext, attrs @ e.pexp_attributes) ) -# 46644 "parsing/parser.ml" +# 46664 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -46651,7 +46671,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 46655 "parsing/parser.ml" +# 46675 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46702,13 +46722,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 46706 "parsing/parser.ml" +# 46726 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 46712 "parsing/parser.ml" +# 46732 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -46717,7 +46737,7 @@ module Tables = struct # 2510 "parsing/parser.mly" ( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 ) -# 46721 "parsing/parser.ml" +# 46741 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -46728,7 +46748,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 46732 "parsing/parser.ml" +# 46752 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46786,13 +46806,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 46790 "parsing/parser.ml" +# 46810 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 46796 "parsing/parser.ml" +# 46816 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in @@ -46800,7 +46820,7 @@ module Tables = struct # 2512 "parsing/parser.mly" ( unclosed "begin" _loc__1_ "end" _loc__4_ ) -# 46804 "parsing/parser.ml" +# 46824 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -46811,7 +46831,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 46815 "parsing/parser.ml" +# 46835 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46863,7 +46883,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46867 "parsing/parser.ml" +# 46887 "parsing/parser.ml" in let _2 = @@ -46873,19 +46893,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 46877 "parsing/parser.ml" +# 46897 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 46883 "parsing/parser.ml" +# 46903 "parsing/parser.ml" in # 2514 "parsing/parser.mly" ( Pexp_new(_3), _2 ) -# 46889 "parsing/parser.ml" +# 46909 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -46896,7 +46916,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 46900 "parsing/parser.ml" +# 46920 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46961,19 +46981,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 46965 "parsing/parser.ml" +# 46985 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 46971 "parsing/parser.ml" +# 46991 "parsing/parser.ml" in # 2516 "parsing/parser.mly" ( Pexp_pack _4, _3 ) -# 46977 "parsing/parser.ml" +# 46997 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -46984,7 +47004,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 46988 "parsing/parser.ml" +# 47008 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47066,7 +47086,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 47070 "parsing/parser.ml" +# 47090 "parsing/parser.ml" in let _3 = @@ -47076,13 +47096,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 47080 "parsing/parser.ml" +# 47100 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 47086 "parsing/parser.ml" +# 47106 "parsing/parser.ml" in let _endpos = _endpos__7_ in @@ -47091,7 +47111,7 @@ module Tables = struct # 2518 "parsing/parser.mly" ( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 ) -# 47095 "parsing/parser.ml" +# 47115 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -47102,7 +47122,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 47106 "parsing/parser.ml" +# 47126 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47174,13 +47194,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 47178 "parsing/parser.ml" +# 47198 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 47184 "parsing/parser.ml" +# 47204 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in @@ -47188,7 +47208,7 @@ module Tables = struct # 2520 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 47192 "parsing/parser.ml" +# 47212 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -47199,7 +47219,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 47203 "parsing/parser.ml" +# 47223 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47264,12 +47284,12 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 47268 "parsing/parser.ml" +# 47288 "parsing/parser.ml" in # 2030 "parsing/parser.mly" ( _1 ) -# 47273 "parsing/parser.ml" +# 47293 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -47278,13 +47298,13 @@ module Tables = struct # 950 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 47282 "parsing/parser.ml" +# 47302 "parsing/parser.ml" in # 2017 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 47288 "parsing/parser.ml" +# 47308 "parsing/parser.ml" in let _2 = @@ -47294,19 +47314,19 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 47298 "parsing/parser.ml" +# 47318 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 47304 "parsing/parser.ml" +# 47324 "parsing/parser.ml" in # 2522 "parsing/parser.mly" ( Pexp_object _3, _2 ) -# 47310 "parsing/parser.ml" +# 47330 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -47317,7 +47337,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 47321 "parsing/parser.ml" +# 47341 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47382,12 +47402,12 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 47386 "parsing/parser.ml" +# 47406 "parsing/parser.ml" in # 2030 "parsing/parser.mly" ( _1 ) -# 47391 "parsing/parser.ml" +# 47411 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -47396,13 +47416,13 @@ module Tables = struct # 950 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 47400 "parsing/parser.ml" +# 47420 "parsing/parser.ml" in # 2017 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 47406 "parsing/parser.ml" +# 47426 "parsing/parser.ml" in let _2 = @@ -47412,13 +47432,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 47416 "parsing/parser.ml" +# 47436 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 47422 "parsing/parser.ml" +# 47442 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in @@ -47426,7 +47446,7 @@ module Tables = struct # 2524 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 47430 "parsing/parser.ml" +# 47450 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -47437,7 +47457,7 @@ module Tables = struct # 2501 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 47441 "parsing/parser.ml" +# 47461 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47468,13 +47488,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 47472 "parsing/parser.ml" +# 47492 "parsing/parser.ml" in # 2528 "parsing/parser.mly" ( Pexp_ident (_1) ) -# 47478 "parsing/parser.ml" +# 47498 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -47483,13 +47503,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47487 "parsing/parser.ml" +# 47507 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47493 "parsing/parser.ml" +# 47513 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47515,7 +47535,7 @@ module Tables = struct let _1 = # 2530 "parsing/parser.mly" ( Pexp_constant _1 ) -# 47519 "parsing/parser.ml" +# 47539 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -47523,13 +47543,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47527 "parsing/parser.ml" +# 47547 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47533 "parsing/parser.ml" +# 47553 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47560,13 +47580,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 47564 "parsing/parser.ml" +# 47584 "parsing/parser.ml" in # 2532 "parsing/parser.mly" ( Pexp_construct(_1, None) ) -# 47570 "parsing/parser.ml" +# 47590 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -47575,13 +47595,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47579 "parsing/parser.ml" +# 47599 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47585 "parsing/parser.ml" +# 47605 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47607,7 +47627,7 @@ module Tables = struct let _1 = # 2534 "parsing/parser.mly" ( Pexp_variant(_1, None) ) -# 47611 "parsing/parser.ml" +# 47631 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -47615,13 +47635,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47619 "parsing/parser.ml" +# 47639 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47625 "parsing/parser.ml" +# 47645 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47649,7 +47669,7 @@ module Tables = struct let _1 : ( # 798 "parsing/parser.mly" (string) -# 47653 "parsing/parser.ml" +# 47673 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -47663,13 +47683,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 47667 "parsing/parser.ml" +# 47687 "parsing/parser.ml" in # 2536 "parsing/parser.mly" ( Pexp_apply(_1, [Nolabel,_2]) ) -# 47673 "parsing/parser.ml" +# 47693 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -47679,13 +47699,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47683 "parsing/parser.ml" +# 47703 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47689 "parsing/parser.ml" +# 47709 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47720,7 +47740,7 @@ module Tables = struct let _1 = # 2537 "parsing/parser.mly" ("!") -# 47724 "parsing/parser.ml" +# 47744 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -47728,13 +47748,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 47732 "parsing/parser.ml" +# 47752 "parsing/parser.ml" in # 2538 "parsing/parser.mly" ( Pexp_apply(_1, [Nolabel,_2]) ) -# 47738 "parsing/parser.ml" +# 47758 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -47744,13 +47764,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47748 "parsing/parser.ml" +# 47768 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47754 "parsing/parser.ml" +# 47774 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47791,12 +47811,12 @@ module Tables = struct let _2 = # 2810 "parsing/parser.mly" ( xs ) -# 47795 "parsing/parser.ml" +# 47815 "parsing/parser.ml" in # 2540 "parsing/parser.mly" ( Pexp_override _2 ) -# 47800 "parsing/parser.ml" +# 47820 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -47806,13 +47826,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47810 "parsing/parser.ml" +# 47830 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47816 "parsing/parser.ml" +# 47836 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47853,14 +47873,14 @@ module Tables = struct let _2 = # 2810 "parsing/parser.mly" ( xs ) -# 47857 "parsing/parser.ml" +# 47877 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2542 "parsing/parser.mly" ( unclosed "{<" _loc__1_ ">}" _loc__3_ ) -# 47864 "parsing/parser.ml" +# 47884 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -47870,13 +47890,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47874 "parsing/parser.ml" +# 47894 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47880 "parsing/parser.ml" +# 47900 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47909,7 +47929,7 @@ module Tables = struct let _1 = # 2544 "parsing/parser.mly" ( Pexp_override [] ) -# 47913 "parsing/parser.ml" +# 47933 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -47918,13 +47938,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47922 "parsing/parser.ml" +# 47942 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47928 "parsing/parser.ml" +# 47948 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -47970,13 +47990,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 47974 "parsing/parser.ml" +# 47994 "parsing/parser.ml" in # 2546 "parsing/parser.mly" ( Pexp_field(_1, _3) ) -# 47980 "parsing/parser.ml" +# 48000 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -47986,13 +48006,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 47990 "parsing/parser.ml" +# 48010 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 47996 "parsing/parser.ml" +# 48016 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48052,7 +48072,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 48056 "parsing/parser.ml" +# 48076 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -48061,13 +48081,13 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 48065 "parsing/parser.ml" +# 48085 "parsing/parser.ml" in # 2548 "parsing/parser.mly" ( Pexp_open(od, _4) ) -# 48071 "parsing/parser.ml" +# 48091 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -48077,13 +48097,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48081 "parsing/parser.ml" +# 48101 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48087 "parsing/parser.ml" +# 48107 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48138,7 +48158,7 @@ module Tables = struct let _4 = # 2810 "parsing/parser.mly" ( xs ) -# 48142 "parsing/parser.ml" +# 48162 "parsing/parser.ml" in let od = let _1 = @@ -48148,7 +48168,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 48152 "parsing/parser.ml" +# 48172 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -48157,7 +48177,7 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 48161 "parsing/parser.ml" +# 48181 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -48168,7 +48188,7 @@ module Tables = struct # 2550 "parsing/parser.mly" ( (* TODO: review the location of Pexp_override *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) ) -# 48172 "parsing/parser.ml" +# 48192 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -48178,13 +48198,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48182 "parsing/parser.ml" +# 48202 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48188 "parsing/parser.ml" +# 48208 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48239,14 +48259,14 @@ module Tables = struct let _4 = # 2810 "parsing/parser.mly" ( xs ) -# 48243 "parsing/parser.ml" +# 48263 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in # 2553 "parsing/parser.mly" ( unclosed "{<" _loc__3_ ">}" _loc__5_ ) -# 48250 "parsing/parser.ml" +# 48270 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -48256,13 +48276,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48260 "parsing/parser.ml" +# 48280 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48266 "parsing/parser.ml" +# 48286 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48295,7 +48315,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 48299 "parsing/parser.ml" +# 48319 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in @@ -48309,7 +48329,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 48313 "parsing/parser.ml" +# 48333 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -48317,13 +48337,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 48321 "parsing/parser.ml" +# 48341 "parsing/parser.ml" in # 2555 "parsing/parser.mly" ( Pexp_send(_1, _3) ) -# 48327 "parsing/parser.ml" +# 48347 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -48333,13 +48353,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48337 "parsing/parser.ml" +# 48357 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48343 "parsing/parser.ml" +# 48363 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48373,7 +48393,7 @@ module Tables = struct let _1_inlined1 : ( # 809 "parsing/parser.mly" (string) -# 48377 "parsing/parser.ml" +# 48397 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -48389,13 +48409,13 @@ module Tables = struct # 983 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 48393 "parsing/parser.ml" +# 48413 "parsing/parser.ml" in # 2557 "parsing/parser.mly" ( mkinfix _1 _2 _3 ) -# 48399 "parsing/parser.ml" +# 48419 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -48405,13 +48425,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48409 "parsing/parser.ml" +# 48429 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48415 "parsing/parser.ml" +# 48435 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48437,7 +48457,7 @@ module Tables = struct let _1 = # 2559 "parsing/parser.mly" ( Pexp_extension _1 ) -# 48441 "parsing/parser.ml" +# 48461 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -48445,13 +48465,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48449 "parsing/parser.ml" +# 48469 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48455 "parsing/parser.ml" +# 48475 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48501,7 +48521,7 @@ module Tables = struct let _1 = # 2560 "parsing/parser.mly" (Lident "()") -# 48505 "parsing/parser.ml" +# 48525 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -48510,7 +48530,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 48514 "parsing/parser.ml" +# 48534 "parsing/parser.ml" in let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in @@ -48522,7 +48542,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 48526 "parsing/parser.ml" +# 48546 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -48531,14 +48551,14 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 48535 "parsing/parser.ml" +# 48555 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in # 2561 "parsing/parser.mly" ( Pexp_open(od, mkexp ~loc:(_loc__3_) (Pexp_construct(_3, None))) ) -# 48542 "parsing/parser.ml" +# 48562 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -48548,13 +48568,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48552 "parsing/parser.ml" +# 48572 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48558 "parsing/parser.ml" +# 48578 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48611,7 +48631,7 @@ module Tables = struct # 2563 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 48615 "parsing/parser.ml" +# 48635 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -48621,13 +48641,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48625 "parsing/parser.ml" +# 48645 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48631 "parsing/parser.ml" +# 48651 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48669,7 +48689,7 @@ module Tables = struct # 2565 "parsing/parser.mly" ( let (exten, fields) = _2 in Pexp_record(fields, exten) ) -# 48673 "parsing/parser.ml" +# 48693 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -48678,13 +48698,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48682 "parsing/parser.ml" +# 48702 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48688 "parsing/parser.ml" +# 48708 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48728,7 +48748,7 @@ module Tables = struct # 2568 "parsing/parser.mly" ( unclosed "{" _loc__1_ "}" _loc__3_ ) -# 48732 "parsing/parser.ml" +# 48752 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -48738,13 +48758,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48742 "parsing/parser.ml" +# 48762 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48748 "parsing/parser.ml" +# 48768 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48805,7 +48825,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 48809 "parsing/parser.ml" +# 48829 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -48814,7 +48834,7 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 48818 "parsing/parser.ml" +# 48838 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -48823,7 +48843,7 @@ module Tables = struct ( let (exten, fields) = _4 in Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_record(fields, exten))) ) -# 48827 "parsing/parser.ml" +# 48847 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -48833,13 +48853,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48837 "parsing/parser.ml" +# 48857 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48843 "parsing/parser.ml" +# 48863 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48897,7 +48917,7 @@ module Tables = struct # 2574 "parsing/parser.mly" ( unclosed "{" _loc__3_ "}" _loc__5_ ) -# 48901 "parsing/parser.ml" +# 48921 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -48907,13 +48927,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48911 "parsing/parser.ml" +# 48931 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48917 "parsing/parser.ml" +# 48937 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -48954,12 +48974,12 @@ module Tables = struct let _2 = # 2827 "parsing/parser.mly" ( es ) -# 48958 "parsing/parser.ml" +# 48978 "parsing/parser.ml" in # 2576 "parsing/parser.mly" ( Pexp_array(_2) ) -# 48963 "parsing/parser.ml" +# 48983 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -48969,13 +48989,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 48973 "parsing/parser.ml" +# 48993 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 48979 "parsing/parser.ml" +# 48999 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49016,14 +49036,14 @@ module Tables = struct let _2 = # 2827 "parsing/parser.mly" ( es ) -# 49020 "parsing/parser.ml" +# 49040 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2578 "parsing/parser.mly" ( unclosed "[|" _loc__1_ "|]" _loc__3_ ) -# 49027 "parsing/parser.ml" +# 49047 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -49033,13 +49053,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49037 "parsing/parser.ml" +# 49057 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49043 "parsing/parser.ml" +# 49063 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49072,7 +49092,7 @@ module Tables = struct let _1 = # 2580 "parsing/parser.mly" ( Pexp_array [] ) -# 49076 "parsing/parser.ml" +# 49096 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -49081,13 +49101,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49085 "parsing/parser.ml" +# 49105 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49091 "parsing/parser.ml" +# 49111 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49142,7 +49162,7 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 49146 "parsing/parser.ml" +# 49166 "parsing/parser.ml" in let od = let _1 = @@ -49152,7 +49172,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 49156 "parsing/parser.ml" +# 49176 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -49161,14 +49181,14 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 49165 "parsing/parser.ml" +# 49185 "parsing/parser.ml" in let _endpos = _endpos__5_ in # 2582 "parsing/parser.mly" ( Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array(_4))) ) -# 49172 "parsing/parser.ml" +# 49192 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -49178,13 +49198,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49182 "parsing/parser.ml" +# 49202 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49188 "parsing/parser.ml" +# 49208 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49237,7 +49257,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 49241 "parsing/parser.ml" +# 49261 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -49246,7 +49266,7 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 49250 "parsing/parser.ml" +# 49270 "parsing/parser.ml" in let _endpos = _endpos__4_ in @@ -49254,7 +49274,7 @@ module Tables = struct # 2584 "parsing/parser.mly" ( (* TODO: review the location of Pexp_array *) Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array [])) ) -# 49258 "parsing/parser.ml" +# 49278 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -49264,13 +49284,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49268 "parsing/parser.ml" +# 49288 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49274 "parsing/parser.ml" +# 49294 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49325,14 +49345,14 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 49329 "parsing/parser.ml" +# 49349 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in # 2588 "parsing/parser.mly" ( unclosed "[|" _loc__3_ "|]" _loc__5_ ) -# 49336 "parsing/parser.ml" +# 49356 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -49342,13 +49362,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49346 "parsing/parser.ml" +# 49366 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49352 "parsing/parser.ml" +# 49372 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49389,13 +49409,13 @@ module Tables = struct let _2 = # 2827 "parsing/parser.mly" ( es ) -# 49393 "parsing/parser.ml" +# 49413 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in # 2590 "parsing/parser.mly" ( fst (mktailexp _loc__3_ _2) ) -# 49399 "parsing/parser.ml" +# 49419 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -49405,13 +49425,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49409 "parsing/parser.ml" +# 49429 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49415 "parsing/parser.ml" +# 49435 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49452,14 +49472,14 @@ module Tables = struct let _2 = # 2827 "parsing/parser.mly" ( es ) -# 49456 "parsing/parser.ml" +# 49476 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in # 2592 "parsing/parser.mly" ( unclosed "[" _loc__1_ "]" _loc__3_ ) -# 49463 "parsing/parser.ml" +# 49483 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -49469,13 +49489,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49473 "parsing/parser.ml" +# 49493 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49479 "parsing/parser.ml" +# 49499 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49530,7 +49550,7 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 49534 "parsing/parser.ml" +# 49554 "parsing/parser.ml" in let od = let _1 = @@ -49540,7 +49560,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 49544 "parsing/parser.ml" +# 49564 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -49549,7 +49569,7 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 49553 "parsing/parser.ml" +# 49573 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -49561,7 +49581,7 @@ module Tables = struct let tail_exp, _tail_loc = mktailexp _loc__5_ _4 in mkexp ~loc:(_startpos__3_, _endpos) tail_exp in Pexp_open(od, list_exp) ) -# 49565 "parsing/parser.ml" +# 49585 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -49571,13 +49591,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49575 "parsing/parser.ml" +# 49595 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49581 "parsing/parser.ml" +# 49601 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49627,7 +49647,7 @@ module Tables = struct let _1 = # 2599 "parsing/parser.mly" (Lident "[]") -# 49631 "parsing/parser.ml" +# 49651 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -49636,7 +49656,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 49640 "parsing/parser.ml" +# 49660 "parsing/parser.ml" in let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in @@ -49648,7 +49668,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 49652 "parsing/parser.ml" +# 49672 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -49657,14 +49677,14 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 49661 "parsing/parser.ml" +# 49681 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in # 2600 "parsing/parser.mly" ( Pexp_open(od, mkexp ~loc:_loc__3_ (Pexp_construct(_3, None))) ) -# 49668 "parsing/parser.ml" +# 49688 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -49674,13 +49694,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49678 "parsing/parser.ml" +# 49698 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49684 "parsing/parser.ml" +# 49704 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49735,14 +49755,14 @@ module Tables = struct let _4 = # 2827 "parsing/parser.mly" ( es ) -# 49739 "parsing/parser.ml" +# 49759 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in # 2603 "parsing/parser.mly" ( unclosed "[" _loc__3_ "]" _loc__5_ ) -# 49746 "parsing/parser.ml" +# 49766 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -49752,13 +49772,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49756 "parsing/parser.ml" +# 49776 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49762 "parsing/parser.ml" +# 49782 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -49855,7 +49875,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 49859 "parsing/parser.ml" +# 49879 "parsing/parser.ml" in let _5 = @@ -49865,13 +49885,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 49869 "parsing/parser.ml" +# 49889 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 49875 "parsing/parser.ml" +# 49895 "parsing/parser.ml" in let od = @@ -49882,7 +49902,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 49886 "parsing/parser.ml" +# 49906 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in @@ -49891,7 +49911,7 @@ module Tables = struct ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 49895 "parsing/parser.ml" +# 49915 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -49904,7 +49924,7 @@ module Tables = struct mkexp_attrs ~loc:(_startpos__3_, _endpos) (Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in Pexp_open(od, modexp) ) -# 49908 "parsing/parser.ml" +# 49928 "parsing/parser.ml" in let _endpos__1_ = _endpos__9_ in @@ -49914,13 +49934,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 49918 "parsing/parser.ml" +# 49938 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 49924 "parsing/parser.ml" +# 49944 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50007,13 +50027,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 50011 "parsing/parser.ml" +# 50031 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 50017 "parsing/parser.ml" +# 50037 "parsing/parser.ml" in let _loc__8_ = (_startpos__8_, _endpos__8_) in @@ -50021,7 +50041,7 @@ module Tables = struct # 2612 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__8_ ) -# 50025 "parsing/parser.ml" +# 50045 "parsing/parser.ml" in let _endpos__1_ = _endpos__8_ in @@ -50031,13 +50051,13 @@ module Tables = struct # 989 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 50035 "parsing/parser.ml" +# 50055 "parsing/parser.ml" in # 2504 "parsing/parser.mly" ( _1 ) -# 50041 "parsing/parser.ml" +# 50061 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50068,13 +50088,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50072 "parsing/parser.ml" +# 50092 "parsing/parser.ml" in # 2910 "parsing/parser.mly" ( Ppat_var (_1) ) -# 50078 "parsing/parser.ml" +# 50098 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -50083,13 +50103,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50087 "parsing/parser.ml" +# 50107 "parsing/parser.ml" in # 2911 "parsing/parser.mly" ( _1 ) -# 50093 "parsing/parser.ml" +# 50113 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50114,7 +50134,7 @@ module Tables = struct let _v : (Parsetree.pattern) = # 2912 "parsing/parser.mly" ( _1 ) -# 50118 "parsing/parser.ml" +# 50138 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50156,7 +50176,7 @@ module Tables = struct # 2917 "parsing/parser.mly" ( reloc_pat ~loc:_sloc _2 ) -# 50160 "parsing/parser.ml" +# 50180 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50181,7 +50201,7 @@ module Tables = struct let _v : (Parsetree.pattern) = # 2919 "parsing/parser.mly" ( _1 ) -# 50185 "parsing/parser.ml" +# 50205 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50246,7 +50266,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50250 "parsing/parser.ml" +# 50270 "parsing/parser.ml" in let _3 = @@ -50256,13 +50276,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 50260 "parsing/parser.ml" +# 50280 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 50266 "parsing/parser.ml" +# 50286 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -50271,7 +50291,7 @@ module Tables = struct # 2921 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 ) -# 50275 "parsing/parser.ml" +# 50295 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50352,7 +50372,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 50356 "parsing/parser.ml" +# 50376 "parsing/parser.ml" in let _4 = @@ -50363,7 +50383,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50367 "parsing/parser.ml" +# 50387 "parsing/parser.ml" in let (_endpos__4_, _startpos__4_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in @@ -50374,13 +50394,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 50378 "parsing/parser.ml" +# 50398 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 50384 "parsing/parser.ml" +# 50404 "parsing/parser.ml" in let _endpos = _endpos__7_ in @@ -50392,7 +50412,7 @@ module Tables = struct ( mkpat_attrs ~loc:_sloc (Ppat_constraint(mkpat ~loc:_loc__4_ (Ppat_unpack _4), _6)) _3 ) -# 50396 "parsing/parser.ml" +# 50416 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50418,7 +50438,7 @@ module Tables = struct let _1 = # 2931 "parsing/parser.mly" ( Ppat_any ) -# 50422 "parsing/parser.ml" +# 50442 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -50426,13 +50446,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50430 "parsing/parser.ml" +# 50450 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50436 "parsing/parser.ml" +# 50456 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50458,7 +50478,7 @@ module Tables = struct let _1 = # 2933 "parsing/parser.mly" ( Ppat_constant _1 ) -# 50462 "parsing/parser.ml" +# 50482 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -50466,13 +50486,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50470 "parsing/parser.ml" +# 50490 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50476 "parsing/parser.ml" +# 50496 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50512,7 +50532,7 @@ module Tables = struct let _1 = # 2935 "parsing/parser.mly" ( Ppat_interval (_1, _3) ) -# 50516 "parsing/parser.ml" +# 50536 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in @@ -50521,13 +50541,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50525 "parsing/parser.ml" +# 50545 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50531 "parsing/parser.ml" +# 50551 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50558,13 +50578,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50562 "parsing/parser.ml" +# 50582 "parsing/parser.ml" in # 2937 "parsing/parser.mly" ( Ppat_construct(_1, None) ) -# 50568 "parsing/parser.ml" +# 50588 "parsing/parser.ml" in let _endpos = _endpos__1_ in @@ -50573,13 +50593,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50577 "parsing/parser.ml" +# 50597 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50583 "parsing/parser.ml" +# 50603 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50605,7 +50625,7 @@ module Tables = struct let _1 = # 2939 "parsing/parser.mly" ( Ppat_variant(_1, None) ) -# 50609 "parsing/parser.ml" +# 50629 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -50613,13 +50633,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50617 "parsing/parser.ml" +# 50637 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50623 "parsing/parser.ml" +# 50643 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50658,13 +50678,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50662 "parsing/parser.ml" +# 50682 "parsing/parser.ml" in # 2941 "parsing/parser.mly" ( Ppat_type (_2) ) -# 50668 "parsing/parser.ml" +# 50688 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -50674,13 +50694,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50678 "parsing/parser.ml" +# 50698 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50684 "parsing/parser.ml" +# 50704 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50725,13 +50745,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50729 "parsing/parser.ml" +# 50749 "parsing/parser.ml" in # 2943 "parsing/parser.mly" ( Ppat_open(_1, _3) ) -# 50735 "parsing/parser.ml" +# 50755 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -50741,13 +50761,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50745 "parsing/parser.ml" +# 50765 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50751 "parsing/parser.ml" +# 50771 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50797,7 +50817,7 @@ module Tables = struct let _1 = # 2944 "parsing/parser.mly" (Lident "[]") -# 50801 "parsing/parser.ml" +# 50821 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -50806,7 +50826,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50810 "parsing/parser.ml" +# 50830 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -50817,7 +50837,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50821 "parsing/parser.ml" +# 50841 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -50826,7 +50846,7 @@ module Tables = struct # 2945 "parsing/parser.mly" ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) ) -# 50830 "parsing/parser.ml" +# 50850 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -50836,13 +50856,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50840 "parsing/parser.ml" +# 50860 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50846 "parsing/parser.ml" +# 50866 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50892,7 +50912,7 @@ module Tables = struct let _1 = # 2946 "parsing/parser.mly" (Lident "()") -# 50896 "parsing/parser.ml" +# 50916 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in @@ -50901,7 +50921,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50905 "parsing/parser.ml" +# 50925 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -50912,7 +50932,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 50916 "parsing/parser.ml" +# 50936 "parsing/parser.ml" in let _endpos = _endpos__3_ in @@ -50921,7 +50941,7 @@ module Tables = struct # 2947 "parsing/parser.mly" ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) ) -# 50925 "parsing/parser.ml" +# 50945 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -50931,13 +50951,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 50935 "parsing/parser.ml" +# 50955 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 50941 "parsing/parser.ml" +# 50961 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -50996,13 +51016,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 51000 "parsing/parser.ml" +# 51020 "parsing/parser.ml" in # 2949 "parsing/parser.mly" ( Ppat_open (_1, _4) ) -# 51006 "parsing/parser.ml" +# 51026 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -51012,13 +51032,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51016 "parsing/parser.ml" +# 51036 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51022 "parsing/parser.ml" +# 51042 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51075,7 +51095,7 @@ module Tables = struct # 2951 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 51079 "parsing/parser.ml" +# 51099 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -51085,13 +51105,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51089 "parsing/parser.ml" +# 51109 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51095 "parsing/parser.ml" +# 51115 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51140,7 +51160,7 @@ module Tables = struct # 2953 "parsing/parser.mly" ( expecting _loc__4_ "pattern" ) -# 51144 "parsing/parser.ml" +# 51164 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -51150,13 +51170,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51154 "parsing/parser.ml" +# 51174 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51160 "parsing/parser.ml" +# 51180 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51199,7 +51219,7 @@ module Tables = struct # 2955 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 51203 "parsing/parser.ml" +# 51223 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -51209,13 +51229,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51213 "parsing/parser.ml" +# 51233 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51219 "parsing/parser.ml" +# 51239 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51269,7 +51289,7 @@ module Tables = struct let _1 = # 2957 "parsing/parser.mly" ( Ppat_constraint(_2, _4) ) -# 51273 "parsing/parser.ml" +# 51293 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in let _endpos = _endpos__1_ in @@ -51278,13 +51298,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51282 "parsing/parser.ml" +# 51302 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51288 "parsing/parser.ml" +# 51308 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51341,7 +51361,7 @@ module Tables = struct # 2959 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 51345 "parsing/parser.ml" +# 51365 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -51351,13 +51371,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51355 "parsing/parser.ml" +# 51375 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51361 "parsing/parser.ml" +# 51381 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51406,7 +51426,7 @@ module Tables = struct # 2961 "parsing/parser.mly" ( expecting _loc__4_ "type" ) -# 51410 "parsing/parser.ml" +# 51430 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -51416,13 +51436,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51420 "parsing/parser.ml" +# 51440 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51426 "parsing/parser.ml" +# 51446 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51505,7 +51525,7 @@ module Tables = struct ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 51509 "parsing/parser.ml" +# 51529 "parsing/parser.ml" in let _3 = @@ -51515,13 +51535,13 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 51519 "parsing/parser.ml" +# 51539 "parsing/parser.ml" in # 4071 "parsing/parser.mly" ( _1, _2 ) -# 51525 "parsing/parser.ml" +# 51545 "parsing/parser.ml" in let _loc__7_ = (_startpos__7_, _endpos__7_) in @@ -51529,7 +51549,7 @@ module Tables = struct # 2964 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__7_ ) -# 51533 "parsing/parser.ml" +# 51553 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -51539,13 +51559,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51543 "parsing/parser.ml" +# 51563 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51549 "parsing/parser.ml" +# 51569 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51571,7 +51591,7 @@ module Tables = struct let _1 = # 2966 "parsing/parser.mly" ( Ppat_extension _1 ) -# 51575 "parsing/parser.ml" +# 51595 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -51579,13 +51599,13 @@ module Tables = struct # 991 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 51583 "parsing/parser.ml" +# 51603 "parsing/parser.ml" in # 2927 "parsing/parser.mly" ( _1 ) -# 51589 "parsing/parser.ml" +# 51609 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51606,7 +51626,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 51610 "parsing/parser.ml" +# 51630 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -51614,7 +51634,7 @@ module Tables = struct let _v : (string) = # 3979 "parsing/parser.mly" ( _1 ) -# 51618 "parsing/parser.ml" +# 51638 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51635,7 +51655,7 @@ module Tables = struct let _1 : ( # 825 "parsing/parser.mly" (string) -# 51639 "parsing/parser.ml" +# 51659 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -51643,7 +51663,7 @@ module Tables = struct let _v : (string) = # 3980 "parsing/parser.mly" ( _1 ) -# 51647 "parsing/parser.ml" +# 51667 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51668,7 +51688,7 @@ module Tables = struct let _v : (string) = # 3981 "parsing/parser.mly" ( "and" ) -# 51672 "parsing/parser.ml" +# 51692 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51693,7 +51713,7 @@ module Tables = struct let _v : (string) = # 3982 "parsing/parser.mly" ( "as" ) -# 51697 "parsing/parser.ml" +# 51717 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51718,7 +51738,7 @@ module Tables = struct let _v : (string) = # 3983 "parsing/parser.mly" ( "assert" ) -# 51722 "parsing/parser.ml" +# 51742 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51743,7 +51763,7 @@ module Tables = struct let _v : (string) = # 3984 "parsing/parser.mly" ( "begin" ) -# 51747 "parsing/parser.ml" +# 51767 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51768,7 +51788,7 @@ module Tables = struct let _v : (string) = # 3985 "parsing/parser.mly" ( "class" ) -# 51772 "parsing/parser.ml" +# 51792 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51793,7 +51813,7 @@ module Tables = struct let _v : (string) = # 3986 "parsing/parser.mly" ( "constraint" ) -# 51797 "parsing/parser.ml" +# 51817 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51818,7 +51838,7 @@ module Tables = struct let _v : (string) = # 3987 "parsing/parser.mly" ( "do" ) -# 51822 "parsing/parser.ml" +# 51842 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51843,7 +51863,7 @@ module Tables = struct let _v : (string) = # 3988 "parsing/parser.mly" ( "done" ) -# 51847 "parsing/parser.ml" +# 51867 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51868,7 +51888,7 @@ module Tables = struct let _v : (string) = # 3989 "parsing/parser.mly" ( "downto" ) -# 51872 "parsing/parser.ml" +# 51892 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51893,7 +51913,7 @@ module Tables = struct let _v : (string) = # 3990 "parsing/parser.mly" ( "else" ) -# 51897 "parsing/parser.ml" +# 51917 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51918,7 +51938,7 @@ module Tables = struct let _v : (string) = # 3991 "parsing/parser.mly" ( "end" ) -# 51922 "parsing/parser.ml" +# 51942 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51943,7 +51963,7 @@ module Tables = struct let _v : (string) = # 3992 "parsing/parser.mly" ( "exception" ) -# 51947 "parsing/parser.ml" +# 51967 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51968,7 +51988,7 @@ module Tables = struct let _v : (string) = # 3993 "parsing/parser.mly" ( "external" ) -# 51972 "parsing/parser.ml" +# 51992 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -51993,7 +52013,7 @@ module Tables = struct let _v : (string) = # 3994 "parsing/parser.mly" ( "false" ) -# 51997 "parsing/parser.ml" +# 52017 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52018,7 +52038,7 @@ module Tables = struct let _v : (string) = # 3995 "parsing/parser.mly" ( "for" ) -# 52022 "parsing/parser.ml" +# 52042 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52043,7 +52063,7 @@ module Tables = struct let _v : (string) = # 3996 "parsing/parser.mly" ( "fun" ) -# 52047 "parsing/parser.ml" +# 52067 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52068,7 +52088,7 @@ module Tables = struct let _v : (string) = # 3997 "parsing/parser.mly" ( "function" ) -# 52072 "parsing/parser.ml" +# 52092 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52093,7 +52113,7 @@ module Tables = struct let _v : (string) = # 3998 "parsing/parser.mly" ( "functor" ) -# 52097 "parsing/parser.ml" +# 52117 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52118,7 +52138,7 @@ module Tables = struct let _v : (string) = # 3999 "parsing/parser.mly" ( "if" ) -# 52122 "parsing/parser.ml" +# 52142 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52143,7 +52163,7 @@ module Tables = struct let _v : (string) = # 4000 "parsing/parser.mly" ( "in" ) -# 52147 "parsing/parser.ml" +# 52167 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52168,7 +52188,7 @@ module Tables = struct let _v : (string) = # 4001 "parsing/parser.mly" ( "include" ) -# 52172 "parsing/parser.ml" +# 52192 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52193,7 +52213,7 @@ module Tables = struct let _v : (string) = # 4002 "parsing/parser.mly" ( "inherit" ) -# 52197 "parsing/parser.ml" +# 52217 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52218,7 +52238,7 @@ module Tables = struct let _v : (string) = # 4003 "parsing/parser.mly" ( "initializer" ) -# 52222 "parsing/parser.ml" +# 52242 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52243,7 +52263,7 @@ module Tables = struct let _v : (string) = # 4004 "parsing/parser.mly" ( "lazy" ) -# 52247 "parsing/parser.ml" +# 52267 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52268,7 +52288,7 @@ module Tables = struct let _v : (string) = # 4005 "parsing/parser.mly" ( "let" ) -# 52272 "parsing/parser.ml" +# 52292 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52293,7 +52313,7 @@ module Tables = struct let _v : (string) = # 4006 "parsing/parser.mly" ( "match" ) -# 52297 "parsing/parser.ml" +# 52317 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52318,7 +52338,7 @@ module Tables = struct let _v : (string) = # 4007 "parsing/parser.mly" ( "method" ) -# 52322 "parsing/parser.ml" +# 52342 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52343,7 +52363,7 @@ module Tables = struct let _v : (string) = # 4008 "parsing/parser.mly" ( "module" ) -# 52347 "parsing/parser.ml" +# 52367 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52368,7 +52388,7 @@ module Tables = struct let _v : (string) = # 4009 "parsing/parser.mly" ( "mutable" ) -# 52372 "parsing/parser.ml" +# 52392 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52393,7 +52413,7 @@ module Tables = struct let _v : (string) = # 4010 "parsing/parser.mly" ( "new" ) -# 52397 "parsing/parser.ml" +# 52417 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52418,7 +52438,7 @@ module Tables = struct let _v : (string) = # 4011 "parsing/parser.mly" ( "nonrec" ) -# 52422 "parsing/parser.ml" +# 52442 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52443,7 +52463,7 @@ module Tables = struct let _v : (string) = # 4012 "parsing/parser.mly" ( "object" ) -# 52447 "parsing/parser.ml" +# 52467 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52468,7 +52488,7 @@ module Tables = struct let _v : (string) = # 4013 "parsing/parser.mly" ( "of" ) -# 52472 "parsing/parser.ml" +# 52492 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52493,7 +52513,7 @@ module Tables = struct let _v : (string) = # 4014 "parsing/parser.mly" ( "open" ) -# 52497 "parsing/parser.ml" +# 52517 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52518,7 +52538,7 @@ module Tables = struct let _v : (string) = # 4015 "parsing/parser.mly" ( "or" ) -# 52522 "parsing/parser.ml" +# 52542 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52543,7 +52563,7 @@ module Tables = struct let _v : (string) = # 4016 "parsing/parser.mly" ( "private" ) -# 52547 "parsing/parser.ml" +# 52567 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52568,7 +52588,7 @@ module Tables = struct let _v : (string) = # 4017 "parsing/parser.mly" ( "rec" ) -# 52572 "parsing/parser.ml" +# 52592 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52593,7 +52613,7 @@ module Tables = struct let _v : (string) = # 4018 "parsing/parser.mly" ( "sig" ) -# 52597 "parsing/parser.ml" +# 52617 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52618,7 +52638,7 @@ module Tables = struct let _v : (string) = # 4019 "parsing/parser.mly" ( "struct" ) -# 52622 "parsing/parser.ml" +# 52642 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52643,7 +52663,7 @@ module Tables = struct let _v : (string) = # 4020 "parsing/parser.mly" ( "then" ) -# 52647 "parsing/parser.ml" +# 52667 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52668,7 +52688,7 @@ module Tables = struct let _v : (string) = # 4021 "parsing/parser.mly" ( "to" ) -# 52672 "parsing/parser.ml" +# 52692 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52693,7 +52713,7 @@ module Tables = struct let _v : (string) = # 4022 "parsing/parser.mly" ( "true" ) -# 52697 "parsing/parser.ml" +# 52717 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52718,7 +52738,7 @@ module Tables = struct let _v : (string) = # 4023 "parsing/parser.mly" ( "try" ) -# 52722 "parsing/parser.ml" +# 52742 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52743,7 +52763,7 @@ module Tables = struct let _v : (string) = # 4024 "parsing/parser.mly" ( "type" ) -# 52747 "parsing/parser.ml" +# 52767 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52768,7 +52788,7 @@ module Tables = struct let _v : (string) = # 4025 "parsing/parser.mly" ( "val" ) -# 52772 "parsing/parser.ml" +# 52792 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52793,7 +52813,7 @@ module Tables = struct let _v : (string) = # 4026 "parsing/parser.mly" ( "virtual" ) -# 52797 "parsing/parser.ml" +# 52817 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52818,7 +52838,7 @@ module Tables = struct let _v : (string) = # 4027 "parsing/parser.mly" ( "when" ) -# 52822 "parsing/parser.ml" +# 52842 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52843,7 +52863,7 @@ module Tables = struct let _v : (string) = # 4028 "parsing/parser.mly" ( "while" ) -# 52847 "parsing/parser.ml" +# 52867 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52868,7 +52888,7 @@ module Tables = struct let _v : (string) = # 4029 "parsing/parser.mly" ( "with" ) -# 52872 "parsing/parser.ml" +# 52892 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52893,7 +52913,7 @@ module Tables = struct let _v : (Parsetree.type_exception * string Asttypes.loc option) = # 3245 "parsing/parser.mly" ( _1 ) -# 52897 "parsing/parser.ml" +# 52917 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -52969,7 +52989,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 52973 "parsing/parser.ml" +# 52993 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined5_ in @@ -52978,7 +52998,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 52982 "parsing/parser.ml" +# 53002 "parsing/parser.ml" in let lid = @@ -52989,7 +53009,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 52993 "parsing/parser.ml" +# 53013 "parsing/parser.ml" in let id = @@ -53000,7 +53020,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 53004 "parsing/parser.ml" +# 53024 "parsing/parser.ml" in let attrs1 = @@ -53008,7 +53028,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 53012 "parsing/parser.ml" +# 53032 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in @@ -53021,7 +53041,7 @@ module Tables = struct Te.mk_exception ~attrs (Te.rebind id lid ~attrs:(attrs1 @ attrs2) ~loc ~docs) , ext ) -# 53025 "parsing/parser.ml" +# 53045 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53053,7 +53073,7 @@ module Tables = struct let _v : (Parsetree.expression) = # 2731 "parsing/parser.mly" ( _2 ) -# 53057 "parsing/parser.ml" +# 53077 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53103,7 +53123,7 @@ module Tables = struct # 2733 "parsing/parser.mly" ( ghexp ~loc:_sloc (mkfunction _1 _2 _4) ) -# 53107 "parsing/parser.ml" +# 53127 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53130,24 +53150,24 @@ module Tables = struct let ys = # 260 "" ( List.flatten xss ) -# 53134 "parsing/parser.ml" +# 53154 "parsing/parser.ml" in let xs = let items = # 1026 "parsing/parser.mly" ( [] ) -# 53140 "parsing/parser.ml" +# 53160 "parsing/parser.ml" in # 1477 "parsing/parser.mly" ( items ) -# 53145 "parsing/parser.ml" +# 53165 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 53151 "parsing/parser.ml" +# 53171 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -53156,13 +53176,13 @@ module Tables = struct # 948 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 53160 "parsing/parser.ml" +# 53180 "parsing/parser.ml" in # 1470 "parsing/parser.mly" ( _1 ) -# 53166 "parsing/parser.ml" +# 53186 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53203,7 +53223,7 @@ module Tables = struct let ys = # 260 "" ( List.flatten xss ) -# 53207 "parsing/parser.ml" +# 53227 "parsing/parser.ml" in let xs = let items = @@ -53213,12 +53233,12 @@ module Tables = struct let attrs = # 4054 "parsing/parser.mly" ( _1 ) -# 53217 "parsing/parser.ml" +# 53237 "parsing/parser.ml" in # 1484 "parsing/parser.mly" ( mkstrexp e attrs ) -# 53222 "parsing/parser.ml" +# 53242 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -53226,7 +53246,7 @@ module Tables = struct # 960 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 53230 "parsing/parser.ml" +# 53250 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -53236,25 +53256,25 @@ module Tables = struct # 979 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 53240 "parsing/parser.ml" +# 53260 "parsing/parser.ml" in # 1028 "parsing/parser.mly" ( x ) -# 53246 "parsing/parser.ml" +# 53266 "parsing/parser.ml" in # 1477 "parsing/parser.mly" ( items ) -# 53252 "parsing/parser.ml" +# 53272 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 53258 "parsing/parser.ml" +# 53278 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in @@ -53263,13 +53283,13 @@ module Tables = struct # 948 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 53267 "parsing/parser.ml" +# 53287 "parsing/parser.ml" in # 1470 "parsing/parser.mly" ( _1 ) -# 53273 "parsing/parser.ml" +# 53293 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53297,7 +53317,7 @@ module Tables = struct # 1499 "parsing/parser.mly" ( val_of_let_bindings ~loc:_sloc _1 ) -# 53301 "parsing/parser.ml" +# 53321 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53333,7 +53353,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 53337 "parsing/parser.ml" +# 53357 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -53344,7 +53364,7 @@ module Tables = struct # 1502 "parsing/parser.mly" ( let docs = symbol_docs _sloc in Pstr_extension (_1, add_docs_attrs docs _2) ) -# 53348 "parsing/parser.ml" +# 53368 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -53354,13 +53374,13 @@ module Tables = struct # 995 "parsing/parser.mly" ( mkstr ~loc:_sloc _1 ) -# 53358 "parsing/parser.ml" +# 53378 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53364 "parsing/parser.ml" +# 53384 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53386,7 +53406,7 @@ module Tables = struct let _1 = # 1505 "parsing/parser.mly" ( Pstr_attribute _1 ) -# 53390 "parsing/parser.ml" +# 53410 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -53394,13 +53414,13 @@ module Tables = struct # 995 "parsing/parser.mly" ( mkstr ~loc:_sloc _1 ) -# 53398 "parsing/parser.ml" +# 53418 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53404 "parsing/parser.ml" +# 53424 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53426,7 +53446,7 @@ module Tables = struct let _1 = # 1509 "parsing/parser.mly" ( pstr_primitive _1 ) -# 53430 "parsing/parser.ml" +# 53450 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -53434,13 +53454,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 53438 "parsing/parser.ml" +# 53458 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53444 "parsing/parser.ml" +# 53464 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53466,7 +53486,7 @@ module Tables = struct let _1 = # 1511 "parsing/parser.mly" ( pstr_primitive _1 ) -# 53470 "parsing/parser.ml" +# 53490 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -53474,13 +53494,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 53478 "parsing/parser.ml" +# 53498 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53484 "parsing/parser.ml" +# 53504 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53517,24 +53537,24 @@ module Tables = struct let _1 = # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 53521 "parsing/parser.ml" +# 53541 "parsing/parser.ml" in # 3089 "parsing/parser.mly" ( _1 ) -# 53526 "parsing/parser.ml" +# 53546 "parsing/parser.ml" in # 3072 "parsing/parser.mly" ( _1 ) -# 53532 "parsing/parser.ml" +# 53552 "parsing/parser.ml" in # 1513 "parsing/parser.mly" ( pstr_type _1 ) -# 53538 "parsing/parser.ml" +# 53558 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -53544,13 +53564,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 53548 "parsing/parser.ml" +# 53568 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53554 "parsing/parser.ml" +# 53574 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53637,14 +53657,14 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 53641 "parsing/parser.ml" +# 53661 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let cs = # 1200 "parsing/parser.mly" ( List.rev xs ) -# 53648 "parsing/parser.ml" +# 53668 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -53654,20 +53674,20 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 53658 "parsing/parser.ml" +# 53678 "parsing/parser.ml" in let _4 = # 3899 "parsing/parser.mly" ( Recursive ) -# 53664 "parsing/parser.ml" +# 53684 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in # 4058 "parsing/parser.mly" ( _1 ) -# 53671 "parsing/parser.ml" +# 53691 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -53679,19 +53699,19 @@ module Tables = struct let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 53683 "parsing/parser.ml" +# 53703 "parsing/parser.ml" in # 3325 "parsing/parser.mly" ( _1 ) -# 53689 "parsing/parser.ml" +# 53709 "parsing/parser.ml" in # 1515 "parsing/parser.mly" ( pstr_typext _1 ) -# 53695 "parsing/parser.ml" +# 53715 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -53701,13 +53721,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 53705 "parsing/parser.ml" +# 53725 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53711 "parsing/parser.ml" +# 53731 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53801,14 +53821,14 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 53805 "parsing/parser.ml" +# 53825 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in let cs = # 1200 "parsing/parser.mly" ( List.rev xs ) -# 53812 "parsing/parser.ml" +# 53832 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in @@ -53818,7 +53838,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 53822 "parsing/parser.ml" +# 53842 "parsing/parser.ml" in let _4 = @@ -53829,7 +53849,7 @@ module Tables = struct # 3901 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 53833 "parsing/parser.ml" +# 53853 "parsing/parser.ml" in let attrs1 = @@ -53837,7 +53857,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 53841 "parsing/parser.ml" +# 53861 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -53849,19 +53869,19 @@ module Tables = struct let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 53853 "parsing/parser.ml" +# 53873 "parsing/parser.ml" in # 3325 "parsing/parser.mly" ( _1 ) -# 53859 "parsing/parser.ml" +# 53879 "parsing/parser.ml" in # 1515 "parsing/parser.mly" ( pstr_typext _1 ) -# 53865 "parsing/parser.ml" +# 53885 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -53871,13 +53891,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 53875 "parsing/parser.ml" +# 53895 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53881 "parsing/parser.ml" +# 53901 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53903,7 +53923,7 @@ module Tables = struct let _1 = # 1517 "parsing/parser.mly" ( pstr_exception _1 ) -# 53907 "parsing/parser.ml" +# 53927 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -53911,13 +53931,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 53915 "parsing/parser.ml" +# 53935 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 53921 "parsing/parser.ml" +# 53941 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -53982,7 +54002,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 53986 "parsing/parser.ml" +# 54006 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -53994,7 +54014,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 53998 "parsing/parser.ml" +# 54018 "parsing/parser.ml" in let attrs1 = @@ -54002,7 +54022,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 54006 "parsing/parser.ml" +# 54026 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -54015,13 +54035,13 @@ module Tables = struct let attrs = attrs1 @ attrs2 in let body = Mb.mk name body ~attrs ~loc ~docs in Pstr_module body, ext ) -# 54019 "parsing/parser.ml" +# 54039 "parsing/parser.ml" in # 1519 "parsing/parser.mly" ( _1 ) -# 54025 "parsing/parser.ml" +# 54045 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -54031,13 +54051,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 54035 "parsing/parser.ml" +# 54055 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 54041 "parsing/parser.ml" +# 54061 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54118,7 +54138,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 54122 "parsing/parser.ml" +# 54142 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -54130,7 +54150,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 54134 "parsing/parser.ml" +# 54154 "parsing/parser.ml" in let attrs1 = @@ -54138,7 +54158,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 54142 "parsing/parser.ml" +# 54162 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -54153,25 +54173,25 @@ module Tables = struct ext, Mb.mk name body ~attrs ~loc ~docs ) -# 54157 "parsing/parser.ml" +# 54177 "parsing/parser.ml" in # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 54163 "parsing/parser.ml" +# 54183 "parsing/parser.ml" in # 1568 "parsing/parser.mly" ( _1 ) -# 54169 "parsing/parser.ml" +# 54189 "parsing/parser.ml" in # 1521 "parsing/parser.mly" ( pstr_recmodule _1 ) -# 54175 "parsing/parser.ml" +# 54195 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -54181,13 +54201,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 54185 "parsing/parser.ml" +# 54205 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 54191 "parsing/parser.ml" +# 54211 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54213,7 +54233,7 @@ module Tables = struct let _1 = # 1523 "parsing/parser.mly" ( let (body, ext) = _1 in (Pstr_modtype body, ext) ) -# 54217 "parsing/parser.ml" +# 54237 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -54221,13 +54241,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 54225 "parsing/parser.ml" +# 54245 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 54231 "parsing/parser.ml" +# 54251 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54253,7 +54273,7 @@ module Tables = struct let _1 = # 1525 "parsing/parser.mly" ( let (body, ext) = _1 in (Pstr_open body, ext) ) -# 54257 "parsing/parser.ml" +# 54277 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -54261,13 +54281,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 54265 "parsing/parser.ml" +# 54285 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 54271 "parsing/parser.ml" +# 54291 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54339,7 +54359,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 54343 "parsing/parser.ml" +# 54363 "parsing/parser.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 @@ -54359,7 +54379,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 54363 "parsing/parser.ml" +# 54383 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -54371,7 +54391,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 54375 "parsing/parser.ml" +# 54395 "parsing/parser.ml" in let attrs1 = @@ -54379,7 +54399,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 54383 "parsing/parser.ml" +# 54403 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -54394,25 +54414,25 @@ module Tables = struct ext, Ci.mk id body ~virt ~params ~attrs ~loc ~docs ) -# 54398 "parsing/parser.ml" +# 54418 "parsing/parser.ml" in # 1208 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 54404 "parsing/parser.ml" +# 54424 "parsing/parser.ml" in # 1913 "parsing/parser.mly" ( _1 ) -# 54410 "parsing/parser.ml" +# 54430 "parsing/parser.ml" in # 1527 "parsing/parser.mly" ( let (ext, l) = _1 in (Pstr_class l, ext) ) -# 54416 "parsing/parser.ml" +# 54436 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -54422,13 +54442,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 54426 "parsing/parser.ml" +# 54446 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 54432 "parsing/parser.ml" +# 54452 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54454,7 +54474,7 @@ module Tables = struct let _1 = # 1529 "parsing/parser.mly" ( let (ext, l) = _1 in (Pstr_class_type l, ext) ) -# 54458 "parsing/parser.ml" +# 54478 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -54462,13 +54482,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 54466 "parsing/parser.ml" +# 54486 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 54472 "parsing/parser.ml" +# 54492 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54526,7 +54546,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 54530 "parsing/parser.ml" +# 54550 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in @@ -54535,7 +54555,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 54539 "parsing/parser.ml" +# 54559 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -54549,13 +54569,13 @@ module Tables = struct let docs = symbol_docs _sloc in Incl.mk thing ~attrs ~loc ~docs, ext ) -# 54553 "parsing/parser.ml" +# 54573 "parsing/parser.ml" in # 1531 "parsing/parser.mly" ( pstr_include _1 ) -# 54559 "parsing/parser.ml" +# 54579 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined2_ in @@ -54565,13 +54585,13 @@ module Tables = struct # 1012 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 54569 "parsing/parser.ml" +# 54589 "parsing/parser.ml" in # 1533 "parsing/parser.mly" ( _1 ) -# 54575 "parsing/parser.ml" +# 54595 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54596,7 +54616,7 @@ module Tables = struct let _v : (string) = # 3964 "parsing/parser.mly" ( "-" ) -# 54600 "parsing/parser.ml" +# 54620 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54621,7 +54641,7 @@ module Tables = struct let _v : (string) = # 3965 "parsing/parser.mly" ( "-." ) -# 54625 "parsing/parser.ml" +# 54645 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54676,7 +54696,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 54680 "parsing/parser.ml" +# 54700 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined1_ in @@ -54685,18 +54705,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 54689 "parsing/parser.ml" +# 54709 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 54694 "parsing/parser.ml" +# 54714 "parsing/parser.ml" in # 3672 "parsing/parser.mly" ( _1 ) -# 54700 "parsing/parser.ml" +# 54720 "parsing/parser.ml" in let _1 = @@ -54706,7 +54726,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 54710 "parsing/parser.ml" +# 54730 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -54717,7 +54737,7 @@ module Tables = struct ( let info = symbol_info _endpos in let attrs = add_info_attrs info _5 in Rf.tag ~loc:(make_loc _sloc) ~attrs _1 _3 _4 ) -# 54721 "parsing/parser.ml" +# 54741 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54751,7 +54771,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 54755 "parsing/parser.ml" +# 54775 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -54762,7 +54782,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 54766 "parsing/parser.ml" +# 54786 "parsing/parser.ml" in let _endpos = _endpos__2_ in @@ -54773,7 +54793,7 @@ module Tables = struct ( let info = symbol_info _endpos in let attrs = add_info_attrs info _2 in Rf.tag ~loc:(make_loc _sloc) ~attrs _1 true [] ) -# 54777 "parsing/parser.ml" +# 54797 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54805,7 +54825,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase) = let arg = # 124 "" ( None ) -# 54809 "parsing/parser.ml" +# 54829 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined1_ in let dir = @@ -54816,7 +54836,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 54820 "parsing/parser.ml" +# 54840 "parsing/parser.ml" in let _endpos = _endpos_arg_ in @@ -54825,7 +54845,7 @@ module Tables = struct # 3862 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 54829 "parsing/parser.ml" +# 54849 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54858,7 +54878,7 @@ module Tables = struct let _1_inlined2 : ( # 812 "parsing/parser.mly" (string * Location.t * string option) -# 54862 "parsing/parser.ml" +# 54882 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in @@ -54871,7 +54891,7 @@ module Tables = struct let _1 = # 3866 "parsing/parser.mly" ( let (s, _, _) = _1 in Pdir_string s ) -# 54875 "parsing/parser.ml" +# 54895 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -54879,13 +54899,13 @@ module Tables = struct # 1017 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 54883 "parsing/parser.ml" +# 54903 "parsing/parser.ml" in # 126 "" ( Some x ) -# 54889 "parsing/parser.ml" +# 54909 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -54897,7 +54917,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 54901 "parsing/parser.ml" +# 54921 "parsing/parser.ml" in let _endpos = _endpos_arg_ in @@ -54906,7 +54926,7 @@ module Tables = struct # 3862 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 54910 "parsing/parser.ml" +# 54930 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -54939,7 +54959,7 @@ module Tables = struct let _1_inlined2 : ( # 760 "parsing/parser.mly" (string * char option) -# 54943 "parsing/parser.ml" +# 54963 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in @@ -54952,7 +54972,7 @@ module Tables = struct let _1 = # 3867 "parsing/parser.mly" ( let (n, m) = _1 in Pdir_int (n ,m) ) -# 54956 "parsing/parser.ml" +# 54976 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -54960,13 +54980,13 @@ module Tables = struct # 1017 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 54964 "parsing/parser.ml" +# 54984 "parsing/parser.ml" in # 126 "" ( Some x ) -# 54970 "parsing/parser.ml" +# 54990 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -54978,7 +54998,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 54982 "parsing/parser.ml" +# 55002 "parsing/parser.ml" in let _endpos = _endpos_arg_ in @@ -54987,7 +55007,7 @@ module Tables = struct # 3862 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 54991 "parsing/parser.ml" +# 55011 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55029,7 +55049,7 @@ module Tables = struct let _1 = # 3868 "parsing/parser.mly" ( Pdir_ident _1 ) -# 55033 "parsing/parser.ml" +# 55053 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -55037,13 +55057,13 @@ module Tables = struct # 1017 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 55041 "parsing/parser.ml" +# 55061 "parsing/parser.ml" in # 126 "" ( Some x ) -# 55047 "parsing/parser.ml" +# 55067 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -55055,7 +55075,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 55059 "parsing/parser.ml" +# 55079 "parsing/parser.ml" in let _endpos = _endpos_arg_ in @@ -55064,7 +55084,7 @@ module Tables = struct # 3862 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 55068 "parsing/parser.ml" +# 55088 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55106,7 +55126,7 @@ module Tables = struct let _1 = # 3869 "parsing/parser.mly" ( Pdir_ident _1 ) -# 55110 "parsing/parser.ml" +# 55130 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -55114,13 +55134,13 @@ module Tables = struct # 1017 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 55118 "parsing/parser.ml" +# 55138 "parsing/parser.ml" in # 126 "" ( Some x ) -# 55124 "parsing/parser.ml" +# 55144 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -55132,7 +55152,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 55136 "parsing/parser.ml" +# 55156 "parsing/parser.ml" in let _endpos = _endpos_arg_ in @@ -55141,7 +55161,7 @@ module Tables = struct # 3862 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 55145 "parsing/parser.ml" +# 55165 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55183,7 +55203,7 @@ module Tables = struct let _1 = # 3870 "parsing/parser.mly" ( Pdir_bool false ) -# 55187 "parsing/parser.ml" +# 55207 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -55191,13 +55211,13 @@ module Tables = struct # 1017 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 55195 "parsing/parser.ml" +# 55215 "parsing/parser.ml" in # 126 "" ( Some x ) -# 55201 "parsing/parser.ml" +# 55221 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -55209,7 +55229,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 55213 "parsing/parser.ml" +# 55233 "parsing/parser.ml" in let _endpos = _endpos_arg_ in @@ -55218,7 +55238,7 @@ module Tables = struct # 3862 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 55222 "parsing/parser.ml" +# 55242 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55260,7 +55280,7 @@ module Tables = struct let _1 = # 3871 "parsing/parser.mly" ( Pdir_bool true ) -# 55264 "parsing/parser.ml" +# 55284 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -55268,13 +55288,13 @@ module Tables = struct # 1017 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 55272 "parsing/parser.ml" +# 55292 "parsing/parser.ml" in # 126 "" ( Some x ) -# 55278 "parsing/parser.ml" +# 55298 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -55286,7 +55306,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 55290 "parsing/parser.ml" +# 55310 "parsing/parser.ml" in let _endpos = _endpos_arg_ in @@ -55295,7 +55315,7 @@ module Tables = struct # 3862 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 55299 "parsing/parser.ml" +# 55319 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55337,12 +55357,12 @@ module Tables = struct let attrs = # 4054 "parsing/parser.mly" ( _1 ) -# 55341 "parsing/parser.ml" +# 55361 "parsing/parser.ml" in # 1484 "parsing/parser.mly" ( mkstrexp e attrs ) -# 55346 "parsing/parser.ml" +# 55366 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -55350,7 +55370,7 @@ module Tables = struct # 960 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 55354 "parsing/parser.ml" +# 55374 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -55359,13 +55379,13 @@ module Tables = struct # 948 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 55363 "parsing/parser.ml" +# 55383 "parsing/parser.ml" in # 1248 "parsing/parser.mly" ( Ptop_def _1 ) -# 55369 "parsing/parser.ml" +# 55389 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55398,7 +55418,7 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 55402 "parsing/parser.ml" +# 55422 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in @@ -55406,13 +55426,13 @@ module Tables = struct # 948 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 55410 "parsing/parser.ml" +# 55430 "parsing/parser.ml" in # 1252 "parsing/parser.mly" ( Ptop_def _1 ) -# 55416 "parsing/parser.ml" +# 55436 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55444,7 +55464,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase) = # 1256 "parsing/parser.mly" ( _1 ) -# 55448 "parsing/parser.ml" +# 55468 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55469,7 +55489,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase) = # 1259 "parsing/parser.mly" ( raise End_of_file ) -# 55473 "parsing/parser.ml" +# 55493 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55494,7 +55514,7 @@ module Tables = struct let _v : (Parsetree.core_type) = # 3508 "parsing/parser.mly" ( ty ) -# 55498 "parsing/parser.ml" +# 55518 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55522,18 +55542,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 55526 "parsing/parser.ml" +# 55546 "parsing/parser.ml" in # 1139 "parsing/parser.mly" ( xs ) -# 55531 "parsing/parser.ml" +# 55551 "parsing/parser.ml" in # 3511 "parsing/parser.mly" ( Ptyp_tuple tys ) -# 55537 "parsing/parser.ml" +# 55557 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in @@ -55543,13 +55563,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 55547 "parsing/parser.ml" +# 55567 "parsing/parser.ml" in # 3513 "parsing/parser.mly" ( _1 ) -# 55553 "parsing/parser.ml" +# 55573 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55581,7 +55601,7 @@ module Tables = struct let _v : (Parsetree.type_constraint) = # 2830 "parsing/parser.mly" ( Pconstraint _2 ) -# 55585 "parsing/parser.ml" +# 55605 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55627,7 +55647,7 @@ module Tables = struct let _v : (Parsetree.type_constraint) = # 2831 "parsing/parser.mly" ( Pcoerce (Some _2, _4) ) -# 55631 "parsing/parser.ml" +# 55651 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55659,7 +55679,7 @@ module Tables = struct let _v : (Parsetree.type_constraint) = # 2832 "parsing/parser.mly" ( Pcoerce (None, _2) ) -# 55663 "parsing/parser.ml" +# 55683 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55691,7 +55711,7 @@ module Tables = struct let _v : (Parsetree.type_constraint) = # 2833 "parsing/parser.mly" ( syntax_error() ) -# 55695 "parsing/parser.ml" +# 55715 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55723,7 +55743,7 @@ module Tables = struct let _v : (Parsetree.type_constraint) = # 2834 "parsing/parser.mly" ( syntax_error() ) -# 55727 "parsing/parser.ml" +# 55747 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55741,7 +55761,7 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = # 3163 "parsing/parser.mly" ( (Ptype_abstract, Public, None) ) -# 55745 "parsing/parser.ml" +# 55765 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55773,7 +55793,7 @@ module Tables = struct let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = # 3165 "parsing/parser.mly" ( _2 ) -# 55777 "parsing/parser.ml" +# 55797 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55798,7 +55818,7 @@ module Tables = struct let _v : (Longident.t) = # 3823 "parsing/parser.mly" ( _1 ) -# 55802 "parsing/parser.ml" +# 55822 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55830,7 +55850,7 @@ module Tables = struct let _v : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) = # 3180 "parsing/parser.mly" ( _2, _1 ) -# 55834 "parsing/parser.ml" +# 55854 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55848,7 +55868,7 @@ module Tables = struct let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = # 3173 "parsing/parser.mly" ( [] ) -# 55852 "parsing/parser.ml" +# 55872 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55873,7 +55893,7 @@ module Tables = struct let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = # 3175 "parsing/parser.mly" ( [p] ) -# 55877 "parsing/parser.ml" +# 55897 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55913,18 +55933,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 55917 "parsing/parser.ml" +# 55937 "parsing/parser.ml" in # 1111 "parsing/parser.mly" ( xs ) -# 55922 "parsing/parser.ml" +# 55942 "parsing/parser.ml" in # 3177 "parsing/parser.mly" ( ps ) -# 55928 "parsing/parser.ml" +# 55948 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55957,7 +55977,7 @@ module Tables = struct let _1 = # 3185 "parsing/parser.mly" ( Ptyp_var tyvar ) -# 55961 "parsing/parser.ml" +# 55981 "parsing/parser.ml" in let _endpos__1_ = _endpos_tyvar_ in let _endpos = _endpos__1_ in @@ -55966,13 +55986,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 55970 "parsing/parser.ml" +# 55990 "parsing/parser.ml" in # 3188 "parsing/parser.mly" ( _1 ) -# 55976 "parsing/parser.ml" +# 55996 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -55998,7 +56018,7 @@ module Tables = struct let _1 = # 3187 "parsing/parser.mly" ( Ptyp_any ) -# 56002 "parsing/parser.ml" +# 56022 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -56006,13 +56026,13 @@ module Tables = struct # 993 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 56010 "parsing/parser.ml" +# 56030 "parsing/parser.ml" in # 3188 "parsing/parser.mly" ( _1 ) -# 56016 "parsing/parser.ml" +# 56036 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56030,7 +56050,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3192 "parsing/parser.mly" ( NoVariance, NoInjectivity ) -# 56034 "parsing/parser.ml" +# 56054 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56055,7 +56075,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3193 "parsing/parser.mly" ( Covariant, NoInjectivity ) -# 56059 "parsing/parser.ml" +# 56079 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56080,7 +56100,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3194 "parsing/parser.mly" ( Contravariant, NoInjectivity ) -# 56084 "parsing/parser.ml" +# 56104 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56105,7 +56125,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3195 "parsing/parser.mly" ( NoVariance, Injective ) -# 56109 "parsing/parser.ml" +# 56129 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56137,7 +56157,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3196 "parsing/parser.mly" ( Covariant, Injective ) -# 56141 "parsing/parser.ml" +# 56161 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56169,7 +56189,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3196 "parsing/parser.mly" ( Covariant, Injective ) -# 56173 "parsing/parser.ml" +# 56193 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56201,7 +56221,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3197 "parsing/parser.mly" ( Contravariant, Injective ) -# 56205 "parsing/parser.ml" +# 56225 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56233,7 +56253,7 @@ module Tables = struct let _v : (Asttypes.variance * Asttypes.injectivity) = # 3197 "parsing/parser.mly" ( Contravariant, Injective ) -# 56237 "parsing/parser.ml" +# 56257 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56254,7 +56274,7 @@ module Tables = struct let _1 : ( # 752 "parsing/parser.mly" (string) -# 56258 "parsing/parser.ml" +# 56278 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -56265,7 +56285,7 @@ module Tables = struct ( if _1 = "+!" then Covariant, Injective else if _1 = "-!" then Contravariant, Injective else expecting _loc__1_ "type_variance" ) -# 56269 "parsing/parser.ml" +# 56289 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56286,7 +56306,7 @@ module Tables = struct let _1 : ( # 798 "parsing/parser.mly" (string) -# 56290 "parsing/parser.ml" +# 56310 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -56297,7 +56317,7 @@ module Tables = struct ( if _1 = "!+" then Covariant, Injective else if _1 = "!-" then Contravariant, Injective else expecting _loc__1_ "type_variance" ) -# 56301 "parsing/parser.ml" +# 56321 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56331,24 +56351,24 @@ module Tables = struct let ys = # 260 "" ( List.flatten xss ) -# 56335 "parsing/parser.ml" +# 56355 "parsing/parser.ml" in let xs = let _1 = # 1026 "parsing/parser.mly" ( [] ) -# 56341 "parsing/parser.ml" +# 56361 "parsing/parser.ml" in # 1279 "parsing/parser.mly" ( _1 ) -# 56346 "parsing/parser.ml" +# 56366 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 56352 "parsing/parser.ml" +# 56372 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in @@ -56357,13 +56377,13 @@ module Tables = struct # 952 "parsing/parser.mly" ( extra_def _startpos _endpos _1 ) -# 56361 "parsing/parser.ml" +# 56381 "parsing/parser.ml" in # 1272 "parsing/parser.mly" ( _1 ) -# 56367 "parsing/parser.ml" +# 56387 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56411,7 +56431,7 @@ module Tables = struct let ys = # 260 "" ( List.flatten xss ) -# 56415 "parsing/parser.ml" +# 56435 "parsing/parser.ml" in let xs = let _1 = @@ -56421,18 +56441,18 @@ module Tables = struct let attrs = # 4054 "parsing/parser.mly" ( _1 ) -# 56425 "parsing/parser.ml" +# 56445 "parsing/parser.ml" in # 1484 "parsing/parser.mly" ( mkstrexp e attrs ) -# 56430 "parsing/parser.ml" +# 56450 "parsing/parser.ml" in # 970 "parsing/parser.mly" ( Ptop_def [_1] ) -# 56436 "parsing/parser.ml" +# 56456 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in @@ -56440,25 +56460,25 @@ module Tables = struct # 968 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 56444 "parsing/parser.ml" +# 56464 "parsing/parser.ml" in # 1028 "parsing/parser.mly" ( x ) -# 56450 "parsing/parser.ml" +# 56470 "parsing/parser.ml" in # 1279 "parsing/parser.mly" ( _1 ) -# 56456 "parsing/parser.ml" +# 56476 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 56462 "parsing/parser.ml" +# 56482 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in @@ -56467,13 +56487,13 @@ module Tables = struct # 952 "parsing/parser.mly" ( extra_def _startpos _endpos _1 ) -# 56471 "parsing/parser.ml" +# 56491 "parsing/parser.ml" in # 1272 "parsing/parser.mly" ( _1 ) -# 56477 "parsing/parser.ml" +# 56497 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56512,7 +56532,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3742 "parsing/parser.mly" ( _2 ) -# 56516 "parsing/parser.ml" +# 56536 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56553,7 +56573,7 @@ module Tables = struct # 3743 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 56557 "parsing/parser.ml" +# 56577 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56586,7 +56606,7 @@ module Tables = struct # 3744 "parsing/parser.mly" ( expecting _loc__2_ "operator" ) -# 56590 "parsing/parser.ml" +# 56610 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56626,7 +56646,7 @@ module Tables = struct # 3745 "parsing/parser.mly" ( expecting _loc__3_ "module-expr" ) -# 56630 "parsing/parser.ml" +# 56650 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56647,7 +56667,7 @@ module Tables = struct let _1 : ( # 774 "parsing/parser.mly" (string) -# 56651 "parsing/parser.ml" +# 56671 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -56655,7 +56675,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3748 "parsing/parser.mly" ( _1 ) -# 56659 "parsing/parser.ml" +# 56679 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56680,7 +56700,7 @@ module Tables = struct let _v : (Asttypes.label) = # 3749 "parsing/parser.mly" ( _1 ) -# 56684 "parsing/parser.ml" +# 56704 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56705,7 +56725,7 @@ module Tables = struct let _v : (Longident.t) = # 3817 "parsing/parser.mly" ( _1 ) -# 56709 "parsing/parser.ml" +# 56729 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56752,7 +56772,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 56756 "parsing/parser.ml" +# 56776 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let mutable_ : (Asttypes.mutable_flag) = Obj.magic mutable_ in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -56766,7 +56786,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 56770 "parsing/parser.ml" +# 56790 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -56774,23 +56794,23 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 56778 "parsing/parser.ml" +# 56798 "parsing/parser.ml" in let attrs = # 4058 "parsing/parser.mly" ( _1 ) -# 56784 "parsing/parser.ml" +# 56804 "parsing/parser.ml" in let _1 = # 3957 "parsing/parser.mly" ( Fresh ) -# 56789 "parsing/parser.ml" +# 56809 "parsing/parser.ml" in # 2064 "parsing/parser.mly" ( (label, mutable_, Cfk_virtual ty), attrs ) -# 56794 "parsing/parser.ml" +# 56814 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56837,7 +56857,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 56841 "parsing/parser.ml" +# 56861 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -56851,7 +56871,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 56855 "parsing/parser.ml" +# 56875 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -56859,23 +56879,23 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 56863 "parsing/parser.ml" +# 56883 "parsing/parser.ml" in let _2 = # 4058 "parsing/parser.mly" ( _1 ) -# 56869 "parsing/parser.ml" +# 56889 "parsing/parser.ml" in let _1 = # 3960 "parsing/parser.mly" ( Fresh ) -# 56874 "parsing/parser.ml" +# 56894 "parsing/parser.ml" in # 2066 "parsing/parser.mly" ( (_4, _3, Cfk_concrete (_1, _6)), _2 ) -# 56879 "parsing/parser.ml" +# 56899 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -56928,7 +56948,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 56932 "parsing/parser.ml" +# 56952 "parsing/parser.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 @@ -56943,7 +56963,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 56947 "parsing/parser.ml" +# 56967 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -56951,7 +56971,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 56955 "parsing/parser.ml" +# 56975 "parsing/parser.ml" in let _2 = @@ -56959,18 +56979,18 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 56963 "parsing/parser.ml" +# 56983 "parsing/parser.ml" in let _1 = # 3961 "parsing/parser.mly" ( Override ) -# 56969 "parsing/parser.ml" +# 56989 "parsing/parser.ml" in # 2066 "parsing/parser.mly" ( (_4, _3, Cfk_concrete (_1, _6)), _2 ) -# 56974 "parsing/parser.ml" +# 56994 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57024,7 +57044,7 @@ module Tables = struct let _1_inlined1 : ( # 774 "parsing/parser.mly" (string) -# 57028 "parsing/parser.ml" +# 57048 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -57038,7 +57058,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 57042 "parsing/parser.ml" +# 57062 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -57046,20 +57066,20 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57050 "parsing/parser.ml" +# 57070 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined1_ in let _2 = # 4058 "parsing/parser.mly" ( _1 ) -# 57057 "parsing/parser.ml" +# 57077 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in let _1 = # 3960 "parsing/parser.mly" ( Fresh ) -# 57063 "parsing/parser.ml" +# 57083 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in let _endpos = _endpos__7_ in @@ -57079,7 +57099,7 @@ module Tables = struct ( let e = mkexp_constraint ~loc:_sloc _7 _5 in (_4, _3, Cfk_concrete (_1, e)), _2 ) -# 57083 "parsing/parser.ml" +# 57103 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57139,7 +57159,7 @@ module Tables = struct let _1_inlined2 : ( # 774 "parsing/parser.mly" (string) -# 57143 "parsing/parser.ml" +# 57163 "parsing/parser.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 @@ -57154,7 +57174,7 @@ module Tables = struct let _1 = # 3716 "parsing/parser.mly" ( _1 ) -# 57158 "parsing/parser.ml" +# 57178 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in @@ -57162,7 +57182,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57166 "parsing/parser.ml" +# 57186 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined2_ in @@ -57171,14 +57191,14 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 57175 "parsing/parser.ml" +# 57195 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in let _1 = # 3961 "parsing/parser.mly" ( Override ) -# 57182 "parsing/parser.ml" +# 57202 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = if _startpos__1_ != _endpos__1_ then @@ -57197,7 +57217,7 @@ module Tables = struct ( let e = mkexp_constraint ~loc:_sloc _7 _5 in (_4, _3, Cfk_concrete (_1, e)), _2 ) -# 57201 "parsing/parser.ml" +# 57221 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57266,7 +57286,7 @@ module Tables = struct # 4054 "parsing/parser.mly" ( _1 ) -# 57270 "parsing/parser.ml" +# 57290 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -57278,7 +57298,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57282 "parsing/parser.ml" +# 57302 "parsing/parser.ml" in let attrs1 = @@ -57286,7 +57306,7 @@ module Tables = struct # 4058 "parsing/parser.mly" ( _1 ) -# 57290 "parsing/parser.ml" +# 57310 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in @@ -57299,7 +57319,7 @@ module Tables = struct let docs = symbol_docs _sloc in Val.mk id ty ~attrs ~loc ~docs, ext ) -# 57303 "parsing/parser.ml" +# 57323 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57317,7 +57337,7 @@ module Tables = struct let _v : (Asttypes.virtual_flag) = # 3921 "parsing/parser.mly" ( Concrete ) -# 57321 "parsing/parser.ml" +# 57341 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57342,7 +57362,7 @@ module Tables = struct let _v : (Asttypes.virtual_flag) = # 3922 "parsing/parser.mly" ( Virtual ) -# 57346 "parsing/parser.ml" +# 57366 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57367,7 +57387,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag) = # 3945 "parsing/parser.mly" ( Immutable ) -# 57371 "parsing/parser.ml" +# 57391 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57399,7 +57419,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag) = # 3946 "parsing/parser.mly" ( Mutable ) -# 57403 "parsing/parser.ml" +# 57423 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57431,7 +57451,7 @@ module Tables = struct let _v : (Asttypes.mutable_flag) = # 3947 "parsing/parser.mly" ( Mutable ) -# 57435 "parsing/parser.ml" +# 57455 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57456,7 +57476,7 @@ module Tables = struct let _v : (Asttypes.private_flag) = # 3952 "parsing/parser.mly" ( Public ) -# 57460 "parsing/parser.ml" +# 57480 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57488,7 +57508,7 @@ module Tables = struct let _v : (Asttypes.private_flag) = # 3953 "parsing/parser.mly" ( Private ) -# 57492 "parsing/parser.ml" +# 57512 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57520,7 +57540,7 @@ module Tables = struct let _v : (Asttypes.private_flag) = # 3954 "parsing/parser.mly" ( Private ) -# 57524 "parsing/parser.ml" +# 57544 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57582,18 +57602,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 57586 "parsing/parser.ml" +# 57606 "parsing/parser.ml" in # 1040 "parsing/parser.mly" ( xs ) -# 57591 "parsing/parser.ml" +# 57611 "parsing/parser.ml" in # 3134 "parsing/parser.mly" ( _1 ) -# 57597 "parsing/parser.ml" +# 57617 "parsing/parser.ml" in let _endpos__6_ = _endpos_xs_ in @@ -57602,7 +57622,7 @@ module Tables = struct # 3456 "parsing/parser.mly" ( _1 ) -# 57606 "parsing/parser.ml" +# 57626 "parsing/parser.ml" in let _3 = @@ -57613,7 +57633,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57617 "parsing/parser.ml" +# 57637 "parsing/parser.ml" in let _endpos = _endpos__6_ in @@ -57630,7 +57650,7 @@ module Tables = struct ~manifest:_5 ~priv:_4 ~loc:(make_loc _sloc))) ) -# 57634 "parsing/parser.ml" +# 57654 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57685,7 +57705,7 @@ module Tables = struct # 3456 "parsing/parser.mly" ( _1 ) -# 57689 "parsing/parser.ml" +# 57709 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined2_ in @@ -57697,7 +57717,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57701 "parsing/parser.ml" +# 57721 "parsing/parser.ml" in let _endpos = _endpos__5_ in @@ -57712,7 +57732,7 @@ module Tables = struct ~params:_2 ~manifest:_5 ~loc:(make_loc _sloc))) ) -# 57716 "parsing/parser.ml" +# 57736 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57763,7 +57783,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57767 "parsing/parser.ml" +# 57787 "parsing/parser.ml" in let _2 = @@ -57774,13 +57794,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57778 "parsing/parser.ml" +# 57798 "parsing/parser.ml" in # 3396 "parsing/parser.mly" ( Pwith_module (_2, _4) ) -# 57784 "parsing/parser.ml" +# 57804 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57831,7 +57851,7 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57835 "parsing/parser.ml" +# 57855 "parsing/parser.ml" in let _2 = @@ -57842,13 +57862,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57846 "parsing/parser.ml" +# 57866 "parsing/parser.ml" in # 3398 "parsing/parser.mly" ( Pwith_modsubst (_2, _4) ) -# 57852 "parsing/parser.ml" +# 57872 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57906,13 +57926,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57910 "parsing/parser.ml" +# 57930 "parsing/parser.ml" in # 3400 "parsing/parser.mly" ( Pwith_modtype (l, rhs) ) -# 57916 "parsing/parser.ml" +# 57936 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -57970,13 +57990,13 @@ module Tables = struct # 956 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 57974 "parsing/parser.ml" +# 57994 "parsing/parser.ml" in # 3402 "parsing/parser.mly" ( Pwith_modtypesubst (l, rhs) ) -# 57980 "parsing/parser.ml" +# 58000 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -58001,7 +58021,7 @@ module Tables = struct let _v : (Asttypes.private_flag) = # 3405 "parsing/parser.mly" ( Public ) -# 58005 "parsing/parser.ml" +# 58025 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -58033,7 +58053,7 @@ module Tables = struct let _v : (Asttypes.private_flag) = # 3406 "parsing/parser.mly" ( Private ) -# 58037 "parsing/parser.ml" +# 58057 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -58186,9 +58206,9 @@ end # 4090 "parsing/parser.mly" -# 58190 "parsing/parser.ml" +# 58210 "parsing/parser.ml" # 269 "" -# 58195 "parsing/parser.ml" +# 58215 "parsing/parser.ml" diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index c51cb4fc1f6..de574471dda 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -103,9 +103,9 @@ module Typ = struct Ptyp_object (List.map loop_object_field lst, o) | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) - | Ptyp_alias(core_type, string) -> - check_variable var_names t.ptyp_loc string; - Ptyp_alias(loop core_type, string) + | Ptyp_alias(core_type, alias) -> + check_variable var_names t.ptyp_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) diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index 1a27d158def..7004144cbcd 100644 --- a/parsing/ast_helper.mli +++ b/parsing/ast_helper.mli @@ -77,7 +77,8 @@ module Typ : 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 -> 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 diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 1076969953d..9663f3cb362 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -147,7 +147,9 @@ module T = struct 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) -> alias ~loc ~attrs (sub.typ sub t) s + | 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 diff --git a/parsing/parser.mly b/parsing/parser.mly index 8f9bb6870ea..14e8033da25 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -3464,7 +3464,7 @@ alias_type: function_type { $1 } | mktyp( - ty = alias_type AS QUOTE tyvar = ident + ty = alias_type AS tyvar = typevar { Ptyp_alias(ty, tyvar) } ) { $1 } diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 7d372a230cb..2f0a40c26c5 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -121,7 +121,7 @@ and core_type_desc = - [T #tconstr] when [l=[T]], - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]]. *) - | Ptyp_alias of core_type * string (** [T as 'a]. *) + | 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 ]] diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 5edc0710dee..d7fea80a7c8 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -317,7 +317,7 @@ and core_type ctxt f x = 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 + 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) -> diff --git a/parsing/printast.ml b/parsing/printast.ml index 597677cc01b..2f5702e7d28 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -172,7 +172,7 @@ let rec core_type i ppf x = 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; + 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; diff --git a/tools/eqparsetree.ml b/tools/eqparsetree.ml index 9630fcd827f..819d49f70e0 100644 --- a/tools/eqparsetree.ml +++ b/tools/eqparsetree.ml @@ -175,7 +175,7 @@ and eq_core_type_desc : (eq_list eq_core_type (a1, b1))) && (eq_list Asttypes.eq_label (a2, b2)) | (Ptyp_alias (a0, a1), Ptyp_alias (b0, b1)) -> - (eq_core_type (a0, b0)) && (eq_string (a1, b1)) + (eq_core_type (a0, b0)) && (eq_string (a1.txt, b1.txt)) | (Ptyp_variant (a0, a1, a2), Ptyp_variant (b0, b1, b2)) -> ((eq_list eq_row_field (a0, b0)) && (eq_bool (a1, b1))) && (eq_option (eq_list Asttypes.eq_label) (a2, b2)) diff --git a/typing/printtyped.ml b/typing/printtyped.ml index c9f2bdc4ad8..2f285bfc37a 100644 --- a/typing/printtyped.ml +++ b/typing/printtyped.ml @@ -206,7 +206,7 @@ let rec core_type i ppf x = 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; + 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" diff --git a/typing/typedtree.ml b/typing/typedtree.ml index d0df9da8e31..cf9a171c38b 100644 --- a/typing/typedtree.ml +++ b/typing/typedtree.ml @@ -474,7 +474,7 @@ and core_type_desc = | 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 + | 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 diff --git a/typing/typedtree.mli b/typing/typedtree.mli index 5309741026c..ad96b13c716 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -640,7 +640,7 @@ and core_type_desc = | 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 + | 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 diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 363c6a3f5e1..d31311915f2 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -526,7 +526,7 @@ and transl_type_aux env ~row_context ~aliased ~policy styp = | Ptyp_alias(st, alias) -> let cty = try - let t = TyVarEnv.lookup_local ~row_context alias in + 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 @@ -537,7 +537,7 @@ and transl_type_aux env ~row_context ~aliased ~policy styp = let t, ty = with_local_level_if_principal begin fun () -> let t = newvar () in - TyVarEnv.remember_used alias t styp.ptyp_loc; + 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 @@ -550,8 +550,8 @@ and transl_type_aux env ~row_context ~aliased ~policy styp = 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)) - | Tunivar None -> set_type_desc px (Tunivar (Some alias)) + | 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 } From f6f617f6d0feb2de194e2c9408c59ab10c74950f Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 6 Jul 2023 16:50:26 +0200 Subject: [PATCH 146/402] Simplify TSan backtrace bookkeeping upon raise Co-authored-by: Fabrice Buoro --- Changes | 3 ++ asmcomp/amd64/emit.mlp | 15 +++------- asmcomp/thread_sanitizer.ml | 12 +++++++- runtime/amd64.S | 57 ++++++++++++++++++------------------- runtime/caml/tsan.h | 1 + 5 files changed, 46 insertions(+), 42 deletions(-) diff --git a/Changes b/Changes index f44224df2fa..989b7aaca99 100644 --- a/Changes +++ b/Changes @@ -131,6 +131,9 @@ Working version (Guillaume Munch-Maccagnoni, review by Enguerrand Decorne, Xavier Leroy, and KC Sivaramakrishnan) +- #12634: Simplify TSan backtrace bookkeeping upon raise + (Olivier Nicole and Fabrice Buoro, review by Gabriel Scherer) + ### Code generation and optimizations: - #11239: on x86-64 and RISC-V, reduce alignment of OCaml stacks from 16 to 8. diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index 09c8b790890..619ce9c3c59 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -864,17 +864,10 @@ let emit_instr env fallthrough i = emit_call "caml_reraise_exn"; record_frame env Reg.Set.empty (Dbg_raise i.dbg) | Lambda.Raise_notrace -> - if Config.tsan then begin - (* TSan requires to signal function exits upon exceptions, - even with [Raise_notrace] *) - emit_call "caml_tsan_raise_notrace_exn"; - record_frame env Reg.Set.empty (Dbg_raise i.dbg) - end else begin - I.mov (domain_field Domainstate.Domain_exn_handler) rsp; - I.pop (domain_field Domainstate.Domain_exn_handler); - I.pop r11; - I.jmp r11 - end + I.mov (domain_field Domainstate.Domain_exn_handler) rsp; + I.pop (domain_field Domainstate.Domain_exn_handler); + I.pop r11; + I.jmp r11 end let rec emit_all env fallthrough i = diff --git a/asmcomp/thread_sanitizer.ml b/asmcomp/thread_sanitizer.ml index d05666d93ae..fa1fbf7fcc4 100644 --- a/asmcomp/thread_sanitizer.ml +++ b/asmcomp/thread_sanitizer.ml @@ -240,12 +240,22 @@ let instrument body = | Cop ((Cload { mutability = Immutable; _ } as op), es, dbg_none) -> (* Loads of immutable location require no instrumentation *) Cop (op, List.map aux es, dbg_none) + | Cop (Craise _, _, _) as raise -> + (* Call a routine that will call [__tsan_func_exit] for every function + about to be exited due to the exception *) + Csequence + (Cmm_helpers.return_unit dbg_none + (Cop (Capply typ_int, + [Cconst_symbol ("caml_tsan_exit_on_raise_asm", dbg_none); + Cconst_int (0, dbg_none)], + dbg_none)), + raise) | Cop ( (( Capply _ | Caddi | Calloc | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor | Cxor | Clsl | Clsr | Casr | Caddv | Cadda | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat | Ccheckbound | Copaque | Cdls_get | Cextcall _ | Ccmpi _ | Ccmpa _ - | Ccmpf _ | Craise _ ) as op), + | Ccmpf _ ) as op), es, dbg_none ) -> Cop (op, List.map aux es, dbg_none) diff --git a/runtime/amd64.S b/runtime/amd64.S index 1d4673bf0f8..e0bcffbb54a 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -916,70 +916,55 @@ FUNCTION(G(caml_raise_exn)) CFI_STARTPROC ENTER_FUNCTION LBL(caml_raise_exn): -#if !defined(WITH_THREAD_SANITIZER) testq $1, Caml_state(backtrace_active) jne LBL(116) RESTORE_EXN_HANDLER_OCAML ret -#endif LBL(116): movq $0, Caml_state(backtrace_pos) LBL(117): movq %rsp, %r13 /* Save OCaml stack pointer */ movq %rax, %r12 /* Save exception bucket */ movq Caml_state(c_stack), %rsp -#if defined(WITH_THREAD_SANITIZER) - testq $1, Caml_state(backtrace_active) - je LBL(118) -#endif movq %rax, C_ARG_1 /* arg 1: exception bucket */ movq STACK_RETADDR(%r13), C_ARG_2 /* arg 2: pc of raise */ leaq STACK_ARG_1(%r13), C_ARG_3 /* arg 3: sp at raise */ movq Caml_state(exn_handler), C_ARG_4 /* arg 4: sp of handler */ C_call (GCALL(caml_stash_backtrace)) -#if defined(WITH_THREAD_SANITIZER) -LBL(118): - /* Signal to TSan all stack frames exited by the exception. No need to save - any registers here. */ - movq STACK_RETADDR(%r13), C_ARG_1 /* arg 1: pc of raise */ - leaq STACK_ARG_1(%r13), C_ARG_2 /* arg 2: sp at raise */ - movq Caml_state(exn_handler), C_ARG_3 /* arg 3: sp of handler */ - C_call (GCALL(caml_tsan_exit_on_raise)) -#endif movq %r12, %rax /* Recover exception bucket */ RESTORE_EXN_HANDLER_OCAML ret CFI_ENDPROC ENDFUNCTION(G(caml_raise_exn)) -/* Exception raising routine called in case of Raise_notrace when TSan - is enabled. Does not store a backtrace but still signals function - exits to TSan. */ #if defined(WITH_THREAD_SANITIZER) -FUNCTION(G(caml_tsan_raise_notrace_exn)) +/* When TSan support is enabled, this routine should be called just before + raising an exception. It calls __tsan_func_exit for every OCaml frame about + to be exited due to the exception. + Takes no arguments, clobbers C_ARG_1, C_ARG_2, C_ARG_3 and potentially all + caller-saved registers of the C calling convention. */ +FUNCTION(G(caml_tsan_exit_on_raise_asm)) CFI_STARTPROC ENTER_FUNCTION - movq %rsp, %r13 /* Save OCaml stack pointer */ - movq %rax, %r12 /* Save exception bucket */ - movq Caml_state(c_stack), %rsp - jmp LBL(118) + movq STACK_RETADDR(%rsp), C_ARG_1 /* arg 1: pc of raise */ + leaq STACK_ARG_1(%rsp), C_ARG_2 /* arg 2: sp at raise */ + movq Caml_state(exn_handler), C_ARG_3 /* arg 3: sp of handler */ + SWITCH_OCAML_TO_C + C_call (GCALL(caml_tsan_exit_on_raise)) + SWITCH_C_TO_OCAML + LEAVE_FUNCTION + ret CFI_ENDPROC -ENDFUNCTION(G(caml_tsan_raise_notrace_exn)) +ENDFUNCTION(G(caml_tsan_exit_on_raise_asm)) #endif FUNCTION(G(caml_reraise_exn)) CFI_STARTPROC ENTER_FUNCTION -#if defined(WITH_THREAD_SANITIZER) - /* Signals function exits to TSan (implemented in caml_raise_exn) even - if backtraces are not enabled */ - jmp LBL(117) -#else testq $1, Caml_state(backtrace_active) jne LBL(117) RESTORE_EXN_HANDLER_OCAML ret -#endif CFI_ENDPROC ENDFUNCTION(G(caml_reraise_exn)) @@ -995,6 +980,18 @@ CFI_STARTPROC /* Discard the C stack pointer and reset to ocaml stack */ movq Caml_state(current_stack), %r10 movq Stack_sp(%r10), %rsp /* FIXME: CFI */ +#if defined(WITH_THREAD_SANITIZER) + /* Call __tsan_func_exit for every OCaml stack frame exited due to the + exception */ + movq STACK_RETADDR(%rsp), C_ARG_1 /* arg 1: pc of raise */ + leaq STACK_ARG_1(%rsp), C_ARG_2 /* arg 2: sp at raise */ + movq Caml_state(exn_handler), C_ARG_3 /* arg 3: sp of handler */ + pushq %rax + SWITCH_OCAML_TO_C + C_call (GCALL(caml_tsan_exit_on_raise)) + SWITCH_C_TO_OCAML + popq %rax +#endif jmp LBL(caml_raise_exn) CFI_ENDPROC ENDFUNCTION(G(caml_raise_exception)) diff --git a/runtime/caml/tsan.h b/runtime/caml/tsan.h index 8b7a8606e72..d406f27f122 100644 --- a/runtime/caml/tsan.h +++ b/runtime/caml/tsan.h @@ -61,6 +61,7 @@ struct stack_info; +CAMLextern void caml_tsan_exit_on_raise(uintnat pc, char* sp, char* trapsp); CAMLextern void caml_tsan_exit_on_raise_c(char* limit); CAMLextern void caml_tsan_exit_on_perform(uintnat pc, char* sp); From 01178bb60eb337790c597af937ac79419eab241c Mon Sep 17 00:00:00 2001 From: Chris Casinghino Date: Mon, 15 May 2023 16:59:55 -0400 Subject: [PATCH 147/402] Add -H flag for transitive dependencies --- Changes | 5 + debugger/command_line.ml | 3 +- debugger/loadprinter.ml | 2 +- debugger/main.ml | 3 +- debugger/parameters.ml | 2 +- debugger/program_management.ml | 5 +- driver/compmisc.ml | 30 ++-- driver/main_args.ml | 19 ++- driver/main_args.mli | 1 + driver/makedepend.ml | 5 +- manual/src/cmds/ocamldep.etex | 6 + manual/src/cmds/ocamldoc.etex | 4 + manual/src/cmds/unified-options.etex | 10 ++ ocamldoc/odoc_args.ml | 1 + ocamldoc/odoc_global.ml | 1 + ocamldoc/odoc_global.mli | 3 + ocamldoc/odoc_info.ml | 2 + ocamldoc/odoc_info.mli | 13 +- parsing/ast_mapper.ml | 16 ++- parsing/ast_mapper.mli | 4 +- .../cant_reference_hidden.ocamlc.reference | 4 + testsuite/tests/hidden_includes/liba/a.ml | 3 + testsuite/tests/hidden_includes/liba_alt/a.ml | 3 + testsuite/tests/hidden_includes/libb/b.ml | 5 + testsuite/tests/hidden_includes/libc/c1.ml | 3 + testsuite/tests/hidden_includes/libc/c2.ml | 1 + testsuite/tests/hidden_includes/libc/c3.ml | 1 + .../not_included.ocamlc.reference | 6 + testsuite/tests/hidden_includes/test.ml | 136 ++++++++++++++++++ .../wrong_include_order.ocamlc.reference | 3 + .../tests/self-contained-toplevel/main.ml | 4 +- tools/ocamlcmt.ml | 2 +- toplevel/topcommon.ml | 15 +- toplevel/topdirs.ml | 2 +- typing/env.ml | 8 +- typing/persistent_env.ml | 30 ++-- typing/persistent_env.mli | 7 +- typing/typemod.ml | 2 +- utils/ccomp.ml | 3 +- utils/clflags.ml | 3 +- utils/clflags.mli | 1 + utils/load_path.ml | 127 +++++++++++----- utils/load_path.mli | 32 ++++- utils/misc.ml | 7 + utils/misc.mli | 3 + 45 files changed, 443 insertions(+), 103 deletions(-) create mode 100644 testsuite/tests/hidden_includes/cant_reference_hidden.ocamlc.reference create mode 100644 testsuite/tests/hidden_includes/liba/a.ml create mode 100644 testsuite/tests/hidden_includes/liba_alt/a.ml create mode 100644 testsuite/tests/hidden_includes/libb/b.ml create mode 100644 testsuite/tests/hidden_includes/libc/c1.ml create mode 100644 testsuite/tests/hidden_includes/libc/c2.ml create mode 100644 testsuite/tests/hidden_includes/libc/c3.ml create mode 100644 testsuite/tests/hidden_includes/not_included.ocamlc.reference create mode 100644 testsuite/tests/hidden_includes/test.ml create mode 100644 testsuite/tests/hidden_includes/wrong_include_order.ocamlc.reference diff --git a/Changes b/Changes index 7b298ddd467..c3220b5cbe9 100644 --- a/Changes +++ b/Changes @@ -250,6 +250,11 @@ Working version (David Allsopp, request by Kate Deplaix, review by Sébastien Hinderer and Xavier Leroy) +- #11989, #12246, RFC 31: New flag, -H, to allow for transitive dependencies + without including them in the initial environment. + (Chris Casinghino, François Bobot, and Gabriel Scherer, review by Leo White + and Stefan Muenzel, RFC by François Bobot) + - #12247: configure: --disable-ocamldebug can now be used instead of --disable-debugger (which remains available for compatibility) (Gabriel Scherer, review by Damien Doligez and Sébastien Hinderer) diff --git a/debugger/command_line.ml b/debugger/command_line.ml index ef50b7c9881..87923614da7 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -264,7 +264,8 @@ let instr_dir ppf lexbuf = let new_directory = argument_list_eol argument lexbuf in if new_directory = [] then begin if yes_or_no "Reinitialize directory list" then begin - Load_path.init ~auto_include:Compmisc.auto_include !default_load_path; + Load_path.init ~auto_include:Compmisc.auto_include + ~visible:!default_load_path ~hidden:[]; Envaux.reset_cache (); Hashtbl.clear Debugger_config.load_path_for; flush_buffer_list () diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml index e7e42dee6be..3fd85843c8a 100644 --- a/debugger/loadprinter.ml +++ b/debugger/loadprinter.ml @@ -41,7 +41,7 @@ let rec loadfiles ppf name = let d = Filename.dirname name in if d <> Filename.current_dir_name then begin if not (List.mem d (Load_path.get_paths ())) then - Load_path.add_dir d; + Load_path.add_dir ~hidden:false d; end; fprintf ppf "File %s loaded@." (if d <> Filename.current_dir_name then diff --git a/debugger/main.ml b/debugger/main.ml index b504ebeee61..006e8fd5bb7 100644 --- a/debugger/main.ml +++ b/debugger/main.ml @@ -224,7 +224,8 @@ let main () = end; if !Parameters.version then printf "\tOCaml Debugger version %s@.@." Config.version; - Load_path.init ~auto_include:Compmisc.auto_include !default_load_path; + Load_path.init ~auto_include:Compmisc.auto_include + ~visible:!default_load_path ~hidden:[]; Clflags.recursive_types := true; (* Allow recursive types. *) toplevel_loop (); (* Toplevel. *) kill_program (); diff --git a/debugger/parameters.ml b/debugger/parameters.ml index 815fab8c84c..cee4ad774e5 100644 --- a/debugger/parameters.ml +++ b/debugger/parameters.ml @@ -31,7 +31,7 @@ let time = ref true let version = ref true let add_path dir = - Load_path.add_dir dir; + Load_path.add_dir ~hidden:false dir; Envaux.reset_cache() let add_path_for mdl dir = diff --git a/debugger/program_management.ml b/debugger/program_management.ml index 160a2191f5e..22cf5ce0c5e 100644 --- a/debugger/program_management.ml +++ b/debugger/program_management.ml @@ -128,8 +128,9 @@ let initialize_loading () = end; Symbols.clear_symbols (); Symbols.read_symbols Debugcom.main_frag !program_name; - let dirs = Load_path.get_paths () @ !Symbols.program_source_dirs in - Load_path.init ~auto_include:Compmisc.auto_include dirs; + let Load_path.{visible; hidden} = Load_path.get_path_info () in + let visible = visible @ !Symbols.program_source_dirs in + Load_path.init ~auto_include:Compmisc.auto_include ~visible ~hidden; Envaux.reset_cache (); if !debug_loading then prerr_endline "Opening a socket..."; diff --git a/driver/compmisc.ml b/driver/compmisc.ml index 355ad262eaa..01eb83f761f 100644 --- a/driver/compmisc.ml +++ b/driver/compmisc.ml @@ -23,28 +23,36 @@ let auto_include find_in_dir fn = (* Initialize the search path. [dir] (default: the current directory) is always searched first unless -nocwd is specified, - then the directories specified with the -I option (in command-line order), - then the standard library directory (unless the -nostdlib option is given). + then the directories specified with the -I option (in command line order), + then the standard library directory (unless the -nostdlib option is given), + then the directories specified with the -H option (in command line order). *) let init_path ?(auto_include=auto_include) ?(dir="") () = - let dirs = + let visible = if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs else !Clflags.include_dirs in - let dirs = - !Compenv.last_include_dirs @ dirs @ Config.flexdll_dirs @ - !Compenv.first_include_dirs + let visible = + List.concat + [!Compenv.last_include_dirs; + visible; + Config.flexdll_dirs; + !Compenv.first_include_dirs] in - let exp_dirs = - List.map (Misc.expand_directory Config.standard_library) dirs + let visible = + List.map (Misc.expand_directory Config.standard_library) visible in - let dirs = + let visible = (if !Clflags.no_cwd then [] else [dir]) - @ List.rev_append exp_dirs (Clflags.std_include_dir ()) + @ List.rev_append visible (Clflags.std_include_dir ()) in - Load_path.init ~auto_include dirs; + let hidden = + List.rev_map (Misc.expand_directory Config.standard_library) + !Clflags.hidden_include_dirs + in + Load_path.init ~auto_include ~visible ~hidden; Env.reset_cache () (* Return the initial environment in which compilation proceeds. *) diff --git a/driver/main_args.ml b/driver/main_args.ml index c3f74735b9d..8fde5e4d756 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -148,6 +148,11 @@ let mk_i f = let mk_I f = "-I", Arg.String f, "