From 5cddcf73631f89e38bb77a779410d7f369a99cf8 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Sun, 6 Dec 2015 23:32:33 +0000 Subject: [PATCH 001/145] Typing: unification error - warn about missing cmi update guard misc --- typing/printtyp.ml | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 7bc7c75c0..02ba195f1 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -1437,6 +1437,19 @@ let explanation unif t3 t4 ppf = end | _ -> () + +let warn_on_missing_def env ppf t = + match t.desc with + | Tconstr (p,_,_) -> + begin + try + ignore(Env.find_type p env : Types.type_declaration) + with Not_found -> + fprintf ppf + "@,@[%a is abstract because no corresponding cmi file was found in path.@]" path p + end + | _ -> () + let explanation unif mis ppf = match mis with None -> () @@ -1466,7 +1479,7 @@ let rec trace_same_names = function type_same_name t1 t2; type_same_name t1' t2'; trace_same_names rem | _ -> () -let unification_error unif tr txt1 ppf txt2 = +let unification_error env unif tr txt1 ppf txt2 = reset (); trace_same_names tr; let tr = List.map (fun (t, t') -> (t, hide_variant_name t')) tr in @@ -1490,6 +1503,11 @@ let unification_error unif tr txt1 ppf txt2 = txt2 (type_expansion t2) t2' (trace false "is not compatible with type") tr (explanation unif mis); + if env <> Env.empty + then begin + warn_on_missing_def env ppf t1; + warn_on_missing_def env ppf t2 + end; print_labels := true with exn -> print_labels := true; @@ -1497,7 +1515,7 @@ let unification_error unif tr txt1 ppf txt2 = let report_unification_error ppf env ?(unif=true) tr txt1 txt2 = - wrap_printing_env env (fun () -> unification_error unif tr txt1 ppf txt2) + wrap_printing_env env (fun () -> unification_error env unif tr txt1 ppf txt2) ;; let trace fst keep_last txt ppf tr = From 79a4e2f15bd93d7ac32fdb04fd50009b67585a7d Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Mon, 21 Dec 2015 14:04:34 +0000 Subject: [PATCH 002/145] new test typing-missing-cmi missing reference file --- testsuite/tests/typing-missing-cmi/Makefile | 12 ++++++++++++ testsuite/tests/typing-missing-cmi/a.ml | 1 + testsuite/tests/typing-missing-cmi/b.ml | 1 + testsuite/tests/typing-missing-cmi/main.ml | 1 + testsuite/tests/typing-missing-cmi/main.ml.reference | 5 +++++ testsuite/tests/typing-missing-cmi/subdir/m.ml | 2 ++ testsuite/typing | 1 + 7 files changed, 23 insertions(+) create mode 100644 testsuite/tests/typing-missing-cmi/Makefile create mode 100644 testsuite/tests/typing-missing-cmi/a.ml create mode 100644 testsuite/tests/typing-missing-cmi/b.ml create mode 100644 testsuite/tests/typing-missing-cmi/main.ml create mode 100644 testsuite/tests/typing-missing-cmi/main.ml.reference create mode 100644 testsuite/tests/typing-missing-cmi/subdir/m.ml diff --git a/testsuite/tests/typing-missing-cmi/Makefile b/testsuite/tests/typing-missing-cmi/Makefile new file mode 100644 index 000000000..efbc9c5d5 --- /dev/null +++ b/testsuite/tests/typing-missing-cmi/Makefile @@ -0,0 +1,12 @@ + +default: subdir/m.ml a.ml b.ml main.ml + @printf " ... testing 'main.ml'"; + @$(OCAMLC) -c subdir/m.ml; + @$(OCAMLC) -c -I subdir a.ml; + @$(OCAMLC) -c -I subdir b.ml; + @$(OCAMLC) -c main.ml 2>&1 | cat > main.ml.result; + @$(DIFF) main.ml.result main.ml.reference >/dev/null \ + && echo " => passed" || echo " => failed" + +BASEDIR=../.. +include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/typing-missing-cmi/a.ml b/testsuite/tests/typing-missing-cmi/a.ml new file mode 100644 index 000000000..0631d4394 --- /dev/null +++ b/testsuite/tests/typing-missing-cmi/a.ml @@ -0,0 +1 @@ +let (a : M.a) = 2 diff --git a/testsuite/tests/typing-missing-cmi/b.ml b/testsuite/tests/typing-missing-cmi/b.ml new file mode 100644 index 000000000..eb1e004ad --- /dev/null +++ b/testsuite/tests/typing-missing-cmi/b.ml @@ -0,0 +1 @@ +let (b : M.b) = 2 diff --git a/testsuite/tests/typing-missing-cmi/main.ml b/testsuite/tests/typing-missing-cmi/main.ml new file mode 100644 index 000000000..1bf8c9911 --- /dev/null +++ b/testsuite/tests/typing-missing-cmi/main.ml @@ -0,0 +1 @@ +let _ = A.a = B.b diff --git a/testsuite/tests/typing-missing-cmi/main.ml.reference b/testsuite/tests/typing-missing-cmi/main.ml.reference new file mode 100644 index 000000000..dfcfd0204 --- /dev/null +++ b/testsuite/tests/typing-missing-cmi/main.ml.reference @@ -0,0 +1,5 @@ +File "main.ml", line 1, characters 14-17: +Error: This expression has type M.b but an expression was expected of type + M.a +M.b is abstract because no corresponding cmi file was found in path. +M.a is abstract because no corresponding cmi file was found in path. diff --git a/testsuite/tests/typing-missing-cmi/subdir/m.ml b/testsuite/tests/typing-missing-cmi/subdir/m.ml new file mode 100644 index 000000000..32870c88c --- /dev/null +++ b/testsuite/tests/typing-missing-cmi/subdir/m.ml @@ -0,0 +1,2 @@ +type a = int +type b = a diff --git a/testsuite/typing b/testsuite/typing index 4357fdf3c..eac3b6378 100644 --- a/testsuite/typing +++ b/testsuite/typing @@ -14,6 +14,7 @@ tests/typing-implicit_unpack tests/typing-labels tests/typing-misc tests/typing-misc-bugs +tests/typing-missing-cmi tests/typing-modules tests/typing-modules-bugs tests/typing-objects From 272624503b292ca835a81c5119c0c5b1f5c16fad Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Mon, 21 Dec 2015 16:23:54 +0000 Subject: [PATCH 003/145] Updage Changes --- Changes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Changes b/Changes index 0ced687ee..2f0ae83bf 100644 --- a/Changes +++ b/Changes @@ -487,6 +487,8 @@ Features wishes: (Hugo Heuzard) - GPR#308: add experimental support for NetBSD/arm (verified on RaspberryPi) (Rich Neswold) +- GPR#335: Type error messages specify if a type is abstract + because no corresponding cmi could be found. (Hugo Heuzard) - GPR#365: prevent printing just a single type variable on one side of a type error clash. (Hugo Heuzard) From 354bd48f200847cc0f159d79325666a7dd2526d3 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Tue, 12 Jan 2016 19:51:06 +0100 Subject: [PATCH 004/145] Prim makearray --- asmcomp/closure.ml | 2 +- asmcomp/cmmgen.ml | 37 ++++++++++++++++----------- bytecomp/bytegen.ml | 16 +++++++++--- bytecomp/lambda.ml | 3 ++- bytecomp/lambda.mli | 6 ++++- bytecomp/printlambda.ml | 6 ++++- bytecomp/translcore.ml | 56 ++++++++++++++++++++++++++++------------- 7 files changed, 86 insertions(+), 40 deletions(-) diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index d4f028c4e..26020ec7a 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -113,7 +113,7 @@ let prim_size prim args = | Praise _ -> 4 | Pstringlength -> 5 | Pstringrefs | Pstringsets -> 6 - | Pmakearray kind -> 5 + List.length args + | Pmakearray _ -> 5 + List.length args | Parraylength kind -> if kind = Pgenarray then 6 else 2 | Parrayrefu kind -> if kind = Pgenarray then 12 else 2 | Parraysetu kind -> if kind = Pgenarray then 16 else 4 diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 829309730..6588a8025 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -687,9 +687,9 @@ let rec expr_size env = function expr_size env body | Uprim(Pmakeblock(tag, mut), args, _) -> RHS_block (List.length args) - | Uprim(Pmakearray(Paddrarray | Pintarray), args, _) -> + | Uprim(Pmakearray((Paddrarray | Pintarray), _), args, _) -> RHS_block (List.length args) - | Uprim(Pmakearray(Pfloatarray), args, _) -> + | Uprim(Pmakearray(Pfloatarray, _), args, _) -> RHS_floatblock (List.length args) | Uprim (Pduprecord ((Record_regular | Record_inlined _), sz), _, _) -> RHS_block sz @@ -1502,19 +1502,17 @@ let rec transl env e = make_alloc tag (List.map (transl env) args) | (Pccall prim, args) -> transl_ccall env prim args dbg - | (Pmakearray kind, []) -> + | (Pduparray (Pfloatarray as kind, _), + [Uprim (Pmakearray (Pfloatarray, _), args, _dbg)]) -> + transl_make_array env kind args + | (Pduparray _, [arg]) -> + let prim_obj_dup = + Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true + in + transl_ccall env prim_obj_dup [arg] dbg + | (Pmakearray (kind, _), []) -> transl_structured_constant (Uconst_block(0, [])) - | (Pmakearray kind, args) -> - begin match kind with - Pgenarray -> - Cop(Cextcall("caml_make_array", typ_val, true, Debuginfo.none), - [make_alloc 0 (List.map (transl env) args)]) - | Paddrarray | Pintarray -> - make_alloc 0 (List.map (transl env) args) - | Pfloatarray -> - make_float_alloc Obj.double_array_tag - (List.map (transl_unbox_float env) args) - end + | (Pmakearray (kind, _), args) -> transl_make_array env kind args | (Pbigarrayref(unsafe, num_dims, elt_kind, layout), arg1 :: argl) -> let elt = bigarray_get unsafe elt_kind layout @@ -1664,6 +1662,17 @@ let rec transl env e = | Uunreachable -> Cop(Cload Word_int, [Cconst_int 0]) +and transl_make_array env kind args = + match kind with + | Pgenarray -> + Cop(Cextcall("caml_make_array", typ_val, true, Debuginfo.none), + [make_alloc 0 (List.map (transl env) args)]) + | Paddrarray | Pintarray -> + make_alloc 0 (List.map (transl env) args) + | Pfloatarray -> + make_float_alloc Obj.double_array_tag + (List.map (transl_unbox_float env) args) + and transl_ccall env prim args dbg = let transl_arg native_repr arg = match native_repr with diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index fcb799311..5b0a91ab2 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -153,10 +153,11 @@ let rec size_of_lambda = function | Llet(str, id, arg, body) -> size_of_lambda body | Lletrec(bindings, body) -> size_of_lambda body | Lprim(Pmakeblock(tag, mut), args) -> RHS_block (List.length args) - | Lprim (Pmakearray (Paddrarray|Pintarray), args) -> + | Lprim (Pmakearray ((Paddrarray|Pintarray), _), args) -> RHS_block (List.length args) - | Lprim (Pmakearray Pfloatarray, args) -> RHS_floatblock (List.length args) - | Lprim (Pmakearray Pgenarray, args) -> assert false + | Lprim (Pmakearray (Pfloatarray, _), args) -> + RHS_floatblock (List.length args) + | Lprim (Pmakearray (Pgenarray, _), args) -> assert false | Lprim (Pduprecord ((Record_regular | Record_inlined _), size), args) -> RHS_block size | Lprim (Pduprecord (Record_extension, size), args) -> @@ -632,7 +633,7 @@ let rec comp_expr env exp sz cont = (Kpush:: Kconst (Const_base (Const_int n)):: Kaddint::cont) - | Lprim(Pmakearray kind, args) -> + | Lprim(Pmakearray (kind, _), args) -> begin match kind with Pintarray | Paddrarray -> comp_args env args sz (Kmakeblock(List.length args, 0) :: cont) @@ -645,6 +646,13 @@ let rec comp_expr env exp sz cont = (Kmakeblock(List.length args, 0) :: Kccall("caml_make_array", 1) :: cont) end + | Lprim (Pduparray _, [arg]) -> + let prim_obj_dup = + Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true + in + comp_expr env (Lprim (Pccall prim_obj_dup, [arg])) sz cont + | Lprim (Pduparray _, _) -> + Misc.fatal_error "Bytegen.comp_expr: Pduparray takes exactly one arg" (* Integer first for enabling futher optimization (cf. emitcode.ml) *) | Lprim (Pintcomp c, [arg ; (Lconst _ as k)]) -> let p = Pintcomp (commute_comparison c) diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 2763ab689..4a9c49fc9 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -77,7 +77,8 @@ type primitive = (* String operations *) | Pstringlength | Pstringrefu | Pstringsetu | Pstringrefs | Pstringsets (* Array operations *) - | Pmakearray of array_kind + | Pmakearray of array_kind * mutable_flag + | Pduparray of array_kind * mutable_flag | Parraylength of array_kind | Parrayrefu of array_kind | Parraysetu of array_kind diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index f50d0ff77..e0ed0952e 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -80,7 +80,11 @@ type primitive = (* String operations *) | Pstringlength | Pstringrefu | Pstringsetu | Pstringrefs | Pstringsets (* Array operations *) - | Pmakearray of array_kind + | Pmakearray of array_kind * mutable_flag + | Pduparray of array_kind * mutable_flag + (** For [Pduparray], the argument must be an immutable array. + The arguments of [Pduparray] give the kind and mutability of the + array being *produced* by the duplication. *) | Parraylength of array_kind | Parrayrefu of array_kind | Parraysetu of array_kind diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index 3e1960d4e..df5f82f9c 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -177,7 +177,10 @@ let primitive ppf = function | Pstringrefs -> fprintf ppf "string.get" | Pstringsets -> fprintf ppf "string.set" | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k) - | Pmakearray k -> fprintf ppf "makearray[%s]" (array_kind k) + | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k) + | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k) + | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k) + | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k) | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k) | Parraysetu k -> fprintf ppf "array.unsafe_set[%s]" (array_kind k) | Parrayrefs k -> fprintf ppf "array.get[%s]" (array_kind k) @@ -312,6 +315,7 @@ let name_of_primitive = function | Pstringsets -> "Pstringsets" | Parraylength _ -> "Parraylength" | Pmakearray _ -> "Pmakearray" + | Pduparray _ -> "Pduparray" | Parrayrefu _ -> "Parrayrefu" | Parraysetu _ -> "Parraysetu" | Parrayrefs _ -> "Parrayrefs" diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 8f5bed4cd..a4470302c 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -30,6 +30,8 @@ type error = exception Error of Location.t * error +let use_dup_for_constant_arrays_bigger_than = 4 + (* Forward declaration -- to be filled in by Translmod.transl_module *) let transl_module = ref((fun cc rootpath modl -> assert false) : @@ -443,8 +445,8 @@ let check_recursive_lambda idlist lam = let idlist' = add_letrec bindings idlist in List.for_all (fun (id, arg) -> check idlist' arg) bindings && check_top idlist' body - | Lprim (Pmakearray (Pgenarray), args) -> false - | Lprim (Pmakearray Pfloatarray, args) -> + | Lprim (Pmakearray (Pgenarray, _), args) -> false + | Lprim (Pmakearray (Pfloatarray, _), args) -> List.for_all (check idlist) args | Lsequence (lam1, lam2) -> check idlist lam1 && check_top idlist lam2 | Levent (lam, _) -> check_top idlist lam @@ -463,8 +465,8 @@ let check_recursive_lambda idlist lam = check idlist' body | Lprim(Pmakeblock(tag, mut), args) -> List.for_all (check idlist) args - | Lprim (Pmakearray Pfloatarray, _) -> false - | Lprim(Pmakearray(_), args) -> + | Lprim (Pmakearray (Pfloatarray, _), _) -> false + | Lprim (Pmakearray _, args) -> List.for_all (check idlist) args | Lsequence (lam1, lam2) -> check idlist lam1 && check idlist lam2 | Levent (lam, _) -> check idlist lam @@ -848,20 +850,35 @@ and transl_exp0 e = let kind = array_kind e in let ll = transl_list expr_list in begin try + (* For native code the decision as to which compilation strategy to + use is made later. This enables the Flambda passes to lift certain + kinds of array definitions to symbols. *) (* Deactivate constant optimization if array is small enough *) - if List.length ll <= 4 then raise Not_constant; - let cl = List.map extract_constant ll in - let master = - match kind with - | Paddrarray | Pintarray -> - Lconst(Const_block(0, cl)) - | Pfloatarray -> - Lconst(Const_float_array(List.map extract_float cl)) - | Pgenarray -> - raise Not_constant in (* can this really happen? *) - Lprim(Pccall prim_obj_dup, [master]) + if List.length ll <= use_dup_for_constant_arrays_bigger_than + then begin + raise Not_constant + end; + (* We cannot currently lift [Pintarray] arrays safely in Flambda + because [caml_modify] might be called upon them (e.g. from + code operating on polymorphic arrays, or functions such as + [caml_array_blit]. *) + if !Clflags.native_code && kind = Pfloatarray then + let imm_array = Lprim (Pmakearray (kind, Immutable), ll) in + Lprim (Pduparray (kind, Mutable), [imm_array]) + else begin + let cl = List.map extract_constant ll in + let master = + match kind with + | Paddrarray | Pintarray -> + Lconst(Const_block(0, cl)) + | Pfloatarray -> + Lconst(Const_float_array(List.map extract_float cl)) + | Pgenarray -> + raise Not_constant in (* can this really happen? *) + Lprim(Pccall prim_obj_dup, [master]) + end with Not_constant -> - Lprim(Pmakearray kind, ll) + Lprim(Pmakearray (kind, Mutable), ll) end | Texp_ifthenelse(cond, ifso, Some ifnot) -> Lifthenelse(transl_exp cond, @@ -1195,14 +1212,17 @@ and transl_record env all_labels repres lbl_expr_list opt_init_expr = | Record_regular -> Lconst(Const_block(0, cl)) | Record_inlined tag -> Lconst(Const_block(tag, cl)) | Record_float -> - Lconst(Const_float_array(List.map extract_float cl)) + if !Clflags.native_code then + Lprim (Pmakearray (Pfloatarray, Immutable), ll) + else + Lconst(Const_float_array(List.map extract_float cl)) | Record_extension -> raise Not_constant with Not_constant -> match repres with Record_regular -> Lprim(Pmakeblock(0, mut), ll) | Record_inlined tag -> Lprim(Pmakeblock(tag, mut), ll) - | Record_float -> Lprim(Pmakearray Pfloatarray, ll) + | Record_float -> Lprim(Pmakearray (Pfloatarray, mut), ll) | Record_extension -> let path = match all_labels.(0).lbl_res.desc with From fb4d06a3aade638016928ac59402d87584e5fea5 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 11:27:30 +0000 Subject: [PATCH 005/145] Clflags stuff and Arg_helper --- .depend | 11 +- Makefile.shared | 7 +- asmcomp/closure.ml | 7 +- bytecomp/simplif.ml | 6 +- bytecomp/simplif.mli | 3 +- debugger/Makefile.shared | 4 +- driver/compenv.ml | 11 +- driver/main_args.ml | 4 +- driver/main_args.mli | 2 +- driver/optmain.ml | 4 +- otherlibs/dynlink/Makefile | 3 +- tools/Makefile.shared | 12 ++- tools/ocamloptp.ml | 2 +- utils/clflags.ml | 212 ++++++++++++++++++++++++++++++++++++- utils/clflags.mli | 86 ++++++++++++++- 15 files changed, 341 insertions(+), 33 deletions(-) diff --git a/.depend b/.depend index 377d89f85..c755d77a4 100644 --- a/.depend +++ b/.depend @@ -1,5 +1,6 @@ +utils/arg_helper.cmi : utils/ccomp.cmi : -utils/clflags.cmi : utils/misc.cmi +utils/clflags.cmi : utils/numbers.cmi utils/misc.cmi utils/config.cmi : utils/consistbl.cmi : utils/identifiable.cmi : @@ -10,12 +11,16 @@ utils/tbl.cmi : utils/terminfo.cmi : utils/timings.cmi : utils/warnings.cmi : +utils/arg_helper.cmo : utils/misc.cmi utils/arg_helper.cmi +utils/arg_helper.cmx : utils/misc.cmx utils/arg_helper.cmi utils/ccomp.cmo : utils/misc.cmi utils/config.cmi utils/clflags.cmi \ utils/ccomp.cmi utils/ccomp.cmx : utils/misc.cmx utils/config.cmx utils/clflags.cmx \ utils/ccomp.cmi -utils/clflags.cmo : utils/misc.cmi utils/config.cmi utils/clflags.cmi -utils/clflags.cmx : utils/misc.cmx utils/config.cmx utils/clflags.cmi +utils/clflags.cmo : utils/numbers.cmi utils/misc.cmi utils/config.cmi \ + utils/arg_helper.cmi utils/clflags.cmi +utils/clflags.cmx : utils/numbers.cmx utils/misc.cmx utils/config.cmx \ + utils/arg_helper.cmx utils/clflags.cmi utils/config.cmo : utils/config.cmi utils/config.cmx : utils/config.cmi utils/consistbl.cmo : utils/consistbl.cmi diff --git a/Makefile.shared b/Makefile.shared index 496ab0731..c41767ac5 100755 --- a/Makefile.shared +++ b/Makefile.shared @@ -36,10 +36,9 @@ OCAMLDOC_OPT=$(WITH_OCAMLDOC:=.opt) INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \ -I toplevel -UTILS=utils/config.cmo utils/clflags.cmo \ - utils/misc.cmo \ - utils/identifiable.cmo utils/numbers.cmo \ - utils/tbl.cmo utils/timings.cmo \ +UTILS=utils/config.cmo utils/misc.cmo \ + utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \ + utils/clflags.cmo utils/tbl.cmo utils/timings.cmo \ utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \ utils/consistbl.cmo \ utils/strongly_connected_components.cmo diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index dccecbc93..57e0447a9 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -1160,7 +1160,12 @@ and close_functions fenv cenv fun_defs = in let threshold = match inline_attribute with - | Default_inline -> !Clflags.inline_threshold + n + | Default_inline -> + let inline_threshold = + Clflags.Float_arg_helper.get ~key:0 !Clflags.inline_threshold + in + let magic_scale_constant = 8. in + int_of_float (inline_threshold *. magic_scale_constant) + n | Always_inline -> max_int | Never_inline -> min_int in diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml index e893065a2..2b5c92cb7 100644 --- a/bytecomp/simplif.ml +++ b/bytecomp/simplif.ml @@ -618,7 +618,8 @@ and list_emit_tail_infos is_tail = 'Some' constructor, only to deconstruct it immediately in the function's body. *) -let split_default_wrapper fun_id kind params body attr = +let split_default_wrapper ?(create_wrapper_body = fun lam -> lam) + fun_id kind params body attr = let rec aux map = function | Llet(Strict, id, (Lifthenelse(Lvar optparam, _, _) as def), rest) when Ident.name optparam = "*opt*" && List.mem optparam params @@ -660,7 +661,8 @@ let split_default_wrapper fun_id kind params body attr = in try let wrapper_body, inner = aux [] body in - [(fun_id, Lfunction{kind; params; body = wrapper_body; attr}); inner] + [(fun_id, Lfunction{kind; params; body = create_wrapper_body wrapper_body; + attr}); inner] with Exit -> [(fun_id, Lfunction{kind; params; body; attr})] diff --git a/bytecomp/simplif.mli b/bytecomp/simplif.mli index 7a1bdd8c5..0dc1e217d 100644 --- a/bytecomp/simplif.mli +++ b/bytecomp/simplif.mli @@ -20,7 +20,8 @@ open Lambda val simplify_lambda: lambda -> lambda val split_default_wrapper - : Ident.t + : ?create_wrapper_body:(lambda -> lambda) + -> Ident.t -> function_kind -> Ident.t list -> lambda diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared index 096d61823..a296bf26c 100644 --- a/debugger/Makefile.shared +++ b/debugger/Makefile.shared @@ -30,9 +30,9 @@ INCLUDES=\ OTHEROBJS=\ $(UNIXDIR)/unix.cma \ - ../utils/config.cmo ../utils/tbl.cmo \ - ../utils/clflags.cmo ../utils/misc.cmo \ + ../utils/config.cmo ../utils/tbl.cmo ../utils/misc.cmo \ ../utils/identifiable.cmo ../utils/numbers.cmo \ + ../utils/arg_helper.cmo ../utils/clflags.cmo \ ../utils/consistbl.cmo ../utils/warnings.cmo \ ../utils/terminfo.cmo \ ../parsing/location.cmo ../parsing/longident.cmo ../parsing/docstrings.cmo \ diff --git a/driver/compenv.ml b/driver/compenv.ml index 42d98bca6..b9eb6307f 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -205,13 +205,10 @@ let read_OCAMLPARAM ppf position = | "wwe" -> Warnings.parse_options false v (* inlining *) - | "inline" -> begin try - inline_threshold := 8 * int_of_string v - with _ -> - Location.print_warning Location.none ppf - (Warnings.Bad_env_variable ("OCAMLPARAM", - "non-integer parameter for \"inline\"")) - end + | "inline" -> + Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline'" + inline_threshold (* color output *) | "color" -> diff --git a/driver/main_args.ml b/driver/main_args.ml index 9b3c6f19f..dd9e0989a 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -110,7 +110,7 @@ let mk_init f = ;; let mk_inline f = - "-inline", Arg.Int f, " Set aggressiveness of inlining to " + "-inline", Arg.String f, " Set aggressiveness of inlining to " ;; let mk_intf f = @@ -605,7 +605,7 @@ end;; module type Optcommon_options = sig val _compact : unit -> unit - val _inline : int -> unit + val _inline : string -> unit val _dclambda : unit -> unit val _dcmm : unit -> unit diff --git a/driver/main_args.mli b/driver/main_args.mli index bc14432d5..5efe5bcbe 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -117,7 +117,7 @@ end;; module type Optcommon_options = sig val _compact : unit -> unit - val _inline : int -> unit + val _inline : string -> unit val _dclambda : unit -> unit val _dcmm : unit -> unit diff --git a/driver/optmain.ml b/driver/optmain.ml index 6b6b95e81..608f5e2d5 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -86,7 +86,9 @@ module Options = Main_args.Make_optcomp_options (struct let _i () = print_types := true; compile_only := true let _I dir = include_dirs := dir :: !include_dirs let _impl = impl - let _inline n = inline_threshold := n * 8 + let _inline spec = + Float_arg_helper.parse spec ~update:inline_threshold + ~help_text:"Syntax: -inline " let _intf = intf let _intf_suffix s = Config.interface_suffix := s let _keep_docs = set keep_docs diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index eb5049716..e95e76363 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -30,8 +30,9 @@ COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string \ OBJS=dynlinkaux.cmo dynlink.cmo COMPILEROBJS=\ - ../../utils/misc.cmo ../../utils/config.cmo ../../utils/clflags.cmo \ + ../../utils/misc.cmo ../../utils/config.cmo \ ../../utils/identifiable.cmo ../../utils/numbers.cmo \ + ../../utils/arg_helper.cmo ../../utils/clflags.cmo \ ../../utils/tbl.cmo ../../utils/consistbl.cmo \ ../../utils/terminfo.cmo ../../utils/warnings.cmo \ ../../parsing/asttypes.cmi \ diff --git a/tools/Makefile.shared b/tools/Makefile.shared index df2372a87..0d804015a 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -36,7 +36,7 @@ opt.opt: ocamldep.opt read_cmt.opt CAMLDEP_OBJ=depend.cmo ocamldep.cmo CAMLDEP_IMPORTS=timings.cmo misc.cmo config.cmo identifiable.cmo numbers.cmo \ - clflags.cmo terminfo.cmo \ + arg_helper.cmo clflags.cmo terminfo.cmo \ warnings.cmo location.cmo longident.cmo docstrings.cmo \ syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \ ccomp.cmo ast_mapper.cmo pparse.cmo compenv.cmo builtin_attributes.cmo @@ -67,7 +67,7 @@ install:: CSLPROF=ocamlprof.cmo CSLPROF_IMPORTS=misc.cmo config.cmo identifiable.cmo numbers.cmo \ - clflags.cmo terminfo.cmo \ + arg_helper.cmo clflags.cmo terminfo.cmo \ warnings.cmo location.cmo longident.cmo docstrings.cmo \ syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo @@ -75,10 +75,12 @@ ocamlprof: $(CSLPROF) profiling.cmo $(CAMLC) $(LINKFLAGS) -o ocamlprof $(CSLPROF_IMPORTS) $(CSLPROF) ocamlcp: ocamlcp.cmo - $(CAMLC) $(LINKFLAGS) -o ocamlcp warnings.cmo main_args.cmo ocamlcp.cmo + $(CAMLC) $(LINKFLAGS) -o ocamlcp warnings.cmo misc.cmo config.cmo \ + identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo main_args.cmo ocamlcp.cmo ocamloptp: ocamloptp.cmo - $(CAMLC) $(LINKFLAGS) -o ocamloptp warnings.cmo main_args.cmo \ + $(CAMLC) $(LINKFLAGS) -o ocamloptp warnings.cmo misc.cmo config.cmo \ + identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo main_args.cmo \ ocamloptp.cmo opt:: profiling.cmx @@ -160,7 +162,7 @@ clean:: # Insert labels following an interface file (upgrade 3.02 to 3.03) -ADDLABELS_IMPORTS=misc.cmo config.cmo clflags.cmo \ +ADDLABELS_IMPORTS=misc.cmo config.cmo arg_helper.cmo clflags.cmo \ identifiable.cmo numbers.cmo terminfo.cmo \ warnings.cmo location.cmo longident.cmo docstrings.cmo \ syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml index 9429d65ed..3fea75f2d 100644 --- a/tools/ocamloptp.ml +++ b/tools/ocamloptp.ml @@ -58,7 +58,7 @@ module Options = Main_args.Make_optcomp_options (struct let _i = option "-i" let _I s = option_with_arg "-I" s let _impl s = with_impl := true; option_with_arg "-impl" s - let _inline n = option_with_int "-inline" n + let _inline s = option_with_arg "-inline" s let _intf s = with_intf := true; option_with_arg "-intf" s let _intf_suffix s = option_with_arg "-intf-suffix" s let _keep_docs = option "-keep-docs" diff --git a/utils/clflags.ml b/utils/clflags.ml index af1fa5c4b..ff63d2761 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -12,6 +12,29 @@ (* Command-line parameters *) +module Int_arg_helper = Arg_helper.Make (struct + module Key = struct + include Numbers.Int + let of_string = int_of_string + end + + module Value = struct + include Numbers.Int + let of_string = int_of_string + end +end) +module Float_arg_helper = Arg_helper.Make (struct + module Key = struct + include Numbers.Int + let of_string = int_of_string + end + + module Value = struct + include Numbers.Float + let of_string = float_of_string + end +end) + let objfiles = ref ([] : string list) (* .cmo and .cma files *) and ccobjs = ref ([] : string list) (* .o, .a, .so and -cclib -lxxx *) and dllibs = ref ([] : string list) (* .so and -dllib -lxxx *) @@ -69,7 +92,11 @@ let dump_parsetree = ref false (* -dparsetree *) and dump_typedtree = ref false (* -dtypedtree *) and dump_rawlambda = ref false (* -drawlambda *) and dump_lambda = ref false (* -dlambda *) +and dump_rawclambda = ref false (* -drawclambda *) and dump_clambda = ref false (* -dclambda *) +and dump_flambda = ref false (* -dflambda *) +and dump_flambda_let = ref (None : int option) (* -dflambda-let=... *) +and dump_flambda_verbose = ref false (* -dflambda-verbose *) and dump_instr = ref false (* -dinstr *) let keep_asm_file = ref false (* -S *) @@ -91,8 +118,16 @@ let dump_linear = ref false (* -dlinear *) let keep_startup_file = ref false (* -dstartup *) let dump_combine = ref false (* -dcombine *) let native_code = ref false (* set to true under ocamlopt *) -let inline_threshold = ref 10 +let o2 = ref false (* -O2 *) +let o3 = ref false (* -O3 *) +let default_inline_threshold = 10. +let inline_threshold = ref (Float_arg_helper.default default_inline_threshold) +let inlining_stats = ref false +let simplify_rounds = ref 1 +let default_unroll = 0 +let unroll = ref (Int_arg_helper.default default_unroll) let force_slash = ref false (* for ocamldep *) +let clambda_checks = ref false (* -clambda-checks *) let dont_write_files = ref false (* set to true under ocamldoc *) @@ -119,6 +154,181 @@ let keep_locs = ref false (* -keep-locs *) let unsafe_string = ref true;; (* -safe-string / -unsafe-string *) let print_timings = ref false (* -dtimings *) +let inline_toplevel_multiplier = 16 +let default_inline_toplevel_threshold = + int_of_float ((float inline_toplevel_multiplier) *. default_inline_threshold) +let inline_toplevel_threshold = + ref (Int_arg_helper.default default_inline_toplevel_threshold) + +let default_inline_call_cost = 5 +let default_inline_alloc_cost = 3 +let default_inline_prim_cost = 3 +let default_inline_branch_cost = 3 +let default_inline_indirect_cost = 2 +let default_branch_inline_factor = 0.1 +let default_inline_lifting_benefit = 1300 + +let inline_call_cost = ref (Int_arg_helper.default default_inline_call_cost) +let inline_alloc_cost = ref (Int_arg_helper.default default_inline_alloc_cost) +let inline_prim_cost = ref (Int_arg_helper.default default_inline_prim_cost) +let inline_branch_cost = + ref (Int_arg_helper.default default_inline_branch_cost) +let inline_indirect_cost = + ref (Int_arg_helper.default default_inline_indirect_cost) +let branch_inline_factor = + ref (Float_arg_helper.default default_branch_inline_factor) +let inline_lifting_benefit = + ref (Int_arg_helper.default default_inline_lifting_benefit) + +let print_timings = ref false (* -timings *) + +let unbox_closures = ref false (* -unbox-closures *) +let remove_unused_arguments = ref false (* -remove-unused-arguments *) +let inline_recursive_functions = ref true (* -no-inline-recursive-functions *) + +let classic_inlining = ref false (* -classic-inlining *) + +let default_max_inlining_depth = 1 +let max_inlining_depth = + ref (Int_arg_helper.default default_max_inlining_depth) + +type inlining_arguments = { + inline_call_cost : int option; + inline_alloc_cost : int option; + inline_prim_cost : int option; + inline_branch_cost : int option; + inline_indirect_cost : int option; + inline_lifting_benefit : int option; + branch_inline_factor : float option; + max_inlining_depth : int option; + unroll : int option; + inline_threshold : float option; + inline_toplevel_threshold : int option; +} + +let set_int_arg round (arg:Int_arg_helper.parsed ref) value = + let open Int_arg_helper in + match value with + | None -> () + | Some value -> + let parsed = + match round with + | None -> { !arg with default = value } + | Some round -> + { !arg with + override = Numbers.Int.Map.add round value !arg.override } + in + arg := parsed + +let set_float_arg round (arg:Float_arg_helper.parsed ref) value = + let open Float_arg_helper in + match value with + | None -> () + | Some value -> + let parsed = + match round with + | None -> { !arg with default = value } + | Some round -> + { !arg with + override = Numbers.Int.Map.add round value !arg.override } + in + arg := parsed + +let use_inlining_arguments_set ?round (arg:inlining_arguments) = + let set_int = set_int_arg round in + let set_float = set_float_arg round in + set_int inline_call_cost arg.inline_call_cost; + set_int inline_alloc_cost arg.inline_alloc_cost; + set_int inline_prim_cost arg.inline_prim_cost; + set_int inline_branch_cost arg.inline_branch_cost; + set_int inline_indirect_cost arg.inline_indirect_cost; + set_int inline_lifting_benefit arg.inline_lifting_benefit; + set_float branch_inline_factor arg.branch_inline_factor; + set_int max_inlining_depth arg.max_inlining_depth; + set_int unroll arg.unroll; + set_float inline_threshold arg.inline_threshold; + set_int inline_toplevel_threshold arg.inline_toplevel_threshold + +(* o1 is the default *) +let o1_arguments = { + inline_call_cost = None; + inline_alloc_cost = None; + inline_prim_cost = None; + inline_branch_cost = None; + inline_indirect_cost = None; + inline_lifting_benefit = None; + branch_inline_factor = None; + max_inlining_depth = None; + unroll = None; + inline_threshold = None; + inline_toplevel_threshold = None; +} + +let classic_arguments = { + inline_call_cost = None; + inline_alloc_cost = None; + inline_prim_cost = None; + inline_branch_cost = None; + inline_indirect_cost = None; + inline_lifting_benefit = None; + branch_inline_factor = None; + max_inlining_depth = None; + unroll = None; + (* [inline_threshold] matches the current compiler's default. + Note that this particular fraction can be expressed exactly in + floating point. *) + inline_threshold = Some (10. /. 8.); + (* [inline_toplevel_threshold] is not used in classic mode. *) + inline_toplevel_threshold = Some 1; +} + +let o2_arguments = { + inline_call_cost = Some (2 * default_inline_call_cost); + inline_alloc_cost = Some (2 * default_inline_alloc_cost); + inline_prim_cost = Some (2 * default_inline_prim_cost); + inline_branch_cost = Some (2 * default_inline_branch_cost); + inline_indirect_cost = Some (2 * default_inline_indirect_cost); + inline_lifting_benefit = None; + branch_inline_factor = None; + max_inlining_depth = Some 2; + unroll = None; + inline_threshold = Some 25.; + inline_toplevel_threshold = Some (25 * inline_toplevel_multiplier); +} + +let o3_arguments = { + inline_call_cost = Some (3 * default_inline_call_cost); + inline_alloc_cost = Some (3 * default_inline_alloc_cost); + inline_prim_cost = Some (3 * default_inline_prim_cost); + inline_branch_cost = Some (3 * default_inline_branch_cost); + inline_indirect_cost = Some (3 * default_inline_indirect_cost); + inline_lifting_benefit = None; + branch_inline_factor = Some 0.; + max_inlining_depth = Some 3; + unroll = Some 1; + inline_threshold = Some 50.; + inline_toplevel_threshold = Some (50 * inline_toplevel_multiplier); +} + +let all_passes = ref [] +let dumped_passes_list = ref [] +let dumped_pass s = + assert(List.mem s !all_passes); + List.mem s !dumped_passes_list + +let set_dumped_pass s enabled = + assert(List.mem s !all_passes); + let passes_without_s = List.filter ((<>) s) !dumped_passes_list in + let dumped_passes = + if enabled then + s :: passes_without_s + else + passes_without_s + in + dumped_passes_list := dumped_passes + +let flambda_invariant_checks = ref false + let parse_color_setting = function | "auto" -> Some Misc.Color.Auto | "always" -> Some Misc.Color.Always diff --git a/utils/clflags.mli b/utils/clflags.mli index a30adde71..c887c4b9e 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -10,6 +10,51 @@ (* *) (***********************************************************************) +(** Optimization parameters represented as ints indexed by round number. *) +module Int_arg_helper : sig + type parsed = { + default : int; + override : int Numbers.Int.Map.t; + } + + val parse : string -> help_text:string -> update:parsed ref -> unit + val get : key:int -> parsed -> int +end + +(** Optimization parameters represented as floats indexed by round number. *) +module Float_arg_helper : sig + type parsed = { + default : float; + override : float Numbers.Int.Map.t; + } + + val parse : string -> help_text:string -> update:parsed ref -> unit + val get : key:int -> parsed -> float +end + +type inlining_arguments = { + inline_call_cost : int option; + inline_alloc_cost : int option; + inline_prim_cost : int option; + inline_branch_cost : int option; + inline_indirect_cost : int option; + inline_lifting_benefit : int option; + branch_inline_factor : float option; + max_inlining_depth : int option; + unroll : int option; + inline_threshold : float option; + inline_toplevel_threshold : int option; +} + +val classic_arguments : inlining_arguments +val o1_arguments : inlining_arguments +val o2_arguments : inlining_arguments +val o3_arguments : inlining_arguments + +(** Set all the inlining arguments for a round. + The default is set if no round is provided. *) +val use_inlining_arguments_set : ?round:int -> inlining_arguments -> unit + val objfiles : string list ref val ccobjs : string list ref val dllibs : string list ref @@ -66,7 +111,10 @@ val dump_parsetree : bool ref val dump_typedtree : bool ref val dump_rawlambda : bool ref val dump_lambda : bool ref +val dump_rawclambda : bool ref val dump_clambda : bool ref +val dump_flambda : bool ref +val dump_flambda_let : int option ref val dump_instr : bool ref val keep_asm_file : bool ref val optimize_for_speed : bool ref @@ -85,7 +133,30 @@ val dump_linear : bool ref val keep_startup_file : bool ref val dump_combine : bool ref val native_code : bool ref -val inline_threshold : int ref +val o2 : bool ref +val o3 : bool ref +val default_inline_threshold : float +val inline_threshold : Float_arg_helper.parsed ref +val inlining_stats : bool ref +val simplify_rounds : int ref +val default_unroll : int +val unroll : Int_arg_helper.parsed ref +val default_inline_toplevel_threshold : int +val inline_toplevel_threshold : Int_arg_helper.parsed ref +val default_inline_call_cost : int +val default_inline_alloc_cost : int +val default_inline_prim_cost : int +val default_inline_branch_cost : int +val default_inline_indirect_cost : int +val default_inline_lifting_benefit : int +val inline_call_cost : Int_arg_helper.parsed ref +val inline_alloc_cost : Int_arg_helper.parsed ref +val inline_prim_cost : Int_arg_helper.parsed ref +val inline_branch_cost : Int_arg_helper.parsed ref +val inline_indirect_cost : Int_arg_helper.parsed ref +val inline_lifting_benefit : Int_arg_helper.parsed ref +val default_branch_inline_factor : float +val branch_inline_factor : Float_arg_helper.parsed ref val dont_write_files : bool ref val std_include_flag : string -> string val std_include_dir : unit -> string list @@ -99,6 +170,19 @@ val keep_locs : bool ref val unsafe_string : bool ref val opaque : bool ref val print_timings : bool ref +val flambda_invariant_checks : bool ref +val unbox_closures : bool ref +val clambda_checks : bool ref +val default_max_inlining_depth : int +val max_inlining_depth : Int_arg_helper.parsed ref +val inline_recursive_functions : bool ref +val remove_unused_arguments : bool ref +val dump_flambda_verbose : bool ref +val classic_inlining : bool ref + +val all_passes : string list ref +val dumped_pass : string -> bool +val set_dumped_pass : string -> bool -> unit val parse_color_setting : string -> Misc.Color.setting option val color : Misc.Color.setting ref From 983a7e4f1b38ba7fe6eff4d7d8cf59e078426171 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 11:34:49 +0000 Subject: [PATCH 006/145] Arg_helper --- utils/arg_helper.ml | 85 ++++++++++++++++++++++++++++++++++++++++++++ utils/arg_helper.mli | 46 ++++++++++++++++++++++++ 2 files changed, 131 insertions(+) create mode 100644 utils/arg_helper.ml create mode 100644 utils/arg_helper.mli diff --git a/utils/arg_helper.ml b/utils/arg_helper.ml new file mode 100644 index 000000000..3b5c27dce --- /dev/null +++ b/utils/arg_helper.ml @@ -0,0 +1,85 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Mark Shinwell, Jane Street Europe *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(**************************************************************************) + +let fatal err = + prerr_endline err; + exit 2 + +module Make (S : sig + module Key : sig + type t + val of_string : string -> t + module Map : Map.S with type key = t + end + + module Value : sig + type t + val of_string : string -> t + end +end) = struct + type parsed = { + default : S.Value.t; + override : S.Value.t S.Key.Map.t; + } + + let default v = { default = v; override = S.Key.Map.empty } + + let no_equals value = + match String.index value '=' with + | exception Not_found -> true + | _index -> false + + let parse str ~help_text ~update = + let values = Misc.Stdlib.String.split str ~on:',' in + let parsed = + List.fold_left (fun acc value -> + match String.index value '=' with + | exception Not_found -> + begin match S.Value.of_string value with + | value -> { acc with default = value } + | exception exn -> + fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text) + end + | equals -> + let key_value_pair = value in + let length = String.length key_value_pair in + if equals <= 0 || equals >= length - 1 then begin + fatal help_text + end; + let key = + let key = String.sub key_value_pair 0 equals in + try S.Key.of_string key + with exn -> + fatal (Printf.sprintf "%s: %s" + (Printexc.to_string exn) help_text) + in + let value = + let value = + String.sub key_value_pair (equals + 1) (length - equals - 1) + in + try S.Value.of_string value + with exn -> + fatal (Printf.sprintf "%s: %s" + (Printexc.to_string exn) help_text) + in + { acc with override = S.Key.Map.add key value acc.override }) + !update + values + in + update := parsed + + let get ~key parsed = + match S.Key.Map.find key parsed.override with + | provided -> provided + | exception Not_found -> + parsed.default +end diff --git a/utils/arg_helper.mli b/utils/arg_helper.mli new file mode 100644 index 000000000..cb95257a5 --- /dev/null +++ b/utils/arg_helper.mli @@ -0,0 +1,46 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Mark Shinwell, Jane Street Europe *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(**************************************************************************) + +(** Decipher command line arguments of the form + | =[,...] + (as used for example for the specification of inlining parameters + varying by simplification round). +*) + +module Make (S : sig + module Key : sig + type t + + (** The textual representation of a key must not contain '=' or ','. *) + val of_string : string -> t + + module Map : Map.S with type key = t + end + + module Value : sig + type t + + (** The textual representation of a value must not contain '=' or ','. *) + val of_string : string -> t + end +end) : sig + type parsed = { + default : S.Value.t; + override : S.Value.t S.Key.Map.t; + } + + val default : S.Value.t -> parsed + + val parse : string -> help_text:string -> update:parsed ref -> unit + + val get : key:S.Key.t -> parsed -> S.Value.t +end From 069d6a0cff47652e08430bcde7c475d472720687 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 11:38:18 +0000 Subject: [PATCH 007/145] copyright headers --- utils/arg_helper.ml | 12 ++++++++---- utils/arg_helper.mli | 12 ++++++++---- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/utils/arg_helper.ml b/utils/arg_helper.ml index 3b5c27dce..7da6233c8 100644 --- a/utils/arg_helper.ml +++ b/utils/arg_helper.ml @@ -2,11 +2,15 @@ (* *) (* OCaml *) (* *) -(* Mark Shinwell, Jane Street Europe *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) (* *) -(* Copyright 2015 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) +(* Copyright 2015--2016 OCamlPro SAS *) +(* Copyright 2015--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) (* *) (**************************************************************************) diff --git a/utils/arg_helper.mli b/utils/arg_helper.mli index cb95257a5..9de1d999e 100644 --- a/utils/arg_helper.mli +++ b/utils/arg_helper.mli @@ -2,11 +2,15 @@ (* *) (* OCaml *) (* *) -(* Mark Shinwell, Jane Street Europe *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) (* *) -(* Copyright 2015 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) +(* Copyright 2015--2016 OCamlPro SAS *) +(* Copyright 2015--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) (* *) (**************************************************************************) From 0f3c60b9ff690824e0a2e4a1cffc8a511f11c4e2 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 12:00:43 +0000 Subject: [PATCH 008/145] New warning --- utils/warnings.ml | 7 ++++++- utils/warnings.mli | 1 + 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/utils/warnings.ml b/utils/warnings.ml index 3166e7859..1fa9e517e 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -76,6 +76,7 @@ type t = | Unreachable_case (* 56 *) | Ambiguous_pattern of string list (* 57 *) | No_cmx_file of string (* 58 *) + | Assignment_on_non_mutable_value (* 59 *) ;; (* If you remove a warning, leave a hole in the numbering. NEVER change @@ -143,10 +144,12 @@ let number = function | Unreachable_case -> 56 | Ambiguous_pattern _ -> 57 | No_cmx_file _ -> 58 + | Assignment_on_non_mutable_value -> 59 ;; -let last_warning_number = 58 +let last_warning_number = 59 ;; + (* Must be the max number returned by the [number] function. *) let letter = function @@ -431,6 +434,7 @@ let message = function Printf.sprintf "the %S attribute is used more than once on this expression" attr_name | Inlining_impossible reason -> Printf.sprintf "Inlining impossible in this context: %s" reason + | Assignment_on_non_mutable_value -> "Assignment to non-mutable value" | Ambiguous_pattern vars -> let msg = let vars = List.sort String.compare vars in @@ -541,6 +545,7 @@ let descriptions = 56, "Unreachable case in a pattern-matching (based on type information)."; 57, "Ambiguous binding by pattern."; 58, "Missing cmx file"; + 59, "Assignment on non-mutable value"; ] ;; diff --git a/utils/warnings.mli b/utils/warnings.mli index 37de15ef0..17b63846e 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -71,6 +71,7 @@ type t = | Unreachable_case (* 56 *) | Ambiguous_pattern of string list (* 57 *) | No_cmx_file of string (* 58 *) + | Assignment_on_non_mutable_value (* 59 *) ;; val parse_options : bool -> string -> unit;; From ceec2b97591e1f152f193cd997cd50564b6a971a Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 12:03:17 +0000 Subject: [PATCH 009/145] rename --- utils/warnings.ml | 6 +++--- utils/warnings.mli | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/utils/warnings.ml b/utils/warnings.ml index 1fa9e517e..13dfa9e88 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -76,7 +76,7 @@ type t = | Unreachable_case (* 56 *) | Ambiguous_pattern of string list (* 57 *) | No_cmx_file of string (* 58 *) - | Assignment_on_non_mutable_value (* 59 *) + | Assignment_to_non_mutable_value (* 59 *) ;; (* If you remove a warning, leave a hole in the numbering. NEVER change @@ -144,7 +144,7 @@ let number = function | Unreachable_case -> 56 | Ambiguous_pattern _ -> 57 | No_cmx_file _ -> 58 - | Assignment_on_non_mutable_value -> 59 + | Assignment_to_non_mutable_value -> 59 ;; let last_warning_number = 59 @@ -434,7 +434,7 @@ let message = function Printf.sprintf "the %S attribute is used more than once on this expression" attr_name | Inlining_impossible reason -> Printf.sprintf "Inlining impossible in this context: %s" reason - | Assignment_on_non_mutable_value -> "Assignment to non-mutable value" + | Assignment_to_non_mutable_value -> "Assignment to non-mutable value" | Ambiguous_pattern vars -> let msg = let vars = List.sort String.compare vars in diff --git a/utils/warnings.mli b/utils/warnings.mli index 17b63846e..1f9e79876 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -71,7 +71,7 @@ type t = | Unreachable_case (* 56 *) | Ambiguous_pattern of string list (* 57 *) | No_cmx_file of string (* 58 *) - | Assignment_on_non_mutable_value (* 59 *) + | Assignment_to_non_mutable_value (* 59 *) ;; val parse_options : bool -> string -> unit;; From cf276faedd258218061856281ca276258a25a953 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 12:04:13 +0000 Subject: [PATCH 010/145] rename --- utils/warnings.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/warnings.ml b/utils/warnings.ml index 13dfa9e88..1ec6cc084 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -545,7 +545,7 @@ let descriptions = 56, "Unreachable case in a pattern-matching (based on type information)."; 57, "Ambiguous binding by pattern."; 58, "Missing cmx file"; - 59, "Assignment on non-mutable value"; + 59, "Assignment to non-mutable value"; ] ;; From 90e98e1544cf2c6e1f3855a46f9f677a2b5127ed Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 12:04:44 +0000 Subject: [PATCH 011/145] move a line --- utils/warnings.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/warnings.ml b/utils/warnings.ml index 1ec6cc084..14575a94e 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -434,7 +434,6 @@ let message = function Printf.sprintf "the %S attribute is used more than once on this expression" attr_name | Inlining_impossible reason -> Printf.sprintf "Inlining impossible in this context: %s" reason - | Assignment_to_non_mutable_value -> "Assignment to non-mutable value" | Ambiguous_pattern vars -> let msg = let vars = List.sort String.compare vars in @@ -449,6 +448,7 @@ let message = function Printf.sprintf "no cmx file was found in path for module %s, \ and its interface was not compiled with -opaque" name + | Assignment_to_non_mutable_value -> "Assignment to non-mutable value" ;; let nerrors = ref 0;; From 776b489f35d0daafad313d3607edc4241113ad52 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 12:06:12 +0000 Subject: [PATCH 012/145] add warning 59 to ocamlc.m --- man/ocamlc.m | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/ocamlc.m b/man/ocamlc.m index ce928d1b9..ae1eeaf53 100644 --- a/man/ocamlc.m +++ b/man/ocamlc.m @@ -855,6 +855,9 @@ mutually recursive types. 50 \ \ Unexpected documentation comment. +59 +\ \ Assignment on non-mutable value. + The letters stand for the following sets of warnings. Any letter not mentioned here corresponds to the empty set. From 868b799304f3f676c0603b7752da0b5db6d33890 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Wed, 6 Jan 2016 17:48:37 +0100 Subject: [PATCH 013/145] Configure option for flambda --- configure | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/configure b/configure index d1d36094a..b2c5f7d54 100755 --- a/configure +++ b/configure @@ -51,6 +51,7 @@ no_naked_pointers=false native_compiler=true TOOLPREF="" with_cfi=true +flambda=false # Try to turn internationalization off, can cause config.guess to malfunction! unset LANG @@ -162,6 +163,8 @@ while : ; do with_cfi=false;; -no-native-compiler) native_compiler=false;; + -flambda) + flambda=true;; *) if echo "$1" | grep -q -e '^--\?[a-zA-Z0-9-]\+='; then err "configure expects arguments of the form '-prefix /foo/bar'," \ "not '-prefix=/foo/bar' (note the '=')." @@ -1788,6 +1791,7 @@ echo "HOST=$host" >> Makefile if [ "$ostype" = Cygwin ]; then echo "DIFF=diff -q --strip-trailing-cr" >>Makefile fi +echo "FLAMBDA=$flambda" >> Makefile rm -f tst hasgot.c @@ -1856,6 +1860,11 @@ else else inf " profiling with gprof ..... not supported" fi + if test "$flambda" = "true"; then + inf " using flambda middle-end . yes" + else + inf " using flambda middle-end . no" + fi fi if test "$with_debugger" = "ocamldebugger"; then From 828cb4ebb918bdc4bba167c87e4dd0e3b6f75f38 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Thu, 17 Dec 2015 16:35:35 +0000 Subject: [PATCH 014/145] Add field in Config for flambda and change the cmx and cmxa magic number --- Makefile | 1 + Makefile.nt | 1 + utils/config.mli | 3 +++ utils/config.mlp | 15 +++++++++++++-- 4 files changed, 18 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 860e3e491..c316aaa6e 100644 --- a/Makefile +++ b/Makefile @@ -414,6 +414,7 @@ utils/config.ml: utils/config.mlp config/Makefile -e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \ -e 's|%%HOST%%|$(HOST)|' \ -e 's|%%TARGET%%|$(TARGET)|' \ + -e 's|%%FLAMBDA%%|$(FLAMBDA)|' \ utils/config.mlp > utils/config.ml partialclean:: diff --git a/Makefile.nt b/Makefile.nt index 3d469361d..6737687f6 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -313,6 +313,7 @@ utils/config.ml: utils/config.mlp config/Makefile -e 's|%%CC_PROFILE%%||' \ -e 's|%%HOST%%|$(HOST)|' \ -e 's|%%TARGET%%|$(TARGET)|' \ + -e 's|%%FLAMBDA%%|$(FLAMBDA)|' \ utils/config.mlp > utils/config.ml partialclean:: diff --git a/utils/config.mli b/utils/config.mli index c9b8904d7..5fc56d660 100644 --- a/utils/config.mli +++ b/utils/config.mli @@ -127,3 +127,6 @@ val target : string (* Whether the compiler is a cross-compiler *) val print_config : out_channel -> unit;; + +val flambda : bool + (* Whether the compiler was configured for flambda *) diff --git a/utils/config.mlp b/utils/config.mlp index 09f639cd8..476431b06 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -48,12 +48,22 @@ let mkdll = "%%MKDLL%%" let mkexe = "%%MKEXE%%" let mkmaindll = "%%MKMAINDLL%%" +let flambda = %%FLAMBDA%% + let exec_magic_number = "Caml1999X011" and cmi_magic_number = "Caml1999I020" and cmo_magic_number = "Caml1999O011" and cma_magic_number = "Caml1999A012" -and cmx_magic_number = "Caml1999Y015" -and cmxa_magic_number = "Caml1999Z014" +and cmx_magic_number = + if flambda then + "Caml1999Y016" + else + "Caml1999Y015" +and cmxa_magic_number = + if flambda then + "Caml1999Z015" + else + "Caml1999Z014" and ast_impl_magic_number = "Caml1999M019" and ast_intf_magic_number = "Caml1999N018" and cmxs_magic_number = "Caml2007D002" @@ -126,6 +136,7 @@ let print_config oc = p_bool "systhread_supported" systhread_supported; p "host" host; p "target" target; + p_bool "flambda" flambda; (* print the magic number *) p "exec_magic_number" exec_magic_number; From 7d1d8814c026b146425a5807ed70b7552d447941 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 14 Jan 2016 17:13:43 +0000 Subject: [PATCH 015/145] code review --- driver/compenv.ml | 14 +++++++++++--- utils/arg_helper.ml | 36 +++++++++++++++++++++++++----------- utils/arg_helper.mli | 8 +++++++- utils/clflags.mli | 12 ++++++++++++ 4 files changed, 55 insertions(+), 15 deletions(-) diff --git a/driver/compenv.ml b/driver/compenv.ml index b9eb6307f..0e6ee604f 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -206,9 +206,17 @@ let read_OCAMLPARAM ppf position = (* inlining *) | "inline" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'inline'" - inline_threshold + let module F = Float_arg_helper in + begin match F.parse_no_error v inline_threshold with + | F.Ok -> () + | F.Parse_failed exn -> + let error = + Printf.sprintf "bad syntax for \"inline\": %s" + (Printexc.to_string exn) + in + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable ("OCAMLPARAM", error)) + end (* color output *) | "color" -> diff --git a/utils/arg_helper.ml b/utils/arg_helper.ml index 7da6233c8..bfbd1870a 100644 --- a/utils/arg_helper.ml +++ b/utils/arg_helper.ml @@ -42,7 +42,9 @@ end) = struct | exception Not_found -> true | _index -> false - let parse str ~help_text ~update = + exception Parse_failure of exn + + let parse_exn str ~update = let values = Misc.Stdlib.String.split str ~on:',' in let parsed = List.fold_left (fun acc value -> @@ -50,30 +52,27 @@ end) = struct | exception Not_found -> begin match S.Value.of_string value with | value -> { acc with default = value } - | exception exn -> - fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text) + | exception exn -> raise (Parse_failure exn) end | equals -> let key_value_pair = value in let length = String.length key_value_pair in - if equals <= 0 || equals >= length - 1 then begin - fatal help_text + assert (equals >= 0 && equals < length); + if equals = 0 then begin + raise (Parse_failure ( + Failure "Missing key in argument specification")) end; let key = let key = String.sub key_value_pair 0 equals in try S.Key.of_string key - with exn -> - fatal (Printf.sprintf "%s: %s" - (Printexc.to_string exn) help_text) + with exn -> raise (Parse_failure exn) in let value = let value = String.sub key_value_pair (equals + 1) (length - equals - 1) in try S.Value.of_string value - with exn -> - fatal (Printf.sprintf "%s: %s" - (Printexc.to_string exn) help_text) + with exn -> raise (Parse_failure exn) in { acc with override = S.Key.Map.add key value acc.override }) !update @@ -81,6 +80,21 @@ end) = struct in update := parsed + let parse str ~help_text ~update = + match parse_exn str ~update with + | () -> () + | exception (Parse_failure exn) -> + fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text) + + type parse_result = + | Ok + | Parse_failed of exn + + let parse_no_error str ~update = + match parse_exn str ~update with + | () -> Ok + | exception (Parse_failure exn) -> Parse_failed exn + let get ~key parsed = match S.Key.Map.find key parsed.override with | provided -> provided diff --git a/utils/arg_helper.mli b/utils/arg_helper.mli index 9de1d999e..75258daa7 100644 --- a/utils/arg_helper.mli +++ b/utils/arg_helper.mli @@ -33,7 +33,7 @@ module Make (S : sig module Value : sig type t - (** The textual representation of a value must not contain '=' or ','. *) + (** The textual representation of a value must not contain ','. *) val of_string : string -> t end end) : sig @@ -46,5 +46,11 @@ end) : sig val parse : string -> help_text:string -> update:parsed ref -> unit + type parse_result = + | Ok + | Parse_failed of exn + + val parse_no_error : string -> update:parsed ref -> parse_result + val get : key:S.Key.t -> parsed -> S.Value.t end diff --git a/utils/clflags.mli b/utils/clflags.mli index c887c4b9e..08cf340ab 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -18,6 +18,12 @@ module Int_arg_helper : sig } val parse : string -> help_text:string -> update:parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + val parse_no_error : string -> update:parsed ref -> parse_result + val get : key:int -> parsed -> int end @@ -29,6 +35,12 @@ module Float_arg_helper : sig } val parse : string -> help_text:string -> update:parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + val parse_no_error : string -> update:parsed ref -> parse_result + val get : key:int -> parsed -> float end From fb312a989cba8bbfa0a0ac993c1a09a001e1aaa0 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 11:20:03 +0000 Subject: [PATCH 016/145] Minor naming/comment changes in Cmmgen --- asmcomp/cmmgen.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index e19be052b..7e50b2b49 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -2571,9 +2571,9 @@ let transl_all_functions_and_emit_all_constants cont = in aux StringSet.empty cont -(* Build the table of GC roots for toplevel modules *) +(* Build the NULL terminated array of gc roots *) -let emit_module_roots_table ~symbols cont = +let emit_gc_roots_table ~symbols cont = let table_symbol = Compilenv.make_symbol (Some "gc_roots") in Cdata(Cglobal_symbol table_symbol :: Cdefine_symbol table_symbol :: @@ -2609,7 +2609,7 @@ let emit_preallocated_blocks preallocated_blocks cont = List.map (fun ({ Clambda.symbol }:Clambda.preallocated_block) -> symbol) preallocated_blocks in - let c1 = emit_module_roots_table ~symbols cont in + let c1 = emit_gc_roots_table ~symbols cont in List.fold_left preallocate_block c1 preallocated_blocks (* Translate a compilation unit *) From 10e5dcfc378d9c0c116243928c3b75f8e704a2d8 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 11:38:37 +0000 Subject: [PATCH 017/145] Support 'opaque' in OCAMLPARAM --- driver/compenv.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/driver/compenv.ml b/driver/compenv.ml index 42d98bca6..c309f25f3 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -186,6 +186,7 @@ let read_OCAMLPARAM ppf position = | "nodynlink" -> clear "nodynlink" [ dlcode ] v | "short-paths" -> clear "short-paths" [ real_paths ] v | "trans-mod" -> set "trans-mod" [ transparent_modules ] v + | "opaque" -> set "opaque" [ opaque ] v | "pp" -> preprocessor := Some v | "runtime-variant" -> runtime_variant := v From 8e9c8651762f813cf8cdc902fbfbccd457258cfe Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 11:53:50 +0000 Subject: [PATCH 018/145] Improved fatal error messages in Cmmgen --- asmcomp/cmmgen.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 7e50b2b49..3ddce13cd 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -1803,8 +1803,8 @@ and transl_prim_1 env p arg dbg = tag_int (Cop(Cextcall("caml_bswap16_direct", typ_int, false, Debuginfo.none), [untag_int (transl env arg)])) - | _ -> - fatal_error "Cmmgen.transl_prim_1" + | prim -> + fatal_errorf "Cmmgen.transl_prim_1: %a" Printlambda.primitive prim and transl_prim_2 env p arg1 arg2 dbg = match p with @@ -2075,8 +2075,8 @@ and transl_prim_2 env p arg1 arg2 dbg = tag_int (Cop(Ccmpi(transl_comparison cmp), [transl_unbox_int env bi arg1; transl_unbox_int env bi arg2])) - | _ -> - fatal_error "Cmmgen.transl_prim_2" + | prim -> + fatal_errorf "Cmmgen.transl_prim_2: %a" Printlambda.primitive prim and transl_prim_3 env p arg1 arg2 arg3 dbg = match p with @@ -2212,8 +2212,8 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg = (Cconst_int 7)) idx (unaligned_set_64 ba_data idx newval)))))) - | _ -> - fatal_error "Cmmgen.transl_prim_3" + | prim -> + fatal_errorf "Cmmgen.transl_prim_3: %a" Printlambda.primitive prim and transl_unbox_float env = function Uconst(Uconst_ref(_, Some (Uconst_float f))) -> Cconst_float f From 9e7bec84caa318687765631aad6eaa6c3e5f7a3e Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 12:32:10 +0000 Subject: [PATCH 019/145] Improve comment in Obj about set_field-like operations --- stdlib/obj.mli | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 462963416..a0c97b357 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -24,14 +24,26 @@ external magic : 'a -> 'b = "%identity" external is_block : t -> bool = "caml_obj_is_block" external is_int : t -> bool = "%obj_is_int" external tag : t -> int = "caml_obj_tag" -external set_tag : t -> int -> unit = "caml_obj_set_tag" external size : t -> int = "%obj_size" external field : t -> int -> t = "%obj_field" (** When using flambda: + [set_field] MUST NOT be called on immutable blocks. (Blocks allocated - in C stubs, or with [new_block] below, are always considered mutable.) *) + in C stubs, or with [new_block] below, are always considered mutable.) + + The same goes for [set_double_field] and [set_tag]. However, for + [set_tag], in the case of immutable blocks where the middle-end optimizers + never see code that discriminates on their tag (for example records), the + operation should be safe. Such uses are nonetheless discouraged. + + For experts only: + [set_field] can be made safe by first wrapping the block in + [Sys.opaque_identity], so any information about its contents will not + be propagated. +*) external set_field : t -> int -> t -> unit = "%obj_set_field" +external set_tag : t -> int -> unit = "caml_obj_set_tag" val double_field : t -> int -> float (* @since 3.11.2 *) val set_double_field : t -> int -> float -> unit (* @since 3.11.2 *) From 98fa936b4fbd502eb6114ee9459bea036e56cf6d Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 12:32:33 +0000 Subject: [PATCH 020/145] Improve comment in Obj about set_field-like operations --- stdlib/obj.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stdlib/obj.mli b/stdlib/obj.mli index a0c97b357..51dd65388 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -38,7 +38,7 @@ external field : t -> int -> t = "%obj_field" operation should be safe. Such uses are nonetheless discouraged. For experts only: - [set_field] can be made safe by first wrapping the block in + [set_field] et al can be made safe by first wrapping the block in [Sys.opaque_identity], so any information about its contents will not be propagated. *) From 56c7413843a9d3be0b56eea9c4d5798ca5690493 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 13:29:28 +0000 Subject: [PATCH 021/145] wrong default_inline_threshold --- utils/clflags.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/clflags.ml b/utils/clflags.ml index ff63d2761..1a190d62e 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -120,7 +120,7 @@ let dump_combine = ref false (* -dcombine *) let native_code = ref false (* set to true under ocamlopt *) let o2 = ref false (* -O2 *) let o3 = ref false (* -O3 *) -let default_inline_threshold = 10. +let default_inline_threshold = 10. /. 8. let inline_threshold = ref (Float_arg_helper.default default_inline_threshold) let inlining_stats = ref false let simplify_rounds = ref 1 From d2968641748d0750ae1c9bd93e7d236f03e2f503 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 15 Jan 2016 15:25:23 +0100 Subject: [PATCH 022/145] remove unused (and wrong?) line in cmmgen.ml --- asmcomp/cmmgen.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 3ddce13cd..865df1522 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -427,7 +427,6 @@ let safe_mod_bi = let test_bool = function Cop(Caddi, [Cop(Clsl, [c; Cconst_int 1]); Cconst_int 1]) -> c - | Cop(Clsl, [c; Cconst_int 1]) -> c | c -> Cop(Ccmpi Cne, [c; Cconst_int 1]) (* Float *) From 9668c45aab07a4875b82d5064eeb143c4ae6abfd Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 15 Jan 2016 15:33:16 +0100 Subject: [PATCH 023/145] Avoid using Pmakearray instead of Const_float_array --- bytecomp/translcore.ml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index a4470302c..8c33e4fa4 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -1212,10 +1212,7 @@ and transl_record env all_labels repres lbl_expr_list opt_init_expr = | Record_regular -> Lconst(Const_block(0, cl)) | Record_inlined tag -> Lconst(Const_block(tag, cl)) | Record_float -> - if !Clflags.native_code then - Lprim (Pmakearray (Pfloatarray, Immutable), ll) - else - Lconst(Const_float_array(List.map extract_float cl)) + Lconst(Const_float_array(List.map extract_float cl)) | Record_extension -> raise Not_constant with Not_constant -> From 0664a1cf034ec2d1cfc0ed97a6869e9eab903a3f Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 14:49:01 +0000 Subject: [PATCH 024/145] Alter array patch after feedback from jdimino --- asmcomp/cmmgen.ml | 9 +++++-- bytecomp/bytegen.ml | 13 ++++++---- bytecomp/translcore.ml | 44 +++++++++++++++++++------------- middle_end/closure_conversion.ml | 3 ++- 4 files changed, 43 insertions(+), 26 deletions(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 6588a8025..8de1ff27b 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -1502,8 +1502,13 @@ let rec transl env e = make_alloc tag (List.map (transl env) args) | (Pccall prim, args) -> transl_ccall env prim args dbg - | (Pduparray (Pfloatarray as kind, _), - [Uprim (Pmakearray (Pfloatarray, _), args, _dbg)]) -> + | (Pduparray (kind, _), [Uprim (Pmakearray (kind', _), args, _dbg)]) -> + (* We arrive here in two cases: + 1. When using Closure, all the time. + 2. When using Flambda, if a float array longer than + [Translcore.use_dup_for_constant_arrays_bigger_than] turns out + to be non-constant. *) + assert (kind = kind'); transl_make_array env kind args | (Pduparray _, [arg]) -> let prim_obj_dup = diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 5b0a91ab2..09e60b8bc 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -646,13 +646,16 @@ let rec comp_expr env exp sz cont = (Kmakeblock(List.length args, 0) :: Kccall("caml_make_array", 1) :: cont) end + | Lprim (Pduparray (kind, mutability), [Lprim (Pmakearray (kind', _), args)]) -> + assert (kind = kind'); + comp_expr env (Lprim (Pmakearray (kind, mutability), args)) sz cont | Lprim (Pduparray _, [arg]) -> - let prim_obj_dup = - Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true - in - comp_expr env (Lprim (Pccall prim_obj_dup, [arg])) sz cont + let prim_obj_dup = + Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true + in + comp_expr env (Lprim (Pccall prim_obj_dup, [arg])) sz cont | Lprim (Pduparray _, _) -> - Misc.fatal_error "Bytegen.comp_expr: Pduparray takes exactly one arg" + Misc.fatal_error "Bytegen.comp_expr: Pduparray takes exactly one arg" (* Integer first for enabling futher optimization (cf. emitcode.ml) *) | Lprim (Pintcomp c, [arg ; (Lconst _ as k)]) -> let p = Pintcomp (commute_comparison c) diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 8c33e4fa4..9f1794bcb 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -858,24 +858,32 @@ and transl_exp0 e = then begin raise Not_constant end; - (* We cannot currently lift [Pintarray] arrays safely in Flambda - because [caml_modify] might be called upon them (e.g. from - code operating on polymorphic arrays, or functions such as - [caml_array_blit]. *) - if !Clflags.native_code && kind = Pfloatarray then - let imm_array = Lprim (Pmakearray (kind, Immutable), ll) in - Lprim (Pduparray (kind, Mutable), [imm_array]) - else begin - let cl = List.map extract_constant ll in - let master = - match kind with - | Paddrarray | Pintarray -> - Lconst(Const_block(0, cl)) - | Pfloatarray -> - Lconst(Const_float_array(List.map extract_float cl)) - | Pgenarray -> - raise Not_constant in (* can this really happen? *) - Lprim(Pccall prim_obj_dup, [master]) + begin match List.map extract_constant ll with + | exception Not_constant when kind = Pfloatarray -> + (* We cannot currently lift [Pintarray] arrays safely in Flambda + because [caml_modify] might be called upon them (e.g. from + code operating on polymorphic arrays, or functions such as + [caml_array_blit]. + To avoid having different Lambda code for bytecode/Closure vs. + flambda, we always generate [Pduparray] here, and deal with it in + [Bytegen] (or in the case of Closure, in [Cmmgen], which already + has to handle [Pduparray Pmakearray Pfloatarray] in the case where + the array turned out to be inconstant. + When not [Pfloatarray], the exception propagates to the handler + below. *) + let imm_array = Lprim (Pmakearray (kind, Immutable), ll) in + Lprim (Pduparray (kind, Mutable), [imm_array]) + | cl -> + let imm_array = + match kind with + | Paddrarray | Pintarray -> + Lconst(Const_block(0, cl)) + | Pfloatarray -> + Lconst(Const_float_array(List.map extract_float cl)) + | Pgenarray -> + raise Not_constant (* can this really happen? *) + in + Lprim (Pduparray (kind, Mutable), [imm_array]) end with Not_constant -> Lprim(Pmakearray (kind, Mutable), ll) diff --git a/middle_end/closure_conversion.ml b/middle_end/closure_conversion.ml index bae35aed8..7d3e23a47 100644 --- a/middle_end/closure_conversion.ml +++ b/middle_end/closure_conversion.ml @@ -149,7 +149,8 @@ let rec close_const t env (const : Lambda.structured_constant) | Const_pointer c -> Const (Const_pointer c), "pointer" | Const_immstring c -> Allocated_const (Immutable_string c), "immstring" | Const_float_array c -> - Allocated_const (Float_array (List.map float_of_string c)), "float_array" + Allocated_const (Immutable_float_array (List.map float_of_string c)), + "float_array" | Const_block _ -> Expr (close t env (eliminate_const_block const)), "const_block" From d489fd2038e94ddce0217f7ce341f683b26373eb Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Fri, 15 Jan 2016 14:54:33 +0000 Subject: [PATCH 025/145] comments --- asmcomp/cmmgen.ml | 7 ++++++- bytecomp/translcore.ml | 4 ++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 8de1ff27b..6d811e719 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -1507,7 +1507,12 @@ let rec transl env e = 1. When using Closure, all the time. 2. When using Flambda, if a float array longer than [Translcore.use_dup_for_constant_arrays_bigger_than] turns out - to be non-constant. *) + to be non-constant. + If for some reason Flambda fails to lift a constant array we + could in theory also end up here. + Note that [kind] above is unconstrained, but with the current + state of [Translcore], we will in fact only get here with + [Pfloatarray]s. *) assert (kind = kind'); transl_make_array env kind args | (Pduparray _, [arg]) -> diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 9f1794bcb..f0cb6ea75 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -865,10 +865,10 @@ and transl_exp0 e = code operating on polymorphic arrays, or functions such as [caml_array_blit]. To avoid having different Lambda code for bytecode/Closure vs. - flambda, we always generate [Pduparray] here, and deal with it in + Flambda, we always generate [Pduparray] here, and deal with it in [Bytegen] (or in the case of Closure, in [Cmmgen], which already has to handle [Pduparray Pmakearray Pfloatarray] in the case where - the array turned out to be inconstant. + the array turned out to be inconstant). When not [Pfloatarray], the exception propagates to the handler below. *) let imm_array = Lprim (Pmakearray (kind, Immutable), ll) in From fbd87e90810286f66b7284cdf2763c17d1f17ed7 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 15 Jan 2016 16:07:59 +0100 Subject: [PATCH 026/145] Const_float_array are constant for branch merging --- bytecomp/lambda.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 1a9678286..cb4227fd5 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -274,7 +274,7 @@ let make_key e = try Ident.find_same id env with Not_found -> e end - | Lconst (Const_base (Const_string _)|Const_float_array _) -> + | Lconst (Const_base (Const_string _)) -> (* Mutable constants are not shared *) raise Not_simple | Lconst _ -> e From 87ef3070cd67dc4d787f6707af89689301472409 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 15 Jan 2016 15:52:23 +0000 Subject: [PATCH 027/145] Build the compiler with -strict-format Following #414 --- Makefile.shared | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.shared b/Makefile.shared index b3df82cd3..217f3c4e6 100755 --- a/Makefile.shared +++ b/Makefile.shared @@ -20,7 +20,7 @@ include stdlib/StdlibModules CAMLC=$(CAMLRUN) boot/ocamlc -g -nostdlib -I boot CAMLOPT=$(CAMLRUN) ./ocamlopt -g -nostdlib -I stdlib -I otherlibs/dynlink COMPFLAGS=-strict-sequence -principal -w +33..39+48+50 -warn-error A -bin-annot \ - -safe-string $(INCLUDES) + -safe-string -strict-formats $(INCLUDES) LINKFLAGS= YACCFLAGS=-v From 5da5d4ac7d3e4dd8c8ecad03840bb8f05a359325 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 2 Jan 2016 08:37:20 +0000 Subject: [PATCH 028/145] Allow optional bootstrapping of FlexDLL on Windows Allows the four native Windows ports to compile FlexDLL and flexlink "in-tree" by placing the sources in directory `flexdll` and issuing `make -f Makefile.nt flexdll` FlexDLL must still be installed somewhere in PATH before OCaml itself can be compiled. The `flexdll` target leaves the OCaml build tree in a sufficiently clean state to allow `world` to be run after installation of FlexDLL. --- .gitignore | 3 +++ Makefile.nt | 27 +++++++++++++++++++++++++++ byterun/Makefile.nt | 11 +++++++++-- byterun/caml/config.h | 3 +++ config/Makefile.mingw | 13 +++++++++++-- config/Makefile.mingw64 | 13 +++++++++++-- config/Makefile.msvc | 14 ++++++++++++-- config/Makefile.msvc64 | 14 ++++++++++++-- 8 files changed, 88 insertions(+), 10 deletions(-) diff --git a/.gitignore b/.gitignore index 9c0da6d5f..ca451d60a 100644 --- a/.gitignore +++ b/.gitignore @@ -294,3 +294,6 @@ /yacc/ocamlyacc /yacc/version.h /yacc/.gdb_history + +# Bootstrapped FlexDLL +flexdll/ diff --git a/Makefile.nt b/Makefile.nt index 6737687f6..607b1fc64 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -18,6 +18,32 @@ include Makefile.shared defaultentry: @echo "Please refer to the installation instructions in file README.win32.adoc." +# FlexDLL sources missing error message +flexdll/Makefile: + @echo In order to bootstrap FlexDLL, you need to place the sources in flexdll. + @echo This can either be done by downloading a source tarball from + @echo \ http://alain.frisch.fr/flexdll.html + @echo or by cloning the git repository + @echo \ git clone https://github.com/alainfrisch/flexdll.git + @echo + @false + +# Bootstrapping FlexDLL - leaves a bytecode flexlink in flexdll/ +flexdll: flexdll/Makefile + cd byterun ; $(MAKEREC) BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE) + cp byterun/ocamlrun.exe boot/ocamlrun.exe + cd stdlib ; $(MAKEREC) COMPILER=../boot/ocamlc stdlib.cma std_exit.cmo + cd stdlib ; cp stdlib.cma std_exit.cmo *.cmi ../boot + cd flexdll ; $(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -I ../boot" flexlink.exe support +# The executable header will not have been available - flexlink.exe is just the bytecode image + cd flexdll ; mv flexlink.exe flexlink + cd stdlib ; $(MAKEREC) FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink" camlheader +# Assemble flexlink.exe + cat stdlib/camlheader flexdll/flexlink > flexdll/flexlink.exe ; chmod +x flexdll/flexlink.exe ; rm flexdll/flexlink +# Tidy-up the OCaml build tree ready for the next stage + cd byterun ; $(MAKEREC) clean + $(MAKEREC) partialclean + # Recompile the system using the bootstrap compiler all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml \ otherlibraries $(OCAMLBUILDBYTE) $(WITH_DEBUGGER) \ @@ -672,5 +698,6 @@ distclean: .PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries .PHONY: otherlibrariesopt promote promote-cross .PHONY: restore runtime runtimeopt makeruntimeopt world world.opt +.PHONY: flexdll include .depend diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt index 257e36441..07a7bf323 100644 --- a/byterun/Makefile.nt +++ b/byterun/Makefile.nt @@ -15,13 +15,20 @@ include Makefile.common CFLAGS=-DOCAML_STDLIB_DIR='"$(LIBDIR)"' $(IFLEXDIR) +ifdef BOOTSTRAPPING_FLEXLINK +MAKE_OCAMLRUN=$(MKEXE_BOOT) +CFLAGS:=-DBOOTSTRAPPING_FLEXLINK $(CFLAGS) +else +MAKE_OCAMLRUN=$(MKEXE) -o $(1) $(2) +endif + DBGO=d.$(O) OBJS=$(COMMONOBJS:.o=.$(O)) win32.$(O) main.$(O) DOBJS=$(OBJS:.$(O)=.$(DBGO)) instrtrace.$(DBGO) ocamlrun$(EXE): libcamlrun.$(A) prims.$(O) - $(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) \ - $(EXTRALIBS) libcamlrun.$(A) + $(call MAKE_OCAMLRUN,ocamlrun$(EXE),prims.$(O) libcamlrun.$(A) \ + $(call SYSLIB,ws2_32) $(EXTRALIBS)) ocamlrund$(EXE): libcamlrund.$(A) prims.$(O) main.$(O) $(MKEXE) -o ocamlrund$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) \ diff --git a/byterun/caml/config.h b/byterun/caml/config.h index 58f2f4266..1245aa451 100644 --- a/byterun/caml/config.h +++ b/byterun/caml/config.h @@ -19,6 +19,9 @@ /* */ #include "../../config/m.h" #include "../../config/s.h" +#ifdef BOOTSTRAPPING_FLEXLINK +#undef SUPPORT_DYNAMIC_LINKING +#endif /* */ #ifndef CAML_NAME_SPACE diff --git a/config/Makefile.mingw b/config/Makefile.mingw index 5b4658f71..4d1a47c39 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -109,13 +109,22 @@ NATIVECCLIBS=-lws2_32 CPP=$(BYTECC) -E ### Flexlink -FLEXLINK=flexlink -chain mingw -stack 16777216 -link -static-libgcc -FLEXDIR:=$(shell $(FLEXLINK) -where) +FLEXLINK_CMD=flexlink +FLEXDLL_CHAIN=mingw +FLEXLINK=$(FLEXLINK_CMD) -chain $(FLEXDLL_CHAIN) -stack 16777216 -link -static-libgcc +FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) +ifeq ($(FLEXDIR),) +IFLEXDIR= +else IFLEXDIR=-I"$(FLEXDIR)" +endif MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll +### Native command to build ocamlrun.exe without flexlink +MKEXE_BOOT=$(BYTECC) -o $(1) $(2) + ### How to build a static library MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1) #ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;; diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 19a9b9437..ce05c8b23 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -109,13 +109,22 @@ NATIVECCLIBS=-lws2_32 CPP=$(BYTECC) -E ### Flexlink -FLEXLINK=flexlink -chain mingw64 -stack 33554432 -FLEXDIR:=$(shell $(FLEXLINK) -where) +FLEXLINK_CMD=flexlink +FLEXDLL_CHAIN=mingw64 +FLEXLINK=$(FLEXLINK_CMD) -chain $(FLEXDLL_CHAIN) -stack 33554432 +FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) +ifeq ($(FLEXDIR),) +IFLEXDIR= +else IFLEXDIR=-I"$(FLEXDIR)" +endif MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll +### Native command to build ocamlrun.exe without flexlink +MKEXE_BOOT=$(BYTECC) -o $(1) $(2) + ### How to build a static library MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1) #ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;; diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 4d399cf49..1173c703c 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -100,13 +100,23 @@ NATIVECCLIBS=advapi32.lib ws2_32.lib CPP=cl -nologo -EP ### Flexlink -FLEXLINK=flexlink -merge-manifest -stack 16777216 -FLEXDIR:=$(shell $(FLEXLINK) -where) +FLEXLINK_CMD=flexlink +FLEXDLL_CHAIN=msvc +FLEXLINK=$(FLEXLINK_CMD) -merge-manifest -stack 16777216 +FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) +ifeq ($(FLEXDIR),) +IFLEXDIR= +else IFLEXDIR=-I"$(FLEXDIR)" +endif MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll +### Native command to build ocamlrun.exe without flexlink +MERGEMANIFESTEXE=test ! -f $(1).manifest || mt -nologo -outputresource:$(1) -manifest $(1).manifest && rm -f $(1).manifest +MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console && ($(MERGEMANIFESTEXE)) + ### How to build a static library MKLIB=link -lib -nologo -out:$(1) $(2) #ml let mklib out files opts = Printf.sprintf "link -lib -nologo -out:%s %s %s" out opts files;; diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index 6a9650ba5..41fc34a03 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -104,13 +104,23 @@ NATIVECCLIBS=advapi32.lib ws2_32.lib $(EXTRALIBS) CPP=cl -nologo -EP ### Flexlink -FLEXLINK=flexlink -x64 -merge-manifest -stack 33554432 -FLEXDIR:=$(shell $(FLEXLINK) -where) +FLEXLINK_CMD=flexlink +FLEXDLL_CHAIN=msvc64 +FLEXLINK=$(FLEXLINK_CMD) -x64 -merge-manifest -stack 33554432 +FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) +ifeq ($(FLEXDIR),) +IFLEXDIR= +else IFLEXDIR=-I"$(FLEXDIR)" +endif MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll +### Native command to build ocamlrun.exe without flexlink +MERGEMANIFESTEXE=test ! -f $(1).manifest || mt -nologo -outputresource:$(1) -manifest $(1).manifest && rm -f $(1).manifest +MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console && ($(MERGEMANIFESTEXE)) + ### How to build a static library MKLIB=link -lib -nologo -machine:AMD64 /out:$(1) $(2) #ml let mklib out files opts = Printf.sprintf "link -lib -nologo -machine:AMD64 -out:%s %s %s" out opts files;; From a9f5227d62c9c18c7ef1f632c91e46d258113f9b Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 2 Jan 2016 09:28:37 +0000 Subject: [PATCH 029/145] Allow bootstrapped FlexDLL to be installed `install-flexdll` target added to Makefile.nt which installs flexlink.exe and the correct objects, manifests and flexdll.h to `$(INSTALL_BINDIR)`. When this target has been used, the behaviour of opt.opt is altered to compile a native-code version of flexlink.exe. This is subsequently installed by the install target. This means that Windows can be fully built by issuing: make -f Makefile.nt flexdll install-flexdll world opt.opt install --- Makefile.nt | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/Makefile.nt b/Makefile.nt index 607b1fc64..468fed30a 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -28,7 +28,7 @@ flexdll/Makefile: @echo @false -# Bootstrapping FlexDLL - leaves a bytecode flexlink in flexdll/ +# Bootstrapping FlexDLL - leaves a bytecode image of flexlink in flexdll/ flexdll: flexdll/Makefile cd byterun ; $(MAKEREC) BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE) cp byterun/ocamlrun.exe boot/ocamlrun.exe @@ -38,12 +38,29 @@ flexdll: flexdll/Makefile # The executable header will not have been available - flexlink.exe is just the bytecode image cd flexdll ; mv flexlink.exe flexlink cd stdlib ; $(MAKEREC) FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink" camlheader + +install-flexdll: + mkdir -p $(INSTALL_BINDIR) # Assemble flexlink.exe cat stdlib/camlheader flexdll/flexlink > flexdll/flexlink.exe ; chmod +x flexdll/flexlink.exe ; rm flexdll/flexlink +# The $(if ...) installs the correct .manifest file for MSVC and MSVC64 +# (GNU make doesn't have ifeq as a function, hence slightly convoluted use of filter-out) + cp flexdll/flexlink.exe flexdll/flexdll_*.$(O) flexdll/flexdll.h $(if $(filter-out mingw,$(TOOLCHAIN)),flexdll/default$(filter-out _i386,_$(ARCH)).manifest) $(INSTALL_BINDIR)/ +# This is the flexlink-free version of ocamlrun, it won't be used during +# compilation and will be overwritten when the finished OCaml is installed + cp boot/ocamlrun.exe $(INSTALL_BINDIR)/ # Tidy-up the OCaml build tree ready for the next stage cd byterun ; $(MAKEREC) clean $(MAKEREC) partialclean +# If Makefile.nt was used to bootstrap FlexDLL, then opt.opt will build a native +# flexlink which install will put in $(INSTALL_BINDIR), overwriting the bytecode +# version placed there by install-flexdll +FLEXLINK_OPT=$(if $(or $(filter flexdll,$(MAKECMDGOALS)),$(wildcard flexdll/flexlink.exe)),flexlink_opt) + +flexlink_opt: + cd flexdll ; rm flexlink.exe ; $(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) OCAMLOPT="../ocamlopt.opt -I ../stdlib" flexlink.exe + # Recompile the system using the bootstrap compiler all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml \ otherlibraries $(OCAMLBUILDBYTE) $(WITH_DEBUGGER) \ @@ -153,7 +170,7 @@ opt: # Native-code versions of the tools opt.opt: core opt-core ocamlc.opt all ocamlopt.opt ocamllex.opt \ - ocamltoolsopt ocamltoolsopt.opt otherlibrariesopt $(OCAMLBUILDNATIVE) $(OCAMLDOC_OPT) + ocamltoolsopt ocamltoolsopt.opt otherlibrariesopt $(OCAMLBUILDNATIVE) $(OCAMLDOC_OPT) $(FLEXLINK_OPT) # Complete build using fast compilers world.opt: coldstart opt.opt @@ -224,6 +241,7 @@ installopt: done if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi cd tools; $(MAKEREC) installopt + if test -f ocamlopt.opt -a -f flexdll/flexlink.exe ; then cp flexdll/flexlink.exe $(INSTALL_BINDIR)/ ; fi installoptopt: cp ocamlc.opt $(INSTALL_BINDIR)/ocamlc.opt$(EXE) @@ -698,6 +716,6 @@ distclean: .PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries .PHONY: otherlibrariesopt promote promote-cross .PHONY: restore runtime runtimeopt makeruntimeopt world world.opt -.PHONY: flexdll +.PHONY: flexdll flexlink_opt include .depend From a7b6083be3848d4d3d6734ac93082906ff443d20 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 2 Jan 2016 09:52:59 +0000 Subject: [PATCH 030/145] Add FlexDLL as git submodule Messages for obtaining flexdll sources updated in Makefile.nt --- .gitignore | 3 --- .gitmodules | 3 +++ .travis.yml | 2 ++ Makefile.nt | 19 +++++++++++++++---- flexdll | 1 + 5 files changed, 21 insertions(+), 7 deletions(-) create mode 100644 .gitmodules create mode 160000 flexdll diff --git a/.gitignore b/.gitignore index ca451d60a..9c0da6d5f 100644 --- a/.gitignore +++ b/.gitignore @@ -294,6 +294,3 @@ /yacc/ocamlyacc /yacc/version.h /yacc/.gdb_history - -# Bootstrapped FlexDLL -flexdll/ diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..938e0dbed --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "flexdll"] + path = flexdll + url = https://github.com/alainfrisch/flexdll.git diff --git a/.travis.yml b/.travis.yml index b0a323af8..b5b1acc66 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,6 +12,8 @@ sudo: false language: c +git: + submodules: false script: bash -ex .travis-ci.sh matrix: include: diff --git a/Makefile.nt b/Makefile.nt index 468fed30a..27f0da573 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -18,11 +18,22 @@ include Makefile.shared defaultentry: @echo "Please refer to the installation instructions in file README.win32.adoc." -# FlexDLL sources missing error message -flexdll/Makefile: - @echo In order to bootstrap FlexDLL, you need to place the sources in flexdll. +# FlexDLL sources missing error messages +# Different git mechanism displayed depending on whether this source tree came +# from a git clone or a source tarball. + +# Displayed in all cases +flexdll-common-err: + @echo In order to bootstrap FlexDLL, you need to place the sources in flexdll @echo This can either be done by downloading a source tarball from @echo \ http://alain.frisch.fr/flexdll.html + +flexdll/Makefile: $(if $(wildcard flexdll/Makefile),,$(if $(wildcard .git),flexdll-common-err,flexdll-repo)) + @echo or by checking out the flexdll submodule with + @echo \ git submodule update --init + @false + +flexdll-repo: flexdll-common-err @echo or by cloning the git repository @echo \ git clone https://github.com/alainfrisch/flexdll.git @echo @@ -716,6 +727,6 @@ distclean: .PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries .PHONY: otherlibrariesopt promote promote-cross .PHONY: restore runtime runtimeopt makeruntimeopt world world.opt -.PHONY: flexdll flexlink_opt +.PHONY: flexdll flexlink_opt flexdll-common-err flexdll-repo include .depend diff --git a/flexdll b/flexdll new file mode 160000 index 000000000..db1d82aa8 --- /dev/null +++ b/flexdll @@ -0,0 +1 @@ +Subproject commit db1d82aa8662d146562067288d0331c4ec2e1bd0 From fe4b643c4efd3fba18a1f0a9aba59dde0e4f7cde Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 2 Jan 2016 14:46:41 +0000 Subject: [PATCH 031/145] Support OCAML_FLEXLINK environment variable OCAML_FLEXLINK is inspected by ocamlopt, ocamlc and ocamlmklib and allows the flexlink command to be overriden. This is primarily intended as a solution for bootstrapping OCaml with FlexDLL, thus allowing a bytecode image of flexlink launched with ocamlrun to be executed, instead of requiring flexlink to be in PATH. --- Changes | 2 ++ Makefile.nt | 1 + config/Makefile.mingw | 8 +++++++- config/Makefile.mingw64 | 8 +++++++- config/Makefile.msvc | 8 +++++++- config/Makefile.msvc64 | 8 +++++++- manual/manual/cmds/comp.etex | 8 ++++++++ manual/manual/cmds/intf-c.etex | 8 ++++++++ manual/manual/cmds/native.etex | 8 ++++++++ tools/Makefile.nt | 11 +++++++++++ tools/Makefile.shared | 2 +- utils/config.mlp | 20 +++++++++++++++++--- 12 files changed, 84 insertions(+), 8 deletions(-) diff --git a/Changes b/Changes index 6c65dcb67..e4f0ed5ba 100644 --- a/Changes +++ b/Changes @@ -138,6 +138,8 @@ Compilers: (Leo White) - PR#6920: fix debug informations around uses of %apply or %revapply (Jérémie Dimino) +- GPR#388: OCAML_FLEXLINK environment variable allows overriding flexlink + command (David Allsopp) Runtime system: - PR#3612: allow allocating custom block with finalizers in the minor heap diff --git a/Makefile.nt b/Makefile.nt index 27f0da573..96db99da1 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -369,6 +369,7 @@ utils/config.ml: utils/config.mlp config/Makefile -e 's|%%HOST%%|$(HOST)|' \ -e 's|%%TARGET%%|$(TARGET)|' \ -e 's|%%FLAMBDA%%|$(FLAMBDA)|' \ + -e 's|%%FLEXLINK_FLAGS%%|$(FLEXLINK_FLAGS)|' \ utils/config.mlp > utils/config.ml partialclean:: diff --git a/config/Makefile.mingw b/config/Makefile.mingw index 4d1a47c39..dea64568d 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -111,13 +111,19 @@ CPP=$(BYTECC) -E ### Flexlink FLEXLINK_CMD=flexlink FLEXDLL_CHAIN=mingw -FLEXLINK=$(FLEXLINK_CMD) -chain $(FLEXDLL_CHAIN) -stack 16777216 -link -static-libgcc +# FLEXLINK_FLAGS must be safe to insert in an OCaml string +# (see ocamlmklibconfig.ml in tools/Makefile.nt) +FLEXLINK_FLAGS=-chain $(FLEXDLL_CHAIN) -stack 16777216 -link -static-libgcc +FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) IFLEXDIR= else IFLEXDIR=-I"$(FLEXDIR)" endif +# MKDLL, MKEXE and MKMAINDLL must ultimately be equivalent to +# $(FLEXLINK_CMD) $(FLEXLINK_FLAGS) [-exe|-maindll] +# or OCAML_FLEXLINK overriding will not work (see utils/config.mlp) MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index ce05c8b23..eccba97df 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -111,13 +111,19 @@ CPP=$(BYTECC) -E ### Flexlink FLEXLINK_CMD=flexlink FLEXDLL_CHAIN=mingw64 -FLEXLINK=$(FLEXLINK_CMD) -chain $(FLEXDLL_CHAIN) -stack 33554432 +# FLEXLINK_FLAGS must be safe to insert in an OCaml string +# (see ocamlmklibconfig.ml in tools/Makefile.nt) +FLEXLINK_FLAGS=-chain $(FLEXDLL_CHAIN) -stack 33554432 +FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) IFLEXDIR= else IFLEXDIR=-I"$(FLEXDIR)" endif +# MKDLL, MKEXE and MKMAINDLL must ultimately be equivalent to +# $(FLEXLINK_CMD) $(FLEXLINK_FLAGS) [-exe|-maindll] +# or OCAML_FLEXLINK overriding will not work (see utils/config.mlp) MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 1173c703c..66400923e 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -102,13 +102,19 @@ CPP=cl -nologo -EP ### Flexlink FLEXLINK_CMD=flexlink FLEXDLL_CHAIN=msvc -FLEXLINK=$(FLEXLINK_CMD) -merge-manifest -stack 16777216 +# FLEXLINK_FLAGS must be safe to insert in an OCaml string +# (see ocamlmklibconfig.ml in tools/Makefile.nt) +FLEXLINK_FLAGS=-merge-manifest -stack 16777216 +FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) IFLEXDIR= else IFLEXDIR=-I"$(FLEXDIR)" endif +# MKDLL, MKEXE and MKMAINDLL must ultimately be equivalent to +# $(FLEXLINK_CMD) $(FLEXLINK_FLAGS) [-exe|-maindll] +# or OCAML_FLEXLINK overriding will not work (see utils/config.mlp) MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index 41fc34a03..d4d33e13d 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -106,13 +106,19 @@ CPP=cl -nologo -EP ### Flexlink FLEXLINK_CMD=flexlink FLEXDLL_CHAIN=msvc64 -FLEXLINK=$(FLEXLINK_CMD) -x64 -merge-manifest -stack 33554432 +# FLEXLINK_FLAGS must be safe to insert in an OCaml string +# (see ocamlmklibconfig.ml in tools/Makefile.nt) +FLEXLINK_FLAGS=-x64 -merge-manifest -stack 33554432 +FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) IFLEXDIR= else IFLEXDIR=-I"$(FLEXDIR)" endif +# MKDLL, MKEXE and MKMAINDLL must ultimately be equivalent to +# $(FLEXLINK_CMD) $(FLEXLINK_FLAGS) [-exe|-maindll] +# or OCAML_FLEXLINK overriding will not work (see utils/config.mlp) MKDLL=$(FLEXLINK) MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll diff --git a/manual/manual/cmds/comp.etex b/manual/manual/cmds/comp.etex index b35ba71f4..a7aabd295 100644 --- a/manual/manual/cmds/comp.etex +++ b/manual/manual/cmds/comp.etex @@ -519,6 +519,14 @@ Display a short usage summary and exit. % \end{options} +\noindent +On native Windows, the following environment variable is also consulted: + +\begin{options} +\item["OCAML_FLEXLINK"] Alternative executable to use instead of the +configured value. Primarily used for bootstrapping. +\end{options} + \section{Modules and the file system} This short section is intended to clarify the relationship between the diff --git a/manual/manual/cmds/intf-c.etex b/manual/manual/cmds/intf-c.etex index 58c1c5012..adce7534f 100644 --- a/manual/manual/cmds/intf-c.etex +++ b/manual/manual/cmds/intf-c.etex @@ -2232,6 +2232,14 @@ libraries are supported) and "lib"\var{outputc}".a". If not specified, defaults to the output name given with "-o". \end{options} +\noindent +On native Windows, the following environment variable is also consulted: + +\begin{options} +\item["OCAML_FLEXLINK"] Alternative executable to use instead of the +configured value. Primarily used for bootstrapping. +\end{options} + \paragraph{Example} Consider an OCaml interface to the standard "libz" C library for reading and writing compressed files. Assume this library resides in "/usr/local/zlib". This interface is diff --git a/manual/manual/cmds/native.etex b/manual/manual/cmds/native.etex index 2de553971..33b2399c6 100644 --- a/manual/manual/cmds/native.etex +++ b/manual/manual/cmds/native.etex @@ -505,6 +505,14 @@ Display a short usage summary and exit. % \end{options} +\noindent +On native Windows, the following environment variable is also consulted: + +\begin{options} +\item["OCAML_FLEXLINK"] Alternative executable to use instead of the +configured value. Primarily used for bootstrapping. +\end{options} + \paragraph{Options for the IA32 architecture} The IA32 code generator (Intel Pentium, AMD Athlon) supports the following additional option: diff --git a/tools/Makefile.nt b/tools/Makefile.nt index 1e5f9cc8c..289236341 100644 --- a/tools/Makefile.nt +++ b/tools/Makefile.nt @@ -20,6 +20,17 @@ OCAMLMKTOP_IMPORTS=misc.cmo identifiable.cmo numbers.cmo config.cmo clflags.cmo ocamlmktop: $(OCAMLMKTOP) $(CAMLC) $(LINKFLAGS) -o ocamlmktop $(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP) +ocamlmklibconfig.ml:: ../config/Makefile + echo "let mkdll = try \ + let flexlink = \ + let flexlink = Sys.getenv \"OCAML_FLEXLINK\" in \ + let f i = \ + let c = flexlink.[i] in \ + if c = '/' then '\\\\' else c in \ + (String.init (String.length flexlink) f) ^ \" $(FLEXLINK_FLAGS)\" in \ + Printf.sprintf \"%s %s\" flexlink \"$(FLEXLINK_FLAGS)\" \ + with Not_found -> mkdll">> $@ + install:: cp ocamlmktop $(INSTALL_BINDIR)/ocamlmktop$(EXE) diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 0d804015a..003ce640f 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -109,7 +109,7 @@ install:: clean:: rm -f ocamlmklib -ocamlmklibconfig.ml: ../config/Makefile +ocamlmklibconfig.ml:: ../config/Makefile (echo 'let bindir = "$(BINDIR)"'; \ echo 'let ext_lib = "$(EXT_LIB)"'; \ echo 'let ext_dll = "$(EXT_DLL)"'; \ diff --git a/utils/config.mlp b/utils/config.mlp index 476431b06..e5af4d79d 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -44,9 +44,23 @@ let native_pack_linker = "%%PACKLD%%" let ranlib = "%%RANLIBCMD%%" let ar = "%%ARCMD%%" let cc_profile = "%%CC_PROFILE%%" -let mkdll = "%%MKDLL%%" -let mkexe = "%%MKEXE%%" -let mkmaindll = "%%MKMAINDLL%%" +let mkdll, mkexe, mkmaindll = + (* @@DRA Cygwin - but only if shared libraries are enabled, which we should be able to detect? *) + if Sys.os_type = "Win32" then + try + let flexlink = + let flexlink = Sys.getenv "OCAML_FLEXLINK" in + let f i = + let c = flexlink.[i] in + if c = '/' then '\\' else c in + (String.init (String.length flexlink) f) ^ " %%FLEXLINK_FLAGS%%" in + flexlink, + flexlink ^ " -exe", + flexlink ^ " -maindll" + with Not_found -> + "%%MKDLL%%", "%%MKEXE%%", "%%MKMAINDLL%%" + else + "%%MKDLL%%", "%%MKEXE%%", "%%MKMAINDLL%%" let flambda = %%FLAMBDA%% From b46843fb697a1b0ff4540087a036f9dc03ec023e Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 2 Jan 2016 14:49:08 +0000 Subject: [PATCH 032/145] Allow compilation using bootstrapped FlexDLL Extend the previous patch allowing make -f Makefile.nt flexdll install-flexdll not to require the install-flexdll stage. OCAML_FLEXLINK is utilised as required to allow compilation of the entire system using an in-tree compiled flexlink. The build process simply required the flexdll target to appear before world. opt.opt compiles a native code version of flexlink.exe as flexlink.opt. install always installs flexlink.exe if it was compiled along with any required .manifest files. It also installs the appropriate .o/.obj files to $(INSTALL_LIBDIR). At present, the bootstrapping is not extended to the Cygwin ports. --- Changes | 4 ++ Makefile.nt | 68 ++++++++++++++--------------- config/Makefile.mingw | 2 +- config/Makefile.mingw64 | 2 +- config/Makefile.msvc | 2 +- config/Makefile.msvc64 | 2 +- lex/Makefile.nt | 2 +- ocamldoc/Makefile.nt | 2 +- otherlibs/Makefile.nt | 2 + otherlibs/systhreads/Makefile.nt | 2 + testsuite/makefiles/Makefile.common | 7 +-- tools/Makefile.nt | 4 +- tools/Makefile.shared | 2 +- 13 files changed, 55 insertions(+), 46 deletions(-) diff --git a/Changes b/Changes index e4f0ed5ba..5ac66d4e0 100644 --- a/Changes +++ b/Changes @@ -522,6 +522,10 @@ Features wishes: - GPR#383: configure: define _ALL_SOURCE for build on AIX7.1 (tkob) +Build system: +- GPR#388: FlexDLL added as a Git submodule and bootstrappable with the compiler + (David Allsopp) + OCaml 4.02.3 (27 Jul 2015): --------------------------- diff --git a/Makefile.nt b/Makefile.nt index 96db99da1..f2cc81184 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -18,6 +18,10 @@ include Makefile.shared defaultentry: @echo "Please refer to the installation instructions in file README.win32.adoc." +FLEXDLL_SUBMODULE_PRESENT:=$(wildcard flexdll/Makefile) +BOOT_FLEXLINK_CMD=$(if $(FLEXDLL_SUBMODULE_PRESENT),FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink.exe") +CAMLOPT:=$(if $(FLEXDLL_SUBMODULE_PRESENT),OCAML_FLEXLINK="boot/ocamlrun flexdll/flexlink.exe") $(CAMLOPT) + # FlexDLL sources missing error messages # Different git mechanism displayed depending on whether this source tree came # from a git clone or a source tarball. @@ -39,38 +43,22 @@ flexdll-repo: flexdll-common-err @echo @false -# Bootstrapping FlexDLL - leaves a bytecode image of flexlink in flexdll/ +# Bootstrapping FlexDLL - leaves a bytecode image of flexlink.exe in flexdll/ flexdll: flexdll/Makefile cd byterun ; $(MAKEREC) BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE) cp byterun/ocamlrun.exe boot/ocamlrun.exe cd stdlib ; $(MAKEREC) COMPILER=../boot/ocamlc stdlib.cma std_exit.cmo cd stdlib ; cp stdlib.cma std_exit.cmo *.cmi ../boot cd flexdll ; $(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -I ../boot" flexlink.exe support -# The executable header will not have been available - flexlink.exe is just the bytecode image - cd flexdll ; mv flexlink.exe flexlink - cd stdlib ; $(MAKEREC) FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink" camlheader - -install-flexdll: - mkdir -p $(INSTALL_BINDIR) -# Assemble flexlink.exe - cat stdlib/camlheader flexdll/flexlink > flexdll/flexlink.exe ; chmod +x flexdll/flexlink.exe ; rm flexdll/flexlink -# The $(if ...) installs the correct .manifest file for MSVC and MSVC64 -# (GNU make doesn't have ifeq as a function, hence slightly convoluted use of filter-out) - cp flexdll/flexlink.exe flexdll/flexdll_*.$(O) flexdll/flexdll.h $(if $(filter-out mingw,$(TOOLCHAIN)),flexdll/default$(filter-out _i386,_$(ARCH)).manifest) $(INSTALL_BINDIR)/ -# This is the flexlink-free version of ocamlrun, it won't be used during -# compilation and will be overwritten when the finished OCaml is installed - cp boot/ocamlrun.exe $(INSTALL_BINDIR)/ -# Tidy-up the OCaml build tree ready for the next stage cd byterun ; $(MAKEREC) clean $(MAKEREC) partialclean -# If Makefile.nt was used to bootstrap FlexDLL, then opt.opt will build a native -# flexlink which install will put in $(INSTALL_BINDIR), overwriting the bytecode -# version placed there by install-flexdll -FLEXLINK_OPT=$(if $(or $(filter flexdll,$(MAKECMDGOALS)),$(wildcard flexdll/flexlink.exe)),flexlink_opt) - -flexlink_opt: - cd flexdll ; rm flexlink.exe ; $(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) OCAMLOPT="../ocamlopt.opt -I ../stdlib" flexlink.exe +flexlink.opt: + cd flexdll ; \ + mv flexlink.exe flexlink ; \ + $(MAKECMD) OCAML_FLEXLINK="../boot/ocamlrun ./flexlink" MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) OCAMLOPT="../ocamlopt.opt -I ../stdlib" flexlink.exe ; \ + mv flexlink.exe flexlink.opt ; \ + mv flexlink flexlink.exe # Recompile the system using the bootstrap compiler all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml \ @@ -114,11 +102,11 @@ LIBFILES=stdlib.cma std_exit.cmo *.cmi camlheader # Start up the system from the distribution compiler coldstart: - cd byterun ; $(MAKEREC) all + cd byterun ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) all cp byterun/ocamlrun.exe boot/ocamlrun.exe - cd yacc ; $(MAKEREC) all + cd yacc ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) all cp yacc/ocamlyacc.exe boot/ocamlyacc.exe - cd stdlib ; $(MAKEREC) COMPILER=../boot/ocamlc all + cd stdlib ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) COMPILER=../boot/ocamlc all cd stdlib ; cp $(LIBFILES) ../boot # Build the core system: the minimum needed to make depend and bootstrap @@ -180,8 +168,10 @@ opt: $(MAKEREC) otherlibrariesopt ocamltoolsopt # Native-code versions of the tools +# If the submodule is initialised, then opt.opt will build a native flexlink opt.opt: core opt-core ocamlc.opt all ocamlopt.opt ocamllex.opt \ - ocamltoolsopt ocamltoolsopt.opt otherlibrariesopt $(OCAMLBUILDNATIVE) $(OCAMLDOC_OPT) $(FLEXLINK_OPT) + ocamltoolsopt ocamltoolsopt.opt otherlibrariesopt $(OCAMLBUILDNATIVE) \ + $(OCAMLDOC_OPT) $(if $(wildcard flexdll/Makefile),flexlink.opt) # Complete build using fast compilers world.opt: coldstart opt.opt @@ -231,12 +221,20 @@ installbyt: else :; fi if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) install); \ else :; fi + if test -n "$(FLEXDLL_SUBMODULE_PRESENT)"; then $(MAKEREC) install-flexdll; \ + else :; fi cp config/Makefile $(INSTALL_LIBDIR)/Makefile.config cp README.adoc $(INSTALL_DISTRIB)/Readme.general.txt cp README.win32.adoc $(INSTALL_DISTRIB)/Readme.windows.txt cp LICENSE $(INSTALL_DISTRIB)/License.txt cp Changes $(INSTALL_DISTRIB)/Changes.txt +install-flexdll: +# The $(if ...) installs the correct .manifest file for MSVC and MSVC64 +# (GNU make doesn't have ifeq as a function, hence slightly convoluted use of filter-out) + cp flexdll/flexlink.exe $(if $(filter-out mingw,$(TOOLCHAIN)),flexdll/default$(filter-out _i386,_$(ARCH)).manifest) $(INSTALL_BINDIR)/ + cp flexdll/flexdll_*.$(O) $(INSTALL_LIBDIR) + # Installation of the native-code compiler installopt: cd asmrun ; $(MAKEREC) install @@ -252,7 +250,7 @@ installopt: done if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi cd tools; $(MAKEREC) installopt - if test -f ocamlopt.opt -a -f flexdll/flexlink.exe ; then cp flexdll/flexlink.exe $(INSTALL_BINDIR)/ ; fi + if test -f ocamlopt.opt -a -f flexdll/flexlink.opt ; then cp -f flexdll/flexlink.opt $(INSTALL_BINDIR)/flexlink.exe ; fi installoptopt: cp ocamlc.opt $(INSTALL_BINDIR)/ocamlc.opt$(EXE) @@ -546,7 +544,7 @@ partialclean:: runtime: makeruntime stdlib/libcamlrun.$(A) makeruntime: - cd byterun ; $(MAKEREC) all + cd byterun ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) all stdlib/libcamlrun.$(A): byterun/libcamlrun.$(A) cp byterun/libcamlrun.$(A) stdlib/libcamlrun.$(A) clean:: @@ -572,11 +570,11 @@ alldepend:: # The library library: - cd stdlib ; $(MAKEREC) all + cd stdlib ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) all library-cross: - cd stdlib ; $(MAKEREC) CAMLRUN=../byterun/ocamlrun all + cd stdlib ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) CAMLRUN=../byterun/ocamlrun all libraryopt: - cd stdlib ; $(MAKEREC) allopt + cd stdlib ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) allopt partialclean:: cd stdlib ; $(MAKEREC) clean alldepend:: @@ -594,7 +592,7 @@ alldepend:: cd lex ; $(MAKEREC) depend ocamlyacc: - cd yacc ; $(MAKEREC) all + cd yacc ; $(MAKEREC) $(BOOT_FLEXLINK_CMD) all clean:: cd yacc ; $(MAKEREC) clean @@ -665,7 +663,7 @@ ocamlbuild.byte: ocamlc otherlibraries cd ocamlbuild && $(MAKE) all ocamlbuild.native: ocamlopt otherlibrariesopt - cd ocamlbuild && $(MAKE) allopt + cd ocamlbuild && $(if $(FLEXDLL_SUBMODULE_PRESENT),OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe") $(MAKE) allopt partialclean:: cd ocamlbuild && $(MAKE) clean @@ -728,6 +726,6 @@ distclean: .PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries .PHONY: otherlibrariesopt promote promote-cross .PHONY: restore runtime runtimeopt makeruntimeopt world world.opt -.PHONY: flexdll flexlink_opt flexdll-common-err flexdll-repo +.PHONY: flexdll flexlink.opt flexdll-common-err flexdll-repo include .depend diff --git a/config/Makefile.mingw b/config/Makefile.mingw index dea64568d..01dc65632 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -117,7 +117,7 @@ FLEXLINK_FLAGS=-chain $(FLEXDLL_CHAIN) -stack 16777216 -link -static-libgcc FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) -IFLEXDIR= +IFLEXDIR=-I"../flexdll" else IFLEXDIR=-I"$(FLEXDIR)" endif diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index eccba97df..f92cbd591 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -117,7 +117,7 @@ FLEXLINK_FLAGS=-chain $(FLEXDLL_CHAIN) -stack 33554432 FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) -IFLEXDIR= +IFLEXDIR=-I"../flexdll" else IFLEXDIR=-I"$(FLEXDIR)" endif diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 66400923e..63f18a526 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -108,7 +108,7 @@ FLEXLINK_FLAGS=-merge-manifest -stack 16777216 FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) -IFLEXDIR= +IFLEXDIR=-I"../flexdll" else IFLEXDIR=-I"$(FLEXDIR)" endif diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index d4d33e13d..3ba8358f6 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -112,7 +112,7 @@ FLEXLINK_FLAGS=-x64 -merge-manifest -stack 33554432 FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) FLEXDIR:=$(shell $(FLEXLINK) -where 2>/dev/null) ifeq ($(FLEXDIR),) -IFLEXDIR= +IFLEXDIR=-I"../flexdll" else IFLEXDIR=-I"$(FLEXDIR)" endif diff --git a/lex/Makefile.nt b/lex/Makefile.nt index 6bd856040..768887809 100644 --- a/lex/Makefile.nt +++ b/lex/Makefile.nt @@ -17,7 +17,7 @@ CAMLRUN ?= ../boot/ocamlrun CAMLYACC ?= ../boot/ocamlyacc CAMLC=$(CAMLRUN) ../boot/ocamlc -I ../boot -CAMLOPT=$(CAMLRUN) ../ocamlopt -I ../stdlib +CAMLOPT=$(if $(wildcard ../flexdll/Makefile),OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe") $(CAMLRUN) ../ocamlopt -I ../stdlib COMPFLAGS=-warn-error A LINKFLAGS= YACCFLAGS=-v diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt index 9c009596b..a16d53e48 100644 --- a/ocamldoc/Makefile.nt +++ b/ocamldoc/Makefile.nt @@ -18,7 +18,7 @@ CAMLYACC ?= ../boot/ocamlyacc ########################## ROOTDIR = .. OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib +OCAMLOPT = $(if $(wildcard $(ROOTDIR)/flexdll/Makefile),OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe") $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex OCAMLLIB = $(LIBDIR) diff --git a/otherlibs/Makefile.nt b/otherlibs/Makefile.nt index 6d16f8d27..be4291bfe 100644 --- a/otherlibs/Makefile.nt +++ b/otherlibs/Makefile.nt @@ -15,6 +15,8 @@ include ../Makefile +export OCAML_FLEXLINK:=$(if $(wildcard $(ROOTDIR)/flexdll/Makefile),$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe) + # The Unix version now works fine under Windows # Note .. is the current directory (this makefile is included from diff --git a/otherlibs/systhreads/Makefile.nt b/otherlibs/systhreads/Makefile.nt index 22fb1c717..bb26cee2c 100644 --- a/otherlibs/systhreads/Makefile.nt +++ b/otherlibs/systhreads/Makefile.nt @@ -22,6 +22,8 @@ COMPFLAGS=-w +33 -warn-error A -g MKLIB=$(CAMLRUN) ../../tools/ocamlmklib CFLAGS=-I../../byterun $(EXTRACFLAGS) +export OCAML_FLEXLINK:=$(if $(wildcard ../../flexdll/Makefile),../../boot/ocamlrun ../../flexdll/flexlink.exe) + CAMLOBJS=thread.cmo mutex.cmo condition.cmo event.cmo threadUnix.cmo CMIFILES=$(CAMLOBJS:.cmo=.cmi) COBJS=st_stubs_b.$(O) diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common index c26f5c02c..16c264b6c 100644 --- a/testsuite/makefiles/Makefile.common +++ b/testsuite/makefiles/Makefile.common @@ -56,11 +56,12 @@ endif OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) \ -init $(OTOPDIR)/testsuite/lib/empty -OCAMLC=$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) -OCAMLOPT=$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) +FLEXLINK_PREFIX=$(if $(FLEXLINK),$(if $(wildcard $(TOPDIR)/flexdll/Makefile),OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe" )) +OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) +OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex -OCAMLMKLIB=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \ +OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \ -ocamlc "$(OTOPDIR)/boot/ocamlrun$(EXE) \ $(OTOPDIR)/ocamlc $(OCFLAGS)" \ -ocamlopt "$(OTOPDIR)/boot/ocamlrun$(EXE) \ diff --git a/tools/Makefile.nt b/tools/Makefile.nt index 289236341..8b86a29ff 100644 --- a/tools/Makefile.nt +++ b/tools/Makefile.nt @@ -12,6 +12,8 @@ include Makefile.shared +CAMLOPT:=$(if $(wildcard ../flexdll/Makefile),OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe") $(CAMLOPT) + # To make custom toplevels OCAMLMKTOP=ocamlmktop.cmo @@ -20,7 +22,7 @@ OCAMLMKTOP_IMPORTS=misc.cmo identifiable.cmo numbers.cmo config.cmo clflags.cmo ocamlmktop: $(OCAMLMKTOP) $(CAMLC) $(LINKFLAGS) -o ocamlmktop $(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP) -ocamlmklibconfig.ml:: ../config/Makefile +ocamlmklibconfig.ml:: ../config/Makefile Makefile echo "let mkdll = try \ let flexlink = \ let flexlink = Sys.getenv \"OCAML_FLEXLINK\" in \ diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 003ce640f..8eb2e2b0b 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -109,7 +109,7 @@ install:: clean:: rm -f ocamlmklib -ocamlmklibconfig.ml:: ../config/Makefile +ocamlmklibconfig.ml:: ../config/Makefile Makefile (echo 'let bindir = "$(BINDIR)"'; \ echo 'let ext_lib = "$(EXT_LIB)"'; \ echo 'let ext_dll = "$(EXT_DLL)"'; \ From ae49015d8e6e92869a1814654ddea8697fad5499 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 15 Jan 2016 16:40:50 +0000 Subject: [PATCH 033/145] Share compiler config with ocamlmklib Remove duplication between tools/ocamlmklibconfig.ml and utils/config.ml and link ocamlmklib with config.cmo from compiler-libs. --- tools/Makefile.nt | 11 ----------- tools/Makefile.shared | 7 ++----- tools/ocamlmklib.ml | 8 ++++---- 3 files changed, 6 insertions(+), 20 deletions(-) diff --git a/tools/Makefile.nt b/tools/Makefile.nt index 8b86a29ff..e428e0d63 100644 --- a/tools/Makefile.nt +++ b/tools/Makefile.nt @@ -22,17 +22,6 @@ OCAMLMKTOP_IMPORTS=misc.cmo identifiable.cmo numbers.cmo config.cmo clflags.cmo ocamlmktop: $(OCAMLMKTOP) $(CAMLC) $(LINKFLAGS) -o ocamlmktop $(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP) -ocamlmklibconfig.ml:: ../config/Makefile Makefile - echo "let mkdll = try \ - let flexlink = \ - let flexlink = Sys.getenv \"OCAML_FLEXLINK\" in \ - let f i = \ - let c = flexlink.[i] in \ - if c = '/' then '\\\\' else c in \ - (String.init (String.length flexlink) f) ^ \" $(FLEXLINK_FLAGS)\" in \ - Printf.sprintf \"%s %s\" flexlink \"$(FLEXLINK_FLAGS)\" \ - with Not_found -> mkdll">> $@ - install:: cp ocamlmktop $(INSTALL_BINDIR)/ocamlmktop$(EXE) diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 8eb2e2b0b..2b17092f8 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -101,7 +101,7 @@ clean:: # To help building mixed-mode libraries (OCaml + C) ocamlmklib: ocamlmklibconfig.cmo ocamlmklib.cmo - $(CAMLC) $(LINKFLAGS) -o ocamlmklib ocamlmklibconfig.cmo ocamlmklib.cmo + $(CAMLC) $(LINKFLAGS) -o ocamlmklib ocamlmklibconfig.cmo config.cmo ocamlmklib.cmo install:: cp ocamlmklib $(INSTALL_BINDIR)/ocamlmklib$(EXE) @@ -109,12 +109,9 @@ install:: clean:: rm -f ocamlmklib -ocamlmklibconfig.ml:: ../config/Makefile Makefile +ocamlmklibconfig.ml: ../config/Makefile Makefile (echo 'let bindir = "$(BINDIR)"'; \ - echo 'let ext_lib = "$(EXT_LIB)"'; \ - echo 'let ext_dll = "$(EXT_DLL)"'; \ echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\ - echo 'let mkdll = "$(MKDLL)"'; \ echo 'let byteccrpath = "$(BYTECCRPATH)"'; \ echo 'let nativeccrpath = "$(NATIVECCRPATH)"'; \ echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \ diff --git a/tools/ocamlmklib.ml b/tools/ocamlmklib.ml index 69cb0452f..54e29893b 100644 --- a/tools/ocamlmklib.ml +++ b/tools/ocamlmklib.ml @@ -244,9 +244,9 @@ let build_libs () = if !dynlink then begin let retcode = command (Printf.sprintf "%s %s -o %s %s %s %s %s %s" - mkdll + Config.mkdll (if !debug then "-g" else "") - (prepostfix "dll" !output_c ext_dll) + (prepostfix "dll" !output_c Config.ext_dll) (String.concat " " !c_objs) (String.concat " " !c_opts) (String.concat " " !ld_opts) @@ -256,9 +256,9 @@ let build_libs () = in if retcode <> 0 then if !failsafe then dynlink := false else exit 2 end; - safe_remove (prepostfix "lib" !output_c ext_lib); + safe_remove (prepostfix "lib" !output_c Config.ext_lib); scommand - (mklib (prepostfix "lib" !output_c ext_lib) + (mklib (prepostfix "lib" !output_c Config.ext_lib) (String.concat " " !c_objs) ""); end; if !bytecode_objs <> [] then From bcbee6896c16aa2f5411a5d32c5ebe3db9b44a6d Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 15 Jan 2016 17:43:34 +0000 Subject: [PATCH 034/145] Fix missing Windows change in #423 --- tools/Makefile.nt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/Makefile.nt b/tools/Makefile.nt index 1e5f9cc8c..aae380383 100644 --- a/tools/Makefile.nt +++ b/tools/Makefile.nt @@ -15,7 +15,7 @@ include Makefile.shared # To make custom toplevels OCAMLMKTOP=ocamlmktop.cmo -OCAMLMKTOP_IMPORTS=misc.cmo identifiable.cmo numbers.cmo config.cmo clflags.cmo ccomp.cmo +OCAMLMKTOP_IMPORTS=misc.cmo identifiable.cmo numbers.cmo config.cmo arg_helper.cmo clflags.cmo ccomp.cmo ocamlmktop: $(OCAMLMKTOP) $(CAMLC) $(LINKFLAGS) -o ocamlmktop $(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP) From 2d05cfb0b4d4e328ae3b288aebff5ed46359dd61 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 15 Jan 2016 17:43:58 +0000 Subject: [PATCH 035/145] Add missing FLAMBDA config for native Windows Missing options from #425. --- config/Makefile.mingw | 1 + config/Makefile.mingw64 | 1 + config/Makefile.msvc | 1 + config/Makefile.msvc64 | 1 + 4 files changed, 4 insertions(+) diff --git a/config/Makefile.mingw b/config/Makefile.mingw index 5b4658f71..178d7fe1b 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -86,6 +86,7 @@ RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false UNIXLIB=win32unix GRAPHLIB=win32graph +FLAMBDA=false ########## Configuration for the bytecode compiler diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 19a9b9437..9189e45c4 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -86,6 +86,7 @@ RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false UNIXLIB=win32unix GRAPHLIB=win32graph +FLAMBDA=false ########## Configuration for the bytecode compiler diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 4d399cf49..9518183c5 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -77,6 +77,7 @@ RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false UNIXLIB=win32unix GRAPHLIB=win32graph +FLAMBDA=false ########## Configuration for the bytecode compiler diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index 6a9650ba5..862a5810c 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -76,6 +76,7 @@ RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false UNIXLIB=win32unix GRAPHLIB=win32graph +FLAMBDA=false ########## Configuration for the bytecode compiler From 009e14a20c97db7480de37b3a2d76bfe365e5e63 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 16 Jan 2016 09:24:01 +0000 Subject: [PATCH 036/145] No need for vsnprintf workaround in VS2015 The Universal CRT includes a compliant implementation of vsnprintf. --- byterun/str.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/byterun/str.c b/byterun/str.c index 2ec18297c..9183cb36e 100644 --- a/byterun/str.c +++ b/byterun/str.c @@ -294,7 +294,7 @@ CAMLexport value caml_alloc_sprintf(const char * format, ...) int n; value res; -#ifndef _WIN32 +#if !defined(_WIN32) || defined(_UCRT) /* C99-compliant implementation */ va_start(args, format); /* "vsnprintf(dest, sz, format, args)" writes at most "sz" characters From 8386733a877d6fb4cadedba5e6ae414f69679afc Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 16 Jan 2016 11:41:30 +0000 Subject: [PATCH 037/145] Initial fixes for tests/asmcomp on MSVC 32-bit --- testsuite/makefiles/Makefile.common | 7 +++- testsuite/tests/asmcomp/Makefile | 53 +++++++++++++++++------------ 2 files changed, 37 insertions(+), 23 deletions(-) diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common index c26f5c02c..1cb35cb50 100644 --- a/testsuite/makefiles/Makefile.common +++ b/testsuite/makefiles/Makefile.common @@ -91,7 +91,7 @@ defaultclean: done .SUFFIXES: -.SUFFIXES: .mli .ml .mly .mll .cmi .cmo .cmx .cmm .cmxa .s .S .o .so .c .f +.SUFFIXES: .mli .ml .mly .mll .cmi .cmo .cmx .cmm .cmxa .s .S .$(O) .so .c .f .mli.cmi: @$(OCAMLC) -c $(ADD_COMPFLAGS) $< @@ -122,6 +122,11 @@ defaultclean: @$(OCAMLRUN) ./codegen $*.cmm > $*.s @$(ASM) -o $*.o $*.s +.cmm.obj: + @$(OCAMLRUN) ./codegen $*.cmm | grep -v "_caml_\(young_ptr\|young_limit\|extra_params\|allocN\|raise_exn\|reraise_exn\)" > $*.s + @set -o pipefail ; \ + $(ASM) $*.obj $*.s | tail -n +2 + .S.o: @$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $*.o $*.S diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile index ee2b91578..f43a31f0e 100644 --- a/testsuite/tests/asmcomp/Makefile +++ b/testsuite/tests/asmcomp/Makefile @@ -12,9 +12,6 @@ BASEDIR=../.. -CC=$(NATIVECC) -CFLAGS=$(NATIVECCCOMPOPTS) -g - INCLUDES=\ -I $(OTOPDIR)/utils \ -I $(OTOPDIR)/typing \ @@ -30,7 +27,7 @@ OBJS=parsecmmaux.cmo parsecmm.cmo lexcmm.cmo ADD_COMPFLAGS=$(INCLUDES) -w -40 -g default: - @if $(BYTECODE_ONLY) || [ -z "$(ASPP)" ]; then : ; else \ + @if $(BYTECODE_ONLY) ; then : ; else \ $(MAKE) all; \ fi @@ -64,31 +61,43 @@ ARGS_tagged-integr=-DINT_FLOAT -DFUN=test main.c ARGS_tagged-quicksort=-DSORT -DFUN=quicksort main.c ARGS_tagged-tak=-DUNIT_INT -DFUN=takmain main.c -tests: $(CASES:=.o) +one_ml: + @$(OCAMLOPT) -o $(NAME).exe $(NAME).ml && \ + ./$(NAME).exe && echo " => passed" || echo " => failed" + +one: + @set -o pipefail ; \ + $(call CC,$(NAME).out $(ARGS_$(NAME)) $(NAME).$(O) $(ARCH).$(O)) \ + && echo " => passed" || echo " => failed" + +clean: defaultclean + @rm -f ./codegen *.out *.$(O) *.exe + @rm -f parsecmm.ml parsecmm.mli lexcmm.ml + @rm -f $(CASES:=.s) + +include $(BASEDIR)/makefiles/Makefile.common + +ifeq ($(CCOMPTYPE),msvc) +CC=$(NATIVECC) $(CFLAGS) /Fe$(1) | tail -n +2 +CFLAGS=$(NATIVECCCOMPOPTS) +else +CC=$(NATIVECC) $(CFLAGS) -o $(1) +CFLAGS=$(NATIVECCCOMPOPTS) -g +endif +tests: $(CASES:=.$(O)) @for c in $(CASES); do \ printf " ... testing '$$c':"; \ - $(MAKE) one CC="$(CC) $(CFLAGS)" NAME=$$c; \ + $(MAKE) one NAME=$$c; \ done @for c in $(MLCASES); do \ printf " ... testing '$$c':"; \ $(MAKE) one_ml NAME=$$c; \ done -one_ml: - @$(OCAMLOPT) -o $(NAME).exe $(NAME).ml && \ - ./$(NAME).exe && echo " => passed" || echo " => failed" - -one: - @$(CC) -o $(NAME).out $(ARGS_$(NAME)) $(NAME).o $(ARCH).o \ - && echo " => passed" || echo " => failed" - -clean: defaultclean - @rm -f ./codegen *.out *.o *.obj *.exe - @rm -f parsecmm.ml parsecmm.mli lexcmm.ml - @rm -f $(CASES:=.s) - -include $(BASEDIR)/makefiles/Makefile.common - promote: -arch: $(ARCH).o +arch: $(ARCH).$(O) + +i386.obj: i386nt.asm + @set -o pipefail ; \ + $(ASM) $@ $^ | tail -n +2 From bfe91a097e5bed4f706f865e87e2f3079a4cde04 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 16 Jan 2016 14:12:18 +0000 Subject: [PATCH 038/145] Fix running outside bash! --- testsuite/tests/asmcomp/Makefile | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile index f43a31f0e..237dc9471 100644 --- a/testsuite/tests/asmcomp/Makefile +++ b/testsuite/tests/asmcomp/Makefile @@ -66,8 +66,7 @@ one_ml: ./$(NAME).exe && echo " => passed" || echo " => failed" one: - @set -o pipefail ; \ - $(call CC,$(NAME).out $(ARGS_$(NAME)) $(NAME).$(O) $(ARCH).$(O)) \ + @$(call CC,$(NAME).out $(ARGS_$(NAME)) $(NAME).$(O) $(ARCH).$(O)) \ && echo " => passed" || echo " => failed" clean: defaultclean @@ -78,7 +77,7 @@ clean: defaultclean include $(BASEDIR)/makefiles/Makefile.common ifeq ($(CCOMPTYPE),msvc) -CC=$(NATIVECC) $(CFLAGS) /Fe$(1) | tail -n +2 +CC=set -o pipefail ; $(NATIVECC) $(CFLAGS) /Fe$(1) | tail -n +2 CFLAGS=$(NATIVECCCOMPOPTS) else CC=$(NATIVECC) $(CFLAGS) -o $(1) From 124672aa136095946d963824841f70592f6d9237 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 9 Jan 2016 08:59:02 +0000 Subject: [PATCH 039/145] Filter out the display of .c files by MSVC Microsoft's C Compiler displays several lines on every invocation - most of this is removed by specifying the /nologo command line option, but the compiler still displays the name of every C file it compiles. The Microsoft Macro Assembler (MASM) does the same thing, but ocamlopt by default is able to pipe the output of that command directly to NUL, as the assembler code should never produce errors. The same cannot be done for invocations of the C compiler, as obviously syntax errors must be displayed. This relative small cosmetic change pipes the output of cl to a temporary file and filters out the first line if it is exactly as expected. The most elegant solution would require pipes and process handling to be merged from the Unix module into the compilers. --- Changes | 9 ++++--- utils/ccomp.ml | 70 +++++++++++++++++++++++++++++++++++++------------- 2 files changed, 58 insertions(+), 21 deletions(-) diff --git a/Changes b/Changes index 6c65dcb67..69c4d2c61 100644 --- a/Changes +++ b/Changes @@ -10,7 +10,7 @@ Language features: Namely, the redundancy checker now checks whether the uncovered pattern of the pattern is actually inhabited, exploding at most one wild card. This is also done for exhaustiveness when there is only one case. - Additionnally, one can now write unreachable cases, of the form, + Additionally, one can now write unreachable cases, of the form, "pat -> .", which are treated by the redundancy check. (Jacques Garrigue) - PR#6374: allow "_ t" as a short-hand for "(_, _, ..) t" for n-ary type constructors (Alain Frisch) @@ -101,8 +101,8 @@ Compilers: - PR#7067: Performance regression in the native compiler for long nested structures (Alain Frisch, report by Daniel Bünzli, review by Jacques Garrigue) -- PR#7097: Strange syntax error message around illegal packaged module signature - constraints (Alain Frisch, report by Jun Furuse) +- PR#7097: Strange syntax error message around illegal packaged module + signature constraints (Alain Frisch, report by Jun Furuse) - GPR#17: some cmm optimizations of integer operations with constants (Stephen Dolan, review by Pierre Chambart) - GPR#109: new unboxing strategy for float and int references (Vladimir Brankov, @@ -138,6 +138,9 @@ Compilers: (Leo White) - PR#6920: fix debug informations around uses of %apply or %revapply (Jérémie Dimino) +- GPR#407: don't display the name of compiled .c files when calling the + Microsoft C Compiler (same as the assembler). + (David Allsopp) Runtime system: - PR#3612: allow allocating custom block with finalizers in the minor heap diff --git a/utils/ccomp.ml b/utils/ccomp.ml index f8b840497..6ce7a4c94 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -48,25 +48,59 @@ let quote_optfile = function | None -> "" | Some f -> Filename.quote f +let display_msvc_output file name = + let c = open_in file in + try + let first = input_line c in + if first <> name then + print_string first; + while true do + print_string (input_line c) + done + with _ -> + close_in c; + Sys.remove file + let compile_file ~output_name name = - command - (Printf.sprintf - "%s%s -c %s %s %s %s %s" - (match !Clflags.c_compiler with - | Some cc -> cc - | None -> - if !Clflags.native_code - then Config.native_c_compiler - else Config.bytecomp_c_compiler) - (match output_name, Config.ccomp_type with - | Some n, "msvc" -> " /Fo" ^ Filename.quote n - | Some n, _ -> " -o " ^ Filename.quote n - | None, _ -> "") - (if !Clflags.debug && Config.ccomp_type <> "msvc" then "-g" else "") - (String.concat " " (List.rev !Clflags.all_ccopts)) - (quote_prefixed "-I" (List.rev !Clflags.include_dirs)) - (Clflags.std_include_flag "-I") - (Filename.quote name)) + let (pipe, file) = + if Config.ccomp_type = "msvc" && not !Clflags.verbose then + try + let (t, c) = Filename.open_temp_file "msvc" "stdout" in + close_out c; + (Printf.sprintf " > %s" (Filename.quote t), t) + with _ -> + ("", "") + else + ("", "") in + let exit = + command + (Printf.sprintf + "%s%s -c %s %s %s %s %s%s" + (match !Clflags.c_compiler with + | Some cc -> cc + | None -> + if !Clflags.native_code + then Config.native_c_compiler + else Config.bytecomp_c_compiler) + (match output_name, Config.ccomp_type with + | Some n, "msvc" -> " /Fo" ^ Filename.quote n + | Some n, _ -> " -o " ^ Filename.quote n + | None, _ -> "") + (if !Clflags.debug && Config.ccomp_type <> "msvc" then "-g" else "") + (String.concat " " (List.rev !Clflags.all_ccopts)) + (quote_prefixed "-I" (List.rev !Clflags.include_dirs)) + (Clflags.std_include_flag "-I") + (Filename.quote name) + (* cl tediously includes the name of the C file as the first thing it + outputs (in fairness, the tedious thing is that there's no switch to + disable this behaviour). In the absence of the Unix module, use + a temporary file to filter the output (cannot pipe the output to a + filter because this removes the exit status of cl, which is wanted. + *) + pipe) in + if pipe <> "" + then display_msvc_output file name; + exit let create_archive archive file_list = Misc.remove_file archive; From 8ca04e3b7f237c323d543aa7503cde9e6d8b81bc Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sun, 17 Jan 2016 19:15:04 +0000 Subject: [PATCH 040/145] Use ocamlc as a C compiler in the testsuite ocamlc and ocamlopt both provide convenient mechanisms to invoke the C compiler for .c files. Given the filtering out of the .c line for MSVC now performed by ocamlc and ocamlopt, changing the testsuite to invoke the C compiler via ocamlc reduces noise from the testsuite _log file. --- testsuite/makefiles/Makefile.one | 4 ++-- testsuite/makefiles/Makefile.several | 2 +- testsuite/tests/unboxed-primitive-args/Makefile | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/testsuite/makefiles/Makefile.one b/testsuite/makefiles/Makefile.one index cebf7fcc2..036fb12c1 100644 --- a/testsuite/makefiles/Makefile.one +++ b/testsuite/makefiles/Makefile.one @@ -29,7 +29,7 @@ CUSTOM_FLAG=`if [ -n "$(C_FILES)" ]; then echo '-custom'; fi` ADD_CFLAGS+=$(CUSTOM_FLAG) MYRUNTIME=`if [ -z "$(C_FILES)$(CUSTOM)" ]; then echo '$(OCAMLRUN)'; fi` -CC=$(NATIVECC) $(NATIVECCCOMPOPTS) +C_INCLUDES+=-I $(CTOPDIR)/byterun .PHONY: default default: @@ -39,7 +39,7 @@ default: .PHONY: compile compile: $(ML_FILES) @for file in $(C_FILES); do \ - $(NATIVECC) $(NATIVECCCOMPOPTS) -c -I$(CTOPDIR)/byterun $$file.c; \ + $(OCAMLC) -c $(C_INCLUDES) $$file.c; \ done; @if $(NATIVECODE_ONLY); then : ; else \ rm -f program.byte program.byte.exe; \ diff --git a/testsuite/makefiles/Makefile.several b/testsuite/makefiles/Makefile.several index 541046306..ce629ad71 100644 --- a/testsuite/makefiles/Makefile.several +++ b/testsuite/makefiles/Makefile.several @@ -36,7 +36,7 @@ check: .PHONY: run-all run-all: @for file in $(C_FILES); do \ - $(CC) $(C_INCLUDES) -c $$file.c; \ + $(OCAMLC) -c $(C_INCLUDES) -c $$file.c; \ done; @for file in $(F_FILES); do \ $(FORTRAN_COMPILER) -c $$file.f; \ diff --git a/testsuite/tests/unboxed-primitive-args/Makefile b/testsuite/tests/unboxed-primitive-args/Makefile index cda32a72f..c187eb382 100644 --- a/testsuite/tests/unboxed-primitive-args/Makefile +++ b/testsuite/tests/unboxed-primitive-args/Makefile @@ -15,6 +15,7 @@ LIBRARIES=unix bigarray MODULES=common MAIN_MODULE=main C_FILES=test_common stubs +C_INCLUDES=-I $(OTOPDIR)/otherlibs/bigarray ADD_COMPFLAGS=-I $(OTOPDIR)/otherlibs/bigarray \ -I $(OTOPDIR)/otherlibs/$(UNIXLIB) From 6bb1c731975967555d0a108fb745c699145d7ce4 Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 7 Jan 2016 16:01:23 +0100 Subject: [PATCH 041/145] Add comments on Parsetree's constants. --- parsing/parsetree.mli | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 5e6edbf14..29e6ac910 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -16,9 +16,23 @@ open Asttypes type constant = PConst_int of string * char option + (* 3 3l 3L 3n + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes except 'l', 'L' and 'n' are rejected by the typechecker + *) | PConst_char of char + (* 'c' *) | PConst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) | PConst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) (** {2 Extension points} *) From 6095df954ed514baa2bc7ea5352d3071f13a55ea Mon Sep 17 00:00:00 2001 From: Drup Date: Fri, 8 Jan 2016 15:48:47 +0100 Subject: [PATCH 042/145] Rename parsetree constants. PConst -> Pconst int -> integer --- parsing/ast_mapper.ml | 10 +++++----- parsing/builtin_attributes.ml | 10 +++++----- parsing/docstrings.ml | 4 ++-- parsing/parser.mly | 28 ++++++++++++++-------------- parsing/parsetree.mli | 8 ++++---- parsing/pprintast.ml | 14 +++++++------- parsing/printast.ml | 10 +++++----- typing/typecore.ml | 32 ++++++++++++++++---------------- typing/untypeast.ml | 14 +++++++------- 9 files changed, 65 insertions(+), 65 deletions(-) diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index d35409e22..cd5210dd3 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -626,13 +626,13 @@ let default_mapper = let rec extension_of_error {loc; msg; if_highlight; sub} = { loc; txt = "ocaml.error" }, - PStr ([Str.eval (Exp.constant (PConst_string (msg, None))); - Str.eval (Exp.constant (PConst_string (if_highlight, None)))] @ + PStr ([Str.eval (Exp.constant (Pconst_string (msg, None))); + Str.eval (Exp.constant (Pconst_string (if_highlight, None)))] @ (List.map (fun ext -> Str.extension (extension_of_error ext)) sub)) let attribute_of_warning loc s = { loc; txt = "ocaml.ppwarning" }, - PStr ([Str.eval ~loc (Exp.constant (PConst_string (s, None)))]) + PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) module StringMap = Map.Make(struct type t = string @@ -660,7 +660,7 @@ module PpxContext = struct let lid name = { txt = Lident name; loc = Location.none } - let make_string x = Exp.constant (PConst_string (x, None)) + let make_string x = Exp.constant (Pconst_string (x, None)) let make_bool x = if x @@ -715,7 +715,7 @@ module PpxContext = struct let restore fields = let field name payload = let rec get_string = function - | { pexp_desc = Pexp_constant (PConst_string (str, None)) } -> str + | { pexp_desc = Pexp_constant (Pconst_string (str, None)) } -> str | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] string syntax" name and get_bool pexp = diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml index 0f1641af9..87d6c7930 100755 --- a/parsing/builtin_attributes.ml +++ b/parsing/builtin_attributes.ml @@ -14,7 +14,7 @@ open Asttypes open Parsetree let string_of_cst = function - | PConst_string(s, _) -> Some s + | Pconst_string(s, _) -> Some s | _ -> None let string_of_payload = function @@ -37,13 +37,13 @@ let rec error_of_extension ext = in begin match p with | PStr({pstr_desc=Pstr_eval - ({pexp_desc=Pexp_constant(PConst_string(msg,_))}, _)}:: + ({pexp_desc=Pexp_constant(Pconst_string(msg,_))}, _)}:: {pstr_desc=Pstr_eval - ({pexp_desc=Pexp_constant(PConst_string(if_highlight,_))}, _)}:: + ({pexp_desc=Pexp_constant(Pconst_string(if_highlight,_))}, _)}:: inner) -> Location.error ~loc ~if_highlight ~sub:(sub_from inner) msg | PStr({pstr_desc=Pstr_eval - ({pexp_desc=Pexp_constant(PConst_string(msg,_))}, _)}::inner) -> + ({pexp_desc=Pexp_constant(Pconst_string(msg,_))}, _)}::inner) -> Location.error ~loc ~sub:(sub_from inner) msg | _ -> Location.errorf ~loc "Invalid syntax for extension '%s'." txt end @@ -113,7 +113,7 @@ let emit_external_warnings = begin match a with | {txt="ocaml.ppwarning"|"ppwarning"}, PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant - (PConst_string (s, _))},_); + (Pconst_string (s, _))},_); pstr_loc}] -> Location.prerr_warning pstr_loc (Warnings.Preprocessor s) | _ -> () diff --git a/parsing/docstrings.ml b/parsing/docstrings.ml index f4bbe9bae..70c9dd4ea 100644 --- a/parsing/docstrings.ml +++ b/parsing/docstrings.ml @@ -85,7 +85,7 @@ let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = - { pexp_desc = Pexp_constant (PConst_string(ds.ds_body, None)); + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in @@ -134,7 +134,7 @@ let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = - { pexp_desc = Pexp_constant (PConst_string(ds.ds_body, None)); + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in diff --git a/parsing/parser.mly b/parsing/parser.mly index f19579090..6851ba68a 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -79,18 +79,18 @@ let neg_string f = let mkuminus name arg = match name, arg.pexp_desc with - | "-", Pexp_constant(PConst_int (n,m)) -> - mkexp(Pexp_constant(PConst_int(neg_string n,m))) - | ("-" | "-."), Pexp_constant(PConst_float (f, m)) -> - mkexp(Pexp_constant(PConst_float(neg_string f, m))) + | "-", Pexp_constant(Pconst_integer (n,m)) -> + mkexp(Pexp_constant(Pconst_integer(neg_string n,m))) + | ("-" | "-."), Pexp_constant(Pconst_float (f, m)) -> + mkexp(Pexp_constant(Pconst_float(neg_string f, m))) | _ -> mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg])) let mkuplus name arg = let desc = arg.pexp_desc in match name, desc with - | "+", Pexp_constant(PConst_int _) - | ("+" | "+."), Pexp_constant(PConst_float _) -> mkexp desc + | "+", Pexp_constant(Pconst_integer _) + | ("+" | "+."), Pexp_constant(Pconst_float _) -> mkexp desc | _ -> mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg])) @@ -2169,17 +2169,17 @@ label: /* Constants */ constant: - | INT { let (n, m) = $1 in PConst_int (n, m) } - | CHAR { PConst_char $1 } - | STRING { let (s, d) = $1 in PConst_string (s, d) } - | FLOAT { let (f, m) = $1 in PConst_float (f, m) } + | INT { let (n, m) = $1 in Pconst_integer (n, m) } + | CHAR { Pconst_char $1 } + | STRING { let (s, d) = $1 in Pconst_string (s, d) } + | FLOAT { let (f, m) = $1 in Pconst_float (f, m) } ; signed_constant: constant { $1 } - | MINUS INT { let (n, m) = $2 in PConst_int("-" ^ n, m) } - | MINUS FLOAT { let (f, m) = $2 in PConst_float("-" ^ f, m) } - | PLUS INT { let (n, m) = $2 in PConst_int (n, m) } - | PLUS FLOAT { let (f, m) = $2 in PConst_float(f, m) } + | MINUS INT { let (n, m) = $2 in Pconst_integer("-" ^ n, m) } + | MINUS FLOAT { let (f, m) = $2 in Pconst_float("-" ^ f, m) } + | PLUS INT { let (n, m) = $2 in Pconst_integer (n, m) } + | PLUS FLOAT { let (f, m) = $2 in Pconst_float(f, m) } ; /* Identifiers and long identifiers */ diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 29e6ac910..a2db59c50 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -15,19 +15,19 @@ open Asttypes type constant = - PConst_int of string * char option + Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) - | PConst_char of char + | Pconst_char of char (* 'c' *) - | PConst_string of string * string option + | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) - | PConst_float of string * char option + | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 4a0b5c6b2..f741565eb 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -168,13 +168,13 @@ class printer ()= object(self:'self) pp f "%a(%a)" self#longident y self#longident s method longident_loc f x = pp f "%a" self#longident x.txt method constant f = function - | PConst_char i -> pp f "%C" i - | PConst_string (i, None) -> pp f "%S" i - | PConst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim - | PConst_int (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i - | PConst_int (i,Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m) - | PConst_float (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i - | PConst_float (i, Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m) + | Pconst_char i -> pp f "%C" i + | Pconst_string (i, None) -> pp f "%S" i + | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim + | Pconst_integer (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i + | Pconst_integer (i,Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m) + | Pconst_float (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i + | Pconst_float (i, Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m) (* trailing space*) method mutable_flag f = function diff --git a/parsing/printast.ml b/parsing/printast.ml index db90e46da..c401b93da 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -55,12 +55,12 @@ let fmt_char_option f = function let fmt_constant f x = match x with - | PConst_int (i,m) -> fprintf f "PConst_int (%s,%a)" i fmt_char_option m; - | PConst_char (c) -> fprintf f "PConst_char %02x" (Char.code c); - | PConst_string (s, None) -> fprintf f "PConst_string(%S,None)" s; - | PConst_string (s, Some delim) -> + | Pconst_integer (i,m) -> fprintf f "PConst_int (%s,%a)" i fmt_char_option m; + | Pconst_char (c) -> fprintf f "PConst_char %02x" (Char.code c); + | Pconst_string (s, None) -> fprintf f "PConst_string(%S,None)" s; + | Pconst_string (s, Some delim) -> fprintf f "PConst_string (%S,Some %S)" s delim; - | PConst_float (s,m) -> fprintf f "PConst_float (%s,%a)" s fmt_char_option m; + | Pconst_float (s,m) -> fprintf f "PConst_float (%s,%a)" s fmt_char_option m; ;; let fmt_mutable_flag f x = diff --git a/typing/typecore.ml b/typing/typecore.ml index d2e86f8ee..565c46907 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -265,31 +265,31 @@ let type_constant = function | Const_nativeint _ -> instance_def Predef.type_nativeint let constant : Parsetree.constant -> (Asttypes.constant, error) result = function - | PConst_int (i,None) -> + | Pconst_integer (i,None) -> begin try Ok (Const_int (Misc.Int_literal_converter.int i)) with Failure _ -> Error (Literal_overflow "int") end - | PConst_int (i,Some 'l') -> + | Pconst_integer (i,Some 'l') -> begin try Ok (Const_int32 (Misc.Int_literal_converter.int32 i)) with Failure _ -> Error (Literal_overflow "int32") end - | PConst_int (i,Some 'L') -> + | Pconst_integer (i,Some 'L') -> begin try Ok (Const_int64 (Misc.Int_literal_converter.int64 i)) with Failure _ -> Error (Literal_overflow "int64") end - | PConst_int (i,Some 'n') -> + | Pconst_integer (i,Some 'n') -> begin try Ok (Const_nativeint (Misc.Int_literal_converter.nativeint i)) with Failure _ -> Error (Literal_overflow "nativeint") end - | PConst_int (i,Some c) -> Error (Unknown_literal (i, c)) - | PConst_char c -> Ok (Const_char c) - | PConst_string (s,d) -> Ok (Const_string (s,d)) - | PConst_float (f,None)-> Ok (Const_float f) - | PConst_float (f,Some c) -> Error (Unknown_literal (f, c)) + | Pconst_integer (i,Some c) -> Error (Unknown_literal (i, c)) + | Pconst_char c -> Ok (Const_char c) + | Pconst_string (s,d) -> Ok (Const_string (s,d)) + | Pconst_float (f,None)-> Ok (Const_float f) + | Pconst_float (f,Some c) -> Error (Unknown_literal (f, c)) let constant_or_raise env loc cst = match constant cst with @@ -1070,14 +1070,14 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~explode ~env pat_type = expected_ty; pat_attributes = sp.ppat_attributes; pat_env = !env } - | Ppat_interval (PConst_char c1, PConst_char c2) -> + | Ppat_interval (Pconst_char c1, Pconst_char c2) -> let open Ast_helper.Pat in let gloc = {loc with Location.loc_ghost=true} in let rec loop c1 c2 = - if c1 = c2 then constant ~loc:gloc (PConst_char c1) + if c1 = c2 then constant ~loc:gloc (Pconst_char c1) else or_ ~loc:gloc - (constant ~loc:gloc (PConst_char c1)) + (constant ~loc:gloc (Pconst_char c1)) (loop (Char.chr(Char.code c1 + 1)) c2) in let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in @@ -1948,7 +1948,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = exp_attributes = sexp.pexp_attributes; exp_env = env } end - | Pexp_constant(PConst_string (str, _) as cst) -> ( + | Pexp_constant(Pconst_string (str, _) as cst) -> ( let cst = constant_or_raise env loc cst in (* Terrible hack for format strings *) let ty_exp = expand_head env ty_expected in @@ -2990,9 +2990,9 @@ and type_format loc str env = | _ :: _ :: _ -> Some (mk_exp_loc (Pexp_tuple args)) in mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg)) in let mk_cst cst = mk_exp_loc (Pexp_constant cst) in - let mk_int n = mk_cst (PConst_int (string_of_int n, None)) - and mk_string str = mk_cst (PConst_string (str, None)) - and mk_char chr = mk_cst (PConst_char chr) in + let mk_int n = mk_cst (Pconst_integer (string_of_int n, None)) + and mk_string str = mk_cst (Pconst_string (str, None)) + and mk_char chr = mk_cst (Pconst_char chr) in let rec mk_formatting_lit fmting = match fmting with | Close_box -> mk_constr "Close_box" [] diff --git a/typing/untypeast.ml b/typing/untypeast.ml index 4fd29d4b4..67605436b 100644 --- a/typing/untypeast.ml +++ b/typing/untypeast.ml @@ -113,13 +113,13 @@ let fresh_name s env = (** Mapping functions. *) let constant = function - | Const_char c -> PConst_char c - | Const_string (s,d) -> PConst_string (s,d) - | Const_int i -> PConst_int (string_of_int i, None) - | Const_int32 i -> PConst_int (Int32.to_string i, Some 'l') - | Const_int64 i -> PConst_int (Int64.to_string i, Some 'L') - | Const_nativeint i -> PConst_int (Nativeint.to_string i, Some 'n') - | Const_float f -> PConst_float (f,None) + | Const_char c -> Pconst_char c + | Const_string (s,d) -> Pconst_string (s,d) + | Const_int i -> Pconst_integer (string_of_int i, None) + | Const_int32 i -> Pconst_integer (Int32.to_string i, Some 'l') + | Const_int64 i -> Pconst_integer (Int64.to_string i, Some 'L') + | Const_nativeint i -> Pconst_integer (Nativeint.to_string i, Some 'n') + | Const_float f -> Pconst_float (f,None) let attribute sub (s, p) = (map_loc sub s, p) let attributes sub l = List.map (sub.attribute sub) l From 8a9d074902316eb865236015bfa93392ab92d278 Mon Sep 17 00:00:00 2001 From: Drup Date: Wed, 6 Jan 2016 20:38:38 +0100 Subject: [PATCH 043/145] Add Ast_helper.Const, for constants. --- parsing/ast_helper.ml | 11 +++++++++++ parsing/ast_helper.mli | 13 +++++++++++++ 2 files changed, 24 insertions(+) diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index fe6f26ce4..d4e28a240 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -29,6 +29,17 @@ let with_default_loc l f = try let r = f () in default_loc := old; r with exn -> default_loc := old; raise exn +module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) +end + module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index 2f8ba31eb..405d770c9 100644 --- a/parsing/ast_helper.mli +++ b/parsing/ast_helper.mli @@ -30,6 +30,19 @@ val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) +(** {2 Constants} *) + +module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant +end + (** {2 Core language} *) (** Type expressions *) From b36f05bb34ed4f83e21e0a51f201c9f99522cd43 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Mon, 18 Jan 2016 08:34:33 +0000 Subject: [PATCH 044/145] Changes entry for GPR#431 --- Changes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Changes b/Changes index 6c65dcb67..4a9d4d376 100644 --- a/Changes +++ b/Changes @@ -138,6 +138,8 @@ Compilers: (Leo White) - PR#6920: fix debug informations around uses of %apply or %revapply (Jérémie Dimino) +- GPR#431: permit constant float arrays to be eligible for pattern match + branch merging (Pierre Chambart) Runtime system: - PR#3612: allow allocating custom block with finalizers in the minor heap From 7ae5d358c119553b1688412e283a3356aab75207 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 18 Jan 2016 16:06:25 +0000 Subject: [PATCH 045/145] Tweaks to hiding the display of .c names with MSVC 1. Update FlexDLL so that ocamlc -custom no longer displays the intermediate C file 2. Ensure that, for example, ocamlc -c foo/bar.c doesn't display bar.c --- flexdll | 2 +- utils/ccomp.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/flexdll b/flexdll index db1d82aa8..c041e8bee 160000 --- a/flexdll +++ b/flexdll @@ -1 +1 @@ -Subproject commit db1d82aa8662d146562067288d0331c4ec2e1bd0 +Subproject commit c041e8beef98484a67df08b2ced27e096b6ea766 diff --git a/utils/ccomp.ml b/utils/ccomp.ml index 6ce7a4c94..a45014255 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -52,7 +52,7 @@ let display_msvc_output file name = let c = open_in file in try let first = input_line c in - if first <> name then + if first <> Filename.basename name then print_string first; while true do print_string (input_line c) From 9e547e67dd6a4992f3fc5ad4cd90b19ce853486c Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 23 Dec 2015 10:57:10 +0000 Subject: [PATCH 046/145] Normalise \r\n to \n for warnings The formatters used for printing warnings have text mode translation enabled which means that any Windows endings which creep into warning texts (e.g. from attributes) result in \r\r\n in the output. The effect is largely innocuous, except that it causes the deprecated_module_use test to fail on Windows. --- tools/Makefile.shared | 4 ++-- utils/misc.ml | 40 ++++++++++++++++++++++++++++++++++++++++ utils/misc.mli | 7 +++++++ utils/warnings.ml | 9 ++++++++- 4 files changed, 57 insertions(+), 3 deletions(-) diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 2b17092f8..0fa8b5052 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -75,11 +75,11 @@ ocamlprof: $(CSLPROF) profiling.cmo $(CAMLC) $(LINKFLAGS) -o ocamlprof $(CSLPROF_IMPORTS) $(CSLPROF) ocamlcp: ocamlcp.cmo - $(CAMLC) $(LINKFLAGS) -o ocamlcp warnings.cmo misc.cmo config.cmo \ + $(CAMLC) $(LINKFLAGS) -o ocamlcp misc.cmo warnings.cmo config.cmo \ identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo main_args.cmo ocamlcp.cmo ocamloptp: ocamloptp.cmo - $(CAMLC) $(LINKFLAGS) -o ocamloptp warnings.cmo misc.cmo config.cmo \ + $(CAMLC) $(LINKFLAGS) -o ocamloptp misc.cmo warnings.cmo config.cmo \ identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo main_args.cmo \ ocamloptp.cmo diff --git a/utils/misc.ml b/utils/misc.ml index 98aee6178..d64036f6b 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -628,3 +628,43 @@ module Color = struct ); () end + +(* + * Reduce \r\n to \n. Ignore \r which is not followed by \n + *) +let normalise_eol s = + let l' = String.length s in + (* + * Compute length of final string by identifying \r which is followed by \n + *) + let l = + let rec g b n i = + if i < 0 then + n + else + let c = s.[i] in + if c = '\r' && b then + g false n (pred i) + else + g (c = '\n') (succ n) (pred i) + in + g false 0 (pred l') in + (* + * Number of \r characters which will be squashed + *) + let count = l' - l in + (* + * Present offset for copying from [s] to the result + *) + let offset = ref 0 in + let f i = + let ofs = !offset in + (* + * ofs < count => there are still \r to squash; therefore i + ofs is not + * the last character of [s]. + *) + if ofs < count && s.[i + ofs] = '\r' && s.[i + ofs + 1] = '\n' then + incr offset; + s.[i + !offset] + in + String.init l f diff --git a/utils/misc.mli b/utils/misc.mli index 235b782ed..3050b6656 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -295,3 +295,10 @@ module Color : sig val set_color_tag_handling : Format.formatter -> unit (* adds functions to support color tags to the given formatter. *) end + +val normalise_eol : string -> string +(** [normalise_eol s] returns a fresh copy of [s] with any '\r' character which + appears before a '\n' character removed. Intended for pre-processing text + which will subsequently be printed on a channel which performs EOL + transformations (i.e. Windows) but leaves any instances of '\r' which are + intended for genuine carriage return. *) diff --git a/utils/warnings.ml b/utils/warnings.ml index 14575a94e..d9f791a33 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -454,7 +454,14 @@ let message = function let nerrors = ref 0;; let print ppf w = - let msg = message w in + (* Reduce \r\n in any warning messages to \n: + - Prevents any \r characters being printed on Unix when processing + Windows sources + - Prevents \r\r\n being generated on Windows, which affects the testsuite + Although applied to all messages, the principal culprit at the time of + writing was the Deprecated constructor. + *) + let msg = Misc.normalise_eol (message w) in let num = number w in Format.fprintf ppf "%d: %s" num msg; Format.pp_print_flush ppf (); From 469810f82298c8eb38e20b70da1028e5c22cd259 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 18 Jan 2016 16:40:03 +0000 Subject: [PATCH 047/145] Normalise \r\n to \n for deprecated warnings The formatters used for printing warnings have text mode translation enabled which means that any Windows endings which creep into warning texts from deprecated attributes result in \r\r\n in the output. The effect is largely innocuous, except that it causes the deprecated_module_use test to fail on Windows. --- utils/misc.ml | 43 +++++-------------------------------------- utils/misc.mli | 8 +++----- utils/warnings.ml | 18 +++++++++--------- 3 files changed, 17 insertions(+), 52 deletions(-) diff --git a/utils/misc.ml b/utils/misc.ml index d64036f6b..79fe83243 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -629,42 +629,9 @@ module Color = struct () end -(* - * Reduce \r\n to \n. Ignore \r which is not followed by \n - *) let normalise_eol s = - let l' = String.length s in - (* - * Compute length of final string by identifying \r which is followed by \n - *) - let l = - let rec g b n i = - if i < 0 then - n - else - let c = s.[i] in - if c = '\r' && b then - g false n (pred i) - else - g (c = '\n') (succ n) (pred i) - in - g false 0 (pred l') in - (* - * Number of \r characters which will be squashed - *) - let count = l' - l in - (* - * Present offset for copying from [s] to the result - *) - let offset = ref 0 in - let f i = - let ofs = !offset in - (* - * ofs < count => there are still \r to squash; therefore i + ofs is not - * the last character of [s]. - *) - if ofs < count && s.[i + ofs] = '\r' && s.[i + ofs + 1] = '\n' then - incr offset; - s.[i + !offset] - in - String.init l f + let b = Buffer.create 80 in + for i = 0 to String.length s - 1 do + if s.[i] <> '\r' then Buffer.add_char b s.[i] + done; + Buffer.contents b diff --git a/utils/misc.mli b/utils/misc.mli index 3050b6656..3ae72ac2c 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -297,8 +297,6 @@ module Color : sig end val normalise_eol : string -> string -(** [normalise_eol s] returns a fresh copy of [s] with any '\r' character which - appears before a '\n' character removed. Intended for pre-processing text - which will subsequently be printed on a channel which performs EOL - transformations (i.e. Windows) but leaves any instances of '\r' which are - intended for genuine carriage return. *) +(** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters + removed. Intended for pre-processing text which will subsequently be printed + on a channel which performs EOL transformations (i.e. Windows) *) diff --git a/utils/warnings.ml b/utils/warnings.ml index d9f791a33..14001d756 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -271,7 +271,14 @@ let () = parse_options true defaults_warn_error;; let message = function | Comment_start -> "this is the start of a comment." | Comment_not_end -> "this is not the end of a comment." - | Deprecated s -> "deprecated: " ^ s + | Deprecated s -> + (* Reduce \r\n to \n: + - Prevents any \r characters being printed on Unix when processing + Windows sources + - Prevents \r\r\n being generated on Windows, which affects the + testsuite + *) + "deprecated: " ^ Misc.normalise_eol s | Fragile_match "" -> "this pattern-matching is fragile." | Fragile_match s -> @@ -454,14 +461,7 @@ let message = function let nerrors = ref 0;; let print ppf w = - (* Reduce \r\n in any warning messages to \n: - - Prevents any \r characters being printed on Unix when processing - Windows sources - - Prevents \r\r\n being generated on Windows, which affects the testsuite - Although applied to all messages, the principal culprit at the time of - writing was the Deprecated constructor. - *) - let msg = Misc.normalise_eol (message w) in + let msg = message w in let num = number w in Format.fprintf ppf "%d: %s" num msg; Format.pp_print_flush ppf (); From 87de6a160d16634cbb43ca2507677d0f90f40f5f Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Tue, 19 Jan 2016 23:40:09 +0100 Subject: [PATCH 048/145] Useless bindings, unit patterns, whitespace. --- bytecomp/bytepackager.ml | 3 +-- bytecomp/switch.ml | 6 ++---- driver/optmain.ml | 4 ++-- parsing/docstrings.ml | 9 +++------ typing/env.ml | 3 +-- typing/parmatch.ml | 15 +++++++-------- typing/typetexp.ml | 4 ++-- 7 files changed, 18 insertions(+), 26 deletions(-) diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index d8493ab32..b54a3689f 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -265,8 +265,7 @@ let package_files ppf initial_env files targetfile = try let coercion = Typemod.package_units initial_env files targetcmi targetname in - let ret = package_object_files ppf files targetfile targetname coercion in - ret + package_object_files ppf files targetfile targetname coercion with x -> remove_file targetfile; raise x diff --git a/bytecomp/switch.ml b/bytecomp/switch.ml index 90dfde253..85b777bed 100644 --- a/bytecomp/switch.ml +++ b/bytecomp/switch.ml @@ -375,8 +375,7 @@ let ok_inter = ref false let rec opt_count top cases = let key = make_key cases in try - let r = Hashtbl.find t key in - r + Hashtbl.find t key with | Not_found -> let r = @@ -813,8 +812,7 @@ let do_zyva (low,high) arg cases actions = *) let n_clusters,k = comp_clusters s in let clusters = make_clusters s n_clusters k in - let r = c_test {arg=arg ; off=0} clusters in - r + c_test {arg=arg ; off=0} clusters let abstract_shared actions = let handlers = ref (fun x -> x) in diff --git a/driver/optmain.ml b/driver/optmain.ml index 608f5e2d5..2e921d063 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -106,8 +106,8 @@ module Options = Main_args.Make_optcomp_options (struct let _o s = output_name := Some s let _open s = open_modules := s :: !open_modules let _output_obj = set output_c_object - let _output_complete_obj s = - set output_c_object s; set output_complete_object s + let _output_complete_obj () = + set output_c_object (); set output_complete_object () let _p = set gprofile let _pack = set make_package let _pp s = preprocessor := Some s diff --git a/parsing/docstrings.ml b/parsing/docstrings.ml index 70c9dd4ea..7562f22ea 100644 --- a/parsing/docstrings.ml +++ b/parsing/docstrings.ml @@ -116,12 +116,9 @@ let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = - let attrs = - match info with - | None -> attrs - | Some ds -> attrs @ [info_attr ds] - in - attrs + match info with + | None -> attrs + | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specifc item *) diff --git a/typing/env.ml b/typing/env.ml index 3a9398788..82f68d26f 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -97,8 +97,7 @@ end = struct match !x with Thunk a -> Some a | _ -> None let create x = - let x = ref (Thunk x) in - x + ref (Thunk x) end diff --git a/typing/parmatch.ml b/typing/parmatch.ml index 6cffd5afe..2698d6c8a 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -767,7 +767,7 @@ let complete_constrs p all_tags = let build_other_constrs env p = match p.pat_desc with - Tpat_construct (_, {cstr_tag=Cstr_constant _|Cstr_block _}, _) -> + Tpat_construct (_, {cstr_tag=Cstr_constant _|Cstr_block _}, _) -> let get_tag = function | {pat_desc = Tpat_construct (_,c,_)} -> c.cstr_tag | _ -> fatal_error "Parmatch.get_tag" in @@ -976,7 +976,7 @@ let rec satisfiables pss qs = match pss with satisfiables pss (q::qs) | {pat_desc = (Tpat_any | Tpat_var(_))}::qs -> let q0 = discr_pat omega pss in - let wild p = + let wild p = List.map (fun qs -> p::qs) (satisfiables (filter_extra pss) qs) in begin match filter_all q0 pss with (* first column of pss is made of variables only *) @@ -2202,8 +2202,7 @@ let filter_all = to get the definitive list of groups *) let env = filter_rec [] rs in (* then add the omega rows to all groups *) - let env = filter_omega env rs in - env + filter_omega env rs (* Compute stable bindings *) @@ -2216,7 +2215,7 @@ let rec do_stable rs = match rs with match filter_all rs with | [] -> do_stable (List.map snd rs) - | (_,rs)::env -> + | (_,rs)::env -> List.fold_left (fun xs (_,rs) -> IdSet.inter xs (do_stable rs)) (do_stable rs) env @@ -2238,8 +2237,8 @@ let stable p = do_stable [{unseen=[p]; seen=[];}] Not doing so will yield excessive warning in (module (M:S) } ...) when true -> .... - as M is always present in - let module M_mod = unpack M .. in true + as M is always present in + let module M_mod = unpack M .. in true *) let all_rhs_idents exp = @@ -2278,7 +2277,7 @@ let all_rhs_idents exp = let check_ambiguous_bindings = let open Warnings in - let warn0 = Ambiguous_pattern [] in + let warn0 = Ambiguous_pattern [] in fun cases -> if is_active warn0 then List.iter diff --git a/typing/typetexp.ml b/typing/typetexp.ml index ffe108afd..ada1f0f0d 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -155,8 +155,8 @@ let find_value env loc lid = r let lookup_module ?(load=false) env loc lid = - let (path, decl) as r = - find_component (fun ?loc lid env -> (Env.lookup_module ~load ?loc lid env, ())) + let path as r = + find_component (fun ?loc lid env -> (Env.lookup_module ~load ?loc lid env)) (fun lid -> Unbound_module lid) env loc lid in path From 09bc2670387b0efb2fcc6fffeb0295fcd6899cb2 Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Tue, 19 Jan 2016 23:42:54 +0100 Subject: [PATCH 049/145] Simplify. --- typing/typetexp.ml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/typing/typetexp.ml b/typing/typetexp.ml index ada1f0f0d..7324dea10 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -155,11 +155,8 @@ let find_value env loc lid = r let lookup_module ?(load=false) env loc lid = - let path as r = - find_component (fun ?loc lid env -> (Env.lookup_module ~load ?loc lid env)) - (fun lid -> Unbound_module lid) env loc lid - in - path + find_component (fun ?loc lid env -> (Env.lookup_module ~load ?loc lid env)) + (fun lid -> Unbound_module lid) env loc lid let find_module env loc lid = let path = lookup_module ~load:true env loc lid in From ae3af451b8fef6be5798e1136c6410de5301c1e8 Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Wed, 20 Jan 2016 00:02:30 +0100 Subject: [PATCH 050/145] Remove useless bindings, use proper sequencing instead of 'let _ = ... in ...'. --- ocamldoc/odoc_analyse.ml | 2 +- ocamldoc/odoc_args.ml | 5 ++- ocamldoc/odoc_ast.ml | 44 +++++++++++--------------- ocamldoc/odoc_comments.ml | 9 +++--- ocamldoc/odoc_dag2html.ml | 18 ++++++----- ocamldoc/odoc_dep.ml | 31 +++++++++--------- ocamldoc/odoc_html.ml | 41 +++++++++--------------- ocamldoc/odoc_lexer.mll | 3 +- ocamldoc/odoc_man.ml | 10 +++--- ocamldoc/odoc_ocamlhtml.mll | 5 ++- ocamldoc/odoc_search.ml | 14 +++------ ocamldoc/odoc_sig.ml | 31 +++++++----------- ocamldoc/odoc_text_lexer.mll | 9 +++--- ocamldoc/odoc_to_text.ml | 61 +++++++++++++++--------------------- 14 files changed, 117 insertions(+), 166 deletions(-) diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml index 3fdf2716f..58e330069 100644 --- a/ocamldoc/odoc_analyse.ml +++ b/ocamldoc/odoc_analyse.ml @@ -438,7 +438,7 @@ let analyse_files ?(init=[]) files = print_string Odoc_messages.cross_referencing; print_newline () ); - let _ = Odoc_cross.associate modules_list in + Odoc_cross.associate modules_list; if !Odoc_global.verbose then ( diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index 8ce41c20f..cdd6e1b99 100644 --- a/ocamldoc/odoc_args.ml +++ b/ocamldoc/odoc_args.ml @@ -399,10 +399,9 @@ let add_option o = let parse () = if modified_options () then append_last_doc "\n"; let options = !options @ !help_options in - let _ = Arg.parse (Arg.align ~limit:13 options) + Arg.parse (Arg.align ~limit:13 options) anonymous - (M.usage^M.options_are) - in + (M.usage^M.options_are); (* we sort the hidden modules by name, to be sure that for example, A.B is before A, so we will match against A.B before A in Odoc_name.hide_modules.*) diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 436c7502e..284c3725e 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -867,19 +867,16 @@ module Analyser = tt_class_exp table in - let cl = - { - cl_name = complete_name ; - cl_info = comment_opt ; - cl_type = cltype ; - cl_virtual = virt ; - cl_type_parameters = type_parameters ; - cl_kind = kind ; - cl_parameters = parameters ; - cl_loc = { loc_impl = Some loc ; loc_inter = None } ; - } - in - cl + { + cl_name = complete_name ; + cl_info = comment_opt ; + cl_type = cltype ; + cl_virtual = virt ; + cl_type_parameters = type_parameters ; + cl_kind = kind ; + cl_parameters = parameters ; + cl_loc = { loc_impl = Some loc ; loc_inter = None } ; + } (** Get a name from a module expression, or "struct ... end" if the module expression is not an ident of a constraint on an ident. *) @@ -1043,18 +1040,15 @@ module Analyser = [] -> let s = get_string_of_file last_pos pos_limit in let (_, ele_coms) = My_ir.all_special !file_name s in - let ele_comments = - List.fold_left - (fun acc -> fun sc -> - match sc.Odoc_types.i_desc with - None -> - acc - | Some t -> - acc @ [Element_module_comment t]) - [] - ele_coms - in - ele_comments + List.fold_left + (fun acc -> fun sc -> + match sc.Odoc_types.i_desc with + None -> + acc + | Some t -> + acc @ [Element_module_comment t]) + [] + ele_coms | item :: q -> let (comment_opt, ele_comments) = get_comments_in_module last_pos item.Parsetree.pstr_loc.Location.loc_start.Lexing.pos_cnum diff --git a/ocamldoc/odoc_comments.ml b/ocamldoc/odoc_comments.ml index 236d860a3..b9fabbdf0 100644 --- a/ocamldoc/odoc_comments.ml +++ b/ocamldoc/odoc_comments.ml @@ -41,7 +41,7 @@ module Info_retriever = let retrieve_info fun_lex file (s : string) = try - let _ = Odoc_comments_global.init () in + Odoc_comments_global.init (); Odoc_lexer.comments_level := 0; let lexbuf = Lexing.from_string s in match Odoc_parser.main fun_lex lexbuf with @@ -49,15 +49,14 @@ module Info_retriever = (0, None) | Some (desc, remain_opt) -> let mem_nb_chars = !Odoc_comments_global.nb_chars in - let _ = - match remain_opt with + begin match remain_opt with None -> () | Some s -> (*DEBUG*)print_string ("remain: "^s); print_newline(); let lexbuf2 = Lexing.from_string s in Odoc_parser.info_part2 Odoc_lexer.elements lexbuf2 - in + end; (mem_nb_chars, Some { @@ -138,7 +137,7 @@ module Info_retriever = retrieve_info Odoc_lexer.main file s let retrieve_info_simple file (s : string) = - let _ = Odoc_comments_global.init () in + Odoc_comments_global.init (); Odoc_lexer.comments_level := 0; let lexbuf = Lexing.from_string s in match Odoc_parser.main Odoc_lexer.simple lexbuf with diff --git a/ocamldoc/odoc_dag2html.ml b/ocamldoc/odoc_dag2html.ml index 74119e6e8..9725d115a 100644 --- a/ocamldoc/odoc_dag2html.ml +++ b/ocamldoc/odoc_dag2html.ml @@ -938,14 +938,16 @@ let tablify phony no_optim no_group d = let t = {table = Array.append t.table [| Array.of_list new_row |]} in let t = if no_group && not (has_phony_children phony d t) then t - else - let _ = if no_optim then () else equilibrate t in - let _ = group_elem t in - let _ = group_ghost t in - let _ = group_children t in - let _ = group_span_by_common_children d t in + else begin + if no_optim then () else equilibrate t; + group_elem t; + group_ghost t; + group_children t; + group_span_by_common_children d t; let t = if no_optim then t else treat_gaps d t in - let _ = group_span_last_row t in t + group_span_last_row t; + t + end in loop t in @@ -1442,7 +1444,7 @@ let table_of_dag phony no_optim invert no_group d = let d = if invert then invert_dag d else d in let t = tablify phony no_optim no_group d in let t = if invert then invert_table t else t in - let _ = fall () t in + fall () t; let t = fall2_right t in let t = fall2_left t in let t = shorten_too_long t in diff --git a/ocamldoc/odoc_dep.ml b/ocamldoc/odoc_dep.ml index ab027d8d4..1e598128b 100644 --- a/ocamldoc/odoc_dep.ml +++ b/ocamldoc/odoc_dep.ml @@ -199,22 +199,19 @@ let kernel_deps_of_modules modules = *) let deps_of_types ?(kernel=false) types = let deps_pre = List.map (fun t -> (t, type_deps t)) types in - let deps = - if kernel then - ( - let graph = List.map - (fun (t, names) -> Dep.make_node t.Type.ty_name names) - deps_pre - in - let k = Dep.kernel graph in - List.map - (fun t -> + if kernel then + ( + let graph = List.map + (fun (t, names) -> Dep.make_node t.Type.ty_name names) + deps_pre + in + let k = Dep.kernel graph in + List.map + (fun t -> let node = Dep.get_node k t.Type.ty_name in (t, Dep.set_to_list node.Dep.near) - ) - types - ) - else - deps_pre - in - deps + ) + types + ) + else + deps_pre diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index 36ec40318..65f0f81ff 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -168,8 +168,7 @@ module Naming = (** Return the complete filename for the code of the given value. *) let file_code_value_complete_target v = - let f = code_prefix^mark_value^(subst_infix_symbols v.val_name)^".html" in - f + code_prefix^mark_value^(subst_infix_symbols v.val_name)^".html" (** Return the link target for the given attribute. *) let attribute_target a = target mark_attribute (Name.simple a.att_value.val_name) @@ -179,8 +178,7 @@ module Naming = (** Return the complete filename for the code of the given attribute. *) let file_code_attribute_complete_target a = - let f = code_prefix^mark_attribute^a.att_value.val_name^".html" in - f + code_prefix^mark_attribute^a.att_value.val_name^".html" (** Return the link target for the given method. *) let method_target m = target mark_method (Name.simple m.met_value.val_name) @@ -190,8 +188,7 @@ module Naming = (** Return the complete filename for the code of the given method. *) let file_code_method_complete_target m = - let f = code_prefix^mark_method^m.met_value.val_name^".html" in - f + code_prefix^mark_method^m.met_value.val_name^".html" (** Return the link target for the given label section. *) let label_target l = target "" l @@ -202,20 +199,17 @@ module Naming = (** Return the complete filename for the code of the type of the given module or module type name. *) let file_type_module_complete_target name = - let f = type_prefix^name^".html" in - f + type_prefix^name^".html" (** Return the complete filename for the code of the given module name. *) let file_code_module_complete_target name = - let f = code_prefix^name^".html" in - f + code_prefix^name^".html" (** Return the complete filename for the code of the type of the given class or class type name. *) let file_type_class_complete_target name = - let f = type_prefix^name^".html" in - f + type_prefix^name^".html" end module StringSet = Set.Make (struct @@ -259,8 +253,7 @@ class virtual text = method label_of_text t= let t2 = Odoc_info.first_sentence_of_text t in let s = Odoc_info.string_of_text t2 in - let s2 = self#keep_alpha_num s in - s2 + self#keep_alpha_num s (** Create a label for the associated title. Return the label specified by the user or a label created @@ -1176,12 +1169,10 @@ class html = else s_final in - let s2 = Str.global_substitute - (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") - f - s - in - s2 + Str.global_substitute + (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") + f + s (** Take a string and return the string where fully qualified module idents have been replaced by links to the module referenced by the ident.*) @@ -1200,12 +1191,10 @@ class html = else s_final in - let s2 = Str.global_substitute - (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\)\\(\\.[A-Z][a-zA-Z_'0-9]*\\)*") - f - s - in - s2 + Str.global_substitute + (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\)\\(\\.[A-Z][a-zA-Z_'0-9]*\\)*") + f + s (** Print html code to display a [Types.type_expr]. *) method html_of_type_expr b m_name t = diff --git a/ocamldoc/odoc_lexer.mll b/ocamldoc/odoc_lexer.mll index 5993cb8fc..bf5da3e23 100644 --- a/ocamldoc/odoc_lexer.mll +++ b/ocamldoc/odoc_lexer.mll @@ -87,8 +87,7 @@ let remove_blanks s = (** Remove first blank characters of each line of a string, until the first '*' *) let remove_stars s = - let s2 = Str.global_replace (Str.regexp ("^"^blank^"*\\*")) "" s in - s2 + Str.global_replace (Str.regexp ("^"^blank^"*\\*")) "" s } let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index 3c85aa32a..d2ee3f750 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -355,12 +355,10 @@ class man = match_s (Name.get_relative m_name match_s) in - let s2 = Str.global_substitute - (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") - f - s - in - s2 + Str.global_substitute + (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") + f + s (** Print groff string to display a [Types.type_expr].*) method man_of_type_expr b m_name t = diff --git a/ocamldoc/odoc_ocamlhtml.mll b/ocamldoc/odoc_ocamlhtml.mll index 9b3ad2da1..04ca1c659 100644 --- a/ocamldoc/odoc_ocamlhtml.mll +++ b/ocamldoc/odoc_ocamlhtml.mll @@ -198,8 +198,7 @@ let string_buffer = Buffer.create 32 let reset_string_buffer () = Buffer.reset string_buffer let store_string_char = Buffer.add_char string_buffer let get_stored_string () = - let s = Buffer.contents string_buffer in - s + Buffer.contents string_buffer (** To translate escape sequences *) @@ -517,7 +516,7 @@ let html_of_code b ?(with_pre=true) code = try print ~esc: false start ; let lexbuf = Lexing.from_string code in - let _ = token lexbuf in + token lexbuf; print ~esc: false ending ; Format.pp_print_flush !fmt () ; Buffer.contents buf diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml index 763b71602..9e40ae3cb 100644 --- a/ocamldoc/odoc_search.ml +++ b/ocamldoc/odoc_search.ml @@ -157,8 +157,7 @@ module Search = [] (Odoc_class.class_comments c) in - let l = res_att @ res_met @ res_sec in - l + res_att @ res_met @ res_sec else [] in @@ -189,8 +188,7 @@ module Search = [] (Odoc_class.class_type_comments ct) in - let l = res_att @ res_met @ res_sec in - l + res_att @ res_met @ res_sec else [] in @@ -252,10 +250,8 @@ module Search = [] (Odoc_module.module_type_comments mt) in - let l = res_val @ res_typ @ res_ext @ res_exc @ res_mod @ + res_val @ res_typ @ res_ext @ res_exc @ res_mod @ res_modtyp @ res_cl @ res_cltyp @ res_sec - in - l else [] in @@ -317,10 +313,8 @@ module Search = [] (Odoc_module.module_comments m) in - let l = res_val @ res_typ @ res_ext @ res_exc @ res_mod @ + res_val @ res_typ @ res_ext @ res_exc @ res_mod @ res_modtyp @ res_cl @ res_cltyp @ res_sec - in - l else [] in diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index e246f01ff..9d0f8b216 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -136,8 +136,7 @@ module Analyser = prepare_file must have been called to fill the file global variable.*) let get_string_of_file the_start the_end = try - let s = String.sub !file the_start (the_end-the_start) in - s + String.sub !file the_start (the_end-the_start) with Invalid_argument _ -> "" @@ -501,14 +500,11 @@ module Analyser = Parsetree.Pcty_constr (longident, _) -> (*of Longident.t * core_type list*) let name = Name.from_longident longident.txt in - let ic = - { - ic_name = Odoc_env.full_class_or_class_type_name env name ; - ic_class = None ; - ic_text = text_opt ; - } - in - ic + { + ic_name = Odoc_env.full_class_or_class_type_name env name ; + ic_class = None ; + ic_text = text_opt ; + } | Parsetree.Pcty_signature _ | Parsetree.Pcty_arrow _ -> @@ -1459,15 +1455,12 @@ module Analyser = (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *), Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) -> print_DEBUG "Cty_constr _"; - let k = - Class_type - { - cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ; - cta_class = None ; - cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list - } - in - k + Class_type + { + cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ; + cta_class = None ; + cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list + } | (Parsetree.Pcty_signature { Parsetree.pcsig_fields = class_type_field_list; diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll index bc339e72c..b53a5a9de 100644 --- a/ocamldoc/odoc_text_lexer.mll +++ b/ocamldoc/odoc_text_lexer.mll @@ -190,12 +190,11 @@ rule main = parse if !verb_mode || !target_mode || !code_pre_mode || (!open_brackets >= 1) then Char (Lexing.lexeme lexbuf) - else - let _ = - if !ele_ref_mode then - ele_ref_mode := false - in + else begin + if !ele_ref_mode then + ele_ref_mode := false; END + end } | begin_title { diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml index ce328b0da..93aff00c8 100644 --- a/ocamldoc/odoc_to_text.ml +++ b/ocamldoc/odoc_to_text.ml @@ -96,13 +96,10 @@ class virtual info = (** Return [text] value for the given "see also" reference. *) method text_of_see (see_ref, t) = - let t_ref = - match see_ref with - Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ] - | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t - | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t - in - t_ref + match see_ref with + Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ] + | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t + | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t (** Return [text] value for the given list of "see also" references.*) method text_of_sees l = @@ -192,12 +189,10 @@ class virtual to_text = let rel = Name.get_relative m_name match_s in Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel in - let s2 = Str.global_substitute - (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") - f - s - in - s2 + Str.global_substitute + (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") + f + s (** Take a string and return the string where fully qualified idents have been replaced by idents relative to the given module name. @@ -208,12 +203,10 @@ class virtual to_text = let rel = Name.get_relative m_name match_s in Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel in - let s2 = Str.global_substitute - (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)") - f - s - in - s2 + Str.global_substitute + (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)") + f + s (** Get a string for a [Types.class_type] where all idents are relative. *) method normal_class_type m_name t = @@ -248,14 +241,12 @@ class virtual to_text = (** @return [text] value to represent a [Types.type_expr].*) method text_of_type_expr module_name t = - let t = List.flatten - (List.map - (fun s -> [Code s ; Newline ]) - (Str.split (Str.regexp "\n") - (self#normal_type module_name t)) - ) - in - t + List.flatten + (List.map + (fun s -> [Code s ; Newline ]) + (Str.split (Str.regexp "\n") + (self#normal_type module_name t)) + ) (** Return [text] value for a given short [Types.type_expr].*) method text_of_short_type_expr module_name t = @@ -273,15 +264,13 @@ class virtual to_text = (** @return [text] value to represent parameters of a class (with arraows).*) method text_of_class_params module_name c = - let t = Odoc_info.text_concat - [Newline] - (List.map - (fun s -> [Code s]) - (Str.split (Str.regexp "\n") - (self#normal_class_params module_name c)) - ) - in - t + Odoc_info.text_concat + [Newline] + (List.map + (fun s -> [Code s]) + (Str.split (Str.regexp "\n") + (self#normal_class_params module_name c)) + ) (** @return [text] value to represent a [Types.module_type]. *) method text_of_module_type t = From 934dd9a40b1512849b689ce97a5204f7f5106d91 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Mon, 18 Jan 2016 18:34:02 +0100 Subject: [PATCH 051/145] More errors with unboxed and untagged attributes This commit adds errors for bad uses of @untagged and @unboxed attributes in external declarations. There are three possible new errors: - One when the external does not contain a native version of the primitive, - One when the attribute occurs deeply into the type, - One when the attribute is applied to the whole function type. --- testsuite/tests/typing-unboxed/test.ml | 82 +++++---- .../tests/typing-unboxed/test.ml.reference | 170 ++++++++++-------- typing/primitive.ml | 10 ++ typing/primitive.mli | 1 + typing/typedecl.ml | 38 +++- typing/typedecl.mli | 1 + 6 files changed, 190 insertions(+), 112 deletions(-) diff --git a/testsuite/tests/typing-unboxed/test.ml b/testsuite/tests/typing-unboxed/test.ml index f872c5bd3..decf43d52 100644 --- a/testsuite/tests/typing-unboxed/test.ml +++ b/testsuite/tests/typing-unboxed/test.ml @@ -11,22 +11,22 @@ (***********************************************************************) -external a : (int [@untagged]) -> unit = "a" -external b : (int32 [@unboxed]) -> unit = "b" -external c : (int64 [@unboxed]) -> unit = "c" -external d : (nativeint [@unboxed]) -> unit = "d" -external e : (float [@unboxed]) -> unit = "e" +external a : (int [@untagged]) -> unit = "a" "a_nat" +external b : (int32 [@unboxed]) -> unit = "b" "b_nat" +external c : (int64 [@unboxed]) -> unit = "c" "c_nat" +external d : (nativeint [@unboxed]) -> unit = "d" "d_nat" +external e : (float [@unboxed]) -> unit = "e" "e_nat" type t = private int -external f : (t [@untagged]) -> unit = "f" +external f : (t [@untagged]) -> unit = "f" "f_nat" module M : sig - external a : int -> (int [@untagged]) = "a" - external b : (int [@untagged]) -> int = "b" + external a : int -> (int [@untagged]) = "a" "a_nat" + external b : (int [@untagged]) -> int = "b" "b_nat" end = struct - external a : int -> (int [@untagged]) = "a" - external b : (int [@untagged]) -> int = "b" + external a : int -> (int [@untagged]) = "a" "a_nat" + external b : (int [@untagged]) -> int = "b" "b_nat" end;; module Global_attributes = struct @@ -38,11 +38,12 @@ module Global_attributes = struct external d : float -> float = "d" "noalloc" external e : float -> float = "e" + (* Should outputs a warning: no native implementation provided *) external f : (int32 [@unboxed]) -> (int32 [@unboxed]) = "f" "noalloc" - external g : int32 -> int32 = "g" [@@unboxed] [@@noalloc] + external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc] - external h : (int [@untagged]) -> (int [@untagged]) = "h" "noalloc" - external i : int -> int = "i" [@@untagged] [@@noalloc] + external h : (int [@untagged]) -> (int [@untagged]) = "h" "h_nat" "noalloc" + external i : int -> int = "i" "i_nat" [@@untagged] [@@noalloc] end;; module Old_style_warning = struct @@ -51,74 +52,87 @@ module Old_style_warning = struct external b : float -> float = "b" "noalloc" "b_nat" external c : float -> float = "c" "c_nat" "float" external d : float -> float = "d" "noalloc" + external e : float -> float = "c" "float" end (* Bad: attributes not reported in the interface *) module Bad1 : sig - external f : int -> int = "f" + external f : int -> int = "f" "f_nat" end = struct - external f : int -> (int [@untagged]) = "f" + external f : int -> (int [@untagged]) = "f" "f_nat" end;; module Bad2 : sig - external f : int -> int = "a" + external f : int -> int = "a" "a_nat" end = struct - external f : (int [@untagged]) -> int = "f" + external f : (int [@untagged]) -> int = "f" "f_nat" end;; module Bad3 : sig - external f : float -> float = "f" + external f : float -> float = "f" "f_nat" end = struct - external f : float -> (float [@unboxed]) = "f" + external f : float -> (float [@unboxed]) = "f" "f_nat" end;; module Bad4 : sig - external f : float -> float = "a" + external f : float -> float = "a" "a_nat" end = struct - external f : (float [@unboxed]) -> float = "f" + external f : (float [@unboxed]) -> float = "f" "f_nat" end;; (* Bad: attributes in the interface but not in the implementation *) module Bad5 : sig - external f : int -> (int [@untagged]) = "f" + external f : int -> (int [@untagged]) = "f" "f_nat" end = struct - external f : int -> int = "f" + external f : int -> int = "f" "f_nat" end;; module Bad6 : sig - external f : (int [@untagged]) -> int = "f" + external f : (int [@untagged]) -> int = "f" "f_nat" end = struct - external f : int -> int = "a" + external f : int -> int = "a" "a_nat" end;; module Bad7 : sig - external f : float -> (float [@unboxed]) = "f" + external f : float -> (float [@unboxed]) = "f" "f_nat" end = struct - external f : float -> float = "f" + external f : float -> float = "f" "f_nat" end;; module Bad8 : sig - external f : (float [@unboxed]) -> float = "f" + external f : (float [@unboxed]) -> float = "f" "f_nat" end = struct - external f : float -> float = "a" + external f : float -> float = "a" "a_nat" end;; (* Bad: unboxed or untagged with the wrong type *) -external g : (float [@untagged]) -> float = "g";; -external h : (int [@unboxed]) -> float = "h";; +external g : (float [@untagged]) -> float = "g" "g_nat";; +external h : (int [@unboxed]) -> float = "h" "h_nat";; + +(* Bad: unboxing the function type *) +external i : int -> float [@unboxed] = "i" "i_nat";; + +(* Bad: unboxing a "deep" sub-type. *) +external j : int -> (float [@unboxed]) * float = "j" "j_nat";; (* This should be rejected, but it is quite complicated to do in the current state of things *) -external i : int -> float [@unboxed] = "i";; -external j : int -> (float [@unboxed]) * float = "j";; -external k : int -> (float [@unboxd]) = "k";; +external k : int -> (float [@unboxd]) = "k" "k_nat";; (* Bad: old style annotations + new style attributes *) external l : float -> float = "l" "l_nat" "float" [@@unboxed];; external m : (float [@unboxed]) -> float = "m" "m_nat" "float";; external n : float -> float = "n" "noalloc" [@@noalloc];; + +(* Warnings: unboxed / untagged without any native implementation *) +external o : (float[@unboxed]) -> float = "o";; +external p : float -> (float[@unboxed]) = "p";; +external q : (int[@untagged]) -> float = "q";; +external r : int -> (int[@untagged]) = "r";; +external s : int -> int = "s" [@@untagged];; +external t : float -> float = "t" [@@unboxed];; diff --git a/testsuite/tests/typing-unboxed/test.ml.reference b/testsuite/tests/typing-unboxed/test.ml.reference index 68c9c9534..d6f1af192 100644 --- a/testsuite/tests/typing-unboxed/test.ml.reference +++ b/testsuite/tests/typing-unboxed/test.ml.reference @@ -1,29 +1,21 @@ -# external a : (int [@untagged]) -> unit = "a" -external b : (int32 [@unboxed]) -> unit = "b" -external c : (int64 [@unboxed]) -> unit = "c" -external d : (nativeint [@unboxed]) -> unit = "d" -external e : (float [@unboxed]) -> unit = "e" +# external a : (int [@untagged]) -> unit = "a" "a_nat" +external b : (int32 [@unboxed]) -> unit = "b" "b_nat" +external c : (int64 [@unboxed]) -> unit = "c" "c_nat" +external d : (nativeint [@unboxed]) -> unit = "d" "d_nat" +external e : (float [@unboxed]) -> unit = "e" "e_nat" type t = private int -external f : (t [@untagged]) -> unit = "f" +external f : (t [@untagged]) -> unit = "f" "f_nat" module M : sig - external a : int -> (int [@untagged]) = "a" - external b : (int [@untagged]) -> int = "b" + external a : int -> (int [@untagged]) = "a" "a_nat" + external b : (int [@untagged]) -> int = "b" "b_nat" end -# module Global_attributes : - sig - external a : float -> float = "a" "a_nat" [@@unboxed] [@@noalloc] - external b : float -> float = "b" "b_nat" [@@noalloc] - external c : float -> float = "c" "c_nat" [@@unboxed] [@@noalloc] - external d : float -> float = "d" [@@noalloc] - external e : float -> float = "e" - external f : int32 -> int32 = "f" [@@unboxed] [@@noalloc] - external g : int32 -> int32 = "g" [@@unboxed] [@@noalloc] - external h : int -> int = "h" [@@untagged] [@@noalloc] - external i : int -> int = "i" [@@untagged] [@@noalloc] - end -# Characters 63-122: +# Characters 383-452: + external f : (int32 [@unboxed]) -> (int32 [@unboxed]) = "f" "noalloc" + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory when attributes [@untagged] or [@unboxed] are present +# Characters 63-122: external a : float -> float = "a" "noalloc" "a_nat" "float" ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 3: deprecated: [@@unboxed] + [@@noalloc] should be used instead of "float" @@ -39,121 +31,127 @@ Characters 231-274: external d : float -> float = "d" "noalloc" ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 3: deprecated: [@@noalloc] should be used instead of "noalloc" -Characters 389-445: +Characters 441-505: ......struct - external f : int -> (int [@untagged]) = "f" + external f : int -> (int [@untagged]) = "f" "f_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : int -> (int [@untagged]) = "f" end + sig external f : int -> (int [@untagged]) = "f" "f_nat" end is not included in - sig external f : int -> int = "f" end + sig external f : int -> int = "f" "f_nat" end Values do not match: - external f : int -> (int [@untagged]) = "f" + external f : int -> (int [@untagged]) = "f" "f_nat" is not included in - external f : int -> int = "f" -# Characters 57-113: + external f : int -> int = "f" "f_nat" +# Characters 65-129: ......struct - external f : (int [@untagged]) -> int = "f" + external f : (int [@untagged]) -> int = "f" "f_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : (int [@untagged]) -> int = "f" end + sig external f : (int [@untagged]) -> int = "f" "f_nat" end is not included in - sig external f : int -> int = "a" end + sig external f : int -> int = "a" "a_nat" end Values do not match: - external f : (int [@untagged]) -> int = "f" + external f : (int [@untagged]) -> int = "f" "f_nat" is not included in - external f : int -> int = "a" -# Characters 61-120: + external f : int -> int = "a" "a_nat" +# Characters 69-136: ......struct - external f : float -> (float [@unboxed]) = "f" + external f : float -> (float [@unboxed]) = "f" "f_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : float -> (float [@unboxed]) = "f" end + sig external f : float -> (float [@unboxed]) = "f" "f_nat" end is not included in - sig external f : float -> float = "f" end + sig external f : float -> float = "f" "f_nat" end Values do not match: - external f : float -> (float [@unboxed]) = "f" + external f : float -> (float [@unboxed]) = "f" "f_nat" is not included in - external f : float -> float = "f" -# Characters 61-120: + external f : float -> float = "f" "f_nat" +# Characters 69-136: ......struct - external f : (float [@unboxed]) -> float = "f" + external f : (float [@unboxed]) -> float = "f" "f_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : (float [@unboxed]) -> float = "f" end + sig external f : (float [@unboxed]) -> float = "f" "f_nat" end is not included in - sig external f : float -> float = "a" end + sig external f : float -> float = "a" "a_nat" end Values do not match: - external f : (float [@unboxed]) -> float = "f" + external f : (float [@unboxed]) -> float = "f" "f_nat" is not included in - external f : float -> float = "a" -# Characters 141-183: + external f : float -> float = "a" "a_nat" +# Characters 149-199: ......struct - external f : int -> int = "f" + external f : int -> int = "f" "f_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : int -> int = "f" end + sig external f : int -> int = "f" "f_nat" end is not included in - sig external f : int -> (int [@untagged]) = "f" end + sig external f : int -> (int [@untagged]) = "f" "f_nat" end Values do not match: - external f : int -> int = "f" + external f : int -> int = "f" "f_nat" is not included in - external f : int -> (int [@untagged]) = "f" -# Characters 71-113: + external f : int -> (int [@untagged]) = "f" "f_nat" +# Characters 79-129: ......struct - external f : int -> int = "a" + external f : int -> int = "a" "a_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : int -> int = "a" end + sig external f : int -> int = "a" "a_nat" end is not included in - sig external f : (int [@untagged]) -> int = "f" end + sig external f : (int [@untagged]) -> int = "f" "f_nat" end Values do not match: - external f : int -> int = "a" + external f : int -> int = "a" "a_nat" is not included in - external f : (int [@untagged]) -> int = "f" -# Characters 74-120: + external f : (int [@untagged]) -> int = "f" "f_nat" +# Characters 82-136: ......struct - external f : float -> float = "f" + external f : float -> float = "f" "f_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : float -> float = "f" end + sig external f : float -> float = "f" "f_nat" end is not included in - sig external f : float -> (float [@unboxed]) = "f" end + sig external f : float -> (float [@unboxed]) = "f" "f_nat" end Values do not match: - external f : float -> float = "f" + external f : float -> float = "f" "f_nat" is not included in - external f : float -> (float [@unboxed]) = "f" -# Characters 74-120: + external f : float -> (float [@unboxed]) = "f" "f_nat" +# Characters 82-136: ......struct - external f : float -> float = "a" + external f : float -> float = "a" "a_nat" end.. Error: Signature mismatch: Modules do not match: - sig external f : float -> float = "a" end + sig external f : float -> float = "a" "a_nat" end is not included in - sig external f : (float [@unboxed]) -> float = "f" end + sig external f : (float [@unboxed]) -> float = "f" "f_nat" end Values do not match: - external f : float -> float = "a" + external f : float -> float = "a" "a_nat" is not included in - external f : (float [@unboxed]) -> float = "f" + external f : (float [@unboxed]) -> float = "f" "f_nat" # Characters 67-72: - external g : (float [@untagged]) -> float = "g";; + external g : (float [@untagged]) -> float = "g" "g_nat";; ^^^^^ Error: Don't know how to untag this type. Only int can be untagged # Characters 14-17: - external h : (int [@unboxed]) -> float = "h";; + external h : (int [@unboxed]) -> float = "h" "h_nat";; ^^^ Error: Don't know how to unbox this type. Only float, int32, int64 and nativeint can be unboxed -# * external i : int -> float = "i" -# external j : int -> float * float = "j" -# external k : int -> float = "k" +# Characters 52-64: + external i : int -> float [@unboxed] = "i" "i_nat";; + ^^^^^^^^^^^^ +Error: Don't know how to unbox this type. Only float, int32, int64 and nativeint can be unboxed +# Characters 61-66: + external j : int -> (float [@unboxed]) * float = "j" "j_nat";; + ^^^^^ +Error: The attribute '@unboxed' should be attached to a direct argument or result of the primitive, it should not occur deeply into its type +# * external k : int -> float = "k" "k_nat" # Characters 58-119: external l : float -> float = "l" "l_nat" "float" [@@unboxed];; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -166,4 +164,28 @@ Error: Cannot use "float" in conjunction with [@unboxed]/[@untagged] external n : float -> float = "n" "noalloc" [@@noalloc];; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Cannot use "noalloc" in conjunction with [@@noalloc] +# Characters 70-115: + external o : (float[@unboxed]) -> float = "o";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory when attributes [@untagged] or [@unboxed] are present +# Characters 0-45: + external p : float -> (float[@unboxed]) = "p";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory when attributes [@untagged] or [@unboxed] are present +# Characters 0-44: + external q : (int[@untagged]) -> float = "q";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory when attributes [@untagged] or [@unboxed] are present +# Characters 0-42: + external r : int -> (int[@untagged]) = "r";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory when attributes [@untagged] or [@unboxed] are present +# Characters 0-42: + external s : int -> int = "s" [@@untagged];; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory when attributes [@untagged] or [@unboxed] are present +# Characters 0-45: + external t : float -> float = "t" [@@unboxed];; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory when attributes [@untagged] or [@unboxed] are present # diff --git a/typing/primitive.ml b/typing/primitive.ml index efe55b138..74d6eba1c 100644 --- a/typing/primitive.ml +++ b/typing/primitive.ml @@ -34,6 +34,7 @@ type description = type error = | Old_style_float_with_native_repr_attribute | Old_style_noalloc_with_noalloc_attribute + | No_native_primitive_with_repr_attribute exception Error of Location.t * error @@ -113,6 +114,11 @@ let parse_declaration valdecl ~native_repr_args ~native_repr_res = Location.prerr_warning valdecl.pval_loc (Warnings.Deprecated "[@@noalloc] should be used instead of \ \"noalloc\""); + if native_name = "" && + not (List.for_all is_ocaml_repr native_repr_args && + is_ocaml_repr native_repr_res) then + raise (Error (valdecl.pval_loc, + No_native_primitive_with_repr_attribute)); let noalloc = old_style_noalloc || noalloc_attribute in let native_repr_args, native_repr_res = if old_style_float then @@ -200,6 +206,10 @@ let report_error ppf err = | Old_style_noalloc_with_noalloc_attribute -> Format.fprintf ppf "Cannot use \"noalloc\" in conjunction with \ [%@%@noalloc]" + | No_native_primitive_with_repr_attribute -> + Format.fprintf ppf + "The native code version of the primitive is mandatory when \ + attributes [%@untagged] or [%@unboxed] are present" let () = Location.register_error_of_exn diff --git a/typing/primitive.mli b/typing/primitive.mli index 4d2e89018..5dabc0966 100644 --- a/typing/primitive.mli +++ b/typing/primitive.mli @@ -63,5 +63,6 @@ val byte_name: description -> string type error = | Old_style_float_with_native_repr_attribute | Old_style_noalloc_with_noalloc_attribute + | No_native_primitive_with_repr_attribute exception Error of Location.t * error diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 1b9f1011e..049df3e48 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -50,6 +50,7 @@ type error = | Val_in_structure | Multiple_native_repr_attributes | Cannot_unbox_or_untag_type of native_repr_kind + | Deep_unbox_or_untag_attribute of native_repr_kind open Typedtree @@ -1393,9 +1394,29 @@ let native_repr_of_type env kind ty = | _ -> None +(* Raises an error when [core_type] contains an [@unboxed] or [@untagged] + attribute in a strict sub-term. *) +let error_if_has_deep_native_repr_attributes core_type = + let open Ast_mapper in + let this_mapper = + { default_mapper with typ = fun mapper core_type -> + begin + match + get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None + with + | Native_repr_attr_present kind -> + raise (Error (core_type.ptyp_loc, Deep_unbox_or_untag_attribute kind)) + | Native_repr_attr_absent -> () + end; + default_mapper.typ mapper core_type } + in + ignore (default_mapper.typ this_mapper core_type : Parsetree.core_type) + let make_native_repr env core_type ty ~global_repr = + error_if_has_deep_native_repr_attributes core_type; match get_native_repr_attribute core_type.ptyp_attributes ~global_repr with - | Native_repr_attr_absent -> Same_as_ocaml_repr + | Native_repr_attr_absent -> + Same_as_ocaml_repr | Native_repr_attr_present kind -> begin match native_repr_of_type env kind ty with | None -> @@ -1404,14 +1425,18 @@ let make_native_repr env core_type ty ~global_repr = end let rec parse_native_repr_attributes env core_type ty ~global_repr = - match core_type.ptyp_desc, (Ctype.repr ty).desc with - | Ptyp_arrow (_, ct1, ct2), Tarrow (_, t1, t2, _) -> + match core_type.ptyp_desc, (Ctype.repr ty).desc, + get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None + with + | Ptyp_arrow _, Tarrow _, Native_repr_attr_present kind -> + raise (Error (core_type.ptyp_loc, Cannot_unbox_or_untag_type kind)) + | Ptyp_arrow (_, ct1, ct2), Tarrow (_, t1, t2, _), _ -> let repr_arg = make_native_repr env ct1 t1 ~global_repr in let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 ~global_repr in (repr_arg :: repr_args, repr_res) - | Ptyp_arrow _, _ | _, Tarrow _ -> assert false + | Ptyp_arrow _, _, _ | _, Tarrow _, _ -> assert false | _ -> ([], make_native_repr env core_type ty ~global_repr) (* Translate a value declaration *) @@ -1799,6 +1824,11 @@ let report_error ppf = function | Cannot_unbox_or_untag_type Untagged -> fprintf ppf "Don't know how to untag this type. Only int \ can be untagged" + | Deep_unbox_or_untag_attribute kind -> + fprintf ppf + "The attribute '%s' should be attached to a direct argument or \ + result of the primitive, it should not occur deeply into its type" + (match kind with Unboxed -> "@unboxed" | Untagged -> "@untagged") let () = Location.register_error_of_exn diff --git a/typing/typedecl.mli b/typing/typedecl.mli index 7b0bdb6b6..b0d0de0d1 100644 --- a/typing/typedecl.mli +++ b/typing/typedecl.mli @@ -87,6 +87,7 @@ type error = | Val_in_structure | Multiple_native_repr_attributes | Cannot_unbox_or_untag_type of native_repr_kind + | Deep_unbox_or_untag_attribute of native_repr_kind exception Error of Location.t * error From 534d607072b4f8e2c8024471d0e85cd733f3679a Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Thu, 21 Jan 2016 15:41:21 +0100 Subject: [PATCH 052/145] Add tests for static data allocation --- testsuite/tests/asmcomp/Makefile | 9 +- testsuite/tests/asmcomp/is_in_static_data.c | 5 + testsuite/tests/asmcomp/is_static.ml | 123 ++++++++++++++++++++ 3 files changed, 135 insertions(+), 2 deletions(-) create mode 100644 testsuite/tests/asmcomp/is_in_static_data.c create mode 100644 testsuite/tests/asmcomp/is_static.ml diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile index 237dc9471..c31179067 100644 --- a/testsuite/tests/asmcomp/Makefile +++ b/testsuite/tests/asmcomp/Makefile @@ -44,7 +44,8 @@ parsecmm.mli parsecmm.ml: parsecmm.mly lexcmm.ml: lexcmm.mll @$(OCAMLLEX) -q lexcmm.mll -MLCASES=optargs staticalloc bind_tuples +MLCASES=optargs staticalloc bind_tuples is_static +ARGS_is_static=is_in_static_data.o CASES=fib tak quicksort quicksort2 soli \ arith checkbound tagged-fib tagged-integr tagged-quicksort tagged-tak @@ -63,12 +64,16 @@ ARGS_tagged-tak=-DUNIT_INT -DFUN=takmain main.c one_ml: @$(OCAMLOPT) -o $(NAME).exe $(NAME).ml && \ - ./$(NAME).exe && echo " => passed" || echo " => failed" + ./$(NAME).exe `$(OCAMLOPT) -config` \ + && echo " => passed" || echo " => failed" one: @$(call CC,$(NAME).out $(ARGS_$(NAME)) $(NAME).$(O) $(ARCH).$(O)) \ && echo " => passed" || echo " => failed" +is_in_static_data.o: is_in_static_data.c + @$(OCAMLOPT) -c is_in_static_data.c + clean: defaultclean @rm -f ./codegen *.out *.$(O) *.exe @rm -f parsecmm.ml parsecmm.mli lexcmm.ml diff --git a/testsuite/tests/asmcomp/is_in_static_data.c b/testsuite/tests/asmcomp/is_in_static_data.c new file mode 100644 index 000000000..ccf0582c0 --- /dev/null +++ b/testsuite/tests/asmcomp/is_in_static_data.c @@ -0,0 +1,5 @@ +#include "caml/address_class.h" + +value caml_is_in_static_data(value v) { + return(Val_bool(Is_in_static_data(v))); +} diff --git a/testsuite/tests/asmcomp/is_static.ml b/testsuite/tests/asmcomp/is_static.ml new file mode 100644 index 000000000..abe07dd69 --- /dev/null +++ b/testsuite/tests/asmcomp/is_static.ml @@ -0,0 +1,123 @@ +external is_in_static_data : 'a -> bool = "caml_is_in_static_data" +let flambda = List.exists ((=) "flambda: true") (Array.to_list Sys.argv) +let is_in_static_data_flambda x = + not flambda || is_in_static_data x + +(* Basic constant blocks should be static *) +let block1 = (1,2) +let () = assert(is_in_static_data block1) + +(* as pattern shouldn't prevent it *) +let (a, b) as block2 = (1,2) +let () = assert(is_in_static_data block2) + +(* Also in functions *) +let f () = + let block = (1,2) in + assert(is_in_static_data block) + +let () = (f [@inlined never]) () + +(* Also after inlining *) +let g x = + let block = (1,x) in + assert(is_in_static_data_flambda block) + +let () = (g [@inlined always]) 2 + +(* Toplevel immutable blocks should be static *) +let block3 = (Sys.opaque_identity 1, Sys.opaque_identity 2) +let () = assert(is_in_static_data block3) + +(* Not being bound shouldn't prevent it *) +let () = + assert(is_in_static_data (Sys.opaque_identity 1, Sys.opaque_identity 2)) + +(* Only with rounds >= 2 currently ! +(* Also after inlining *) +let h x = + let block = (Sys.opaque_identity 1,x) in + assert(is_in_static_data block) + +let () = (h [@inlined always]) (Sys.opaque_identity 2) +*) + +(* Closed functions should be static *) +let closed_function x = x + 1 (* + is a primitive, it cannot be in the closure *) +let () = assert(is_in_static_data closed_function) + +(* And functions using closed functions *) +let almost_closed_function x = + (closed_function [@inlined never]) x +let () = assert(is_in_static_data almost_closed_function) + +(* Recursive constant values should be static *) +let rec a = 1 :: b +and b = 2 :: a +let () = + assert(is_in_static_data_flambda a); + assert(is_in_static_data_flambda b) + +(* Recursive constant functions should be static *) +let rec f1 a = g1 a +and g1 a = f1 a +let () = + assert(is_in_static_data f1); + assert(is_in_static_data g1) + +(* And a mix *) +type e = E : 'a -> e + +let rec f1 a = E (g1 a, l1) +and g1 a = E (f1 a, l2) +and l1 = E (f1, l2) +and l2 = E (g1, l1) + +let () = + assert(is_in_static_data_flambda f1); + assert(is_in_static_data_flambda g1); + assert(is_in_static_data_flambda l1); + assert(is_in_static_data_flambda l2) + +(* Also in functions *) +let i () = + let rec f1 a = E (g1 a, l1) + and g1 a = E (f1 a, l2) + and l1 = E (f1, l2) + and l2 = E (g1, l1) in + + assert(is_in_static_data_flambda f1); + assert(is_in_static_data_flambda g1); + assert(is_in_static_data_flambda l1); + assert(is_in_static_data_flambda l2) + +let () = (i [@inlined never]) () + +module type P = module type of Pervasives +(* Top-level modules should be static *) +let () = assert(is_in_static_data_flambda (module Pervasives:P)) + +(* Not constant let rec to test extraction to initialize_symbol *) +let r = ref 0 +let rec a = (incr r; !r) :: b +and b = (incr r; !r) :: a + +let next = + let r = ref 0 in + fun () -> incr r; !r + +let () = + assert(is_in_static_data_flambda next) + +(* Exceptions without arguments should be static *) +exception No_argument +let () = assert(is_in_static_data_flambda No_argument) + +(* And also with constant arguments *) +exception Some_argument of string +let () = assert(is_in_static_data_flambda (Some_argument "some string")) + +(* Even when exposed by inlining *) +let () = + let exn = try (failwith [@inlined always]) "some other string" with exn -> exn in + assert(is_in_static_data_flambda exn) From efa7d04f118c860711a5ed9e38441fde85e247e6 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Thu, 21 Jan 2016 17:38:06 +0100 Subject: [PATCH 053/145] fix problem reported in GPR#435: assertion failure --- asmrun/signals_asm.c | 1 - 1 file changed, 1 deletion(-) diff --git a/asmrun/signals_asm.c b/asmrun/signals_asm.c index 3dd32b625..a0b71b63a 100644 --- a/asmrun/signals_asm.c +++ b/asmrun/signals_asm.c @@ -67,7 +67,6 @@ extern char caml_system__code_begin, caml_system__code_end; void caml_garbage_collection(void) { - CAMLassert (caml_young_ptr >= caml_young_alloc_start); caml_young_limit = caml_young_trigger; if (caml_requested_major_slice || caml_requested_minor_gc || caml_young_ptr - caml_young_trigger < Max_young_whsize){ From fb35dc8fb43d31a6df9dbbaba9528dbf4bcfd28f Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Thu, 21 Jan 2016 16:46:49 +0000 Subject: [PATCH 054/145] Fix chambart/ocaml-1 GPR#134: wrong sharing of float array literals (Flambda only) --- middle_end/lift_constants.ml | 82 ++++++++++++++++++++---------------- 1 file changed, 46 insertions(+), 36 deletions(-) diff --git a/middle_end/lift_constants.ml b/middle_end/lift_constants.ml index 4ec33c07e..19609ded3 100644 --- a/middle_end/lift_constants.ml +++ b/middle_end/lift_constants.ml @@ -272,7 +272,7 @@ let find_original_set_of_closure in loop var -let rec translate_definition_and_resolve_alias +let translate_definition_and_resolve_alias inconstants (aliases:Alias_analysis.allocation_point Variable.Map.t) (var_to_symbol_tbl:Symbol.t Variable.Tbl.t) @@ -282,6 +282,41 @@ let rec translate_definition_and_resolve_alias (definition:Alias_analysis.constant_defining_value) ~(backend:(module Backend_intf.S)) : Flambda.constant_defining_value option = + let resolve_float_array_involving_variables + ~(mutability : Asttypes.mutable_flag) ~vars = + (* Resolve an [Allocated_const] of the form: + [Array (Pfloatarray, _, _)] + (which references its contents via variables; it does not contain + manifest floats). *) + let floats = + List.map (fun var -> + let var = + match Variable.Map.find var aliases with + | exception Not_found -> var + | Symbol _ -> + Misc.fatal_errorf + "Lift_constants.translate_definition_and_resolve_alias: \ + Array Pfloatarray %a with Symbol argument: %a" + Variable.print var + Alias_analysis.print_constant_defining_value definition + | Variable var -> var + in + match Variable.Tbl.find var_to_definition_tbl var with + | Allocated_const (Normal (Float f)) -> f + | const_defining_value -> + Misc.fatal_errorf "Bad definition for float array member %a: %a" + Variable.print var + Alias_analysis.print_constant_defining_value + const_defining_value) + vars + in + let const : Allocated_const.t = + match mutability with + | Immutable -> Immutable_float_array floats + | Mutable -> Float_array floats + in + Some (Flambda.Allocated_const const) + in match definition with | Block (tag, fields) -> Some (Flambda.Block (tag, List.map (resolve_variable aliases var_to_symbol_tbl var_to_definition_tbl) fields)) @@ -347,10 +382,13 @@ let rec translate_definition_and_resolve_alias Alias_analysis.Allocated_const (Normal (Immutable_float_array l)) end | wrong -> + (* CR-someday mshinwell: we might hit this if we ever duplicate + a mutable array across compilation units (e.g. "snapshotting" + an array). We do not currently generate such code. *) Misc.fatal_errorf "Lift_constants.translate_definition_and_resolve_alias: \ - Duplicate Pfloatarray %a with symbol %a mapping to \ - wrong value %a" + Duplicate Pfloatarray %a with symbol %a that does not \ + have an export description of an immutable array" Variable.print var Alias_analysis.print_constant_defining_value definition Simple_value_approx.print_descr wrong @@ -385,11 +423,10 @@ let rec translate_definition_and_resolve_alias | Mutable -> Float_array floats in Some (Flambda.Allocated_const const) - | (Allocated_const (Array (Pfloatarray, _, _))) as definition -> - translate_definition_and_resolve_alias inconstants aliases - var_to_symbol_tbl var_to_definition_tbl symbol_definition_map - project_closure_map definition - ~backend + | Allocated_const (Array (Pfloatarray, _, vars)) -> + (* Important: [mutability] is from the [Duplicate_array] + construction above. *) + resolve_float_array_involving_variables ~mutability ~vars | const -> Misc.fatal_errorf "Lift_constants.translate_definition_and_resolve_alias: \ @@ -402,34 +439,7 @@ let rec translate_definition_and_resolve_alias Duplicate_array with non-Pfloatarray kind: %a" Alias_analysis.print_constant_defining_value definition | Allocated_const (Array (Pfloatarray, mutability, vars)) -> - let floats = - List.map (fun var -> - let var = - match Variable.Map.find var aliases with - | exception Not_found -> var - | Symbol _ -> - Misc.fatal_errorf - "Lift_constants.translate_definition_and_resolve_alias: \ - Array Pfloatarray %a with Symbol argument: %a" - Variable.print var - Alias_analysis.print_constant_defining_value definition - | Variable var -> var - in - match Variable.Tbl.find var_to_definition_tbl var with - | Allocated_const (Normal (Float f)) -> f - | const_defining_value -> - Misc.fatal_errorf "Bad definition for float array member %a: %a" - Variable.print var - Alias_analysis.print_constant_defining_value - const_defining_value) - vars - in - let const : Allocated_const.t = - match mutability with - | Immutable -> Immutable_float_array floats - | Mutable -> Float_array floats - in - Some (Flambda.Allocated_const const) + resolve_float_array_involving_variables ~mutability ~vars | Allocated_const (Array (_, _, _)) -> Misc.fatal_errorf "Lift_constants.translate_definition_and_resolve_alias: \ Array with non-Pfloatarray kind: %a" From 0e8ed08a9dd30c89219c8a16cad45d5a4ec920a9 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 22 Jan 2016 00:29:19 +0100 Subject: [PATCH 055/145] Add warning headers to flambda files --- asmcomp/build_export_info.ml | 2 ++ asmcomp/build_export_info.mli | 2 ++ asmcomp/closure_offsets.ml | 2 ++ asmcomp/closure_offsets.mli | 2 ++ asmcomp/export_info.ml | 2 ++ asmcomp/export_info.mli | 2 ++ asmcomp/export_info_for_pack.ml | 2 ++ asmcomp/export_info_for_pack.mli | 2 ++ asmcomp/flambda_to_clambda.ml | 2 ++ asmcomp/flambda_to_clambda.mli | 2 ++ asmcomp/import_approx.ml | 2 ++ asmcomp/import_approx.mli | 2 ++ asmcomp/un_anf.ml | 2 ++ middle_end/alias_analysis.ml | 2 ++ middle_end/alias_analysis.mli | 2 ++ middle_end/allocated_const.ml | 2 ++ middle_end/allocated_const.mli | 2 ++ middle_end/augment_closures.ml | 2 ++ middle_end/augment_closures.mli | 2 ++ middle_end/backend_intf.mli | 2 ++ middle_end/base_types/closure_element.ml | 2 ++ middle_end/base_types/closure_element.mli | 2 ++ middle_end/base_types/closure_id.ml | 2 ++ middle_end/base_types/closure_id.mli | 2 ++ middle_end/base_types/compilation_unit.ml | 2 ++ middle_end/base_types/compilation_unit.mli | 2 ++ middle_end/base_types/export_id.ml | 2 ++ middle_end/base_types/export_id.mli | 2 ++ middle_end/base_types/id_types.ml | 2 ++ middle_end/base_types/id_types.mli | 2 ++ middle_end/base_types/linkage_name.ml | 2 ++ middle_end/base_types/linkage_name.mli | 2 ++ middle_end/base_types/mutable_variable.ml | 2 ++ middle_end/base_types/mutable_variable.mli | 2 ++ middle_end/base_types/set_of_closures_id.ml | 2 ++ middle_end/base_types/set_of_closures_id.mli | 2 ++ middle_end/base_types/static_exception.ml | 2 ++ middle_end/base_types/static_exception.mli | 2 ++ middle_end/base_types/symbol.ml | 2 ++ middle_end/base_types/symbol.mli | 2 ++ middle_end/base_types/tag.ml | 2 ++ middle_end/base_types/tag.mli | 2 ++ middle_end/base_types/var_within_closure.ml | 2 ++ middle_end/base_types/var_within_closure.mli | 2 ++ middle_end/base_types/variable.ml | 2 ++ middle_end/base_types/variable.mli | 2 ++ middle_end/closure_conversion.ml | 2 ++ middle_end/closure_conversion.mli | 2 ++ middle_end/closure_conversion_aux.ml | 2 ++ middle_end/closure_conversion_aux.mli | 2 ++ middle_end/effect_analysis.ml | 2 ++ middle_end/effect_analysis.mli | 2 ++ middle_end/find_recursive_functions.ml | 2 ++ middle_end/find_recursive_functions.mli | 2 ++ middle_end/flambda.ml | 2 ++ middle_end/flambda.mli | 2 ++ middle_end/flambda_invariants.ml | 2 ++ middle_end/flambda_invariants.mli | 2 ++ middle_end/flambda_iterators.ml | 2 ++ middle_end/flambda_iterators.mli | 2 ++ middle_end/flambda_utils.ml | 2 ++ middle_end/flambda_utils.mli | 2 ++ middle_end/freshening.ml | 2 ++ middle_end/freshening.mli | 2 ++ middle_end/inconstant_idents.ml | 2 ++ middle_end/inconstant_idents.mli | 2 ++ middle_end/initialize_symbol_to_let_symbol.ml | 2 ++ middle_end/initialize_symbol_to_let_symbol.mli | 2 ++ middle_end/inline_and_simplify.ml | 2 ++ middle_end/inline_and_simplify.mli | 2 ++ middle_end/inline_and_simplify_aux.ml | 2 ++ middle_end/inline_and_simplify_aux.mli | 2 ++ middle_end/inlining_cost.ml | 2 ++ middle_end/inlining_cost.mli | 2 ++ middle_end/inlining_decision.ml | 2 ++ middle_end/inlining_decision.mli | 2 ++ middle_end/inlining_decision_intf.mli | 2 ++ middle_end/inlining_stats.ml | 2 ++ middle_end/inlining_stats.mli | 2 ++ middle_end/inlining_stats_types.ml | 2 ++ middle_end/inlining_stats_types.mli | 2 ++ middle_end/inlining_transforms.ml | 2 ++ middle_end/inlining_transforms.mli | 2 ++ middle_end/invariant_params.ml | 2 ++ middle_end/invariant_params.mli | 2 ++ middle_end/lift_code.ml | 2 ++ middle_end/lift_code.mli | 2 ++ middle_end/lift_constants.ml | 2 ++ middle_end/lift_constants.mli | 2 ++ middle_end/lift_let_to_initialize_symbol.ml | 2 ++ middle_end/lift_let_to_initialize_symbol.mli | 2 ++ middle_end/middle_end.ml | 2 ++ middle_end/middle_end.mli | 2 ++ middle_end/ref_to_variables.ml | 2 ++ middle_end/ref_to_variables.mli | 2 ++ middle_end/remove_unused_arguments.ml | 2 ++ middle_end/remove_unused_arguments.mli | 2 ++ middle_end/remove_unused_closure_vars.ml | 2 ++ middle_end/remove_unused_closure_vars.mli | 2 ++ middle_end/remove_unused_program_constructs.ml | 2 ++ middle_end/remove_unused_program_constructs.mli | 2 ++ middle_end/semantics_of_primitives.ml | 2 ++ middle_end/semantics_of_primitives.mli | 2 ++ middle_end/share_constants.ml | 2 ++ middle_end/share_constants.mli | 2 ++ middle_end/simple_value_approx.ml | 2 ++ middle_end/simple_value_approx.mli | 2 ++ middle_end/simplify_boxed_integer_ops.ml | 2 ++ middle_end/simplify_boxed_integer_ops.mli | 2 ++ middle_end/simplify_boxed_integer_ops_intf.mli | 2 ++ middle_end/simplify_common.ml | 2 ++ middle_end/simplify_common.mli | 2 ++ middle_end/simplify_primitives.ml | 2 ++ middle_end/simplify_primitives.mli | 2 ++ middle_end/unbox_closures.ml | 2 ++ middle_end/unbox_closures.mli | 2 ++ 116 files changed, 232 insertions(+) diff --git a/asmcomp/build_export_info.ml b/asmcomp/build_export_info.ml index cf4bed4bd..d235ed4d1 100644 --- a/asmcomp/build_export_info.ml +++ b/asmcomp/build_export_info.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Env : sig type t diff --git a/asmcomp/build_export_info.mli b/asmcomp/build_export_info.mli index c98df74d4..a0f8b571c 100644 --- a/asmcomp/build_export_info.mli +++ b/asmcomp/build_export_info.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Construct export information, for emission into .cmx files, from an Flambda program. *) diff --git a/asmcomp/closure_offsets.ml b/asmcomp/closure_offsets.ml index 4a1d3e278..57a5428ba 100644 --- a/asmcomp/closure_offsets.ml +++ b/asmcomp/closure_offsets.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type result = { function_offsets : int Closure_id.Map.t; free_variable_offsets : int Var_within_closure.Map.t; diff --git a/asmcomp/closure_offsets.mli b/asmcomp/closure_offsets.mli index dbebffce7..1612953a5 100644 --- a/asmcomp/closure_offsets.mli +++ b/asmcomp/closure_offsets.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Assign numerical offsets, within closure blocks, for code pointers and environment entries. *) diff --git a/asmcomp/export_info.ml b/asmcomp/export_info.ml index 2f629b2a7..f7df1daaf 100644 --- a/asmcomp/export_info.ml +++ b/asmcomp/export_info.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type value_string_contents = | Contents of string | Unknown_or_mutable diff --git a/asmcomp/export_info.mli b/asmcomp/export_info.mli index 5568be61d..891a3cfbe 100644 --- a/asmcomp/export_info.mli +++ b/asmcomp/export_info.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Exported information (that is to say, information written into a .cmx file) about a compilation unit. *) diff --git a/asmcomp/export_info_for_pack.ml b/asmcomp/export_info_for_pack.ml index 9d6dfe139..d51bd3ae5 100644 --- a/asmcomp/export_info_for_pack.ml +++ b/asmcomp/export_info_for_pack.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let rename_id_state = Export_id.Tbl.create 100 (* Rename export identifiers' compilation units to denote that they now diff --git a/asmcomp/export_info_for_pack.mli b/asmcomp/export_info_for_pack.mli index 8ffe3098b..811a741d3 100644 --- a/asmcomp/export_info_for_pack.mli +++ b/asmcomp/export_info_for_pack.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Transformations on export information that are only used for the building of packs. *) diff --git a/asmcomp/flambda_to_clambda.ml b/asmcomp/flambda_to_clambda.ml index dcecaaecd..0e91d8e35 100644 --- a/asmcomp/flambda_to_clambda.ml +++ b/asmcomp/flambda_to_clambda.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type for_one_or_more_units = { fun_offset_table : int Closure_id.Map.t; fv_offset_table : int Var_within_closure.Map.t; diff --git a/asmcomp/flambda_to_clambda.mli b/asmcomp/flambda_to_clambda.mli index e6c6023b6..2c2bd9da6 100644 --- a/asmcomp/flambda_to_clambda.mli +++ b/asmcomp/flambda_to_clambda.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type result = { expr : Clambda.ulambda; preallocated_blocks : Clambda.preallocated_block list; diff --git a/asmcomp/import_approx.ml b/asmcomp/import_approx.ml index 40565b4ac..69628235f 100644 --- a/asmcomp/import_approx.ml +++ b/asmcomp/import_approx.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx let import_set_of_closures = diff --git a/asmcomp/import_approx.mli b/asmcomp/import_approx.mli index 185b8ff32..eb4ab705c 100644 --- a/asmcomp/import_approx.mli +++ b/asmcomp/import_approx.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Create simple value approximations from the export information in .cmx files. *) diff --git a/asmcomp/un_anf.ml b/asmcomp/un_anf.ml index ec753445d..71acbf8f6 100644 --- a/asmcomp/un_anf.ml +++ b/asmcomp/un_anf.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-30-40-41-42"] + (* We say that an [Ident.t] is "linear" iff: (a) it is used exactly once; (b) it is never assigned to (using [Uassign]). diff --git a/middle_end/alias_analysis.ml b/middle_end/alias_analysis.ml index 2883583ce..e7231b62a 100644 --- a/middle_end/alias_analysis.ml +++ b/middle_end/alias_analysis.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type allocation_point = | Symbol of Symbol.t | Variable of Variable.t diff --git a/middle_end/alias_analysis.mli b/middle_end/alias_analysis.mli index dd548d578..d45ea4ca3 100644 --- a/middle_end/alias_analysis.mli +++ b/middle_end/alias_analysis.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type allocation_point = | Symbol of Symbol.t | Variable of Variable.t diff --git a/middle_end/allocated_const.ml b/middle_end/allocated_const.ml index 0bb2d4bac..a29ca2e86 100644 --- a/middle_end/allocated_const.ml +++ b/middle_end/allocated_const.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type t = | Float of float | Int32 of int32 diff --git a/middle_end/allocated_const.mli b/middle_end/allocated_const.mli index ffd9bcc0c..4ab554211 100644 --- a/middle_end/allocated_const.mli +++ b/middle_end/allocated_const.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Constants that are always allocated (possibly statically). Blocks are not included here since they are always encoded using [Prim (Pmakeblock, ...)]. *) diff --git a/middle_end/augment_closures.ml b/middle_end/augment_closures.ml index 8a62bd20b..d32707b95 100644 --- a/middle_end/augment_closures.ml +++ b/middle_end/augment_closures.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module E = Inline_and_simplify_aux.Env diff --git a/middle_end/augment_closures.mli b/middle_end/augment_closures.mli index 609307529..c8bcac59a 100644 --- a/middle_end/augment_closures.mli +++ b/middle_end/augment_closures.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + val run : env:Inline_and_simplify_aux.Env.t -> set_of_closures:Flambda.set_of_closures -> diff --git a/middle_end/backend_intf.mli b/middle_end/backend_intf.mli index ac13225a5..45070159b 100644 --- a/middle_end/backend_intf.mli +++ b/middle_end/backend_intf.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Knowledge that the middle end needs about the backend. *) module type S = sig diff --git a/middle_end/base_types/closure_element.ml b/middle_end/base_types/closure_element.ml index f444d87a7..069ba44f4 100644 --- a/middle_end/base_types/closure_element.ml +++ b/middle_end/base_types/closure_element.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Variable let wrap t = t diff --git a/middle_end/base_types/closure_element.mli b/middle_end/base_types/closure_element.mli index 5a9244bec..5aee016d1 100644 --- a/middle_end/base_types/closure_element.mli +++ b/middle_end/base_types/closure_element.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Identifiable.S val wrap : Variable.t -> t diff --git a/middle_end/base_types/closure_id.ml b/middle_end/base_types/closure_id.ml index 39e19e0ce..fe3027cd5 100644 --- a/middle_end/base_types/closure_id.ml +++ b/middle_end/base_types/closure_id.ml @@ -14,4 +14,6 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Closure_element diff --git a/middle_end/base_types/closure_id.mli b/middle_end/base_types/closure_id.mli index 02425be40..f2a42fae8 100644 --- a/middle_end/base_types/closure_id.mli +++ b/middle_end/base_types/closure_id.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** CR-someday lwhite: "Closure_id" is quite a generic name. I wonder wether something like "Closure_label" would better capture that it is the label of a projection. *) diff --git a/middle_end/base_types/compilation_unit.ml b/middle_end/base_types/compilation_unit.ml index a798c436e..6e846e322 100644 --- a/middle_end/base_types/compilation_unit.ml +++ b/middle_end/base_types/compilation_unit.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type t = { id : Ident.t; linkage_name : Linkage_name.t; diff --git a/middle_end/base_types/compilation_unit.mli b/middle_end/base_types/compilation_unit.mli index 408da62e6..1af20c6dd 100644 --- a/middle_end/base_types/compilation_unit.mli +++ b/middle_end/base_types/compilation_unit.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Identifiable.S (* The [Ident.t] must be persistent. This function raises an exception diff --git a/middle_end/base_types/export_id.ml b/middle_end/base_types/export_id.ml index edcb731aa..7da010f0c 100644 --- a/middle_end/base_types/export_id.ml +++ b/middle_end/base_types/export_id.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Id : Id_types.Id = Id_types.Id (struct end) module Unit_id = Id_types.UnitId (Id) (Compilation_unit) diff --git a/middle_end/base_types/export_id.mli b/middle_end/base_types/export_id.mli index f4ed136ad..a71e43d5b 100644 --- a/middle_end/base_types/export_id.mli +++ b/middle_end/base_types/export_id.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* Keys representing value descriptions that may be written into intermediate files and loaded by a dependent compilation unit. These keys are used to ensure maximal sharing of value descriptions, diff --git a/middle_end/base_types/id_types.ml b/middle_end/base_types/id_types.ml index c2c5a2fae..a6c3cccb1 100644 --- a/middle_end/base_types/id_types.ml +++ b/middle_end/base_types/id_types.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module type BaseId = sig type t val equal : t -> t -> bool diff --git a/middle_end/base_types/id_types.mli b/middle_end/base_types/id_types.mli index 0a6dee184..dbfeadb91 100644 --- a/middle_end/base_types/id_types.mli +++ b/middle_end/base_types/id_types.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* CR-soon mshinwell: This module should be removed. *) diff --git a/middle_end/base_types/linkage_name.ml b/middle_end/base_types/linkage_name.ml index 1690d51d6..7e7dfce75 100644 --- a/middle_end/base_types/linkage_name.ml +++ b/middle_end/base_types/linkage_name.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type t = string include Identifiable.Make (struct diff --git a/middle_end/base_types/linkage_name.mli b/middle_end/base_types/linkage_name.mli index c0a29cdea..b54af46a3 100644 --- a/middle_end/base_types/linkage_name.mli +++ b/middle_end/base_types/linkage_name.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Identifiable.S val create : string -> t diff --git a/middle_end/base_types/mutable_variable.ml b/middle_end/base_types/mutable_variable.ml index b8090a9eb..d42d9ce0a 100644 --- a/middle_end/base_types/mutable_variable.ml +++ b/middle_end/base_types/mutable_variable.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type t = { compilation_unit : Compilation_unit.t; ident : Ident.t; diff --git a/middle_end/base_types/mutable_variable.mli b/middle_end/base_types/mutable_variable.mli index 158875b30..aa3bec17b 100644 --- a/middle_end/base_types/mutable_variable.mli +++ b/middle_end/base_types/mutable_variable.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Identifiable.S val create : ?current_compilation_unit:Compilation_unit.t -> string -> t diff --git a/middle_end/base_types/set_of_closures_id.ml b/middle_end/base_types/set_of_closures_id.ml index 99d56051f..a579e5a6b 100644 --- a/middle_end/base_types/set_of_closures_id.ml +++ b/middle_end/base_types/set_of_closures_id.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Id : Id_types.Id = Id_types.Id (struct end) module Unit_id = Id_types.UnitId (Id) (Compilation_unit) diff --git a/middle_end/base_types/set_of_closures_id.mli b/middle_end/base_types/set_of_closures_id.mli index a1e01fa6a..fa14e1ee9 100644 --- a/middle_end/base_types/set_of_closures_id.mli +++ b/middle_end/base_types/set_of_closures_id.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** An identifier, unique across the whole program, that identifies a set of a closures (viz. [Set_of_closures]). *) diff --git a/middle_end/base_types/static_exception.ml b/middle_end/base_types/static_exception.ml index 1520e472d..4a93526a0 100644 --- a/middle_end/base_types/static_exception.ml +++ b/middle_end/base_types/static_exception.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Numbers.Int let create () = Lambda.next_raise_count () diff --git a/middle_end/base_types/static_exception.mli b/middle_end/base_types/static_exception.mli index 00078d543..9cf5c905d 100644 --- a/middle_end/base_types/static_exception.mli +++ b/middle_end/base_types/static_exception.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** An identifier that is used to label static exceptions. Its uniqueness properties are unspecified. *) diff --git a/middle_end/base_types/symbol.ml b/middle_end/base_types/symbol.ml index 4f41c3dda..0f91dc4ef 100644 --- a/middle_end/base_types/symbol.ml +++ b/middle_end/base_types/symbol.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type t = { compilation_unit : Compilation_unit.t; label : Linkage_name.t; diff --git a/middle_end/base_types/symbol.mli b/middle_end/base_types/symbol.mli index 65bc4da01..20d970596 100644 --- a/middle_end/base_types/symbol.mli +++ b/middle_end/base_types/symbol.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** A symbol identifies a constant provided by either: - another compilation unit; or - a top-level module. diff --git a/middle_end/base_types/tag.ml b/middle_end/base_types/tag.ml index 938eed265..a168aff1f 100644 --- a/middle_end/base_types/tag.ml +++ b/middle_end/base_types/tag.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type t = int include Identifiable.Make (Numbers.Int) diff --git a/middle_end/base_types/tag.mli b/middle_end/base_types/tag.mli index 25ec434db..26d96d92e 100644 --- a/middle_end/base_types/tag.mli +++ b/middle_end/base_types/tag.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Tags on runtime boxed values. *) include Identifiable.S diff --git a/middle_end/base_types/var_within_closure.ml b/middle_end/base_types/var_within_closure.ml index 39e19e0ce..fe3027cd5 100644 --- a/middle_end/base_types/var_within_closure.ml +++ b/middle_end/base_types/var_within_closure.ml @@ -14,4 +14,6 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + include Closure_element diff --git a/middle_end/base_types/var_within_closure.mli b/middle_end/base_types/var_within_closure.mli index 48ecc5dbe..72a906ca9 100644 --- a/middle_end/base_types/var_within_closure.mli +++ b/middle_end/base_types/var_within_closure.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** An identifier, unique across the whole program, that identifies a particular variable within a particular closure. Only [Project_var], and not [Var], nodes are tagged with these diff --git a/middle_end/base_types/variable.ml b/middle_end/base_types/variable.ml index cae8207cf..cdd8ee067 100644 --- a/middle_end/base_types/variable.ml +++ b/middle_end/base_types/variable.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type t = { compilation_unit : Compilation_unit.t; name : string; diff --git a/middle_end/base_types/variable.mli b/middle_end/base_types/variable.mli index 363cb6c52..a99486562 100644 --- a/middle_end/base_types/variable.mli +++ b/middle_end/base_types/variable.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** [Variable.t] is the equivalent of a non-persistent [Ident.t] in the [Flambda] tree. It wraps an [Ident.t] together with its source [compilation_unit]. As such, it is unique within a whole program, diff --git a/middle_end/closure_conversion.ml b/middle_end/closure_conversion.ml index 7d3e23a47..b39c6d746 100644 --- a/middle_end/closure_conversion.ml +++ b/middle_end/closure_conversion.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Env = Closure_conversion_aux.Env module Function_decls = Closure_conversion_aux.Function_decls module Function_decl = Function_decls.Function_decl diff --git a/middle_end/closure_conversion.mli b/middle_end/closure_conversion.mli index 59161fcf1..152012462 100644 --- a/middle_end/closure_conversion.mli +++ b/middle_end/closure_conversion.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Generation of [Flambda] intermediate language code from [Lambda] code by performing a form of closure conversion. diff --git a/middle_end/closure_conversion_aux.ml b/middle_end/closure_conversion_aux.ml index e524a5a0b..c1d559781 100644 --- a/middle_end/closure_conversion_aux.ml +++ b/middle_end/closure_conversion_aux.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module IdentSet = Lambda.IdentSet module Env = struct diff --git a/middle_end/closure_conversion_aux.mli b/middle_end/closure_conversion_aux.mli index 66ce463a1..3701a7eb3 100644 --- a/middle_end/closure_conversion_aux.mli +++ b/middle_end/closure_conversion_aux.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Environments and auxiliary structures used during closure conversion. *) (** Used to remember which [Variable.t] values correspond to which diff --git a/middle_end/effect_analysis.ml b/middle_end/effect_analysis.ml index f97715cad..e411207a8 100644 --- a/middle_end/effect_analysis.ml +++ b/middle_end/effect_analysis.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let no_effects_prim (prim : Lambda.primitive) = match Semantics_of_primitives.for_primitive prim with | (No_effects | Only_generative_effects), (No_coeffects | Has_coeffects) -> diff --git a/middle_end/effect_analysis.mli b/middle_end/effect_analysis.mli index 2705571ec..55266455b 100644 --- a/middle_end/effect_analysis.mli +++ b/middle_end/effect_analysis.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Simple side effect analysis. *) (* CR-someday pchambart: Replace by call to [Purity] module. diff --git a/middle_end/find_recursive_functions.ml b/middle_end/find_recursive_functions.ml index ed23c3b42..919c939af 100644 --- a/middle_end/find_recursive_functions.ml +++ b/middle_end/find_recursive_functions.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let in_function_declarations (function_decls : Flambda.function_declarations) ~backend = let module VCC = Strongly_connected_components.Make (Variable) in diff --git a/middle_end/find_recursive_functions.mli b/middle_end/find_recursive_functions.mli index 12d055967..f6130cd14 100644 --- a/middle_end/find_recursive_functions.mli +++ b/middle_end/find_recursive_functions.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** "Recursive functions" are those functions [f] that might call either: - themselves, or - another function that in turn might call [f]. diff --git a/middle_end/flambda.ml b/middle_end/flambda.ml index e5b095ea0..43eccd072 100644 --- a/middle_end/flambda.ml +++ b/middle_end/flambda.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type call_kind = | Indirect | Direct of Closure_id.t diff --git a/middle_end/flambda.mli b/middle_end/flambda.mli index 624856cd9..7f7f96b53 100644 --- a/middle_end/flambda.mli +++ b/middle_end/flambda.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Intermediate language used for tree-based analysis and optimization. *) (** Whether the callee in a function application is known at compile time. *) diff --git a/middle_end/flambda_invariants.ml b/middle_end/flambda_invariants.ml index 657159aa6..b7ebf3fe3 100644 --- a/middle_end/flambda_invariants.ml +++ b/middle_end/flambda_invariants.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-30-40-41-42"] + type flambda_kind = | Normal | Lifted diff --git a/middle_end/flambda_invariants.mli b/middle_end/flambda_invariants.mli index 327093609..093c599cc 100644 --- a/middle_end/flambda_invariants.mli +++ b/middle_end/flambda_invariants.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type flambda_kind = | Normal | Lifted diff --git a/middle_end/flambda_iterators.ml b/middle_end/flambda_iterators.ml index ea38fadd7..2f5456e7a 100644 --- a/middle_end/flambda_iterators.ml +++ b/middle_end/flambda_iterators.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let apply_on_subexpressions f f_named (flam : Flambda.t) = match flam with | Var _ | Apply _ | Assign _ | Send _ | Proved_unreachable diff --git a/middle_end/flambda_iterators.mli b/middle_end/flambda_iterators.mli index 3ea854191..c77fbfca0 100644 --- a/middle_end/flambda_iterators.mli +++ b/middle_end/flambda_iterators.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* CR-soon mshinwell: we need to document whether these iterators follow any particular order. *) diff --git a/middle_end/flambda_utils.ml b/middle_end/flambda_utils.ml index c583c623d..ab97ed1a2 100644 --- a/middle_end/flambda_utils.ml +++ b/middle_end/flambda_utils.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let find_declaration cf ({ funs } : Flambda.function_declarations) = Variable.Map.find (Closure_id.unwrap cf) funs diff --git a/middle_end/flambda_utils.mli b/middle_end/flambda_utils.mli index 2ae870306..8210a9e0e 100644 --- a/middle_end/flambda_utils.mli +++ b/middle_end/flambda_utils.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Utility functions for the Flambda intermediate language. *) (** Access functions *) diff --git a/middle_end/freshening.ml b/middle_end/freshening.ml index 29d7b922d..cc2e4bcc6 100644 --- a/middle_end/freshening.ml +++ b/middle_end/freshening.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type tbl = { sb_var : Variable.t Variable.Map.t; sb_mutable_var : Mutable_variable.t Mutable_variable.Map.t; diff --git a/middle_end/freshening.mli b/middle_end/freshening.mli index ba4f3b16f..45bfcb203 100644 --- a/middle_end/freshening.mli +++ b/middle_end/freshening.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Freshening of various identifiers. *) (** A table used for freshening variables and static exception identifiers. *) diff --git a/middle_end/inconstant_idents.ml b/middle_end/inconstant_idents.ml index c57d432f9..8ece1942b 100644 --- a/middle_end/inconstant_idents.ml +++ b/middle_end/inconstant_idents.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* This cannot be done in a single simple pass due to expressions like: let rec ... = diff --git a/middle_end/inconstant_idents.mli b/middle_end/inconstant_idents.mli index 3e961e20e..08128c9c3 100644 --- a/middle_end/inconstant_idents.mli +++ b/middle_end/inconstant_idents.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type result (** [inconstants_on_program] finds those variables and set-of-closures identifiers that diff --git a/middle_end/initialize_symbol_to_let_symbol.ml b/middle_end/initialize_symbol_to_let_symbol.ml index 869576f23..7f32493dd 100644 --- a/middle_end/initialize_symbol_to_let_symbol.ml +++ b/middle_end/initialize_symbol_to_let_symbol.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let constant_field (expr:Flambda.t) : Flambda.constant_defining_value_block_field option = match expr with diff --git a/middle_end/initialize_symbol_to_let_symbol.mli b/middle_end/initialize_symbol_to_let_symbol.mli index b24c3f3fa..4535c3a08 100644 --- a/middle_end/initialize_symbol_to_let_symbol.mli +++ b/middle_end/initialize_symbol_to_let_symbol.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Transform Initialize_symbol with only constant fields to let_symbol construction. *) val run : Flambda.program -> Flambda.program diff --git a/middle_end/inline_and_simplify.ml b/middle_end/inline_and_simplify.ml index 11c3f0cf2..4ba6b9611 100644 --- a/middle_end/inline_and_simplify.ml +++ b/middle_end/inline_and_simplify.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module B = Inlining_cost.Benefit module E = Inline_and_simplify_aux.Env diff --git a/middle_end/inline_and_simplify.mli b/middle_end/inline_and_simplify.mli index d56015bd8..9e827a83f 100644 --- a/middle_end/inline_and_simplify.mli +++ b/middle_end/inline_and_simplify.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Simplification of Flambda programs combined with function inlining: for the most part a beta-reduction pass. diff --git a/middle_end/inline_and_simplify_aux.ml b/middle_end/inline_and_simplify_aux.ml index 037eb0365..b4d94e1e0 100644 --- a/middle_end/inline_and_simplify_aux.ml +++ b/middle_end/inline_and_simplify_aux.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Env = struct type scope = Current | Outer diff --git a/middle_end/inline_and_simplify_aux.mli b/middle_end/inline_and_simplify_aux.mli index 6567682c8..7ec54acc4 100644 --- a/middle_end/inline_and_simplify_aux.mli +++ b/middle_end/inline_and_simplify_aux.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Environments and result structures used during inlining and simplification. (See inline_and_simplify.ml.) *) diff --git a/middle_end/inlining_cost.ml b/middle_end/inlining_cost.ml index cbd6ca65c..afea7a000 100644 --- a/middle_end/inlining_cost.ml +++ b/middle_end/inlining_cost.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* Simple approximation of the space cost of a primitive. *) let prim_size (prim : Lambda.primitive) args = diff --git a/middle_end/inlining_cost.mli b/middle_end/inlining_cost.mli index 5af569aa2..99550f6ce 100644 --- a/middle_end/inlining_cost.mli +++ b/middle_end/inlining_cost.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Measurement of the cost (including cost in space) of Flambda terms in the context of inlining. *) diff --git a/middle_end/inlining_decision.ml b/middle_end/inlining_decision.ml index 4dc9c5f5e..2e2e2728a 100644 --- a/middle_end/inlining_decision.ml +++ b/middle_end/inlining_decision.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module E = Inline_and_simplify_aux.Env module R = Inline_and_simplify_aux.Result diff --git a/middle_end/inlining_decision.mli b/middle_end/inlining_decision.mli index 9fae5921c..5d161d698 100644 --- a/middle_end/inlining_decision.mli +++ b/middle_end/inlining_decision.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* CR mshinwell: Add the new inlining heuristic documentation here. *) (** Try to inline a full application of a known function, guided by various diff --git a/middle_end/inlining_decision_intf.mli b/middle_end/inlining_decision_intf.mli index d85481031..1aa801ca6 100644 --- a/middle_end/inlining_decision_intf.mli +++ b/middle_end/inlining_decision_intf.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* CR-someday mshinwell: name of this source file could now be improved *) type 'a by_copying_function_body = diff --git a/middle_end/inlining_stats.ml b/middle_end/inlining_stats.ml index e7dfa3960..b5d8888b7 100644 --- a/middle_end/inlining_stats.ml +++ b/middle_end/inlining_stats.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let _vim_trailer = "vim:fdm=expr:filetype=plain:\ foldexpr=getline(v\\:lnum)=~'^\\\\s*$'&&getline(v\\:lnum+1)=~'\\\\S'?'<1'\\:1" diff --git a/middle_end/inlining_stats.mli b/middle_end/inlining_stats.mli index d8201a66b..9bdf1a8d2 100644 --- a/middle_end/inlining_stats.mli +++ b/middle_end/inlining_stats.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Closure_stack : sig type t diff --git a/middle_end/inlining_stats_types.ml b/middle_end/inlining_stats_types.ml index df2c30d5a..b12d05700 100644 --- a/middle_end/inlining_stats_types.ml +++ b/middle_end/inlining_stats_types.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Wsb = Inlining_cost.Whether_sufficient_benefit let print_stars ppf n = diff --git a/middle_end/inlining_stats_types.mli b/middle_end/inlining_stats_types.mli index 3ea9b09e9..c19b2eec5 100644 --- a/middle_end/inlining_stats_types.mli +++ b/middle_end/inlining_stats_types.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* Types used for producing statistics about inlining. *) module Inlined : sig diff --git a/middle_end/inlining_transforms.ml b/middle_end/inlining_transforms.ml index 35fa90303..3502b3009 100644 --- a/middle_end/inlining_transforms.ml +++ b/middle_end/inlining_transforms.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module B = Inlining_cost.Benefit module E = Inline_and_simplify_aux.Env diff --git a/middle_end/inlining_transforms.mli b/middle_end/inlining_transforms.mli index 9d5d3cf92..010ec26a7 100644 --- a/middle_end/inlining_transforms.mli +++ b/middle_end/inlining_transforms.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Source code transformations used during inlining. *) (** Inline a function by substituting its body (which may be subject to diff --git a/middle_end/invariant_params.ml b/middle_end/invariant_params.ml index 64611cdad..07b950190 100644 --- a/middle_end/invariant_params.ml +++ b/middle_end/invariant_params.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* CR-someday pchambart to pchambart: in fact partial application doesn't work because there are no 'known' partial application left: they are converted to applications new partial function declaration. diff --git a/middle_end/invariant_params.mli b/middle_end/invariant_params.mli index 136ef3dc4..37cee2f3e 100644 --- a/middle_end/invariant_params.mli +++ b/middle_end/invariant_params.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* [invariant_params_in_recursion] calculates the set of parameters whose values are known not to change during the execution of a recursive function. As such, occurrences of the parameters may always be replaced diff --git a/middle_end/lift_code.ml b/middle_end/lift_code.ml index 1adf4e858..dc826ffc3 100644 --- a/middle_end/lift_code.ml +++ b/middle_end/lift_code.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module C = Inlining_cost diff --git a/middle_end/lift_code.mli b/middle_end/lift_code.mli index fdf2331de..bc4681935 100644 --- a/middle_end/lift_code.mli +++ b/middle_end/lift_code.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type lifter = Flambda.program -> Flambda.program (** Lift [let] bindings to attempt to increase the length of scopes, as an diff --git a/middle_end/lift_constants.ml b/middle_end/lift_constants.ml index 19609ded3..c3beb9d9b 100644 --- a/middle_end/lift_constants.ml +++ b/middle_end/lift_constants.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let rec tail_variable : Flambda.t -> Variable.t option = function | Var v -> Some v | Let_rec (_, e) diff --git a/middle_end/lift_constants.mli b/middle_end/lift_constants.mli index 04fe7fa05..ebb8bf580 100644 --- a/middle_end/lift_constants.mli +++ b/middle_end/lift_constants.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* CR mshinwell: check comment is up to date *) (** The aim of this pass is to assign symbols to values known to be constant (in other words, whose values we know at compile time), with diff --git a/middle_end/lift_let_to_initialize_symbol.ml b/middle_end/lift_let_to_initialize_symbol.ml index 6dd54ad1a..d77dff09f 100644 --- a/middle_end/lift_let_to_initialize_symbol.ml +++ b/middle_end/lift_let_to_initialize_symbol.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type ('a, 'b) kind = | Initialisation of (Symbol.t * Tag.t * Flambda.t list) | Effect of 'b diff --git a/middle_end/lift_let_to_initialize_symbol.mli b/middle_end/lift_let_to_initialize_symbol.mli index e1627e82d..451669134 100644 --- a/middle_end/lift_let_to_initialize_symbol.mli +++ b/middle_end/lift_let_to_initialize_symbol.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Lift toplevel [Let]-expressions to Flambda [program] constructions such that the results of evaluation of such expressions may be accessed directly, through symbols, rather than through closures. The diff --git a/middle_end/middle_end.ml b/middle_end/middle_end.ml index 85751f5a8..d264246a3 100644 --- a/middle_end/middle_end.ml +++ b/middle_end/middle_end.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let _dump_function_sizes flam ~backend = let module Backend = (val backend : Backend_intf.S) in let than = max_int in diff --git a/middle_end/middle_end.mli b/middle_end/middle_end.mli index 12db62d19..74444bf89 100644 --- a/middle_end/middle_end.mli +++ b/middle_end/middle_end.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* Translate Lambda code to Flambda code and then optimize it. *) val middle_end diff --git a/middle_end/ref_to_variables.ml b/middle_end/ref_to_variables.ml index 7a7123171..9d9557a81 100644 --- a/middle_end/ref_to_variables.ml +++ b/middle_end/ref_to_variables.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let rename_var var = Mutable_variable.create (Variable.unique_name var) diff --git a/middle_end/ref_to_variables.mli b/middle_end/ref_to_variables.mli index 9cce0833f..107e4ae5e 100644 --- a/middle_end/ref_to_variables.mli +++ b/middle_end/ref_to_variables.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Transform [let]-bound references into variables. *) val eliminate_ref diff --git a/middle_end/remove_unused_arguments.ml b/middle_end/remove_unused_arguments.ml index 290b00a70..b32b5f61b 100644 --- a/middle_end/remove_unused_arguments.ml +++ b/middle_end/remove_unused_arguments.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let pass_name = "remove-unused-arguments" let () = Clflags.all_passes := pass_name :: !Clflags.all_passes diff --git a/middle_end/remove_unused_arguments.mli b/middle_end/remove_unused_arguments.mli index 80573d7d8..c35da0f78 100644 --- a/middle_end/remove_unused_arguments.mli +++ b/middle_end/remove_unused_arguments.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Introduce a stub function to avoid depending on unused arguments. For instance, it turns diff --git a/middle_end/remove_unused_closure_vars.ml b/middle_end/remove_unused_closure_vars.ml index e02cee1bb..26cad48d3 100644 --- a/middle_end/remove_unused_closure_vars.ml +++ b/middle_end/remove_unused_closure_vars.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** A variable in a closure can either be used by the closure itself or by an inlined version of the function. *) let remove_unused_closure_variables program = diff --git a/middle_end/remove_unused_closure_vars.mli b/middle_end/remove_unused_closure_vars.mli index 35b5984dc..bf361cee4 100644 --- a/middle_end/remove_unused_closure_vars.mli +++ b/middle_end/remove_unused_closure_vars.mli @@ -14,5 +14,7 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Eliminate variables bound by closures that are not required. *) val remove_unused_closure_variables : Flambda.program -> Flambda.program diff --git a/middle_end/remove_unused_program_constructs.ml b/middle_end/remove_unused_program_constructs.ml index ae7378a2c..93f982d8d 100644 --- a/middle_end/remove_unused_program_constructs.ml +++ b/middle_end/remove_unused_program_constructs.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + let dependency (expr:Flambda.t) = Flambda.free_symbols expr (* CR-soon pchambart: copied from lift_constant. Needs remerging *) diff --git a/middle_end/remove_unused_program_constructs.mli b/middle_end/remove_unused_program_constructs.mli index a639a0415..e736e5cd8 100644 --- a/middle_end/remove_unused_program_constructs.mli +++ b/middle_end/remove_unused_program_constructs.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* Remove unused [Flambda.program] constructs from the given program. - Symbols (whose defining expressions have no effects) are eliminated if unused. diff --git a/middle_end/semantics_of_primitives.ml b/middle_end/semantics_of_primitives.ml index f68c56725..13f506fb0 100644 --- a/middle_end/semantics_of_primitives.ml +++ b/middle_end/semantics_of_primitives.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + type effects = No_effects | Only_generative_effects | Arbitrary_effects type coeffects = No_coeffects | Has_coeffects diff --git a/middle_end/semantics_of_primitives.mli b/middle_end/semantics_of_primitives.mli index c2df0f0a6..5b092ff47 100644 --- a/middle_end/semantics_of_primitives.mli +++ b/middle_end/semantics_of_primitives.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Description of the semantics of primitives, to be used for optimization purposes. diff --git a/middle_end/share_constants.ml b/middle_end/share_constants.ml index 45f8bc794..245264c0a 100644 --- a/middle_end/share_constants.ml +++ b/middle_end/share_constants.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module Constant_defining_value = Flambda.Constant_defining_value let update_constant_for_sharing sharing_symbol_tbl const : Flambda.constant_defining_value = diff --git a/middle_end/share_constants.mli b/middle_end/share_constants.mli index 3881601e4..3dac5d374 100644 --- a/middle_end/share_constants.mli +++ b/middle_end/share_constants.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Share lifted constants that are eligible for sharing (e.g. not strings) and have equal definitions. *) diff --git a/middle_end/simple_value_approx.ml b/middle_end/simple_value_approx.ml index 13f49df30..b21c35bd5 100644 --- a/middle_end/simple_value_approx.ml +++ b/middle_end/simple_value_approx.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module U = Flambda_utils type 'a boxed_int = diff --git a/middle_end/simple_value_approx.mli b/middle_end/simple_value_approx.mli index f6b436d11..987151525 100644 --- a/middle_end/simple_value_approx.mli +++ b/middle_end/simple_value_approx.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Simple approximations to the runtime results of computations. This pass is designed for speed rather than accuracy; the performance is important since it is used heavily during inlining. *) diff --git a/middle_end/simplify_boxed_integer_ops.ml b/middle_end/simplify_boxed_integer_ops.ml index cdd6afb09..87f2ca472 100644 --- a/middle_end/simplify_boxed_integer_ops.ml +++ b/middle_end/simplify_boxed_integer_ops.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module S = Simplify_common (* Simplification of operations on boxed integers (nativeint, Int32, Int64). *) diff --git a/middle_end/simplify_boxed_integer_ops.mli b/middle_end/simplify_boxed_integer_ops.mli index 0a22da44b..1980495ce 100644 --- a/middle_end/simplify_boxed_integer_ops.mli +++ b/middle_end/simplify_boxed_integer_ops.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (* Simplification of operations on boxed integers (nativeint, Int32, Int64). *) module Simplify_boxed_nativeint : Simplify_boxed_integer_ops_intf.S diff --git a/middle_end/simplify_boxed_integer_ops_intf.mli b/middle_end/simplify_boxed_integer_ops_intf.mli index cd9d52e65..a9a742702 100644 --- a/middle_end/simplify_boxed_integer_ops_intf.mli +++ b/middle_end/simplify_boxed_integer_ops_intf.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module type S = sig type t diff --git a/middle_end/simplify_common.ml b/middle_end/simplify_common.ml index e87ebb1fd..1593c9ad9 100644 --- a/middle_end/simplify_common.ml +++ b/middle_end/simplify_common.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module C = Inlining_cost diff --git a/middle_end/simplify_common.mli b/middle_end/simplify_common.mli index 6f882c387..b0a8e26f3 100644 --- a/middle_end/simplify_common.mli +++ b/middle_end/simplify_common.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** [const_*_expr expr v annot], where the expression [expr] is known to evaluate to the value [v], attempt to produce a more simple expression together with its approximation and the benefit gained by replacing [expr] diff --git a/middle_end/simplify_primitives.ml b/middle_end/simplify_primitives.ml index 650f7a5e0..334cbb9c9 100644 --- a/middle_end/simplify_primitives.ml +++ b/middle_end/simplify_primitives.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module C = Inlining_cost module I = Simplify_boxed_integer_ops diff --git a/middle_end/simplify_primitives.mli b/middle_end/simplify_primitives.mli index e297e34af..f24d20ff1 100644 --- a/middle_end/simplify_primitives.mli +++ b/middle_end/simplify_primitives.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + (** Simplifies an application of a primitive based on approximation information. *) val primitive diff --git a/middle_end/unbox_closures.ml b/middle_end/unbox_closures.ml index 87f6f5105..39c494d17 100644 --- a/middle_end/unbox_closures.ml +++ b/middle_end/unbox_closures.ml @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + module A = Simple_value_approx module E = Inline_and_simplify_aux.Env diff --git a/middle_end/unbox_closures.mli b/middle_end/unbox_closures.mli index 0f39b563a..6277891c2 100644 --- a/middle_end/unbox_closures.mli +++ b/middle_end/unbox_closures.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +[@@@ocaml.warning "+a-4-9-30-40-41-42"] + val introduce_specialised_args_for_free_vars : backend:(module Backend_intf.S) -> Flambda.set_of_closures From f1f0a798f680b9a8f43f6f2852e2752e21151b65 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 22 Jan 2016 01:21:49 +0100 Subject: [PATCH 056/145] Add missing compilenv functions approx_for_global and approx_env are missing implementation --- asmcomp/compilenv.ml | 75 ++++++++++++++++++++++++++++++++++++++++++- asmcomp/compilenv.mli | 19 +++++++++++ 2 files changed, 93 insertions(+), 1 deletion(-) diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml index fd5fe5071..c8e643616 100644 --- a/asmcomp/compilenv.ml +++ b/asmcomp/compilenv.ml @@ -27,6 +27,10 @@ exception Error of error let global_infos_table = (Hashtbl.create 17 : (string, unit_infos option) Hashtbl.t) +let imported_sets_of_closures_table = + (Set_of_closures_id.Tbl.create 10 + : Flambda.function_declarations Set_of_closures_id.Tbl.t) + let sourcefile = ref None module CstMap = @@ -80,9 +84,21 @@ let symbolname_for_pack pack name = Buffer.add_string b name; Buffer.contents b +let concat_symbol unitname id = + unitname ^ "__" ^ id + +let make_symbol ?(unitname = current_unit.ui_symbol) idopt = + let prefix = "caml" ^ unitname in + match idopt with + | None -> prefix + | Some id -> concat_symbol prefix id + +let current_unit_linkage_name () = + Linkage_name.create (make_symbol ~unitname:current_unit.ui_symbol None) let reset ?packname ~source_provenance:file name = Hashtbl.clear global_infos_table; + Set_of_closures_id.Tbl.clear imported_sets_of_closures_table; let symbol = symbolname_for_pack packname name in sourcefile := Some file; current_unit.ui_name <- name; @@ -95,7 +111,13 @@ let reset ?packname ~source_provenance:file name = current_unit.ui_send_fun <- []; current_unit.ui_force_link <- false; Hashtbl.clear exported_constants; - structured_constants := structured_constants_empty + structured_constants := structured_constants_empty; + let compilation_unit = + Compilation_unit.create + (Ident.create_persistent name) + (current_unit_linkage_name ()) + in + Compilation_unit.set_current compilation_unit let current_unit_infos () = current_unit @@ -217,9 +239,33 @@ let symbol_for_global id = (* Register the approximation of the module being compiled *) +let unit_for_global id = + let sym_label = Linkage_name.create (symbol_for_global id) in + Compilation_unit.create id sym_label + +let predefined_exception_compilation_unit = + Compilation_unit.create (Ident.create_persistent "__dummy__") + (Linkage_name.create "__dummy__") + +let is_predefined_exception sym = + Compilation_unit.equal + predefined_exception_compilation_unit + (Symbol.compilation_unit sym) + +let symbol_for_global' id = + let sym_label = Linkage_name.create (symbol_for_global id) in + if Ident.is_predef_exn id then + Symbol.unsafe_create predefined_exception_compilation_unit sym_label + else + Symbol.unsafe_create (unit_for_global id) sym_label + let set_global_approx approx = current_unit.ui_approx <- approx +let approx_for_global _ = assert false + +let approx_env _ = assert false + (* Record that a currying function or application function is needed *) let need_curry_fun n = @@ -249,7 +295,16 @@ let save_unit_info filename = current_unit.ui_imports_cmi <- Env.imports(); write_unit_info current_unit filename +let current_unit_linkage_name () = + Linkage_name.create (make_symbol ~unitname:current_unit.ui_symbol None) +let current_unit () = + match Compilation_unit.get_current () with + | Some current_unit -> current_unit + | None -> Misc.fatal_error "Compilenv.current_unit" + +let current_unit_symbol () = + Symbol.unsafe_create (current_unit ()) (current_unit_linkage_name ()) let const_label = ref 0 @@ -302,6 +357,24 @@ let structured_constants () = }) (!structured_constants).strcst_all +let closure_symbol fv = + let compilation_unit = Closure_id.get_compilation_unit fv in + let unitname = + Linkage_name.to_string (Compilation_unit.get_linkage_name compilation_unit) + in + let linkage_name = + concat_symbol unitname ((Closure_id.unique_name fv) ^ "_closure") + in + Symbol.unsafe_create compilation_unit (Linkage_name.create linkage_name) + +let function_label fv = + let compilation_unit = Closure_id.get_compilation_unit fv in + let unitname = + Linkage_name.to_string + (Compilation_unit.get_linkage_name compilation_unit) + in + (concat_symbol unitname (Closure_id.unique_name fv)) + (* Error report *) open Format diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli index 0fd9dfac9..000758b66 100644 --- a/asmcomp/compilenv.mli +++ b/asmcomp/compilenv.mli @@ -14,6 +14,9 @@ open Cmx_format +val imported_sets_of_closures_table + : Flambda.function_declarations Set_of_closures_id.Tbl.t + val reset: ?packname:string -> source_provenance:Timings.source_provenance -> string -> unit (* Reset the environment and record the name of the unit being @@ -29,6 +32,10 @@ val current_build: unit -> Timings.source_provenance (* Return the kind of build source being compiled. If it is a file compilation it also provides the filename. *) +val current_unit: unit -> Compilation_unit.t + +val current_unit_symbol: unit -> Symbol.t + val make_symbol: ?unitname:string -> string option -> string (* [make_symbol ~unitname:u None] returns the asm symbol that corresponds to the compilation unit [u] (default: the current unit). @@ -40,8 +47,11 @@ val symbol_in_current_unit: string -> bool (* Return true if the given asm symbol belongs to the current compilation unit, false otherwise. *) +val is_predefined_exception: Symbol.t -> bool + val symbol_for_global: Ident.t -> string (* Return the asm symbol that refers to the given global identifier *) +val symbol_for_global': Ident.t -> Symbol.t val global_approx: Ident.t -> Clambda.value_approximation (* Return the approximation for the given global identifier *) @@ -50,6 +60,10 @@ val set_global_approx: Clambda.value_approximation -> unit val record_global_approx_toplevel: unit -> unit (* Record the current approximation for the current toplevel phrase *) +val approx_env: unit -> Export_info.t + (* Returns all the information loaded from extenal compilation units *) +val approx_for_global: Compilation_unit.t -> Export_info.t + (* Loads the exported information declaring the compilation_unit *) val need_curry_fun: int -> unit val need_apply_fun: int -> unit @@ -58,6 +72,11 @@ val need_send_fun: int -> unit message sending) function with the given arity *) val new_const_symbol : unit -> string +val closure_symbol : Closure_id.t -> Symbol.t + (* Symbol of a function if the function is + closed (statically allocated) *) +val function_label : Closure_id.t -> string + (* linkage name of the code of a function *) val new_const_label : unit -> int val new_structured_constant: From 1cf70d9e6ebe3ff099cbbaea82e3579c337158e4 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 22 Jan 2016 01:23:17 +0100 Subject: [PATCH 057/145] Remove unused globals field of Export_info.t --- asmcomp/build_export_info.ml | 8 +------- asmcomp/export_info.ml | 10 +--------- asmcomp/export_info.mli | 4 ---- asmcomp/export_info_for_pack.ml | 8 -------- 4 files changed, 2 insertions(+), 28 deletions(-) diff --git a/asmcomp/build_export_info.ml b/asmcomp/build_export_info.ml index d235ed4d1..716e30d63 100644 --- a/asmcomp/build_export_info.ml +++ b/asmcomp/build_export_info.ml @@ -496,12 +496,6 @@ let build_export_info ~(backend : (module Backend_intf.S)) let _global_symbol, env = describe_program (Env.Global.create_empty ()) program in - let globals = - let root_approx : Export_info.approx = - Value_symbol (Compilenv.current_unit_symbol ()) - in - Ident.Map.singleton (Compilenv.current_unit_id ()) root_approx - in let sets_of_closures = Flambda_utils.all_function_decls_indexed_by_set_of_closures_id program in @@ -542,7 +536,7 @@ let build_export_info ~(backend : (module Backend_intf.S)) let values = Export_info.nest_eid_map unnested_values in - Export_info.create ~values ~globals + Export_info.create ~values ~symbol_id:(Env.Global.symbol_to_export_id_map env) ~offset_fun:Closure_id.Map.empty ~offset_fv:Var_within_closure.Map.empty diff --git a/asmcomp/export_info.ml b/asmcomp/export_info.ml index f7df1daaf..10caf0ffd 100644 --- a/asmcomp/export_info.ml +++ b/asmcomp/export_info.ml @@ -135,7 +135,6 @@ type t = { sets_of_closures : Flambda.function_declarations Set_of_closures_id.Map.t; closures : Flambda.function_declarations Closure_id.Map.t; values : descr Export_id.Map.t Compilation_unit.Map.t; - globals : approx Ident.Map.t; symbol_id : Export_id.t Symbol.Map.t; offset_fun : int Closure_id.Map.t; offset_fv : int Var_within_closure.Map.t; @@ -147,7 +146,6 @@ let empty : t = { sets_of_closures = Set_of_closures_id.Map.empty; closures = Closure_id.Map.empty; values = Compilation_unit.Map.empty; - globals = Ident.Map.empty; symbol_id = Symbol.Map.empty; offset_fun = Closure_id.Map.empty; offset_fv = Var_within_closure.Map.empty; @@ -155,13 +153,12 @@ let empty : t = { invariant_params = Set_of_closures_id.Map.empty; } -let create ~sets_of_closures ~closures ~values ~globals ~symbol_id +let create ~sets_of_closures ~closures ~values ~symbol_id ~offset_fun ~offset_fv ~constant_sets_of_closures ~invariant_params = { sets_of_closures; closures; values; - globals; symbol_id; offset_fun; offset_fv; @@ -188,7 +185,6 @@ let merge (t1 : t) (t2 : t) : t = in let int_eq (i : int) j = i = j in { values = eidmap_disjoint_union ~eq:equal_descr t1.values t2.values; - globals = Ident.Map.disjoint_union t1.globals t2.globals; sets_of_closures = Set_of_closures_id.Map.disjoint_union t1.sets_of_closures t2.sets_of_closures; @@ -316,9 +312,6 @@ let print_approx ppf (t : t) = print_approx approx) bound_vars in - let print_approxs id approx = - fprintf ppf "%a -> %a;@ " Ident.print id print_approx approx - in let rec print_recorded_symbols () = if not (Queue.is_empty symbols_to_print) then begin let sym = Queue.pop symbols_to_print in @@ -333,7 +326,6 @@ let print_approx ppf (t : t) = end in fprintf ppf "@[Globals:@ "; - Ident.Map.iter print_approxs t.globals; fprintf ppf "@]@ @[Symbols:@ "; print_recorded_symbols (); fprintf ppf "@]" diff --git a/asmcomp/export_info.mli b/asmcomp/export_info.mli index 891a3cfbe..3909e9652 100644 --- a/asmcomp/export_info.mli +++ b/asmcomp/export_info.mli @@ -82,9 +82,6 @@ type t = private { (** Code of exported functions indexed by closure IDs. *) values : descr Export_id.Map.t Compilation_unit.Map.t; (** Structure of exported values. *) - globals : approx Ident.Map.t; - (** Global variables provided by the unit: usually only the top-level - module identifier, but packs may contain more than one. *) symbol_id : Export_id.t Symbol.Map.t; (** Associates symbols and values. *) offset_fun : int Closure_id.Map.t; @@ -106,7 +103,6 @@ val create : sets_of_closures:Flambda.function_declarations Set_of_closures_id.Map.t -> closures:Flambda.function_declarations Closure_id.Map.t -> values:descr Export_id.Map.t Compilation_unit.Map.t - -> globals:approx Ident.Map.t -> symbol_id:Export_id.t Symbol.Map.t -> offset_fun:int Closure_id.Map.t -> offset_fv:int Var_within_closure.Map.t diff --git a/asmcomp/export_info_for_pack.ml b/asmcomp/export_info_for_pack.ml index d51bd3ae5..3d62f84ee 100644 --- a/asmcomp/export_info_for_pack.ml +++ b/asmcomp/export_info_for_pack.ml @@ -117,7 +117,6 @@ let import_eidmap_for_pack units pack f map = let import_for_pack ~pack_units ~pack (exp : Export_info.t) = let import_sym = import_symbol_for_pack pack_units pack in let import_descr = import_descr_for_pack pack_units pack in - let import_approx = import_approx_for_pack pack_units pack in let import_eid = import_eid_for_pack pack_units pack in let import_eidmap f map = import_eidmap_for_pack pack_units pack f map in let sets_of_closures = @@ -125,15 +124,8 @@ let import_for_pack ~pack_units ~pack (exp : Export_info.t) = (import_function_declarations_for_pack pack_units pack) exp.sets_of_closures in - (* The only reachable global identifier of a pack is the pack itself. *) - let globals = - Ident.Map.filter (fun unit _ -> - Ident.same (Compilation_unit.get_persistent_ident pack) unit) - exp.globals - in Export_info.create ~sets_of_closures ~closures:(Flambda_utils.make_closure_map' sets_of_closures) - ~globals:(Ident.Map.map import_approx globals) ~offset_fun:exp.offset_fun ~offset_fv:exp.offset_fv ~values:(import_eidmap import_descr exp.values) From d07c0698d0747d9a3a3f7bb7c8a2f3fea7800e59 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 22 Jan 2016 01:23:47 +0100 Subject: [PATCH 058/145] Fix small divergences --- asmcomp/flambda_to_clambda.ml | 1 + middle_end/inline_and_simplify.ml | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/asmcomp/flambda_to_clambda.ml b/asmcomp/flambda_to_clambda.ml index 0e91d8e35..42945d948 100644 --- a/asmcomp/flambda_to_clambda.ml +++ b/asmcomp/flambda_to_clambda.ml @@ -662,6 +662,7 @@ let convert (program, exported) : result = List.map (fun (symbol, tag, fields) -> { Clambda. symbol = Linkage_name.to_string (Symbol.label symbol); + exported = true; tag = Tag.to_int tag; size = List.length fields; }) diff --git a/middle_end/inline_and_simplify.ml b/middle_end/inline_and_simplify.ml index 4ba6b9611..0e6e0f1c2 100644 --- a/middle_end/inline_and_simplify.ml +++ b/middle_end/inline_and_simplify.ml @@ -942,7 +942,7 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t = _block::_, block_approx::_ -> if A.is_definitely_immutable block_approx then begin Location.prerr_warning (Debuginfo.to_location dbg) - Warnings.Assignment_on_non_mutable_value + Warnings.Assignment_to_non_mutable_value end; tree, ret r (A.value_unknown Other) | (Psetfield _ | Parraysetu _ | Parraysets _), _, _ -> From 050c454765aa2721622ee1f187cf351a336dc0e8 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 22 Jan 2016 00:30:27 +0100 Subject: [PATCH 059/145] Add middle_end to Makefiles --- .depend | 894 ++++++++++++++++++++++++++++++++++++++++++--- .merlin | 6 + Makefile | 20 +- Makefile.nt | 23 +- Makefile.shared | 69 +++- asmrun/Makefile | 2 +- asmrun/Makefile.nt | 2 +- 7 files changed, 942 insertions(+), 74 deletions(-) diff --git a/.depend b/.depend index c755d77a4..0267f62bf 100644 --- a/.depend +++ b/.depend @@ -678,11 +678,13 @@ asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi asmcomp/asmpackager.cmi : typing/env.cmi asmcomp/branch_relaxation.cmi : asmcomp/linearize.cmi \ asmcomp/branch_relaxation_intf.cmo -asmcomp/build_export_info.cmi : asmcomp/export_info.cmi +asmcomp/build_export_info.cmi : middle_end/flambda.cmi \ + asmcomp/export_info.cmi middle_end/backend_intf.cmi asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi -asmcomp/closure_offsets.cmi : +asmcomp/closure_offsets.cmi : middle_end/base_types/var_within_closure.cmi \ + middle_end/flambda.cmi middle_end/base_types/closure_id.cmi asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \ asmcomp/clambda.cmi asmcomp/cmm.cmi : bytecomp/lambda.cmi typing/ident.cmi \ @@ -696,10 +698,20 @@ asmcomp/CSEgen.cmi : asmcomp/mach.cmi asmcomp/deadcode.cmi : asmcomp/mach.cmi asmcomp/emitaux.cmi : bytecomp/debuginfo.cmi asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi -asmcomp/export_info_for_pack.cmi : asmcomp/export_info.cmi -asmcomp/export_info.cmi : typing/ident.cmi -asmcomp/flambda_to_clambda.cmi : asmcomp/export_info.cmi asmcomp/clambda.cmi -asmcomp/import_approx.cmi : +asmcomp/export_info_for_pack.cmi : asmcomp/export_info.cmi \ + middle_end/base_types/compilation_unit.cmi +asmcomp/export_info.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/simple_value_approx.cmi \ + middle_end/base_types/set_of_closures_id.cmi typing/ident.cmi \ + middle_end/flambda.cmi middle_end/base_types/export_id.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi +asmcomp/flambda_to_clambda.cmi : middle_end/base_types/symbol.cmi \ + middle_end/flambda.cmi asmcomp/export_info.cmi asmcomp/clambda.cmi +asmcomp/import_approx.cmi : middle_end/base_types/symbol.cmi \ + middle_end/simple_value_approx.cmi asmcomp/interf.cmi : asmcomp/mach.cmi asmcomp/linearize.cmi : asmcomp/reg.cmi asmcomp/mach.cmi bytecomp/lambda.cmi \ bytecomp/debuginfo.cmi @@ -740,7 +752,7 @@ asmcomp/asmgen.cmo : bytecomp/translmod.cmi utils/timings.cmi \ asmcomp/emit.cmi asmcomp/deadcode.cmi utils/config.cmi \ asmcomp/compilenv.cmi asmcomp/comballoc.cmi asmcomp/coloring.cmi \ asmcomp/cmmgen.cmi asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi \ - asmcomp/CSE.cmo asmcomp/asmgen.cmi + asmcomp/clambda.cmi asmcomp/CSE.cmo asmcomp/asmgen.cmi asmcomp/asmgen.cmx : bytecomp/translmod.cmx utils/timings.cmx \ asmcomp/split.cmx asmcomp/spill.cmx asmcomp/selection.cmx \ asmcomp/scheduling.cmx asmcomp/reload.cmx asmcomp/reg.cmx \ @@ -751,7 +763,7 @@ asmcomp/asmgen.cmx : bytecomp/translmod.cmx utils/timings.cmx \ asmcomp/emit.cmx asmcomp/deadcode.cmx utils/config.cmx \ asmcomp/compilenv.cmx asmcomp/comballoc.cmx asmcomp/coloring.cmx \ asmcomp/cmmgen.cmx asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx \ - asmcomp/CSE.cmx asmcomp/asmgen.cmi + asmcomp/clambda.cmx asmcomp/CSE.cmx asmcomp/asmgen.cmi asmcomp/asmlibrarian.cmo : utils/misc.cmi parsing/location.cmi \ utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \ utils/clflags.cmi asmcomp/clambda.cmi utils/ccomp.cmi asmcomp/asmlink.cmi \ @@ -788,12 +800,26 @@ asmcomp/branch_relaxation.cmo : utils/misc.cmi asmcomp/mach.cmi \ asmcomp/branch_relaxation.cmx : utils/misc.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/branch_relaxation_intf.cmx \ asmcomp/branch_relaxation.cmi -asmcomp/build_export_info.cmo : utils/misc.cmi typing/ident.cmi \ - asmcomp/export_info.cmi asmcomp/compilenv.cmi utils/clflags.cmi \ - asmcomp/build_export_info.cmi -asmcomp/build_export_info.cmx : utils/misc.cmx typing/ident.cmx \ - asmcomp/export_info.cmx asmcomp/compilenv.cmx utils/clflags.cmx \ - asmcomp/build_export_info.cmi +asmcomp/build_export_info.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/misc.cmi \ + middle_end/invariant_params.cmi typing/ident.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda.cmi \ + asmcomp/export_info.cmi middle_end/base_types/export_id.cmi \ + asmcomp/compilenv.cmi middle_end/base_types/closure_id.cmi \ + utils/clflags.cmi middle_end/backend_intf.cmi \ + middle_end/allocated_const.cmi asmcomp/build_export_info.cmi +asmcomp/build_export_info.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/base_types/set_of_closures_id.cmx utils/misc.cmx \ + middle_end/invariant_params.cmx typing/ident.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda.cmx \ + asmcomp/export_info.cmx middle_end/base_types/export_id.cmx \ + asmcomp/compilenv.cmx middle_end/base_types/closure_id.cmx \ + utils/clflags.cmx middle_end/backend_intf.cmi \ + middle_end/allocated_const.cmx asmcomp/build_export_info.cmi asmcomp/clambda.cmo : bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/clambda.cmi asmcomp/clambda.cmx : bytecomp/lambda.cmx typing/ident.cmx \ @@ -810,20 +836,30 @@ asmcomp/closure.cmx : utils/warnings.cmx utils/tbl.cmx bytecomp/switch.cmx \ bytecomp/debuginfo.cmx asmcomp/compilenv.cmx utils/clflags.cmx \ asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \ asmcomp/closure.cmi -asmcomp/closure_offsets.cmo : utils/misc.cmi asmcomp/closure_offsets.cmi -asmcomp/closure_offsets.cmx : utils/misc.cmx asmcomp/closure_offsets.cmi +asmcomp/closure_offsets.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi utils/misc.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi middle_end/base_types/closure_id.cmi \ + asmcomp/closure_offsets.cmi +asmcomp/closure_offsets.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx utils/misc.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx middle_end/base_types/closure_id.cmx \ + asmcomp/closure_offsets.cmi asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi \ - asmcomp/strmatch.cmi asmcomp/proc.cmi typing/primitive.cmi utils/misc.cmi \ - bytecomp/lambda.cmi typing/ident.cmi bytecomp/debuginfo.cmi \ - utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \ - asmcomp/cmm.cmi utils/clflags.cmi asmcomp/clambda.cmi \ - parsing/asttypes.cmi asmcomp/arch.cmo asmcomp/cmmgen.cmi + asmcomp/strmatch.cmi asmcomp/proc.cmi bytecomp/printlambda.cmi \ + typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ + bytecomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ + asmcomp/cmx_format.cmi asmcomp/cmm.cmi utils/clflags.cmi \ + asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/arch.cmo \ + asmcomp/cmmgen.cmi asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx \ - asmcomp/strmatch.cmx asmcomp/proc.cmx typing/primitive.cmx utils/misc.cmx \ - bytecomp/lambda.cmx typing/ident.cmx bytecomp/debuginfo.cmx \ - utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ - asmcomp/cmm.cmx utils/clflags.cmx asmcomp/clambda.cmx \ - parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/cmmgen.cmi + asmcomp/strmatch.cmx asmcomp/proc.cmx bytecomp/printlambda.cmx \ + typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ + bytecomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ + asmcomp/cmx_format.cmi asmcomp/cmm.cmx utils/clflags.cmx \ + asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \ + asmcomp/cmmgen.cmi asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx \ @@ -868,24 +904,80 @@ asmcomp/emit.cmx : asmcomp/x86_proc.cmx asmcomp/x86_masm.cmx \ bytecomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/branch_relaxation.cmx \ asmcomp/arch.cmx asmcomp/emit.cmi -asmcomp/export_info_for_pack.cmo : utils/misc.cmi typing/ident.cmi \ - asmcomp/export_info.cmi asmcomp/export_info_for_pack.cmi -asmcomp/export_info_for_pack.cmx : utils/misc.cmx typing/ident.cmx \ - asmcomp/export_info.cmx asmcomp/export_info_for_pack.cmi -asmcomp/export_info.cmo : typing/ident.cmi asmcomp/export_info.cmi -asmcomp/export_info.cmx : typing/ident.cmx asmcomp/export_info.cmi -asmcomp/flambda_to_clambda.cmo : typing/primitive.cmi utils/numbers.cmi \ - utils/misc.cmi typing/ident.cmi asmcomp/export_info.cmi \ - bytecomp/debuginfo.cmi asmcomp/compilenv.cmi asmcomp/closure_offsets.cmi \ - utils/clflags.cmi asmcomp/clambda.cmi asmcomp/flambda_to_clambda.cmi -asmcomp/flambda_to_clambda.cmx : typing/primitive.cmx utils/numbers.cmx \ - utils/misc.cmx typing/ident.cmx asmcomp/export_info.cmx \ - bytecomp/debuginfo.cmx asmcomp/compilenv.cmx asmcomp/closure_offsets.cmx \ - utils/clflags.cmx asmcomp/clambda.cmx asmcomp/flambda_to_clambda.cmi -asmcomp/import_approx.cmo : utils/misc.cmi asmcomp/export_info.cmi \ - asmcomp/compilenv.cmi asmcomp/import_approx.cmi -asmcomp/import_approx.cmx : utils/misc.cmx asmcomp/export_info.cmx \ - asmcomp/compilenv.cmx asmcomp/import_approx.cmi +asmcomp/export_info_for_pack.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/misc.cmi \ + typing/ident.cmi middle_end/flambda_utils.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ + asmcomp/export_info.cmi middle_end/base_types/export_id.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi asmcomp/export_info_for_pack.cmi +asmcomp/export_info_for_pack.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/set_of_closures_id.cmx utils/misc.cmx \ + typing/ident.cmx middle_end/flambda_utils.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ + asmcomp/export_info.cmx middle_end/base_types/export_id.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx asmcomp/export_info_for_pack.cmi +asmcomp/export_info.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/simple_value_approx.cmi \ + middle_end/base_types/set_of_closures_id.cmi typing/ident.cmi \ + middle_end/flambda.cmi middle_end/base_types/export_id.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi asmcomp/export_info.cmi +asmcomp/export_info.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/simple_value_approx.cmx \ + middle_end/base_types/set_of_closures_id.cmx typing/ident.cmx \ + middle_end/flambda.cmx middle_end/base_types/export_id.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx asmcomp/export_info.cmi +asmcomp/flambda_to_clambda.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi typing/primitive.cmi \ + utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ + utils/misc.cmi middle_end/base_types/linkage_name.cmi typing/ident.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda.cmi \ + asmcomp/export_info.cmi bytecomp/debuginfo.cmi asmcomp/compilenv.cmi \ + asmcomp/closure_offsets.cmi middle_end/base_types/closure_id.cmi \ + utils/clflags.cmi asmcomp/clambda.cmi middle_end/allocated_const.cmi \ + asmcomp/flambda_to_clambda.cmi +asmcomp/flambda_to_clambda.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/base_types/set_of_closures_id.cmx typing/primitive.cmx \ + utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ + utils/misc.cmx middle_end/base_types/linkage_name.cmx typing/ident.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda.cmx \ + asmcomp/export_info.cmx bytecomp/debuginfo.cmx asmcomp/compilenv.cmx \ + asmcomp/closure_offsets.cmx middle_end/base_types/closure_id.cmx \ + utils/clflags.cmx asmcomp/clambda.cmx middle_end/allocated_const.cmx \ + asmcomp/flambda_to_clambda.cmi +asmcomp/import_approx.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/symbol.cmi middle_end/simple_value_approx.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/misc.cmi \ + middle_end/freshening.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi asmcomp/export_info.cmi \ + middle_end/base_types/export_id.cmi asmcomp/compilenv.cmi \ + middle_end/base_types/closure_id.cmi asmcomp/import_approx.cmi +asmcomp/import_approx.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/symbol.cmx middle_end/simple_value_approx.cmx \ + middle_end/base_types/set_of_closures_id.cmx utils/misc.cmx \ + middle_end/freshening.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx asmcomp/export_info.cmx \ + middle_end/base_types/export_id.cmx asmcomp/compilenv.cmx \ + middle_end/base_types/closure_id.cmx asmcomp/import_approx.cmi asmcomp/interf.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/interf.cmi asmcomp/interf.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ @@ -980,14 +1072,16 @@ asmcomp/strmatch.cmo : bytecomp/lambda.cmi typing/ident.cmi asmcomp/cmm.cmi \ asmcomp/arch.cmo asmcomp/strmatch.cmi asmcomp/strmatch.cmx : bytecomp/lambda.cmx typing/ident.cmx asmcomp/cmm.cmx \ asmcomp/arch.cmx asmcomp/strmatch.cmi -asmcomp/un_anf.cmo : asmcomp/printclambda.cmi utils/misc.cmi \ - bytecomp/lambda.cmi typing/ident.cmi bytecomp/debuginfo.cmi \ - utils/config.cmi utils/clflags.cmi asmcomp/clambda.cmi \ - parsing/asttypes.cmi asmcomp/un_anf.cmi -asmcomp/un_anf.cmx : asmcomp/printclambda.cmx utils/misc.cmx \ - bytecomp/lambda.cmx typing/ident.cmx bytecomp/debuginfo.cmx \ - utils/config.cmx utils/clflags.cmx asmcomp/clambda.cmx \ - parsing/asttypes.cmi asmcomp/un_anf.cmi +asmcomp/un_anf.cmo : middle_end/semantics_of_primitives.cmi \ + asmcomp/printclambda.cmi utils/misc.cmi bytecomp/lambda.cmi \ + typing/ident.cmi bytecomp/debuginfo.cmi utils/config.cmi \ + utils/clflags.cmi asmcomp/clambda.cmi parsing/asttypes.cmi \ + asmcomp/un_anf.cmi +asmcomp/un_anf.cmx : middle_end/semantics_of_primitives.cmx \ + asmcomp/printclambda.cmx utils/misc.cmx bytecomp/lambda.cmx \ + typing/ident.cmx bytecomp/debuginfo.cmx utils/config.cmx \ + utils/clflags.cmx asmcomp/clambda.cmx parsing/asttypes.cmi \ + asmcomp/un_anf.cmi asmcomp/x86_dsl.cmo : asmcomp/x86_proc.cmi asmcomp/x86_ast.cmi \ asmcomp/x86_dsl.cmi asmcomp/x86_dsl.cmx : asmcomp/x86_proc.cmx asmcomp/x86_ast.cmi \ @@ -1004,6 +1098,702 @@ asmcomp/x86_proc.cmo : asmcomp/x86_ast.cmi utils/config.cmi \ utils/clflags.cmi utils/ccomp.cmi asmcomp/x86_proc.cmi asmcomp/x86_proc.cmx : asmcomp/x86_ast.cmi utils/config.cmx \ utils/clflags.cmx utils/ccomp.cmx asmcomp/x86_proc.cmi +middle_end/alias_analysis.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + bytecomp/lambda.cmi middle_end/flambda.cmi parsing/asttypes.cmi \ + middle_end/allocated_const.cmi +middle_end/allocated_const.cmi : +middle_end/augment_closures.cmi : middle_end/inline_and_simplify_aux.cmi \ + middle_end/flambda.cmi +middle_end/backend_intf.cmi : middle_end/base_types/symbol.cmi \ + middle_end/simple_value_approx.cmi typing/ident.cmi \ + middle_end/base_types/closure_id.cmi +middle_end/closure_conversion_aux.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/mutable_variable.cmi bytecomp/lambda.cmi \ + typing/ident.cmi +middle_end/closure_conversion.cmi : bytecomp/lambda.cmi typing/ident.cmi \ + middle_end/flambda.cmi middle_end/backend_intf.cmi +middle_end/effect_analysis.cmi : middle_end/flambda.cmi +middle_end/find_recursive_functions.cmi : middle_end/base_types/variable.cmi \ + middle_end/flambda.cmi middle_end/backend_intf.cmi +middle_end/flambda_invariants.cmi : middle_end/flambda.cmi +middle_end/flambda_iterators.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi middle_end/flambda.cmi +middle_end/flambda.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/numbers.cmi \ + middle_end/base_types/mutable_variable.cmi bytecomp/lambda.cmi \ + utils/identifiable.cmi bytecomp/debuginfo.cmi \ + middle_end/base_types/closure_id.cmi parsing/asttypes.cmi \ + middle_end/allocated_const.cmi +middle_end/flambda_utils.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + bytecomp/switch.cmi middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi middle_end/flambda.cmi \ + middle_end/base_types/closure_id.cmi middle_end/backend_intf.cmi +middle_end/freshening.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/mutable_variable.cmi middle_end/flambda.cmi \ + middle_end/base_types/closure_id.cmi +middle_end/inconstant_idents.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/set_of_closures_id.cmi middle_end/flambda.cmi \ + middle_end/base_types/compilation_unit.cmi middle_end/backend_intf.cmi +middle_end/initialize_symbol_to_let_symbol.cmi : middle_end/flambda.cmi +middle_end/inline_and_simplify_aux.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/simple_value_approx.cmi \ + middle_end/base_types/set_of_closures_id.cmi \ + middle_end/base_types/mutable_variable.cmi \ + middle_end/inlining_stats_types.cmi middle_end/inlining_cost.cmi \ + middle_end/freshening.cmi bytecomp/debuginfo.cmi \ + middle_end/base_types/closure_id.cmi middle_end/backend_intf.cmi +middle_end/inline_and_simplify.cmi : middle_end/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/inlining_cost.cmi : middle_end/flambda.cmi +middle_end/inlining_decision_intf.cmi : middle_end/base_types/variable.cmi \ + middle_end/simple_value_approx.cmi middle_end/inline_and_simplify_aux.cmi \ + middle_end/flambda.cmi bytecomp/debuginfo.cmi \ + middle_end/base_types/closure_id.cmi +middle_end/inlining_decision.cmi : middle_end/base_types/variable.cmi \ + middle_end/simple_value_approx.cmi bytecomp/lambda.cmi \ + middle_end/inlining_decision_intf.cmi \ + middle_end/inline_and_simplify_aux.cmi middle_end/flambda.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi +middle_end/inlining_stats.cmi : middle_end/inlining_stats_types.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi +middle_end/inlining_stats_types.cmi : middle_end/inlining_cost.cmi +middle_end/inlining_transforms.cmi : middle_end/base_types/variable.cmi \ + middle_end/simple_value_approx.cmi bytecomp/lambda.cmi \ + middle_end/inlining_decision_intf.cmi \ + middle_end/inline_and_simplify_aux.cmi middle_end/flambda.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi +middle_end/invariant_params.cmi : middle_end/base_types/variable.cmi \ + middle_end/flambda.cmi middle_end/backend_intf.cmi +middle_end/lift_code.cmi : middle_end/base_types/variable.cmi \ + middle_end/flambda.cmi +middle_end/lift_constants.cmi : middle_end/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/lift_let_to_initialize_symbol.cmi : middle_end/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/middle_end.cmi : utils/timings.cmi bytecomp/lambda.cmi \ + typing/ident.cmi middle_end/flambda.cmi middle_end/backend_intf.cmi +middle_end/ref_to_variables.cmi : middle_end/flambda.cmi +middle_end/remove_unused_arguments.cmi : middle_end/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/remove_unused_closure_vars.cmi : middle_end/flambda.cmi +middle_end/remove_unused_program_constructs.cmi : middle_end/flambda.cmi +middle_end/semantics_of_primitives.cmi : bytecomp/lambda.cmi +middle_end/share_constants.cmi : middle_end/flambda.cmi +middle_end/simple_value_approx.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/freshening.cmi middle_end/flambda.cmi \ + middle_end/base_types/export_id.cmi middle_end/base_types/closure_id.cmi +middle_end/simplify_boxed_integer_ops_intf.cmi : \ + middle_end/simple_value_approx.cmi bytecomp/lambda.cmi \ + middle_end/inlining_cost.cmi middle_end/flambda.cmi +middle_end/simplify_boxed_integer_ops.cmi : \ + middle_end/simplify_boxed_integer_ops_intf.cmi +middle_end/simplify_common.cmi : middle_end/simple_value_approx.cmi \ + bytecomp/lambda.cmi middle_end/inlining_cost.cmi middle_end/flambda.cmi +middle_end/simplify_primitives.cmi : middle_end/base_types/variable.cmi \ + middle_end/simple_value_approx.cmi bytecomp/lambda.cmi \ + middle_end/inlining_cost.cmi middle_end/flambda.cmi \ + bytecomp/debuginfo.cmi +middle_end/unbox_closures.cmi : middle_end/base_types/variable.cmi \ + middle_end/flambda.cmi middle_end/backend_intf.cmi +middle_end/alias_analysis.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + utils/misc.cmi bytecomp/lambda.cmi middle_end/flambda.cmi \ + parsing/asttypes.cmi middle_end/allocated_const.cmi \ + middle_end/alias_analysis.cmi +middle_end/alias_analysis.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + utils/misc.cmx bytecomp/lambda.cmx middle_end/flambda.cmx \ + parsing/asttypes.cmi middle_end/allocated_const.cmx \ + middle_end/alias_analysis.cmi +middle_end/allocated_const.cmo : middle_end/allocated_const.cmi +middle_end/allocated_const.cmx : middle_end/allocated_const.cmi +middle_end/augment_closures.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/simple_value_approx.cmi utils/numbers.cmi \ + middle_end/inline_and_simplify_aux.cmi utils/identifiable.cmi \ + middle_end/freshening.cmi middle_end/flambda_utils.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi \ + utils/clflags.cmi middle_end/augment_closures.cmi +middle_end/augment_closures.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/simple_value_approx.cmx utils/numbers.cmx \ + middle_end/inline_and_simplify_aux.cmx utils/identifiable.cmx \ + middle_end/freshening.cmx middle_end/flambda_utils.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ + bytecomp/debuginfo.cmx middle_end/base_types/closure_id.cmx \ + utils/clflags.cmx middle_end/augment_closures.cmi +middle_end/closure_conversion_aux.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi typing/primitive.cmi \ + utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ + utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ + middle_end/closure_conversion_aux.cmi +middle_end/closure_conversion_aux.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx typing/primitive.cmx \ + utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ + utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ + middle_end/closure_conversion_aux.cmi +middle_end/closure_conversion.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi bytecomp/simplif.cmi \ + middle_end/base_types/set_of_closures_id.cmi bytecomp/printlambda.cmi \ + typing/primitive.cmi typing/predef.cmi utils/numbers.cmi \ + middle_end/base_types/mutable_variable.cmi utils/misc.cmi \ + parsing/location.cmi middle_end/base_types/linkage_name.cmi \ + middle_end/lift_code.cmi bytecomp/lambda.cmi typing/ident.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi \ + middle_end/closure_conversion_aux.cmi utils/clflags.cmi \ + middle_end/backend_intf.cmi parsing/asttypes.cmi \ + middle_end/closure_conversion.cmi +middle_end/closure_conversion.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx bytecomp/simplif.cmx \ + middle_end/base_types/set_of_closures_id.cmx bytecomp/printlambda.cmx \ + typing/primitive.cmx typing/predef.cmx utils/numbers.cmx \ + middle_end/base_types/mutable_variable.cmx utils/misc.cmx \ + parsing/location.cmx middle_end/base_types/linkage_name.cmx \ + middle_end/lift_code.cmx bytecomp/lambda.cmx typing/ident.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda.cmx \ + bytecomp/debuginfo.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx \ + middle_end/closure_conversion_aux.cmx utils/clflags.cmx \ + middle_end/backend_intf.cmi parsing/asttypes.cmi \ + middle_end/closure_conversion.cmi +middle_end/effect_analysis.cmo : middle_end/semantics_of_primitives.cmi \ + utils/misc.cmi bytecomp/lambda.cmi middle_end/flambda.cmi \ + middle_end/effect_analysis.cmi +middle_end/effect_analysis.cmx : middle_end/semantics_of_primitives.cmx \ + utils/misc.cmx bytecomp/lambda.cmx middle_end/flambda.cmx \ + middle_end/effect_analysis.cmi +middle_end/find_recursive_functions.cmo : middle_end/base_types/variable.cmi \ + utils/strongly_connected_components.cmi middle_end/flambda_utils.cmi \ + middle_end/flambda.cmi middle_end/find_recursive_functions.cmi +middle_end/find_recursive_functions.cmx : middle_end/base_types/variable.cmx \ + utils/strongly_connected_components.cmx middle_end/flambda_utils.cmx \ + middle_end/flambda.cmx middle_end/find_recursive_functions.cmi +middle_end/flambda_invariants.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi bytecomp/printlambda.cmi \ + utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ + utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi parsing/asttypes.cmi \ + middle_end/allocated_const.cmi middle_end/flambda_invariants.cmi +middle_end/flambda_invariants.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/base_types/set_of_closures_id.cmx bytecomp/printlambda.cmx \ + utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ + utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ + bytecomp/debuginfo.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx parsing/asttypes.cmi \ + middle_end/allocated_const.cmx middle_end/flambda_invariants.cmi +middle_end/flambda_iterators.cmo : middle_end/base_types/variable.cmi \ + utils/misc.cmi middle_end/flambda.cmi middle_end/flambda_iterators.cmi +middle_end/flambda_iterators.cmx : middle_end/base_types/variable.cmx \ + utils/misc.cmx middle_end/flambda.cmx middle_end/flambda_iterators.cmi +middle_end/flambda.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi bytecomp/printlambda.cmi \ + utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ + utils/misc.cmi bytecomp/lambda.cmi utils/identifiable.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi utils/clflags.cmi \ + parsing/asttypes.cmi middle_end/allocated_const.cmi \ + middle_end/flambda.cmi +middle_end/flambda.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/base_types/set_of_closures_id.cmx bytecomp/printlambda.cmx \ + utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ + utils/misc.cmx bytecomp/lambda.cmx utils/identifiable.cmx \ + bytecomp/debuginfo.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx utils/clflags.cmx \ + parsing/asttypes.cmi middle_end/allocated_const.cmx \ + middle_end/flambda.cmi +middle_end/flambda_utils.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/symbol.cmi bytecomp/switch.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi \ + middle_end/base_types/mutable_variable.cmi utils/misc.cmi \ + middle_end/base_types/linkage_name.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi bytecomp/debuginfo.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi middle_end/backend_intf.cmi \ + middle_end/allocated_const.cmi middle_end/flambda_utils.cmi +middle_end/flambda_utils.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/symbol.cmx bytecomp/switch.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/base_types/set_of_closures_id.cmx \ + middle_end/base_types/mutable_variable.cmx utils/misc.cmx \ + middle_end/base_types/linkage_name.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx bytecomp/debuginfo.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx middle_end/backend_intf.cmi \ + middle_end/allocated_const.cmx middle_end/flambda_utils.cmi +middle_end/freshening.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi \ + middle_end/base_types/mutable_variable.cmi utils/misc.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi middle_end/freshening.cmi +middle_end/freshening.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/base_types/set_of_closures_id.cmx \ + middle_end/base_types/mutable_variable.cmx utils/misc.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx middle_end/freshening.cmi +middle_end/inconstant_idents.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/numbers.cmi \ + utils/misc.cmi bytecomp/lambda.cmi utils/identifiable.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi middle_end/backend_intf.cmi \ + parsing/asttypes.cmi middle_end/inconstant_idents.cmi +middle_end/inconstant_idents.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/set_of_closures_id.cmx utils/numbers.cmx \ + utils/misc.cmx bytecomp/lambda.cmx utils/identifiable.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx middle_end/backend_intf.cmi \ + parsing/asttypes.cmi middle_end/inconstant_idents.cmi +middle_end/initialize_symbol_to_let_symbol.cmo : \ + middle_end/base_types/variable.cmi utils/misc.cmi middle_end/flambda.cmi \ + middle_end/initialize_symbol_to_let_symbol.cmi +middle_end/initialize_symbol_to_let_symbol.cmx : \ + middle_end/base_types/variable.cmx utils/misc.cmx middle_end/flambda.cmx \ + middle_end/initialize_symbol_to_let_symbol.cmi +middle_end/inline_and_simplify_aux.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/simple_value_approx.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/numbers.cmi \ + middle_end/base_types/mutable_variable.cmi utils/misc.cmi \ + middle_end/inlining_stats.cmi middle_end/inlining_cost.cmi \ + middle_end/freshening.cmi middle_end/base_types/compilation_unit.cmi \ + utils/clflags.cmi middle_end/backend_intf.cmi \ + middle_end/inline_and_simplify_aux.cmi +middle_end/inline_and_simplify_aux.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/simple_value_approx.cmx \ + middle_end/base_types/set_of_closures_id.cmx utils/numbers.cmx \ + middle_end/base_types/mutable_variable.cmx utils/misc.cmx \ + middle_end/inlining_stats.cmx middle_end/inlining_cost.cmx \ + middle_end/freshening.cmx middle_end/base_types/compilation_unit.cmx \ + utils/clflags.cmx middle_end/backend_intf.cmi \ + middle_end/inline_and_simplify_aux.cmi +middle_end/inline_and_simplify.cmo : utils/warnings.cmi \ + middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/unbox_closures.cmi middle_end/base_types/tag.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/simplify_primitives.cmi middle_end/simple_value_approx.cmi \ + middle_end/remove_unused_arguments.cmi typing/predef.cmi utils/misc.cmi \ + parsing/location.cmi bytecomp/lambda.cmi middle_end/invariant_params.cmi \ + middle_end/inlining_stats.cmi middle_end/inlining_decision.cmi \ + middle_end/inlining_cost.cmi middle_end/inline_and_simplify_aux.cmi \ + typing/ident.cmi middle_end/freshening.cmi middle_end/flambda_utils.cmi \ + middle_end/flambda.cmi middle_end/effect_analysis.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi \ + utils/clflags.cmi middle_end/backend_intf.cmi \ + middle_end/augment_closures.cmi middle_end/allocated_const.cmi \ + middle_end/inline_and_simplify.cmi +middle_end/inline_and_simplify.cmx : utils/warnings.cmx \ + middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/unbox_closures.cmx middle_end/base_types/tag.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/simplify_primitives.cmx middle_end/simple_value_approx.cmx \ + middle_end/remove_unused_arguments.cmx typing/predef.cmx utils/misc.cmx \ + parsing/location.cmx bytecomp/lambda.cmx middle_end/invariant_params.cmx \ + middle_end/inlining_stats.cmx middle_end/inlining_decision.cmx \ + middle_end/inlining_cost.cmx middle_end/inline_and_simplify_aux.cmx \ + typing/ident.cmx middle_end/freshening.cmx middle_end/flambda_utils.cmx \ + middle_end/flambda.cmx middle_end/effect_analysis.cmx \ + bytecomp/debuginfo.cmx middle_end/base_types/closure_id.cmx \ + utils/clflags.cmx middle_end/backend_intf.cmi \ + middle_end/augment_closures.cmx middle_end/allocated_const.cmx \ + middle_end/inline_and_simplify.cmi +middle_end/inlining_cost.cmo : middle_end/base_types/variable.cmi \ + typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi utils/clflags.cmi \ + middle_end/inlining_cost.cmi +middle_end/inlining_cost.cmx : middle_end/base_types/variable.cmx \ + typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx utils/clflags.cmx \ + middle_end/inlining_cost.cmi +middle_end/inlining_decision.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/simple_value_approx.cmi utils/misc.cmi \ + middle_end/lift_code.cmi bytecomp/lambda.cmi \ + middle_end/inlining_transforms.cmi middle_end/inlining_stats_types.cmi \ + middle_end/inlining_cost.cmi middle_end/inline_and_simplify_aux.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda.cmi \ + middle_end/find_recursive_functions.cmi utils/clflags.cmi \ + middle_end/inlining_decision.cmi +middle_end/inlining_decision.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/simple_value_approx.cmx utils/misc.cmx \ + middle_end/lift_code.cmx bytecomp/lambda.cmx \ + middle_end/inlining_transforms.cmx middle_end/inlining_stats_types.cmx \ + middle_end/inlining_cost.cmx middle_end/inline_and_simplify_aux.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda.cmx \ + middle_end/find_recursive_functions.cmx utils/clflags.cmx \ + middle_end/inlining_decision.cmi +middle_end/inlining_stats.cmo : utils/misc.cmi \ + middle_end/inlining_stats_types.cmi bytecomp/debuginfo.cmi \ + middle_end/base_types/closure_id.cmi utils/clflags.cmi \ + middle_end/inlining_stats.cmi +middle_end/inlining_stats.cmx : utils/misc.cmx \ + middle_end/inlining_stats_types.cmx bytecomp/debuginfo.cmx \ + middle_end/base_types/closure_id.cmx utils/clflags.cmx \ + middle_end/inlining_stats.cmi +middle_end/inlining_stats_types.cmo : middle_end/inlining_cost.cmi \ + middle_end/inlining_stats_types.cmi +middle_end/inlining_stats_types.cmx : middle_end/inlining_cost.cmx \ + middle_end/inlining_stats_types.cmi +middle_end/inlining_transforms.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/simple_value_approx.cmi utils/misc.cmi bytecomp/lambda.cmi \ + middle_end/inlining_cost.cmi middle_end/inline_and_simplify_aux.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi middle_end/inlining_transforms.cmi +middle_end/inlining_transforms.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/simple_value_approx.cmx utils/misc.cmx bytecomp/lambda.cmx \ + middle_end/inlining_cost.cmx middle_end/inline_and_simplify_aux.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx middle_end/inlining_transforms.cmi +middle_end/invariant_params.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi utils/misc.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi middle_end/base_types/closure_id.cmi \ + utils/clflags.cmi middle_end/backend_intf.cmi \ + middle_end/invariant_params.cmi +middle_end/invariant_params.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/symbol.cmx utils/misc.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx middle_end/base_types/closure_id.cmx \ + utils/clflags.cmx middle_end/backend_intf.cmi \ + middle_end/invariant_params.cmi +middle_end/lift_code.cmo : middle_end/base_types/variable.cmi \ + utils/strongly_connected_components.cmi \ + middle_end/simple_value_approx.cmi middle_end/inlining_cost.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ + middle_end/base_types/compilation_unit.cmi middle_end/lift_code.cmi +middle_end/lift_code.cmx : middle_end/base_types/variable.cmx \ + utils/strongly_connected_components.cmx \ + middle_end/simple_value_approx.cmx middle_end/inlining_cost.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ + middle_end/base_types/compilation_unit.cmx middle_end/lift_code.cmi +middle_end/lift_constants.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + utils/strongly_connected_components.cmi \ + middle_end/simple_value_approx.cmi utils/misc.cmi \ + middle_end/base_types/linkage_name.cmi middle_end/inconstant_idents.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi middle_end/backend_intf.cmi \ + middle_end/allocated_const.cmi middle_end/alias_analysis.cmi \ + middle_end/lift_constants.cmi +middle_end/lift_constants.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + utils/strongly_connected_components.cmx \ + middle_end/simple_value_approx.cmx utils/misc.cmx \ + middle_end/base_types/linkage_name.cmx middle_end/inconstant_idents.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx middle_end/backend_intf.cmi \ + middle_end/allocated_const.cmx middle_end/alias_analysis.cmx \ + middle_end/lift_constants.cmi +middle_end/lift_let_to_initialize_symbol.cmo : \ + middle_end/base_types/variable.cmi middle_end/base_types/tag.cmi \ + middle_end/base_types/symbol.cmi middle_end/flambda_utils.cmi \ + middle_end/flambda.cmi bytecomp/debuginfo.cmi parsing/asttypes.cmi \ + middle_end/lift_let_to_initialize_symbol.cmi +middle_end/lift_let_to_initialize_symbol.cmx : \ + middle_end/base_types/variable.cmx middle_end/base_types/tag.cmx \ + middle_end/base_types/symbol.cmx middle_end/flambda_utils.cmx \ + middle_end/flambda.cmx bytecomp/debuginfo.cmx parsing/asttypes.cmi \ + middle_end/lift_let_to_initialize_symbol.cmi +middle_end/middle_end.cmo : utils/warnings.cmi \ + middle_end/base_types/variable.cmi utils/timings.cmi \ + middle_end/base_types/symbol.cmi middle_end/share_constants.cmi \ + middle_end/remove_unused_program_constructs.cmi \ + middle_end/remove_unused_closure_vars.cmi middle_end/ref_to_variables.cmi \ + utils/misc.cmi parsing/location.cmi \ + middle_end/lift_let_to_initialize_symbol.cmi \ + middle_end/lift_constants.cmi middle_end/lift_code.cmi \ + middle_end/inlining_cost.cmi middle_end/inline_and_simplify.cmi \ + middle_end/initialize_symbol_to_let_symbol.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda_invariants.cmi \ + middle_end/flambda.cmi bytecomp/debuginfo.cmi \ + middle_end/base_types/closure_id.cmi middle_end/closure_conversion.cmi \ + utils/clflags.cmi middle_end/backend_intf.cmi middle_end/middle_end.cmi +middle_end/middle_end.cmx : utils/warnings.cmx \ + middle_end/base_types/variable.cmx utils/timings.cmx \ + middle_end/base_types/symbol.cmx middle_end/share_constants.cmx \ + middle_end/remove_unused_program_constructs.cmx \ + middle_end/remove_unused_closure_vars.cmx middle_end/ref_to_variables.cmx \ + utils/misc.cmx parsing/location.cmx \ + middle_end/lift_let_to_initialize_symbol.cmx \ + middle_end/lift_constants.cmx middle_end/lift_code.cmx \ + middle_end/inlining_cost.cmx middle_end/inline_and_simplify.cmx \ + middle_end/initialize_symbol_to_let_symbol.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda_invariants.cmx \ + middle_end/flambda.cmx bytecomp/debuginfo.cmx \ + middle_end/base_types/closure_id.cmx middle_end/closure_conversion.cmx \ + utils/clflags.cmx middle_end/backend_intf.cmi middle_end/middle_end.cmi +middle_end/ref_to_variables.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/mutable_variable.cmi utils/misc.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ + parsing/asttypes.cmi middle_end/ref_to_variables.cmi +middle_end/ref_to_variables.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/mutable_variable.cmx utils/misc.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ + parsing/asttypes.cmi middle_end/ref_to_variables.cmi +middle_end/remove_unused_arguments.cmo : middle_end/base_types/variable.cmi \ + middle_end/invariant_params.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi middle_end/find_recursive_functions.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi utils/clflags.cmi \ + middle_end/remove_unused_arguments.cmi +middle_end/remove_unused_arguments.cmx : middle_end/base_types/variable.cmx \ + middle_end/invariant_params.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx middle_end/find_recursive_functions.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx utils/clflags.cmx \ + middle_end/remove_unused_arguments.cmi +middle_end/remove_unused_closure_vars.cmo : \ + middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ + middle_end/base_types/closure_id.cmi \ + middle_end/remove_unused_closure_vars.cmi +middle_end/remove_unused_closure_vars.cmx : \ + middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ + middle_end/base_types/closure_id.cmx \ + middle_end/remove_unused_closure_vars.cmi +middle_end/remove_unused_program_constructs.cmo : \ + middle_end/base_types/symbol.cmi utils/misc.cmi middle_end/flambda.cmi \ + middle_end/effect_analysis.cmi \ + middle_end/remove_unused_program_constructs.cmi +middle_end/remove_unused_program_constructs.cmx : \ + middle_end/base_types/symbol.cmx utils/misc.cmx middle_end/flambda.cmx \ + middle_end/effect_analysis.cmx \ + middle_end/remove_unused_program_constructs.cmi +middle_end/semantics_of_primitives.cmo : bytecomp/printlambda.cmi \ + utils/misc.cmi bytecomp/lambda.cmi middle_end/semantics_of_primitives.cmi +middle_end/semantics_of_primitives.cmx : bytecomp/printlambda.cmx \ + utils/misc.cmx bytecomp/lambda.cmx middle_end/semantics_of_primitives.cmi +middle_end/share_constants.cmo : middle_end/base_types/symbol.cmi \ + middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ + middle_end/share_constants.cmi +middle_end/share_constants.cmx : middle_end/base_types/symbol.cmx \ + middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ + middle_end/share_constants.cmi +middle_end/simple_value_approx.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + utils/misc.cmi middle_end/inlining_cost.cmi middle_end/freshening.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda.cmi \ + middle_end/base_types/export_id.cmi middle_end/effect_analysis.cmi \ + middle_end/base_types/closure_id.cmi middle_end/allocated_const.cmi \ + middle_end/simple_value_approx.cmi +middle_end/simple_value_approx.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + utils/misc.cmx middle_end/inlining_cost.cmx middle_end/freshening.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda.cmx \ + middle_end/base_types/export_id.cmx middle_end/effect_analysis.cmx \ + middle_end/base_types/closure_id.cmx middle_end/allocated_const.cmx \ + middle_end/simple_value_approx.cmi +middle_end/simplify_boxed_integer_ops.cmo : middle_end/simplify_common.cmi \ + middle_end/simplify_boxed_integer_ops_intf.cmi \ + middle_end/simple_value_approx.cmi bytecomp/lambda.cmi \ + middle_end/inlining_cost.cmi middle_end/simplify_boxed_integer_ops.cmi +middle_end/simplify_boxed_integer_ops.cmx : middle_end/simplify_common.cmx \ + middle_end/simplify_boxed_integer_ops_intf.cmi \ + middle_end/simple_value_approx.cmx bytecomp/lambda.cmx \ + middle_end/inlining_cost.cmx middle_end/simplify_boxed_integer_ops.cmi +middle_end/simplify_common.cmo : middle_end/simple_value_approx.cmi \ + bytecomp/lambda.cmi middle_end/inlining_cost.cmi \ + middle_end/effect_analysis.cmi middle_end/simplify_common.cmi +middle_end/simplify_common.cmx : middle_end/simple_value_approx.cmx \ + bytecomp/lambda.cmx middle_end/inlining_cost.cmx \ + middle_end/effect_analysis.cmx middle_end/simplify_common.cmi +middle_end/simplify_primitives.cmo : middle_end/base_types/tag.cmi \ + middle_end/base_types/symbol.cmi middle_end/simplify_common.cmi \ + middle_end/simplify_boxed_integer_ops.cmi \ + middle_end/simple_value_approx.cmi utils/misc.cmi bytecomp/lambda.cmi \ + middle_end/inlining_cost.cmi middle_end/flambda.cmi utils/clflags.cmi \ + parsing/asttypes.cmi middle_end/simplify_primitives.cmi +middle_end/simplify_primitives.cmx : middle_end/base_types/tag.cmx \ + middle_end/base_types/symbol.cmx middle_end/simplify_common.cmx \ + middle_end/simplify_boxed_integer_ops.cmx \ + middle_end/simple_value_approx.cmx utils/misc.cmx bytecomp/lambda.cmx \ + middle_end/inlining_cost.cmx middle_end/flambda.cmx utils/clflags.cmx \ + parsing/asttypes.cmi middle_end/simplify_primitives.cmi +middle_end/unbox_closures.cmo : middle_end/base_types/variable.cmi \ + middle_end/simple_value_approx.cmi middle_end/inline_and_simplify_aux.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi \ + utils/clflags.cmi middle_end/backend_intf.cmi \ + middle_end/unbox_closures.cmi +middle_end/unbox_closures.cmx : middle_end/base_types/variable.cmx \ + middle_end/simple_value_approx.cmx middle_end/inline_and_simplify_aux.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda.cmx \ + bytecomp/debuginfo.cmx middle_end/base_types/closure_id.cmx \ + utils/clflags.cmx middle_end/backend_intf.cmi \ + middle_end/unbox_closures.cmi +middle_end/base_types/closure_element.cmi : \ + middle_end/base_types/variable.cmi utils/identifiable.cmi \ + middle_end/base_types/compilation_unit.cmi +middle_end/base_types/closure_id.cmi : \ + middle_end/base_types/closure_element.cmi +middle_end/base_types/compilation_unit.cmi : \ + middle_end/base_types/linkage_name.cmi utils/identifiable.cmi \ + typing/ident.cmi +middle_end/base_types/export_id.cmi : utils/identifiable.cmi \ + middle_end/base_types/compilation_unit.cmi +middle_end/base_types/id_types.cmi : utils/identifiable.cmi +middle_end/base_types/linkage_name.cmi : utils/identifiable.cmi +middle_end/base_types/mutable_variable.cmi : utils/identifiable.cmi \ + typing/ident.cmi middle_end/base_types/compilation_unit.cmi +middle_end/base_types/set_of_closures_id.cmi : utils/identifiable.cmi \ + middle_end/base_types/compilation_unit.cmi +middle_end/base_types/static_exception.cmi : utils/identifiable.cmi +middle_end/base_types/symbol.cmi : middle_end/base_types/linkage_name.cmi \ + utils/identifiable.cmi middle_end/base_types/compilation_unit.cmi +middle_end/base_types/tag.cmi : utils/identifiable.cmi +middle_end/base_types/variable.cmi : utils/identifiable.cmi typing/ident.cmi \ + middle_end/base_types/compilation_unit.cmi +middle_end/base_types/var_within_closure.cmi : \ + middle_end/base_types/closure_element.cmi +middle_end/base_types/closure_element.cmo : \ + middle_end/base_types/variable.cmi \ + middle_end/base_types/closure_element.cmi +middle_end/base_types/closure_element.cmx : \ + middle_end/base_types/variable.cmx \ + middle_end/base_types/closure_element.cmi +middle_end/base_types/closure_id.cmo : \ + middle_end/base_types/closure_element.cmi \ + middle_end/base_types/closure_id.cmi +middle_end/base_types/closure_id.cmx : \ + middle_end/base_types/closure_element.cmx \ + middle_end/base_types/closure_id.cmi +middle_end/base_types/compilation_unit.cmo : utils/misc.cmi \ + middle_end/base_types/linkage_name.cmi utils/identifiable.cmi \ + typing/ident.cmi middle_end/base_types/compilation_unit.cmi +middle_end/base_types/compilation_unit.cmx : utils/misc.cmx \ + middle_end/base_types/linkage_name.cmx utils/identifiable.cmx \ + typing/ident.cmx middle_end/base_types/compilation_unit.cmi +middle_end/base_types/export_id.cmo : utils/identifiable.cmi \ + middle_end/base_types/id_types.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/export_id.cmi +middle_end/base_types/export_id.cmx : utils/identifiable.cmx \ + middle_end/base_types/id_types.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/export_id.cmi +middle_end/base_types/id_types.cmo : utils/identifiable.cmi \ + middle_end/base_types/id_types.cmi +middle_end/base_types/id_types.cmx : utils/identifiable.cmx \ + middle_end/base_types/id_types.cmi +middle_end/base_types/linkage_name.cmo : utils/identifiable.cmi \ + middle_end/base_types/linkage_name.cmi +middle_end/base_types/linkage_name.cmx : utils/identifiable.cmx \ + middle_end/base_types/linkage_name.cmi +middle_end/base_types/mutable_variable.cmo : utils/identifiable.cmi \ + typing/ident.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/mutable_variable.cmi +middle_end/base_types/mutable_variable.cmx : utils/identifiable.cmx \ + typing/ident.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/mutable_variable.cmi +middle_end/base_types/set_of_closures_id.cmo : utils/identifiable.cmi \ + middle_end/base_types/id_types.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/set_of_closures_id.cmi +middle_end/base_types/set_of_closures_id.cmx : utils/identifiable.cmx \ + middle_end/base_types/id_types.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/set_of_closures_id.cmi +middle_end/base_types/static_exception.cmo : utils/numbers.cmi \ + bytecomp/lambda.cmi middle_end/base_types/static_exception.cmi +middle_end/base_types/static_exception.cmx : utils/numbers.cmx \ + bytecomp/lambda.cmx middle_end/base_types/static_exception.cmi +middle_end/base_types/symbol.cmo : utils/misc.cmi \ + middle_end/base_types/linkage_name.cmi utils/identifiable.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/symbol.cmi +middle_end/base_types/symbol.cmx : utils/misc.cmx \ + middle_end/base_types/linkage_name.cmx utils/identifiable.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/symbol.cmi +middle_end/base_types/tag.cmo : utils/numbers.cmi utils/misc.cmi \ + utils/identifiable.cmi middle_end/base_types/tag.cmi +middle_end/base_types/tag.cmx : utils/numbers.cmx utils/misc.cmx \ + utils/identifiable.cmx middle_end/base_types/tag.cmi +middle_end/base_types/variable.cmo : utils/misc.cmi utils/identifiable.cmi \ + typing/ident.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/variable.cmi +middle_end/base_types/variable.cmx : utils/misc.cmx utils/identifiable.cmx \ + typing/ident.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/variable.cmi +middle_end/base_types/var_within_closure.cmo : \ + middle_end/base_types/closure_element.cmi \ + middle_end/base_types/var_within_closure.cmi +middle_end/base_types/var_within_closure.cmx : \ + middle_end/base_types/closure_element.cmx \ + middle_end/base_types/var_within_closure.cmi driver/compenv.cmi : driver/compile.cmi : driver/compmisc.cmi : typing/env.cmi diff --git a/.merlin b/.merlin index 0442978ec..38628a474 100644 --- a/.merlin +++ b/.merlin @@ -1,6 +1,12 @@ S ./asmcomp B ./asmcomp +S ./middle_end +B ./middle_end + +S ./middle_end/base_types +B ./middle_end/base_types + S ./bytecomp B ./bytecomp diff --git a/Makefile b/Makefile index c316aaa6e..2c1545e53 100644 --- a/Makefile +++ b/Makefile @@ -252,6 +252,10 @@ installopt: cd asmrun; $(MAKE) install cp ocamlopt $(INSTALL_BINDIR)/ocamlopt$(EXE) cd stdlib; $(MAKE) installopt + cp middle_end/*.cmi middle_end/*.cmt middle_end/*.cmti \ + $(INSTALL_COMPLIBDIR) + cp middle_end/base_types/*.cmi middle_end/base_types/*.cmt \ + middle_end/base_types/*.cmti $(INSTALL_COMPLIBDIR) cp asmcomp/*.cmi asmcomp/*.cmt asmcomp/*.cmti $(INSTALL_COMPLIBDIR) cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(INSTALL_COMPLIBDIR) if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKE) installopt); \ @@ -314,8 +318,9 @@ ocamlc: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART) # The native-code compiler -compilerlibs/ocamloptcomp.cma: $(ASMCOMP) - $(CAMLC) -a -o $@ $(ASMCOMP) +compilerlibs/ocamloptcomp.cma: $(MIDDLE_END) $(ASMCOMP) + $(CAMLC) -a -o $@ $(MIDDLE_END) $(ASMCOMP) + partialclean:: rm -f compilerlibs/ocamloptcomp.cma @@ -467,8 +472,8 @@ partialclean:: # The native-code compiler compiled with itself -compilerlibs/ocamloptcomp.cmxa: $(ASMCOMP:.cmo=.cmx) - $(CAMLOPT) -a -o $@ $(ASMCOMP:.cmo=.cmx) +compilerlibs/ocamloptcomp.cmxa: $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx) partialclean:: rm -f compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.a @@ -481,7 +486,7 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ partialclean:: rm -f ocamlopt.opt -$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt +$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt # The numeric opcodes @@ -781,12 +786,13 @@ clean:: $(CAMLOPT) $(COMPFLAGS) -c $< partialclean:: - for d in utils parsing typing bytecomp asmcomp driver toplevel tools; \ + for d in utils parsing typing bytecomp asmcomp middle_end middle_end/base_types driver toplevel tools; \ do rm -f $$d/*.cm[ioxt] $$d/*.cmti $$d/*.annot $$d/*.[so] $$d/*~; done rm -f *~ depend: beforedepend - (for d in utils parsing typing bytecomp asmcomp driver toplevel; \ + (for d in utils parsing typing bytecomp asmcomp middle_end \ + middle_end/base_types driver toplevel; \ do $(CAMLDEP) $(DEPFLAGS) $$d/*.mli $$d/*.ml; \ done) > .depend diff --git a/Makefile.nt b/Makefile.nt index f2cc81184..3f8286096 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -240,6 +240,10 @@ installopt: cd asmrun ; $(MAKEREC) install cp ocamlopt $(INSTALL_BINDIR)/ocamlopt.exe cd stdlib ; $(MAKEREC) installopt + cp middle_end/*.cmi middle_end/*.cmt middle_end/*.cmti \ + $(INSTALL_COMPLIBDIR) + cp middle_end/base_types/*.cmi middle_end/base_types/*.cmt \ + middle_end/base_types/*.cmti $(INSTALL_COMPLIBDIR) cp asmcomp/*.cmi asmcomp/*.cmt asmcomp/*.cmti $(INSTALL_COMPLIBDIR) cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(INSTALL_COMPLIBDIR) if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKEREC) installopt); fi @@ -290,8 +294,8 @@ partialclean:: # The native-code compiler -compilerlibs/ocamloptcomp.cma: $(ASMCOMP) - $(CAMLC) -a -o $@ $(ASMCOMP) +compilerlibs/ocamloptcomp.cma: $(MIDDLE_END) $(ASMCOMP) + $(CAMLC) -a -o $@ $(MIDDLE_END) $(ASMCOMP) partialclean:: rm -f compilerlibs/ocamloptcomp.cma @@ -420,8 +424,8 @@ partialclean:: # The native-code compiler compiled with itself -compilerlibs/ocamloptcomp.cmxa: $(ASMCOMP:.cmo=.cmx) - $(CAMLOPT) -a -o $@ $(ASMCOMP:.cmo=.cmx) +compilerlibs/ocamloptcomp.cmxa: $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx) partialclean:: rm -f compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.$(A) @@ -434,7 +438,7 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ partialclean:: rm -f ocamlopt.opt -$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt +$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt # The numeric opcodes @@ -681,13 +685,13 @@ clean:: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: - $(CAMLC) $(COMPFLAGS) -c $< + $(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $< .mli.cmi: - $(CAMLC) $(COMPFLAGS) -c $< + $(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $< .ml.cmx: - $(CAMLOPT) $(COMPFLAGS) -c $< + $(CAMLOPT) $(COMPFLAGS) `./Compflags $@` -c $< partialclean:: rm -f utils/*.cm* utils/*.$(O) utils/*.$(S) @@ -700,7 +704,8 @@ partialclean:: rm -f tools/*.cm* tools/*.$(O) tools/*.$(S) depend: beforedepend - (for d in utils parsing typing bytecomp asmcomp driver toplevel; \ + (for d in utils parsing typing bytecomp asmcomp middle_end \ + middle_end/base_types driver toplevel; \ do $(CAMLDEP) $(DEPFLAGS) $$d/*.mli $$d/*.ml; \ done) > .depend diff --git a/Makefile.shared b/Makefile.shared index 217f3c4e6..3ab908d3c 100755 --- a/Makefile.shared +++ b/Makefile.shared @@ -33,8 +33,8 @@ OCAMLBUILDNATIVE=$(WITH_OCAMLBUILD:=.native) OCAMLDOC_OPT=$(WITH_OCAMLDOC:=.opt) -INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \ - -I toplevel +INCLUDES=-I utils -I parsing -I typing -I bytecomp -I middle_end \ + -I middle_end/base_types -I asmcomp -I driver -I toplevel UTILS=utils/config.cmo utils/misc.cmo \ utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \ @@ -104,8 +104,17 @@ ASMCOMP=\ asmcomp/arch.cmo \ asmcomp/cmm.cmo asmcomp/printcmm.cmo \ asmcomp/reg.cmo asmcomp/mach.cmo asmcomp/proc.cmo \ - asmcomp/clambda.cmo asmcomp/printclambda.cmo asmcomp/compilenv.cmo \ - asmcomp/closure.cmo asmcomp/strmatch.cmo asmcomp/cmmgen.cmo \ + asmcomp/clambda.cmo asmcomp/printclambda.cmo \ + asmcomp/export_info.cmo \ + asmcomp/export_info_for_pack.cmo \ + asmcomp/compilenv.cmo \ + asmcomp/closure.cmo \ + asmcomp/build_export_info.cmo \ + asmcomp/closure_offsets.cmo \ + asmcomp/flambda_to_clambda.cmo \ + asmcomp/import_approx.cmo \ + asmcomp/un_anf.cmo \ + asmcomp/strmatch.cmo asmcomp/cmmgen.cmo \ asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \ asmcomp/comballoc.cmo \ asmcomp/CSEgen.cmo asmcomp/CSE.cmo \ @@ -122,6 +131,58 @@ ASMCOMP=\ asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \ driver/opterrors.cmo driver/optcompile.cmo +MIDDLE_END=\ + middle_end/base_types/tag.cmo \ + middle_end/base_types/linkage_name.cmo \ + middle_end/base_types/compilation_unit.cmo \ + middle_end/base_types/variable.cmo \ + middle_end/base_types/mutable_variable.cmo \ + middle_end/base_types/id_types.cmo \ + middle_end/base_types/set_of_closures_id.cmo \ + middle_end/base_types/closure_element.cmo \ + middle_end/base_types/closure_id.cmo \ + middle_end/base_types/var_within_closure.cmo \ + middle_end/base_types/static_exception.cmo \ + middle_end/base_types/export_id.cmo \ + middle_end/base_types/symbol.cmo \ + middle_end/semantics_of_primitives.cmo \ + middle_end/allocated_const.cmo \ + middle_end/flambda.cmo \ + middle_end/flambda_iterators.cmo \ + middle_end/flambda_utils.cmo \ + middle_end/inlining_cost.cmo \ + middle_end/effect_analysis.cmo \ + middle_end/freshening.cmo \ + middle_end/simple_value_approx.cmo \ + middle_end/lift_code.cmo \ + middle_end/closure_conversion_aux.cmo \ + middle_end/closure_conversion.cmo \ + middle_end/initialize_symbol_to_let_symbol.cmo \ + middle_end/lift_let_to_initialize_symbol.cmo \ + middle_end/find_recursive_functions.cmo \ + middle_end/invariant_params.cmo \ + middle_end/inconstant_idents.cmo \ + middle_end/alias_analysis.cmo \ + middle_end/lift_constants.cmo \ + middle_end/share_constants.cmo \ + middle_end/simplify_common.cmo \ + middle_end/remove_unused_arguments.cmo \ + middle_end/remove_unused_closure_vars.cmo \ + middle_end/remove_unused_program_constructs.cmo \ + middle_end/simplify_boxed_integer_ops.cmo \ + middle_end/simplify_primitives.cmo \ + middle_end/inlining_stats_types.cmo \ + middle_end/inlining_stats.cmo \ + middle_end/inline_and_simplify_aux.cmo \ + middle_end/augment_closures.cmo \ + middle_end/unbox_closures.cmo \ + middle_end/inlining_transforms.cmo \ + middle_end/inlining_decision.cmo \ + middle_end/inline_and_simplify.cmo \ + middle_end/ref_to_variables.cmo \ + middle_end/flambda_invariants.cmo \ + middle_end/middle_end.cmo + TOPLEVEL=toplevel/genprintval.cmo toplevel/toploop.cmo \ toplevel/trace.cmo toplevel/topdirs.cmo toplevel/topmain.cmo diff --git a/asmrun/Makefile b/asmrun/Makefile index 32c00597b..32479e1be 100644 --- a/asmrun/Makefile +++ b/asmrun/Makefile @@ -29,7 +29,7 @@ COBJS=startup_aux.o startup.o \ gc_ctrl.o terminfo.o md5.o obj.o lexing.o printexc.o callback.o weak.o \ compact.o finalise.o custom.o $(UNIX_OR_WIN32).o backtrace_prim.o \ backtrace.o \ - natdynlink.o debugger.o meta.o dynlink.o + natdynlink.o debugger.o meta.o dynlink.o clambda_checks.o ASMOBJS=$(ARCH).o diff --git a/asmrun/Makefile.nt b/asmrun/Makefile.nt index 4a1056f6c..8a6b8407a 100644 --- a/asmrun/Makefile.nt +++ b/asmrun/Makefile.nt @@ -25,7 +25,7 @@ COBJS=startup_aux.$(O) startup.$(O) \ md5.$(O) obj.$(O) lexing.$(O) win32.$(O) printexc.$(O) callback.$(O) \ weak.$(O) compact.$(O) finalise.$(O) custom.$(O) globroots.$(O) \ backtrace_prim.$(O) backtrace.$(O) \ - natdynlink.$(O) debugger.$(O) meta.$(O) dynlink.$(O) + natdynlink.$(O) debugger.$(O) meta.$(O) dynlink.$(O) clambda_checks.$(O) LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \ compare.c ints.c floats.c str.c io.c extern.c intern.c hash.c sys.c \ From 821359c20a0ce65889a432da27594981070fd644 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 22 Jan 2016 12:03:54 +0100 Subject: [PATCH 060/145] tests/asmcomp: simplify checking for flambda; debug compilation --- testsuite/tests/asmcomp/Makefile | 10 +++------- testsuite/tests/asmcomp/is_static.ml | 2 +- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile index c31179067..cf9ffa587 100644 --- a/testsuite/tests/asmcomp/Makefile +++ b/testsuite/tests/asmcomp/Makefile @@ -45,7 +45,7 @@ lexcmm.ml: lexcmm.mll @$(OCAMLLEX) -q lexcmm.mll MLCASES=optargs staticalloc bind_tuples is_static -ARGS_is_static=is_in_static_data.o +ARGS_is_static=is_in_static_data.c CASES=fib tak quicksort quicksort2 soli \ arith checkbound tagged-fib tagged-integr tagged-quicksort tagged-tak @@ -63,17 +63,13 @@ ARGS_tagged-quicksort=-DSORT -DFUN=quicksort main.c ARGS_tagged-tak=-DUNIT_INT -DFUN=takmain main.c one_ml: - @$(OCAMLOPT) -o $(NAME).exe $(NAME).ml && \ - ./$(NAME).exe `$(OCAMLOPT) -config` \ - && echo " => passed" || echo " => failed" + @$(OCAMLOPT) $(ARGS_$(NAME)) -o $(NAME).exe $(NAME).ml && \ + ./$(NAME).exe $(FLAMBDA) && echo " => passed" || echo " => failed" one: @$(call CC,$(NAME).out $(ARGS_$(NAME)) $(NAME).$(O) $(ARCH).$(O)) \ && echo " => passed" || echo " => failed" -is_in_static_data.o: is_in_static_data.c - @$(OCAMLOPT) -c is_in_static_data.c - clean: defaultclean @rm -f ./codegen *.out *.$(O) *.exe @rm -f parsecmm.ml parsecmm.mli lexcmm.ml diff --git a/testsuite/tests/asmcomp/is_static.ml b/testsuite/tests/asmcomp/is_static.ml index abe07dd69..fe9623289 100644 --- a/testsuite/tests/asmcomp/is_static.ml +++ b/testsuite/tests/asmcomp/is_static.ml @@ -1,5 +1,5 @@ external is_in_static_data : 'a -> bool = "caml_is_in_static_data" -let flambda = List.exists ((=) "flambda: true") (Array.to_list Sys.argv) +let flambda = bool_of_string Sys.argv.(1) let is_in_static_data_flambda x = not flambda || is_in_static_data x From 974733bb8a0fd71f2dc2d0b945d3cb7167d09eb3 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 22 Jan 2016 16:13:40 +0100 Subject: [PATCH 061/145] Fix test for static data --- testsuite/tests/asmcomp/is_static.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/asmcomp/is_static.ml b/testsuite/tests/asmcomp/is_static.ml index fe9623289..aac61fd87 100644 --- a/testsuite/tests/asmcomp/is_static.ml +++ b/testsuite/tests/asmcomp/is_static.ml @@ -27,11 +27,11 @@ let () = (g [@inlined always]) 2 (* Toplevel immutable blocks should be static *) let block3 = (Sys.opaque_identity 1, Sys.opaque_identity 2) -let () = assert(is_in_static_data block3) +let () = assert(is_in_static_data_flambda block3) (* Not being bound shouldn't prevent it *) let () = - assert(is_in_static_data (Sys.opaque_identity 1, Sys.opaque_identity 2)) + assert(is_in_static_data_flambda (Sys.opaque_identity 1, Sys.opaque_identity 2)) (* Only with rounds >= 2 currently ! (* Also after inlining *) From 4c67cc03477796a47b9959533a155cb2ef475ef3 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 22 Jan 2016 17:02:06 +0100 Subject: [PATCH 062/145] Fix Makefile.nt --- Makefile.nt | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Makefile.nt b/Makefile.nt index 3f8286096..74dd17a7b 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -685,13 +685,13 @@ clean:: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: - $(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $< + $(CAMLC) $(COMPFLAGS) -c $< .mli.cmi: - $(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $< + $(CAMLC) $(COMPFLAGS) -c $< .ml.cmx: - $(CAMLOPT) $(COMPFLAGS) `./Compflags $@` -c $< + $(CAMLOPT) $(COMPFLAGS) -c $< partialclean:: rm -f utils/*.cm* utils/*.$(O) utils/*.$(S) @@ -699,6 +699,9 @@ partialclean:: rm -f typing/*.cm* typing/*.$(O) typing/*.$(S) rm -f bytecomp/*.cm* bytecomp/*.$(O) bytecomp/*.$(S) rm -f asmcomp/*.cm* asmcomp/*.$(O) asmcomp/*.$(S) + rm -f middle_end/*.cm* middle_end/*.$(O) middle_end/*.$(S) + rm -f middle_end/base_types/*.cm* middle_end/base_types/*.$(O) \ + middle_end/base_types/*.$(S) rm -f driver/*.cm* driver/*.$(O) driver/*.$(S) rm -f toplevel/*.cm* toplevel/*.$(O) toplevel/*.$(S) rm -f tools/*.cm* tools/*.$(O) tools/*.$(S) From 031d4ac095a66ae64e97053545a3e81aa3359c9a Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 22 Jan 2016 17:54:46 +0100 Subject: [PATCH 063/145] disable asmcomp tests for msvc64 --- testsuite/tests/asmcomp/Makefile | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile index 237dc9471..07010ff8a 100644 --- a/testsuite/tests/asmcomp/Makefile +++ b/testsuite/tests/asmcomp/Makefile @@ -76,6 +76,13 @@ clean: defaultclean include $(BASEDIR)/makefiles/Makefile.common +ifeq "$(CCOMPTYPE)-$(ARCH)" "msvc-amd64" +# these tests are not ported to MSVC64 yet +SKIP=true +else +SKIP=false +endif + ifeq ($(CCOMPTYPE),msvc) CC=set -o pipefail ; $(NATIVECC) $(CFLAGS) /Fe$(1) | tail -n +2 CFLAGS=$(NATIVECCCOMPOPTS) From 7dce037bdf15c696f9576d4fbf8c87813360b489 Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Fri, 22 Jan 2016 18:40:16 +0100 Subject: [PATCH 064/145] GPR#337: Hashtbl.filter_map_inplace. --- Changes | 1 + stdlib/hashtbl.ml | 17 +++++++++++++++++ stdlib/hashtbl.mli | 23 +++++++++++++++++++++-- stdlib/moreLabels.mli | 6 ++++++ 4 files changed, 45 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 155c93271..7a6e92a86 100644 --- a/Changes +++ b/Changes @@ -237,6 +237,7 @@ Standard library: (Bobot François) - GPR#329: Add exists, for_all, mem and memq functions in Array (Bernhard Schommer) +- GPR#337: Add [Hashtbl.filter_map_inplace] (Alain Frisch) - GPR#356: Add [Format.kasprintf] (Jérémie Dimino, Mark Shinwell) Type system: diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml index 28fd46335..1e884e671 100644 --- a/stdlib/hashtbl.ml +++ b/stdlib/hashtbl.ml @@ -191,6 +191,20 @@ let iter f h = do_bucket d.(i) done +let filter_map_inplace f h = + let rec do_bucket = function + | Empty -> + Empty + | Cons(k, d, rest) -> + match f k d with + | None -> do_bucket rest + | Some new_d -> Cons(k, new_d, do_bucket rest) + in + let d = h.data in + for i = 0 to Array.length d - 1 do + d.(i) <- do_bucket d.(i) + done + let fold f h init = let rec do_bucket b accu = match b with @@ -261,6 +275,7 @@ module type S = val replace : 'a t -> key -> 'a -> unit val mem : 'a t -> key -> bool val iter: (key -> 'a -> unit) -> 'a t -> unit + val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val length: 'a t -> int val stats: 'a t -> statistics @@ -281,6 +296,7 @@ module type SeededS = val replace : 'a t -> key -> 'a -> unit val mem : 'a t -> key -> bool val iter : (key -> 'a -> unit) -> 'a t -> unit + val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val length : 'a t -> int val stats: 'a t -> statistics @@ -373,6 +389,7 @@ module MakeSeeded(H: SeededHashedType): (SeededS with type key = H.t) = mem_in_bucket h.data.(key_index h key) let iter = iter + let filter_map_inplace = filter_map_inplace let fold = fold let length = length let stats = stats diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index 386f5a6cc..e64a170fd 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -120,7 +120,20 @@ val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit in which the bindings are enumerated is reproducible between successive runs of the program, and even between minor versions of OCaml. For randomized hash tables, the order of enumeration - is entirely random. *) + is entirely random. + + The behavior is not defined if the hash table is modified + by [f] during the iteration. +*) + +val filter_map_inplace: ('a -> 'b -> 'b option) -> ('a, 'b) t -> unit +(** [Hashtbl.filter_map_inplace f tbl] applies [f] to all bindings in + table [tbl] and update each binding depending on the result of + [f]. If [f] returns [None], the binding is discarded. If it + returns [Some new_val], the binding is update to associate the key + to [new_val]. + + Other comments for {!Hashtbl.iter} apply as well. *) val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c (** [Hashtbl.fold f tbl init] computes @@ -138,7 +151,11 @@ val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c in which the bindings are enumerated is reproducible between successive runs of the program, and even between minor versions of OCaml. For randomized hash tables, the order of enumeration - is entirely random. *) + is entirely random. + + The behavior is not defined if the hash table is modified + by [f] during the iteration. +*) val length : ('a, 'b) t -> int (** [Hashtbl.length tbl] returns the number of bindings in [tbl]. @@ -253,6 +270,7 @@ module type S = val replace : 'a t -> key -> 'a -> unit val mem : 'a t -> key -> bool val iter : (key -> 'a -> unit) -> 'a t -> unit + val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val length : 'a t -> int val stats: 'a t -> statistics @@ -302,6 +320,7 @@ module type SeededS = val replace : 'a t -> key -> 'a -> unit val mem : 'a t -> key -> bool val iter : (key -> 'a -> unit) -> 'a t -> unit + val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val length : 'a t -> int val stats: 'a t -> statistics diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli index d8ca64bfb..de28c3c7f 100644 --- a/stdlib/moreLabels.mli +++ b/stdlib/moreLabels.mli @@ -34,6 +34,8 @@ module Hashtbl : sig val remove : ('a, 'b) t -> 'a -> unit val replace : ('a, 'b) t -> key:'a -> data:'b -> unit val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit + val filter_map_inplace: + f:(key:'a -> data:'b -> 'b option) -> ('a, 'b) t -> unit val fold : f:(key:'a -> data:'b -> 'c -> 'c) -> ('a, 'b) t -> init:'c -> 'c @@ -58,6 +60,8 @@ module Hashtbl : sig val replace : 'a t -> key:key -> data:'a -> unit val mem : 'a t -> key -> bool val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit + val filter_map_inplace: + f:(key:key -> data:'a -> 'a option) -> 'a t -> unit val fold : f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b @@ -79,6 +83,8 @@ module Hashtbl : sig val replace : 'a t -> key:key -> data:'a -> unit val mem : 'a t -> key -> bool val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit + val filter_map_inplace: + f:(key:key -> data:'a -> 'a option) -> 'a t -> unit val fold : f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b From 0b7542ddd8559760acea2e8be20b5503085c71ce Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Fri, 22 Jan 2016 21:36:34 +0100 Subject: [PATCH 065/145] Fix testsuite. --- testsuite/tests/lib-hashtbl/htbl.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/lib-hashtbl/htbl.ml b/testsuite/tests/lib-hashtbl/htbl.ml index c023d4bcd..a93fac4f2 100644 --- a/testsuite/tests/lib-hashtbl/htbl.ml +++ b/testsuite/tests/lib-hashtbl/htbl.ml @@ -102,6 +102,7 @@ module HofM (M: Map.S) : Hashtbl.S with type key = M.key = let fold = Hashtbl.fold let length = Hashtbl.length let stats = Hashtbl.stats + let filter_map_inplace = Hashtbl.filter_map_inplace end module HS1 = HofM(MS) From ff0f9b83386fa763e8bcf5230e799fb4184a606b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Sat, 16 Jan 2016 12:24:14 +0100 Subject: [PATCH 066/145] Fix instrumented runtime for glibc < 2.17 - Compile the instrumented runtime, for catching errors in CAML_INSTR macros. - Compile the debug runtime for compile time errors in Assert. --- .travis-ci.sh | 2 +- configure | 20 +++++++++++++++++++- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/.travis-ci.sh b/.travis-ci.sh index d73705c2f..6b7a81319 100644 --- a/.travis-ci.sh +++ b/.travis-ci.sh @@ -29,7 +29,7 @@ control. ------------------------------------------------------------------------ EOF mkdir -p $PREFIX - ./configure --prefix $PREFIX + ./configure --prefix $PREFIX -with-debug-runtime -with-instrumented-runtime export PATH=$PREFIX/bin:$PATH make world.opt make install diff --git a/configure b/configure index b2c5f7d54..e59567ebc 100755 --- a/configure +++ b/configure @@ -1061,6 +1061,23 @@ if test "$with_curses" = "yes"; then done fi +# For instrumented runtime +# (clock_gettime needs -lrt for glibc before 2.17) +if $with_instrumented_runtime; then + with_instrumented_runtime=false #enabled it only if found + for libs in "" "-lrt"; do + if sh ./hasgot $libs clock_gettime; then + inf "clock_gettime functions found (with libraries '$libs')" + instrumented_runtime_libs="${libs}" + with_instrumented_runtime=true; + break + fi + done + if ! $with_instrumented_runtime; then + err "clock_gettime functions not found. Instrumented runtime can't be built." + fi +fi + # Configuration for the libraries case "$system" in @@ -1719,7 +1736,8 @@ cclibs="$cclibs $mathlib" echo "BYTECC=$bytecc" >> Makefile echo "BYTECCCOMPOPTS=$bytecccompopts" >> Makefile echo "BYTECCLINKOPTS=$bytecclinkopts" >> Makefile -echo "BYTECCLIBS=$cclibs $dllib $curseslibs $pthread_link" >> Makefile +echo "BYTECCLIBS=$cclibs $dllib $curseslibs $pthread_link \ + $instrumented_runtime_libs" >> Makefile echo "BYTECCRPATH=$byteccrpath" >> Makefile echo "EXE=$exe" >> Makefile echo "SUPPORTS_SHARED_LIBRARIES=$shared_libraries_supported" >> Makefile From b7fc239e9afeb0e95f2bfc6e7820acd8efc918f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 22 Jan 2016 15:27:22 +0100 Subject: [PATCH 067/145] Fix problem reported in GPR#435: assertion failure The assertion is wrong since 5b8296c. --- byterun/minor_gc.c | 1 - 1 file changed, 1 deletion(-) diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index 950ec216c..6781abb72 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -326,7 +326,6 @@ void caml_empty_minor_heap (void) } } CAML_INSTR_TIME (tmr, "minor/update_weak"); - CAMLassert (caml_young_ptr >= caml_young_alloc_start); caml_stat_minor_words += caml_young_alloc_end - caml_young_ptr; caml_gc_clock += (double) (caml_young_alloc_end - caml_young_ptr) / caml_minor_heap_wsz; From 85bbbf0721ae8ede704d6e3d2e57ab780a48d970 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Sat, 23 Jan 2016 11:26:23 +0100 Subject: [PATCH 068/145] Fix OCAMLRUNPARAM in testsuite/tests/backtrace/ --- testsuite/tests/backtrace/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/backtrace/Makefile b/testsuite/tests/backtrace/Makefile index 6faa1a26a..ce5d6dbcb 100644 --- a/testsuite/tests/backtrace/Makefile +++ b/testsuite/tests/backtrace/Makefile @@ -70,7 +70,7 @@ native: $(OCAMLOPT) -g -o $(EXECNAME) $$file; \ printf " ... testing '$$file' with ocamlopt:"; \ F="`basename $$file .ml`"; \ - (OCAMLRUNPARAM=$OCAMLRUNPARAM,b=1 \ + (OCAMLRUNPARAM=$$OCAMLRUNPARAM,b=1 \ ./$(EXECNAME) $$arg || true) \ >$$F.native.result 2>&1; \ $(DIFF) $$F.reference $$F.native.result >/dev/null \ From b36a06dca972a22f1ab48f8c96334f904e456195 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Sat, 16 Jan 2016 11:47:05 +0100 Subject: [PATCH 069/145] Travis runs the testsuite with the debug runtime --- .travis-ci.sh | 1 + testsuite/makefiles/Makefile.common | 24 +++++++++++++------ testsuite/tests/lib-dynlink-bytecode/Makefile | 2 +- 3 files changed, 19 insertions(+), 8 deletions(-) diff --git a/.travis-ci.sh b/.travis-ci.sh index 6b7a81319..aaf2feccd 100644 --- a/.travis-ci.sh +++ b/.travis-ci.sh @@ -34,6 +34,7 @@ EOF make world.opt make install (cd testsuite && make all) + (cd testsuite && make USE_RUNTIME="d" all) mkdir external-packages cd external-packages git clone git://github.com/ocaml/camlp4 diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common index fb439201e..b77dcb55c 100644 --- a/testsuite/makefiles/Makefile.common +++ b/testsuite/makefiles/Makefile.common @@ -43,7 +43,17 @@ SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)" include $(TOPDIR)/config/Makefile -OCAMLRUN=$(TOPDIR)/boot/ocamlrun$(EXE) +ifneq ($(USE_RUNTIME),) +#Check USE_RUNTIME value +ifeq ($(findstring $(USE_RUNTIME),d i),) +$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) or "i" (instrumented runtime)) +endif + +RUNTIME_VARIANT=-I $(OTOPDIR)/asmrun -I $(OTOPDIR)/byterun -runtime-variant $(USE_RUNTIME) +export OCAMLRUNPARAM?=v=0 +endif + +OCAMLRUN=$(TOPDIR)/byterun/ocamlrun$(USE_RUNTIME)$(EXE) OCFLAGS=-nostdlib -I $(OTOPDIR)/stdlib $(COMPFLAGS) OCOPTFLAGS= @@ -57,15 +67,15 @@ endif OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) \ -init $(OTOPDIR)/testsuite/lib/empty FLEXLINK_PREFIX=$(if $(FLEXLINK),$(if $(wildcard $(TOPDIR)/flexdll/Makefile),OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe" )) -OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) -OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) +OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) $(RUNTIME_VARIANT) +OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) $(RUNTIME_VARIANT) OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \ - -ocamlc "$(OTOPDIR)/boot/ocamlrun$(EXE) \ - $(OTOPDIR)/ocamlc $(OCFLAGS)" \ - -ocamlopt "$(OTOPDIR)/boot/ocamlrun$(EXE) \ - $(OTOPDIR)/ocamlopt $(OCFLAGS)" + -ocamlc "$(OTOPDIR)/byterun/ocamlrun$(USE_RUNTIME)$(EXE) \ + $(OTOPDIR)/ocamlc $(OCFLAGS) $(RUNTIME_VARIANT)" \ + -ocamlopt "$(OTOPDIR)/byterun/ocamlrun$(USE_RUNTIME)$(EXE) \ + $(OTOPDIR)/ocamlopt $(OCFLAGS) $(RUNTIME_VARIANT)" OCAMLYACC=$(TOPDIR)/yacc/ocamlyacc$(EXE) OCAMLBUILD=$(TOPDIR)/_build/ocamlbuild/ocamlbuild.native DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tools/dumpobj diff --git a/testsuite/tests/lib-dynlink-bytecode/Makefile b/testsuite/tests/lib-dynlink-bytecode/Makefile index 28d6f1402..a91e45b68 100644 --- a/testsuite/tests/lib-dynlink-bytecode/Makefile +++ b/testsuite/tests/lib-dynlink-bytecode/Makefile @@ -39,7 +39,7 @@ compile: @rm -f main static custom custom.exe @$(OCAMLC) -o main dynlink.cma registry.cmo main.cmo @$(OCAMLC) -o static -linkall registry.cmo plug1.cma plug2.cma \ - -use-runtime $(OTOPDIR)/boot/ocamlrun$(EXE) + -use-runtime $(OTOPDIR)/byterun/ocamlrun$(USE_RUNTIME)$(EXE) @$(OCAMLC) -o custom$(EXE) -custom -linkall registry.cmo plug2.cma \ plug1.cma -I . From 3b6677096675d8a4c1ec3cf19d81cf788847be2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Sun, 23 Feb 2014 15:51:27 +0100 Subject: [PATCH 070/145] [GC] Simplify mark_slice function --- byterun/major_gc.c | 115 ++++++++++++++++++++++++--------------------- 1 file changed, 62 insertions(+), 53 deletions(-) diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 23dd9b2c1..ee0196b4c 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -159,25 +159,80 @@ static void start_cycle (void) static value current_value = 0; static mlsize_t current_index = 0; +/* For instrumentation */ #ifdef CAML_INSTR #define INSTR(x) x #else #define INSTR(x) /**/ #endif +//auxillary function of mark_slice +static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, + int *slice_pointers) +{ + value child; + header_t chd; + + child = Field (v, i); + +#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS + if (Is_block (child) + && ! Is_young (child) + && Wosize_val (child) > 0 /* Atoms never need to be marked. */ + /* Closure blocks contain code pointers at offsets that cannot + be reliably determined, so we always use the page table when + marking such values. */ + && (!(Tag_val (v) == Closure_tag || Tag_val (v) == Infix_tag) || + Is_in_heap (child))) { +#else + if (Is_block (child) && Is_in_heap (child)) { +#endif + INSTR (++ *slice_pointers;) + chd = Hd_val (child); + if (Tag_hd (chd) == Forward_tag){ + value f = Forward_val (child); + if (Is_block (f) + && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag)){ + /* Do not short-circuit the pointer. */ + }else{ + Field (v, i) = f; + if (Is_block (f) && Is_young (f) && !Is_young (child)) + add_to_ref_table (&caml_ref_table, &Field (v, i)); + } + } + else if (Tag_hd(chd) == Infix_tag) { + child -= Infix_offset_val(child); + chd = Hd_val(child); + } +#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS + /* See [caml_darken] for a description of this assertion. */ + CAMLassert (Is_in_heap (child) || Is_black_hd (chd)); +#endif + if (Is_white_hd (chd)){ + Hd_val (child) = Grayhd_hd (chd); + *gray_vals_ptr++ = child; + if (gray_vals_ptr >= gray_vals_end) { + gray_vals_cur = gray_vals_ptr; + realloc_gray_vals (); + gray_vals_ptr = gray_vals_cur; + } + } + } + + return gray_vals_ptr; +} + static void mark_slice (intnat work) { value *gray_vals_ptr; /* Local copy of [gray_vals_cur] */ - value v, child; - header_t hd, chd; + value v; + header_t hd; mlsize_t size, i, start, end; /* [start] is a local copy of [current_index] */ -#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS - int marking_closure = 0; -#endif #ifdef CAML_INSTR int slice_fields = 0; - int slice_pointers = 0; #endif + int slice_pointers = 0; /** gcc removes it when not in CAML_INSTR */ caml_gc_message (0x40, "Marking %ld words\n", work); caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); @@ -192,10 +247,6 @@ static void mark_slice (intnat work) } if (v != 0){ hd = Hd_val(v); -#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS - marking_closure = - (Tag_hd (hd) == Closure_tag || Tag_hd (hd) == Infix_tag); -#endif Assert (Is_gray_hd (hd)); size = Wosize_hd (hd); end = start + work; @@ -207,49 +258,7 @@ static void mark_slice (intnat work) INSTR (if (size > end) CAML_INSTR_INT ("major/mark/slice/remain", size - end);) for (i = start; i < end; i++){ - child = Field (v, i); -#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS - if (Is_block (child) - && ! Is_young (child) - && Wosize_val (child) > 0 /* Atoms never need to be marked. */ - /* Closure blocks contain code pointers at offsets that cannot - be reliably determined, so we always use the page table when - marking such values. */ - && (!marking_closure || Is_in_heap (child))) { -#else - if (Is_block (child) && Is_in_heap (child)) { -#endif - INSTR (++ slice_pointers;) - chd = Hd_val (child); - if (Tag_hd (chd) == Forward_tag){ - value f = Forward_val (child); - if (Is_block (f) - && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag)){ - /* Do not short-circuit the pointer. */ - }else{ - Field (v, i) = f; - if (Is_block (f) && Is_young (f) && !Is_young (child)) - add_to_ref_table (&caml_ref_table, &Field (v, i)); - } - }else if (Tag_hd(chd) == Infix_tag) { - child -= Infix_offset_val(child); - chd = Hd_val(child); - } -#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS - /* See [caml_darken] for a description of this assertion. */ - CAMLassert (Is_in_heap (child) || Is_black_hd (chd)); -#endif - if (Is_white_hd (chd)){ - Hd_val (child) = Grayhd_hd (chd); - *gray_vals_ptr++ = child; - if (gray_vals_ptr >= gray_vals_end) { - gray_vals_cur = gray_vals_ptr; - realloc_gray_vals (); - gray_vals_ptr = gray_vals_cur; - } - } - } + gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,i,&slice_pointers); } if (end < size){ work = 0; From d94f1da32f75793c2dee162df82990ca6f4adaa4 Mon Sep 17 00:00:00 2001 From: doligez Date: Wed, 2 Apr 2014 13:46:19 +0200 Subject: [PATCH 071/145] [GC] Factorize the management of resizable arrays For major to minor pointers --- byterun/caml/minor_gc.h | 22 +++++++------- byterun/minor_gc.c | 64 +++++++++++++++++++++++++++-------------- 2 files changed, 54 insertions(+), 32 deletions(-) diff --git a/byterun/caml/minor_gc.h b/byterun/caml/minor_gc.h index 04f6f9953..a494db2ae 100644 --- a/byterun/caml/minor_gc.h +++ b/byterun/caml/minor_gc.h @@ -25,16 +25,18 @@ CAMLextern value *caml_young_trigger; extern asize_t caml_minor_heap_wsz; extern int caml_in_minor_collection; -struct caml_ref_table { - value **base; - value **end; - value **threshold; - value **ptr; - value **limit; - asize_t size; - asize_t reserve; -}; -CAMLextern struct caml_ref_table caml_ref_table, caml_weak_ref_table, +#define CAML_TABLE_STRUCT(t) { \ + t *base; \ + t *end; \ + t *threshold; \ + t *ptr; \ + t *limit; \ + asize_t size; \ + asize_t reserve; \ +} + +struct caml_ref_table CAML_TABLE_STRUCT(value *); +CAMLextern struct caml_ref_table caml_ref_table, caml_weak_ref_table, caml_finalize_table; extern void caml_set_minor_heap_size (asize_t); /* size in bytes */ diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index 6781abb72..b147e5e46 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -49,6 +49,8 @@ native code, or [caml_young_trigger]. */ +struct generic_table CAML_TABLE_STRUCT(void); + asize_t caml_minor_heap_wsz; static void *caml_young_base = NULL; CAMLexport value *caml_young_start = NULL, *caml_young_end = NULL; @@ -67,14 +69,15 @@ CAMLexport struct caml_ref_table int caml_in_minor_collection = 0; /* [sz] and [rsv] are numbers of entries */ -void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv) +static void alloc_generic_table (struct generic_table *tbl, asize_t sz, + asize_t rsv, asize_t element_size) { - value **new_table; + void *new_table; tbl->size = sz; tbl->reserve = rsv; - new_table = (value **) caml_stat_alloc ((tbl->size + tbl->reserve) - * sizeof (value *)); + new_table = (void *) caml_stat_alloc ((tbl->size + tbl->reserve) + * element_size); if (tbl->base != NULL) caml_stat_free (tbl->base); tbl->base = new_table; tbl->ptr = tbl->base; @@ -83,7 +86,12 @@ void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv) tbl->end = tbl->base + tbl->size + tbl->reserve; } -static void reset_table (struct caml_ref_table *tbl) +void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv) +{ + alloc_generic_table ((struct generic_table *) tbl, sz, rsv, sizeof (value *)); +} + +static void reset_table (struct generic_table *tbl) { tbl->size = 0; tbl->reserve = 0; @@ -91,7 +99,7 @@ static void reset_table (struct caml_ref_table *tbl) tbl->base = tbl->ptr = tbl->threshold = tbl->limit = tbl->end = NULL; } -static void clear_table (struct caml_ref_table *tbl) +static void clear_table (struct generic_table *tbl) { tbl->ptr = tbl->base; tbl->limit = tbl->threshold; @@ -165,8 +173,8 @@ void caml_set_minor_heap_size (asize_t bsz) caml_young_ptr = caml_young_alloc_end; caml_minor_heap_wsz = Wsize_bsize (bsz); - reset_table (&caml_ref_table); - reset_table (&caml_weak_ref_table); + reset_table ((struct generic_table *) &caml_ref_table); + reset_table ((struct generic_table *) &caml_weak_ref_table); } static value oldify_todo_list = 0; @@ -330,9 +338,9 @@ void caml_empty_minor_heap (void) caml_gc_clock += (double) (caml_young_alloc_end - caml_young_ptr) / caml_minor_heap_wsz; caml_young_ptr = caml_young_alloc_end; - clear_table (&caml_ref_table); - clear_table (&caml_weak_ref_table); - clear_table (&caml_finalize_table); + clear_table ((struct generic_table *) &caml_ref_table); + clear_table ((struct generic_table *) &caml_weak_ref_table); + clear_table ((struct generic_table *) &caml_finalize_table); caml_gc_message (0x02, ">", 0); caml_in_minor_collection = 0; caml_final_empty_young (); @@ -427,16 +435,20 @@ CAMLexport value caml_check_urgent_gc (value extra_root) CAMLreturn (extra_root); } -void caml_realloc_ref_table (struct caml_ref_table *tbl) -{ Assert (tbl->ptr == tbl->limit); +static void realloc_generic_table +(struct generic_table *tbl, asize_t element_size, + char * msg_intr_int, char *msg_threshold, char *msg_growing, char *msg_error) +{ + Assert (tbl->ptr == tbl->limit); Assert (tbl->limit <= tbl->end); Assert (tbl->limit >= tbl->threshold); if (tbl->base == NULL){ - caml_alloc_table (tbl, caml_minor_heap_wsz / 8, 256); + alloc_generic_table (tbl, caml_minor_heap_wsz / 8, 256, + element_size); }else if (tbl->limit == tbl->threshold){ - CAML_INSTR_INT ("request_minor/realloc_ref_table@", 1); - caml_gc_message (0x08, "ref_table threshold crossed\n", 0); + CAML_INSTR_INT (msg_intr_int, 1); + caml_gc_message (0x08, msg_threshold, 0); tbl->limit = tbl->end; caml_request_minor_gc (); }else{ @@ -445,13 +457,11 @@ void caml_realloc_ref_table (struct caml_ref_table *tbl) CAMLassert (caml_requested_minor_gc); tbl->size *= 2; - sz = (tbl->size + tbl->reserve) * sizeof (value *); - caml_gc_message (0x08, "Growing ref_table to %" - ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", - (intnat) sz/1024); - tbl->base = (value **) realloc ((char *) tbl->base, sz); + sz = (tbl->size + tbl->reserve) * element_size; + caml_gc_message (0x08, msg_growing, (intnat) sz/1024); + tbl->base = (void *) realloc ((char *) tbl->base, sz); if (tbl->base == NULL){ - caml_fatal_error ("Fatal error: ref_table overflow\n"); + caml_fatal_error (msg_error); } tbl->end = tbl->base + tbl->size + tbl->reserve; tbl->threshold = tbl->base + tbl->size; @@ -459,3 +469,13 @@ void caml_realloc_ref_table (struct caml_ref_table *tbl) tbl->limit = tbl->end; } } + +void caml_realloc_ref_table (struct caml_ref_table *tbl) +{ + realloc_generic_table + ((struct generic_table *) tbl, sizeof (value *), + "request_minor/realloc_ref_table@", + "ref_table threshold crossed\n", + "Growing ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", + "Fatal error: ref_table overflow\n"); +} From 88c1aec005e16a5bd9dc48debd6233e84be73243 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 1 Jan 2016 10:31:32 +0100 Subject: [PATCH 072/145] Add a failing test for weak arrays multiple weak arrays on the same value --- testsuite/tests/misc/weaklifetime2.ml | 69 ++++++++++++++++++++ testsuite/tests/misc/weaklifetime2.reference | 2 + 2 files changed, 71 insertions(+) create mode 100644 testsuite/tests/misc/weaklifetime2.ml create mode 100644 testsuite/tests/misc/weaklifetime2.reference diff --git a/testsuite/tests/misc/weaklifetime2.ml b/testsuite/tests/misc/weaklifetime2.ml new file mode 100644 index 000000000..4e18640ea --- /dev/null +++ b/testsuite/tests/misc/weaklifetime2.ml @@ -0,0 +1,69 @@ +(*************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Damien Doligez, Jane Street Group, LLC *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(*************************************************************************) + +let n = 500 +let loop = 2 + +let alive = ref (Array.init n (fun _ -> Array.make 10 0)) + +let create_weaks () = + Array.init n (fun i -> + let w = Weak.create 1 in + Weak.set w 0 (Some (!alive.(i))); + w + ) + +(** We are trying to keep the weak pointer of weak2 set when the + weak pointer of weak1 and weak3 are wrongly unset. + [weak1], [weak2] and [weak3] are identical. + *) + +let weak1 = create_weaks () +let weak2 = create_weaks () +let weak3 = create_weaks () + +(** put the weak pointers in the major heap *) +let () = + let dummy = ref [||] in + for l=0 to 10 do + dummy := Array.make 300 0 + done + +let gccount () = (Gc.quick_stat ()).Gc.major_collections;; + +let () = + for _l=1 to loop do + let bad = ref 0 in + for i=0 to n-1 do + (** make *this* weak key alive *) + for _j=0 to n*10 do + ignore (Weak.get weak2.(i) 0); + done; + (** Check that if it is alive in weak2 it is alive in weak1 *) + if Weak.check weak2.(i) 0 && + not (Weak.check weak1.(i) 0) && + Weak.check weak2.(i) 0 + then incr bad; + (** Check that if it is alive in weak2 it is alive in weak3 + This case was failing before the addition of the clean phase in the gc + *) + if Weak.check weak2.(i) 0 && + not (Weak.check weak3.(i) 0) && + Weak.check weak2.(i) 0 + then incr bad; + !alive.(i) <- Array.make 10 0; + done; + (* Printf.printf "bad: %i\ gccount:%i\n%!" !bad (gccount ()); *) + if !bad > 0 + then Printf.printf "failing\n%!" + else Printf.printf "success\n%!" + done diff --git a/testsuite/tests/misc/weaklifetime2.reference b/testsuite/tests/misc/weaklifetime2.reference new file mode 100644 index 000000000..e246d5ca1 --- /dev/null +++ b/testsuite/tests/misc/weaklifetime2.reference @@ -0,0 +1,2 @@ +success +failing From d5fffddc638df21e24ecece1ff0883d327037991 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 21 Nov 2013 18:02:55 +0100 Subject: [PATCH 073/145] [GC] move the cleaning of the weak arrays in a new phase A value disappears from a weak array only when it really becomes unreachable. Previously it was not the case if: - the value is referenced by two weak arrays and during the incremental cleaning one weak arrays have been cleaned and the other is accessed, - the value has a finalizer and the finalizer make it alive again. --- byterun/caml/major_gc.h | 23 ++- byterun/major_gc.c | 186 ++++++++++--------- byterun/memory.c | 4 +- byterun/weak.c | 24 ++- testsuite/tests/misc/weaklifetime2.reference | 2 +- 5 files changed, 139 insertions(+), 100 deletions(-) diff --git a/byterun/caml/major_gc.h b/byterun/caml/major_gc.h index 53027a7b2..b2e3bd166 100644 --- a/byterun/caml/major_gc.h +++ b/byterun/caml/major_gc.h @@ -38,13 +38,22 @@ extern uintnat caml_dependent_size, caml_dependent_allocated; extern uintnat caml_fl_wsz_at_phase_change; #define Phase_mark 0 -#define Phase_sweep 1 -#define Phase_idle 2 -#define Subphase_roots 10 -#define Subphase_main 11 -#define Subphase_weak1 12 -#define Subphase_weak2 13 -#define Subphase_final 14 +#define Phase_clean 1 +#define Phase_sweep 2 +#define Phase_idle 3 + + +/* Subphase of mark */ +#define Subphase_mark_roots 10 /* finish to mark global roots */ +#define Subphase_mark_main 11 /* before marking finalized value */ +/* Between this two subphases the set of marked blocks is an + over-approximation of the set of alive blocks at the beginning of + the marking phase */ +#define Subphase_mark_final 12 /* after marking finalized value */ + +/* Subphase of clean */ +#define Subphase_clean_weak 20 /* clean weak arrays */ +#define Subphase_unlink_weak 21 /* remove dead weak arrays */ CAMLextern char *caml_heap_start; extern uintnat total_heap_size; diff --git a/byterun/major_gc.c b/byterun/major_gc.c index ee0196b4c..f90e2985d 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -44,7 +44,8 @@ uintnat caml_percent_free; uintnat caml_major_heap_increment; CAMLexport char *caml_heap_start; char *caml_gc_sweep_hp; -int caml_gc_phase; /* always Phase_mark, Phase_sweep, or Phase_idle */ +int caml_gc_phase; /* always Phase_mark, Pase_clean, + Phase_sweep, or Phase_idle */ static value *gray_vals; static value *gray_vals_cur, *gray_vals_end; static asize_t gray_vals_size; @@ -59,7 +60,8 @@ extern char *caml_fl_merge; /* Defined in freelist.c. */ static char *markhp, *chunk, *limit; -int caml_gc_subphase; /* Subphase_{main,weak1,weak2,final} */ +int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final, + clean_weak,unlink_weak} */ static value *weak_prev; int caml_major_window = 1; @@ -144,7 +146,7 @@ static void start_cycle (void) caml_gc_message (0x01, "Starting new major GC cycle\n", 0); caml_darken_all_roots_start (); caml_gc_phase = Phase_mark; - caml_gc_subphase = Subphase_roots; + caml_gc_subphase = Subphase_mark_roots; markhp = NULL; #ifdef DEBUG ++ major_gc_counter; @@ -303,60 +305,18 @@ static void mark_slice (intnat work) limit = chunk + Chunk_size (chunk); }else{ switch (caml_gc_subphase){ - case Subphase_roots: { + case Subphase_mark_roots: { gray_vals_cur = gray_vals_ptr; work = caml_darken_all_roots_slice (work); gray_vals_ptr = gray_vals_cur; if (work > 0){ - caml_gc_subphase = Subphase_main; + caml_gc_subphase = Subphase_mark_main; } } break; - case Subphase_main: { - /* The main marking phase is over. Start removing weak pointers to - dead values. */ - caml_gc_subphase = Subphase_weak1; - weak_prev = &caml_weak_list_head; - } - break; - case Subphase_weak1: { - value cur, curfield; - mlsize_t sz, i; - header_t hd; - - cur = *weak_prev; - if (cur != (value) NULL){ - hd = Hd_val (cur); - sz = Wosize_hd (hd); - for (i = 1; i < sz; i++){ - curfield = Field (cur, i); - weak_again: - if (curfield != caml_weak_none - && Is_block (curfield) && Is_in_heap_or_young (curfield)){ - if (Tag_val (curfield) == Forward_tag){ - value f = Forward_val (curfield); - if (Is_block (f)) { - if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){ - /* Do not short-circuit the pointer. */ - }else{ - Field (cur, i) = curfield = f; - if (Is_block (f) && Is_young (f)) - add_to_ref_table (&caml_weak_ref_table, &Field (cur, i)); - goto weak_again; - } - } - } - if (Is_white_val (curfield) && !Is_young (curfield)){ - Field (cur, i) = caml_weak_none; - } - } - } - weak_prev = &Field (cur, 0); - work -= Whsize_hd (hd); - }else{ - /* Subphase_weak1 is done. - Handle finalised values and start removing dead weak arrays. */ + case Subphase_mark_main: { + /* Subphase_mark_main is done. + Mark finalised values. */ gray_vals_cur = gray_vals_ptr; caml_final_update (); gray_vals_ptr = gray_vals_cur; @@ -364,42 +324,16 @@ static void mark_slice (intnat work) v = *--gray_vals_ptr; CAMLassert (start == 0); } - caml_gc_subphase = Subphase_weak2; - weak_prev = &caml_weak_list_head; - } + /* Complete the marking */ + caml_gc_subphase = Subphase_mark_final; } break; - case Subphase_weak2: { - value cur; - header_t hd; - - cur = *weak_prev; - if (cur != (value) NULL){ - hd = Hd_val (cur); - if (Color_hd (hd) == Caml_white){ - /* The whole array is dead, remove it from the list. */ - *weak_prev = Field (cur, 0); - }else{ - weak_prev = &Field (cur, 0); - } - work -= 1; - }else{ - /* Subphase_weak2 is done. Go to Subphase_final. */ - caml_gc_subphase = Subphase_final; - } - } - break; - case Subphase_final: { - /* Initialise the sweep phase. */ - caml_gc_sweep_hp = caml_heap_start; - caml_fl_init_merge (); - caml_gc_phase = Phase_sweep; - chunk = caml_heap_start; - caml_gc_sweep_hp = chunk; - limit = chunk + Chunk_size (chunk); + case Subphase_mark_final: { + /* Initialise the clean phase. */ + caml_gc_phase = Phase_clean; + caml_gc_subphase = Subphase_clean_weak; + weak_prev = &caml_weak_list_head; work = 0; - caml_fl_wsz_at_phase_change = caml_fl_cur_wsz; - if (caml_major_gc_hook) (*caml_major_gc_hook)(); } break; default: Assert (0); @@ -413,6 +347,86 @@ static void mark_slice (intnat work) INSTR (CAML_INSTR_INT ("major/mark/slice/pointers#", slice_pointers);) } +static void clean_slice (intnat work) +{ + value v, child; + header_t hd; + mlsize_t size, i; + + caml_gc_message (0x40, "Cleaning %ld words\n", work); + caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); + while (work > 0){ + switch (caml_gc_subphase){ + case Subphase_clean_weak: { + v = *weak_prev; + if (v != (value) NULL){ + hd = Hd_val (v); + size = Wosize_hd (hd); + for (i = 1; i < size; i++){ + child = Field (v, i); + weak_again: + if (child != caml_weak_none + && Is_block (child) && Is_in_heap_or_young (child)){ + if (Tag_val (child) == Forward_tag){ + value f = Forward_val (child); + if (Is_block (f)) { + if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){ + /* Do not short-circuit the pointer. */ + }else{ + Field (v, i) = child = f; + if (Is_block (f) && Is_young (f)) + add_to_ref_table(&caml_weak_ref_table, &Field (v, i)); + goto weak_again; + } + } + } + if (Is_white_val (child) && !Is_young (child)){ + Field (v, i) = caml_weak_none; + } + } + } + weak_prev = &Field (v, 0); + work -= Whsize_hd (hd); + }else{ + /* Subphase_clean_weak is done. + Start removing dead weak arrays. */ + caml_gc_subphase = Subphase_unlink_weak; + weak_prev = &caml_weak_list_head; + } + } + break; + case Subphase_unlink_weak: { + v = *weak_prev; + if (v != (value) NULL){ + hd = Hd_val (v); + if (Color_hd (hd) == Caml_white){ + /* The whole array is dead, remove it from the list. */ + *weak_prev = Field (v, 0); + }else{ + weak_prev = &Field (v, 0); + } + work -= 1; + }else{ + /* Phase_clean is done. */ + /* Initialise the sweep phase. */ + caml_gc_sweep_hp = caml_heap_start; + caml_fl_init_merge (); + caml_gc_phase = Phase_sweep; + chunk = caml_heap_start; + caml_gc_sweep_hp = chunk; + limit = chunk + Chunk_size (chunk); + work = 0; + caml_fl_wsz_at_phase_change = caml_fl_cur_wsz; + if (caml_major_gc_hook) (*caml_major_gc_hook)(); + } + } + break; + default: Assert (0); + } + } +} + static void sweep_slice (intnat work) { char *hp; @@ -634,7 +648,7 @@ void caml_major_collection_slice (intnat howmuch) goto finished; } - if (caml_gc_phase == Phase_mark){ + if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean){ computed_work = (intnat) (p * (caml_stat_heap_wsz * 250 / (100 + caml_percent_free) + caml_incremental_roots_count)); @@ -647,6 +661,9 @@ void caml_major_collection_slice (intnat howmuch) mark_slice (computed_work); CAML_INSTR_TIME (tmr, mark_slice_name[caml_gc_subphase]); caml_gc_message (0x02, "!", 0); + }else if (caml_gc_phase == Phase_clean){ + clean_slice (computed_work); + caml_gc_message (0x02, "%%", 0); }else{ Assert (caml_gc_phase == Phase_sweep); CAML_INSTR_INT ("major/work/sweep#", computed_work); @@ -691,6 +708,7 @@ void caml_finish_major_cycle (void) { if (caml_gc_phase == Phase_idle) start_cycle (); while (caml_gc_phase == Phase_mark) mark_slice (LONG_MAX); + while (caml_gc_phase == Phase_clean) clean_slice (LONG_MAX); Assert (caml_gc_phase == Phase_sweep); while (caml_gc_phase == Phase_sweep) sweep_slice (LONG_MAX); Assert (caml_gc_phase == Phase_idle); diff --git a/byterun/memory.c b/byterun/memory.c index 54391b7d3..05f95a266 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -445,7 +445,7 @@ void caml_shrink_heap (char *chunk) color_t caml_allocation_color (void *hp) { - if (caml_gc_phase == Phase_mark + if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean || (caml_gc_phase == Phase_sweep && (addr)hp >= (addr)caml_gc_sweep_hp)){ return Caml_black; }else{ @@ -486,7 +486,7 @@ static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, Assert (Is_in_heap (Val_hp (hp))); /* Inline expansion of caml_allocation_color. */ - if (caml_gc_phase == Phase_mark + if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean || (caml_gc_phase == Phase_sweep && (addr)hp >= (addr)caml_gc_sweep_hp)){ Hd_hp (hp) = Make_header (wosize, tag, Caml_black); }else{ diff --git a/byterun/weak.c b/byterun/weak.c index 8be7a1810..62b62ef88 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -77,6 +77,18 @@ CAMLprim value caml_weak_set (value ar, value n, value el) #define Setup_for_gc #define Restore_after_gc +int caml_is_weak_none(value ar, mlsize_t offset, value elt){ + if (elt == caml_weak_none){ + return 1; + }else if (caml_gc_phase == Phase_clean && + Is_block (elt) && Is_in_heap (elt) && Is_white_val(elt)){ + /** Must be cleaned during this phase */ + Field (ar, offset) = caml_weak_none; /* just optimisation */ + return 1; + } + return 0; +} + CAMLprim value caml_weak_get (value ar, value n) { CAMLparam2 (ar, n); @@ -86,10 +98,10 @@ CAMLprim value caml_weak_get (value ar, value n) if (offset < 1 || offset >= Wosize_val (ar)){ caml_invalid_argument ("Weak.get"); } - if (Field (ar, offset) == caml_weak_none){ + elt = Field (ar, offset); + if (caml_is_weak_none(ar, offset, elt)){ res = None_val; }else{ - elt = Field (ar, offset); if (caml_gc_phase == Phase_mark && Is_block (elt) && Is_in_heap (elt)){ caml_darken (elt, NULL); } @@ -114,12 +126,12 @@ CAMLprim value caml_weak_get_copy (value ar, value n) } v = Field (ar, offset); - if (v == caml_weak_none) CAMLreturn (None_val); + if (caml_is_weak_none(ar, offset, v)) CAMLreturn (None_val); if (Is_block (v) && Is_in_heap_or_young(v)) { elt = caml_alloc (Wosize_val (v), Tag_val (v)); /* The GC may erase or move v during this call to caml_alloc. */ v = Field (ar, offset); - if (v == caml_weak_none) CAMLreturn (None_val); + if (caml_is_weak_none(ar, offset, v)) CAMLreturn (None_val); if (Tag_val (v) < No_scan_tag){ mlsize_t i; for (i = 0; i < Wosize_val (v); i++){ @@ -148,7 +160,7 @@ CAMLprim value caml_weak_check (value ar, value n) if (offset < 1 || offset >= Wosize_val (ar)){ caml_invalid_argument ("Weak.get"); } - return Val_bool (Field (ar, offset) != caml_weak_none); + return Val_bool (!caml_is_weak_none(ar, offset, Field (ar, offset))); } CAMLprim value caml_weak_blit (value ars, value ofs, @@ -166,7 +178,7 @@ CAMLprim value caml_weak_blit (value ars, value ofs, if (offset_d < 1 || offset_d + length > Wosize_val (ard)){ caml_invalid_argument ("Weak.blit"); } - if (caml_gc_phase == Phase_mark && caml_gc_subphase == Subphase_weak1){ + if (caml_gc_phase == Phase_clean){ for (i = 0; i < length; i++){ value v = Field (ars, offset_s + i); if (v != caml_weak_none && Is_block (v) && Is_in_heap (v) diff --git a/testsuite/tests/misc/weaklifetime2.reference b/testsuite/tests/misc/weaklifetime2.reference index e246d5ca1..cfb2161cc 100644 --- a/testsuite/tests/misc/weaklifetime2.reference +++ b/testsuite/tests/misc/weaklifetime2.reference @@ -1,2 +1,2 @@ success -failing +success From e402d38dfe81fdb919f61d14dcf87dd80aaae910 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 25 Dec 2013 20:15:39 +0100 Subject: [PATCH 074/145] [GC] add full-featured ephemerons in an inefficient way - use the generic abstract tag like weak pointers - a weak pointer is implemented using an ephemeron (one additionnal word) - add for every full GC a complexity of O((n+m)*(m+1)) with m the number of pure ephemerons, n the number of ephemerons used as weak pointers - multiple keys, modifiable keys --- boot/ocamlc | Bin 1960740 -> 1973124 bytes boot/ocamldep | Bin 614483 -> 623939 bytes boot/ocamllex | Bin 264162 -> 264421 bytes byterun/caml/major_gc.h | 4 +- byterun/caml/minor_gc.h | 26 ++- byterun/caml/weak.h | 6 +- byterun/compact.c | 6 +- byterun/major_gc.c | 175 +++++++++++++------- byterun/minor_gc.c | 75 ++++++++- byterun/weak.c | 352 +++++++++++++++++++++++++++++++++------- stdlib/weak.ml | 2 +- 11 files changed, 509 insertions(+), 137 deletions(-) diff --git a/boot/ocamlc b/boot/ocamlc index 21f16c8c5623d009e7e31a53c38b5a5e0fec7d2b..c893a8f7e41e92642886bec78d178626c2f77511 100755 GIT binary patch delta 191820 zcmeFad3;pG(mza}jhQf$%rIF=LJ|@nY?82VLL#ezk_fWMmIx|BfJ9J4wgf?tHE|$? zSI|UIQGx`6cMw4nL`4mnTsQE7hU}G(!B?4TkrPZQ16ifhd0M*^VYoJpo^WAP%h~G?S}bK>azuN}-4oj}aWaBHxECP^p#{QZg#Vj@ASP$?Xz{YQ zUGw4gYO|nblpZB{yoJq2h*!NQo3C;I6A4oh{OtL>3p^{uKfNOKoT&CTgg&DGkM!?Xl7HV09Ws=4IgM$l@gI84pME5h@hGxS@GsZB%3LFImLTwN?aJX zXF3Ac%^?c`DG*`dWaV#C(6Ra9cm@JsL|<+;{hx7;f|o|8vFSmfK`;p(3Hx!d_BS;eG1P&(Q%1 zlOnu@6Uy+kXHp06^ojd)+!XvTnABOvF2(=U$x|Vl%!cqdy7-P{qpW1~VCCd_ND^7Y zz4=q}^{4llG%LE|bk-sP`hwC>51si|*u437bu*J{?s`Z@Qu?cr9!g7)m5Qu;4v7B} z;=Q0Qn%85$zo}tE1>o*;j1Q z-jZ1kknWnrrDV>o@KeOk;Sx5@`AhV#D9RnEs7;|V$zJh5wDk z;~z^FKT&Ceh^E}55sKHg`XTXiMZxNSHx*?SlOAv85M`A8ne3@p^ps7AGH=7PiImby z4)x}4RVpf;qAc&87vjV`Z!M@7dC%hij0*dU6GYf@Gn0gv|JdHl@Sfd? zLBG=>p73tn84X*-nOA#{?~IP!h;(ZuvjO`n$**viO%UQ=-dVe%#mC;qc16d29Y8+c zLarC<-M-7^t>5Jkb>2(J^`STFrTOBdx9BC0QU_Y^q8DQ-4!?9!2piQ_U|?j#V+ed* z9;(`)RRgFfGo*tz-l=#y?y(spuo~@TTSdm6B#e)W2VVB@FnO$EIR1Z9(EzTg;G(z@3at?DgAkSw6|tHM&CJyQgLAa79mbk zksD)w-hnORmkRg6FNHYcZFoIG{Nyco%~KKcMxo>`L+LzV*z)rXS>`=h6%obQUI>pM z@Eum;JM6u>P?UTKgBw<=!&GnjuB#*FV!U? z1T^kuw^(RIbExJk#YX*_iwtp=Y6paPsHC}=j_0Dm7%s^k(GB?~dBh_EbDHlzq2g0E zI(c)2hpNLx4kP7$lVhG3IMu}%cwePVO;vJOY z%Zw4S(1ptl3-&hbjquHj6&ocKlHS4Qp_q7a9(3*m;q476zB&N|rSeX3L7evCxn~IC zh8f(X(}WoGIijEW?90g!8)Y%nCvwHTJRkdJ>=3PVHrKx()-$5zi=w^654V&FO@Fxk zCGnE}Ang%<>J7g9viMf$%F~Qe+e-s|9bXYSVVvn7?}=w*e(3*!DAvox!#`rg>@o>Yj~-f6iyfF#5`tV_9^ik7p9Yy7dbJder=E;rH${{ z*P_N~Mi3R1Xc2VyTQPzQY5tu!#Q8t{PTXTO;(G%j{a^~`hBKn2o^sn+@gQfp9ICXW zug{7z4E*aSU6zb&;ahZ0L<*h%H1O}B(tYTY@_L;^YSSPdMh@=>ox>?@scfUl1`(=P z-5}cN0=fLN7~?{B-yusKxGl6ym6qtT529Un$PpByNz=Fph{8K;ii2u2X%IXQ3U4a4 zg32_MN*)@~R5~WM(w>pcBB-BDTGi-rv87@&7Y^};Am(x8qEj|0TDa(v5k=Xh>$qsv z48BaeG>1n(Rgkojxxb~Ev_y!z>0O63QVgLervxv9(w)-t;syHNDGe7ZDLYu|AU-yt zJR=(F&AtLJw435P7Az&J$O2(J(!3f>u^I3WbW~6rD&3^Z|MM`Z1xw|(FsZ+rm4v-A zwioOfyJ>K^^l#zzB}7OV57oZjk_fJQ6xhXqc+R0$>O$_={Z<4-~VQZp>NPpQxUvF*aXi6C=T~OI&zJpS`J7KCb zq-k7BhX@bt%a9&I>8Y90QtppEw@YnR7GE$Gu^!alE~V(I$TL>FH~YyrZ}kF~Hx~;# zy?bD3MoIBOjq1UZ60662)aIX{T)sV%(2t@ojh_NF>Fax7iqw@Wdm&4T=4QX0CAC+? zKx&vKO@PuN8tL0|w}dfY?R#Ll1Vdj=8a!KH9)N z(4s)^b6=kVNn)07TqgO94r)vJw_~AE0vkgm>5_xe9>I`9%O8D2nk~djl({OZEyb*m z3XzQ+TspEsN*24RVTIJy?bl|%lJ53(e^i1qlI+{MQt}G%Af-MgCANDIEb(YufWXUG zCTI8|1Re8KPJT`EHaaMLgpl1*fF^upH1SmAP?0%CUtAQ7Wf>5mIz!dFSim9 z*lFW5&R0b3R!eQWH-bP}xhMqeuY#Z1cKA73MJrZ=BX)AQq$AK$rNYSD$Q21`2!!G^#VMeNALuC%E1WxaUUMIoWyx?j>{mPM;XqPG$C;7E7*ZIrSu%;inVQPl2`P%;&Lhxxj4Y$%ov!xhTiDDpYYE4P9BCu0dqILjhT~6 zeklp2I_n*&TJ-XDI>K`ZcN1%%KT{dy?NsBaygbZ7gWi)mik`l__oU7;m?%9e4HTDs z-yD?|M!^DPe+t$_(#yfHfqB14ZEd<$c2L7R5M7BQ%tePUOBY2JRb7E$+)nN} zp>gn)o7%i-U2K%GRF0u6hpfD^NDd7`5k*1rPzlq*afj?{4I@_6MNSl#D6_vOf~vd7 z4xo$D0`8*X`nn1orB?% zC^TImBn@H?hM3a^%a|m1c6l$C6g*14M|XL7`E`YAZ6R^I8Kv)7uvy{4t7+FL z8Cw>h3>hQqQ~Et)>h2W`xI^7vm|OBs-iV zLC${$(+PLVeZ%}4Tz!ocGbzuS#QRJ9XXL7~Ch@|W|BNK}1hc?opqO3$Gm^3=$Z-jN zPq{PD43Z*sr-F@iPB)KiiwaY|#azMvyohU~~u~gZ{ z>zS?3R67wp1dp`k8Amw9-vOyPASZMQWD`LtljNjE0bScvNFjpq{pr_lFSGRdB>4vJ z>Y&N;exdiq7%DjD@lZ-hs6us9SaW^fOpzCg1l~7di6{s%0vD>9u+i*-Y#A$DR+l+k zcFViuKDxW@q||Y+_PKYVG?7H^0=a{)WU7qCrU_h_hG7A>*?BMY(?#v{$T#?2`6C(Y z+^W$LzLc3Vj9VmC<)B^lIkL?i0z1S)<9RI#p#?Q?TKp`exdYN-C}9@TGC0kHG*(Z4 zzLu29Y5ANM7LYHV3OMZ|(x_w>7*3+2Kt%D5XAiD3psZGOiRr7EK4!KYgVj~<+47fk zAP1e+mYj3s#CFKmxUtR(#}(}+CvU#9W+l^}As&yrCmwlNbU@%LlPP@;_TviY z$Tn~@X^z}As6Dvg4#3p)#XNf}D!JmpYN(}Cp^{!6g{tSs9gB125leX{_6IJiJM!^v z02j|4$}We$lgHwDJc3Tgabq0@$IK3oAi8qp3e)sNIvWP78gtnr5SXqNNPiDj+*IRm z*i_EZi}oy+qt)KX=%7?h@leKgaQk(quw*Bz*qsQY5qeTWIeV)?9wnR|>ORQ8`TLr2 zKZ#mOm~uM4^G}Ca?qx` znvAI%nC4EWCE6owJtz`yTxNeTA>Sh_oHE#tE^2Qg0Qi&HU7RO&9HmbiB{@TUX&1`hh zDN<<5lnCs?I&t8(BPr577+JZv#+cmm0y%DQc7UM9pfoO(1#;JQ z(lp?CfU{AEMBoxzQ)z+xku+7J%gf|&xV-C@$t$J1q2*JQ_E;~;@q_QVPElq@Ho5mY zX?_-_Thr*-N8}3Zx{E(xPI8vZgTxGdM2eY|sVLD@|8!G@&McQB-8smX49<8Qb4zAX z!*>uy&1o35*-RWqS>HI|^sbPTjBKk`$jSCxe>Qqyg*=x!J}P5QCd*RWAa7RxOKIB?%G+`_rw}`xTH@_!E|(;9Ko~IZL>mKQv7=P zGy_2!WPNX>%?7!RPUoVA^*Wtz#s+x|oFZRUp*&y0s@CwEy)y3!(rPa}rfPcCD^Ji@ zCp>H&l=qL&L|@uQc^o@a4bRCPnDozLc{ODe%Nf9x7RzIS^8xoD)8uWI=Og-lv%JR0 z5l8tQY>Iv$f(AVycWuE_2REL>Y=me89@r@5hbLrgOu}mjep3Eae5UUN{F_R*$bIz! zR_lljR}u4c#C%4K^ z*_g<9RP*p-bzz0BrazvM$BKB$+$MXZ_E=vH(!$Agx1>=1HhB>e^b;o6cBoT4#cr2( z`wyM!w#$)zpXBRiSjjyr=NRMz=)kk`JmYyPc7^D+ND)qD&q0f?O1S0o@;w0k!u{fT z`A$X3m*}=HLR)%WDT;4mnLJ%kuQEB(cVZV*PAsFvyXBEV!@xBw)guzEKO7eBJF{D^ zQ^j)M(O2X|MXc~OyedCw7mw1qH{tKBq=avw((#F*Np#^&xu3L3qAvzH+t9?rvQ2#q zIvP!RGcjKB56huqHPs%*c#H2ErBK;njF*kTlIuaq;j2F^M=I)CWQd_X|FA{Sffuz< zs;h^QOM6!yA=dfUy(@cUv7Sn+;U=x{9jul&s8mu7n^cqIz%pk+u#4)tIg+U4U-CY+ z5GA>}YIt5B$v8GBBIhS?s!~oNUZ_^*0b<5S^+*KjzND>O1YvW|36B44zWWPEDcBk^@`OQxtdr--SdP zg`~{J4pI55Ar6%*b9?hP!7TZj;mmG+2wM8B4TmCUnkhJotJ>HsTD5^lqghYdBUBy@ z*qI&;$DuBswN_?3W6MqQ^+{>Hj#^2F_``)%Y#B?0ue_RRwIjLb)M4Tu#rlXSQRV9{9%mM_SYq*JQp$YxNO_ONS z#IOk3^1N!JuSY@AGJch9o%~$0m*wx7zvY@z?~^0KSP0C|90Yx#3AZnpX3db|Qkk{D z68}dz=q0vhwQwOYDVNMWaJP6|ly;A#M0Etx-;FEKM$X8y{6H$L z!sf}|kPw%+oy6$o5l$}eW`tw}g%WPSasKvyKmv=-V9-?_aEFGm;5ZfKGzmj66f`pr z1(n30Q%Y`tZf5K=U~|i z&&e)PVyJV+6`}ABy;#wnprf(w2&|qGQeiCXLa`~8;|;gbnH$1vP98{Cd$wV>9lK`N zmRD*iZ(nqji&74=Nl6TYnQ=xqX0=2K+#nvN9CObzjt2z8tq^1c)tEbbFOJDiV;<}~itzCeG*_nr9VR<^B<5S zss037SN<#Jy2GEy#zD|l-I3D&x88~@{&8_Ho_X=fwu9Ts#pzO{%w{OAoUlP1nQeDa z^(fpX=~Wq#^!VC%s`Ef|GgeB9y;14`^q2=yD4 z{o!Y}2dozS9FD-9%+Fy6tN{ERiooWYpV{895#wie@_3mxltfumkCV}iVznJgr((l# zXm+Hj;$)n^Iwy77EX8$akkS4cm@|g`wQvy(`)gv&Zce8Nruj@tSY$en9!_V@m=hkj z3^UiPj{MB6;epD}+)5tI{LHN%=xx~Hp+&uMtleul5Ilz2G5y( z+{eHbKP*Qkurje3;e8IS`FT9EI&kgAsWi@m*bdtq8mI4&X!3ly57o_=m8JgS#Uqe2 zu`#&`fir(#!dnpgS-lU>Y`$5G{UXW1Gmo8_mM{a)T-gg?hSNhq;IAtWuvrETb*oNF z`K76%-p^P{cjL%Shvx>s^8(-p{ug+@o^A+xzTAt@TS}wEm*|PLzqve*KVoa{hA7!M zuxR=3_+NC}5UGvVwKi!mHV&*aQh^ijBH zlKu$LF9aruN4Oro)!*Qgu7lV4rUKcCn*!Yx8_u{JZpN;`6MuStTGm2Lqx9HNPw@#j z7=>+GFmIPgnlTTnPO>j%u@@;%nZlly?IG-VldT4 z*$2?(WGo!Ikoz{QgmZ7lR#yJ5C`_VJ_7s}FIs{YkuBc?{SR0v3tK5;1-p#FDRPK&+ z(TUo~eUx#B!)5=_EVh=u8R>{?ciaU3ZN?|f_)9ZBWyYUUryuPRUXKIRE??YM~7apk*nq;!OBsd$JCJR}g!pCcY<+ z%T7&w1v>Cw+YohMVjJS0zD{-Whk}-$g%gx@R8oAA|B-hHvCoGsQtX<(N=LuJuEBoZ z7U>YiHM1V_(k=mk_3bsv{#I@)I?-d_%5z0Jr5^IY=v87}=IR6|EbTkF95>{##~6(Z z`OecIecg!OFrrE$s-j(|(O-vu#?Hlo({j9cQ%8uyM)Z~uy=_GA=n>63?5lL(NGlmJ8mq$}8Qgzt zF!~8c5j63Pd<>25eiplIpBgKa_y_DZvPF7a-mEWh7pE({=gPC#B?_ZY&dNi@X9iWb zpX6cU7%lz@yJ*KL^E{@A`k$~_)`>3tBySU+Q|UQ54p7xOY~20Z$iq9;c6P7Ws)bQ% zz1&xH^3AH3=ZLTq;IG&jC@w433$)(tUHT=c?^Uv65V~Q@6w*xL>^)K?U z8@c2l@4X2IFPFs+0^+qXC zzd?vUQ08xP+c2wWSOmP^;iRH(Lpo4-gTNa4H>msyI`x~J7{#>yZu=3>jon7Eze6?7 z@D5j^ULQAGuM6=iYB+~6cGl3Cv^Lm<+wnV`9WIUOxI=!TqraOy>hNdv*4`FD*sjI8 z?u1bE!@P5pdO?m*Ij4D;mvsT=A!V#$8_&hmBf;usp+-5@2H%m2;9|1Qz&p{_ReV&FKtTQ4>Cf>|oFI~!=W zYJL@UT-ETfKakEr9)rMRmbv%~_&|yI5AFP;@FHkfZ<#yJ zb15KCb8?Tv%|?e4`zM8e$hN4+O~Y3lxvOAvB??u8|%m%aM~OBB*q#bCib;ca3y8rvbhL;XL-? zrcza3oL2SQ9R_2)Lb5s09DOvkM|sI~>9w##y7-rDEB;G%NQz9sf648GRq%ebUhnIC zJL)faT(EWxo`RFZyHM65H(u)d3j@0;6*R@-BjuuOYhR68*sQRg_|?N^N^K<2cr*tT z-LMOHxbyQ>rMLinn12zQYb&VeB2KRCGQD_FZW9y)Y8HDlnLfWLKaM@NQ%#i!8rOrj z-!I9o7S>_NGU63JE0>W_bctx2}JPTF&`&7=Mc z2fM+v=TYp4PQ#;>G9m!B0}i588QxG#T(Hd@3s0X*;_BIc2T|S)MSco>&LZ5@O^KA6%bRXf`b!@9mGw#sAwtRB z7j3Q-%EYA}Ox%4@2wR(h2)vyz9DxNp3Slh51cWIFQxWb(n29h4VJ^aage3?o5FSHV zhd>A~BYcOzZzZK7q$4at*o?3Pflnb02yCWT;b9IGnL{m}zd`s7L4$IIBeX&2fiMIi zA7MX2I9fg%VF|)|geMVpAiRQb2%!$)F9aLPY>p6v&<5dd1n$c)q#6FoQUk#SS{;~( z05~!LjtYQV1i;Y&a7+Lk>xb_HH_TB>Kf;9L0^s-nI3WOT6#yp&z)3P)mX#J#Ya?#n zCLq17Op`le?4+E=9i?O*6S(nfQ(T?ef$-|^HEe<3{L4YQvPNSL9iif^p*~2#*2E=%SsJz=yHJs;jKa-R?+t^) zDeL2K#oY}BrJ)f15#XYIvV<2o@(@Be}IJ{H!S&{hY`8aG$; zGs-*R0DCnG{>3*{l7st$+V2qzki9Pr3J>E7(gJu&=LUAL-vl%#4zZkWB{c)$nYIN+)Sg2*Jz|Dd9 zP54)zA8Zr18r^W4QBd7-9I3d@;W#oy4NIbYJA^cnR@jw+B7@$wD{V!lL4UiY;!y@_ zv;}pCff{2$jWtl?EU57Y>P`a{-%RN!CK#xRl<82|Mb>p>GNlGX9#g1_MIY+HrTF@$ z&}9KPTH5zxK|t6q3t@jCAH%y6}EW@?36x zw3w%Nw(cK3V6@>ui==ShfCtM%1}e>^#ES)#?NYkpx`!SuG@?ZuVSQKT> zE$8;o7Ic$XXB3EYdv5Rs<^fCoP-UNfZ7bbK(aPnD-C|M=G~7(Or?s zWSuBV(XXWb5T&%z(_1Kyi$Y&%3!rh}4~4+nGDG27pN>(sba^~LVBP?DV*tEKrVnD3 zR#bP~jl*sJmmjMrt%?K4C;;B9XKN##pc`8%(e8f)BtL1Ow*;WK>ga^00?TEY zAXFk8MmT~{jZlN|F~Tu~69{z(Un87GID=4+a30|T!bJr3gcSjQSHIE&fZcrFz2TRh z*?oxj9gTzHsO)<5^_`4YHb|+T!O_ZL7=hiS4hSG^G6?wTh#d%++jSg!`(?B>5f-A1 zQaeH|D@TOG!+!;9&}h)J753+EP6@w+dxT7xYi*ve^Ki;SkjhRNQ}BQ}NC`=bC+uf) zN3|4U=F#>H;%1b+2IuS(laxqx^6y}TP7UO@Ns^S%PVE>59WOqIA#k2;$diVcCBY2) znZPyQ=D7bZkcG*%)7d2OzJ}D+${g{m?}66Jhx`_#vz;=5N|KcvgTq6cz^0VmTbN5z;im=^C zXEV=f{^cPSJAGgR^7|--qMTjbg<=mC4daRQEt}#i>kCsWUZ$h{l+WxH$j{v}oeKK1 zV%(^th-azcMy0EL@3l#3{W00FgE^f_RlCPm(_hIIctJHiP3funfOk^%MMpGkPE+=Z zeRONO@;mkd5yjE8o0PSDZR#d)jM94#QhK_dMGp3(Vi35Y`>9}%;thWdXco^vGnj3D zX^7H?Tq(FAkuzAy!tUVF!O8&a4zeF#JWRnM+Yro~uT%ETXhhw!*vZHRBK(cNE$tSy z5^2Fyy8}B?@oIDU4?~q{QB`IJqgrE;7zlpJ^vy8z$lJ{8!oR!e7Jmy?E$Hh$w2QNGLrD_v z^RvfyF+=HRytbQzo9+1cMaJ#Q=CBm#)>IV4OCbK^?x?0qw<{B{6N)IB=8ZzWuC!;A z(pT*YYK01hEBfug;L*zcZbpS6(?A4P)>PcQQl>ITzl~NtmBdLpI#%hRegMfdqoP-^ z#o!vJ43j>T>7@hW1}g6gZ;q`IZ5*c*wypsgvrucs|1#r`%=lx(!QN9jFf`+pMfOij z^rya4&7FLNRWp8XioN29oHBs$pf)=_sXj8i5na=gjsBbFDzU6uvu|AuC=6Xw8NkO z5Yt`dECu)Rs^QQLyD21wT$ga=F86)-tSjJ$mU-O{U+yerhX^}~Qdr#wAuun@YzQUv z2*qyUcFevdqhY8=%uzz!Um%5TN+TuZ%~9g)Ujoe;pQR_}D9=an!p~n0u(}*i0hdOp zH#$OTR<6=EHq^Yy6iD|Urt`WFdz`1uRlIJGsYrw7U;NnaYF-Sybq$|&nI`8c?L{|A z&4Yms#-Q7e7Ia)x+IT}swxrneL;wY3ladeTY z<|@og!2pLxoWd6d0DWvAs|;j06_o?IRY!)c#e~Ki4J>5;M6}ePxZlWjH|~)ueet&1 zt@B{*gT8{iSh0eFX~{sP4V65g>=R#6RX$ws{E^W9uP9*w%KwT=A5=WjS8#5A@q|U^bd>#tE9*Ujp{UBkumplXG{cpXPk4=Er0A5@aHK*}sP-4U@RPex*=rItJfyVMxB1-PAQLmx$Q0eT2xCQWWml?M ztSH6n+{u)+7$&%6v9cqKYhhyM+SSPQq$SE{|CK3a35Lg(rApd0nXWdqVX5+=k!c_z z_X=H<>5nQsDWgDHt7l@*rVBF7))+bCis@Gf(QQhTy`#wapQ<_wUU9Nt@+B= zDCfohkdNwCDGuNHbxNfikTdCV#da0vOW&kKgnP4wqL$}z2W!OFIM>|L4kriYxme#h zzQ)^^CAl`oRf_y&eDawetax*-U~?iRIHovDQexTdoQ>eu0d^}{@CgVo=fyCpx!rBa zjkF^ywDa)H7US<|b1by%IR((x{EByV(|(hZ{7ky^8^%{}6K3sHCgN!9;7%pZX|+tX z)cxMjxYTVhb(C6~FI|Ikw3v5U`E1S%~ISYGQ~7UyR6$ zwRw7vHYu7}DAG-wm9GNxE;Wbzc7K&3UR=SG*AkB@)+y7kwe zMyG~aa6gzhp8ouF$0)NOPH^5alOilhK1vUfJxiZ6lcFq1#U_pqll&zuH*tJ8=f}-6 zal9Jw)>)gOCRo4ZeF?<34T=rzR5oTH$&`aYz<&5V~YS=8Jh{% z%Gdp<{wldZauw`gUO*+xRy~@a?7F-hn8mp@Rg1rSRPhSJJ^7JWSD^EuNTY1_K z*veBGU@K2g{eI=zaajn0K+|1d;{3wmae2Rqvobr?#90|0X5y?&_Xh52KBY;M_P^5? zWy%t=gNs}h;0=5>rAF#E^GQd_jYz1tU!v?@sITQf4%3&^GOFy)4 zayJlxau{Rcta2Di=|07CS1&Wk%40hdXXUeniL>&0mm+991 z$|xEZ)y#4GTR3*MGP4t~m6<02TbWr4*via8z*c5*&eKnI?mkPcWwZf}RU~16t?8HX z3W~Lk?*Lot_z1AIjzfU04c-ITTK+S?TnV|RQ4jw@x9wMMrxX3)f7ZMPExjQiOEh3B zOB!G+OAS9?%hE}}R+g#(TUmMyu(c0f1Z-hZYVss~^06A%d_M42@lX1hCcmc4z&As2 z1E6lMU6C#}(B;>ZHquT#Zb4}Wu->?nZasi~bi0Ww1WtOro}M}Y!u)#9fD;2I>`Z5w z@X$FO*ULKJ^*U!LZ@9&9p8LtbStq~efuouwQgYax*GYBYYcPr@eAihcqjhSWbe4jh zQLX66LB*vG1p!Xq-@*6Q>JNgk?!HS0m9fgwp{SjA>3GC;Mqn6rMTb)m`!5@&;(4%% z?}C_jDL7A8gn{OBH^iJD{(_#?-GuoPMt=nMSon|gaoLEy=T55$oW}Dv|FP%5&%F`8 z#Zr^k-``WVJtUeYj>b!FC5NyPcZ^OQQg*w)LptjzcQo%Oou<+^aRB!{9e-1aQ+cN) zfwF_JQR+I3{b~a)vSaTj?Jy2)exQc8u#Iqx@(yEv;ztXFH=hsVX6hNrHV78Kh1GJ* zTUbq>MVZF#C{@l?6=Y6-3#U#$StvV*bC#kyh&Wj+PVG>`W z^iM!s_OY_cdD&9P6~>RHjU80%o^?{eM?lxKQ zD&wKTpD9T+>;`KgRJT}7(&Z9FXMaT;I*CKUuPF0N#ZzoovE7#gUNe5i$?`F3IH^SF72*EL`zp%& z0$b_^aa(J02o+3HyHd(oWgNxVp&Rt_{+k5**>%b^q^94cM*kfV-XlDv2ly?l8m45(; zjJde*TmQAP<$5C8dfG3d4PZ3ydz^z>Mi3hg>wi#oNYK^xKPr!2 z+jKA`>cN!l432+}k$6uvgl?yzGpP0&SsJt(sBoG(jB3u}^y50o5j5-B~(?qas6thhWy z>fKI7zbU(&!In-AF*-TxcZ@)n1@ETP4j5VS7nF`pzB%OACQswYiY#6YuFEedp>{Si zJf#ezQy(gczWNKwXj9X8Gi7$=&KlxtUcQyS8ZBZnO`WJZuW>?&ObUA#v8jpEhKT=fyf=F4rS&NJGe zP-%OCLnMc~io5x`s>*xArlGoSx~|H&7+kMRqiUzRoNR8j+yCprd>9v@PK^KiGSm*m z@oFePX2P;%ox}`%4f=%)wKE(2Zd9nKHlHg&JuD;~uFOtUZ;>L*IMR&qaRwdV!i=NM zIL3@)&A6o*$C+`w87G)=D>F_s<0Qp*xsCdgu(w7hvrp27N>ec0>XOwGds`Ei+=$Dd zTvc`WT)r6XhYX&$8v;*t>9Q)92H1Cx5iGE6=l)gK#P?Mrefc*)p+zb^)>(bT*#$&1k(cv#rGzdl z_Y}34y&Le1>&^|CqxN7jI(Y{!=cc5pIrd&=a&JA^*~d~!UoPcIXFm(-M#CVL3{bHX zyf?^!w4n{&YLWm@WlXbROLH11>3!%yZR>X zraAknJt?b~I@&qJQqEAS>IKr=9%=?us;Y-N!8y!Q(#^~>KE&QroofR|{?WY@t%a5Ou!!IBTfd7fs_yw3A<_ z*i%nJNJN;9;I~rN^wxChB79%hU^R_gb#N!g4O440F^(>chf=TWR?Ro@i!#~b?DtS#gd$5(F)fXb&!;;&`(E|{*?bQoXNW^l(=`t zQz2$Gd_dqoxKcOGl6bc%?cbGt)b9^a)b~*%$@Phn^B*QYrAA&uMbF-)&J;O5_f)QLmM?Xhx>H4_)cNR#47YAu8-3fR zlrTf}{*S46?_j2X?!m`n*1@LM%~a#9b=oL4N8N3-8hxFkb~ICU%f{6AmiW9QJ+TYW4USv zM6cwk_gYzMO1<;ccSJ7Eqt&rUFP*C<>K$RDg8Pw>cl`v9@5Eeu(8{Q_gS9{#ZGF%$ zsept9^VLU;9QZ)Sf?x;beyPt|jZ(JJ;D^+ee@CKw04$^-B+e=WDD6(Tw6g2#PX*3h%@0kg-phB-Yk1D@}ms~al|57$X0Oi%Vj**etO!1v420PM5 zh1M6VH;~?vO?2yK^+W2nMIAxYpTNJhTTq`~ecgGbqqhW?POG=5i1K^4Pcy9pwN&x)NM%a8+ zz}JW{B(N_4el-Bz9{|4=03Qf|4+g-m`(ZwJW|6<)N0@MB09+LS9}0lq41f;@z;6Y> zZ=3K^f1ke-KyV}gem4MqF93c&0Im*zj|RXW7;sRd(tXGl5H~cMsfxb(K)P|lj@WSG z7H?IDUgP8O?&&}T_RDH`WMY?Ot7>d}h2v(F+L!X5#t_bW3gbi6`nEo;R>8E{ z^>}l&^>dj0Kc|N0v5)Z!WxuFK6c28S5xT?NnQ2Z{=K25X){fdV??Q$SZCIHAwO z2|M|}6fxX8?pJ&_Y=@dt5weKb>tSi8 zAxH=;&0lnBzHQ+7Cm-s!nXPbpm zd70WxM~2e(Wol>rF`Qy|nUBpV6OT@Itk}t77F^!iTk&!0?}SY?%H6X|<%>jb?NZ0; zHS?Jy*UYJUMy{@NEbm$cCh@^4muVySnGnx)Ny1GM``?rJg%kYuB#q2dUMKv7Ugd-M zIHxTnlnTFchI(tN@$Icpmg#i;owH0K00{1cjUf>M3z06X85ad)t3Q?Ev&|I!4PflK-Ea4}zeFGM)-Y4D$*7~u*VO3e zllG|sSHbipSH`RABD{sHKVNtizB+ub{ptq$*T~9)i9OG zj_qM;8L#Tqe}daU@e7;c4UpH> z8oZNx@^!VR-g5tDP8yhMR7s=dxdb)G?^XR59b2kK39;9)^$pCj`qmIN6yWV?Be9mT zzd%UBD^lR(p@n)U@Nv{Y%KOxY`*Xg8N)?|y#|ysOvC7G352-GDLt`?QlK8afAvIK2d6g0lp@@_v_< WNfh%x)i0|&!A?_;TyO9 z3(R~J!`=3aHO+VOkot?jHh1k|bxONmtx0I^7?At3{bo(`jekoWE@9^y**e=nrQcA+ zJKgW7(NTQkemPK`5O}wj|M&tc-nlpe+jD`^kEknkxv7-;gW}QsQs#Cb0o*NT?_@wR;EI+@4;`!A;Np`$d6I>dum%# zkn4A;ojN@6KUf6ShHKazi{4{=7WSre=wA4 z-`8tu#CUWbtu$d&RSmmsuG=?ZWz6(b&S1kPl9n9VIBLa`rKLg;u05krg8DBEv%VvDVjCsR^=>*~&#C>lz zV9CVGW~`X8iWn;7d-5YSy|<*P^o2ufDaz=QL+c=6Pwuu0a=0(esktO<^ks%<5!@TG z{j@|{>(NHwxhhnHtMAcP;kI#6E8w?;YDu64p7^aCXdP}Sx6&M-T@kKTz$o>O(D0&; zO8qYdx1jQ)7&iG4+FpIcv-0^T0oF0zd~8Jx;Tl|nPEGNF%-yhEpvI4=Sxc(BH%KXdFUUoO?eJxm_#`cZMz_-X87+kk@*z)KAvvx` z?gP0^lANmdi*EQer#4zXeo>*SjTQo-_-fl~O_`J9$r|h5ugTg5H#hg1=KD6a(?a-n zzI3r>WJ=1WI$UL|>7XfmkN)yAc6`RQgVwDnM4HeQjC@5mchx%R7d|zrn&#o@bzN6& z3ZklRT32eRPz2wqkykU0Hq2MiMoiuk( zFk0irSx8Dcb}4gvYDzE*f#+pb;pXU?nU3~Uf7GT(9Y_~ zkP8SiRcvA}tygR~6rD@f&6yA< zODgQI*pe|(|6n!f1|x@vL`;K*Bh2%p>fArhO^1GM~h!@vM@ z76E3`5MMCiNWeT=Hz6=XE9j2_+S9thYeISBa1c?MrVSIiXUsO5hX|Jwg?vHY%<=fq z#`XC8WbS%fvM={0s9MVwNMUz@-^Ln`5Qo6>;?i5F6g)_KSY;ZS+$}wER8oq*C?BLP zZ_h&HKdxdbf{}qS1`c`rg-jl-wbzwOP|@@FM19RqxLKSv5-&Ztc6$^F)$AXv-Ps}< zS-2GLTi)~-h`>`LbohoL+D-7D@`h+}En@zj?8PD47?6pfTHE&4VZtJa{rhaU57pZE zeY3SgwT(+PW*&d62YxHVIP{}FVOw#m?bg#$reo3YmW`E;h00dSisNedh~A2W&qGfS z({7eps`SG!t-lnf(&SKQ7plpCQ?QhvAFq*f}u zUT$l{Uv3>IB|@yf+q=;6TeNZb(H;8Y7HzfETBRAowf6QlsG4gIA-9Adcq$*R#oOBg z$L^1d(no0c+Td_)1b$A9`i#)-5$&jSgff3s{sHhi%OEG1IL4S2qZ6Q|%O%TW5g*hz0UR{IV+ z>F#l0eF!Zc2fCC@{2T>xJH${%j1t4BcAT~lFLxJBK$B96`E9N7;NuqBGhW+`cf7Oj zL|G#!b%HjQ;wNY>?3Uwsinxt)+>5uji|$6o`nzyJKYpS%2)pIFB=V=>d)b8(G1X;K z)kN(Pd>{4E$i zlr%-#h^^|pENv>y%Y~@+P10hDv$c76pW9y>wwV61@1wR zQ++n3*GU$B^GBkTHE8j)`%z{I8fOR~|1K>9Z-dv~g=S_^>QqcF*&KDH5_GM&i}p-K z%2aYs1HaQ6IY`01?>*DBxzar*+x_l_Qr*iHF2uVvx>6wl{^K-Ob>OJc z-TeTBww~1)+a(X6|29y=1ISotK^0NKgFrn_XCDNy*GReepytqD>f1;Q<|B1e0J@m$ z4}qE}?;)6o&E#HyAu?_?+V;=_^x!`X@|p$OcJU+?EQI>xu7Kdn9)@;pVY3rK$qO{R z?6?q}yOk;Ci>J7hIEq|^A^0?nU!<+EmzdIYQ_&L5Q@mJPD@u*ro0lMWIU}B-^rdKC z#u7LH+xU3`mF#YgPY5i*D7?4?17W*`;#q#4DW0QUOTqv16qXNY2NmR_mtUX;hF+ve z1<-(LsN8(W^(>@yiC?xVK)jkT1 z*iW~v1VgVGUAuM-%uVGgNV8@oH2nZ4wx#maph&!jsz2AK26d#I$57?#RJsbB;(K+E zfyGLOM$!njBJpE*9IQf7b&o-CRR(YItHJDnEx?Xm3Et1-;Vr@VZqU=cWBdENco5%*O+yf4Bn;mQm8`V zI!qmPC1C5oI&B=Km7+Z0T-0y9mTa%SsstO*(fRAOT)Yq3upVCU2Nb&j!~8=k*q{yY z3$=za3t??j3blAq%g>{*e+arns$?CkF2rI0JBd7G;)~#RVLP!1J@*N9dK@zUlui{x z3m17&{l|}^rJs?T5h>Hqjq^#Az3V2OtN0$xP{_`SHq758;JUpph(I<`>~aH zwTy`yL2-f+iL`km2Fppqik{yHUcNAdmP@ECnZ;VR3DjR2)Vi=Ydo@RKF@|y-BZp%f z2~jjXRIE+MHWHYckJSK6-iJc6g!r0jH*2qnZ>Zo&2(RP`v4ji9E5B*^D*0e3KEkDx1EwFoM$hj2;>MU*As=dKmnrygpo0pX|YwqZ4J87|w1pjO`U*?5C)JCfq@;`4N|y9mv?BlNfBWA1+9$~iDo9?cV()#&hm?X%guHEopQi;hsK1#DE<;Na(GvL5zIkO@mMkS{^yzNxCaE=Aex5&%R1ROF4P{qiWV+_tg6W30 zAp49x(9*WF=XEG#-gIg|MmByy z^CKvK+H26|zSz{&_}zLY*T2aE$}Vgl(eVfIFY5rzOg}0(h#ZR!XuaS} z;!fguFp=^GjMdEy7vF)O%BXiY?FMK1RLiDu>`Yg(!L5Xu8Ntuq;#wHvlDMWx6jOz1 z9A8OFXxf=7r{KlVx+<(rM(X9d4q^R}L8iQ$LC_--KBhjUUC)qFdhqYU>947{GjYn-_|#%3}csQ|WY91fBUtvUy#dLyHf? zY>uPs!*KY<8_eI?$b1aNkH=W+_7-gQ1Zv>^sh@<+@|w4xc@ru9Z6LBbVE1zpKQF}Z zb?JRr^R_lRY6|M&In`+Z3?|m)Kd!`w_rMDNC?b7}Y z3zhMn)+_2hv+@~cJk!jG_bxeOj!}Aw10D-FNCk(1-_pq84*{yZP3%|A)6X0jsK7Exg%HubObx)YJk|UdHTJ$axW69k;am<%vCT6uogOwHmtR$0^b#!iA?$me8XZS3 z=JPnfdC76_^&tLRod62RhWEBqu@!UD6`3povJ&YEMg;!-5A zh9|xKVivh~p-%T+aF2sct9PK!S7;6YF#s*5>XT^B66${nyZursK8106kt$CC?w6Tg z%lQjUT?DX6J&iTH!fXq8fzxRA%iPo+%m&o7Ed3j_INL2C;b(tYS&5eLK)|(O3|3(H zEv(tI-vA+jPpHZ2IODz3YZX#Dsd}#tNX|vAhtFadZl3W@^>+;@D?L~k!(CWS)6b%{ zxx9oRe{7F);h&xLp2Z^4hsuEhi58WE(q6;K!sxSdAc3{ye-5DbikW5dIq%Szb*R%d zzb>6kZdfP2_c)5kfe)gy7a&pG;$Ebcr-jw-*WKgH z>egTM9;Cd1a2~m>RDIF=X=R)B`6hotu7Alp&gZRKSw(dfm%JTm+ug&h>P}eI?YK|e zYgXLb_lZlf;@)wOGm=R5C1%DdL*dz5y?`$NjJ!DT;3zfaAs0-fx# zq79?)s`p#)+s)evq$!smF3-3I8hsCM-fw~X0bU3F{Sg%SS=YU%fe(uR1ykp^;k_N) z&%PTF)$F6`KVZMI6c>(5z%RRhz#Q$Th##>;4$z${;GKdWy>}`_sFpD$F3kH4rDRk= zdRENw6W~xMt=jub+s73DllOdZIE6o<%uh_Jq3S2^iC}5+|1iser08d4JVZBs2EqIp zw`eG>QLr^E{{>X@=XCWKfbSRN^DCAa#LvHQ4;TTYpTOGa`YTq@5e~(M7l6=kPqaAU zNkoXWC8=g`m7#@&gVPJSb?F|I4GtWz! z1TF`0AlFA=bYyQS+I9t=3Z*EpI-|X%34F+^rm|~P=`FRifyka7w-4a4ml%H?BFd92_Y{Q+fkwmEG%JnRyf%h50(w9i^B0 z<6niZ^b6carL~YEX>J*)lA>GKe;toO@t5@h)Ns-MQZKtK(Nq3tRM%)J6nAYw52IrC zaL6MXwY$plv+I&^*JQ}2mV2}gSgXYd7w1hs~$@6 zfn#Bug*rPDHKMfv)Hq05X|FHQyFt=Nc85g&3YIq7oe~8!ls>RGkm#$1(zkYBiFSoZ zFWCJg>K-aRYWJ6nS3)Ik8?JAx91VIRwHJC>)JO`o1#&=Gt`j@Aqp>vE9wgDf8%s~v zg2hnT8dC8{qz?*{7TQB3+88FSw1t|(no)w`ND7yh+Z#!AE?jyE_X3OY&WOOYhnaok zLCkF;B|wv4#vzlD+C-9V!4c>kgIg2p8Hp!TjNXD+vo{s9@|eAuM1OtcjjJr1N=t&9 zTWO=LXLPMR%mnd-gCGS}I7e~h6nq2tVj}u>Q%ue72Qj0cT?4L3Sj#DzNz=e2?P!K2 z6ib=S0XD#5N#K<5-WPg)$+I5oTimom-!zvV0`Jr)N*V*DLh%?WBq#bSkg8Eq5VQ+B zqA`*~7)WB__N6LHVl_jzXsH8T>BNu$@Bj~mR6W2xx$1*zDn{xGbpryxzb%Ek9?`mR zXmKecM)CtwwdX+zj#6T<8ags4PGu&_nnv^`2EMRcBCa#cprxmQc$~375nbVgP|6AJ zh7oe-5xV1>H~cmA@8jA5*LK-vs8 z>RxEvOswE6Zx}=uwZ;PLNnUYS#=WR`2o_AmARvBZL5etOn!UHVOu%6U$4gPpzGw-H zd?WBNX48frBbegQ&}B2c!r-i-7}R8$?A`R48?92ketv6D1%TlfzdR6iQ>C zQv7lf=D~drPs=car^NN^3oLvGa6v&wAh0nt3rD7%oiICNYXW#Bf$@A3*Sv*ymY5AY zG9GyoUWBGJp)(-NFA2M6(q;(vl9GYls)m4TDCmq)N-;agn9vCCB8{~{{V}hrbO`E? zJ>AgA)NYvV@%-Ks>{)Vm1O;_RlPB`~e5gNwur`4^D@&F_Sn<(Ait?X~`Ex1Xn^E=C6e7A%yn;UkWX_t z%fNZv=`HnbGy^3uW?;o8pGyw6-i2P;Nb4i{+Q5sUiCFsnKx|ok0m#o#A@*TPXodUT z96?e&`o6F9A24at`$@wnYb5Ug{iKOdqGS$0zOMZ-O3!fvezeUp5QL+-v+0w8SV&;1 z`U99Db`PTPK>+eO_l5r~j+#ry2T2#~^GrzhdY*@fY#mWST)gCP&d0Yq$Y+qx5I{sG zbs8cq28)GN^CdG@L#1KC3z3$W#UktZ0+)qv+2myx*9;uUs{Oz@2}x2r=Mp4xU+qh2 zQIhm3*e75OIPy)F)_{i+lek<=B8^Iubj3A$FWsBH;FnPnt8JTFW9?#2vv@QxtOsBY zUbGE^z5Zcf`)qhH1nOBy(}!Wiz&`QNCp`}g%oj&gXlD*a-4pi(lP)P|Rq-d|Tu5U2n2jS@M70MnVGM>?I-2;xhKKtU8dBCWS?5F1oOW^O^G&cgbs*uy6QMoQt%jmW^` z{HpcLGdDimZaGrw3qHtPo};i;Y+}-45)>}Kj*{jpTaccC5@&o^w(xrG`2fn}tCuVO zfU||X9dHC!G#@zf@Mz$TH#j9JTWjUFZIHvO{h~T7g*s|cUZyZq0JLV#Q&}OWyz!>}(rrw`@*FJ(D+sN=A_qC90 zsZwjGb5K@?`=)r$OtF(wU`7lmmrGNzjlWOMGz`lwfn^25W6-=bpffNyX;KHUHHe2K zej^U+BxC|C9U(ZK8aiGouzg?vTZKWoxn9y6xft32w1%nNy%-HQJ`_R$BX+j5*WP=d zdxXW_b+a<>D+b2{#Pl{~tDPr9h+aav_@%{nS^?B^)pV92+rATK3OL&i#pFeFEx%h zjQZ!}2bX8U^#;pw*oJ2sp3F1P&Z%4n+%aEjiY&$>^QB!j&RZ{28elz}(A-QZI_3-1 z!!vu>dLFT!N3G|V*0a<&k}2Uv^)l+cP>K|Wjyg?WC_UHAb>yrMN{Pg8vh`ym>#~~e zMTKv{O=X@h$eU9OCH?;~(~Ko>MmlW~HmK4!utDW5l8T^iNqa#$Y5STwEtbxRc4!p5 zMCxlbDgP!sS|()yzho?t*7zJl^Y4L2;)@c*hkYam%k^pdQfZ0L@wy3?f$cl;A|~q; z-FXqH=@jLE5r}I6VgZg>%cQ+NC+p^bPH8#lQlvccGGKny3Mt8I*VPr0;dAP5=?UpC zQt10w8wD?ev=bSp*6Bd1xacPcgJ_z(W-hd2m&%gj9^z|SIGjmLo_Cid2|6Wl#*{H` zGyK@#wgY~go_&(sOHU7FOKpVfRZbT{#dC0>+vaR(nrH*uG>pU5*KxBQo>1b&LyTwz z4_*lz{f&Fb(v{LcpEK?qG$3~T9hX=k%moPiWMIHZ=1RV~tEFQxLLvMLnwPAumeL} zee;!14d4h=M2F;sd_k!FZcB`vc;3(o=Eu3uv=Iu(>#ks*azF_nhY(|V2BZB2B5k+~ZLwFvg788^Tz z#vPZMiqk*-Xglw5Q53({7M4@`i%x^uK`oc}ff$kMU8tzzhthH$DFg6u_CqPlRnT5( zf%RJaJCf=9q+Ztdjq_j;!rzx5kK89s7J;7BYCqVB%WyD+VycQI?0oydBV4AkPm%fN zeksnC?tr!LdE!Px3C3u}l6jN~9>8}aY3dblD<~kEwibZ_4F3q*V%H+c^t9tigKt7Q zkX0m#UR%QQElw4;4+LjM8RR-e`;k4oSn6k0H@z6NH$$H%oh}AdF7>4Jc9^xK z$+(yt8JZ$=&leD9d@RL@VPoE_FMjo?@?&YBm3_s>papS{-w`b2s*k0vR&e}5YaTp} zr3bNiMX(ob`^3tKo#`@iI4*-dbsUg_1hnzC*M}N?EsdeLy;4_EDTi^T7?;Bk7kVDD z`i!f?cxt+?wLy{RHh}<)BTOuffM^(B+I{(qb$0&as*VqmN4y ztkB})HKC18)TG^ZLK<1CcafA0IDqC!dVn4|DdmdXIuw1<80$6pl+;5E98*1gV4`9} z@>2lgQx#z91pP_Bp0ZZDPTfvRJw*+ioFT-Uk}I(S3rGu8$Gj`OT^K!mCc+^DYH zf;E+9mm?M5eW6kD5rEz8a;rL(V$NBUp%O5hiCk0@2~>SuQ-BKzBv=&y*%)H5m?Q>G zUTd(h9tWR71Hv&Bc+WnCg_2rn4I(^AR|=fe=`?Vn=eOX6fads}hX?N^{JzF~kN5`f z*S{6vQ~15z1(Cjx-L&)z52f{?yH7g-8k~`vB2oNq z3#0ilLV`Z$x^!0L_T^2-BszSlFkcQR@^0HRQ+fq}y{ezS)N|B8j zKSCQ~zKdPd2(Oj~d58eXnDGnrOyb>xR{RR)8!p85^N#haG|LJe{Tl=pmnr4|X323w zf-|gV;31-DG6aTQKeDz^4<73f-ZXTY`MZUGJQzbRM%J_<%-+4dBxR)_cgu z>`?v8@Rs|6m%K%tJr0WG^ONF97clPMU|g}{M?PZw5WgfTg()) zr+XaTQROIjo1%>eal;`F;ArxE50p||PacSePklMk%bTkZm$$gw6ArE~cZreQ%dzTk z$tq;`I4Z0!PqpL5;>HenK#b}hWo2XPi<_po$5FOJo`8EM6WhbrVks^-!*!w#JI;tT zcFGOy*x5Tf3Xq@SLIUJS=)Y!kg9%^w9Zgmy zTPe0sd4SwArlEUdtPUbbG&ICL&gdT~|7d#ks!#C?G)Odp<()pE?rF%`Q06n5@eSob zTO)J&#x|7sykcfUImfQt!2;pGaXDq7zD8UlIozf;MhPr=y6llNBs#!IZ!917VgXV2 zrt^Be!P4lDQyEfp7E#C zym{3X-jouLV(A@jA?vng;@$YAg*=KC-Id@|sA#2A_BQ1h^zT@?yRA8Q25R?MxgE?F zUGFf3o(?fw*H&^r4|}vsFT}~O*s_g?czJ;h`nxS{ckSZB zT?h1hXvi?HR>-W=k)9gtCfdt>wg))42OWO9o=WvPpz*EE>5tpwrP5O!;y!?O95(HPl?JO! ze8n&;&MUPEe%#HT$i#4If|M!4=6IRX;u}Ep&_{+L+EM5v+x5W=_jAIC`qXrsc^t)` zj?UhmM$^970HBLZ>nGp4wX8RF>kni-gqHS~yFikg7$^G%5667~TxTED$!nmm_3TI0 z{pFSqcEp7TOnFkTh><4o3hoN6BBn!c>G8 zZAWj@N6S^vhho8>u?;c0jp4m+D9sp$xq){x#$c&WsIX=kC!e)J8NDb)ei_NiaHjk*HA5aKZi8fz>I+oXG#K!W zD--RbWqOPRiJw>~pRhq+ zD^g{}@*Oraot{SN3!Hf@4-VM=7qOG)P2{uM4IJT=@eqtwE0)ODp}Q5?5_b7{qQ8w^ zlp{%h5hEww+v1V@qI}Z!m=Uu~zQ&+2FH44zm5RP~%#wTAt{Dh8=?TT|h}9U8REqdO z4m65Z<6JUyx@EcM zaq@Wu%kv3x9!0CtkH`?ZtOl%PbY=4S6*(wo67n)ybL}IO@y**PD`$CY=l`y|K&zf#yUBHmB8!dkDE=eQ_xfR=0)BPKb|BmJHmK8L z$Ajy=zFwXQ^)R-o1(doCEu6SPhR4{A@+#*{t4tSl^(=j|5&iIdQ}&Bt8;H!juc`S@;xoq?Ym#61rqspZ6d;s@k+F^0Z+8p zz$_YyC!8l`HOIk%4Wh|Xq*ZdQ#*hmT#=>-#3#N>%AVAidU{$qM9^`xlN!X zRv#v6C0H)jdwy#_0odB^A6YPjr4*C(T|n>%Ka{`>m`8YO=x*>OFZ7 zj`(5Wp+nCD3s$`cEKx@sbV);bY+)38P>1K239_9-81B#P{{%T08!j=!c#>WIJPQ7?uf&E2yIP{ z*I~Jkx*IrT<{==$RCuPKtldBZ$GD6Tn)Y@*KT2AIDZRKGIOaGn(AH3a&e#K%=A?2i9NQV%u@{))EFIa4K`rMc23C6?Dmh2p_95nc z?Qso-=_+~z*ApSIK0!`@&&>)E z=DVV|6RrW^oiyoFY(9VTR7bH5kh{%EMhLSExDeAcPCoo8KnceOv9D9yC^*4t%21Sr z+urHeD*!4HHWpzJv~Z%_r;t7C5D?H^%0C23?jH*MbqIn4oAtC?PY>(qsZhO5atrv_ z_tR&BS)d47}w+t<#&#dGO(LwG6;@xN z{l7RLpoGumC3c5GpMNelu{#y|;d8mOtpO!Ip@ghX!X=}FzQ9Hg|4dwkfW?9@R(Z=<14wH{Q(6BBIU+3 z@hf?v@HSST%C>m>8Wms3%WeK~7_?{%HstNXyoU!qo-&WgA;QT3qYK`wJ5%*BjLzO; zSio)WMY}jo5go>-ACJo&9&Cp)UAS!INPggngN5rDg2Zb*42u#Vtr zQ3>FI|P@=q}Gtvo5WRQqvF_;pc)u+xY=CF7>bu5{xJ==eR9coxh<3ffb)qx3-cO;JX-Yw}1WTYU|w7a5h; zBkWZBmX^*Iqdsv!}600yQW60!~H`1+q-27R?u-89xC-msW$hFq0Vw0O>A1P|aZ zNzpB&XhX?=F#h-hQz71;F#&5T#r-LVDhV|MgNvP^tZNBre8!*HkoM4yKjoH6VoiMI zpYnUkLp7hAJSPdx{`0o7^!B!Fnvgt8Ww+(N!W86R)aZ`fcS=uWaqSf@D;gHq@+#|f zpE!RjuJ?W7xE#*cr%v1mg!zz7K}Rd@pwsXq_m|w-YDMy2vdcE3GT%Rh7XAg&Y7bTZ zB~MVqL?d$~RsSXTSotNWl@8$YD~|GM`MX&2CL|QD0zhVM0Vk0Dxa`@8A&DdS?{DvP z^{zarw!C-sG-a>S7j5RX-p`1)DLp+}^~X2wi2L0NVreMzPrQcskNe9Nz?+h%G6wR4 zJD$p<-~q_Vq3&ic0}+-$X@S1%_HC_~G7^cay_Bc%Nb^>P;!)_WL@}I5N)JF*u%t}7 z_f;$@jA*Ple03m)qAaWx6h#S=($0YJ0>^WZR>z(irz`NpW8fV=U#+lhvJ+0Ro8bCzFENF`cB3-gbR&p0v<+y%R1hbXc)yi z6yI*ctti)gaeGEsVXk&_*dtb$dpk!`CKoZvigIt_Xe-RUnU7jw?oAzIlsOa}ut=e7 zU#0c`+oReSSRuie=d4aH#PqZR2Qw1qZPC@=u~zMDrsfJ8XN9$K3wz88YwH%4LWO?l zXsQ*(Yu8monia-l`ldd%_B1gK1Z~NtEob ze20Z`MDb}&lLHh#|H)P|){D53O@Yn`H9cuXv1HyAHPs4Zy{{{5niba1Eo?efq6pDvP0W$@c+qF*XD8u=Eh67Xp%hP(qB- z5M?XxbF&*Mufn-waAO7AUK^t@Oo4zD!4XPJd~S)ry!)i1Dh4;EhPoJ)O%z|2yjJ`9 z0+}~eHj7;5r%5%+m6s&_%%2IFKx#MJdzV3rUJrVi7klS{a5%Su{`` z$d4H1WgINYk3qgu^nMIh%`}x@Te}B$q0$^^ zB$~EV{DhGqD>4~g|5ZcvHl@5T6wg|b&oPk;BbJtmUMqZ-nW<<8Ht(vIiYyE>8&IYK z#|{|^j&ujbDiy-cm@$s!TK9?I5GPwoa*%799TeY6iL8?{t(6jJm00|O2P{Fxd3Ywe zjFE$o+hu&rCAp~J`nK9s@NCSqJD2uvqq-GfuI8FOcpPhued83x#3>!rxmM~=qp9(O zN@H3Qr_2R-dc`Y|%@~7wq9$G}44T{$-le%_yqXxD;-3M1lNyg~dvIm30{S&xsj!KC zyAu_5#EFvYZ2>lIsQSqOUli?Zr-b;kHqM2gct{v5Vkog4)=CUjwo{g2nN5FC@vyNX z;O(_wO_#SL$3KR}Tc1LB7t?@i-A&KJt)_Q8uSs8C{ z45?aY<%ybt9bFXGNQivXR$AiDvgOC5g%zCyxM2sP6TCN*{o1 zf2w{+c@Bv{bMaSYZ{-=v8wGcZ3H#u()Cx`Or95|^60Y{b4$z-k^{!LG{nFm6ZA@-o zB^~oKqc4_P8!GIpyn#YS_ftCjt#6>j`zecqne5?qyO0U*bKLc3DY3uO0jqDu9$%&MDEUtmO?njqoJJ&nCKBpKN{V`TBF= z+;bNp!rzN1Em>*(|4+Nv6en{WM(g?!h=s;Jti(B=M{``{9XDqSZFpELraccU3!2Zj zV%^aVYl3u~IX52>;?{vY=F@2%vpBRXK0wgoIdupQY3Qu(oju z&i7ZPDLY+JMdOuHG!zv~u(firGp=p!3QFd_@s`0u!nR!e&TWI}`*G~!Vv~lD!y7(q z{|bYvu{Dn?9cyj63#t5ZrEeoHn>TM)-(26knJ;2_VF%|67!j_TL4||i!G^c-?N49> zf}=|orIqq~8>)Ol2@@EUH#nXsPQH|P_qH*Nvs}Sk*<}2FmL!3u;429*^bwPlNUv*12mb_Gz(-oNU?4i+5;~8Th zO5)E;=}L~1Q3C&Q3;7*>HO_p4r^O@LCh^A{In? zx-ml;BglYR;*tueF4O+0goqHF@yE3lP+oEf75r0~3{`IMGuXY{He!s!v(JF1g{4AC zAV`dvK)73J!%Sr=G@X!FLA5*E4h76cp!1bfc1Q`!NhkQ2^@1ykEZ7>d%fM~8gfA}! z5WD+Xr8Fi7eRV;mON_yblUbTo?r~K3FNG~13tKs%2abj`A+@v8l!`9FZYJS5r6T}n z_H)2mVj+f6`kcU6%6Ja6gMfcZ%l2$bp|g}&Wi?9W(bz)Cvy?z3x8`#Oe^Sk7_AF2v zqP=6NVm8`tjYH87xUl!%*q&o(#=k)jiw6kte`74H_qaLYy?74bWMR!aClx_SkKoXI z++4KT3doqNG{w+vnG4RtsxfXJ7Fc_ecmI?xE%2Ld9e=0N|x0WjN z1v3Hz@l=o$SucV(1T*3bG3@piQ8~Du7eS=+3W0lusVZEsq^P}epfjR`WoUE?B`*VH zFQUhnDf6Ka7jWuW4(j+7^L_Vnvb6?B3pf$v zb5gFdP+@vF2(>jK+aVkougX;>3X8xXiqB$^Fe%|UE1pe?Z?HQ;g4F34 zft7<7-~W43W8oU5s~xMd_!Tg*8+fGQ(&h$~)1~V$fo+WA>y#)vh6!T$sqo3g$byRA z#&(vq5zPV7yAcH6SsMH*IHR-l{;SHz@YW^fE@35j+ECwM*(k_U+Og#p>IgJ$=PMaZ z%V+Z_75wNA*LfY_6tjB@TypN-ti)Q2WX5nTlG~e^buogsC_wIe41n`cM#W%XHpS-w zT3rzA>OP}cMoIaIV@?hOTBARK7vi^+$Oi5s$NR}9sOVr_Oj&P%CuJm5Kd15}So^n> z!+^zk+X3U2Y1!Pjfylx?)MQKio&SO#)CO-0iQehAv3}#80sN%yP!GMD#o49asdl-qb=}rZAc;w6<5JITzVl^;}4Ws2%(Y5 zm{RFhc$3O_7wAt2Zjn#07Vh07 zI2*tN>VjQLw6$)s-^bc|gM*{!)Q7MhDcz;a#KwgH7_1rC$hYx3OtcN)^*1Sbx01u2 z1vtpDM@co=r=gG;74Lz3$<=sp)v_`1Lj`xM@1WItl`oaI(N1pP7Mi|K`C3p+_!2>& zsdAlx3db^o??Gwf9q_lZUvc>GH}BI7HSf@d{Yu+9Im`Dei))cz1-N_(IHu6-LBU6$ zQQ=o8nw9W6g$^!KqUybms_(&i&fB8{XibrleqQ+biaQGPlhh&)c-}q=e8Hl8#%NrTwFe=I*v4M@RfRBY=D|>6?cAuJRQ%XGs(1y0`m?d~( zt`EahW9i!oei_`q8{{M}@wHti_^l3e7W`E^axKp6d4)OW)d`+R)hq2ip$Nue?SQx* zeA>l1r;bhWRH{4<=|c?NI<736ABk9o$d>pqnsMNp+vfWAsPp|B%#2w)#{y4Rn({hU z$y?bf*)4t}z8NvP(l4>%u~?{Y10NsfusQ|wrihbhB5uUM1J{6pz-@XG)Jc#TE{liP z%|Gwnt(Q|B=Bs>ph6#P(%e zukc+@MEM=66SW`Tl-ktO&;PwTF>m4g^jmFUNW{11)|IySrX)Q$ zI;V6PyqBI)LcN;*diU;R_>%Srj0nc7duk`X-N*h4MVtk_nsfZ_T?pwfIeoEvB%cL$ z+4C19h>?2pfw+$u9inw64qM#_D{f@#HhOw6qxfnIWK#lA2U z+=qbR9SCp-z(x3GT%l7$Pj6r6V|Ahjld}Tj9tbzHSlF4ARsk+*G|j63tsX)79Cwn6 z`Rg^hRDo?gj+~WB%iiN|)P|Gv>$Tx%EWX{F(H-AB08Ed%7FjdOtOT#~1%a9*!uMc(_Whhi_L45d4qpmoZF~ zhVwEoG0nV)<{qR^E`oblOFox`cqaLh;_I~+U6gYomc!_I1kQh6cY5H$Gi3jO3NHaS z;PCP#B`oHdi)I(+xm9@X!r#NTlJl|>*(k?~T7u*}CCjaB3`mP`c36q@|NL8X7FoXM zn#H$iDWYtXX$L>xobJ|j zjqWq`Z!2s&cI}++lxENnSAJIyW

67rgCvo^olaU!&YJxUjxAkflB-h@Tag1$;P@bVn-p4A0RMRSepi+$U!!w8cuv?Afq+Q8 z3BKnTmE8ox(@zKZ=(j-Mp1@gU@KYx#pC35Ldz)FL!QRlF{Q&{jX%2wvzdu0!ep5R# z`rdV9_A?5ddl)WC^Zryufsv2DgFKLHfbGIN5LZ`_|6fqcko&#It$J1cudEElDp95T~Nf`S*zpJ zj`vGC+;(yGCABRKsYUsvHWlYiY$_l0M=PK(wy9m=G1wIuYP&*d9%>JYwIj{dnlw7! zoCc#>yUJJV7TeWfs0<0isGWxz3lbRbL*YQUkRLyg%~PEOQ|T$5Y6=XbOFY&0U=}^k zOC3l{0@38cPyk*!rXKE^7B->gsr^ z2u15-RTa)ZeblaY50%a}P;m!dO=)ml9c1@Zsj;fIpwN2iAUjTsB5QkbMUUOv`bbZK z*V**f+5LKbq>)s5tiJjY1iKNP)IjR!P&4cb3gJ7^N*$%b{|)p_=>mK25J&te95J*(a`oPT+Wm`!8^`gUnJ{ncUVuS zcs4Pw4Vvq#2H6|9hwSxLo7#Ov?TvH&&~-o6= zq}X7!pFL8AlVo*(S5stk;-EE#=4>!BHZwDJZHSD`RT|Pzeaaq%j1AR)+M`u!6M`1R zpkGg+v*{sfM|%sE-V9M!!bn+6!R`=T50x6KwxdxGV5B#P0vuaWWvDtI=ZVuAsmpMR z_(mi3IZ!{3H&z$h;=z5WW2{Th8mr+x{m@lLQ4H&CIC3fsj_-saV>`2kyl^#?Z-?0* zu6D-3;9KEXWbL`tk>J97nxG@=BQW0`=|+Sa21{WCJq-)tc}>*5um}>vvb>3E-gVZM zW<;uixsgcUjgljgzB`9Zh4B)f5Xpk&ZW22jXOIL^Jgnubvn;@I|YD z!M8V4XW4rJDxSxfbZxHg#w~DA5}4^Z6L+BK*t8r+7@WeU<3 ztr;tHR68oHe&Wd(WiFs&52!VlnT@9S*1&C#Qg&;M%or+ftS3hJE14_F7a1L#iXs=_GrLDkQKkH(brATCLpLQ@_Ds69#552|nA#O2!d zK+n_YYJ1@C>C~-*+7fPd#n;ocuY(F33|N0?QrxGMNfs}T|A=bVh=QBp;^}L zwt$cI-FclSVAyf~l5sCu4`IZAki8&W)vXD@IhMXEgxra^Q|ko_JQETznv1D0Q9S^u zz>J5~E;x>fhp$oe5P$%OGVu{evAuvfmWc=|>V=WnzRnv~o)$1JuZfsxUttwIs5iE{ zmuO3Gb*R_NVtH0h!WDwQFjdw^odyBQygsNio4WM{Hd;yh`eHTYP_usOd-hdU8CCt% zHD0Tc*}B0juRm5Vu09-~UQ-CctThj%v;k13I0mYIUQL0W;Ye$WcWW9o5PR4fm7d>( z>ulH3k%54gSNH)VQTDeiZX#O;RO-5k3<{NTg8)PuXu}}2gV#nBU*{e&Xg-v|YEN4p z4IZq9c;$-}wQeD63TCn}34nx?xCwB^TRa3ydoxuI!Kgwm&R=lC%U_U#^Ve4M3xaR{ zdei)Z%$vWqn_oN3ueZ%F9GK*|0!mK8vMc1;T0-EA2X5}@;|E%FCy0ouWzftfY{L~5 z?@>f5RCMCBX8JbxZrDkclUWN8;TME6lOp>r^I@0|c*#w|Ai;l45R2G{pSJ zt1|8a5drCYu*c^;jP3VB_@0=gG^7enzLy(^(-Q6dLP36j5ZK4bhw?3m!_-MaS_;P> zCp~a`54w(3Y9+w;tw{KDdK^&s60hwE#;IH(1R#5Mg96d*%zg% zVM0k1Oo?rvBr19eLd2p}pb{u4e+1o}cO5rpIoi~#M{oBA(G#1dCe#$;vf@C}@qnbP zG&Qv*jyW;2g|_kP(3)Uo*vw#L>3jcR+>bUMc%+1E6Vz*XI9JsRbSbOCV|}`=i~$St z0;s*v4R8mLJ`vkW31$BZOi^2-)t#nb2?<*jUs^H+xG;r|Oi{<+5%VMnj}#jG zB+?C_h;9u6bHZC;@E^zCzy3+Jqj2}&L5VN3`rt{G_10ouL#L|YH3P>zsR4vAnl@G4 z3?|b#O@*b1C>!1;ACcfV`coMGPb-E^RMK<-lWEh%uv9LE9q?14UlC7X4{k#no>CVe zE8zMIJj(v1`sSt!aKK?Bcy>=0K-E88z@&2$>_+p_)pi1eJYZ=6TMN%STBw)Vrm`TG zOV7Y~6jRI$mCrpS&%k(;(25y=bZgd%W}y5MFqT@B;rJ)WU?eMk7t2Q+@C zLOW)P(JGrMR!H?s0q1;P%INs4x`sQ8rlvrB68{{QF;wf%scl88AVC}A454GssjDz+ z#V<4f_wrA`P1Y=Rx7Wu&j2g}O70{bHTkVH@+$Cc#zvIJej_79pIqE>SV^P^ZfCDa= zqt3J+ROzMVxMHyDTy?vZmu}A$({BwN^v?6t0xa<(^Hliaz&e~S`f+20j+0b8q0leQ z2Md@&jWWbS#epneV{!(78e!tysns9&4 z3<$4(##AOCI9GCQMyr)-UvG5f*);$z+U|qHmBOLQ*jLmg++Evwoo&j?wrXK?m{ncj z>k)x2s~U$VE^>q!XV#^iq8N##Ho{+K=KEfL_RYQ$1{@4*q*;Q)li&`OV=m-@{XE={){WY z_Ey$c=$!HnLFxjR*yM<}6YyRi9}(Br#+yIJwx!dSXX{heVW za}PGB6yxe16WI2BsQ!r19eZI+lR~}sfmBa1%J!*;Oh@)SPyYD16!^ik<_{Q`}I&#`dLu3>wc344&Zv)H4mz5oT8 zVstyKe(8-^;0s`yuT?)`i^Djc0g&g&WhB-V?-TK>!I;LluR)J<-ec->qDI)d&%o+W zIC9NuK8t_v6O>COd+3h;0drfoWtgDh>=i;k#$am z!W0X;0yCRJ{VO2G!FFCDu>a^vF*YkIF_q$ICMdB=ftjm02m-=yMXjU1Rl8V?OB^o; z=A`z8D}y(1A~f$=&!#xo2t&DwjrHZ+3o08qm0d8g_#~XfJ1(l`@liJHh@j-h;cF;-3sk_fE{Z%Q7tKMqgl^*S zN0II;798_D3=8)Lx7#HwDiOyrR*vH|)>d^HJ^ailysZArD|yTJ+*9Mo_b6IGmS~TA z4nS6YbF>q#12ypy?}~U_>e?QDBCD>eRmfj?0|SfVy8WoWg~!z&v5-<|X%!Yw3Lz4= zg;lF_y*TVQfsMBC1E0mei#f2}R6}4PVl=*~e#^nOKd??9NSNOsl1dloaYpE$SlfuW zdRu+D2G7-AKP&FsXZs&w&0Y0m>ISo7R#zP6dyCL6-$W&$*@+%mO8c$8;q%p&^#M|%#B z75@=c?D&s1A78B&Xi-WTfQs?MB0vo6iqjWpO*!E#XIPG76}Xi&EWV-zT2}<#S)ldA z1E9ZH3{4`kG4^K-pm{!_e4&cah$MEY7LC%t&fsGCrJ`5J!WDqEVG8%oQqdiFJ%GyWMU8n0 zkl1WXx#vYBuo$`9FKWvXv~-!q+!`vt9G63KaB&&Jkz={G01fyR4iR_=1=HX3C9Ob= zdslL1g73@Q%6@xa(heelSoxp5EJnmDOCYmWS=x^%x>2?^6_4pFwMgjJvR48UvNmH; zlx73tTj5_D2>;WDbtoJU2wg6yi zY*>rx5d6t28gGL$)@hr>rpgo03qPKW0Q^jR-)g;yX>mA&Ca(u>2QFOC>z4Mc$55ou zuj{opfLu0gz>wopjClgCAoUWHX=J{tjWo%%0Ls5Dhpa9|6bpTik!=&OH{={gfx(Ja zfT@k!1ORM9$2VysVJVUAp|i0+&Y3QR)8Vn30qV*Lz!?LK9bP)L5M%omZ4i&bt=BPF zCuzoeC@G^r>xUp9&OoE001bv1sh%uAjrAYgyL&PQFcOELhs?gKh2-qM2Jb!FP@o_d zJ5YK~0Nej;DDge?`!v@Av2d;eUk`6;vB0xbxC>iq)-G^3p*u9$3}_q7 z&KNyWTiwIE1B@9vvF&f!GR8smo+A(AmT{&~#u2k^&f{q=Ehm+f4HR&v; z=7m|f54`$LEe?|$zfFF$2KkD^+a~8u_XMp0Rt+bEp)*Z|%S9vM1FTv!sO&?rw5mVUa>VKt$HjB1c`fV( z$YTH8r_I4*-abI6Xnzm1y?P(84L)NI2+&JDfW>H1z+PMc(j5@!$U34tT);e>2c3p2 zVOkN4o|*h>NSTl0J82!H`&kI&TB4!k=Ia}&s7T<-TScOr_+l&sK+HtULRB$_FNPvM zLe&F|{vQEC(V}r5BcbR4pK5PHg%#LB3Jz*N=uCbtDIs7@d%UJul_Ob_@OvW4q{()l253cz}9o2^Wp99Fa z4tP&Sjl4u*F>q9S#;%;VP_T8JBdHAgbO}u_(@2bmM^40bxN-do!(Jhl7CB}G$WV*( zGNaT2I5#c*3J4X;?<;h+jp6e(Rv}7w{FoLdy51UGpQMRP@eIo4<2e@ur$c$WAiYmL4zkiB{T3byhCMG^EFbd9r z!`apept};faYE1%*bt-WN`TJf;_;K(%c4u2D8lf=f8F%`QEq`PJHa zF*+7T6XcbCTA;F4r-5_9fPI5zTr@jT5dlr_*l$ErlW*5Ez4io?bBZ%0_j`z&wts_` zU!r|FHc9yWhMwPf2D1%b^`HZCYo^3f&uA=^z_Ioa`0~ba4aZq+6pR2eqji|x50aVq z0Rhb0pfvyx%SN)3mfW{Mvxk@S5~k#G0i8?B8EA~^atskdea?#!Yjqy8lVU77kEur} zKEZ=zgZB;p7Lz!DY~L{e3!x!R{8o%L#*jDh)8B%E24Gy!HsQ;8QOgm78BEz@{6lhM zK>K}mQFLB3zv`ms%Ir&^AVIxe)>?{D#b65a?R%IMXI&-;FyW{^l>IfJ>OO5r_)btP z)4vmK5nRCD??iPjQ6X#(%m56HZ|)UANMLE=`jIPQ^G?2^wG|Qwu847~gkKZy_imYp*1N*LNCS>4%)@Psvs;*ghCx$X(a1B_-B1jNJuWMHdnV-869K+me+20Q>CRZtCwqU?@(}JO`4{2F@+u%OBwAgq-E|XB zWuIX*^b`C5SAkJQve4hOUdWR6 zo5=~5UqV7fi^#VBlsmp-Y6 zFuLxo-$c|D4eKu54%Lc7))SysOqO*95V(5+Cm`#w2)ZNdAO?+KMHg+^r|L``A?FwN zA5>~FF1R7=bM+t?-SEn%3|;RE%NxA2pbbkO21E}7afJKmJevZkSDW(Bs-IL(m$=(U z|5*TCBqcJG6g)2b<<@Ue+kEw>@d)-4UncGDrwa(2&cN)4$q;x3OUh4Y?%l^;+5Q-C zY#8jY`mnz~9PbeUVlwf-&J>`JLeQ-M-NaMeu;%!=dM$VoY%YQNG$a$+htfb@uF;n8 z2%2>7)j)lnm?|fBd)XJMHv|D5MW&GZq`woSGd@oY79E=&jM;>SDOewaM{q-KyV1X) z{<7&aqXm_R=mP;b*g^*i>AD@e*2iwWnP<{B{j>ITAWsmy$ z@F5fa<2Lt)5sVlku!Bak|E9@eY{{@=_Hue-ojIW+jdk9JZ!{LI?iQwx5gb7@(lNaZ za!UNnJcVI;q!^i2l>IE!IoHF){Kbb0(L7>7$As%971oLpkAPLn2uHWLMa?PV1$Y53 z3K!FSBV0F;XiKxC@CaROd=b_vF;nCIa$Pok<+Z4lt}s$S#*IjwX-HIzW!coK7*vn~ zY+cj`9_zO@)i-1K2RG9_>|WmJd~{CQJa98nIwK*WNXm=Sn~L45JG$DOlG_88Dx&l} zTxW+(d$HJWSmxq_r3dl;tF^io5nQZ6@YMpu&)InroLR=`8Df`o<>2w-9KTUzjGhDA zJAniXHu%HXp@p7q!!37=WTRUOs9fC=Aask0Tk7jzdWY)U8dtI^iv6p!&WQrqem?WSsg`nT8L z11R2UuSeC;c@a6quYkkufN2v-3bK6)gr2nuH$-I}tnUZ2zx)n*BoLQ*cWNX#AA=^m zqJy4gkGO+znT(qG#}LCO6&dP!y1ps9Gjv<0Xj^B!XN||2zbLJK!>dHB4kM(VzCPYZ^V7qW{ybYjiF}f5_%T)wi*7iu%LWLhgX0j7h2bWHIY9PT3uUFH2B~GP7|OJ`Kx($QK&Cg%1=Li`1=7mQ z1uRQ*30kdGe(y8)xd>LD&-eBEzg~Y{Ugx=UXP+}?&N*}Docj{jLF;pUp#wZd3AYD& zWu0)4f*f2GrjJ!TjO$~RSvFgci1$@tMsS?c(><6bO5~FX_v_=7uJ#ZwapIj?(BgUm zFLk}dnl^f9_S+sF_E5C`31x^q>|UIEI5I1+yIw0A7U|(kLJRV$CBpL|Fr76X7z-yO zT!m&yS6{_R_?RHIo=BVwqGRy~TDYh`0X>g|vnXK3%_)QX@mUwXaOx_-AB92c|nmL=|Gi8HH)B%8a7h0Nu7drwsH+tYYc;rbZsAD2L(^3Jo>}+jE zcB+eFahXG1H4plQvqnRIC@B@Aga3f$4J7YOce(SQR03Q$Ep0c*@4R%4EzeW3pHhy1 z<6f@ThU<){lo`EmG}(rr@7z=f5+HaD&J{ zhS_cVk~j1{>A&RJ7%}TVhZsLw>FqZSFik=SD=%G3hcbY~0<)DdwvI;P9A%K**{Q0l zx#^M?vW@liF>a+RISy2W@ej@lIR-}v^D%e?I4>y!5bqkq!7nQ@MD$C+DQQa?Ij<<2 zY_!SsU8JiN58w7I2GQSHBz_2xAbkOmutaI-OsHy5 z+7d}3xO6H=d@kxNReo_MR;BP;2B3OSJg`i;D2Y3KxQEn5qf8~ZF3Iy~UT9Tei<8cx z>78&_7b7K8d6sPc!Tu*`f#ulAyNcnjVkb9!uvGa;nXYz2*;Krw=tV>p2-@xLONt+zAlOEp6LW#Mdp`y}qWY^9I=dOZT7f4$N;zs}VxWYyHl5ZM#JTY%tw0Okb^0^#W99c-?c&l~T7N^fLzd|!FN1_f0c$}dpo zma9kl)hT`&RAgSBa*WX59QXvYL&H0MDE3l#Xn`A*ZD3DfT$LiQU3th$@{bzG?_+a5 zhF+0W8+NYUp&dA5J7jhP#Vgyv?hF#2Z^tToT>Pkh&}W+lv))giird%9qlqVN#jPCkqF9r3|q>_%I^}f2b;JlbvHIx?20XMioSTa z@)6;jZhO)9VFtS1gEQlkt)6 zjanFS3f`&osi5lKujOxK9#P&QLytzgqsj+15$B7Ab?}bHvX4O`lM3VhBo{ES9eL4S zyXQC%9d?5g3JKnNosjLDeZsXkA?vTeCYQVunx}bd!6E1U<>hb^B_r33C^-Sfu(?oA zD(&6V&<+>j7dI5_OL{$sj^>?InA|e`kOyY@kAptVJE@owV;P5dWOSAH)k!5xVg>kp zg7O_91YfA@OEL)Vm2jJ(o0oaQM0p4_tH9EjQmlMTu-51^}GbXoVSs^;7g_9KiQW5^GhWNm^JYNx}W3@)z7#ykZ`$3tK>7-O#lI* zUn@-!S9V4cAdS9q4MmEG|CRat6TYUsAbT1%;kY3XW@mnd`F%)~d<9ewgYaj82V~E1 z5(EBG6r5Ft{k@izUqhDHNYp)tH6~@*nCx>P9$mlF&nfjKDP;|}g)ZT}bq;*pKP`@* z!y8ViJ;eyQ@TdoQ98%#EXbiUY8D9W26`Ql+Jt910g@$~^nCU|k~I{6!ME z$1Ny>kPAn*AvhB&F9V$`M>9(ET>=~DB-o+mc7ba+J80Dp zA>~a!i)oXi`Ze;ezAQy#u=R~1FDug<(SDYUECexxi>%SI0R0}YF8L0mEJ{kb0=ZQq zvFD01@_vNS_^Jd4sTh)aRY|7RTJi(PFW}BMfrFB+DGTshQs?E@l<~CWhg`>!S7)FZ zG+~nNF#>Nw`e;I|$o&yWm!#8x!y`W`nNsTl7D%>3rjS~W;p5bWNaQ6sKjm+qRd*lA ztTG7QB{`av8|WiXm1l~I3II)!i1-OI2549R1Tmh>E!6LHWcdkPOOdGiv;5lXXQi2} z>_1s)Ps7Ah3wROB{8_0ZtsTK9?{(ZPE&dsR_ndM5X8^FPy%`!zEEGX27!nHE>_G^w z{;EupWjRE|4akF1f5W6eUGq2Wx}Xw%lWW``BlDiKP?lP)-e~tz_Q@N}FRc%yIC4iQ7HPIrjIY+vt6|7=9aas|><; zk?t>|P+0cZ4&>B(7MZ=hqbvrn9KVB26%^E6NO6dip%YO!H*JFZED3kPf;AE;ca=6S z)+-|wqUF51sI!qM8y0}0nY$p^=b~h4Z6kwM0sw6zS58qOUSGLcjq$VgrOx_$=V~*}8Z%f+0gl|p zV*^O=Q`_Pe(o8?KytZb7SGTT89!@GkF>D|01zA#F7ZVP3^H6nJmEmVgek;?>m8UJ#X&fL; zsN-W~hN-t~(kLvE1lDP+?19KQ34MmV2sOE?ERy%g9vTt#)Qh&NcxwZ|>aDNR;V@c& zvxoX>9kZ3e;+OjBqmUr>YM}ZM3xn@aScz6s5my$i#*o^8^l6IQH?PSh?jy=pgI`Ns z2Zrffta?n!qsO6s!r;_SnjwkFjlw1>7#W-^HdB`&C~2k=*LploCGkK+ym|_6zs9RC zNUTDD-&xpdVY|$1uEwggtJB1rnqx)H)rXPEuZ8*)wP+1cV)}Ygx^EA*C9j405z3#? zQtbieIlrZfGZ~u1_mOl-E3C01vAGp$!?|E0WCjh4<6eY8$!R*u;%D zB~owHM*Ug>?EqZY_43II&jan23l24|tvZIFHoL7l0-^C+TeUS=^lj2koksC%+Nnb* z{Ii|r zcRU`m(HWi9Cu-R6uKC%P;QCB+{|~vX&x9oY{@IqO4v>Y@bXYSg>jibvOq3)7Jkk@@ zwtl_vPP1Jj4g4Xi{p2S?Wi>y=KZx1sC1yUTMxu|aAC%x2-$f;IaAy~_a|D%Gy-|c? z-?pX--E(;{OFBRyQ%dfXgi{J#r z8~-9*f$OVwCGh>Culk5{lWT|?iTHl%Mk@MjKeam@!AJDRUSX;Vi`4$=di zQ6S|lqT8dY0Z*KF9>rR5wHAhL5!f&A3#q~K<jGk9=+0 zAtHuh(=g27BQw}3dJO}<*(D|*s9~X%pz>q!`aebQ{^#gD;*ViKPoS=##a%;&L@S%h z+bjAHS0DacHT%To;b=sGI6fRBS15iRuJ)k*cN(ES=uZ?gonF%7B+7|q0N=7lsP!Z; zAS)>&R8keLt`;p--aCv`W8LtYy<$Y% zXmv3)W$$RUDTOyjtD_pw_kKtpj)y>YAfAzUXfd13BdKso3Je@(j!{!(GlR48kNIR} z!dq1MSap>wa;*9)+SGp>NJ;`JY5}b(s}+Fuaq1vS`NKH%4OvJ7Q8Cm91_qu`8&dq) zC)BeP?ijD$mEUnJi+dtfUZ=4IJm?iJ5?;aWG&WH!r?mD-sI`4o+3Nt_>)?zxO;R(f z&hz$z3_s`x10Sc!rB{1cqD`Hw7T69L@l(_=7-Tj2zoLfO5vDCtpY^jHG_K~TmGFgT zTwSl~?k-{@zmnGIyI>mYyoZH~dyJdZ7$f;T6&H-=iyQA_Uz2e^B47Syz^BWgYvD1{ zIuLe8_LC5DCQX6LYxq{Rt5vEu3oz2Rs{n`Y2VO#Vcj z?D}nZ9Kz~!m7f2LPk<43SY2VS9#LAPLXbJ%xbvyn-rx3#@xUeZ&1T4c-0l->lyhyo z!}TKAc3jrZ{28RtsvGz($6v!IV}rkT${pd%5Dizm4vAioT4%|bg$d%!B8V`gdF_Jd zaXbVm%kU76CP;w-RHWu3bGWRQ9~Keyq3K5%V@<2&M=0iHcQT~2o5^D#2}*+6r+2SKm{)5h29V5;kZ_RDFY&4YSYgDCBL7+K(r z;D;_eT3g^vzG7%)(e6kn9aQG7XsvGp%ZJRpc(VhfvqPuo)PY%|Nkc8Bst7C$tB8pW zwYSY`mf40Ixs9|iH|c(cYLePQ;&`mq-dTh!^jcr=CR#s9oAt&km3@dx!=Fh|&1|9# ztvZuG3JIER;It`-$ol< z<60!4q+?*hW~o6?7|P!+Y6W4TE?Td9>QR(lJy zVbhPQCZ^t2J&l|sEyPXchrDTkb`2SpUnEh2hP`t4MV!y&{ElU?>6hBrBsbwmq5M&8 zfxFD$E@ltWB3(Zd%dj(jG{n_4hjDd?Hri~iyU~BRcEI79HmTGRJ`&pXaig^Bt`uzdfT+5Wx$eFtgXhJ6M#c0 z?e1g^XwX041x%`b zLcwYAN4oYDSgI)*T8z!_7>Xm>o-l!2y9noqhyVyw3SQJgI2}(kL>vZ561Yc=8!u|x z+;MXvcY!ttw$>n1_mL+<>=kW=^GhsjTH6gogqvGHR_Sqv7}g3(e8sN-uYomL2z^9l zp%#uC4*1=|264hdV9B${17kIj(3D)f5VcmPpTCyhmV06R;!Z&p548nIG$-S~@`XT! z=kS>c+YYEDBz=V4F!d0uhILq^`AS-Z1mLvu5^Qem8j!_Jj{ZHW<{J{sV#t&_~F@v zPmYNtLJNbvy3Ims26?HtAhb}#-Vxe2Fk4dgn)U)JN_icVf_}e_MS>A}UGs92Lb1nO z&9z3TNK~xSe4ym-z8WKhI#z4nI5_buWZ{N7MjhH<^nXkH#t!{|dBB$Q8!l)K+n{-% z=&>76Eo$nuQETt&L)m6u(~^Ax+{syk!PR%PE;XXQ`Fj*xj=!t*gT_1w4+*1@ zSTXNijTGXg%1Z2eT6&E_u23OuMEQG~FZ7R*P5PR5#=ENhLBzkWMaNg?lL&^c0ow4- zwG*0~Cczl-e%JA#p~&wJuM>G4VMM%m6+GRrX@PYB`0ySV4W$9>9ObEYkL*oaPng-0 zeBt;_XuwSv*4Ktg^2I6Q9b}C0MG#51Hfdd<3w-Yob=YRjLlO{e#DvXQzQ@GM&DzIM z5$?YQ1j9VBXN$J62J=}V(zYVqPjvRvOccC>3m9j%Vk!PiGZK(}6c;8+$+K>FoaTRx$PBsB_MK~l$-lnyc&8ve9|I|Dyp4w9>3b$!bgi^Ug z^;m?x^-f73zMh&82$O-ifco%jo(@@f7(P(pgm3AwT4%*mPMaufuSaH&!#Yox1w$A) zJ7JdyZZs-sN7xQxCKuMvvHIqTKHIebZ>qFDvRQ+GP~6uiT=nX zlhXpVlEV@wk~gmbHaKc(ufwYHS|28}x~)vXF?-SuEu=;=u*&WAW`dR0_LUCVfphNe z(EROabKli)bf44P?vNjF_qdaxwUeg&X}6(XdVy-gSxI;fkalJk>;dE%8o6pIGzj;I zJBHTA4B&sGDbAmgKSFnU!66(*Ar{__MDcb~t@udm0K9tRBkd`^0i6WFd(Yj1fyB_$ zhjm5j4M||c?OmYhAo%-O>w&;;w?^jYQ_NuVZW;Nj8FbtuzrC_Y8#zkF1k)~P!$V75 zyYF4U@15QE&hLBozV9986PA7nryFDTVhD=F(|ffnDJSw4C41eXMfelwZijuKGm6CP z`?S$CF8j1#Om1L-wn(B+P1p*w0Ge*Z;Cr7!Ao2quqfpyegI~8`u1Iv;uLa1gULvt8 zNV!xS4pLM1gPLt5mh4CA2ZTBqf|MiswHZW+A3*V@006C+f;T5g$)sFR#1~`d&N+a_ z9}xKmWZvTkv}sk`CuUc2pTiDny{jT|*`x0vhre;;pa!#PMMm92m~r6B#|~>Fo&Fdh z5}m+a-C+&KGvdx+?Fl(1jYP&kn24HnM9Y&~6M=p>9%9#NH9^K(gceBIT7Z~dq#gYC zWRQ{{#dhRMn|@S#=U>ux{8XdcR}j|)8|j~FADVi)ey9$HeLisaA^!W3;~J?n*%ZB* zapgEjd!X^e&A77>*V-pU;H(yh)%ec{Db_;l_Bx7a_nG#bWbW&jF4nK_@a!PiDXo-B z`{|UnLuy9(h>91K02C~5^PV}a9mMa|pKAkve=9!M-lxQCzR=oHc=ije9zx^p7g~_1 z7{x_ID-Xc_SqJpvjKnh_R%Df3L`4P^)Y8A!6w0{tYi)>#`w&ut%=S=qDE|sgM6`BR z8-;GCodvN@f(+nu98T=7RPfD3geb+DY`d z;vxWgnusXka`B_{o)kadI9xBtK?DC2M5wFxB0uPe#NK7u` zVG1CSUb`TgV2vP%IADrP6lwkJrj}M0xVghgz?E+_l4**jKk!hI{;lRgFAKjl2Yk!7 zn!i-fJak!`iV>6Mnv=fM8v4~m+h{8yx~MB2YQq_^~a&b+T`y+ z3WQN4*moV^lJo~iz|8NpI?iyELOJ0#^m|ZqvVyJ9362ON<7jm6G5i%w-t`nO52N4; zSZ8XS_Jii{5*{u2Rtuvjw6m$WUK_+?`VZOyit)UrJ!t_~<~40Pes}yu3)8NlHj6Mt zvWdTFjm5C*K*85U#&xYdW!-xn6N*VA7!QBR+avpiwh0rq`G#57i5uD|7p&c=>m#ez zLVfCq88^XCN`pZne*p`il0tvf9x|sIw<~_s68a!UL)}kexiXR==C#~*|+6dGJ3hW0vk#AuYlso6%Dzg&C+a}F(w`X>|Ccses;AIGp_J7}Ms}wv>CV5fn?QVtd#MPf+{T7;1~=QT-U&if@1)wB<)33=(`INUn2tuz;e0Fy8VA zwKsHyu&5{B8!JLv=TR@a54OG3yV^YW7-UpL;$e?q_gL#E86?4mgUdgaS{q50paxk@ zQ_;Vc9xXOiY7J|UE6s?6>Y-7Kt)y{^2)*OoSR|ErctGbo!-jluUA!DM%4@zdS05mm z8_GswMMH{H@nNv&7H-pH|M?rRZZ7OcwxCjDVEq^E1i$cxU~^)}wEsq6S+eQl$N5qmsvy^ z8Rb${dO+m5>875ohg4pw+YV(^KbdHccN!L&CD`X_19B<67T8wiaJ2~W@?%Gg1uiH| zs^w5SRm;;E(J`Xjp|ctz2gi0a6UQ8S%Np^C6dxnny5AT7pc!A93pGIcRO zvRe0L>Pqn=Yb1rVhRVNkf70$|{G+vX6Edt`^^mdeSi#sf41miw(ZoxCN@7PB%~0T_19uV8LH-SADta`6Tt#nV-)R>oepUQMxuQ#r zYrCp9r^uzxA+ooshalkuRgVdxO03Fl=*zvz#THe65v9j#day)sn*JbiE!XsovJHtf ziHH%p{sB^RrpHL+#`Jo4O<{TuWO|qB)BXWdHR5`(?P0kQie#>*BV`%apXKDpm>6r~ zRA^5|TfKF<`?%R#-wLzR*!WC4K2jm84{m4*!HkJw&ag7n8tt!Pf3O}#TUuy{j?<=4$o?{e0isa3 zFuy|yG1&FJ9gKJn#;YXj!KA6~!P#3N;miEZ&P3?~IG-SaQhiZ47uNz09)?(ccY>p( zU^t379GH5j`jII-)$n&5@PU0`wJ(`u}Y# zibPRezyTPHy0ZOELaW**+uu_*B1+gofy8C^a2YievuyQ|h3T)!G?6vagjJ;p70E$h zJu_PYj>5zBB=xbHfRTm$Fkv}Jz1PBZV*lO^*H0ms9ijIa+Y=okup5Xh2?%fDp-CrM zt@UltfBE)!wQn@_G@|rp0Z=@CM~L{&(2aagbgZY7Rn(dFbg36%28CvD8Q=H|aCJs> zgEiDiklE@!wgw`tu7{8F7dS8@Qdh|;{NBe&oTf~d6(8mU!^_Jf^#I#?@ouCZ?3sp? z)PkM%m0Q%tk^#UQbZ$~gy?iEI!!@z$6M7Esw5+XKkK&!WLGSc;zZ0~V@x6L0XW-on z>8$+Y@lNgZ6ovCaXSEf}>+8|(x#XBkIv-moO6u!A&N4Xlq2d+6n?lCjKp)@eAbcHt z19w+H;fcj30yp}b1YcPcS~UPkG{8`XiQ^6Q826@dYvv_VZu$mi<;?RHu~FEa^QGsq z3^yox_m0wi$pA}~9`FD;G^^gV%lG*gd;h-oEWFEU75P!RPhFbbk!S}dy=t*j+$g-O zQq|S@R8@{UQF^d*T-9qtwC>Z05|2S*63toIg5n70R3{RP#PDc+fbCJ8?l~CkAS&aV=HhN`@8(9GM*4JEGZlO^h=Lhk;8?#PMlVpUD-a|T z|4&xoX>c?)5J-8k`iJiF{6Q>#2bM}_HPKhN;m!t+*Y}A>m*^o?w~-fsG>3bYNc%8| z6yBu^mvte_C}<8W=K3)F-#(0ReMpD|-s^C^Hn2nsy{-F5v|JS#Z{rvwuZ3Pm9%Y4z zl*`z3N~0APXAEkh=`uHoKU!iRA1l&Y=`8}sA-W~L5Gd1J(2^ij@PydY zO7CGG51HC#El7m72KY>%qQQ&M-HhVaK)N}jQ3*`v!Du!lu<4&dz?s?_d;UbRq%{!P zq?+kF*e088i)(}SPcfT2m7*R7&yDW2$L$HcLGyAGt~VsNhvm=GAZ!dFZS@?u767pW zF~=D0VU)H7Rf}s2YDdJ-#UGE@2NLsi zQ+Qp_#_n*DN@**hCYaYvhk7B|L&05_?s_zgL;S$257m=un=9g!vuYg(+Xp~6WAr>1_?PSe91cqZZ(lqHYXYa6^CyBB zBCYqMlk|4-N3ALPMABPGOVhX3vNboLDY>W?xkVsCsbG_?7{zn+SR4Ezkjx;vTWu3O zV$-p+o2r~V!#h~qN(VHZ5o(6s#uF^Mt)V?r7?YJ2Xv> zFVtaC`Xv#+RFBNcJmM=BFVWXSNgD5+#r0sjM^@fNK=ly#0nc0t$_;C}|4*8av1u9L zS&TV>wj?xziq}zbHB%q$e8n{n8^mMF^`YuQ>lL`kM%F}O!3bpL8PWe$eUO;`ncmPS zeia0YZG*vA0Nn9q_)2{mg5xXoeYVA>cq8v|NT4@m>zPQ_QRuin)Lis>4Wx_okSx;b z!vX8!*YrGj4UoiwG#&(|%|)Nrf!FDFAl+uHiuS+@{)oJN3=c_%h=!wd{s^nmiPgyd zFSldM&f}Oc$?2yU<*(~UZ1yFJXgbO*NPKh|qQP(9#ON#)wp9R>Wun_EZ0Tpj1iU#j zEkG69R{<5AG0IlyLv8AE*DRWds4N_1k6EMF$FRP#Mqh^@_Zd=)TdSwqJ~#5$>WjeB z7#(xVC--YO!tVvWq&q7Q>Ac-6=3tyrp&c$R(1eZfZb5Zqcf-M6!B0?!Nc~vfZHr%zVNXC2^helz!+q~>-}k;z4BvyX zhvU^f*nr;^9rq%5Pb{b4eQ|lO{*?2YtEf#PWuG2=|J|B}`*i7gdWP<^qX3KDw%PD2 z)W5emx1c5yv%=H}j;$xC-bV8S`ja-OI!YN|!9o3;n&(P&6p&g=*l^!g6jVU|Sp13J zQes<|rds_&`X*r5l0%ZDR1fR$p?in2Eaea_A**VAcgK*nnL7I_y0)T*zyjXwV`C(P3 za9`!cj=Zf`ms7?|d6tS~O++AXFZFfsBG~if2!)Cq1DiBic_el zP&rQlNkT4v3L+YqFFghR0hWYLOJ3P%d|D6kbQ)FFFV_NK5#<6k?IWY?qW+gn-D!Qa zql;PG&&Rl3hMms2%N2iAY`&~-bbf3lgYK(8?katU%ALEdNTcw3{cBPk?Vko(GViKB znYM+{AM~X*coW%t4XxRW-8LU)EK09oIYT4!8g_(`>w1X203YrEVccF1n^%*s>mK$( zMO?T}jN8j3dA_dCf-3{{hCaxC03x|7Zc+AwuJ99Ac*qqVc7;b=VUY|&MXCeb*- zFq%XypqU?o!$CiIfX;*2{JaI&3yXjBaQG2FYpH`09MXFoVO!%IDbmTeb;6Ijqwc3x zziG_y*8mU62?%*&=6=+h)l_dcR{yBK?B+-7m|8$=6aA)^K*T>6>ejt~)>p~H4VIO1 z5d)J6YX{0NdT)u^|05!LLQ^Zfrw3TbR7lN#(LJi9eO4oJ%!A2$faqlUtBS^NTG7W` zO_nPL??lT{{Bc)&BQgZ(BX0cybaYGbU-bZ~D~A++E9!(u{8b+r^xd(_$}1=S?ojun zd7>tYf7N>ix}U79e7?A{@*p1HlFG{dcxK_*AmV@14+9(h@f&b~Uc$Rg1x7sG2)qqK z(fviR@jb-mJK)StoT;oFA-=k!?=}1!jnb=g#KmIx zT|Jm@#i#1ke=c6Ri|z2TIDS|E9X4q`sl@&lCn_rSZMM}bH!!-6XtS|F?q9$OE0k*1 zyZHd+q}dp$c^BGPGpK-9*qD!BDZGbLhcJVZ=ObX`BGAra8nwAtlNF3bQsSIq@X#=P z0+*dM`z2zEokcs}M{?TyZDM&i`SY-|U!btH!3}Mh2M3JI)Hw|m-5l&$Y~Xtw?65qM z*F{E*8#EW(*?K5`cB{qOL%|Eq)Y?PA3jx$^YXd2ttHm1PvwLmCe=ZVhvo@r$Ronbr zA72Us192O&Hd1{lDr&PBsmwueOh8H}-O$2y9dOV-SCJb+Y=luSJEEJ+IQ3&{Ct$o}(yH?>xqfc2gP$D*VEI?-zl6BHV(q zk{ddVBc2ST9?l(LGmaBl7>I{jMj1<~cAQ@7=;I27^@fHKBEH9FUt-4*W9fQe`Sc33 zs$6Bhfo~#*wTTm+ptGk?ggDsCb2byDs{_^ivmqhNvCuZC+E>)ivo6>F^~{+LVF794wsiY#o+!N(a&*k7tvCVw*H)B&JS_ z(V{AAfp0J$(vo#?55_T`5oT;^%~seXzf9t@dax(s4@Kj)OzH~EY0DO3C=JgC08Hvtw4FfTY_D}A z{h#-a&dS{DYdqeb7WogNk5zh&o zf!AzDjSUIR%?5=!8d0Mlk->M=mqot~s?pdLcHG6e(Ge=Um?y}Pmks!r?1>Zw1X zrB*dDZW#7@d-#%=eJxX#Zq{Jf2+53{#w$DCno%Kg;^+bjM)e~2Uxk-MU)vp4NC{gGOu-c6xvr40(lKwdJ zsP-{qCMjue#8E}u`yBsW#;uaU%tO}hot1bIH-7ygqG~&sU9ZZ8x=unMms+YhWE}0s z4Md^=9GpA^c>P{4*9^JWOWE5Y?CpCU1N-ZRouyzXn?)Zx4P)j-rT>V;N9{Q7{T7xO z7T-kIGlv1M{MQsY!&z@iadS9}k`=TUC4ufZMH<11(H`4KW*sisU>H;+k7Nz~KLuvA z7KVk#+ESk0e`Cduq~X^-RqbU#Yu*2C~8 zqyT)}ThF=%`{ zB z+@LBE=-Zi$xk^7j6JTaGh3>DYG{Ux;sl&HHu6_GtZBrM=A^JSW%zG)`BJq-Um>*@a zBMXIYRaqe%gDC=d7t4OWsxrUlnR&;>T_irw=H44yp!Db2_*M?&uG%9pJPwpt4-X+^ zYCeI5T+{e%(XEZEbf&UrvBs_yQ}UUqMs;Bp^Cvj`Z5C@+W4#ejnI($uvsqLGmHY(a zBJuoFZ4Qxp83;3HHVc=)Npv@D5yWYC$3x}aD^t>xKWI`f@6Xxn8EOJr7v*^`iFj)c zlc(9A&5;P!_;U{Px8ZDor!#pGa$-6=gxB~CwoP@%xYVF~q{Qb%W>CRDyvTM?_|{w# zx15;Ef@J($_8Smq**tJ*kp0Z3z<{ehm=b`}Tz?;|{+F>g&lfXaW~LDcZ_#8p2toES zfVY&~2cCPGHI!J4!}A3QsgMOMS*=xllEfOt;A-az`=-|d5wijHmHrTy^Y&UxZDR-i`PK}#l6nr?yqy|>+Dsz z+B{Gatsug>G?9dq3As|~gGIy}tl7VjisRm3q15G<-e8U8T$-dJ|I9DID1HN^K7H)8 z3ha)gJ8_k8HFoU+cVdB8S=4B7RyY(OHmza}Wf6~{)<{uS1igy#RUns9LetgkC6`X6 zY)NAzp$5~RYbq|RHrKGW2AGGSwJE$G`1)*2TElE+00(+4W%N&F!z90{IJ$! z)#em1oL;WLZrn46g`*9|#2hx!=9IRUkOeM3-v;SZo(pyy4V?29lSW!Tc#Aa#K%9Te zq)YF<#U7F)z({Pl4#<~U_8*a(@8#npj7p8ih3j=}5+%F4j&vm{wwf9!wovvK4EE)&FUVD+h}fg7rbjEIY5xEk?tbUUHw zdSF{&Ewgw7_IDR{un-2JMx*COu>G>=UbuYZ7Mzs{4G}t3{s$eYl6Qd2&KS0Lq4kRT zbJt-drcc9e4JH2fz*Va?qGrEmE|JjpS-l1{7SvM<-_X#|dlViEu)CTRPr(~7J2CHl zZ1CvY8}FMyx9fcqyMFOLBpYYM%uVbt3^ErMK=Ec zjD>Aw!CZIEwy!JY8F79q@C}+?E049Nuu~oj#gUopR{2dVoLPBny6jsXdj!O8#KX`F zdpw`TQrzBs0Nb2=7atA}K-aK|I6hz>O7amp#$zFYI`e^~F9j&8LlRqr%J}Sh5H8=| z=3;})g&d(k2tDgV2+nwoc?9_gHQ5iD?|nGMxcea*g}Lv)gKdoWM(3=xMVkvDb=uWw zXlN55D#fRI8l#Z`vJ|piLg?9Bpej&$78r~@gd?=lSD7R6evq-|&%$6Ruu4Uc4vvX} zp~S-MEZ92ZMZUr#Z-f?le(N<6S17 z+;cM9>R0vB&7#Twx5ES|<}mMV{2PyoZ5Y(B!D$XKAUAFyZU7`Eg z2)xeT@6y)aj}?%&AKZNatr^^F_HkIA*edojFI(gP1w$6BpvtI&YzV~e8SrZan1PRz zNO`HdCd`O04#LVsFW25paMX)z?}0D=#N;%me!_N1iJ~=_G>|kh7RIM!ZyaaMUEo`C9J~_Y18G88q;xlD&hv!1hjuz)G71Avn9J+A6RsWIHB1Lj zfGz|2JZbK+pPh8cd=kZtiOjT8`X6`&2WK5@5{Ajetf!oH8Z27d^k^OJjhG$J&sf@FZdJ7Ia~b5ITqC{DzG0qvcHa2#_cU&irC_!mHNQL5uGPOiXXlJ8Q+Ma(ThNlcE%o@l|B*I=)Yuf_Qopi39{y}gHiY; zHvU*MXhH$3!ku9~ZB3B_Uz(XgoEgNM0gkfhTMIL2X$Gy#ptTvm?;a&-YX%RPK|2a$ z`JgMmVqZg8riL9P&J31_LMnDR~Y!>rvr6 z4{&=7uFu$9=Rns;<2LFgNQmMtKyE)sEHA~G*W+d|*bIi4!B8_8CIgXt9Sd_sDQLVA z6ah8fE3BcoG72Uq;VbGQo90ZeDnIuIYhk7xWtK78491v6mEJ^A)5|cr;{-=jU|m@T zIIQ;g$;lX9ReS*yQj@JD`zV-EIZJF{Z;n3nn7h?)ev!8Ta;a4 zbJZ9B9yRxGQ8?Z7yT+Ee&zEh;Z2&7fn@S<{e93IX%VrzGucHkMM9Ouv;T742>{1pd zCf{Ij?h9qkjF-p=#SPZmeUW@mDFxlW*eqm8RYzh)*P9rbrBp;`@f!VJW_GFICdBob zqUhOwaIxY?q{DD#9R&*Wbrs-gYCVhwZ=pXcrKZ?xBMzp^i|LXZE(T2!L}ZNuS3D*P9K zb@=b5Jfz+4ILmrXJpDTxU5}*XG)mN_`Di#XDfRH&8wT;`@8JT0h| z5a?P)NXENb0-~f6PRl@OL=;= z9hSDpIX2$Z6;)lFC5K6FaH%$s)KhT5W3=d4iAwzq`CoPnaDydIAQ0K(YL$tsi3ZKDm@8`e&^lz%T1)VB@)xP z6BjWM4^bRMWW9+ML;a?LX^z0uJ9uX(_?0+Nz!{^XI~O$S#uv4?W>Z%qIS~*h7g150 z%M<*m9(;rxA8(OA$=y7G_7*AiahK$_2Tua6(#Of=vHDUcmvYDVoV@S9IA~QpIhk;+ z`w2Wm&gugb={YbJDRTNiqan33?t-Ly@}9CXF8aUg4&^jY*K7oev0i*5jRnkWkVaaX z!nalf)O;-fhnOmF7-WG1p*=cOvA_aZm#X}xYa(6T@Jfw0b1AGY_Xp*cu)P*;ENNVx z)%>aPAQxoxUx<_CSRI!NQFTYg+sI4QEl@m7oCRAnxzOxASPQBL^Kppx4&$`z?P2_5 zoJ7y${8MOBN~z&6Zw`mEqU5x9j41Htb!=e2V1T&+>b*h@|JkopD(kmGu#7sZ8vrO{ZosxqafZ; zA_I#*sCHO1HHe$yENJ|U1-?xn13SBec&zP87Ei*&2XS&3*Cd#KERQ}MB5{;QKvr@O zY&#+R9dof7J41Lgn^euICGvlU!a(s*$VojyF^Xr5z)&7zlQJ=@e&SDv?=Uf(7!k%t z(R@pcP#%rVyflnYr@pTu_3g_Lz)lb6QVwR1;L^h6BN3c#+qu`{*1;KQ*-0Yg5p0J! z^-%3#kzbEbgBEv0ByUldy#3f{{P0-Jkp(SMOCW|Muxldu57jgRaD9P=XR$kQ*IJ*y zQ&$qz$lnFe|A!62s+RCIv`7vD6q8Co{Ukr2IQVO3PWI5`_20mTblL2h%KIF${+CqX2*AP9&kdu_${0;go^ikunYRHNHl>Chy0}%E1*G*Y|gu1LM3SikkE2YWOy-J@9{N&j3Z7 zI|z?o>|LPoxE6evE7S58+$_`yGuzO_I@ki3@S6Clg}I+$yAKs{Pm;~qV&;*x;9zxM#m6#+ag+|hWf85rk^qxXN3!!?4lMIJ0k zDofx-15ATPSzyeh4eug5DNFjB?CRY%JWTrY0OF9lv{|t@+lF6|qL%87x;JgWE+Y3O zSR*TF2^Hczjjofn<;4K2!Uy=tQ0h(f^;)x6VoN(dksvXsJ%7tJK85Xh8(MOIw&%5M zb!*6g0B}T~QW?}ZmrN+GBkxUR%<0JG!O5DAyt4QJ zy7EDwHzT@nL8H8@8*h&G-somRG1`kmo$kD)leFIIprm?P90+#u3(&?)ZsAbK0lCO| z2jov?cRma`(@w$zcMq<3ZmJqd;opN#mCF>$ieMZ?dKr$iN>A5($+WtmdZ(eQ-t-iw%h9(K#y+tQF z_2q9j*@E1Jf)G@J-UciZjG%m{Vf4e(3eQ%-`*9!a!43L>0>Fi;e!SAWSJfG_v^>uD7+3;>shuCupDe0mzpp_&^|}d=Za8UO)dpR6GW`JvnpOMjwO4!2#U2 z!G~x}L)1rYpg&p;M4*vajFv}hJln;c0X#;MDDZjviW_vdK6N^z#&3ga$##g8M*)I{ ztTWKk)Uk|a5TQwheI)Wz=s@@}&itsd`@iq3`tIw#3ys5eeH*?!lAg3VWO~9_*4m}= zJ{H3t<0EamsZU_%+SKxp$?osN9_oIWZLc{l`>2hPe=|B=aBqwX&4l~S;DDLlYAe-y z@Lt;re)o3RKB1I2^uCJ|`<{b9D$_J{ne;e!*pA%y4ibuz9W{eb&ES|B z95;g#W^mFBip>CaPbuGLW^hX659ZNZ=-fb*oKqzaujFc*dY%^DC0=K zu9oh|9tHwfnmdU^koc#!)bxODsCr`YFy28LR3Usp&x1oL5aVCJ8X-DTWOPEd|pu!+CIxaxch!x(u~k6d6Nt?2ufkd1SXkBb5;# zZAwMO80g?6jNnQQTOefwiD1A+@D6@7n8df!lAvvkn$lbx9|3ruCn`o@#a$A8MxyBY zBY7RUGN_RxYo~sEL*JSq}BTM0r!Y-vX+~F|udS9EbP@9{{Zdjvq)$9fv#eJpa5sIhB8cqC^jr;-J32zU) zY89VgyDmybp@}y{#aMJLZxnpAgpcMPem7kcLjAM2x_P4GXr%p7q>Scs(TU5Wc^EHu zO=N{D{E6z27k(Qe$>1?O7#en%5~!z*BQj?UHx1}mZHG!6rUtrj|0T_DG<`i#9Ht%@ zOW;VRM)!X=t4tru$p;Or<T9OT4v^K2+mr?NfoMq(*u_1;ssC7PkZ`s3aMZnn@u|LU3B-sIA>g@79f%ga4`3gp zl0#{KBy>$5D_sLisp%bO>^Gm_IMsnWBQVXVYYt$(;zMez2G_iGK}3px0z>>ifisv|ueDD>Vcg`(*xMl@CFn zc-cb&QAmWQ@E5?ZN-K5+Ii8N}shlj=Bu;fvp|MB>lUnorVZLN4m+DARDQ_$a60xLi zP32vwk)5V-fB$PpNpnKFm{bRqk8gboKxY>$!#&a*A8?bI)A$uzkufus_j8jY<0;}_ zA$>2)oh>Stj$oDPJnkQ~E|#D33Q#+uX!908+vyXRXaPn@`YbIo8BgHE-xxC79VkVymf+ao(3ORWV zpd_61+&^-f@P-3w?KxiGlrv?e#NlKs3A2&69DX&4_^*SSs8)h5s*&QNMdC#e2e+P+ z5CL08@bLD$9KYeu^B1Tu7oO)*voUlQjPI2X2UC$g+g)CRLCjK0v1JzbM}uLi2yAex zTJqb4S$qwBn=>2q;s&u{HjkA47-*QO4K(D`2AFN0jb3jMjpkr6q4NmbiKO!s%ipC# zfAaaAnueR`>|;RJ9PkH4u*wKRCH)1SYW^M|De}fyDYpO(>0oqgY2w0CyMN&Q*Zyi( z&Fju|u;K&(4pElw0tSb0&)`xyrD+Bq0fK%>2DTiWfK33`lGx6wu?PAh&z(g&o@Dd5|4|6`KcY6doJq@fPTA#C#rxVKN?^ z4`HKRD)mHJHoR3OWWdr+=}4@<;+OaWyN4!*ybQveq~G^au|UC&YY~6Wymw-B*@%d%0G}yaRQ2|Cn9>Fy~mbe(@{j(*O+ie zCZBLU zm0NWc0QiVVTm>occGxB*3ZxD0*Qc)HjFV9);?s!xr3C_hYZV_U&OCzi(%Y-}bh;*s zBiGd+IM0aJR|9f8io(^{q|O+LYxp`h)f)w1V>a1Dqav5%?z#^w@_7f_eX$P*!5j5Q z>-c1sNIie1BSx%xKET5mww~{X0|%&$L5Di?UCIi8eC1;u^69v=Y**;;7v!TsjR6Ggn_vjX0 z+%y1Vfz?taD;S91Bu*kazYe}NL}+up2Lkiq8YkT*fvv++5N790#I1!>UJ7n4EZNGh z5zd(g$Jd#8e1Yqlb=p;^1IOiad2QxqJ|yy_1EZVTbkZnUhYxsy+(C#`r3Fq4o%&3x z*rm6U_W{nKh-ZYu4qRvxY#SfrPw!}<%+m!Sbv{TF3%8jf_nX_e)URs%A@B6RE)0sC z5BVzFHKXHpz#XWrv>kjX;j0rnxOEdKZI=(IuW)E3WPS%PJK+YO-k>_OOM@uUHCkmc zz$Ayzjh*mQVT<~|q$Pj#JNYAER&sap=o&kLl;wz$Z8*cu3kTvZ--!kT0(Jr6!@1cm z4%ZK&$;bRzXVn=d9FPFlr#65J^QH#4ksmU_>0w;|m?V_dh8D(&A^9}S|8PNqUc(L8 zoL#ktn^%Z5VY>R*0b4A=B0d_RQ@#g`8E!M}rVKP7h9i zX7NQd5`Q;$7$rgu+^cREG$dqosRw|x28$&Jco*4}f66Eu8-5V&qN35*zvVuNBeHOF z35GjhEIaO&m()yde2BLen?5lGn0Q%QeVWc3;{V+jefnYGy9n7|vfo#?9;Stcf|SK* z0TXe)wtM30IMN3dI&rkZ8baGfF>?Bb(E z{1;FKy^ccYRbLZt9K|WXeDOKGHqb=Wr}8!BQ@loL;)73lcYOVWUZXYf&@uko3zqJ_ zIdkS&KS{3Wh{!rdp)UNl@09kxeWxY)FW>vga~kULza)^~Ev!qk+6-y$Zy=4YnO|rp z_(S&jc5!nGOuvUbO`dlmn5VJy1otO%SMbP%gOf9W#=Lc~bYD;c(rvzo_zVKx`9{%a z{7oBW?sS^ty76hAgUGs{^Y+zq0%jm87Hp~NYrJ-bpO#7oQ_q5~gwW$GWPzWeHMPw< zD(q{VfYGIQ`isa)d<^LLYtZ1IijH4{zrQ2~e~rm)SOqx1CbVXx4M-fK5p7ibHCB5J z{SJ%jiBbsB#sX*(5Z=N=fI^I<^{t5}4Zvq7I~+#BIev@W+C6ZAe`$*r{358{7GMh? z$7(88U*v7Do<6_G7qNazD=TAA2>qqQ9G@u8sO>x9{B_f$A8kkUmB7FganyunXadmy zR<4WJYTDTQ^1kFW+!c2yfa||+_yG5)E3h(=#UtQ9=NmBot-nW8M9FryfCk2QHH{yxbG;Ls(umN4 zm?82jb)WdNubbvF+z>^7;*HA6L91YB1CIyZJK>4NLxW4tA`$T|k8IFtbxkW96W7$V zfYBZ`G7;ZJ@u_#@a?PRdao>B$<*b`82K6_-t(k1meeV(Xy-)b2=Ad=OyB8X0L4rd# zFY{pcwJ^ouB^%;bT4usaw`!^0Gx}fV&)NnDq5Uy~0LO@Cfz)=Vz@K7aG3dO_y-1j`#Z!wZl zw7=^UP1_t%@jbw4ig3Te|Ee1g2qit_fsIUBogkPBApGUxm*QUcl)O==t2_vMa_%Ls zFzEtd)>XN?FS*Ls(uNGf_)@Sm@P{g5NU8`ouR;_e?*~4Nl4{rZ+Y~NM_8#H7ew^3_ zC$Xcd3$b#QNxUK2LJhF(SSX6f?;En!729;x{0AeMqDwdPis91bcNw_}%2o z1!N0gB zYxdsZZs6^cj9IX0f`x ze+%q4%F01pTToa9wm0{}Dn6ElmZ(sDl171vEU$2>VXfGYdU1nn69(~-$Fn6+qN-n#UDx5Hr{!T1E#peEXC^|WR zgGj$Kis!k>!@^jOMeI@Be@yueD_s{Zq?XjxaJm^zccbLu?f&YbYM4fmNW@Dzx08i~ zj9J`vMw@Yf=>S%1TMAeW*atWZV1nrebO7W6UIXj|oB><~M1c+`0yYEQ1MCNU5BLkf zW%UTUhdN(%MMm~S3%KU|gd?N$A|r3H*!H4zSFk2PQTi%69*WX%!ulWq_eEdR?Pt0v zRr|(xi8j?p`VUIKiVZ`5&QDksWwq(szXuw>6OzKB>v|rkpdF%a9L95sfr}nQ**Cx+ zyXfAToY6+`x*{DB-|+Qq}5lb=o&-~I1Bp&?J2(ojQZ+k z)hHi%L}@$den+L!HheR$32#IxmD*t&SR1pKG}4qz!gJ`Ot|=1 z0QUluZ4UQt@l-S2G}C>MN346;dpD{sxUa#F823!1RJ=})(JHv^YBkh5v*~6gGvJEY ze^cm8e6&OjJS_ajjd{pS|1c%ra5asY1+QmcSkWFaqs`{N=uETxL!EdW^!ppYt~utX zxu*Ll?Y@cbYJJlcjh7&eQs$ZNeB;}4{R}H4b>@tOX7TGe= zh;LNz3!28p2cc-s5=^s8aUsOuA%blTgztk>I0Crup%OTLczrE5#`^tjLS?DWI<{D$^ z$|>&wA$l5^hX6lWMWPr#EHyYxXD64^{p2aUC-alP!@jDZnk)`*I{3@Y?yCM}Y5np% zL90cxd!b8sWV@LDrL@^!Hf+d1Ep0oN^5r?u*>*bQ9@t6^b;#l3mKkF6EwkegfoC~n zr_iBK<}d*6WbO$H$xR2ZaL6G?h|a;e(;-MTuRG*%sHu1koFxaTW|FaRc@S%!5Q|q!%a=n(VR?7(Mrrfl9S|UI!6gML5FHEU z*+5KUF%m)Y<2cwZ2$EkBB6>kY$+a8GW>bUZ4am{uls|%4xXdZX$t%$_JRv&+3~qyJ zy5yRy$<)#%cW|((52IygDw_w{W0p$}l~&{~6XKZdV^evoil#R3d+Y zW~kLz@vXdY4gEtu7A%x#VV!_K9wOHhSAj#QgfATz zhR8w%{zQmeQ%rz3WF|-n{S+pLR|#55k)g7o?KujEjgUtU36)2PT?&rDOJGvzSSU!v zVe$==r-&JIJ6Zyj*TLSVI7|+xk|(Z;-C2yQro0|IoPr^^Jdl(Pt%}l`m~yupF)UoJ zjgz4T;qn{_#yqb?$n&HPc!xpG5jwJoXae^QZz*`I!Oa185EUg`RvtvqfzEJ$MD#aDzidozaDt4karY78&V7EjS(ab!-MF{>&Q=v@xXb1dsH{02dktI zO!yY!Nm44@2hseoU2?RzwQN}KNc#b%4>Ib?YzZtgfSXuXW|jZ4y0TC`tyxcov6|O) z$e)8H*j!GoFB_L&VLf#N7Qc-8ato+#3LzMq@uTAUvSAM`c||gwS&f%h!#1;!Uh`FH zy)Ygq0!oIr=<&`Hp5TLNGU#WOZbVHJ8p_5Eosm@H^v6^64dp|UxeHESh`JRw2JyrT z!%eVc2z^iRb4}!N!e%UYERQ-fQ9R<}Fo6nUAqOAVRA!6!OPk95g}rxJ$an!4sLPu| zXJ8Bc(G6Jp4?l#rjK$SrBv= z55^{aWjnc1m6tbpY?zE6qc7UYwRjo&vz=TIQ#_`<+z?LsaIgZss6xecwv2UwFm~Tw zF7-hOgdD>m8NH2N=aOZZ4At9ol3|DbUE@RkHB6GJo#obIl9+Zi4s@0cYmqRcd>uHD z@g{`H&NFr)&1upF(+6GLMeYwNqR2h(HD8Dmy2_!VW5B(~p*3s}G{}Jed?;dwBpw=TQZY z>s;37t_bEq>qTV)Q9%Ac;3zE64aUBscTc$;eoH?h%hf$a_{N^{U?v?mdx9dO3cX}; zk*;qqISPeCS`|kx_5!Cjnl|>5+q#%PK3q~6a% zq%XK%hP}zrw4*orOtdS664ro0P3R+s{)dfQ-AB$stx-apV@hR#qJ1;^%B(}Qpf9*W z;7319iC*+*KlyV6rlx@2f)i!6kc<@h#hMmN%oS%;n`q{Rj%kvL#n6nKl?u{>yIA!> zoTFc{*>loXVsfR*`N(?RKST*-LwHU6S_wdq_+5JYckVYLIPe=Kj*|MLdcCMmf0=K& zi38o`{pA6HI%bCGHgvQPm2L7>atDC+U}Of!{ou?TAio2r?m)~#5eTIfV}!+MuTFCF zXlD*Y1FIqcujF9W1JfI>r${ zAi{_>ez2IQ&kmNGBO1`qcnnpd%r{hMgbcy5X%?9=M05#84^Ny90nVXX?NO~`L%{Tl z64rwTr@jh)v(XOd*5nP9=OR38n9LUBg=*ZEl~B_u9)`7EU^y^;xJYY~2NMfc4Hqej z#-YmPMd0gGMi})TVQd|4j*$0ZLs2wR7RFJoj+BM2U+q!yLR4VgC}WD87$x6lEULUr zQGOU6tXX|FNSrcu7%j6jS06tb)2RA;=9r>4SZ0gLUQCnYs_(cR9F>j|u^y$%-2)jH znM)L0YtFh`n8FW1p?JU;xeoW|V`F6F!ksB!-nA6V@3Ap*Z=t^<7Jei~)&h;1QRA_4 zTcNSWdFK_&tu?#ErSb2^w@9uFIcogifM2|yxX|lU~K2cgNK66xC!XYW8>vULd&2X^0OEy=2eZd5QjH_Lnp}nM92A1 zV*Nl|`@h6Sli$z;x}2CG8wQaYQTvG|JA}=Si^anev0U=TqY*8b2$C|IHctdn!J3s7 z@g6F1LCM593Aj6&!X}Big<0NNh{^AvqB`J&S5Gn+);A`}+f8~e^f%^DmeVl2XC}+{ zOFJokirh+E)ai%nM+11-90;&>%prATgA09psEFwK)8yU~wDOHZf3~0$F&zuVUPIcP&>ei&uIX|B zsWX73g~no2xB_N}vQohJq|Lyj6*LKS#~=2j=g+|Y4>suq$F!>^_@e<2$>Ui6W#>b3 zOFT({LOY@gi4PmtzUN`Nwiicz@nN~S=o&nq*dNvi@>;l^l=2AV2pNl@^^-PBjy5o# z(v!ec6~4n}MKyop!JvCcnjRKQ$7X?#5i4>yO=Y8~jUK_MpyeOI8fkGq-uyixpL6X; z*DyAA0WjBmjw*s+87FPF{5tq!#~h#lA0=Y!+T#Qu!w)JJrD^DqlsRBHZ!`3d&yjOo z2ap#pjB5bQb$meabLEEGK?L(!$=kYW03M&qG-)mvgOU0NbLF&;Nwx)7T#Vbc!RbQb~P`6$U0s^Ds?lLjop z8ZK@n_GfbN!y>tp=po$6JB}OpNg47XtH(NGnaX+{{6%SmuU${blnV_Lr9PB?3=_eB zG3f13(iUSb#Z&TPd4J$xb2N-DaxIa+LWFEhVHIfCQu%qwPiV*FB;X_#gvU_7XlqQ* z^65^;Z8n`ww*a~%ER&7fWXt3xf;&L|qQMqF2Nr4>1WTYM%P`W0^r>h%G%*`J0Y>U5 zq6gu<6W%4Tl_ahf-qd{pQICmF6%Y;R8=k;y5!A0ezBAe3ct*dKEcS;Dh^OSFyKK!X zp2AvWoYbxR1+SU3ej20?dxNLths7??qNP0g)}8=8{v}jqxaXldGg-9B58qkr-~%xE zF%`I)^^82r%)aDvv_RZL&bR`(M#6G@VYF!or5}e9#FV}VfElaf#<9L$x*YpN`)J53 zFssArQ)xGBGLxRetgv1BO#k_L2*+>}R~l|t;-9w8JdvFHm+RXM&=9~>tCjgZh_ave zSL$#zKSI86#6Ezd^YwI&&fj|DQ3XgOHI>SL<%?#W@pKE&!x;+8(GU697jZmZFHYcn z2u{oUeGX&t*BfCxw3fe~8K)M)I4oRACPg~uwOHXgxXOn}+mE{ft{ zaWWhi(wOSuoA-l4S99fNC?}reR^Fc;B)J2Zz0Gtlks%E1uu?Xz_BN*U*+B1zp97fZ zE9(HRzHp^%SVd?|(u-JI>aW6X2Ol4O39B@y@k`)*4C-dD~EA_drhZA;g_e=E?2ix#Bzn8MWB8NGWfJ82dW|IFDX*F;AYt?HRUCo{ct?tdsdY zagnn*pG{S`-ml8%1Pu*i4N4qvt`|Jf=F<>ZEml5VD>1@*eLjp zif@9Nn;Kl4@4k)lLQezoBR0v=wVCYTpQ!a%vxZ(5+1G9|=*+%N@_l$+TY4Rg1SjJ; z17mrkFhU8h$w?TQnXiFaGh{iUz}GNdMgn;Cny<@vg(_ZucC);fcf`W@__3*K1Z8Yx zwpU-b6@0FFUzo3Wi&A)oL(%PNmy+Yu?P#GZACf!c()GVE%%=~_XUYU@c?Z~-_8w-| z=>jY>#q?7Fm_KZK-^T9m6fJ!l^Q(k*ye+r#D4A;?^bR(niIn(`ENlc0dPlx$#whVH z)GQd524)9B0TFMELcLUM1{2@Kf`WqHm1Fhg@5;+<=IxKj_pnjDT`?zL8+^~I6DH?- zSXc3O-wsslV@louT;aL5L%t-^3k!z448qzhih3E+=y@tu)}0_5JSqm-CVvXWT<7~$ zm+cnsn!YuSw|68n|xNc3-35tgJ&&n28l|#y+!)62wiM+<~|-ns*W}yK)8%Dfxap zv{1ZHu2Xp%DioPXW|v?;@;0`J(fc7Z8BJaH3od`!eu#xIV9)KB#|v{Oykf^tdIPq7 z-v?SC%g3UOMh76{VJ-s~5@z@-xsh&2lph7hz5IZjz{&RekRQB*_?`Nni658lK4=m-U`j{m4x}7}Xf%Zp;=!lPp2?4=VP3)78aPhWJ5r7J5zRi+-3LwS}T$2zh4m=K@g<8&kFBTQuJggjcz zOk;_P>5P?f$q9L`up(~FG>?|ZAIbFu6WIi{i}h$FtQLI)k!w6U^k=&pa^CD4;7_wY zk|Vg{meu%!AIY7nXwdNFHE$I~uY^^Z7R8WiGt<|Aq}JFpr4`FlVPySyF=k&C6G4@7 zT=aS~HW38Q^rVo$^*o7<_c`30#T75-$MOK6M*Gju{`ntc8Ti837=H4xA);b)L3v@= zWwrZ6ev$WwpWtv00=-YMXRTrz2!Xzzp$;Oirf{Zx2KJiCQD9EdO^~|Jz=*TAI;}e# zq98)aXYw;hHS%+L^c^;{67}PsqqA-s|7k=s8U*@Nqc2h2!<6}@9QW^ca_(0Ka&-90 zV1yQaRmpkZUa2AP`ATkKYpBI; z>O;=RyKIgx%_(~1Up>C?l@$r&D432r9$z?Z#kk|~g)^03?*6(19$&!2on>->3ZRJILtQqfU@t*!#u-ui{l_v zM;PrBDe^2tJfhw-^DIP>iS+DQ>}wP0;#q@C2YoMh6OtmHiOjkI**&CE)4s=U{1jer zG$e4}elO?NEk$dXda$H`OSz2dGlRz~CU3ipI$3tYVPnJ%6$U)bSRNbb^x`1oA7$g! zfiUXxqx_AyD&%Q+s`ojtET?GbIr)CfaedP{d60z4-}p)9%Y}NqpCQ$A@YO^vKPIQ( zdrar^@+pDYyc6LDF`?vY4y8U9BdL39?xj=PJjH=MtMz z*&xG)@8oj1nYq+R9YJpLe~||Wzf5HZa8#944w+qaIlAd@lXJmq%jNNy_P!M+tAe+L z_`YBo}v>XvEm9ST3`f9ylr}XYbX|eXE7PcQvkMjx$q|ha42;#Q@ii$!zi&+HbwYc-SSE1{41;p!|(D|u} z*LwZ!4n8SkS<+8NQ9qOGD%ePzfL#Tfb-@UPZ2)MgFeZzg&Lt|iDi4Mg0K|ddVvx%& zl^Zn_)kP$;i~HAD=cpE4xCSOoT&oYEMt@-QhxQ_h&OQn1`JO8B~Pd=VR%^L$J_~zlFjskGzh;> zFgaYGYjZF1;=%RH?Er&1|ZMuSkKu@AWpgYB=CVmEKe7^&4{Ze_V4OVXnEK zS@T9W#jH%ei8Z(yWk#b$Gkj3Au%NK=rW_&kG%ZrVZQ%YwuZvv#MO`7x0=rs{oP>1@ zKBeU%9Kkfo9$cGX;R0%3yLl51^E5K|C(}m@uc`-A)F@YzDoJaYNq60n8{Ls0AebKP zZI4rBdVCqn+HJ~I3dyUq43KXih zKvLVl0fI^sG&Z3*+U7^{u-BVgXzjOWK6yz-#w0y|Y+(rrC^c z9L8P6z<*X)RTf|0=A%4kvxNkUE9#M~CcuB3h#SDmbY}o3#wABTB^=_jXW^Kd12Ly@ zV1Bw3`hBC>*x<`RyK{a@#J{UK(4d-P7;1A+=4h}xrPY)k(g{7@U-{6ua@gDuT9j7c zC`_%c7*BdMr-Dwt{2-=3^{%cM`z)beK{Ki=#xeIlNcx%2aFB#a_t({xUV`sasN!r8 z40kLx&hv)VP=-NAzU&JnTraMngi0}d_Q8MLVE)aMnUM~ID8detBT$LGBO2p1N3#U$ zkh}&eAzpUsX9lACa0BzsF9isKg^I(0%6Uo5={m@ZWs!J(DOgd&nhq714{-J2w_xQH z!Ph*%MN;BUV~xAyRA!4cEzU4wnBh_);u!@v7j8`DB~ScjZqFK35yyC0Ge3nT94;lG z@!ut6>|nS{;W zd@H5TA-TaY%~!e^(#@oJAAgF@ui?ybwzg9tHqE!AH4S6SWrL6#6HxpV%{H1hGYZ=? z=l8g6mERERKjlF<%b3v{H~EW~h?AGwrvlgv4FXL%rYWV6kFcJY*y&k}kUyRs2ggwA zRwjan>KURmhqE9=X(+G@Hp((XjYrOSlYv9cZ@_hyhA1jxT|q3<-ef(l)fm)}`@?g- zR-K!4VzEE?zEH(Dn!v5s7N828wlTS8LyxdHR54VcS{k-9{m;VuTXdKbAYPDiBXh<{ zrWMxYzgwYP2?qW%;?d+V#W)9TMKWwyY@WF(EHkw4>V z6;}_ZX8exzmYT-w+f!3{NQAefk`!DB=ErS>3D!GnLzBamdg8z$3fXY2n5PK`m^FJN zTxlZms;n7=LgA)RC_)i0i*<+qnML)+M<}z!?2k~aJK5=DSh&;|daMzVMjKj2D$6+1 zo=8O;jQ<>|@QH{H3DZG-TjkSQ7`DSCMJvWBVmhs3Wa=HQup)yc6j&m9e5^;EL-E_Q z=PmMVjfB@wgACWEmH()rQpPGwq>LEFP#ZHwHpl;b1Qo|9FN)r7f~;Zqx*p`z%WEtD z6bf}#S6bq>iMP9KRIFlHJrn~?i7^c3saOA=7G3!zfI)t(8s3t(*@L=lI zL@`V`^yKHHP`mS3ls{<#O2IW3$ECPHHxc*s%d;^m(M^@r0{@#T%gp-aPRD*|M1o=* zzL?qUO2A5Ms zam{8%+z!o@pKX!B)S$WYDlYb8DXv8`y5O9*ygA0K7ild(V|!807RnT%+F|Dd+VH?y z$dwmefrnJq0;7SmgL~P+e9Itv?hdSE3HK`gTBTWB#084njvwy0?M1rgz(p9u1?sr? zP&3eO+$QTqhwlY$2u!DJuot;46}v4unEYBQqfp`lEk(gkwNwbcm{y?AM%=O-youS1 zMz&JKxy*B|l$P+~>C{?Kw8WcBLY!6Jz-iBIt<2~CU)UOa7~G&XAYw7WdWSYjP2M#Q zy-yj8lm+)GQ+U?2RmQ@}Y^w~1bEd7*)^QZGm@yy6D34WFZeQG{qNX_RNl-NV-H-5C z$j+Q>Dy*bLe-vQP$?AtW+D;k5+7(SYD9v)0*$gF!bSirZ_JOlLvb&8bc!!)=EL2$? zz#>m=4-U?xi-+1P3CJv`?=UwxI{@X;LmiavVorOJKP!WFLXHxL=I~C4B@)aAFrjKd z$&I0k&{1jO=z$={ES%MyRg~(MH#XR~MBYvI7f0F5$#JwgKozccJh|2fz@SP;CC?^w z|CkM`4d9Q{_0&$vUo05u(?xk0{f=YS;kLTq)w?R4!1JbeMgQZe+-*v1PS!7AN4EOo zO!?!0MvN;EOm@IJ?xJ#IiMW>6d zIZPM(D);-=MRj~c=JhYyo#GnH@_)dT{j7fAg_cs$L`Bid`zeJIJa}a@_Kvodr;4`S zNJZP~SGJAc2D{5UPx_#LD0tg!BW>;v{Kxt`K$(Xw&=(F+qU_QMS~Ens>+?`2hbXTK z>5zkuGzl&JO>_&isc`zK=M6*Wi2xfv@C}ucp-O#nj!^QEXVD1dckZ;2N^|b*OCy!O zV9MK%QsQi8mIcS4H?SX6EMbHjkKLy!X_E29pv?Ybln5`LKXDAUnTPevF-ou`x=<4J zDj%oxrfXxB(<01fgL8?<9QECOcu^2Lq zjs@WIzXK|kBmTtpb@d}k1aLfkHpJM+9sw`1QOED+d0tn{QTiJ*2{vfwV(n!Prv{ZA zMbwPBN>X4GtECv1`zSjTLa^fH)zsWal}4_n=C{i2JZ0wMl5}xXD8fvARPn!CFE4vk zd5jB|<|(Y$*mIuJR7*fU%#m4pHtwl&^z1yeY$H{`@#U7`(en{_3ygo_ePe$AJZmRJ zZyV+-Y4H|;;b@!_6J_ou4(A1!dqnuD@d9N|WTHo-8sk$mfKi;IY}AVuDEC`jsfYb` zAv#ES*~hN&u8U`jMb!;4y60KD*gG_!#B1Q&@-j@}fv_3XoJupmHF6fP85ILLan{$c ze^uT;1Uj{uN?MG_44HQZ3<7Yc@W``FhU+5N?0EK5hJ>k{P^ z>0AB#B}!)>3}O6}%EwFsZa#@fLOBxV)1FdRO1{levv52{7!=O0R^&dTtQ3U6LFsRT z?~NXbtw-TAie2=A58Dp~^1-Gg70&hZqd%WfCL>#Y{Bos(B%;7rQ6~r9IfQr)XNe`x z0wH(}@}Zb?2v0{mr({8zbMZOQK9JWN&!dup$|6&~XH%G^ylBdi%Is)s-gzh?%*a++ zaNRd$D^O6@>%IVL#{PvbDmQsOUbsT}(jc0Yxk715%X7iM;(G&98hFv(bW%DCjYgJ6 z*Um{lkK1b=U=5 zt>l375a$G0^Kn!)cMSxBEcUEM6@>YHYK<}i1{x~vRckr!#Yi%D(-P(;aP4u%T9D*c z;uGF%;}}vKc5v~kC-ed`zNujt;^o7CPIe#Eo|LA7Ffkj%L2Zp7F3*b9?#`h0w}X&I zB~v*LB6vP3nO3KMagH|0R6KOTkK`YI~HaV*(yGUwG+ z7+mJg;XdTLb-EqXs#|BHB0QIvndDeq?hNXBySiK@j@9kXpzd61Q!0H7cI6Xn!A4gh zs)*kM8adGJ&w5ocZcSVH^t@ds)ImhW8U8ESzZ5UV#wuXFk^}CPA-+sQaNF}E99^bt0P*6KovG*t z2qb1~KykP+yg^Yai7v}cxGZK6ICEY?BH?ncvVSC9+@QeH5DFgzFYj6z8Cb9!P4OGe z8pBtK$GBhh1{yebBe?m)RPqKEqtzQhHTwb^q34kbRhRPTY<5ha>^Jevf0Gg*_v3HK z!y^4a$9kJUK@QUco0O(v(oLgPo3N2eq1~I%TUh)yDgAv@MV_fvp29?xol1W7QF6*B z_*2BH>X5#_hF)NPs5)gPK-QN3nlcVg{k1=))QV@;iPw%g0B#nKn+D*PGsf^mXTAx!is=5ajzMP6`%{sG9fxxZC_7J3BaK)s znbGH_aBIAi_;}3*0$OzP_czw&!o-@tK=r(OV7^ zRYe&8ah}XC@kn?M{!prTONpz?pLibeC#!g|?S@}6!-neZ^OXsbHXL~{W{rT$aT$N^ zGnUHo6v;m~0E=J3JUJAPMJrvf>DPO`t*n*A=Fn~I(DJt8)GOdya8b^G0;4z5BmYzu z35=+UhbH1ff$UvHjTDpu47SBHSu$UwZ5RjMnEfR$x&xB}DTFeYZg zdrAT>1E;^ITxO}ppdApwvTgtrZ(^XHo_`J&{#Wl1i)O_RWw6K#qqiOQhus1CgFCU- z`u0S(*>Vc{fE_>Rr_!PKl@!M)t4k?nm(tw9qayH>q+7OHIfY;#GIl9bu@qn2rMxC` z@T2UHu{oKs8w+awZqTisRJ0rC3mef=8?Bp;iGkBM$eVVf#&|ep50JVUE!cx;w2{{A z!D7TLJ{Q7WDzJop!dH=jKV=T)rvmqy#8}v;!e~Td0Vqtyy{?qK5ZYE|KqZk-f+$q- zg#2ze^24?K{-{CPG&?Q>7ov8UyCp?n{e=UyxY150m4Aq#Xmmqmf!oM^m>RGsxlj2D zda#rBE4cX?Pmdf>nu^X~f``d>4Km)s1K921b~Zl2aeM%-2G?mnzy@r_2VfS`#P7f^ zNWh#d<48IOHJ8S)1Fo(&?k@)%RJLGX3$)-`x%*&*s`Q}JI?N9UUmx*7F9bzJPa1d* zRc9qmuz)xcUL=L&B=pA4vW?vd9cQuA+5Dk$6jbq%Ly(s(rNG0=95_o4E5@ZJKbkoP z9LxOoaNbjXSP6(3i_vC55R)J#J>yJ2v)$}}K#x44be6>A6fH-Xv70kiv@P&klk)^E zJ*wzwXvg+22z(9RRA6BL(w9Fm;#H1xP~S@7Lev!zidlx9ZETX>fh zD{-wb#=)ww%>4nm7GoHa_!-I4kCeH0%WiTpICP_6y|7qmC*3Vl&`G7W?7|*+^lZfYC*=4xcD* z+$EX*=O>VZ2v!59v5pYz-?vEtdd6qKE+HzsP~ENPf3CEaY^QywLrD#H?iV;bo2WyS z`@1Cg?^q0jd823&6ZMeX1<=FesnnB_Pb&(hT}3C%f@Awb{PBC{X-vV%EDDCM zXgrB$S&x+|{j?m^3ub`38xIVe$5cwBvhx^2oN%58O~U@=g7UIshB;H;&>y*o zO{rt1Nw*<=Dpy)z`u$O^JnwkO3e~eKlvuVq^u;V& zb|v6CbU|iQ@^$6&+H;TzQ#B?SoN%s}|4}5qq14t#+)!}E5!w)IfJD1)D(~TU`c1Il zc|Qb4et2-Vu+a9l%xztvY zW1i(Foc(>%H3cS!PY+X@+7O%_uEyE$(8R~UIT6|OCZh*{hi@SbjZmA@j4fEcuk8sANSqJlOP=2i0sI#QKg&?qkG9<6IZ_SB8`SJ9nu4!f`XbbbGizjK4(A^GZ&fXs4)gM# zgrDPC6>5*Xm`T+DRz6(O8;EB$q7LGCl#?_1A>Z^~S8jjT@M^thqb~nm)qm2tQmec0dcn=t{hHCP7&S?HhHk_lhvk)@AsVi& zww9jd-8Al8JOz7=Jj+RH1XYlB9ZSXKB^lzP&`5_0*$yvjN+CFl%vY9ouT5xfKQDPLP>xi9@MtJnFT! zYA&Hw+VP5>Szis2s)Xek31F87*MWP0acsQ-JYR9V8eM%I2G5{Nw6?X{j2bmi{i~$i zNXZSI(Im1sWem*V8905H;tn1RsE>E zp_+!dn%YQRY?p!y3j8)F8ebTc!v?Q|mn)zI02me*ulFn9UZgJ{K~|X zTfW~b_5liPq2BNMz$^G5O=+=nv z+!TGU`XsX+m7y80U>}k+Sapi2cEpei9wk>xAo?*wJUFAJ+QN1mQ{+G>6pdS|p}r?j zp+L&qq&?4SaPX_QB^$=h-;4#2Lz~g{rfTsb^0bT&) z0$u{F1-uH_1b73m4e&N#J76bZ4`3hQAm9k#1mGm#Gr*UN@ZZ;fZvj65eg<3u{0g`V z_!DpwU;~EnMx{C+2p|L4?kX>sQGnWjdVmIiCV*yumVo;JY@4+cpc|kUpfBJbfI)yo z!|>lIz!<=Iz+}LKfQJCH0gnL|0v-n}13V3Q4)6jX7w{5bE#OtaCcqnjZGg7{+W|WP zdjR_Y2LVR_Cjch_z$1NeTlJ!C5o6RXjEq4U3=Ct^@9CGk{5CJYkC)%><@fdS``z|0 z5-45mc7X8vd-)w+{_0--8eaYYFMptyKd90VEZ`mpt_(2zPA|X9%P)KR6)(T)<=4FY zZp+VD$Q1~&0!)9Xmp{zQU(?GU?&Xj0@<)34qfGxIAcLqtEw2dCUj7&_e{C;+te3xz zm%px;zn zz;l3Hz*@j2z&5~kz#hOszzM)-fUf~R04@Qp0&W8Q(33#`Hy{d756}eA63_wA4bWGD zb>%_$F$ypq@E~9|U?E@`;5k4pU<2SC0MA`E=zIi};6-T~|ad;mBB_#99Q_zCbUpb7TO z9RVqT;eZ){rGS?JZvhSfz5rYT_&~H03TO=I1Q-l>5^yiR-P43(lCXnmYB;#=%DzOy z!Sn6xYi>9#31{ZD45zQ*^fR0k!$~!qe;7`G!x;emAZ*$O zQb8{;8sc=#lT#gpow?ey%3?j3gP@((RjqFu;^eCUH7Tt{uwC$;&@}GKhj=k+D8$|+ z-LR@3TN0w?lpe?O-A#46hGSAN1CP-Zvwj4ncT+>^j`Rv11wZf9YXB^v9<+(Nsm&qo zL$)1b(!ElQfuCbDv;>T$#O`1Y#<64C=`LrR>3Q8DeSF|{b6vcpV3|yenQ*-EEu|;; z>j{+D15F4>!M%Jo2TVyRYCGfCiz#Xk!^ZG5kswzM^z}$N-AFki)k>L_YNb4zswPq4 zXs~p7U2z*AtA41R4===7rB#VXjD9SPh9TikdZ|v^Y|+zEw5t?{*ngjHj(57bX1ddt zp)@iBR*bP}#85Yv9y6SIhBM!A7O)dXDZSB03(3`6jg=PBy8G4p@s@}1;qf*OgdJu$ z^jm-IR-${WZ2eb+FEyNHhVz8sJZU&j8P3y&^9*MjORM{+jj**k+y|KaEd9jJbB6Q0 z;ba+3HcjfQw#AO=r@q*874}u@W5uh7Wrm zjH$HR@U1a?YYpEkhA+?XtuuVD8ou?0Z-e36X!tf6zSj)j>xOT$;d{gI!Ad5Vw}qts zYQOZYCff2zFE6{>OuuIO-!lD-5&S*h^z$TOe}U=e{WbgFHvOP%!v79b_f!Qt4{IK( z#%R7vSNf~XJ8egFPsU33^1tWh-{Ixo>CD*^fM?>HvR?53HClS#AS1gBXE#$5>{s@O z`jTrf#y71d^X&uGh?u>|i6_2Q@j}yYRlJB63{?9q+GhqQn(f(d`Wu`61ExRT^nYOb z>ze+9rk^Jg_s@r>pHGX~f5`M({eRf>YsU9Z_Z%?;tN}P``mF&tX8Nsm95?+|J5JEE zgD~75(bhqjD8*DVNbLxl8t9Ggwv$c@I)_)}N_XRB#*aNcp9qhe@&^O6KV=GsJxdoz z$FC1oL*qX~8J?r|xtITx<)@0ve5oT|btZmcg_#Zi(#!vqm;W?n55ZpkCE7ehea#l~ z2L&C_@b;{X1IRijed|ycyT6lOABr7VDnvnRY4=df$20mLL)Gb$?Q3VwHq}iT!_`w! z-ymZq!Yo+5^F%?PJwn}N6Lz0M5rJtuM}$SZ(P~FmshPG5f<^(_QbBKsQS(NtDIy6z zSLO{Bq%<`|1oK!~MPm7$i}zC7rD3sQ+bt|g^!hf#`X*QTmW}M%a1yRqWfFgQ@K+l! z5Ks%iN6dHHcP_JP!{@q{$!}MZG4OV9Vmina-oPA(mxq(mvdz^Z}t0O%!-1Yu$;JlBnNBxNiFO;g9K zOT;}M7WeVAu`0mEkb>tQHJGwYQo#QwQFHh`CG;N}~hze&x zjP%neM9W}>c#3@iR$}lp?agGYKjzi z5$ymgAno>>KBqKg^K{WxL0UXZkJ$LOdNY8nCrs2382bvL&+7;_M zhFhet3Kfy*r?*xtyO?4fFpYQ4G_jTeg-9A zqFPRmY*hEhJ59MQld6UQH1eL`t{ReTZViWFdvFgH=}qX-9#{2kF9-ILDCx-{yMF35 zb)vme1-`;5RN!$(RgHF4|K-*#D?R6ltIk{0@an&sh-dGbv!`Bd%FoA1{OK)fDgEXK z0%ZLYC++99LN>^KqCuCb0O#g;7jRaRv<>Xd2I{#@onrgVnRDs$s237puzwqvqqa2j zpLkcm`IdUlmtQlNStqGhPFfqg9-Xg_lWbSOPp#Kr=;9TaT-;KCvxd{LxHQw_Z53A` z4xxk#1rXDnq#FfbKJmi)+nDCp*uh1U^TANHep{XIBmKd1AspAdjVZBRwTsexDZ7t9 zlo;j)x1iPAA$!iCGux3thVIhUaGP{eZ@dF?V{yaBmrB}eA$s9X^_mYwG(n4t_o)9w zid6^HwtC@Sb(VzI+*_pPAT06_hW>1k`ib@XlYPMc>qhZ2CIS(r?#E0sQZJTn7#|X< z*RboYKY$>U>@BruT5?s5$W4a{kM|C$TO=5NOxJLe{zK5M3>_s5w@FfESR*Ptg8mZK zX|4}BswUXzR4bmR$JHU!r8TCV^MtzEM(^P#rH#i~;e6JEIy4|On)03v#RbP3e)jDp zYQ7}-8o6dA_}KO0lj;x&{Tu%Y`qvK^RkRRV@`;)j#%#PFkb|d^r7p%)D}!!)f^{u} z(np3G*19t&@l&u!C#mbF>SD9sQ{#O@Xywjoc&qDE^_s1ki%yJoxVL|FPs`MKY$+`D zJDgCVr(?cXKled<{x}C}4)0G8QJ&5-MMmXfU`j`YUjC6bDFhfzKeM+UMP6# zyIi!bT&-u5UG!PGI>@HD^d=SRHpbO6mw|ie=9yQpe>h9Kuc!pyz^iIQs^1NR4pmhg zr7Xu0!IrCPUZ2az%@cUxW=g`PSmD?3I}h*Cb_n96@wJDE~m zrkwv3VENkri-O1ehxsh}e^K~%rv`UnJ_Ak&gyp!JKmEhX? zvA@)b1_}pJnWGx6W!z9_IouY;@#8V9@{g%@0UxS|SRedp)DOYnI&XsRg;MrxP@|Mv z$SQ+&+)`^<6!j5kX_apX_J2`Rr7#ie-2|;v!V5TpcnH$d$fhx^%C>1oajjR-wYfgp zaw)?2jkjtK;1yqvuV1%oAe2#tC&^Dsk{q=vo0UDv9-dPOWr_T1+KZ0p%J9VQ!O%l% z3H71*{@N_ef(n1FyHUZMR{7n@B+QZatCJtB51y&29o7q9tX-S|Kif#9r zKyA|hrD-zeKb#8x3XA{y(?kymq~*a{53#yK(e*Ga*W!GqWsU*S|BEvnnjaK|M z?%_r6#D6mgjQXyp+!2(p9vnwfgqGrn^PEq(^BjR0nnCR&wT{SeL8SJh&6vZra<1Qm zcp@4zEkl=Lw6AQA`ess7TQ09!7~cDi#iUp8*oqb+)=xb4y$Sn-tUB6U=obp(|Iu}| z4Z<>E5Z;NwmCMt0wFtW--ZQfawgxVJas#cV$=U~m5 zleH0QDqrJX{JDl&gh$-ez3y145tR(b2y(>S5^#~_d%+TqXry7yZfwx0(irgU?V4!O zjwY4GKhQ)QY-{S$_cYPERg)mbZl%FU96r~l#02Q^v~H=L!+wv0AbKS+@KWZ?kszUIt+gSvawZtG;?`QU&Cv?^F($O8Kkn07Iog=s z`>0J@c-xxZc6ee0-u9-qgTAA!cG)I%)VFrfd?Z|uDCns5!=sl{k~YuL$&A&RLt!Z} zNxPsim*qw=wE;}U7#&a2nq)0j>Y^7VYl9_eL(aO7!+9%Jx!>BLCwJCzY_#MlpjuKr z+&eArsaK6@rhR1d?SV4Gb7r;;p%;5(QXd|@R#M;F zgUF+udjrzZ@^`Qg?J+{DFG>Blf8TVZROale1;#OH6xJo&qplG4wI`q*ut4)7CQ8g= zAVmE%t&tC8kej+|j`G&fBv#x((q={%`Fp_^*0$hZ0Hxqb z&8kU>e)bR?Kp49KD(VD%)#7-_PV#2}t4~tcOl^@g(d_s=&~6apMy{Q>9=Rol6`W^k z_07O_*&qhd4{0MDlgu7lN`h5M!lol(Yqe19KKvmxC<}iR=qkwRWvWBH|+f=9GBQNBRW8MATcW-_l9Z5>l8vj&znr>wU%5dN=0#f$#{Wsjbt zg<4hgWjnGGnvyn0iw^WOcH>8xXRuS#7q=)Dy1RLGe%JHyg-JX|b@!&QT6V3+2VXR{WdPFR; zB(}S~muS&;=ygteQu__k1N~5e9W7qQJUve_mtYbh|7Bq4 zd2+1QhW|}IslS5tSiTxF?L7Uo8q6Lv_t$8@BkR<)*c7zIkpQIHNi#5?5~lj&ne0or zS2N=kt%a`;pyD}(5D0@_0pBH93)B<0C!}BrisyNtKpDDYoz|TjoBFEuxmeC*O4UFX zlGdY4ocoD|xB$nEh3mDcIQ(n8L5p*9r||Ibj-Opd&qa`p6tJ*=gI33uf$jf!?7?WQhiS!?Q8Qi*tCn&)rUR*F1blzkd|tnBOkSHGbpu%PDno7!F}aH*9IPe5{g1^G$-R&AEe!7Ue~O|Af# z!bnSF%bNQk&`!zMeq#wxw*u`mcB9_bu2u?J1E^pT7?0w&!SrPv3-Z@f-qBPeGhUNw zQ^9^1bIW)aTga38)_1j9Hpeon2ILBHE4eRWfG_CUeCY|2b|9;a_p}T=NQ>X+k>uhI z5PiH!D^Nb~BF<)(zpwd+S;J&ekf$s2Ecy`(f8hojsM}eZnZOu1ytTJDuXAdAkJRLru_0xvzx^-);SFKi1;}5V6Jfsi(02?6Rz}+a2iWDj2g|{H* zj>A2XT?e)LkqI1*KR)Z~4`>A7Ny-S{oum)7_anpi+`2Vw@2y)m3UA$dvFO&Vp8Iay z8U;AM|JE%(lA1B~{16L`qz^pA6w{X;IIR5@m}_ELPk&@ZiC^R1OU4n+-$4lHE?uc- zAJHyLj#XAXs+jA>x_C?raJ*DC?9ef-g<~9wW3urw`5s4$Hc;2&p!LPH`M4Gv^E*CT zRY#nAVh&XGr_jaYTEqC&X4z{@cdhBZV!C;zyG~C&p|!I4@)?4S5|aW#q_1g3G5Fk1 z^q3ONHEkgZ^zQOkDduDCHEkb0aUHDsaCe5&nUA&Zu6IAETCD)O_Y>__p#9*jTOR-% zAKtn(L{I({%%>DbD?ZcWBnR#OOlviC#W6$Y{bl6E=OmoxScEYRvdY2Fd;AXHy2anD zIK2^vId#h)0zZ=)%l{*#e-7l_FPzAXqedx_h`|UEXU1e?s7u+OYh&xYj{>+*&Vc{= zd-+?zPsN$lRG0v4d`cVrzG;a{A=WIjyozeeQ4`XgU!gMGw(^8tEEnTE41Jiqsy_KssC zu!-qpJYOEdt)#QskT$#x<3EU31Yy~PI7#@;^I#%?<8z!SxUqoFW>^NEK@4e*I|G^D zgKd7@+Db|HVL?CkJtS?$smZ!6;F3~yga%NLAFxk zb_>6P_9M6~oG10*d*OK7jS7RY!O8ehJB0^xhn~}#r@x7`HBbp2I45d32rlnSnYwMc z%Qv2D{B7%9zFB%F+dRL~#dF$d>{j~x1aAHmE%-@mwdgI+2xg)2X2$t<`Ic&aE4a%y ztFmw3X_sn5@ltDmB<^I$tpQDRMO0#eRv&iHpdW0_U9 z+PmHJ8_m3o{nqMDc;SB6dF@GYkvo_QW`dbY`Lw#fgXI;xVxOmJ7qH}^yX!#AdYj9QF8!f0MN9k>Kx!wzcy3wZ8Rx~m*~Yy3{n znwYg@ROEKP@A(byL;FGM^e#BrgkQl`!>U3#SeLwC!Ni)s11@Xr;&*u_@@n>O&u`r9 zj`4dugS?{e_59}1O98)Wr>hs@BU5Ha3=YWMQdz-}fH@HXHkAO;vT0Pr%P0jfL_FddKySO=&8 zgkwM30?-vOACLq19-yI>tpS}#^KnmUc@Q<{$OahF&C!k2S3rh5LkkMH_T|FXIp&$NHS zItH0we||#B{~GW~_P;8ek^NtNx4u35Z^pCYTkaz3$A7~G22f`WdLbE)z|?7wTZNXU zI4(&DazngAJ%d1hKBH+tmI?h-#REM|$yO6WAE)-Gchq~(+zvsXS z3v<^BdPg z95SCV#%XtffZnqN-~$K+__DT&;y`uoNdn-waw?3Qtp3dHALuZ{c&;ST%r@wr(&;|1 zU?Es@+quBwyWumCboK>leNO`n1s~4TqV(@n(jAEUa!c{9jmts zcf*1luP`w3%yzuXfAI;xt7FCJ&5}rWTeDLgUn52ma`40Zcp(rMOF4GXO4gFfqTS8K@`fi|f?S+y;~3x} zq#+ij@N z@~~9~dnIRVv65?^@hB$NOz!p!_DbH}BYB8tJlq&IlQVApUFpp|l81T5qarIgANBlQ z@>(9rnM1CON3J?%={#8~gS{%x!)CRehqf{vj-cIR^(A$HSs1!Cb=~2P?@YXir=q&< z&c19|D*|?xfOLgCpQG!!6C7tN;|#6m9*hO7pq@LW71ydIDD+aqfrtfIQ9( zlLkxmt?}-~lIwdU=C(42!Q+e-yP^9nsF_tXbpIkjI#$-$-Q4k`RfHbd#NCgN*QX`8 z-xm*~H8T_QytmHBmg>og?v6fz=d5H*5GXT-EixX#1UUVq!{3+X1%4}1eM9up7Vg%p zAQsjV^WrCZwl!!)N=x@@X}x~2CFT(bVSHvyO1FL`L7=z)HdSEsq$&_FrK*HQjSBS-tEC;o~5$(sNt^mOe%H!t|2wXeL69wypv?X29Ie! z0I!8x0L*1wuzEue>*)T@hGU=1w`zn$PR1ueFyUqbn6M7E!oWgHilkB3PVQJYhw>cc zuATx&0=Vv>*`3_aNf(X9MQBw!cR)U!(An*e_O$8j{?T#CDw*QDpo?2k&n|Al6G&xU z+|6y}E?U?Smk|=Wy8Q)pRH$e+&KOd7?nkEGJClDfykBgaF4ZJMiHC*qHMpJ?iJI$>Y_^n)CSOxE$WGZ z5%y5LRZ=X(G)e0<+R+O*@CUDnk^dz@P&(SoFp4=L9${~&jBuB4o^k)(cvc$k`2VpW z$U7sefd7p<7E`*FFVx|(dINEo6?W2^-WYUP3hwQmV1^9s1B5$FkM?ozHAC9>6(J-0 zx{o^kG!b(tCH8ag?RgFTWdRe}WB~8qtT1o4^e*2jIE=E#F|ApzIQ4NU?jY&EgeaBW z`FDs?83C34Pk)d3H`4yci1MFS$}=4+e-6GG7)JRY;8ZxEzq=H4>0*EP{j_BSxIA9J zdEsaa7)%8t+~GK(fus0dLdX?8bAUVM|I`5fI|Jg`Khw}mPygM1|JMgFe6afphRrnu z!*hWe4{Ds|9|^iqLMLCh2KgpTZl%_ zJrgpBl7?ZmFW(gC%>6?1`@cTD|F;<9jUoSa?D%}R`%~&NLW-u85t0+?(#a#RojQ9( zbNX^!p?6cwhZP~K`O&Bzp`)nICBOf(17{7E<$4ds|Hl7cAGnaw?mwVZ;!1NruN{H0 zu`{qk_A6|Yh2Ok&D;{uNe>cs&*bdt|Z60vfviVCi>;d;q$6u8UCF|tpqzr`7HNTKh zN?C(4_q+cW0PU0iG1A>q+v8cNcHOGd z|3}`Nz(rZE{o_8vpfd^z4)ZL+=pY~-Y) zu{3^>fPnxWk%J|^q1;~tCCS}%coD`a6{O|L18~TR_r_s zmz>O#t-5F|9qfq>!bJyhwPHlRJOfSRjZ&*W5BOS_KN z{c`i;kD4)XgfB+=qxO8|5f(aAAm<}%W*5qLhO!a`3kyPtG8`rzZ+wtu$)C=Pa)$a#Uh**^r^omr(;4#m|clw2w+mO?w-REpCE1}&!)TFg)A zMi|0ISTh?9rE-)YcWg!uEi=g2|LEg>hDnZSMy@i+u4d$hGI>ZjE6I7T%jLmbKINLl z)m>_VH^|^wTHy6EcmXZ&xc0G|*5kKDiCU^|veJaEsEB+OL#lyXs3;LKhnjYrbS0dbk?R zYsGY{9kosbq!X5iq~qyQQepBx-SWal^%xK6Q-{(y_#7Sz9br=NicnV zNp2=8e4!^E#zu?0RdPstAH!B(!|Vss*Q5T;YzvPD7@`AV`g$~|nW!F}!6dCl)(kPM z3^mMQFnxWwteI8e%Wy-~1Jl=+lxCv3FC%ncQVlC34RaJsUtcb7W>xqy+7KNB)7O`@ zW}><;S5V3txl1I!B>`?@@g55#4>-3fT&8hn=o(qEk85;cC(y7E^!Rpg69D|p{ipcKm zBl&kHg_g@VR3BR(F@?z(TD8LLzSW%{Uc9*cB<=(F^5Vs}0pA1K{^R1s?trTSI{|0E zzIbui>5CV?`{v@s7#!q(2vCGO1k6zNg?DW!r6JH^55p&?_%VvFfUd6>jjxbXL)k;l ziwQ_EUUXeUJ1gYjp%a0!`hZ&{wuCM16t_qTQOE{i?g z$iH~+zV-5+04N=&Z-PQ<0v`?Pn{mCokndE8+-_IAM>nGf$6Z}1*hhgqLhV$q=O+1r zWSP*BE|V0Q(kl%m+GLtt37t0%@k~_|^x69>OCV_!P?c1fBfJT^NHGRm**)sXAfx2DA*vqHu6DZWE5zpR9(S95;ByLA_nk z+G_O%-69tSz@OrMIFD0F^7l9|R#na~*$=YW@Fqs+b&#yf)U4uwJ(mkJ-qX!^drxge z0PHi&fKkfr@|*UVjVQv2>%#89vW4dkIodw!62?Hp?eHBKa!l}^y90T``iAXT_23~q z9zED#b5tEgthQsUTR~;pA&8fiKSgZow#!9)zHNuRBy={M{b%K24|bewzf&GyX_o7_ zaCADdIpQvPjG6!OUA&v_l4nUK9;?*cBZpDg^KHX$axV0Foa%EwkFzO$|L*B%4G}Mn z^TMc^K64NtuIyqILpR=o)jk{Q6E`g>fYo$rXh(%-RA{C&Tq`rrTf84Tz5=t+P71Gx&wH|1tS#Db}0+xcr_4XEKG*(RB30i=LFvT5>zmoR#S6i=L8K z@L@@IqH+Mv69qkueJD$G0)`z{JPagzq&$N#6bERw4YTz{pOw|W^#H1UMvmy1&tXC; zGw|S}pd-DpyLD%A@U)Q5JtJ2eJ15VL(0Dt@_5(7Wuz)2VB0biLHnjwnKms?Gc8AJf?m^6(@Tk>6?CmQBIh-QJbv6g( zFnd{Zhb|n%HqB*}RxkF$h}|*EX?wj;zZpBlrRTA>kIOEwQ{29SJwXuhaLzkH`f+@G zevX&TE1#F=+gJKJu25bsE&!`Mi`_Ss^Q=55$bSI}lB0o0!t@u!ay|${a5V7#7vu!{ zDqqV{HHR=}z|QbPaw?3+4#~rftwF^VDno;E$QzZmMfYax#XFJ zJ}SIZ}uzghokCl)-s!wgSxBoRcHiow)@y0DCGg~-` z4;}(@taLAag9>7p7_5QBTXdM+)nJ=WqygvMFDA}T@+KPHiHz5I-yE%c9m`DOswNEX zDsTXB@9P+x@u5(h>w6scxF5ZiANM^Xj}+IoT43KCVtr8^83C1AM~vB%zOq?^|AKVm zxfi=1Pp4KYUBqEiV2u%G)&o?3L@w0$_yEtsIMiIPu4zp5v^V7PnDr*gF~g7J&SD#U z>9l{V!%_1lipaGlnKItQrWzdOJBnoAL>WghcfQVK`nh#I==f`VltvG9vN#dz=w1a>t^t_ zw!q^8$o6h)&eP8_Kxr$OxBD_FvN}kq2|`PA?6_Q7eupm)5u6G;Nrt^`E%0It-u4!F zJbU55>}Y|B#-3j?N zvJJt?)jjXaeT|7Gx*O=>jprxO%6uRn5@)GJ8%d#`VQFd!*U(34&x7de z+Y60Ca9*J&?skT3dBRpxjq^ETi{fw;m8x&#REx6}?dUAa^z}CwqaC8qGf1olaDg8* zCJ#{Y89B3s_?_YO7`=}j|%7lS-N9&Rf;2U(O2xa)J}6$ADo2LI*+1rJ5`;R-xjJD`>n;;&%OEw z*^SX}{YX4jRQH1%;e5$Rx__wpT|rz6E9le@SRv)%2bbPlY8Z~=W$qubl~aFjc>fE$ zt@KCv6Z^}s?tu)hjjY46Zu$ke0!6&x0<6DcWI{asc0qJ-$v>gToUmp2=unM1;O8uknN zUfk~W3vcN6*8d_839uhFLWG-I+A9vPdQq;F?5~={TlXv1*k5Z5^e{hN*jmwXrNMLfmDi38IEhp*4dO2U3W$e zdsM|6VpsNBu;cbXJLQZN{JI%lZrP~5KaPaG9;`fLKVrs;qdF67-mJ>3>7Z}|XLL{; zY+ztW6&;i$=}qtc4obCt2dafa9ZCWnbfA3-3B&XDwH@(QC*xm59i~sSIw}#gHwG6X zod{J{TgA<4*z*6T6=xDuWvCaDC&epon!*oh?$?xX@nE%#@I?Z6ygGs2*OaTwN!Zb! z9YO8+&1Ek8JOVu0ksjP<>qZB6Qc%@VUuu10KLuL`Bs~g$IIL>HHHVa0x9DeoVK6USqVYf z$gs4Ct(^5KdWesSmFE>Y`LaGT5zr?&3pv7Q;avk97vHURSS7 zp^=JWDW;WuKdG}M(7-H;79i~}tsCMY-9-!tNe z*Is*|O2kvY9&j+;dv6bAIj4oImvXb-VmNjk?4?Nfu1{1PA{TI(E1rL(uM?FB)Dn9V z>`%ZIZ3^C1@UBThTKY=WC5y~T=?(WpoqpSS41RkMSuQ%UCT2{qq^=J@lHO#o%J zwc!ZrP^E|D9FIEb1cPUmJYE(}F=Y)?l<|YXY6*CD-V*&^(*A#@)Z;nWrSNAf^|)9f zQ^iQ?Agz1V=D<6B#lw{nTG77!f6N}kc`c@GOX>Z`X@B~X%8yS62YV}0&@NxnD12Zx z3b@wpbJ2GNP(zl6(@m+0)o7hlD)`QH#<@w6NcsuNg|Ed)J=_Rnu z7$qKAm^?-l3|!cOLzLfQ+vMgkN?ssOCR)*{TjlVYA(#wRI+c(bJMKRlcYj!rH$4r5 zU(2xo`u&M^c!uH%B}n?vd*BLXiDb+wr1MxV@QhR90#Cx7PU7gMw_==v18t%RhI`)` zuf(y&?6-+Z0-jdb*~f}E2x={ET9mG=#w}E0bjZ(C)MQ|+b}!EcX#X#myHsWY3_qqLS1S6;Cp>sF=MlYWrxSMue?q~Nl)Et--akoM z2qU92rcym7qhCEt>n1CGET3Y{Ai;_Y+}c7{dUUdK5CbkeNWJTldsaR}%slXb+u20` zv!1Z0Q2?`6>G!MzehzVCz2pnCexuWec3>Lro3GocS|7g(V=ZwUs6PcyQ$~wN%X!Vb zD}bZH1BNdtcbbwI$nTk3NeV@R)J+q^zWQm(fWUu<)J`6XD_l0;fve*qrXwr4dbXvV zg%}gpPFEsA*=_)wYSRB6nXc?jFxi ziCNT}bY!NoP+N%EZ6cmuo$qs$q?=|FVocdN0L+g2;41^N^oFTY~b2g?c zeL&_^J8eV;Z&c3~`$yQx&`@wWT}?~hQREzq?_a|Hn|8PzFhGf{#;32d8-a7*YT78G zvN_7=e#6e{VkXN1k+ayz<7@ROaGpr8RsKCe=h!m>8J^9wIzk8eN#KR|OhvKZk96QP zJVqIrXmeN7hD@cz{taTpdXfmQG*@XO^*e`HN5fx!d2k9~5nvUd3a}HfAJ72!0ANA3 zbO17ekM1!F%_Q&PYe!W)$Ey9oVZ+LWF7h|579IS-5#~Lcs~k1%o5H=Yn&Lf?uUIAA zzjvwtbFpJ&FI0wzMKx~QQt8wx+5VN(9ylV=TJr>Ib3tjehXy@vaXYpo52^7b9 zOVJW<@NQqKI4nLkvpPC(|6?iJq|>F!hoZIXObunI;P=w$GKCdADa$a~tneORro13^ zK7(>@mPQ`wn0tsgk8!``Q!A9u(2ML`sq_gx3sGJr;DW0!55Y0%YD^<>6%-q|YTz++ za&xb1jd))zCboyK#uT=~8@NhYWl2dwnHU1N6|ft?FMR$L&=%?E1at)?0!9EP0_Fmi z0oDMv0B)oDHOj>CKf`|$cnW2H|Bp<}lA*zThU!1Z`ri6G`RdiR%6!^18|y&&L#dn+ ze+pod^WXM(-XDYi&b#z(OElb|9X`4pD45%>PFT`dLuR{yG^H(cj9pSll1XQN40De05QNRlTzS!w&0C&jz zMC^FLB0wo%3jhy1UawH_4~U5gxR7HO-~2WUBY6A^qC<($dp{)#qO_l?)?zYwDE&WY zGHI5o|0hf0svDJ_R{L3GUo=X=DC~t*N~DFdxugqsVJ0<~&JlXu4Ww;_>J$qcThTej2r2Kut%}tu z2J{xnn8zA`ZP127=er$quP43lZ^v=~nvQcjltR(9PNt0CZ4Tp#fi-t3%R{GO{M;5B z?OEB(9p#f0SPQ%Jy~VZ4FKwjn^exSsc0*?%dSc8kLU2uS?Y&OCHIk0^7b>q)){pm~ z&0yf}tv4VIz!hvMARF!BRse6p>52B{ZUDDKF9Y5Md<^&<&=&UN0DZl#2b3dxmVFz_ z?wO^evA2A8DaD3aN@mMd`z+ ziZ%X&9#g`tAL6Ji6}fT4civ-AMqxu1hFsQXO{(|cW6H?Zfs--g`-tq%U?pe{r9GpB zH$H9nJ+=e>-l3D!fvy8NFp#H;R6Gwar|t4P0wU27NI1t}nyF!m)D2+Ht+vu{Y&i-f z9KkvpjB9BoSZtB!F+k)M>>ptA!I7^3JUjf+#7TMxvL|b?75xIOIe^jhG1_@R;rBX< zpGED(fb-#JmAkYdurw9GN-uWsCpZuXQ>w22IW~};{F!chPKga=LBW8@g1_KOZsqQ_ zze1iTZ^NKL`Pk7ZlrJ!1jT=|U&Tv$s{ZF@XK*fLHpfaRAbJa#JJ@|AR87x;lCIQE2 zO1<(jjB}T1Lu&5862aW(u>kQK?R*}Zg^D+AA=2;so!ymdBd-9b0yyaH034!=2nq)n zr!MF0X^k_E_hNADc>#+LyqeI4im!#0VAGQw`b0T_yK{rAVD^YC&5j##a z49PD$tW34EanKt-2FTcYr`TNWk#78p1S|rq1ej}1a0d3pge-(I7C?J*Fh@h{x(mI5 z`&B4&-DriT;W-n&ukBUEqbILI1E0a8PqnWq5f)f^_ElxD)7-KQ^uQ?%I-!Y z7H$P`(Hl@9;u)Mbl;$Tv2n-t+ z6i>}}n5%~C_@N(_FoC;t>CQsh8+`$lg2tUk6g)pE(c%jSsMr_p`k$1o65dz@FZvgQ zN9n&PW8%5|&PRT5esX4VmEm}eLHc-n@H9P0IK{-l9m^O-^*<`s;Co?}Gly-Bqn$sZ zoQ?Nmv*XO3ptC3HZl&vPW$4(IIyOniChOP~9h<6SSLxU^9hDW9S%hs{^I+mkj3v_IujxEx$Tpe4iV@q@_Psj3gtU$*Kb*xCoigj$M zj+N+GsUEU29b2aJmh0FG9b2hmSL>3ibZoVbtDYE1+o5B3>R7Fg?bNZmbnI>&yGO_F)v^0@47YxBYDbFU_KI%ru#UZ|W3TDh>$>C-9eYFPy{ThI zb*w?h-qI!C*0FbV>|GuEtB$>=W4K3~%h_=q`=PaPRL4HkvCnnv3myBCF(~({EVk+spM=od5U9(0yb%~e5#M7+R+0;E)Av(D zyoUnSSsh&eK>Nj`kD<1v9Rb|dagW)Cs>-x*n&wpR5j}%SlB^~gooUK=?2StwgHwV0 z_Q=$);10KmJVN&0zC0doanJoVWLSOIl1vcVR+c#p8FK)DEzS?hs$BjJXxwSCJ+rG@ zh;NoZ(*kdj!8_XmZ@9rb*8(rW;Cwfqv^sc6^5{ZTKDaNbjc9jh@zE;ymEH*s6f}whCCpAo@P;aVN z)$nrFC{n*81WiS%`F8IbBhnXr!)_$xUkn~kZ2gO0fx(kn;LXr^m$$OCz`WeB7|;Tb zQ;KuW>dO-e8QKF0V~*^2h#SIDc0`&rbsB8(25u8a48#RH*p0LwZ9&lzEdSMY#Ae6U z8`}hlIY}U;^i&5kUWF_o02UsEV6nR8>T~D=d2e z{No6OHpMLws0YA5W_1jso4TrskO|Hh4HVMkY#=>C$q2y3f z>Y_#s;)LA@QP#@D0eCjWk(3e1f1T6kVpL^tXIN)(1>*m#?PfJ2%cziPs%U!Ktu;?e z(Lxm)LFm*1kEi17R(K0Mjso){THrCA!PT6nw@{G=v$HQ#RIFiNA?&=c%*iwvW-4GR zfGfOzb}t3Z1K=O$VHZ8czi_KzA|JVR^#J(Ce0Ni3tpMr)@Q+!MO)O3^4}gEn!u`}{ z7Iy;b0q~DmQB5o^s~!OVm=(<|%pfDxpz`a1b6UjsMi=p%3L4j1=5=d<$MI)gYzsV( z!Ha8w*W2L5>%8XYTg*z;-PfW>`)=6?lYbg7hg<9y|2SR=dOeBf{PAs7%$8>)WIO== zv3w6s2W61SE&<6b`MkTy-@6{5c>w%l>ph!NxI0h}fPc)w6p>RnFG|g$dpfBhqN~BH z=iJqt0-sYZ5s_@F0nNLbHHJ)*Z$cQkl56miTi{JGc)eTTrRcoNTlHyyX*P9zTi}_w z($AMCa)k~?8zYxNaNGmnA16TnrnFfJ)C1rjvj#M=+(115{xNG{6N>}n0q~DmgPK^q zfO-J@W7gm%Rw+;qfPc&y!Yretj|I-@KGZiFMw)W1X5O$Cc<~1BvKDyUD6+lbE%3}9 z+N1MY>qAmK-R|k8hS+(M&%bWC2OnyYquo?D*0RraQ^Q3I5e1fq`S@{MQktU4`Zy1O zf6N-8M{`lE(WUa>)C1rj^Hb@%Sffkj_S6I5AG1c%fmn5kG>YQm)C8?DNZ_!Jvaz+J z{5bU*QHm#f&&R2FljL$liyPo*is`Oa$BYK*0m>=DeH4%HxneaN6nNk7uHtT$rF1$$ zy*YUdtgxsZFb7}`*SYK9L{0PO)4m>RHO>TKG@?X~_3@BxT;dt6?5Pe39tSZFi|~Nz zd#bES`Lw5c6)T;3sRJw%!f3(;sNgpDQY-P6v@21aiTwvF*%14pQ9^_gN4QU)CaF=O z>2Q;Wmh2{9jyIJe<1nU7N>+pT;*raeRj4_zim-E- zyZW%gXOlKdMl^9qe~>yFuL0jbNS%~C&7iWIZa89gz?{Km zQRTA0bS~V}spnuL`jNP$UhOiBZTd>gfQueT@^3Q031F8vJUp&tm&{m*@P#8u>IbV) z!921y+qzPj;#P;H2yg8mgAI!7|9YRCRRPm!SU<;3;8?@)SB!Rd718;b%-fJtNimSdsrv zc>|EEn=i~WaMSeV{n76~drJuQxm-Pse2E;b&dl(lT$zAE(TY1f&doCblkRWs@v&p_ z_8YWTl(Ly;T(`BgiLKi_td9h6!Nz+xW6%cGQPmkoBAu*)a=rRLwnX^m`v106{OKj) z5_j;=Qr$gT1ehQ-?}ebWTafeJ1IF*a3O; z3Mfl!SKtZf+AAdNZJ(e9Nw`dO_C)n#DbowN1POaG@-x&`c%*yHm1-Xn<}cNr~@P^hke6?E>qQaq<+QFYL(bqwYnbg zH^3hBPY(2av49i+AD@gy-!_{86N>;$OL27Z0jE+kUFGwAq0i03&QAwn=CR$3F~I4Z(1&GExcK?)em_ueoCgQT*@Y}9p2TM>PNgSqdjI(oQVlA zD`3t-do&PzBIB>Y93G&5GyZRf@)jKB06hjzc_+z#*F)A{4F=QzOgjzyjq$OGw`7*L zMEt)+L)fVL_BQb~!)&&|gTN$89u|W0+u7xWnSbZdu7P908B%`n7_cUlRitT6K;>D`NV#x}iYxC6G z0|!H_6%`-A9Os#hDsDB;S8bLa0rbsN9r{xxkiZB?1W^ z5sGsLZiebKO)0?m^d*YShnG*V;iQ6mwR_-hNE(jaX`!16)wT4_oOU4{c~iS@XqQ{4 zSCM*!Wxj3F0(WvO~c;A@DAL>Xo6y4at`Cnr)Ww)U%h zfY()`UK4sdsJ;Qlir-S?+t$rNL3Ff4RdMr8axn-M>+y76sk+&j>1Sak@WASn9mx0N zD)tEk@fDn<>QP*+RaK^T!IfJ3%hXKTofsTOb05IP2=7pF$2QK1VPX^f0|<~m@My%J z_Fv-vPYfr_&Zs4G9#W+xx-ad|?!?+Q*5@S3u-R~*LH{;3>^Vr8h0Xm(w_*J+4_oj< zZVJGKBYZ_^uIPFw{EGnu(f$&Y z?`O8Qvw7XiFkwd1HEcQNFKEH?u^(jf85HQE;xTC$h2dTS1^X9ai9dujYibh&%I=U2iVTx%P=O1)d^W)~Z_r zWAYIq4+jN5j!l6dUdT9Z48R_q^z{f_5#_H}_gIS2h29w`Q_==F!u>0Dqm1l`ojAj= z6X)y(HP61(jH);1T6MHlvU~SkuYSk(t?j&-CuiO#Z&qKhNF}spi&`R;de3c9vHvrk zl5bTV!o^TZ&c~^@BnQ7fxd;t+(XHyE67&c$gfT}MWsrK6#?wjutp-d5pzAXf1@)x% zMDIKhElx|orIt(d0>ENG0bnU$8Q^NbTEJfb*8;8w+yvMHr~%v#*a5f;a36r%h6e!; z10DxF1$Y+lJRbpg3Ggc54ZvFf|G@kewD$p@0L}t_1pE#NM6gilqG;LfD6zKz{fOrjFJMl0x$_M3y=dS0PwM> zdjY(8pT{t70^SC^2lzYSL%_#?&jDWn&H%mx{0R63kcfaSM0dFGHnl!&8S*F&F#=s^ zyq5dnEBx@4e)!cUPR_g4RC@GwHJWDKtwzxI{I&XSwFmXshW8HA??9u!o+7uY-i!@~ z9fU*pd95G5(GTC`hhOK1Ur+Jd)l}&Q%HOVrOPlG`cJ#+LQvG&xFgFP-@@79Pm40}Y zF1E#wT`{iphZMyE8`TIf_7u>ovIpmo50sSf{SS? z@5E5!_U3%&9e(z=HOZg7Qw@{0>%Q&KjXQOtRyTI)#$CE`w{F~{8~5tQeY&wrH+ECi zPBnGP{f3`r7ChjG@A1R;`r-Th@CO;ElrORGZs=W5B0og4?@}jXPQULi=+5>t7FEuT z?8Amdv%Edxhd=6vKjw!&?uUE*@F)E6C!6s8B6pr@A_)9xKl~X#`~a6(g+g8mv{H{r zVbNL7LSQmtVy;O%XW*>2;}{+^aMqABUT@%-4+;Ev1IPSH;4c_BhR6axMEUoi4SrFq zc+=KI(ZCCeQo+ zL#nuk5c)yfP4h~a_t<_lE)d;>| z0fNxSM*z}j-BYUKbij?a@Q}mE9`E^qcYin32RNh|RR5Hk8W;=;jxrv@O=%~eQZa8Y z!RRz0oaA!l4SbO0qVeRe4B>p1}aTTDom z-lqM}qm6N&?hqpONW4Qg9>Ai)yKE$QL!MP_lI5>q`a7NP8Rjv=JZ_kOGt9pm<_W`m z-!MNg%nuFoq%gZ+W2<=n^CQFj*f2ja%ufyTGsFDcFuw?+Z+5kAwEho+{FPyTZJ4JG z^BcoFW0+@QonIF{$1zX9EJhgL>BjfEab7om(2XA{@(@;7E`-s8cR9M#(XLuLc@C+n ziJ}YGN}Ij`k1N z5`*98wF&%K3T0=w7DY#2gg+Li?(^9rHmejs>k74465qJ^sPQ|{=exDfcN?E?>`7^q z$0n4<@3ubQ?R>t2_`3_8y&M-G9DP}h#&GxaDyt3L=uH%aHPQ%k2VGpGO^B0r zyrNDB3`LU`L@6)Z!UH=teL9*x!rbbSK`}Jz@9Lu#LAZgc zK2S%~tPh~>f{mL#P)FcW2XDhkwT&bM7O`t+0#31d0Iuh;3*n@Gr1oW(Cw!z9G|92A z^Z`hM^|9JXu!d2_M^JlLevGYN?1UZ&s{KrYs^eqz9jl-Y5J988U#LaAv;9kKT--p9 zeW_k!u}C!dA8Ie4x&HulHc4M$`Edi?`jxTP6G8{@iF*J~eT6>5$tUYkTpQPn(trfw zBy@X)4z>@n2J))d=vz~8EW&dd+P_Tiji=S+dTi|!c?K#I#G>;VRTklzC`jTnz3DTf z>GR5_&q+<6)0#eKG=0u$`pj?oENJ>HZ2Bx}`YdkxT-x+m()3x{^jX&Qxvc4PdDG{L zrcYd$jOdEEUDx#am!{8~#HXEe?PjECI9_7GdR5UhK7U;vWTkEA(AP1y6|Fgs6+Zq% z9sNm7ppb9XXn{K^`8zCwGE1YBpVb8MiP@O>iG!-e?K-a;UnLNB1VNcu^2+qq9;&oMGH zz3DFOQ&K-@fNMwCMZLQEd-ZY=QSLay>By(JljMnWtua^pUfsmLUwz&v&q+-V^<#e= zbmBZlxa`Lu9S{0JeIkTcnCpMS(7#m z?}lQ^@S_?nf+d`yDtOlC6vQL-& zto9P5F-^&a3l)(S%zeY;PT`!_i^kNZPn{|P{0nq=u<+6^&}4GZrt3weHWHVwtbRg* z&hS??NN{F~K#I>Tjp6;2ni>eu`QXa#3{)pH?=pu5S8V)%1xI5T@g+n?Bdl zy0cInAH1jrg}RUcdB{2LZ|4B^l61luP8Tk!IFobhFs)FEdTgII(_-%oL4Bkg8lc^Q zMsr_)HUP$_y5X{F1MIBo=?+IOr-ptw5LIN=CWm%`J*;DhHdOcEU8_cRccXK-`36_i z1ZvyjLAtHX;D^Z8ScVCD{b8r*2HwjSV)4U^U*RrLu@! zo7lKbA`(Rx+a$b2cI}k_OIN3NaIl6xu8rh^VvNKPmN2ZH3d@}U{Q%us z;IXopd9l7c+V0f4SmK}@e;W$2V@}O&j|X4hx+BTjSR54#eaRADU56GgPu6OI@7xuT zP?Latz#c`LZ0` z^>^SnK*&a1Hh&^Qv*`o}U5L=aG)|z60G@`r0UYL@@MJNan#AwguCv*kVqXpD94G#X zgvI5k0a2}al-CPAWlvit^32q1H6OMM^47VubW3O=T$v1ZW^1+sTh#E4J)C;DwL^4^ zB`BmOQd=SYgH}eOfaqr*sjjOQEhYJkk&=DBd;5I%;crA~kv)hiqO>?1m);rFA(ql{ zrLb|`!oF@{;nm|-+vwLQ%_eApRR1exd`C~9=W<7DeeHdX#N0r$qcuFA;q4cr;q8bS zG_0EzYoCEIb8fe-u3wIn?50I`?gtB8az+ApyvU7h8lWGbzmuNtrag`vTN$gxN&|42 zgf_r35W}PU?VVe5o+V-s7OTn9AacfO#lVPJ`Wam6P!mg=u~&@Y3NyDgnOSz z&?+tBQOjsb{s@OaPL|qnZEG(S!Xb@8I8f+}s#%1d_nBVWHk_ZGo~R{?J)CiHFV%3D z%giPK|B?aRoAG9zING16JsrxQ@gOydQ>aUI*oVRsE-u4p=O|5~x+E>EnJDuvqvUOx zBaj2%gH9)Dinw-0I7aI>BFE#B5iCskN1|{aOV&L2#$irm>IBV-;3oG*vxmN`w>DAo z(7E1PxRgQ-eNZDt=tQjQFma?#9HkR4XCiLfS%xWYkSoaM-PRZ7P#R73{WJ%X@7;b{ zlu?4t;kscu>I}5D=AwZOW}W+M%SLgGxpHufrvSM1;Y8t0M?GMQ8jEk95}OSO%kkz9 zGx5Uccz-m+Tx$YAj-;&3_E_=^(8gI%aBdo){Z-rt%eu8ll3wMzO3RRcl>@af5w-x5 zHsW0AGXu3ns0}fLw26aQFN(ib-2kReZWfdl*}yr8#{f9h$G}ey%nJYx>XY7mgHRvP zm~0q=4g-Vg$YELlucyacru7jw7vOR9&rz3(F4KZ={%p-N<+Y8*fYz#uf>U!@6l3S zCaFEdIP50Q-lfwKkJhJI2r@1W!IezvLI;a+qv7dxRQyj*PBTc;^{O^ERht$#1GIKj-#P@l`o2=F zPEK1cf83_@1I%p3x77quCTR8lB%l;*I{g0CE6jL1f5;dV|i4$K_N0%{1ZgP_>r$D?N!&Sc>zu^Tgn zLhtT?rfd|tH8*`ZO3TJJkMWmlR|WD3ZVT=2-7bMVkB3>&=^ejZ(+|PnlAO`#D`(TF z(HMDTQSoT4k2rwNL-WOS&f7M&=GC?#p+kY1SyzJZRMOURuQNuAHgcNxOVYMCtU)w) zjMi89*@kuwL7Ti6I2xx@W3)tWqteifW^)R|8M6g26O$u6-Q2rnGw^jfG72F~7Ov5Iu$ zXfl0~POtq6^jrjhbB}YofU1t*LV4?0G%bu{HrE)>qA>P*tQN-y#+Q!O24i=vl-p$s zI@+_5Sg@?^jw?|1rfN3&daM?Lx1fF-i;P?X*E`U;ahf8Yfk>l40)=7wS^-rb!H-|Yovu$p7IqtlO zh#DulKBH@VD?{rqts?uC+ULRM5Rx+mr~kPt_vG^W_9Sf#LYO-VIlG$E1N*cmY3^nN z1AVyJFiCSnu0fo6Ov%-#SZVI# zoB?U!A!^kh>2sWqGU5U%a-BY!oIXs5oaRW!e98YipbBeN>odf4P2ow1O8q2e* zW+CRlvwhzr!NB7BsaoeimXqk*3%G3J;8g7uC*u%p46UfBbnYtT&e^N9h{k_z*E&c- z)z*0KkdqYw6Whvd7(a#T_ZIclw>(u&(}FtwG!=X7nk^V*hN6rOkWuZtTm z5v6aYYrW$)T|#e43NtXGrNGiD25PfrXd%w)TCyX&71M(m+LdNwbMRWtcIzfwGjihU zAY2KHsg@MwjhU%^ECpTUqH?5n8ITDyJ+PhSz z#|2T*`x2g;numGJZt9t>Rl}S5Yz)3}QBAg%=;Toy7b`9RoNJ6@TE7Fg;nu~qN3`Z^ zw-|vqJYU<>xZB^XUfc`^)6NmWSJBBFEn4(~JYd(Gme2)SxVYVhNoEg?+ifmepgk_= z7&H6Oy{#8&Z}7g$cNb|(c>86pwh+esxfqjhLiC}ATuo`A3CsGdqr+(?XB^z*;ORk# zTx^Vs9F(yb(}2y$0FEf8I*YX%8n5+*D(Xfos8n7SHkzOR zExrj&xu-y@z?y%30m9~gvk>mLz{*FnadD+S2u{BT7krB@{A{77iV;>ARn_A8y`kk= z4@xi6#)v3lw2B)Bg3aXRSgZPpk)(MjU?+<(Zg(QSd@7mA)>~A_8yXQclU^ z@#JyRN6=)497okkD%HL>vN67_F;k|OX>SW^M@n9XqPu~nFVo6l9ABn&Y0RD~l9p>; zr1z7{wMq6ZaGsl-p5$Diy&#r>%`(hQra7sJr*kW`sKyJO&52Ar#jL~>Bn`cUrF#Fb zSg={CVb_(RDXGkX=HuYiT69-)!o%%8ml$59GlxywC01iKCNrqFm{4`~WpY6`>ykM^ zy9G1N1beS$MdMa38d3DjD%2a(Gj_N}Uq&N}T#aQk|E>i?)z#V!p3;ua9VPi zzf9b|E7n0-oMU}EZMX(`d6WwzUJY#LfYy?py+(Tper#B;UDP<4n91TRBGe9>0% zKDq(JHbnjKwP;fBpp3iF5r=Km;##N|A|rg;u@EZTh-N#4&TZ7*l)j?+O(?$G^e*D; z_CP#(a~;Z6nz!e5P{v}*LjLub8f~Z0&1l5qy$#p1M$Dk@FsL+av-VnJp}&*cq^GeJ z=*W#)N$8GWn%|HuQwEwN`%k#7P!u+9o%-N@<9lz?5(n2BH6#_$=bu>|dCZa~C{4-A zS!uR6n0mCoS-UJW9QHYl&7@DIjP=+;S#+~z8zd4Nyhwx3>(aimmx0bBG9D{%vYYh> z%jP#DC1%pOn=z5#vuFHc2_9{+PlqY8Qgig=V`JS5nyH!v_ zpP&Y9sLUfhRM>_Fv~8Bxc`=9Ol$xXF1%Bsf>#{p-bh&=O6p9i-K#= z(wmiYur9&5#!1f-yICT^$-(3}cLkX44HeSuxm56vrSHcgz&LAXnrp$kWVO4ov$wWJ z)0I!{>HZp|&3bC6(ZVfq5Pegl$??g^N!BZJ^jpeAGi2?lC&5~08(l$Kr@#l0oE>!~ zNd=)5IZU?_DtHkcA*ApgI!$OC_EPRvv@BETwyoNbDO~2c*l-L?pSUQ=z&!x|nK9!S zd6z=O1@olxO{602j?Du>1;pB zx?KzJ_doKH_TLVLpKmK-dR$AVZ-=Htc#O`Z9qxv|!x&JtrR4NbM`JN;gL)e37{$3{ z28nYi6)+Vr%!mHZQh;O1op%h?N1$gud6#Cja{{t^V&y0{@F668JIWXh_Sb9M*=pX! z=9G|anoSI{;vm=P2EMs)*RdL35eJFekn|Gvna_o|P;UAMBY=vxv~i#^R>6j7ZvC?X z13F{_T7iab=#q}nZ!knRtzVQPRtPr2(=@7bVS7h~%W4hY?^9H8?&|9f`ZN^p-$|_K z--P>jxfEi-q8VO74cnnk;{sx*jAAIbYq#Pk#uSov7-Rbg%HN?WqGjcTP6Nyba00M{ zN((fHup$&iEm?8sezNWGCO<{+!m-=Y&_cIs@|Qbze}9u&pml7D9L6{qcOpaBlb|L~ zq(>=thZZh^#ueV*RqWa`{qIl7VMw{NcWV0m8GVJ4TR7NPM4(Y~&1H`>nUlolt|xm_ z(&D`XpQPPci+tyRaXb1?EZdp_(!2WHDroO^Y9qz$q$i!~gAEj0cVZm^8wGZvg!md= zs*`30QRN|I;=?>_66HHcdW64O0eszE=;|N!;XI}fu717SsBh5bI#K`JC)?{KrVSZ^23oRdINZ-i?rB@%C;lR-~rQ&qLgi zW!i|NQ+FH1(C#N?*MsHNgH?Br7L>dfRRG?I7R?NfnZ*9}^$Ezfr_ePBkM&+H&Im~I zy_l*$X^a%1JEpndA$ddZ)52rec?r%(`NkICoC@3oJO#dZDF=ynuNEYnY(u9O+n~N4 z040U)jFX+=pRY6hDCIuQA<6_d{icggx9H-H_hDT13^m-Rl~3oKK<_JNR@{(tG5MMN;s!XIkwB28`-`ujXSsys(K8Hxw=)DX&l^zX%Gu@z=ZHIkZJ47kq zn#m-d9r(HtMv=R&_Z#*Sn?Acz7N{Z^Jegy=939_a^r0%#Vldr*zY&ancoS0VBP@0|EXMm;>_Hh1 zXi-9BxgnC^Cz3!_4;bF}G(>v&iS(j+Q^akEaI@tb!bm!2ittc}BhlMW1e@6QVA+qG zXjYJOcADR2Uw$vG+oL&#nfIrd9x!f)I0FZte=~5UwdsVpe#L1Vg|}Ue=P{xpM}^U$Ep-N14>z zZdpMKVmeU>dOeS5+Z`Q4H{;2dUah2u?`tKETxn}H^;hqimo&MvEp|a(R{p&CSrquG z=55OuV~iepYV5{Jgvvch8&^IW+cj z=-BaZmeil__*~Oy*XP>n-kLA8b(X@rJbSthcHiakbc-n&?2aj^>r+;mn^%&UwRB7> z#%C?biJKJPD?MvzNlxa1tlYe^rBwWd)~UQMN%tf>4+*uf1U^WTXGERVB1uC>AQia5 z!_Vz8KB7G_S^4w(_jL!|ejERu9FCr+M=MX$uQKIQJCz1$kf(Bl`JLveOsNb?HBn3~ zsG&oI!yEsV7G;I5c>EdYii_#g8LdlHbbiUQ>~1Bc^9##L#dqzVDEDQYRxvPQN)S-G zct#s;1!W+4&T4W1h~BAZwJCw_;VDS2g#{vsN(k1SW#yISc=w#g zv=vuWzxjhUGcb0B+a5RPM+VjTcvBffBjwC zWyPBgYXdrMmZT@V?E*X9-mYtH?W+I6yN&mRbOMBX?+J-`bdaS6`&F)pxPfL|5pi|- z=*f$6+y%(KWjXHb!ubea&e9U(rMqx}yA-UVrMdaJf}307&d(}9l`mYn(!G394oX33 z>C)VJWu-YK?wNaAdG_=wD=5ucxG-n_YZ}ea;B&CUq=2K8nHLc==*d}i)-IA|+Kf7@Te8faU1yDyEZH!+N|uG= z>#R|dMZwael<0K@D^2tRp4qt$A_XkskAN7Ics9 zm7SkkXT_5s1K`6LN$QhbXHAo&#F=&0E3o@6r_MT7lH%y&{D_Itd)__;5%VTuOIXc; zh^uWiD>(wvOJ4QahzadFscDswneNEg$XIt>pcEmsdOjPbOKMf`tvDPp$J*hpF?H5& zB-;rD_l#sa={x26z&n?C!+(wVOK5p~W3tAX30k`+ku$9^&)u3a5vpDa@kyS9`Bf=n3FU?yu#`U-jOIc$wT)pJc zsCMn7fXmU&2T1|k+y_em;oi*|t}T}6*pv}y(rvLRDZ&_`V&ufP~{xgt`4yyM(JVF4Z1wjH5$Z` zI#D-hTc+!>j{gxcQZyM}C&uUnrzC4ZP9_FPEQY<8^Ih6iVPGd4Y>btB1f1Z+#}v+6+!#QIhy_y? zEiKH1!S*y^uZdHTvyjQ*e&nqA!j}lD z&2h;NmmfF3EDsC0t}uE($JJ(57k_S{ueB0=sM(-eThrA+PWC%i%@!1 zMp=5gbc2|PdjGz@34&5?QhgExRFNQ%H50^#WG09Y$xINFR1TYFikLKz%mncvWgWajvmKJf0qec)xhhh)V^8)p*@%zZlaeqosh`l)2c|IeE?&HjCvl_Uf${rggJp37xP#%)S@ zt_Uj3bG4yI@?0w2l;>(q4fwJkOkd@>I>jS+y4^kqd4D4rau+rQzJFigYacoXC#AmB zA>Y**1~8?K9_M~cQ*1`?`spm)(f)!(wfU|#m`3i-ce#5EMDTmW%qv-*Rm6>yE;kT~ z-P0iIjUq>9p!fTHSGlE~GbJjgKr}32-nB(8du!=y@1|w0O#$V7{Im$HS?KLY!`!oP z6RAnF;A6K@vykK?C^QQ`jdz4wTfr8x_83VLN1<`-q=tSDMK z*v*4XF+OmYVu)Gd&RLO_U5WvGVF9KFOBdEzWyx~C_xQuEM0fdG=zA-%7zfo^>sx9i z=W|E(pQp|f1tmg?BvpD+>O9?>6bdPl<+h_>$E5JsHKo-YPs#`uC@D2G6)94{XGd8= z(DJj2puI?u+Wf}uB&1-f+9+p}+6$LP@MtJSvSre`w_QCt+B&mntP!&mDeNdc_qI!p z-NNKJCL=joPOSg;@$31*osti%H^$t@|JmxuJ&?MXt=V^Z~awrj^8$BjfOU7AybFx$(R z5I-_!UfIIjf(3;sQpaCu$-Azusm??Z?2(1pdizlV$37OeM?o9FdIAKgs|a+|C=Rgw zu<*SbkgT#5DN?&Vbo5b!yV<+w@j0bg@OzdBbu`pt$P>#3;X=%KBfamX{P)m*-9k6L=j!ZnMzD+BCPJga z-r0v@66A@4dJLr^dl4e`mWYSYmm!!ajHwV8C zz`ZsN>|VEYp;CbJh3r~3*|7w{&{dZyQpo!# zUmQM`MtqPN>-EeqDLKfDw$ITQ$6S#(E7kTmVtSquj=P{Irm@FeeXrar6Z~j=N&ZUt-Cq z$y~xMPqI+lvMYz;H85w}0 z8OK6g@KdDrZctI=#yP*VFZUf^b66}}Iyb_=iaJt~W3U+yT zVo@F>5Sf=kl6iP)Vz%S<(%Z6vjJz4Z3BhV$gYyuu6t|f^`Hrlbz;uO^bC&$$H<;77 zL-}9zDbDF9@5ufZc*nDX)qZFHd9>m;_EP zx~sXRKViAzf@caBmstl*PkAo8Prygd`I_s+e_VGJP0asFKb^DP=ml^{KtPD^OU|e5 zI|J?VHaqngM*~}ZuViIpkt(AJ2C?5G@BVD)yKE8DyVKHH>e=*_uVgKqZsxf71cZP_ zuU&k6f4CO{$}AP5P!a)le@N(2RzBM}soD-i@#z=VaA z2T1Tj1SB!)sGJdRL4zkEV4|p?poyY_f_%T4-3`P3@%_H<&GU3-s=B(my1Kf$x~FG$ znKA#FFXoj_af+>!_qdwqUFPg8wov*NStDayRn&J_Rum(2TJ-l9;Cc-5QZ@`$JF z==PY{7fh`0|2FgfmO6^pnZmo<>GT%5r8gJ6pEfC;t)tju^51RJZFfb8XXHNLws=RnQ(R^B>eY)xnt-&$TQSe$ z%?*pW8cRcOkn!Hqu<HiNSD9aTdFP`mhFNPLGRk zs6q*&P>#!VMB)w#lvll*;|v$e>O|spqvW(nl%1qW?|boM#BgtNLRV3Y|0&-5gb}o^ zyWQyc9Yr2}x2Ah>A|+$;!g9)P`v8d5BG*K|LITYN|0zI;)m zr&aNDd2-_goyFf&QRa-Mk^?R`ResF!-cpK&Cr^m>7LMDFyRr$bz0=0OX5uE{f5C)y zCUyz_r%#+L_EABx5>2_f;w*kok(Av6eYt<)Tx5&v0p9#c`R3h+Or9NIekyyRK$)TM zM0jZTY`2?|9IB*zugmUTcWaWLsPfkNDv0vN$9O0sS(WA4x9=AJqu{BaE}GVy*-wx5 zR!*~)-IW6A1e<71MyyH&PlfGSP?k&9| z8;GzwpJsxmJXDh;Se(44;=OVPw1nG{M%w_1T z@&HBBZ04|j_CF%MyePMqgxaf_k;MfLH8e4RvH}8JWP4zJfcsw#D%yRFv+&8e?yDj&jmU~zE zq5GQ)(Y5@KrN0XC9aW4`J;LX)sdSkly$Q=R0=k>Oyoo6BZd@LXhSWxQyxHUJ-pb`o zDC3Bhw04j5mUt!AbZ7vlyrM&(OzsMlp`vOSX31L)=`CFW-{R}6b1TxsNpI7Ymt(&{ zBX~%Akk}jYaOQ?pQ<&2Q4LsPPjwJMdNDB6Zc)X<#b{5r?94@2RK9n!MFE4oLYn#|q zK4EQrr`SZvhgDDc!YA!QZ1UDVn?h-w)d+9yMp?dpQwKk;_-Vynp0v421&MgJ6aII3 z)-cH*5l@yEJU5kfbb8AiA#$i&1&g{Nqht(cF8g)Ghv@vQApG*Im{G$gAy)I;V>1(HisHKWK?D5{p zd6F^)*=70eH#P|IH5G+nNYCB9LHtl2w&xomzVX)XjTY73f?b~Sgnfld*d}o2LBP(Q zb-2m9ry@F*v7M2YBJm%ajG0TdU)J}$^ky2m(wlxD9{&d&n1?>ziu+C8>I0s@e=2ID z$J6#)yS+U1EjdthHPYQ8TEN0?3KI)_m)TU+T(eWRaFHdds4S;}hf2c5G~DMc!bF=r z1kQB#OLjY@c|!n8wH(qQ&)`OLxVHqsT03rNkFc zkWPB7M0HYrtVlo?q;H9iriG`4os#14uYav@Qe~`&K-SQg;l|qbqewvNy5f7VadYV1*(31oPd+NMVuF38@TV(0N2_(xXoV^ zt{zI5A-ehRjTtk)8AX+JWbMtngn>WK=6fc@L zN}2fE)Wg3oi64aa4@9d^>8+GrM(QhKMkE({`~&fnibiEt2#=BVkyr*xGywwe46UjZ z=YVj%53TM#ERHCUt73%PL%E*{N!vdY*%03Kx%kVhM*mWLVpe?gEAf%a>|Z!8`YJB2 zcm`58r29ymK>K5=L<*Vw4+JFj7@on@zf3Qx^N#?-;2@Q-ZEc;c7V$qYaK|H=P;{ zd#uux4$9y4D9WZZhOyReRy;J&rW_H4)YPtQsteILlwywm(tq6@{k6oej>=~A|c4RqS23=sEG zPN>paylY;(>%K^!n%itnN()saqR8~Yh*~>H<4CB|LPJStWobAEjqFPT-U9U$M<_kb z-Z&bm#IYLwj8wXZv9dXuW2Z9-Nm8FE;KkfT!>Q+G=PguFKLI)O>ZtdueMf_(2bPbRe2gC z;O(wTSBN3HDc?v?M-`(fwy*M!U9|Nc zZWm8!LzMFx$J!$)r!kyMMwWuOjh@X?9tQLDp~@2OlCoi@?$aAN;r=!w=&Tv0q?z`( z45~@;<~)(;J$SF%TbiQP1PuyfW8!MY3wAJN?YUZNlJUJ zZELm?53!ARvXxd+Tu-%AlyR^*T!t7MZd2e1_8E6iQ!rKRqmg$gcZ#l*vuk#uAx!m5Gh?Ud6Fx8a_p6^X`x$x&qvT;x(S|!; zv73ewS77$EaYKQku&g)UuNb~wX-)}C6>~;dzEqhd#AaG_IvU6a6nJ(sY@+ubP+Ewm zsP+M+eOSO~1Ge~-(Q&ylRfu?F;|j$q#B@r3P)TXY=E`G_{T;7qnVjJ}k=Wh?iocB( zJ*Xrm&-Q0?2*z2w-ed9regy4#Q0don2~f_i)-W_LT)r=?S*rXS*18dF*RMKj26YlqE*TxP%^pJCdiPQfh=aVH9~4uPR0vO-VTrA~qSP zH!GLz8i&VoC}*JX6mL@!#As@`P5BPFV!JX~I5r`dn|(74jnX`nze70#bKLxdV;sHr zqS66zP4aOMxpykrVie`=glil{nN?WRmF~nK809T^&O_UsD%|@{B^BEMk)?1U(Z8&UQyClRVHQ~{2Z`us0wZNEe zK}A1;;l+2AG_57zQB<)E6HDpKN`KLUnR$u_DRwHks7NE`73Dm_aSAiQw}sKsP`(tR zrQv!V9$l;{s_+;y-cULVNJtaA+M{UqE+tiK4W=QKJk#ZQbvFhHBrMvaY!azP`d;p& zHU{cY%`$uYL`TuF{YomDPrn>;G@{&N4J1`Au}dSZ0($Vbj%wyYqA71G^F>QK{w7>c zOA0%nq?qjyRFDnA^TJj=u%30hw=nN3jXNY+>g@qbd7c<)CP7 zw0RFxg&DW983xL2qRcQS{r|$X45y0AaD((p8+CFBXp2JB zehM7@S5DPv3J+Cuotol3`GDJ-1siwY>XCHtI@O7cuaF^Xj7!(4@MIf}%#JGj<|f0{ zS?$Drxlb3BglZh`qNX^|VWOAnMeh1uYA5h2H=%Y$VS@E2` z9S@m%`lw&HP9U4z0T0C*O0QJ0JM@q=a{H+(L(|w}biJ!`0U2<^=l?X1b4d3|FUW`*0gV=@n5PBXtDC0BQP2^>J?SrsW5GoTACN5&s6nORp{P|5z$84oob<=gxMI^@6CXR z-akXNhc$rLVFmF#7R!lhXP}ieoEH|97Z2yCM#mlVOqPe)VPY_+|kWgU2SwmL~^rBL5oby!Olt|PMedcFVJ$$#zazjom( z?a5QInx^Et&@86T0G21-9!UJhxJ-(jqqb|)(_gTc|JvJs?Sm`N-&~Bz`!b%Y?^2tO zOJJ;WmvGAlT_cZ&0Ot+1=27h&H9C0+P$Q6K^OI!xVXlgc45gNH z)dO^Jjm=K;)zA^Kt%2mN>1O|4zRY|%+;H=i^1chl7S*z8v|kN(Q*LXQoz8t1leG49 zjQ7+jH?8|3*6l5AV!v{8ep`bKG0waB0S}G8O}8%@=CAuEu;aRiTgByh9JpwI-iT}D zv59fHkwJMQfn&?%yiv#tj7Nq?Ux95V!5GE+Vq6p*Tm*Y^e*=ek@)v_vcqv@%>;1Y{!5F0RvR^Bt+B&on;DOL zt6_}f$S0nvUZ{@+^v|kPCMfjcZqe9Rf5|B|g7U}5IK^7ZoP^cX{`Ij=nsQlplY51N zEubEDY@NTI2wgGRh7K zx0ADd%oveR4IAOX-lI+3wEZ`AZfti5I1Y*b*j@5{7o>?s^*w5R1yg+Wvmw!x`cjm8 zeKvUJ{~6)*X2nSAcCVT*CSmc8J+347sx^*mG}AYF*}Ew@3boBu8}+$0sP$|wfqtKS zjXWLs+>0%dVvv|+4CO3PKgA9N?OmwGQPx6rnR2^AjfTavDqf@}MNYj2pI92YNcGe$ zF9TIhx02Fri_~&)2W<|O9!g!T_7-H%QCm>{5_N{g<~yINm#9n4U;~r~uR;?y*rJLH)Mv0c z@oa&504w;+4e_+>euMxEXvh8P(?sx690q^cF_DW0l6SgD#@ z8$Ya6o0(*8DqCriRk)oVquYbf4(7gshtzormZ%*4lY6zw+kSNOY6M67=-$=pICBNU z-qJ~#k441eVUzvUHR>1+oytmJ7NCBkP<@Epg=!XXIfd$I;0)mIF{81y>O7#gu2r$Q zz$FqLQDA1y|1`m?wvXk|gmuAb7E(OYM5KQxXPopHyS=KL=jPgbv9hmPr@kdVFrO5E zL^;K3SM#~aA`@}HiSV9uxxF)7b{GNjhhPt(tXLg@sxK9*yu(0oq&5@zMkcAfw2mB( ztVH5JcI}gqSPrv(TzRX5Jpp@#x)6|F-=L1hW?a}t)uS{NH0zWjirlwhizH*Cx)2$) zn^X@~ZbS^@q2n9Xop`d8oPb@FC*k7$_GbQq&EY5289u@ulr_xhq?Mc0X+Fec#e+ve zF(Qg`=fq0NEkVTWQ#J1i?L*{JQv&aIMbl4iR&SBCY>OIWxSvz!3gvzbr2Ca9s=6gs z8YNp)?6@zb8@H-MLb{?EY;wzBvuj*Y#`djhl_nlAR_|0(q*!j0m8(xU#0na;2OYZ- zFZ7^yEkOMpU^J_7byKb!rd6j^iosPJ{*-d*S8^`CtA7$US4P z+C;1}iuS6Vq*zVK|EQgc52yph8e`A_)uW0>DCZrF%jL$RchpBTiaCVM$1yP>O(^Y? zumtb^_poSb$WJ;Cs;_B9s3nYR@fc}`xH)U-&_`Isw4vIMz_wCNE6#^gpZ2l(s8~m$ z5*lA?lvS$3g|-$&1tr_jA@1)T5k}f47?fhY5%!1LK*zElaxGN|UZAO`8D&3@Ra%Kd z#29D(QCAA(QMjj`BF-qhq&_c{#}x004pBzdWfcz(AE!P-4%ePA+g~uEK|H-Cq_bF8 zWF*fFyaY`4D|>@UQ#%GU83Q7uX|YKp6gfw9KzM13r$R*@Q8p?xc(pxFJV`rL*&ItR z^HSowZ1!EA;!6r;|Lnka++u{TPX{BO2}V2{jCd{>u_YMsd@y2bFye(^#I|6>_F%-0 zV8n~Th@HWR(qKdxBXH8eCX>WVlx~xq!postt3!X;ufC z3G>@;IXgp*1_yk^h*O&{MFY)|gV5sb%O#~c9 zVK0Zpivv6zMYm)MUitMxVwdq2U|wi6_QP)j=74!309bsMbmD9db30i6-yX zl-@v&GpRV5Wh!>5zTj?i1L=uk2HY0TvLkUD-Ziz4%^Xce(8UIF47}b*w`||=eGs#Y z{u^l&63;07=bKfYb;}jzxfR|>1f?k$^ZS4@!(<8;W2S?4Pm=I24P#^&*Uc+!uHVO^ zC=9y#kT6N0Tb>TJ)3L`Dd+~FzKH7j@xc$pXgv-%lIgJgMDY48c&^rflU)MXdK3pc! z6kWP0^>eto%5Z5n>*X-UtP|Ijl)Td!uY3eI+fPSO;*l|CPq}E1j-E>WHQG+&Ju<%#%2_l>Cxiru6Z0}zK$6TfW!5ot)-GTkrLUz5SzhQGR zTNC!;Sec|8Lw8k0Mp5Tj84-FM#p*g;c=tNviVxWNF|QmLdg7`)>OLsyI?6waojG?L z9NIVjF!1Ft*(P8RY{0zi3+T4WFH~TaYK{SK-mTbmwP}(H<77nKa?tQfkqW z+;cyFkJVPZ>?snl$t9q!${BP{a)U;6K2eTn7LKWc-D-EFo=AO> zZbll6Gz^K&_!fk-6)}yLEW$lUe;ggIMcRS%EmAb>Ar+|`(jp`;($h#gkPM{VNOz!d zoDSl?3aJ)Jpb@-(lZ=#(l!>$e=@q0f7}#{AdyyVQDpv871i`gI@NdeJs~P?tL~t$${v!zfGYI}G2tFSKUkHN# zW;Iz`^iL3c5mQ5B8K+$GU;o7w(UWpnp?{mm#%*}aUKxkjtbmpR-bWyhd4r{?J%#d` zNZz9pDYBPKB9|Qwj}eWArXY&YsURNf$!u&eQ(=m93Y)Klo$>I!DN+gt6{X7NbTLJy zDj}-3ZJ#L0Xd-2s`e2sCO1c}R{;N4` zJ%Q$cnORFX4Q&BW>G3g);FdKf`-vzgX$kO!NtqLf&OXX zqiX5n+R6vD_CcvWsErS5YeFp5K41Y>GoC~c55v4b-q&VeQn#` z3jVo+57m)GD~OVdzQrk$vM}`jswOgqU1tl?*+jusEOLc1s8A`y0 zi$+kIgYR0)@mhD#gqoa157u*QI@ekzX&EMZPg8WHsrR0iKImm~7rogAA9nTOO8n~Y z>r;O}CLZGIkDNfq++^m^k!C(I>|%h~dDH~G;j3YgPiKRDEf_+1ZDo6rMVal;{{3xb zj2LRUA7;59&iBp52uhDb_bzNFo5YSp&DI%z6kt~LXePz^p6i_0vTG+hh%r7yOd5vS zSk@!v+!5%Wj5HY$ehW$kOr8DSIJM}>D9TsS7vrfQ4RucNT_)1uG&vi)S()kRpw6w( z)7fpH;2G&KsvK4Z*rvnmZskT}@j9JjvY)_bGBdzN17}Y0F}uxF0424CVoV>9b)Cdn zU2?RSoy?7uD<^pn7PQB*0ox3Zx0ly}rtXL-)wGvR&iJ=ICQTgcYJrnANBTyi=fA+z zJ)?u{U_M7--;jZX4Vk8)9%Fw8nZVm9$2-dQTsr)E+1;!&o-&^d^AtygKyTN}BwBSn zraykHb-kR(1+>nxITvW#SvKbDu+DO=GF7F}k7MIr?E+E6G;TUhgY?5&-9$0_I9z&cp z14TK!;T2YEBv9A8iH>JV-@(c00NLp;@n>=HhzGn6!`hR2Vyzm{OL0d=gAe--Yba+o zL%A*&5WqD+76*XLUO{@3gF0NT^-%rkW1eh+O%>L3-2QH=w{pGu2iP7{Xxl>@*+%*20o8@PY0#wAqZn<%2fSjy2 z?yrNp43-aLw}{>zA|E#QL78kljm<*1u!-)@k^``nRFQ?5HgXekSi>`sSj#@`R(EwK z(wU|%yOA_ZuDY6v)ofB36~pClJ{=J`QhtrCy4sQQ&e&ys?LB}i>x%oIssE<*0(AiG zA0?j`O^xZJWk2Cs4jNt}aK1`=#>j1A1!dljv6(+sPEl5>H24G#Rn#P6=i}gqAx^`6 z3%r|nkeZH@Uy6t5(l|LlTL>mPRo@4G7dAnz5ZJMoGO}zi*lqQIV-Xcq%5G z4R~5B6T^7Pa|>keg=88A-8fY)5F5EZZ0!CFi9VYuv#+_WD{0|08Q}=*OgO0Q8<=Y4 zG)z9F)3AdPMULt6XZFZ{PM05Hw@=JQKb1V_aB7=;D%xd_rc?c5V<_QHb1E@L-6^kA zaMT`@@y0VV<#;|k2B3#{%E+88hxks3^5_ro9v+M1KDlxo;;GC$==W(V%j0k*PiBZ` z_uf`;%2e%^oG>c76=ziy+A^Q70Y-4E_C zy3ChTmAc*O7ggWx^#1!K_Ih{HgoSdcgO@_SzQ}8cGbh=d5R2Ov$?fJT=-H?&l#;*1 zHgqZP1ed-L;Vyn&IExp{xsEcFG^aHZ<8WTGaIx&*c&U!tp~aFMj2m?oWDn;1Kpk#aEsf5MZNqMVb?XLjMqrMIexB*q%j7Jug ztEJuXDqtpGNY$(5mPo@7?!=YL-%E$e>9m}vR}u21|7cL86n}KLukV9 z(eYmU7I)ZMfV>aGE}8$v)1XIWYb6cOEz9gtB7}+_fgSvW2Q#v@_=pZa0^hZT&ORce zwdL^MF7M{W9z;5vE&BsOh3jx&s+ozXTLk5TT%4yOcI!V;H7=3IF=6nI z54*6yyjAI=*ke+N?UcS2BhPsl4(!n)>5N?IFTy$x6j@*riCMmqIW%^y>?+%Xkg}h( zC3v%*kD-HW<(ZH-ph@oRLKmHo^_x+Ztlz|&)XYu`pM;BkgEp^|?OQUD2SnW0^^v$c z7{>#nF%siV92F79ul-{WHhb60?f&w(h+^5b=`Ivu8SBU`EEw-&ky8wp`hQa~X)IF+ z<*mc2pyb7{G^*MNN3-%#__8->{iE_jTyh?RrvUfI0#IvmM`QPKH;S@cb+S>}<0eV^ zGuRg@eL_~DRM7^^pvAqGqx0}++eoTN48PUjpTgh!iu@lsxD8;kHG*1=~can=!QNDyPf|VK{iS z8586GvDTqa$pimqikVOUzfo9tfK}16@4Tub}>S+amM+r z@|?JKSsV_P|ESk4Y=o7{$^Vh(V|=n)?vAAWN3rHv_aWw_opkm?nYe_t-x>-2zuxO` zLsqY{39vPPEnx1*0R2+H*1>oeVC#6E448w*0R3>lfuND=>vj2Z_sfCEk`e7ez)rz# zDb(1H3kb$^>@S%vgf?fvyH8mZ#79FFVuDh-7lMZ*cdvXQ` zk@o;>ZCg9Q*0v=9wzka;*xEJ$*xIyOZ`oTOQH6(>(zE1acvw?@OFQ@ZaaM)D=*L;x zvC)sS3b)#ivkJJ#kFyFn(}!zZ7rL`DC-@1i(hj1`c_H(>`8eprS&jPjzSq#{!$>kR>FS$yU_kbYSN^bMx0)lbFM*4Bq zrBQD`&MI(wKh7$2V?WL(I1T<->XBi7oK^VCzKQ2o-;{OSoQ+x@^iNbQWWe@!`EfkI z1aQw$!ELdgmh1glJk12Mmilo~7TjHwd6ViHdaFMx#*#JEk7HjHV3Fy^u@evA+WB$u z7F;4_z8~Sav4KCUp(X3zzkQl+WWoL7$0b^D$EoZS=^1>;pOtLM+U3XbG!c+un;(~A z!EFRC(0M@Dd*pB9mk%Nu3wrHCc&v=iq0h;d2)*hhAlbL}8!GuH^n4qr+No5(-+|(Fd?quc<6?#Ur+%A7>Rd)Q__Y{5y6Fn4eYXlfYdmhv4LM5?{(CORR3~ zk*jFx)w>(8mGA9r`|@l{q627+KkD75(t>1p}< zpT4XsZKzl8q#tLM@pH;KB0V>}g zSRP2MB8>)Y6{#O!t4N&zTUF2;uvMg(KWOn$dBYN`3O+e^wMr@gTkCiMu(b{^U~3&q z09)&r1=!l`34pEj4L*kj#8Y!gfJ$N)YV$o%Zfhhj}l)5JBs{mTu+w-{_-b zGA`6A)o2sfOwoOL~4s*EJ>&DrLG^vAFwK-Wsp#n^Vqv zcnv)Fq+A!i7ci@X70+w^eJZ_p9gdx*eUFW{{WR!%nTQ~K=J(hp-ANn2$3ne=!hXQ= zc_$V8h=p&)4_F9g{fJGwH-qs`9M~D;Bdz@btH8n^@J#M4!loVeLQo7WUiks+-?mV- z7ViYJ@w0!|f{(A;JALo!t`P@`$2p{oBxoLT%RKA4u95X`U{o1kI>pu zp{BJ6{nCSQhxdV+kNJya%+s8q$1NEr zR9f6Z8*J(ZCtsqq(UkGG?B;8p$0+<;o>#+osmo@>L6vXkAS?uDQnvq#!)$NR@qe)c zhvj}NEs>H|X?FDd=K5N+$uWR}L(fD2vXJm->2rg(hUT|2eVISrr8=k{mHf_I70}ZHUeQk)3 z?i%_b=%*8vlxQR9;52;vAr@| zLw~enoU)FW)0T{%Oyj@9WFKSP7^mT#E3@C4Q&qgy-*-QmRwZb>dxid-T%1~WOEVf? zxj$BS-k3rVSlf058k(Yg8OdIa z&t>o!<9X9(wH3+uL`ud%X^d&2;e9XcNjKG^abf)0L((X0swHqOR%QKcY5Ez<@D8WL zEi^K<5KS{%nzn$(&PJOLx6*jW4g)ZecDL5D0xHR^)5BHmHQrA}7nueqX>%)lQX{vm zwvv^4&F+uJ3nSXg$PL)mwQQg@Wv|fEsAeku!Ju%ay`8p<7G9@y_`harz_gmXpq=A+ zT5Fn{sYUSpU0OfdpK7`(E56}fT03@qX_VUxWBJrfyVEG_sl6tYvnsXiqus3h;=lgt zzt;G#wf^gG{_F4l>pB1R5C8Q~|Mf5b^}PRj!GHbRch&wu|G8*UE3HTI?V8ir-(SlX zAs2z<8T=9^rkl0 zEE=SB6)ry36__C;4ZVOFzvLdR1G)dees}5X*y)_n4oBmXhG?k`**iZ)lw-bOFM=G&zG{ar7j1G-03fl#{cT9HCwVo)wG5ZXLJ&d8^U=R0uW8O= z4X2TojnL9ukst^(KMLP_(Y|)^0k=TiF(f8HrkcTMOU+0v+ZAh}$DBV5P0k&KVHr<% zkJ1i^1S%M>b)wwS+6Y%e3!g@Gc(gVdrdNB9HqMo3VUom5qG{zQZ9KWh!p-cYhGQ`x zlWFx>?Fm<73zHOPf>*e<;?TsvTeRnuCX&|Ntu-pXEIaW03G6s+uB)kqdoy2;R*i#* z&FTAb+7mdi1QF+GEtxU725IqhY={4YS8nXbkAZjG_i zwO%&Sj`9{j<)u*?jsiW0Cv8=^+C^vu1GNV$=Ps?iNTZ>5X#=hxF`$Qsr9*@nsEj3H zd%BJ?=fKUk_wnOEiE8F(3(d+@BX6$OKyh^daiIG<)>(fRIGY`Hy(PPo#S}{B;jR77 zboM!|2XQ#%>S7_hf$eOZtE&aojVfZaAygWt;d^+oS~u5?mdx&yey`R}^e}Sn)$n$I z24~Uck?0s`H;JCVPkT@FG@z6oh(iA-K+-sdYELbeXdI7P!Y4DP<b+o))@wiCrN z*O>iZCy@=$EHMxEp|ZV@sAPfGn}cEO(H+q2#b@Dfa%XETbT)*(7$%(&M3-*SVvN#9 zv}xQ!JgUAg2s=S)p zv@9DHgyUI&Nz(uSL}FyE*XAoIpZ6F#q>8SV#71F{n%esBTuiKw6 z>)>PB-2coqHarejqw%w6LDj{f5cmm=AI8+FSEr5}w2!aC7|9#8FMSc3!Vww<>2Fwl zq?N#C#Z5-uGui@0+{~k*ml$BAZ_&Ey_^8dy9U8v3f%AO(pzzY8QO@38y^Hu2!baD!IOgE>>xNN2)@+MiZ)NSIqOm%!d}{Y<{roYuXdjKQ5A%q@Xg3z^ zgLe?m8(|d~#Ez|C%gy-qvEoHok9%lMH!pYweXC(%WcV z9PNKwYofep-WR{4bx?Ln`lx?+V@h)3t&s8WAQ1R~#QR`T@{V?1l+t7GV&W~ML+@f8 z{s9%d55ag^52HixYXd0%J=F6OJ@%fNYnIDCgy8WYQZ}^DqLRV5#~5Mf{&* z!98Nn;dnnT`$MgXzrqJU)Y@sUpvm=V<9nC_Olk0$3LJ$uYCeSEP+amMZE{O%ygCi) z;ZTJ4G5A~<$FOxc+HpwhWOA=hrw?hf&07ym_y`qoBO|E@w`QEf`;{E$gi_91dW!im zQ-8q=A8D=4r{c_-6K|E8RZ^Fawb5o4Kh@%_Ku}~>*WA1R7JEY$EI6B=(s5;WyaO&h z*CdJblQ{mH_f~3#4XR8(qO~{ABndE1ro7G^EvTB^yMIxP1)u(Beasn0 z&?kIg4WDDm##UU(ANB3tg*rYC@RjC_wQ9cyn4x`UyHUqiT8dc?56+Kip0HQZm%Nq9 z6g(;nW6@WzBk`Iq)PL)!wotsz_e(LMnTv#)ueB+TT`0y5Ww#HP`vY9fs$-akStK9p z$UQ-<_X5U3V+`ImuR5lk#9?J0zvEb7?Wdt95aU$%P^V64108Srt2p4ptvb-aO&PD? zLmBzsXqDLN99pGyG8-CLwr4;d)b4NS<|;FaI#gv^DViN$T&=lbo?+G495a{uRJH)` z`DIiiK=+Ne;_Y_6oluRq*w>InAjTdlPoT#0)d-KUg?i{)&Fgp<(y=A&r0L&j%`Kal z6|>?g>pRWuc(0D)5Gb%&Q}i9;O7}@Erseyr2^2ODZlbeC;hrspJKzIro-yf2| zkwNKcO)4KtI`K1JBR_Z=Ar7LFpS0+PJP`S5L@y*>$+ERfM)GMO?=*^nv^rmfvd-++52wIz{RP?i!;xKy&)g)8JG|f|dT1t~Hit-{6 z=Vi5XIvM9vEh5S@W*j%+jD|0PkHHIVt?+U|)){kM2jtbp!mTl-M^mD_hws7hrZZRX zoksHBAkIi{!TTX4GwuJA@A2iEFU5~PYt~X1!G+hgH?R{MK^12)u6$7*B%b~YVtyZF z>daxyH!&eJ^B12M13c_juHez|*Qlgm(m;UP!TzS3M^(J4rul)F<{_EHN>oHs%a4HS{&@#Iu9|y#~#(?cl z#T7?*%){%vcgjOy6J9mZTZWdgLkWUVtEWAzO>KA%=-yxmpbr6^U>xWBvp z6edBVX@*{(C&Tniy*w&VS5uT_Z^h%hTACjjAh%kdTbJG&@~8FGokICm*1ddgr|e$( zGl8bobkecAZ-BJ9P`(SInr58rqhq`5q~y1Vi}CTcj{Wrptc{_4bsT>kh`AyACjAWS z>SjIOY-j^~SONnn|7Lyu|LVhV4A2|k`c%Iuj@FMhvIprMY~~R}92_61 z$2<6mE)S+RXwL|}bu3S(+)O_3!GHYt%a<)i>gKbGk$P8j%*K&=4_uCqL~p%8j#1_% z$CsDqgEsmu?~l^?3B>oK^j{(W;p(VPl)nk@=Y@~a8!O+V#b4Q*Q5Ih7r|dDhTlqoK zzcuz&%8$qyqc>7cLDysSR-xPv+;?p1rzN$mvA0!z^3(ndeGbG&E^^1}NvMj0K=Z*% zpx?R78H*8Bj@3ISpM^!&83QN-!~xIJz?=CE42i!eoNaeyaV4hdh|AZic$+z-lo6Miu<4cnAv0`u8(Q?k8!*+ z;=|D=x9hE-?Mt`o?YMZ`sroH(zk!sqStc8F;2i%`Q}v$O2h5(t?Rs?aG+oC1 z{@>({rs< z#QLm`=~!NVHgBb4mi(N-ietU-Sh3vO|ev|Ttq=|Rv-IYIK(|71MD1S+s6&sG7 z6~i8(oR`$-PQ96S0c_(abAA{C$2-v@e@lAjPW>U}A4$Vz;Cc~r`wYF6a!FFiOfdOZ zQs0^S?aF0IFXAfdQP~`P$}nTL-k)k_>v&njhbWn)pXbCN5or!j9e3;f1>P>7tH;x-)DWBmzgy1|;hfo; z1~v_GQ@6HgLhe=w?y>O5x(8EE1Rc6Z??mo&knO$)fvxLob;8)`;sdDCy#speyaIysFkr;05E(vW-mp^dEHdfymHH6T zlbSw=?(9YPKB$iqy?tGH>OpjLAG+|MK2P*D@*YC(VW;z}hxMhRKTTMrCyJYB(JD*< zH`9exkpI0^5PbmOj}`-I=xP`P4(+lrytf*h22-0gFzkdr5Zk^6hBt%}lkkSd>NT*; zq4YUJ!>HpU;5?j0KBCWdjDQPbPZdg;h2T^52!{7a>QabGN8!y7NIsg%3Ux1D*ERc~ za4lNg`DLhRZV_}cmNpjY1E~M~K%6f^EHaHJ;R+^O5QW81@f7;17;3tWo1G$Vr`rf! zGSvr7qdyp$PC1W)}MCUpx;wN!tjcy}PcQomOo` z;d|)NMzm`ljeSzzBIc9Wr0*2>QrRYiL-+B;Q(OX#Ebw6#1~C17T3JNNo6(ZR^x$T+ zYl)A!^C@&uzVCkFQy7f}boeRs>;07eG^m!+#-~wcnXjGOpVpn`hwUDqmd_w}c@TO9 zz5WcS@jaSnA?Aa$<5~EwhbU|dtZjdh-h`5#)A+;N8E17a%AF@)n9mDQ5?K+lFm=8a~>C{;hl-Ss=Xen@(I(%pEqoDnQbK26 zgj?Q>5A~qhrxuc0k8vka|#o-du~ zVj1+fm5H&9H6Am_z?U$VU-0Q|-Aj7DV_TiVa$bc4E*usTM}y1tVc1FBTn-1ZgATu} zx1;_qqly*$|_i^iAg_>Tb zp|9$M(|O#x#Rl~4-f|Vycms7A%mp7CIG$a{Sa0PvI+H13Nri@$s=6 zXI_Jiie1#_4Sg3rh$VKx-1qPWzXh@jGp^W6n|EVS;ddK=BjDgc2jE}Q9>~4lf*rF* zpN37Miaq*lI=GE}&t7PBdvZnp@S_gGY#S zYUu-84&=`EdwCuwgZ`1qVl;RAqg>-feikon)}Qu#uo z?%O0jHadkLxG~w6b!4f^5sezXqhGIlrO_|5LatMeYV^=MdQatRjXruukJFB!Di;;) zlIY9F@ub)NE)4KE<&9zKXNP1cCo~%T9@b9ZXf*3Rgo;&uxY`eY>xaMd!zcal_kQ>X zKm4N~KIMl``{AGb@Xs2ZcwfI&IRktw_P`GgLiCn2R+r)|OM^h^13gXoMWe+d@I9ZZ z4|KcoD@f;rG@^sgAd;)xga9<-L8o1*(I|9BXj^Y(GxX3M7*r;gTILe3^OE~Fjn;gq zch`P5)tq?@FWiR~*jbgV6suWFT0)69X>oAV%mPK7C{#gdb9A{XxB}@~1{G zE)I*MGY9n;cr}52EKbNA+Ha zp7V}kCGDiuM==Inl>9ZCT6Gl4#PhPxuDoGv0SepdH`nqa6)FW1g+2p+D%+ z2$~N&ZHZLV-QlFHDnzh}w5JNOc@kZ!g1=0r9D%PeCRKr5V=DRts>uIAPoUCjOl&yE z_lch9&A$f`onphfAprNk64kaQ@x30OoC>scSH2Bk zejvfCOJ1J0r5nG8uf}LI{itUv?R6U5T8UCR=+x+Y zZ1Lvyi@;gSckTG(ZMIDopMqQ+(YN~4uYp$ZcBh#?1KERC|E$jr%kY=a^j~|D>kM*xF)fZ`wt`Z#&mhF= z&E(Kebfhfa3=dmk$Lrh)XQA#sTmoO!Jqz#Im#N}u|5=R9er$9eqvkB!yw)G=@slhM z(hR;d`9EIqCfS~$|#*) zoNsH4<7WCg1mv6l!Z;tpZN!&G|AB#}oyWY4kLdh^Fd+XtmRGm<^e~QTQm6*mEyr71 z5!Av7);!ixikL{ZU4TL-(VhzkKC-FkZ|F6L%Kk>3xqqW;ZuOxMq5rK9r>vjQp4ZOv zTInau((nC)JBXHn5FJwWK!^@Wy5id)ra(y-F?mg=mKQNl@cG`0`j^_B5CPvE+=gw~ ztV{aB$hz+;K$EOE;1D^*@b2r-)}6RF!} z*i$Y&cp3HNaj8x%@3Qn<;A@3_z?(aIjx}$6vW*bn!($|_KVoYl?p}Y%HW>ju5WU1a z<5_HED6aWeDGsKAZ5U~rh7kXKY3tYWJ}bi@oiDKFQPC94O<9^PzvV(JOMjVGegPL* z^VkycE`n|wNQHmGQL~1Y&~Y6vZm$H=kq=_V6);9|Cn)Qva+1xoxt$2TZU-;`= zc8$EJ{CN*tBX5#FZ@D$k9COAon=MH=Rv?3AT1lG2_O9bWKll)R?y&80JnRQo(PJUD zrH<8paE;NlzHOVp$^zbf5#L`r;AG6w((e8D zVK9M5Idih(F@HHbiA0pE3AeqBb;hD-Xxs0@@U0M!Eei{drV*%f0}YC>@ux&K$NO04 zW0{c?3ERP^c%p6XDC-}LlVg##7)MDRYf~h5lx-ju9uuN$DOh+EMA>>^%~8RZXSn17 ztT|9^SFAaZhsmxTmiz8VTL(&tu{p&SqfLyhlY(_eZ4<~jKhBnhbq9(k(tB~XDOhr} ziMP$cDFw(ihu0SIXaU?Zw(H_-ZYpVk=dHO3wiZ}#fKj6HS_1kF3y!ZE+Ad?kVM(Xv24_u1cCSEaSrr4GW@hVH5f;GpW)~Fz@scj6F8=ITjJmwR`W}AwY28a`Besf!@whxM)Mw^=< zHm~^$4talbC~Q9+YL0i7+W@RET&)3pV1R{)Xo-B+zQa#qnHf&sWMfj!mL*IuuV~Z z)#;ZWw%bLGMRm14)vd~~Efc@h#hfVh4$kFdWMc6C?u(*I*mani%Wr~s>I`R{<4CD> zu^NeAyzGHWtM=iS9twNHA^l+%D((fV`m;`V2|oX`su#NNuVAjHdfCoVO&gmGWrbfr z02z&D9WWD~6n-Y;G)x(D#YO zcfj~D>m~V+ElecAmhpQgOx2RB=s`)p=yvRRU=RLg_{&xXcZ#5-eyFo|4mxxG7?^A- zZ61Ru5WlT927P*d3{=#XI*tWpJIWc0CZ*B(vCwR~A#SnZvHW$u&Tlae)8r{w1LgKY zLkfSuZ?$xw%w-tQrQ;Y^ZW5UmvhdZ_u6Z(z1G@muZ=Eax1nmZ zb2|*u@qjJS7!1LW4>?Cr;sE40HyV9JSS%!_^f4gdUHB1BZoH5N%?h(pXe+WgS<$UV|z8wa8E*d>`ru^?2N?jgxS`~ z;GXZhbq-+PuQi$x^#qa+F(<;PC!D1am>A*xhjF1WrU4;Nnc{SN?zdX!T`-1I<`e*O z1g)Fme91o2No{|rjhkrFoSXa~;H0n*)4*$hkIYH#4?SeMGb-#sMDQStvYw;y^wBds z#Nf8{43#bYpuWn0)nswHGsZIpDSfAX3SCNfz6HtYjVHmhK5P#ASaaAP@s{c{?AY1B zu!lW{DBc-vf*s>nws5Z}By|QLwX?}r%=YaOSNQ38K2wpNu=3sn5 zeo`}?f!Il@%5=8FPD=FifI@L578@((6*Fc5$Bgw~CYiEs4)bCzdweB(?p zEbmR{W_z#KeIu+)-KEYka@q{igKcK_LNe zdOxk?%YYNPftZhPVeppIqi;DIdsZNg?;Ki5Z@dLs`WBtx*t{CC*rUmFwyVDQkY(j( z@f(I8&l>(?OSms6JQs>OH|_XXk0nsA>Unl&-pXV==QG019!Hp zaUQTN3KzZaG)>1fDlFuMs8qqC{DCvW^&whRjW`rt03<8;znKf^N4GG%^X)~)XqTIPp(JXHc%4Rt88#4TTL3h!D+ZQ_~tQCdnDV= zA?ZY!O15^Yy#6Azdi>%(a`p(|+a@@OnL^7(=*5qm4P|)9t>K@1ZPk!WFW`XeK zjaYLFsA8i9WT?|OqUORHA=tXvMz!90IH_Kl--1C;y|pUlu@J__QO(FwFG@l)rH7KU&78fAUz z8)w9Q<~(J?o}AedBkprBKM<6yh81ph{!J-wI`!&H)f!qY+U#43sU1C57!`x~v99D_DzXI2?{WeiS^$h=?oWpJMJ(yB|cFvJq2}W0XQ~Ewk!;GJuDOU7^ zea;2e>p+*%j#AD$W32D|6U;9hLoYM-J43C&75kk-tk)8Ob?@L|0D!k5jfTHCA2KTq zqRazUsvz2b!1;yD5JW2uS_CwRx*c+^k|%S5(5gQ8)uzEGAb=mXx*tT74?Blj`BH6) z1ou63#}VgaGSH9mk2rf&AD-w8oUpLeLAK;TFv=&L^R41A7_#qCwBrw}KUng@lvWgV008j` z1e8ozIB3=>=Nv1)?KD>TBHI0{vj-)f21Z4dvnY6!8IRM@QWs(C9G0hm7;0z-SITK; zs+(DO#<|)mX7pLG@kP|{H?*ewtaG^)ocX77uJtM^t6#G#ou|ABs;Wc9Utk&-vJ4YO zykLoV@IGJ-r-S1Db`H8F3GN=PaCV^LzpLA1J6B!c%jcY{tZL%UTPW+GMdz&n^j6b= zl0ua(v@i&6yJG*TE-3w<>MXneagM#E+9*mr1_>l;KQJcc38-8*AF!sOgR(C;U$Sa# zaIw0GXD>RB%OaQ`>xo};^1Q&e2-?92VC13cx$F#*D8VUuQTk z-d7f@(S*y+9@c9iUXdc-5BSpLiq!^(CstQ_k^}2JE)IwNaB0J(u zT$}Q*fSX`ER2hz~NWba~y(J0uhq$~HhXq)b0o#gj;bcs8i~3N-Di}z(uRuZUub6aO zWk@%tzSpdAg0E+P#bkz6qrzV~V$x^@hsHr7%AJZy1r-WYlqt7`o__~0+$HL z1tMmWSbPh`To2%c$%Zk2F?76aAFH5xQ|3iy0xmqXDhZ*?ygI<>-<^FaQBy|AG6T6K zCNc+78(lG%qd+RU`HGdPkCpZfmsKAwO?4@M%FqB_Z`x5%UB#rT0o1LoRZIX=IdfnG zD8C#?(bcUm@?li;-aBbtaU?s#1w`0#tNsz&I>K0;^ zZ>QZM$~Y?&lQxR{Vc(;@ayR z&sJ#4nkqlq#gF)AvG_g8uBg`?@`gMXBkhSAz7bX*n>d9r80Ex~&=UM);QfHD+SUHg z5VLU+EUj&+bY+>SrP9H^&q)niDY*^yqulW*mw(K?^7&Ez<5Lf)q?Ph?i(inWT3EDr zfA%NK?DhfQI7)A=G`Al_$;Tb_<&mQ(@~o|cV=k?gNBm?!B;|ji2GW37B_1uwj8z)@ zAL15J=8`(n)l#g|rNv?2LahqDT8JaQanv*p)1(|hF_fADOfDaWTXu`zhEi^GoD$Wd z!Z)#15NqqgpBrz+kOn)I3ViPX1@40Cwua1g!40H?Un7e z7Qg%EwaR6gl*>Kt8%HJaO7|8ge1mEvKj|CC$y?J?4^ljqUnIXrW@r~p9BFzn}*xrhsdng#v&mGEAc}++yvK`X`b6>_a<}nFMMA%v6 z`z293=;9$F+CvEAX++m%2 z%j^Z*NVWkjV*e8W1HAQhY8z2qmGO2LPb>bD$0dy=cPZ^`_VZ5T>+Z@Q{_+N<>6AUr z(Kx5HzayveIcSJ_Dan4=N|U{i=k9TBaFCJGPf4`#UK*?1`9@|+iP5mbf0s~^=IV>Cw zMO9@T98XD^?((Mw_bPSm*P!ISSGmW2T|V2hlLCiPaIezW&wj&6mj^3v-n=h4#3;BA zt133=!iHidv0podJhR*|l^m*!VB4C@LzUlo|8AHqMXJAVm_i&5=ko|8>k;dkXBb4qa(l%0A zC2ImxhrNH=JW~18`xg+>g6(LmZoXHJ zQG&u;RufoY_0@v-Q^_U)Vf7$-*m@9}H6TUV=c!XOHF?5Zfkxj{9N(g)@fc7)nlM)B z<8t59Gq&o(uzJUE}*SioJqUF zuO`8Hd6F{7*3j5LNm*sLUCODz?M$(!V6KukMd{>ci!}B>sq}F`V;cRmG7gg{sXcbT zGIj+Z!PCkbJ0G3za>3dlw7r4WZhAurve{q6h4F7Hy~(`{Ncxg0zjN<%fjIs{V|7OSEulWz-*TBXFoGHdWEAXQtMz6ulpr;XF> zA-RLFEtB#NW@_mwWsMCxx)M-X?;<@il)R_3V=LpQdii~nqYTrHg4Ga&u;F`iJTh7W zm&@Z7cqmz;;Dj{nRNCfagYs+#cT1}LK)J~K!2mvcfAEh)voH@@^7612@>c9+p-Vq% zw?;$&8k5&5KifJOz1AtG7*sG4@&4v13y;|gx!gl4rpFHek_AD z!jET67fRZ!jPZ0uwC{q_jS4p_A^vwEIGn0}1zq52)}6}sLE_5$9X1i}J$%bikunNr z)MNw7cOx_{w~jj}D;8{15fD6y3y-9$Many#yKB?{_hws^KwD3;eXDeUYE4&izfflK zMso?^m-U5`7S_8)mOl9AHutSggHx8p%IltfRzfdZcMnw*D~-GLuaSQMzS)rBe*9pq zFL{E2HPYORZ?0nyC6$00C7V^@PBcuv5)gN6E_3*O40~9GYH+BQ{G~DvyU74etK6@Y z82eC#9y+hL%}I%YHOp53&@e6wlGYaB(!Q^hDEs|N^+jc&Fv3Mqu=HTEkhoRp8#baw zlSW!idVun`DhW6jhnm9anfn6t+-+b6Mw#Ck?OhHWkmFWhxxv;<-WW{lv~8GW577(T zK<&pcsKbroZ6KpC!#)4C@@H6Tjk+GT>KaSYM^H(|H&9kY?SN;KN6eCwcPLRfGMBzX z=?{C{q8&iY_KvEttfueHs?J-eQ1qHYiQqzc}ld)s#P^!I9m!N+)>x_D%tqEZrXzkrUei zN7{EPQNdGCnlE0b$=a&E0FYikt^`r?F3i(UcPc%@rqxI}ol~NH_tT|fB~tFAK112Z zc{1)&(p=9X+H1D$N4s|^3HImYsPc&prHOrp^^vk0QqoLXu^TgW7C#!3@|_Zc&1E#X z1Gbd$fR*ic7$)2=$g^ehcS?#q(*kPOJ)lU>Q}!NAyMpO9hv^h2(SgM?}*6h{qEc*4Iz!m569DpLSXAoqIpU?xMs-FOW&==}L z72g$$WO6kA75@YZzm%gMjC;eXhj&#N;oh{qy%b=X^$lS`wtBgoCh)Tb)X)1_i4R^; zqkxtCO;tMqp{qYDv7S6D9;zH!K|Xccr%Z&wEzf!vlVdMkTE&xS8H{g1LvZqAA_ykV z3c>r)eh4r)|HrIi@(5U+rA>wGv|~T|_a0U3SH{AD7#=v|u%r%--EBv{nZE#I)^L^t zY}(!|uiz=THZK1LWGOLFQR(_G%0t-3#e9V~)UFN(taT;zCE7uBo~akSP>q@owz^)(HUZQw#-5{z;1-OUL88yI$&j^BExk4GyU~`Re zDZ)3)l#H5NBs}G!_Js)%Nk5DE9p@jn_&Ho9|Er1csn1RP%4*`gqiEt*pC-D0MH9FA zG_mimXyVsCO@y^da)a$Pnz+NKiQn8DayF4QqK+w(>~Jly=yymqJ8Adt$_(2s9upiC zI1Y5*&EwD=`)p;$mATklyGasZQi*eaCxA_*j0w05`UIH0GKxNlVfvmQuxdVu=pQKi zB$&G&spuq_yS)lK(ywp-$$I{5J@=VUw&BHMBah5w{DF1vmzxU#oEU!yT7CKtCDe5Q zee&`omvIyy_ZybK?x#qKde9Wy3O<62+xHZx{~-$?Dpdsr1cn{10iPrI=HV;n-oaMr z288eeFFWxdQf7kF;IOf<;4Q> z`vqtfbp*q0^u0S;>(HT#N-IvGUQ+&o z-LC|L`?3;ReLaTTh`X%(><8mtaUD$hn^X}YCXzcGcK8b;1k8@FgEYregC*@V_j^uA-2pW8V7SQntOB3aTh87Xiy+U*hMEK z8)g?%@re5nz5omE)FEsbs0hbmV8Hqs^r?9c;l_KRLwtd~g>-*0247|V;z16qK&Hgn zf~{Q#))svPSI5wcUSh+r7StB;hyUJB#XEV;4x!4rc= zk;UwIqf8ORs-p=is;focn2#2kn24_mO*E#&bez&E{*8|vPR0rd-zKDxYFwf}xS{mN>tKKTvjD}2s3R`gt-X)J$$^b? zis9=k?+%z^_VtK0D7wlc68zr;E;@7ap8_xc46Krp0|fj0Ob-y+O_z z23~{98;BrLuR8i#1F=zrRDYVc<&H;<2OHv!VYUnzN@p61KJpblJt9S))KDb%l6CLt zH`dhhtO>hKT(A{a|2A=44(AK^jiZW4G2FhvFQ@Ij4QWJ_aEEb2h9MdA!2D#>3~A*- znNeZ}dVMWQjKw20T8x#wg$E)JKwcg#^aeb3{Kr`FuXjrQ9fT^Pkx0H(hfB{k5<5i% zn#ClifibYL=;4R6!P(73pj0cu7k-cfcdb*^Mm;3=vtYQJZzf{=4xv`ke&}}+GLa1x3=!v+@SkdLyheS{KHgDq>Nh9LK2%c+kB5)3C zYrJqdE-71=@?iZY`}S#zt?Mt*kKLcDA;{eB0Uv*Jp^p7HzF4-)6S6!hD+= zYn*8>a9RT3jTi0ye|sc#1SzbU0fFHZbBAEhMqHGqnjE7O3}hVVz5{)0Z#AO5Pv1IN zVXPMN_BY-NV>OXCtRsx$QN$fqlpH!l^E1H;<5}oU-pLAMeD{WR#z6pp=T0l?PM@eQ zRv7Dhy~(@M)gF}(}uD6~^2yNZ{fR7~%NRjI8})(uo0IK8C1cuTy6jI70g--G-R z(Cb7o6Y5uEcaqp{v-TXyMnltD&;x6fFiLu0q+PvGtCwuHHLmp(fvg<$^u|()C7`$H zAZHLZF7|7I2x-tqJl(YBnD#~)>^8cQ)c}TcJbl(jgjds%@suRbCiW3KT6nWJMKX*2 zm}@TPq!-uCA}aby3S&E}HK*8qa*7YW2MCtcPXx)O+dCb(+l)$Pwz9WmTg&>1IcPF+ z^ueR>s1})%2O*&N9?=@#w(B?=F~9|js-XTNl+#^=Eo0CA;+fz+=uZ+#b5qh<;1>K;~#+tuQgnwDZJu<*hKFvGgPj|o9B|ZBrlr^ zjJ$UCv6nrxEcmK8Lva-S+Gk) zk-H2>2@6JwtJpJG_W+oKhWDZW)eS(Sp2F{q>#^-B@qcs!aSa8;#GEoLd*J`$~ryj0N><4J?R z2lIJ#tk~*d81clcZXT6A0xWI_&&A?FDu0Z3I}g@@2>&Sf$Xb;2m>Kyfrd##btjEOD zw{f7zTqabV5nM&}5tvunlP0pK5*oh&{o&x4RZvtkr^ddR#>OtJiN*(c|JJSv`!hCWGGHL!&2xnZ5^^Z4`Y4jMv(UU@ZidO%xq& zlRtQpxBy_dCW{c{Z8}*bpa-KTi??o**7byF&ck@e6XL1cL>E0FHlnEXDI(JBNcim% zO%cnGXk?n`a+_Gx5JH>Nz@IgwOaCLusB|$t^61W1G-dEq5Fj28 zFYCe8yhyXAigy3sw}M>LAWvA>uJ1y@X-*bD};f zGTwYn)V2Zt@@Ie&n7AAFzB?qR_)~1^%n&K!e&jW~nlw`qfzdO?(~y7n&J+u5VBb?` zW2A-~i)IUWR+g2*f80c9Ym4WISTUkH_oX=^Qj$&BZ%BTJ7hNtG6g5NqfRb#PAOQDJ zw@k4o_&icEiH^pPhhFv!2g8uCA)S9-96|b$d04|M=R(?)@29LFW5){uK1{tP``%US z07buq_Tvo7G!J%w{(-tTGo&A6?@~Ha(Cqtyno-nz5hZUK;|Onaxm<6; z2Wa$sk>Gg{o#bkGSa~TPWv;siA8_eX9XQ(5l%%}qQG}Nm3c5C5L`nkXRUB~EhfHNt z;>!@hVX*nK2nk>^>YHSYpq0^e8+K;NG6gmBYQ}K%U6LeRedsh7or<*le3)C;4vr%| zuVCaFQnyz`V}LI86&A{jvR8!W=X2i$9LT&XSP3@xRS2QA=u)=mPUl|53iPH?wOGI- z#hWxe8_!w>qTtlwO|s>P92d`7{^OQ3r2HJwxEC{Q?eNKC%CkU5A(?j_^)AV`WJSDp zNi&NAeST0bS@80M+ZwQgSNOUx?(g~$hP~5=4NcxdPX^Zh_ zlNYPJDgy6T$OPXw+PxG!;|3Z$G7x7ud*EDmWe9feN4+6BHSitP?f?ceSj_x#C*>>} zgp9T~#aQt;isaClH2F66e{H^a-F)8z4D+mlM&~e1SOv73%wWX^-&|-fQ`S2iM)4{!!j9Om z_au?&_@3Ax7gr$O!GJ(ia}5zP1lrUGaTYOlHI#M0-qqr1i*K_%8Qdp#4VbDoslgh| zEiWEHK9atzofYOJf;pSj8>m@z_FdCBWLkw3#>i3~!L|!nzcAJmjwPKEx zVQ}!SNDpC2U@iI)Plwima58EqQqnS47~Ru1;7*EtUe$Ao0i(nR1w2!{;cMiZ8vnH})y=W}uoJ3@3h99ej_|IDyqajZx`Auy$ zK%o*(vo?SYh^G}Bq|~!*gKTEi25}+yFp@GfScdeH4JpEa-z@~-{>2y6GQitG%_*7D zosj5Un?NigjkrzXxE-NkhUhM#kE3DF^3FwT>}W1D#4bh@#=uFRig|di`cyJ?>7R)% zZPFO-Xh1Lg#^c9r_ni&i1@nFmr&&Ad!DQ<*F{w@Z|KItHy#I) zaFhvj6-HGNI4TCQrHbweohutK6@wRr?^=S~1oKjC!xRH9f_4{!dD=)5N}!$ENM$9E zm#4|0GK#+h#Xy0mgY1&w4}t?&+{v7>LFhTjE1|YJkFC%0^Hg{LX*6mL=N7Vdv7 zG1%_kjX{JY+8%psyLJOAFVY*|0rdq{d?$6j(R%a7w7FC$h`gDjaZcs0*y%k4%|3@+FIi0T_UQ}P^MNF9QqHS1vl?#a?sTu#C%_AZuyVk#4)u? z_FC*DL|QouxkU}(Pg0zMbW~LbvRUO%&`(SCb2yFo8Q6RI5Js5)g~9qdKyN1J!fn3$LEXu310dKwT_6ag4kP0b2o($`3J;4tuDKX^ZvRZI zV>VdTVh1wsh}c}s`EVR_E4b3))8G()mX!UdFcAl!mX`~+i@$kkWu9OjeO3-3#mh6@ z%!#8KIEGOn(r!^8yg-X8Kvl5Q;E#Ed;fD?Qm#Crw^k%+<4V9j+2W=^!L|u=HD47?v z$kyU^prfL>>lM^qjnSr5yy>V&wl5I0Wp`kGsdQk*uZNZGMT+}X9G44!Q)+Nb46ngq zWFEshz+HmR90ht4_irM_BtpFQzx*3`RzJh`J8uWgp>@ZhbDTq|3&SF*(+QC*SpkI# zn`hfbb=&tVA@ioOaqq2MGqp@r2e7yLQ=0cx?RX27em=hB36F~$7> zsAO@H=0?UJVj8b;=TD2pc)&U?gqEKHW&$zKK+evl%(DPl+EE<#8+8`puW`Us{~UA+ z&R~9l1*ZNdWYyQrbjg20Gq;3x|A`%vT#By5EG09h^eA?3(<-5lTFL#q8JyKaRK$UGsp2vyJ*?2Kh>*_TUoxA@U21MMkqKmLg!3Hrb}_2P zH!hvJBAPo+U&Pp@G!a2ma0S@8kq%t}D$XF!RS_7LibyUu(5IXc2!jcKFYGT5y^2wK zi6&nak&P4t`$F)>g-_>@h00(4GZBHaX6HdfW?mCP(U1Le>p&*r+jk(_Q{gqy-@obk8#l&N_6EO@ zrlENCP2tA3FC34bLy0*h6o?5v7z#}oD^0jA8vEaka6Kn~c3`*P|2CnBfz*c(QoxRUogBN>cw>NUr8YU&1W9AreJPr2G>urzhc+X$ALOQX=cS4QtcKCKv1ylxMO=?6%;G3sTW7wN3fgVqdXt5+o4fkBHy0yN4 zmP}T|!~UodT7hpl%jCEa?5y2lmlX!a9b@Gwu93x9Ql*B&x2wyBM;mH^M}r%cW-$ZM zDlTpmehgE_@ZC7uhm=bw+olF$a`2;mC^9fL;KVHTdlO&$ldf;Jg*g61=a-ZO1bWuu z%@<+k(KVFj8C@fI0JX5Ik??EQ&#tz^YX7WV4fh{$7D$^@u>hOa;{p}Fy1Z5teTH<7 zpU!|dA z_X+#RWoamCIYQs1g6lAGf9-h3_2q&>$M% zP~E+z{CwjEs;O?*jgw|-ZyPvn3(|1u{PzdqnV@?6&*RsN@*Qf3=g^5;E7}O>vg*V( zwe|yA2X5T>5x@2aZ`_!RU&f&uH+mnwaU&1E*dsS?titawez=atA1H7)P4`!OvX?U;FH1P1sgZ@bDHH; z`-gq@n;FH`&cM%GEl!y@fsk-lrKo|ShkiBtHOorD1*}FG{4)E&Y3|CF0x;X=69!}#`HhQG$Q zFL>7D+jm)h9pBtHmVCTrJZpum#j^ULP@7_}vrMSX;R@}NP`f16N3<`5FJtI^zX#)+ zp~=O5VHL}W7Km`k6&ur4b*!IlrLo_oPGSA$;CL|9qw1;!c(2OF0$rTMyES%53$5Mi zBT$KCyVVeX>x@X%prG)aG+6B9g+b|28mtbrN$$8F>X7AAT!{K0962otQM==g4VYL- zcmJ?KjSK3V8(4WaQ3T!@*4mQh2&|dZf6VG2o)#3eJ{C+0Y8Aq#xyBX9cAAn zsO^)r>rr{6Isn&dw24v){(a&at08nSN^LC-Omr$)R3{uKEnq9$I$CXQHy{!$4}fd- zXh7>QWj0cATS&AT568E0jZ`)vLC_4C(q3z%b^zOh;s(KNHnXuh1XpX|3;r`2s|wCW zw`rwZ6!BC4Hc|qVBTp9r^f|IP1L?n!=oRN1e>T`;rtev`osCHH*c)% zOZuiMYWT_wDt!-X!^CE4A`E3So2g@99$V2&-Dv+>&=V!->e}XL>2|7U4uI~UVKM6G zwr>ni3l&W29%0*1iy6@Y_XetTTQRoNaK{l%6T0~o@# zM(UZZ(9k{n4q&uWJHZAPnShDya8(rUi%NqbEF#Ci5H_w2hV%!sPX%oN!ykFna64IB zwI>CI<5q}rzUk|kw(2DKw?!ttuLol7Z2XIAr^eWRt}c40Z66ochZ2zuma?+Sh*+Tc zFES(L6~bfx0rR~)10FadlIq3KfH*bA{~+cWHiyrlkqhJ0weWQ7?Oq0k5F;5vC)%S4 zN4QjIU*@9vVgvTv867}^%FWP%4rot>H9j5GSXjoQJ&}|ckAD4HU7`iBQ4gYX&&-3n z_hV+VlUy=4KX4VOA0(|O~;jm=X z9csM&q=n6s?oiL!|FAxuNl?4mPYHUclZp#t6Vy)j)7D2sC)^=&Mt(eCJIja}NV__z zZu_5t4tG+YvsVgwptIW0UM1+c&T2C%Z;s|W?t~-Dt)10a``?28>8##wKPTwkJJpBb zwpJFg^-k68{||tRQ>S;L$iyx{mC8HSPW~5e2^?U*2-B=C>OJ;Lf_~|u@_w)^;6xYn zFr}*s<4-}4byc4bSCNr9A6&%J4JB4~RY%yb3A(47+RXnt;_6aaKZMWkhTh!}^kp~o zHHcFAcVh@A-G!N8qjh(wxb&(W+OKp6F8a~4-9d94%c9H36bsYqGV=H*Zr zCJw}~`gA&Nf9*PS*O#?x zCf4VJ6ZeAL#!#C<=pYV14nkEe>9av-TPy0743fR}E{s%0G74$Kt;CK07K0O<9m_a8u9A6hg@ZJfId8$1P1 z;ohY30=Tm-z6XRj`9Y8?>$)er^dKdTMSpOy-B|StoZHKM40AH^F$`heBWT4#91v+7djwM+2lu?O zi8!~1_a1NpiwBPMJcfDou!-6i-wk9vE1Er)ipF7F9wFCwRPiV+8ILL+GgGAmz-dU@ z1S~}3tbheN083BSe? zF^!_9pc~UUJVc(9+n%PXselAuBZafx(P@~7&r(tvIIri-uNmgoO!EuwTRCpF z`8CJ<$}qn&&9CRpues*eJoD=X{%S?V%W?cK?@5V!sJ9g~EO=P=M$K1m-W!D@ag#Y7 zu2=c7z@Hm0G%`P0={{~Qo?Xj-f*q_7Jz9itDW|5NG@cH8U5`DfHU?5$zjb0CCdw3&hI zpc<)Pf()hMA|lG032ca`YcoNFuwl~|D$;4QFgDnkI11ytyjkjI+#E4_HYBBZD)Q(d z#=_Z{DlXn_<5esgKP(b+AdkTovD&B)F5c#-odl=i{d}A(?+@x9n*pfB)96gDJp=L; z$3ux;ZN*s`hr=vzG}DMi$x_ zkIYOpLB^t(&e)7D%~Ur_1J_%sp%u>qNuDSn3wSs_Od!AfWd^k)f?sTlJUyR>Whf>yrPbiP)$NKj}3R* zwC`B-3MeB+`W38SF#KJBnI~xQ0-&3qMGMs75^6~l2girG3+399v`{9ETdYRr;QTu+ zT!@j6q$Ht-zHqOcChIZvk!s6+K z_sV<-+wpWhU+pfb1Op3BEqbt3?%UiiWAfW-g3ao0)$2HJuz8hw6=3@89rYy!Q_^Y+ zQ((m~6Ltn!tHB(_(>JTtzwxM=8~`KS5!f{;UnA+mnKf#ESz1_5#m}hZef1q{))~qN zYN8+V^jjyp@aQ^-+k)Dx2kBgCTwAZgtU(yjh3X*QmB*N`3T}(m^0q0H0-j;!yl=6I z^BcW3seNiA=c50pJ8iaQoFl|Y+pOYz8lwrT*m!30)6D1Dg0&OJf3`>>8kgycG|p{N zCvlTNs0ZOu_@#{U4Aro{f2qP>&Pp1%6`D>aAu9IT0MV#nb_LCTc`Ih4oMz!XH-A%G zeX>nWv)kGl>D$#+juzFsyQp5nuZPtP-*CAzO!?b_V4=PX^P#10$Q!e^6PxG57+cAv`NCs$IB*1~(*S>2<@Rz5hn8Y;06W zyuXVE&aE4=BvI=myLlICVXGIem8sNnlU|g+69_+>JKf61TeUQ4krWBp|=ymKXZfX@B~8eTfzq0^`Y9NbQx4`p9$87w1~!{Y!I`)kZX+>&`QwvX2Y zy5Kyew$>GqlWS{J@u;Y+CA8of$0NxjTD?O1gfTXoc#!1O0s+}!PA$?V4=ymua5k2i zWfEkAj^$;LqC7>5v9AEHcQ~+~QLbnQd9D`e8mPSSo3168Go1(XmI5fQj`lf{oT;N} z3|mhia8`F~;MZ}&(xZKdhb=&R3y=H&29kjki~adCRAbUo#1DM#50iiotB=pi@cL30 zj-Bdjr5qI&p@DiC6%kq_&mUW)w)p>?5UtTr{xbnl6e;W4ABpy$q!*&K?c%>suGCiA zSE!_EYb^&4F9EBAqac-vpJH5Xt?jc(^4=AtH>2!dvG!NC)uu^=>`EnV?SV`3po+|B zr!D2S$7%+8Sr)4`HX-O8xtlDPXs-=HlF{w8#oWEZt93$h+^^#}e@87!;+>oRg?EEH zGPDd(h#3qa$>cUkkccObt&B?0vJlQ|RBk63j3o--rZ%0-es$8CO8~G9VI%x()v&_( z73=|a)|dlr&=~^{1nR5}_hSMWp$++@n>Nkw{{(+5isL^M{P~Fz{6&cXEx@07x3)n0 zFW`^9S381=y>QRO(ZQ%pr^DzvNaGW_)NhEkL4vvt<*)Pry9q1EDLl+(57TyFiKzHq z3o$B(Y4hNiiajoY&#Hv=j5}3>fk7_J8`q4~=3)70^MJNMI&b3irK7YMN6qwkNL84s zO@RiVq94VKhNZzAR}d|l5~ks*F1TvQ+6ptUf=|JpRknitSF9hnFL^szX&hhUG#G4( zblJA%QEefb$zqBz;4uwc4Q|I~cBXus7G;YxY~!^lPQW;QinbGq{BCL51|-jKr#FTI z-;=H#hw>iFF6_iE)zOWpC$$v0+Dz4^Fj%Ud*4km9qMy-**rDE+TwJUMRw3&-trI$h z(s64gT$LH;p3@5c@A2btyU7KV&6eYLX13O!&Erx#gI)~C)Hb1F+w+n_w0K^tTN`@` zo#$)I5Gt3r6Z7Q^$b1<%8gE>CS?j|%)N2u-xY9^pq!~;Fdx{eHKF-$XeWS6>2GR=9Zo|`&}@glvA!!nF_DAWrJTG%NLMAeJ8bPriO`>| z)W#yN!CP7nJW}7%265SMfj<6A)Wa2Rc^Y%Zae0^om#D<%2dmsXZ7XNwQ5==8y~7pR zR!K_VW)+AE(`IR(Ot!P|TIgO4O-ATDS`d=8c}K%?NAJF)nJh2#MNdJRJNS+^ULtfC z=oo>iqu$lruJ<4U^AMOWoeYqd5Wc_6*u zC~P-~8}2m{1l`t12tks8k>DDn5yt*C+G3kO8)D*kaaSyI^FGklA}>fz7qbYgl-r?9 zod2OomN@U)548b^L^)8I`e}^0!E0sF9oI4u6=fKA?z0>Vfp>CzyLUX>LeZgA(JK zJOh&()m-}&OvH=0J3^almq4y3MFykva|{~d4{bKPP^7KGSDP(bh{PD)F@y)O({@Hf zoDc-P+5)10>A!`iHI;3VFvS;m;xDwqAA!oe4~WPG&;K##QlAs zP&mqE;yxZfMknyl0;7<)4I?G!%ru9~$}F zv1Fs)o^JrCwUqh2HU^{$!#~VC9cm z6vaLO?k8mzDu|@?y`Usn{Jx$G$7bkiKiw$ZrNuH?w(UW;TGEYgmTy{zuhmz$Q_>nnF*}Et` za~f+}yis^sTkOY5>q-!dwv;^w2CZq8+R)&QKz%P?^KaCL55r1rlwEAHXsmViU{sqB zH(h)Ig7r#z;ctylaf5T9*dOx*!9sEwnue3Yf$eAhCbo*q$(sy7{ZfZz!!zf!1W651 zTzkJrIL-ife_T_HQRgv}SrGh3j=+k4fP*V3=`KB-;HL{$rH|AVxO$Q+cFM{yH^tr; z3a@qRVJ7`4Mb}4FYzj@!T##g6GJ4A|NYaL(#isKG&8s@ht_OXj`=UuzFG`Am!^Im> zTiH5{V(2ApIXZ=9u{o7)0*6|DNfuePnUg2>s4D}N>F`Z0Se5k%s$YHt5|z+gU&Urx&P-VQl)$k z$Z6s=tPd+`@HNTsfcnkBE<89RCfl;R#nZ}`b zp~=6YjgxWya&~3a2?$-%RX>4T9`uw(wSX*^Xp_t&0^q2=3devmY&t7wR@n5Z%z+@H z6_b>i0hpdbcjKK^gf!Ekvot1QSnfbL-W__57sQnsPKo9D>+?B$1Nzprww{6aqS`u> zar6y${JsU7J1Uev+wByx`q zs(RlVfy;fmoQE>9by-xAuJepVt0SqWOI9+$rSnK;yYwDXrReP=8|v`d#9A^_N~m(_ zOfzw(u4bO3Zc5R0^{KLE_|Nc%9xW;qOiIBc7{Qd4z~JJ#`j2SH61Tn@k8U1)4r+o% z-@uot-!~QopiqRa3)F8Q6l^D)E(Pg%eCa{3Y_p_3dBHlEB_p^V1{29xTTPoo^a!bq zYC!qZ?X0QiB^k+wP;FjyUN-J9#^IvJ@I2gEXUV~Yh|_z#o%Je$G{q%Zmqv=mb(+? zF(3>GZwn~HGN!FQgs+6U1`>C=tsaApgFuAmJ_OZEr*`^yqljCu4Yo#$dUWWq=$#~248E3?3ZAU!_K_wmaDR{))A(7SO z!0*tR*_T}Ujyv?$k`kj~wR%wM3$S=k4se)jf|3*68bl~TPQ=s%NrbW!fE8d+5@ge` zLxes5PWn&;;T_CvCw&CoJ)JF*B)7UyGz&GnqT`fLXMJv)+iec8(Wp!Uz_9Gd@G@t% z?M|Jg!WDPQgK!_;3G{o&|vB(tHmAh)BcGVZ#gjBwwDLp9Z>tLLSxJ!=*Hemto zk7aw&U4RCTYu%;Ks6PM4ZRW#%BB$(uz#7L!p6xDy2*DA&YIi-aTFc33Z|az{t3m>0 zyPA=0CH6FyCtB1K_xUb|i{vETVMSN$2*zGZk{&MykS*z>DSa`JwDMj!@61S&eJMW+UeDNm zQ)e9AL+>No)rveHVwWnThkg(+9NiNX3ngUs()-xs6{_>08|HYuEYLTj!Owv#NA%Vo z;WWLOfKz^N{VVfH1nR4EMg3ZBA-+S>lQ zsS#!ych(34tE5JFrz{-$I&hIu1N2ESor{hHCl>W3oVjlrpr_Hrbm)jGBN3lC5b;KYn%)UngepJo7 zO%g}z${a3{VaSM9GvVIrciZJk438~1uVJ_+fWrgTe&cc7@8*Rthg9ReiFz}wy70r*g;&If1sau4 z>3NPYFZhpmBfTv(xx?}e=+}-Jl56ZY6U+cOrvyFFcxI-)l&kd2)~EQ1a%5&|TS{f) zamw5cf=_ER^}hBBm7WL-XiEhKu0%KrtCNXvMm_3z@HVxKvgdgfuSJLE>L1#Fwc^&! z(_{RPp*Woe+dU!n-vA(+r;+#_K@7kFl-?HvDeod|e)7iSKC@bbZC-{+di4d=^#>=TvV}O|p7IYmh_WCQJzyGkE z40N=w=%MxtDz&YI!_$Zb`Y8KFm0tb1PBY3|0OYu2#f%tl52e!!^mzMa48#a{wJY5V z&LDB2-qn6Z4oxG>*^@3ctqjYm^}T3 ztG8a&d%%(sk4SPX#&U~mNY~Am5v_t1azQ-!G7$C%&%tP_crjQTxUk`b za7Yd7wO{0=9=0qn6gXD35ahIAr-G|ovp^ZWj4%#3=XO#YK@#rYCYDUx(6j^*Oj^#rP{%e~w9mT&;I(VG(hu9wS#y&dS9Az!ss{y;T3fCTAAk*c45R zmV@s9_@FIQ>H(@H%WuuO_!o)ZwJ*DTX}y6U17uHV$sdY*M-dp;W~w20+;vaIFb z@^j{LDe-k)p?~4o$czvExE(xZZW1f?K4|aYmEcXF+u=>XtY-BbIh$L*g*q7kVp9 z)8E%yNrA(%%~FibA3})1^&#osgKJ(VnPjP<+q6y};Ll_Y?q&Da!-BkC-vkisT@R!R zq7s80l+MA*K4OC&BZ8}&S=bVu9hPs9@_>&GhS8uv$6iXk>U3=i!NuS#WTAdUa%|qF znxIMg2!uA0M&schil`V$PsM7G^${3)5KQ>AoGZdO938Y#`W7qW#M1CIJ*U~)J;`>{Tk(dYWd`YSxH4$P#yPatDKME*n{iwBIGBIywWEKV(Y z-;lx|jGAx`Ty8HLRfay!Zi_HR{zw0Un-aEJhlwx7*+H4d>%zADmmoJ~eGc-UVn8T% zAN6vP2}R9s$UG0{${7>_o(x9DyO^1hV*8)#hO7QOH7=LW6V zqE8Iq(P3$ThnV5!offfQp!McyxD z^P-ijfi)cF*q;1KE~3DGAk|hq<2F;EaH~GW)eyNjhh!C*Uy`7y2YTiRp;6oPa#Y&w zYyD{vWhGomMPKXvn?~c)JLx#TuL$f_ApM^x}Vc)`0!ew|WoLVT6NH--ZaC{FOhr*xe9kY8k_JL-zqA@2Z7N8Tby3 z%J1}^q6w;EU2Fg)4Gn^^`5rw>iUG_a@;GwUz$PCtz*Z_rP`^?JoAGEVq)uB?BfE^{ z(`M#G%$Na{L&gA{w8*;PhYi*5^-b2LRt;Bg`a!qDlsxVyEGa+kg~T1h@6BOFjya4= z9b%!s$@ob>ZEH#SKclH>O`!YE`WZvsiUa!FTGN@IF<0A=XP>@6vcv%}oY9~5GvBGf zK^-0_Y1Tn~xM*kft`U6X!iJ^tAP_Outf-VPjmql>>RErcnA}2r0D; zxZc~z)N6D(dKkxWgMY^&z%Ama?lwLx2c2cPuma*99QygjuDyk{qX`y)J#VaM7)LY;>30=xZ36w zUNpyHKR4=kJq;%C*}v-(|Id7IH|m=Yu9=SO@7&TvFH>0P07h3T+l3Ue4do|HG4upL*UenLPRQlDFgB^~~=$i?B4dNcc7 z8m-)o>kM##g6`=KI5C668&wRdMC$g3-X$yv!OY+C0?7cl8{Zt=!^r*vgwUS>6a$aC zo(g%71B?Yb2@0279SIt6onp*{3iep#CGr09%K>R)?1BNSuz+FRggQlhbrJE`Q4JV_p zy}0}@9XrkND0xo*+18gb=d%KB7f#s~C)gbx51`EI85a2%O8v|P@HZce!z%gbp$hZR z{`2~FV1NEUn8+*X4?H6{_ zHp1af@i*9_SRNUS8?xK`$vJl!3m2AvZ!ha@(IKpSt#FI2Tv=#g!BF-b)^3?oK! zZo7#kH5VC48&g2-W9!2Y#o8-Sz)SLvTSuts97tFqJRj9hqcUwsJ8 z?*NxprPuUFeDc$P>(HV~ML)EK*MY^>`_k)rliP3&`AuO9*7a*FYp1X4^Zok+B!QIu z7?v||pmAauv{Yz`)w=-uI6;56j%0ojzyIIdkUBIj5ScByE=V zva24$#*q1{^8#r`v#hq#jM8jk^Xg0eazE>#Ls$`8kNmzt@A0vltA z8*Z40oNSIIo) zWq&msH*H`(x1HS0_`+%iY@K6&6rgS*7{3yr4hW@APHsw6uSYeLo5 z6uuFvzS4;2qcY^ox%0x*9^SYrv@a6PA1N+Js(rA-0_rh+pp7>7g=HUtV!)Ln$i|2O zU!O6^A1o9jl$wJpL)csbCr7I;IQYUA5%+Yzz>c^o4cRiH)hDGXOcF-MiP-Nn z_{Uia8W$3yvOwZXn&1P$emx^4dc^=#VXikGZX9wda8R1_CA43PYJZ;J_NZw#7C2>fOmMTFFT&-m%$ zGL<#M%zcYU?SLgQvwk9cahC}Ng46Gy_T;ls2mzt3>N!DFc2wIGlzoWZK}R*jhYAK8 zz5*&o`5o01KIh-kj|!ZNXcANs7fGC=Y?G*tGGOm;32gl2bW$S%Z~fOq#e~h~iP}z> zmHB3{zzl9PgB%L1>*{4EaUE)*Nw&*6s}Zm^Kp92IFRlQ=YJEd+SBij7WOPx}aA9g~ z7qtg1zN1~#0g_e6O}DopL`vzZhEV*FuIftVZc*7)orXD1?WX?Fi4Fo1(FIzbWAV^F zzZ0H&(0cqc!3BLJrih?Ut|j-F?yBykF7iwx7WP!*r8L4bsm-;y3aSs{jIpPBT$(TS zMoBby^)-l>djYJZqL|<*82%!7eGxUi&}Xx34s-y(q^OTd z<`z%)Q6HnlPf;t<)H~~K7Te-vnFKeSRgmPAUa&lV^(cs4TDm$ExNdd2>hD#brD0u_ z_Ej6~CX)o!Tsz(Rsb4Ae$!!t@!)pW70<#e?Oh?VT4P|E!MA?YFYcSC6R`(x+)i$IV z0neNA7En)-R)V#f-ya@8bKb>1pe(tmZ^6(`zGCxm6?+&_Ib8h#*~>?$!Qk*?*LjD# ze;%REpmCUxsXmV2+f4N@Bs@P-9R=LqZ4`*g4MH6a5^#f9Jz5M+31# z&1#H#2ij3Q27STN?pSpo2D)@2$0W_e7*&mx^L>rNywb$EKZ~kg_!W% zICZyVwu!D0WY~*=7VBb6EDhFHv3EQ$Mz@nBC6+M?5|E&yM|H@LQ;)#ATHHRlQlynJDY1~sPQtZ3o^0Laf02V zc17z3-=aQ5U~>zWOqAd=Re$Gw^^?(dCJ4n6Yr{HIovjkSqqRtLwv@!8@F?^EJPC&3 z-JHMJSzxHp-b>i$WX*!_oMl#NDJGJtB5uRwq>|$XA0Yr1cl&_duC9W&otxZ!H3@g8n5OxZOlU-0ME|F`tJUCldL0 z>n`{2_o==LF3c)Rfp8urF^H5fFi}$sg`-tV)%Cp|Lq7bwp#>fi$q+SK^)GR&|0Qk> zENKJ7JTCGOG!hpPgy)OWe~VuG@6k`-wkvR#)NS{doRNB#Shtww|mBvo%HYhvhKCA{b zlKj|}cN8x?td65BUXQ37Dct%9oLwON@e%bTg-0J%uOW0FeGJQzBEnXyPbkR+)f+&9 zR)Yz)4+VvovPS)0S??bFxEf84vGaa{h-1l1VA}1M%`dAn0+kJJ+_22deG^ zdd3d}-+^&Bth&h$gU?aW#xnx1ZQ#Vtw+YPXcr_ts#joRI`YLG8p8A*o8MX#0v9&lO zil-Pb9*_u|p_?n!L_cS}98)M~;OS^~5J7D6{q(wVk-=@q5KL6z@iS5AtH&_FHuqI_5t8z1qe0I+huPy+cKyGh}?-N&Ong;jU>?f8z=?s%OOxxgITg)iIhN5p3PeS`B zYk-!8ZBh9Etp`T$?*ZDaf#jxyz@HdPDwep9AhC3y7VTB*5L*XoTVdj+_Ej7kWDL@d zS%y`sqe1j*hCqTnbg*`(L1oawAi7CZ0Qa9i8LSO&VY@(Sh&P#6+QAaape|&J{zJ4j z^+gayv5L5Vi1wUSUv~c{;dIRp3{Mblz+~K{%~nRb_uiyMdrQ|WRJp19bbh$j!?_iu z&}*=0H9{L9M{X!ysk%*60sc%TYwZZIGByBj!>2UzQtx(UXwZu&0_Ua?i^zY%fl5)P z_HI+3eW1cHk#Yp+zGxsW9#l-kJ}Q5L*7G0OrPzIXg4S12o^r=d(mr-LDJO;rnml=l zu(xoF7U53G(h|L7k^WRy*^jl#o;Z|*i%mH2n%~6(PiNv(U z8F&6+`cDU2S#uC-?mg#eSAFQ5PZ7nfAjr#@uZ=gG>+62`Hb9VUDU8JAXb0p^7@AqA zy(E9S+}XElcX-R+%|u?27G1ara-~b3G))p^>$Dhgshs&1Zo<0E+Mq%3cDL3~rd36{ zmk-wW-P&#+8Q~D?mT2)%cpAR$lR|?;(L-8KtN7}Nv`^(vF3{uzch$pMiI+;VMP#He zo&=G8sfoY4( z)d<*z6Dh@ju96RYBgFWZH73`mrB(=v1najPm7DG=8hw=M`<25@_3wCT9lpXY$|&Uj?LYbzgo}YpVF%i-voN;vP*v zeMb^)*`tk?++l#oTMa?Zl0DiWY}s&)9U2;Yv;etpBMEi9sQ$yBoB;6Gv|yQ|-X=x* zYuYG$SofN?30YI!+O2ro;zq5n()xZC6z8tjwRQ@`X3y>g0^jW??ta=gnGU#q-K#|* zI`9qctZ8T)`~p;C-iIP<%$wSHl(YCvOf>rWCRR2E;Z4oYyA|yvN$ePh#}*1w9I0a1 zaWo@)MC1X@^iGK#brEz4N(SJ%UeN*Vb%#_LlTtDyq=CBEJ?CBRtQRgLpv};4`9Nc+ zaOnryS+ZK5eUR!GTMlYJ$Qf3UgQ{@Te8KGBAF`3kK@F$-%%|Bw)nD-VvgP+l20`Ur)5twPdjoN!H>)%J@zifV)M=>rswIyqV`iP`Uya^TCmJQG?4fs z%5ua!PtG}}jSoGF;wbK8E380B6SZDcAJcjmR9g^U?W~o4V)#-=Q0VpXpIF&Hr4z?d zsJIjdkFw$rkKD)1ifca8G9sx2Voq#++kU6Ud`7U;Mif;L0gS~t!30tKxm8}YM|m() zND|tTE$|^$)EUC)FHA{e{sAD#q%Sb^cZ1YHEC#6PK;XD535+poN9r^O#qfeQFij*mEDxY(( zDI}pMG)LHJYeeFak^YE=P$6ePnonpgonPTQ{t=(_B^;2JjRV_S(?xLv+W3cXFA*Qg zRONy1%iIAWvTsr1#0iN*hMm+B3Q88Z%xg|j0`DZu*>X~wC9y3ExM8-4y@0_@`BEFi zCCWw|HH`*ICWTs5Hjrf12|tIs0? z@G!9imaHK8SzV=()HAkPBVlA|wKiQkg;7QM*IFE|?m$y#Tk@ib(_(c5y|C^7$>Mn2vkUd3gULRkA*FUrqp zBD4t2r0FAgBM!@+R&)O@3(P<2BJHrI21&}QPiu<{3DK`xmXHFqX7(98V1z$n4sxi9zrglTH6fz zm-N~-4KnyE=qUjS7pZ>G8p}P2)tFMJrKmsP1O7>>>MiEiY4X@m>#PTf&2?b*Yk*NY zL&R2AC&y-8oIXU^xNg24jTWz4qrV8_L3td<;2DbkI@;p&(mMp%I)>>e*BcLk9{RW7 zAWZVk_R^(TZjF~dQ?0dHMF|cG#ao|7!+*24-qK5&1Eb8;IIDn-K6+Frb(ElkV2(ha zC^f~Ui-jY+g5@}1JC>*W7dFus(XigzL~kjh(?q&UkG4jNKN5=Vj0;$G{1)aaY^tB4 zv}c;?3ox*_BMtdbERHGX`RdIBe?%Kd;7|NlKRnc&UE*0^{b?^;6P?-t!;_24K_bVg zM|k}VjN#PVJAXkYO1M%Sbn5NwLZL6fss*(@l+@sxGhW5P(*EiW+vSI$e;8)bwcW4AR-64wN@U(}!aN zRvDzr)3eVtJxck_TqD>DyF`et?{G@DG{}bqdjKe+O2?5V4RSJ^(K>Lko9SsZTtk>1 zN8tjdzbIuUV7otL!4%b*6QB@mNWqw$@*3CgwNu{AgQZlEcF;sL35Q!V{i2~qNqvH3 z#Kq$w=%#PDB4X%t$8UqD4=*7;@M6>oZ8x^gsICTI>kYn|pLz3)aU{LuUr- z&oycWYO$LU7XomA3PXtAP7XQ2UA$Nezd7zxA^IYFNoTt;?(@R*e&lfT-nR|d;U$kL zWvk$HA*@ z!$jU=u3#rkFcIgg=CSqPW^m06>gW&~3hFUB`M_0UbzIgIZDaK|iWj5=I_y@*>H(60 zLJ6{DZ?QH(PZ00M>WPgQD+eSjNM8~KV^1k@I%|~4M+}S8JHUc4%52l<3)J6Rp}49z zJxT7es2Unc*PG-j`}gFn{CtGfs~#+=zkB zIR(K{&5unT1-XeRFJ2D-@5q~@$Kbx3>*2Cl_Bb}9UZVHS^+oa&sjbL!V#n)hfd=>? z5v8-!xFWgn|%ENV2#g07~U~=a;TxC z(^7BOXt)e>xN5pJbEy6vNdwIIoP_IUE6|*+b1n6bjmin4c&HF0To)fq@zWY5g&3ET zCMI5&G}MfL^7?pakRyFztLu`7i}Y6ds7576P@^074_AG!kBXwGct8klKve8>Ipl_f zXcM|$zb^1o4jIf1P0{1s`K^JH<-{e4@+LTHbS3G7tck4Lg-e0+lJrFDU8(d+5M@b# zSi-TG8M)}7XO4S6q9#fAmADrk#!fO*DLFwDhk;*dxLTLiR(Al~_HV1-A=8H7yb8Bc z^M3%Vjhmi7Xzj$HWPK2ltWDMv5M&R-KDjCxK(bNPB8qTQSUbJF`3eD2J3R)!^V;cc z=+n-2dJu*0x6|*p6cw}8DqgYy`ZSwUfdimcM%MAl&fs=;T6;Z!svX;2kHd$>?e&3Z zRC#;-wtvBw=^gZNSjSFZ%U~cf1)O%wlTb>^?EpM2`-`K$j(QfS_7G1@q?ULGbh4w~ zS9YpZLFz`FICj*Z6wfzyIN?*hTN6v@jbTQ_<7`KH*>&eV`mAL!?H~ z31~-H^&EeXOU4C=>R&KAlV?C+kkwW9Ra;t1P&P@B+L!W|SU4VOin{8%<=}PG&GRr- z@cW_4UerzZZ9#xW&`a2zT2IK1;$~ZM=ExlBravSvsSw(rq?Bx%xTU*3T@p55aiqK6 z2SQr@JTyFFdgvuq^k+RVQwgGWq#i82n&CdhaS&=(I&{6ShQZo;PEY+qDV9qR)qV6f z(r$)B@FUpg3h)Qw>11J+wXKZsT;K8XkJiz4FkLsH1A?>eUL~S38j=% z2VkUh#%dlAcnJOE4H-K5))S7^9Cjo6=pp|YBdG25!EA4Zt`6|B zQ>bb6EtY-imuB^;rQN5!X<$t~dhMGI0K|ALkzEI0g;7F5d(-Qa$*yOGfv#Ll*GH?Z z8v%m6gHrS?7U7~BbtcPD#M(D;{+&|`nb?jS^%AshN?(0owtaHb1_h*{m%rm7Fd&(< z{VnN#d~56R%^p}}tp}-8kv$DixmiT^)5%iognl{%yke;t6q~_&_{JB(MH}%m_ITeY z79Mf<4+};#F~y#rF2KJU#i8!{2C^LiBV{`8iP6z^T6SQKyTxS`4et?Y6knlcho?=xzE$& zuMLW~&d$)a`z*t11{&^g{Py-cMu7sBPF zZF)mN`7x;4DPZFAhwHncT3k6?hpD#_`jg&DJ3?s(aK)r_l)fFCiQ3VCEG8 z*1pkO2YSO1!47DqzjYe2=Cm<-SFesPaqSP>Qmrb4B(`Xb?hDTMg)t}tx=drRQ|N^2 z-oRh-;@!OafsSIvf(UgcHU#)_4%~=l+=0Ux=|;1Q$Q+9-T}A2y@FH_X+wlxK05k3j6aJ4qtcKL_I{o9f`|R5fgI+ z8aP)cp;^ix!KZ+R4yL36P7=@n^WG^aAE_x#1v7CI<>~~`_+ALhQ8bjt`+ij17hg1g(Sn4943F3KAMpH zgV0!T%m&A_RkWC`-z3?h?kFuzWd4aW{#CPemovjIQWVeD`#Ll0U+D&8;T+x9Ins`D z^Evt^%{i+6ea}6*H&kHUd+*g@S$H%x#1HyPnc_SQjX&vtf@R_Xutb9DfSavrAll z3arf%cZ;VXXn<3Q>}T~mu+Jfu0Gi^VIF)@?XM7_1NI0=C9)i+83sOt`Mf2zMOCWZ9 zyFSWi13oK4IS;q7Wx^}KU9=rLVr7H-FDmM2|1X|1dzz+XcXxOz(XPss=g= zGCH9tt8o&PHaLK}=apaup<@e6L6D)7UHl5RUE4(YEBbWjRBND@h_=ppr%AdT!M(jW1mWAH@cA+C$k(Iw0JbYj?>da%qMi6>Q>@*fQ{b+eCJm{xpKp&7^dxACid6zvVqLO6DMJMzX@@U^P6I^;6)x+HxC-p=xIQBrj(+kU?zmaxlP;+IG zJNC4GR!Loqg3?e6{ZXy=UiW_Ab?-|=r>`)$OGWutAb`t6U=@PpVh#nlVqcYhN3%0l zQF$&g+~F4_*g$XdB$?_UAS9MQSS&mSB(bO(vLUC`)pj4RCIoxG`|{WNH;VHCRBYl# z*j#~HIU!Hic|AuF$DRd~DivrpU(k;`AG8u~6HC95qFiz28~qTF;tLlg=Xd_1{ymNl zD!?Pt>mQud?1>PMoDoq z(Pn$H((yY1Pg4;a>kKc*N_4oBe${K7>MFYn#661auYCOX^khpE_?o6}xQ{8UN^!2S z6S?fhF(~0Nuk)a3vaQ0m4^j9lh4O#7=KVORo)9xX}tXS>a|Y++v0R zzqX9UtJ~202HZ7;vA$BkOgkJx!S(=Kl9LL?hDH{7_84j8Od}*bD~)C0@>VQJYubFU zaTOo?IR0Tk$`_Vvjqrlp)*#HBP4*6?g-xxX%@zG7NCtESvRwd@@<2ueB{hh(yZ++r zf*=;ujTmV9v)dYs-&9Dk)y{4BZeN(9_@}IR%ZO)15DQ8D^>AGs&1@Sy3ZA#Hr={}# ztL&#mXfT@=dJfqx9Q~*3;Ag~I`t1F2UESh}y1KXV7?pK(Bk#VIRPJb!7-k zfRnF3LRb%<1D{|=Qc!vkW<^8UD%f~C5z4|Hrw}Vn8Msc)!dO0>s}+Z_Nj&7!#=Dsn zLJen6JMTyIk9cr28q1;!N>+fs31=x}l_Y}A;@=!=oU2Sc62YQqt80e;KewUO*`Ma_jH+5X4t>WI!pir5`MkwwwW<#QNulSOGX z>!2j%4C1H`v_Q@{&AcvZ<5`=ePG6ayY(Qv@q@Kc#ci{Jwfap2o zg*&2P_=s%IT*?dX`OTS5s%=YKpg|MFi5ARMwhb1ME!jQRg_hd4fY!1OL8upV3v5%o z)sht5%}yt28{{;!f(X_q_zevkXSr)+VHaQY0bKz)?TgIB%hr~t(&P!TCIen~7M_7&tIGEO5&CBAyy`)+q$62KZ|z0ek> z9!U^777sOolJB7^W^$1*pbT+3zXoYl+f<H)^JR>^^b2Jz#Vjj!u|7>Q3&!T7#5M=)mr?HYRI_%P}7pTvG!6LP9RBm7tA!756|t!=#t!) zZfuqmYBdwtA41=;suP$0OITJIRhDd z9dCCZ8N$Hh?G@QW*%xH-cQp%lj~>Rdyx?Yc&j_|$eG3q6Gd71rdIp;&VMvO0;2sj1 z(r;z3<|M1B9?70YlO7z!mP13+XEcijNgv#w$BRLunF~j*?y;lU&E`!y9e%1|vo`{+K#^!p#H_t@iC3QbKV{5A%60Ih)cTkx7%4CK+SO-M6sq7(| zu&`TMOM|v|zL+Nh1#?*4e@86PUFin3ctq zfUH^Ub&z6N3A7JmVhLvLh7tm#)lGfuYvoQB3um)FjlhAZiv=q0&t_6H;5##PYjfBd z;`z7CW%o523xa`$u@D%GWRZI-*n;;7cEUyCJPhy$V(>inu@sN{h_%yj$(NM*-D&gL z^G&F<@9tpN=)xIfx$diXvV6KOw0aRE9Tl;25o<}|)+MYng}_EP$^`-Zw#gf)YB4I< zD%LKxCh1;wBPE-9FY7I{;oV$61?gXf7v9INQtY++SQLd(DAc2_yO%W7W!16vCYCG}>ENdCo>wkUBSp^ppHH649$&s@#MN)?X%YuHGvKK?j3N|Ri7dYlamBpV;J zUi#pnKPu2E);g?RQaWec0v z@V;EEZ_Qk-4p9eDL>!*!cx*IoW8nH}tXHsFu$8s8R>GF8rp{H=Gyd|F{^(ZLz0o=% zxUm2{YMVvFXCW@WQEg)4HWTM<+{U7$N}9buDD+TC(_UfNkZ)t-<=WoLT8f+^=1VX4 z7O`Xr=S6bCyFV#nK?+3u-xjlRlAW_x_H2<}0Rx~pGrb)JS9ii3z*8W){e<&r_Nsak z!$?SiS}a+EaB=QwFe|3Pgvv9lj~Mz4yVHXdFZ>E{SoI8BFWc}eYaQjeYKUr44{QpJ zcE0^A`xV$kYIGic4lE_C$~=cXAkZ5*D(t$Q{Y+BJ+D-o9&R*8R)Jl>00+Tv(YhD1N zL@8%pV0WuuqP2F(heY;^_4tW2;ba@-9E#XbFw-edLW)uLA^?IgN4&Ux=3ra-iqzhv zwMekgFmu2zqIwHZ+PsebzP+h`sa6^^pdMa={w3eP(ESBF*bwT$8#_#DcWnndL)69vu#wv+^+zo`Fqfme(n={K)VpC zZtRx`mua*5bB3qP)S0f*N=7O|Yc!Sn?DsiMrlm5&y+U^?u7_G^V~K zw`}f5-(rs{ku>`@W}x~#*C%ew?FS?$i|qaECaP-Zel}K)vKNjkvF2h9uz9Vi1RE}h zyR-34Yy2j5jQ%W)@!A1%ONu}5`q`lAB zb>kW%R=v+MsHQXTnT8?x7;~6y zv&v8J1-#@sf}Iqa9d?98$@qSP--CK5A7KF!*Vs%N(I_f45l_QZ0w(ZIH4-kO@2&7y z@U!y>dy2#@Mg@>L)N2nhG zRx9LD7=Fiz%GWSn6_w_AovAc86;Wp(;wVbRe!1%~29s3qfFnkK!tSIoJ@g6qMOa5| z2JOw1PgxShP5so|!|(r;eL`s97#IqIOOwYE;ISZ39*6tN>@!A=R$l&$Jx2Muf6jU< z7wlP-{Nu%9e`e57H^wyX&p$`C$lB^S+pd0t?%30X^XlU)SiR^O-7iAJC?6%zYTf}(@p9MApH@NZ8-8VOelU$O*gpo9R8(1$toCZ|d71U3|xELMLB zStoTB0+UU^mJzohkFz}vmMlK$KA&&ah21f}jc`ZIH86)lYuKk|jgtCDbbLf54y!Jh0H(lBNk_MU{o! zLVyE!8@r6_mDtfq8}R?EGTEu_)g}&~Sk1aylOHBZszG7S2jzW*@%0a^y`;i6il(_iE9^N)t}!JwBWp|!V_6Mr zMhByh)MDR7qh~;kfs}V^A*84Gbn)IQ>l3^oV3RCDW&`Kt-VEK}ig2h{X8g!f8Zj8C z%&N@-K)g4ga`EDiAP~5{^%HorU1G~mY@mmYqS{hTf}z*XY@!X|ShuOv5_@@2S%f5r z#MPo}9T9?QuOos)gYoaY_Q{{YQ8bb$4E}{ZfYpEG7j~=Hk1o;uS2ow{Czm+$D+}}b z*$RKL!e6cMH!J+z3je@)uRp;||HdXd|3Z6+9EaoP43V4PF^X3yuAulUtU+&F zEXZwxQ{%EHaDgcQcb4M(+sY9tDhnZnt@<4#>o3rLWe^$!+8N@ITj zle&JxB2+wnd(rPnxTTi&Ckw~ELk2!(0GSCzHZ=oZGr;LTMZ(ks1%77WG6UQ#ph(RO zbP6C{`U@ujOk`fg7j6b%<>}4e3}8q?RnleZL0uOW4U415y78elMg zgP82_H3&6YiRx=?pwe2jsskLf5ii$)`%eG0O;PR;@p4n%LA>=h>buyKkA^N?FJHtD6N@PrE-HPY#X+zq zlCI&u7#i>{{2%x6sL5u)HbD zF4B0GC{wWD96HYtDPHC;s4^B}8#~mC$B1K2o+66q1Af8Uk6CkvV6;+Ka16{X zW~C+jL8&VkpRCLjijKCYaipGw8*gaX?D~c!iSxz$~6@Ndi=L4tTW08leeLA27YYc-YWgjgVpknQe?H z=b&bj{2~;oqu~`gX2)BA1m-91Z55Tidwe%OJFGg>c#@iIXARluAgBMr5A^pU^cF za6DfO3+2<}Xy->P64g#tt3Vng+uAS$;*(G=cZyBIxD?#C4CBM0FjjgN63vIhcoCgV zw2I*JO!ep(4%OV)W-fP51Yc!d+l%BIv5+@Jad{o){V0C3Bu0j48_ge6Cb;)T^EL`F z@%b1Y9ZI|c{msThZK{74%2}LNr^KS^+eH6Z-iOf+l&CtEyBj!| z2(dSgFZUpVl0}t7P-OZ7<>tim0PC}-U`dwHS}fcOFsX>==UJE|R=Qcn+ z=*JA`;8pC0n7gV4mJ9SDTk>$8gKyO9epW5J#GIDAkIzCxGZFhP3?rAU#gXXYmV6Ml zxPb|{iiV2ZI}^F4sJA0k!?vKd2QXh%D?X!Ptir{N*4)|{t}FGCpt!#^pNZOAv_Un* zKA^;`rv9o8v*~C^yePdwwq}0DEP=+e>vO0(y_Lk5SOC(iEhj^Y;zC<~Gm;NZ=47Bz{F%&0qA|nT!Q~QOXSU;4tf{lM zq4QHX_V!{+3h&TJnyH~7#85OyuH08rcuQj00^9R0a{JQ(-(&IEP}Nanw+B}0DAu*- zZ$f_}vjhJK3XT%}6s3U#h8kB9wMQ`$ibXuMdP$)<~(ejq=|;*owp+V_e-`eC?V6>a;2 zgv-O~HYCuzyFdSqLYzl;FJON=M9~2Lyfy3ppK!U2UsjE&=9Rc!} zHG(H1iInVZ9%16Mog;8j5bYb1!8=3ODKCRRFxPX|X_3$>oNg6GU67aVsEXd^Y6#A7+-W{Tl%b8e0XT;KxCbE#|H!T4-&|V)Y2V0yO zX;RrU=M59E`-+9HLqeZ2ia#uer8N{ufKqEdG+YH0CvnwsXpl=BhtJ!>(Y&Vxg7($@ ziKBU(6_q!dM?=H7cr=$cL=TPT8|^Reg!;>SbaL`=Dg{TDo5z5#!LafeNhRE9<`YVk z=co}9rBQ0YU1Hfdo@^CaI?h7ONhD#x_0)?1r^&Ih;D2wnMjjkz^>O|!e zC{r}%eQCOfPpEHA-UJ?9PYOK_zh0TZ&omOiQ-eIG z6W2D65i2{99|z=Yn8ZJ(lIKq5VUk{(JdCmdo-&Fj^AYsz$I1LDYYa9_;dD&m{$vVo zqC}F6gZ`+0^qa(Jc7LP9FH`w6%06})^iFArh(19a@-vQ7@~3fmAh&TEFO=U%{iub= z^MMtBj4W>MFl~^4ibT57>EOy2)XjnFXUeRnvJA;Y)1>PX-$8HG|)WL%Cif;gY*z25>zr z8QcQI4&{woxW9D`rL+?;Le52Rhn9=x5(_gG4{Wy`y@dyn!-HjaIl~HPVs!Ak*-T!D z?8P(rI3H4;^%bQF;5(r~nkxsbHL_ZRRx*nRgb|)3pc#ONbQ3(ffd&u9bhn)iuHuYP z801McHQ02Yn$3Ni<<*azxH6lQ0SNchIbcStNk2Fj^_z#`sh6S6*7a8Y*8iRmcicSw zwxZsTa;ZJkMQ?ZQeBRW{D)R5!tlQZ%;<2LiHb7)b4qp}c0J0FAAgBkWC89Ei2M4aO zK9TUrhO#B%?;H@#C8E_rUPr<0ybs2G&g~L%-EZ8^pQF<~Sd`ckBWz#5eH#_-OwSF?k92I@oUO1j%$sG}Il7 zmS776yBLo^(NFrB@Ll@P6gYHTilw|m6$@JEtqXEK!DX+lHHXn#4@Q2WxdCR$Pqmo~x0qNkiTXrW(q-+8Lk!DBEEeBh&M-^Ab z>ro=6<#o1AUK6Rgd>Tq!n~PH!creK2@p6TL?#abYNPwE@7N>K07r7v)b+pha`gMwq z7X9+TYEx?=56{CcXkH$7dF@rj)Xy|Han0i;s3HA+9`E&r)xI<`YLfB`l!o)~=L}zq z@5i`!_V-P3V11OWSl@-R2eZ`gyopZelqYa_}o&T}}?X4&uqs<`$6 z{IN=aNm~K#qpZHB7;$xdFk6>_J!IB6KwlB&Mk#NYCy})v!1UAdc70?F`JjIgw1g^c zRc}hw<@K)BRLlD79+cCIg`p|X2bcDb(K{;CA zJLteYfKsVR^hZtlxM2e9s0woevK|J4yKX%~b>-pfDygIbr12b=@O=b)v|O8GBvhGlLR8@U}_Rjee(tTFw}3O}cH15A2^Owz_fUY1Y)jR!^$F^>ZD zj?;Izy?+z}5Q(*g@&w!zSwG(fP0!eY!`Y%oAr4$AUVfB!u}rTNU&TFzm=vc2d$-!| zhLjUTJ;qHf0jH>a4M$5cV<73vdd%8~CI}@8EXKo+ahK!~64B&1u`n9$0p`{4C&iA( zaAPfF6)J*#g;jtA=-scvb~{=0U(LTnWb7K$PDm!n)E3EE18V;#N*Rj>q@aGcCH=pW zt*i3Kv7zoLLi0@~b!xu3IeBQO%Uhr5_~g+UbKS^LYwWSVVN$@eV1%;&Btw- ztj#;f+H}43cBJ~Cg$Hr{sGa6NxhFo@~9igXY?mS=H%D2kFnD)AS_519d0b}@!_ ztB8CG7!;QBKZ2;TW{sC4^!h7pr|Ksia#CA^bnjE#R1x)tp>1=g+T>|IRW5Oy48hoh zVBf&rAvu+zx*_Z(>#eMsLgn2l;K|NSw3A}7ilf{&1lT#XSr17 zFrMQpX;=3gGyq7{Y!!d%IUZrj#Y+8AI@@k;zaXs)a;I$PFoch#^#WnaX;`n%KhGal zPopcucgEm>B*KXWH~IynlnJ-dz`O_^R91o%)HGWidZk$UBEPTM8EYYYr3$Z?_$#y( zeC;JEuDJXXm#Sagckrjs+S5Dut6o*A`-zwNy;A_ZVhGBN{E{AD_2wPleT#J$tZmLeBt_*8g8m_r`V2{eM+4q3oL*7w~`2FH(2mf=a|&Kq&Ue>~0DN5asZ>{;HU= zkI(Wt4@#Wrz*YRIE?=J^I5BS~N}Iq_V9}ib(u_CA;QD@``GaJDM{r+1e_UqE`y5(U z6`>%%8TiI8V5*4P5Q|CR0;{n5!HZ&J_Z&nG(uez{{X7eX24u#p17Om2iMtMfGwChX zK7(6lY3s;u^)cKVK74>Mr8}~WKkco4gM#tT+}n!SlBU7#bMN4E(B~pz{X{8u1Vdj5 zm?Bs_`5qAbF1PYNhoOU4#e|Q*3UsZ4_EgM=5N*Kb#D_o?rVoZxI;o3!KhWV$ImmGt z|5Z0q<2vIm_ngC!a7)I|Au10N0U6;1P(1>%?wt6 zJ6>9x)K(e*x=5QT($kuSiZh@3G!d(g^5>-+Ybl*U0%C!_Q^kOf`Ak}PI}s}1n^Mu3 z4luykwSs?`e2F@Vgr@Mq?LB}|g0w5CC(ufcyp%FnR7aWs^AC<>A@iUp9 z!L#lUs+jp1znO;M&}UpKMm71I_x>N3*#s`Lq0yi7&CoRp{Q?qp9JmcT&L>eBYcl-h zIpfjeKzZ=-e1iKo+P~94dSS$1$^@SE+&fNSCupVnhx3U);5YM29M8DL(l2>JBkCaM zL#(aF6(ly+D^aisL0~~o;jD}19rcFeTG_*=04X>2t~g;=dk(7))7J7lzpRg%?br_doJp z;7=;Qm~Be=#*%UN5$PNRIpQLY_aFWSr*hP?hR8+o-I|fz7x{m9hX;ew3tb!ZGIX5E ze#CAvV|EjV+{pbZ>mws~k-uTGYz#nalh&_IMd2IpTd<$oMBaCplaTLtjPrLpxk&$x zn?5SwgLDjuFTcZ6ra;#V5VgKCE&1?q7>h~{sgaZ8PphJ)XRANOBHJ_^8u2Tfn$U3iBr0ZSn_*= zU4>UL%vV*>@(TZTIW>d+?CRU$H_6|?0@WYQP@n(TcS`%ezS~NoG(*>wKT@9k&@SeG z6@b3~&+j(ZEh~`YS4e!ns|Fhqa9usH!-&X-eW{EZoZSWg>{9{{(E-Z1Q%wv;O4pK14NGOb`r)u!gJ1WI044YTT{+9(+nk z4v5U*tKg%G(7LAZNdRWE=)+J4kWcMZ5XmAD`ZqR_Ziwy!qH%i{pa;bhE*Ut!-2LzccR=n@&x9tHdGG=#t7A@KAxRp8}Tt^qeId)5USUnq&| zE*o?wCQ>m-jcl=EbO9+SRgA}2#+tgiHponWd9XYuin5!~*-y5Y;Xl^zl4&}?ftm zFMOu0CEE(A9Ydg{<1l=cJTcf|B=Fep8XN4Z7I_XM7}u3IIE-+gxiGZXOcck0TITl0 zEL9+@Pqy=B5NGjO}NG14r3HF$})Y71fMS7pb28_F7MzuuU}|v?C%-tonVy4 zgBHVL#8DrU@X+F+zb`kK)*)!E)8G1yb#>!6*VV1WG ziCecew(ihVq&G2w;|`v0JOhKSdyhO{aOM86`LDzBrRU(Uy6!#hy7#$f8xLfEyaSx; zjg0u6aQ@?$jial@6sHj#yB$VA2xy79qLYtUJXAP!g5tMA z3C;*_wHnDNns)zo|CU>Ebh>EAEx=CD_$#srmdzA4|1%KKQhnFqq!SRiSW`r;W(|A_TtT5Bo76DP$6tHRA)HXn?4< zNbdnUa#%N-(^g(L9+z@5vzgV8_=fuV-7p+&rpG19mjwWQE(^eY2mDvC;sYoV55n#v zXNBHGy!dJ}L!|Zeix6cc%>tlvsBD2eF6lK88cnvIK z(e`GJf}eN7aaAZ-jU{JLcp0KZ%`MIpQS~lJV!&oUu)2oPwQwTHde)aP0y1wJJWpP_ zKLlF15`1+N8v#(AZHOpK2F{KNFc_@fA~x7Z#ndK>^bcV4JSV_#am|`)TJglr>tc0)(awh< z8h%AoFH)^NO)*A&Or$^kMB0Db9t4QNfrcq5Mhc1Y14U&poIB!%HuZ_GAO=eZj%VOu{{t+OT})mH-1yvo>tmkG`;cS>f9!548`}h;`>-(8bUdfD1@qy$3uf)6Nl?N zoNnd2(F*(0#0(7G`*&k<_&nZ`;)dBm84>J{NvV!9x=gsfuzpq{{SnI4$U%*{KHUI( zw0HhAOY}#b8EEAngtHQ(UF=}IdX9yiY>1WYCK`*rJP>X3oRA6;7z213YNZ-xg~P?= z7>wNP7$b&{u;MbTFw^|@7JVCO#f`GU(e$k^A7j0awL(mLtTD=KJp2Pc$Z^IJYnaX? z>C7j#o|KnvBvt`_e|Njx+i| zXFW5*KfG{WfCHN9^i!050g_R4J7`zZ0FWowFb%4ScX**8;~~Y)dLMhUSlqYG+JTQ{ z@p6?_#v5+wpq_+8v@xTQ(A_jtO4CGQT-^Pbh2!;@1cyV(64~!zUy&_NH^-W|ncje< z5+F2lO~V0}ByZD2dJ7|5nIWdMFlIIEX?h4pOCv_Uhl$d?FgKO96vSjuOM{f-7q>J9 z(z0)9^o3@;Pl7QE5H&vmt9_Qlks{|7l%L-T9VkgKh7z-JEy0+JEPsdihZocgg3lu= zZdD=(DGneLfqbFCNx^JUooL(&synQeaTWrW)YgW)6}ca#ouv{X`Y7?|bcEDtTf3ST z2*yFiNfrga`&sWRMXNT3X*0z-?@Mz+gEwn8L^1hoj6vA(oM>Z&J84rwe^3!#0VQsh zWJty5xFo~04}&v<3lQPwCK*|1TKaO;KTwJSDGMIENgl_HZ4Iedx}dEwL=I+OQ9ce( zl@kZ{;#6B>32LVM;qH0K7zt$#oH1Y!ceyvTGfZDHJ5!ANvE@olHMU6(i(o5O<$J-7z02Ht}h;wZ4etf7-6Ia^;!p`x6~UNBFdkH!57xi2r+K8 z(vz-}mA-pN<6a1~_H;D1Bbd_3C=exc!1JW&kV5!&HdYl*p{ea+BG!#vjN9db7qPeY zQpdKp8+f33C_GWb{tC&=(5^;?OcwBuWG&`XGDMS%mHuc>NfJSPL*o*m%dd1Z{AEFr z|M=SCHme{SBAb#>K}7SfD=0@S?q+moxez(1y5m;eL_{bhp|acSzll$}8N;DT9oyZQ zrras=x*NA)*zJSlCOwRn(B5p@!-#K1jJup5oS(6L9aja#q#ngY|Z!Egt;#@iA2f378VD{ew%4fk~v zc7p~&(dY1#nDPmaC@A|7oZ`<=hOg;`XQ~DV{pi#s68`E(jP}(18Y^ykeKn_%Uk(UpX z-L3&fqO@~mH;NiW4YRolnwTI_`bN`+TdxC*iL!_wnBeoX925HvG^ByBE+F)v7>UX)6l9bqD~%i_<0##XtPf`D}@)@;cj5Rb(ob{Gg*%^=`XoRB4s;UyDJVG< zeL#zJD9T+TGH=0dpsF3H%=n>(sa~HhipL{z)nrnx7;5AzOWi1Z65We|t99r|^ns+T zXt=Rkq8i%rfg>)!xF1e2n0v(t<8``h-YXN^A^1Tv;3gaQ8K}B$c+yUeEx7q)sLeS zjFB|p6Ak}RnznAJh#HQca`l>9-O9Pxb!JU8Hp9;H-xCQbo66&>-U*HoWdpHA96AZ; zJ5L;(1h}(4_I%J0BdVYh>W-Lfte|l%o?^sX<`*-2tKkJzZh-z2gUqjAo?_ro>VEO} zRO6#g51?m>XaI4VMABDW_x_;AJE_T=oAAtRY}>Omkg|#qfW(L_BdO7W2+av~=YZgM zJENs$Y!=Yf|3loDfJad@e=|!Gb|Hb?>6u9&AqU|OM-Y%8Ac@?UgouF3ktixCM($$0c2TD$#T73R*L zrK}S;cq?V$L&bfnbmc=-AXzr92XUtb)>cy!9ndjR%>Fp;hD6 z1W7_7Pza+XZw(k*c$xLCEK)4PR-l_rP&;|#fjVM2H6wKlJu*RxS=mB_>sp?Y30UW2 z@ESb!QtnfNwH1_!_#%|kB@>Oq(NX6AnB4oFe19CV>@@59IkM}wBDN#t5w#yXf3bem3P(_0`XXn3 zUo0Z&^}$$8eMDV@dQ%))IGiqzGM3Q@%b8|5vbPH#Rbvr@-+a|dDkZreQwO_d*^@nn z#y^D{l@$)^IXrS`58D86+i!_D_~0ivh-|*kn*g3!%%> zTtXTp^^JWO6z1{vLlw+G$Hn0}O<5mfi7X3!31Tt@6BnOy{j5h3jM(#2Kptag*5hhh zIB2K5O?c*UIqy7AsBK-|T6K8*K*V+%vQ#vtuqf1eeu-D6wtV{v z78swBiyF;)O1(j@Sdd0e3lenbDam4+XP#1{m9XdSA?J)$g_2p%s7=CV`$e~M^xSQ0OYJaJQ zZy+PD0;odHSQiz|R6EIzf~2nqY7v+T8?b~&JgbgIPfU9j^Ac}0S4Zs6>U+kvVD$1i9v_@jP^`=Bn?=;jj*}^5u?2^C3Iu%PYKm#RHh;;Th@qn3FEbny-et=GkMn$XqZV3=bHB zgSl|$v-}mCO9CUB8xYqU2J}3+j(hzL&9yy&x=}lZTeSV68v$>CN&yDfb5T zfkDtbwNQcnz2uelEmSk{=n37NuiglQ^RkHCd`POR(WZRWQVfKKXD)Qs(@71g!iTq` zEK=LbE@@(&-laAR)hM+L`?YdX8_JjzT5v@Z`LpVJ1?za;4hrmx&_GPZoxB~c)T>T&r%hS zwAl8@u-}ZLvtLBS(wbIki~JSp&THGtyqv?Zw!A`(@+?Mq%qw%5To!a6I^zkzRsWWoR@GuiArQ zub7DCG&K{45uiaxt1LIe-o*Dy!qtU82EZT3bkpX>VqdH2rp~X`jG)4!cpqm@5)Mex z*QqcafpM$44PW^@)WLGssnR;w@^$JB%-ye3CrRy6FI{9b@Ur$G93$6TlnELo_BN<| zI0QQBPoeJ$*Q=d<7Ml3D3|(%s7s>`znn`|sgS{_G!2U8J^jhFIlOcv~uhHDs_K~B#V#jg_~*iunCaY$oPsA@-DB2q9)ALdafx)a>H%RE{9H1#gzUxw zIIRPagg6!lu%G|Fz%v5edT&{q1N?1{T=i7RP=M1&oH&I>#O33(le2Oa+)dspp27!m zld=DJ2Wxru7~%AU+v!*m$E~yIp(~!#ke>^Q(8TZh&yD zTm;cT>}K_}q;VcRABusA-J+HUzEe^AUA3q0eOxcv-9<_Xv=FAgt40K-fB9XYR16(_ zSM6|}Y*|xqcQ|pYYN-UZq>}rfca?0au|91igpsoe#hwOdxqGWEm2621mVkCneLWn9 ze49aSQ-8<3fy_J+B%9xorY%Br>Nd&MVciWRNPx``*XQZbe7mSG)3h8vTKK zlUy>n<9SvxKCi?~_I8tpVA~V}^(Pve`vDH+c*^#mHlti3zk@SK65$l&iKnAyKwQc{ zu;gs(cUjY|_D=QgX8z`#Ly*=>Q<<-1($)>Y^~KQQo$75f~ z-g;GSmH(kyj`-srVvi!tFOHJ!f*qSZwQza#BNcDC*x94@$W`}W-hh9SYyD}DdQ$`b zzFKHZ9N-?iVN8O!;Z~HK?RTsNAc+zgN8zU0wfUwbMU|SSEZ7 z!REDG*OoDg8x78&{9{P2yvu^33o~`UiYMXZctZ+Wh8<{(IiL(|t$nM~dmVQ9XW&Tf zk1qWTQUrO)nb?M56}c6@!~PI6;zCN+%Fos&T6rFGc4C|{@{|I;v86;bX4crlQj%+6Q zmm}Dut)g>BY%ydXk~SqXkD>wADm>trTtYE*YVhA z>X!0+<}DaGc*d|DOYcmPvjBenV_BVlJSNuokFP1 z8TB#AxOgdWGOA^&XjlFI8CB{bd&wUtYGX=$8ytAzEU1s9{-{1zg}^c+;63X6JAqZs zszU!;FwRB~gn&bEKzf1zhTx-plv#K;zRP&r%B1;S~i>c?-(Q=~KM>;V5 zaj=MTH5?9bM!(fnss+V5b!X*qt_ z5;lQdCF>#XpRtbx8LW_mpiPAoGr!R7sQruj zlEK_R^EN!le&4g>7qzjxVbTiW@qTfZTDm-Yu120;At?cu*8u9toqx5KBd=ZahkjLW zsiKX|<7RK7I@iIO#ke!9hWRT9GPl9Lx)b^v#2^q`eGn@05?kN_$=`s#9B>{SH>ThX znD^!9As%T*=g(t9j-6KyF1u{|T^$UZ@mx@c;^84FQirLWB+k(uw$sudhGg~h1@%R5 zKt($|s#5p|gu*ao$o6mo&EgbY1U--ihUfnYCZ5-&Fk0{xC{*H~XtMO@mHY)!|6nzu zE_<1x#{w8f`8R)W2u=G_osCLdm()>zvmX^=PPwFpJMa+;u0Rrmx6l4koBYpueeGXr zXNeKb^Acl$Feg{!E0J3!b5*CT5Yblt z)admPF*IQHj;jhQNNs90R5z&5DWp!zyH3$l4mwXmrmak=nA2he!bMV-U?UE9xP%ng%>#eg zXd{}>%WZc%mH&eTEdI4Q9GmZeJrIKugK#HuYE98FfX&!ZQ`{(nRJvGGe8Z>rU2!n* zM=cSGT496<_ku!2JK%+x7Al4)67wBYk^<(pI83+$IGNQIVFK^rP-SiLtK8M{OyH05 zvW%_hVjaOE5fs2iiEnocem9MMycp!WMYOztbGMz(ruHAYMe~0M#~phQkmOPBGW^BU zpl~L>9`PI(__aqo8u%6stmNbE;ugc9PY1zi1Si9WzA>h0nJTP9$JUfH)q1q6wh)$} zQ$Dc;PJRlQjnYX#xZL~kl6~?dm{Tp^RKrb6g|K!3SjToiB2oSZw$Ry=-7G`=kL6;u zhAKkG8Y)yY(+VF7zVd)AyPeE z^u!%0NN?`>k7hpJwp9BzS&&&p-Je3e{R zIHl^8cjwN?%43B0;_8ZU$Gf%pl7BtQtqc6wY8AbWok%)V7vyF;E6s@fdLlyEVa2{@ z#j=WHFi*{58c|OS#pQoaNU4)?zvg{k60Ok(K>emjrU3X)P7*Yt9ey*OaS=PIS)_=^ z14+=@vlS^nv?}|^a&}Wuq*#HsT~J38Jmtb_Z?q^%@QwJAC~?31;--|*0QZA(o7D-D z*YIQQ(m!S;F}&#fHB^cAaS8EMP+!C<`>CY9NNDD-<%b+r=Kwdk!?Q&4P#Lxb2u!D{M`0~j7tB(+SE8!^u-H|(6@rP>_Oi7#)_&&BEDp$ zL`d^@VI!Z}01Po(#K@2H_G|(Tjzd@d58BV;%-wa!YCj!{0~S3>=i)&9zhWIFa7hhh zmt-^mjs4oHACHGaEBOJCyn+V8QU_zj7A^<|^|&9)8;A<Z0)NFX9}r#w0dgM93lc z<~i!?dyUFJtc{20dtje2Ctf&J9s~a(j)A%t*Nvu~@uJ-|GzzyYgTywJ9RV{bk(87H z73R!_!d>$l8zahV(~i?M8&hFJ;jDSw4*a$@tq(Gq%c=1lwRs-&xKM%Oj=Pc28l6BQ z#w)2=fu3TSK9fNnzLRzV-!ocbHvj_~^1PD!;FOJfGd&Sh&?&R z-bf_LwabBrBC)#hVj4~z8;d4&`6u(_Jpu6mZh$N#R#d4B?>BW<8k`LrybG) zdPr+=r*cN_XU(atK^4RJ^o9SpC!%R(B38-el+z7d$G$`n+M`M|lA=h7e_qKx^U`e) z#v{X{#ONT4s#0wIHX^bSCrvZms!98}TDsXUu4eiFXI(v=zU~ z-h=iGyU?O}RCWY3ssF?dHL<;jXv~A%#4ePt#>*atpSiJab~y4*XfGO9IlF-lReK>1 z6Lz#0%>$y&w-@(wjU#WA?I#9%VQBX5aQSrv|o!!)~_H zJ#e#lNFv9LFjE~IBc*PCua}IjLhf>J?rOb^HKeOmysUFgSNo%|h3o=N#L})7<95c* zq$XQ!cs|)e$o0uW+7SLWSY8XM$ShA01*{Z>nU(-&T{nx} z{G6uEBfh=jwEz#Qq|x%AIW#2f;G<1Hl)c#l(dAg7+OdxvPUz zaUigV7q05GYoO?0@5+=^OlVs&oH++_nEt6)3+(`i*FhTwL&R7yBq+4zwV5ezugfvH zCWXOzJQ3V}d8!yJFGxcrgKccYF2LE~;6Wl)_DKr*1aAl38)9uSAU>IecOg>`Lt1rq z5LozgwdwakLfRP^nI?ML%kS%H;ysDLw}A+OCfz11nZ6~s4fE1{{y6z0N;u6KjO}N@ zSIAAy-oe(~z+<$n96!~j=-b6>T=a*xTj6JJ7iSzl*QPIqh?jB8U7o?mK3g*=-@ucM z1*09IVZ54L)3GTTivEj%A~YEF!kSP}3>_v0L!yu|OvHp$Vj%F(LMWO$3=BC`n1+eA zI*X84633*-;h!SXbF} z#XNT96FM^=Dtw+2w0!m(JTkuG1R-g_wQamW-SW;{a3GPI2#}y+5+sT3H z95y$FZDapYqO(`pbp>0*f>ENOs{oxUrHYgjg13&b5gR4quXDbJV>!t4$6&=uOc$eh zHS^%octwVY%AaX569>}m&2s?J`72%AjW%XvV8Ynhwq>Aa?K6V%4AD+b(7$J^N6B}K zBuTJ&A?NJ@a|$eDK)=kpTcr7JD*uMANk;e|0ABT&C1hgA{N{Oi5Db-Mk5g)D@)F45 zzatM*11a(#HY0DQ-XoSeq}m-*DMk@a(A~Upuef9hA0ntM61<*!4A%H-$ECd;7i!bq zG2#|*hhbyIgUTOL!z9n07)qBvae{CEJ+uWSy$$BQVysBzVR=B@^EUxyJKFRB7#%zv z@t~LveWbW?qKUk!!SkQ-jhUow0B-(8yZI>VFbp=NKLkXZGY)bGK0BC<2cHY>!g8EE zUNnTF!@c9hBt;HBCUF6XL&XFUg~sAuL;@B578FJM-hln9^odx9aLqOooA_#UZzhC4 z%V|}nxGJ-DW@Ra?^;zQW07fzAA!gHP@k63t@CCH1dS1?z@cc>QIcY8cCRoOcc(ZU4 z_*#6Gd@At`T=U|-#jW^90zQ(7iuWV`^#8~v*Lm&7bUZ53l;FpK#tJF5Ff{2`Kss}W z!1BW6$3#1{YTaYv33Q5yPKgc*W@fuODV-eQ`LjLF>y$`OP8Bapp$&A7vPCZ%H%;tR z3d}Z70)b_A2S1pMZDtna$mvhQB4z4e2tIdC7i-XWT8&^E$~x zk9VE|Q(_gKSF|sN3O@7%nMu!JMsechGsF!6J$rNp1R~4LmNP{i1xRMz{49`6_OXLf zp2fk>>F2~+7oX)a!xxt~s3JUnhG>{qz7Lv4vmle?s9>t>i{tU+=f!TckRSKu+M;KR zdgz{xv&GObPKAFG$wDaZ>4{E#s(0}LzOi}{ zVxi(W;)LsxJzCXh-CVG#mwkhGd@d+rH42^w?in>tm?vIvUGc?En=h~@nJ>D#{_+p| z@;ZZK-j~Z_K;|i$Qpp0b0Uwa{f*8e8t`~%GUG)`k?gjCzTqp0MjAi^pd7j8b6OQ8*BB;CM8mZ`reN;zsF7JcbJxjh+HZqgTGK|V&T!)<0S6b~zMAsvp)4Jcz2%wD=l z6l1oQk(kty_cJW;Wun15VLohB0F2~(@r{MQJcZehHZQU}GL$ktgA}cBk?4<4xw1&a zIDV`}(TgEWdz|iFELJOzn_(}B`OFgonpL!<2JX8Z z5wv!xXyH=q2&gkH6oGAqTO!V}U`Hk&q> zUm{t7_C8KouVHh)c?HnyM_!z%?vr@#iGK#O=@&fF^%YPfwLqjpyRWD~gv)2SFm~6p z`_OB3C~gjPI4h8>es%9>AiO2g#R8b-^QS#-j$bMI`5&;$@sM~=$6u^2blwB8*Gsr9 zNp#?u_KmNKXo(rNEtiL16{+^_IOnuGA+K~_Q2vx~D8s)2ZM~pXVwf$o&R8WPr9u)o z2zmV%Buvt<5L&=dL3Ve+@yW(FP{}GFsqCp0_FRm62nYGeU+}HAA<)Q5TrITg3=0ie z4L+%$7R_4?asATO;B8=mcQpiurnz8^=vEyFaqvy?nN6wU3PAdb*J2M}&HQSucvA@u zMmzA7)Sh5yiFH=pwCxEonG!cZOw6c?!-BhU*1L9q5sF=9)&{Wx6Vp@+#mx%*gNiWS zSJ1Q~tOEsfyhxaEKmc+4)gw%!-5W*uHA)zhzY$t(hu#vIG7RrZr9!1Pc`;bpac_$k zc}i^(19{%3Z4ys{n3Zi3Lv11mTl07mG);{t8Ah_`J*S0xZ;uih0) zCCS5g@Kij-tjW8Ov_*3O{uo=LDQqhUHlEJjDkgH}?{5`1+an;~g?C@ZDcn8^N~FQt z#1T2h;naRRmb?ObWV?u$Y0)*Cu;jhHU8HguAv>`9C@@>@z;Y*1=uV5cq`xPIOWfuK znz4^(1GfSn^d1O~#7g*Jbnz%uK8wNrM3bi&(j>edQ7rP{loVrVA>k;&${#|78|G$B)iv)@wvCYzRmPwna)XAgRMbED<9s3v%jETKPVtw>%4(iQ%9yD~P3q z-c+^!9#rRA5c0^3Zd&kx=%9Pc@@_S`plb9(LkOZ%Z`WXQ;p-5mg2&%>+EQcg1+G_c z_O_I}6Z&Lmf#y=?hS~IyloGRk)L3O$6))f0%h?}yT z*g|w9mFeqITpDaiRK!4(S$N7B26_vOyw*6L>|93_*MU1LPeX}#^M{c6&ZLVU zVh2*6T7D#AB*)A&k_VrYN7IOpM3XR{YTi}gaaw?&D!jFQo;?DB#25^A7~87D$$1?d z7-tX0JsQs5jXWc;e#Pzw(=Pd)ZxiElt99|I>Rug6`T+`U*mv1skZq7_e-du4f^k1e*S=f_xc z8ggo`gQpDls*(%^T|I#O@OzlTrTWYyVdZ8#gJ@e z|A;L&w)$rU!P#?R+EaV5K;EHDm@@W+P4x~ z2g56HhFHLQC{1W>g%~DZ0cI5KMma@Lg~D5S_}*h|kD^lSlWc9(%Bkir;s&dPtHB-7 z;xKCSk%+7!3X#o(F-DAE_OIfZ>y={s23)e*VUGI^g0AZ&diOlIH95z-$)4wS;=;y4 zOo!gTi&!Z%s7`}6v0~-#U?1gNLz;NNJ=QyUg};kMb(!Q;{R(UQh>PgwF+rdRaRHp> zO0H(L#jkka@Y~eXAQqmPSWhLSy zBv#Q<{dasXvY+RUMk{yMikFX_{C)cy=g{~X=YMmlQ!~pQ+GyUN_6X8?!I>MRJt)D?p}EeIGX=B3MY4Uw8L0Q_LGxK9TP!OYmKLO$8p2<#6#D!W$mV42{ z7;UK1o6f~(UpDB2h^9!uRE87w4ebDL`yYP$NPH2&;r=G^vL2gNnO>!v{OOpeDugau+~DxL4D zwY_ClfElF80seaMb8!iFaZZ>V!e~oBoNC`)qLDSV=2USQ0*a|qL!EK&;cXHB9Dn{< z)hN_HDoF-)c|+@N|^&SgVsOm3Za5-TB>q8Rd&-7@EWmnhFZ=r%Yn8L$K7c;cd^4# z6udYg%|Q*Plslnz&c@yNwY|Kv{ULYkp(Qy+)S;h7)@eZ7dT35qd-7)Mu8iW%E95IZ zwNRL58qgDkXIO=##;c(&?`HaLZt18nCNxZE_#5uwZ-D5jn})g?<7}Xp)?FFR>F%QP zURo?nGAX^aez3)aAZ(BC=I!zOc=92!9gImOe^V=hmiE>H8aH)QtJCgZVQ?6o1zda8O* zem@j2f#UjMj!*P!Y9=?eQMr|{s^`phyQNXoKjy1m*n2Wt+Fw4`{Nk*25K~&zEw-)CopYvn+kGpZlLxwOtNI9VqKd?S+U>=N)IxBS>kl& zInPB=;vj8smCt+o$zMQ!oO*uVCOM)>H;Lu$#I|8RGZA;S<d^B2tXg^yXZ^j0YRPdg+6npCggb0uK*oG}eW=#YLjl2yD0mo%{bD)2>p^^{;cT?k$Cs@FHuw{q*8=>j1N>_O{I3W2-w5!(8Q@=g%|BgY!n$h#(!V~y zzahY17~n4o@NW$8zZKwr+vlHdq2eZAfaQNDz;6clHwXB)1o+<#@NW(9Z}a+5zx?9u z-T>RbBf$S&fWJ7vUlQPdKfwP%fPbg$pAJ-z4cHZs;KKm_M*;rb0scJ!{=EVIj|2Ss zEPq=cBfdW%!GQq(CqBP<^Kk7K2Ss$Rp-pdu)ouhn;apTYPs0&pK-B49Eg2k<-~53m%l3a}nv0*V2b0b$rtM+2GxZU)>27z3CF zcmc2)unkZK_#SWx;0{Jl0EPhCqnEBq0`GvR`qtec(GJCS9kz>0`7%7nc7tsfrynvL zH${K#lrSdlJX-jS}yc5$pI{ZNG1vFBQL-3~Tv z7jKTpWD&Mo*LLgKZlvu-*=~K?jketw+l{r|INNPtyYaT$&~_WSY57;q#+3aD7VCmB zSRWfx(KxUgsRLX=RaRR(kTzC}&;I~7Ap93$7@QmnMz|T3Okh@f2%cMuO@t}b=Coie z`0WHP4c95hYEAVP;6VKOrk3!Bk!M8>(Wq5GRBQNo|6dCb24EftmvJA!lHA5BF?TNp zY-%&`-BDnr8r%?2KwJ1ZGXrOC=eC~t{NsTTEiW@UC@-@+8v3B-bhLNVgt}0c?f)Qn z%p0$LyodKTEM$nYi|Am*6+Z}OE{Qx3V~5?*a&EF5=&f*IXUpkAZ5~EH%B{=IoHaq| z>Q_Rtl`6$@Zm}F3U~viEEeBQ#xP;V+7?qy1U?M)gm*w=foIaM**K+z2z5_X1L&IrpHX*r|l_(RzDz(npOAWG6CttmER_}v6{awWzUPQrKI zV}1H){`9ukWy$`yPx|P@gIZ_2qNPPp!*SkUqsM8zN#-1HrJZ1r$1pMS6yHNQ<$l?U$_0!Y`@3$KWY0J zb2;UfwEVljL5qQb=d%t6e?e~7iQVMFIcGE#wyL2~?s+`p#v`(V zy95`zK7}=a>`_iPmnCTn&Sp6CO3Qf}w&Ap{$}2Qzs@5s)RaE3ZOsfL?uhF`xTEY#h z1A^BC_+Jn3zky+Dt{O@i#ZA*z-_qw|Rf$e!fCQ&ofWLKszs?1!`J~o3>^aDh4*qVv ziBgBMW<%Vc`XrIuuOd|A*`{%ZiZ9l+Sgr<9zITk1&yTpT5cYl0pX`-LqLxl_Voyq6Q9+RuhT7Up3|(i zPpftdf^pB~IW2+(`ZKWhu6a%?RoazsODRF2s$wXXa?bTpJO{gyB~@IY*mLYrl3mgQMZELn*a_@Z#79 z;Z5n)x!Psib6q)48wE3Hrm{eTrO~%Z$rOS(tLv z%2P^k{<=YX(ZfMw0F2Fyu`A5>h1z3|xNWF`$@B;SQ!dWt{mto|w11-(-lzmWxevD^ zITzud1Z=M?vNx41f=WwlDzpg-PG~`9)3+etQx2Oe-_}0k=K>$uqJ5yW$}4M~V2*wl z?L?n$*{XfQCgx`C0LfWFStZ)DFr&m>y26A9Pix6QVa9%-Jscd?q!RY60KWoun=5xi zWbZnSInOQML0|3BKG191!rrC`N&xVh^a~a3)dVd2?b-_*>S>YL~Bs9o@PKRdnv5P z6?_UF0Jil$)gE-b@6NlmMf3}8qNpMV;urVZHMtWqKGQBKtIZLgYqJ%{2X2ZUtsD7Y zKrFTs=6&!zt106PtsCwX!w2=aFE9^2>xE*;zJh_Wnlu zygKeEOKdIp0)p59(5UYG9Zs{-=*nrW6AhoQ;NbFvHjecu7N6Ae5Rr2h&FlTW_PO_W z(kYDgUbE;FxM?fn)5^zY&JU0o;`*{|^nR*5qkW0T$7NOJKWYVNDGIvFp?u;COUxT{ z6aw9!wP98%ZOv^zYl#lL0)pO#(Oc4;dD&55et&^{8tccWTFk;iHbcE4D9C*77wtKR z@~Kr=?pEx1vYUsy^S_1GqMICei0!=gwxWDy#iu4#cbe@kpd$3)+&|FkpWCfC2nTKXIq;3GFrC!>SMj02i@L(BD+k3gfWlAR2Op$;qk^=GLf}k09 zq9t|Mc2zs;O-tJp{Wr&#z@(=f2I1L77;RetgVIMFdbZ*^gtjm-oJpRsb>b=e3=0B- z5Oa(?!Fo5>SHAcW!TJi=G`SM2$2-1u)3JFDLmnSON1zRcI`t8!W{wNddt0`#oK(^` z43w^h{e&We;h( z+jG>Om`sJ34B+X5FEkO%KfjSbsiCfGO1bqrdkv1dQguCHKU^S zQl-&%-T{Wlga4RiWv-F?izzuH$7<6PtIy_HyDUzh?K)v+!JUx?I=N2zys*grvEzH} zxa0MwkT|ZP9)nIwX{dK{oN}8_Hq`%AaKl?p?%c-u7$hm{uE$VB6MZdhUIy*a@+SHm zN_rJLAa^gwFN#@DEb(n@>`HY#l-4xWU!~rw5L#-c=nn_;1cd3Y`@^tq&cRmuvIhA??k*f%q}PwI zDQ8<3qp6B+fZ~x3#g@eVTIf5i^fih+9h4D>Y?Fzoqxf-Io!+6e!$sII4 z47R({UT-Ipc%XC-Qw;7K^>WwG=9<90qZ7F9rOs7)Nn;aJ!*3a`dg*n zhhx82j9wqz0rOre9;}vZU@Q`GS8~6*NSOi4eH9R5BHB2g>43@Of$Q5*6Rd0e#2%mSzqru?~hmERImXWPq8WbbEy9H z6uqlW-!iV^Ys=pV3N_ug=*12T>zAOg@jdjz4%hE?AHWR+a3ng}Tb~aN zG-TQEu7kn9{A>iy=^}&umApS`UZ%pNCxbub0SnL+pg@)EZNZ%R` z)c2vZ%7Gx;7twpEdV{>&Rao9r^+becrRoWeKiww6&nOi29Z#k-y{YT6uadGfeW>G# z+iZTD-m?aMenyMMNs)e;cK@hF@C&vMyfnvqHQaC1pHUo?(TR07hU=+Hbt)RJPlA#( zoUW9-)!{V9jnFHUuwZcX%q@n%_0XW@urTJ1hc;^VC_O5yh8^h)h%DwvmmOKNYGi&o z;%eD(p;hC|K?7=2aC^(S0zJF~|`RCT2;Qw9S~ z?Kbfhze;51&f zGt2MS(;d)#O?g1SjZW0laVO^ikU-tkAJji_1RJP7GB2xBc>V-^cW^j-QF)$y;Mx=& z>U$HAGB^T(b*K#tMN?{jw;S)|dCsGX(zdmn=F&_($?2+x6g+XDCHfS;Z)$K@X#N!a zMH>&>48S#<@{dBCX7LmqT+nK>&s6=_>bPXlC0p;HMA5QTJ)UvHEXW43L!BMthGSlS z@#AuiKF1a9E#5@&trdJs$|} zXPo`4PH!rhiTN5Q`;U1uvvj5&<#09dl>jo0jnN#vKT23ON57wnXX&v}9X~!xf6K$e zz$+9Fi`=SE;ioxHerr>EzE942x=IF!ET=INb+ z+sJgdUl0!U*MO95y(tF_tBdz~((puk>Wlj5;C9G^ce^-Gdv6jbnStM4s6UMEoUu@! zP7Ox@t-U)01m+X~f0FYhB0Q3>PjYpz`vW)E^7XFR>m3h;mF&C}SgsgDdO65lN-$(H z!x!npLGHFJ(qTXfFA2Y-zsaRNgKs+W5)dJYuDpa1>*y;D7sml3gGsoueLlP`JMQoV_+9J{jH!tu7sGF|fck1W^kadq+~JHA}sfDH|J?4PZ| zpTLgvN&y-ZY~R-S6Km+smqGR*6X&^@{t70l#I4A@La5a&t&QW6;;%8ZnP2KK>uc(- z>H`(lQDh>C`7m6$*~QXCV4Ap>$uTC=b41Ig7O@w5ruslj%Y3)gqlw58cgF`n(Z2N{f!-h!L6OywFl;09gJ#Q(Ogyj!cnk9g+24X!7XFs2r?>CT z@o(!BtGjx6{ls%Jf3vR1eU$fls+UP%mZTSD^#(;s-mE(%y~E8l`(iyhf3rTi$}={S zNMdf`K0%_6ThAZj&@A>Ve0$R^dVjguk||;dcFL z_z>5Gl6UCals*=kWIq87nArF9!Af6y#NGn|Iz~ks@VZ=7G0^xJJyNXSb*-eVB5=I1 z13W?bpI}q(E&(cG3p51gs>YN6{f^PD68!>_Z+~C^jFJ5VeLC>evlBywR<+rsce9)X zvtSn(Qh2t1sDJ6l6UW7)YYN5!PtykiDYtzDs@>08U}JZqas4S}pB@9k>YrulG5IiSBK2iZf)1@w-)ChlyPAHW1% zZ6bXyMMehG@lxQ%wkw!UxnbCEOfA)?Dz4kS#hA*c`g|!u`5g6!d6nrIH-l*9mwG>% z^9t6x^ii0kQD5lem>fO-h5kEwH|I-zAae3nzL%`aNuJ-sB3CDUtvg(Uy%kW(5j`*X zc6gJiY#6NKRvbYChS2z<`j5!Wq5?DX7zhqEoC~^J@r~}T<(*<(=2VyoK>(rz}-# zlD`FPZfd!{7DZes#|*r~j62R9h$F6V!L3O=7I^SD7!SF*FrbA`K}EIvTdX3scp|Yc zc=p&WN)R81Njml@PIIfI#a^{X4XAs4htVC*bfQUqPp5T#2m|yTw*GSJP@9cW1= z{0Q=#&?6-Z@W#{I{E>_T;Zk#)Gx$f1vM^%m3AwryozQO!eiJ+^j43zgTMsAERo~IF zlOVUJ>D)>EE}u9rod$ic3!gWG#(%GGQ1`xDRXG(l16!TaZv}g};1tkxq~$zDt4`?y z>pr)&s-|i!D4eTux19;*$%m5aSvA%HT+R;ffanvkJ!ug zq47WJTkF=}arNrN_i!1x`0CaClB-wy;lcBCz$cV)78AR=S#nmdqu|NzvUB<+*Jv9% zqUqpIn4%UsKS=9QoHUlrH=zUa70Ouo=cJ=8VEKdhJQK0Kz*b9F3bRibe)h+T=5 z_*2q<(c>FkL}Uv@@}%a!_?=b#Y4C#r3oN3UC!iHM`4>I3*#mYX9<<$YwmaT-C)n;p zbKNg`2ZxIVuW}`$tl;VbavbG6L=|6{bI)Uz=-FsOV6SG<+za|@eJ7&0Ro)hIE9+CA zKlEN6b63@d;)d)W`qi)yyc+)zpw>rMuij~{y9nw7y#VDB(77falXp|xjBwnrj=)YP z^%9UepE54#V*KcR*5Q@6BCfQ?o~w`%T$4Z#KpN&}6960@0l&YZ_34i-Ka1Zv4S(^@ z>xAXd@k_vl#&qS9eox#s)WU?9bMW8b0DltYT*jguN{cV+qwdW@&+?JStvt=}H&p(w zRoe@f;iCXxu~uN%zxt`{DMSAkc}7rJ28!m1z%aol%W}GA+F>(&VF5z0P)oG+$6sJd zm9&N94P5(PSY$N8@2`vwSiC%nA#6vAZ@43q0sP0f{}2sOj7vz-$6?$9#(JFt*_N9p z9mde=)^@;52{9l#Z$~4X##^pQ=rqYqz&@_=U?XPG`H!VRT-?KmPKL{4ItIW=@fOMx z;oOMrE~71u>MLDFBrHkV96FflaOzys=qK z)kagFT83rtry3{4cCeNagt8CTGJb{L@t#nlZN?NNX5`|{QgyUs2wWCc^Td7pI&q9H z9QVX^;=BjWQ~l#0%{4}0AGJNqXbtCFn9*VSH2(y4rOoVupS(`oAUkgQb>h5@&Av`t zH#=WW)wp`{EBQ?l{*tHsBWZhW<6|^)RvjZAj%O+EVPsB%kTLdhh_l(#{z>h2dq4Ua z|2QgX2N7#Sw~;G%12|4j42^X0#+0%47#($E1Yk16V|=O4Kt|9hIsCkJVDxB^mvsT` zv}z=IW+Iy9h>SdpA=1(mWEH~5hWhk6VSI**Avv0HSZVg0e-rHHacTUOv;5;I2f}D7 zFbp3gd4-Wzo&*9otr)HpFZGIXZy$Tr*>^N$3G|_`CR`vt7jgLFizB*hj6AT zrLi~`GiY*Mqd*D_tFe{vywpf1dZ?sR4VYW1XJk6U<|8@Qc?(m`{ZR%#C2BT{#xxGg zMI3X`5{u0#F__eN&TC~X<};q*iZuw|HXzRE;Nrt9-Vwx6*-{883*wByVaMS24!{ai zX<$69I9~AN)gEZj(s)Bt=Hcy6<3jLc)KP;nwkVNk8{|>zAQdg>4+d^(SKNI#(a=c6 zlVEbEmz;zX?$k!;(RnZu2}GJl`y0VI27~#=DO+%Gw6W1|#Mc<_bAX!Q%Mt-afGdDl zpvrB4mjHhPTB6Ne0fPWpfD*uufFN*`I-oz`9>6BRN$g#m_)L{%G%+5$@kKP7Cpgaq z?jGhvdG)v*z&ORovC!_?YiX!)Q=@sCe1uB^#@iwM#Q~Ud(RIQ(T^i*yHKtEr^ta+H zy3z+pxVpvH$T^bg@n{vmwnb;8jMN3}FFrx{SdwaiX1lZu)f9VF4LiKk@osCIED z91n#i7`tVlhjPBa?TV#S!$N}@E2~q=8U@2}e;;Fv^ zn;U02MVjeqi&aR;!fB2XgXeZ6?P}NF7-y3$ITeB^qaQ!G`n@YC*jl^JwMVYk==hCT z&$GzW!C38B?V(#cvSVt0!y=fWUv?qop7vXQ>(Y;=O7cQGD=Gq(#`+?`Ss5$+m? zZwJY&_9X4^VuXVpS9URQjViU@iEHch(H;;zP1RGsh;gNKryOHW*np}y^Mm=`$C_nWf%7~Q&f^}cw`A1zdbX3yIu++<#&iH}@vft&GUH4B%p5AtL!#_A6doRE2;r{6;!<#+AKR6&e zU%U4>!FeiYxP_BD`V#-Ap;D{@q|NV46y+De|U%3PquHAPkV@J8A0OVEZfj z?A=B~WuuATwUn0qL8EzCnG*2sn1^*BfO#@j_Fx9+U2kugeMTGKIf5TTSTtok?hy6I z;HT4u9Jsuo^F)(jq#RP%c+(^I8}YR{ls|(D-0GqA_Z#z+Z8l>%7V^FHF>Wqgan$yhj5bkOU;_0qjw;Xw?Ho zKc(2Le86~+$6~}d?Dx?7<3P?z=-fC&%CU&2+}9v2OdoFylcQUWavlZKRXQG{yMfA% zW3ZAZ7%d#{V=>{oD<9bIPRoT>+x`hgg5yIE-5igLuf?q(e~g-FIFT7<2`udZFOK?= z+mEPnq7m=dZ7)%osY+0F+)=uYri?o{9bJ~r;)BR*KjW|cY;x_V)Srn6@N4vNUUK5V?#=K|W} z1*R$~0A7T>VS(;9*NLm(Fe<4Y-kSD38y-c)j~GAwi;U%(+$88fX$!HU5FKIjc-gVF zK}dGtSO3XIIp#;pDMr6OzoBM^Z~)KyPJp2RZ+M`4SB|8ZcXYS+Uf@%&$6jPtNa&)WnjS+X2+)BEuX>lKqoWt&L7TsifTY9C4FfGG@TxZ7>?&~{tLOB=E}eq zF>?NA{W7cdl>Ury88wZVVa(SLz;Hx4%uDxfLNx{ z*m;nuLh1KTJ+l6O@5u5phrcTMDdh}Q#tTb=p|BLI1?8nCL1*k%J;-$cxss6@7K-N? zt*P^TBdYH2K&t8p>keQJ%U2Q}j7RO&C}Rnf)C%SsbELUGW;){myba)Oj7LO^FEimHcbpRw`lQd6b;<(?#ikbPOGs;TVgoeLhJODJDqg4C<2Yjpe zf7$?^FaK?x8A!_{Z7<+7AS9r^>Hlp({^?+#NM6PF5Bs0~Mq8LyqFyf=V=*8_FB&U6 z%+o=rCO0cx;i{Ce(6}G5gBF4u4$B86tXK$f-bUK95T>`1Z^G)9nQ!z)KuSIW%JXI9 z7XF=H8*IpMGM+)?aRMXU1O+ygg;rL_jx%wQH>ww1USy05<_kA&!rQ>%^|>ARM2Tq3 zween~1Avp@_!&u1=$6G;hfp>gnOBn$66s`KS{Vl0)X6UyP8qERMjsD_8Om&LbfmY~ zRWBLwG6VJksOVaGc_{}({t~;i`T>!Y6Ty`&F=D5Gf=R|4J@c>Lg9DyiJnu`d6W7s> zE4xlyD?9Gf>%{RanAV{q_cq;Oj{TAj;=1;oERSihfv>O|=>Bci8?bK5a?qHmCh z6PLr~uWVq4AGgE5h0D@#Z}@k1_z4fST5cGwlkhW9izaz?o4y>Q{XN1w)MmLMT&MmP zjkOnPT&H~zMa#j7|KOox%Z+-?&LEhZ^P}yah09HS0KnnreA(hw7~ye0*~xx}JJv5* zg)bROj|t(Nm39rk*jawH-QVE)*KppKRo3vko$LZ!{~G@ACG*vA(XQc7JIf{8y$sjC zhAY0TvWCCxWLM$(*TBM4t7o|ed2>>sqsxuRW)8&gCsnuIAh`Y&1p9Kz3PS8;HQ@SJ zfR_jYD}X$BB`TX{x2=nEX71Xwq)q(3@f!mkN_XQrS0@cnTY!}wZt5l%- za>@z}J6Skf{|X{}$$S;mrDZQ0F>!2~7?D1-tp^XYdQ3UEQ)klAmyK{&q_2Q0@Tw{n zb{Aq30Q~pl6{;QMG;n>o%PU60kovY&GM*=#glBoEZJCVc2v_KhWBy=OfW5F>__-T- zG4xK-C{?Oxcy7S$G5@M-!h*R|bfKevS04BoVcr(*`n77d75;w8*r5-j1w~ za2^>xwrmVH4uCXyADs@Pf>qd>x1=kt!=7UCDx-ymGx1Q?M~cC4AEzs;jIN$&cP*~dB;$=IGwUq~6Hw^FO_<-73hO#u zqhJnrjEc<=+ce_%UP@!iN)N}4&@IN~>Zl9P5J3-foADdYhK_H?2Q;C|{o#>(6;J9G zGLG`l@TWHQeyZ7J2P$+m^KVfMZF|osbT#)6ldVj2CHyT6xK?bm!xDyQ6a`WO&ql2T$SWiUV7~<)yl%BE&{Qil>wfO1naBsMG@0o(|snux0)!K&RQZ;J47rGbM6Daw~ zQL1RIjQ?lhg!fh!E(Wl4C4D#a>x+lhhT`qV#+m_apUNLt4#EC@w(B4FufM5mAEdo; z)MGz*-x{RUs3HDAFm~-buKjZVvt-C>yV?5_v3%_0%+y0T^l=bPqY7hCh+Nr$tPvc-+f}_ySjeYoluRb^WITF>p z13eA1^Fhd+9c|RS34IJ)sx=Z7+ExIudW%C4`wlT@9KxImZi}z9O`W!*LFKsLTl^Rf zn#%dV*sqPL(2|#-nKKbk{55jkXeV<))1>oZV^MH3$U_{I^(Agao;_^fVo(P=%RFQ$ zJ!Vt@;Yz+S=0jwQqPD{JuPm{29|%t3ageG`lyzL{-9WHQ^-(3IjbmWAu0RuNsm3BNmA2H1|hiV54>*ON{+-046)!@BU#-p62Bh zwZI7ozaAWQ*61(0i0#g^q4BfEPE_CH9H!g=T6_*7{#)(Js?n^UptY7p=YBG*#~54` z_p`A?c9|4_qG;xbtVOu&XXw`qq?Q$MQsr_(1r+go& zkpQc8``htI4zA9}+Q%!QB8SW7l|c7uG~yRyl!xnOM$b#Q5929Vyp2&<-5nG*2>rnf z9~T6z=gwhxFn69KNLugaAZ{!3IvmfHJMko)16O_;z@~fuUyc6K^gnZo+<2Z#X}%6F z`qh{ocbnH6z+(*dhSQ+mprm)Z&nqwL?fVUMWeANuZw#c~TMT)5uGuhent-D2Ksf&S z3`6^UMjL-g8@KMxe<E$i6b-!y6)Id|xQK}XYe*N32PwM@w#+}jXuQqG zgg8eB(j0&(_=3wu)O9CtI+a~EOjm|o$z)n^Mat&4Trp-(zZ;?6alVKT=CPXz;J+6E zOyBN78YX=_djiuiE^?aDNW*yH&j56`a6cwtsQYFd!qK^m8^aBSngU z0@fHc&VVL16fCg|qoNXN0(K2z64Nxnpl*9Gy^CoR6KkTWYB24lnMe{7lc>S8n||MS z?R^e2;N;zV|DWIgz0aEui+$EwyRO~V?pcyItHWF`%p~36JTE*d#T4LtFFZ^L30|=$ zk8hZR!aL|+kxOf?^Q5EWyB78{bvFyV@Dg=ii5DJeUlfm0FFe#A!7FRa+tgd#P*V=t z-wE?d-CadncWvUi&RaTi(sd$7d{wnZEPsMYZP^6Cb^vAdDleWp$XPqL9f)mjZGT+yQq^bceJ$vwE^m6G_C`&2dkNuJKJzw8-uZ) zh~#4&I?z&Q@LWjW?F!of+%xdI3_hh_uXX3VrUg{%G&ug}_sTF{4%+WR9b zV-MoSpVb%e6%&DD`xOo~u)YClrz5tP%dS2yCYm396&=+42sK?lX}NHmzv^m?P=l#E zIijllThH%obSawJTk%c$f)0~hc*0-BRoVGWT@iBeY}->DzWg*(7j&QdmAwB;Lt4`T zXfXtw!la3TgM@v+3!~JoD6Si#)M#8>{&GJ*x{zk$%Ra~4Rh*2@uz)NFP+8DnxM*SB~h3vGd+d&*)Qxk%?o-LwJ=UJ;Uk$+}0 z7D89sR1J2v+SIWkTd-YqML^i*uA))N>WUo3@yeTN$4XZ(Aa zn;T;B-aG{n!Z$3%0o(nt>L49I)e%`297mzKy2q&leJoq_D6Mssc2nJV{lkq^H#L{qtcT!gmyXKeVj`$2k#2VsvYCA0eZ{2Q;Y!R>zf&yR zTVrqSt-fv9(VDhjdm|z{Wdn4$7=9G`;j!M;ebg(2zT$_pk$y_Orp#LCr=u`g!TO?U z#;qAg2GV5D6)NVh`l~5i8-$xg&c728=!)&HHkg&WU9iv}izqy6G;WjdL%j|jg6fNh zGKZ+q;w3mLHPo7uN^IrBhNzQJWW=7C%!`;D5f_%y%XCy=sYSn=Ul^j^tT(b*KLtc@ z{sFgyZLzC3rP&~RqQVoXW=#%tKHH6i+Tn=OL5}Zfl|z0uGU8tTXSOIQt8&z?A*2&i zqvejx<2fRK-px_3L8e)UqFkUJ4ppBrjq9@EAnrmRrXGh7W?ZdCi|HuR)<}7#7SR}R zSowyl)deVKf5Mi$=LgRL59nud&?M8nFw*)hgt)a|AL5J6lJfGLGZU z1t{|^Bh)KQdwlrGB|%t|S%ADAK2p7fq%~4~5F*7ZA-E#0Nz-`6N4R99;gV_wb?+!O zS)2kU8Bo$Fa(ZnUrRHF_8?t7ef?cw*7ymZgpNSSxw@%6w6#<$3r*hSDh{7=jX|eJd zV-ULzeAO70gBUSZEfBAmAT1pd>Yd49uDY>mxFYUL^5+ZhMFX3+4qIt5H{xHgf~miz zJT({|H0PgDYqpdOKq%=mS3r*W)6S*txjTNmP-8&)ITCTQ-EyMW3Nm?4Let2(Rk+E0F+L?a3Vso@~sn5sG+cf?fPRP#3qpk z^-#0?QONBRP&Lnly~QUvWe*5?`op?QP-Kdkn3gn^SDR;e1(d}iq&XQ;(dAT zC+Ip4--ips@`_cn=-d?9pOzG>n$Szkym^gJSKN$@ndV{?U%X^^9r|UxBQ3lR4JS6V zU#BZ{MvG6?9SaN~3*At~E3%z%7fU7v{DI0R630<2=Jpdhi}EVH=rE$ zM*rW^{v(n5I^p$yuxCr78EK8zm8#*QZu#+$r?EJ4*o|KrNjnV=ccGnl>ks3?xW-R9 z2lMnY)vj!Em6k!T(G@o5F*HE26=>9+aAj4X*(dd9A@uS+uG0%u+<_sb?y^^@nWWP# zT%^)7!_5N&aX(jsDVBe{NL{Hk%8FI77~jkJg~jOm_lDNrk!<4|m#7mwUv6H#27Q0< zQuO#wa>r6t-lu9qvZ*JcEVOXvfKV0l!L>`#dF{eIJa}4T&@wd--|LsD^TcCp8L*hZ zcW*^2*YF$E*VyH%zv<~v{z)3%``GbYm+<;C$$@;%aT~NzuFcU;-)CV%pF?(e6l~G((6uWexYchZnjoYb4BpVy;k8;>`-=f@m17>*6p z{d%55omP3^Y794C&|6S_55eTsY9H%3XwQ2A9nQ7YmWzSU<{S24sCRg^x*A8o9kuE_ zb{&-JURZs674REYAW5sxD^#tT;G2$B+D^Q-8}>Elr3RTduTlNGAHZF|)F7q-NOpGs zM?}OyHbXxr`ky>&4f1&>)-U0y#ZG6>@sv0qWW?fh0=B$%ycae9l@`>)V1HNI)3$h{6QGJiu~59iRcw2xtPF1}Mn%&H#nSJrzKQ zHIJ=TUuiQX?bZ@7q`8Ei>R)jI5txp}81Vnqe;sKv!Ncf#+a`q;;o>m>`+qE1nelj! z>)ggjyeoB^dK6iBYE596%l~#2*MxO&4O@p+2Er7(%+)~BHK@u_t=JL zx_Hqx^;6xO5!(^cN?x>G9gpbm+YaS@oGX8a`jXQ9AWFSaEU8&B){$xI_&30{fOJ44 z9;3z9gUP$p!)RgI-D>ZkLvTuC1*%vc)Ak5q+1=2t_wZw6U~JxiMjL0s8b~d5t!hwL zm>eKt3IK}$D*+n-Tlj!`)v>uW0d4@P6~_1f zClk+cVQK9JEc15^L+@%ReUowG70xAJ@fF1nw z9+e0Egoqjt-nz#gW6jI<;0v0W|2P4siuMU1;$clFO$}RcrvsGd$vDmQKPSguo>Vi< zmhTWdO#gHk%ClUk5#9cib@Tr)qx$Sqhbzhv*Q)2$AtvP^zPB2g(X<~5+EV#lcmRC| zp1dIX;m>dyDDMMQUo;CJs7oxO<|A@=@%90fres&vK^59MsmdmgPa_IjW z&~9;Wfm6TrJ-{39f09=7Kk3;8 z9h?-NE^oaW^r1Rkw&w}rRd~!5e29+a4A1%qZP&+-2M2EcNX#SzeS}HbLoSe~`T0(S zUi&%U(2Oxr0jBvd325lxFQEgmBbLALxKp^&D4d6UhGDKB>BW5EEK}I9huUpm^lkaq zzi5*?{YX)yjtM1BsL!LJbz7n4r2y3AsrtHnRnbRv}7syoH=!u^=eIrCr$c4VEyx&t*K7@C~y9MC^V60XDMlT42@sgwF;0ThmA%S-Mb>E`peM_H< zYQfZCp(QAtw|t8RmQsU`^Hx059e5tgHt(Q0?8LL2jLwQ@okwYXhv%MGCwaAKF)TJq zi+`TSjIo}i!xtz?^~%O*+?r3bV4E*uDFIiiUc~%7wf49wI*+bX-GnvK%&C~^Tum0% z@>A1r>wUv^Y=EN`wNCHoGJZFdU-i9e<6m6F6z_Y;n(tJb=}Qy8>N_v_hdpsmSf^4^GDk6i5X>`zk6&z z!d<(tck>d2e}MabuV!@mQ1|*H;dQp@W0?-im++B(as0#&v}N{t_@aCLXmHqOx_0`^ z_i9S(J#nYyCS;!SgZfY_@e`fc@`E~5+^L-;e01K8dYAX3dY|djP}k2ts-X$&45C44 zr=|h*M3muX&>Y-3)jurqGY>Yng8g|YACs!7nitmDR+sEcFYK?}>~mh&U%T1gcwv9* zW}o-MzTjqG^uqqm&2I6+zT{?q?}hz?oBg8~_D^p1&tBO7bhCf)!v59G{>=;fcQ^YF zFYG_v?7zIQXt*F0lxSMe@gEv}lWp$!x z#Es97(T4Lmnih;ZTSe+d$T*Lb*eHpOmRPQg^B9SZl~|s{@+CG-V&f%-=f6o}6D4-7 z#3o5UCrfOK#HLCNmt~Tqr%McP#}PJDVg(W_l$cXuc($8Dm@P3p&P`a6#PBXRVe=$5 zUt)N9oBYJf+r-0D+l1k%ZNf?=Rwl7>iB(8!p~NaBRwc1&i7k@YVu>x0*iwltlh|^J zt&rGCiLH{@^%AR**lLN@N^Fh9Zje&CQDQeq3`2Q}_01ByMPL!Pq6iu78EJ7;GH#O= zZ8ua5EQqa;L=VB(^~YewW1RCALvwn=}tYD>0YEo^zc_)&9}Nx)0JNjZVXCM+D3q0O=&u4Pu(50E_JQ zf8ceLGgoT&iM}s{-#So}+e{;Q?Icqe-Q-&Hyq-za;nH*i>7#1_^cxJXNZWe>c4%_N zn;lGB3p@K^$Ix%u`*RcAl0OGvhZYP)=MHz!C~G>*)0qb^XLcB`^A368Q7=iJ9`?c` z#hG|VyzodBCEkmI2fa$F8jfH6R9wgS=OArh1c{LJIXi%URB&J7wS%>;f<->q0rVr* zQNe;PvU@Pf!!ftTE5Wn_=tmY`CKi@~N8tY5z^k;vnpeEUFAo+eey@7r8QbJu^TH#w zg516Cg=cJ&d!sE+Ub<-PlRNIo1FiTAC=MY20DgqHD0vLZsyc0{^>0MTL~od(t!7vQUX}KJni4 z!lUdaUXvHzNXfgp!znLJ%0Y7YmKPpKg7>y3PslLeA2Oj%lj}gCAJvNd3=-Dk^#i0;O7GjZ)h>X z4xk^U>Roq{9S+nEpdYc`bF--C+5z+<);|P`QDvc#upK}@V!cn1!$vIV{2ym)!8IRv zibc<(iLgiF{Ll-}q4PfS!t0^)KK8<6I`4E_9?$vJFCvjN_x6&Yk+&T{KZ^J#?&MOP zu>;U=^ui5P*rPvOjAF)1jv#4^}0rVr* z=fuLwZ7!}vIXqO8gBR#0FS7(uPp0xqL$xsL7f9#d76KkO3{|O_ZCEXC7KQ_DSeImg?`La);&Lex+xMPHMB1(e4euZi(!wTU zcbY)$Ad%G{y;$v~^M3NeGiuAvo;)GNq^Y_TJzEV5*$$u|rSYG#)ORN-dNvz|#M}3N zzfkJ1&vdw6oN;B>U|sTw@XijPA9?+&TSf^$?Ev}_>o+MQ^r0o#SEhvz_#LtTyF$AP z4oEV8c&1R7S~0(Ll@^w02yvor^)D}09lX}Ag$*#Q8Z8h_FSk=?#C;JIqT(2rPt zf+bpv@tkF2yhde<$Bx$gi~T)gsLO;Z1;yUth1Xr@b@IZaHi+B>c;SWNI0+KqBMKJZ zKN{n^mHfnLZJ>pQlk`jCO12gzMi48;Z12U#;@Nd0IVsx>I?Y8sV)QPT;3@;r))_eC_ZkVV|!)w3@ z27!rvcNFp-{^zw?LQo8>lj=g={>B%M42s^onT}*l(){TV?zNM&tCd6bS%uO3xk*|$ zNUoEUw7Y08k#maH+t(^WYp%i0Nc+7wPun;}>n1Kt#Lk1M+7K));YpiuymqRVws|Tx zhZauN{Fx1ojKouvDDjkI!d?b;*YBOG;UP~G%`><9B5DA(lf8v2wlk+`X3=Jm=qP`$ z1yBym29VE`$<%{TZ_xqI1z_f{@h4Qkmit44dEP(i9_b1^(+b&4qjF%Z0>tto)3rBg z|M?6pTA9lqpP_A6;`oS}T5qw7mGr(ifKj}z6<2?XZAb`E4CN?PVjIs!8L|WUx#?>3bahjwj3dLH=Rw%WIV1= z3+q9jRPsq0RFD#3#SW8x69A;|7}1X6&O)tgNP8zqd_y6Me;iy=MJ1n%*x_N81uWW^ zSOH>O%E$(BMK0;zq@9KEIGjzP(+d6~$Hwq1rp-MS4DOkaSqJ?2B=N)Y9DW)V2!0^ zJkFu^#QrpG1#jwtg{J9|ov|RfCerWUY~lPbuV*`Y)*rWKmS|@X*x*ua+L&ih{0%^w z#a1GU=S6@)Z*M;A;l|+M-cZ=*pC~@KEw~X650z=*;+O}<#;r9T2Zzfv>;~kHf8e|? z-9g8-U04uymS`(*C&uojT5oP&sue=I_` zTAlk>Yj2t^&mY%KH)x+K-Nnj0>{AzF2aq44s-Xh4$xqk%o3x*3RXY_{s2{rqW(~|~ zC=UHm;|PBpCT+Z+@Bd$*#*4=kp{Eh(Xa7aO!Du=M05$=Ph&FkA8?^RjO?$%sDI95} zd++$|w`vw1{1v??z8PmxVxR5k?|T{%S8#Fyd*_GWs$GFq)=TTOQKo0ju9LTFp*|s( zAQ)(=qDQ8d?gDq#K@-{tyQU9)Tvx3pOA+lXg^;EGzCIu;xSBXL%+*+@{h^qyH}NO# z(zYp+aMPL=!DrTM@io)N6&7P~a52iSHb&&>F<5 zjp*q+v404bup4>WA6c0-5@386rY1Uy+ z@#78fyJb7w$onUrf=t<_t>Z24s^$<+S4-i8Z@ps|y{)Kytn|h{IIXL1AM^lre&j(M z7BAec;qFqpDzt**snO$iYu)I;)1?N?t>fUxEGTy|yV20~;-@08>AP;X7NcnL`|xgL z+}*C`-5Rcqxf|>MXbA6iJ$x@*;`W~-_i6Vkf4Pe8*IXv0ugm(7w#PTF9|epk(T^Ic z{_XH9_=U%{-Y83PPiT+gPK*;zXy|bGsy$l0WgzTQ;&uv+z)sd@Hk*E;2FR^zyZJ!z%jsUfD?dIfc9a$3);tk&jH^7eg^yrz!9hp0e~(F znq_jtfW!iD!l*+}0MY11nF)Ym0PPUk1b7tiG~fV0L0zR8pfErTAQ3?O5vhT<14aNy zy_yD?11JU1p5Xfc&jF|dIBDvQNl$#d2lx>13E(pTEsuW#xCrs7TS+c6eSpJii@2t{pxeGkaQ&b%F_T+5feg338bU~!W@9MFJqN;@2H1j13=w07j_?eH07Ev)_wc6$`Q ziZRzr-uxPdhy`Rs*EfyD=Bby#d+b$hXh@;%7JZaRx|1ufX&Kl+nDrXsHCtdIbJ|%d z;u~H=&6_LzohOa?(kPb3b<$WMjS^{;N~25~<|iPmxgx0O*W>}a2i^fdcEjk{d3-?wX57F`4bUaAM zZ`W~Xnj$mS={RW@6oK_Rj+Q`N_(yX9)JWd}IvQS{b5iR;TJ%XxwbV%(_B3rci88Z6 zcWQWjmyR1=*So$xiQYlk$Tu`;X{Jqve#-G68U|bW*gizp;kf>2($00XY;N`Z!u#6Y zow$LT>TPLJuEr0v$Iv{xFixB1i_T%+8LdFH>XdHkAVh0!eDkbkEyEPi%x5)g@utLP zzP4HG75_kU+XF5?wZq4L#y@P&E^EVfH*b&WVn1DS1n=av% z+W8d%K<9qy9O`R>GJtdO4hzRdq^LULkI>JmpQrvnw)}sup%eUeq#zJV~z!QfGSZlzwFEb>zv>uztJ& zFD780q&rT>Wt>h(7lt=`ni0)uk?}4`i$w4qnFW16#l(h^g)$RM@+Av4uK3dKL@RbDroV>A+K-x8 zp5XN2Un`h!Vqekc&Uh@5+*SV;b&%$P2_hU&o_aEZMji&Eka(MmEyKXPEml z-2K^=KA~|Z;Y4s#3=0=l@q$J)c3Du7j3s^o&$O~`0#D?pl2D^6tV|PlH$3;l`dg@D zBkL({pHrpFSQ`r#Hq*E>9xh`|D8lJUbS0*ZX%yMzHukKrfvY8>nM$NFU0F|&Qr&!_ zD?2IhSUu(Q$aCEH_8d~aKbFM^_nyQ*Vp%4+=o#16MIGJAu{s{Is)%EQ$i@?KdVw40 z_R~++NPaPnT^mK|qS<0v+D`K2pE6glBoal{stvBMov56TAWS)?FBHJeX zp3>?~rogA+77o3V-X%Uo(_2r{;-Jknh6G~Sg)P)}AKat_W(GtV)?=j(eiZu#2NSCtRVU_0EC7Qbe&-{IR&nJf)P zTozhjoTJPVK`hH+LxAne61=n02P^@sbIU03vHS133i z;i|lXWh+56r$EX(O)Ntd8^EH)AqgT;O2s;)>%su`D0Qn_2O{>Z`{mDv^A`uPifXv=Y>ZTXT)pqmhr12Izn;!H7 z9EqU-(u=*^JAJ}jB@VV!G5sif=fPu{`Pm${5!b-LMhdSjN5k1Tl=@xQiJ@$gV)`kZ zCtc0P==}U+;MZNv=pK`uSF>bx2r;@DKtsq_043&U1d2_=@8Qa`ycs^`h~GdXK~Q4p zCxsqz4NErt6T`A^O_8p=YuJ2K#4m6-0Tv2qy9$0}v0weE=MiKx&TiMy1(WATu>H9E z_S8t0!B=OpbesUjXg6;-#u&l1nConKB^0}n;P5oh8ig{56Bt|AVBYz4KR?|5#A5hk z7qrp5Zn9sX^1IOd_|S{kBA!`|@kwKEymb~k5&HD-T&7_h+>wTL_7=Kq_WW4nN-nqNu_30vpiJknDAT{t1Ld)2 zkwIDcEZLWK#fI=x@8R%HMLvtgUi%ICEP;^_NPmd~OaaiSjHGJfC-Pa1=>qz!aqK#a z4_wPSePkS4f$Ye7h7N3uXG?vlWcu*@Xe_Lr8P5V4;f9a2?n2IphL?$LAt*Ex*l0wx zbOP%dbPlZ90Fpc|gPp)$z(@>6w5wtwt1~G>xiXpMSj??~=T2rXVXP4{g=L5}SBf>Y z6EctUr?4;!EyW5lZ=T8u`0*)hvRKiL_q2-dTLAPc22g^15eSV%{CNIUmL_~RoDjJq zUq6+pR$P-LwB6+(Q6Zz+M|~!R8qbeRMGA1fXBrz1180O(ME2`x4C7ATJcEtJL4~ZD z=+{=yKz88(lm3k}<};XG36ORITj~BvQ0upDr?a%v#Ra$5C=tPkG*x(#fk%5;08Mop z-wVUzHLB(;WPM8kn=TfU19^TS!~M62H;wg;TAM~`0npxyi7;uA%t#-0pA@3G`~@R| zLblvOC5Kc79EQCTb#K0tVVaeP{D8e3nX_0rA~0hXtATNP78^T&4maaZT*7ZmmZiW4 zBm0eg10hI}9rk_!P^7lGie{tWqk$M)#J1xe7S{)JnUA7`^3(GeT~-q^ABnBuedn_( zS^Ea^FXkioFdkBjh7^|o7PB<53xuYXC@Uj){{1Xr^GjiYZOD;=%=20>0IB!^vsYr6 z-1K^Y*%pdOMZ%>~oT(o)e4|yO_d56EXDZOcwKVvftp=Co=_v^YPGK{C-XPi!o=SnH+NCID2%DRS-u&LO^ z0r~>E@!h3tiHK`=ZY^VKggA7j+n~0aguIrIC}X4AuqZi_B~I(@FJoF9)l*Vz3|Uc* zQXq+XRFXvOctttd{@`-d(qz8(0c03mz?|6LG0i)Ytf&%^0!?YcKmo}k52({xRgS`m zb4BHBwxv6Qps{-pcfNwx5MnE!rsHVf%nH^EHaAo-c^Dy>AFF`gg8ObNpem-q(E@&H zL}yH^YIxvS1jlDAWY>rmY8?Edq)^CdytW!eqLB6u9bd>|_1wL*kWHg-##FMA`ff9O6kfXx*F6AVUZ7%3AsF^0dJx0 zug18Ja4g|2WNDihu@p*a>LPX}Hd-mgnE81N=SUmFaEo5>SRDS?u?Ugu%}*^NwIT(x zgMH|`D;kqai`Wf8G$6WD54A7e{sgBV-@TY6i!w<`pfX9#<5`}S-7#$QFSxI(Wid13 z?t55E;Mx-8`V~BX2^2gk#unWPB?H&s8)Tz*Br>kWUxHktt735@e#lY`{u;@bvs@X3 z)zGFTD1(EDE+gStF$NQPw%*YQIp96#r5Lqbg`hEYimJj7FGW+hmS2Fscs_dYDi&SS z9ibZ8LH#oQC|w4PB2Kb5>Yp7rH7_K5vQO129zgb~?=kE-{x|jvx5z7g?=t3)k%lI6 z3-jN+9QvQ!7k9;S7A|@$l1w&rbt*4e&eDBzM2dC~1fFtZCmgz6j>#%$p(`*u^E>RK zH^V7_c*+_=smM~br~x3z)}ah`;gzj`Y6SDP6|5ihiz6%8S9Ff~k(F#QA{7S#;a-2p zY2Yv_Sd>okNazlAES#5|MWxiE z*7Ak5Y&@^1WigSIFC&q7YHKNi1%{5g++NQ$EGcyK<@B-} zSY$la4N9O<=5sH%w`&ciMkq@<^W7i&hACtCi8aV1a%tv{gV+@E#~M}`I`(pxtsxj9 z>5Gu^F1Po<4XjsU{$+G`%`~#Y!vDO1C5Mi?%qpj#gl>N$8;4@Q`$jfUiFBR5k$tWx zm}p#!mTv-YUd!%OLR|}QCcP_^!$hxjD|-wMPTa~8A}C3e5%BQoEurj3HB-IDpr*Y#x3ep# zW=5@JHdq|6jwQozu46X{`~KW9!K7|p&z6c!#x#dTnL>IBW%wSxem%wrqnPL{*%b*v`*0g z+i@MNV<%~|#rnJ00?%s+D+XZhzVR+hPiEF*ERRjV^(;Y*R7fAE8Z;R|0gM6|@+Dal zPsVF+JyX4mgFdK-=0HU-kXtrl5_2MCPpOBFw2|H3I-7AVKfRHS(&HqqMzn8YlZAA# z`>rpx*fu5xh1VBuF}sd$!fY3**Bq1MllZbNY@SrMCn=NhyoJ_Q!JfhwZpB~+lh<3> zogyMo7d=m4%Kfa^-+DKT4x;2x>?p!g8P(&y_Y1mzWE*QVdJEjQ5aT7oPHg}0GOQ_9P`#J}Fb3cO?_oR9VwKLDceM&PMFF;U0_@ali5m zOW5WMKK{(;a*Z1gjnPC0yfKIBX>E`BzAB4!=@y197`yO;V!TflxrR}g}CJjrjX)|Cd;E!Lz!XVzh_zss5 z{&+tN_L4bDD8?M(GGqG#tT2RhLL1^kb(P}fB=tH+>BgI#*x$GA6V(3T2hl@i^SB4u zDBhxCjpx;ma2fSVqKcLZ2YGjZP;n(@PYyrG!uit+@vpHbX08gU6D0)_$x|MJCPZSu zdCE0tbuu3kn$V1gFqRNi8M%ZLt}PF-$ruiec$hsXveLqT!Y7Kv&PUkI;>y&kc}S*z zm}}6ZD2VX))Sz_`7{BFl_&$jbc!K>)jA6(Hd2ZBuiz{~zW`!VuRgExloc=g8#aA0yikGHJ zWP@i@<-@!0MXT(?@88SbR6gO0oce+-KQc*s5$9cSbb6-;6o*=Shn z&vW;of*$2X``8d)+Gvj=_OrjL#PK8hSeST{*#RQCpA8^)$^2`09kLO5PBAvT>WhIm zCeKoyXPLg)sOCOAs{nY#^DHp&04$PS^2UhDLr|eeVut(PeE0Kc_kV|)pm>n`@YkMa zX}CXy|NK0=O7tY8dyx>R7l{NI5u-CchF;be^y|3u1(XOEzx4$+O2h#c+Qgx~IQsEl zUqCB#fV2I=7_grW^j(1b3FZ0uCXBB3vp%M8!}-hm(R&}@XZJ%<7oqaq%di4XftK(d z2SlI~4~Q|N7^G)DiQ>|503(7@e&7HG&n~;a^{An@R!w$iGV7gHR2!@)w_=qEzamePiN067e zIpYZ0ibdS|A{v@Fp8FyjIFU}PP^(4JGlHW2nmQ>vfPO}Leei830)7UqC%)}Oz|Wxh z^V2V~v7*uK$g^I;6wzXoAL1g=moV45#6S_aQCf{O`SaSBP-{g!go}89!Sby6aXkMh z3qvYS!GC2MU-&W$o8l>>32=CyhhvIp4&Yiq4*(_B7>)dAfmuja)D5Fya0IC0kFks_K{jl{N+Q0gh%VEGZ=9-2(Cx(WKaXLO zjv~`m&^=yeD)ST(9JGo~&wxoH1N8Lfuf@jjmLfm1#Sq6HzV~IlTC_dfodn&WZW^}7 zvHuX8-jsU{uH>h%wfZ%z`%!`- zc-*T@6)h(fZ0b_x07!_$rg_8mv_RoRocj0X1oILUF1Zeu;mXgp;o`0}BV3w~Y#&B< zFSG!U1X30Ty94rd2ZT>}EMi9$sJ+KN(v#NoXJB8dzTKsVJf%jl?IFAtv%tVa?V#3) zq_UQ`-dbUDOW5BnVSl$_r8HClciq2Gw^^;^Bd?naFq|~NU_J!ncxYl&fFz==tj5gP4hjtu{VT6{Q?X#8sV`zN$OM%odV? zpz{qUP&G-)SdMEG5fT^Wmk|+Z{eoc~C#Bn1r?`4rr+DMOA_!nWH++(Blwpfdb;v5U z4My8xWQ=GlD5Bs|3sB2o zn>@M!{6K!>q<+6i2fq7FWRG+_m>kp3)3IkGOtU!NJiW2Kr;a9!BW~h1HL;p0Bv9&^ zsWwqkDQPr9qO*&lY1V0EPsKNNZH7IfX~3yEd(z;XYS|uIKRv}#gj_oFou?oGaza5- zTs?y%It54cAnCNlaEjL(-eTi($;t%X3dO`T#ECkcV&h3C?+Dt{1NecrSV9eX*-N)V z3HEeKrHP!jr&9||bYo~n0waHjMnKy+J^e}7>9OtTm>c5-Z?pU$a!lDsj2wO;lb)>8GuqK< z{7e31wxeTmyPsgt^rojrq{)$kUhU{cM0@Lb{SHfUP(MSOBuUixp0DH7@6(U`E(VYt zPny8_ly@;{Pfls#(a0FeK#Iau0MDq=sE_DF+R=OKbbC8`AD!-KNAIiCvn738Yrs^Y zDS#ZwXr)sfCHl~I^Z`13SUdV;*Rc1nFoiwLyWhuJk>|K49#)MiKbimZKH3dpWA+qh z*?Hy%7>usv!#;qndb6wO1Gdq}^~Y(pB`h>B61R%)>!39D>Y!xr_U~|Qtm}bGEYil0 zc8PM;SO#U3mQ`nzl+SjSWK_*@W@VIC%`YxnQdCmn{^|j4X-Tgh#bs61PB2P}XJrUd z%Gex7?YvXgbwGUUJW&IkVSM}wm(v6|C0Br1mIhD2S@V?(2+^IJosg803mQHSD_ zoFz+~%c{CL7gd)hmK7~7s;tYdv)4IdV`CGYrE~iAiFG-{qSlx;+hZbJL26Vi&fR18 zWK@0Eu~#?TV}G<;Y~}3Od+d)D-eb3?B~}rJ|A|#`+#C}%M6>rxtODLcr%E3Fy9#5X zCi=SGjf+Z9aQ5xj_^4^V-KNG`Qg}hvs7P0NLexb?xxzIwG3uzC5{h*kq2AJxG@?J|~mh(pz$K1l} zmd3p7nzStDv#$QXU)^XnDSm%($JUtiR@lg zYdt>azz$b@PVtRfV-g2EKfTf1RWVJO+GvhdOfzRRn&TAH92oJ6X?|{_IYBXv2d|rA z8UZ6wG3CNYQcMp1{nnVLloR}cZ7~A|yfw4YJXBHMo|TeXQCT#nXl`n^p0i7f8_m}s zxd;I_h4-1=Xda;`nbR80BNe4bQKNa3f^BEo_L#BC`>y%hV`hz2uHoQ7! z@|r96+n6x{QPCsn;tFEplH-zN8-0}+rNgn=Fs(|5qpoLuj+trha_{g)^F_t~G@|>R z;@|9w|2-zLr==X>n()+Ckt?sebxjCAKhQc!d6n0ki;3h@2U%aod293i`Hj9NAH{r- zOtWHsbrMWp#r(z?n0P?0i4Pxa&72gh_!N%?B}DP*Uj#E$@yX6@us1jwvQeh$91V7R zLk_;cidK|eGhyQGwFk*ltDz%z^`zx${{9FY~td0ISts1=A+B0%E zvOYlZ8J^u}4n(YA1Svi-t_iEHcbU2+IkM4t`zJXZ!pN3bw#4ibb9K7GI>rx|_D;Fg zdRy!#V;jvOis^?b_uEBjG5z99C|X)3ut>#6<36`p`(hn_z-`tMR(NU-$!RpFD&`j^ zb}uVhQYjMAXiitm@42?#X3aHGCU557tg|{hPMddaqj~ylK5o7B!H}fvVKQdYun*&( z?6WeSaECR$OH%ew$&&`3d585X5OX9^8vM~atV2Q6(*R0y{w|BU{P7|QsH!HLqiXPxTLtOcP~L5*3i(?pw3=44-7%Rx}m{k+F%`G8WoCI zWF$H(E1k;vS@BW7P3D$+3r9Wg9_`( z=_NRP&=xC;PPXT?wLrC6I8EUdWFf_#eYu6+Y8 zsr^5u1m~;f* ztBqv{LHgZ;pMj^QtbRNnZcM#<@zQNb+yQdd)0?w?eJF?wau$uvSS{PFI6kr6YEd%z zDgE2mPedbAGINQUC7BDhTRY*K9Cbo`rC+!e0l2TgdBt{Xl&^>#zjM2l>7S2pw^}J~ z$G2N!$ovL)N9npRxmNxA^$}tA<=5@7#zyu>%+nKRRV{H=Q0pXZ_U8>dtPx6o*RwmU zHKu@YM?z7VXhOnV_PebXKjk^s$os9g__*GE*t(-PCDY%QDs=KZ$2do>CBCe@3|f12 z(Y&I{*a~N*v$UuhUvtYVW8;g1E{=MU{)4 zRcNcLK&`5t1C2kfBB7#qc6@~};wtz@pIE!P{`$n~>*Ig-b)=n{8hOBH*2OrUy5=+M zKpZ0V``nrlTXP+zLDplc+KQpt%?(P#Elu)gZ?q>kD(5*ArOxhXv?n^K({yy0*#t(a zqpG@Keo+ac;ZS@I*d5tAt<+f|XdT}nYiW+^>dIDo9p5KfVm5W;4#mF@T;(*{`Kvy* zq|lB(Q5ebD%SaSu4kdi+X0t6ac^XkuhzeOOa3~Rz$cuC$R5)iZa6)V#7UQLNTY@S4 z0-t5JtuUFstwwjsbI5nrVxB&7jbyhnROTLJFPANKJofOa@BA=X7URr^?L&$MW zWJwT;OAyhBMIsVpp|rSaHf$u@vvYOcVd~NYL;lGGz4=tZ9D`6Ep zdtSI6R$5#=yL=9!6#lJO{2qpdnbKVgyE+m5XLW zp5fiO%g@%M%Q&JZjxJhC*@5#Ew##lINtnpFQ891U^U}CxTFg1e#IeQ2devO3^;ed-&U8u-AR0 zzb)mO&`(A5@`Pv3D)`s&A@VONPYk)>{ZR6)dtPNRvIP|pCE6x@OaZB^S~&6jo$vFv z^%)fY1$mYx7$wfqS#yxG;73u4D1Kxc>4A8sNRb8xVtkR~e89ySiv8@-wifNW;Xk zYFH8FA>a`a<4MlSGATTtm99qvQ0Rg%32s`9-k}iyj`o{J7?M%v{!k*WUvMt*FqAQ}a?VwMv&Gz0SgRf|q_pdJgkG)mA zYAgRd#P)1(Xvgc~En&&dVNc%Ce@ND#I{t8|ZEx@=r$c^NJ78DE%Jk{3z{le6;MaxO z&ITt(U*BUy`2#=S_t(@(n;uy91}_M=y&PPBN9DR9eR?K3C;0zSed^dsSKkO*p(%LR z-k9#I-*())@@z(*iQ8{q#qU>b2ZKNO^60A%U)&dcuJG+m4Pn+hT~(Sb*A(2R&+Stl zZBRRnx~jx{eOAyG-V|kv;Q`UM{@Ht;8#+3VCXzc09X)zHnR(+zrlr8M+b9Y j>i8+S*;xI$K4)AG_?>A3S;rh`Y*_;a449mmmG!>>R>@vh diff --git a/boot/ocamldep b/boot/ocamldep index 92571f5e7183e97b334c7b6459dbbeed5d1eea96..6432b6b2aa5de3aa85887a683e90da2d228ba147 100755 GIT binary patch delta 41844 zcmeFacYGB^_dm{TBY|AFmzzowNJt=b5At#db^R-yo%!&o>G;_vVM0Gdv;Y;g`ZF&Z|a?52bXeB`yDd)ycyJ@00BJC1Z!h z_(+o8wMeFTJBmsk(KIumu}15U>tSYU;|ro6)6E30Cf1r6UccCB-sny8?5S6;UIbt) zV5eC+&u`}VqJyYqZ$+7v-e@X0rf9h6--a`_1_;1pKm$Niz&ODFO@XkOr%9}M)ojyb zsMv4LZ8BNBX`XDd%=bD9oCt6<44Cu%i`n$yKSHi5{2}>&tXU9|4C-qU<6}~w6Sw6p zfCtbJz-oPLc8F|_4oaM%#G27fyr^t`WRjWCNDBp5W_i`je>%!6iS&v}vn;ZoU36+x zve->xk`YA(P0`OeQLSyxPUe^uGd+jyh|iyNX?u zHDB?Y<T1^wOVw#JA=Ioe3N{FCsC&jhq#hCWcrcKknVvsqtX>7a~&A$ox zIL}o8?iDA$*DPup@UX6705%eGP8m-H55raV#*Pvb%*42!Vgvq9GV|g_(uFIk*Zd|f zP7F3h{QX&vAjj2!Bs;f*CkNpzgYZ^Cc#4CY2jVG)J8G&;;TBJGu8S8o+n|cyixXSi z-(9IM%yqYZiKZrwjWP>HZ^6}$vF*$$W8RRo@%TS~Y$r+0#s6vJCW`%(9VMd7E#sDe zASMho^Ty}NtB+Y=LTvHr2@3?Id?$=pGw-&pHudmr_o}+=P!e&%Up(QCUE*&>n+)N? zDJfjs)F|`tln{yg&9hU&C9MnoueiU9Ic4e$T;(rF!v7glV$G5TEEzv-I%`*?q?p^M zO#s0+eFF8I)S;Tf$>F*nw{Fz0#QaIoSx=3ZbcWNlNEiVx45BSd{F z{8W#k^*iD06Xrvm;{5q&;g`rG%Jqi@Sr##?D!sEVfeVd+3oZi+MmY@xtO%QDwGVawX<0s^LND2XG|gW^(h+ zo4uC~s^&Hd=2Avu;WxK0?JmyK?Bi$*{_n9dAf;A{&BggIOlBjTdGT%`W|?DOiWRfX`7g!B z=c0Z#2rMQ;M>bL?bWAXJywqIGG0Pymz&wZlrxl03JX%C7vNI`2`N#2Lnt5(B2I=N7 z@uazSb1cFNXMWT?wmCNb3Gm&O%mVIIl2`28GFpgF%$Zwb#b@Tyt+Dan1c}dciOXWm z=eK&z%B^9d+`NQbhs>C5^TbKBaGPH%hpf5a<+$Saw_OwnnC7fTP0bVA>rX_e6F+~deBUJFBbn_ z_uf2o?Mt}cVphE8cmAi+$Mx9a@aC=#R$Yek8lU zRb#2ZE4qupfqh=_5F0EoyovaNV?*Lx;ivB5Vg?gm2p3l~mrg~9FJ++gnAyWIIc^kT zR30f>OZ(2JjNZDR5~4(^hwVKd_3{vCVis=nQ%;mvB+cmssWFw#HT(f@wAg~m0=r{` z%4um+QLIQI_K%@v)_gw|#EY}&41~wPnr7nO9^!PsH%g$hP7~7DK>95rt}%#Xr-&#f z&Ydbo0R3R9cu^IDsPInV59G}hBfE1$zSt;Q$cFs+f_RJxkG?3{Dtz(!OTv&Bdp3)0 z@?zFD@uxJ&wC&=*Lbk9WWj_qFY)?^A18ZItGa@*ru~$5&^2N&^i`BAlT)a-d9}pLq zdj6njqCzk6iI@ky=6@o7lcnDEnfOH3Gw_HwDDy`i7Xz6><4%g;!#eU z{YSKV{VS0tg?K4I-lq+X_Ew0IU%SXQY8^e-y1`i>FnJo4jKGYo$s%*@E+m@&F6YQmyp7syvQK zpB~hd7VyB0n(~8KONF}ftngBrp~ND&&Pt{tsb2SRc;$6Z6!d9~ln0ELilk&xJgt=2!aoScX?X zJp9K4e6+)_92dU8if|=L$RWV2M<_c*^#@8Kl>S1FDK592l&^|Z{MDomAcayji6e9Z zAW@QJWlpTIDw`XnfVXFpj}9BUq0O<|c)fJCPJUGu>0(aL*`F+|hWcVY|Q z+FI$1Zl)F8l?}p2X+4yl7}_&?C|_yZ+r#@Px5~jZml99IZA$tmVGzsCQ&Q+cA7zo` z&9Qg|eVG?n+gJHc4IK;>c&eE|z8{sS!1Mi-6Ct8!Ab*&GVBn=y*D3d-R^M=C8LC@5 zT*>8bkI$6-o0zG@(u7Qo(cut5B1xI%nSRCFVN z`;UF=e)Jc22=`&nK*boPi)h0RuowVVy;FdR0B2s~{$;yy#~h)=lL$hY^rNx2 zDWl=nNJa!gCMri2s9SNnf=OaOl}=Wsi^0@k3RD?PLu3-TeTwq2B7UW`>1fL>az%9$ z{~ySkt}IZ*Ep%xn+I*gt&QiuRmZL-=!=w#QDI!dlk(5XQ}snN?*)E zg+~xq?^9C2DZNkWr-<)KUkI&!4`eS?lB|&(3(es_cWHiF|A4|>7kJ?TMPV&p%2fhZ zm#t*-PkG8LA+}NWgCNUw5OsY>X)Ru%u@5O-d~7DS_q`G*dPu=?q;(+lVZ{{U9$Nc| zlGNrNh_Q8f*5Db-u{Qf64>8BGchQ+gl;(*GKw@#8oSDV9V2nHTY-+Pu86=j|?8QoK z=yID|NUIhrDOXjaAiL`-0PYmT*BnipdY4euV${ov8LlVKW;x;xJ)6>&AmSXPq9saF z#I=y(hVU&}B7mpiYw6e$X!aN-E`{f=ac&vK*B0SR5TYn=sp1tIsBo!rv)B+gvs76r zU{N~tnHEU}%apFSu!FJ5W&k+2upJy-+&p$*4m34U%F4$*;-<|4E&(^hu~eR>gap!; zD{m-b3+*_s_yb`pl}aIgpo-fNkGzFSo=Q8vR=k1rPbfPZh%JE|pH;4e=sX1OrtFuM zD9YKSMC+4)-(_Y*!-qC0`yn>-C1oO3tbwwZ5$WNx$2Oy7Tg=3heslddA(Z!DU85yi zl##ULSu8E`cIsaGeT(9y3yTadMQ>H2#Y9TmiqM@*`CAcKk^{T9Dxb!}DGT>0quCqJ z?^9lFgdtUQR7t^&S72W`Mva(2RTUUo&j-f-N150FxlW{2pfqfu|6S zGWO$MXwwKaoLZ~uSxd`1X_2Pxrgaz3NcumCJ!p33eV0S{fkB6wYarwW7s9$nJJ_%JjaxtQz3XLFB zT@kJy0B||Y04Um004bLzl?l4OlQLdHqbeJ!?RkoA7KXC-({*8L&j@GxfI}YtthTIm zv-s|ve-`T;ScsSTja5I&=f1!MO*zU?hUw8lIWsem20big{#-dY0E=9 z8mQf8v^WCNs)$?CHrA~2w(3fJyHGh3)F z9!cIl2rGGg)vlcJ^}f>gvpXq%`n|6@7||#rU44l4D;l6Sr*ffalzxL6!oscksgKfv zYt>9}cif=f3|auRdsupHe|28zYC87vhMV+>e|2FC-W-t-Gzi%7 z+fv~Ol|%yX3;8K;3!5ZU4FRF_dW@|xnd&pvrV;Ljo(0pJ1@}fXwjEZRQhJs;#mSm; zz1p5mXQ^{sgiNcL(Uw_)EdH+>WO#Lq-C(48zCPmgAEVWF4dBV8BclSn?obPah^7OR zv59kWvKr$17hI6tu>~Lo(3CDQul*G8h6VBBu)G3q4D*JA$A0GIYer+4x14#ILHQDB z1$ZKnHcnByP$i3u3=(NcRS=2c(yj*F6vR%V#Hn~x5Jm&0s$bFG$!eImjbf&$Nj&bV zH`95l;6=$I00#(;MZDoY2Eg$Nh00%RI&jj6(kB8Br4`elS~5+Yrgmv?J1E?T$q2BY z7%eC@3%+=Gn%b4ZrmMqpr-0=EYncP_?np-fQ~(DdCobNM>stUU$4btwF51$u9cWOu z9%0O~%w6Df@Td;hxaP8l0a&gDM88|B`Y3aap@l+NmV7rQu0xoaLq*S{6=9UN8+Uii z3jE$q$lw5IEQKkex00@@f(oPHPv=FJ=EjaJvpjFQeFvd-w@o+<<+SW7cU~;!`i=S}w zsAz^7mADEdHcEY4WVMYuMj|>kLw)b@Ga+HI4Fc(b6-XPr zXlGv~%!409>O3SGQrbE_*4!KLV)>2dhKI1!E|{xmG2A+K-~IqLG2g)SW1Nbv7=E2Q z&LamQRemkB)!PN%*;eI34u;(Sx{Ys4Ru@!yp|I2Vx6=GvxVpv;p~Uz;=5`=db}h#JKy}L$~vQ$1f4U zUb+eGWcqEOvo~>%vHt8n>}@PA>%?|wH&rynuG>5a~6Sg2E9g4Me6d5YGCBVZ_i zEye}0QP>zRW8 zd?}cF3Z@uZOCGHA0X)FCnLLJGMzgqiNb02n>dD%qJT0oPMt5Kp9aT9FvZ}1+KdVaV zTQH}4NcgdoZ$!r?E6wXH<$rFlETtuT3EzmaEH{^X$kBjl0|7~t^^JySXPq_kbU!SO z_9|NM_MkgGc@5ged3hMJ)-3>RN%ls@*$KEz9?NWo>#6h&!|!7eu5JjRH9(_^M-0Dc zOglRB5K2;$&0bH3nA`8gcIeOWx`bq`s;1D6S-55CPiY_GsgyTGqmuJ@5|nwPX7UZKHpnxL)pt}>asBn>D_6LA+yqDV9njcRjI%R7 zZD!okjwX0Djb@m7h&ifD7-cRuTIaF=|9-X$cQWh_!f!)?&XmA0ifzNOX$vlRsLntw z>_S_CH$*D$GeBeaiUKfi+uwQ3WowxEN)Yo#&^-0%;L~bn^Npr>2JnIs{j>I01DjQ~E5qpw9#l`9#`ZzU3{6|LQ^ZkDilXIm z>0B$@qZxoZh;hf)n8u@san^=All_?K92wno_E)BJ5OCAk=b6q?$4wu^cRE}+GeiE) zloc?~aehYuWR#UKkB2)q!p-A~n8%F@s!-O$HnZq(C2kQH$OW;>1{cPaa~Sqe+5k1y zoX}dku{}@)z=M(N;O>b5z?USA%Vr*rMo!saOk?1#BCU~2($46Bn)rDIjUE(bSd+yt@oR}2i&*5UsjQH9o*WBSPZ0QZ;guTA@l<$mDQ2_7}sOLJ8JfM~F| zn^}zG1ZU%G9=qJ7d>sMc{^9Fz0M7$_&2fl>+#s5LKStmJ#R%~+&TBAk0n0R|vLwUr zVUkmghf42Jo98mhWT#|Sl5wYWE`f1b15zGDjPp{EORjI@Oku7wj*fE%!`0}#K;T><7Vwl)pr%sE6WEf$)&4fjdIO@IzKL`k(pCV+ zO?lGg_?JlHWr2fvPvE}I;qel!n%9ZEPpDcl%kz-tcyaoob%(=qtV8<@H1e9LJ`>_G zYfvTM0CDwi;hIMatKg-XPe9wZY3&ng&)gYI0kF%m-?J2llxqPjebC0ALFydf993C&zT`&#TT>CE6&irr)ICaeijxy-yd76(74>dIXE~Ze`JWS6LzdHz@6NJzG zpYhOn%m+yGcCz{fHrA?b{D321Ry`Qi#0TrSgXXcn=&gQAE7Q9?c>s@4Hc)3f@_F68j{-w;%smJaq&ElvYmLc z%mFyI%se z+={Tm@7cC^-%dY}X>PrGAKEQ(TF>6&&dl^?fV$`j|3Gi?5A@_LG-ORw0oG|NQ%M{K-Gf^A9%FCV@rk_u)vGHVUi7f`*3XnNI3GuD4rB>Q$A*GSJESEFBZj;`y)3@w&m!0mh(-J#<*G}KJ(+}-*ubqBu zrw8oxke!y<>8E!3IXe|AaKt7Yv(w{tdeTn6veODX{lZSavD5$B>1jLt-cHZj>3KV? zw9}vL^a7ugU{PQ;J_gBj-e={sft@ZVL26X)V|I2Y z^?{8QffQ|mYiF|Y!Gdoh66 z?_xu#&r5jrw2wm9sC~u1X~-J&S?aY8w^)^H@Z@VhMLY@mfxwMV@^i<7H2W#_?p!}s zlRc5UFMvZOFH(jAMgVRA+zc2EfKlb1=47Ni6z>FZc;*oM0N`Q3QUI$+fL8(E0r>D` z8XyDkAYct(6W~?AE&*RD#l@YP1!cJY7Vs;;K(itNtpHa81_JT`JdZ`HcnA%60Pq;# zX}~7HYk+qF<$%8cAt<*AAP&$9a68~CD0K*Bv_{JHOTyu5f`yj_;hzNIp9bNd1>v6u z;a>#dM;v?#v|x>nIs_X(7KDEpgdY#WPXys7gYZ*S@eF$XE1CGpgSZtmI|Q@gD|Y#P=TSg9GV_lM z`H_zC=6|J?ugc2zQ+2+Ot61n~WNL`CF6}RX$DNKu{#gDO*O+fU$4eC`4gmcp!{R5f`CdLxlzss}FEHLhWCKV`nGcE`hcdHu}GY8Z}d(dD(Ue96mdbd%l? zc3heVXdkt3T_mlat!SbzWwE^qn!~HoUDp}a*Ip{0hb{O8oAGG-TB(rE75B5uQn?xK z)}OCaur`4qqj>w)i=&VzHw6b~YlY zs|0-bj~?8nUd!o++thJL1Fc?Bui-mAB(eVBjE4)q%H?m(|XsO=7Q91AUd zRZVHc)AAzd+Yyjdk7hlf@Pl&t;#Ku=@vp$tVl_n(Ls{{+(}o3^>AE0%co05<(gJAj z`qyzEh5y1<2UIOFGe{^a2*18Mlav=XFdpk086AC})))e~4v+=lpnVH~@8Yrnw*&Z&Z6<*4y5<7r0~P}E0S^O~0G0y^08aqc z0G?X?*sM%_5%(BJ_8&DoB)&qz5$#DoCWZL?E>I; z0I$V({l#l8?$9s*&pNy);#WI(^^gFV1hLkZC>j%Z;SIHc@bFTEmoAb)8QpODtmI8~ zjuLYO+uSp3W&@<{04M|xTCUrL$L`z;wg$&|%>RN6J{M~@Rot)meLvYZhNIDqJhsM=XE*M<$5C%25p90^ z`=f)gl)oF#wxg-)0*>tpNN~P!$lrj{{=n0hWprRSj_-`8-h0&PO()m|XCvj#PDV4i zDL7%Vu8aCF3VTQ0BsvFPdq*84JhwrJ!={`ZDYR7GEGE*9{qS_}0ZcH5OVtTtQXuVJ zED~|>dG>pFR(J;ud0!o>k4H{}%I4uD%$E1DdpVi*y|0>LN?_~<>SBR6cE0^k?IxyC z{734iVmeiQr2ZymaMC;wvQPa?K;4u7R=Y)TIXX0m18}=$0&h%32ROKVtlk^RYdW@a zKO5|(9Q;^)4lgOp-Ve=kSmU8$HeCW1dDlN?xQ3P=K)AY_)*euoHJW3~*#%yG5C?$f za!Egx1GW<{>pizZY4&RJ9w&T5=f2nj4SM7amd<>+`uZDq~jM zVRh0!9dPN$2VG7b#v!02y0J|Cfy2|apQs1LedPNT=R5AFt3Fkyb6|V!Q?;`q7BD%A zQol2_K;`G^7$FwcP-w~#Our8>!5>(E1nVR&?$l9rTSO{4eIhKzOL+dVWpkvY|#U#fRSbV23_WatNA58}0YH`*~54_PyhtAkm)r;e*% zC}JBDyVh@CD*+Q_V!;a^>@E(l#>Q|Zj4F)48=YCYB$NDLefv~S}S}1fGq(*|efl5P+82a}&>TNil>-!EvGyPk&1o2<| zSA9pU;7~XM$78{HHgu((sW|ZFcj}>r=B|I^Y4Qc!HCO(mYUcJ<8qGPO#04sUR`&~E z0fgDj`UAQHFs6QicNT)oF`=3ayfJln1#fqz{;F!Bj{|3MjJ;pg7b8p?WqtX_EqQ{n ze&g}uWMxb*edBi&r>pY3y)pq(Ph*%A&s$7lIH{&vl@(b~V^HIwF9ieB6l!+O} zGRVret6a2G1XfL4L?c;5RweSCCGiIw<1lsjLygk5VGqsRK0BNyRN{fh@&$NUGvyDg zLFUuKKh)UJk@lu#BN@#?ud0QLa4Lh4xJX5RBGf@!BoP$|qO66}5IAT(ymY}5rBVWK zO=mH-RuUtY+wzXqET3yh+$AMKZ?`3ykcd~K%;-csnEVsLqFbQqPmIgZ)vzCX;2BE% zH%3qQi&!Boqx_5ND?S3tu{3x18p^nY(Dx+Gzoa&Y(36)C-) zdzxx6oO-^DrQ|atEP?ndxC_|DB%JsE01i~J+R%`(;xY zM4UlYL}gc0e>M6Xox6fH>9SRc+MNwH*bQvZXw@FA});`DJ=kOD@mgss`hD6?%Ksq#baOy z2wj_wWTvittaC|zoK4g^(F{Wi19`qtP4;P83YG80(VdMDC-NiL7Lc7hfaX;yX)iAYC-c>TodHct76cP=s1m`%y8b+0+&N;n-Jro^qjP0`|cp*IWQ z^e->k*vyH5hLq*!r}-UmBB`>4)>;Y=a|zGEHOJL|6rSM{=4IjEg~R204wQ3LNtPNu z^NtZl3GHyx?i^qkgTZ?8YOVQo?g(BMbo!zcIC}+$QVvQRfOC@^{9)kkpf#D&7AgLC zcafP8apV2vvsyD}Q5c=R$q1K+6`bN41<78pCkluEojpM~_)*~Q>OTVRj=66D=XI_l zzX`ZA;c#=-T)vWf#aRS1VF?5{aEG`u&9iAvBUtWso93PkN7}T8uDlsG&26(Z&}wju zZ;$mHw7WJe*WH+ZW4?0gM3MEj+tZuVm<_;d%E3eq+?{_BaJMn$0(TqZcHnMf+;r(m zqguuoXzqC5A8{4L*d&fB+Z|2Q)zN^lzSiA{4W z_O4BHEBC5Rb9dHrX4>gxH0ByDJlEaMn;_~ai<;{70`AtZ18}!?&49b@<^k?5?@vs< zZuNcu?pE#iUqMdvF$990=q;P(D8^QN*`~Rj=t-OAR(Od`b1Oa1rdf)|TBGw0o9Nbl zq_yn8wg|5`I?F{xZlW#7S~@-9wQ0O*@6i6jb0d}schSDLX*^vzaz|}iq>J{EO^b5T z0v3(tRVkj_7i@tTm%wV9#uJEB_#&HzMpo12*fhQ?bL99T7b_d@qTOKAnz?BGELscs znAyqP*%nN23AUiBUYfs$*Jkk)?1g-A?+~??Hq6ES>DDjn3Wqdu^qk0`Ash z8F05A3xK=zm=4^n$7tYgJ%$2z>(L9iYYZ#(I2m}w{e4FMTz<1d+x3Uv$np@$)HqEVc5727z zVHRjhr4#V-MJlEN>RyGD#rVpJmizUuZn1jx_5pVn{T6U{v0H$-czC1^Ef zs#mY#7aCWfJVyQdYu?;P!E|)M*r}HT++Fbm;O$DuWTc`VhyLFmzfg9X{;>N1sx!e)%!dgMt zU3mm>H~%tD*SahF4!FCrPl3BDdl$Id06T!Y%JW)S z>%{_hYhwU+Yg6@8ZEa2hcWbjBxLcdIfxEloW#BIDlzLCo{Ly;zCi6gdD>?QjdSIY7 zt&zLs7pth*Agz_MS*A^C!XVtM-AXeDX(>vmP1_EdvZs>vuwY&#XK1>5FyuOsXE5a6 z{ZW#xcF%;}f3$qqJrn+T-lDl@!WYlexWQW6h+FI6h0%_|nm=;uIV+ocejIy_J{+ud z)(3%y-PMoqz{@)X8eJ8LAEMo?_@NOkLN+$s0nvJI-b)Mj-;d+2g?~Ii9k2p^k zKtKDsD^kv1-^Q=9aRX@|0I!kx$N9Kyq~?#O^%&;y{LMdJOz?FNzzg_}f%dHa0%Dy` zD@JJZ#EZ0JxYo(0WSqbzLe8!D{#?iiEl(0POKcO1MNwR)7L7MSDu!!GRFJ8K1SVu^ zQ-pXaurEt%hr71GFC#U4NCsN~H*2vp@+R%9bzQ8yjHipA;O%lg1y9~l+9G8$DEDbC zX#HQ>y_9;3mgm_5wWdN#-XYmaVyd>8rre71w^7-x+IY_^U{ABz+o?2w`?t)|+7izW zSGHFv>m+XbOQvb9J;g5iPRbvL4T|(p(0RcaZKv??Lw~2T*O`mb#%al(fQ$YH)4O@z zbdlb&3aW&tv`+&nT%g@dIpeinR#WjbVZ8RciWhvWZHz={Y~9dj+=)6)Ow>{#=$WLA zM^d;_YfhO}*fm*3WjR`uEYcU)G0C!G#n)Pjn}bd7yR~JjD=|HJCu?yi;O`Q%C!<$! z77;U)?+f}Z{dg+!NZGCd7XJ-nV;)q$U@J~(I$cW z4|c_?*>knx+PN`MvJJf3xBYHy0afnP;wW>T_6*BV?QV^tw0pIWT!sIQpY^2HEl@CD zyQoOpN3iWz!iMLLf_Ak2 zM{NRolSVmDXp3kIX z$&om;uwA=<^($It=$AI>cmSk^isyu@H&3#=w<;?R-R#7 z0eE)ine#JH%;rYsyuiOfAhmUJrDg9PNoSbQRrEBm`t!q5H9#7=#daOwWaOr+X zBdKr$N1mNpy5~Qx;=abCL8ws>tGB1j*R&Jj8|v`7_7Ek%t0mCk*R>g;-$9y7JI(FF z7J5MIPbKd=+#hW2*&43r9B9*R9nSMSi0)d4ZYc<0`ufquth9!_H&cX}nd{&%>^0lp z)Vg}AAmvPcKT*}2+Hud%u8bEftrK=4W+l80f9rn|3ax)z)5LGI@oj8E|4utf5t!HS z(nfmzaOM1y#BOaOyeRR6Hrm67>6~gVvZhh=#@pH$O5cO{u#B$TgVA(}cJD!`y6h_C z3K!z1d*9LUqJu_zzSNpg>LhdsCOw=yDbeOM66gr0WGpBymuQg+9!5u&YELPU>GQfa zjWXZSLK^81bc}^S^yf~kElp^uCkOK0#YEhwzN?%NEwJZ3O%aVkU3nU4frIaB?}o@p zgdK;MV=XDM0AVqGww6u>QFzsy-N0H@`3`D5U2~5NA39AvsKr{Bfu#qve)W}xDE4!$ z4~Hp?vA%4KBU%?vm|Zik*IJS96ii$*5?Km^^M)oKNX>u*66rdPT_`C!%K+HEM1`>7Ehc63;NjUGLr&B8;q_%OXM<($yM8b!GH zks8f{_Z566LtOPztA3#LJ1vRX_Ph?McCbo~01Y{V2TRQZbqJPk)=qMwkDz zCi)Q}+E9Knj&78P<7K?ca-8^I{~zoStq<4Ri?)rTIYUlFl_Eu<$=>Qtvy2x>j z6vmV@P{+X7NZl`JN&@DG6AAiZnh~wHrtOJ(FTRSSk~lqw4kzF{Rh6}9fsz=#zo7PW z5cd)M!&mP|sFuQDoDQVM>&pdB+f_Bwanm+NiObNuRTgxL6_R= zvEc0Js1K6Ss0m%_s1K#>9Z=(Aw6BBY%6#eRSkzr)`brmlq9~}li~tUmv`N(`Qgo{B zwXT=hHN2UschU>d+J$`fq*7eU^$2$auSXi0W!E(~*DnmQv$g4}x0BD_ zxnKs~@{<+P)UNu?lEsf`nB^>8WMwI4$*m!EvcoCnDm^xyH4e@hiBedLP)fW?_tz;> zt*8{Kvx2a|OIPWE`Y>R2Z@r5=nI%|7Dq71E_Y^I}ELq6?^?7f-uRK=QiDLTbooaa| zpJjuFvQa3gkDeqYeN>jA`+bk2n?~9aJig4p);{nF@dV9I*W1yBzWM^OimxBS{3A&T z8TzD9LN<2wH5P6CP)q>cFZ3|^-7k0fPX?9$6mj|Fy;lDQ=Xk6F`{@&KfG5A7J{^a4 zBq_STJ}h*dUB|N)E$&O6U;69iVm;*#(7VY-@}?j6SUP|YKyc4(pt1ox{OHmE>3nE1 zj;;@cmoB4>fgmlTTLxD9z1~e`SpkZz_g0oEvSv1%-PQsp2I>hyJZFtJyjXz~3xoBX z&<)U!>%&o{!Fq~Z4S<5zluKvDQr=+Q8~S{;#3e_9m&^UkqI+P1H;fR<9HNJ`*$6TA zMm|!>M|N*Q${WbsA1}Chf&3x*&jS0Ca@HL)9FyVmL-o`)o7_S{1-#_u1uhNMhbrRb z>H_#(ru^Z${6N{d;W~ey?9wwjzN)69mF2^AO>8FLaYU7bgSe%*I9$(x^~y%*QSm(N zSm}NMzJX*Hn+UKhQZxdg%#y^G&vhg9q#DdugGr-VCh^7iS8v3dfCZU)c<{}FMx~j0 zl042RJDjQxU=5Z!T+^gvBxMZ2o>E+v?v;aGr?f0t;R+;X-YC3RG7H-0Wnmu27D!f* z@9;pBTB8Y(X4ySStFOmb?pzDrNZxTnV0}p7n>{l_g4y8~J8uQz=kn`i9o5TIKV^;7 z`7~QKC4#E1hx558VYK#!+AJI=O#9M>#ZNQoSik)t^(;asDs+|_w=}x447t?cymG3p1{<@t8?DP$!p?JZ& z@2z@95Ai1Dn`rhHDl#!zv4@P6WT4#C@y*6%fnQeXQG9H#^j$rPQlHX?;dX6_Lcy4T^`cA?TPzE*?ZaeNN8Zfi*OsU$6~C1S)W6{Z_;}? zjZIj~k^xBK+mr7|p#X&1E7B%Zg?H>;_Kl@waMA`3fUC4Zn6h(zqt zf0SL3WajU{hYD{*Agb($yNdMP=<-rJw;SPUOK-%^<-7H8@h%nZM$zwa605U$-)E6_ zjkuG!v)GY8z|G)%wHcj$1E0Ff+=Hn0p_T0;%HJdP<7J(EJmK^;XT$EN`|d_t{f^!} zaUYzx+6f@-WN;!#V>9C`Kh1bY|I9M!Q1sl261@w1HG8vlDqH5FZ0y9p{yulT{5vJ` zb)G&S=>Gz`^aFG@K7c6`v+P}bROthKNz7ooMgN8t>A3#g#y_SNAL_55irydLhEH}f z2W9qfZVA5kzZdsw@duENXM28G-S@avct#v<~H2F{NoZP0=Rjc zn}1B>pe<=6_RFsAupbfs0FB+Rk8XMpf{s1-Fb=1Nu!^|7<*!X#zM; zV{RHRB>16hHI2j}-QR}AxfI@FuV#V3reOE4rcv)h`iRgnu-MjHY1JV;sRw^Rf}72X ze*zXO;!OBA;+jig_x;q)#|;ak&_PisZ3& zHrYvy#x=$}pI-iyYOIfyNCBBGZspwlDJ*)*8r>nEA&TH*L7(Z%WV4+<`U-Vd_YswT zhN-HYDn8SbWFK&2tg?KcgHyqcv3iF&Y~}xOb1V}3mnFR8a|D2|WyLz1e2x76CSlgo zDC7%09Df!IZ*+dHXt!_?-`E|)4Pdq0rWgR6t;xNRgp@m%-H2EFJhD3hcyzNmY?E(M z7MJ;7$~wnR^QE3ZIoX=^vBqn_VDIH$L+sJgn+!05{WDqe1*xTLW(9 zEbyE$#yHL+z||wpL4+$~|%EZtt%O z%EKNWM)61V=ANIx;x3k>nT8xe7yoSeR^AazSr@Epe0~-0b05*eBYuHATZ`N3DBPLO z9Kq6zn>A7nK{=dwf@LL;p?Wy+HRopAvweS+!{#dP4&Gc~12OqGw^ES32{djSXXieU z0f6#5V=^tj%?N4J8#K<#<*@&>1+XkD*anaRV7`y8JFG_eoXEw+vX=EIf4Sk0XJvWN zi~(?MwQ@@l&m@r9QE?>b%0!xd0`ELenQVmn&~iCQ+CtgZxYlUlQS4ygp~_Lr=6^t! z>d`37Jz-5rJEo6n^k*$PHTzU=N{fzR>GT(OeXRVWa2y^uKyyIjp>UC^;1!|H2X}QU zu$xl*<9c*c_o!nN@ZyMz#%t!|j_cQo z_EdCSpB%x)YzN@qDIBlnapIxGk95C$aj21eTd3tE98GphMg`%az;UEv5bVo6#|1*a zdhs|9%ms4Y?2Qd*_D;Nlb9xJwN-OZD*1flcnPHnl6a|W(&|BEsAm5(Q=h-(&*(Y`D za77p`JZW#F=;WdvIH`A8HQ0zIZ#O-fQcvld@Ye{Aox*OhrqijpIQ{k6SNa>Ww1!kz zZtpOK(aCbX*rTKWt9y*fzQJ67_&@p>^8QDE#$(jUoTJp&Y2ep-M=V+Ael0hyzx`VO z$`j(24xlLPY~vaBxB7Iu?(F~S0Z*t~iYxq!5>Csz1W4jfk(|~uZ5u$pSUP-KA0{hDx4U=o|!3b^#>8NHdLN7bgkbw=+DMRxpT_*Z|gFR{(K;(P1~HGneC zaO7Pq1|AI712ORfLh#Y=^|1Jc|C`)UPgt#XiPwy%K+X@?1&Q#0;gs!^zl?4_r+?R` zkvk6t6#FPQihZ=Pn@43A&@s!;>-R=@>ntwjNB!qEK6jR&;+nX5vbeyoN-Tb3{B@Ow znAZZ&LGbXX@?ZFS7ZZNM(}4*7lGWcE^4ia+Il^7KU2`+LA(3t#*SsMns;-ipI`JCj zvv@J5{1z>m4o}3QDfJ4b-TlAlgL9*ikC$-nur|@ICZ-PF4K}Z79lUF8UThsaKHtWD z5LcUbwd|k-n;Bo5DS5npjza%te`&R>`FNAaS(DI$Kkd-Rrs@aaNhA@#u`)rYZGY;` z?25|%#GX>3ixf+~zd&kXlPpaoDaj=jW=SQ3^q1aNX(?Gv>B3)ncYAcDUBry*>^=2I zy-C)q<~bL2P2Tf?B=u>f(__u}>kjrOW@-IJeWad(rpA#Ng%wWD_jv0lb2VOeYJW+O zi*F6i|1x4P=J08&OS%@{=6@6}x@1Qt9q%jZDe-OpN9n@Lh(ptB+#( zQ|UZR$m?~iRhYY~!01i|sxe1O@J!Q>io&t?eE4VHT~Li=%G8X^U~Y+KlvI~Fpt{Tw zsa|9JB@ZKsN_3+=P3eZ$ze)^aisay{$jr&CZ)~#8iS?tyhw#?xiEr>JbUe@ma8NZ0%&WN83Ug8xv%P zNIKKV$h9wvt_DA^v2m}BXZ1HaQF%9`wT<86HTpTCUgHMqGVq7jSZvi2A#2I#XtbkE z9SrL%B)0pmLaCKaj4e_gUw!c#PurIn;l>90@=Un#kbOBj!noPKJP=`gDlawK7-?6o z$r4vb*_P1o_g9U+wova8MhaCviH*p^QAV6itco%w+m~abjr(ER6^TY)^2XxPQe2FY z$~%QE46Fk)jn?!;j4@1(FZQfKfCeNRlo!X+O^sB$q^zb!E;7zdGWt2R5nF9 z`xA}+b~%NKwrgNxH3t0D7RE4}mEWS8B`5RL>)}-iNybQqjEp`Bs0ZGw@dJ(7!TE| z#BWuyJ;gX|i#*)gb~BwkZK_q=*T$G!D`OOQdUG1n*7kj!mbNwK)e?!Z{36v09eTB^ zHq454#)evQvDL%Q>7K&&c3gTkq!VdJGh+mK zTjJw^7dsjWwp?N-djRRQu#@qfq=wPdRAaP#ncstlNvaWTUW0*L zo>nb&sfJa>tenoab+CcoxjI*VPq4gQs&jSdVz(B5WTTgnvbvYi-mdjz7o(qS4&OZT zQ1g)Q8d!Z;S0h?RElH=U7cp7ob+uh9jE;3R-jO9>!QTw7mEc9|_g-a>Hat4G%Ghl4 z5zwrlfO?n9)#Bzt#SPaU+?W~@HzR6&bVg#;QC3vp43xbSMc?g zo>IO|7hG@eBCqqiz@BUp$R~D1BiIzuY+OB?EsQFdUeH2lfw11j8&<>!by?>^AKN;i z6yMi)MK&pv%K93neTfj+g=Ta#l2J)$cgz}i!qS~TR*_+Jl}+XQvwo{5K3Y0V|373*1iIR2iI9T~&zwis3&l@Z2Z{23!- zk*u6=_Xk)5qu?HFm&FaVUEPo8nRX3+Le#US4L@}lWCUc+5ah(?_Upr|q_v@ zNC)9u6ta|$u>Dl!km{#lnZ_JhG>#S}B12`S9i>$~qmy${MGVABvW!u-m=jK)K#^rl z(FZ54H~P!|#){M)Cg_Khz{nenO(CK~;L>R02L<01J2TEml6!r8m&W&6ya6jHo5O7C zc%xS%=g!XJ(YPc7f7ow4W-WYVV!ZJYlEMkb%}OVo4(`S_Le3uDtEAdUYPK;rk=N96 z4TQq^j*1o#kZoYwpVn5vBHeE@_`&m#+l;&M!I<5*8H2F9 zSv3U>i<@YK;ZX~Y-BQ)bZf))VQmVuj({m$DlwRWT)x5H^_GQ@KR_VvGIK$+2$csslUmcHHC z>@;G_9Y&Zgw^C?#TRlp-S~pL1jij@8V8AXTeX_A3w3}_7?zCevhE@-nIo)W^+Y)W3 z7_&qIJvjwbX_LO<8cLgL@SnPyIn}s1w5Of37w3$kZ>D0gvWz08Ar!IBaWr?DVch`5 z(QDI;>7l*t41G95bL#azzSx;L-H5|C+?+}un{M1u{V9)hx-{K*r~2zT8MtS_*K_E^ z45L3PN}OrD6Mrp=qAuE7S2F`+B;j@fQQlV%non>^g?O9O)$HN~) z3%iwlqaTW4>+>BZe-4#<$DD6S9lUl_b}u%eoUKwGXDm9@Eh={aLVIH9#ejt% zyZ{ConPbF7u)%nnHyyw~w#qR4(QCuHBW*?x&o`1*&xSkkbDlW-F&^8L{plBQsQm)W zbNy!<6LK@%722BunJA5w$*P0r+;v}H2d|Z#?}j>fysOM*j;zfy1LHkJhbM9ox|Vsso7Nk_`NNeoQqQrY?V=UlUOQvjT@Cae|r3u`eqF>68%D*|XbfPc)&u3-%TnhxL}vu>l^bB&bTiEaa; zi8q0DBY=%NsSaL-&AYu0UI&|ZM;$yKzFg+y+C2L7f*#TGDdq15=mOz%0RLFuDK$-L z0W=-JKW0s>VexaSbO8UDHI1&j-)Jt)#+%yd0RAy+dQGl-fTjcZ$E+EWB?rh{D$6yJ zJlu;;*F1uCj*--ZN7Q1F9p9>tYi{8zwD5oQ0NU|@5p_*7WM}a^A^uNMnm-!IGC7c` z8J03i=gzKeNZE0-Z58gSgU5T)T-M!n@VE)gn^Omm=?rsg^P0*Ec`z{Z9ye1C!`?qY zciu{3GjRy(2e=8qGfS|u-vwGafPZZNd6YOCv)!ioM!4)cj=1Rn{xSdFny$MSXgYv@ z%$i@rVvD5%_{XgKYFNB8mk!_`v+l29v7@E~_{XdTmM(es8DY7P0_Wx~bT=36ya_ZO zyv%!`4j#9kdAW7)(rsQ|9lXvqFW=&|s5K=!BkDnSMrr$&6QNVEjpv~(u8V)%u7~8v zXv5v(4k(V3_lHP2fPXB$h%FS=!(rbIlH>RsRD)}44_Z2af1Lf{8UwclnhxL}vmRjs zW1B7?TOR!v7$a%Y-G*0=y*O)fs(=t%Z!sELGYV=?P77_BC2nKbJu}tjEvN9Lv0)G|!5hF=#q>YalD{;?UScE`a&Id|{Ej9|oi-D7ijevC`46Yzo zL$XxbxD@xxn@|!zTVhqMySVF?8L04mm7V7&0c|R4Zg>gX94=M0c2;qOuiLHR1GI3p6#$16|)}fd(LAQ_EEbW z?v#eKdxd>-(10qq3`q@KT478S)%R>$?0dGnmBt&&_}|Q@9%zbhaNk&9JT10TRRK0s zw$ai;-0Uu+jfKX%Hm|sCXAcf%p}*bDqXCZ_DasC=`dr4R*tr)H$oG`MCu1Ksrl=?` zbhW(8zj3vZq`Zm;{~zFKll`^HRjZAjZHnEc*){Phk(W3%FjKd@_!v0b!z+g+kv8^>|3ZI_!zm!86&PRUb7c$?jBdQhG{ZXV}( zCHoyW$rk5THdj$n2QS>_mDa&?qW8OQ9(kTIK1Sp@_KeXt<~?wn^*P^yvU^*DAZ;x? z<9)hrEjBjr?0hXYX^>|v2Gj?1X)Qv+cxt)M=-1{$ciFbSY(>`hBR4NlxX!@4mH5W# zdgEiyUN?(wDZ-WvI}+E=(TG=|{NujZ$9>k#>I)LL;M2tAMaBXply_wKH`XkR^9SyI z-bfJQ-+?DL8hsnL`Pf~&t(D_p``x?%jtv|)r=7Cp`igy9`yg$wNx*t)L!( zjirX)I^fqMuzR1evVNNb?$Uy~_n@1{-HW~0G9%3QZ_x3tCgcRRmKp5~afpr`F;?n) znp9BXPCSOrJ8IxF1czwtmqt{?A(hPC5 z^rX>Td_pgs#KiR}C)njYWrXOTL9H-K{El}MPvMiYhv=$PMz`J^l6Yy*4=@$L+B&o$ zxMp`_=jGVOs=#*DTS$kfsuIQRI)yz^nFn8j#@_iM%J>RR`kcmoh21UAq>`@_9s+Ft z3UlfqD*X!13L}DxbDk097{RiUl+^_r5{D?O94$CRv&)TciARu|7qdJCvacQm&NBzA z%N96B6+dAucedOJ$B9f)VT`~z%&ZDH{)xc+3MeB^a`^TK4*$paMxa#R1t5FBF@`BP zKncO-lzJ7mq`QA-EEit|KKKq(LE2VS!gmeadlLa1UfC9G1LkoUVg(#qh4D68EW&lx z8KWD9&eAi$5@_QYV{|-EC{d8*)w=Wq zblneVOc|~H!MH(g3rD+4A#oO(!qR840{9Qg45QNFILRvC6evH7LH0F?b0`j9%R7fg z_CE*He`{SQ{D6h;f^&FQm={uCBkczx{KcK;47Sc|=ZzPUjQ!DQ?sFW^Y3U(a0W#*M ztv?zgVt89og+>VgTvpp6mLe*l{(P zLVmgV%x^>Nt1>!4_Kzy*SiOJ3_Vah#&v=gU6PhGXFC}?6C~^2@mpIKX(G452F+XFQ z7At^jem1^95$O3lLCwDa<{5hPg3&H?Kg7ACXPLfrQKbE1w1+_2FX)W#>AGJq1MjDz z0VrDd*f52mva~4%U?{a}ZjsCtLfxE{|C3{s;VANkmrfA9w zr5jNthi?uk&Qc6}__JOYP0a)hi1LfZBu^De;aDSAS9};5eb);ICuUqS)8H>o!DN7!=vY zgnD$haoP1+d+lVR0`iB!A5cQ@`2)2<0-AvtK{=)bV>BvgWZ;j)ME=C6iINx<0hxYZ z+jRvrzT|rEeZHUf{l4Gt-u2xb9JGC8 z&}=jPrh7sOYq5|e2+c906qI94Mxc6UCnDgKv?vR_G+}gsoo;c;BqcjZskw!cGfBx! zQs{azUCY!Ig|%5oyA_q1r==h~JsGQxxUGjCh{}Yb7u<8nFZd7GR;opeRfJ(R0v+0cOH)PR2QWvu;F7;0i9ygX~iiT z%UQ@cM)~HFNvPC9sM$ zMpm}mVtky9_GWAiZj!wlRVD20mBNzAC;3&coWcg=p)|<1N%jrg%1eN^5JR#QmeXSP z%eU!ILR%%TFAz+(LIpRgOCq-t_1l$F=;pW)?O$jKFiteq*w8C^)9bInT=}ZW^yV)n zQy;OK3Sve^89G;DE$>q$|HfX4Txdf^)`FUd9;#6TK8c)aM}=97Cc{&fp%7fwk|&m- z!aKOz9PWm<7ou+R`!Zy2i*YXwjH*h>Z;RjG$=HdBDZoXeq zv|d%^x%u*DnH1cM3hB>-1q+VVg))}FD(JFRp?0_&_dN+4K5FEUI zH^=KE4Uw>->NQfR-@8dxgL0_auRi9&yj#(AMeFCFI56Y9u5J4oQ7P8q&+8NI1Z6)#O1r6m5wLQE{X;VcDlb zS@!E-mSKdJ5qSL$)7%0DMehiJHEvfQu5vl$L>T0oockA$U-s>}^aYD6|>cEErP zA0=yAg?h~8>o{CNK5(Oa@|qh>H$Gg2zGIjsBj!OLWwMXAZ#r874KIn7k z;od+b9QVhD?c5Stu{@l39SV><-i()K0kEXqQbki0O-?k8rvDW3dR4r2c8IG*H`&vMf5<2e2Fc^?xOkQ$5R@K{$R$C0Q1Q{D zB$$NAFvv6Q!Qf`&Y&+hTs}QJ$k6^}r5{^YN#!@jBcfyEZhxQ~g%q~G35vnHJmdLP2 z#>PO-i=mJ-B$_rP2zof#XhkOD5S3Sn0QsdLv}2JmSCiKs!1LhUWS>8P1FV@P_pHT5 zHJ{M9<<5XVC~JejI!YrtoB^#*0o&{g@nEYA(q53BBRkjPN_bTB_*&e~93=^{5ra@tHn}IxeiY_1iel)xo9dXJ@FcnLqN}XT@YJZp@cj`x@cMn1qOtQHFC(W zXng@l_ow9TF3d4rW3h@(DWrjBJz7h+Gy4yYPp#d*{iJ<- z%UNtpS%(K1+mS!t*~0+JqAzEUf4nQ^x$>2y;*ZcE}u9tXGP)Zhc3VW-tWfs z9$e4b&K$T{`S$LI4wuBf=guE$T21cRfGcdSYUej?=f|@ymMmCwWA>%}Mq~r_Ft+Kr zzp1|(qpOx^$6KCl=z$kJd2!(rY1JF8U4Nzf;?-@tzFhp^bEA#US>MNEv?WAqOD}nj zy?Sn}Ts;*W`Qquz7X;_Z);1HW9&2@V&?{C`tIOq~=Z@9O-LPq+v{hUqn%IV1Pq(`T WX7pj_YA47o9Y8@7BV$)>UEM#RrE@?4 delta 35719 zcmbV#349bq(>FcWW+4k%HYZ6)LIMc{NCGGz*G511SKyAUiKW~la0}FVXY9xt?XL@6cbscQJI4@ju#E9F_#^D`BIe8bKD8eFwk=s0Uzi z-te^wk3*{@OqQa3kqtvo*xc|$*K;88#Yvv=6+IE*+aDex{^L6u-rdSNJt9ez`6@?w zD65fBs2Klz1raG0^<|417q$;M%)h8zIW1w*)dlz*XSMt1Ux^k`%|@gile;eq`1|0HL4|~Y2K)txWzZ2QFN>f72Jh%oaQC~ zw}?Nz>?>`gyI9s>0M{BR^G5mJjvgTf`4VC}iS_uO=qrr5Q~d1vJSJ6i@`>1a*>k~p zGa%7Q<&P%?#G3}hn+3#^{c+#nSc>9CnqXnLrW5`56$=_~k;Tsy2~Fm85Ld|kupB`l zjkRFk{=0Xft_dR}e8t1Jg*iGvq{9{FpOeI9VU8q3$Gp79L;W=yn$M$mlt;YP2kg7~!eNxp$BFhxW#U zxg;-{vz-v(JCYY<#67;Vd7%cbE&f-|YwOFKFd276^AqtuGcVe=e?D`@PMpM2mP*OK zvWYoBxF>C4hRq(|s>$)Vo3=UHr%ayt58V3(uFI5OB7=@DmJ?O8HFr$mbenJ|Ey;>O24Wq6~PO(D&kq+0au*wv!XmPg500T9$(gj ziWDj+Us1!2iiG*5J?QCE52nnWimT?f-3Qz58`$ncZ1?qT_pXY=4<-xIsp9uVzlgB^ zaGe1%fG^JdZp!Q<#nJxTCB+xB)Qbv?T-r@+@@-fef%}W09$(IgAm5RtNn$un`&Nxx z|F{(7i&@qIMAmY_vLvyI4!kA7)|PR1WaOn~>Eg7n>GB&<-=YNWk{$s2GB!3YwbIvR zMXxGq{Xi;ZHh?*nt>_>s$^EAsvG$=t@qIjfj2@Km%A8+{j_Nvznq zv7dG88?hm>BE9s842pQBJ^pumMmM=X0{*r zD#87!?;8HU>5JMqTO9F~?DQy~g3~wu`Iw5gcU~3ZZ(qW)WZ#cvA>wZ;?;=H$_Y+y6 zkh5B-uVr}<$mK1gE3(RyVCEI~z2sqQUs1tB(&rVa_%B|rFnk5qu7Hl-B6}*1yj(1a zuY9?Bg?JSIiQ-=sN=4bOABDI`(^`s%in7T&Nj~unpL>bxA#Cq6k|I876JHTTQR5==MHp7Yx*+Y zipKx`Z_P$CZ^QjYU*%gK|9@Igu0~fRyPCp$Tz{iH9yGWYH1w4`q*R!U!fNX<~L*MbR|H&t1BBc`WGXc{^}U)jl?}L6khF|N zdNoLTK!~AqQ(bAG=txWIN*KavM_uVT@gxndC-oKgQ)xXZRlH{ezDK@@q2hW{2xeIs z17LH(QcD#Hrnsd=4UH)R3iJ0$WG^+8ZWWE$Vz|rB0R#cY0zv>R8EQS+BXxB%56^3|I1w8yHmW67OW80HxYNMOuACD+GAN^dnlSIyXz#yY+` zMQVfArqvy!EwGe~j#4Ld@hKgpZxwFz0bQlLjZSqRCH#m^wZE$r47S`tDVZ*Hl@=Sc znI^5c8`Ja+-J~C6XD5ij!%Pmje~}{er@Kohf<$Y*sGkI;_D&CPyW!)nME8=DvIa(SH z%SJFz4;mvKmmqHCI0?hTJ~}X7nj|_=t2~I(iTW6UJ}yuCP!eY-V-o7p&sf~`;s1K! zBx$}R`q8y1sB~U;6tS5`E|S{1{T;+_y}B$ zH&sP}wwJ}-%AXP6vm^1BJC80dL%H12T+R%OPMfK90F!JZGbwQ3KTh%dT*EFF>y&a>G5qkjS15pMWN-} zr8~u4zRKii`fEG1au+#wpao(4pfsGV^87*RrTXYo zrN^aYEVlH6r;tbtqKlR2TcnTtP8w4e=mTe^UJ@od&R?V-JTCthLS1xbg^EJZUqfVB zu?zV=`;J>w`CgP&s>-Rxnvjiz+jbv)smfRs>Y191x%oaC>5zXzkR2q)VSK!p24_7M ze17Bpn@Z|qlzTcz&f;wU2$H{I**|g0tvR)*CsQW(pQ`+E{{Vnh+!(+<$0!#e=ULnR zRB|6xu?195Zpou-<6z{ykNOA8ox=Rv1?*G#GOMt`PD(Z@7U>*F@R3CgWDoM_;xb|- z3hWq;-X+IzC3d>x#1BLBV#qd4UIe=WP>2#jl}<7pBU4{L)cgE4gLWOo}zmQbk}W5p&AM!B!SemUK z{uHtH6#CIL`34VaN889ULSN>S(fWmU@^LoogEz~+)NFnIo%V8HDV7}=J16$gH*hsX zSlwANRkVF!m?Mb#-6H>J=sbjSJIN7jQFnBbn^~w>6Q!^3B;SSNdCX&Nx+}!ftXqPWWm!qetYTbJAbk=QO@`WYN_qjvkC?^?v1%?yb9e6RPE!#S_;+hi(8!a%f57xvQ z3-rmZATiO8Z;9PqPU!6;rx;@KkXDB-qVsY|OZ&(Zc@}$dfE>*d)E_8^BieMJJS5Bm zi?nwP?hLV1G7!@v4<(#M_bS}ZO39LgfH-gm5F@hWC$Vpo5Q7EMM$kgCk&qq+_ zYjH zxtMMF@OZd`L*wNj_wBGmw#p`eC*;;;pXR4(|kFt)dGv@0V`Z+g@p)tmcg?MPF2KsIyXg5 z9^3&@u83@rmVs2|P%H!E#$ji(ycQbI%$T;qPNQr2azw&IK-~$F!(v%!#knX>vWjk+ z3TN2S=RVVyR!x&b!dRP0fM(Zk+~ADa$%Ih$1nk-sEY9=2|6>U4Z{_g%e*7`Sw<#%- zfjYEyc*SsE=@O5VU3EvmYW>_a`3a|Zm{!b_Q`I#nH<}K7Cr4A^d^`g>H4l!Vm@?+e zX`+O3Iao_2^D#{NIKV1nzMQ0}k04nLC-YFwL-6zQMRK0H4#)3BO`!2Gi}p8oORM7!1F>21?Q9gThJoJQSNT{3oq9k~RJNtn)M|sA8n&f6 zMIG)ds}UC@enFKBH^4>yb-xt6{&|tEXFY?)2xFss8Z6xq^2PCI^aIbLX()cHd`L{D zY2T~Sl>V9sZpOn+Zva~hOZW$@g>kGAKkmEh^x8JLaTJ#u2Rvu^Ebgl`MHjarb3AW) zUhd?(`e3lK7P(O2_iCgs=TSu@P|;r)$n)Mw@fH3U=?g82rwaw}A^Xd)J9vB${Kzyp zg@Rf;7C)kdQhXUki~H!>HH>^MuS-D*3s4-3#3Lk!MOMhpo#RVr z?0A{HxK&r6h6DKG-DtjNo8AiHZ?W#T;hrtYO}Q1AZaq&$6>>N60v)KpRAW2kzKrS5 z4qE*(kURCmFY_e#MJm5Zj#&SyJYr!(G%e@ECEW_R4RAYP0N@V5U4Xj*_W(u%?gjAj zg_j@G0kZ&HKVC8~2do9`0DK4Fjh&W&&VU5~A7Be$2S5kx5p^cjnTVMj!yzC}0WJar zs^kVF05SlXfO&vd0B$&p34pnP6@c}CEr2q>UclFYKL9fFbO9m&34k1h9)47A6U)|K zfqd*1{jxt!*&AffLS}i@kHS62^?>-UfcWl!_-g_2*8}2v0^)nCr!t45@im%+kMYWro0rzeAamk^Egw-re;c z(Ci4fTf9%XyD`f-$P^Dfxf_%A4@~9{O;p)ym_Qt&>^&%V|C{Ip!LMPJa#-@U?io&5 zuR)NHkewG<@x@twj5s@kegK}THv{-bfg@(#M{Rk3!g(iVe2P^6R-Mm4sec^2?9iC?OZclE;k5sCS#f^_ycamWnD#Z-KaPqwz{dw4 zkb~-;00R?FO7ziCDV*Z>V3PEWP2O(}d0nT#$MP~Swr#lJr*~nB(R(uZPge^^mv&** z9KRRX|FW1Kz7L`F-6-%>b1B3a$bT>^@FORSrmcJBbm@#lU+tA|m41?_@f&h8@w3Tt zwmN5V&P1KJp?)z@7i_4DChFH}6rDhunu1!SdN?hpV<6t{Et52Q3=^Eqq$y}G2 z2fFHk;%}v3lj7o1F=n9wM12x(Bg?nnkmt~oZ_AOGa9XTl~62-7jMqu=}DBQ4NG-6h0Xf9S3BbrH=!0@*FU+>5<*eWteDeq#$e|kT( zvqwXtWW6hgHjG7Tzqxa7ZY-BP6;7L`VQCacCGVo_cr!?#%6H|dq6uZcCr5}xuCj;b zzlT1YWZrLj4`$btl@vkV_pqQk@}3+lnsI6ziD6>0nNtc)+Y5a*r`$I{8Sy?=p8F{3 zpxmC99mbP}$p_`m9C`kr+y*p$5KR{j$}z^ez!|UU8lK z&|Ez=IV5*A)_&1c`Xwd;Cl1L;^yDEq5*g^P9+K~2=CF_CWX`bbM{*MmM}H)*6)p7N z87)$|9?{g{sJtnoWq^uW1;kqi#M7wc6X+oR6FDUzJ%E-G5N~7h7JdRfw&nY1ce?x?t*^;I5cXTsfYf@B$ze!2Esa+%YWBxDLFIVYj{zz$BigY^0J9#Y5@G z<>03A$f6!_{-hCzvu6mgaBx0#f++X6>FvA7cXJ|upT%V+ZE~S(t%LLBi7NB zFVR)I(aA66Nl{)a<4lB{4Qq+3a)maumHX26ujH+wsXq8?xtDO=3Lf@^OqXff3Hb%l zow9#~HJAMeXHsxd&JjKIqbD)n6FtfOt$a+}MrXd2`>NfLQlq1@v1!up6kJX(ns7?? ziQf9PQ}Qw)`p}Z^lKjGp&!+@pJclRFy^X&$&F?+i;s zQ;&h7x&ioNg^r@k-%*bo4x(w-?{a6g8Q6j-V=xRm_z&dOj57W}y|}B@r43<@2%7wd zJT#2i!hq`zU_(kmygilQho#7cKjhvl>@9!FUr1sbxvyYhkV{>z$fLw)+Hghwu<016 zhRYvoh2yO7UMn1ru)eQyG9C;3Ezfu6S?CFR)2s4$sjlDnC(872cPU)oejWQuV$!-k z$|5Y;%HiYIol^G0t(OXApP0g4Z=lF$!bay*@r>Wv$|vT31| za{=>)61o_wL}Qie3R9w;S)g%#^$p+T%%~9+*sleX_=_^a;kY1b7=n{jJ`BMT6S>z! zZl_A7J!T-omcwh>rGzQgnP+n38ywDDi=!clSUJKMnGj3`;R;4sy(nBs6wX=D7aPSH zDr&7n)1J!;c4Z?Jub4#cNaaQMY|#Dc^km-S4S|g;H)(H7MVB<)|V@i8|g|-;Z zo<=J{RZqQ(@C;Y+R7D@81<^`d*Jj1|;+qB0{1|1Gm_^f) zmDKgI5N;M7je}xmQFg2mjEhx1u1TNJSn1Ssv8500B5b^@KlTPq0IVkiM+X}#pVmxV zGxN)F3V~h{uS`O4EnfLh<%~R3l&YlB)dVFNXlIiubZHzER(KjasY}4dWmlC?QHjcj zW?5~iFbR(aW0I5;VVoWFuw2|VOu1Z5m18w|n<)h~c&qDB+RU$j?nrVV)zHetmP-5e zDatA%4Nn-jpD>vDm!>GMoB5~Fs^&1WS+t?K@|KCJnN0xFFvLd4s0q1W!h^ZvEtIGK zFUc;qGAe#C!<4L(GF)$$ro>DCE*rM|+KC|Al%ZrHZ+pU=Hp(UOKPF65g7v4{Df{Js zl%I7_f~s-)#ZF2@I9(W|j8zTaN0~b@FcjRWC<|Fl>`J(k?uP%fd$f&++v#f&=jQYC zFGAe!ia7mr#Qoll<6{u#nU$Y^5aNE1$n@?vZrpyuKkZ^fTQIQa2(l$=V&VLPF&{f> z=Ce-@Z;-f4@iaXPFUusmoIIbj$9GY}X1T8~epNg@eU}ot&`!G#y#At)O`YM0+jTG? zAg^wS+jWqJxLpT45w+_e1aZ3##Pu8XYv|yjul#LK^HXr=Tn)b{TZ>+(3_c8L!nZco1pal53?Aa0j(J>qr=mtMWGu!b&Yfg#YI##uPOV654}7S68O z9v03na9ay!7rKdsGX;+}dy?Bi+NHl?4w=9B$5CU*JVfGdwBPI2farlR{@(Jeg$uRe z)>$}q?tZ>S7B1X|n{MGEY`D=DF4Bg}HgWeDPu~0)W?GEw`24su3y1nu;o>YDF9-a5 z4J=%&4R@U`qK;k8Uojga&PFVhI^edhof`9V387Sqz%CN+Y;zHYbbLR zCeJx8oDWPNp%gB(w?S+Gvy6B>TV|Io*R;s*5w~097l_;Qdk1m5MZSW#-6Eg8e4{}P zi=@lcb)+(2p*_(kB(m3_C*pRYZbsa0amk3=g$hU9E|iA2J^w%cswvbDe+9UlTIv#0yqiU-%B4|3!dR9q}|Fh>QOXm!>Eq`D7rdr9{q zZdc7v#ObSuWs2a(_*;Vr!mF6g((Wn0~+3hlZ zZsF{5zH8y^vc6#9?D9SdoLy_H|Dbz{rH9>tBHc{xIjU!&z1UzRwHJBq_nNBt32}Q- zUmWZ@^5YO3Y{;`S1rN8Db54{>`53lX=MkdL^%{v#2$ zt9}6Dwi?NGnq8uuW0X6n-%DE1Lhc@4{Z=!@dx+a5dI@p6L>mydOSA%UyF_ykw@Wl0 zaeIs0g}5bQdt)Bi3kaKtb`*4&-BRV(}Cuk~ahLl|8w+9AD&#%^vhc!sH5Dzu&eM@)%Alov37dLp&xa8;yrUIHkBqi7<2=LX`z7j&Uzi z(pi<@PPWL9Aa|Xzh6$Onu+-0dU7L-zl8eJPh8l^8&3SCdw>h@%n_D{Gs0MAnM z`i(6&fihlDdQsM1C5GZxD2rWB*%IP3@Cs$2lkJ3;QayM}%%k^vNZBOUqK0d${c2bP z!Hzy$RVSm$4Jd346#Tzb4M8HGf+wUW+}%f1!G4tM6a5Tb%{g?+-w@!VYQ*9eKo9ZP#qT>=Kwz!CGYw zU0A2=LRm+trY^#%@>Q_x+M@KP^jDP*R92z1G>xRHVQWo;hrPQ{blDzQ=8?5nv@d^D z*)JKQg;M_~lr>@8uKbXkt&{zr(bjbF3FSpssjX!K0#%-1mXP&%|x>22!PKxEOJO~!7IzdK~n*%t#4LrVh? z@7F{`uHUT0BhQ4*%Fi`w$3u%zJ3V2GGFz&hMxaI0`_Cww{+%ANzB~H(qt7bE|2LkY z&nbIq@bGYEY8d52=-#dH6H)di;E4?nVWyzD+m!Y-1r2DT=WKf4YIr20Z5z_w?Ft#{ z=aIrxKNar4mUeZ28sWb`vePg+=sb=l@5Gj8*^2?KGNP=8&iyJj99YYIB}hL~rp(07 zyWaC9ICSJ&t1_&eY;6~0g1gIDVvKgBTmrY*%=#)!MVQi;@0eF|-gx9QAh$|Ch0@L;ET1DsXyG5D$Y zB`~K$UnuF$_dwxH-{+c4bsc0ztDFz0=op%%n)gGC7n>B!d)UVN5%WIb`q+j#!m^}M zNR|lp!NXAAaixRnC>Z>ciBBxwbzFJh^{Fl4XH}J;{a-5cU7y?1d|}Ykn;_yb%Kb`t zOFAx7{wd{V+J92H)Agk-o3AM08=k9t4bMJ_5>6-|5&90e52w!zr~#lYW-z zo*POF+EfI|4_#8Onw_v4tK|=+t#nqVu74=ES7Xsz2f5Fo8k12FTP7ROd81{>`=^p8 z{bJ>a>0A(<_*0p02rla*|56%At_wB=Tx1hR*MCBZLHDLq-Qjzrm z*Az{-uG$!`nGDQ#}oY$vV`?8eF6XsgtA|GBs|mHlvW=F&%w6NIfg+=p|0|1r^Cl zVlaa$d)08J)w$zsAJz9iQav;|MCGXs>V?z(ZZ*kXu!9!3)fY`FP9--~TUu1ZojK6z zJppWXe9r?pcT7R04b=)&f@OFq`!)E?O^>57LNpam?fT%+#*tt(M&IvIdvL`~$)y0j zP@gb$qw%;Yg0f%N@O_2~oG=Vm`4L!HxH{f0rACj1tMB2>mfQ$+2*_YjU8{7XO*fR@>*Lf%jK|)*R>uir9bNS8IF%o6R^_TuLcIEM4UFzeP>)GQ zhWzBX2bKS%r0Fq9s#g)JJ~Bm}CrLPpZgiLUui>8@dTgrNNrV1jG~MVzeKk@q%TNo2 za8gEFXbua~wrYgFsjb>sxa*_l;;;0UlwwNZf?^d3|6e@u-D&4%Mp*8z7p( zEe~J|2nmS01L6$>;+}wbXh1wHARb;bzR)<_YZoB0CPSU5fOw;TcyvHKCLkUg5N~XY zkHO)PAhi+2->e2_#Mua}iTHpxpFp+?+JuVQtIuU52B4Dy;!OkM%{bW;I+iY8LA~c; zepI#>UF_^bSX6{`Qcuu@4(d!Exr6D+*7#T4MUAA8=}L^=p)-<5$qJqCq_!r*Fj8no z7xm-J<^g522#BW!#9Ic$ThZRG>JVpZKbo4}thS~3L23+nA6HuXHVss0#Lem<>epWN zQW8WDXASl8^INvlTcP}}>fIF5P4()Jc2h$HZEuJ?%E}bQn6rc5m|R-2pr)!;mG@Q$ zihD`)QB%cu4&eCus4+O?W!x9^QRDI6b4eey8+MtF_5m}-t=rLk7Ex(GFt55@{R^jD zmh@HI;%G~Df2{5o(Sd<*250-K>4sl&Q$jy=3{Jcp?PpMtE=^3e#XRf#t68Gpe@NZe zH}v;l3K^j0m@nbZFoQAFd!U+9U5JO44^(4fr$J||6P_fn`n&*k8mzuWI)v+sMFP39 zAr#IyWUC(IAu~V6;W;NyCzx{acP9~g1rT(FUlOH5nH zn>K+Yen`eO3j#C+aLxEKWUhrj3^eBF_1yo4pZ7AEALCo=|5bwON@hGB&0n7g)*rc3 zUGDIkNcsra&{WDE0UMf1B?ydjX({yi2sN#SA@gA{)WB>gIyzRxTclT%R_%e}lWZ(m zcfef$|AJyV8ko<@a5C;+GpIaAjec(NNL7fLR6a^grLud}`8e`p+z%b44u#%vzs5Nm zNx93+F-hrDFk>m0sA7W;?_4(jw*uz|6nH-ucmpSE%5&9~I8I{}lQ$Y}XMuVD*=V(& z^8u@@g(eQGDusrQQBR9P>M~YsUt{s@g-liEYHFc?f{m{}{ezE(Aj7Pgj|cB-W7UXQ z`%=CuI8eB8nVcEpFr@Jb9N`n`*ziDYV*_i;s^+{|KSg@cIJLbH53(DGpd0R>F-voAoGbXB|nlHDL0+Ow;)AZdF)xHvTc9ATN?cO*Ph}XcUsL@e; zc5pGE6@WKH`QkH!`)Jw}IHr|UIz?S(_)e8d)+ioh^5=K4yq0BC8v`)wKQbR4fE8|X z8>*0K+B7vT5Gw~_p_j^h_|WvJYC4*(YAaBt1yeCi#+j|Dm}^g>15+&(D|F5zxC_uA zI1N^yCi;rs51~^TINUagim*FtdVSx~S&6i#024^tv?`3ZZ}|*X)kMof8PklCsxS== zA?-Y&lrSBB+e`(K2T!j`fmjJ>hEKEQT9<}RHw3TBHOQW;S#7Rg72Q;g9V6*|W~gn| zg{#o6+&bR?*cev_#2-eS@oTKG*a}OmaIF>ktnd+pypHSC$4s}*!mqbNvcg9Z!gBP# z=ct(-akQ_?OQ_LC8u=1>+2iIIyZ@4^=$l?rLnLfDmA|Y;a1$)3R1@j!F0~)-6JA4i z$=a>rvwn2(J>akI<^_iiJn=Dq*jpThysrj>_xsn?3OJ_6_Nd8t>G8lG^;4s-v#lin z3|m8lckb|>1Gp&t3T8T|_G09mL>X_ua$!Mls1eA2?i<`)i}mt->g$qtQlIjsx`nsJ z+;6M(c;t(H2W3s7qwio0+F*8SuU9DR-&MH=vF~G69P=)u5>N3^kHZ89)dG6?JzB!k-Emsy`@IQ z@MeSB0B_!#T8jS`j=1Gf*zOg)R_W1uA5}XzpqrxOD03EVJFcci@xaLY#Z3Tw@dG*5 z(JVT5Tpb0jgs;?2#)8U8*TRSnfcMLu*5}&{2FDHV*QTfo5_6=$?=ucljsTT!JcM99KC-+4R&!=*>|vsK0}o! z&`i&o3GnSzB%q-u)ug6eDD17qJdbhsGjN=GE0vy92gPm!A7|({2tSJvC-*n%&o(ut zpr!hJtF~nWWy546DE*FG&iI&P8h_{`%;E8!Dovqwr!n{3M?Fu2j1NW`f$!*>c(ia@ zT^{8>L6+ z*~8)}p1+c`=?Aq;h#i!D2BxutrkqjdAvkkJeW5v5o-a;02Eeu3!5YHFI3E2C9PRzd zXuC5%L9;t3>SuL$qn%(h)PYPKVC)XCj?O>)vwAD0B}ac&tH#QPa<5hu}vskb% zqTI7;atph`az)DiEomKk=`7ByTXW;HXVpjGI*QJzo-U6ei9k{w_P7QtAmiA^?2qLb z$Cc;Zg(^NeiY&sI#1&^-uO?kSrw(+MgT%8Sjk3?Hi5>ZcU(SSOeF-Es82?y182A3k zQ-zg`dD(JbrXAF6J7 zL?*Mddt!AnT1VzQr*2}!cOlNT=BY*tgv@srfV(lz@K#eL-i&tc1{-&}y8NPagi%&1 z9eo@v((;1Zy9<}XQw6Rqvl%IY<58Y*tV=(RtIasB1Xu4hD!+hE@H%~d0b44V4qQ~* z#_mCRrgfO&goBYUb4sxKqPi@6AEL_uD5h%HXRku{G{6TiWb-2vIlrnwZk8<>JY24s zeD1GM=NnZ1D>~I``tnzGrSUShzisxR?5eh*1;1g4*-smOQxlD>xGF|A2$%DB)uQpS zCclqWDCm+J>Ea@pj}`tVwYsFXHBfA2MpEBVeCW{l0!CSLSuvXHEh@PL#d6AEIxql= z#XuJ6-AHs{DCNs%Qx)XH*GYEZHlpV&fn<7 zpMj?l9{%H9#XWzkAuM8gl|JmcIy=Gt z2;er569IV^aQm7|>x%a7pw(K z-~AJRA|GFEP5(l}XDEi?U8(KCTBz$k_R8pogS9_J*lFPWP0t}W|0MddzV<`&@9pg9 zqTH*w4(wk3Yo}33i59UwM4J=#L#?^34$*#V{-ZrbKyGL3G$S{CzgzoEMEz7-e(0)A zsPsB|(uLdM9by`4LHY@g)1?L}C{H?}Hs&Q3FmrxD@Ws<895W_K-I zTe(zOEwn)v?P4voTP@nJwa_vw+HW;!Hye!+ZxJumBpNiHVsJzK zZl_U~NUf9MnL=qnq?U-mwlq>pHZUq32FAEequ(Pn^Q}my9u=iMAw~UxZ2n;;Mng=S zk8{*n2{5z^(OP69`xxfmDrA58CmuS)YVZ&(9ZC~sN&~VxfQLnH2p-6q0GRo&K;}>& z?aYv-iutmQ85KGZqs2*AY&fGd&i&sq_}gNR{}$fJ8;kyQ)xg|g^|NPUp^Pe*h(lmt zF&1aY(-8L>#PL$;AgohD8*6u}*Ab5)F%)A)VPmbcbmO1h^DI7qFJXod*q!IM!6#x0 z*pu{*(>hoJEQ!F z&9zNN2F8Thcdi(Ra9U{TX3=hDO{DFKS_Z+9)EDEjbW@W69dkEBpDqEBUul58) zKiUDJAMsk^DcpL{S*Et#Vyn!o8dafhHh})OpaS0RhAt1>!WA3_1K8hPORwr7JaegA zReKP7ppSZcq7C}>uK=HTokDE+1(Qbm2_1&{g(unR#BM-rlP!_2pic_29cFy{m4WeXL%o z(B(c=*rMAt-72(8Uv0c~yRENfvI<@6tND+U%fqgyR>}<*2(s2 zItM4gR=d$v_5|C9Xk#t<0WX?5eW;d)ax!ya#f2H@RPYxCKzy02wXfDQK3p@*>QzpH zpGai)97E~ZT0?4aw|1{#P(0=CLD{AFe9WdhEU!|Ry4-;V3m#-utS&)Om~jrWYE+jN z47X}jmzobkWiJf3R8yCru~h1Orxt0nj(>lk~)2j!u7E>uN$1(*RT*%R0G%^XYycD*L zdqY=?b1@dPP(cI-Xxdg#wc3zywB?MzFj|{x@Zw;}80{_N)?@e=dNe~M(a^D4Z$qWL z48D!Jj6*|J5xBMTpu-;HH1kZ8ho)t~c>c<;bc~$twHnJq6YkZ1G4gLnBgb3VhNeAS z8n5-UNHB#o^0u+m)sRZ_3<6DW!3oKtCu_mK= zjKJf+X_gO?2yPTUYnnBNON8+RW^)T1)%@vNlF>Gp@fjls4B<8qi_=hSaW0OXoSv?A zuEBvFEp9zyJZYH$VGCwhK0;y#`Vw?TfS!-0xka&EO+6i?v?Z zNt?SEbM7m2)WwsZ#aci9gvj;9+O47Kg3w#8ZBQVYKMvJ#}uD>N@Y5>dGd z({gM>Jhej0#{$>&5N2lkXxu|uH_5Hy#U7~o``6_LaGt}Y@t12*v_N>BE9|!TRQl-`Ki2lv_2%5H9+gBBhI|4@|cNX*gXhcz6rTzV;k%(Hhr6 z^RGSQYN7E_0?squq;;*4X{tp`s3jqrASY~Mrx|N!?AmQB(K>~(hS-?B0KQl)i8$b< z#Tg{dzzg7uN%#gCllU0|uN%DpzL?asIu(EH$qV3%NzIsqmx-RjjCj{tEoWh}T^?&; zo&`phHKi7se}Ub+7FshaU5i?1ylmw>Q)|*18H;b;8DL^dJJC>1Ccg>g-%4c@`y?R# zQ9yiaK>TTPK7x5WD_78pM=bLbwD%D$)xf6Gxkt3A$Mbkr++(S&YKO~9huD5#+Uz|HO1>>rgMpT0Dm^@ z8NC3$jEYoSWpALojK{^Ko2yCOQM~}ZnAEiLS%_F*2OV1s^3*d{T?^aDpLDUQ2 zi%DLt7^avTv|yv_vt#rE_+olybyBXV7r+;jZmlM9Z}9^7Vp4Y|VK?R&jzM#G7)IH5 z;#c4But2$q<9CCn4}hg{09b!LP}hHLe>(gaI!;|AW!9cxt@h3}Jvjd~9rN4x)7=4g0oa}cdqy_JuEpfO!xPxZXZ{wHz1DI}8ZBXx zcdga*+{?WHzPJ&ys@s>JP6)yv(45)*lX;t4)yJcnXt<5%zjm zs+xeTSXCoyp$)cZ_tZkmv}mJhq4~W_PEDFQ2KtqnYbP2?rNtYy5W`T~P%dHWmA6)l zH0nMSg?RydaoxvMTL)+71@OhBvDG9Vro8~Zm^7}M#J=1M;EPH3R+D&Er16Hi z(V#QJz4E!rcnG@L>VZkXc>#PeeJb_eY)#2{p5z7a#iRl% z+N@0y)9Bo0Ej7w62;{By4wSJ4%R|Fa=)1RI_tiNabRLl-=*-iaPt2eN&u9_GAs--( zK7j)^&)~tHSWo58YHKoPB7yOQ8f2bb_#GTOU{>CJfpnVooaXB|3ux{_{s+iSaLLO7!Lqo8dXpHC(*VSv_$uO4^8z^p}g#i2_o&%2v z;D|fGv&Pt{K0ucmH;6t-!Mk*G{Y}7vMWwS~tXsc48%jZ|1*<_4B3|vABK` z54Q2$xdV#Bqq2D#v^0EsZsdzt|Cid%2xP z*LJ~bSI~srTHodm*(p{kwlub?m3A7P+>N@g;^yWQ(@5;qQrEknzOvr@hSMG`sCkK{&{m%QFiBljD4;DRsBz5yd6iruG~2cy|y+2^peqFm$C{aomylnoZN z)P#N5+CaK}XsO3Y?1$RAQS<#;_vVk=^S5MX*Tu=7u+#K)`!&1^H;IS;NxzC#~IvHhRx*G+DLK{r_Wan6%Ni{YUed^UgN< zfuFTCj^?F-xk4(xRcyA?xM8EItP)QfFZ`@2Vch+m0t5c4y@_7_o0h8KyyVHt+8VJ# zpK?XR`NS;of~+8x-s3?gcJx22R1P zYNjf>uJN(V9oNx}Pt(!sXvQsc`8urs8IIwkViCSHUba$%`Yz1EyNWloP%z})upS$S z(drv$sAp-%4UK;Q9YHE(y<#1r+PW^*5iPc?>*#3Tg}o2Y!r1%pY{c(%7}p2DC#%?c z*^{xzY;??Ph`DZuW1!UtLO8k`bz+7dfCRu@0Jc~*v2Bzq9GxKK2H{AKvS-DUS2hB( z<|mo!d5V%8iD2#`IU*1YmK<@ak%mg+QTt-a5tHx&#NoLn{D4uycEow$VDWgo*+B_S z9QY3WclbJc?>^XyGrqpQld*A>Bsfyfsd?|>+sxv3b94stvN(A=J|4NJ8$}F2_JoPNgo#Amd0&BvMorLTY`~U<>uE?^vY1%K4k; z>5xH^q+|1M08UII5~Q&%cUcH;14pE^+lmx4fDT{Nxm@UrAO>EU2yr}u`&_pp&h0mG zzgo6X3D6>n%H0qwibO*Uk*upwifZWS8^#-ah#56QVAXDJLq{5zw}HbjfjT&8gva2U z!UTT(%HwEPOEH5z4r|Mo-zqumK?Ymsng`9hg)&1Oy>N=sZ1@wHKWq&}>l>$fJoJ93 zBgB{yu`}m-?=cwHhoRB%^QK`A}KPGRAWslYA?ceEFKX>YiLf3ogOxTCM} zD_}gAP<)wfJUBv`9pQKawCbNZ3yE|XKXcY7(lHtY<3s$#kx(r@SN(jXqY0{ZI1;MD zBg#leTjN(?x%qj>9>w`mMwG+cSQR@2kB@fX zx4RA)c>Ds%;TXqo_gf&_`_J2k1?gF_juFOBqwQ?$2*RH~dOEepI}-6ilIsj?V56z|##h zzPQ0Yq})WuJmla`f;C=9bi|wYpE?hLlQ|C4xg^IJ@sXb06pCwZfBazgN=Da062DI_ zCs(o~*L=ImhhS$1#I$l6nT(ozOuLgEsm2>hJilR&%AWKWPKJv)i%6uP{}xfx z6h~b65#+%R(O##cD&@C8TYN&(QXC%XQ!^@krqWX>j&SL7Gv4?MB;^dbNAWs}v*7N; zl|E+jIFDOAa9qt{%wL-5CSL*V1Y0VAuZQsIG)~TbhLeA7^3i|Qzq9DPcD1Mfk4cwKt8{w{M-%CLGftZtI24r&%%JQR zkmCmvAO0iq;SbE&Wj|x(@smpDTR0j^Kbvv&EO_(iA}2p*qFm>J@@r5vYxs+m`T~@l z3T0n3{(R(gVqk8tmm|KJnCtff$=za6b$1BEW`H%)rq*E*X`x_ zIDsnj9Qs0M=d>yLGt(wd9g{mbZN}K#jI=2;@+RcZ9yfV%^<67ar%Z0sYC`^unYkcL zo-jJiK&1@qp4q=&zdpAnTcNYt|66u4@}u`BIHrrv_+dUr3{9Nqcz_Zn;cnO@hgYwd zcp*ITw^jYD6uCTRB&tb4lUIDK&gZ`-ul`$AIu^fB?9z1wp( zd%dYmXK)Pvo6bm}uv}-iNbk)}XCU6n!kRSv*Qez=R|K`g=pNL#g`v5u%sVpsJDcQB z&4+GhjvGI2dVE3d^xP@qX5#MNsng?|Ovs-+A%9#G@=kRAs3aB?%%Rjt&bZbI1&IX{ z#xyA~f`o#U{HZf$jzzPy%%55?Zu+d;853rWn*r?P+|lDE&(N1mau(Jfya<+d0M2wK zpv5MkUOi%5-ZF1u=JfHILOkrvEb}(aoIX8wZf2c(j)2f2bH>b3dE+J{(@Y^RtwK%7 zEih23im!G!TjF)A4fi{zO3Ig1f1WcoZ7XM#+{$rjq)ia56YTj>Z{`d)F$K}t25L2n$ zd}seIPkJ+Nh2R56Pt2?{1oc1xDFfL|$BrvNo>z>jWaUnuF)mXmPET@f&zBx<-z}qaF^w*C z-W~GIN%wC{J3dt~zvT!$czctF^+ScuHd4q_F}{l1jDJS`?IP_L&N;yIZ@N-#PEh>qpo=&-Z-uJm;Q!&pG$p zbIv{Y-22WK8_a*LF*nUI!F~Z*R#9ns81~6-7skR-(P`4#V_N@hQ4?r|6Cyjn3QZoN zcZd`xb_NEEx2sK}Fu*9z)tclFE)0XWH0k3WX{~M1=dj|_8vCTiX!bDvsFB|EkOUmE z31>eeM2Ug@Zo*h?9BnqhR*_=1!agzG92;=-jyvuMA;=)uCyrNGMTsS>7q#u6O>~*V zWRqDjQ0L(Uo)k|21oH^`5`+`XBKZF(q(}t>IiN)(1WoX3^(yq2DR#7qjX@LPbpA=OCM0I zVsxm9qA)2mkyc(38Y`j$4SvMcrnHFa%{K8ys2RFMTj*G?>Y=s)a74B_!6vh2Q!q+w z@m|h8=7`SBs1UY4kAN3s$RZ$)i42=%_z&Eauw=5NDr^cI7Vn15zh(F#uZ~-Wi*$Pw zj1#5yR5XG(XfLAW6T(M9s>ly_M3~9nU(pm6zlVVLM4xIF+rrfVHqJ!AQK6Z6nc}45 zNyrj0&Scm@ZLC=7d`vzzN-;}Qu3`@O^5)H(>f-^u#shne z2lX1q>0|M3gtYSx<$EdYbb;P?S4Hkn;5&Cr|7G{1FNl|)I8QFeWZ1;UnJ(%zXC#We zCl6?}Olqq$hG^6k)F#c!fmV5Z720G;A2hv?PCIsZRwZ#DYl2vrxl-%>i6yff?n_zA zK}$Z4*jU+l5v*e6?BQPSx!IKpw7MUe`##(j#CarBlNZO@@@?W=o>3cH#W#7u8f_T0 zoy&%ay!=AyRWFaFHYLv?-dN6(5e4(f%F<03Cz=Yfh+vt&g9Wx*WmhyrQ@3=xLl_Fn zZYRFYM7b>n9Ad_TJ7J`(_ET&kZL!J6v%d`sSW|kDTbGJ1W-b3!{BIcPt|=L7@bRUL zi5F1r5ZB9g`t;F9?gQo5f!uAVkl@EMoK*(d*$-@D&Jrhas+Sxhf&YWsuaMO3E{}2> zt6TVbdC_9G6_yyQ_E4 zh%5DUi0e)8qS#vRpc=%J*NMN>J0hMZe$PdUXsj=?(rt0g1b9y@XmG#>Vr_#X;zBR+ ziXP&cTCuaiEV>#@&>?Qnth2)2SOM*#rqOEXAX%}z&gnkc_ycfFEeZ^mY0+R57n*{7 zjO6AhSv?wU!ZajUu1r*nVra90yaoQ|wjB8!;2Y6> z)CN~Y^&zX1zMfzD` z8VP1tVKoO#{UR7XB-dr>BCyKVP$*>LgEqLAxpH9`P{EcpgV7By5$=LKxxgtA&N|yaK5zl)$|E*~Egq&|fogeJ!kKLS!8bM(#Z7 zf<9VjY9lmi9c+ewY0m!G0vAC`3xAn37{{u2z6OOMJn5x(V7tPdk!RoqO)qu!%io`a z>qM1-r{O{Ma2tG#WKhQY^nh@E09j;kz@Ootn(96u!F$?b=l=p{G);Bw6rupm!9t3~ z2!f>&J|myQIv}2u()~Y1{_q8ujmcf#K%~Z*d<7P>=v!ByuSR(9swaH2 zufg5m$JUM}OHFdy0osA4F3lD>s2i5jEOBN?=yU4~@^CkVY3p^vAXcLO_$~a(Oj|o$ z!9=!MuJXaBv^e*bHM{8oclN_7I+~T$7ta_AA;c=kbi{WNDD`opGjN-G6^j5m!bFxSkxFBQrfqw4}@W+ zHti)lM)I_SUVNUgHeIhEp6Pz!xPryjg?q&7y!ai$x38vtAC4#bQE5y1!w`Ip}j?DA2}q9fBFON#L^ZMkAB0%(-?l#-C=fgp_wF&PdE(k+*8;^LXH=pIcF5dH{59-Qk5u9Y3bLHE6en;FzqAy?@8;9Ufi5I4 z67b3V-y`hd^*YuUm*PbPmrUP{R<)xFy8te$Z7WbHkfY|V#uI(Pr6#P$n?|1;(zZxu zPoye3TA~x?$P9^J5<6uR=FlTf-Sr|BK)RzFULxCEBBtFc(>7z4DEl@{qy-sd>t-}V zj%?pdwJAqb@3zY2gXp_1ehc0S1LX8AbXW(dHCxc;FXX`Lk`)aX@Qm0j}{55S=R~^!a zmb}rx_e4DopbC;wk5-*j=poe*Nh=@oCEe;)dDuhl>_s-YGzCd6O~KYik2iB&7)ko{ z;cn0H6n!4BZx>y77vsIS-7*d5Md-JPEOVj0m$m4>de&+0H-b~RAiX}%BexNL}-2u6V>1Bqokm8pus4lrMgwxRI>~?z(`FvfWilM$|FZ`2%#$)QX`I{FMT}7 zfyb#n?~uEWV?CAg^f&Pn_TU$1z17-Z#$2NuE^<)>$HljSl+hOg-} zbeuRsm(|~%!?UDWo&EtH11h>9A5v*E%i0fn+|v({Bp37cp2b{tk_buO@F4p~JthQs zCv^T~LOO|%hYLPJw}DoS`4kn-&TSnyL_YaBI@OYPJnT;rzxW!LA^BH(8IQ5o`PV4Q zE@`3nvi#v1rV(pW7gqSv6>{pIc%MHhyMYQ_TrRcBpj<|x=ld#>!l*)kvJ41U1uCh* zbo0UU4z;7dGFl;-m_dp|fz4EhV%4k!WiR-+$nL%}doaeS!xNPQ2D++hhAFSATZSrc z@Vy21D$``s-AV_|CPp!@L^Nw3N&#`y6e$Z=D@Jw12<1AG-jr2Vvh35$2-HG_F~C(bdO#UDL<Q9LLZ>Ad#XZTCDLb_GL4*ge44VzNG7+1+SCg(l}&!Mu~oSW zZ`X^t%7#GlBcV)L?MIL3hAM?B=U}z;8O7wcq9iXjb9P~VS>~MVvg|u@vKJI)=H8;s z&t1}kl#`d6GrzZ-huBMSVQzL=ZjYJsa&Ob`C9TNL%qcGExe7CWs?JO4Ex71*rA+$i y-14HI5%Ul=LAA0*nYPF*`bIWg+rK|@vh!%xwPT0=u6|-Lv?GS~mj`_f@&5y#u~f4F delta 5576 zcmbU_4OmrGwyt$93UV)AIKcICK|oYg9F;W7u##$?ulxf|GZjHgMMVJ>@sClomsyia zyXUgB2o(_o2E01QOhWvrsrO7A8*4Na`muUVBh2{Tl;${Voy+m@aNhULH~0J2{#k!} zt+m%)d!PGNk@NGd&YEZKP_7_DS1aw0K^e7GVjR?}7Q59RG{^6#q97f9t!6uP*yCfW zGf@>L%GVw+$J2e}w}q^Z+3jkZ)24D9HrQj5OD$0y&|uYz}6 zDzb+^gs8qfZo>$39^aFt}u|2-KeW=A>*J@HHEws zT+W1N7%X!u)GB?GL_hQz)T_48jb`gn+rs)V_HbCbJAw@q$Ep|{41o+{Cs_ge%l7|JlY1tyB?Ubv!mreso{R1nUfr(aj^QfR9StK@ zu6qpL?4pjkm+G+OgKWPp5g`PV;`9 z=JD2Corxm1Y|(;tjCj4!8hZ1_rncJKF&E&GyOO0cWjzVZJSZaquR6t zl{xc>iA(3UFl~s5UB_+WtY@H}8aAMda=M~@dn#|+u~{pb0vTh~`tyob6x!*Gt|Tl zs(b>tp=!%r)Y=35)w8Q28C$sO9VY$*E*CS`-R?f@ z^)INj!9LaCh*lpLX2MMM;09MzC}*%#lgAj$E#Tftzc7`%L4Q1uIV?m&kluwhUml zN-Ou!@Du1%FO=J(mh$QnD2}9AVrFwMc1l^D%sCRRzH!*qXXQ@FR^OLPY!wJJQ|fnTaOxHVNkf%^RcPt+!+bzEu*&#k4Fd4nrw0Gw8ft32?& z+Fa#{`lJ)PENQX()PAU1nESlC#q9~@uFi)>RaC9p&NHW4TM_9!Rs9pdO%=N-UVT&J zgqzgx9(t60NGPpO(EQcVS{qYq2YI|HwSDAd%I3~cs}<@R^p1a9FFpEK{_LkAEp zs@aAYc5q7+^ETMLHAlVyXrtgE;PTcS-4Aeyih}vrEuo3v? zF+LB43+y`OE(4wZGaRx6`G5;X2$h!hgo{ip8i*c>iPiim#|?vo@TMF7Mf$65*bVi@ z<_LJ7wHT?9p!v$KI1;4V4!MlwQSd4p{2*emB{)KuR2lj~asxLspmwz5XHW);Ld+8$dTwK7!{seas2*WH0@) z5w0`B@d1bK*g5zV*{-zn{CKGR7&6#y$M4`T<_cXuf!~^IUi>|Lq>1K=CXSRt*34oU z#ju*-GP~Zh8TvB=-~Er!PoIOGwlzZvFH$v}Z@3?tVYx^zX@PyB&*Yl+B~0TnF|wcW z>6g%G2B6|9%oA+L*Kk5aE_@C1Ou|Fo`VjbE?U5P$2k2!|CVUSog!R4ep}UFr?H_$X zoO2ECfdDafG=rT=j_^Lzw3@b1zcyIS$HpvAHagY@Jg4^MqG5uV zOdI_07iO@#Q_(*5DY7d*%Xo1`{cF0N8oT0Sc%uu2cf;PCWQki)r*YlzQ`km*{jvDY zBS=b&Jc7cxRQ2Fq&WA=V{^$XXZuvTQ0REjP*3H2T1f z6JaE|9msb+B|ESTcG0&E91E*yb`U1O`(~$Jy%0$$LFnWsTH*wL0}i(tp9W!nKNf;e z+!!J+GCAPZ5#}YfhvFky42; zG2Ik<-Hp9O>}Y#`k$Y3zDkMJffCyYCY%fOm*elxm54pd4HRHz!JlTUQT;f|pINcKC zLH~6E#_-lrY!dF_i|uq0Cb1bX3a{8i@8_d&y7Uhv^G4Zdb}}B2Y0x7wH4-1euQfgw zZY~J^Fj$=%;-R4v@dw_V0V%kK)t089KZ#ZloqL)0ymb-|HFNGc z#>J@FJEJM*6xvne0e(=)hHwp;j4|EsB!pZBk`Vd4zt+W|8MSG=b1;~mPUplJY~-cm zFj=iU13hf5@m>ZFw802!dlqMKhH*F1*fkgVDAyZ#naCx(o~A6sMUX@d3t2-FHJP39 z<3da~^LhGWGrY#?#fZXPumlZXIO3_*Pjjl~bQ|SlX z*iDH`aagdGEmjijHu9F@d;pKpv>vTre*CUi`~LMNq+f!BpWC%ALGJgLp$4YFIDB^n6Scj1!87z z1~K!cJ0D^f{topFQ~8m*ShLZzm1u|UG23fmAI9IOygJMSjpknS7XFIav)bQ zNJ#t{Btu}wOq?8FS1O0_$={7j{$ zom`rxs=|Fbt?j2dssAn<#COk>U3^SkM$s;G`2|>C$lZk3gnL~x>Y6D z!~yKXwIlfe>J}=?hbm%}SvVFE-|RXa^PyWhq3xBXg2YNw!5h^+Z{}5EFV<&G_xYx$ zD}B_fl{i>@46njjo!lv`;;Tj6k^HsX={U}&sA>-24a$8=<7!rc{?uBV;4x0Mr9^`y51D`F%q8A^K z4SC3m5x@yidl(ap=MHgla9Z%>VdUl747N=p#}Vm_0Y^~z0a0BY4&m;5vooUJ#cuoo zL46yzLT{(i20Xw8J@o`$5-)ysw!K~lQtUO(;;gfL3ErfV4=|dBN(FrDEXMc{9{TJo z?g+ljk&;{cBQDSqvCGE4HR4%b!I<(f)&rN{unSz|G%CN);o5$XIi(6Tbu8=D!Ys^r z%h$O-=^zl&F3|FS1X7uWJze|>dTqR7>}RM+ww5&G5Sn=fBaNIUJQm0tKl>KfAp2SV z9oCEY3$Ag*iz%4j(Dc(aOkvXaR?P3lm&xhB;C+Ft>=tT#g%ukGHtjoP{DN*8aX1Zd zXuMfu6a;BwLirAaS3O2^Z*8>3JhA;Wj|N+~BE=aQ1GN3%SIl;Ir`ZEB-WZ;s9kKDH zRWwZdm9cB6c3f^S7@ti(9IE2jhhFBwf)8#RAp)F|ybvfktkI$Qel zhc#E=6wxeIjQ{JoEvHY)ui&J5S>@N7TNTclTTd%%?zH5M+9$Lt5}=|9nr;&^?OLZr z8mA^`F@pXoReOfJ$0unMxqEGr7R}w;lQjMqrM5{Lf2ok)WNk7#@$_VEnLnF+F5G2& zIYZkKz#Ch@e@^jcyf#}P92bVXC0zpek@06>*N;s5{u diff --git a/byterun/caml/major_gc.h b/byterun/caml/major_gc.h index b2e3bd166..ff83a90c5 100644 --- a/byterun/caml/major_gc.h +++ b/byterun/caml/major_gc.h @@ -52,8 +52,8 @@ extern uintnat caml_fl_wsz_at_phase_change; #define Subphase_mark_final 12 /* after marking finalized value */ /* Subphase of clean */ -#define Subphase_clean_weak 20 /* clean weak arrays */ -#define Subphase_unlink_weak 21 /* remove dead weak arrays */ +#define Subphase_clean_ephe 20 /* clean ephemeron */ +#define Subphase_unlink_ephe 21 /* remove dead ephemeron */ CAMLextern char *caml_heap_start; extern uintnat total_heap_size; diff --git a/byterun/caml/minor_gc.h b/byterun/caml/minor_gc.h index a494db2ae..668cb2faa 100644 --- a/byterun/caml/minor_gc.h +++ b/byterun/caml/minor_gc.h @@ -36,8 +36,15 @@ extern int caml_in_minor_collection; } struct caml_ref_table CAML_TABLE_STRUCT(value *); -CAMLextern struct caml_ref_table caml_ref_table, caml_weak_ref_table, - caml_finalize_table; +CAMLextern struct caml_ref_table caml_ref_table, caml_finalize_table; + +struct caml_ephe_ref_elt { + value ephe; /* an ephemeron in major heap */ + mlsize_t offset; /* the offset that points in the minor heap */ +}; + +struct caml_ephe_ref_table CAML_TABLE_STRUCT(struct caml_ephe_ref_elt); +CAMLextern struct caml_ephe_ref_table caml_ephe_ref_table; extern void caml_set_minor_heap_size (asize_t); /* size in bytes */ extern void caml_empty_minor_heap (void); @@ -45,6 +52,9 @@ CAMLextern void caml_gc_dispatch (void); CAMLextern void garbage_collection (void); /* def in asmrun/signals_asm.c */ extern void caml_realloc_ref_table (struct caml_ref_table *); extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t); +extern void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *); +extern void caml_alloc_ephe_table (struct caml_ephe_ref_table *, + asize_t, asize_t); extern void caml_oldify_one (value, value *); extern void caml_oldify_mopup (void); @@ -64,4 +74,16 @@ static inline void add_to_ref_table (struct caml_ref_table *tbl, value *p) *tbl->ptr++ = p; } +static inline void add_to_ephe_ref_table (struct caml_ephe_ref_table *tbl, + value ar, mlsize_t offset) +{ + if (tbl->ptr >= tbl->limit){ + CAMLassert (tbl->ptr == tbl->limit); + caml_realloc_ephe_ref_table (tbl); + } + struct caml_ephe_ref_elt *ephe_ref = tbl->ptr++; + ephe_ref->ephe = ar; + ephe_ref->offset = offset; +} + #endif /* CAML_MINOR_GC_H */ diff --git a/byterun/caml/weak.h b/byterun/caml/weak.h index 0cf4b8b2b..ec599dcd5 100644 --- a/byterun/caml/weak.h +++ b/byterun/caml/weak.h @@ -18,7 +18,9 @@ #include "mlvalues.h" -extern value caml_weak_list_head; -extern value caml_weak_none; +extern value caml_ephe_list_head; +extern value caml_ephe_none; + +void caml_ephe_clean (value v); #endif /* CAML_WEAK_H */ diff --git a/byterun/compact.c b/byterun/compact.c index 07ffabb31..b317149f7 100644 --- a/byterun/compact.c +++ b/byterun/compact.c @@ -221,7 +221,7 @@ static void do_compaction (void) } /* Invert weak pointers. */ { - value *pp = &caml_weak_list_head; + value *pp = &caml_ephe_list_head; value p; word q; size_t sz, i; @@ -233,7 +233,7 @@ static void do_compaction (void) while (Ecolor (q) == 0) q = * (word *) q; sz = Wosize_ehd (q); for (i = 1; i < sz; i++){ - if (Field (p,i) != caml_weak_none){ + if (Field (p,i) != caml_ephe_none){ invert_pointer_at ((word *) &(Field (p,i))); } } @@ -402,7 +402,7 @@ void caml_compact_heap (void) CAMLassert (caml_young_ptr == caml_young_alloc_end); CAMLassert (caml_ref_table.ptr == caml_ref_table.base); - CAMLassert (caml_weak_ref_table.ptr == caml_weak_ref_table.base); + CAMLassert (caml_ephe_ref_table.ptr == caml_ephe_ref_table.base); do_compaction (); CAML_INSTR_TIME (tmr, "compact/main"); diff --git a/byterun/major_gc.c b/byterun/major_gc.c index f90e2985d..ed2aed1c2 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -51,6 +51,9 @@ static value *gray_vals_cur, *gray_vals_end; static asize_t gray_vals_size; static int heap_is_pure; /* The heap is pure if the only gray objects below [markhp] are also in [gray_vals]. */ +static int ephe_list_pure; /* The list of ephemerons is pure if + since the start of its iteration + no value have been darken. */ uintnat caml_allocated_words; uintnat caml_dependent_size, caml_dependent_allocated; double caml_extra_heap_resources; @@ -61,8 +64,8 @@ extern char *caml_fl_merge; /* Defined in freelist.c. */ static char *markhp, *chunk, *limit; int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final, - clean_weak,unlink_weak} */ -static value *weak_prev; + clean_ephe,unlink_ephe} */ +static value *ephe_prev; int caml_major_window = 1; double caml_major_ring[Max_major_window] = { 0. }; @@ -128,6 +131,7 @@ void caml_darken (value v, value *p /* not used */) #endif CAMLassert (!Is_blue_hd (h)); if (Is_white_hd (h)){ + ephe_list_pure = 0; if (t < No_scan_tag){ Hd_val (v) = Grayhd_hd (h); *gray_vals_cur++ = v; @@ -148,6 +152,8 @@ static void start_cycle (void) caml_gc_phase = Phase_mark; caml_gc_subphase = Subphase_mark_roots; markhp = NULL; + ephe_list_pure = 1; + ephe_prev = &caml_ephe_list_head; #ifdef DEBUG ++ major_gc_counter; caml_heap_check (); @@ -168,9 +174,9 @@ static mlsize_t current_index = 0; #define INSTR(x) /**/ #endif -//auxillary function of mark_slice +/* auxillary function of mark_slice */ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, - int *slice_pointers) + int in_ephemeron, int *slice_pointers) { value child; header_t chd; @@ -193,14 +199,21 @@ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, chd = Hd_val (child); if (Tag_hd (chd) == Forward_tag){ value f = Forward_val (child); - if (Is_block (f) - && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag)){ + if ((in_ephemeron && Is_long(f)) || + (Is_block (f) + && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag))){ /* Do not short-circuit the pointer. */ }else{ + /* The variable child is not changed because it must be mark alive */ Field (v, i) = f; - if (Is_block (f) && Is_young (f) && !Is_young (child)) - add_to_ref_table (&caml_ref_table, &Field (v, i)); + if (Is_block (f) && Is_young (f) && !Is_young (child)){ + if(in_ephemeron){ + add_to_ephe_ref_table (&caml_ephe_ref_table, v, i); + }else{ + add_to_ref_table (&caml_ref_table, &Field (v, i)); + } + } } } else if (Tag_hd(chd) == Infix_tag) { @@ -212,6 +225,7 @@ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, CAMLassert (Is_in_heap (child) || Is_black_hd (chd)); #endif if (Is_white_hd (chd)){ + ephe_list_pure = 0; Hd_val (child) = Grayhd_hd (chd); *gray_vals_ptr++ = child; if (gray_vals_ptr >= gray_vals_end) { @@ -225,6 +239,59 @@ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, return gray_vals_ptr; } +static value* mark_ephe_aux (value *gray_vals_ptr, value v, intnat *work, + int *slice_pointers) +{ + value child; + header_t hd; + mlsize_t size, i; + + hd = Hd_val(v); + Assert(Tag_val (v) == Abstract_tag); + child = Field(v,1); /* child = data */ + if ( child != caml_ephe_none && + Is_block (child) && Is_in_heap (child) && Is_white_val (child)){ + + int alive_data = 1; + + /* The liveness of the ephemeron is one of the condition */ + if (Is_white_hd (hd)) alive_data = 0; + + /* The liveness of the keys not caml_ephe_none is the other condition */ + size = Wosize_hd (hd); + for (i = 2; alive_data && i < size; i++){ + child = Field (v, i); /* child = one key */ + ephemeron_again: + if (Tag_val (child) == Forward_tag){ + value f = Forward_val (child); + if (Is_long (f) || + (Is_block (f) && + (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag))){ + /* Do not short-circuit the pointer. */ + }else{ + Field (v, i) = child = f; + goto ephemeron_again; + } + } + if (child != caml_ephe_none && + Is_block (child) && Is_in_heap (child) && Is_white_val (child)){ + alive_data = 0; + } + } + + if (alive_data){ + gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,1,/*in_ephemeron=*/1, + slice_pointers); + } + *work -= Whsize_wosize(size); + } else { /* a simily weak pointer or an already alive data */ + *work -= 1; + } + + return gray_vals_ptr; +} + static void mark_slice (intnat work) { value *gray_vals_ptr; /* Local copy of [gray_vals_cur] */ @@ -260,7 +327,9 @@ static void mark_slice (intnat work) INSTR (if (size > end) CAML_INSTR_INT ("major/mark/slice/remain", size - end);) for (i = start; i < end; i++){ - gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,i,&slice_pointers); + gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,i, + /*in_ephemeron=*/ 0, + &slice_pointers); } if (end < size){ work = 0; @@ -303,6 +372,15 @@ static void mark_slice (intnat work) chunk = caml_heap_start; markhp = chunk; limit = chunk + Chunk_size (chunk); + } else if (*ephe_prev != (value) NULL) { + /* Continue to scan the list of ephe */ + v = *ephe_prev; + gray_vals_ptr=mark_ephe_aux(gray_vals_ptr,v,&work,&slice_pointers); + ephe_prev = &Field(v,0); + } else if (!ephe_list_pure){ + /* We must scan again the list because some value have been darken */ + ephe_list_pure = 1; + ephe_prev = &caml_ephe_list_head; }else{ switch (caml_gc_subphase){ case Subphase_mark_roots: { @@ -325,14 +403,15 @@ static void mark_slice (intnat work) CAMLassert (start == 0); } /* Complete the marking */ + ephe_prev = &caml_ephe_list_head; caml_gc_subphase = Subphase_mark_final; } break; case Subphase_mark_final: { /* Initialise the clean phase. */ caml_gc_phase = Phase_clean; - caml_gc_subphase = Subphase_clean_weak; - weak_prev = &caml_weak_list_head; + caml_gc_subphase = Subphase_clean_ephe; + ephe_prev = &caml_ephe_list_head; work = 0; } break; @@ -349,65 +428,37 @@ static void mark_slice (intnat work) static void clean_slice (intnat work) { - value v, child; - header_t hd; - mlsize_t size, i; + value v; caml_gc_message (0x40, "Cleaning %ld words\n", work); caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); while (work > 0){ switch (caml_gc_subphase){ - case Subphase_clean_weak: { - v = *weak_prev; + case Subphase_clean_ephe: { + v = *ephe_prev; if (v != (value) NULL){ - hd = Hd_val (v); - size = Wosize_hd (hd); - for (i = 1; i < size; i++){ - child = Field (v, i); - weak_again: - if (child != caml_weak_none - && Is_block (child) && Is_in_heap_or_young (child)){ - if (Tag_val (child) == Forward_tag){ - value f = Forward_val (child); - if (Is_block (f)) { - if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){ - /* Do not short-circuit the pointer. */ - }else{ - Field (v, i) = child = f; - if (Is_block (f) && Is_young (f)) - add_to_ref_table(&caml_weak_ref_table, &Field (v, i)); - goto weak_again; - } - } - } - if (Is_white_val (child) && !Is_young (child)){ - Field (v, i) = caml_weak_none; - } - } - } - weak_prev = &Field (v, 0); - work -= Whsize_hd (hd); - }else{ - /* Subphase_clean_weak is done. - Start removing dead weak arrays. */ - caml_gc_subphase = Subphase_unlink_weak; - weak_prev = &caml_weak_list_head; - } + caml_ephe_clean(v); + ephe_prev = &Field (v, 0); + work -= Whsize_val (v); + }else{ + /* Subphase_clean_ephe is done. + Start removing dead ephe arrays. */ + caml_gc_subphase = Subphase_unlink_ephe; + ephe_prev = &caml_ephe_list_head; } - break; - case Subphase_unlink_weak: { - v = *weak_prev; + } + break; + case Subphase_unlink_ephe: { + v = *ephe_prev; if (v != (value) NULL){ - hd = Hd_val (v); - if (Color_hd (hd) == Caml_white){ - /* The whole array is dead, remove it from the list. */ - *weak_prev = Field (v, 0); - }else{ - weak_prev = &Field (v, 0); - } - work -= 1; + if (Color_val (v) == Caml_white){ + /* The whole array is dead, remove it from the list. */ + *ephe_prev = Field (v, 0); }else{ + ephe_prev = &Field (v, 0); + } + work -= 1; + }else{ /* Phase_clean is done. */ /* Initialise the sweep phase. */ caml_gc_sweep_hp = caml_heap_start; diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index b147e5e46..80f96878c 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -62,10 +62,12 @@ CAMLexport value *caml_young_trigger = NULL; CAMLexport struct caml_ref_table caml_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0}, - caml_weak_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0}, caml_finalize_table = { NULL, NULL, NULL, NULL, NULL, 0, 0}; /* table of custom blocks containing finalizers in the minor heap */ +CAMLexport struct caml_ephe_ref_table + caml_ephe_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0}; + int caml_in_minor_collection = 0; /* [sz] and [rsv] are numbers of entries */ @@ -91,6 +93,13 @@ void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv) alloc_generic_table ((struct generic_table *) tbl, sz, rsv, sizeof (value *)); } +void caml_alloc_ephe_table (struct caml_ephe_ref_table *tbl, asize_t sz, + asize_t rsv) +{ + alloc_generic_table ((struct generic_table *) tbl, sz, rsv, + sizeof (struct caml_ephe_ref_elt)); +} + static void reset_table (struct generic_table *tbl) { tbl->size = 0; @@ -174,7 +183,7 @@ void caml_set_minor_heap_size (asize_t bsz) caml_minor_heap_wsz = Wsize_bsize (bsz); reset_table ((struct generic_table *) &caml_ref_table); - reset_table ((struct generic_table *) &caml_weak_ref_table); + reset_table ((struct generic_table *) &caml_ephe_ref_table); } static value oldify_todo_list = 0; @@ -273,6 +282,7 @@ void caml_oldify_mopup (void) { value v, new_v, f; mlsize_t i; + struct caml_ephe_ref_elt *re; while (oldify_todo_list != 0){ v = oldify_todo_list; /* Get the head. */ @@ -293,6 +303,37 @@ void caml_oldify_mopup (void) } } } + + /* Oldify the data in the minor heap of alive ephemeron + During minor collection keys outside the minor heap are considered alive */ + for (re = caml_ephe_ref_table.base; + re < caml_ephe_ref_table.ptr; re++){ + /* look only at ephemeron with data in the minor heap */ + if (re->offset == 1){ + value *data = &Field(re->ephe,re->offset); + if (Is_block (*data) && Is_young (*data)){ + if (Hd_val (*data) == 0){ /* Value copied to major heap */ + *data = Field (*data, 0); + } else { + /* Test if the ephemeron is alive */ + int alive_data = 1; + value child; + for (i = 2; alive_data && i < Wosize_val(re->ephe); i++){ + child = Field (re->ephe, i); + if(child != caml_ephe_none + && Is_block (child) && Is_young (child) + && Hd_val (child) != 0){ /* Value not copied to major heap */ + alive_data = 0; + } + } + if (alive_data) caml_oldify_one(*data,data); + } + } + } + } + + if (oldify_todo_list != 0) caml_oldify_mopup (); + } /* Make sure the minor heap is empty by performing a minor collection @@ -302,6 +343,7 @@ void caml_empty_minor_heap (void) { value **r; uintnat prev_alloc_words; + struct caml_ephe_ref_elt *re; if (caml_young_ptr != caml_young_alloc_end){ if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) (); @@ -317,15 +359,20 @@ void caml_empty_minor_heap (void) CAML_INSTR_TIME (tmr, "minor/ref_table"); caml_oldify_mopup (); CAML_INSTR_TIME (tmr, "minor/copy"); - for (r = caml_weak_ref_table.base; r < caml_weak_ref_table.ptr; r++){ - if (Is_block (**r) && Is_young (**r)){ - if (Hd_val (**r) == 0){ - **r = Field (**r, 0); - }else{ - **r = caml_weak_none; + /* Update the ephemerons */ + for (re = caml_ephe_ref_table.base; + re < caml_ephe_ref_table.ptr; re++){ + value *key = &Field(re->ephe,re->offset); + if (Is_block (*key) && Is_young (*key)){ + if (Hd_val (*key) == 0){ /* Value copied to major heap */ + *key = Field (*key, 0); + }else{ /* Value not copied so it's dead */ + *key = caml_ephe_none; + Field(re->ephe,1) = caml_ephe_none; } } } + /* Run custom block finalisation of dead minor value */ for (r = caml_finalize_table.base; r < caml_finalize_table.ptr; r++){ int hd = Hd_val ((value)*r); if (hd != 0){ /* If not oldified the finalizer must be called */ @@ -339,7 +386,7 @@ void caml_empty_minor_heap (void) / caml_minor_heap_wsz; caml_young_ptr = caml_young_alloc_end; clear_table ((struct generic_table *) &caml_ref_table); - clear_table ((struct generic_table *) &caml_weak_ref_table); + clear_table ((struct generic_table *) &caml_ephe_ref_table); clear_table ((struct generic_table *) &caml_finalize_table); caml_gc_message (0x02, ">", 0); caml_in_minor_collection = 0; @@ -479,3 +526,13 @@ void caml_realloc_ref_table (struct caml_ref_table *tbl) "Growing ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", "Fatal error: ref_table overflow\n"); } + +void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *tbl) +{ + realloc_generic_table + ((struct generic_table *) tbl, sizeof (struct caml_ephe_ref_elt), + "request_minor/realloc_ephe_ref_table@", + "ephe_ref_table threshold crossed\n", + "Growing ephe_ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", + "Fatal error: ephe_ref_table overflow\n"); +} diff --git a/byterun/weak.c b/byterun/weak.c index 62b62ef88..89ec92242 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* Operations on weak arrays */ +/* Operations on weak arrays and ephemerons (named ephe here)*/ #include @@ -21,29 +21,147 @@ #include "caml/memory.h" #include "caml/mlvalues.h" -value caml_weak_list_head = 0; +value caml_ephe_list_head = 0; -static value weak_dummy = 0; -value caml_weak_none = (value) &weak_dummy; +static value ephe_dummy = 0; +value caml_ephe_none = (value) &ephe_dummy; + +/** The first field 0: weak list; + second field 1: data; + others 2..: keys; + + A weak pointer is an ephemeron with the data at caml_ephe_none + */ /* [len] is a value that represents a number of words (fields) */ -CAMLprim value caml_weak_create (value len) +CAMLprim value caml_ephe_create (value len) { mlsize_t size, i; value res; - size = Long_val (len) + 1; + size = Long_val (len) + 1 /* weak_list */ + 1 /* the value */; if (size <= 0 || size > Max_wosize) caml_invalid_argument ("Weak.create"); res = caml_alloc_shr (size, Abstract_tag); - for (i = 1; i < size; i++) Field (res, i) = caml_weak_none; - Field (res, 0) = caml_weak_list_head; - caml_weak_list_head = res; + for (i = 1; i < size; i++) Field (res, i) = caml_ephe_none; + Field (res, 0) = caml_ephe_list_head; + caml_ephe_list_head = res; return res; } +CAMLprim value caml_weak_create (value len) +{ + return caml_ephe_create(len); +} + +/** + Specificity of the cleaning phase (Phase_clean): + + The dead keys must be removed from the ephemerons and data removed + when one the keys is dead. Here we call it cleaning the ephemerons. + A specific phase of the GC is dedicated to this, Phase_clean. This + phase is just after the mark phase, so the white values are dead + values. It iterates the function caml_ephe_clean through all the + ephemerons. + + However the GC is incremental and ocaml code can run on the middle + of this cleaning phase. In order to respect the semantic of the + ephemerons concerning dead values, the getter and setter must work + as if the cleaning of all the ephemerons have been done at once. + + - key getter: Even if a dead key have not yet been replaced by + caml_ephe_none, getting it should return none. + - key setter: If we replace a dead key we need to set the data to + caml_ephe_none and clean the ephemeron. + + This two cases are dealt by a call to do_check_key_clean that + trigger the cleaning of the ephemerons when the accessed key is + dead. This test is fast. + + In the case of value getter and value setter, there is no fast + test because the removing of the data depend of the deadliness of the keys. + We must always try to clean the ephemerons. + + */ + +void caml_ephe_clean (value v){ + value child; + int release_data = 0; + mlsize_t size, i; + header_t hd; + Assert(caml_gc_phase == Phase_clean); + + hd = Hd_val (v); + size = Wosize_hd (hd); + for (i = 2; i < size; i++){ + child = Field (v, i); + ephemeron_again: + if (child != caml_ephe_none + && Is_block (child) && Is_in_heap_or_young (child)){ + if (Tag_val (child) == Forward_tag){ + value f = Forward_val (child); + if (Is_block (f)) { + if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){ + /* Do not short-circuit the pointer. */ + }else{ + Field (v, i) = child = f; + if (Is_block (f) && Is_young (f)) + add_to_ephe_ref_table(&caml_ephe_ref_table, v, i); + goto ephemeron_again; + } + } + } + if (Is_white_val (child) && !Is_young (child)){ + release_data = 1; + Field (v, i) = caml_ephe_none; + } + } + } + + child = Field (v, 1); + if(child != caml_ephe_none){ + if (release_data){ + Field (v, 1) = caml_ephe_none; + } else { + /* The mark phase must have marked it */ + Assert( !(Is_block (child) && Is_in_heap (child) + && Is_white_val (child)) ); + } + } +} + + #define None_val (Val_int(0)) #define Some_tag 0 +/* If we are in Phase_clean we need to check if the key + that is going to disappear is dead and so should trigger a cleaning + */ +static void do_check_key_clean(value ar, mlsize_t offset){ + Assert ( offset >= 2); + if (caml_gc_phase == Phase_clean){ + value elt = Field (ar, offset); + if (Is_block (elt) && Is_in_heap (elt) && Is_white_val(elt)){ + caml_ephe_clean(ar); + }; + }; +} + +/* If we are in Phase_clean we need to do as if the key is empty when + it will be cleaned during this phase */ +static int is_ephe_key_none(value ar, value elt){ + if (elt == caml_ephe_none){ + return 1; + }else if (caml_gc_phase == Phase_clean && + Is_block (elt) && Is_in_heap (elt) && Is_white_val(elt)){ + caml_ephe_clean(ar); + return 1; + } else { + return 0; + } +} + + static void do_set (value ar, mlsize_t offset, value v) { if (Is_block (v) && Is_young (v)){ @@ -51,55 +169,116 @@ static void do_set (value ar, mlsize_t offset, value v) value old = Field (ar, offset); Field (ar, offset) = v; if (!(Is_block (old) && Is_young (old))){ - add_to_ref_table (&caml_weak_ref_table, &Field (ar, offset)); + add_to_ephe_ref_table (&caml_ephe_ref_table, ar, offset); } }else{ Field (ar, offset) = v; } } -CAMLprim value caml_weak_set (value ar, value n, value el) +CAMLprim value caml_ephe_set_key (value ar, value n, value el) { - mlsize_t offset = Long_val (n) + 1; + mlsize_t offset = Long_val (n) + 2; Assert (Is_in_heap (ar)); - if (offset < 1 || offset >= Wosize_val (ar)){ + if (offset < 2 || offset >= Wosize_val (ar)){ caml_invalid_argument ("Weak.set"); } + do_check_key_clean(ar,offset); + do_set (ar, offset, el); + return Val_unit; +} + +CAMLprim value caml_ephe_unset_key (value ar, value n) +{ + mlsize_t offset = Long_val (n) + 2; + Assert (Is_in_heap (ar)); + if (offset < 2 || offset >= Wosize_val (ar)){ + caml_invalid_argument ("Weak.set"); + } + do_check_key_clean(ar,offset); + Field (ar, offset) = caml_ephe_none; + return Val_unit; +} + +value caml_ephe_set_key_option (value ar, value n, value el) +{ + mlsize_t offset = Long_val (n) + 2; + Assert (Is_in_heap (ar)); + if (offset < 2 || offset >= Wosize_val (ar)){ + caml_invalid_argument ("Weak.set"); + } + do_check_key_clean(ar,offset); if (el != None_val && Is_block (el)){ Assert (Wosize_val (el) == 1); do_set (ar, offset, Field (el, 0)); }else{ - Field (ar, offset) = caml_weak_none; + Field (ar, offset) = caml_ephe_none; } return Val_unit; } +CAMLprim value caml_weak_set (value ar, value n, value el){ + return caml_ephe_set_key_option(ar,n,el); +} + +CAMLprim value caml_ephe_set_data (value ar, value el) +{ + Assert (Is_in_heap (ar)); + if (caml_gc_phase == Phase_clean){ + /* During this phase since we don't know which ephemeron have been + cleaned we always need to check it. */ + caml_ephe_clean(ar); + }; + do_set (ar, 1, el); + return Val_unit; +} + +CAMLprim value caml_ephe_unset_data (value ar) +{ + Assert (Is_in_heap (ar)); + Field (ar, 1) = caml_ephe_none; + return Val_unit; +} + + #define Setup_for_gc #define Restore_after_gc -int caml_is_weak_none(value ar, mlsize_t offset, value elt){ - if (elt == caml_weak_none){ - return 1; - }else if (caml_gc_phase == Phase_clean && - Is_block (elt) && Is_in_heap (elt) && Is_white_val(elt)){ - /** Must be cleaned during this phase */ - Field (ar, offset) = caml_weak_none; /* just optimisation */ - return 1; - } - return 0; -} - -CAMLprim value caml_weak_get (value ar, value n) +CAMLprim value caml_ephe_get_key (value ar, value n) { CAMLparam2 (ar, n); - mlsize_t offset = Long_val (n) + 1; + mlsize_t offset = Long_val (n) + 2; CAMLlocal2 (res, elt); Assert (Is_in_heap (ar)); - if (offset < 1 || offset >= Wosize_val (ar)){ - caml_invalid_argument ("Weak.get"); + if (offset < 2 || offset >= Wosize_val (ar)){ + caml_invalid_argument ("Weak.get_key"); } elt = Field (ar, offset); - if (caml_is_weak_none(ar, offset, elt)){ + if (is_ephe_key_none(ar, elt)){ + res = None_val; + }else{ + if (caml_gc_phase == Phase_mark && Is_block (elt) && Is_in_heap (elt)){ + caml_darken (elt, NULL); + } + res = caml_alloc_small (1, Some_tag); + Field (res, 0) = elt; + } + CAMLreturn (res); +} + +CAMLprim value caml_weak_get (value ar, value n){ + return caml_ephe_get_key(ar, n); +} + +CAMLprim value caml_ephe_get_data (value ar) +{ + CAMLparam1 (ar); + mlsize_t offset = 1; + CAMLlocal2 (res, elt); + Assert (Is_in_heap (ar)); + elt = Field (ar, offset); + if(caml_gc_phase == Phase_clean) caml_ephe_clean(ar); + if (elt == caml_ephe_none){ res = None_val; }else{ if (caml_gc_phase == Phase_mark && Is_block (elt) && Is_in_heap (elt)){ @@ -114,24 +293,24 @@ CAMLprim value caml_weak_get (value ar, value n) #undef Setup_for_gc #undef Restore_after_gc -CAMLprim value caml_weak_get_copy (value ar, value n) +CAMLprim value caml_ephe_get_key_copy (value ar, value n) { CAMLparam2 (ar, n); - mlsize_t offset = Long_val (n) + 1; + mlsize_t offset = Long_val (n) + 2; CAMLlocal2 (res, elt); value v; /* Caution: this is NOT a local root. */ Assert (Is_in_heap (ar)); if (offset < 1 || offset >= Wosize_val (ar)){ - caml_invalid_argument ("Weak.get"); + caml_invalid_argument ("Weak.get_copy"); } v = Field (ar, offset); - if (caml_is_weak_none(ar, offset, v)) CAMLreturn (None_val); + if (is_ephe_key_none(ar, v)) CAMLreturn (None_val); if (Is_block (v) && Is_in_heap_or_young(v)) { elt = caml_alloc (Wosize_val (v), Tag_val (v)); /* The GC may erase or move v during this call to caml_alloc. */ v = Field (ar, offset); - if (caml_is_weak_none(ar, offset, v)) CAMLreturn (None_val); + if (is_ephe_key_none(ar, v)) CAMLreturn (None_val); if (Tag_val (v) < No_scan_tag){ mlsize_t i; for (i = 0; i < Wosize_val (v); i++){ @@ -153,21 +332,74 @@ CAMLprim value caml_weak_get_copy (value ar, value n) CAMLreturn (res); } -CAMLprim value caml_weak_check (value ar, value n) -{ - mlsize_t offset = Long_val (n) + 1; - Assert (Is_in_heap (ar)); - if (offset < 1 || offset >= Wosize_val (ar)){ - caml_invalid_argument ("Weak.get"); - } - return Val_bool (!caml_is_weak_none(ar, offset, Field (ar, offset))); +CAMLprim value caml_weak_get_copy (value ar, value n){ + return caml_ephe_get_key_copy(ar,n); } -CAMLprim value caml_weak_blit (value ars, value ofs, +CAMLprim value caml_ephe_get_data_copy (value ar) +{ + CAMLparam1 (ar); + mlsize_t offset = 1; + CAMLlocal2 (res, elt); + value v; /* Caution: this is NOT a local root. */ + Assert (Is_in_heap (ar)); + + v = Field (ar, offset); + if (caml_gc_phase == Phase_clean) caml_ephe_clean(ar); + if (v == caml_ephe_none) CAMLreturn (None_val); + if (Is_block (v) && Is_in_heap_or_young(v)) { + elt = caml_alloc (Wosize_val (v), Tag_val (v)); + /* The GC may erase or move v during this call to caml_alloc. */ + v = Field (ar, offset); + if (caml_gc_phase == Phase_clean) caml_ephe_clean(ar); + if (v == caml_ephe_none) CAMLreturn (None_val); + if (Tag_val (v) < No_scan_tag){ + mlsize_t i; + for (i = 0; i < Wosize_val (v); i++){ + value f = Field (v, i); + if (caml_gc_phase == Phase_mark && Is_block (f) && Is_in_heap (f)){ + caml_darken (f, NULL); + } + Modify (&Field (elt, i), f); + } + }else{ + memmove (Bp_val (elt), Bp_val (v), Bosize_val (v)); + } + }else{ + elt = v; + } + res = caml_alloc_small (1, Some_tag); + Field (res, 0) = elt; + + CAMLreturn (res); +} + +CAMLprim value caml_ephe_check_key (value ar, value n) +{ + mlsize_t offset = Long_val (n) + 2; + Assert (Is_in_heap (ar)); + if (offset < 2 || offset >= Wosize_val (ar)){ + caml_invalid_argument ("Weak.check"); + } + return Val_bool (!is_ephe_key_none(ar, Field (ar, offset))); +} + +CAMLprim value caml_weak_check (value ar, value n) +{ + return caml_ephe_check_key(ar,n); +} + +CAMLprim value caml_ephe_check_data (value ar) +{ + if(caml_gc_phase == Phase_clean) caml_ephe_clean(ar); + return Val_bool (Field (ar, 1) != caml_ephe_none); +} + +CAMLprim value caml_ephe_blit_key (value ars, value ofs, value ard, value ofd, value len) { - mlsize_t offset_s = Long_val (ofs) + 1; - mlsize_t offset_d = Long_val (ofd) + 1; + mlsize_t offset_s = Long_val (ofs) + 2; + mlsize_t offset_d = Long_val (ofd) + 2; mlsize_t length = Long_val (len); long i; Assert (Is_in_heap (ars)); @@ -178,15 +410,7 @@ CAMLprim value caml_weak_blit (value ars, value ofs, if (offset_d < 1 || offset_d + length > Wosize_val (ard)){ caml_invalid_argument ("Weak.blit"); } - if (caml_gc_phase == Phase_clean){ - for (i = 0; i < length; i++){ - value v = Field (ars, offset_s + i); - if (v != caml_weak_none && Is_block (v) && Is_in_heap (v) - && Is_white_val (v)){ - Field (ars, offset_s + i) = caml_weak_none; - } - } - } + if (caml_gc_phase == Phase_clean) caml_ephe_clean(ars); if (offset_d < offset_s){ for (i = 0; i < length; i++){ do_set (ard, offset_d + i, Field (ars, offset_s + i)); @@ -198,3 +422,19 @@ CAMLprim value caml_weak_blit (value ars, value ofs, } return Val_unit; } + +CAMLprim value caml_ephe_blit_data (value ars, value ard) +{ + if(caml_gc_phase == Phase_clean) { + caml_ephe_clean(ars); + caml_ephe_clean(ard); + }; + do_set (ard, 1, Field (ars, 1)); + return Val_unit; +} + +CAMLprim value caml_weak_blit (value ars, value ofs, + value ard, value ofd, value len) +{ + return caml_ephe_blit_key (ars, ofs, ard, ofd, len); +} diff --git a/stdlib/weak.ml b/stdlib/weak.ml index 71385c9b7..79abf7fff 100644 --- a/stdlib/weak.ml +++ b/stdlib/weak.ml @@ -17,7 +17,7 @@ type 'a t;; external create : int -> 'a t = "caml_weak_create";; -let length x = Obj.size(Obj.repr x) - 1;; +let length x = Obj.size(Obj.repr x) - 2;; external set : 'a t -> int -> 'a option -> unit = "caml_weak_set";; external get : 'a t -> int -> 'a option = "caml_weak_get";; From 189d29bfcf98525f63c1c3c4a4a2be9989a62ef7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Mon, 3 Feb 2014 20:30:07 +0100 Subject: [PATCH 075/145] [Stdlib] Hashtbl: add a getter for randomize --- stdlib/hashtbl.ml | 1 + stdlib/hashtbl.mli | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml index 1e884e671..55b43c191 100644 --- a/stdlib/hashtbl.ml +++ b/stdlib/hashtbl.ml @@ -47,6 +47,7 @@ let randomized_default = let randomized = ref randomized_default let randomize () = randomized := true +let is_randomized () = !randomized let prng = lazy (Random.State.make_self_init()) diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index e64a170fd..076efe414 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -182,6 +182,11 @@ val randomize : unit -> unit @since 4.00.0 *) +val is_randomized : unit -> bool +(** return if the tables are currently created in randomized mode by default + + @since 4.02.0 *) + type statistics = { num_bindings: int; (** Number of bindings present in the table. From 03ed6a0f5169304ff29326e7fb1dd8e310dc405a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Tue, 4 Feb 2014 08:56:26 +0100 Subject: [PATCH 076/145] [Stdlib] Ephemeron: add the module in the stdlib --- otherlibs/threads/Makefile | 9 +- stdlib/.depend | 5 + stdlib/Makefile.shared | 2 +- stdlib/ephemeron.ml | 573 +++++++++++++++++++++++ stdlib/ephemeron.mli | 306 ++++++++++++ stdlib/obj.ml | 25 + stdlib/obj.mli | 39 ++ stdlib/stdlib.mllib | 1 + testsuite/tests/misc/ephetest.ml | 172 +++++++ testsuite/tests/misc/ephetest.reference | 29 ++ testsuite/tests/misc/ephetest2.ml | 161 +++++++ testsuite/tests/misc/ephetest2.reference | 5 + 12 files changed, 1322 insertions(+), 5 deletions(-) create mode 100644 stdlib/ephemeron.ml create mode 100644 stdlib/ephemeron.mli create mode 100644 testsuite/tests/misc/ephetest.ml create mode 100644 testsuite/tests/misc/ephetest.reference create mode 100644 testsuite/tests/misc/ephetest2.ml create mode 100644 testsuite/tests/misc/ephetest2.reference diff --git a/otherlibs/threads/Makefile b/otherlibs/threads/Makefile index b7851d0b7..771e52375 100644 --- a/otherlibs/threads/Makefile +++ b/otherlibs/threads/Makefile @@ -33,7 +33,7 @@ LIB=../../stdlib LIB_OBJS=$(LIB)/camlinternalFormatBasics.cmo pervasives.cmo \ $(LIB)/array.cmo $(LIB)/list.cmo $(LIB)/char.cmo $(LIB)/bytes.cmo \ - $(LIB)/string.cmo $(LIB)/sys.cmo $(LIB)/sort.cmo marshal.cmo \ + $(LIB)/string.cmo $(LIB)/sys.cmo $(LIB)/sort.cmo marshal.cmo \ $(LIB)/obj.cmo $(LIB)/int32.cmo $(LIB)/int64.cmo \ $(LIB)/nativeint.cmo $(LIB)/lexing.cmo $(LIB)/parsing.cmo \ $(LIB)/set.cmo $(LIB)/map.cmo $(LIB)/stack.cmo $(LIB)/queue.cmo \ @@ -43,9 +43,10 @@ LIB_OBJS=$(LIB)/camlinternalFormatBasics.cmo pervasives.cmo \ $(LIB)/random.cmo $(LIB)/hashtbl.cmo $(LIB)/format.cmo \ $(LIB)/scanf.cmo $(LIB)/callback.cmo $(LIB)/camlinternalOO.cmo \ $(LIB)/oo.cmo $(LIB)/camlinternalMod.cmo $(LIB)/genlex.cmo \ - $(LIB)/weak.cmo $(LIB)/filename.cmo $(LIB)/complex.cmo \ - $(LIB)/arrayLabels.cmo $(LIB)/listLabels.cmo $(LIB)/bytesLabels.cmo \ - $(LIB)/stringLabels.cmo $(LIB)/moreLabels.cmo $(LIB)/stdLabels.cmo + $(LIB)/weak.cmo $(LIB)/ephemeron.cmo $(LIB)/filename.cmo \ + $(LIB)/complex.cmo $(LIB)/arrayLabels.cmo $(LIB)/listLabels.cmo \ + $(LIB)/bytesLabels.cmo $(LIB)/stringLabels.cmo \ + $(LIB)/moreLabels.cmo $(LIB)/stdLabels.cmo UNIXLIB=../unix diff --git a/stdlib/.depend b/stdlib/.depend index bdf9cbb24..d83a6c53c 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -48,6 +48,7 @@ stringLabels.cmi : sys.cmi : uchar.cmi : format.cmi weak.cmi : hashtbl.cmi +ephemeron.cmi : hashtbl.cmi obj.cmi arg.cmo : sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi \ arg.cmi arg.cmx : sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx \ @@ -176,6 +177,8 @@ uchar.cmo : printf.cmi pervasives.cmi format.cmi char.cmi uchar.cmi uchar.cmx : printf.cmx pervasives.cmx format.cmx char.cmx uchar.cmi weak.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi weak.cmx : sys.cmx obj.cmx hashtbl.cmx array.cmx weak.cmi +ephemeron.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi obj.cmi ephemeron.cmi +ephemeron.cmx : sys.cmx obj.cmx hashtbl.cmx array.cmx obj.cmx ephemeron.cmi arg.cmo : sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi \ arg.cmi arg.p.cmx : sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx \ @@ -304,3 +307,5 @@ uchar.cmo : printf.cmi pervasives.cmi format.cmi char.cmi uchar.cmi uchar.p.cmx : printf.cmx pervasives.cmx format.cmx char.cmx uchar.cmi weak.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi weak.p.cmx : sys.cmx obj.cmx hashtbl.cmx array.cmx weak.cmi +ephemeron.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi obj.cmi ephemeron.cmi +ephemeron.p.cmx : sys.cmx obj.cmx hashtbl.cmx array.cmx obj.cmx ephemeron.cmi diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared index 5d1b73cb3..92bf46b7e 100755 --- a/stdlib/Makefile.shared +++ b/stdlib/Makefile.shared @@ -36,7 +36,7 @@ OTHERS=list.cmo char.cmo bytes.cmo string.cmo sys.cmo \ digest.cmo random.cmo hashtbl.cmo weak.cmo \ format.cmo uchar.cmo scanf.cmo callback.cmo \ camlinternalOO.cmo oo.cmo camlinternalMod.cmo \ - genlex.cmo \ + genlex.cmo ephemeron.cmo \ filename.cmo complex.cmo \ arrayLabels.cmo listLabels.cmo bytesLabels.cmo \ stringLabels.cmo moreLabels.cmo stdLabels.cmo diff --git a/stdlib/ephemeron.ml b/stdlib/ephemeron.ml new file mode 100644 index 000000000..40a32bcae --- /dev/null +++ b/stdlib/ephemeron.ml @@ -0,0 +1,573 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) + +module type SeededS = sig + include Hashtbl.SeededS + val stats_alive: 'a t -> Hashtbl.statistics + (** same as {!stats} but only count the alive bindings *) +end + +module type S = sig + include Hashtbl.S + val stats_alive: 'a t -> Hashtbl.statistics + (** same as {!stats} but only count the alive bindings *) +end + +module GenHashTable = struct + + type equal = + | ETrue | EFalse + | EDead (** the garbage collector reclaimed the data *) + + module MakeSeeded(H: sig + type t + type 'a container + val create: t -> 'a -> 'a container + val hash: int -> t -> int + val equal: t -> 'a container -> equal + val get_data: 'a container -> 'a option + val get_key: 'a container -> t option + val set_data: 'a container -> 'a -> unit + val check_key: 'a container -> bool + end) : SeededS with type key = H.t + = struct + + type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a bucketlist array; (* the buckets *) + mutable seed: int; (* for randomization *) + initial_size: int; (* initial array size *) + } + + and 'a bucketlist = + | Empty + | Cons of int (** hash of the key *) * 'a H.container * 'a bucketlist + + (** the hash of the key is kept in order to test the equality of the hash + before the key. Same reason than for Weak.Make *) + + type key = H.t + + let rec power_2_above x n = + if x >= n then x + else if x * 2 > Sys.max_array_length then x + else power_2_above (x * 2) n + + let prng = lazy (Random.State.make_self_init()) + + let create ?(random = (Hashtbl.is_randomized ())) initial_size = + let s = power_2_above 16 initial_size in + let seed = if random then Random.State.bits (Lazy.force prng) else 0 in + { initial_size = s; size = 0; seed = seed; data = Array.make s Empty } + + let clear h = + h.size <- 0; + let len = Array.length h.data in + for i = 0 to len - 1 do + h.data.(i) <- Empty + done + + let reset h = + let len = Array.length h.data in + if len = h.initial_size then + clear h + else begin + h.size <- 0; + h.data <- Array.make h.initial_size Empty + end + + let copy h = { h with data = Array.copy h.data } + + let key_index h hkey = + hkey land (Array.length h.data - 1) + + let resize indexfun h = + let odata = h.data in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize < Sys.max_array_length then begin + let ndata = Array.make nsize Empty in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + Empty -> () + | Cons(key, data, rest) -> + insert_bucket rest; (* preserve original order of elements *) + let nidx = indexfun h key in + ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in + for i = 0 to osize - 1 do + insert_bucket odata.(i) + done + end + + let add h key info = + let hkey = H.hash h.seed key in + let i = key_index h hkey in + let container = H.create key info in + let bucket = Cons(hkey, container, h.data.(i)) in + h.data.(i) <- bucket; + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then resize key_index h + + let remove h key = + let hkey = H.hash h.seed key in + let rec remove_bucket = function + | Empty -> Empty + | Cons(hk, c, next) when hkey = hk -> + begin match H.equal key c with + | ETrue -> h.size <- h.size - 1; next + | EFalse -> Cons(hk, c, remove_bucket next) + | EDead -> remove_bucket next (** The key have been reclaimed *) + end + | Cons(hk,c,next) -> Cons(hk, c, remove_bucket next) in + let i = key_index h hkey in + h.data.(i) <- remove_bucket h.data.(i) + + let rec find_rec key hkey = function + | Empty -> + raise Not_found + | Cons(hk, c, rest) when hkey = hk -> + begin match H.equal key c with + | ETrue -> + begin match H.get_data c with + | None -> + (** This case is not impossible because the gc can run between + H.equal and H.get_data *) + (** TODO? remove this dead key *) + find_rec key hkey rest + | Some d -> d + end + | EFalse -> find_rec key hkey rest + | EDead -> + (** TODO? remove this dead key *) + find_rec key hkey rest + end + | Cons(_, _, rest) -> + find_rec key hkey rest + + let find h key = + let hkey = H.hash h.seed key in + (** TODO inline 3 iteration *) + find_rec key hkey (h.data.(key_index h hkey)) + + let find_all h key = + let hkey = H.hash h.seed key in + let rec find_in_bucket = function + | Empty -> [] + | Cons(hk, c, rest) when hkey = hk -> + begin match H.equal key c with + | ETrue -> begin match H.get_data c with + | None -> + (** TODO? remove this dead key *) + find_in_bucket rest + | Some d -> d::find_in_bucket rest + end + | EFalse -> find_in_bucket rest + | EDead -> + (** TODO? remove this dead key *) + find_in_bucket rest + end + | Cons(_, _, rest) -> + find_in_bucket rest in + find_in_bucket h.data.(key_index h hkey) + + + let replace h key info = + let hkey = H.hash h.seed key in + let rec replace_bucket = function + | Empty -> raise Not_found + | Cons(hk, c, next) when hkey = hk -> + begin match H.equal key c with + | ETrue -> begin match H.get_data c with + | None -> + (** Can this case really happend? *) + (** TODO? remove this dead key *) + replace_bucket next + | Some d -> H.set_data c info + end + | EFalse -> replace_bucket next + | EDead -> + (** TODO? remove this dead key *) + replace_bucket next + end + | Cons(_,_,next) -> replace_bucket next + in + let i = key_index h hkey in + let l = h.data.(i) in + try + replace_bucket l + with Not_found -> + let container = H.create key info in + h.data.(i) <- Cons(hkey, container, l); + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then resize key_index h + + let mem h key = + let hkey = H.hash h.seed key in + let rec mem_in_bucket = function + | Empty -> + false + | Cons(hk, c, rest) when hk = hkey -> + begin match H.equal key c with + | ETrue -> true + | EFalse -> mem_in_bucket rest + | EDead -> + (** TODO? remove this dead key *) + mem_in_bucket rest + end + | Cons(hk, c, rest) -> mem_in_bucket rest in + mem_in_bucket h.data.(key_index h hkey) + + let iter f h = + let rec do_bucket = function + | Empty -> + () + | Cons(_, c, rest) -> + begin match H.get_key c, H.get_data c with + | None, _ | _, None -> (** TODO? remove this dead key? *) () + | Some k, Some d -> f k d + end; do_bucket rest in + let d = h.data in + for i = 0 to Array.length d - 1 do + do_bucket d.(i) + done + + let fold f h init = + let rec do_bucket b accu = + match b with + Empty -> + accu + | Cons(_, c, rest) -> + let accu = begin match H.get_key c, H.get_data c with + | None, _ | _, None -> (** TODO? remove this dead key? *) accu + | Some k, Some d -> f k d accu + end in + do_bucket rest accu in + let d = h.data in + let accu = ref init in + for i = 0 to Array.length d - 1 do + accu := do_bucket d.(i) !accu + done; + !accu + + let filter_map_inplace f h = + let rec do_bucket = function + | Empty -> + Empty + | Cons(hk, c, rest) -> + match H.get_key c, H.get_data c with + | None, _ | _, None -> + do_bucket rest + | Some k, Some d -> + match f k d with + | None -> + do_bucket rest + | Some new_d -> + H.set_key_data c k new_d; + Cons(hk, c, do_bucket rest) + in + let d = h.data in + for i = 0 to Array.length d - 1 do + d.(i) <- do_bucket d.(i) + done + + let length h = h.size + + let rec bucket_length accu = function + | Empty -> accu + | Cons(_, _, rest) -> bucket_length (accu + 1) rest + + let stats h = + let mbl = + Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in + let histo = Array.make (mbl + 1) 0 in + Array.iter + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + h.data; + { Hashtbl.num_bindings = h.size; + num_buckets = Array.length h.data; + max_bucket_length = mbl; + bucket_histogram = histo } + + let rec bucket_length_alive accu = function + | Empty -> accu + | Cons(_, c, rest) when H.check_key c -> + bucket_length_alive (accu + 1) rest + | Cons(_, _, rest) -> bucket_length_alive accu rest + + let stats_alive h = + let size = ref 0 in + let mbl = + Array.fold_left (fun m b -> max m (bucket_length_alive 0 b)) 0 h.data in + let histo = Array.make (mbl + 1) 0 in + Array.iter + (fun b -> + let l = bucket_length_alive 0 b in + size := !size + l; + histo.(l) <- histo.(l) + 1) + h.data; + { Hashtbl.num_bindings = !size; + num_buckets = Array.length h.data; + max_bucket_length = mbl; + bucket_histogram = histo } + + + end +end + +module ObjEph = Obj.Ephemeron + +let _obj_opt : Obj.t option -> 'a option = fun x -> + match x with + | None -> x + | Some v -> Some (Obj.obj v) + +(** The previous function is typed so this one is also correct *) +let obj_opt : Obj.t option -> 'a option = fun x -> Obj.magic x + + +module K1 = struct + type ('k,'d) t = ObjEph.eph + + let create () : ('k,'d) t = ObjEph.create 1 + + let get_key (t:('k,'d) t) : 'k option = obj_opt (ObjEph.get_key t 0) + let get_key_copy (t:('k,'d) t) : 'k option = obj_opt (ObjEph.get_key_copy t 0) + let set_key (t:('k,'d) t) (k:'k) : unit = ObjEph.set_key t 0 (Obj.repr k) + let unset_key (t:('k,'d) t) : unit = ObjEph.unset_key t 0 + let check_key (t:('k,'d) t) : bool = ObjEph.check_key t 0 + + let blit_key (t1:('k,'d) t) (t2:('k,'d) t): unit = + ObjEph.blit_key t1 0 t2 0 1 + + let get_data (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data t) + let get_data_copy (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data_copy t) + let set_data (t:('k,'d) t) (d:'d) : unit = ObjEph.set_data t (Obj.repr d) + let unset_data (t:('k,'d) t) : unit = ObjEph.unset_data t + let check_data (t:('k,'d) t) : bool = ObjEph.check_data t + let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2 + + module MakeSeeded (H:Hashtbl.SeededHashedType) = + GenHashTable.MakeSeeded(struct + type 'a container = (H.t,'a) t + type t = H.t + let create k d = + let c = create () in + set_data c d; + set_key c k; + c + let hash = H.hash + let equal k c = + (** {!get_key_copy} is not used because the equality of the user can be + the physical equality *) + match get_key c with + | None -> GenHashTable.EDead + | Some k' -> + if H.equal k k' then GenHashTable.ETrue else GenHashTable.EFalse + let get_data = get_data + let get_key = get_key + let set_data = set_data + let check_key = check_key + end) + + module Make(H: Hashtbl.HashedType): (S with type key = H.t) = + struct + include MakeSeeded(struct + type t = H.t + let equal = H.equal + let hash (seed: int) x = H.hash x + end) + let create sz = create ~random:false sz + end + +end + +module K2 = struct + type ('k1, 'k2, 'd) t = ObjEph.eph + + let create () : ('k1,'k2,'d) t = ObjEph.create 1 + + let get_key1 (t:('k1,'k2,'d) t) : 'k1 option = obj_opt (ObjEph.get_key t 0) + let get_key1_copy (t:('k1,'k2,'d) t) : 'k1 option = + obj_opt (ObjEph.get_key_copy t 0) + let set_key1 (t:('k1,'k2,'d) t) (k:'k1) : unit = + ObjEph.set_key t 0 (Obj.repr k) + let unset_key1 (t:('k1,'k2,'d) t) : unit = ObjEph.unset_key t 0 + let check_key1 (t:('k1,'k2,'d) t) : bool = ObjEph.check_key t 0 + + let get_key2 (t:('k1,'k2,'d) t) : 'k2 option = obj_opt (ObjEph.get_key t 1) + let get_key2_copy (t:('k1,'k2,'d) t) : 'k2 option = + obj_opt (ObjEph.get_key_copy t 1) + let set_key2 (t:('k1,'k2,'d) t) (k:'k2) : unit = + ObjEph.set_key t 1 (Obj.repr k) + let unset_key2 (t:('k1,'k2,'d) t) : unit = ObjEph.unset_key t 1 + let check_key2 (t:('k1,'k2,'d) t) : bool = ObjEph.check_key t 1 + + + let blit_key1 (t1:('k1,_,_) t) (t2:('k1,_,_) t) : unit = + ObjEph.blit_key t1 0 t2 0 1 + let blit_key2 (t1:(_,'k2,_) t) (t2:(_,'k2,_) t) : unit = + ObjEph.blit_key t1 1 t2 1 1 + let blit_key12 (t1:('k1,'k2,_) t) (t2:('k1,'k2,_) t) : unit = + ObjEph.blit_key t1 0 t2 0 2 + + let get_data (t:('k1,'k2,'d) t) : 'd option = obj_opt (ObjEph.get_data t) + let get_data_copy (t:('k1,'k2,'d) t) : 'd option = + obj_opt (ObjEph.get_data_copy t) + let set_data (t:('k1,'k2,'d) t) (d:'d) : unit = + ObjEph.set_data t (Obj.repr d) + let unset_data (t:('k1,'k2,'d) t) : unit = ObjEph.unset_data t + let check_data (t:('k1,'k2,'d) t) : bool = ObjEph.check_data t + let blit_data (t1:(_,_,'d) t) (t2:(_,_,'d) t) : unit = ObjEph.blit_data t1 t2 + + module MakeSeeded + (H1:Hashtbl.SeededHashedType) + (H2:Hashtbl.SeededHashedType) = + GenHashTable.MakeSeeded(struct + type 'a container = (H1.t,H2.t,'a) t + type t = H1.t * H2.t + let create (k1,k2) d = + let c = create () in + set_data c d; + set_key1 c k1; set_key2 c k2; + c + let hash seed (k1,k2) = + H1.hash seed k1 + H2.hash seed k2 * 65599 + let equal (k1,k2) c = + match get_key1 c, get_key2 c with + | None, _ | _ , None -> GenHashTable.EDead + | Some k1', Some k2' -> + if H1.equal k1 k1' && H2.equal k2 k2' + then GenHashTable.ETrue else GenHashTable.EFalse + let get_data = get_data + let get_key c = + match get_key1 c, get_key2 c with + | None, _ | _ , None -> None + | Some k1', Some k2' -> Some (k1', k2') + let set_data = set_data + let check_key c = check_key1 c && check_key2 c + end) + + module Make(H1: Hashtbl.HashedType)(H2: Hashtbl.HashedType): + (S with type key = H1.t * H2.t) = + struct + include MakeSeeded + (struct + type t = H1.t + let equal = H1.equal + let hash (seed: int) x = H1.hash x + end) + (struct + type t = H2.t + let equal = H2.equal + let hash (seed: int) x = H2.hash x + end) + let create sz = create ~random:false sz + end + +end + +module Kn = struct + type ('k,'d) t = ObjEph.eph + + let create n : ('k,'d) t = ObjEph.create n + let length (k:('k,'d) t) : int = ObjEph.length k + + let get_key (t:('k,'d) t) (n:int) : 'k option = obj_opt (ObjEph.get_key t n) + let get_key_copy (t:('k,'d) t) (n:int) : 'k option = + obj_opt (ObjEph.get_key_copy t n) + let set_key (t:('k,'d) t) (n:int) (k:'k) : unit = + ObjEph.set_key t n (Obj.repr k) + let unset_key (t:('k,'d) t) (n:int) : unit = ObjEph.unset_key t n + let check_key (t:('k,'d) t) (n:int) : bool = ObjEph.check_key t n + + let blit_key (t1:('k,'d) t) (o1:int) (t2:('k,'d) t) (o2:int) (l:int) : unit = + ObjEph.blit_key t1 o1 t2 o2 l + + let get_data (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data t) + let get_data_copy (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data_copy t) + let set_data (t:('k,'d) t) (d:'d) : unit = ObjEph.set_data t (Obj.repr d) + let unset_data (t:('k,'d) t) : unit = ObjEph.unset_data t + let check_data (t:('k,'d) t) : bool = ObjEph.check_data t + let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2 + + module MakeSeeded (H:Hashtbl.SeededHashedType) = + GenHashTable.MakeSeeded(struct + type 'a container = (H.t,'a) t + type t = H.t array + let create k d = + let c = create (Array.length k) in + set_data c d; + for i=0 to Array.length k -1 do + set_key c i k.(i); + done; + c + let hash seed k = + let h = ref 0 in + for i=0 to Array.length k -1 do + h := H.hash seed k.(i) * 65599 + !h; + done; + !h + let equal k c = + let len = Array.length k in + let len' = length c in + if len != len' then GenHashTable.EFalse + else + let rec equal_array k c i = + if i < 0 then GenHashTable.ETrue + else + match get_key c i with + | None -> GenHashTable.EDead + | Some ki -> + if H.equal k.(i) ki + then equal_array k c (i-1) + else GenHashTable.EFalse + in + equal_array k c (len-1) + let get_data = get_data + let get_key c = + let len = length c in + if len = 0 then Some [||] + else + match get_key c 0 with + | None -> None + | Some k0 -> + let rec fill a i = + if i < 1 then Some a + else + match get_key c i with + | None -> None + | Some ki -> + a.(i) <- ki; + fill a (i-1) + in + let a = Array.make len k0 in + fill a (len-1) + let set_data = set_data + let check_key c = + let rec check c i = + i < 0 || (check_key c i && check c (i-1)) in + check c (length c - 1) + end) + + module Make(H: Hashtbl.HashedType): (S with type key = H.t array) = + struct + include MakeSeeded(struct + type t = H.t + let equal = H.equal + let hash (seed: int) x = H.hash x + end) + let create sz = create ~random:false sz + end +end diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli new file mode 100644 index 000000000..01bf89350 --- /dev/null +++ b/stdlib/ephemeron.mli @@ -0,0 +1,306 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) + +(** Ephemerons and weak hash table *) + +(** Ephemerons and weak hash table + + Ephemerons are defined in a language agnostic way in this paper: + B. Hayes, Ephemerons: a New Finalization Mechanism, OOPSLA'9 + + Ephemerons hold some keys and one data. They are all boxed ocaml values and + suffer of the same limitation than weak pointers. + + The keys of an ephemerons have the same behavior than weak + pointers according to the garbage collector. + + The keys and data of an ephemeron are said to be full if it points to a + value, empty if the value have never been set or was erased by the GC. + + The data is considered by the garbage collector alive if all the + full keys are alive and if the ephemeron is alive. When one of the + keys is not considered alive anymore by the GC, the data is + emptied from the ephemeron even if the data is alive for another + reason. + + The ephemerons complicate the notion of liveness of values, because + it is not anymore an equivalence with the reachability from root + value by usual pointers (not weak and not ephemerons). The notion + of liveness is constructed by the least fixpoint of: + A value is alive if: + - it is a root value + - it is reachable from alive value by usual pointers + - it is the data of an ephemeron with all its full keys alive + + Notes: + - All the types defined in this module cannot be marshaled + using {!Pervasives.output_value} nor the functions of the + {!Marshal} module. + +*) + +module type S = sig + include Hashtbl.S + val stats_alive: 'a t -> Hashtbl.statistics + (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *) +end +(** The output signature of the functor {!K1.Make} and {!K2.Make}. + These hash tables are weak in the keys. If all the keys of a binding are + alive the binding is kept, but if one of the keys of the binding + is dead then the binding is removed. +*) + +module type SeededS = sig + include Hashtbl.SeededS + val stats_alive: 'a t -> Hashtbl.statistics + (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *) +end +(** The output signature of the functor {!K1.MakeSeeded} and {!K2.MakeSeeded}. +*) + +module K1 : sig + type ('k,'d) t (** an ephemeron with one key *) + + val create: unit -> ('k,'d) t + (** [Ephemeron.K1.create ()] creates an ephemeron with one key. The + data and key are empty *) + + val get_key: ('k,'d) t -> 'k option + (** [Ephemeron.K1.get_key eph] returns [None] if the key of [eph] is + empty, [Some x] (where [x] is the key) if it is full. *) + + val get_key_copy: ('k,'d) t -> 'k option + (** [Ephemeron.K1.get_key_copy eph] returns [None] if the key of [eph] is + empty, [Some x] (where [x] is a (shallow) copy of the key) if + it is full. This function has the same GC friendliness as {!Weak.get_copy} + *) + + val set_key: ('k,'d) t -> 'k -> unit + (** [Ephemeron.K1.set_key eph el] sets the key of [eph] to be a + (full) key to [el] + *) + + val unset_key: ('k,'d) t -> unit + (** [Ephemeron.K1.unset_key eph el] sets the key of [eph] to be an + empty key. Since there is only one key, the ephemeron start + behaving like a references on the data. *) + + val check_key: ('k,'d) t -> bool + (** [Ephemeron.K1.check_key eph] returns [true] if the key of the [eph] + is full, [false] if it is empty. Note that even if + [Ephemeron.K1.check_key eph] returns [true], a subsequent + {!Ephemeron.K1.get_key}[eph] can return [None]. + *) + + + val blit_key : ('k,_) t -> ('k,_) t -> unit + (** [Ephemeron.K1.blit_key eph1 eph2] sets the key of [eph2] with + the key of [eph1]. Contrary to using [Ephemeron.K1.get_key] + followed by [Ephemeron.K1.set_key] or [Ephemeon.K1.unset_key] + this function does not prevent the incremental GC from erasing + the value in its current cycle. *) + + val get_data: ('k,'d) t -> 'd option + (** [Ephemeron.K1.get_data eph] returns [None] if the data of [eph] is + empty, [Some x] (where [x] is the data) if it is full. *) + + val get_data_copy: ('k,'d) t -> 'd option + (** [Ephemeron.K1.get_data_copy eph] returns [None] if the data of [eph] is + empty, [Some x] (where [x] is a (shallow) copy of the data) if + it is full. This function has the same GC friendliness as {!Weak.get_copy} + *) + + val set_data: ('k,'d) t -> 'd -> unit + (** [Ephemeron.K1.set_data eph el] sets the data of [eph] to be a + (full) data to [el] + *) + + val unset_data: ('k,'d) t -> unit + (** [Ephemeron.K1.unset_key eph el] sets the key of [eph] to be an + empty key. The ephemeron start behaving like a weak pointer. + *) + + val check_data: ('k,'d) t -> bool + (** [Ephemeron.K1.check_data eph] returns [true] if the data of the [eph] + is full, [false] if it is empty. Note that even if + [Ephemeron.K1.check_data eph] returns [true], a subsequent + {!Ephemeron.K1.get_data}[eph] can return [None]. + *) + + val blit_data : (_,'d) t -> (_,'d) t -> unit + (** [Ephemeron.K1.blit_data eph1 eph2] sets the data of [eph2] with + the data of [eph1]. Contrary to using [Ephemeron.K1.get_data] + followed by [Ephemeron.K1.set_data] or [Ephemeon.K1.unset_data] + this function does not prevent the incremental GC from erasing + the value in its current cycle. *) + + module Make (H:Hashtbl.HashedType) : S with type key = H.t + (** Functor building an implementation of a weak hash table *) + + module MakeSeeded (H:Hashtbl.SeededHashedType) : SeededS with type key = H.t + (** Functor building an implementation of a weak hash table. + The seed is similar to the one of {!Hashtbl.MakeSeeded}. *) + +end + +module K2 : sig + type ('k1,'k2,'d) t (** an ephemeron with two keys *) + + val create: unit -> ('k1,'k2,'d) t + (** Same as {!Ephemeron.K1.create} *) + + val get_key1: ('k1,'k2,'d) t -> 'k1 option + (** Same as {!Ephemeron.K1.get_key} *) + val get_key1_copy: ('k1,'k2,'d) t -> 'k1 option + (** Same as {!Ephemeron.K1.get_key_copy} *) + val set_key1: ('k1,'k2,'d) t -> 'k1 -> unit + (** Same as {!Ephemeron.K1.set_key} *) + val unset_key1: ('k1,'k2,'d) t -> unit + (** Same as {!Ephemeron.K1.unset_key} *) + val check_key1: ('k1,'k2,'d) t -> bool + (** Same as {!Ephemeron.K1.check_key} *) + + val get_key2: ('k1,'k2,'d) t -> 'k2 option + (** Same as {!Ephemeron.K1.get_key} *) + val get_key2_copy: ('k1,'k2,'d) t -> 'k2 option + (** Same as {!Ephemeron.K1.get_key_copy} *) + val set_key2: ('k1,'k2,'d) t -> 'k2 -> unit + (** Same as {!Ephemeron.K1.get_key} *) + val unset_key2: ('k1,'k2,'d) t -> unit + (** Same as {!Ephemeron.K1.unset_key} *) + val check_key2: ('k1,'k2,'d) t -> bool + (** Same as {!Ephemeron.K1.check_key} *) + + val blit_key1 : ('k1,_,_) t -> ('k1,_,_) t -> unit + (** Same as {!Ephemeron.K1.blit_key} *) + val blit_key2 : (_,'k2,_) t -> (_,'k2,_) t -> unit + (** Same as {!Ephemeron.K1.blit_key} *) + val blit_key12 : ('k1,'k2,_) t -> ('k1,'k2,_) t -> unit + (** Same as {!Ephemeron.K1.blit_key} *) + + val get_data: ('k1,'k2,'d) t -> 'd option + (** Same as {!Ephemeron.K1.get_data} *) + val get_data_copy: ('k1,'k2,'d) t -> 'd option + (** Same as {!Ephemeron.K1.get_data_copy} *) + val set_data: ('k1,'k2,'d) t -> 'd -> unit + (** Same as {!Ephemeron.K1.set_data} *) + val unset_data: ('k1,'k2,'d) t -> unit + (** Same as {!Ephemeron.K1.unset_data} *) + val check_data: ('k1,'k2,'d) t -> bool + (** Same as {!Ephemeron.K1.check_data} *) + val blit_data: ('k1,'k2,'d) t -> ('k1,'k2,'d) t -> unit + (** Same as {!Ephemeron.K1.blit_data} *) + + module Make + (H1:Hashtbl.HashedType) + (H2:Hashtbl.HashedType) : + S with type key = H1.t * H2.t + (** Functor building an implementation of a weak hash table *) + + module MakeSeeded + (H1:Hashtbl.SeededHashedType) + (H2:Hashtbl.SeededHashedType) : + SeededS with type key = H1.t * H2.t + (** Functor building an implementation of a weak hash table. + The seed is similar to the one of {!Hashtbl.MakeSeeded}. *) + +end + +module Kn : sig + type ('k,'d) t (** an ephemeron with an arbitrary number of keys + of the same types *) + + val create: int -> ('k,'d) t + (** Same as {!Ephemeron.K1.create} *) + + val get_key: ('k,'d) t -> int -> 'k option + (** Same as {!Ephemeron.K1.get_key} *) + val get_key_copy: ('k,'d) t -> int -> 'k option + (** Same as {!Ephemeron.K1.get_key_copy} *) + val set_key: ('k,'d) t -> int -> 'k -> unit + (** Same as {!Ephemeron.K1.set_key} *) + val unset_key: ('k,'d) t -> int -> unit + (** Same as {!Ephemeron.K1.unset_key} *) + val check_key: ('k,'d) t -> int -> bool + (** Same as {!Ephemeron.K1.check_key} *) + + val blit_key : ('k,_) t -> int -> ('k,_) t -> int -> int -> unit + (** Same as {!Ephemeron.K1.blit_key} *) + + val get_data: ('k,'d) t -> 'd option + (** Same as {!Ephemeron.K1.get_data} *) + val get_data_copy: ('k,'d) t -> 'd option + (** Same as {!Ephemeron.K1.get_data_copy} *) + val set_data: ('k,'d) t -> 'd -> unit + (** Same as {!Ephemeron.K1.set_data} *) + val unset_data: ('k,'d) t -> unit + (** Same as {!Ephemeron.K1.unset_data} *) + val check_data: ('k,'d) t -> bool + (** Same as {!Ephemeron.K1.check_data} *) + val blit_data: ('k,'d) t -> ('k,'d) t -> unit + (** Same as {!Ephemeron.K1.blit_data} *) + + module Make + (H:Hashtbl.HashedType) : + S with type key = H.t array + (** Functor building an implementation of a weak hash table *) + + module MakeSeeded + (H:Hashtbl.SeededHashedType) : + SeededS with type key = H.t array + (** Functor building an implementation of a weak hash table. + The seed is similar to the one of {!Hashtbl.MakeSeeded}. *) + +end + +module GenHashTable: sig + (** Define hash table on generic containers. *) + + (** It can be used in conjunction of {!Obj.Ephemeron} + for building weak hash table for specific type of keys *) + + type equal = + | ETrue | EFalse + | EDead (** the garbage collector reclaimed the data *) + + module MakeSeeded(H: + sig + type t + (** keys *) + type 'a container + (** contains keys and the associated data *) + + val hash: int -> t -> int + (** same as {!Hashtbl.SeededHashedType} *) + val equal: t -> 'a container -> equal + (** equality predicate used to compare a key with the one in a + container. Can return [EDead] if the keys in the container are + dead *) + + val create: t -> 'a -> 'a container + (** [create key data] creates a container from + some initials keys and one data *) + val get_key: 'a container -> t option + (** [get_key cont] returns the keys if they are all alive *) + val get_data: 'a container -> 'a option + (** [get_data cont] return the data if it is alive *) + val set_data: 'a container -> 'a -> unit + (** [set_data cont] modify the data *) + val check_key: 'a container -> bool + (** [check_key cont] checks if all the keys contained in the data + are alive *) + end) : SeededS with type key = H.t + (** Functor building an implementation of an hash table that use the container + for keeping the information given *) + +end diff --git a/stdlib/obj.ml b/stdlib/obj.ml index af37d4289..8ca39a72b 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -80,3 +80,28 @@ let extension_name (slot : extension_constructor) = let extension_id (slot : extension_constructor) = (obj (field (repr slot) 1) : int) + +module Ephemeron = struct + type eph (** ephemeron *) + + external create: int -> eph = "caml_ephe_create" + + let length x = size(repr x) - 2 + + external get_key: eph -> int -> t option = "caml_ephe_get_key" + external get_key_copy: eph -> int -> t option = "caml_ephe_get_key_copy" + external set_key: eph -> int -> t -> unit = "caml_ephe_set_key" + external unset_key: eph -> int -> unit = "caml_ephe_unset_key" + external check_key: eph -> int -> bool = "caml_ephe_check_key" + external blit_key : eph -> int -> eph -> int -> int -> unit + = "caml_ephe_blit_key" + + external get_data: eph -> t option = "caml_ephe_get_data" + external get_data_copy: eph -> t option = "caml_ephe_get_data_copy" + external set_data: eph -> t -> unit = "caml_ephe_set_data" + external unset_data: eph -> unit = "caml_ephe_unset_data" + external check_data: eph -> bool = "caml_ephe_check_data" + external blit_data : eph -> eph -> unit = "caml_ephe_blit_data" + + +end diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 51dd65388..1fcd15599 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -85,3 +85,42 @@ val marshal : t -> bytes [@@ocaml.deprecated "Use Marshal.to_bytes instead."] val unmarshal : bytes -> int -> t * int [@@ocaml.deprecated "Use Marshal.from_bytes and Marshal.total_size instead."] + +module Ephemeron: sig + (** Ephemeron with arbitrary arity and untyped *) + + type eph + (** an ephemeron cf {!Ephemeron} *) + + val create: int -> eph + (** [create n] returns an ephemeron with [n] keys. + All the keys and the data are initially empty *) + val length: eph -> int + (** return the number of keys *) + + val get_key: eph -> int -> t option + (** Same as {!Ephemeron.K1.get_key} *) + val get_key_copy: eph -> int -> t option + (** Same as {!Ephemeron.K1.get_key_copy} *) + val set_key: eph -> int -> t -> unit + (** Same as {!Ephemeron.K1.set_key} *) + val unset_key: eph -> int -> unit + (** Same as {!Ephemeron.K1.unset_key} *) + val check_key: eph -> int -> bool + (** Same as {!Ephemeron.K1.check_key} *) + val blit_key : eph -> int -> eph -> int -> int -> unit + (** Same as {!Ephemeron.K1.blit_key} *) + + val get_data: eph -> t option + (** Same as {!Ephemeron.K1.get_data} *) + val get_data_copy: eph -> t option + (** Same as {!Ephemeron.K1.get_data_copy} *) + val set_data: eph -> t -> unit + (** Same as {!Ephemeron.K1.set_data} *) + val unset_data: eph -> unit + (** Same as {!Ephemeron.K1.unset_data} *) + val check_data: eph -> bool + (** Same as {!Ephemeron.K1.check_data} *) + val blit_data : eph -> eph -> unit + (** Same as {!Ephemeron.K1.blit_data} *) +end diff --git a/stdlib/stdlib.mllib b/stdlib/stdlib.mllib index b41bc2d93..bdbd831d8 100644 --- a/stdlib/stdlib.mllib +++ b/stdlib/stdlib.mllib @@ -39,6 +39,7 @@ Oo CamlinternalMod Genlex Weak +Ephemeron Filename Complex ArrayLabels diff --git a/testsuite/tests/misc/ephetest.ml b/testsuite/tests/misc/ephetest.ml new file mode 100644 index 000000000..3061d83f0 --- /dev/null +++ b/testsuite/tests/misc/ephetest.ml @@ -0,0 +1,172 @@ +(*************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Damien Doligez, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(*************************************************************************) + +let debug = false + +open Printf +open Ephemeron + +let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL") +let is_false test s b = is_true test s (not b) + +let is_data_value test eph (v:int) = + match K1.get_data_copy eph with + | Some x -> + if !x = v + then printf "%s data set: OK\n" test + else printf "%s data set: FAIL(bad value %i)\n" test (!x) + | None -> printf "%s data set: FAIL\n" test + +let is_key_value test eph (v:int) = + match K1.get_key_copy eph with + | Some x -> + if !x = v + then printf "%s key set: OK\n" test + else printf "%s key set: FAIL(bad value %i)\n" test (!x) + | None -> printf "%s key unset: FAIL\n" test + +let is_key_unset test eph = + is_false test "key unset" (K1.check_key eph) + +let is_data_unset test eph = + is_false test "data unset" (K1.check_data eph) + +let ra = ref (ref 1) +let rb = ref (ref (ref 2)) + +(** test: key alive data dangling *) +let () = + let test = "test1" in + Gc.minor (); + Gc.full_major (); + let eph : (int ref, int ref) K1.t = K1.create () in + K1.set_key eph (!ra); + K1.set_data eph (ref 42); + is_key_value test eph 1; + is_data_value test eph 42; + Gc.minor (); + is_key_value test eph 1; + is_data_value test eph 42; + Gc.full_major (); + is_key_value test eph 1; + is_data_value test eph 42; + ra := ref 12; + Gc.full_major (); + is_key_unset test eph; + is_data_unset test eph + +(** test: key dangling data dangling *) +let () = + let test = "test2" in + Gc.minor (); + Gc.full_major (); + let eph : (int ref, int ref) K1.t = K1.create () in + K1.set_key eph (ref 125); + K1.set_data eph (ref 42); + is_key_value test eph 125; + is_data_value test eph 42; + ra := ref 13; + Gc.minor (); + is_key_unset test eph; + is_data_unset test eph + + +(** test: key dangling data alive *) +let () = + let test = "test3" in + Gc.minor (); + Gc.full_major (); + let eph : (int ref, int ref) K1.t = K1.create () in + K1.set_key eph (ref 125); + K1.set_data eph (!ra); + is_key_value test eph 125; + is_data_value test eph 13; + ra := ref 14; + Gc.minor (); + is_key_unset test eph; + is_data_unset test eph + +(** test: key alive but one away, data dangling *) +let () = + let test = "test4" in + Gc.minor (); + Gc.full_major (); + let eph : (int ref, int ref) K1.t = K1.create () in + rb := ref (ref 3); + K1.set_key eph (!(!rb)); + K1.set_data eph (ref 43); + is_key_value test eph 3; + is_data_value test eph 43; + Gc.minor (); + Gc.minor (); + is_key_value test eph 3; + is_data_value test eph 43 + +(** test: key dangling but one away, data dangling *) +let () = + let test = "test5" in + Gc.minor (); + Gc.full_major (); + let eph : (int ref, int ref) K1.t = K1.create () in + rb := ref (ref 3); + K1.set_key eph (!(!rb)); + K1.set_data eph (ref 43); + is_key_value test eph 3; + is_data_value test eph 43; + !rb := ref 4; + Gc.minor (); + Gc.minor (); + is_key_unset test eph; + is_data_unset test eph + +(** test: key accessible from data but all dangling *) +let () = + let test = "test6" in + Gc.minor (); + Gc.full_major (); + let eph : (int ref, int ref ref) K1.t = K1.create () in + rb := ref (ref 3); + K1.set_key eph (!(!rb)); + K1.set_data eph (ref (!(!rb))); + Gc.minor (); + is_key_value test eph 3; + !rb := ref 4; + Gc.full_major (); + is_key_unset test eph; + is_data_unset test eph + +(** test: ephemeron accessible from data but they are dangling *) +type t = + | No + | Ephe of (int ref, t) K1.t + +let rc = ref No + +let () = + let test = "test7" in + Gc.minor (); + Gc.full_major (); + ra := ref 42; + let weak : t Weak.t = Weak.create 1 in + let eph : (int ref, t) K1.t ref = ref (K1.create ()) in + rc := Ephe !eph; + Weak.set weak 0 (Some !rc); + K1.set_key !eph !ra; + K1.set_data !eph !rc; + Gc.minor (); + is_true test "before" (Weak.check weak 0); + eph := K1.create (); + rc := No; + Gc.full_major (); + Gc.full_major (); + Gc.full_major (); + is_false test "after" (Weak.check weak 0) diff --git a/testsuite/tests/misc/ephetest.reference b/testsuite/tests/misc/ephetest.reference new file mode 100644 index 000000000..2699fdf7f --- /dev/null +++ b/testsuite/tests/misc/ephetest.reference @@ -0,0 +1,29 @@ +test1 key set: OK +test1 data set: OK +test1 key set: OK +test1 data set: OK +test1 key set: OK +test1 data set: OK +test1 key unset: OK +test1 data unset: OK +test2 key set: OK +test2 data set: OK +test2 key unset: OK +test2 data unset: OK +test3 key set: OK +test3 data set: OK +test3 key unset: OK +test3 data unset: OK +test4 key set: OK +test4 data set: OK +test4 key set: OK +test4 data set: OK +test5 key set: OK +test5 data set: OK +test5 key unset: OK +test5 data unset: OK +test6 key set: OK +test6 key unset: OK +test6 data unset: OK +test7 before: OK +test7 after: OK diff --git a/testsuite/tests/misc/ephetest2.ml b/testsuite/tests/misc/ephetest2.ml new file mode 100644 index 000000000..d1da44865 --- /dev/null +++ b/testsuite/tests/misc/ephetest2.ml @@ -0,0 +1,161 @@ +(*************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Damien Doligez, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(*************************************************************************) + +(*** + This test evaluate boolean formula composed by conjunction and + disjunction using ephemeron: + - true == alive, false == garbage collected + - and == an n-ephemeron, or == many 1-ephemeron + +*) + +let nb_test = 4 +let max_level = 10 + (** probability that a branch is not linked to a previous one *) +let proba_no_shared = 0.2 +let arity_max = 4 + +let proba_new = proba_no_shared ** (1./.(float_of_int max_level)) + +open Format +open Ephemeron + +let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL") +let is_false test s b = is_true test s (not b) + +type varephe = int ref +type ephe = (varephe,varephe) Kn.t + +type formula = + | Constant of bool + | And of var array + | Or of var array + +and var = { + form: formula; + value: bool; + ephe: varephe Weak.t; +} + +let print_short_bool fmt b = + if b + then pp_print_string fmt "t" + else pp_print_string fmt "f" + +let rec pp_form fmt = function + | Constant b -> + fprintf fmt "%b" b + | And a -> + fprintf fmt "And[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a + | Or a -> + fprintf fmt "Or[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a + +and pp_var fmt v = + fprintf fmt "%a%a:%a;@ " + print_short_bool v.value + print_short_bool (Weak.check v.ephe 0) + pp_form v.form + +type env = { + (** resizeable array for cheap *) + vars : (int,var) Hashtbl.t; + (** the ephemerons must be alive *) + ephes : ephe Stack.t; + (** keep alive the true constant *) + varephe_true : varephe Stack.t; +(** keep temporarily alive the false constant *) + varephe_false : varephe Stack.t; +} + +let new_env () = { + vars = Hashtbl.create 100; + ephes = Stack.create (); + varephe_true = Stack.create (); + varephe_false = Stack.create (); +} + +let evaluate = function + | Constant b -> b + | And a -> Array.fold_left (fun acc e -> acc && e.value) true a + | Or a -> Array.fold_left (fun acc e -> acc || e.value) false a + +let get_ephe v = + match Weak.get v.ephe 0 with + | None -> + invalid_arg "Error: weak dead but nothing have been released" + | Some r -> r + +(** create a variable and its definition in the boolean world and + ephemerons world *) +let rec create env rem_level (** remaining level *) = + let varephe = ref 1 in + let form = + if rem_level = 0 then (** Constant *) + if Random.bool () + then (Stack.push varephe env.varephe_true ; Constant true ) + else (Stack.push varephe env.varephe_false; Constant false) + else + let size = (Random.int (arity_max - 1)) + 2 in + let new_link _ = + if (Hashtbl.length env.vars) = 0 || Random.float 1. < proba_new + then create env (rem_level -1) + else Hashtbl.find env.vars (Random.int (Hashtbl.length env.vars)) + in + let args = Array.init size new_link in + if Random.bool () + then begin (** Or *) + Array.iter (fun v -> + let r = get_ephe v in + let e = Kn.create 1 in + Kn.set_key e 0 r; + Kn.set_data e varephe; + Stack.push e env.ephes + ) args; Or args + end + else begin (** And *) + let e = Kn.create (Array.length args) in + for i=0 to Array.length args - 1 do + Kn.set_key e i (get_ephe args.(i)); + done; + Kn.set_data e varephe; + Stack.push e env.ephes; + And args + end + in + let create_weak e = + let w = Weak.create 1 in + Weak.set w 0 (Some e); + w + in + let v = {form; value = evaluate form; + ephe = create_weak varephe; + } in + Hashtbl.add env.vars (Hashtbl.length env.vars) v; + v + + +let check_var v = v.value = Weak.check v.ephe 0 + +let run test init = + Random.init init; + let env = new_env () in + let _top = create env max_level in + (** release false ref *) + Stack.clear env.varephe_false; + Gc.full_major (); + let res = Hashtbl.fold (fun _ v acc -> acc && check_var v) env.vars true in + is_true test "check" res + +let () = + for i = 0 to nb_test do + run ("test"^(string_of_int i)) i; + done diff --git a/testsuite/tests/misc/ephetest2.reference b/testsuite/tests/misc/ephetest2.reference new file mode 100644 index 000000000..db17cd7aa --- /dev/null +++ b/testsuite/tests/misc/ephetest2.reference @@ -0,0 +1,5 @@ +test0 check: OK +test1 check: OK +test2 check: OK +test3 check: OK +test4 check: OK From ff8c0c83c2f10e6040c1d0181b68f5bbc533cb02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 6 Mar 2014 19:18:58 +0100 Subject: [PATCH 077/145] [GC] shortcut clean phase when possible --- byterun/major_gc.c | 39 ++++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/byterun/major_gc.c b/byterun/major_gc.c index ed2aed1c2..8d6166a24 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -174,6 +174,20 @@ static mlsize_t current_index = 0; #define INSTR(x) /**/ #endif +static void init_sweep_phase(void) +{ + /* Phase_clean is done. */ + /* Initialise the sweep phase. */ + caml_gc_sweep_hp = caml_heap_start; + caml_fl_init_merge (); + caml_gc_phase = Phase_sweep; + chunk = caml_heap_start; + caml_gc_sweep_hp = chunk; + limit = chunk + Chunk_size (chunk); + caml_fl_wsz_at_phase_change = caml_fl_cur_wsz; + if (caml_major_gc_hook) (*caml_major_gc_hook)(); +} + /* auxillary function of mark_slice */ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, int in_ephemeron, int *slice_pointers) @@ -408,11 +422,17 @@ static void mark_slice (intnat work) } break; case Subphase_mark_final: { - /* Initialise the clean phase. */ - caml_gc_phase = Phase_clean; - caml_gc_subphase = Subphase_clean_ephe; - ephe_prev = &caml_ephe_list_head; - work = 0; + if (caml_ephe_list_head != (value) NULL){ + /* Initialise the clean phase. */ + caml_gc_phase = Phase_clean; + caml_gc_subphase = Subphase_clean_ephe; + ephe_prev = &caml_ephe_list_head; + work = 0; + } else { + /* Initialise the sweep phase. */ + init_sweep_phase(); + work = 0; + } } break; default: Assert (0); @@ -461,15 +481,8 @@ static void clean_slice (intnat work) }else{ /* Phase_clean is done. */ /* Initialise the sweep phase. */ - caml_gc_sweep_hp = caml_heap_start; - caml_fl_init_merge (); - caml_gc_phase = Phase_sweep; - chunk = caml_heap_start; - caml_gc_sweep_hp = chunk; - limit = chunk + Chunk_size (chunk); + init_sweep_phase(); work = 0; - caml_fl_wsz_at_phase_change = caml_fl_cur_wsz; - if (caml_major_gc_hook) (*caml_major_gc_hook)(); } } break; From e33599880d087c5954e50346172a1842a566352d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 7 Mar 2014 09:10:12 +0100 Subject: [PATCH 078/145] [GC] make ephemerons more efficient During one mark phase instead of iterating on every ephemerons every time, we don't iterate on the one which data is alive (not white) or at none (weak pointer). That give us a complexity in O(n*(p+1)) with m the number of ephemerons, p is the maximum of the distance to an ephemeron from its nearest root p = max_{e \in ephemerons} min_{r \in roots} distance(r,e) One worst case is when ephemerons e_1, ..., e_n are linked e_1.data = e_2, ... e_{n-1}.data = e_n but they have been created in the reverse order and are iterated from e_n to e_1, O(n*n). In order to mitigate this the ephemerons are automatically sorted during mark in the order they are triggered. So during the next marking phase the ephemerons will be iterated from e_1 to e_n giving a complexity of O(n). --- byterun/caml/major_gc.h | 4 -- byterun/major_gc.c | 107 ++++++++++++++++++++++++---------------- 2 files changed, 65 insertions(+), 46 deletions(-) diff --git a/byterun/caml/major_gc.h b/byterun/caml/major_gc.h index ff83a90c5..20d69e079 100644 --- a/byterun/caml/major_gc.h +++ b/byterun/caml/major_gc.h @@ -51,10 +51,6 @@ extern uintnat caml_fl_wsz_at_phase_change; the marking phase */ #define Subphase_mark_final 12 /* after marking finalized value */ -/* Subphase of clean */ -#define Subphase_clean_ephe 20 /* clean ephemeron */ -#define Subphase_unlink_ephe 21 /* remove dead ephemeron */ - CAMLextern char *caml_heap_start; extern uintnat total_heap_size; extern char *caml_gc_sweep_hp; diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 8d6166a24..982dff58f 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -51,9 +51,6 @@ static value *gray_vals_cur, *gray_vals_end; static asize_t gray_vals_size; static int heap_is_pure; /* The heap is pure if the only gray objects below [markhp] are also in [gray_vals]. */ -static int ephe_list_pure; /* The list of ephemerons is pure if - since the start of its iteration - no value have been darken. */ uintnat caml_allocated_words; uintnat caml_dependent_size, caml_dependent_allocated; double caml_extra_heap_resources; @@ -65,7 +62,33 @@ static char *markhp, *chunk, *limit; int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final, clean_ephe,unlink_ephe} */ + +/** + Ephemerons: + During mark and clean phase the list caml_ephe_list_head of ephemerons + is iterated. The following pointers follows this invariant: + caml_ephe_list_head ->* ephe_list_head_todo ->* ephe_prev ->* null + | | | + (1) (2) (3) + + In mark phase: + - the ephemerons in (1) have a data alive or none + (nb: new ephe are added in this part by weak.c) + - the ephemerons in (2) have at least a white key if ephe_list_pure is + true otherwise they are in an unknown state and must be checked + again. + - the ephemerons in (3) are in an unknown state and must be checked + + In clean phase, ephe_list_head_todo is not used (1) = (2). + - the ephemerons in (1) are clean (white keys and datas replaced by none) + - the ephemerons in (3) should be cleaned or removed if white + + */ +static int ephe_list_pure; /* The list of ephemerons is pure if + since the start of its iteration + no value have been darken. */ static value *ephe_prev; +static value *ephe_list_head_todo; int caml_major_window = 1; double caml_major_ring[Max_major_window] = { 0. }; @@ -153,6 +176,7 @@ static void start_cycle (void) caml_gc_subphase = Subphase_mark_roots; markhp = NULL; ephe_list_pure = 1; + ephe_list_head_todo = &caml_ephe_list_head; ephe_prev = &caml_ephe_list_head; #ifdef DEBUG ++ major_gc_counter; @@ -253,13 +277,14 @@ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, return gray_vals_ptr; } -static value* mark_ephe_aux (value *gray_vals_ptr, value v, intnat *work, +static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, int *slice_pointers) { - value child; + value v, child; header_t hd; mlsize_t size, i; + v = *ephe_prev; hd = Hd_val(v); Assert(Tag_val (v) == Abstract_tag); child = Field(v,1); /* child = data */ @@ -293,19 +318,38 @@ static value* mark_ephe_aux (value *gray_vals_ptr, value v, intnat *work, alive_data = 0; } } + *work -= Whsize_wosize(i); if (alive_data){ gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,1,/*in_ephemeron=*/1, slice_pointers); + } else { /* not triggered move to the next one */ + ephe_prev = &Field(v,0); + return gray_vals_ptr; } - *work -= Whsize_wosize(size); } else { /* a simily weak pointer or an already alive data */ *work -= 1; } + /* all keys black or data none or black + move the ephemerons from (3) to the end of (1) */ + if ( ephe_list_head_todo == ephe_prev ) { + /* corner case and optim */ + ephe_list_head_todo = &Field(v,0); + ephe_prev = ephe_list_head_todo; + } else { + /* - remove v from the list (3) */ + *ephe_prev = Field(v,0); + /* - insert it at the end of (1) */ + Field(v,0) = *ephe_list_head_todo; + *ephe_list_head_todo = v; + ephe_list_head_todo = &Field(v,0); + } return gray_vals_ptr; } + + static void mark_slice (intnat work) { value *gray_vals_ptr; /* Local copy of [gray_vals_cur] */ @@ -388,13 +432,11 @@ static void mark_slice (intnat work) limit = chunk + Chunk_size (chunk); } else if (*ephe_prev != (value) NULL) { /* Continue to scan the list of ephe */ - v = *ephe_prev; - gray_vals_ptr=mark_ephe_aux(gray_vals_ptr,v,&work,&slice_pointers); - ephe_prev = &Field(v,0); + gray_vals_ptr = mark_ephe_aux(gray_vals_ptr,&work,&slice_pointers); } else if (!ephe_list_pure){ /* We must scan again the list because some value have been darken */ ephe_list_pure = 1; - ephe_prev = &caml_ephe_list_head; + ephe_prev = ephe_list_head_todo; }else{ switch (caml_gc_subphase){ case Subphase_mark_roots: { @@ -417,7 +459,7 @@ static void mark_slice (intnat work) CAMLassert (start == 0); } /* Complete the marking */ - ephe_prev = &caml_ephe_list_head; + ephe_prev = ephe_list_head_todo; caml_gc_subphase = Subphase_mark_final; } break; @@ -425,7 +467,6 @@ static void mark_slice (intnat work) if (caml_ephe_list_head != (value) NULL){ /* Initialise the clean phase. */ caml_gc_phase = Phase_clean; - caml_gc_subphase = Subphase_clean_ephe; ephe_prev = &caml_ephe_list_head; work = 0; } else { @@ -453,40 +494,22 @@ static void clean_slice (intnat work) caml_gc_message (0x40, "Cleaning %ld words\n", work); caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); while (work > 0){ - switch (caml_gc_subphase){ - case Subphase_clean_ephe: { - v = *ephe_prev; - if (v != (value) NULL){ + v = *ephe_prev; + if (v != (value) NULL){ + if (Is_white_val (v)){ + /* The whole array is dead, remove it from the list. */ + *ephe_prev = Field (v, 0); + work -= 1; + }else{ caml_ephe_clean(v); ephe_prev = &Field (v, 0); work -= Whsize_val (v); - }else{ - /* Subphase_clean_ephe is done. - Start removing dead ephe arrays. */ - caml_gc_subphase = Subphase_unlink_ephe; - ephe_prev = &caml_ephe_list_head; } - } - break; - case Subphase_unlink_ephe: { - v = *ephe_prev; - if (v != (value) NULL){ - if (Color_val (v) == Caml_white){ - /* The whole array is dead, remove it from the list. */ - *ephe_prev = Field (v, 0); - }else{ - ephe_prev = &Field (v, 0); - } - work -= 1; - }else{ - /* Phase_clean is done. */ - /* Initialise the sweep phase. */ - init_sweep_phase(); - work = 0; - } - } - break; - default: Assert (0); + }else{ /* End of list reached */ + /* Phase_clean is done. */ + /* Initialise the sweep phase. */ + init_sweep_phase(); + work = 0; } } } From 7a72ad0ce415cb9a26806e4e88c4d80009b21c4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 26 Mar 2014 17:09:01 +0100 Subject: [PATCH 079/145] [Stdlib] Rephrase hash table by hash set in Weak --- stdlib/weak.mli | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/stdlib/weak.mli b/stdlib/weak.mli index a27dea5ce..d66ac9cdf 100644 --- a/stdlib/weak.mli +++ b/stdlib/weak.mli @@ -11,7 +11,7 @@ (* *) (***********************************************************************) -(** Arrays of weak pointers and hash tables of weak pointers. *) +(** Arrays of weak pointers and hash sets of weak pointers. *) (** {6 Low-level functions} *) @@ -86,13 +86,13 @@ val blit : 'a t -> int -> 'a t -> int -> int -> unit do not designate a valid subarray of [ar2].*) -(** {6 Weak hash tables} *) +(** {6 Weak hash sets} *) -(** A weak hash table is a hashed set of values. Each value may +(** A weak hash set is a hashed set of values. Each value may magically disappear from the set when it is not used by the rest of the program any more. This is normally used to share data structures without inducing memory leaks. - Weak hash tables are defined on values from a {!Hashtbl.HashedType} + Weak hash sets are defined on values from a {!Hashtbl.HashedType} module; the [equal] relation and [hash] function are taken from that module. We will say that [v] is an instance of [x] if [equal x v] is [true]. @@ -106,11 +106,11 @@ module type S = sig (** The type of the elements stored in the table. *) type t (** The type of tables that contain elements of type [data]. - Note that weak hash tables cannot be marshaled using + Note that weak hash sets cannot be marshaled using {!Pervasives.output_value} or the functions of the {!Marshal} module. *) val create : int -> t - (** [create n] creates a new empty weak hash table, of initial + (** [create n] creates a new empty weak hash set, of initial size [n]. The table will grow as needed. *) val clear : t -> unit (** Remove all elements from the table. *) @@ -154,4 +154,4 @@ end;; (** The output signature of the functor {!Weak.Make}. *) module Make (H : Hashtbl.HashedType) : S with type data = H.t;; -(** Functor building an implementation of the weak hash table structure. *) +(** Functor building an implementation of the weak hash set structure. *) From 9f7b0872a681668a8b767a6effdf70a649f6940b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Sun, 29 Nov 2015 17:25:21 +0100 Subject: [PATCH 080/145] [GC] More comments for ephemerons and rename some variables --- byterun/caml/major_gc.h | 19 ++++++---- byterun/major_gc.c | 83 ++++++++++++++++++++++++----------------- 2 files changed, 60 insertions(+), 42 deletions(-) diff --git a/byterun/caml/major_gc.h b/byterun/caml/major_gc.h index 20d69e079..50ad36ccd 100644 --- a/byterun/caml/major_gc.h +++ b/byterun/caml/major_gc.h @@ -42,14 +42,19 @@ extern uintnat caml_fl_wsz_at_phase_change; #define Phase_sweep 2 #define Phase_idle 3 - /* Subphase of mark */ -#define Subphase_mark_roots 10 /* finish to mark global roots */ -#define Subphase_mark_main 11 /* before marking finalized value */ -/* Between this two subphases the set of marked blocks is an - over-approximation of the set of alive blocks at the beginning of - the marking phase */ -#define Subphase_mark_final 12 /* after marking finalized value */ +#define Subphase_mark_roots 10 +/* Subphase_mark_roots: At the end of this subphase all the global + roots are marked. */ +#define Subphase_mark_main 11 +/* Subphase_mark_main: At the end of this subphase all the value alive at + the start of this subphase and created during it are marked. */ +#define Subphase_mark_final 12 +/* Subphase_mark_final: At the start of this subphase register which + value with an ocaml finalizer are not marked, the associated + finalizer will be run later. So we mark now these value as alive, + since they must be available for their finalizer. + */ CAMLextern char *caml_heap_start; extern uintnat total_heap_size; diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 982dff58f..b3cb50d7b 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -65,30 +65,43 @@ int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final, /** Ephemerons: - During mark and clean phase the list caml_ephe_list_head of ephemerons - is iterated. The following pointers follows this invariant: - caml_ephe_list_head ->* ephe_list_head_todo ->* ephe_prev ->* null - | | | - (1) (2) (3) + During mark phase the list caml_ephe_list_head of ephemerons + is iterated by different pointers that follow the invariants: + caml_ephe_list_head ->* ephes_checked_if_pure ->* ephes_to_check ->* null + | | | + (1) (2) (3) + + At the start of mark phase, (1) and (2) are empty. In mark phase: - the ephemerons in (1) have a data alive or none - (nb: new ephe are added in this part by weak.c) - - the ephemerons in (2) have at least a white key if ephe_list_pure is - true otherwise they are in an unknown state and must be checked - again. + (nb: new ephemerons are added in this part by weak.c) + - the ephemerons in (2) have at least a white key or are white + if ephe_list_pure is true, otherwise they are in an unknown state and + must be checked again. - the ephemerons in (3) are in an unknown state and must be checked - In clean phase, ephe_list_head_todo is not used (1) = (2). - - the ephemerons in (1) are clean (white keys and datas replaced by none) - - the ephemerons in (3) should be cleaned or removed if white + At the end of mark phase, (3) is empty and ephe_list_pure is true. + The ephemeron in (1) and (2) will be cleaned (white keys and datas + replaced by none or the ephemeron is removed from the list if it is white) + in clean phase. + + In clean phase: + caml_ephe_list_head ->* ephes_to_check ->* null + | | + (1) (3) + + In clean phase, (2) is not used, ephes_to_check is initialized at + caml_ephe_list_head: + - the ephemerons in (1) are clean. + - the ephemerons in (3) should be cleaned or removed if white. */ -static int ephe_list_pure; /* The list of ephemerons is pure if - since the start of its iteration - no value have been darken. */ -static value *ephe_prev; -static value *ephe_list_head_todo; +static int ephe_list_pure; +/** The ephemerons is pure if since the start of its iteration + no value have been darken. */ +static value *ephes_checked_if_pure; +static value *ephes_to_check; int caml_major_window = 1; double caml_major_ring[Max_major_window] = { 0. }; @@ -176,8 +189,8 @@ static void start_cycle (void) caml_gc_subphase = Subphase_mark_roots; markhp = NULL; ephe_list_pure = 1; - ephe_list_head_todo = &caml_ephe_list_head; - ephe_prev = &caml_ephe_list_head; + ephes_checked_if_pure = &caml_ephe_list_head; + ephes_to_check = &caml_ephe_list_head; #ifdef DEBUG ++ major_gc_counter; caml_heap_check (); @@ -284,7 +297,7 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, header_t hd; mlsize_t size, i; - v = *ephe_prev; + v = *ephes_to_check; hd = Hd_val(v); Assert(Tag_val (v) == Abstract_tag); child = Field(v,1); /* child = data */ @@ -324,7 +337,7 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,1,/*in_ephemeron=*/1, slice_pointers); } else { /* not triggered move to the next one */ - ephe_prev = &Field(v,0); + ephes_to_check = &Field(v,0); return gray_vals_ptr; } } else { /* a simily weak pointer or an already alive data */ @@ -333,17 +346,17 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, /* all keys black or data none or black move the ephemerons from (3) to the end of (1) */ - if ( ephe_list_head_todo == ephe_prev ) { + if ( ephes_checked_if_pure == ephes_to_check ) { /* corner case and optim */ - ephe_list_head_todo = &Field(v,0); - ephe_prev = ephe_list_head_todo; + ephes_checked_if_pure = &Field(v,0); + ephes_to_check = ephes_checked_if_pure; } else { /* - remove v from the list (3) */ - *ephe_prev = Field(v,0); + *ephes_to_check = Field(v,0); /* - insert it at the end of (1) */ - Field(v,0) = *ephe_list_head_todo; - *ephe_list_head_todo = v; - ephe_list_head_todo = &Field(v,0); + Field(v,0) = *ephes_checked_if_pure; + *ephes_checked_if_pure = v; + ephes_checked_if_pure = &Field(v,0); } return gray_vals_ptr; } @@ -430,13 +443,13 @@ static void mark_slice (intnat work) chunk = caml_heap_start; markhp = chunk; limit = chunk + Chunk_size (chunk); - } else if (*ephe_prev != (value) NULL) { + } else if (*ephes_to_check != (value) NULL) { /* Continue to scan the list of ephe */ gray_vals_ptr = mark_ephe_aux(gray_vals_ptr,&work,&slice_pointers); } else if (!ephe_list_pure){ /* We must scan again the list because some value have been darken */ ephe_list_pure = 1; - ephe_prev = ephe_list_head_todo; + ephes_to_check = ephes_checked_if_pure; }else{ switch (caml_gc_subphase){ case Subphase_mark_roots: { @@ -459,7 +472,7 @@ static void mark_slice (intnat work) CAMLassert (start == 0); } /* Complete the marking */ - ephe_prev = ephe_list_head_todo; + ephes_to_check = ephes_checked_if_pure; caml_gc_subphase = Subphase_mark_final; } break; @@ -467,7 +480,7 @@ static void mark_slice (intnat work) if (caml_ephe_list_head != (value) NULL){ /* Initialise the clean phase. */ caml_gc_phase = Phase_clean; - ephe_prev = &caml_ephe_list_head; + ephes_to_check = &caml_ephe_list_head; work = 0; } else { /* Initialise the sweep phase. */ @@ -494,15 +507,15 @@ static void clean_slice (intnat work) caml_gc_message (0x40, "Cleaning %ld words\n", work); caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); while (work > 0){ - v = *ephe_prev; + v = *ephes_to_check; if (v != (value) NULL){ if (Is_white_val (v)){ /* The whole array is dead, remove it from the list. */ - *ephe_prev = Field (v, 0); + *ephes_to_check = Field (v, 0); work -= 1; }else{ caml_ephe_clean(v); - ephe_prev = &Field (v, 0); + ephes_to_check = &Field (v, 0); work -= Whsize_val (v); } }else{ /* End of list reached */ From deb94edc0d7dfd701fc630122901700fd4f144da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Sun, 29 Nov 2015 18:23:34 +0100 Subject: [PATCH 081/145] [Change] For Ephemerons --- Changes | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index 7a6e92a86..bb02b36e9 100644 --- a/Changes +++ b/Changes @@ -234,11 +234,14 @@ Standard library: * Sys.time (and [@@noalloc]) * Pervasives.ldexp (and [@@noalloc]) * Pervasives.compare for float, nativeint, int32, int64. - (Bobot François) + (François Bobot) - GPR#329: Add exists, for_all, mem and memq functions in Array (Bernhard Schommer) - GPR#337: Add [Hashtbl.filter_map_inplace] (Alain Frisch) - GPR#356: Add [Format.kasprintf] (Jérémie Dimino, Mark Shinwell) +- GPR#22: Add the Ephemeron module that implements ephemerons and weak + hash table (François Bobot, review by Damien Doligez, Daniel Bünzli, + Alain Frisch) Type system: - PR#5545: Type annotations on methods cannot control the choice of abbreviation @@ -448,6 +451,12 @@ Bug fixes: Mark Shinwell) - GPR#283: Fix memory leaks in intern.c when OOM is raised (Marc Lasson, review by Alain Frisch) +- GPR#22: Fix the cleaning of weak pointers. In very rare cases + accessing a value during the cleaning of the weak pointers could + result in the value being removed from one weak arrays and kept in + another one. That breaks the property that a value is removed from a + weak pointer only when it is dead and garbage collected. (François + Bobot, review by Damien Doligez) - GPR#313: Prevent quadratic cases in CSE (Pierre Chambart, review by Xavier Leroy) - PR#6795, PR#6996: Make ocamldep report errors passed in From 9e85e6cb4db03d358de7fa690b19067ebd6c1f1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Tue, 1 Dec 2015 13:44:48 +0100 Subject: [PATCH 082/145] [Stdlib] Rename Obj.Ephemeron.eph in .t An ugly obj_t is needed for the shadowing of Obj.t --- stdlib/ephemeron.ml | 6 +++--- stdlib/obj.ml | 30 ++++++++++++++++-------------- stdlib/obj.mli | 33 ++++++++++++++++++--------------- 3 files changed, 37 insertions(+), 32 deletions(-) diff --git a/stdlib/ephemeron.ml b/stdlib/ephemeron.ml index 40a32bcae..d4be722c2 100644 --- a/stdlib/ephemeron.ml +++ b/stdlib/ephemeron.ml @@ -338,7 +338,7 @@ let obj_opt : Obj.t option -> 'a option = fun x -> Obj.magic x module K1 = struct - type ('k,'d) t = ObjEph.eph + type ('k,'d) t = ObjEph.t let create () : ('k,'d) t = ObjEph.create 1 @@ -394,7 +394,7 @@ module K1 = struct end module K2 = struct - type ('k1, 'k2, 'd) t = ObjEph.eph + type ('k1, 'k2, 'd) t = ObjEph.t let create () : ('k1,'k2,'d) t = ObjEph.create 1 @@ -479,7 +479,7 @@ module K2 = struct end module Kn = struct - type ('k,'d) t = ObjEph.eph + type ('k,'d) t = ObjEph.t let create n : ('k,'d) t = ObjEph.create n let length (k:('k,'d) t) : int = ObjEph.length k diff --git a/stdlib/obj.ml b/stdlib/obj.ml index 8ca39a72b..4777f584e 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -82,26 +82,28 @@ let extension_id (slot : extension_constructor) = (obj (field (repr slot) 1) : int) module Ephemeron = struct - type eph (** ephemeron *) + type obj_t = t - external create: int -> eph = "caml_ephe_create" + type t (** ephemeron *) + + external create: int -> t = "caml_ephe_create" let length x = size(repr x) - 2 - external get_key: eph -> int -> t option = "caml_ephe_get_key" - external get_key_copy: eph -> int -> t option = "caml_ephe_get_key_copy" - external set_key: eph -> int -> t -> unit = "caml_ephe_set_key" - external unset_key: eph -> int -> unit = "caml_ephe_unset_key" - external check_key: eph -> int -> bool = "caml_ephe_check_key" - external blit_key : eph -> int -> eph -> int -> int -> unit + external get_key: t -> int -> obj_t option = "caml_ephe_get_key" + external get_key_copy: t -> int -> obj_t option = "caml_ephe_get_key_copy" + external set_key: t -> int -> obj_t -> unit = "caml_ephe_set_key" + external unset_key: t -> int -> unit = "caml_ephe_unset_key" + external check_key: t -> int -> bool = "caml_ephe_check_key" + external blit_key : t -> int -> t -> int -> int -> unit = "caml_ephe_blit_key" - external get_data: eph -> t option = "caml_ephe_get_data" - external get_data_copy: eph -> t option = "caml_ephe_get_data_copy" - external set_data: eph -> t -> unit = "caml_ephe_set_data" - external unset_data: eph -> unit = "caml_ephe_unset_data" - external check_data: eph -> bool = "caml_ephe_check_data" - external blit_data : eph -> eph -> unit = "caml_ephe_blit_data" + external get_data: t -> obj_t option = "caml_ephe_get_data" + external get_data_copy: t -> obj_t option = "caml_ephe_get_data_copy" + external set_data: t -> obj_t -> unit = "caml_ephe_set_data" + external unset_data: t -> unit = "caml_ephe_unset_data" + external check_data: t -> bool = "caml_ephe_check_data" + external blit_data : t -> t -> unit = "caml_ephe_blit_data" end diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 1fcd15599..23943f842 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -89,38 +89,41 @@ val unmarshal : bytes -> int -> t * int module Ephemeron: sig (** Ephemeron with arbitrary arity and untyped *) - type eph + type obj_t = t + (** alias for {!Obj.t} *) + + type t (** an ephemeron cf {!Ephemeron} *) - val create: int -> eph + val create: int -> t (** [create n] returns an ephemeron with [n] keys. All the keys and the data are initially empty *) - val length: eph -> int + val length: t -> int (** return the number of keys *) - val get_key: eph -> int -> t option + val get_key: t -> int -> obj_t option (** Same as {!Ephemeron.K1.get_key} *) - val get_key_copy: eph -> int -> t option + val get_key_copy: t -> int -> obj_t option (** Same as {!Ephemeron.K1.get_key_copy} *) - val set_key: eph -> int -> t -> unit + val set_key: t -> int -> obj_t -> unit (** Same as {!Ephemeron.K1.set_key} *) - val unset_key: eph -> int -> unit + val unset_key: t -> int -> unit (** Same as {!Ephemeron.K1.unset_key} *) - val check_key: eph -> int -> bool + val check_key: t -> int -> bool (** Same as {!Ephemeron.K1.check_key} *) - val blit_key : eph -> int -> eph -> int -> int -> unit + val blit_key : t -> int -> t -> int -> int -> unit (** Same as {!Ephemeron.K1.blit_key} *) - val get_data: eph -> t option + val get_data: t -> obj_t option (** Same as {!Ephemeron.K1.get_data} *) - val get_data_copy: eph -> t option + val get_data_copy: t -> obj_t option (** Same as {!Ephemeron.K1.get_data_copy} *) - val set_data: eph -> t -> unit + val set_data: t -> obj_t -> unit (** Same as {!Ephemeron.K1.set_data} *) - val unset_data: eph -> unit + val unset_data: t -> unit (** Same as {!Ephemeron.K1.unset_data} *) - val check_data: eph -> bool + val check_data: t -> bool (** Same as {!Ephemeron.K1.check_data} *) - val blit_data : eph -> eph -> unit + val blit_data : t -> t -> unit (** Same as {!Ephemeron.K1.blit_data} *) end From 4b62e39a696f3f45cd16d2fd6cfd48cd4fe1b54f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 17 Dec 2015 10:53:02 +0100 Subject: [PATCH 083/145] Fix bad cleaning of ephemerons size not exact and infinite resizing --- stdlib/ephemeron.ml | 95 ++++++++++++++++++++++++++++++-------------- stdlib/ephemeron.mli | 4 ++ 2 files changed, 69 insertions(+), 30 deletions(-) diff --git a/stdlib/ephemeron.ml b/stdlib/ephemeron.ml index d4be722c2..6446bf4de 100644 --- a/stdlib/ephemeron.ml +++ b/stdlib/ephemeron.ml @@ -13,12 +13,14 @@ module type SeededS = sig include Hashtbl.SeededS + val clean: 'a t -> unit val stats_alive: 'a t -> Hashtbl.statistics (** same as {!stats} but only count the alive bindings *) end module type S = sig include Hashtbl.S + val clean: 'a t -> unit val stats_alive: 'a t -> Hashtbl.statistics (** same as {!stats} but only count the alive bindings *) end @@ -91,19 +93,55 @@ module GenHashTable = struct let key_index h hkey = hkey land (Array.length h.data - 1) - let resize indexfun h = + let clean h = + let rec do_bucket = function + | Empty -> + Empty + | Cons(_, c, rest) when not (H.check_key c) -> + h.size <- h.size - 1; + do_bucket rest + | Cons(hkey, c, rest) -> + Cons(hkey, c, do_bucket rest) + in + let d = h.data in + for i = 0 to Array.length d - 1 do + d.(i) <- do_bucket d.(i) + done + + (** resize is the only function to do the actual cleaning of dead keys + (remove does it just because it could). + + The goal is to: + + - not resize infinitely when the actual number of alive keys is + bounded but keys are continuously added. That would happen if + this function always resize. + - not call this function after each addition, that would happen if this + function don't resize even when only one key is dead. + + So the algorithm: + - clean the keys before resizing + - if the number of remaining key is less than half the size of the + array, don't resize. + - if it is more, resize. + + The second problem remains if the table reaches {!Sys.max_array_length}. + + *) + let resize h = let odata = h.data in let osize = Array.length odata in let nsize = osize * 2 in - if nsize < Sys.max_array_length then begin + clean h; + if nsize < Sys.max_array_length && h.size >= osize lsr 1 then begin let ndata = Array.make nsize Empty in - h.data <- ndata; (* so that indexfun sees the new bucket count *) + h.data <- ndata; (* so that key_index sees the new bucket count *) let rec insert_bucket = function Empty -> () - | Cons(key, data, rest) -> + | Cons(hkey, data, rest) -> insert_bucket rest; (* preserve original order of elements *) - let nidx = indexfun h key in - ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in + let nidx = key_index h hkey in + ndata.(nidx) <- Cons(hkey, data, ndata.(nidx)) in for i = 0 to osize - 1 do insert_bucket odata.(i) done @@ -116,7 +154,7 @@ module GenHashTable = struct let bucket = Cons(hkey, container, h.data.(i)) in h.data.(i) <- bucket; h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then resize key_index h + if h.size > Array.length h.data lsl 1 then resize h let remove h key = let hkey = H.hash h.seed key in @@ -126,12 +164,20 @@ module GenHashTable = struct begin match H.equal key c with | ETrue -> h.size <- h.size - 1; next | EFalse -> Cons(hk, c, remove_bucket next) - | EDead -> remove_bucket next (** The key have been reclaimed *) + | EDead -> + (** The dead key is automatically removed. It is acceptable + for this function since it already remove a binding *) + h.size <- h.size - 1; + remove_bucket next end | Cons(hk,c,next) -> Cons(hk, c, remove_bucket next) in let i = key_index h hkey in h.data.(i) <- remove_bucket h.data.(i) + (** {!find} don't remove dead keys because it would be surprising for + the user that a read-only function mutate the state (eg. concurrent + access). Same for {!iter}, {!fold}, {!mem}. + *) let rec find_rec key hkey = function | Empty -> raise Not_found @@ -142,13 +188,11 @@ module GenHashTable = struct | None -> (** This case is not impossible because the gc can run between H.equal and H.get_data *) - (** TODO? remove this dead key *) find_rec key hkey rest | Some d -> d end | EFalse -> find_rec key hkey rest | EDead -> - (** TODO? remove this dead key *) find_rec key hkey rest end | Cons(_, _, rest) -> @@ -167,13 +211,11 @@ module GenHashTable = struct begin match H.equal key c with | ETrue -> begin match H.get_data c with | None -> - (** TODO? remove this dead key *) find_in_bucket rest | Some d -> d::find_in_bucket rest end | EFalse -> find_in_bucket rest | EDead -> - (** TODO? remove this dead key *) find_in_bucket rest end | Cons(_, _, rest) -> @@ -187,17 +229,13 @@ module GenHashTable = struct | Empty -> raise Not_found | Cons(hk, c, next) when hkey = hk -> begin match H.equal key c with - | ETrue -> begin match H.get_data c with - | None -> - (** Can this case really happend? *) - (** TODO? remove this dead key *) - replace_bucket next - | Some d -> H.set_data c info - end - | EFalse -> replace_bucket next - | EDead -> - (** TODO? remove this dead key *) - replace_bucket next + | ETrue -> begin match H.get_data c with + | None -> + (** This case is not impossible, cf remove *) + replace_bucket next + | Some d -> H.set_data c info + end + | EFalse | EDead -> replace_bucket next end | Cons(_,_,next) -> replace_bucket next in @@ -209,7 +247,7 @@ module GenHashTable = struct let container = H.create key info in h.data.(i) <- Cons(hkey, container, l); h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then resize key_index h + if h.size > Array.length h.data lsl 1 then resize h let mem h key = let hkey = H.hash h.seed key in @@ -219,10 +257,7 @@ module GenHashTable = struct | Cons(hk, c, rest) when hk = hkey -> begin match H.equal key c with | ETrue -> true - | EFalse -> mem_in_bucket rest - | EDead -> - (** TODO? remove this dead key *) - mem_in_bucket rest + | EFalse | EDead -> mem_in_bucket rest end | Cons(hk, c, rest) -> mem_in_bucket rest in mem_in_bucket h.data.(key_index h hkey) @@ -233,7 +268,7 @@ module GenHashTable = struct () | Cons(_, c, rest) -> begin match H.get_key c, H.get_data c with - | None, _ | _, None -> (** TODO? remove this dead key? *) () + | None, _ | _, None -> () | Some k, Some d -> f k d end; do_bucket rest in let d = h.data in @@ -248,7 +283,7 @@ module GenHashTable = struct accu | Cons(_, c, rest) -> let accu = begin match H.get_key c, H.get_data c with - | None, _ | _, None -> (** TODO? remove this dead key? *) accu + | None, _ | _, None -> accu | Some k, Some d -> f k d accu end in do_bucket rest accu in diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli index 01bf89350..718cc97d1 100644 --- a/stdlib/ephemeron.mli +++ b/stdlib/ephemeron.mli @@ -51,6 +51,8 @@ module type S = sig include Hashtbl.S + val clean: 'a t -> unit + (** remove all dead bindings. Done automatically during automatic resizing. *) val stats_alive: 'a t -> Hashtbl.statistics (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *) end @@ -62,6 +64,8 @@ end module type SeededS = sig include Hashtbl.SeededS + val clean: 'a t -> unit + (** remove all dead bindings. Done automatically during automatic resizing. *) val stats_alive: 'a t -> Hashtbl.statistics (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *) end From ec173d03d67609204f01a26aa12a5c32a2339805 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 17 Dec 2015 11:24:18 +0100 Subject: [PATCH 084/145] Add precisions on the equality for Weak.Make It can't be physical equality since it use `Weak.get_copy`. --- stdlib/weak.mli | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/stdlib/weak.mli b/stdlib/weak.mli index d66ac9cdf..d856dd8b0 100644 --- a/stdlib/weak.mli +++ b/stdlib/weak.mli @@ -154,4 +154,7 @@ end;; (** The output signature of the functor {!Weak.Make}. *) module Make (H : Hashtbl.HashedType) : S with type data = H.t;; -(** Functor building an implementation of the weak hash set structure. *) +(** Functor building an implementation of the weak hash set structure. + [H.equal] can't be the physical equality, since only shallow + copies of the elements in the set are given to it. + *) From 3a470635e9e2694d1ae56d9ca6efe0634d01217e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 17 Dec 2015 11:25:19 +0100 Subject: [PATCH 085/145] Fix mantis 5349, semantic of `replace` The closed bug report is about classic hashtable but it is also applicable for weak hashtable (thanks @signoles for the heads up) --- stdlib/ephemeron.ml | 44 +++++++++++++++++++++++++------------------- stdlib/ephemeron.mli | 6 +++--- 2 files changed, 28 insertions(+), 22 deletions(-) diff --git a/stdlib/ephemeron.ml b/stdlib/ephemeron.ml index 6446bf4de..e92e6b321 100644 --- a/stdlib/ephemeron.ml +++ b/stdlib/ephemeron.ml @@ -36,10 +36,10 @@ module GenHashTable = struct type 'a container val create: t -> 'a -> 'a container val hash: int -> t -> int - val equal: t -> 'a container -> equal + val equal: 'a container -> t -> equal val get_data: 'a container -> 'a option val get_key: 'a container -> t option - val set_data: 'a container -> 'a -> unit + val set_key_data: 'a container -> t -> 'a -> unit val check_key: 'a container -> bool end) : SeededS with type key = H.t = struct @@ -161,7 +161,7 @@ module GenHashTable = struct let rec remove_bucket = function | Empty -> Empty | Cons(hk, c, next) when hkey = hk -> - begin match H.equal key c with + begin match H.equal c key with | ETrue -> h.size <- h.size - 1; next | EFalse -> Cons(hk, c, remove_bucket next) | EDead -> @@ -182,7 +182,7 @@ module GenHashTable = struct | Empty -> raise Not_found | Cons(hk, c, rest) when hkey = hk -> - begin match H.equal key c with + begin match H.equal c key with | ETrue -> begin match H.get_data c with | None -> @@ -208,7 +208,7 @@ module GenHashTable = struct let rec find_in_bucket = function | Empty -> [] | Cons(hk, c, rest) when hkey = hk -> - begin match H.equal key c with + begin match H.equal c key with | ETrue -> begin match H.get_data c with | None -> find_in_bucket rest @@ -228,13 +228,8 @@ module GenHashTable = struct let rec replace_bucket = function | Empty -> raise Not_found | Cons(hk, c, next) when hkey = hk -> - begin match H.equal key c with - | ETrue -> begin match H.get_data c with - | None -> - (** This case is not impossible, cf remove *) - replace_bucket next - | Some d -> H.set_data c info - end + begin match H.equal c key with + | ETrue -> H.set_key_data c key info | EFalse | EDead -> replace_bucket next end | Cons(_,_,next) -> replace_bucket next @@ -255,7 +250,7 @@ module GenHashTable = struct | Empty -> false | Cons(hk, c, rest) when hk = hkey -> - begin match H.equal key c with + begin match H.equal c key with | ETrue -> true | EFalse | EDead -> mem_in_bucket rest end @@ -403,7 +398,7 @@ module K1 = struct set_key c k; c let hash = H.hash - let equal k c = + let equal c k = (** {!get_key_copy} is not used because the equality of the user can be the physical equality *) match get_key c with @@ -412,7 +407,10 @@ module K1 = struct if H.equal k k' then GenHashTable.ETrue else GenHashTable.EFalse let get_data = get_data let get_key = get_key - let set_data = set_data + let set_key_data c k d = + unset_data c; + set_key c k; + set_data c d let check_key = check_key end) @@ -479,7 +477,7 @@ module K2 = struct c let hash seed (k1,k2) = H1.hash seed k1 + H2.hash seed k2 * 65599 - let equal (k1,k2) c = + let equal c (k1,k2) = match get_key1 c, get_key2 c with | None, _ | _ , None -> GenHashTable.EDead | Some k1', Some k2' -> @@ -490,7 +488,10 @@ module K2 = struct match get_key1 c, get_key2 c with | None, _ | _ , None -> None | Some k1', Some k2' -> Some (k1', k2') - let set_data = set_data + let set_key_data c (k1,k2) d = + unset_data c; + set_key1 c k1; set_key2 c k2; + set_data c d let check_key c = check_key1 c && check_key2 c end) @@ -554,7 +555,7 @@ module Kn = struct h := H.hash seed k.(i) * 65599 + !h; done; !h - let equal k c = + let equal c k = let len = Array.length k in let len' = length c in if len != len' then GenHashTable.EFalse @@ -589,7 +590,12 @@ module Kn = struct in let a = Array.make len k0 in fill a (len-1) - let set_data = set_data + let set_key_data c k d = + unset_data c; + for i=0 to Array.length k -1 do + set_key c i k.(i); + done; + set_data c d let check_key c = let rec check c i = i < 0 || (check_key c i && check c (i-1)) in diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli index 718cc97d1..7b78e21af 100644 --- a/stdlib/ephemeron.mli +++ b/stdlib/ephemeron.mli @@ -286,7 +286,7 @@ module GenHashTable: sig val hash: int -> t -> int (** same as {!Hashtbl.SeededHashedType} *) - val equal: t -> 'a container -> equal + val equal: 'a container -> t -> equal (** equality predicate used to compare a key with the one in a container. Can return [EDead] if the keys in the container are dead *) @@ -298,8 +298,8 @@ module GenHashTable: sig (** [get_key cont] returns the keys if they are all alive *) val get_data: 'a container -> 'a option (** [get_data cont] return the data if it is alive *) - val set_data: 'a container -> 'a -> unit - (** [set_data cont] modify the data *) + val set_key_data: 'a container -> t -> 'a -> unit + (** [set_key_data cont] modify the key and data *) val check_key: 'a container -> bool (** [check_key cont] checks if all the keys contained in the data are alive *) From ba18944e120bc0679c7e2b201305ce4028974c32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 17 Dec 2015 12:34:22 +0100 Subject: [PATCH 086/145] Fix creation of Ephemeron.K2 And use the tests for the classic hashtables for testing the (non-weak) behavior of weak hashtables. --- stdlib/ephemeron.ml | 2 +- testsuite/tests/lib-hashtbl/htbl.ml | 86 ++++++++++++++++------ testsuite/tests/lib-hashtbl/htbl.reference | 20 +++++ 3 files changed, 86 insertions(+), 22 deletions(-) diff --git a/stdlib/ephemeron.ml b/stdlib/ephemeron.ml index e92e6b321..c14c7e36b 100644 --- a/stdlib/ephemeron.ml +++ b/stdlib/ephemeron.ml @@ -429,7 +429,7 @@ end module K2 = struct type ('k1, 'k2, 'd) t = ObjEph.t - let create () : ('k1,'k2,'d) t = ObjEph.create 1 + let create () : ('k1,'k2,'d) t = ObjEph.create 2 let get_key1 (t:('k1,'k2,'d) t) : 'k1 option = obj_opt (ObjEph.get_key t 0) let get_key1_copy (t:('k1,'k2,'d) t) : 'k1 option = diff --git a/testsuite/tests/lib-hashtbl/htbl.ml b/testsuite/tests/lib-hashtbl/htbl.ml index a93fac4f2..205644140 100644 --- a/testsuite/tests/lib-hashtbl/htbl.ml +++ b/testsuite/tests/lib-hashtbl/htbl.ml @@ -67,20 +67,43 @@ module Test(H: Hashtbl.S) (M: Map.S with type key = H.key) = struct end -module MS = Map.Make(struct type t = string - let compare (x:t) (y:t) = Pervasives.compare x y - end) -module MI = Map.Make(struct type t = int - let compare (x:t) (y:t) = Pervasives.compare x y - end) +module SS = struct + type t = string + let compare (x:t) (y:t) = Pervasives.compare x y + let equal (x:t) (y:t) = x=y + let hash = Hashtbl.hash +end +module SI = struct + type t = int + let compare (x:t) (y:t) = Pervasives.compare x y + let equal (x:t) (y:t) = x=y + let hash = Hashtbl.hash +end +module SSP = struct + type t = string*string + let compare (x:t) (y:t) = Pervasives.compare x y + let equal (x:t) (y:t) = x=y + let hash = Hashtbl.hash +end +module SSL = struct + type t = string list + let compare (x:t) (y:t) = Pervasives.compare x y + let equal (x:t) (y:t) = x=y + let hash = Hashtbl.hash +end +module SSA = struct + type t = string array + let compare (x:t) (y:t) = Pervasives.compare x y + let equal (x:t) (y:t) = x=y + let hash = Hashtbl.hash +end -module MSP = Map.Make(struct type t = string*string - let compare (x:t) (y:t) = Pervasives.compare x y - end) +module MS = Map.Make(SS) +module MI = Map.Make(SI) +module MSP = Map.Make(SSP) +module MSL = Map.Make(SSL) +module MSA = Map.Make(SSA) -module MSL = Map.Make(struct type t = string list - let compare (x:t) (y:t) = Pervasives.compare x y - end) (* Generic hash wrapped as a functorial hash *) @@ -112,13 +135,16 @@ module HSL = HofM(MSL) (* Specific functorial hashes *) -module HS2 = Hashtbl.Make(struct type t = string - let equal (x:t) (y:t) = x=y - let hash = Hashtbl.hash end) +module HS2 = Hashtbl.Make(SS) +module HI2 = Hashtbl.Make(SI) + +(* Specific weak functorial hashes *) +module WS = Ephemeron.K1.Make(SS) +module WSP1 = Ephemeron.K1.Make(SSP) +module WSP2 = Ephemeron.K2.Make(SS)(SS) +module WSL = Ephemeron.K1.Make(SSL) +module WSA = Ephemeron.Kn.Make(SS) -module HI2 = Hashtbl.Make(struct type t = int - let equal (x:t) (y:t) = x=y - let hash = Hashtbl.hash end) (* Instantiating the test *) module TS1 = Test(HS1)(MS) @@ -127,6 +153,11 @@ module TI1 = Test(HI1)(MI) module TI2 = Test(HI2)(MI) module TSP = Test(HSP)(MSP) module TSL = Test(HSL)(MSL) +module TWS = Test(WS)(MS) +module TWSP1 = Test(WSP1)(MSP) +module TWSP2 = Test(WSP2)(MSP) +module TWSL = Test(WSL)(MSL) +module TWSA = Test(WSA)(MSA) (* Data set: strings from a file, associated with their line number *) @@ -172,7 +203,7 @@ let pair_data data = (* Data set: lists *) let list_data data = - let d = Array.make (Array.length data / 10) ([], 0) in + let d = Array.make (Array.length data / 10) ([], "0") in let j = ref 0 in let rec mklist n = if n <= 0 || !j >= Array.length data then [] else begin @@ -182,7 +213,7 @@ let list_data data = hd :: tl end in for i = 0 to Array.length d - 1 do - d.(i) <- (mklist (Random.int 16), i) + d.(i) <- (mklist (Random.int 16), string_of_int i) done; d @@ -202,4 +233,17 @@ let _ = printf "-- Pairs of strings\n%!"; TSP.test (pair_data d); printf "-- Lists of strings\n%!"; - TSL.test (list_data d) + TSL.test (list_data d); + (* weak *) + let d = + try file_data "../../LICENSE" with Sys_error _ -> string_data in + printf "-- Weak K1 -- Strings, functorial interface\n%!"; + TWS.test d; + printf "-- Weak K1 -- Pairs of strings\n%!"; + TWSP1.test (pair_data d); + printf "-- Weak K2 -- Pairs of strings\n%!"; + TWSP2.test (pair_data d); + printf "-- Weak K1 -- Lists of strings\n%!"; + TWSL.test (list_data d); + printf "-- Weak Kn -- Arrays of strings\n%!"; + TWSA.test (Array.map (fun (l,i) -> (Array.of_list l,i)) (list_data d)) diff --git a/testsuite/tests/lib-hashtbl/htbl.reference b/testsuite/tests/lib-hashtbl/htbl.reference index 08ca22f07..9f42ee4bc 100644 --- a/testsuite/tests/lib-hashtbl/htbl.reference +++ b/testsuite/tests/lib-hashtbl/htbl.reference @@ -22,3 +22,23 @@ Removal: passed Insertion: passed Insertion: passed Removal: passed +-- Weak K1 -- Strings, functorial interface +Insertion: passed +Insertion: passed +Removal: passed +-- Weak K1 -- Pairs of strings +Insertion: passed +Insertion: passed +Removal: passed +-- Weak K2 -- Pairs of strings +Insertion: passed +Insertion: passed +Removal: passed +-- Weak K1 -- Lists of strings +Insertion: passed +Insertion: passed +Removal: passed +-- Weak Kn -- Arrays of strings +Insertion: passed +Insertion: passed +Removal: passed From 8567ad7c2de24646dec9d168ddd92c9e113125bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 17 Dec 2015 15:28:18 +0100 Subject: [PATCH 087/145] Precise documentation for ephemerons (Thanks Romait Troit alias William) --- stdlib/ephemeron.mli | 45 +++++++++++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli index 7b78e21af..656eb5d35 100644 --- a/stdlib/ephemeron.mli +++ b/stdlib/ephemeron.mli @@ -15,38 +15,49 @@ (** Ephemerons and weak hash table - Ephemerons are defined in a language agnostic way in this paper: - B. Hayes, Ephemerons: a New Finalization Mechanism, OOPSLA'9 + Ephemerons and weak hashtable are useful when one wants to cache + or memorize the computation of a function, as long as the + arguments and the function are used, without creating memory leaks + by continuously keeping old computation results that are not + useful anymore because one argument or the function is freed. An + implementation using {Hashtbl.t} is not suitable, because all + associations would keep in memory the arguments and the result. - Ephemerons hold some keys and one data. They are all boxed ocaml values and - suffer of the same limitation than weak pointers. + Ephemerons hold some keys and one or no data. They are all boxed + ocaml values. The keys of an ephemerons have the same behavior + than weak pointers according to the garbage collector. In fact + ocaml weak pointers are implemented as ephemerons without data. - The keys of an ephemerons have the same behavior than weak - pointers according to the garbage collector. - - The keys and data of an ephemeron are said to be full if it points to a - value, empty if the value have never been set or was erased by the GC. + The keys and data of an ephemeron are said to be full if they + point to a value, empty if the value have never been set, have + been unset, or was erased by the GC. In the function that access + the keys or data these two states are represented by the [option] + type. The data is considered by the garbage collector alive if all the full keys are alive and if the ephemeron is alive. When one of the keys is not considered alive anymore by the GC, the data is - emptied from the ephemeron even if the data is alive for another - reason. + emptied from the ephemeron. The data could be alive for another + reason and in that case the GC will free it, but the ephemerons + will not hold the data anymore. The ephemerons complicate the notion of liveness of values, because it is not anymore an equivalence with the reachability from root - value by usual pointers (not weak and not ephemerons). The notion - of liveness is constructed by the least fixpoint of: - A value is alive if: - - it is a root value - - it is reachable from alive value by usual pointers - - it is the data of an ephemeron with all its full keys alive + value by usual pointers (not weak and not ephemerons). With ephemerons + the notion of liveness is constructed by the least fixpoint of: + A value is alive if: + - it is a root value + - it is reachable from alive value by usual pointers + - it is the data of an alive ephemeron with all its full keys alive Notes: - All the types defined in this module cannot be marshaled using {!Pervasives.output_value} nor the functions of the {!Marshal} module. + Ephemerons are defined in a language agnostic way in this paper: + B. Hayes, Ephemerons: a New Finalization Mechanism, OOPSLA'9 + *) module type S = sig From cbda9517511b132721fe0dd69ca4e10ca5c8f22b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 25 Dec 2015 10:54:17 +0100 Subject: [PATCH 088/145] [Ephemeron] Don't advertise `Obj.Ephemeron` --- stdlib/ephemeron.mli | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli index 656eb5d35..81c60ef9e 100644 --- a/stdlib/ephemeron.mli +++ b/stdlib/ephemeron.mli @@ -279,14 +279,13 @@ module Kn : sig end module GenHashTable: sig - (** Define hash table on generic containers. *) - - (** It can be used in conjunction of {!Obj.Ephemeron} - for building weak hash table for specific type of keys *) + (** Define hash table on generic containers which have a notion of + "death" and aliveness. If a binding is dead the hash table can + automatically remove it. *) type equal = | ETrue | EFalse - | EDead (** the garbage collector reclaimed the data *) + | EDead (** the container is dead *) module MakeSeeded(H: sig From 511192d5473a6d11823f2ca0199d056c60415f1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 25 Dec 2015 10:57:44 +0100 Subject: [PATCH 089/145] Add Pierre Chambart to reviewers in Changes --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index bb02b36e9..ca6710256 100644 --- a/Changes +++ b/Changes @@ -241,7 +241,7 @@ Standard library: - GPR#356: Add [Format.kasprintf] (Jérémie Dimino, Mark Shinwell) - GPR#22: Add the Ephemeron module that implements ephemerons and weak hash table (François Bobot, review by Damien Doligez, Daniel Bünzli, - Alain Frisch) + Alain Frisch, Pierre Chambart) Type system: - PR#5545: Type annotations on methods cannot control the choice of abbreviation From 300c8e96566df2961a46bc1a74d25c63a981723b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 25 Dec 2015 11:07:13 +0100 Subject: [PATCH 090/145] [GC] Fix some comments and debug message --- byterun/major_gc.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/byterun/major_gc.c b/byterun/major_gc.c index b3cb50d7b..fb0acdd30 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -60,8 +60,7 @@ extern char *caml_fl_merge; /* Defined in freelist.c. */ static char *markhp, *chunk, *limit; -int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final, - clean_ephe,unlink_ephe} */ +int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final} */ /** Ephemerons: @@ -483,7 +482,8 @@ static void mark_slice (intnat work) ephes_to_check = &caml_ephe_list_head; work = 0; } else { - /* Initialise the sweep phase. */ + /* Initialise the sweep phase, + shortcut the unneeded clean phase. */ init_sweep_phase(); work = 0; } @@ -500,12 +500,12 @@ static void mark_slice (intnat work) INSTR (CAML_INSTR_INT ("major/mark/slice/pointers#", slice_pointers);) } +/* Clean ephemerons */ static void clean_slice (intnat work) { value v; caml_gc_message (0x40, "Cleaning %ld words\n", work); - caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); while (work > 0){ v = *ephes_to_check; if (v != (value) NULL){ From cbb96ecdc86ac5d490e427392fa082355e8fbcc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 25 Dec 2015 22:18:40 +0100 Subject: [PATCH 091/145] [GC] shortcut in mark_ephe_aux as caml_ephe_clean --- byterun/major_gc.c | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/byterun/major_gc.c b/byterun/major_gc.c index fb0acdd30..050f86688 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -292,16 +292,16 @@ static inline value* mark_slice_darken(value *gray_vals_ptr, value v, int i, static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, int *slice_pointers) { - value v, child; + value v, data, key; header_t hd; mlsize_t size, i; v = *ephes_to_check; hd = Hd_val(v); Assert(Tag_val (v) == Abstract_tag); - child = Field(v,1); /* child = data */ - if ( child != caml_ephe_none && - Is_block (child) && Is_in_heap (child) && Is_white_val (child)){ + data = Field(v,1); + if ( data != caml_ephe_none && + Is_block (data) && Is_in_heap (data) && Is_white_val (data)){ int alive_data = 1; @@ -311,23 +311,25 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, /* The liveness of the keys not caml_ephe_none is the other condition */ size = Wosize_hd (hd); for (i = 2; alive_data && i < size; i++){ - child = Field (v, i); /* child = one key */ + key = Field (v, i); ephemeron_again: - if (Tag_val (child) == Forward_tag){ - value f = Forward_val (child); - if (Is_long (f) || - (Is_block (f) && - (!Is_in_value_area(f) || Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag))){ - /* Do not short-circuit the pointer. */ - }else{ - Field (v, i) = child = f; - goto ephemeron_again; + if (key != caml_ephe_none && + Is_block (key) && Is_in_heap (key)){ + if (Tag_val (key) == Forward_tag){ + value f = Forward_val (key); + if (Is_long (f) || + (Is_block (f) && + (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag))){ + /* Do not short-circuit the pointer. */ + }else{ + Field (v, i) = key = f; + goto ephemeron_again; + } + } + if (Is_white_val (key)){ + alive_data = 0; } - } - if (child != caml_ephe_none && - Is_block (child) && Is_in_heap (child) && Is_white_val (child)){ - alive_data = 0; } } *work -= Whsize_wosize(i); From 07b88bb5ac1a254bbc3146559e88e12a96650204 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 30 Dec 2015 00:13:08 +0100 Subject: [PATCH 092/145] Add a test specifically for weak table And fix a bug in the handling of ephemeron during minor collection found thanks to this test. Oldifying of ephemerons' data was not iterated enough because `oldify_todo_list` doesn't become non-null each time `caml_oldify_one` is run. --- byterun/minor_gc.c | 40 ++++--- stdlib/ephemeron.mli | 7 ++ testsuite/tests/misc/ephetest3.ml | 133 +++++++++++++++++++++++ testsuite/tests/misc/ephetest3.reference | 18 +++ 4 files changed, 182 insertions(+), 16 deletions(-) create mode 100644 testsuite/tests/misc/ephetest3.ml create mode 100644 testsuite/tests/misc/ephetest3.reference diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index 80f96878c..c21aa3186 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -274,6 +274,21 @@ void caml_oldify_one (value v, value *p) } } +/* Test if the ephemeron is alive, everything outside minor heap is alive */ +static inline int ephe_check_alive_data(struct caml_ephe_ref_elt *re){ + mlsize_t i; + value child; + for (i = 2; i < Wosize_val(re->ephe); i++){ + child = Field (re->ephe, i); + if(child != caml_ephe_none + && Is_block (child) && Is_young (child) + && Hd_val (child) != 0){ /* Value not copied to major heap */ + return 0; + } + } + return 1; +} + /* Finish the work that was put off by [caml_oldify_one]. Note that [caml_oldify_one] itself is called by oldify_mopup, so we have to be careful to remove the first entry from the list before @@ -283,6 +298,7 @@ void caml_oldify_mopup (void) value v, new_v, f; mlsize_t i; struct caml_ephe_ref_elt *re; + int redo = 0; while (oldify_todo_list != 0){ v = oldify_todo_list; /* Get the head. */ @@ -310,30 +326,21 @@ void caml_oldify_mopup (void) re < caml_ephe_ref_table.ptr; re++){ /* look only at ephemeron with data in the minor heap */ if (re->offset == 1){ - value *data = &Field(re->ephe,re->offset); - if (Is_block (*data) && Is_young (*data)){ + value *data = &Field(re->ephe,1); + if (*data != caml_ephe_none && Is_block (*data) && Is_young (*data)){ if (Hd_val (*data) == 0){ /* Value copied to major heap */ *data = Field (*data, 0); } else { - /* Test if the ephemeron is alive */ - int alive_data = 1; - value child; - for (i = 2; alive_data && i < Wosize_val(re->ephe); i++){ - child = Field (re->ephe, i); - if(child != caml_ephe_none - && Is_block (child) && Is_young (child) - && Hd_val (child) != 0){ /* Value not copied to major heap */ - alive_data = 0; - } + if (ephe_check_alive_data(re)){ + caml_oldify_one(*data,data); + redo = 1; /* oldify_todo_list can still be 0 */ } - if (alive_data) caml_oldify_one(*data,data); } } } } - if (oldify_todo_list != 0) caml_oldify_mopup (); - + if (redo) caml_oldify_mopup (); } /* Make sure the minor heap is empty by performing a minor collection @@ -363,10 +370,11 @@ void caml_empty_minor_heap (void) for (re = caml_ephe_ref_table.base; re < caml_ephe_ref_table.ptr; re++){ value *key = &Field(re->ephe,re->offset); - if (Is_block (*key) && Is_young (*key)){ + if (*key != caml_ephe_none && Is_block (*key) && Is_young (*key)){ if (Hd_val (*key) == 0){ /* Value copied to major heap */ *key = Field (*key, 0); }else{ /* Value not copied so it's dead */ + Assert(!ephe_check_alive_data(re)); *key = caml_ephe_none; Field(re->ephe,1) = caml_ephe_none; } diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli index 81c60ef9e..5338e48ed 100644 --- a/stdlib/ephemeron.mli +++ b/stdlib/ephemeron.mli @@ -61,7 +61,14 @@ *) module type S = sig + (** Propose the same interface than usual hash table. However since + the bindings are weak, [mem h k] is true doesn't mean that a + just following [find h k] will not raise the exception + [Not_found] since the garbage collector can run between the two. + *) + include Hashtbl.S + val clean: 'a t -> unit (** remove all dead bindings. Done automatically during automatic resizing. *) val stats_alive: 'a t -> Hashtbl.statistics diff --git a/testsuite/tests/misc/ephetest3.ml b/testsuite/tests/misc/ephetest3.ml new file mode 100644 index 000000000..3c49b47fe --- /dev/null +++ b/testsuite/tests/misc/ephetest3.ml @@ -0,0 +1,133 @@ +(*************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Damien Doligez, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(*************************************************************************) + +(** This test weak table by application to the memoization of collatz + (also known as syracuse) algorithm suite computation *) + +(** We use Int64 because they are boxed *) + +(** number of element of the suite to compute (more are computed) *) +let n = 1000 + +let two = Int64.of_int 2 +let three = Int64.of_int 3 + +let collatz x = + if Int64.equal (Int64.rem x two) Int64.zero + then Int64.div x two + else Int64.succ (Int64.mul x three) + +module S = struct + include Int64 + let hash (x:t) = Hashtbl.hash x +end + +let pp = Int64.to_string + +module HW = Ephemeron.K1.Make(S) +module SW = Weak.Make(S) + + +let sw = SW.create n +let hashcons x = SW.merge sw x + +let hw = HW.create n + +let rec fill_hw x = + if not (HW.mem hw x) then begin + let y = hashcons (collatz x) in + HW.add hw x y; + fill_hw y + end + +exception InvariantBroken of string +let test b = Printf.ksprintf (fun s -> if not b then raise (InvariantBroken s)) + +let rec check_hw_aux cache x = + (** We use int so that the cache doesn't make x alive *) + if not (Hashtbl.mem cache (Int64.to_int x)) then begin + test (HW.mem hw x) "missing %s%!" (pp x); + let y = + try HW.find hw x + with Not_found -> + test (not (HW.mem hw x)) "key in the table but data missing %s!%!" + (pp x); + test false "missing %s%!" (pp x); + assert false + in + let y' = collatz x in + test (Int64.equal y y') "bad result for %s: %s instead of %s%!" + (pp x) (pp y) (pp y'); + let y'' = hashcons y' in + test (y == y'') "bad result for %s: not physically equal%!" (pp x); + Hashtbl.add cache (Int64.to_int x) (); + check_hw_aux cache y + end + +let check_hw iter = + let cache = Hashtbl.create n in + iter (fun x -> check_hw_aux cache x) + +(** tests *) + +let run ~next ~check = + HW.reset hw; + SW.clear sw; + (* Gc.full_major (); *) + for x=0 to n do + let x' = next x in + fill_hw x'; + check x; + done; + Gc.full_major (); + HW.clean hw; + Printf.printf "length: %i\n%!" (HW.length hw) + +let print_stats () = + let print_stats name stats = + Printf.printf "%s (%3i,%3i,%3i): %!" + name + stats.Hashtbl.num_bindings + stats.Hashtbl.num_buckets + stats.Hashtbl.max_bucket_length; + Array.iteri (fun i n -> Printf.printf "%i: %i, %!" i n) + stats.Hashtbl.bucket_histogram; + Printf.printf "\n%!"; + in + print_stats "stats : " (HW.stats hw); + print_stats "stats_alive: " (HW.stats_alive hw) + +let test_keep_last d d' = + Printf.printf "## Keep last %i alive, check each %i ##\n%!" (n/d) (n/d'); + let keep_alive = Array.create (n/d) Int64.zero in + let next x = + let x' = hashcons (Int64.of_int x) in + Array.set keep_alive (x mod (n/d)) x'; + x' + in + let check x = + if x mod (n/d') = 0 || x = n then begin + check_hw (fun f -> Array.iter f keep_alive) + end + in + run ~next ~check; + (** keep the array alive until the end *) + let s = + Array.fold_left (fun acc x -> Int64.add x acc) Int64.zero keep_alive in + Printf.printf "sum of kept alive %s\n%!" (pp s); + print_stats (); + Printf.printf "\n%!" + +let () = + test_keep_last 1 10; + test_keep_last 50 10; + test_keep_last 100 2 diff --git a/testsuite/tests/misc/ephetest3.reference b/testsuite/tests/misc/ephetest3.reference new file mode 100644 index 000000000..4fd03fb90 --- /dev/null +++ b/testsuite/tests/misc/ephetest3.reference @@ -0,0 +1,18 @@ +## Keep last 1000 alive, check each 100 ## +length: 2228 +sum of kept alive 500500 +stats : (2228,2048, 6): 0: 658, 1: 791, 2: 413, 3: 143, 4: 34, 5: 8, 6: 1, +stats_alive: (2228,2048, 6): 0: 658, 1: 791, 2: 413, 3: 143, 4: 34, 5: 8, 6: 1, + +## Keep last 20 alive, check each 100 ## +length: 458 +sum of kept alive 19810 +stats : (458,2048, 3): 0: 1636, 1: 370, 2: 38, 3: 4, +stats_alive: (458,2048, 3): 0: 1636, 1: 370, 2: 38, 3: 4, + +## Keep last 10 alive, check each 500 ## +length: 339 +sum of kept alive 9955 +stats : (339,2048, 3): 0: 1740, 1: 279, 2: 27, 3: 2, +stats_alive: (339,2048, 3): 0: 1740, 1: 279, 2: 27, 3: 2, + From 4e8a7ff173701bc693db68ff9bb9c25b9c0d0e73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 20 Jan 2016 09:14:05 +0100 Subject: [PATCH 093/145] Move caml_ephe_clean to the weak.h So that major_gc.c can inline this function for clean phase. --- byterun/caml/weak.h | 49 ++++++++++++++++++++++++++++++++++++++++++++- byterun/weak.c | 49 +-------------------------------------------- 2 files changed, 49 insertions(+), 49 deletions(-) diff --git a/byterun/caml/weak.h b/byterun/caml/weak.h index ec599dcd5..9fefaa41a 100644 --- a/byterun/caml/weak.h +++ b/byterun/caml/weak.h @@ -21,6 +21,53 @@ extern value caml_ephe_list_head; extern value caml_ephe_none; -void caml_ephe_clean (value v); +/* In the header, in order to let major_gc.c + and weak.c see the body of the function */ +static inline void caml_ephe_clean (value v){ + value child; + int release_data = 0; + mlsize_t size, i; + header_t hd; + Assert(caml_gc_phase == Phase_clean); + + hd = Hd_val (v); + size = Wosize_hd (hd); + for (i = 2; i < size; i++){ + child = Field (v, i); + ephemeron_again: + if (child != caml_ephe_none + && Is_block (child) && Is_in_heap_or_young (child)){ + if (Tag_val (child) == Forward_tag){ + value f = Forward_val (child); + if (Is_block (f)) { + if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){ + /* Do not short-circuit the pointer. */ + }else{ + Field (v, i) = child = f; + if (Is_block (f) && Is_young (f)) + add_to_ephe_ref_table(&caml_ephe_ref_table, v, i); + goto ephemeron_again; + } + } + } + if (Is_white_val (child) && !Is_young (child)){ + release_data = 1; + Field (v, i) = caml_ephe_none; + } + } + } + + child = Field (v, 1); + if(child != caml_ephe_none){ + if (release_data){ + Field (v, 1) = caml_ephe_none; + } else { + /* The mark phase must have marked it */ + Assert( !(Is_block (child) && Is_in_heap (child) + && Is_white_val (child)) ); + } + } +} #endif /* CAML_WEAK_H */ diff --git a/byterun/weak.c b/byterun/weak.c index 89ec92242..12000e528 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -20,6 +20,7 @@ #include "caml/major_gc.h" #include "caml/memory.h" #include "caml/mlvalues.h" +#include "caml/weak.h" value caml_ephe_list_head = 0; @@ -83,54 +84,6 @@ CAMLprim value caml_weak_create (value len) */ -void caml_ephe_clean (value v){ - value child; - int release_data = 0; - mlsize_t size, i; - header_t hd; - Assert(caml_gc_phase == Phase_clean); - - hd = Hd_val (v); - size = Wosize_hd (hd); - for (i = 2; i < size; i++){ - child = Field (v, i); - ephemeron_again: - if (child != caml_ephe_none - && Is_block (child) && Is_in_heap_or_young (child)){ - if (Tag_val (child) == Forward_tag){ - value f = Forward_val (child); - if (Is_block (f)) { - if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){ - /* Do not short-circuit the pointer. */ - }else{ - Field (v, i) = child = f; - if (Is_block (f) && Is_young (f)) - add_to_ephe_ref_table(&caml_ephe_ref_table, v, i); - goto ephemeron_again; - } - } - } - if (Is_white_val (child) && !Is_young (child)){ - release_data = 1; - Field (v, i) = caml_ephe_none; - } - } - } - - child = Field (v, 1); - if(child != caml_ephe_none){ - if (release_data){ - Field (v, 1) = caml_ephe_none; - } else { - /* The mark phase must have marked it */ - Assert( !(Is_block (child) && Is_in_heap (child) - && Is_white_val (child)) ); - } - } -} - - #define None_val (Val_int(0)) #define Some_tag 0 From 40fd65c485cb6ed5b603b4d2a8634cbeff0accd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 20 Jan 2016 09:20:42 +0100 Subject: [PATCH 094/145] Check ephemerons after marking globals --- byterun/major_gc.c | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 050f86688..1ab1338ef 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -444,6 +444,13 @@ static void mark_slice (intnat work) chunk = caml_heap_start; markhp = chunk; limit = chunk + Chunk_size (chunk); + } else if (caml_gc_subphase == Subphase_mark_roots) { + gray_vals_cur = gray_vals_ptr; + work = caml_darken_all_roots_slice (work); + gray_vals_ptr = gray_vals_cur; + if (work > 0){ + caml_gc_subphase = Subphase_mark_main; + } } else if (*ephes_to_check != (value) NULL) { /* Continue to scan the list of ephe */ gray_vals_ptr = mark_ephe_aux(gray_vals_ptr,&work,&slice_pointers); @@ -453,15 +460,6 @@ static void mark_slice (intnat work) ephes_to_check = ephes_checked_if_pure; }else{ switch (caml_gc_subphase){ - case Subphase_mark_roots: { - gray_vals_cur = gray_vals_ptr; - work = caml_darken_all_roots_slice (work); - gray_vals_ptr = gray_vals_cur; - if (work > 0){ - caml_gc_subphase = Subphase_mark_main; - } - } - break; case Subphase_mark_main: { /* Subphase_mark_main is done. Mark finalised values. */ From d8823e11d45f4098df237168403ea176a8123327 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 20 Jan 2016 09:23:38 +0100 Subject: [PATCH 095/145] Do cleaning less often. optimize No_naked_pointer During clean phase for consistency we need to check if the key checked or got is alive or not. Three possibilities: - Doesn't unset the key, but still return the right value as if it is unset. - Unset the key and the data - Clean the ephemeron Testing aliveness is a little costly, so it is better to amortize this cost. Previously the last possibility was implemented but a better trade-off seems the second one, since the clean phase is still going to clean the ephemeron eventually. --- byterun/weak.c | 75 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 55 insertions(+), 20 deletions(-) diff --git a/byterun/weak.c b/byterun/weak.c index 12000e528..b2b9e508a 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -34,6 +34,36 @@ value caml_ephe_none = (value) &ephe_dummy; A weak pointer is an ephemeron with the data at caml_ephe_none */ +#define CAML_EPHE_LINK_OFFSET 0 +#define CAML_EPHE_DATA_OFFSET 1 + +#if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS) +/** The minor heap is considered alive. + Outside minor and major heap, x must be black. +*/ +static inline int Is_Dead_during_clean(value x){ + Assert (x != caml_ephe_none); Assert (caml_gc_phase == Phase_clean); + return Is_block (x) && !Is_young (x) && Is_white_val(x); +} +/** The minor heap doesn't have to be marked, outside they should + already be black +*/ +static inline int Must_be_Marked_during_mark(value x){ + Assert (x != caml_ephe_none); Assert (caml_gc_phase == Phase_mark); + return Is_block (x) && !Is_young (x); +} +#else +static inline int Is_Dead_during_clean(value x){ + Assert (x != caml_ephe_none); Assert (caml_gc_phase == Phase_clean); + return Is_block (x) && Is_in_heap (x) && Is_white_val(x); +} +static inline int Must_be_Marked_during_mark(value x){ + Assert (x != caml_ephe_none); Assert (caml_gc_phase == Phase_mark); + return Is_block (x) && Is_in_heap (x); +} +#endif + + /* [len] is a value that represents a number of words (fields) */ CAMLprim value caml_ephe_create (value len) { @@ -44,7 +74,7 @@ CAMLprim value caml_ephe_create (value len) if (size <= 0 || size > Max_wosize) caml_invalid_argument ("Weak.create"); res = caml_alloc_shr (size, Abstract_tag); for (i = 1; i < size; i++) Field (res, i) = caml_ephe_none; - Field (res, 0) = caml_ephe_list_head; + Field (res, CAML_EPHE_LINK_OFFSET) = caml_ephe_list_head; caml_ephe_list_head = res; return res; } @@ -94,20 +124,22 @@ static void do_check_key_clean(value ar, mlsize_t offset){ Assert ( offset >= 2); if (caml_gc_phase == Phase_clean){ value elt = Field (ar, offset); - if (Is_block (elt) && Is_in_heap (elt) && Is_white_val(elt)){ - caml_ephe_clean(ar); + if (elt != caml_ephe_none && Is_Dead_during_clean(elt)){ + Field(ar,offset) = caml_ephe_none; + Field(ar,CAML_EPHE_DATA_OFFSET) = caml_ephe_none; }; }; } /* If we are in Phase_clean we need to do as if the key is empty when it will be cleaned during this phase */ -static int is_ephe_key_none(value ar, value elt){ +static inline int is_ephe_key_none(value ar, mlsize_t offset){ + value elt = Field (ar, offset); if (elt == caml_ephe_none){ return 1; - }else if (caml_gc_phase == Phase_clean && - Is_block (elt) && Is_in_heap (elt) && Is_white_val(elt)){ - caml_ephe_clean(ar); + }else if (caml_gc_phase == Phase_clean && Is_Dead_during_clean(elt)){ + Field(ar,offset) = caml_ephe_none; + Field(ar,CAML_EPHE_DATA_OFFSET) = caml_ephe_none; return 1; } else { return 0; @@ -189,7 +221,7 @@ CAMLprim value caml_ephe_set_data (value ar, value el) CAMLprim value caml_ephe_unset_data (value ar) { Assert (Is_in_heap (ar)); - Field (ar, 1) = caml_ephe_none; + Field (ar, CAML_EPHE_DATA_OFFSET) = caml_ephe_none; return Val_unit; } @@ -206,11 +238,11 @@ CAMLprim value caml_ephe_get_key (value ar, value n) if (offset < 2 || offset >= Wosize_val (ar)){ caml_invalid_argument ("Weak.get_key"); } - elt = Field (ar, offset); - if (is_ephe_key_none(ar, elt)){ + if (is_ephe_key_none(ar, offset)){ res = None_val; }else{ - if (caml_gc_phase == Phase_mark && Is_block (elt) && Is_in_heap (elt)){ + elt = Field (ar, offset); + if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(elt)){ caml_darken (elt, NULL); } res = caml_alloc_small (1, Some_tag); @@ -234,7 +266,7 @@ CAMLprim value caml_ephe_get_data (value ar) if (elt == caml_ephe_none){ res = None_val; }else{ - if (caml_gc_phase == Phase_mark && Is_block (elt) && Is_in_heap (elt)){ + if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(elt)){ caml_darken (elt, NULL); } res = caml_alloc_small (1, Some_tag); @@ -257,18 +289,18 @@ CAMLprim value caml_ephe_get_key_copy (value ar, value n) caml_invalid_argument ("Weak.get_copy"); } + if (is_ephe_key_none(ar, offset)) CAMLreturn (None_val); v = Field (ar, offset); - if (is_ephe_key_none(ar, v)) CAMLreturn (None_val); if (Is_block (v) && Is_in_heap_or_young(v)) { elt = caml_alloc (Wosize_val (v), Tag_val (v)); /* The GC may erase or move v during this call to caml_alloc. */ v = Field (ar, offset); - if (is_ephe_key_none(ar, v)) CAMLreturn (None_val); + if (is_ephe_key_none(ar, offset)) CAMLreturn (None_val); if (Tag_val (v) < No_scan_tag){ mlsize_t i; for (i = 0; i < Wosize_val (v); i++){ value f = Field (v, i); - if (caml_gc_phase == Phase_mark && Is_block (f) && Is_in_heap (f)){ + if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(f)){ caml_darken (f, NULL); } Modify (&Field (elt, i), f); @@ -310,7 +342,7 @@ CAMLprim value caml_ephe_get_data_copy (value ar) mlsize_t i; for (i = 0; i < Wosize_val (v); i++){ value f = Field (v, i); - if (caml_gc_phase == Phase_mark && Is_block (f) && Is_in_heap (f)){ + if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(f)){ caml_darken (f, NULL); } Modify (&Field (elt, i), f); @@ -334,7 +366,7 @@ CAMLprim value caml_ephe_check_key (value ar, value n) if (offset < 2 || offset >= Wosize_val (ar)){ caml_invalid_argument ("Weak.check"); } - return Val_bool (!is_ephe_key_none(ar, Field (ar, offset))); + return Val_bool (!is_ephe_key_none(ar, offset)); } CAMLprim value caml_weak_check (value ar, value n) @@ -345,7 +377,7 @@ CAMLprim value caml_weak_check (value ar, value n) CAMLprim value caml_ephe_check_data (value ar) { if(caml_gc_phase == Phase_clean) caml_ephe_clean(ar); - return Val_bool (Field (ar, 1) != caml_ephe_none); + return Val_bool (Field (ar, CAML_EPHE_DATA_OFFSET) != caml_ephe_none); } CAMLprim value caml_ephe_blit_key (value ars, value ofs, @@ -363,7 +395,10 @@ CAMLprim value caml_ephe_blit_key (value ars, value ofs, if (offset_d < 1 || offset_d + length > Wosize_val (ard)){ caml_invalid_argument ("Weak.blit"); } - if (caml_gc_phase == Phase_clean) caml_ephe_clean(ars); + if (caml_gc_phase == Phase_clean){ + caml_ephe_clean(ars); + caml_ephe_clean(ard); + } if (offset_d < offset_s){ for (i = 0; i < length; i++){ do_set (ard, offset_d + i, Field (ars, offset_s + i)); @@ -382,7 +417,7 @@ CAMLprim value caml_ephe_blit_data (value ars, value ard) caml_ephe_clean(ars); caml_ephe_clean(ard); }; - do_set (ard, 1, Field (ars, 1)); + do_set (ard, CAML_EPHE_DATA_OFFSET, Field (ars, CAML_EPHE_DATA_OFFSET)); return Val_unit; } From e77b7aba50e95e7e9217c9c7b89194b554d8a3cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Thu, 21 Jan 2016 18:07:55 +0100 Subject: [PATCH 096/145] Use CAML_EPHE_*_OFFSET for better readability in major_gc --- byterun/caml/weak.h | 13 +++++++++++++ byterun/major_gc.c | 22 ++++++++++++---------- byterun/weak.c | 10 ---------- 3 files changed, 25 insertions(+), 20 deletions(-) diff --git a/byterun/caml/weak.h b/byterun/caml/weak.h index 9fefaa41a..fd12188c2 100644 --- a/byterun/caml/weak.h +++ b/byterun/caml/weak.h @@ -21,6 +21,19 @@ extern value caml_ephe_list_head; extern value caml_ephe_none; + +/** The first field 0: weak list; + second field 1: data; + others 2..: keys; + + A weak pointer is an ephemeron with the data at caml_ephe_none + */ + +#define CAML_EPHE_LINK_OFFSET 0 +#define CAML_EPHE_DATA_OFFSET 1 +#define CAML_EPHE_FIRST_KEY 2 + + /* In the header, in order to let major_gc.c and weak.c see the body of the function */ static inline void caml_ephe_clean (value v){ diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 1ab1338ef..f9f48a10f 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -299,7 +299,7 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, v = *ephes_to_check; hd = Hd_val(v); Assert(Tag_val (v) == Abstract_tag); - data = Field(v,1); + data = Field(v,CAML_EPHE_DATA_OFFSET); if ( data != caml_ephe_none && Is_block (data) && Is_in_heap (data) && Is_white_val (data)){ @@ -310,7 +310,7 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, /* The liveness of the keys not caml_ephe_none is the other condition */ size = Wosize_hd (hd); - for (i = 2; alive_data && i < size; i++){ + for (i = CAML_EPHE_FIRST_KEY; alive_data && i < size; i++){ key = Field (v, i); ephemeron_again: if (key != caml_ephe_none && @@ -335,10 +335,12 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, *work -= Whsize_wosize(i); if (alive_data){ - gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,1,/*in_ephemeron=*/1, + gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v, + CAML_EPHE_DATA_OFFSET, + /*in_ephemeron=*/1, slice_pointers); } else { /* not triggered move to the next one */ - ephes_to_check = &Field(v,0); + ephes_to_check = &Field(v,CAML_EPHE_LINK_OFFSET); return gray_vals_ptr; } } else { /* a simily weak pointer or an already alive data */ @@ -349,15 +351,15 @@ static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work, move the ephemerons from (3) to the end of (1) */ if ( ephes_checked_if_pure == ephes_to_check ) { /* corner case and optim */ - ephes_checked_if_pure = &Field(v,0); + ephes_checked_if_pure = &Field(v,CAML_EPHE_LINK_OFFSET); ephes_to_check = ephes_checked_if_pure; } else { /* - remove v from the list (3) */ - *ephes_to_check = Field(v,0); + *ephes_to_check = Field(v,CAML_EPHE_LINK_OFFSET); /* - insert it at the end of (1) */ - Field(v,0) = *ephes_checked_if_pure; + Field(v,CAML_EPHE_LINK_OFFSET) = *ephes_checked_if_pure; *ephes_checked_if_pure = v; - ephes_checked_if_pure = &Field(v,0); + ephes_checked_if_pure = &Field(v,CAML_EPHE_LINK_OFFSET); } return gray_vals_ptr; } @@ -511,11 +513,11 @@ static void clean_slice (intnat work) if (v != (value) NULL){ if (Is_white_val (v)){ /* The whole array is dead, remove it from the list. */ - *ephes_to_check = Field (v, 0); + *ephes_to_check = Field (v, CAML_EPHE_LINK_OFFSET); work -= 1; }else{ caml_ephe_clean(v); - ephes_to_check = &Field (v, 0); + ephes_to_check = &Field (v, CAML_EPHE_LINK_OFFSET); work -= Whsize_val (v); } }else{ /* End of list reached */ diff --git a/byterun/weak.c b/byterun/weak.c index b2b9e508a..262c85054 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -27,16 +27,6 @@ value caml_ephe_list_head = 0; static value ephe_dummy = 0; value caml_ephe_none = (value) &ephe_dummy; -/** The first field 0: weak list; - second field 1: data; - others 2..: keys; - - A weak pointer is an ephemeron with the data at caml_ephe_none - */ - -#define CAML_EPHE_LINK_OFFSET 0 -#define CAML_EPHE_DATA_OFFSET 1 - #if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS) /** The minor heap is considered alive. Outside minor and major heap, x must be black. From dbf2b8f90ba21fd8cee749f314109244aea07858 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Mon, 25 Jan 2016 08:41:53 +0100 Subject: [PATCH 097/145] [Ephemeron] Advise to use {!filter_map_inplace} Add another example of use. --- stdlib/ephemeron.mli | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli index 5338e48ed..add6989d9 100644 --- a/stdlib/ephemeron.mli +++ b/stdlib/ephemeron.mli @@ -23,6 +23,10 @@ implementation using {Hashtbl.t} is not suitable, because all associations would keep in memory the arguments and the result. + Ephemerons can also be used for "adding" a field to an arbitrary + boxed ocaml value: you can attach an information to a value + created by an external library without memory leaks. + Ephemerons hold some keys and one or no data. They are all boxed ocaml values. The keys of an ephemerons have the same behavior than weak pointers according to the garbage collector. In fact @@ -65,6 +69,9 @@ module type S = sig the bindings are weak, [mem h k] is true doesn't mean that a just following [find h k] will not raise the exception [Not_found] since the garbage collector can run between the two. + + Secondly during an iteration the table shouldn't be modified use + instead {!filter_map_inplace} for that purpose. *) include Hashtbl.S From 340788e216718f81a0c835128af0d8cb6c6ca65d Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 22 Dec 2015 13:22:01 +0000 Subject: [PATCH 098/145] Fix XML tokenization test on Windows XML sample document behaves differently when checked out on Windows where the source line endings in the test document become `\r\n`. Alternative would have been to specify that t01.ml needs LF endings in .gitattributes, but explicitly including the \n and \t in the OCaml string seems less brittle. --- testsuite/tests/lib-str/t01.ml | 126 ++++++++++++++++----------------- 1 file changed, 63 insertions(+), 63 deletions(-) diff --git a/testsuite/tests/lib-str/t01.ml b/testsuite/tests/lib-str/t01.ml index ba171eb7a..3255ca8be 100644 --- a/testsuite/tests/lib-str/t01.ml +++ b/testsuite/tests/lib-str/t01.ml @@ -842,69 +842,69 @@ let automated_test() = in let _XML_SPE = _TextSE ^ "\\|" ^ _MarkupSPE in let input = "\ - - - - -]> - - - - - 65 - 20 - 300 - 2400 - 300 - 25 - 50 - - - Avocado Dip - Sunnydale - 29 - - 11 - 3 - 5 - 210 - 2 - 0 - 1 - - 0 - 0 - - - 0 - 0 - - - +\n\ +\n\ +\n\ +\ \n\ +]>\n\ +\n\ + \n\ +\n\ +\n\ +\t65\n\ +\t20\n\ +\t300\n\ +\t2400\n\ +\t300\n\ +\t25\n\ +\t50\n\ +\n\ +\n\ +\tAvocado Dip\n\ +\tSunnydale\n\ +\t29\n\ +\t\n\ +\t11\n\ +\t3\n\ +\t5\n\ +\t210\n\ +\t2\n\ +\t0\n\ +\t1\n\ +\t\n\ +\t\t0\n\ +\t\t0\n\ +\t\n\ +\t\n\ +\t\t0\n\ +\t\t0\n\ +\t\n\ +\n\ +\n\ " in let result = [ ""; From 9b7c1134de16f998654bd1e6b7a77bcd37ee38a7 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 22 Dec 2015 13:34:28 +0000 Subject: [PATCH 099/145] Fix parsing tests on Windows Testing the parsetree fails on Windows because the .ml files have `\r\n` endings. For these tests, simplest simply to ensure that they are checked out using LF endings, even on Windows. --- .gitattributes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitattributes b/.gitattributes index 7836b6f21..410bf7a10 100644 --- a/.gitattributes +++ b/.gitattributes @@ -79,3 +79,7 @@ manual/tools/htmlcut text eol=lf manual/tools/htmltbl text eol=lf manual/tools/htmlthread text eol=lf manual/tools/texexpand text eol=lf + +# Checking out the parsetree test files with \r\n endings causes all the +# locations to change, so use \n endings only, even on Windows +testsuite/tests/parsing/*.ml text eol=lf From 0dc60eefc7a70ff8428c119530c505b56a0a3b31 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 22 Dec 2015 13:40:17 +0000 Subject: [PATCH 100/145] Fix test-suite custom scripts on Windows .precheck, .runner and .checker files are part of scripts and need to have LF line-endings. --- .gitattributes | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.gitattributes b/.gitattributes index 410bf7a10..94b2ca301 100644 --- a/.gitattributes +++ b/.gitattributes @@ -44,6 +44,11 @@ ocamldoc/ocamldoc.sty ocaml-typo=missing-header *.sh.in text eol=lf *.awk text eol=lf +# Test suite command fragments +*.checker text eol=lf +*.precheck text eol=lf +*.runner text eol=lf + configure text eol=lf config/auto-aux/hasgot text eol=lf config/auto-aux/hasgot2 text eol=lf From 7d2e2afd120476848209f1b393047a3530b05cd1 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 22 Dec 2015 14:52:51 +0000 Subject: [PATCH 101/145] Missing items from .gitignore --- .gitignore | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/.gitignore b/.gitignore index 9c0da6d5f..70221c1fb 100644 --- a/.gitignore +++ b/.gitignore @@ -17,6 +17,7 @@ .DS_Store *.out *.out.dSYM +*.swp # local to root directory @@ -133,6 +134,8 @@ /ocamlbuild/ocamlbuild_config.ml /ocamlbuild/lexers.ml /ocamlbuild/glob_lexer.ml +/ocamlbuild/ocamlbuild.native +/ocamlbuild/ocamlbuild.byte /ocamldoc/ocamldoc /ocamldoc/ocamldoc.opt @@ -238,6 +241,8 @@ /testsuite/tests/lib-threads/*.byt +/testsuite/tests/opaque/*/*.mli + /testsuite/tests/runtime-errors/*.bytecode /testsuite/tests/tool-debugger/**/compiler-libs @@ -245,10 +250,20 @@ /testsuite/tests/tool-debugger/no_debug_event/out /testsuite/tests/tool-debugger/no_debug_event/c +/testsuite/tests/tool-ocamldep-modalias/*.byt* +/testsuite/tests/tool-ocamldep-modalias/*.opt* +/testsuite/tests/tool-ocamldep-modalias/depend.mk +/testsuite/tests/tool-ocamldep-modalias/depend.mk2 +/testsuite/tests/tool-ocamldep-modalias/depend.mod +/testsuite/tests/tool-ocamldep-modalias/depend.mod2 +/testsuite/tests/tool-ocamldep-modalias/depend.mod3 + /testsuite/tests/tool-ocamldoc/*.html /testsuite/tests/tool-ocamldoc/*.sty /testsuite/tests/tool-ocamldoc/*.css +/testsuite/tests/tool-ocamldoc-2/ocamldoc.sty + /testsuite/tests/tool-lexyacc/scanner.ml /testsuite/tests/tool-lexyacc/grammar.mli /testsuite/tests/tool-lexyacc/grammar.ml From 7c10fb227e9a5ee172e0c1458c4b525e79777b1b Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 22 Dec 2015 17:38:32 +0000 Subject: [PATCH 102/145] Eliminate testsuite ulimit warning on Cygwin Cygwin doesn't allow the stack limit (uname -s) to be changed, though it can be queried. Alter the test so that the stack limit is only changed if it is either unlimited or very large (and skip the tests if ulimit returns an error) --- testsuite/tests/runtime-errors/Makefile | 31 +++++++++++++++++++------ 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/runtime-errors/Makefile b/testsuite/tests/runtime-errors/Makefile index 2c0bed9b6..0046eb433 100644 --- a/testsuite/tests/runtime-errors/Makefile +++ b/testsuite/tests/runtime-errors/Makefile @@ -30,20 +30,37 @@ compile: @grep -q HAS_STACK_OVERFLOW_DETECTION $(TOPDIR)/config/s.h \ || rm -f stackoverflow.native$(EXE) +# Cygwin doesn't allow the stack limit to be changed - the 4096 is +# intended to be larger than the its default stack size. The logic +# causes the test to be skipped if the stacksize cannot be brought +# below this value (uname -s value exits with an error status in Cygwin) .PHONY: run run: - @ulimit -s 1024; \ + @ul=`ulimit -s`; \ + if ( [ "$$ul" = "unlimited" ] || [ $$ul -gt 4096 ] ) ; then \ + ulimit -s 1024 && ul=1 || ul=0 ; \ + else \ + ul=1; \ + fi; \ for f in *.bytecode; do \ printf " ... testing '$$f':"; \ - $(OCAMLRUN) ./$$f >$$f.result 2>&1 || true; \ - DIFF="$(DIFF)" sh $$f.checker \ - && echo " => passed" || echo " => failed"; \ + if [ $$ul -eq 1 ] ; then \ + $(OCAMLRUN) ./$$f >$$f.result 2>&1 || true; \ + DIFF="$(DIFF)" sh $$f.checker \ + && echo " => passed" || echo " => failed"; \ + else \ + echo " => unexpected error"; \ + fi; \ fn=`basename $$f bytecode`native; \ if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then : ; else \ printf " ... testing '$$fn':"; \ - ./$${fn}$(EXE) >$$fn.result 2>&1 || true; \ - DIFF="$(DIFF)" sh $$fn.checker \ - && echo " => passed" || echo " => failed"; \ + if [ $$ul -eq 1 ] ; then \ + ./$${fn}$(EXE) >$$fn.result 2>&1 || true; \ + DIFF="$(DIFF)" sh $$fn.checker \ + && echo " => passed" || echo " => failed"; \ + else \ + echo " => unexpected error"; \ + fi; \ fi; \ done From 81604e76f6b93d93fab817c38c4ce07b88207fac Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 22 Dec 2015 17:53:40 +0000 Subject: [PATCH 103/145] Minor corrections to clean targets --- lex/Makefile.nt | 2 +- otherlibs/win32graph/Makefile.nt | 3 +++ testsuite/tests/lib-dynlink-bytecode/Makefile | 2 +- testsuite/tests/opaque/Makefile | 6 +++--- testsuite/tests/tool-ocamldep-modalias/Makefile | 2 +- tools/Makefile.nt | 2 +- 6 files changed, 10 insertions(+), 7 deletions(-) diff --git a/lex/Makefile.nt b/lex/Makefile.nt index 768887809..508af8c1b 100644 --- a/lex/Makefile.nt +++ b/lex/Makefile.nt @@ -45,7 +45,7 @@ parser.ml parser.mli: parser.mly $(CAMLYACC) $(YACCFLAGS) parser.mly clean:: - rm -f parser.ml parser.mli + rm -f parser.ml parser.mli parser.output beforedepend:: parser.ml parser.mli diff --git a/otherlibs/win32graph/Makefile.nt b/otherlibs/win32graph/Makefile.nt index f09392ed7..8a2e92363 100644 --- a/otherlibs/win32graph/Makefile.nt +++ b/otherlibs/win32graph/Makefile.nt @@ -31,3 +31,6 @@ graphics.cmo: graphics.cmi graphics.cmx: graphics.cmi draw.$(O): libgraph.h open.$(O): libgraph.h + +clean:: partialclean + rm -f graphics.ml graphics.mli diff --git a/testsuite/tests/lib-dynlink-bytecode/Makefile b/testsuite/tests/lib-dynlink-bytecode/Makefile index 28d6f1402..9dd8e6a0f 100644 --- a/testsuite/tests/lib-dynlink-bytecode/Makefile +++ b/testsuite/tests/lib-dynlink-bytecode/Makefile @@ -65,6 +65,6 @@ promote: defaultpromote .PHONY: clean clean: defaultclean - @rm -f main static custom custom.exe *.result marshal.data + @rm -f main static custom custom.exe *.result marshal.data dllplug*.dll include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/opaque/Makefile b/testsuite/tests/opaque/Makefile index 4efc1de8f..f42b0fe72 100644 --- a/testsuite/tests/opaque/Makefile +++ b/testsuite/tests/opaque/Makefile @@ -55,9 +55,9 @@ promote: .PHONY: clean clean: defaultclean - @rm -f *.cmi *.cmx *.o a.out + @rm -f *.cmi *.cmx *.$(O) a.out camlprog.exe @rm -f intf/*.cmi - @rm -f fst/*.cmi fst/*.cmx fst/*.o fst/*.mli - @rm -f snd/*.cmi snd/*.cmx snd/*.o snd/*.mli + @rm -f fst/*.cmi fst/*.cmx fst/*.$(O) fst/*.mli + @rm -f snd/*.cmi snd/*.cmx snd/*.$(O) snd/*.mli include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/tool-ocamldep-modalias/Makefile b/testsuite/tests/tool-ocamldep-modalias/Makefile index c11819930..476a8ace7 100644 --- a/testsuite/tests/tool-ocamldep-modalias/Makefile +++ b/testsuite/tests/tool-ocamldep-modalias/Makefile @@ -67,7 +67,7 @@ compare: $(DEPENDS) done clean: - @rm -f *.cm* *.o *.a $(DEPENDS) $(LINKS) lib.ml *~ *.byt* *.opt* + @rm -f *.cm* *.$(O) *.$(A) $(DEPENDS) $(LINKS) lib.ml *~ *.byt* *.opt* BASEDIR=../.. include $(BASEDIR)/makefiles/Makefile.common diff --git a/tools/Makefile.nt b/tools/Makefile.nt index eceff3025..e748554ae 100644 --- a/tools/Makefile.nt +++ b/tools/Makefile.nt @@ -26,4 +26,4 @@ install:: cp ocamlmktop $(INSTALL_BINDIR)/ocamlmktop$(EXE) clean:: - rm -f ocamlmktop$(EXE) + rm -f ocamlmktop objinfo_helper$(EXE).manifest From 8d00870c39d67107120da9a302cf2d0776b7892b Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 30 Dec 2015 20:07:15 +0000 Subject: [PATCH 104/145] Fix testsuite incorrectly running native tests Warnings tests didn't check `$(BYTECODE_ONLY)` --- testsuite/tests/warnings/Makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/warnings/Makefile b/testsuite/tests/warnings/Makefile index b9c1568eb..a4209668e 100644 --- a/testsuite/tests/warnings/Makefile +++ b/testsuite/tests/warnings/Makefile @@ -15,7 +15,7 @@ FLAGS=-w A run-all: @$(OCAMLC) $(FLAGS) -c deprecated_module.mli - @$(OCAMLOPT) $(FLAGS) -c module_without_cmx.mli + @$(OCAMLC) $(FLAGS) -c module_without_cmx.mli @for file in *.ml; do \ printf " ... testing '$$file':"; \ F="`basename $$file .ml`"; \ @@ -23,13 +23,13 @@ run-all: $(DIFF) $$F.reference $$F.result >/dev/null \ && echo " => passed" || echo " => failed"; \ done; - @for file in *.opt.ml; do \ + @if $(BYTECODE_ONLY); then :; else for file in *.opt.ml; do \ printf " ... testing '$$file' with ocamlopt:"; \ F="`basename $$file .ml`"; \ $(OCAMLOPT) $(FLAGS) -c $$file 2>$$F.opt_result; \ $(DIFF) $$F.opt_reference $$F.opt_result >/dev/null \ && echo " => passed" || echo " => failed"; \ - done; + done fi; promote: defaultpromote From 09c5ded55bedf4ea794a52edb68e104028b620ca Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 5 Jan 2016 18:19:25 +0000 Subject: [PATCH 105/145] Add missing '@' to testsuite Makefiles Various testsuite Makefiles displaying commands, which fog up the log files. --- testsuite/tests/embedded/Makefile | 4 ++-- testsuite/tests/lib-dynlink-native/Makefile | 4 +++- testsuite/tests/no-alias-deps/Makefile | 2 +- testsuite/tests/runtime-errors/Makefile | 4 ++-- 4 files changed, 8 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/embedded/Makefile b/testsuite/tests/embedded/Makefile index 088b02165..0e07f57a2 100644 --- a/testsuite/tests/embedded/Makefile +++ b/testsuite/tests/embedded/Makefile @@ -14,8 +14,8 @@ BASEDIR=../.. .PHONY: default default: - $(MAKE) compile - $(MAKE) run + @$(MAKE) compile + @$(MAKE) run .PHONY: compile compile: diff --git a/testsuite/tests/lib-dynlink-native/Makefile b/testsuite/tests/lib-dynlink-native/Makefile index 803ee5673..77c1aff5a 100644 --- a/testsuite/tests/lib-dynlink-native/Makefile +++ b/testsuite/tests/lib-dynlink-native/Makefile @@ -77,7 +77,7 @@ sub/api.cmx: sub/api.cmi sub/api.ml @cd sub; $(OCAMLOPT) -c api.ml plugin.cmi: plugin.mli - $(OCAMLOPT) -c -opaque plugin.mli + @$(OCAMLOPT) -c -opaque plugin.mli plugin.cmx: api.cmx plugin.cmi sub/plugin.cmx: api.cmx @@ -115,6 +115,8 @@ factorial.$(O): factorial.c promote: @cp result reference +.PRECIOUS: %.cmx + .PHONY: clean clean: defaultclean @rm -f result *.so *.o *.cm* main main_ext *.exe *.s *.asm *.obj diff --git a/testsuite/tests/no-alias-deps/Makefile b/testsuite/tests/no-alias-deps/Makefile index 072505bdc..5076c716e 100644 --- a/testsuite/tests/no-alias-deps/Makefile +++ b/testsuite/tests/no-alias-deps/Makefile @@ -27,7 +27,7 @@ clean: defaultclean @rm -f *.result b.cmi: b.cmi.pre - cp b.cmi.pre b.cmi + @cp b.cmi.pre b.cmi BASEDIR=../.. include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/runtime-errors/Makefile b/testsuite/tests/runtime-errors/Makefile index 0046eb433..976d9a6cd 100644 --- a/testsuite/tests/runtime-errors/Makefile +++ b/testsuite/tests/runtime-errors/Makefile @@ -14,8 +14,8 @@ BASEDIR=../.. .PHONY: default default: - $(MAKE) compile - $(MAKE) run + @$(MAKE) compile + @$(MAKE) run .PHONY: compile compile: From e66d98e23e0a67526a731b7b5556fbb9bd019411 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 6 Jan 2016 00:11:48 +0000 Subject: [PATCH 106/145] Missing reference files in the test suite --- .../legacy_incompatible_flags.ml.reference | 8 +++++ .../tests/typing-gadts/didier.ml.reference | 34 +++++++++++++++++++ testsuite/tests/typing-modules/b.ml.reference | 5 +++ .../tests/typing-modules/b2.ml.reference | 5 +++ testsuite/tests/typing-modules/d.ml.reference | 5 +++ 5 files changed, 57 insertions(+) create mode 100644 testsuite/tests/formats-transition/legacy_incompatible_flags.ml.reference create mode 100644 testsuite/tests/typing-gadts/didier.ml.reference create mode 100644 testsuite/tests/typing-modules/b.ml.reference create mode 100644 testsuite/tests/typing-modules/b2.ml.reference create mode 100644 testsuite/tests/typing-modules/d.ml.reference diff --git a/testsuite/tests/formats-transition/legacy_incompatible_flags.ml.reference b/testsuite/tests/formats-transition/legacy_incompatible_flags.ml.reference new file mode 100644 index 000000000..814a5d33c --- /dev/null +++ b/testsuite/tests/formats-transition/legacy_incompatible_flags.ml.reference @@ -0,0 +1,8 @@ + +# * toto +# toto +# toto +# toto +# "toto" +# toto +# * * * diff --git a/testsuite/tests/typing-gadts/didier.ml.reference b/testsuite/tests/typing-gadts/didier.ml.reference new file mode 100644 index 000000000..295d38bb5 --- /dev/null +++ b/testsuite/tests/typing-gadts/didier.ml.reference @@ -0,0 +1,34 @@ + +# Characters 94-122: + ..match tag with + | Bool -> x +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a value that is not matched: +Int +type 'a ty = Int : int ty | Bool : bool ty +val fbool : 'a -> 'a ty -> 'a = +# Characters 132-163: + ..match tag with + | Int -> x > 0 +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a value that is not matched: +Bool +val fint : 'a -> 'a ty -> bool = +# * * Characters 376-381: + | Int -> x > 0 + ^^^^^ +Error: This expression has type bool but an expression was expected of type + t = int +# Characters 45-47: + let idb1 = (fun id -> let _ = id true in id) id;; + ^^ +Error: Unbound value id +# Characters 26-28: + let idb2 : bool -> bool = id;; + ^^ +Error: Unbound value id +# val idb3 : bool -> bool = +# +Characters 184-184: + Error: Syntax error +# diff --git a/testsuite/tests/typing-modules/b.ml.reference b/testsuite/tests/typing-modules/b.ml.reference new file mode 100644 index 000000000..9faafbf65 --- /dev/null +++ b/testsuite/tests/typing-modules/b.ml.reference @@ -0,0 +1,5 @@ + +# * * * * * +Characters 352-352: + Error: Syntax error +# diff --git a/testsuite/tests/typing-modules/b2.ml.reference b/testsuite/tests/typing-modules/b2.ml.reference new file mode 100644 index 000000000..9b4558624 --- /dev/null +++ b/testsuite/tests/typing-modules/b2.ml.reference @@ -0,0 +1,5 @@ + +# * * +Characters 312-312: + Error: Syntax error +# diff --git a/testsuite/tests/typing-modules/d.ml.reference b/testsuite/tests/typing-modules/d.ml.reference new file mode 100644 index 000000000..06308c781 --- /dev/null +++ b/testsuite/tests/typing-modules/d.ml.reference @@ -0,0 +1,5 @@ + +# +Characters 42-42: + Error: Syntax error +# From b505fc699c9b6c2bc34319d1e656056c92addf1c Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 16 Jan 2016 16:03:23 +0000 Subject: [PATCH 107/145] Improve threading tests on Windows The `CANKILL` testsuite variable is eliminated in favour of testing for `TOOLCHAIN`. tests/lib-threads/signal.ml can be executed under native Windows by means of a wrapper program to send CTRL+C. tests/lib-threads/signal2.ml is not possible under native Windows because Thread.sigmask is not implemented, so the precheck is updated to reflect this, rather than the lack of kill -INT. tests/lib-threads/sockets.ml is re-enabled, since the two MPRs affecting it have been fixed. --- config/Makefile.mingw | 1 - config/Makefile.mingw64 | 1 - config/Makefile.msvc | 1 - config/Makefile.msvc64 | 1 - testsuite/makefiles/Makefile.common | 5 +-- testsuite/makefiles/Makefile.several | 2 +- testsuite/tests/lib-threads/Makefile | 10 ++++++ testsuite/tests/lib-threads/sigint.c | 37 ++++++++++++++++++++ testsuite/tests/lib-threads/signal.precheck | 13 ------- testsuite/tests/lib-threads/signal.runner | 2 +- testsuite/tests/lib-threads/signal2.precheck | 2 +- testsuite/tests/lib-threads/sockets.precheck | 23 ------------ 12 files changed, 51 insertions(+), 47 deletions(-) create mode 100644 testsuite/tests/lib-threads/sigint.c delete mode 100644 testsuite/tests/lib-threads/signal.precheck delete mode 100644 testsuite/tests/lib-threads/sockets.precheck diff --git a/config/Makefile.mingw b/config/Makefile.mingw index 2e4d19d0b..b98fc65ec 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -189,5 +189,4 @@ OTOPDIR=$(WINTOPDIR) CTOPDIR=$(TOPDIR) CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr -CANKILL=false SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 39b0f7f3a..1936dd7c0 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -189,5 +189,4 @@ OTOPDIR=$(WINTOPDIR) CTOPDIR=$(TOPDIR) CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr -CANKILL=false SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff --git a/config/Makefile.msvc b/config/Makefile.msvc index b9f53e755..5d93bacb6 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -191,7 +191,6 @@ OTOPDIR=$(WINTOPDIR) CTOPDIR=$(WINTOPDIR) CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr -CANKILL=false FIND=/usr/bin/find SORT=/usr/bin/sort SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index 3ab556493..ae2895be7 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -195,7 +195,6 @@ OTOPDIR=$(WINTOPDIR) CTOPDIR=$(WINTOPDIR) CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr -CANKILL=false FIND=/usr/bin/find SORT=/usr/bin/sort SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common index fb439201e..7f3d8a0f7 100644 --- a/testsuite/makefiles/Makefile.common +++ b/testsuite/makefiles/Makefile.common @@ -20,7 +20,6 @@ OTOPDIR=$(TOPDIR) CTOPDIR=$(TOPDIR) CYGPATH=echo DIFF=diff -q -CANKILL=true SORT=sort SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)" @@ -32,8 +31,6 @@ SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)" # CYGPATH is the command that translates unix-style file names into # whichever syntax is appropriate for arguments of OCaml programs. # DIFF is a "diff -q" command that ignores trailing CRs under Windows. -# CANKILL is true if a script launched by Make can kill an OCaml process, -# and false for the mingw and MSVC ports. # SORT is the Unix "sort" command. Usually a simple command, but may be an # absolute name if the Windows "sort" command is in the PATH. # SET_LD_PATH is a command prefix that sets the path for dynamic libraries @@ -84,7 +81,7 @@ defaultpromote: done defaultclean: - @rm -f *.cmo *.cmi *.cmx *.cma *.cmxa *.cmxs *.$(O) *.$(SO) *.$(A) + @rm -f *.cmo *.cmi *.cmx *.cma *.cmxa *.cmxs *.$(O) *.$(SO) *.$(A) *.exe @for dsym in *.dSYM; do \ if [ -d $$dsym ]; then \ rm -fr $$dsym; \ diff --git a/testsuite/makefiles/Makefile.several b/testsuite/makefiles/Makefile.several index ce629ad71..1a4ab1aa2 100644 --- a/testsuite/makefiles/Makefile.several +++ b/testsuite/makefiles/Makefile.several @@ -43,7 +43,7 @@ run-all: done; @for file in *.ml; do \ if [ -f `basename $$file ml`precheck ]; then \ - CANKILL=$(CANKILL) sh `basename $$file ml`precheck || continue; \ + TOOLCHAIN=$(TOOLCHAIN) sh `basename $$file ml`precheck || continue; \ fi; \ printf " ... testing '$$file':"; \ $(MAKE) run-file DESC=ocamlc COMP='$(OCAMLC)' \ diff --git a/testsuite/tests/lib-threads/Makefile b/testsuite/tests/lib-threads/Makefile index fc098713f..a55ee0ebf 100644 --- a/testsuite/tests/lib-threads/Makefile +++ b/testsuite/tests/lib-threads/Makefile @@ -16,5 +16,15 @@ ADD_COMPFLAGS=-thread -I $(OTOPDIR)/otherlibs/systhreads \ -I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix LD_PATH=$(TOPDIR)/otherlibs/systhreads:$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix +default: + @$(if $(filter msvc mingw,$(TOOLCHAIN)),$(MAKE) sigint.exe,true) + @$(SET_LD_PATH) $(MAKE) run-all + include $(BASEDIR)/makefiles/Makefile.several include $(BASEDIR)/makefiles/Makefile.common + +sigint.exe: sigint.$(O) + @$(CC) $(if $(filter msvc,$(CCOMPTYPE)),/Fe$@,-o $@) $^ + +%.obj: %.c + @$(CC) -c $*.c > /dev/null diff --git a/testsuite/tests/lib-threads/sigint.c b/testsuite/tests/lib-threads/sigint.c new file mode 100644 index 000000000..89536fd32 --- /dev/null +++ b/testsuite/tests/lib-threads/sigint.c @@ -0,0 +1,37 @@ +#include +#include + +int main(int argc, char** argv) +{ + DWORD pid; + HANDLE hProcess; + + if (argc != 2) { + printf("Usage: %s pid\n", argv[0]); + return 1; + } + + pid = atoi(argv[1]); + hProcess = OpenProcess(SYNCHRONIZE, FALSE, pid); + + if (!hProcess) { + printf("Process %d not found!\n", pid); + return 1; + } + + FreeConsole(); + + if (!AttachConsole(pid)) { + printf("Failed to attach to console of Process %d\n", pid); + CloseHandle(hProcess); + return 1; + } + + SetConsoleCtrlHandler(NULL, TRUE); + GenerateConsoleCtrlEvent(0, 0); + WaitForSingleObject(hProcess, INFINITE); + CloseHandle(hProcess); + FreeConsole(); + + return 0; +} diff --git a/testsuite/tests/lib-threads/signal.precheck b/testsuite/tests/lib-threads/signal.precheck deleted file mode 100644 index aa357092a..000000000 --- a/testsuite/tests/lib-threads/signal.precheck +++ /dev/null @@ -1,13 +0,0 @@ -######################################################################### -# # -# OCaml # -# # -# Damien Doligez, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2013 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -$CANKILL diff --git a/testsuite/tests/lib-threads/signal.runner b/testsuite/tests/lib-threads/signal.runner index eec95bcce..3be86d1fe 100644 --- a/testsuite/tests/lib-threads/signal.runner +++ b/testsuite/tests/lib-threads/signal.runner @@ -13,4 +13,4 @@ $RUNTIME ./program >signal.result & pid=$! sleep 2 -kill -INT $pid +test -e ./sigint.exe && ./sigint $pid || kill -INT $pid diff --git a/testsuite/tests/lib-threads/signal2.precheck b/testsuite/tests/lib-threads/signal2.precheck index aa357092a..b4532ac0a 100644 --- a/testsuite/tests/lib-threads/signal2.precheck +++ b/testsuite/tests/lib-threads/signal2.precheck @@ -10,4 +10,4 @@ # # ######################################################################### -$CANKILL +test "$TOOLCHAIN" != "msvc" -a "$TOOLCHAIN" != "mingw" diff --git a/testsuite/tests/lib-threads/sockets.precheck b/testsuite/tests/lib-threads/sockets.precheck deleted file mode 100644 index 6d41158ef..000000000 --- a/testsuite/tests/lib-threads/sockets.precheck +++ /dev/null @@ -1,23 +0,0 @@ -######################################################################### -# # -# OCaml # -# # -# Damien Doligez, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2013 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - - -########################################## -########################################## -#### TEMPORARY #### -########################################## -########################################## - -# disable this test on Windows non-cygwin ports until we decide -# how to fix PR#5325 and PR#5578 - -$CANKILL From d6ea706a0212a8b4d6f51893764f5d188c8c4b49 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Thu, 14 Jan 2016 18:24:14 +0100 Subject: [PATCH 108/145] Add handling of OCAMLPARAM as a file --- driver/compenv.ml | 137 +++++++++++++++++++++++++++++++++++++-------- driver/compenv.mli | 4 +- driver/optmain.ml | 6 +- 3 files changed, 119 insertions(+), 28 deletions(-) diff --git a/driver/compenv.ml b/driver/compenv.ml index 8d6ed2a82..b70a5748d 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -93,9 +93,10 @@ let module_of_filename ppf inputfile outputprefix = name ;; +type filename = string type readenv_position = - Before_args | Before_compile | Before_link + Before_args | Before_compile of filename | Before_link (* Syntax of OCAMLPARAM: (name=VALUE,)* _ (,name=VALUE)* where VALUE should not contain ',' *) @@ -142,20 +143,9 @@ let setter ppf f name options s = because they are not understood by some versions of OCaml. *) let can_discard = ref [] -let read_OCAMLPARAM ppf position = - try - let s = Sys.getenv "OCAMLPARAM" in - let (before, after) = - try - parse_args s - with SyntaxError s -> - Location.print_warning Location.none ppf - (Warnings.Bad_env_variable ("OCAMLPARAM", s)); - [],[] - in - let set name options s = setter ppf (fun b -> b) name options s in - let clear name options s = setter ppf (fun b -> not b) name options s in - List.iter (fun (name, v) -> +let read_one_param ppf position name v = + let set name options s = setter ppf (fun b -> b) name options s in + let clear name options s = setter ppf (fun b -> not b) name options s in match name with | "g" -> set "g" [ Clflags.debug ] v | "p" -> set "p" [ Clflags.gprofile ] v @@ -235,14 +225,14 @@ let read_OCAMLPARAM ppf position = | "I" -> begin match position with | Before_args -> first_include_dirs := v :: !first_include_dirs - | Before_link | Before_compile -> + | Before_link | Before_compile _ -> last_include_dirs := v :: !last_include_dirs end | "cclib" -> begin match position with - | Before_compile -> () + | Before_compile _ -> () | Before_link | Before_args -> ccobjs := Misc.rev_split_words v @ !ccobjs end @@ -250,7 +240,7 @@ let read_OCAMLPARAM ppf position = | "ccopts" -> begin match position with - | Before_link | Before_compile -> + | Before_link | Before_compile _ -> last_ccopts := v :: !last_ccopts | Before_args -> first_ccopts := v :: !first_ccopts @@ -259,7 +249,7 @@ let read_OCAMLPARAM ppf position = | "ppx" -> begin match position with - | Before_link | Before_compile -> + | Before_link | Before_compile _ -> last_ppx := v :: !last_ppx | Before_args -> first_ppx := v :: !first_ppx @@ -270,7 +260,7 @@ let read_OCAMLPARAM ppf position = if not !native_code then begin match position with - | Before_link | Before_compile -> + | Before_link | Before_compile _ -> last_objfiles := v ::! last_objfiles | Before_args -> first_objfiles := v :: !first_objfiles @@ -280,7 +270,7 @@ let read_OCAMLPARAM ppf position = if !native_code then begin match position with - | Before_link | Before_compile -> + | Before_link | Before_compile _ -> last_objfiles := v ::! last_objfiles | Before_args -> first_objfiles := v :: !first_objfiles @@ -302,16 +292,115 @@ let read_OCAMLPARAM ppf position = "Warning: discarding value of variable %S in OCAMLPARAM\n%!" name end - ) (match position with - Before_args -> before - | Before_compile | Before_link -> after) + +let read_OCAMLPARAM ppf position = + try + let s = Sys.getenv "OCAMLPARAM" in + let (before, after) = + try + parse_args s + with SyntaxError s -> + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable ("OCAMLPARAM", s)); + [],[] + in + List.iter (fun (name, v) -> read_one_param ppf position name v) + (match position with + Before_args -> before + | Before_compile _ | Before_link -> after) with Not_found -> () +(* OCAMLPARAM passed as file *) + +type pattern = + | Filename of string + | Any + +type file_option = { + pattern : pattern; + name : string; + value : string; +} + +let scan_line ic = + Scanf.bscanf ic "%[0-9a-zA-Z_.*] : %[a-zA-Z_-] = %s " + (fun pattern name value -> + let pattern = + match pattern with + | "*" -> Any + | _ -> Filename pattern + in + { pattern; name; value }) + +let load_config ppf filename = + match open_in_bin filename with + | exception e -> + Location.print_error ppf (Location.in_file filename); + Format.fprintf ppf "Cannot open file %s@." (Printexc.to_string e); + raise Exit + | ic -> + let sic = Scanf.Scanning.from_channel ic in + let rec read line_number line_start acc = + match scan_line sic with + | exception End_of_file -> + close_in ic; + acc + | exception Scanf.Scan_failure error -> + let position = Lexing.{ + pos_fname = filename; + pos_lnum = line_number; + pos_bol = line_start; + pos_cnum = pos_in ic; + } + in + let loc = Location.{ + loc_start = position; + loc_end = position; + loc_ghost = false; + } + in + Location.print_error ppf loc; + Format.fprintf ppf "Configuration file error %s@." error; + close_in ic; + raise Exit + | line -> + read (line_number + 1) (pos_in ic) (line :: acc) + in + let lines = read 0 0 [] in + lines + +let matching_filename filename { pattern } = + match pattern with + | Any -> true + | Filename pattern -> + let filename = String.lowercase_ascii filename in + let pattern = String.lowercase_ascii pattern in + filename = pattern + +let apply_config_file ppf position = + let config_file = Filename.concat Config.standard_library "compiler_configuration" in + let config = + if Sys.file_exists config_file then + load_config ppf config_file + else + [] + in + let config = + match position with + | Before_compile filename -> + List.filter (matching_filename filename) config + | Before_args | Before_link -> + List.filter (fun { pattern } -> pattern = Any) config + in + List.iter (fun { name; value } -> read_one_param ppf position name value) + config + let readenv ppf position = last_include_dirs := []; last_ccopts := []; last_ppx := []; last_objfiles := []; + apply_config_file ppf position; read_OCAMLPARAM ppf position; all_ccopts := !last_ccopts @ !first_ccopts; all_ppx := !last_ppx @ !first_ppx diff --git a/driver/compenv.mli b/driver/compenv.mli index 59cd10124..a7aeb1b4e 100644 --- a/driver/compenv.mli +++ b/driver/compenv.mli @@ -30,8 +30,10 @@ val implicit_modules : string list ref (* return the list of objfiles, after OCAMLPARAM and List.rev *) val get_objfiles : unit -> string list +type filename = string + type readenv_position = - Before_args | Before_compile | Before_link + Before_args | Before_compile of filename | Before_link val readenv : Format.formatter -> readenv_position -> unit diff --git a/driver/optmain.ml b/driver/optmain.ml index 2e921d063..47c6bdc5c 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -56,11 +56,11 @@ let ppf = Format.err_formatter (* Error messages to standard error formatter *) let anonymous filename = - readenv ppf Before_compile; process_file ppf filename;; + readenv ppf (Before_compile filename); process_file ppf filename;; let impl filename = - readenv ppf Before_compile; process_implementation_file ppf filename;; + readenv ppf (Before_compile filename); process_implementation_file ppf filename;; let intf filename = - readenv ppf Before_compile; process_interface_file ppf filename;; + readenv ppf (Before_compile filename); process_interface_file ppf filename;; let show_config () = Config.print_config stdout; From 5b2d1e7d5d1854f19c8fd262a6adb68173b8dcdf Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Thu, 14 Jan 2016 18:20:35 +0100 Subject: [PATCH 109/145] Reindent compenv --- driver/compenv.ml | 256 +++++++++++++++++++++++----------------------- 1 file changed, 128 insertions(+), 128 deletions(-) diff --git a/driver/compenv.ml b/driver/compenv.ml index b70a5748d..b8cf96680 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -146,152 +146,152 @@ let can_discard = ref [] let read_one_param ppf position name v = let set name options s = setter ppf (fun b -> b) name options s in let clear name options s = setter ppf (fun b -> not b) name options s in - match name with - | "g" -> set "g" [ Clflags.debug ] v - | "p" -> set "p" [ Clflags.gprofile ] v - | "bin-annot" -> set "bin-annot" [ Clflags.binary_annotations ] v - | "annot" -> set "annot" [ Clflags.annotations ] v - | "absname" -> set "absname" [ Location.absname ] v - | "compat-32" -> set "compat-32" [ bytecode_compatible_32 ] v - | "noassert" -> set "noassert" [ noassert ] v - | "noautolink" -> set "noautolink" [ no_auto_link ] v - | "nostdlib" -> set "nostdlib" [ no_std_include ] v - | "linkall" -> set "linkall" [ link_everything ] v - | "nolabels" -> set "nolabels" [ classic ] v - | "principal" -> set "principal" [ principal ] v - | "rectypes" -> set "rectypes" [ recursive_types ] v - | "safe-string" -> clear "safe-string" [ unsafe_string ] v - | "strict-sequence" -> set "strict-sequence" [ strict_sequence ] v - | "strict-formats" -> set "strict-formats" [ strict_formats ] v - | "thread" -> set "thread" [ use_threads ] v - | "unsafe" -> set "unsafe" [ fast ] v - | "verbose" -> set "verbose" [ verbose ] v - | "nopervasives" -> set "nopervasives" [ nopervasives ] v - | "slash" -> set "slash" [ force_slash ] v (* for ocamldep *) - | "keep-docs" -> set "keep-docs" [ Clflags.keep_docs ] v - | "keep-locs" -> set "keep-locs" [ Clflags.keep_locs ] v + match name with + | "g" -> set "g" [ Clflags.debug ] v + | "p" -> set "p" [ Clflags.gprofile ] v + | "bin-annot" -> set "bin-annot" [ Clflags.binary_annotations ] v + | "annot" -> set "annot" [ Clflags.annotations ] v + | "absname" -> set "absname" [ Location.absname ] v + | "compat-32" -> set "compat-32" [ bytecode_compatible_32 ] v + | "noassert" -> set "noassert" [ noassert ] v + | "noautolink" -> set "noautolink" [ no_auto_link ] v + | "nostdlib" -> set "nostdlib" [ no_std_include ] v + | "linkall" -> set "linkall" [ link_everything ] v + | "nolabels" -> set "nolabels" [ classic ] v + | "principal" -> set "principal" [ principal ] v + | "rectypes" -> set "rectypes" [ recursive_types ] v + | "safe-string" -> clear "safe-string" [ unsafe_string ] v + | "strict-sequence" -> set "strict-sequence" [ strict_sequence ] v + | "strict-formats" -> set "strict-formats" [ strict_formats ] v + | "thread" -> set "thread" [ use_threads ] v + | "unsafe" -> set "unsafe" [ fast ] v + | "verbose" -> set "verbose" [ verbose ] v + | "nopervasives" -> set "nopervasives" [ nopervasives ] v + | "slash" -> set "slash" [ force_slash ] v (* for ocamldep *) + | "keep-docs" -> set "keep-docs" [ Clflags.keep_docs ] v + | "keep-locs" -> set "keep-locs" [ Clflags.keep_locs ] v - | "compact" -> clear "compact" [ optimize_for_speed ] v - | "no-app-funct" -> clear "no-app-funct" [ applicative_functors ] v - | "nodynlink" -> clear "nodynlink" [ dlcode ] v - | "short-paths" -> clear "short-paths" [ real_paths ] v - | "trans-mod" -> set "trans-mod" [ transparent_modules ] v - | "opaque" -> set "opaque" [ opaque ] v + | "compact" -> clear "compact" [ optimize_for_speed ] v + | "no-app-funct" -> clear "no-app-funct" [ applicative_functors ] v + | "nodynlink" -> clear "nodynlink" [ dlcode ] v + | "short-paths" -> clear "short-paths" [ real_paths ] v + | "trans-mod" -> set "trans-mod" [ transparent_modules ] v + | "opaque" -> set "opaque" [ opaque ] v - | "pp" -> preprocessor := Some v - | "runtime-variant" -> runtime_variant := v - | "cc" -> c_compiler := Some v + | "pp" -> preprocessor := Some v + | "runtime-variant" -> runtime_variant := v + | "cc" -> c_compiler := Some v - (* assembly sources *) - | "s" -> - set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v - | "S" -> set "S" [ Clflags.keep_asm_file ] v - | "dstartup" -> set "dstartup" [ Clflags.keep_startup_file ] v + (* assembly sources *) + | "s" -> + set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v + | "S" -> set "S" [ Clflags.keep_asm_file ] v + | "dstartup" -> set "dstartup" [ Clflags.keep_startup_file ] v - (* warn-errors *) - | "we" | "warn-error" -> Warnings.parse_options true v - (* warnings *) - | "w" -> Warnings.parse_options false v - (* warn-errors *) - | "wwe" -> Warnings.parse_options false v + (* warn-errors *) + | "we" | "warn-error" -> Warnings.parse_options true v + (* warnings *) + | "w" -> Warnings.parse_options false v + (* warn-errors *) + | "wwe" -> Warnings.parse_options false v - (* inlining *) - | "inline" -> - let module F = Float_arg_helper in - begin match F.parse_no_error v inline_threshold with - | F.Ok -> () - | F.Parse_failed exn -> - let error = - Printf.sprintf "bad syntax for \"inline\": %s" - (Printexc.to_string exn) - in - Location.print_warning Location.none ppf - (Warnings.Bad_env_variable ("OCAMLPARAM", error)) - end + (* inlining *) + | "inline" -> + let module F = Float_arg_helper in + begin match F.parse_no_error v inline_threshold with + | F.Ok -> () + | F.Parse_failed exn -> + let error = + Printf.sprintf "bad syntax for \"inline\": %s" + (Printexc.to_string exn) + in + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable ("OCAMLPARAM", error)) + end - (* color output *) - | "color" -> - begin match parse_color_setting v with - | None -> - Location.print_warning Location.none ppf - (Warnings.Bad_env_variable ("OCAMLPARAM", - "bad value for \"color\", \ - (expected \"auto\", \"always\" or \"never\")")) - | Some setting -> color := setting - end + (* color output *) + | "color" -> + begin match parse_color_setting v with + | None -> + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable ("OCAMLPARAM", + "bad value for \"color\", \ + (expected \"auto\", \"always\" or \"never\")")) + | Some setting -> color := setting + end - | "intf-suffix" -> Config.interface_suffix := v + | "intf-suffix" -> Config.interface_suffix := v - | "I" -> begin - match position with - | Before_args -> first_include_dirs := v :: !first_include_dirs - | Before_link | Before_compile _ -> - last_include_dirs := v :: !last_include_dirs - end + | "I" -> begin + match position with + | Before_args -> first_include_dirs := v :: !first_include_dirs + | Before_link | Before_compile _ -> + last_include_dirs := v :: !last_include_dirs + end - | "cclib" -> - begin - match position with - | Before_compile _ -> () - | Before_link | Before_args -> - ccobjs := Misc.rev_split_words v @ !ccobjs - end + | "cclib" -> + begin + match position with + | Before_compile _ -> () + | Before_link | Before_args -> + ccobjs := Misc.rev_split_words v @ !ccobjs + end - | "ccopts" -> - begin - match position with - | Before_link | Before_compile _ -> - last_ccopts := v :: !last_ccopts - | Before_args -> - first_ccopts := v :: !first_ccopts - end + | "ccopts" -> + begin + match position with + | Before_link | Before_compile _ -> + last_ccopts := v :: !last_ccopts + | Before_args -> + first_ccopts := v :: !first_ccopts + end - | "ppx" -> - begin - match position with - | Before_link | Before_compile _ -> - last_ppx := v :: !last_ppx - | Before_args -> - first_ppx := v :: !first_ppx - end + | "ppx" -> + begin + match position with + | Before_link | Before_compile _ -> + last_ppx := v :: !last_ppx + | Before_args -> + first_ppx := v :: !first_ppx + end - | "cmo" | "cma" -> - if not !native_code then - begin - match position with - | Before_link | Before_compile _ -> - last_objfiles := v ::! last_objfiles - | Before_args -> - first_objfiles := v :: !first_objfiles - end + | "cmo" | "cma" -> + if not !native_code then + begin + match position with + | Before_link | Before_compile _ -> + last_objfiles := v ::! last_objfiles + | Before_args -> + first_objfiles := v :: !first_objfiles + end - | "cmx" | "cmxa" -> - if !native_code then - begin - match position with - | Before_link | Before_compile _ -> - last_objfiles := v ::! last_objfiles - | Before_args -> - first_objfiles := v :: !first_objfiles - end + | "cmx" | "cmxa" -> + if !native_code then + begin + match position with + | Before_link | Before_compile _ -> + last_objfiles := v ::! last_objfiles + | Before_args -> + first_objfiles := v :: !first_objfiles + end - | "pic" -> - if !native_code then - set "pic" [ pic_code ] v + | "pic" -> + if !native_code then + set "pic" [ pic_code ] v - | "can-discard" -> - can_discard := v ::!can_discard + | "can-discard" -> + can_discard := v ::!can_discard - | "timings" -> set "timings" [ print_timings ] v + | "timings" -> set "timings" [ print_timings ] v - | _ -> - if not (List.mem name !can_discard) then begin - can_discard := name :: !can_discard; - Printf.eprintf - "Warning: discarding value of variable %S in OCAMLPARAM\n%!" - name - end + | _ -> + if not (List.mem name !can_discard) then begin + can_discard := name :: !can_discard; + Printf.eprintf + "Warning: discarding value of variable %S in OCAMLPARAM\n%!" + name + end let read_OCAMLPARAM ppf position = try From 2555c4e773aa0fa32a478674c4ad7dfe2213fdf0 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Thu, 14 Jan 2016 19:22:41 +0100 Subject: [PATCH 110/145] Update main and ocamldep --- driver/main.ml | 6 +++--- tools/ocamldep.ml | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/driver/main.ml b/driver/main.ml index 50ef9748e..228d691ac 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -54,11 +54,11 @@ let ppf = Format.err_formatter (* Error messages to standard error formatter *) let anonymous filename = - readenv ppf Before_compile; process_file ppf filename;; + readenv ppf (Before_compile filename); process_file ppf filename;; let impl filename = - readenv ppf Before_compile; process_implementation_file ppf filename;; + readenv ppf (Before_compile filename); process_implementation_file ppf filename;; let intf filename = - readenv ppf Before_compile; process_interface_file ppf filename;; + readenv ppf (Before_compile filename); process_interface_file ppf filename;; let show_config () = Config.print_config stdout; diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml index 1c9320822..522ba4ed1 100644 --- a/tools/ocamldep.ml +++ b/tools/ocamldep.ml @@ -367,7 +367,7 @@ let mli_file_dependencies source_file = end let process_file_as process_fun def source_file = - Compenv.readenv ppf Before_compile; + Compenv.readenv ppf (Before_compile source_file); load_path := []; List.iter add_to_load_path ( (!Compenv.last_include_dirs @ From ab2e736358a8d6f0d8d8d3d76038dd5da72a39cf Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Thu, 21 Jan 2016 15:12:53 +0100 Subject: [PATCH 111/145] Rename compiler_configuration file Renamed to ocaml_compiler_internal_params. --- driver/compenv.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/driver/compenv.ml b/driver/compenv.ml index b8cf96680..e94372754 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -378,7 +378,9 @@ let matching_filename filename { pattern } = filename = pattern let apply_config_file ppf position = - let config_file = Filename.concat Config.standard_library "compiler_configuration" in + let config_file = + Filename.concat Config.standard_library "ocaml_compiler_internal_params" + in let config = if Sys.file_exists config_file then load_config ppf config_file From d9337d856de05f5203ef6887fc4b077fe0657a5f Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Thu, 21 Jan 2016 14:29:42 +0000 Subject: [PATCH 112/145] Better type error location in presence of constraints --- Changes | 2 ++ .../tests/typing-gadts/pr6690.ml.reference | 10 +++---- .../typing-gadts/test.ml.principal.reference | 4 +-- .../tests/typing-gadts/test.ml.reference | 4 +-- typing/typecore.ml | 27 ++++++++++++++++--- 5 files changed, 34 insertions(+), 13 deletions(-) diff --git a/Changes b/Changes index 7a6e92a86..e91821d67 100644 --- a/Changes +++ b/Changes @@ -457,6 +457,8 @@ Bug fixes: (Jérémie Dimino, Thomas Refis) - GPR#405: fix compilation under Visual Studio 2015 (David Allsopp) +- GPR#441: better type error location in presence of type constraints + (Thomas Refis, report by Arseniy Alekseyev) Features wishes: - PR#4518, GPR#29: change location format for reporting errors in ocamldoc diff --git a/testsuite/tests/typing-gadts/pr6690.ml.reference b/testsuite/tests/typing-gadts/pr6690.ml.reference index 3f435f67b..06db19675 100644 --- a/testsuite/tests/typing-gadts/pr6690.ml.reference +++ b/testsuite/tests/typing-gadts/pr6690.ml.reference @@ -5,18 +5,16 @@ type 'a local_visit_action type ('a, 'result, 'visit_action) context = Local : ('a, 'a * insert, 'a local_visit_action) context | Global : ('a, 'a, 'a visit_action) context -# Characters 11-166: - ..........(type visit_action) - : (_, _, visit_action) context -> _ -> visit_action = +# Characters 35-166: + ....: (_, _, visit_action) context -> _ -> visit_action = function | Local -> fun _ -> raise Exit | Global -> fun _ -> raise Exit Error: This expression has type ($0, $0 * insert, 'a) context -> 'b -> 'a but an expression was expected of type 'c The type constructor $0 would escape its scope -# Characters 11-174: - ..........(type visit_action) - : ('a, 'result, visit_action) context -> 'a -> visit_action = +# Characters 35-174: + ....: ('a, 'result, visit_action) context -> 'a -> visit_action = function | Local -> fun _ -> raise Exit | Global -> fun _ -> raise Exit diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference index 262eb0042..b69bb6b67 100644 --- a/testsuite/tests/typing-gadts/test.ml.principal.reference +++ b/testsuite/tests/typing-gadts/test.ml.principal.reference @@ -360,9 +360,9 @@ Error: This expression has type t = < foo : int; .. > but an expression was expected of type < bar : int; foo : int > Type $0 = < bar : int; .. > is not compatible with type < bar : int > The first object type has an abstract row, it cannot be closed -# Characters 98-99: +# Characters 97-121: (x:) - ^ + ^^^^^^^^^^^^^^^^^^^^^^^^ Error: This expression has type < bar : int; foo : int; .. > but an expression was expected of type 'a The type constructor $1 would escape its scope diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference index af8b63526..2ef37155a 100644 --- a/testsuite/tests/typing-gadts/test.ml.reference +++ b/testsuite/tests/typing-gadts/test.ml.reference @@ -347,9 +347,9 @@ Error: This expression has type t = < foo : int; .. > but an expression was expected of type < bar : int; foo : int > Type $0 = < bar : int; .. > is not compatible with type < bar : int > The first object type has an abstract row, it cannot be closed -# Characters 98-99: +# Characters 97-121: (x:) - ^ + ^^^^^^^^^^^^^^^^^^^^^^^^ Error: This expression has type < bar : int; foo : int; .. > but an expression was expected of type 'a The type constructor $1 would escape its scope diff --git a/typing/typecore.ml b/typing/typecore.ml index 565c46907..5853fab9e 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -1866,12 +1866,33 @@ let duplicate_ident_types loc caselist env = to keep the same internal 'slot' to track unused opens. *) List.fold_left (fun env s -> Env.update_value s upd env) env idents + +(* Getting proper location of already typed expressions. + + Used to avoid confusing locations on type error messages in presence of + type constraints. + For example: + + (* Before patch *) + # let x : string = (5 : int);; + ^ + (* After patch *) + # let x : string = (5 : int);; + ^^^^^^^^^ +*) +let proper_exp_loc exp = + let rec aux = function + | [] -> exp.exp_loc + | ((Texp_constraint _ | Texp_coerce _), loc, _) :: _ -> loc + | _ :: rest -> aux rest + in + aux exp.exp_extra + (* Typing of expressions *) let unify_exp env exp expected_ty = - (* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type - Printtyp.raw_type_expr expected_ty; *) - unify_exp_types exp.exp_loc env exp.exp_type expected_ty + let loc = proper_exp_loc exp in + unify_exp_types loc env exp.exp_type expected_ty let rec type_exp ?recarg env sexp = (* We now delegate everything to type_expect *) From ebd1a90dcd71e4e561eeb4187e6c2f7f122897aa Mon Sep 17 00:00:00 2001 From: Leo White Date: Tue, 26 Jan 2016 11:26:40 +0000 Subject: [PATCH 113/145] Update .depends --- .depend | 89 +++++++++++++++++++++++++++++++++------------------------ 1 file changed, 51 insertions(+), 38 deletions(-) diff --git a/.depend b/.depend index 0267f62bf..f2c604aac 100644 --- a/.depend +++ b/.depend @@ -386,7 +386,8 @@ typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \ parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \ utils/clflags.cmi typing/btype.cmi parsing/attr_helper.cmi \ - parsing/asttypes.cmi parsing/ast_helper.cmi typing/typedecl.cmi + parsing/asttypes.cmi parsing/ast_mapper.cmi parsing/ast_helper.cmi \ + typing/typedecl.cmi typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \ typing/subst.cmx typing/printtyp.cmx typing/primitive.cmx \ @@ -394,7 +395,8 @@ typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \ utils/clflags.cmx typing/btype.cmx parsing/attr_helper.cmx \ - parsing/asttypes.cmi parsing/ast_helper.cmx typing/typedecl.cmi + parsing/asttypes.cmi parsing/ast_mapper.cmx parsing/ast_helper.cmx \ + typing/typedecl.cmi typing/typedtreeIter.cmo : typing/typedtree.cmi utils/misc.cmi \ parsing/asttypes.cmi typing/typedtreeIter.cmi typing/typedtreeIter.cmx : typing/typedtree.cmx utils/misc.cmx \ @@ -692,8 +694,11 @@ asmcomp/cmm.cmi : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/cmx_format.cmi : asmcomp/clambda.cmi asmcomp/coloring.cmi : asmcomp/comballoc.cmi : asmcomp/mach.cmi -asmcomp/compilenv.cmi : utils/timings.cmi typing/ident.cmi \ - asmcomp/cmx_format.cmi asmcomp/clambda.cmi +asmcomp/compilenv.cmi : utils/timings.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/set_of_closures_id.cmi typing/ident.cmi \ + middle_end/flambda.cmi asmcomp/export_info.cmi \ + middle_end/base_types/compilation_unit.cmi asmcomp/cmx_format.cmi \ + middle_end/base_types/closure_id.cmi asmcomp/clambda.cmi asmcomp/CSEgen.cmi : asmcomp/mach.cmi asmcomp/deadcode.cmi : asmcomp/mach.cmi asmcomp/emitaux.cmi : bytecomp/debuginfo.cmi @@ -704,8 +709,8 @@ asmcomp/export_info.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ middle_end/simple_value_approx.cmi \ - middle_end/base_types/set_of_closures_id.cmi typing/ident.cmi \ - middle_end/flambda.cmi middle_end/base_types/export_id.cmi \ + middle_end/base_types/set_of_closures_id.cmi middle_end/flambda.cmi \ + middle_end/base_types/export_id.cmi \ middle_end/base_types/compilation_unit.cmi \ middle_end/base_types/closure_id.cmi asmcomp/flambda_to_clambda.cmi : middle_end/base_types/symbol.cmi \ @@ -804,22 +809,22 @@ asmcomp/build_export_info.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ middle_end/base_types/set_of_closures_id.cmi utils/misc.cmi \ - middle_end/invariant_params.cmi typing/ident.cmi \ - middle_end/flambda_utils.cmi middle_end/flambda.cmi \ - asmcomp/export_info.cmi middle_end/base_types/export_id.cmi \ - asmcomp/compilenv.cmi middle_end/base_types/closure_id.cmi \ - utils/clflags.cmi middle_end/backend_intf.cmi \ - middle_end/allocated_const.cmi asmcomp/build_export_info.cmi + middle_end/invariant_params.cmi middle_end/flambda_utils.cmi \ + middle_end/flambda.cmi asmcomp/export_info.cmi \ + middle_end/base_types/export_id.cmi asmcomp/compilenv.cmi \ + middle_end/base_types/closure_id.cmi utils/clflags.cmi \ + middle_end/backend_intf.cmi middle_end/allocated_const.cmi \ + asmcomp/build_export_info.cmi asmcomp/build_export_info.cmx : middle_end/base_types/variable.cmx \ middle_end/base_types/var_within_closure.cmx \ middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ middle_end/base_types/set_of_closures_id.cmx utils/misc.cmx \ - middle_end/invariant_params.cmx typing/ident.cmx \ - middle_end/flambda_utils.cmx middle_end/flambda.cmx \ - asmcomp/export_info.cmx middle_end/base_types/export_id.cmx \ - asmcomp/compilenv.cmx middle_end/base_types/closure_id.cmx \ - utils/clflags.cmx middle_end/backend_intf.cmi \ - middle_end/allocated_const.cmx asmcomp/build_export_info.cmi + middle_end/invariant_params.cmx middle_end/flambda_utils.cmx \ + middle_end/flambda.cmx asmcomp/export_info.cmx \ + middle_end/base_types/export_id.cmx asmcomp/compilenv.cmx \ + middle_end/base_types/closure_id.cmx utils/clflags.cmx \ + middle_end/backend_intf.cmi middle_end/allocated_const.cmx \ + asmcomp/build_export_info.cmi asmcomp/clambda.cmo : bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/clambda.cmi asmcomp/clambda.cmx : bytecomp/lambda.cmx typing/ident.cmx \ @@ -870,12 +875,20 @@ asmcomp/comballoc.cmo : asmcomp/reg.cmi asmcomp/mach.cmi utils/config.cmi \ asmcomp/arch.cmo asmcomp/comballoc.cmi asmcomp/comballoc.cmx : asmcomp/reg.cmx asmcomp/mach.cmx utils/config.cmx \ asmcomp/arch.cmx asmcomp/comballoc.cmi -asmcomp/compilenv.cmo : utils/warnings.cmi utils/misc.cmi \ - parsing/location.cmi typing/ident.cmi typing/env.cmi utils/config.cmi \ - asmcomp/cmx_format.cmi asmcomp/clambda.cmi asmcomp/compilenv.cmi -asmcomp/compilenv.cmx : utils/warnings.cmx utils/misc.cmx \ - parsing/location.cmx typing/ident.cmx typing/env.cmx utils/config.cmx \ - asmcomp/cmx_format.cmi asmcomp/clambda.cmx asmcomp/compilenv.cmi +asmcomp/compilenv.cmo : utils/warnings.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/misc.cmi \ + parsing/location.cmi middle_end/base_types/linkage_name.cmi \ + typing/ident.cmi middle_end/flambda.cmi typing/env.cmi utils/config.cmi \ + middle_end/base_types/compilation_unit.cmi asmcomp/cmx_format.cmi \ + middle_end/base_types/closure_id.cmi asmcomp/clambda.cmi \ + asmcomp/compilenv.cmi +asmcomp/compilenv.cmx : utils/warnings.cmx middle_end/base_types/symbol.cmx \ + middle_end/base_types/set_of_closures_id.cmx utils/misc.cmx \ + parsing/location.cmx middle_end/base_types/linkage_name.cmx \ + typing/ident.cmx middle_end/flambda.cmx typing/env.cmx utils/config.cmx \ + middle_end/base_types/compilation_unit.cmx asmcomp/cmx_format.cmi \ + middle_end/base_types/closure_id.cmx asmcomp/clambda.cmx \ + asmcomp/compilenv.cmi asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/cmm.cmi asmcomp/CSEgen.cmi asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ @@ -908,34 +921,34 @@ asmcomp/export_info_for_pack.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/symbol.cmi \ middle_end/base_types/set_of_closures_id.cmi utils/misc.cmi \ - typing/ident.cmi middle_end/flambda_utils.cmi \ - middle_end/flambda_iterators.cmi middle_end/flambda.cmi \ - asmcomp/export_info.cmi middle_end/base_types/export_id.cmi \ + middle_end/flambda_utils.cmi middle_end/flambda_iterators.cmi \ + middle_end/flambda.cmi asmcomp/export_info.cmi \ + middle_end/base_types/export_id.cmi \ middle_end/base_types/compilation_unit.cmi \ middle_end/base_types/closure_id.cmi asmcomp/export_info_for_pack.cmi asmcomp/export_info_for_pack.cmx : middle_end/base_types/variable.cmx \ middle_end/base_types/var_within_closure.cmx \ middle_end/base_types/symbol.cmx \ middle_end/base_types/set_of_closures_id.cmx utils/misc.cmx \ - typing/ident.cmx middle_end/flambda_utils.cmx \ - middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ - asmcomp/export_info.cmx middle_end/base_types/export_id.cmx \ + middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ + middle_end/flambda.cmx asmcomp/export_info.cmx \ + middle_end/base_types/export_id.cmx \ middle_end/base_types/compilation_unit.cmx \ middle_end/base_types/closure_id.cmx asmcomp/export_info_for_pack.cmi asmcomp/export_info.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ middle_end/simple_value_approx.cmi \ - middle_end/base_types/set_of_closures_id.cmi typing/ident.cmi \ - middle_end/flambda.cmi middle_end/base_types/export_id.cmi \ + middle_end/base_types/set_of_closures_id.cmi middle_end/flambda.cmi \ + middle_end/base_types/export_id.cmi \ middle_end/base_types/compilation_unit.cmi \ middle_end/base_types/closure_id.cmi asmcomp/export_info.cmi asmcomp/export_info.cmx : middle_end/base_types/variable.cmx \ middle_end/base_types/var_within_closure.cmx \ middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ middle_end/simple_value_approx.cmx \ - middle_end/base_types/set_of_closures_id.cmx typing/ident.cmx \ - middle_end/flambda.cmx middle_end/base_types/export_id.cmx \ + middle_end/base_types/set_of_closures_id.cmx middle_end/flambda.cmx \ + middle_end/base_types/export_id.cmx \ middle_end/base_types/compilation_unit.cmx \ middle_end/base_types/closure_id.cmx asmcomp/export_info.cmi asmcomp/flambda_to_clambda.cmo : middle_end/base_types/variable.cmi \ @@ -1539,8 +1552,8 @@ middle_end/lift_constants.cmo : middle_end/base_types/variable.cmi \ middle_end/flambda_utils.cmi middle_end/flambda_iterators.cmi \ middle_end/flambda.cmi middle_end/base_types/compilation_unit.cmi \ middle_end/base_types/closure_id.cmi middle_end/backend_intf.cmi \ - middle_end/allocated_const.cmi middle_end/alias_analysis.cmi \ - middle_end/lift_constants.cmi + parsing/asttypes.cmi middle_end/allocated_const.cmi \ + middle_end/alias_analysis.cmi middle_end/lift_constants.cmi middle_end/lift_constants.cmx : middle_end/base_types/variable.cmx \ middle_end/base_types/var_within_closure.cmx \ middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ @@ -1550,8 +1563,8 @@ middle_end/lift_constants.cmx : middle_end/base_types/variable.cmx \ middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ middle_end/flambda.cmx middle_end/base_types/compilation_unit.cmx \ middle_end/base_types/closure_id.cmx middle_end/backend_intf.cmi \ - middle_end/allocated_const.cmx middle_end/alias_analysis.cmx \ - middle_end/lift_constants.cmi + parsing/asttypes.cmi middle_end/allocated_const.cmx \ + middle_end/alias_analysis.cmx middle_end/lift_constants.cmi middle_end/lift_let_to_initialize_symbol.cmo : \ middle_end/base_types/variable.cmi middle_end/base_types/tag.cmi \ middle_end/base_types/symbol.cmi middle_end/flambda_utils.cmi \ From 4bf93642aff8f89192a3f1bf9c979e5d6566dd19 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 6 Jan 2016 19:55:44 +0000 Subject: [PATCH 114/145] Allow automatic re-running of failed tests MAX_TESTSUITE_DIR_RETRIES (which defaults to 1 for the native Windows ports and 0 for all other platforms) causes the `all` and `list` targets to re-run any given test directory an additional number of times in order to eliminate random failures during tests. --- Changes | 2 + config/Makefile.mingw | 1 + config/Makefile.mingw64 | 1 + config/Makefile.msvc | 1 + config/Makefile.msvc64 | 1 + configure | 2 + testsuite/Makefile | 57 +++++++++++------- testsuite/makefiles/summarize.awk | 98 +++++++++++++++++++++++-------- 8 files changed, 120 insertions(+), 43 deletions(-) diff --git a/Changes b/Changes index 7a6e92a86..ed57ee342 100644 --- a/Changes +++ b/Changes @@ -527,6 +527,8 @@ Features wishes: of a type error clash. (Hugo Heuzard) - GPR#383: configure: define _ALL_SOURCE for build on AIX7.1 (tkob) +- GPR#401: automatically retry failed test directories in the testsuite + (David Allsopp) Build system: - GPR#388: FlexDLL added as a Git submodule and bootstrappable with the compiler diff --git a/config/Makefile.mingw b/config/Makefile.mingw index b98fc65ec..488effde8 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -190,3 +190,4 @@ CTOPDIR=$(TOPDIR) CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" +MAX_TESTSUITE_DIR_RETRIES=1 diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 1936dd7c0..2676958da 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -190,3 +190,4 @@ CTOPDIR=$(TOPDIR) CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" +MAX_TESTSUITE_DIR_RETRIES=1 diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 5d93bacb6..80679c278 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -194,3 +194,4 @@ DIFF=diff -q --strip-trailing-cr FIND=/usr/bin/find SORT=/usr/bin/sort SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" +MAX_TESTSUITE_DIR_RETRIES=1 diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index ae2895be7..2abdbf344 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -198,3 +198,4 @@ DIFF=diff -q --strip-trailing-cr FIND=/usr/bin/find SORT=/usr/bin/sort SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" +MAX_TESTSUITE_DIR_RETRIES=1 diff --git a/configure b/configure index e59567ebc..30b0c02fd 100755 --- a/configure +++ b/configure @@ -52,6 +52,7 @@ native_compiler=true TOOLPREF="" with_cfi=true flambda=false +max_testsuite_dir_retries=0 # Try to turn internationalization off, can cause config.guess to malfunction! unset LANG @@ -1810,6 +1811,7 @@ if [ "$ostype" = Cygwin ]; then echo "DIFF=diff -q --strip-trailing-cr" >>Makefile fi echo "FLAMBDA=$flambda" >> Makefile +echo "MAX_TESTSUITE_DIR_RETRIES=$max_testsuite_dir_retries" >> Makefile rm -f tst hasgot.c diff --git a/testsuite/Makefile b/testsuite/Makefile index 1df26bca5..5ef712211 100644 --- a/testsuite/Makefile +++ b/testsuite/Makefile @@ -21,42 +21,31 @@ include ../config/Makefile default: @echo "Available targets:" @echo " all launch all tests" + @echo " all-foo launch all tests beginning with foo" @echo " list FILE=f launch the tests listed in f (one per line)" @echo " one DIR=p launch the tests located in path p" @echo " promote DIR=p promote the reference files for the tests in p" @echo " lib build library modules" @echo " clean delete generated files" @echo " report print the report for the last execution" + @echo + @echo "all* and list can automatically re-run failed test directories if" + @echo "MAX_TESTSUITE_DIR_RETRIES permits (default value = $(MAX_TESTSUITE_DIR_RETRIES))" .PHONY: all all: lib @for dir in tests/*; do \ $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \ done 2>&1 | tee _log + @$(MAKE) $(NO_PRINT) retries @$(MAKE) report -all-basic: lib - @for dir in tests/basic*; do \ - $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \ - done 2>&1 | tee _log - @$(MAKE) report - -all-lib: lib - @for dir in tests/lib-*; do \ - $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \ - done 2>&1 | tee _log - @$(MAKE) report - -all-typing: lib - @for dir in tests/typing-*; do \ - $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \ - done 2>&1 | tee _log - @$(MAKE) report - -all-tool: lib - @for dir in tests/tool-*; do \ +.PHONY: all-% +all-%: lib + @for dir in tests/$**; do \ $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \ done 2>&1 | tee _log + @$(MAKE) $(NO_PRINT) retries @$(MAKE) report .PHONY: list @@ -68,6 +57,7 @@ list: lib @while read LINE; do \ $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE; \ done <$(FILE) 2>&1 | tee _log + @$(MAKE) $(NO_PRINT) retries @$(MAKE) report .PHONY: one @@ -96,6 +86,18 @@ exec-one: $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) || echo '=> unexpected error'; \ fi +.PHONY: clean-one +clean-one: + @if [ ! -f $(DIR)/Makefile ]; then \ + for dir in $(DIR)/*; do \ + if [ -d $$dir ]; then \ + $(MAKE) clean-one DIR=$$dir; \ + fi; \ + done; \ + else \ + cd $(DIR) && $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) clean; \ + fi + .PHONY: promote promote: @if [ -z "$(DIR)" ]; then \ @@ -124,5 +126,20 @@ report: @if [ ! -f _log ]; then echo "No '_log' file."; exit 1; fi @awk -f makefiles/summarize.awk <_log +retry-list: + @while read LINE; do \ + if [ -n "$$LINE" ] ; then \ + echo re-ran $$LINE>>_log; \ + $(MAKE) $(NO_PRINT) clean-one DIR=$$LINE; \ + $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE 2>&1 | tee -a _log ; \ + fi \ + done <_retries; + @$(MAKE) $(NO_PRINT) retries + +retries: + @awk -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) -f makefiles/summarize.awk <_log >_retries + @test `cat _retries | wc -l` -eq 0 || $(MAKE) $(NO_PRINT) retry-list + @rm -f _retries + .PHONY: empty empty: diff --git a/testsuite/makefiles/summarize.awk b/testsuite/makefiles/summarize.awk index 75ab95255..ed44a59f4 100644 --- a/testsuite/makefiles/summarize.awk +++ b/testsuite/makefiles/summarize.awk @@ -24,26 +24,30 @@ function clear() { function record_pass() { check(); - ++ passed; + RESULTS[key] = "p"; clear(); } function record_skip() { check(); - ++ skipped; + RESULTS[key] = "s"; clear(); } +# The output cares only if the test passes at least once so if a test passes, +# but then fails in a re-run triggered by a different test, ignore it. function record_fail() { check(); - ++ failed; - fail[failidx++] = sprintf ("%s/%s", curdir, curfile); + if (!(key in RESULTS)){ + RESULTS[key] = "f"; + } clear(); } function record_unexp() { - ++ unexped; - unexp[unexpidx++] = sprintf ("%s/%s", curdir, curfile); + if (!(key in RESULTS)){ + RESULTS[key] = "e"; + } clear(); } @@ -51,6 +55,8 @@ function record_unexp() { if (in_test) record_unexp(); match($0, /Running tests from '[^']*'/); curdir = substr($0, RSTART+20, RLENGTH - 21); + key = curdir; + DIRS[key] = key; curfile = ""; } @@ -63,11 +69,15 @@ function record_unexp() { if (in_test) record_unexp(); match($0, /... testing '[^']*'/); curfile = substr($0, RSTART+13, RLENGTH-14); + key = sprintf ("%s/%s", curdir, curfile); + DIRS[key] = curdir; in_test = 1; } /^ ... testing with / { if (in_test) record_unexp(); + key = curdir; + DIRS[key] = curdir; in_test = 1; } @@ -87,6 +97,16 @@ function record_unexp() { record_unexp(); } +/^re-ran / { + if (in_test){ + printf("error at line %d: found re-ran inside a test\n", NR); + errored = 1; + }else{ + RERAN[substr($0, 8, length($0)-7)] += 1; + ++ reran; + } +} + # Not displaying "skipped" for the moment, as most of the skipped tests # print nothing at all and are not counted. @@ -95,23 +115,55 @@ END { printf ("\n#### Some fatal error occurred during testing.\n\n"); exit (3); }else{ - printf("\n"); - printf("Summary:\n"); - printf(" %3d test(s) passed\n", passed); - printf(" %3d test(s) failed\n", failed); - printf(" %3d unexpected error(s)\n", unexped); - if (failed != 0){ - printf("\nList of failed tests:\n"); - for (i=0; i < failed; i++) printf(" %s\n", fail[i]); - } - if (unexped != 0){ - printf("\nList of unexpected errors:\n"); - for (i=0; i < unexped; i++) printf(" %s\n", unexp[i]); - } - printf("\n"); - if (failed || unexped){ - printf("#### Some tests failed. Exiting with error status.\n\n"); - exit 4; + if (!retries){ + for (key in RESULTS){ + switch (RESULTS[key]) { + case "p": + ++ passed; + break + case "f": + ++ failed; + fail[failidx++] = key; + break + case "e": + ++ unexped; + unexp[unexpidx++] = key; + break + } + } + printf("\n"); + printf("Summary:\n"); + printf(" %3d test(s) passed\n", passed); + printf(" %3d test(s) failed\n", failed); + printf(" %3d unexpected error(s)\n", unexped); + if (reran != 0){ + printf(" %3d test dir re-run(s)\n", reran); + } + if (failed != 0){ + printf("\nList of failed tests:\n"); + for (i=0; i < failed; i++) printf(" %s\n", fail[i]); + } + if (unexped != 0){ + printf("\nList of unexpected errors:\n"); + for (i=0; i < unexped; i++) printf(" %s\n", unexp[i]); + } + printf("\n"); + if (failed || unexped){ + printf("#### Some tests failed. Exiting with error status.\n\n"); + exit 4; + } + }else{ + for (key in RESULTS){ + if (RESULTS[key] == "f" || RESULTS[key] == "e"){ + key = DIRS[key]; + if (!(key in RERUNS)){ + RERUNS[key] = 1; + if (RERAN[key] < max_retries){ + printf("%s\n", key); + } + } + } + } } } } From e37f72f348c8535ddf5e1b64dee563b342f5fb79 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sun, 17 Jan 2016 09:50:09 +0000 Subject: [PATCH 115/145] Remove requirement for gawk in testsuite switch is a GNU extension - not supported, for example, by the default installation of awk on Ubuntu. --- testsuite/makefiles/summarize.awk | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/testsuite/makefiles/summarize.awk b/testsuite/makefiles/summarize.awk index ed44a59f4..240fc5516 100644 --- a/testsuite/makefiles/summarize.awk +++ b/testsuite/makefiles/summarize.awk @@ -117,18 +117,26 @@ END { }else{ if (!retries){ for (key in RESULTS){ - switch (RESULTS[key]) { - case "p": + r = RESULTS[key]; + if (r == "p"){ ++ passed; - break - case "f": + }else if (r == "f"){ ++ failed; fail[failidx++] = key; - break - case "e": + }else if (r == "e"){ ++ unexped; unexp[unexpidx++] = key; - break + }else if (r == "s"){ + ++ skipped; + curdir = DIRS[key]; + if (curdir in SKIPPED){ + if (SKIPPED[curdir]){ + SKIPPED[curdir] = 0; + skips[skipidx++] = curdir; + } + }else{ + skips[skipidx++] = key; + } } } printf("\n"); From 790d9c988520a6ed4321ec1e7f58ddb82ec7d9c4 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sun, 17 Jan 2016 09:54:20 +0000 Subject: [PATCH 116/145] Display details of all skipped tests Some Makefile's displayed "=> skipped" lines; some Makefile's displayed a summary line including the word skipped; most Makefile's are simply silent if tests are skipped. Silent obviously doesn't discern between "skipped" and "broken"! Patch alters all existing to display an explicit "=> skipped" for any test which is skipped (including ocamlopt tests if `BYTECODE_ONLY=true`). The summary is updated to include: - The number of skipped tests, and their names (if all tests are skipped in a directory then just the directory name is displayed) - The total number of tests considered - which should therefore be the same on all platforms in all configurations --- testsuite/makefiles/Makefile.one | 3 ++- testsuite/makefiles/Makefile.several | 16 +++++++++++++--- testsuite/makefiles/summarize.awk | 19 +++++++++++++------ testsuite/tests/asmcomp/Makefile | 7 ++++++- testsuite/tests/backtrace/Makefile | 13 ++++++++++++- testsuite/tests/callback/Makefile | 7 +++++++ testsuite/tests/lib-dynlink-csharp/Makefile | 17 +++++------------ testsuite/tests/lib-dynlink-native/Makefile | 6 ++---- testsuite/tests/opaque/Makefile | 9 ++++++++- testsuite/tests/runtime-errors/Makefile | 2 +- testsuite/tests/warnings/Makefile | 14 ++++++++------ 11 files changed, 77 insertions(+), 36 deletions(-) diff --git a/testsuite/makefiles/Makefile.one b/testsuite/makefiles/Makefile.one index 036fb12c1..4fba264c3 100644 --- a/testsuite/makefiles/Makefile.one +++ b/testsuite/makefiles/Makefile.one @@ -34,7 +34,8 @@ C_INCLUDES+=-I $(CTOPDIR)/byterun .PHONY: default default: @$(MAKE) compile - @$(SET_LD_PATH) $(MAKE) run + @$(NATIVECODE_ONLY) && $(BYTECODE_ONLY) && echo " ... testing => skipped" || \ + $(SET_LD_PATH) $(MAKE) run .PHONY: compile compile: $(ML_FILES) diff --git a/testsuite/makefiles/Makefile.several b/testsuite/makefiles/Makefile.several index 1a4ab1aa2..8ed868f48 100644 --- a/testsuite/makefiles/Makefile.several +++ b/testsuite/makefiles/Makefile.several @@ -27,10 +27,14 @@ ADD_OPTFLAGS+=$(FORTRAN_LIB) C_INCLUDES+=-I $(CTOPDIR)/byterun -I$(CTOPDIR)/otherlibs/bigarray +SKIP=false + .PHONY: check check: @if [ -n "$(FORTRAN_COMPILER)" -o -z "$(F_FILES)" ]; then \ $(SET_LD_PATH) $(MAKE) run-all; \ + else \ + $(MAKE) C_FILES= F_FILES= SKIP=true run-all; \ fi .PHONY: run-all @@ -42,10 +46,16 @@ run-all: $(FORTRAN_COMPILER) -c $$file.f; \ done; @for file in *.ml; do \ - if [ -f `basename $$file ml`precheck ]; then \ - TOOLCHAIN=$(TOOLCHAIN) sh `basename $$file ml`precheck || continue; \ - fi; \ printf " ... testing '$$file':"; \ + if $(SKIP) ; then \ + echo " => skipped"; continue; \ + fi; \ + if [ -f `basename $$file ml`precheck ]; then \ + if ! TOOLCHAIN=$(TOOLCHAIN) sh `basename $$file ml`precheck ; then \ + echo " => skipped"; \ + continue; \ + fi; \ + fi; \ $(MAKE) run-file DESC=ocamlc COMP='$(OCAMLC)' \ RUNTIME='$(MYRUNTIME)' \ COMPFLAGS='-w a $(ADD_COMPFLAGS) $(ADD_CFLAGS) $(O_FILES) \ diff --git a/testsuite/makefiles/summarize.awk b/testsuite/makefiles/summarize.awk index 240fc5516..945126086 100644 --- a/testsuite/makefiles/summarize.awk +++ b/testsuite/makefiles/summarize.awk @@ -25,6 +25,7 @@ function clear() { function record_pass() { check(); RESULTS[key] = "p"; + delete SKIPPED[curdir]; clear(); } @@ -38,16 +39,18 @@ function record_skip() { # but then fails in a re-run triggered by a different test, ignore it. function record_fail() { check(); - if (!(key in RESULTS)){ + if (!(key in RESULTS) || RESULTS[key] == "s"){ RESULTS[key] = "f"; } + delete SKIPPED[curdir]; clear(); } function record_unexp() { - if (!(key in RESULTS)){ + if (!(key in RESULTS) || RESULTS[key] == "s"){ RESULTS[key] = "e"; } + delete SKIPPED[curdir]; clear(); } @@ -55,6 +58,7 @@ function record_unexp() { if (in_test) record_unexp(); match($0, /Running tests from '[^']*'/); curdir = substr($0, RSTART+20, RLENGTH - 21); + SKIPPED[curdir] = 1; key = curdir; DIRS[key] = key; curfile = ""; @@ -74,7 +78,7 @@ function record_unexp() { in_test = 1; } -/^ ... testing with / { +/^ ... testing (with|[^'])/ { if (in_test) record_unexp(); key = curdir; DIRS[key] = curdir; @@ -107,9 +111,6 @@ function record_unexp() { } } -# Not displaying "skipped" for the moment, as most of the skipped tests -# print nothing at all and are not counted. - END { if (errored){ printf ("\n#### Some fatal error occurred during testing.\n\n"); @@ -142,8 +143,10 @@ END { printf("\n"); printf("Summary:\n"); printf(" %3d test(s) passed\n", passed); + printf(" %3d test(s) skipped\n", skipped); printf(" %3d test(s) failed\n", failed); printf(" %3d unexpected error(s)\n", unexped); + printf(" %3d tests considered%s\n", length(RESULTS), (length(RESULTS) != passed + skipped + failed + unexped ? " (totals don't add up??)": "")); if (reran != 0){ printf(" %3d test dir re-run(s)\n", reran); } @@ -155,6 +158,10 @@ END { printf("\nList of unexpected errors:\n"); for (i=0; i < unexped; i++) printf(" %s\n", unexp[i]); } + if (skipped != 0){ + printf("\nList of skipped tests:\n"); + for (i=0; i < skipidx; i++) printf(" %s\n", skips[i]); + } printf("\n"); if (failed || unexped){ printf("#### Some tests failed. Exiting with error status.\n\n"); diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile index 07010ff8a..7ed3e5a39 100644 --- a/testsuite/tests/asmcomp/Makefile +++ b/testsuite/tests/asmcomp/Makefile @@ -27,7 +27,7 @@ OBJS=parsecmmaux.cmo parsecmm.cmo lexcmm.cmo ADD_COMPFLAGS=$(INCLUDES) -w -40 -g default: - @if $(BYTECODE_ONLY) ; then : ; else \ + @if $(BYTECODE_ONLY) || $(SKIP) ; then $(MAKE) skips ; else \ $(MAKE) all; \ fi @@ -61,6 +61,11 @@ ARGS_tagged-integr=-DINT_FLOAT -DFUN=test main.c ARGS_tagged-quicksort=-DSORT -DFUN=quicksort main.c ARGS_tagged-tak=-DUNIT_INT -DFUN=takmain main.c +skips: + @for c in $(CASES) $(MLCASES); do \ + echo " ... testing '$$c': => skipped"; \ + done + one_ml: @$(OCAMLOPT) -o $(NAME).exe $(NAME).ml && \ ./$(NAME).exe && echo " => passed" || echo " => failed" diff --git a/testsuite/tests/backtrace/Makefile b/testsuite/tests/backtrace/Makefile index ce5d6dbcb..028bf3821 100644 --- a/testsuite/tests/backtrace/Makefile +++ b/testsuite/tests/backtrace/Makefile @@ -21,7 +21,7 @@ OTHERFILESNOINLINING_NATIVE=backtraces_and_finalizers.ml default: @$(MAKE) byte - @if $(BYTECODE_ONLY); then : ; else $(MAKE) native; fi + @if $(BYTECODE_ONLY); then $(MAKE) skip ; else $(MAKE) native; fi .PHONY: byte byte: @@ -50,6 +50,17 @@ byte: && echo " => passed" || echo " => failed"; \ done +.PHONY: skip +skip: + @for file in $(ABCDFILES); do \ + for arg in a b c d ''; do \ + echo " ... testing '$$file' with ocamlopt and argument '$$arg': => skipped"; \ + done; \ + done + @for file in $(OTHERFILES) $(OTHERFILESNOINLINING) $(OTHERFILESNOINLINING_NATIVE); do \ + echo " ... testing '$$file' with ocamlopt: => skipped"; \ + done + .PHONY: native native: @for file in $(ABCDFILES); do \ diff --git a/testsuite/tests/callback/Makefile b/testsuite/tests/callback/Makefile index d89c53263..8eb43aa81 100644 --- a/testsuite/tests/callback/Makefile +++ b/testsuite/tests/callback/Makefile @@ -21,12 +21,19 @@ default: @case " $(OTHERLIBRARIES) " in \ *' unix '*) $(SET_LD_PATH) $(MAKE) run-byte; \ $(SET_LD_PATH) $(MAKE) run-opt;; \ + *) $(MAKE) skip;; \ esac .PHONY: common common: @$(CC) -c callbackprim.c +.PHONY: skip +skip: + @for c in bytecode native; do \ + echo " ... testing '$$c': => skipped" ; \ + done + .PHONY: run-byte run-byte: common @printf " ... testing 'bytecode':" diff --git a/testsuite/tests/lib-dynlink-csharp/Makefile b/testsuite/tests/lib-dynlink-csharp/Makefile index c576a0990..da0246974 100644 --- a/testsuite/tests/lib-dynlink-csharp/Makefile +++ b/testsuite/tests/lib-dynlink-csharp/Makefile @@ -16,15 +16,8 @@ CSC=csc COMPFLAGS=-I $(OTOPDIR)/otherlibs/bigarray LD_PATH=$(TOPDIR)/otherlibs/bigarray -.PHONY: default default: - @if ! $(SUPPORTS_SHARED_LIBRARIES); then \ - echo 'skipped (shared libraries not available)'; \ - elif $(BYTECODE_ONLY); then \ - echo 'skipped (native compiler not available)' ; \ - else \ - $(SET_LD_PATH) $(MAKE) all; \ - fi + @$(SET_LD_PATH) $(MAKE) all .PHONY: all all: prepare bytecode bytecode-dll native native-dll @@ -37,7 +30,7 @@ prepare: .PHONY: bytecode bytecode: @printf " ... testing 'bytecode':" - @if [ ! `which $(CSC) >/dev/null 2>&1` ]; then \ + @if ! $(SUPPORTS_SHARED_LIBRARIES) || [ ! `which $(CSC) >/dev/null 2>&1` ]; then \ echo " => skipped"; \ else \ $(OCAMLC) -output-obj -o main.dll dynlink.cma main.ml entry.c; \ @@ -50,7 +43,7 @@ bytecode: .PHONY: bytecode-dll bytecode-dll: @printf " ... testing 'bytecode-dll':" - @if [ ! `which $(CSC) > /dev/null 2>&1` ]; then \ + @if ! $(SUPPORTS_SHARED_LIBRARIES) || [ ! `which $(CSC) > /dev/null 2>&1` ]; then \ echo " => skipped"; \ else \ $(OCAMLC) -output-obj -o main_obj.$(O) dynlink.cma entry.c main.ml; \ @@ -65,7 +58,7 @@ bytecode-dll: .PHONY: native native: @printf " ... testing 'native':" - @if [ ! `which $(CSC) > /dev/null 2>&1` ]; then \ + @if ! $(SUPPORTS_SHARED_LIBRARIES) || $(BYTECODE_ONLY) || [ ! `which $(CSC) > /dev/null 2>&1` ]; then \ echo " => skipped"; \ else \ $(OCAMLOPT) -output-obj -o main.dll dynlink.cmxa entry.c main.ml; \ @@ -78,7 +71,7 @@ native: .PHONY: native-dll native-dll: @printf " ... testing 'native-dll':" - @if [ ! `which $(CSC) > /dev/null 2>&1` ]; then \ + @if ! $(SUPPORTS_SHARED_LIBRARIES) || $(BYTECODE_ONLY) || [ ! `which $(CSC) > /dev/null 2>&1` ]; then \ echo " => skipped"; \ else \ $(OCAMLOPT) -output-obj -o main_obj.$(O) dynlink.cmxa entry.c \ diff --git a/testsuite/tests/lib-dynlink-native/Makefile b/testsuite/tests/lib-dynlink-native/Makefile index 77c1aff5a..34306051c 100644 --- a/testsuite/tests/lib-dynlink-native/Makefile +++ b/testsuite/tests/lib-dynlink-native/Makefile @@ -20,10 +20,8 @@ LD_PATH = $(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix:$(TOPDIR)/otherlibs/systhreads\ .PHONY: default default: - @if ! $(SUPPORTS_SHARED_LIBRARIES); then \ - echo 'skipped (shared libraries not available)'; \ - elif $(BYTECODE_ONLY); then \ - echo 'skipped (native compiler not available)' ; \ + @if ! $(SUPPORTS_SHARED_LIBRARIES) || $(BYTECODE_ONLY) ; then \ + echo " ... testing 'main' => skipped"; \ else \ $(SET_LD_PATH) $(MAKE) all; \ fi diff --git a/testsuite/tests/opaque/Makefile b/testsuite/tests/opaque/Makefile index f42b0fe72..22c64fb28 100644 --- a/testsuite/tests/opaque/Makefile +++ b/testsuite/tests/opaque/Makefile @@ -14,10 +14,17 @@ BASEDIR=../.. .PHONY: default default: - @if $(BYTECODE_ONLY); then : ; else \ + @if $(BYTECODE_ONLY); then $(MAKE) skip ; else \ $(MAKE) compile; \ fi +.PHONY: skip +skip: + @echo " ... testing 'test' with ordinary compilation => skipped" + @echo " ... testing 'test' with change to opaque interface => skipped" + @echo " ... testing 'test' with change to opaque implementation => skipped" + @echo " ... testing 'test' with change to non-opaque implementation => skipped" + .PHONY: compile compile: @$(OCAMLOPT) -I intf -opaque -c intf/opaque_intf.mli diff --git a/testsuite/tests/runtime-errors/Makefile b/testsuite/tests/runtime-errors/Makefile index 976d9a6cd..682f7b3be 100644 --- a/testsuite/tests/runtime-errors/Makefile +++ b/testsuite/tests/runtime-errors/Makefile @@ -52,7 +52,7 @@ run: echo " => unexpected error"; \ fi; \ fn=`basename $$f bytecode`native; \ - if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then : ; else \ + if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then echo " ... testing '$$fn': => skipped" ; else \ printf " ... testing '$$fn':"; \ if [ $$ul -eq 1 ] ; then \ ./$${fn}$(EXE) >$$fn.result 2>&1 || true; \ diff --git a/testsuite/tests/warnings/Makefile b/testsuite/tests/warnings/Makefile index a4209668e..30e1dffc9 100644 --- a/testsuite/tests/warnings/Makefile +++ b/testsuite/tests/warnings/Makefile @@ -23,13 +23,15 @@ run-all: $(DIFF) $$F.reference $$F.result >/dev/null \ && echo " => passed" || echo " => failed"; \ done; - @if $(BYTECODE_ONLY); then :; else for file in *.opt.ml; do \ + @for file in *.opt.ml; do \ printf " ... testing '$$file' with ocamlopt:"; \ - F="`basename $$file .ml`"; \ - $(OCAMLOPT) $(FLAGS) -c $$file 2>$$F.opt_result; \ - $(DIFF) $$F.opt_reference $$F.opt_result >/dev/null \ - && echo " => passed" || echo " => failed"; \ - done fi; + if $(BYTECODE_ONLY); then echo " => skipped"; else \ + F="`basename $$file .ml`"; \ + $(OCAMLOPT) $(FLAGS) -c $$file 2>$$F.opt_result; \ + $(DIFF) $$F.opt_reference $$F.opt_result >/dev/null \ + && echo " => passed" || echo " => failed"; \ + fi \ + done; promote: defaultpromote From 6b8ce81f18865cb5b7dbec9b1b4fdd7689754c57 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sun, 17 Jan 2016 10:00:18 +0000 Subject: [PATCH 117/145] Display plurals correctly in testsuite summary David R Allsopp -- pedantically eschewing lazy plural(s) since 1994. --- testsuite/makefiles/summarize.awk | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/testsuite/makefiles/summarize.awk b/testsuite/makefiles/summarize.awk index 945126086..fa5fcd6ba 100644 --- a/testsuite/makefiles/summarize.awk +++ b/testsuite/makefiles/summarize.awk @@ -142,13 +142,13 @@ END { } printf("\n"); printf("Summary:\n"); - printf(" %3d test(s) passed\n", passed); - printf(" %3d test(s) skipped\n", skipped); - printf(" %3d test(s) failed\n", failed); - printf(" %3d unexpected error(s)\n", unexped); + printf(" %3d test%s passed\n", passed, (passed == 1 ? "" : "s")); + printf(" %3d test%s skipped\n", skipped, (skipped == 1 ? "" : "s")); + printf(" %3d test%s failed\n", failed, (failed == 1 ? "" : "s")); + printf(" %3d unexpected error%s\n", unexped, (unexped == 1 ? "" : "s")); printf(" %3d tests considered%s\n", length(RESULTS), (length(RESULTS) != passed + skipped + failed + unexped ? " (totals don't add up??)": "")); if (reran != 0){ - printf(" %3d test dir re-run(s)\n", reran); + printf(" %3d test dir re-run%s\n", reran, (reran == 1 ? "" : "s")); } if (failed != 0){ printf("\nList of failed tests:\n"); @@ -164,7 +164,7 @@ END { } printf("\n"); if (failed || unexped){ - printf("#### Some tests failed. Exiting with error status.\n\n"); + printf("#### Something failed. Exiting with error status.\n\n"); exit 4; } }else{ From 771d1bd06a0c141b5ec5292345227988d88f8670 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sun, 17 Jan 2016 10:14:12 +0000 Subject: [PATCH 118/145] Display list of directories which ran no tests Testsuite directories should now display " => skipped" for each test, rather than simply displaying nothing. --- testsuite/makefiles/summarize.awk | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/testsuite/makefiles/summarize.awk b/testsuite/makefiles/summarize.awk index fa5fcd6ba..4e3f046da 100644 --- a/testsuite/makefiles/summarize.awk +++ b/testsuite/makefiles/summarize.awk @@ -32,6 +32,7 @@ function record_pass() { function record_skip() { check(); RESULTS[key] = "s"; + if (curdir in SKIPPED) SKIPPED[curdir] = 1; clear(); } @@ -58,7 +59,8 @@ function record_unexp() { if (in_test) record_unexp(); match($0, /Running tests from '[^']*'/); curdir = substr($0, RSTART+20, RLENGTH - 21); - SKIPPED[curdir] = 1; + # Use SKIPPED[curdir] as a sentintel to detect no output + SKIPPED[curdir] = 0; key = curdir; DIRS[key] = key; curfile = ""; @@ -117,6 +119,13 @@ END { exit (3); }else{ if (!retries){ + for (key in SKIPPED){ + if (!SKIPPED[key]){ + ++ empty; + blanks[emptyidx++] = key; + delete SKIPPED[key]; + } + } for (key in RESULTS){ r = RESULTS[key]; if (r == "p"){ @@ -162,6 +171,10 @@ END { printf("\nList of skipped tests:\n"); for (i=0; i < skipidx; i++) printf(" %s\n", skips[i]); } + if (empty != 0){ + printf("\nList of directories returning no results:\n"); + for (i=0; i < empty; i++) printf(" %s\n", blanks[i]); + } printf("\n"); if (failed || unexped){ printf("#### Something failed. Exiting with error status.\n\n"); From 3c2f747f0b5eaf25f69e778e75fbe7150b291a5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rafa=C3=ABl=20Bocquet?= Date: Thu, 30 Oct 2014 09:44:42 +0100 Subject: [PATCH 119/145] GPR#112: octal escape sequences for char and string literals merged by Damien Doligez --- Changes | 2 ++ parsing/lexer.mll | 11 +++++++++++ 2 files changed, 13 insertions(+) diff --git a/Changes b/Changes index 7a6e92a86..3abb9f2ec 100644 --- a/Changes +++ b/Changes @@ -24,6 +24,8 @@ Language features: - GPR#88: allow field punning in object copying expressions: {< x; y; >} is sugar for {< x = x; y = y; >} (Jeremy Yallop) +- GPR#112: octal escape sequences for char and string literals + (Rafaël Bocquet) - GPR#167: allow to annotate externals' arguments and result types so they can be unboxed or untagged. Supports untagging int and unboxing int32, int64, nativeint and float. diff --git a/parsing/lexer.mll b/parsing/lexer.mll index 25e2aad1c..ec1a93bca 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -163,6 +163,12 @@ let char_for_decimal_code lexbuf i = Location.curr lexbuf)) else Char.chr c +let char_for_octal_code lexbuf i = + let c = 64 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + + 8 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + + (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in + Char.chr c + let char_for_hexadecimal_code lexbuf i = let d1 = Char.code (Lexing.lexeme_char lexbuf i) in let val1 = if d1 >= 97 then d1 - 87 @@ -366,6 +372,8 @@ rule token = parse { CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) } | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'" { CHAR(char_for_decimal_code lexbuf 2) } + | "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'" + { CHAR(char_for_octal_code lexbuf 3) } | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'" { CHAR(char_for_hexadecimal_code lexbuf 3) } | "\'\\" _ @@ -583,6 +591,9 @@ and string = parse | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] { store_string_char(char_for_decimal_code lexbuf 1); string lexbuf } + | '\\' 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] + { store_string_char(char_for_octal_code lexbuf 2); + string lexbuf } | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] { store_string_char(char_for_hexadecimal_code lexbuf 2); string lexbuf } From a41b820d267ea8e1cc2bd7464f6b17c00728ee34 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Sat, 5 Sep 2015 09:12:28 -0700 Subject: [PATCH 120/145] Add byte_size and kind_byte_size to Bigarray --- otherlibs/bigarray/bigarray.ml | 31 ++++++++++++ otherlibs/bigarray/bigarray.mli | 15 ++++++ testsuite/tests/lib-bigarray/bigarrays.ml | 48 +++++++++++++++++++ .../tests/lib-bigarray/bigarrays.reference | 10 ++++ 4 files changed, 104 insertions(+) diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml index 960c97241..be7f7f5ea 100644 --- a/otherlibs/bigarray/bigarray.ml +++ b/otherlibs/bigarray/bigarray.ml @@ -62,6 +62,21 @@ let complex32 = Complex32 let complex64 = Complex64 let char = Char +let kind_byte_size : type a b. (a, b) kind -> int = function + | Float32 -> 4 + | Float64 -> 8 + | Int8_signed -> 1 + | Int8_unsigned -> 1 + | Int16_signed -> 2 + | Int16_unsigned -> 2 + | Int32 -> 4 + | Int64 -> 8 + | Int -> Sys.word_size / 8 + | Nativeint -> Sys.word_size / 8 + | Complex32 -> 8 + | Complex64 -> 16 + | Char -> 1 + type c_layout = C_layout_typ type fortran_layout = Fortran_layout_typ @@ -90,9 +105,13 @@ module Genarray = struct let d = Array.make n 0 in for i = 0 to n-1 do d.(i) <- nth_dim a i done; d + external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" + let byte_size arr = + (kind_byte_size (kind arr)) * (Array.fold_left ( * ) 1 (dims arr)) + external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t = "caml_ba_sub" external sub_right: ('a, 'b, fortran_layout) t -> int -> int -> @@ -126,6 +145,10 @@ module Array1 = struct external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1" external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" + + let byte_size arr = + (kind_byte_size (kind arr)) * (dim arr) + external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub" external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill" @@ -156,6 +179,10 @@ module Array2 = struct external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2" external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" + + let byte_size arr = + (kind_byte_size (kind arr)) * (dim1 arr) * (dim2 arr) + external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t = "caml_ba_sub" external sub_right: @@ -203,6 +230,10 @@ module Array3 = struct external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3" external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" + + let byte_size arr = + (kind_byte_size (kind arr)) * (dim1 arr) * (dim2 arr) * (dim3 arr) + external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t = "caml_ba_sub" external sub_right: diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index a45c6799e..b3d01bad4 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -168,6 +168,9 @@ val char : (char, int8_unsigned_elt) kind characters instead of arrays of small integers, by using the kind value [char] instead of [int8_unsigned]. *) +val kind_byte_size : ('a, 'b) kind -> int +(** [kind_byte_size k] is the byte length of an element of kind [k]. *) + (** {6 Array layouts} *) type c_layout = C_layout_typ (**) @@ -280,6 +283,9 @@ module Genarray : external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) + val byte_size : ('a, 'b, 'c) t -> int + (** [byte_size a] is [a]'s byte length. *) + external get: ('a, 'b, 'c) t -> int array -> 'a = "caml_ba_get_generic" (** Read an element of a generic big array. [Genarray.get a [|i1; ...; iN|]] returns the element of [a] @@ -490,6 +496,9 @@ module Array1 : sig external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) + val byte_size : ('a, 'b, 'c) t -> int + (** [byte_size a] is [a]'s byte length. *) + external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1" (** [Array1.get a x], or alternatively [a.{x}], returns the element of [a] at index [x]. @@ -572,6 +581,9 @@ module Array2 : external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) + val byte_size : ('a, 'b, 'c) t -> int + (** [byte_size a] is [a]'s byte length. *) + external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2" (** [Array2.get a x y], also written [a.{x,y}], returns the element of [a] at coordinates ([x], [y]). @@ -678,6 +690,9 @@ module Array3 : external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) + val byte_size : ('a, 'b, 'c) t -> int + (** [byte_size a] is [a]'s byte length. *) + external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3" (** [Array3.get a x y z], also written [a.{x,y,z}], returns the element of [a] at coordinates ([x], [y], [z]). diff --git a/testsuite/tests/lib-bigarray/bigarrays.ml b/testsuite/tests/lib-bigarray/bigarrays.ml index 1f2b5ccbe..3ffd19636 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.ml +++ b/testsuite/tests/lib-bigarray/bigarrays.ml @@ -411,6 +411,12 @@ let _ = test 1 (Array1.dim (from_list int [1;2;3;4;5])) 5; test 2 (Array1.dim (from_list_fortran int [1;2;3])) 3; + testing_function "byte_size"; + test 1 (Array1.byte_size (from_list int [1;2;3;4;5])) 40; + test 2 (Array1.byte_size (from_list int [])) 0; + test 3 (Array1.byte_size (from_list int64 (List.map Int64.of_int [1;2;3;4;5]))) 40; + test 4 (Array1.byte_size (from_list int64 (List.map Int64.of_int []))) 0; + testing_function "kind & layout"; let a = from_list int [1;2;3] in test 1 (Array1.kind a) int; @@ -595,6 +601,10 @@ let _ = test 3 (Array2.dim1 b) 4; test 4 (Array2.dim2 b) 6; + testing_function "byte_size"; + let a = Array2.create int c_layout 4 6 in + test 1 (Array2.byte_size a) 192; + testing_function "sub"; let a = make_array2 int c_layout 0 5 3 id in let b = Array2.sub_left a 2 2 in @@ -746,6 +756,10 @@ let _ = test 5 (Array3.dim2 b) 5; test 6 (Array3.dim3 b) 6; + testing_function "byte_size"; + let a = Array3.create int c_layout 4 5 6 in + test 1 (Array3.byte_size a) 960; + testing_function "slice1"; let a = make_array3 int c_layout 0 3 3 3 id in test 1 (Array3.slice_left_1 a 0 0) (from_list int [0;1;2]); @@ -757,6 +771,40 @@ let _ = test 6 (Array3.slice_right_1 a 1 2) (from_list_fortran int [112;212;312]); test 7 (Array3.slice_right_1 a 3 1) (from_list_fortran int [131;231;331]); +(* Genarray byte_size *) + testing_function "byte_size"; + let a = Genarray.create int c_layout [|2;2;2;2;2|] in + test 1 (Genarray.byte_size a) 256; + +(* Kind size *) + testing_function "kind_byte_size"; + let arr1 = Array1.create Float32 c_layout 1 in + test 1 (kind_byte_size Float32) (Array1.byte_size arr1); + let arr1 = Array1.create Float64 c_layout 1 in + test 2 (kind_byte_size Float64) (Array1.byte_size arr1); + let arr1 = Array1.create Int8_signed c_layout 1 in + test 3 (kind_byte_size Int8_signed) (Array1.byte_size arr1); + let arr1 = Array1.create Int8_unsigned c_layout 1 in + test 4 (kind_byte_size Int8_unsigned) (Array1.byte_size arr1); + let arr1 = Array1.create Int16_signed c_layout 1 in + test 5 (kind_byte_size Int16_signed) (Array1.byte_size arr1); + let arr1 = Array1.create Int16_unsigned c_layout 1 in + test 6 (kind_byte_size Int16_unsigned) (Array1.byte_size arr1); + let arr1 = Array1.create Int32 c_layout 1 in + test 7 (kind_byte_size Int32) (Array1.byte_size arr1); + let arr1 = Array1.create Int64 c_layout 1 in + test 8 (kind_byte_size Int64) (Array1.byte_size arr1); + let arr1 = Array1.create Int c_layout 1 in + test 9 (kind_byte_size Int) (Array1.byte_size arr1); + let arr1 = Array1.create Nativeint c_layout 1 in + test 10 (kind_byte_size Nativeint) (Array1.byte_size arr1); + let arr1 = Array1.create Complex32 c_layout 1 in + test 11 (kind_byte_size Complex32) (Array1.byte_size arr1); + let arr1 = Array1.create Complex64 c_layout 1 in + test 12 (kind_byte_size Complex64) (Array1.byte_size arr1); + let arr1 = Array1.create Char c_layout 1 in + test 13 (kind_byte_size Char) (Array1.byte_size arr1); + (* Reshaping *) print_newline(); testing_function "------ Reshaping --------"; diff --git a/testsuite/tests/lib-bigarray/bigarrays.reference b/testsuite/tests/lib-bigarray/bigarrays.reference index af05f4ca5..66c67cfff 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.reference +++ b/testsuite/tests/lib-bigarray/bigarrays.reference @@ -11,6 +11,8 @@ comparisons 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19... 20... 21... 22... 23... 24... 25... 26... 27... 28... 29... 30... 31... 32... 44... 45... 46... 47... 48... 49... dim 1... 2... +byte_size + 1... 2... 3... 4... kind & layout 1... 2... 1... 2... sub @@ -28,6 +30,8 @@ set/get (unsafe, specialized) 1... 2... dim 1... 2... 3... 4... +byte_size + 1... sub 1... 2... slice @@ -43,8 +47,14 @@ set/get (unsafe, specialized) 1... dim 1... 2... 3... 4... 5... 6... +byte_size + 1... slice1 1... 2... 3... 4... 5... 6... 7... +byte_size + 1... +kind_byte_size + 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... ------ Reshaping -------- From aacf9f6c4604951b39e114d9ddfc7c37dd583ac7 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Wed, 14 Oct 2015 08:18:56 -0700 Subject: [PATCH 121/145] Update changelog --- Changes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Changes b/Changes index 1f931b942..0865a0193 100644 --- a/Changes +++ b/Changes @@ -285,6 +285,8 @@ Other libraries: Before, a handled signal could cause Unix.sleep to return early. Now, the sleep is restarted until the given time is elapsed. (Xavier Leroy) +- PR#6263: add kind_byte_size and byte_size functions to Bigarray module. + (Runhang Li) - PR#6289: Unix.utimes uses the current time only if both arguments are exactly 0.0. Also, use sub-second resolution if available. (Xavier Leroy, report by Christophe Troestler) From 829dea35a4ac328efac74e070d4ed543e11aabcc Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Thu, 19 Nov 2015 18:18:09 -0800 Subject: [PATCH 122/145] Change function names, improve documentation. Change ``byte_size'' to ``size_in_bytes``, change ``kind_byte_size`` to ``kind_size_in_bytes``. Add detailed comment indicating size functions do not consider header of OCaml value. --- otherlibs/bigarray/bigarray.ml | 18 +++---- otherlibs/bigarray/bigarray.mli | 25 +++++---- testsuite/tests/lib-bigarray/bigarrays.ml | 51 +++++++++---------- .../tests/lib-bigarray/bigarrays.reference | 10 ++-- 4 files changed, 54 insertions(+), 50 deletions(-) diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml index be7f7f5ea..039e09c31 100644 --- a/otherlibs/bigarray/bigarray.ml +++ b/otherlibs/bigarray/bigarray.ml @@ -62,7 +62,7 @@ let complex32 = Complex32 let complex64 = Complex64 let char = Char -let kind_byte_size : type a b. (a, b) kind -> int = function +let kind_size_in_bytes : type a b. (a, b) kind -> int = function | Float32 -> 4 | Float64 -> 8 | Int8_signed -> 1 @@ -109,8 +109,8 @@ module Genarray = struct external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" - let byte_size arr = - (kind_byte_size (kind arr)) * (Array.fold_left ( * ) 1 (dims arr)) + let size_in_bytes arr = + (kind_size_in_bytes (kind arr)) * (Array.fold_left ( * ) 1 (dims arr)) external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t = "caml_ba_sub" @@ -146,8 +146,8 @@ module Array1 = struct external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" - let byte_size arr = - (kind_byte_size (kind arr)) * (dim arr) + let size_in_bytes arr = + (kind_size_in_bytes (kind arr)) * (dim arr) external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub" external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" @@ -180,8 +180,8 @@ module Array2 = struct external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" - let byte_size arr = - (kind_byte_size (kind arr)) * (dim1 arr) * (dim2 arr) + let size_in_bytes arr = + (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr) external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t = "caml_ba_sub" @@ -231,8 +231,8 @@ module Array3 = struct external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" - let byte_size arr = - (kind_byte_size (kind arr)) * (dim1 arr) * (dim2 arr) * (dim3 arr) + let size_in_bytes arr = + (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr) * (dim3 arr) external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t = "caml_ba_sub" diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index b3d01bad4..751051827 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -168,8 +168,9 @@ val char : (char, int8_unsigned_elt) kind characters instead of arrays of small integers, by using the kind value [char] instead of [int8_unsigned]. *) -val kind_byte_size : ('a, 'b) kind -> int -(** [kind_byte_size k] is the byte length of an element of kind [k]. *) +val kind_size_in_bytes : ('a, 'b) kind -> int +(** [kind_size_in_bytes k] is the number of bytes used to store + an element of type [k]. *) (** {6 Array layouts} *) @@ -283,8 +284,9 @@ module Genarray : external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) - val byte_size : ('a, 'b, 'c) t -> int - (** [byte_size a] is [a]'s byte length. *) + val size_in_bytes : ('a, 'b, 'c) t -> int + (** [size_in_bytes a] is the number of elements in [a] multiplied + by [a]'s {!kind_size_in_bytes}.*) external get: ('a, 'b, 'c) t -> int array -> 'a = "caml_ba_get_generic" (** Read an element of a generic big array. @@ -496,8 +498,9 @@ module Array1 : sig external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) - val byte_size : ('a, 'b, 'c) t -> int - (** [byte_size a] is [a]'s byte length. *) + val size_in_bytes : ('a, 'b, 'c) t -> int + (** [size_in_bytes a] is the number of elements in [a] + multiplied by [a]'s {!kind_size_in_bytes}. *) external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1" (** [Array1.get a x], or alternatively [a.{x}], @@ -581,8 +584,9 @@ module Array2 : external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) - val byte_size : ('a, 'b, 'c) t -> int - (** [byte_size a] is [a]'s byte length. *) + val size_in_bytes : ('a, 'b, 'c) t -> int + (** [[size_in_bytes a] is the number of elements in [a] + multiplied by [a]'s {!kind_size_in_bytes}. *) external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2" (** [Array2.get a x y], also written [a.{x,y}], @@ -690,8 +694,9 @@ module Array3 : external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) - val byte_size : ('a, 'b, 'c) t -> int - (** [byte_size a] is [a]'s byte length. *) + val size_in_bytes : ('a, 'b, 'c) t -> int + (** [size_in_bytes a] is the number of elements in [a] + multiplied by [a]'s {!kind_size_in_bytes}. *) external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3" (** [Array3.get a x y z], also written [a.{x,y,z}], diff --git a/testsuite/tests/lib-bigarray/bigarrays.ml b/testsuite/tests/lib-bigarray/bigarrays.ml index 3ffd19636..04e5b5bda 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.ml +++ b/testsuite/tests/lib-bigarray/bigarrays.ml @@ -411,11 +411,11 @@ let _ = test 1 (Array1.dim (from_list int [1;2;3;4;5])) 5; test 2 (Array1.dim (from_list_fortran int [1;2;3])) 3; - testing_function "byte_size"; - test 1 (Array1.byte_size (from_list int [1;2;3;4;5])) 40; - test 2 (Array1.byte_size (from_list int [])) 0; - test 3 (Array1.byte_size (from_list int64 (List.map Int64.of_int [1;2;3;4;5]))) 40; - test 4 (Array1.byte_size (from_list int64 (List.map Int64.of_int []))) 0; + testing_function "size_in_bytes_one"; + test 1 (Array1.size_in_bytes (from_list int [1;2;3;4;5])) 40; + test 2 (Array1.size_in_bytes (from_list int [])) 0; + test 3 (Array1.size_in_bytes (from_list int64 (List.map Int64.of_int [1;2;3;4;5]))) 40; + test 4 (Array1.size_in_bytes (from_list int64 (List.map Int64.of_int []))) 0; testing_function "kind & layout"; let a = from_list int [1;2;3] in @@ -601,9 +601,9 @@ let _ = test 3 (Array2.dim1 b) 4; test 4 (Array2.dim2 b) 6; - testing_function "byte_size"; + testing_function "size_in_bytes_two"; let a = Array2.create int c_layout 4 6 in - test 1 (Array2.byte_size a) 192; + test 1 (Array2.size_in_bytes a) 192; testing_function "sub"; let a = make_array2 int c_layout 0 5 3 id in @@ -756,9 +756,9 @@ let _ = test 5 (Array3.dim2 b) 5; test 6 (Array3.dim3 b) 6; - testing_function "byte_size"; + testing_function "size_in_bytes_three"; let a = Array3.create int c_layout 4 5 6 in - test 1 (Array3.byte_size a) 960; + test 1 (Array3.size_in_bytes a) 960; testing_function "slice1"; let a = make_array3 int c_layout 0 3 3 3 id in @@ -771,39 +771,38 @@ let _ = test 6 (Array3.slice_right_1 a 1 2) (from_list_fortran int [112;212;312]); test 7 (Array3.slice_right_1 a 3 1) (from_list_fortran int [131;231;331]); -(* Genarray byte_size *) - testing_function "byte_size"; + testing_function "size_in_bytes_general"; let a = Genarray.create int c_layout [|2;2;2;2;2|] in - test 1 (Genarray.byte_size a) 256; + test 1 (Genarray.size_in_bytes a) 256; (* Kind size *) - testing_function "kind_byte_size"; + testing_function "kind_size_in_bytes"; let arr1 = Array1.create Float32 c_layout 1 in - test 1 (kind_byte_size Float32) (Array1.byte_size arr1); + test 1 (kind_size_in_bytes Float32) (Array1.size_in_bytes arr1); let arr1 = Array1.create Float64 c_layout 1 in - test 2 (kind_byte_size Float64) (Array1.byte_size arr1); + test 2 (kind_size_in_bytes Float64) (Array1.size_in_bytes arr1); let arr1 = Array1.create Int8_signed c_layout 1 in - test 3 (kind_byte_size Int8_signed) (Array1.byte_size arr1); + test 3 (kind_size_in_bytes Int8_signed) (Array1.size_in_bytes arr1); let arr1 = Array1.create Int8_unsigned c_layout 1 in - test 4 (kind_byte_size Int8_unsigned) (Array1.byte_size arr1); + test 4 (kind_size_in_bytes Int8_unsigned) (Array1.size_in_bytes arr1); let arr1 = Array1.create Int16_signed c_layout 1 in - test 5 (kind_byte_size Int16_signed) (Array1.byte_size arr1); + test 5 (kind_size_in_bytes Int16_signed) (Array1.size_in_bytes arr1); let arr1 = Array1.create Int16_unsigned c_layout 1 in - test 6 (kind_byte_size Int16_unsigned) (Array1.byte_size arr1); + test 6 (kind_size_in_bytes Int16_unsigned) (Array1.size_in_bytes arr1); let arr1 = Array1.create Int32 c_layout 1 in - test 7 (kind_byte_size Int32) (Array1.byte_size arr1); + test 7 (kind_size_in_bytes Int32) (Array1.size_in_bytes arr1); let arr1 = Array1.create Int64 c_layout 1 in - test 8 (kind_byte_size Int64) (Array1.byte_size arr1); + test 8 (kind_size_in_bytes Int64) (Array1.size_in_bytes arr1); let arr1 = Array1.create Int c_layout 1 in - test 9 (kind_byte_size Int) (Array1.byte_size arr1); + test 9 (kind_size_in_bytes Int) (Array1.size_in_bytes arr1); let arr1 = Array1.create Nativeint c_layout 1 in - test 10 (kind_byte_size Nativeint) (Array1.byte_size arr1); + test 10 (kind_size_in_bytes Nativeint) (Array1.size_in_bytes arr1); let arr1 = Array1.create Complex32 c_layout 1 in - test 11 (kind_byte_size Complex32) (Array1.byte_size arr1); + test 11 (kind_size_in_bytes Complex32) (Array1.size_in_bytes arr1); let arr1 = Array1.create Complex64 c_layout 1 in - test 12 (kind_byte_size Complex64) (Array1.byte_size arr1); + test 12 (kind_size_in_bytes Complex64) (Array1.size_in_bytes arr1); let arr1 = Array1.create Char c_layout 1 in - test 13 (kind_byte_size Char) (Array1.byte_size arr1); + test 13 (kind_size_in_bytes Char) (Array1.size_in_bytes arr1); (* Reshaping *) print_newline(); diff --git a/testsuite/tests/lib-bigarray/bigarrays.reference b/testsuite/tests/lib-bigarray/bigarrays.reference index 66c67cfff..40ab1ec49 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.reference +++ b/testsuite/tests/lib-bigarray/bigarrays.reference @@ -11,7 +11,7 @@ comparisons 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19... 20... 21... 22... 23... 24... 25... 26... 27... 28... 29... 30... 31... 32... 44... 45... 46... 47... 48... 49... dim 1... 2... -byte_size +size_in_bytes_one 1... 2... 3... 4... kind & layout 1... 2... 1... 2... @@ -30,7 +30,7 @@ set/get (unsafe, specialized) 1... 2... dim 1... 2... 3... 4... -byte_size +size_in_bytes_two 1... sub 1... 2... @@ -47,13 +47,13 @@ set/get (unsafe, specialized) 1... dim 1... 2... 3... 4... 5... 6... -byte_size +size_in_bytes_three 1... slice1 1... 2... 3... 4... 5... 6... 7... -byte_size +size_in_bytes_general 1... -kind_byte_size +kind_size_in_bytes 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... ------ Reshaping -------- From a62ab0e163af88ab316c3e10aa2cb1133d9b2df7 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Thu, 19 Nov 2015 18:27:38 -0800 Subject: [PATCH 123/145] Update Changelog --- Changes | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index 0865a0193..5ee74b89a 100644 --- a/Changes +++ b/Changes @@ -285,7 +285,8 @@ Other libraries: Before, a handled signal could cause Unix.sleep to return early. Now, the sleep is restarted until the given time is elapsed. (Xavier Leroy) -- PR#6263: add kind_byte_size and byte_size functions to Bigarray module. +- PR#6263: add kind_size_in_bytes and size_in_bytes functions + to Bigarray module. (Runhang Li) - PR#6289: Unix.utimes uses the current time only if both arguments are exactly 0.0. Also, use sub-second resolution if available. From 0544aac0af61325c6bdd4e2917ed7fd1acda9cc9 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Sun, 22 Nov 2015 10:10:59 -0800 Subject: [PATCH 124/145] Add Shinwell as reviewer --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 5ee74b89a..cde16fcac 100644 --- a/Changes +++ b/Changes @@ -287,7 +287,7 @@ Other libraries: (Xavier Leroy) - PR#6263: add kind_size_in_bytes and size_in_bytes functions to Bigarray module. - (Runhang Li) + (Runhang Li, review by Mark Shinwell) - PR#6289: Unix.utimes uses the current time only if both arguments are exactly 0.0. Also, use sub-second resolution if available. (Xavier Leroy, report by Christophe Troestler) From 2ef65ed2aa6cb51b4b4f7506cd72f8ae77bb9514 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Tue, 24 Nov 2015 10:06:57 -0800 Subject: [PATCH 125/145] Fix test Several tests will fail on 32-bit machine. --- testsuite/tests/lib-bigarray/bigarrays.ml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/lib-bigarray/bigarrays.ml b/testsuite/tests/lib-bigarray/bigarrays.ml index 04e5b5bda..c37571ff3 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.ml +++ b/testsuite/tests/lib-bigarray/bigarrays.ml @@ -412,9 +412,11 @@ let _ = test 2 (Array1.dim (from_list_fortran int [1;2;3])) 3; testing_function "size_in_bytes_one"; - test 1 (Array1.size_in_bytes (from_list int [1;2;3;4;5])) 40; + test 1 (Array1.size_in_bytes (from_list int [1;2;3;4;5])) + (5 * (kind_size_in_bytes int)); test 2 (Array1.size_in_bytes (from_list int [])) 0; - test 3 (Array1.size_in_bytes (from_list int64 (List.map Int64.of_int [1;2;3;4;5]))) 40; + let int64list = (from_list int64 (List.map Int64.of_int [1;2;3;4;5])) in + test 3 (Array1.size_in_bytes int64list) (5 * (kind_size_in_bytes int64)); test 4 (Array1.size_in_bytes (from_list int64 (List.map Int64.of_int []))) 0; testing_function "kind & layout"; @@ -603,7 +605,7 @@ let _ = testing_function "size_in_bytes_two"; let a = Array2.create int c_layout 4 6 in - test 1 (Array2.size_in_bytes a) 192; + test 1 (Array2.size_in_bytes a) (24 * (kind_size_in_bytes int)); testing_function "sub"; let a = make_array2 int c_layout 0 5 3 id in @@ -758,7 +760,7 @@ let _ = testing_function "size_in_bytes_three"; let a = Array3.create int c_layout 4 5 6 in - test 1 (Array3.size_in_bytes a) 960; + test 1 (Array3.size_in_bytes a) (120 * (kind_size_in_bytes int)); testing_function "slice1"; let a = make_array3 int c_layout 0 3 3 3 id in @@ -773,7 +775,7 @@ let _ = testing_function "size_in_bytes_general"; let a = Genarray.create int c_layout [|2;2;2;2;2|] in - test 1 (Genarray.size_in_bytes a) 256; + test 1 (Genarray.size_in_bytes a) (32 * (kind_size_in_bytes int)); (* Kind size *) testing_function "kind_size_in_bytes"; From 9e8facef9c8d17f8451b259fd0174ed26905a8e0 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 27 Jan 2016 18:40:54 +0000 Subject: [PATCH 126/145] typo --- otherlibs/bigarray/bigarray.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index 751051827..d45fb8050 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -585,7 +585,7 @@ module Array2 : (** Return the layout of the given big array. *) val size_in_bytes : ('a, 'b, 'c) t -> int - (** [[size_in_bytes a] is the number of elements in [a] + (** [size_in_bytes a] is the number of elements in [a] multiplied by [a]'s {!kind_size_in_bytes}. *) external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2" From d8704f6ba83d696e8b6e6f42a399ff48777ec75e Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 4 Jan 2016 12:57:37 +0000 Subject: [PATCH 127/145] Add module Ast_invariants This module checks all the AST invariants. This is to ensure that all invariants are written down in one place and are consistently checked between the various clients of the AST (typer, pprintast, ...). The invariants are checked in Pparsee, after applying the ppx rewriters. --- .depend | 9 ++- Makefile.shared | 2 +- driver/pparse.ml | 15 +++- parsing/ast_invariants.ml | 158 +++++++++++++++++++++++++++++++++++++ parsing/ast_invariants.mli | 18 +++++ tools/Makefile.shared | 3 +- 6 files changed, 197 insertions(+), 8 deletions(-) create mode 100644 parsing/ast_invariants.ml create mode 100644 parsing/ast_invariants.mli diff --git a/.depend b/.depend index f2c604aac..8ffdb57f8 100644 --- a/.depend +++ b/.depend @@ -45,6 +45,7 @@ utils/warnings.cmo : utils/warnings.cmi utils/warnings.cmx : utils/warnings.cmi parsing/ast_helper.cmi : parsing/parsetree.cmi parsing/longident.cmi \ parsing/location.cmi parsing/docstrings.cmi parsing/asttypes.cmi +parsing/ast_invariants.cmi : parsing/parsetree.cmi parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/asttypes.cmi : parsing/location.cmi parsing/attr_helper.cmi : parsing/parsetree.cmi parsing/location.cmi \ @@ -70,6 +71,10 @@ parsing/ast_helper.cmo : parsing/parsetree.cmi parsing/longident.cmi \ parsing/ast_helper.cmx : parsing/parsetree.cmi parsing/longident.cmx \ parsing/location.cmx parsing/docstrings.cmx parsing/asttypes.cmi \ parsing/ast_helper.cmi +parsing/ast_invariants.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \ + parsing/ast_mapper.cmi parsing/ast_invariants.cmi +parsing/ast_invariants.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \ + parsing/ast_mapper.cmx parsing/ast_invariants.cmi parsing/ast_mapper.cmo : parsing/parsetree.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi utils/config.cmi \ utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \ @@ -1895,10 +1900,10 @@ driver/optmain.cmx : utils/warnings.cmx utils/timings.cmx \ asmcomp/arch.cmx driver/optmain.cmi driver/pparse.cmo : utils/timings.cmi parsing/parse.cmi utils/misc.cmi \ parsing/location.cmi utils/config.cmi utils/clflags.cmi utils/ccomp.cmi \ - parsing/ast_mapper.cmi driver/pparse.cmi + parsing/ast_mapper.cmi parsing/ast_invariants.cmi driver/pparse.cmi driver/pparse.cmx : utils/timings.cmx parsing/parse.cmx utils/misc.cmx \ parsing/location.cmx utils/config.cmx utils/clflags.cmx utils/ccomp.cmx \ - parsing/ast_mapper.cmx driver/pparse.cmi + parsing/ast_mapper.cmx parsing/ast_invariants.cmx driver/pparse.cmi toplevel/genprintval.cmi : typing/types.cmi typing/path.cmi \ typing/outcometree.cmi typing/env.cmi toplevel/opttopdirs.cmi : parsing/longident.cmi diff --git a/Makefile.shared b/Makefile.shared index 3ab908d3c..e3ffa95b6 100755 --- a/Makefile.shared +++ b/Makefile.shared @@ -49,7 +49,7 @@ PARSING=parsing/location.cmo parsing/longident.cmo \ parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \ parsing/pprintast.cmo \ parsing/ast_mapper.cmo parsing/attr_helper.cmo \ - parsing/builtin_attributes.cmo + parsing/builtin_attributes.cmo parsing/ast_invariants.cmo TYPING=typing/ident.cmo typing/path.cmo \ typing/primitive.cmo typing/types.cmo \ diff --git a/driver/pparse.ml b/driver/pparse.ml index d8f57ec3d..eea40abe9 100644 --- a/driver/pparse.ml +++ b/driver/pparse.ml @@ -145,7 +145,7 @@ let open_and_check_magic inputfile ast_magic = in (ic, is_ast_file) -let file ppf ~tool_name inputfile parse_fun ast_magic = +let file_aux ppf ~tool_name inputfile parse_fun invariant_fun ast_magic = let (ic, is_ast_file) = open_and_check_magic inputfile ast_magic in let ast = try @@ -166,7 +166,12 @@ let file ppf ~tool_name inputfile parse_fun ast_magic = with x -> close_in ic; raise x in close_in ic; - apply_rewriters ~restore:false ~tool_name ast_magic ast + let ast = apply_rewriters ~restore:false ~tool_name ast_magic ast in + if is_ast_file || !Clflags.all_ppx <> [] then invariant_fun ast; + ast + +let file ppf ~tool_name inputfile parse_fun ast_magic = + file_aux ppf ~tool_name inputfile parse_fun ignore ast_magic let report_error ppf = function | CannotRun cmd -> @@ -183,11 +188,11 @@ let () = | _ -> None ) -let parse_all ~tool_name parse_fun magic ppf sourcefile = +let parse_all ~tool_name parse_fun invariant_fun magic ppf sourcefile = Location.input_name := sourcefile; let inputfile = preprocess sourcefile in let ast = - try file ppf ~tool_name inputfile parse_fun magic + try file_aux ppf ~tool_name inputfile parse_fun invariant_fun magic with exn -> remove_preprocessed inputfile; raise exn @@ -198,8 +203,10 @@ let parse_all ~tool_name parse_fun magic ppf sourcefile = let parse_implementation ppf ~tool_name sourcefile = parse_all ~tool_name (Timings.(time (Parsing sourcefile)) Parse.implementation) + Ast_invariants.structure Config.ast_impl_magic_number ppf sourcefile let parse_interface ppf ~tool_name sourcefile = parse_all ~tool_name (Timings.(time (Parsing sourcefile)) Parse.interface) + Ast_invariants.signature Config.ast_intf_magic_number ppf sourcefile diff --git a/parsing/ast_invariants.ml b/parsing/ast_invariants.ml new file mode 100644 index 000000000..5bab8a07d --- /dev/null +++ b/parsing/ast_invariants.ml @@ -0,0 +1,158 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Jeremie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2015 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) +(* *) +(***********************************************************************) + +open Asttypes +open Parsetree +open Ast_mapper + +let err = Syntaxerr.ill_formed_ast + +let empty_record loc = err loc "Records cannot be empty." +let empty_variant loc = err loc "Variant types cannot be empty." +let invalid_tuple loc = err loc "Tuples must have at least 2 components." +let no_args loc = err loc "Function application with no argument." +let empty_let loc = err loc "Let with no bindings." +let empty_type loc = err loc "Type declarations cannot be empty." +let complex_id loc = err loc "Functor application not allowed here." + +let simple_longident id = + let rec is_simple = function + | Longident.Lident _ -> true + | Longident.Ldot (id, _) -> is_simple id + | Longident.Lapply _ -> false + in + if not (is_simple id.txt) then complex_id id.loc + +let mapper = + let super = Ast_mapper.default_mapper in + let type_declaration self td = + let td = super.type_declaration self td in + let loc = td.ptype_loc in + match td.ptype_kind with + | Ptype_record [] -> empty_record loc + | Ptype_variant [] -> empty_variant loc + | _ -> td + in + let typ self ty = + let ty = super.typ self ty in + let loc = ty.ptyp_loc in + match ty.ptyp_desc with + | Ptyp_tuple ([] | [_]) -> invalid_tuple loc + | Ptyp_class (id, _) -> simple_longident id; ty + | Ptyp_package (_, cstrs) -> + List.iter (fun (id, _) -> simple_longident id) cstrs; + ty + | _ -> ty + in + let pat self pat = + let pat = super.pat self pat in + let loc = pat.ppat_loc in + match pat.ppat_desc with + | Ppat_tuple ([] | [_]) -> invalid_tuple loc + | Ppat_record ([], _) -> empty_record loc + | Ppat_construct (id, _) -> simple_longident id; pat + | Ppat_record (fields, _) -> + List.iter (fun (id, _) -> simple_longident id) fields; + pat + | _ -> pat + in + let expr self exp = + let exp = super.expr self exp in + let loc = exp.pexp_loc in + match exp.pexp_desc with + | Pexp_tuple ([] | [_]) -> invalid_tuple loc + | Pexp_record ([], _) -> empty_record loc + | Pexp_apply (_, []) -> no_args loc + | Pexp_let (_, [], _) -> empty_let loc + | Pexp_ident id + | Pexp_construct (id, _) + | Pexp_field (_, id) + | Pexp_setfield (_, id, _) + | Pexp_new id + | Pexp_open (_, id, _) -> simple_longident id; exp + | Pexp_record (fields, _) -> + List.iter (fun (id, _) -> simple_longident id) fields; + exp + | _ -> exp + in + let extension_constructor self ec = + let ec = super.extension_constructor self ec in + match ec.pext_kind with + | Pext_rebind id -> simple_longident id; ec + | _ -> ec + in + let class_expr self ce = + let ce = super.class_expr self ce in + let loc = ce.pcl_loc in + match ce.pcl_desc with + | Pcl_apply (_, []) -> no_args loc + | Pcl_constr (id, _) -> simple_longident id; ce + | _ -> ce + in + let module_type self mty = + let mty = super.module_type self mty in + match mty.pmty_desc with + | Pmty_alias id -> simple_longident id; mty + | _ -> mty + in + let open_description self opn = + let opn = super.open_description self opn in + simple_longident opn.popen_lid; + opn + in + let with_constraint self wc = + let wc = super.with_constraint self wc in + match wc with + | Pwith_type (id, _) + | Pwith_module (id, _) -> simple_longident id; wc + | _ -> wc + in + let module_expr self me = + let me = super.module_expr self me in + match me.pmod_desc with + | Pmod_ident id -> simple_longident id; me + | _ -> me + in + let structure_item self st = + let st = super.structure_item self st in + let loc = st.pstr_loc in + match st.pstr_desc with + | Pstr_type (_, []) -> empty_type loc + | Pstr_value (_, []) -> empty_let loc + | _ -> st + in + let signature_item self sg = + let sg = super.signature_item self sg in + let loc = sg.psig_loc in + match sg.psig_desc with + | Psig_type (_, []) -> empty_type loc + | _ -> sg + in + { super with + type_declaration + ; typ + ; pat + ; expr + ; extension_constructor + ; class_expr + ; module_expr + ; module_type + ; open_description + ; with_constraint + ; structure_item + ; signature_item + } + +let structure st = ignore (mapper.structure mapper st : structure) +let signature sg = ignore (mapper.signature mapper sg : signature) diff --git a/parsing/ast_invariants.mli b/parsing/ast_invariants.mli new file mode 100644 index 000000000..15d905dcf --- /dev/null +++ b/parsing/ast_invariants.mli @@ -0,0 +1,18 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Jeremie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2015 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) +(* *) +(***********************************************************************) + +(** Check AST invariants *) + +val structure : Parsetree.structure -> unit +val signature : Parsetree.signature -> unit diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 0fa8b5052..f0074a605 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -39,7 +39,8 @@ CAMLDEP_IMPORTS=timings.cmo misc.cmo config.cmo identifiable.cmo numbers.cmo \ arg_helper.cmo clflags.cmo terminfo.cmo \ warnings.cmo location.cmo longident.cmo docstrings.cmo \ syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \ - ccomp.cmo ast_mapper.cmo pparse.cmo compenv.cmo builtin_attributes.cmo + ccomp.cmo ast_mapper.cmo ast_invariants.cmo pparse.cmo compenv.cmo \ + builtin_attributes.cmo ocamldep: depend.cmi $(CAMLDEP_OBJ) $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamldep $(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ) From 4ee998dbb442368571e269f64c62e2a99f90dff5 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 25 Jan 2016 17:10:55 +0000 Subject: [PATCH 128/145] Add tests for Ast_invariants --- testsuite/tests/ast-invariants/Makefile | 26 +++++++ testsuite/tests/ast-invariants/test.ml | 67 +++++++++++++++++++ testsuite/tests/ast-invariants/test.reference | 0 3 files changed, 93 insertions(+) create mode 100644 testsuite/tests/ast-invariants/Makefile create mode 100644 testsuite/tests/ast-invariants/test.ml create mode 100644 testsuite/tests/ast-invariants/test.reference diff --git a/testsuite/tests/ast-invariants/Makefile b/testsuite/tests/ast-invariants/Makefile new file mode 100644 index 000000000..25c139432 --- /dev/null +++ b/testsuite/tests/ast-invariants/Makefile @@ -0,0 +1,26 @@ +######################################################################### +# # +# OCaml # +# # +# Jeremie Dimino, Jane Street Europe # +# # +# Copyright 2015 Jane Street Group LLC # +# # +# All rights reserved. This file is distributed under the terms of # +# the GNU Lesser General Public License version 2.1, with the # +# special exception on linking described in the file ../LICENSE. # +# # +######################################################################### + +BASEDIR=../.. +COMPFLAGS=-I $(TOPDIR)/parsing -I $(TOPDIR)/utils +LIBRARIES=$(TOPDIR)/compilerlibs/ocamlcommon +MODULES= +MAIN_MODULE=test + +include $(BASEDIR)/makefiles/Makefile.one +include $(BASEDIR)/makefiles/Makefile.common + +# This test is a bit slow and there is little value in testing both +# versions so we run only the native code one: +NATIVECODE_ONLY=true diff --git a/testsuite/tests/ast-invariants/test.ml b/testsuite/tests/ast-invariants/test.ml new file mode 100644 index 000000000..f30733c0a --- /dev/null +++ b/testsuite/tests/ast-invariants/test.ml @@ -0,0 +1,67 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Jeremie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2015 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) +(* *) +(***********************************************************************) + +(* This test checks all ml files in the ocaml repository that are accepted + by the parser satisfy [Ast_invariants]. + + We don't check the invariants on the output of the parser, so this test + is to ensure that we the parser doesn't accept more than [Ast_invariants]. +*) + +let root = "../../.." +let () = assert (Sys.file_exists (Filename.concat root "VERSION")) + +type _ kind = + | Implem : Parsetree.structure kind + | Interf : Parsetree.signature kind + +let parse : type a. a kind -> Lexing.lexbuf -> a = function + | Implem -> Parse.implementation + | Interf -> Parse.interface + +let invariants : type a. a kind -> a -> unit = function + | Implem -> Ast_invariants.structure + | Interf -> Ast_invariants.signature + +let check_file kind fn = + Warnings.parse_options false "-a"; + let ic = open_in fn in + Location.input_name := fn; + let lexbuf = Lexing.from_channel ic in + Location.init lexbuf fn; + match parse kind lexbuf with + | exception _ -> + (* A few files don't parse as they are meant for the toplevel; + ignore them *) + close_in ic + | ast -> + close_in ic; + try + invariants kind ast + with exn -> + Location.report_exception Format.std_formatter exn + +let rec walk dir = + Array.iter + (fun fn -> + let fn = Filename.concat dir fn in + if Sys.is_directory fn then + walk fn + else if Filename.check_suffix fn ".mli" then + check_file Interf fn + else if Filename.check_suffix fn ".ml" then + check_file Implem fn) + (Sys.readdir dir) + +let () = walk root diff --git a/testsuite/tests/ast-invariants/test.reference b/testsuite/tests/ast-invariants/test.reference new file mode 100644 index 000000000..e69de29bb From 43111b38cd599d29d79fb1a7495c3272ba451ad8 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 4 Jan 2016 13:07:38 +0000 Subject: [PATCH 129/145] Replace uses of [Syntaxerr.ill_formed_ast] by asserts All invariants are already checked by [Ast_invariants] --- typing/typeclass.ml | 4 +--- typing/typecore.ml | 15 +++++---------- typing/typedecl.ml | 7 ++----- typing/typetexp.ml | 3 +-- 4 files changed, 9 insertions(+), 20 deletions(-) diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 0597a0dd1..c5965caba 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -980,9 +980,7 @@ and class_expr cl_num val_env met_env scl = cl_attributes = scl.pcl_attributes; } | Pcl_apply (scl', sargs) -> - if sargs = [] then - Syntaxerr.ill_formed_ast scl.pcl_loc - "Function application with no argument."; + assert (sargs <> []); if !Clflags.principal then Ctype.begin_def (); let cl = class_expr cl_num val_env met_env scl' in if !Clflags.principal then begin diff --git a/typing/typecore.ml b/typing/typecore.ml index 5853fab9e..62835302e 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -1087,8 +1087,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~explode ~env | Ppat_interval _ -> raise (Error (loc, !env, Invalid_interval)) | Ppat_tuple spl -> - if List.length spl < 2 then - Syntaxerr.ill_formed_ast loc "Tuples must have at least 2 components."; + assert (List.length spl >= 2); let spl_ann = List.map (fun p -> (p,newvar ())) spl in let ty = newty (Ttuple(List.map snd spl_ann)) in unify_pat_types loc !env ty expected_ty; @@ -1210,8 +1209,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~explode ~env | _ -> k None end | Ppat_record(lid_sp_list, closed) -> - if lid_sp_list = [] then - Syntaxerr.ill_formed_ast loc "Records cannot be empty."; + assert (lid_sp_list <> []); let opath, record_ty = try let (p0, p,_) = extract_concrete_record !env expected_ty in @@ -2065,8 +2063,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = type_function ?in_function loc sexp.pexp_attributes env ty_expected Nolabel caselist | Pexp_apply(sfunct, sargs) -> - if sargs = [] then - Syntaxerr.ill_formed_ast loc "Function application with no argument."; + assert (sargs <> []); begin_def (); (* one more level for non-returning functions *) if !Clflags.principal then begin_def (); let funct = type_exp env sfunct in @@ -2136,8 +2133,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = exp_attributes = sexp.pexp_attributes; exp_env = env } | Pexp_tuple sexpl -> - if List.length sexpl < 2 then - Syntaxerr.ill_formed_ast loc "Tuples must have at least 2 components."; + assert (List.length sexpl >= 2); let subtypes = List.map (fun _ -> newgenvar ()) sexpl in let to_unify = newgenty (Ttuple subtypes) in unify_exp_types loc env to_unify ty_expected; @@ -2188,8 +2184,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = exp_env = env } end | Pexp_record(lid_sexp_list, opt_sexp) -> - if lid_sexp_list = [] then - Syntaxerr.ill_formed_ast loc "Records cannot be empty."; + assert (lid_sexp_list <> []); let opt_exp = match opt_sexp with None -> None diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 049df3e48..1b9fad07c 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -153,8 +153,7 @@ let make_params env params = List.map make_param params let transl_labels loc env closed lbls = - if lbls = [] then - Syntaxerr.ill_formed_ast loc "Records cannot be empty."; + assert (lbls <> []); let all_labels = ref StringSet.empty in List.iter (fun {pld_name = {txt=name; loc}} -> @@ -238,9 +237,7 @@ let transl_declaration env sdecl id = match sdecl.ptype_kind with Ptype_abstract -> Ttype_abstract, Type_abstract | Ptype_variant scstrs -> - if scstrs = [] then - Syntaxerr.ill_formed_ast sdecl.ptype_loc - "Variant types cannot be empty."; + assert (scstrs <> []); let all_constrs = ref StringSet.empty in List.iter (fun {pcd_name = {txt = name}} -> diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 7324dea10..0dbad0356 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -331,8 +331,7 @@ let rec transl_type env policy styp = let ty = newty (Tarrow(l, ty1, cty2.ctyp_type, Cok)) in ctyp (Ttyp_arrow (l, cty1, cty2)) ty | Ptyp_tuple stl -> - if List.length stl < 2 then - Syntaxerr.ill_formed_ast loc "Tuples must have at least 2 components."; + assert (List.length stl >= 2); let ctys = List.map (transl_type env policy) stl in let ty = newty (Ttuple (List.map (fun ctyp -> ctyp.ctyp_type) ctys)) in ctyp (Ttyp_tuple ctys) ty From f9ebe43e75f65e7f637f67106b9525aadefbcd89 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 4 Jan 2016 14:06:30 +0000 Subject: [PATCH 130/145] update Changes --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index cde16fcac..d0bf1a5c9 100644 --- a/Changes +++ b/Changes @@ -147,6 +147,8 @@ Compilers: (David Allsopp) - GPR#431: permit constant float arrays to be eligible for pattern match branch merging (Pierre Chambart) +- GPR#392: put all parsetree invariants in a new module Ast_invariants + (Jérémie Dimino) Runtime system: - PR#3612: allow allocating custom block with finalizers in the minor heap @@ -473,6 +475,8 @@ Bug fixes: (David Allsopp) - GPR#441: better type error location in presence of type constraints (Thomas Refis, report by Arseniy Alekseyev) +- PR#7111: reject empty let bindings instead of printing incorrect syntax + (Jérémie Dimino) Features wishes: - PR#4518, GPR#29: change location format for reporting errors in ocamldoc From 3878b84d8b8ebfa75522a50e925a8bfccb32fd5a Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Wed, 27 Jan 2016 22:47:31 +0100 Subject: [PATCH 131/145] Fix for Windows following merge of GPR#22. --- byterun/caml/minor_gc.h | 3 ++- byterun/minor_gc.c | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/byterun/caml/minor_gc.h b/byterun/caml/minor_gc.h index 668cb2faa..6e46a5e10 100644 --- a/byterun/caml/minor_gc.h +++ b/byterun/caml/minor_gc.h @@ -77,11 +77,12 @@ static inline void add_to_ref_table (struct caml_ref_table *tbl, value *p) static inline void add_to_ephe_ref_table (struct caml_ephe_ref_table *tbl, value ar, mlsize_t offset) { + struct caml_ephe_ref_elt *ephe_ref; if (tbl->ptr >= tbl->limit){ CAMLassert (tbl->ptr == tbl->limit); caml_realloc_ephe_ref_table (tbl); } - struct caml_ephe_ref_elt *ephe_ref = tbl->ptr++; + ephe_ref = tbl->ptr++; ephe_ref->ephe = ar; ephe_ref->offset = offset; } diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index c21aa3186..75be7bdf3 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -49,7 +49,7 @@ native code, or [caml_young_trigger]. */ -struct generic_table CAML_TABLE_STRUCT(void); +struct generic_table CAML_TABLE_STRUCT(char); asize_t caml_minor_heap_wsz; static void *caml_young_base = NULL; From ff1ecd8fcd2ac92bdd52ad826d1b8798367ef461 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Wed, 27 Jan 2016 21:48:56 +0100 Subject: [PATCH 132/145] Add Ast_iterator --- Makefile.shared | 2 +- parsing/ast_iterator.ml | 588 +++++++++++++++++++++++++++++++++++++++ parsing/ast_iterator.mli | 69 +++++ 3 files changed, 658 insertions(+), 1 deletion(-) create mode 100755 parsing/ast_iterator.ml create mode 100755 parsing/ast_iterator.mli diff --git a/Makefile.shared b/Makefile.shared index e3ffa95b6..542ec3569 100755 --- a/Makefile.shared +++ b/Makefile.shared @@ -48,7 +48,7 @@ PARSING=parsing/location.cmo parsing/longident.cmo \ parsing/syntaxerr.cmo parsing/parser.cmo \ parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \ parsing/pprintast.cmo \ - parsing/ast_mapper.cmo parsing/attr_helper.cmo \ + parsing/ast_mapper.cmo parsing/ast_iterator.cmo parsing/attr_helper.cmo \ parsing/builtin_attributes.cmo parsing/ast_invariants.cmo TYPING=typing/ident.cmo typing/path.cmo \ diff --git a/parsing/ast_iterator.ml b/parsing/ast_iterator.ml new file mode 100755 index 000000000..22ba96ae6 --- /dev/null +++ b/parsing/ast_iterator.ml @@ -0,0 +1,588 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Nicolas Ojeda Bar, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* A generic Parsetree mapping class *) + +(* +[@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) +*) + + +open Parsetree +open Location + +type iterator = { + attribute: iterator -> attribute -> unit; + attributes: iterator -> attribute list -> unit; + case: iterator -> case -> unit; + cases: iterator -> case list -> unit; + class_declaration: iterator -> class_declaration -> unit; + class_description: iterator -> class_description -> unit; + class_expr: iterator -> class_expr -> unit; + class_field: iterator -> class_field -> unit; + class_signature: iterator -> class_signature -> unit; + class_structure: iterator -> class_structure -> unit; + class_type: iterator -> class_type -> unit; + class_type_declaration: iterator -> class_type_declaration -> unit; + class_type_field: iterator -> class_type_field -> unit; + constructor_declaration: iterator -> constructor_declaration -> unit; + expr: iterator -> expression -> unit; + extension: iterator -> extension -> unit; + extension_constructor: iterator -> extension_constructor -> unit; + include_declaration: iterator -> include_declaration -> unit; + include_description: iterator -> include_description -> unit; + label_declaration: iterator -> label_declaration -> unit; + location: iterator -> Location.t -> unit; + module_binding: iterator -> module_binding -> unit; + module_declaration: iterator -> module_declaration -> unit; + module_expr: iterator -> module_expr -> unit; + module_type: iterator -> module_type -> unit; + module_type_declaration: iterator -> module_type_declaration -> unit; + open_description: iterator -> open_description -> unit; + pat: iterator -> pattern -> unit; + payload: iterator -> payload -> unit; + signature: iterator -> signature -> unit; + signature_item: iterator -> signature_item -> unit; + structure: iterator -> structure -> unit; + structure_item: iterator -> structure_item -> unit; + typ: iterator -> core_type -> unit; + type_declaration: iterator -> type_declaration -> unit; + type_extension: iterator -> type_extension -> unit; + type_kind: iterator -> type_kind -> unit; + value_binding: iterator -> value_binding -> unit; + value_description: iterator -> value_description -> unit; + with_constraint: iterator -> with_constraint -> unit; +} +(** A [iterator] record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the iterator to be applied to children in the syntax + tree. *) + +let iter_fst f (x, _) = f x +let iter_snd f (_, y) = f y +let iter_tuple f1 f2 (x, y) = f1 x; f2 y +let iter_tuple3 f1 f2 f3 (x, y, z) = f1 x; f2 y; f3 z +let iter_opt f = function None -> () | Some x -> f x + +let iter_loc sub {loc; txt = _} = sub.location sub loc + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (_, attrs, _, tl) -> + sub.attributes sub attrs; List.iter (sub.typ sub) tl + | Rinherit t -> sub.typ sub t + + let iter sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Ptyp_any + | Ptyp_var _ -> () + | Ptyp_arrow (_lab, t1, t2) -> + sub.typ sub t1; sub.typ sub t2 + | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl + | Ptyp_constr (lid, tl) -> + iter_loc sub lid; List.iter (sub.typ sub) tl + | Ptyp_object (l, o) -> + let f (_, a, t) = sub.attributes sub a; sub.typ sub t in + List.iter f l + | Ptyp_class (lid, tl) -> + iter_loc sub lid; List.iter (sub.typ sub) tl + | Ptyp_alias (t, _) -> sub.typ sub t + | Ptyp_variant (rl, b, ll) -> + List.iter (row_field sub) rl + | Ptyp_poly (_, t) -> sub.typ sub t + | Ptyp_package (lid, l) -> + iter_loc sub lid; + List.iter (iter_tuple (iter_loc sub) (sub.typ sub)) l + | Ptyp_extension x -> sub.extension sub x + + let iter_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + iter_loc sub ptype_name; + List.iter (iter_fst (sub.typ sub)) ptype_params; + List.iter + (iter_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs; + sub.type_kind sub ptype_kind; + iter_opt (sub.typ sub) ptype_manifest; + sub.location sub ptype_loc; + sub.attributes sub ptype_attributes + + let iter_type_kind sub = function + | Ptype_abstract -> () + | Ptype_variant l -> + List.iter (sub.constructor_declaration sub) l + | Ptype_record l -> List.iter (sub.label_declaration sub) l + | Ptype_open -> () + + let iter_constructor_arguments sub = function + | Pcstr_tuple l -> List.iter (sub.typ sub) l + | Pcstr_record l -> + List.iter (sub.label_declaration sub) l + + let iter_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + iter_loc sub ptyext_path; + List.iter (sub.extension_constructor sub) ptyext_constructors; + List.iter (iter_fst (sub.typ sub)) ptyext_params; + sub.attributes sub ptyext_attributes + + let iter_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + iter_constructor_arguments sub ctl; iter_opt (sub.typ sub) cto + | Pext_rebind li -> + iter_loc sub li + + let iter_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + iter_loc sub pext_name; + iter_extension_constructor_kind sub pext_kind; + sub.location sub pext_loc; + sub.attributes sub pext_attributes + +end + +module CT = struct + (* Type expressions for the class language *) + + let iter sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pcty_constr (lid, tys) -> + iter_loc sub lid; List.iter (sub.typ sub) tys + | Pcty_signature x -> sub.class_signature sub x + | Pcty_arrow (_lab, t, ct) -> + sub.typ sub t; sub.class_type sub ct + | Pcty_extension x -> sub.extension sub x + + let iter_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pctf_inherit ct -> sub.class_type sub ct + | Pctf_val (s, m, v, t) -> sub.typ sub t + | Pctf_method (s, p, v, t) -> sub.typ sub t + | Pctf_constraint (t1, t2) -> + sub.typ sub t1; sub.typ sub t2 + | Pctf_attribute x -> sub.attribute sub x + | Pctf_extension x -> sub.extension sub x + + let iter_signature sub {pcsig_self; pcsig_fields} = + sub.typ sub pcsig_self; + List.iter (sub.class_type_field sub) pcsig_fields +end + +module MT = struct + (* Type expressions for the module language *) + + let iter sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pmty_ident s -> iter_loc sub s + | Pmty_alias s -> iter_loc sub s + | Pmty_signature sg -> sub.signature sub sg + | Pmty_functor (s, mt1, mt2) -> + iter_loc sub s; + iter_opt (sub.module_type sub) mt1; + sub.module_type sub mt2 + | Pmty_with (mt, l) -> + sub.module_type sub mt; + List.iter (sub.with_constraint sub) l + | Pmty_typeof me -> sub.module_expr sub me + | Pmty_extension x -> sub.extension sub x + + let iter_with_constraint sub = function + | Pwith_type (lid, d) -> + iter_loc sub lid; sub.type_declaration sub d + | Pwith_module (lid, lid2) -> + iter_loc sub lid; iter_loc sub lid2 + | Pwith_typesubst d -> sub.type_declaration sub d + | Pwith_modsubst (s, lid) -> + iter_loc sub s; iter_loc sub lid + + let iter_signature_item sub {psig_desc = desc; psig_loc = loc} = + sub.location sub loc; + match desc with + | Psig_value vd -> sub.value_description sub vd + | Psig_type (rf, l) -> List.iter (sub.type_declaration sub) l + | Psig_typext te -> sub.type_extension sub te + | Psig_exception ed -> sub.extension_constructor sub ed + | Psig_module x -> sub.module_declaration sub x + | Psig_recmodule l -> + List.iter (sub.module_declaration sub) l + | Psig_modtype x -> sub.module_type_declaration sub x + | Psig_open x -> sub.open_description sub x + | Psig_include x -> sub.include_description sub x + | Psig_class l -> List.iter (sub.class_description sub) l + | Psig_class_type l -> + List.iter (sub.class_type_declaration sub) l + | Psig_extension (x, attrs) -> + sub.extension sub x; sub.attributes sub attrs + | Psig_attribute x -> sub.attribute sub x +end + + +module M = struct + (* Value expressions for the module language *) + + let iter sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pmod_ident x -> iter_loc sub x + | Pmod_structure str -> sub.structure sub str + | Pmod_functor (arg, arg_ty, body) -> + iter_loc sub arg; + iter_opt (sub.module_type sub) arg_ty; + sub.module_expr sub body + | Pmod_apply (m1, m2) -> + sub.module_expr sub m1; sub.module_expr sub m2 + | Pmod_constraint (m, mty) -> + sub.module_expr sub m; sub.module_type sub mty + | Pmod_unpack e -> sub.expr sub e + | Pmod_extension x -> sub.extension sub x + + let iter_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + sub.location sub loc; + match desc with + | Pstr_eval (x, attrs) -> + sub.expr sub x; sub.attributes sub attrs + | Pstr_value (r, vbs) -> List.iter (sub.value_binding sub) vbs + | Pstr_primitive vd -> sub.value_description sub vd + | Pstr_type (rf, l) -> List.iter (sub.type_declaration sub) l + | Pstr_typext te -> sub.type_extension sub te + | Pstr_exception ed -> sub.extension_constructor sub ed + | Pstr_module x -> sub.module_binding sub x + | Pstr_recmodule l -> List.iter (sub.module_binding sub) l + | Pstr_modtype x -> sub.module_type_declaration sub x + | Pstr_open x -> sub.open_description sub x + | Pstr_class l -> List.iter (sub.class_declaration sub) l + | Pstr_class_type l -> + List.iter (sub.class_type_declaration sub) l + | Pstr_include x -> sub.include_declaration sub x + | Pstr_extension (x, attrs) -> + sub.extension sub x; sub.attributes sub attrs + | Pstr_attribute x -> sub.attribute sub x +end + +module E = struct + (* Value expressions for the core language *) + + let iter sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pexp_ident x -> iter_loc sub x + | Pexp_constant x -> () + | Pexp_let (r, vbs, e) -> + List.iter (sub.value_binding sub) vbs; + sub.expr sub e + | Pexp_fun (lab, def, p, e) -> + iter_opt (sub.expr sub) def; + sub.pat sub p; + sub.expr sub e + | Pexp_function pel -> sub.cases sub pel + | Pexp_apply (e, l) -> + sub.expr sub e; List.iter (iter_snd (sub.expr sub)) l + | Pexp_match (e, pel) -> + sub.expr sub e; sub.cases sub pel + | Pexp_try (e, pel) -> sub.expr sub e; sub.cases sub pel + | Pexp_tuple el -> List.iter (sub.expr sub) el + | Pexp_construct (lid, arg) -> + iter_loc sub lid; iter_opt (sub.expr sub) arg + | Pexp_variant (lab, eo) -> + iter_opt (sub.expr sub) eo + | Pexp_record (l, eo) -> + List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) l; + iter_opt (sub.expr sub) eo + | Pexp_field (e, lid) -> + sub.expr sub e; iter_loc sub lid + | Pexp_setfield (e1, lid, e2) -> + sub.expr sub e1; iter_loc sub lid; + sub.expr sub e2 + | Pexp_array el -> List.iter (sub.expr sub) el + | Pexp_ifthenelse (e1, e2, e3) -> + sub.expr sub e1; sub.expr sub e2; + iter_opt (sub.expr sub) e3 + | Pexp_sequence (e1, e2) -> + sub.expr sub e1; sub.expr sub e2 + | Pexp_while (e1, e2) -> + sub.expr sub e1; sub.expr sub e2 + | Pexp_for (p, e1, e2, d, e3) -> + sub.pat sub p; sub.expr sub e1; sub.expr sub e2; + sub.expr sub e3 + | Pexp_coerce (e, t1, t2) -> + sub.expr sub e; iter_opt (sub.typ sub) t1; + sub.typ sub t2 + | Pexp_constraint (e, t) -> + sub.expr sub e; sub.typ sub t + | Pexp_send (e, s) -> sub.expr sub e + | Pexp_new lid -> iter_loc sub lid + | Pexp_setinstvar (s, e) -> + iter_loc sub s; sub.expr sub e + | Pexp_override sel -> + List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) sel + | Pexp_letmodule (s, me, e) -> + iter_loc sub s; sub.module_expr sub me; + sub.expr sub e + | Pexp_assert e -> sub.expr sub e + | Pexp_lazy e -> sub.expr sub e + | Pexp_poly (e, t) -> + sub.expr sub e; iter_opt (sub.typ sub) t + | Pexp_object cls -> sub.class_structure sub cls + | Pexp_newtype (s, e) -> sub.expr sub e + | Pexp_pack me -> sub.module_expr sub me + | Pexp_open (ovf, lid, e) -> + iter_loc sub lid; sub.expr sub e + | Pexp_extension x -> sub.extension sub x + | Pexp_unreachable -> () +end + +module P = struct + (* Patterns *) + + let iter sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Ppat_any -> () + | Ppat_var s -> iter_loc sub s + | Ppat_alias (p, s) -> sub.pat sub p; iter_loc sub s + | Ppat_constant c -> () + | Ppat_interval (c1, c2) -> () + | Ppat_tuple pl -> List.iter (sub.pat sub) pl + | Ppat_construct (l, p) -> + iter_loc sub l; iter_opt (sub.pat sub) p + | Ppat_variant (l, p) -> iter_opt (sub.pat sub) p + | Ppat_record (lpl, cf) -> + List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl + | Ppat_array pl -> List.iter (sub.pat sub) pl + | Ppat_or (p1, p2) -> sub.pat sub p1; sub.pat sub p2 + | Ppat_constraint (p, t) -> + sub.pat sub p; sub.typ sub t + | Ppat_type s -> iter_loc sub s + | Ppat_lazy p -> sub.pat sub p + | Ppat_unpack s -> iter_loc sub s + | Ppat_exception p -> sub.pat sub p + | Ppat_extension x -> sub.extension sub x +end + +module CE = struct + (* Value expressions for the class language *) + + let iter sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pcl_constr (lid, tys) -> + iter_loc sub lid; List.iter (sub.typ sub) tys + | Pcl_structure s -> + sub.class_structure sub s + | Pcl_fun (lab, e, p, ce) -> + iter_opt (sub.expr sub) e; + sub.pat sub p; + sub.class_expr sub ce + | Pcl_apply (ce, l) -> + sub.class_expr sub ce; + List.iter (iter_snd (sub.expr sub)) l + | Pcl_let (r, vbs, ce) -> + List.iter (sub.value_binding sub) vbs; + sub.class_expr sub ce + | Pcl_constraint (ce, ct) -> + sub.class_expr sub ce; sub.class_type sub ct + | Pcl_extension x -> sub.extension sub x + + let iter_kind sub = function + | Cfk_concrete (o, e) -> sub.expr sub e + | Cfk_virtual t -> sub.typ sub t + + let iter_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pcf_inherit (o, ce, s) -> sub.class_expr sub ce + | Pcf_val (s, m, k) -> iter_loc sub s; iter_kind sub k + | Pcf_method (s, p, k) -> + iter_loc sub s; iter_kind sub k + | Pcf_constraint (t1, t2) -> + sub.typ sub t1; sub.typ sub t2 + | Pcf_initializer e -> sub.expr sub e + | Pcf_attribute x -> sub.attribute sub x + | Pcf_extension x -> sub.extension sub x + + let iter_structure sub {pcstr_self; pcstr_fields} = + sub.pat sub pcstr_self; + List.iter (sub.class_field sub) pcstr_fields + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + List.iter (iter_fst (sub.typ sub)) pl; + iter_loc sub pci_name; + f pci_expr; + sub.location sub pci_loc; + sub.attributes sub pci_attributes +end + +(* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + +let default_iterator = + { + structure = (fun this l -> List.iter (this.structure_item this) l); + structure_item = M.iter_structure_item; + module_expr = M.iter; + signature = (fun this l -> List.iter (this.signature_item this) l); + signature_item = MT.iter_signature_item; + module_type = MT.iter; + with_constraint = MT.iter_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.iter; + class_field = CE.iter_field; + class_structure = CE.iter_structure; + class_type = CT.iter; + class_type_field = CT.iter_field; + class_signature = CT.iter_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.iter_type_declaration; + type_kind = T.iter_type_kind; + typ = T.iter; + type_extension = T.iter_type_extension; + extension_constructor = T.iter_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + iter_loc this pval_name; + this.typ this pval_type; + this.attributes this pval_attributes; + this.location this pval_loc + ); + + pat = P.iter; + expr = E.iter; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + iter_loc this pmd_name; + this.module_type this pmd_type; + this.attributes this pmd_attributes; + this.location this pmd_loc + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + iter_loc this pmtd_name; + iter_opt (this.module_type this) pmtd_type; + this.attributes this pmtd_attributes; + this.location this pmtd_loc + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + iter_loc this pmb_name; this.module_expr this pmb_expr; + this.attributes this pmb_attributes; + this.location this pmb_loc + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + iter_loc this popen_lid; + this.location this popen_loc; + this.attributes this popen_attributes + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + this.module_type this pincl_mod; + this.location this pincl_loc; + this.attributes this pincl_attributes + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + this.module_expr this pincl_mod; + this.location this pincl_loc; + this.attributes this pincl_attributes + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + this.pat this pvb_pat; + this.expr this pvb_expr; + this.location this pvb_loc; + this.attributes this pvb_attributes + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + iter_loc this pcd_name; + T.iter_constructor_arguments this pcd_args; + iter_opt (this.typ this) pcd_res; + this.location this pcd_loc; + this.attributes this pcd_attributes + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + iter_loc this pld_name; + this.typ this pld_type; + this.location this pld_loc; + this.attributes this pld_attributes + ); + + cases = (fun this l -> List.iter (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + this.pat this pc_lhs; + iter_opt (this.expr this) pc_guard; + this.expr this pc_rhs + ); + + location = (fun this l -> ()); + + extension = (fun this (s, e) -> iter_loc this s; this.payload this e); + attribute = (fun this (s, e) -> iter_loc this s; this.payload this e); + attributes = (fun this l -> List.iter (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> this.structure this x + | PSig x -> this.signature this x + | PTyp x -> this.typ this x + | PPat (x, g) -> this.pat this x; iter_opt (this.expr this) g + ); + } diff --git a/parsing/ast_iterator.mli b/parsing/ast_iterator.mli new file mode 100755 index 000000000..c8d7dd00e --- /dev/null +++ b/parsing/ast_iterator.mli @@ -0,0 +1,69 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Nicolas Ojeda Bar, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(** {!iterator} allows to implement AST inspection using open recursion. A + typical mapper would be based on {!default_iterator}, a trivial iterator, + and will fall back on it for handling the syntax it does not modify. *) + +open Parsetree + +(** {2 A generic Parsetree iterator} *) + +type iterator = { + attribute: iterator -> attribute -> unit; + attributes: iterator -> attribute list -> unit; + case: iterator -> case -> unit; + cases: iterator -> case list -> unit; + class_declaration: iterator -> class_declaration -> unit; + class_description: iterator -> class_description -> unit; + class_expr: iterator -> class_expr -> unit; + class_field: iterator -> class_field -> unit; + class_signature: iterator -> class_signature -> unit; + class_structure: iterator -> class_structure -> unit; + class_type: iterator -> class_type -> unit; + class_type_declaration: iterator -> class_type_declaration -> unit; + class_type_field: iterator -> class_type_field -> unit; + constructor_declaration: iterator -> constructor_declaration -> unit; + expr: iterator -> expression -> unit; + extension: iterator -> extension -> unit; + extension_constructor: iterator -> extension_constructor -> unit; + include_declaration: iterator -> include_declaration -> unit; + include_description: iterator -> include_description -> unit; + label_declaration: iterator -> label_declaration -> unit; + location: iterator -> Location.t -> unit; + module_binding: iterator -> module_binding -> unit; + module_declaration: iterator -> module_declaration -> unit; + module_expr: iterator -> module_expr -> unit; + module_type: iterator -> module_type -> unit; + module_type_declaration: iterator -> module_type_declaration -> unit; + open_description: iterator -> open_description -> unit; + pat: iterator -> pattern -> unit; + payload: iterator -> payload -> unit; + signature: iterator -> signature -> unit; + signature_item: iterator -> signature_item -> unit; + structure: iterator -> structure -> unit; + structure_item: iterator -> structure_item -> unit; + typ: iterator -> core_type -> unit; + type_declaration: iterator -> type_declaration -> unit; + type_extension: iterator -> type_extension -> unit; + type_kind: iterator -> type_kind -> unit; + value_binding: iterator -> value_binding -> unit; + value_description: iterator -> value_description -> unit; + with_constraint: iterator -> with_constraint -> unit; +} +(** A [iterator] record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the iterator to be applied to children in the syntax + tree. *) + +val default_iterator: iterator +(** A default iterator, which implements a "do not do anything" mapping. *) From 92d679f79114414cdf48bfc140a285c90ad90b9c Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Wed, 27 Jan 2016 21:48:56 +0100 Subject: [PATCH 133/145] Use Ast_iterator for Ast_invariants --- .depend | 383 +++++++++++++++++++------------------- parsing/ast_invariants.ml | 84 ++++----- tools/Makefile.shared | 2 +- 3 files changed, 235 insertions(+), 234 deletions(-) diff --git a/.depend b/.depend index 8ffdb57f8..aa35979b6 100644 --- a/.depend +++ b/.depend @@ -41,11 +41,12 @@ utils/terminfo.cmo : utils/terminfo.cmi utils/terminfo.cmx : utils/terminfo.cmi utils/timings.cmo : utils/timings.cmi utils/timings.cmx : utils/timings.cmi -utils/warnings.cmo : utils/warnings.cmi -utils/warnings.cmx : utils/warnings.cmi +utils/warnings.cmo : utils/misc.cmi utils/warnings.cmi +utils/warnings.cmx : utils/misc.cmx utils/warnings.cmi parsing/ast_helper.cmi : parsing/parsetree.cmi parsing/longident.cmi \ parsing/location.cmi parsing/docstrings.cmi parsing/asttypes.cmi parsing/ast_invariants.cmi : parsing/parsetree.cmi +parsing/ast_iterator.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/asttypes.cmi : parsing/location.cmi parsing/attr_helper.cmi : parsing/parsetree.cmi parsing/location.cmi \ @@ -72,9 +73,15 @@ parsing/ast_helper.cmx : parsing/parsetree.cmi parsing/longident.cmx \ parsing/location.cmx parsing/docstrings.cmx parsing/asttypes.cmi \ parsing/ast_helper.cmi parsing/ast_invariants.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \ - parsing/ast_mapper.cmi parsing/ast_invariants.cmi + parsing/longident.cmi parsing/asttypes.cmi parsing/ast_iterator.cmi \ + parsing/ast_invariants.cmi parsing/ast_invariants.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \ - parsing/ast_mapper.cmx parsing/ast_invariants.cmi + parsing/longident.cmx parsing/asttypes.cmi parsing/ast_iterator.cmx \ + parsing/ast_invariants.cmi +parsing/ast_iterator.cmo : parsing/parsetree.cmi parsing/location.cmi \ + parsing/ast_iterator.cmi +parsing/ast_iterator.cmx : parsing/parsetree.cmi parsing/location.cmx \ + parsing/ast_iterator.cmi parsing/ast_mapper.cmo : parsing/parsetree.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi utils/config.cmi \ utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \ @@ -143,10 +150,10 @@ typing/cmt_format.cmi : typing/types.cmi typing/typedtree.cmi \ typing/ctype.cmi : typing/types.cmi typing/path.cmi parsing/longident.cmi \ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/datarepr.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi -typing/envaux.cmi : typing/subst.cmi typing/path.cmi typing/env.cmi typing/env.cmi : utils/warnings.cmi typing/types.cmi typing/subst.cmi \ typing/path.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi utils/consistbl.cmi parsing/asttypes.cmi +typing/envaux.cmi : typing/subst.cmi typing/path.cmi typing/env.cmi typing/ident.cmi : utils/identifiable.cmi typing/includeclass.cmi : typing/types.cmi typing/env.cmi typing/ctype.cmi typing/includecore.cmi : typing/types.cmi typing/typedtree.cmi \ @@ -165,10 +172,10 @@ typing/path.cmi : typing/ident.cmi typing/predef.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi typing/primitive.cmi : parsing/parsetree.cmi typing/outcometree.cmi \ parsing/location.cmi -typing/printtyped.cmi : typing/typedtree.cmi typing/printtyp.cmi : typing/types.cmi typing/path.cmi \ typing/outcometree.cmi parsing/longident.cmi typing/ident.cmi \ typing/env.cmi parsing/asttypes.cmi +typing/printtyped.cmi : typing/typedtree.cmi typing/stypes.cmi : typing/typedtree.cmi parsing/location.cmi \ typing/annot.cmi typing/subst.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi @@ -184,11 +191,11 @@ typing/typedecl.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/includecore.cmi typing/ident.cmi typing/env.cmi \ parsing/asttypes.cmi -typing/typedtreeIter.cmi : typing/typedtree.cmi parsing/asttypes.cmi -typing/typedtreeMap.cmi : typing/typedtree.cmi typing/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi +typing/typedtreeIter.cmi : typing/typedtree.cmi parsing/asttypes.cmi +typing/typedtreeMap.cmi : typing/typedtree.cmi typing/typemod.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/includemod.cmi typing/ident.cmi typing/env.cmi \ @@ -232,12 +239,6 @@ typing/datarepr.cmo : typing/types.cmi typing/path.cmi parsing/location.cmi \ typing/datarepr.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \ typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi \ typing/datarepr.cmi -typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \ - typing/path.cmi utils/misc.cmi typing/ident.cmi typing/env.cmi \ - parsing/asttypes.cmi typing/envaux.cmi -typing/envaux.cmx : typing/types.cmx typing/subst.cmx typing/printtyp.cmx \ - typing/path.cmx utils/misc.cmx typing/ident.cmx typing/env.cmx \ - parsing/asttypes.cmi typing/envaux.cmi typing/env.cmo : utils/warnings.cmi typing/types.cmi utils/tbl.cmi \ typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ @@ -250,6 +251,12 @@ typing/env.cmx : utils/warnings.cmx typing/types.cmx utils/tbl.cmx \ typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \ typing/cmi_format.cmx utils/clflags.cmx parsing/builtin_attributes.cmx \ typing/btype.cmx parsing/asttypes.cmi typing/env.cmi +typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \ + typing/path.cmi utils/misc.cmi typing/ident.cmi typing/env.cmi \ + parsing/asttypes.cmi typing/envaux.cmi +typing/envaux.cmx : typing/types.cmx typing/subst.cmx typing/printtyp.cmx \ + typing/path.cmx utils/misc.cmx typing/ident.cmx typing/env.cmx \ + parsing/asttypes.cmi typing/envaux.cmi typing/ident.cmo : utils/identifiable.cmi typing/ident.cmi typing/ident.cmx : utils/identifiable.cmx typing/ident.cmi typing/includeclass.cmo : typing/types.cmi typing/printtyp.cmi \ @@ -314,12 +321,6 @@ typing/primitive.cmo : utils/warnings.cmi parsing/parsetree.cmi \ typing/primitive.cmx : utils/warnings.cmx parsing/parsetree.cmi \ typing/outcometree.cmi utils/misc.cmx parsing/location.cmx \ parsing/attr_helper.cmx typing/primitive.cmi -typing/printtyped.cmo : typing/typedtree.cmi parsing/printast.cmi \ - typing/path.cmi utils/misc.cmi parsing/longident.cmi parsing/location.cmi \ - typing/ident.cmi parsing/asttypes.cmi typing/printtyped.cmi -typing/printtyped.cmx : typing/typedtree.cmx parsing/printast.cmx \ - typing/path.cmx utils/misc.cmx parsing/longident.cmx parsing/location.cmx \ - typing/ident.cmx parsing/asttypes.cmi typing/printtyped.cmi typing/printtyp.cmo : typing/types.cmi typing/primitive.cmi \ typing/predef.cmi typing/path.cmi parsing/parsetree.cmi \ typing/outcometree.cmi typing/oprint.cmi utils/misc.cmi \ @@ -332,6 +333,12 @@ typing/printtyp.cmx : typing/types.cmx typing/primitive.cmx \ parsing/longident.cmx parsing/location.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi typing/printtyp.cmi +typing/printtyped.cmo : typing/typedtree.cmi parsing/printast.cmi \ + typing/path.cmi utils/misc.cmi parsing/longident.cmi parsing/location.cmi \ + typing/ident.cmi parsing/asttypes.cmi typing/printtyped.cmi +typing/printtyped.cmx : typing/typedtree.cmx parsing/printast.cmx \ + typing/path.cmx utils/misc.cmx parsing/longident.cmx parsing/location.cmx \ + typing/ident.cmx parsing/asttypes.cmi typing/printtyped.cmi typing/stypes.cmo : typing/typedtree.cmi typing/printtyp.cmi \ parsing/location.cmi utils/clflags.cmi typing/annot.cmi typing/stypes.cmi typing/stypes.cmx : typing/typedtree.cmx typing/printtyp.cmx \ @@ -348,8 +355,8 @@ typing/tast_mapper.cmx : typing/typedtree.cmx typing/env.cmx \ parsing/asttypes.cmi typing/tast_mapper.cmi typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \ typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \ - typing/typecore.cmi parsing/syntaxerr.cmi typing/subst.cmi \ - typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi typing/path.cmi \ + typing/typecore.cmi typing/subst.cmi typing/stypes.cmi \ + typing/printtyp.cmi typing/predef.cmi typing/path.cmi \ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/includeclass.cmi typing/ident.cmi \ typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi utils/clflags.cmi \ @@ -357,59 +364,49 @@ typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \ parsing/ast_helper.cmi typing/typeclass.cmi typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \ - typing/typecore.cmx parsing/syntaxerr.cmx typing/subst.cmx \ - typing/stypes.cmx typing/printtyp.cmx typing/predef.cmx typing/path.cmx \ + typing/typecore.cmx typing/subst.cmx typing/stypes.cmx \ + typing/printtyp.cmx typing/predef.cmx typing/path.cmx \ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/includeclass.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx utils/clflags.cmx \ parsing/builtin_attributes.cmx typing/btype.cmx parsing/asttypes.cmi \ parsing/ast_helper.cmx typing/typeclass.cmi typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \ - typing/types.cmi typing/typedtree.cmi parsing/syntaxerr.cmi \ - typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \ - typing/primitive.cmi typing/predef.cmi typing/path.cmi \ - parsing/parsetree.cmi typing/parmatch.cmi typing/oprint.cmi \ - utils/misc.cmi parsing/longident.cmi parsing/location.cmi \ - typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \ - utils/clflags.cmi parsing/builtin_attributes.cmi typing/btype.cmi \ - parsing/asttypes.cmi parsing/ast_helper.cmi typing/annot.cmi \ - typing/typecore.cmi + typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \ + typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ + typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi \ + typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ + parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ + typing/cmt_format.cmi utils/clflags.cmi parsing/builtin_attributes.cmi \ + typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \ + typing/annot.cmi typing/typecore.cmi typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \ - typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \ - typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \ - typing/primitive.cmx typing/predef.cmx typing/path.cmx \ - parsing/parsetree.cmi typing/parmatch.cmx typing/oprint.cmx \ - utils/misc.cmx parsing/longident.cmx parsing/location.cmx \ - typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \ - utils/clflags.cmx parsing/builtin_attributes.cmx typing/btype.cmx \ - parsing/asttypes.cmi parsing/ast_helper.cmx typing/annot.cmi \ - typing/typecore.cmi + typing/types.cmx typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \ + typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ + typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx \ + typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ + parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ + typing/cmt_format.cmx utils/clflags.cmx parsing/builtin_attributes.cmx \ + typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \ + typing/annot.cmi typing/typecore.cmi typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \ - typing/types.cmi typing/typedtree.cmi parsing/syntaxerr.cmi \ - typing/subst.cmi typing/printtyp.cmi typing/primitive.cmi \ - typing/predef.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ + typing/types.cmi typing/typedtree.cmi typing/subst.cmi \ + typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ + typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \ utils/clflags.cmi typing/btype.cmi parsing/attr_helper.cmi \ parsing/asttypes.cmi parsing/ast_mapper.cmi parsing/ast_helper.cmi \ typing/typedecl.cmi typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ - typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \ - typing/subst.cmx typing/printtyp.cmx typing/primitive.cmx \ - typing/predef.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \ + typing/types.cmx typing/typedtree.cmx typing/subst.cmx \ + typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ + typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \ parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \ utils/clflags.cmx typing/btype.cmx parsing/attr_helper.cmx \ parsing/asttypes.cmi parsing/ast_mapper.cmx parsing/ast_helper.cmx \ typing/typedecl.cmi -typing/typedtreeIter.cmo : typing/typedtree.cmi utils/misc.cmi \ - parsing/asttypes.cmi typing/typedtreeIter.cmi -typing/typedtreeIter.cmx : typing/typedtree.cmx utils/misc.cmx \ - parsing/asttypes.cmi typing/typedtreeIter.cmi -typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \ - typing/typedtreeMap.cmi -typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \ - typing/typedtreeMap.cmi typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi \ @@ -418,6 +415,14 @@ typing/typedtree.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx parsing/asttypes.cmi \ typing/typedtree.cmi +typing/typedtreeIter.cmo : typing/typedtree.cmi utils/misc.cmi \ + parsing/asttypes.cmi typing/typedtreeIter.cmi +typing/typedtreeIter.cmx : typing/typedtree.cmx utils/misc.cmx \ + parsing/asttypes.cmi typing/typedtreeIter.cmi +typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \ + typing/typedtreeMap.cmi +typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \ + typing/typedtreeMap.cmi typing/typemod.cmo : utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \ typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \ @@ -445,19 +450,19 @@ typing/types.cmx : typing/primitive.cmx typing/path.cmx \ parsing/parsetree.cmi parsing/longident.cmx parsing/location.cmx \ typing/ident.cmx parsing/asttypes.cmi typing/types.cmi typing/typetexp.cmo : utils/warnings.cmi typing/types.cmi \ - typing/typedtree.cmi utils/tbl.cmi parsing/syntaxerr.cmi \ - typing/printtyp.cmi typing/predef.cmi typing/path.cmi \ - parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ - parsing/location.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ - parsing/builtin_attributes.cmi typing/btype.cmi parsing/asttypes.cmi \ - parsing/ast_helper.cmi typing/typetexp.cmi + typing/typedtree.cmi utils/tbl.cmi typing/printtyp.cmi typing/predef.cmi \ + typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ + parsing/longident.cmi parsing/location.cmi typing/env.cmi \ + typing/ctype.cmi utils/clflags.cmi parsing/builtin_attributes.cmi \ + typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \ + typing/typetexp.cmi typing/typetexp.cmx : utils/warnings.cmx typing/types.cmx \ - typing/typedtree.cmx utils/tbl.cmx parsing/syntaxerr.cmx \ - typing/printtyp.cmx typing/predef.cmx typing/path.cmx \ - parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ - parsing/location.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ - parsing/builtin_attributes.cmx typing/btype.cmx parsing/asttypes.cmi \ - parsing/ast_helper.cmx typing/typetexp.cmi + typing/typedtree.cmx utils/tbl.cmx typing/printtyp.cmx typing/predef.cmx \ + typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \ + parsing/longident.cmx parsing/location.cmx typing/env.cmx \ + typing/ctype.cmx utils/clflags.cmx parsing/builtin_attributes.cmx \ + typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \ + typing/typetexp.cmi typing/untypeast.cmo : typing/typedtree.cmi typing/path.cmi \ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi \ @@ -679,6 +684,7 @@ bytecomp/typeopt.cmo : typing/types.cmi typing/typedtree.cmi \ bytecomp/typeopt.cmx : typing/types.cmx typing/typedtree.cmx \ typing/predef.cmx typing/path.cmx bytecomp/lambda.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx typing/btype.cmx bytecomp/typeopt.cmi +asmcomp/CSEgen.cmi : asmcomp/mach.cmi asmcomp/asmgen.cmi : utils/timings.cmi bytecomp/lambda.cmi asmcomp/cmm.cmi asmcomp/asmlibrarian.cmi : asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi @@ -692,10 +698,10 @@ asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi asmcomp/closure_offsets.cmi : middle_end/base_types/var_within_closure.cmi \ middle_end/flambda.cmi middle_end/base_types/closure_id.cmi -asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \ - asmcomp/clambda.cmi asmcomp/cmm.cmi : bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi +asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \ + asmcomp/clambda.cmi asmcomp/cmx_format.cmi : asmcomp/clambda.cmi asmcomp/coloring.cmi : asmcomp/comballoc.cmi : asmcomp/mach.cmi @@ -704,12 +710,9 @@ asmcomp/compilenv.cmi : utils/timings.cmi middle_end/base_types/symbol.cmi \ middle_end/flambda.cmi asmcomp/export_info.cmi \ middle_end/base_types/compilation_unit.cmi asmcomp/cmx_format.cmi \ middle_end/base_types/closure_id.cmi asmcomp/clambda.cmi -asmcomp/CSEgen.cmi : asmcomp/mach.cmi asmcomp/deadcode.cmi : asmcomp/mach.cmi -asmcomp/emitaux.cmi : bytecomp/debuginfo.cmi asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi -asmcomp/export_info_for_pack.cmi : asmcomp/export_info.cmi \ - middle_end/base_types/compilation_unit.cmi +asmcomp/emitaux.cmi : bytecomp/debuginfo.cmi asmcomp/export_info.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ @@ -718,6 +721,8 @@ asmcomp/export_info.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/export_id.cmi \ middle_end/base_types/compilation_unit.cmi \ middle_end/base_types/closure_id.cmi +asmcomp/export_info_for_pack.cmi : asmcomp/export_info.cmi \ + middle_end/base_types/compilation_unit.cmi asmcomp/flambda_to_clambda.cmi : middle_end/base_types/symbol.cmi \ middle_end/flambda.cmi asmcomp/export_info.cmi asmcomp/clambda.cmi asmcomp/import_approx.cmi : middle_end/base_types/symbol.cmi \ @@ -734,8 +739,8 @@ asmcomp/printlinear.cmi : asmcomp/linearize.cmi asmcomp/printmach.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/proc.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/reg.cmi : typing/ident.cmi asmcomp/cmm.cmi -asmcomp/reloadgen.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/reload.cmi : asmcomp/mach.cmi +asmcomp/reloadgen.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/schedgen.cmi : asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/scheduling.cmi : asmcomp/linearize.cmi asmcomp/selectgen.cmi : utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ @@ -750,6 +755,12 @@ asmcomp/x86_dsl.cmi : asmcomp/x86_ast.cmi asmcomp/x86_gas.cmi : asmcomp/x86_ast.cmi asmcomp/x86_masm.cmi : asmcomp/x86_ast.cmi asmcomp/x86_proc.cmi : asmcomp/x86_ast.cmi +asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo +asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx +asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ + asmcomp/cmm.cmi asmcomp/CSEgen.cmi +asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ + asmcomp/cmm.cmx asmcomp/CSEgen.cmi asmcomp/arch.cmo : utils/clflags.cmi asmcomp/arch.cmx : utils/clflags.cmx asmcomp/asmgen.cmo : bytecomp/translmod.cmi utils/timings.cmi \ @@ -802,14 +813,14 @@ asmcomp/asmpackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ typing/env.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmx_format.cmi utils/clflags.cmx utils/ccomp.cmx \ asmcomp/asmlink.cmx asmcomp/asmgen.cmx asmcomp/asmpackager.cmi -asmcomp/branch_relaxation_intf.cmo : asmcomp/linearize.cmi asmcomp/arch.cmo -asmcomp/branch_relaxation_intf.cmx : asmcomp/linearize.cmx asmcomp/arch.cmx asmcomp/branch_relaxation.cmo : utils/misc.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/branch_relaxation_intf.cmo \ asmcomp/branch_relaxation.cmi asmcomp/branch_relaxation.cmx : utils/misc.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/branch_relaxation_intf.cmx \ asmcomp/branch_relaxation.cmi +asmcomp/branch_relaxation_intf.cmo : asmcomp/linearize.cmi asmcomp/arch.cmo +asmcomp/branch_relaxation_intf.cmx : asmcomp/linearize.cmx asmcomp/arch.cmx asmcomp/build_export_info.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ @@ -856,6 +867,10 @@ asmcomp/closure_offsets.cmx : middle_end/base_types/variable.cmx \ middle_end/flambda_utils.cmx middle_end/flambda_iterators.cmx \ middle_end/flambda.cmx middle_end/base_types/closure_id.cmx \ asmcomp/closure_offsets.cmi +asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi \ + bytecomp/debuginfo.cmi asmcomp/arch.cmo asmcomp/cmm.cmi +asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx \ + bytecomp/debuginfo.cmx asmcomp/arch.cmx asmcomp/cmm.cmi asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi \ asmcomp/strmatch.cmi asmcomp/proc.cmi bytecomp/printlambda.cmi \ typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ @@ -870,10 +885,6 @@ asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx \ asmcomp/cmx_format.cmi asmcomp/cmm.cmx utils/clflags.cmx \ asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \ asmcomp/cmmgen.cmi -asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi \ - bytecomp/debuginfo.cmi asmcomp/arch.cmo asmcomp/cmm.cmi -asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx \ - bytecomp/debuginfo.cmx asmcomp/arch.cmx asmcomp/cmm.cmi asmcomp/coloring.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/coloring.cmi asmcomp/coloring.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/coloring.cmi asmcomp/comballoc.cmo : asmcomp/reg.cmi asmcomp/mach.cmi utils/config.cmi \ @@ -894,20 +905,10 @@ asmcomp/compilenv.cmx : utils/warnings.cmx middle_end/base_types/symbol.cmx \ middle_end/base_types/compilation_unit.cmx asmcomp/cmx_format.cmi \ middle_end/base_types/closure_id.cmx asmcomp/clambda.cmx \ asmcomp/compilenv.cmi -asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ - asmcomp/cmm.cmi asmcomp/CSEgen.cmi -asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ - asmcomp/cmm.cmx asmcomp/CSEgen.cmi -asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo -asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx asmcomp/deadcode.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/deadcode.cmi asmcomp/deadcode.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ asmcomp/deadcode.cmi -asmcomp/emitaux.cmo : asmcomp/linearize.cmi bytecomp/debuginfo.cmi \ - utils/config.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emitaux.cmi -asmcomp/emitaux.cmx : asmcomp/linearize.cmx bytecomp/debuginfo.cmx \ - utils/config.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emitaux.cmi asmcomp/emit.cmo : asmcomp/x86_proc.cmi asmcomp/x86_masm.cmi \ asmcomp/x86_gas.cmi asmcomp/x86_dsl.cmi asmcomp/x86_ast.cmi \ asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi asmcomp/mach.cmi \ @@ -922,6 +923,26 @@ asmcomp/emit.cmx : asmcomp/x86_proc.cmx asmcomp/x86_masm.cmx \ bytecomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/branch_relaxation.cmx \ asmcomp/arch.cmx asmcomp/emit.cmi +asmcomp/emitaux.cmo : asmcomp/linearize.cmi bytecomp/debuginfo.cmi \ + utils/config.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emitaux.cmi +asmcomp/emitaux.cmx : asmcomp/linearize.cmx bytecomp/debuginfo.cmx \ + utils/config.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emitaux.cmi +asmcomp/export_info.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/simple_value_approx.cmi \ + middle_end/base_types/set_of_closures_id.cmi middle_end/flambda.cmi \ + middle_end/base_types/export_id.cmi \ + middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi asmcomp/export_info.cmi +asmcomp/export_info.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/simple_value_approx.cmx \ + middle_end/base_types/set_of_closures_id.cmx middle_end/flambda.cmx \ + middle_end/base_types/export_id.cmx \ + middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx asmcomp/export_info.cmi asmcomp/export_info_for_pack.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/symbol.cmi \ @@ -940,22 +961,6 @@ asmcomp/export_info_for_pack.cmx : middle_end/base_types/variable.cmx \ middle_end/base_types/export_id.cmx \ middle_end/base_types/compilation_unit.cmx \ middle_end/base_types/closure_id.cmx asmcomp/export_info_for_pack.cmi -asmcomp/export_info.cmo : middle_end/base_types/variable.cmi \ - middle_end/base_types/var_within_closure.cmi \ - middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ - middle_end/simple_value_approx.cmi \ - middle_end/base_types/set_of_closures_id.cmi middle_end/flambda.cmi \ - middle_end/base_types/export_id.cmi \ - middle_end/base_types/compilation_unit.cmi \ - middle_end/base_types/closure_id.cmi asmcomp/export_info.cmi -asmcomp/export_info.cmx : middle_end/base_types/variable.cmx \ - middle_end/base_types/var_within_closure.cmx \ - middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ - middle_end/simple_value_approx.cmx \ - middle_end/base_types/set_of_closures_id.cmx middle_end/flambda.cmx \ - middle_end/base_types/export_id.cmx \ - middle_end/base_types/compilation_unit.cmx \ - middle_end/base_types/closure_id.cmx asmcomp/export_info.cmi asmcomp/flambda_to_clambda.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ @@ -1048,14 +1053,14 @@ asmcomp/proc.cmx : asmcomp/x86_proc.cmx asmcomp/reg.cmx utils/misc.cmx \ asmcomp/proc.cmi asmcomp/reg.cmo : typing/ident.cmi asmcomp/cmm.cmi asmcomp/reg.cmi asmcomp/reg.cmx : typing/ident.cmx asmcomp/cmm.cmx asmcomp/reg.cmi -asmcomp/reloadgen.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ - asmcomp/reloadgen.cmi -asmcomp/reloadgen.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ - asmcomp/reloadgen.cmi asmcomp/reload.cmo : asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ asmcomp/cmm.cmi utils/clflags.cmi asmcomp/reload.cmi asmcomp/reload.cmx : asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/reload.cmi +asmcomp/reloadgen.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ + asmcomp/reloadgen.cmi +asmcomp/reloadgen.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ + asmcomp/reloadgen.cmi asmcomp/schedgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ asmcomp/schedgen.cmi @@ -1126,19 +1131,16 @@ middle_end/augment_closures.cmi : middle_end/inline_and_simplify_aux.cmi \ middle_end/backend_intf.cmi : middle_end/base_types/symbol.cmi \ middle_end/simple_value_approx.cmi typing/ident.cmi \ middle_end/base_types/closure_id.cmi +middle_end/closure_conversion.cmi : bytecomp/lambda.cmi typing/ident.cmi \ + middle_end/flambda.cmi middle_end/backend_intf.cmi middle_end/closure_conversion_aux.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/symbol.cmi \ middle_end/base_types/static_exception.cmi \ middle_end/base_types/mutable_variable.cmi bytecomp/lambda.cmi \ typing/ident.cmi -middle_end/closure_conversion.cmi : bytecomp/lambda.cmi typing/ident.cmi \ - middle_end/flambda.cmi middle_end/backend_intf.cmi middle_end/effect_analysis.cmi : middle_end/flambda.cmi middle_end/find_recursive_functions.cmi : middle_end/base_types/variable.cmi \ middle_end/flambda.cmi middle_end/backend_intf.cmi -middle_end/flambda_invariants.cmi : middle_end/flambda.cmi -middle_end/flambda_iterators.cmi : middle_end/base_types/variable.cmi \ - middle_end/base_types/symbol.cmi middle_end/flambda.cmi middle_end/flambda.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ @@ -1148,6 +1150,9 @@ middle_end/flambda.cmi : middle_end/base_types/variable.cmi \ utils/identifiable.cmi bytecomp/debuginfo.cmi \ middle_end/base_types/closure_id.cmi parsing/asttypes.cmi \ middle_end/allocated_const.cmi +middle_end/flambda_invariants.cmi : middle_end/flambda.cmi +middle_end/flambda_iterators.cmi : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi middle_end/flambda.cmi middle_end/flambda_utils.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ @@ -1164,6 +1169,8 @@ middle_end/inconstant_idents.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/set_of_closures_id.cmi middle_end/flambda.cmi \ middle_end/base_types/compilation_unit.cmi middle_end/backend_intf.cmi middle_end/initialize_symbol_to_let_symbol.cmi : middle_end/flambda.cmi +middle_end/inline_and_simplify.cmi : middle_end/flambda.cmi \ + middle_end/backend_intf.cmi middle_end/inline_and_simplify_aux.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/symbol.cmi \ middle_end/base_types/static_exception.cmi \ @@ -1173,18 +1180,16 @@ middle_end/inline_and_simplify_aux.cmi : middle_end/base_types/variable.cmi \ middle_end/inlining_stats_types.cmi middle_end/inlining_cost.cmi \ middle_end/freshening.cmi bytecomp/debuginfo.cmi \ middle_end/base_types/closure_id.cmi middle_end/backend_intf.cmi -middle_end/inline_and_simplify.cmi : middle_end/flambda.cmi \ - middle_end/backend_intf.cmi middle_end/inlining_cost.cmi : middle_end/flambda.cmi -middle_end/inlining_decision_intf.cmi : middle_end/base_types/variable.cmi \ - middle_end/simple_value_approx.cmi middle_end/inline_and_simplify_aux.cmi \ - middle_end/flambda.cmi bytecomp/debuginfo.cmi \ - middle_end/base_types/closure_id.cmi middle_end/inlining_decision.cmi : middle_end/base_types/variable.cmi \ middle_end/simple_value_approx.cmi bytecomp/lambda.cmi \ middle_end/inlining_decision_intf.cmi \ middle_end/inline_and_simplify_aux.cmi middle_end/flambda.cmi \ bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi +middle_end/inlining_decision_intf.cmi : middle_end/base_types/variable.cmi \ + middle_end/simple_value_approx.cmi middle_end/inline_and_simplify_aux.cmi \ + middle_end/flambda.cmi bytecomp/debuginfo.cmi \ + middle_end/base_types/closure_id.cmi middle_end/inlining_stats.cmi : middle_end/inlining_stats_types.cmi \ bytecomp/debuginfo.cmi middle_end/base_types/closure_id.cmi middle_end/inlining_stats_types.cmi : middle_end/inlining_cost.cmi @@ -1215,11 +1220,11 @@ middle_end/simple_value_approx.cmi : middle_end/base_types/variable.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ middle_end/freshening.cmi middle_end/flambda.cmi \ middle_end/base_types/export_id.cmi middle_end/base_types/closure_id.cmi +middle_end/simplify_boxed_integer_ops.cmi : \ + middle_end/simplify_boxed_integer_ops_intf.cmi middle_end/simplify_boxed_integer_ops_intf.cmi : \ middle_end/simple_value_approx.cmi bytecomp/lambda.cmi \ middle_end/inlining_cost.cmi middle_end/flambda.cmi -middle_end/simplify_boxed_integer_ops.cmi : \ - middle_end/simplify_boxed_integer_ops_intf.cmi middle_end/simplify_common.cmi : middle_end/simple_value_approx.cmi \ bytecomp/lambda.cmi middle_end/inlining_cost.cmi middle_end/flambda.cmi middle_end/simplify_primitives.cmi : middle_end/base_types/variable.cmi \ @@ -1258,18 +1263,6 @@ middle_end/augment_closures.cmx : middle_end/base_types/variable.cmx \ middle_end/flambda_iterators.cmx middle_end/flambda.cmx \ bytecomp/debuginfo.cmx middle_end/base_types/closure_id.cmx \ utils/clflags.cmx middle_end/augment_closures.cmi -middle_end/closure_conversion_aux.cmo : middle_end/base_types/variable.cmi \ - middle_end/base_types/symbol.cmi \ - middle_end/base_types/static_exception.cmi typing/primitive.cmi \ - utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ - utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ - middle_end/closure_conversion_aux.cmi -middle_end/closure_conversion_aux.cmx : middle_end/base_types/variable.cmx \ - middle_end/base_types/symbol.cmx \ - middle_end/base_types/static_exception.cmx typing/primitive.cmx \ - utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ - utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ - middle_end/closure_conversion_aux.cmi middle_end/closure_conversion.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ middle_end/base_types/static_exception.cmi bytecomp/simplif.cmi \ @@ -1298,6 +1291,18 @@ middle_end/closure_conversion.cmx : middle_end/base_types/variable.cmx \ middle_end/closure_conversion_aux.cmx utils/clflags.cmx \ middle_end/backend_intf.cmi parsing/asttypes.cmi \ middle_end/closure_conversion.cmi +middle_end/closure_conversion_aux.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi typing/primitive.cmi \ + utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ + utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ + middle_end/closure_conversion_aux.cmi +middle_end/closure_conversion_aux.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx typing/primitive.cmx \ + utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ + utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ + middle_end/closure_conversion_aux.cmi middle_end/effect_analysis.cmo : middle_end/semantics_of_primitives.cmi \ utils/misc.cmi bytecomp/lambda.cmi middle_end/flambda.cmi \ middle_end/effect_analysis.cmi @@ -1310,6 +1315,28 @@ middle_end/find_recursive_functions.cmo : middle_end/base_types/variable.cmi \ middle_end/find_recursive_functions.cmx : middle_end/base_types/variable.cmx \ utils/strongly_connected_components.cmx middle_end/flambda_utils.cmx \ middle_end/flambda.cmx middle_end/find_recursive_functions.cmi +middle_end/flambda.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/var_within_closure.cmi \ + middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/base_types/set_of_closures_id.cmi bytecomp/printlambda.cmi \ + utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ + utils/misc.cmi bytecomp/lambda.cmi utils/identifiable.cmi \ + bytecomp/debuginfo.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/closure_id.cmi utils/clflags.cmi \ + parsing/asttypes.cmi middle_end/allocated_const.cmi \ + middle_end/flambda.cmi +middle_end/flambda.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/var_within_closure.cmx \ + middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/base_types/set_of_closures_id.cmx bytecomp/printlambda.cmx \ + utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ + utils/misc.cmx bytecomp/lambda.cmx utils/identifiable.cmx \ + bytecomp/debuginfo.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/closure_id.cmx utils/clflags.cmx \ + parsing/asttypes.cmi middle_end/allocated_const.cmx \ + middle_end/flambda.cmi middle_end/flambda_invariants.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ @@ -1336,28 +1363,6 @@ middle_end/flambda_iterators.cmo : middle_end/base_types/variable.cmi \ utils/misc.cmi middle_end/flambda.cmi middle_end/flambda_iterators.cmi middle_end/flambda_iterators.cmx : middle_end/base_types/variable.cmx \ utils/misc.cmx middle_end/flambda.cmx middle_end/flambda_iterators.cmi -middle_end/flambda.cmo : middle_end/base_types/variable.cmi \ - middle_end/base_types/var_within_closure.cmi \ - middle_end/base_types/tag.cmi middle_end/base_types/symbol.cmi \ - middle_end/base_types/static_exception.cmi \ - middle_end/base_types/set_of_closures_id.cmi bytecomp/printlambda.cmi \ - utils/numbers.cmi middle_end/base_types/mutable_variable.cmi \ - utils/misc.cmi bytecomp/lambda.cmi utils/identifiable.cmi \ - bytecomp/debuginfo.cmi middle_end/base_types/compilation_unit.cmi \ - middle_end/base_types/closure_id.cmi utils/clflags.cmi \ - parsing/asttypes.cmi middle_end/allocated_const.cmi \ - middle_end/flambda.cmi -middle_end/flambda.cmx : middle_end/base_types/variable.cmx \ - middle_end/base_types/var_within_closure.cmx \ - middle_end/base_types/tag.cmx middle_end/base_types/symbol.cmx \ - middle_end/base_types/static_exception.cmx \ - middle_end/base_types/set_of_closures_id.cmx bytecomp/printlambda.cmx \ - utils/numbers.cmx middle_end/base_types/mutable_variable.cmx \ - utils/misc.cmx bytecomp/lambda.cmx utils/identifiable.cmx \ - bytecomp/debuginfo.cmx middle_end/base_types/compilation_unit.cmx \ - middle_end/base_types/closure_id.cmx utils/clflags.cmx \ - parsing/asttypes.cmi middle_end/allocated_const.cmx \ - middle_end/flambda.cmi middle_end/flambda_utils.cmo : middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ middle_end/base_types/symbol.cmi bytecomp/switch.cmi \ @@ -1420,26 +1425,6 @@ middle_end/initialize_symbol_to_let_symbol.cmo : \ middle_end/initialize_symbol_to_let_symbol.cmx : \ middle_end/base_types/variable.cmx utils/misc.cmx middle_end/flambda.cmx \ middle_end/initialize_symbol_to_let_symbol.cmi -middle_end/inline_and_simplify_aux.cmo : middle_end/base_types/variable.cmi \ - middle_end/base_types/symbol.cmi \ - middle_end/base_types/static_exception.cmi \ - middle_end/simple_value_approx.cmi \ - middle_end/base_types/set_of_closures_id.cmi utils/numbers.cmi \ - middle_end/base_types/mutable_variable.cmi utils/misc.cmi \ - middle_end/inlining_stats.cmi middle_end/inlining_cost.cmi \ - middle_end/freshening.cmi middle_end/base_types/compilation_unit.cmi \ - utils/clflags.cmi middle_end/backend_intf.cmi \ - middle_end/inline_and_simplify_aux.cmi -middle_end/inline_and_simplify_aux.cmx : middle_end/base_types/variable.cmx \ - middle_end/base_types/symbol.cmx \ - middle_end/base_types/static_exception.cmx \ - middle_end/simple_value_approx.cmx \ - middle_end/base_types/set_of_closures_id.cmx utils/numbers.cmx \ - middle_end/base_types/mutable_variable.cmx utils/misc.cmx \ - middle_end/inlining_stats.cmx middle_end/inlining_cost.cmx \ - middle_end/freshening.cmx middle_end/base_types/compilation_unit.cmx \ - utils/clflags.cmx middle_end/backend_intf.cmi \ - middle_end/inline_and_simplify_aux.cmi middle_end/inline_and_simplify.cmo : utils/warnings.cmi \ middle_end/base_types/variable.cmi \ middle_end/base_types/var_within_closure.cmi \ @@ -1474,6 +1459,26 @@ middle_end/inline_and_simplify.cmx : utils/warnings.cmx \ utils/clflags.cmx middle_end/backend_intf.cmi \ middle_end/augment_closures.cmx middle_end/allocated_const.cmx \ middle_end/inline_and_simplify.cmi +middle_end/inline_and_simplify_aux.cmo : middle_end/base_types/variable.cmi \ + middle_end/base_types/symbol.cmi \ + middle_end/base_types/static_exception.cmi \ + middle_end/simple_value_approx.cmi \ + middle_end/base_types/set_of_closures_id.cmi utils/numbers.cmi \ + middle_end/base_types/mutable_variable.cmi utils/misc.cmi \ + middle_end/inlining_stats.cmi middle_end/inlining_cost.cmi \ + middle_end/freshening.cmi middle_end/base_types/compilation_unit.cmi \ + utils/clflags.cmi middle_end/backend_intf.cmi \ + middle_end/inline_and_simplify_aux.cmi +middle_end/inline_and_simplify_aux.cmx : middle_end/base_types/variable.cmx \ + middle_end/base_types/symbol.cmx \ + middle_end/base_types/static_exception.cmx \ + middle_end/simple_value_approx.cmx \ + middle_end/base_types/set_of_closures_id.cmx utils/numbers.cmx \ + middle_end/base_types/mutable_variable.cmx utils/misc.cmx \ + middle_end/inlining_stats.cmx middle_end/inlining_cost.cmx \ + middle_end/freshening.cmx middle_end/base_types/compilation_unit.cmx \ + utils/clflags.cmx middle_end/backend_intf.cmi \ + middle_end/inline_and_simplify_aux.cmi middle_end/inlining_cost.cmo : middle_end/base_types/variable.cmi \ typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \ middle_end/flambda_iterators.cmi middle_end/flambda.cmi utils/clflags.cmi \ @@ -1732,10 +1737,10 @@ middle_end/base_types/static_exception.cmi : utils/identifiable.cmi middle_end/base_types/symbol.cmi : middle_end/base_types/linkage_name.cmi \ utils/identifiable.cmi middle_end/base_types/compilation_unit.cmi middle_end/base_types/tag.cmi : utils/identifiable.cmi -middle_end/base_types/variable.cmi : utils/identifiable.cmi typing/ident.cmi \ - middle_end/base_types/compilation_unit.cmi middle_end/base_types/var_within_closure.cmi : \ middle_end/base_types/closure_element.cmi +middle_end/base_types/variable.cmi : utils/identifiable.cmi typing/ident.cmi \ + middle_end/base_types/compilation_unit.cmi middle_end/base_types/closure_element.cmo : \ middle_end/base_types/variable.cmi \ middle_end/base_types/closure_element.cmi @@ -1800,24 +1805,24 @@ middle_end/base_types/tag.cmo : utils/numbers.cmi utils/misc.cmi \ utils/identifiable.cmi middle_end/base_types/tag.cmi middle_end/base_types/tag.cmx : utils/numbers.cmx utils/misc.cmx \ utils/identifiable.cmx middle_end/base_types/tag.cmi -middle_end/base_types/variable.cmo : utils/misc.cmi utils/identifiable.cmi \ - typing/ident.cmi middle_end/base_types/compilation_unit.cmi \ - middle_end/base_types/variable.cmi -middle_end/base_types/variable.cmx : utils/misc.cmx utils/identifiable.cmx \ - typing/ident.cmx middle_end/base_types/compilation_unit.cmx \ - middle_end/base_types/variable.cmi middle_end/base_types/var_within_closure.cmo : \ middle_end/base_types/closure_element.cmi \ middle_end/base_types/var_within_closure.cmi middle_end/base_types/var_within_closure.cmx : \ middle_end/base_types/closure_element.cmx \ middle_end/base_types/var_within_closure.cmi +middle_end/base_types/variable.cmo : utils/misc.cmi utils/identifiable.cmi \ + typing/ident.cmi middle_end/base_types/compilation_unit.cmi \ + middle_end/base_types/variable.cmi +middle_end/base_types/variable.cmx : utils/misc.cmx utils/identifiable.cmx \ + typing/ident.cmx middle_end/base_types/compilation_unit.cmx \ + middle_end/base_types/variable.cmi driver/compenv.cmi : driver/compile.cmi : driver/compmisc.cmi : typing/env.cmi driver/errors.cmi : -driver/main_args.cmi : driver/main.cmi : +driver/main_args.cmi : driver/optcompile.cmi : driver/opterrors.cmi : driver/optmain.cmi : @@ -1854,8 +1859,6 @@ driver/compmisc.cmx : typing/typemod.cmx utils/misc.cmx \ parsing/asttypes.cmi driver/compmisc.cmi driver/errors.cmo : parsing/location.cmi driver/errors.cmi driver/errors.cmx : parsing/location.cmx driver/errors.cmi -driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi -driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi driver/main.cmo : utils/warnings.cmi utils/timings.cmi utils/misc.cmi \ driver/main_args.cmi parsing/location.cmi utils/config.cmi \ driver/compmisc.cmi driver/compile.cmi driver/compenv.cmi \ @@ -1866,6 +1869,8 @@ driver/main.cmx : utils/warnings.cmx utils/timings.cmx utils/misc.cmx \ driver/compmisc.cmx driver/compile.cmx driver/compenv.cmx \ utils/clflags.cmx bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ bytecomp/bytelibrarian.cmx driver/main.cmi +driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi +driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \ typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \ utils/timings.cmi typing/stypes.cmi bytecomp/simplif.cmi \ diff --git a/parsing/ast_invariants.ml b/parsing/ast_invariants.ml index 5bab8a07d..22cc1282e 100644 --- a/parsing/ast_invariants.ml +++ b/parsing/ast_invariants.ml @@ -14,7 +14,7 @@ open Asttypes open Parsetree -open Ast_mapper +open Ast_iterator let err = Syntaxerr.ill_formed_ast @@ -34,41 +34,39 @@ let simple_longident id = in if not (is_simple id.txt) then complex_id id.loc -let mapper = - let super = Ast_mapper.default_mapper in +let iterator = + let super = Ast_iterator.default_iterator in let type_declaration self td = - let td = super.type_declaration self td in + super.type_declaration self td; let loc = td.ptype_loc in match td.ptype_kind with | Ptype_record [] -> empty_record loc | Ptype_variant [] -> empty_variant loc - | _ -> td + | _ -> () in let typ self ty = - let ty = super.typ self ty in + super.typ self ty; let loc = ty.ptyp_loc in match ty.ptyp_desc with | Ptyp_tuple ([] | [_]) -> invalid_tuple loc - | Ptyp_class (id, _) -> simple_longident id; ty + | Ptyp_class (id, _) -> simple_longident id | Ptyp_package (_, cstrs) -> - List.iter (fun (id, _) -> simple_longident id) cstrs; - ty - | _ -> ty + List.iter (fun (id, _) -> simple_longident id) cstrs + | _ -> () in let pat self pat = - let pat = super.pat self pat in + super.pat self pat; let loc = pat.ppat_loc in match pat.ppat_desc with | Ppat_tuple ([] | [_]) -> invalid_tuple loc | Ppat_record ([], _) -> empty_record loc - | Ppat_construct (id, _) -> simple_longident id; pat + | Ppat_construct (id, _) -> simple_longident id | Ppat_record (fields, _) -> - List.iter (fun (id, _) -> simple_longident id) fields; - pat - | _ -> pat + List.iter (fun (id, _) -> simple_longident id) fields + | _ -> () in let expr self exp = - let exp = super.expr self exp in + super.expr self exp; let loc = exp.pexp_loc in match exp.pexp_desc with | Pexp_tuple ([] | [_]) -> invalid_tuple loc @@ -80,64 +78,62 @@ let mapper = | Pexp_field (_, id) | Pexp_setfield (_, id, _) | Pexp_new id - | Pexp_open (_, id, _) -> simple_longident id; exp + | Pexp_open (_, id, _) -> simple_longident id | Pexp_record (fields, _) -> - List.iter (fun (id, _) -> simple_longident id) fields; - exp - | _ -> exp + List.iter (fun (id, _) -> simple_longident id) fields + | _ -> () in let extension_constructor self ec = - let ec = super.extension_constructor self ec in + super.extension_constructor self ec; match ec.pext_kind with - | Pext_rebind id -> simple_longident id; ec - | _ -> ec + | Pext_rebind id -> simple_longident id + | _ -> () in let class_expr self ce = - let ce = super.class_expr self ce in + super.class_expr self ce; let loc = ce.pcl_loc in match ce.pcl_desc with | Pcl_apply (_, []) -> no_args loc - | Pcl_constr (id, _) -> simple_longident id; ce - | _ -> ce + | Pcl_constr (id, _) -> simple_longident id + | _ -> () in let module_type self mty = - let mty = super.module_type self mty in + super.module_type self mty; match mty.pmty_desc with - | Pmty_alias id -> simple_longident id; mty - | _ -> mty + | Pmty_alias id -> simple_longident id + | _ -> () in let open_description self opn = - let opn = super.open_description self opn in - simple_longident opn.popen_lid; - opn + super.open_description self opn; + simple_longident opn.popen_lid in let with_constraint self wc = - let wc = super.with_constraint self wc in + super.with_constraint self wc; match wc with | Pwith_type (id, _) - | Pwith_module (id, _) -> simple_longident id; wc - | _ -> wc + | Pwith_module (id, _) -> simple_longident id + | _ -> () in let module_expr self me = - let me = super.module_expr self me in + super.module_expr self me; match me.pmod_desc with - | Pmod_ident id -> simple_longident id; me - | _ -> me + | Pmod_ident id -> simple_longident id + | _ -> () in let structure_item self st = - let st = super.structure_item self st in + super.structure_item self st; let loc = st.pstr_loc in match st.pstr_desc with | Pstr_type (_, []) -> empty_type loc | Pstr_value (_, []) -> empty_let loc - | _ -> st + | _ -> () in let signature_item self sg = - let sg = super.signature_item self sg in + super.signature_item self sg; let loc = sg.psig_loc in match sg.psig_desc with | Psig_type (_, []) -> empty_type loc - | _ -> sg + | _ -> () in { super with type_declaration @@ -154,5 +150,5 @@ let mapper = ; signature_item } -let structure st = ignore (mapper.structure mapper st : structure) -let signature sg = ignore (mapper.signature mapper sg : signature) +let structure st = iterator.structure iterator st +let signature sg = iterator.signature iterator sg diff --git a/tools/Makefile.shared b/tools/Makefile.shared index f0074a605..ba50ba662 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -39,7 +39,7 @@ CAMLDEP_IMPORTS=timings.cmo misc.cmo config.cmo identifiable.cmo numbers.cmo \ arg_helper.cmo clflags.cmo terminfo.cmo \ warnings.cmo location.cmo longident.cmo docstrings.cmo \ syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \ - ccomp.cmo ast_mapper.cmo ast_invariants.cmo pparse.cmo compenv.cmo \ + ccomp.cmo ast_mapper.cmo ast_iterator.cmo ast_invariants.cmo pparse.cmo compenv.cmo \ builtin_attributes.cmo ocamldep: depend.cmi $(CAMLDEP_OBJ) From e343dd0ba6c35a212e4cc82e82c01e4b4325ff18 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Wed, 27 Jan 2016 22:53:00 +0100 Subject: [PATCH 134/145] Adapt emit_external_warnings and error_if_has_deep_native_repr_attributes --- .depend | 14 +++++++------- debugger/Makefile.shared | 2 +- otherlibs/dynlink/Makefile | 3 ++- parsing/builtin_attributes.ml | 8 +++----- parsing/builtin_attributes.mli | 2 +- typing/typedecl.ml | 10 +++++----- typing/typemod.ml | 12 ++++++------ 7 files changed, 25 insertions(+), 26 deletions(-) diff --git a/.depend b/.depend index aa35979b6..0137ec0b1 100644 --- a/.depend +++ b/.depend @@ -52,7 +52,7 @@ parsing/asttypes.cmi : parsing/location.cmi parsing/attr_helper.cmi : parsing/parsetree.cmi parsing/location.cmi \ parsing/asttypes.cmi parsing/builtin_attributes.cmi : parsing/parsetree.cmi parsing/location.cmi \ - parsing/ast_mapper.cmi + parsing/ast_iterator.cmi parsing/docstrings.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/lexer.cmi : parsing/parser.cmi parsing/location.cmi parsing/location.cmi : utils/warnings.cmi @@ -95,10 +95,10 @@ parsing/attr_helper.cmo : parsing/parsetree.cmi parsing/location.cmi \ parsing/attr_helper.cmx : parsing/parsetree.cmi parsing/location.cmx \ parsing/asttypes.cmi parsing/attr_helper.cmi parsing/builtin_attributes.cmo : utils/warnings.cmi parsing/parsetree.cmi \ - parsing/location.cmi parsing/asttypes.cmi parsing/ast_mapper.cmi \ + parsing/location.cmi parsing/asttypes.cmi parsing/ast_iterator.cmi \ parsing/builtin_attributes.cmi parsing/builtin_attributes.cmx : utils/warnings.cmx parsing/parsetree.cmi \ - parsing/location.cmx parsing/asttypes.cmi parsing/ast_mapper.cmx \ + parsing/location.cmx parsing/asttypes.cmi parsing/ast_iterator.cmx \ parsing/builtin_attributes.cmi parsing/docstrings.cmo : utils/warnings.cmi parsing/parsetree.cmi \ parsing/location.cmi parsing/docstrings.cmi @@ -396,7 +396,7 @@ typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \ parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \ utils/clflags.cmi typing/btype.cmi parsing/attr_helper.cmi \ - parsing/asttypes.cmi parsing/ast_mapper.cmi parsing/ast_helper.cmi \ + parsing/asttypes.cmi parsing/ast_iterator.cmi parsing/ast_helper.cmi \ typing/typedecl.cmi typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/types.cmx typing/typedtree.cmx typing/subst.cmx \ @@ -405,7 +405,7 @@ typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \ utils/clflags.cmx typing/btype.cmx parsing/attr_helper.cmx \ - parsing/asttypes.cmi parsing/ast_mapper.cmx parsing/ast_helper.cmx \ + parsing/asttypes.cmi parsing/ast_iterator.cmx parsing/ast_helper.cmx \ typing/typedecl.cmi typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ @@ -431,7 +431,7 @@ typing/typemod.cmo : utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ parsing/location.cmi typing/includemod.cmi typing/ident.cmi \ typing/env.cmi typing/ctype.cmi utils/config.cmi typing/cmt_format.cmi \ utils/clflags.cmi parsing/builtin_attributes.cmi typing/btype.cmi \ - parsing/asttypes.cmi parsing/ast_mapper.cmi typing/annot.cmi \ + parsing/asttypes.cmi parsing/ast_iterator.cmi typing/annot.cmi \ typing/typemod.cmi typing/typemod.cmx : utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \ @@ -441,7 +441,7 @@ typing/typemod.cmx : utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ parsing/location.cmx typing/includemod.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx utils/config.cmx typing/cmt_format.cmx \ utils/clflags.cmx parsing/builtin_attributes.cmx typing/btype.cmx \ - parsing/asttypes.cmi parsing/ast_mapper.cmx typing/annot.cmi \ + parsing/asttypes.cmi parsing/ast_iterator.cmx typing/annot.cmi \ typing/typemod.cmi typing/types.cmo : typing/primitive.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared index a296bf26c..30df6492d 100644 --- a/debugger/Makefile.shared +++ b/debugger/Makefile.shared @@ -37,7 +37,7 @@ OTHEROBJS=\ ../utils/terminfo.cmo \ ../parsing/location.cmo ../parsing/longident.cmo ../parsing/docstrings.cmo \ ../parsing/ast_helper.cmo ../parsing/ast_mapper.cmo \ - ../parsing/attr_helper.cmo \ + ../parsing/ast_iterator.cmo ../parsing/attr_helper.cmo \ ../parsing/builtin_attributes.cmo \ ../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \ ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \ diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index e95e76363..26ad34cd1 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -38,7 +38,8 @@ COMPILEROBJS=\ ../../parsing/asttypes.cmi \ ../../parsing/location.cmo ../../parsing/longident.cmo \ ../../parsing/docstrings.cmo ../../parsing/ast_helper.cmo \ - ../../parsing/ast_mapper.cmo ../../parsing/attr_helper.cmo \ + ../../parsing/ast_mapper.cmo ../../parsing/ast_iterator.cmo \ + ../../parsing/attr_helper.cmo \ ../../parsing/builtin_attributes.cmo \ ../../typing/ident.cmo ../../typing/path.cmo \ ../../typing/primitive.cmo ../../typing/types.cmo \ diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml index 87d6c7930..e9d0fa916 100755 --- a/parsing/builtin_attributes.ml +++ b/parsing/builtin_attributes.ml @@ -106,19 +106,17 @@ let emit_external_warnings = 'ppwarning' attributes during the actual type-checking, making sure to cover all contexts (easier and more ugly alternative: duplicate here the logic which control warnings locally). *) - let open Ast_mapper in + let open Ast_iterator in { - default_mapper with + default_iterator with attribute = (fun _ a -> - begin match a with + match a with | {txt="ocaml.ppwarning"|"ppwarning"}, PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant (Pconst_string (s, _))},_); pstr_loc}] -> Location.prerr_warning pstr_loc (Warnings.Preprocessor s) | _ -> () - end; - a ) } diff --git a/parsing/builtin_attributes.mli b/parsing/builtin_attributes.mli index 2760bf5f5..ee2be723c 100755 --- a/parsing/builtin_attributes.mli +++ b/parsing/builtin_attributes.mli @@ -37,7 +37,7 @@ val warning_leave_scope: unit -> unit val warning_attribute: Parsetree.attributes -> unit val with_warning_attribute: Parsetree.attributes -> (unit -> 'a) -> 'a -val emit_external_warnings: Ast_mapper.mapper +val emit_external_warnings: Ast_iterator.iterator val warn_on_literal_pattern: Parsetree.attributes -> bool val explicit_arity: Parsetree.attributes -> bool diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 1b9fad07c..15f89d702 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -1394,9 +1394,9 @@ let native_repr_of_type env kind ty = (* Raises an error when [core_type] contains an [@unboxed] or [@untagged] attribute in a strict sub-term. *) let error_if_has_deep_native_repr_attributes core_type = - let open Ast_mapper in - let this_mapper = - { default_mapper with typ = fun mapper core_type -> + let open Ast_iterator in + let this_iterator = + { default_iterator with typ = fun iterator core_type -> begin match get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None @@ -1405,9 +1405,9 @@ let error_if_has_deep_native_repr_attributes core_type = raise (Error (core_type.ptyp_loc, Deep_unbox_or_untag_attribute kind)) | Native_repr_attr_absent -> () end; - default_mapper.typ mapper core_type } + default_iterator.typ iterator core_type } in - ignore (default_mapper.typ this_mapper core_type : Parsetree.core_type) + default_iterator.typ this_iterator core_type let make_native_repr env core_type ty ~global_repr = error_if_has_deep_native_repr_attributes core_type; diff --git a/typing/typemod.ml b/typing/typemod.ml index a45f8281e..7a81c8343 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -1465,8 +1465,8 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = let type_toplevel_phrase env s = Env.reset_required_globals (); begin - let map = Builtin_attributes.emit_external_warnings in - ignore (map.Ast_mapper.structure map s) + let iter = Builtin_attributes.emit_external_warnings in + iter.Ast_iterator.structure iter s end; type_structure ~toplevel:true false None env s Location.none let type_module_alias = type_module ~alias:true true false None @@ -1570,8 +1570,8 @@ let type_implementation sourcefile outputprefix modulename initial_env ast = Typecore.reset_delayed_checks (); Env.reset_required_globals (); begin - let map = Builtin_attributes.emit_external_warnings in - ignore (map.Ast_mapper.structure map ast) + let iter = Builtin_attributes.emit_external_warnings in + iter.Ast_iterator.structure iter ast end; let (str, sg, finalenv) = @@ -1639,8 +1639,8 @@ let save_signature modname tsg outputprefix source_file initial_env cmi = let type_interface env ast = begin - let map = Builtin_attributes.emit_external_warnings in - ignore (map.Ast_mapper.signature map ast) + let iter = Builtin_attributes.emit_external_warnings in + iter.Ast_iterator.signature iter ast end; transl_signature env ast From 5ac0c42baf573ef11be703583a1598fa5818ee9e Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Wed, 27 Jan 2016 23:24:18 +0100 Subject: [PATCH 135/145] Fix testsuite for Windows. --- testsuite/tests/ast-invariants/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/ast-invariants/Makefile b/testsuite/tests/ast-invariants/Makefile index 25c139432..3efb7483b 100644 --- a/testsuite/tests/ast-invariants/Makefile +++ b/testsuite/tests/ast-invariants/Makefile @@ -13,8 +13,8 @@ ######################################################################### BASEDIR=../.. -COMPFLAGS=-I $(TOPDIR)/parsing -I $(TOPDIR)/utils -LIBRARIES=$(TOPDIR)/compilerlibs/ocamlcommon +COMPFLAGS=-I $(OTOPDIR)/parsing -I $(OTOPDIR)/utils +LIBRARIES=../../../compilerlibs/ocamlcommon MODULES= MAIN_MODULE=test From b0b0f6609c83a5ff71d3239a9000e4ef9f1f805e Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Tue, 26 Jan 2016 16:43:24 +0100 Subject: [PATCH 136/145] Enable flambda --- .depend | 140 ++++++++++-------- Changes | 2 + asmcomp/asmgen.ml | 122 +++++++++++++--- asmcomp/asmgen.mli | 14 +- asmcomp/asmlibrarian.ml | 8 +- asmcomp/asmlink.ml | 4 +- asmcomp/asmpackager.ml | 89 ++++++++++-- asmcomp/asmpackager.mli | 8 +- asmcomp/cmmgen.ml | 31 +++- asmcomp/cmx_format.mli | 35 +++-- asmcomp/compilenv.ml | 111 ++++++++++---- asmcomp/compilenv.mli | 86 ++++++++--- asmcomp/un_anf.ml | 31 ++-- bytecomp/lambda.ml | 4 + bytecomp/lambda.mli | 6 + bytecomp/printlambda.ml | 2 + bytecomp/printlambda.mli | 1 + bytecomp/translmod.ml | 22 ++- bytecomp/translmod.mli | 9 +- bytecomp/translobj.ml | 24 ++- driver/compenv.ml | 82 +++++++++++ driver/main_args.ml | 202 +++++++++++++++++++++++++- driver/main_args.mli | 25 ++++ driver/optcompile.ml | 63 ++++++-- driver/optcompile.mli | 9 +- driver/optmain.ml | 74 +++++++++- middle_end/flambda.ml | 4 +- middle_end/flambda.mli | 3 +- middle_end/inconstant_idents.ml | 5 +- middle_end/semantics_of_primitives.ml | 3 +- ocamldoc/odoc_args.ml | 1 + tools/objinfo.ml | 10 +- tools/ocamlcp.ml | 1 + tools/ocamloptp.ml | 28 ++++ toplevel/opttoploop.ml | 118 +++++++++++++-- toplevel/opttopmain.ml | 62 +++++++- toplevel/topmain.ml | 1 + utils/clflags.ml | 3 +- 38 files changed, 1217 insertions(+), 226 deletions(-) diff --git a/.depend b/.depend index 0137ec0b1..20e57764f 100644 --- a/.depend +++ b/.depend @@ -672,11 +672,11 @@ bytecomp/translmod.cmx : typing/types.cmx typing/typedtree.cmx \ parsing/asttypes.cmi bytecomp/translmod.cmi bytecomp/translobj.cmo : typing/primitive.cmi utils/misc.cmi \ parsing/longident.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ - utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ + utils/config.cmi utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ bytecomp/translobj.cmi bytecomp/translobj.cmx : typing/primitive.cmx utils/misc.cmx \ parsing/longident.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ - utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ + utils/config.cmx utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ bytecomp/translobj.cmi bytecomp/typeopt.cmo : typing/types.cmi typing/typedtree.cmi \ typing/predef.cmi typing/path.cmi bytecomp/lambda.cmi typing/ident.cmi \ @@ -685,10 +685,11 @@ bytecomp/typeopt.cmx : typing/types.cmx typing/typedtree.cmx \ typing/predef.cmx typing/path.cmx bytecomp/lambda.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx typing/btype.cmx bytecomp/typeopt.cmi asmcomp/CSEgen.cmi : asmcomp/mach.cmi -asmcomp/asmgen.cmi : utils/timings.cmi bytecomp/lambda.cmi asmcomp/cmm.cmi +asmcomp/asmgen.cmi : utils/timings.cmi bytecomp/lambda.cmi \ + middle_end/flambda.cmi asmcomp/cmm.cmi middle_end/backend_intf.cmi asmcomp/asmlibrarian.cmi : asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi -asmcomp/asmpackager.cmi : typing/env.cmi +asmcomp/asmpackager.cmi : typing/env.cmi middle_end/backend_intf.cmi asmcomp/branch_relaxation.cmi : asmcomp/linearize.cmi \ asmcomp/branch_relaxation_intf.cmo asmcomp/build_export_info.cmi : middle_end/flambda.cmi \ @@ -702,11 +703,12 @@ asmcomp/cmm.cmi : bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \ asmcomp/clambda.cmi -asmcomp/cmx_format.cmi : asmcomp/clambda.cmi +asmcomp/cmx_format.cmi : asmcomp/export_info.cmi asmcomp/clambda.cmi asmcomp/coloring.cmi : asmcomp/comballoc.cmi : asmcomp/mach.cmi asmcomp/compilenv.cmi : utils/timings.cmi middle_end/base_types/symbol.cmi \ - middle_end/base_types/set_of_closures_id.cmi typing/ident.cmi \ + middle_end/base_types/set_of_closures_id.cmi \ + middle_end/base_types/linkage_name.cmi typing/ident.cmi \ middle_end/flambda.cmi asmcomp/export_info.cmi \ middle_end/base_types/compilation_unit.cmi asmcomp/cmx_format.cmi \ middle_end/base_types/closure_id.cmi asmcomp/clambda.cmi @@ -763,36 +765,42 @@ asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ asmcomp/cmm.cmx asmcomp/CSEgen.cmi asmcomp/arch.cmo : utils/clflags.cmi asmcomp/arch.cmx : utils/clflags.cmx -asmcomp/asmgen.cmo : bytecomp/translmod.cmi utils/timings.cmi \ - asmcomp/split.cmi asmcomp/spill.cmi asmcomp/selection.cmi \ - asmcomp/scheduling.cmi asmcomp/reload.cmi asmcomp/reg.cmi \ - asmcomp/proc.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \ - asmcomp/printcmm.cmi asmcomp/printclambda.cmi typing/primitive.cmi \ - utils/misc.cmi asmcomp/mach.cmi parsing/location.cmi asmcomp/liveness.cmi \ - asmcomp/linearize.cmi asmcomp/interf.cmi asmcomp/emitaux.cmi \ +asmcomp/asmgen.cmo : asmcomp/un_anf.cmi bytecomp/translmod.cmi \ + utils/timings.cmi middle_end/base_types/symbol.cmi asmcomp/split.cmi \ + asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \ + asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \ + asmcomp/printlinear.cmi asmcomp/printcmm.cmi asmcomp/printclambda.cmi \ + typing/primitive.cmi utils/misc.cmi asmcomp/mach.cmi parsing/location.cmi \ + asmcomp/liveness.cmi middle_end/base_types/linkage_name.cmi \ + asmcomp/linearize.cmi bytecomp/lambda.cmi asmcomp/interf.cmi \ + asmcomp/flambda_to_clambda.cmi middle_end/flambda.cmi asmcomp/emitaux.cmi \ asmcomp/emit.cmi asmcomp/deadcode.cmi utils/config.cmi \ asmcomp/compilenv.cmi asmcomp/comballoc.cmi asmcomp/coloring.cmi \ asmcomp/cmmgen.cmi asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi \ - asmcomp/clambda.cmi asmcomp/CSE.cmo asmcomp/asmgen.cmi -asmcomp/asmgen.cmx : bytecomp/translmod.cmx utils/timings.cmx \ - asmcomp/split.cmx asmcomp/spill.cmx asmcomp/selection.cmx \ - asmcomp/scheduling.cmx asmcomp/reload.cmx asmcomp/reg.cmx \ - asmcomp/proc.cmx asmcomp/printmach.cmx asmcomp/printlinear.cmx \ - asmcomp/printcmm.cmx asmcomp/printclambda.cmx typing/primitive.cmx \ - utils/misc.cmx asmcomp/mach.cmx parsing/location.cmx asmcomp/liveness.cmx \ - asmcomp/linearize.cmx asmcomp/interf.cmx asmcomp/emitaux.cmx \ + asmcomp/clambda.cmi asmcomp/CSE.cmo asmcomp/build_export_info.cmi \ + asmcomp/asmgen.cmi +asmcomp/asmgen.cmx : asmcomp/un_anf.cmx bytecomp/translmod.cmx \ + utils/timings.cmx middle_end/base_types/symbol.cmx asmcomp/split.cmx \ + asmcomp/spill.cmx asmcomp/selection.cmx asmcomp/scheduling.cmx \ + asmcomp/reload.cmx asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printmach.cmx \ + asmcomp/printlinear.cmx asmcomp/printcmm.cmx asmcomp/printclambda.cmx \ + typing/primitive.cmx utils/misc.cmx asmcomp/mach.cmx parsing/location.cmx \ + asmcomp/liveness.cmx middle_end/base_types/linkage_name.cmx \ + asmcomp/linearize.cmx bytecomp/lambda.cmx asmcomp/interf.cmx \ + asmcomp/flambda_to_clambda.cmx middle_end/flambda.cmx asmcomp/emitaux.cmx \ asmcomp/emit.cmx asmcomp/deadcode.cmx utils/config.cmx \ asmcomp/compilenv.cmx asmcomp/comballoc.cmx asmcomp/coloring.cmx \ asmcomp/cmmgen.cmx asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx \ - asmcomp/clambda.cmx asmcomp/CSE.cmx asmcomp/asmgen.cmi + asmcomp/clambda.cmx asmcomp/CSE.cmx asmcomp/build_export_info.cmx \ + asmcomp/asmgen.cmi asmcomp/asmlibrarian.cmo : utils/misc.cmi parsing/location.cmi \ - utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \ - utils/clflags.cmi asmcomp/clambda.cmi utils/ccomp.cmi asmcomp/asmlink.cmi \ - asmcomp/asmlibrarian.cmi + asmcomp/export_info.cmi utils/config.cmi asmcomp/compilenv.cmi \ + asmcomp/cmx_format.cmi utils/clflags.cmi asmcomp/clambda.cmi \ + utils/ccomp.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi asmcomp/asmlibrarian.cmx : utils/misc.cmx parsing/location.cmx \ - utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ - utils/clflags.cmx asmcomp/clambda.cmx utils/ccomp.cmx asmcomp/asmlink.cmx \ - asmcomp/asmlibrarian.cmi + asmcomp/export_info.cmx utils/config.cmx asmcomp/compilenv.cmx \ + asmcomp/cmx_format.cmi utils/clflags.cmx asmcomp/clambda.cmx \ + utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmi asmcomp/asmlink.cmo : utils/timings.cmi bytecomp/runtimedef.cmi \ utils/misc.cmi parsing/location.cmi asmcomp/emitaux.cmi asmcomp/emit.cmi \ utils/consistbl.cmi utils/config.cmi asmcomp/compilenv.cmi \ @@ -804,13 +812,17 @@ asmcomp/asmlink.cmx : utils/timings.cmx bytecomp/runtimedef.cmx \ asmcomp/cmx_format.cmi asmcomp/cmmgen.cmx utils/clflags.cmx \ utils/ccomp.cmx asmcomp/asmgen.cmx asmcomp/asmlink.cmi asmcomp/asmpackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \ - utils/timings.cmi utils/misc.cmi parsing/location.cmi typing/ident.cmi \ - typing/env.cmi utils/config.cmi asmcomp/compilenv.cmi \ + utils/timings.cmi utils/misc.cmi middle_end/middle_end.cmi \ + parsing/location.cmi typing/ident.cmi asmcomp/export_info_for_pack.cmi \ + asmcomp/export_info.cmi typing/env.cmi utils/config.cmi \ + asmcomp/compilenv.cmi middle_end/base_types/compilation_unit.cmi \ asmcomp/cmx_format.cmi utils/clflags.cmi utils/ccomp.cmi \ asmcomp/asmlink.cmi asmcomp/asmgen.cmi asmcomp/asmpackager.cmi asmcomp/asmpackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ - utils/timings.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \ - typing/env.cmx utils/config.cmx asmcomp/compilenv.cmx \ + utils/timings.cmx utils/misc.cmx middle_end/middle_end.cmx \ + parsing/location.cmx typing/ident.cmx asmcomp/export_info_for_pack.cmx \ + asmcomp/export_info.cmx typing/env.cmx utils/config.cmx \ + asmcomp/compilenv.cmx middle_end/base_types/compilation_unit.cmx \ asmcomp/cmx_format.cmi utils/clflags.cmx utils/ccomp.cmx \ asmcomp/asmlink.cmx asmcomp/asmgen.cmx asmcomp/asmpackager.cmi asmcomp/branch_relaxation.cmo : utils/misc.cmi asmcomp/mach.cmi \ @@ -871,14 +883,14 @@ asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx \ bytecomp/debuginfo.cmx asmcomp/arch.cmx asmcomp/cmm.cmi -asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi \ +asmcomp/cmmgen.cmo : asmcomp/un_anf.cmi typing/types.cmi bytecomp/switch.cmi \ asmcomp/strmatch.cmi asmcomp/proc.cmi bytecomp/printlambda.cmi \ typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ bytecomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ asmcomp/cmx_format.cmi asmcomp/cmm.cmi utils/clflags.cmi \ asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/arch.cmo \ asmcomp/cmmgen.cmi -asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx \ +asmcomp/cmmgen.cmx : asmcomp/un_anf.cmx typing/types.cmx bytecomp/switch.cmx \ asmcomp/strmatch.cmx asmcomp/proc.cmx bytecomp/printlambda.cmx \ typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ bytecomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ @@ -894,14 +906,16 @@ asmcomp/comballoc.cmx : asmcomp/reg.cmx asmcomp/mach.cmx utils/config.cmx \ asmcomp/compilenv.cmo : utils/warnings.cmi middle_end/base_types/symbol.cmi \ middle_end/base_types/set_of_closures_id.cmi utils/misc.cmi \ parsing/location.cmi middle_end/base_types/linkage_name.cmi \ - typing/ident.cmi middle_end/flambda.cmi typing/env.cmi utils/config.cmi \ + typing/ident.cmi middle_end/flambda.cmi asmcomp/export_info.cmi \ + typing/env.cmi utils/config.cmi \ middle_end/base_types/compilation_unit.cmi asmcomp/cmx_format.cmi \ middle_end/base_types/closure_id.cmi asmcomp/clambda.cmi \ asmcomp/compilenv.cmi asmcomp/compilenv.cmx : utils/warnings.cmx middle_end/base_types/symbol.cmx \ middle_end/base_types/set_of_closures_id.cmx utils/misc.cmx \ parsing/location.cmx middle_end/base_types/linkage_name.cmx \ - typing/ident.cmx middle_end/flambda.cmx typing/env.cmx utils/config.cmx \ + typing/ident.cmx middle_end/flambda.cmx asmcomp/export_info.cmx \ + typing/env.cmx utils/config.cmx \ middle_end/base_types/compilation_unit.cmx asmcomp/cmx_format.cmi \ middle_end/base_types/closure_id.cmx asmcomp/clambda.cmx \ asmcomp/compilenv.cmi @@ -1823,7 +1837,7 @@ driver/compmisc.cmi : typing/env.cmi driver/errors.cmi : driver/main.cmi : driver/main_args.cmi : -driver/optcompile.cmi : +driver/optcompile.cmi : middle_end/backend_intf.cmi driver/opterrors.cmi : driver/optmain.cmi : driver/pparse.cmi : parsing/parsetree.cmi @@ -1869,38 +1883,42 @@ driver/main.cmx : utils/warnings.cmx utils/timings.cmx utils/misc.cmx \ driver/compmisc.cmx driver/compile.cmx driver/compenv.cmx \ utils/clflags.cmx bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ bytecomp/bytelibrarian.cmx driver/main.cmi -driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi -driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi +driver/main_args.cmo : utils/warnings.cmi utils/clflags.cmi \ + driver/main_args.cmi +driver/main_args.cmx : utils/warnings.cmx utils/clflags.cmx \ + driver/main_args.cmi driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \ typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \ utils/timings.cmi typing/stypes.cmi bytecomp/simplif.cmi \ typing/printtyped.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \ parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \ - utils/misc.cmi typing/includemod.cmi typing/env.cmi utils/config.cmi \ - driver/compmisc.cmi asmcomp/compilenv.cmi driver/compenv.cmi \ - utils/clflags.cmi utils/ccomp.cmi parsing/builtin_attributes.cmi \ - asmcomp/asmgen.cmi driver/optcompile.cmi + utils/misc.cmi middle_end/middle_end.cmi typing/includemod.cmi \ + typing/env.cmi utils/config.cmi driver/compmisc.cmi asmcomp/compilenv.cmi \ + driver/compenv.cmi utils/clflags.cmi utils/ccomp.cmi \ + parsing/builtin_attributes.cmi asmcomp/asmgen.cmi driver/optcompile.cmi driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \ typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \ utils/timings.cmx typing/stypes.cmx bytecomp/simplif.cmx \ typing/printtyped.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \ parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \ - utils/misc.cmx typing/includemod.cmx typing/env.cmx utils/config.cmx \ - driver/compmisc.cmx asmcomp/compilenv.cmx driver/compenv.cmx \ - utils/clflags.cmx utils/ccomp.cmx parsing/builtin_attributes.cmx \ - asmcomp/asmgen.cmx driver/optcompile.cmi + utils/misc.cmx middle_end/middle_end.cmx typing/includemod.cmx \ + typing/env.cmx utils/config.cmx driver/compmisc.cmx asmcomp/compilenv.cmx \ + driver/compenv.cmx utils/clflags.cmx utils/ccomp.cmx \ + parsing/builtin_attributes.cmx asmcomp/asmgen.cmx driver/optcompile.cmi driver/opterrors.cmo : parsing/location.cmi driver/opterrors.cmi driver/opterrors.cmx : parsing/location.cmx driver/opterrors.cmi driver/optmain.cmo : utils/warnings.cmi utils/timings.cmi \ asmcomp/printmach.cmi driver/optcompile.cmi utils/misc.cmi \ - driver/main_args.cmi parsing/location.cmi utils/config.cmi \ - driver/compmisc.cmi driver/compenv.cmi utils/clflags.cmi \ + driver/main_args.cmi parsing/location.cmi asmcomp/import_approx.cmi \ + utils/config.cmi driver/compmisc.cmi asmcomp/compilenv.cmi \ + driver/compenv.cmi utils/clflags.cmi middle_end/backend_intf.cmi \ asmcomp/asmpackager.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi \ asmcomp/arch.cmo driver/optmain.cmi driver/optmain.cmx : utils/warnings.cmx utils/timings.cmx \ asmcomp/printmach.cmx driver/optcompile.cmx utils/misc.cmx \ - driver/main_args.cmx parsing/location.cmx utils/config.cmx \ - driver/compmisc.cmx driver/compenv.cmx utils/clflags.cmx \ + driver/main_args.cmx parsing/location.cmx asmcomp/import_approx.cmx \ + utils/config.cmx driver/compmisc.cmx asmcomp/compilenv.cmx \ + driver/compenv.cmx utils/clflags.cmx middle_end/backend_intf.cmi \ asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \ asmcomp/arch.cmx driver/optmain.cmi driver/pparse.cmo : utils/timings.cmi parsing/parse.cmi utils/misc.cmi \ @@ -1954,11 +1972,13 @@ toplevel/opttoploop.cmo : utils/warnings.cmi typing/types.cmi \ parsing/printast.cmi typing/predef.cmi parsing/pprintast.cmi \ driver/pparse.cmi typing/path.cmi parsing/parsetree.cmi parsing/parse.cmi \ typing/outcometree.cmi typing/oprint.cmi utils/misc.cmi \ - parsing/longident.cmi parsing/location.cmi parsing/lexer.cmi \ - typing/includemod.cmi typing/ident.cmi toplevel/genprintval.cmi \ + middle_end/middle_end.cmi parsing/longident.cmi parsing/location.cmi \ + parsing/lexer.cmi bytecomp/lambda.cmi typing/includemod.cmi \ + asmcomp/import_approx.cmi typing/ident.cmi toplevel/genprintval.cmi \ typing/env.cmi utils/config.cmi driver/compmisc.cmi asmcomp/compilenv.cmi \ - utils/clflags.cmi typing/btype.cmi parsing/ast_helper.cmi \ - asmcomp/asmlink.cmi asmcomp/asmgen.cmi toplevel/opttoploop.cmi + utils/clflags.cmi typing/btype.cmi middle_end/backend_intf.cmi \ + parsing/asttypes.cmi parsing/ast_helper.cmi asmcomp/asmlink.cmi \ + asmcomp/asmgen.cmi asmcomp/arch.cmo toplevel/opttoploop.cmi toplevel/opttoploop.cmx : utils/warnings.cmx typing/types.cmx \ typing/typemod.cmx typing/typedtree.cmx typing/typecore.cmx \ bytecomp/translmod.cmx utils/timings.cmx bytecomp/simplif.cmx \ @@ -1966,11 +1986,13 @@ toplevel/opttoploop.cmx : utils/warnings.cmx typing/types.cmx \ parsing/printast.cmx typing/predef.cmx parsing/pprintast.cmx \ driver/pparse.cmx typing/path.cmx parsing/parsetree.cmi parsing/parse.cmx \ typing/outcometree.cmi typing/oprint.cmx utils/misc.cmx \ - parsing/longident.cmx parsing/location.cmx parsing/lexer.cmx \ - typing/includemod.cmx typing/ident.cmx toplevel/genprintval.cmx \ + middle_end/middle_end.cmx parsing/longident.cmx parsing/location.cmx \ + parsing/lexer.cmx bytecomp/lambda.cmx typing/includemod.cmx \ + asmcomp/import_approx.cmx typing/ident.cmx toplevel/genprintval.cmx \ typing/env.cmx utils/config.cmx driver/compmisc.cmx asmcomp/compilenv.cmx \ - utils/clflags.cmx typing/btype.cmx parsing/ast_helper.cmx \ - asmcomp/asmlink.cmx asmcomp/asmgen.cmx toplevel/opttoploop.cmi + utils/clflags.cmx typing/btype.cmx middle_end/backend_intf.cmi \ + parsing/asttypes.cmi parsing/ast_helper.cmx asmcomp/asmlink.cmx \ + asmcomp/asmgen.cmx asmcomp/arch.cmx toplevel/opttoploop.cmi toplevel/opttopmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \ toplevel/opttoploop.cmi toplevel/opttopdirs.cmi utils/misc.cmi \ driver/main_args.cmi parsing/location.cmi utils/config.cmi \ diff --git a/Changes b/Changes index d0bf1a5c9..5ce607682 100644 --- a/Changes +++ b/Changes @@ -115,6 +115,8 @@ Compilers: (Vladimir Brankov, review by Alain Frisch) - GPR#115: More precise typing of values at the C-- and Mach level,. (Xavier Leroy, review by Pierre Chambart) +- GPR#132: Flambda: new intermediate language and "middle-end" optimizers + (Pierre Chambart, Mark Shinwell, Leo White) - GPR#207: Colors in compiler messages (warnings, errors) (Simon Cruanes, review by Gabriel Scherer) - GPR#258: more precise information on PowerPC instruction sizes diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml index b51ee0439..df8c57de9 100644 --- a/asmcomp/asmgen.ml +++ b/asmcomp/asmgen.ml @@ -12,6 +12,8 @@ (* From lambda to assembly code *) +[@@@ocaml.warning "+a-4-9-40-41-42"] + open Format open Config open Clflags @@ -35,8 +37,39 @@ let pass_dump_linear_if ppf flag message phrase = if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase; phrase -let clambda_dump_if ppf ulambda = - if !dump_clambda then Printclambda.clambda ppf ulambda; ulambda +let flambda_raw_clambda_dump_if ppf + ({ Flambda_to_clambda. expr = ulambda; preallocated_blocks = _; + structured_constants; exported = _; } as input) = + if !dump_rawclambda then + begin + Format.fprintf ppf "@.clambda (before Un_anf):@."; + Printclambda.clambda ppf ulambda; + Symbol.Map.iter (fun sym cst -> + Format.fprintf ppf "%a:@ %a@." + Symbol.print sym + Printclambda.structured_constant cst) + structured_constants + end; + if !dump_cmm then Format.fprintf ppf "@.cmm:@."; + input + +type clambda_and_constants = + Clambda.ulambda * + Clambda.preallocated_block list * + Clambda.preallocated_constant list + +let raw_clambda_dump_if ppf ((ulambda, _, structured_constants):clambda_and_constants) = + if !dump_rawclambda then + begin + Format.fprintf ppf "@.clambda (before Un_anf):@."; + Printclambda.clambda ppf ulambda; + List.iter (fun {Clambda.symbol; definition} -> + Format.fprintf ppf "%s:@ %a@." + symbol + Printclambda.structured_constant definition) + structured_constants + end; + if !dump_cmm then Format.fprintf ppf "@.cmm:@." let rec regalloc ppf round fd = if round > 50 then @@ -100,7 +133,8 @@ let compile_genfuns ppf f = | _ -> ()) (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()]) -let compile_unit ~source_provenance asm_filename keep_asm obj_filename gen = +let compile_unit ~source_provenance _output_prefix asm_filename keep_asm + obj_filename gen = let create_asm = keep_asm || not !Emitaux.binary_backend_available in Emitaux.create_asm_file := create_asm; try @@ -124,20 +158,15 @@ let compile_unit ~source_provenance asm_filename keep_asm obj_filename gen = remove_file obj_filename; raise exn -let gen_implementation ?toplevel ~source_provenance ppf (size, lam) = - let main_module_block = - { - Clambda.symbol = Compilenv.make_symbol None; - exported = true; - tag = 0; - size; - } - in +let set_export_info (ulambda, prealloc, structured_constants, export) = + Compilenv.set_export_info export; + (ulambda, prealloc, structured_constants) + +let end_gen_implementation ?toplevel ~source_provenance ppf + (clambda:clambda_and_constants) = Emit.begin_assembly (); - Timings.(time (Clambda source_provenance)) (Closure.intro size) lam - ++ clambda_dump_if ppf - ++ Timings.(time (Cmm source_provenance)) - (fun clam -> Cmmgen.compunit (clam, [main_module_block], [])) + clambda + ++ Timings.(time (Cmm source_provenance)) Cmmgen.compunit ++ Timings.(time (Compile_phrases source_provenance)) (List.iter (compile_phrase ppf)) ++ (fun () -> ()); @@ -156,14 +185,69 @@ let gen_implementation ?toplevel ~source_provenance ppf (size, lam) = ); Emit.end_assembly () -let compile_implementation ?toplevel ~source_provenance prefixname ppf (size, lam) = +let flambda_gen_implementation ?toplevel ~source_provenance ~backend ppf + (program:Flambda.program) = + let export = Build_export_info.build_export_info ~backend program in + let (clambda, preallocated, constants) = + Timings.time (Flambda_pass ("backend", source_provenance)) (fun () -> + (program, export) + ++ Flambda_to_clambda.convert + ++ flambda_raw_clambda_dump_if ppf + ++ (fun { Flambda_to_clambda. expr; preallocated_blocks; + structured_constants; exported; } -> + (* "init_code" following the name used in + [Cmmgen.compunit_and_constants]. *) + Un_anf.apply expr ~what:"init_code", preallocated_blocks, + structured_constants, exported) + ++ set_export_info) () + in + let constants = + List.map (fun (symbol, definition) -> + { Clambda.symbol = Linkage_name.to_string (Symbol.label symbol); + exported = true; + definition }) + (Symbol.Map.bindings constants) + in + end_gen_implementation ?toplevel ~source_provenance ppf + (clambda, preallocated, constants) + +let lambda_gen_implementation ?toplevel ~source_provenance ppf + (lambda:Lambda.program) = + let clambda = Closure.intro lambda.main_module_block_size lambda.code in + let preallocated_block = + Clambda.{ + symbol = Compilenv.make_symbol None; + exported = true; + tag = 0; + size = lambda.main_module_block_size; + } + in + let clambda_and_constants = + clambda, [preallocated_block], [] + in + raw_clambda_dump_if ppf clambda_and_constants; + end_gen_implementation ?toplevel ~source_provenance ppf clambda_and_constants + +let compile_implementation_gen ?toplevel ~source_provenance prefixname + ppf gen_implementation program = let asmfile = if !keep_asm_file || !Emitaux.binary_backend_available then prefixname ^ ext_asm else Filename.temp_file "camlasm" ext_asm in - compile_unit ~source_provenance asmfile !keep_asm_file (prefixname ^ ext_obj) - (fun () -> gen_implementation ?toplevel ~source_provenance ppf (size, lam)) + compile_unit ~source_provenance prefixname asmfile !keep_asm_file + (prefixname ^ ext_obj) (fun () -> + gen_implementation ?toplevel ~source_provenance ppf program) + +let compile_implementation_clambda ?toplevel ~source_provenance prefixname + ppf (program:Lambda.program) = + compile_implementation_gen ?toplevel ~source_provenance prefixname + ppf lambda_gen_implementation program + +let compile_implementation_flambda ?toplevel ~source_provenance prefixname + ~backend ppf (program:Flambda.program) = + compile_implementation_gen ?toplevel ~source_provenance prefixname + ppf (flambda_gen_implementation ~backend) program (* Error report *) diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli index 939e21f90..721010b9d 100644 --- a/asmcomp/asmgen.mli +++ b/asmcomp/asmgen.mli @@ -12,10 +12,19 @@ (* From lambda to assembly code *) -val compile_implementation : +val compile_implementation_flambda : ?toplevel:(string -> bool) -> source_provenance:Timings.source_provenance -> - string -> Format.formatter -> int * Lambda.lambda -> unit + string -> + backend:(module Backend_intf.S) -> + Format.formatter -> Flambda.program -> unit + +val compile_implementation_clambda : + ?toplevel:(string -> bool) -> + source_provenance:Timings.source_provenance -> + string -> + Format.formatter -> Lambda.program -> unit + val compile_phrase : Format.formatter -> Cmm.phrase -> unit @@ -26,5 +35,6 @@ val report_error: Format.formatter -> error -> unit val compile_unit: source_provenance:Timings.source_provenance -> + string(*prefixname*) -> string(*asm file*) -> bool(*keep asm*) -> string(*obj file*) -> (unit -> unit) -> unit diff --git a/asmcomp/asmlibrarian.ml b/asmcomp/asmlibrarian.ml index 968e1de74..aadc9ed7e 100644 --- a/asmcomp/asmlibrarian.ml +++ b/asmcomp/asmlibrarian.ml @@ -22,6 +22,12 @@ type error = exception Error of error +let default_ui_export_info = + if Config.flambda then + Cmx_format.Flambda Export_info.empty + else + Cmx_format.Clambda Clambda.Value_unknown + let read_info name = let filename = try @@ -34,7 +40,7 @@ let read_info name = since the compiler will go looking directly for .cmx files. The linker, which is the only one that reads .cmxa files, does not need the approximation. *) - info.ui_approx <- Clambda.Value_unknown; + info.ui_export_info <- default_ui_export_info; (Filename.chop_suffix filename ".cmx" ^ ext_obj, (info, crc)) let create_archive file_list lib_name = diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 296aef62c..3697e6520 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -268,7 +268,7 @@ let link_shared ppf objfiles output_name = then output_name ^ ".startup" ^ ext_asm else Filename.temp_file "camlstartup" ext_asm in let startup_obj = output_name ^ ".startup" ^ ext_obj in - Asmgen.compile_unit ~source_provenance:Timings.Startup + Asmgen.compile_unit ~source_provenance:Timings.Startup output_name startup !Clflags.keep_startup_file startup_obj (fun () -> make_shared_startup_file ppf @@ -327,7 +327,7 @@ let link ppf objfiles output_name = then output_name ^ ".startup" ^ ext_asm else Filename.temp_file "camlstartup" ext_asm in let startup_obj = Filename.temp_file "camlstartup" ext_obj in - Asmgen.compile_unit ~source_provenance:Timings.Startup + Asmgen.compile_unit ~source_provenance:Timings.Startup output_name startup !Clflags.keep_startup_file startup_obj (fun () -> make_startup_file ppf units_tolink); Misc.try_finally diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index 8f71cd77a..cbd19b708 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -75,7 +75,8 @@ let check_units members = (* Make the .o file for the package *) -let make_package_object ppf members targetobj targetname coercion = +let make_package_object ppf members targetobj targetname coercion + ~backend = let objtemp = if !Clflags.keep_asm_file then chop_extension_if_any targetobj ^ ".pack" ^ Config.ext_obj @@ -91,10 +92,32 @@ let make_package_object ppf members targetobj targetname coercion = | PM_intf -> None | PM_impl _ -> Some(Ident.create_persistent m.pm_name)) members in - Asmgen.compile_implementation ~source_provenance:(Timings.Pack targetname) - (chop_extension_if_any objtemp) ppf - (Translmod.transl_store_package - components (Ident.create_persistent targetname) coercion); + let module_ident = Ident.create_persistent targetname in + let source_provenance = Timings.Pack targetname in + let prefixname = chop_extension_if_any objtemp in + if Config.flambda then begin + let size, lam = + Translmod.transl_package_flambda + components module_ident coercion + in + let flam = + Middle_end.middle_end ppf + ~source_provenance + ~prefixname + ~backend + ~size + ~module_ident + ~module_initializer:lam + in + Asmgen.compile_implementation_flambda ~source_provenance + prefixname ~backend ppf flam; + end else begin + let main_module_block_size, code = + Translmod.transl_store_package + components (Ident.create_persistent targetname) coercion in + Asmgen.compile_implementation_clambda ~source_provenance + prefixname ppf { Lambda.code; main_module_block_size; } + end; let objfiles = List.map (fun m -> chop_extension_if_any m.pm_file ^ Config.ext_obj) @@ -107,6 +130,18 @@ let make_package_object ppf members targetobj targetname coercion = (* Make the .cmx file for the package *) +let get_export_info ui = + assert(Config.flambda); + match ui.ui_export_info with + | Clambda _ -> assert false + | Flambda info -> info + +let get_approx ui = + assert(not Config.flambda); + match ui.ui_export_info with + | Flambda _ -> assert false + | Clambda info -> info + let build_package_cmx members cmxfile = let unit_names = List.map (fun m -> m.pm_name) members in @@ -122,7 +157,42 @@ let build_package_cmx members cmxfile = (fun m accu -> match m.pm_kind with PM_intf -> accu | PM_impl info -> info :: accu) members [] in + let pack_units = + List.fold_left + (fun set info -> + let unit_id = Compilenv.unit_id_from_name info.ui_name in + Compilation_unit.Set.add + (Compilenv.unit_for_global unit_id) set) + Compilation_unit.Set.empty units in + let units = + if Config.flambda then + List.map (fun info -> + { info with + ui_export_info = + Flambda + (Export_info_for_pack.import_for_pack ~pack_units + ~pack:(Compilenv.current_unit ()) + (get_export_info info)) }) + units + else + units + in let ui = Compilenv.current_unit_infos() in + let ui_export_info = + if Config.flambda then + let ui_export_info = + List.fold_left (fun acc info -> + Export_info.merge acc (get_export_info info)) + (Export_info_for_pack.import_for_pack ~pack_units + ~pack:(Compilenv.current_unit ()) + (get_export_info ui)) + units + in + Flambda ui_export_info + else + Clambda (get_approx ui) + in + Export_info_for_pack.clear_import_state (); let pkg_infos = { ui_name = ui.ui_name; ui_symbol = ui.ui_symbol; @@ -134,7 +204,6 @@ let build_package_cmx members cmxfile = filter(Asmlink.extract_crc_interfaces()); ui_imports_cmx = filter(Asmlink.extract_crc_implementations()); - ui_approx = ui.ui_approx; ui_curry_fun = union(List.map (fun info -> info.ui_curry_fun) units); ui_apply_fun = @@ -143,25 +212,26 @@ let build_package_cmx members cmxfile = union(List.map (fun info -> info.ui_send_fun) units); ui_force_link = List.exists (fun info -> info.ui_force_link) units; + ui_export_info; } in Compilenv.write_unit_info pkg_infos cmxfile (* Make the .cmx and the .o for the package *) let package_object_files ppf files targetcmx - targetobj targetname coercion = + targetobj targetname coercion ~backend = let pack_path = match !Clflags.for_package with | None -> targetname | Some p -> p ^ "." ^ targetname in let members = map_left_right (read_member_info pack_path) files in check_units members; - make_package_object ppf members targetobj targetname coercion; + make_package_object ppf members targetobj targetname coercion ~backend; build_package_cmx members targetcmx (* The entry point *) -let package_files ppf initial_env files targetcmx = +let package_files ppf initial_env files targetcmx ~backend = let files = List.map (fun f -> @@ -181,6 +251,7 @@ let package_files ppf initial_env files targetcmx = let coercion = Typemod.package_units initial_env files targetcmi targetname in package_object_files ppf files targetcmx targetobj targetname coercion + ~backend with x -> remove_file targetcmx; remove_file targetobj; raise x diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli index 4d47f5c28..0021554e9 100644 --- a/asmcomp/asmpackager.mli +++ b/asmcomp/asmpackager.mli @@ -13,7 +13,13 @@ (* "Package" a set of .cmx/.o files into one .cmx/.o file having the original compilation units as sub-modules. *) -val package_files: Format.formatter -> Env.t -> string list -> string -> unit +val package_files + : Format.formatter + -> Env.t + -> string list + -> string + -> backend:(module Backend_intf.S) + -> unit type error = Illegal_renaming of string * string * string diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 029f1b29b..c65a5ce6e 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -696,6 +696,10 @@ let rec expr_size env = function RHS_block (sz + 1) | Uprim (Pduprecord (Record_float, sz), _, _) -> RHS_floatblock sz + | Uprim (Pccall { prim_name; _ }, closure::_, _) + when prim_name = "caml_check_value_is_closure" -> + (* Used for "-clambda-checks". *) + expr_size env closure | Usequence(exp, exp') -> expr_size env exp' | _ -> RHS_nonrec @@ -2419,9 +2423,15 @@ and transl_letrec env bindings cont = (* Translate a function definition *) let transl_function f = + let body = + if Config.flambda then + Un_anf.apply f.body ~what:f.label + else + f.body + in Cfunction {fun_name = f.label; fun_args = List.map (fun id -> (id, typ_val)) f.params; - fun_body = transl empty_env f.body; + fun_body = transl empty_env body; fun_fast = !Clflags.optimize_for_speed; fun_dbg = f.dbg; } @@ -2523,9 +2533,21 @@ and emit_boxed_int64_constant n cont = (* Emit constant closures *) -let emit_constant_closure symb fundecls clos_vars cont = +let emit_constant_closure ((_, global_symb) as symb) fundecls clos_vars cont = + let closure_symbol f = + if Config.flambda then + cdefine_symbol (f.label ^ "_closure", global_symb) + else + [] + in match fundecls with - [] -> assert false + [] -> + (* This should probably not happen: dead code has normally been + eliminated and a closure cannot be accessed without going through + a [Project_closure], which depends on the function. *) + assert (clos_vars = []); + cdefine_symbol symb @ + List.fold_right emit_constant clos_vars cont | f1 :: remainder -> let rec emit_others pos = function [] -> @@ -2533,11 +2555,13 @@ let emit_constant_closure symb fundecls clos_vars cont = | f2 :: rem -> if f2.arity = 1 || f2.arity = 0 then Cint(infix_header pos) :: + (closure_symbol f2) @ Csymbol_address f2.label :: cint_const f2.arity :: emit_others (pos + 3) rem else Cint(infix_header pos) :: + (closure_symbol f2) @ Csymbol_address(curry_function f2.arity) :: cint_const f2.arity :: Csymbol_address f2.label :: @@ -2545,6 +2569,7 @@ let emit_constant_closure symb fundecls clos_vars cont = Cint(black_closure_header (fundecls_size fundecls + List.length clos_vars)) :: cdefine_symbol symb @ + (closure_symbol f1) @ if f1.arity = 1 || f1.arity = 0 then Csymbol_address f1.label :: cint_const f1.arity :: diff --git a/asmcomp/cmx_format.mli b/asmcomp/cmx_format.mli index 51aa04408..71878cb4b 100644 --- a/asmcomp/cmx_format.mli +++ b/asmcomp/cmx_format.mli @@ -1,14 +1,21 @@ -(***********************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Gallium, 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 Q Public License version 1.0. *) -(* *) -(***********************************************************************) +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2010 Institut National de Recherche en Informatique et *) +(* en Automatique *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) +(* *) +(**************************************************************************) (* Format of .cmx, .cmxa and .cmxs files *) @@ -22,6 +29,10 @@ The .cmx file contains these infos (as an externed record) plus a MD5 of these infos *) +type export_info = + | Clambda of Clambda.value_approximation + | Flambda of Export_info.t + type unit_infos = { mutable ui_name: string; (* Name of unit implemented *) mutable ui_symbol: string; (* Prefix for symbols *) @@ -29,10 +40,10 @@ type unit_infos = mutable ui_imports_cmi: (string * Digest.t option) list; (* Interfaces imported *) mutable ui_imports_cmx:(string * Digest.t option) list; (* Infos imported *) - mutable ui_approx: Clambda.value_approximation; (* Approx of the structure*) mutable ui_curry_fun: int list; (* Currying functions needed *) mutable ui_apply_fun: int list; (* Apply functions needed *) mutable ui_send_fun: int list; (* Send functions needed *) + mutable ui_export_info: export_info; mutable ui_force_link: bool } (* Always linked *) (* Each .a library has a matching .cmxa file that provides the following diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml index c8e643616..f5e2f3b88 100644 --- a/asmcomp/compilenv.ml +++ b/asmcomp/compilenv.ml @@ -1,20 +1,28 @@ -(***********************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2010 Institut National de Recherche en Informatique et *) +(* en Automatique *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) +(* *) +(**************************************************************************) (* Compilation environments for compilation units *) +[@@@ocaml.warning "+a-4-9-40-41-42"] + open Config open Misc -open Clambda open Cmx_format type error = @@ -26,6 +34,8 @@ exception Error of error let global_infos_table = (Hashtbl.create 17 : (string, unit_infos option) Hashtbl.t) +let export_infos_table = + (Hashtbl.create 10 : (string, Export_info.t) Hashtbl.t) let imported_sets_of_closures_table = (Set_of_closures_id.Tbl.create 10 @@ -58,17 +68,25 @@ let structured_constants = ref structured_constants_empty let exported_constants = Hashtbl.create 17 +let merged_environment = ref Export_info.empty + +let default_ui_export_info = + if Config.flambda then + Cmx_format.Flambda Export_info.empty + else + Cmx_format.Clambda Value_unknown + let current_unit = { ui_name = ""; ui_symbol = ""; ui_defines = []; ui_imports_cmi = []; ui_imports_cmx = []; - ui_approx = Value_unknown; ui_curry_fun = []; ui_apply_fun = []; ui_send_fun = []; - ui_force_link = false } + ui_force_link = false; + ui_export_info = default_ui_export_info } let symbolname_for_pack pack name = match pack with @@ -84,6 +102,8 @@ let symbolname_for_pack pack name = Buffer.add_string b name; Buffer.contents b +let unit_id_from_name name = Ident.create_persistent name + let concat_symbol unitname id = unitname ^ "__" ^ id @@ -112,6 +132,9 @@ let reset ?packname ~source_provenance:file name = current_unit.ui_force_link <- false; Hashtbl.clear exported_constants; structured_constants := structured_constants_empty; + current_unit.ui_export_info <- default_ui_export_info; + merged_environment := Export_info.empty; + Hashtbl.clear export_infos_table; let compilation_unit = Compilation_unit.create (Ident.create_persistent name) @@ -209,18 +232,26 @@ let cache_unit_info ui = (* Return the approximation of a global identifier *) -let toplevel_approx = Hashtbl.create 16 +let get_clambda_approx ui = + assert(not Config.flambda); + match ui.ui_export_info with + | Flambda _ -> assert false + | Clambda approx -> approx -let record_global_approx_toplevel id = - Hashtbl.add toplevel_approx current_unit.ui_name current_unit.ui_approx +let toplevel_approx : + (string, Clambda.value_approximation) Hashtbl.t = Hashtbl.create 16 + +let record_global_approx_toplevel () = + Hashtbl.add toplevel_approx current_unit.ui_name + (get_clambda_approx current_unit) let global_approx id = - if Ident.is_predef_exn id then Value_unknown + if Ident.is_predef_exn id then Clambda.Value_unknown else try Hashtbl.find toplevel_approx (Ident.name id) with Not_found -> match get_global_info id with - | None -> Value_unknown - | Some ui -> ui.ui_approx + | None -> Clambda.Value_unknown + | Some ui -> get_clambda_approx ui (* Return the symbol used to refer to a global identifier *) @@ -260,11 +291,40 @@ let symbol_for_global' id = Symbol.unsafe_create (unit_for_global id) sym_label let set_global_approx approx = - current_unit.ui_approx <- approx + assert(not Config.flambda); + current_unit.ui_export_info <- Clambda approx -let approx_for_global _ = assert false +(* Exporting and importing cross module information *) -let approx_env _ = assert false +let get_flambda_export_info ui = + assert(Config.flambda); + match ui.ui_export_info with + | Clambda _ -> assert false + | Flambda ei -> ei + +let set_export_info export_info = + assert(Config.flambda); + current_unit.ui_export_info <- Flambda export_info + +let approx_for_global comp_unit = + let id = Compilation_unit.get_persistent_ident comp_unit in + if (Compilation_unit.equal + predefined_exception_compilation_unit + comp_unit) + || Ident.is_predef_exn id + || not (Ident.global id) + then invalid_arg (Format.asprintf "approx_for_global %a" Ident.print id); + let modname = Ident.name id in + try Hashtbl.find export_infos_table modname with + | Not_found -> + let exported = match get_global_info id with + | None -> Export_info.empty + | Some ui -> get_flambda_export_info ui in + Hashtbl.add export_infos_table modname exported; + merged_environment := Export_info.merge !merged_environment exported; + exported + +let approx_env () = !merged_environment (* Record that a currying function or application function is needed *) @@ -273,6 +333,7 @@ let need_curry_fun n = current_unit.ui_curry_fun <- n :: current_unit.ui_curry_fun let need_apply_fun n = + assert(n > 0); if not (List.mem n current_unit.ui_apply_fun) then current_unit.ui_apply_fun <- n :: current_unit.ui_apply_fun @@ -308,10 +369,6 @@ let current_unit_symbol () = let const_label = ref 0 -let new_const_label () = - incr const_label; - !const_label - let new_const_symbol () = incr const_label; make_symbol (Some (string_of_int !const_label)) diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli index 000758b66..62b00acde 100644 --- a/asmcomp/compilenv.mli +++ b/asmcomp/compilenv.mli @@ -1,40 +1,62 @@ -(***********************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2010 Institut National de Recherche en Informatique et *) +(* en Automatique *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file ../LICENSE. *) +(* *) +(**************************************************************************) (* Compilation environments for compilation units *) open Cmx_format +(* CR-soon mshinwell: this is a bit ugly + mshinwell: deferred CR, this has been addressed in the export info + improvement feature. +*) val imported_sets_of_closures_table : Flambda.function_declarations Set_of_closures_id.Tbl.t + (* flambda-only *) val reset: ?packname:string -> source_provenance:Timings.source_provenance -> string -> unit (* Reset the environment and record the name of the unit being compiled (arg). Optional argument is [-for-pack] prefix. *) +val unit_id_from_name: string -> Ident.t + (* flambda-only *) + val current_unit_infos: unit -> unit_infos (* Return the infos for the unit being compiled *) val current_unit_name: unit -> string - (* Return the name of the unit being compiled *) + (* Return the name of the unit being compiled + clambda-only *) + +val current_unit_linkage_name: unit -> Linkage_name.t + (* Return the linkage_name of the unit being compiled. + flambda-only *) val current_build: unit -> Timings.source_provenance (* Return the kind of build source being compiled. If it is a file compilation it also provides the filename. *) val current_unit: unit -> Compilation_unit.t + (* flambda-only *) val current_unit_symbol: unit -> Symbol.t + (* flambda-only *) val make_symbol: ?unitname:string -> string option -> string (* [make_symbol ~unitname:u None] returns the asm symbol that @@ -48,22 +70,35 @@ val symbol_in_current_unit: string -> bool current compilation unit, false otherwise. *) val is_predefined_exception: Symbol.t -> bool + (* flambda-only *) + +val unit_for_global: Ident.t -> Compilation_unit.t + (* flambda-only *) val symbol_for_global: Ident.t -> string - (* Return the asm symbol that refers to the given global identifier *) + (* Return the asm symbol that refers to the given global identifier + flambda-only *) val symbol_for_global': Ident.t -> Symbol.t - + (* flambda-only *) val global_approx: Ident.t -> Clambda.value_approximation - (* Return the approximation for the given global identifier *) + (* Return the approximation for the given global identifier + clambda-only *) val set_global_approx: Clambda.value_approximation -> unit - (* Record the approximation of the unit being compiled *) + (* Record the approximation of the unit being compiled + clambda-only *) val record_global_approx_toplevel: unit -> unit - (* Record the current approximation for the current toplevel phrase *) + (* Record the current approximation for the current toplevel phrase + clambda-only *) +val set_export_info: Export_info.t -> unit + (* Record the informations of the unit being compiled + flambda-only *) val approx_env: unit -> Export_info.t - (* Returns all the information loaded from extenal compilation units *) + (* Returns all the information loaded from extenal compilation units + flambda-only *) val approx_for_global: Compilation_unit.t -> Export_info.t - (* Loads the exported information declaring the compilation_unit *) + (* Loads the exported information declaring the compilation_unit + flambda-only *) val need_curry_fun: int -> unit val need_apply_fun: int -> unit @@ -74,10 +109,11 @@ val need_send_fun: int -> unit val new_const_symbol : unit -> string val closure_symbol : Closure_id.t -> Symbol.t (* Symbol of a function if the function is - closed (statically allocated) *) + closed (statically allocated) + flambda-only *) val function_label : Closure_id.t -> string - (* linkage name of the code of a function *) -val new_const_label : unit -> int + (* linkage name of the code of a function + flambda-only *) val new_structured_constant: Clambda.ustructured_constant -> @@ -87,11 +123,13 @@ val structured_constants: unit -> Clambda.preallocated_constant list val clear_structured_constants: unit -> unit val add_exported_constant: string -> unit - + (* clambda-only *) type structured_constants + (* clambda-only *) val snapshot: unit -> structured_constants + (* clambda-only *) val backtrack: structured_constants -> unit - + (* clambda-only *) val read_unit_info: string -> unit_infos * Digest.t (* Read infos and MD5 from a [.cmx] file. *) diff --git a/asmcomp/un_anf.ml b/asmcomp/un_anf.ml index 71acbf8f6..c8f1ac888 100644 --- a/asmcomp/un_anf.ml +++ b/asmcomp/un_anf.ml @@ -733,20 +733,17 @@ and un_anf_array ident_info env clams : Clambda.ulambda array = Array.map (un_anf ident_info env) clams let apply clam ~what = - if not Config.flambda then clam - else begin - let ident_info = make_ident_info clam in - let let_bound_vars_that_can_be_moved = - let_bound_vars_that_can_be_moved ident_info clam - in - let clam = - substitute_let_moveable let_bound_vars_that_can_be_moved - Ident.Map.empty clam - in - let ident_info = make_ident_info clam in - let clam = un_anf ident_info Ident.Map.empty clam in - if !Clflags.dump_clambda then begin - Format.eprintf "@.un-anf (%s):@ %a@." what Printclambda.clambda clam - end; - clam - end + let ident_info = make_ident_info clam in + let let_bound_vars_that_can_be_moved = + let_bound_vars_that_can_be_moved ident_info clam + in + let clam = + substitute_let_moveable let_bound_vars_that_can_be_moved + Ident.Map.empty clam + in + let ident_info = make_ident_info clam in + let clam = un_anf ident_info Ident.Map.empty clam in + if !Clflags.dump_clambda then begin + Format.eprintf "@.un-anf (%s):@ %a@." what Printclambda.clambda clam + end; + clam diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index d23cb14dd..f74b6568e 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -243,6 +243,10 @@ and lambda_event_kind = | Lev_after of Types.type_expr | Lev_function +type program = + { code : lambda; + main_module_block_size : int; } + let const_unit = Const_pointer 0 let lambda_unit = Lconst const_unit diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index 106c33c17..389a45b0e 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -259,6 +259,12 @@ and lambda_event_kind = | Lev_after of Types.type_expr | Lev_function +type program = + { code : lambda; + main_module_block_size : int; } +(* Lambda code for the Closure middle-end. The main module block size + is required for preallocating the block *) + (* Sharing key *) val make_key: lambda -> lambda option diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index ccb9be572..c8f297828 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -532,3 +532,5 @@ and sequence ppf = function let structured_constant = struct_const let lambda = lam + +let program ppf { code } = lambda ppf code diff --git a/bytecomp/printlambda.mli b/bytecomp/printlambda.mli index 2748cb9e0..de6d335d7 100644 --- a/bytecomp/printlambda.mli +++ b/bytecomp/printlambda.mli @@ -16,5 +16,6 @@ open Format val structured_constant: formatter -> structured_constant -> unit val lambda: formatter -> lambda -> unit +val program: formatter -> program -> unit val primitive: formatter -> primitive -> unit val name_of_primitive : primitive -> string diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index 7f30b5fea..8a77cb817 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -566,13 +566,13 @@ let transl_implementation_flambda module_name (str, cc) = Hashtbl.clear used_primitives; let module_id = Ident.create_persistent module_name in let body, size = - transl_label_init + Translobj.transl_label_init (fun () -> transl_struct [] cc (global_path module_id) str) in - module_id, (wrap_globals body, size) + (module_id, size), wrap_globals body let transl_implementation module_name (str, cc) = - let module_id, (module_initializer, _size) = + let (module_id, _size), module_initializer = transl_implementation_flambda module_name (str, cc) in Lprim (Psetglobal module_id, [module_initializer]) @@ -907,7 +907,8 @@ let transl_store_implementation module_name (str, restr) = transl_store_subst := Ident.empty; let (i, r) = transl_store_gen module_name (str, restr) false in transl_store_subst := s; - (i, wrap_globals r) + { Lambda.main_module_block_size = i; + code = wrap_globals r; } (* Compile a toplevel phrase *) @@ -1024,6 +1025,19 @@ let get_component = function None -> Lconst const_unit | Some id -> Lprim(Pgetglobal id, []) +let transl_package_flambda component_names target_name coercion = + let size = + match coercion with + | Tcoerce_none -> List.length component_names + | Tcoerce_structure (l, _) -> List.length l + | Tcoerce_functor _ + | Tcoerce_primitive _ + | Tcoerce_alias _ -> assert false + in + size, + apply_coercion Strict coercion + (Lprim(Pmakeblock(0, Immutable), List.map get_component component_names)) + let transl_package component_names target_name coercion = let components = Lprim(Pmakeblock(0, Immutable), List.map get_component component_names) in diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli index 1d84aaabd..b63fa8719 100644 --- a/bytecomp/translmod.mli +++ b/bytecomp/translmod.mli @@ -19,13 +19,20 @@ open Lambda val transl_implementation: string -> structure * module_coercion -> lambda val transl_store_phrases: string -> structure -> int * lambda val transl_store_implementation: - string -> structure * module_coercion -> int * lambda + string -> structure * module_coercion -> Lambda.program + +val transl_implementation_flambda: + string -> structure * module_coercion -> (Ident.t * int) * lambda + val transl_toplevel_definition: structure -> lambda val transl_package: Ident.t option list -> Ident.t -> module_coercion -> lambda val transl_store_package: Ident.t option list -> Ident.t -> module_coercion -> int * lambda +val transl_package_flambda: + Ident.t option list -> Ident.t -> module_coercion -> int * lambda + val toplevel_name: Ident.t -> string val nat_toplevel_name: Ident.t -> Ident.t * int diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml index 5fe306e21..10bd5397e 100644 --- a/bytecomp/translobj.ml +++ b/bytecomp/translobj.ml @@ -107,7 +107,26 @@ let transl_label_init_general f = reset_labels (); expr, size +let transl_label_init_flambda f = + assert(Config.flambda); + let method_cache_id = Ident.create "method_cache" in + method_cache := Lvar method_cache_id; + (* Calling f (usualy Translmod.transl_struct) requires the + method_cache variable to be initialised to be able to generate + method accesses. *) + let expr, size = f () in + let expr = + if !method_count = 0 then expr + else + Llet (Strict, method_cache_id, + Lprim (Pccall prim_makearray, [int !method_count; int 0]), + expr) + in + transl_label_init_general (fun () -> expr, size) + let transl_store_label_init glob size f arg = + assert(not Config.flambda); + assert(!Clflags.native_code); method_cache := Lprim(Pfield size, [Lprim(Pgetglobal glob, [])]); let expr = f arg in let (size, expr) = @@ -123,7 +142,10 @@ let transl_store_label_init glob size f arg = size, lam let transl_label_init f = - transl_label_init_general f + if !Clflags.native_code then + transl_label_init_flambda f + else + transl_label_init_general f (* Share classes *) diff --git a/driver/compenv.ml b/driver/compenv.ml index e94372754..f8933dcdb 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -139,6 +139,22 @@ let setter ppf f name options s = (Warnings.Bad_env_variable ("OCAMLPARAM", Printf.sprintf "bad value for %s" name)) +let int_setter ppf name option s = + try + option := int_of_string s + with _ -> + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable + ("OCAMLPARAM", Printf.sprintf "non-integer parameter for \"%s\"" name)) + +let float_setter ppf name option s = + try + option := float_of_string s + with _ -> + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable + ("OCAMLPARAM", Printf.sprintf "non-float parameter for \"%s\"" name)) + (* 'can-discard=' specifies which arguments can be discarded without warning because they are not understood by some versions of OCaml. *) let can_discard = ref [] @@ -182,6 +198,8 @@ let read_one_param ppf position name v = | "runtime-variant" -> runtime_variant := v | "cc" -> c_compiler := Some v + | "clambda-checks" -> set "clambda-checks" [ clambda_checks ] v + (* assembly sources *) | "s" -> set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v @@ -209,6 +227,70 @@ let read_one_param ppf position name v = (Warnings.Bad_env_variable ("OCAMLPARAM", error)) end + | "inline-toplevel" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline-toplevel'" + inline_toplevel_threshold + + | "rounds" -> int_setter ppf "rounds" simplify_rounds v + | "unroll" -> + Int_arg_helper.parse v "Bad syntax in OCAMLPARAM for 'unroll'" + unroll + | "inline-call-cost" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline-call-cost'" + inline_call_cost + | "inline-alloc-cost" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline-alloc-cost'" + inline_alloc_cost + | "inline-prim-cost" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline-prim-cost'" + inline_prim_cost + | "inline-branch-cost" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline-branch-cost'" + inline_branch_cost + | "inline-indirect-cost" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline-indirect-cost'" + inline_indirect_cost + | "inline-lifting-benefit" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'inline-lifting-benefit'" + inline_lifting_benefit + | "branch-inline-factor" -> + Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'branch-inline-factor'" + branch_inline_factor + | "max-inlining-depth" -> + Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'max-inlining-depth'" + max_inlining_depth + + | "classic-inlining" -> + set "classic-inlining" [ classic_inlining ] v + | "O2" -> + set "O2" [ o2 ] v + | "O3" -> + set "O3" [ o3 ] v + | "unbox-closures" -> + set "unbox-closures" [ unbox_closures ] v + | "remove-unused-arguments" -> + set "remove-unused-arguments" [ remove_unused_arguments ] v + | "no-inline-recursive-functions" -> + clear "no-inline-recursive-functions" [ inline_recursive_functions ] v + + | "inlining-report" -> + if !native_code then + set "inlining-report" [ inlining_stats ] v + + | "flambda-verbose" -> + set "flambda-verbose" [ dump_flambda_verbose ] v + | "flambda-invariants" -> + set "flambda-invariants" [ flambda_invariant_checks ] v + (* color output *) | "color" -> begin match parse_color_setting v with diff --git a/driver/main_args.ml b/driver/main_args.ml index dd9e0989a..df4ded0ec 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -43,6 +43,10 @@ let mk_ccopt f = " Pass option to the C compiler and linker" ;; +let mk_clambda_checks f = + "-clambda-checks", Arg.Unit f, " Instrument clambda code with closure and field access checks (for debugging the compiler)" +;; + let mk_compact f = "-compact", Arg.Unit f, " Optimize code size rather than speed" ;; @@ -110,7 +114,91 @@ let mk_init f = ;; let mk_inline f = - "-inline", Arg.String f, " Set aggressiveness of inlining to " + "-inline", Arg.String f, + Printf.sprintf "|=[,...] Aggressiveness of inlining \ + (default %.02f, higher numbers mean more aggressive)" + Clflags.default_inline_threshold +;; + +let mk_inline_toplevel f = + "-inline-toplevel", Arg.String f, + Printf.sprintf "|=[,...] Aggressiveness of inlining at \ + toplevel (higher numbers mean more aggressive)" +;; + +let mk_inlining_stats f = + "-inlining-report", Arg.Unit f, " Emit `..inlining' file(s) (one per \ + round) showing the inliner's decisions" +;; + +let mk_dump_pass f = + "-dump-pass", Arg.String f, + Format.asprintf " Record transformations performed by these passes: %a" + (Format.pp_print_list Format.pp_print_string) + !Clflags.all_passes +;; + +let mk_o2 f = + "-O2", Arg.Unit f, " Apply increased optimization for speed" +;; + +let mk_o3 f = + "-O3", Arg.Unit f, " Apply aggressive optimization for speed (may \ + significantly increase code size and compilation time)" +;; + +let mk_rounds f = + "-rounds", Arg.Int f, + Printf.sprintf " Repeat tree optimization and inlining phases this \ + many times (default %d). Rounds are numbered starting from zero." + !Clflags.simplify_rounds +;; + +let mk_unroll f = + "-unroll", Arg.String f, + Printf.sprintf "|=[,...] Unroll recursive functions at most this many times \ + (default %d)" + Clflags.default_unroll +;; + +let mk_classic_inlining f = + "-classic-inlining", Arg.Unit f, " Make inlining decisions at function definition time \ + rather than at the call site (replicates previous behaviour of the compiler)" +;; + +let mk_inline_cost arg descr default f = + Printf.sprintf "-inline-%s-cost" arg, + Arg.String f, + Printf.sprintf "|=[,...] The cost of not removing %s during inlining \ + (default %d, higher numbers more costly)" + descr + default +;; + +let mk_inline_call_cost = + mk_inline_cost "call" "a call" Clflags.default_inline_call_cost +let mk_inline_alloc_cost = + mk_inline_cost "alloc" "an allocation" Clflags.default_inline_alloc_cost +let mk_inline_prim_cost = + mk_inline_cost "prim" "a primitive" Clflags.default_inline_prim_cost +let mk_inline_branch_cost = + mk_inline_cost "branch" "a conditional" Clflags.default_inline_branch_cost +let mk_inline_indirect_cost = + mk_inline_cost "indirect" "an indirect call" Clflags.default_inline_indirect_cost + +let mk_inline_lifting_benefit f = + "-inline-lifting-benefit", + Arg.String f, + Printf.sprintf "|=[,...] The benefit of lifting definitions \ + to toplevel during inlining (default %d, higher numbers more beneficial)" + Clflags.default_inline_lifting_benefit +;; + +let mk_branch_inline_factor f = + "-branch-inline-factor", Arg.String f, + Printf.sprintf "|=[,...] Estimate the probability of a \ + branch being cold as 1/(1+n) (used for inlining) (default %.2f)" + Clflags.default_branch_inline_factor ;; let mk_intf f = @@ -151,6 +239,13 @@ let mk_make_runtime_2 f = "-make_runtime", Arg.Unit f, " (deprecated) same as -make-runtime" ;; +let mk_max_inlining_depth f = + "-max-inlining-depth", Arg.String f, + Printf.sprintf "|=[,...] Maximum depth of search for inlining opportunities \ + inside inlined functions (default %d)" + Clflags.default_max_inlining_depth +;; + let mk_modern f = "-modern", Arg.Unit f, " (deprecated) same as -labels" ;; @@ -196,6 +291,11 @@ let mk_noinit f = "-noinit", Arg.Unit f, " Do not load any init file" +let mk_no_inline_recursive_functions f = + "-no-inline-recursive-functions", Arg.Unit f, + " Do not duplicate and specialise declarations of recursive functions" +;; + let mk_nolabels f = "-nolabels", Arg.Unit f, " Ignore non-optional labels in types" ;; @@ -261,6 +361,11 @@ let mk_rectypes f = "-rectypes", Arg.Unit f, " Allow arbitrary recursive types" ;; +let mk_remove_unused_arguments f = + "-remove-unused-arguments", Arg.Unit f, + " Remove unused function arguments (experimental)" +;; + let mk_runtime_variant f = "-runtime-variant", Arg.String f, " Use the variant of the run-time system" @@ -300,6 +405,11 @@ let mk_dtimings f = "-dtimings", Arg.Unit f, " Print timings" ;; +let mk_unbox_closures f = + "-unbox-closures", Arg.Unit f, + " Unbox closures into function arguments (experimental)" +;; + let mk_unsafe f = "-unsafe", Arg.Unit f, " Do not compile bounds checking on array and string access" @@ -417,10 +527,30 @@ let mk_dlambda f = "-dlambda", Arg.Unit f, " (undocumented)" ;; +let mk_drawclambda f = + "-drawclambda", Arg.Unit f, " (undocumented)" +;; + let mk_dclambda f = "-dclambda", Arg.Unit f, " (undocumented)" ;; +let mk_dflambda f = + "-dflambda", Arg.Unit f, " Print Flambda terms" +;; + +let mk_dflambda_invariants f = + "-dflambda-invariants", Arg.Unit f, " Check Flambda invariants around each pass" +;; + +let mk_dflambda_let f = + "-dflambda-let", Arg.Int f, " Print when the given Flambda [Let] is created" +;; + +let mk_dflambda_verbose f = + "-dflambda-verbose", Arg.Unit f, " Print Flambda terms including around each pass" +;; + let mk_dinstr f = "-dinstr", Arg.Unit f, " (undocumented)" ;; @@ -606,7 +736,32 @@ end;; module type Optcommon_options = sig val _compact : unit -> unit val _inline : string -> unit + val _inline_toplevel : string -> unit + val _inlining_stats : unit -> unit + val _dump_pass : string -> unit + val _max_inlining_depth : string -> unit + val _rounds : int -> unit + val _unroll : string -> unit + val _classic_inlining : unit -> unit + val _inline_call_cost : string -> unit + val _inline_alloc_cost : string -> unit + val _inline_prim_cost : string -> unit + val _inline_branch_cost : string -> unit + val _inline_indirect_cost : string -> unit + val _inline_lifting_benefit : string -> unit + val _unbox_closures : unit -> unit + val _branch_inline_factor : string -> unit + val _no_inline_recursive_functions : unit -> unit + val _remove_unused_arguments : unit -> unit + val _o2 : unit -> unit + val _o3 : unit -> unit + val _clambda_checks : unit -> unit + val _dflambda : unit -> unit + val _dflambda_invariants : unit -> unit + val _dflambda_let : int -> unit + val _dflambda_verbose : unit -> unit + val _drawclambda : unit -> unit val _dclambda : unit -> unit val _dcmm : unit -> unit val _dsel : unit -> unit @@ -801,10 +956,13 @@ struct mk_absname F._absname; mk_annot F._annot; mk_binannot F._binannot; + mk_branch_inline_factor F._branch_inline_factor; mk_c F._c; mk_cc F._cc; mk_cclib F._cclib; mk_ccopt F._ccopt; + mk_clambda_checks F._clambda_checks; + mk_classic_inlining F._classic_inlining; mk_color F._color; mk_compact F._compact; mk_config F._config; @@ -815,21 +973,33 @@ struct mk_I F._I; mk_impl F._impl; mk_inline F._inline; + mk_inline_toplevel F._inline_toplevel; + mk_inline_alloc_cost F._inline_alloc_cost; + mk_inline_branch_cost F._inline_branch_cost; + mk_inline_call_cost F._inline_call_cost; + mk_inline_prim_cost F._inline_prim_cost; + mk_inline_indirect_cost F._inline_indirect_cost; + mk_inline_lifting_benefit F._inline_lifting_benefit; + mk_inlining_stats F._inlining_stats; mk_intf F._intf; mk_intf_suffix F._intf_suffix; mk_keep_docs F._keep_docs; mk_keep_locs F._keep_locs; mk_labels F._labels; mk_linkall F._linkall; + mk_max_inlining_depth F._max_inlining_depth; mk_no_alias_deps F._no_alias_deps; mk_no_app_funct F._no_app_funct; mk_no_float_const_prop F._no_float_const_prop; mk_noassert F._noassert; mk_noautolink_opt F._noautolink; mk_nodynlink F._nodynlink; + mk_no_inline_recursive_functions F._no_inline_recursive_functions; mk_nolabels F._nolabels; mk_nostdlib F._nostdlib; mk_o F._o; + mk_o2 F._o2; + mk_o3 F._o3; mk_open F._open; mk_output_obj F._output_obj; mk_output_complete_obj F._output_complete_obj; @@ -839,6 +1009,8 @@ struct mk_ppx F._ppx; mk_principal F._principal; mk_rectypes F._rectypes; + mk_remove_unused_arguments F._remove_unused_arguments; + mk_rounds F._rounds; mk_runtime_variant F._runtime_variant; mk_S F._S; mk_safe_string F._safe_string; @@ -847,6 +1019,8 @@ struct mk_strict_sequence F._strict_sequence; mk_strict_formats F._strict_formats; mk_thread F._thread; + mk_unbox_closures F._unbox_closures; + mk_unroll F._unroll; mk_unsafe F._unsafe; mk_unsafe_string F._unsafe_string; mk_v F._v; @@ -866,7 +1040,12 @@ struct mk_dtypedtree F._dtypedtree; mk_drawlambda F._drawlambda; mk_dlambda F._dlambda; + mk_drawclambda F._drawclambda; mk_dclambda F._dclambda; + mk_dflambda F._dflambda; + mk_dflambda_invariants F._dflambda_invariants; + mk_dflambda_let F._dflambda_let; + mk_dflambda_verbose F._dflambda_verbose; mk_dcmm F._dcmm; mk_dsel F._dsel; mk_dcombine F._dcombine; @@ -882,6 +1061,7 @@ struct mk_dlinear F._dlinear; mk_dstartup F._dstartup; mk_dtimings F._dtimings; + mk_dump_pass F._dump_pass; mk_opaque F._opaque; ] end;; @@ -893,25 +1073,42 @@ module Make_opttop_options (F : Opttop_options) = struct mk_I F._I; mk_init F._init; mk_inline F._inline; + mk_inline_toplevel F._inline_toplevel; + mk_inlining_stats F._inlining_stats; + mk_rounds F._rounds; + mk_unroll F._unroll; + mk_classic_inlining F._classic_inlining; + mk_inline_call_cost F._inline_call_cost; + mk_inline_alloc_cost F._inline_alloc_cost; + mk_inline_prim_cost F._inline_prim_cost; + mk_inline_branch_cost F._inline_branch_cost; + mk_inline_indirect_cost F._inline_indirect_cost; + mk_inline_lifting_benefit F._inline_lifting_benefit; + mk_branch_inline_factor F._branch_inline_factor; mk_labels F._labels; mk_no_alias_deps F._no_alias_deps; mk_no_app_funct F._no_app_funct; mk_noassert F._noassert; mk_noinit F._noinit; + mk_no_inline_recursive_functions F._no_inline_recursive_functions; mk_nolabels F._nolabels; mk_noprompt F._noprompt; mk_nopromptcont F._nopromptcont; mk_nostdlib F._nostdlib; + mk_o2 F._o2; + mk_o3 F._o3; mk_open F._open; mk_ppx F._ppx; mk_principal F._principal; mk_rectypes F._rectypes; + mk_remove_unused_arguments F._remove_unused_arguments; mk_S F._S; mk_safe_string F._safe_string; mk_short_paths F._short_paths; mk_stdin F._stdin; mk_strict_sequence F._strict_sequence; mk_strict_formats F._strict_formats; + mk_unbox_closures F._unbox_closures; mk_unsafe F._unsafe; mk_unsafe_string F._unsafe_string; mk_version F._version; @@ -926,7 +1123,9 @@ module Make_opttop_options (F : Opttop_options) = struct mk_dparsetree F._dparsetree; mk_dtypedtree F._dtypedtree; mk_drawlambda F._drawlambda; + mk_drawclambda F._drawclambda; mk_dclambda F._dclambda; + mk_dflambda F._dflambda; mk_dcmm F._dcmm; mk_dsel F._dsel; mk_dcombine F._dcombine; @@ -941,6 +1140,7 @@ module Make_opttop_options (F : Opttop_options) = struct mk_dscheduling F._dscheduling; mk_dlinear F._dlinear; mk_dstartup F._dstartup; + mk_dump_pass F._dump_pass; ] end;; diff --git a/driver/main_args.mli b/driver/main_args.mli index 5efe5bcbe..f45662e32 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -118,7 +118,32 @@ end;; module type Optcommon_options = sig val _compact : unit -> unit val _inline : string -> unit + val _inline_toplevel : string -> unit + val _inlining_stats : unit -> unit + val _dump_pass : string -> unit + val _max_inlining_depth : string -> unit + val _rounds : int -> unit + val _unroll : string -> unit + val _classic_inlining : unit -> unit + val _inline_call_cost : string -> unit + val _inline_alloc_cost : string -> unit + val _inline_prim_cost : string -> unit + val _inline_branch_cost : string -> unit + val _inline_indirect_cost : string -> unit + val _inline_lifting_benefit : string -> unit + val _unbox_closures : unit -> unit + val _branch_inline_factor : string -> unit + val _no_inline_recursive_functions : unit -> unit + val _remove_unused_arguments : unit -> unit + val _o2 : unit -> unit + val _o3 : unit -> unit + val _clambda_checks : unit -> unit + val _dflambda : unit -> unit + val _dflambda_invariants : unit -> unit + val _dflambda_let : int -> unit + val _dflambda_verbose : unit -> unit + val _drawclambda : unit -> unit val _dclambda : unit -> unit val _dcmm : unit -> unit val _dsel : unit -> unit diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 0ea9e72b0..9592de1a1 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -58,7 +58,7 @@ let print_if ppf flag printer arg = let (++) x f = f x let (+++) (x, y) f = (x, f y) -let implementation ppf sourcefile outputprefix = +let implementation ppf sourcefile outputprefix ~backend = let source_provenance = Timings.File sourcefile in Compmisc.init_path true; let modulename = module_of_filename ppf sourcefile outputprefix in @@ -75,19 +75,58 @@ let implementation ppf sourcefile outputprefix = ++ Timings.(time (Typing sourcefile)) (Typemod.type_implementation sourcefile outputprefix modulename env) ++ print_if ppf Clflags.dump_typedtree - Printtyped.implementation_with_coercion + Printtyped.implementation_with_coercion in if not !Clflags.print_types then begin - (typedtree, coercion) - ++ Timings.(time (Transl sourcefile)) - (Translmod.transl_store_implementation modulename) - +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda - ++ Timings.(time (Generate sourcefile)) - (fun (size, lambda) -> - (size, Simplif.simplify_lambda lambda) - +++ print_if ppf Clflags.dump_lambda Printlambda.lambda - ++ Asmgen.compile_implementation ~source_provenance outputprefix ppf; - Compilenv.save_unit_info cmxfile) + if Config.flambda then begin + if !Clflags.o3 then begin + Clflags.simplify_rounds := 3; + Clflags.use_inlining_arguments_set ~round:0 Clflags.o1_arguments; + Clflags.use_inlining_arguments_set ~round:1 Clflags.o2_arguments; + Clflags.use_inlining_arguments_set ~round:2 Clflags.o3_arguments + end + else if !Clflags.o2 then begin + Clflags.simplify_rounds := 2; + Clflags.use_inlining_arguments_set ~round:0 Clflags.o1_arguments; + Clflags.use_inlining_arguments_set ~round:1 Clflags.o2_arguments + end + else if !Clflags.classic_inlining then begin + Clflags.use_inlining_arguments_set Clflags.classic_arguments + end; + (typedtree, coercion) + ++ Timings.(time (Timings.Transl sourcefile) + (Translmod.transl_implementation_flambda modulename)) + +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda + ++ Timings.time (Timings.Generate sourcefile) (fun lambda -> + lambda + +++ Simplif.simplify_lambda + +++ print_if ppf Clflags.dump_lambda Printlambda.lambda + ++ (fun ((module_ident, size), lam) -> + Middle_end.middle_end ppf ~source_provenance + ~prefixname:outputprefix + ~size + ~module_ident + ~backend + ~module_initializer:lam) + ++ Asmgen.compile_implementation_flambda ~source_provenance + outputprefix ~backend ppf; + Compilenv.save_unit_info cmxfile) + end + else begin + Clflags.use_inlining_arguments_set Clflags.classic_arguments; + (typedtree, coercion) + ++ Timings.(time (Transl sourcefile)) + (Translmod.transl_store_implementation modulename) + ++ print_if ppf Clflags.dump_rawlambda Printlambda.program + ++ Timings.(time (Generate sourcefile)) + (fun { Lambda.code; main_module_block_size } -> + { Lambda.code = Simplif.simplify_lambda code; + main_module_block_size } + ++ print_if ppf Clflags.dump_lambda Printlambda.program + ++ Asmgen.compile_implementation_clambda ~source_provenance + outputprefix ppf; + Compilenv.save_unit_info cmxfile) + end end; Warnings.check_fatal (); Stypes.dump (Some (outputprefix ^ ".annot")) diff --git a/driver/optcompile.mli b/driver/optcompile.mli index 00f9029a5..9f7891bdd 100644 --- a/driver/optcompile.mli +++ b/driver/optcompile.mli @@ -15,5 +15,12 @@ open Format val interface: formatter -> string -> string -> unit -val implementation: formatter -> string -> string -> unit + +val implementation + : formatter + -> string + -> string + -> backend:(module Backend_intf.S) + -> unit + val c_file: string -> unit diff --git a/driver/optmain.ml b/driver/optmain.ml index 47c6bdc5c..2e48453b4 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -14,6 +14,24 @@ open Config open Clflags open Compenv +module Backend = struct + (* See backend_intf.mli. *) + + let symbol_for_global' = Compilenv.symbol_for_global' + let closure_symbol = Compilenv.closure_symbol + + let really_import_approx = Import_approx.really_import_approx + let import_symbol = Import_approx.import_symbol + + let size_int = Arch.size_int + let big_endian = Arch.big_endian + + (* CR mshinwell: this needs tying through to [Proc], although it may + necessitate the introduction of a new field in that module. *) + let max_sensible_number_of_arguments = 9 +end +let backend = (module Backend : Backend_intf.S) + let process_interface_file ppf name = let opref = output_prefix name in Optcompile.interface ppf name opref; @@ -21,7 +39,7 @@ let process_interface_file ppf name = let process_implementation_file ppf name = let opref = output_prefix name in - Optcompile.implementation ppf name opref; + Optcompile.implementation ppf name opref ~backend; objfiles := (opref ^ ".cmx") :: !objfiles let cmxa_present = ref false;; @@ -79,6 +97,7 @@ module Options = Main_args.Make_optcomp_options (struct let _cc s = c_compiler := Some s let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs let _ccopt s = first_ccopts := s :: !first_ccopts + let _clambda_checks () = clambda_checks := true let _compact = clear optimize_for_speed let _config () = show_config () let _for_pack s = for_package := Some s @@ -88,22 +107,62 @@ module Options = Main_args.Make_optcomp_options (struct let _impl = impl let _inline spec = Float_arg_helper.parse spec ~update:inline_threshold - ~help_text:"Syntax: -inline " + ~help_text:"Syntax: -inline | =[,...]" + let _inline_toplevel spec = + Int_arg_helper.parse spec ~update:inline_toplevel_threshold + ~help_text:"Syntax: -inline-toplevel | =[,...]" + let _inlining_stats () = inlining_stats := true + let _dump_pass pass = set_dumped_pass pass true + let _rounds n = simplify_rounds := n + let _unroll spec = + Int_arg_helper.parse spec ~update:unroll + ~help_text:"Syntax: -unroll | =[,...]" + let _classic_inlining () = classic_inlining := true + let _inline_call_cost spec = + Int_arg_helper.parse spec ~update:inline_call_cost + ~help_text:"Syntax: -inline-call-cost | =[,...]" + let _inline_alloc_cost spec = + Int_arg_helper.parse spec ~update:inline_alloc_cost + ~help_text:"Syntax: -inline-alloc-cost | =[,...]" + let _inline_prim_cost spec = + Int_arg_helper.parse spec ~update:inline_prim_cost + ~help_text:"Syntax: -inline-prim-cost | =[,...]" + let _inline_branch_cost spec = + Int_arg_helper.parse spec ~update:inline_branch_cost + ~help_text:"Syntax: -inline-branch-cost | =[,...]" + let _inline_indirect_cost spec = + Int_arg_helper.parse spec ~update:inline_indirect_cost + ~help_text:"Syntax: -inline-indirect-cost | =[,...]" + let _inline_lifting_benefit spec = + Int_arg_helper.parse spec ~update:inline_lifting_benefit + ~help_text:"Syntax: -inline-lifting-benefit | =[,...]" + let _branch_inline_factor spec = + Float_arg_helper.parse spec ~update:branch_inline_factor + ~help_text:"Syntax: -branch-inline-factor | =[,...]" let _intf = intf let _intf_suffix s = Config.interface_suffix := s let _keep_docs = set keep_docs let _keep_locs = set keep_locs let _labels = clear classic let _linkall = set link_everything + let _max_inlining_depth spec = + Int_arg_helper.parse spec ~update:max_inlining_depth + ~help_text:"Syntax: -max-inlining-depth | =[,...]" let _no_alias_deps = set transparent_modules let _no_app_funct = clear applicative_functors let _no_float_const_prop = clear float_const_prop let _noassert = set noassert let _noautolink = set no_auto_link let _nodynlink = clear dlcode + let _no_inline_recursive_functions = clear inline_recursive_functions let _nolabels = set classic let _nostdlib = set no_std_include let _o s = output_name := Some s + (* CR mshinwell: should stop e.g. -O2 -classic-inlining + lgesbert: could be done in main() below, like for -pack and -c, but that + would prevent overriding using OCAMLPARAM. *) + let _o2 = set o2 + let _o3 = set o3 let _open s = open_modules := s :: !open_modules let _output_obj = set output_c_object let _output_complete_obj () = @@ -114,6 +173,7 @@ module Options = Main_args.Make_optcomp_options (struct let _ppx s = first_ppx := s :: !first_ppx let _principal = set principal let _rectypes = set recursive_types + let _remove_unused_arguments = set remove_unused_arguments let _runtime_variant s = runtime_variant := s let _safe_string = clear unsafe_string let _short_paths = clear real_paths @@ -122,6 +182,7 @@ module Options = Main_args.Make_optcomp_options (struct let _shared () = shared := true; dlcode := true let _S = set keep_asm_file let _thread = set use_threads + let _unbox_closures = set unbox_closures let _unsafe = set fast let _unsafe_string = set unsafe_string let _v () = print_version_and_library "native-code compiler" @@ -144,7 +205,14 @@ module Options = Main_args.Make_optcomp_options (struct let _dtypedtree = set dump_typedtree let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda + let _drawclambda = set dump_rawclambda let _dclambda = set dump_clambda + let _dflambda = set dump_flambda + let _dflambda_let stamp = dump_flambda_let := Some stamp + let _dflambda_verbose () = + set dump_flambda (); + set dump_flambda_verbose () + let _dflambda_invariants = set flambda_invariant_checks let _dcmm = set dump_cmm let _dsel = set dump_selection let _dcombine = set dump_combine @@ -190,7 +258,7 @@ let main () = Compmisc.init_path true; let target = extract_output !output_name in Asmpackager.package_files ppf (Compmisc.initial_env ()) - (get_objfiles ()) target; + (get_objfiles ()) target ~backend; Warnings.check_fatal (); end else if !shared then begin diff --git a/middle_end/flambda.ml b/middle_end/flambda.ml index 43eccd072..83349041b 100644 --- a/middle_end/flambda.ml +++ b/middle_end/flambda.ml @@ -516,9 +516,7 @@ let rec variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument free_variables (variables_usage_named ?ignore_uses_in_project_var ?ignore_uses_as_callee ?ignore_uses_as_argument ~all_used_variables defining_expr); - free_variables - (variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument - ?ignore_uses_in_project_var ~all_used_variables body) + aux body end else begin free_variables free_vars_of_defining_expr; diff --git a/middle_end/flambda.mli b/middle_end/flambda.mli index 7f7f96b53..7a8859459 100644 --- a/middle_end/flambda.mli +++ b/middle_end/flambda.mli @@ -400,8 +400,7 @@ val free_variables_named -> named -> Variable.Set.t -(** Compute _all_ variables occuring inside an expression. (This is O(1) - for [Let]s). *) +(** Compute _all_ variables occuring inside an expression. *) val used_variables : ?ignore_uses_as_callee:unit -> ?ignore_uses_as_argument:unit diff --git a/middle_end/inconstant_idents.ml b/middle_end/inconstant_idents.ml index 8ece1942b..822e19602 100644 --- a/middle_end/inconstant_idents.ml +++ b/middle_end/inconstant_idents.ml @@ -351,9 +351,8 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct if toplevel then mark_var arg curr else mark_curr curr | Prim (Pduparray _, _, _) -> - Misc.fatal_errorf - "Unsupported case of Pduparray in Inconstant_idents: %a" - Flambda.print_named named + (* See Lift_constants *) + mark_curr curr | Project_closure ({ set_of_closures; closure_id; }) -> if Closure_id.in_compilation_unit closure_id compilation_unit then mark_var set_of_closures curr diff --git a/middle_end/semantics_of_primitives.ml b/middle_end/semantics_of_primitives.ml index 13f506fb0..6bd3d1607 100644 --- a/middle_end/semantics_of_primitives.ml +++ b/middle_end/semantics_of_primitives.ml @@ -26,7 +26,8 @@ let for_primitive (prim : Lambda.primitive) = | Pmakearray (_, Mutable) -> Only_generative_effects, No_coeffects | Pmakearray (_, Immutable) -> No_effects, No_coeffects | Pduparray (_, Immutable) -> - No_effects, Has_coeffects (* Might read a mutable record field. *) + No_effects, No_coeffects (* Pduparray (_, Immutable) is allowed only on + immutable arrays. *) | Pduparray (_, Mutable) | Pduprecord _ -> Only_generative_effects, Has_coeffects | Pccall { prim_name = diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index cdd6e1b99..57102068a 100644 --- a/ocamldoc/odoc_args.ml +++ b/ocamldoc/odoc_args.ml @@ -229,6 +229,7 @@ module Options = Main_args.Make_ocamldoc_options(struct let _dtypedtree = set Clflags.dump_typedtree let _drawlambda = set Clflags.dump_rawlambda let _dlambda = set Clflags.dump_lambda + let _dflambda = set Clflags.dump_flambda let _dinstr = set Clflags.dump_instr let anonymous = anonymous end) diff --git a/tools/objinfo.ml b/tools/objinfo.ml index 5faa42de9..3b8c26daa 100644 --- a/tools/objinfo.ml +++ b/tools/objinfo.ml @@ -113,8 +113,14 @@ open Cmx_format let print_cmx_infos (ui, crc) = print_general_infos ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx; - printf "Approximation:\n"; - Format.fprintf Format.std_formatter " %a@." Printclambda.approx ui.ui_approx; + begin match ui.ui_export_info with + | Clambda approx -> + printf "Approximation:\n"; + Format.fprintf Format.std_formatter " %a@." Printclambda.approx approx + | Flambda _ -> () + (* CR mshinwell: This should print the flambda export info. + Unfortunately this needs some surgery in the Makefiles. *) + end; let pr_funs _ fns = List.iter (fun arity -> printf " %d" arity) fns in printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun; diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index 76f73bc5a..931e557b5 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -108,6 +108,7 @@ module Options = Main_args.Make_bytecomp_options (struct let _dtypedtree = option "-dtypedtree" let _drawlambda = option "-drawlambda" let _dlambda = option "-dlambda" + let _dflambda = option "-dflambda" let _dinstr = option "-dinstr" let _dtimings = option "-dtimings" let anonymous = process_file diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml index 3fea75f2d..bf4d347e7 100644 --- a/tools/ocamloptp.ml +++ b/tools/ocamloptp.ml @@ -23,6 +23,9 @@ let option_with_arg opt arg = let option_with_int opt arg = compargs := (string_of_int arg) :: opt :: !compargs ;; +let option_with_float opt arg = + compargs := (string_of_float arg) :: opt :: !compargs +;; let make_archive = ref false;; let with_impl = ref false;; @@ -51,6 +54,7 @@ module Options = Main_args.Make_optcomp_options (struct let _cc s = option_with_arg "-cc" s let _cclib s = option_with_arg "-cclib" s let _ccopt s = option_with_arg "-ccopt" s + let _clambda_checks = option "-clambda-checks" let _compact = option "-compact" let _config = option "-config" let _for_pack s = option_with_arg "-for-pack" s @@ -59,6 +63,20 @@ module Options = Main_args.Make_optcomp_options (struct let _I s = option_with_arg "-I" s let _impl s = with_impl := true; option_with_arg "-impl" s let _inline s = option_with_arg "-inline" s + let _inline_toplevel n = option_with_arg "-inline-toplevel" n + let _inlining_stats = option "-inlining-report" + let _dump_pass = option_with_arg "-dump-pass" + let _max_inlining_depth n = option_with_arg "-max-inlining-depth" n + let _rounds n = option_with_int "-rounds" n + let _unroll n = option_with_arg "-unroll" n + let _inline_call_cost n = option_with_arg "-inline-call-cost" n + let _inline_alloc_cost n = option_with_arg "-inline-alloc-cost" n + let _inline_prim_cost n = option_with_arg "-inline-prim-cost" n + let _inline_branch_cost n = option_with_arg "-inline-branch-cost" n + let _inline_indirect_cost n = option_with_arg "-inline-indirect-cost" n + let _inline_lifting_benefit n = option_with_arg "-inline-lifting-benefit" n + let _branch_inline_factor n = option_with_arg "-branch-inline-factor" n + let _classic_inlining = option "-classic-inlining" let _intf s = with_intf := true; option_with_arg "-intf" s let _intf_suffix s = option_with_arg "-intf-suffix" s let _keep_docs = option "-keep-docs" @@ -71,9 +89,12 @@ module Options = Main_args.Make_optcomp_options (struct let _noassert = option "-noassert" let _noautolink = option "-noautolink" let _nodynlink = option "-nodynlink" + let _no_inline_recursive_functions = option "-no-inline-recursive-functions" let _nolabels = option "-nolabels" let _nostdlib = option "-nostdlib" let _o s = option_with_arg "-o" s + let _o2 = option "-O2" + let _o3 = option "-O3" let _open s = option_with_arg "-open" s let _output_obj = option "-output-obj" let _output_complete_obj = option "-output-complete-obj" @@ -83,6 +104,7 @@ module Options = Main_args.Make_optcomp_options (struct let _ppx _s = incompatible "-ppx" let _principal = option "-principal" let _rectypes = option "-rectypes" + let _remove_unused_arguments = option "-remove-unused-arguments" let _runtime_variant s = option_with_arg "-runtime-variant" s let _S = option "-S" let _safe_string = option "-safe-string" @@ -91,6 +113,7 @@ module Options = Main_args.Make_optcomp_options (struct let _strict_formats = option "-strict-formats" let _shared = option "-shared" let _thread = option "-thread" + let _unbox_closures = option "-unbox-closures" let _unsafe = option "-unsafe" let _unsafe_string = option "-unsafe-string" let _v = option "-v" @@ -109,7 +132,12 @@ module Options = Main_args.Make_optcomp_options (struct let _dtypedtree = option "-dtypedtree" let _drawlambda = option "-drawlambda" let _dlambda = option "-dlambda" + let _drawclambda = option "-drawclambda" let _dclambda = option "-dclambda" + let _dflambda = option "-dflambda" + let _dflambda_invariants = option "-dflambda-invariants" + let _dflambda_let stamp = option_with_int "-dflambda-let" stamp + let _dflambda_verbose = option "-dflambda-verbose" let _dcmm = option "-dcmm" let _dsel = option "-dsel" let _dcombine = option "-dcombine" diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index bb5b5e05b..a612d0678 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -61,9 +61,35 @@ type directive_fun = (* Return the value referred to by a path *) +let remembered = ref Ident.empty + +let rec remember phrase_name i = function + | [] -> () + | Sig_value (id, _) :: rest + | Sig_module (id, _, _) :: rest + | Sig_typext (id, _, _) :: rest + | Sig_class (id, _, _) :: rest -> + remembered := Ident.add id (phrase_name, i) !remembered; + remember phrase_name (succ i) rest + | _ :: rest -> remember phrase_name i rest + let toplevel_value id = - let (glb,pos) = Translmod.nat_toplevel_name id in - (Obj.magic (global_symbol glb)).(pos) + try Ident.find_same id !remembered + with _ -> Misc.fatal_error @@ "Unknown ident: " ^ Ident.unique_name id + +let close_phrase lam = + let open Lambda in + IdentSet.fold (fun id l -> + let glb, pos = toplevel_value id in + let glob = Lprim (Pfield pos, [Lprim (Pgetglobal glb, [])]) in + Llet(Strict, id, glob, l) + ) (free_variables lam) lam + +let toplevel_value id = + let glob, pos = + if Config.flambda then toplevel_value id else Translmod.nat_toplevel_name id + in + (Obj.magic (global_symbol glob)).(pos) let rec eval_path = function | Pident id -> @@ -155,7 +181,26 @@ let toplevel_startup_hook = ref (fun () -> ()) let phrase_seqid = ref 0 let phrase_name = ref "TOP" -let load_lambda ppf (size, lam) = +(* CR trefis for mshinwell: copy/pasted from Optmain. Should it be shared or? *) +module Backend = struct + (* See backend_intf.mli. *) + + let symbol_for_global' = Compilenv.symbol_for_global' + let closure_symbol = Compilenv.closure_symbol + + let really_import_approx = Import_approx.really_import_approx + let import_symbol = Import_approx.import_symbol + + let size_int = Arch.size_int + let big_endian = Arch.big_endian + + (* CR mshinwell: this needs tying through to [Proc], although it may + necessitate the introduction of a new field in that module. *) + let max_sensible_number_of_arguments = 9 +end +let backend = (module Backend : Backend_intf.S) + +let load_lambda ppf ~module_ident lam size = if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam; let slam = Simplif.simplify_lambda lam in if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam; @@ -165,8 +210,16 @@ let load_lambda ppf (size, lam) = else Filename.temp_file ("caml" ^ !phrase_name) ext_dll in let fn = Filename.chop_extension dll in - Asmgen.compile_implementation ~source_provenance:Timings.Toplevel - ~toplevel:need_symbol fn ppf (size, slam); + if not Config.flambda then + Asmgen.compile_implementation_clambda ~source_provenance:Timings.Toplevel + ~toplevel:need_symbol fn ppf + { Lambda.code=lam ; main_module_block_size=size } + else + Asmgen.compile_implementation_flambda ~source_provenance:Timings.Toplevel + ~backend ~toplevel:need_symbol fn ppf + (Middle_end.middle_end ppf + ~source_provenance:Timings.Toplevel ~prefixname:"" ~backend ~size + ~module_ident ~module_initializer:lam); Asmlink.call_linker_shared [fn ^ ext_obj] dll; Sys.remove (fn ^ ext_obj); @@ -221,29 +274,68 @@ let execute_phrase print_outcome ppf phr = Compilenv.reset ~source_provenance:Timings.Toplevel ?packname:None !phrase_name; Typecore.reset_delayed_checks (); + let sstr, rewritten = + match sstr with + | [ { pstr_desc = Pstr_eval (e, attrs) ; pstr_loc = loc } ] + | [ { pstr_desc = Pstr_value (Asttypes.Nonrecursive, + [{ pvb_expr = e + ; pvb_pat = { ppat_desc = Ppat_any ; _ } + ; pvb_attributes = attrs + ; _ }]) + ; pstr_loc = loc } + ] -> + let pat = Ast_helper.Pat.var (Location.mknoloc "_$") in + let vb = Ast_helper.Vb.mk ~loc ~attrs pat e in + [ Ast_helper.Str.value ~loc Asttypes.Nonrecursive [vb] ], true + | _ -> sstr, false + in let (str, sg, newenv) = Typemod.type_toplevel_phrase oldenv sstr in if !Clflags.dump_typedtree then Printtyped.implementation ppf str; let sg' = Typemod.simplify_signature sg in + (* Why is this done? *) ignore (Includemod.signatures oldenv sg sg'); Typecore.force_delayed_checks (); - let res = Translmod.transl_store_phrases !phrase_name str in + let module_ident, res, size = + if Config.flambda then + let ((module_ident, size), res) = + Translmod.transl_implementation_flambda !phrase_name + (str, Tcoerce_none) + in + remember module_ident 0 sg'; + module_ident, close_phrase res, size + else + let size, res = Translmod.transl_store_phrases !phrase_name str in + Ident.create_persistent !phrase_name, res, size + in Warnings.check_fatal (); begin try toplevel_env := newenv; - let res = load_lambda ppf res in + let res = load_lambda ppf ~module_ident res size in let out_phr = match res with | Result v -> - Compilenv.record_global_approx_toplevel (); + if Config.flambda then + (* CR-someday trefis: *) + () + else + Compilenv.record_global_approx_toplevel (); if print_outcome then Printtyp.wrap_printing_env oldenv (fun () -> match str.str_items with - | [ {str_desc = Tstr_eval (exp, _attrs)} ] -> - let outv = outval_of_value newenv v exp.exp_type in - let ty = Printtyp.tree_of_type_scheme exp.exp_type in - Ophr_eval (outv, ty) | [] -> Ophr_signature [] - | _ -> Ophr_signature (pr_item newenv sg')) + | _ -> + if rewritten then + match sg' with + | [ Sig_value (id, vd) ] -> + let outv = + outval_of_value newenv (toplevel_value id) + vd.val_type + in + let ty = Printtyp.tree_of_type_scheme vd.val_type in + Ophr_eval (outv, ty) + | _ -> assert false + else + Ophr_signature (pr_item newenv sg')) else Ophr_signature [] | Exception exn -> toplevel_env := oldenv; diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml index c44e173e2..3820d26dd 100644 --- a/toplevel/opttopmain.ml +++ b/toplevel/opttopmain.ml @@ -68,7 +68,65 @@ module Options = Main_args.Make_opttop_options (struct include_dirs := dir :: !include_dirs let _init s = init_file := Some s let _noinit = set noinit - let _inline n = inline_threshold := n * 8 + let _clambda_checks () = clambda_checks := true + let _inline spec = + Float_arg_helper.parse spec ~update:inline_threshold + ~help_text:"Syntax: -inline | =[,...]" + let _inline_indirect_cost spec = + Int_arg_helper.parse spec ~update:inline_indirect_cost + ~help_text:"Syntax: -inline-indirect-cost | =[,...]" + let _inline_toplevel spec = + Int_arg_helper.parse spec ~update:inline_toplevel_threshold + ~help_text:"Syntax: -inline-toplevel | =[,...]" + let _inlining_stats () = inlining_stats := true + let _dump_pass pass = set_dumped_pass pass true + let _rounds n = simplify_rounds := n + let _unroll spec = + Int_arg_helper.parse spec ~update:unroll + ~help_text:"Syntax: -unroll | =[,...]" + let _classic_inlining () = classic_inlining := true + let _inline_call_cost spec = + Int_arg_helper.parse spec ~update:inline_call_cost + ~help_text:"Syntax: -inline-call-cost | =[,...]" + let _inline_alloc_cost spec = + Int_arg_helper.parse spec ~update:inline_alloc_cost + ~help_text:"Syntax: -inline-alloc-cost | =[,...]" + let _inline_prim_cost spec = + Int_arg_helper.parse spec ~update:inline_prim_cost + ~help_text:"Syntax: -inline-prim-cost | =[,...]" + let _inline_branch_cost spec = + Int_arg_helper.parse spec ~update:inline_branch_cost + ~help_text:"Syntax: -inline-branch-cost | =[,...]" + let _inline_lifting_benefit spec = + Int_arg_helper.parse spec ~update:inline_lifting_benefit + ~help_text:"Syntax: -inline-lifting-benefit | =[,...]" + let _branch_inline_factor spec = + Float_arg_helper.parse spec ~update:branch_inline_factor + ~help_text:"Syntax: -branch-inline-factor | =[,...]" + let _max_inlining_depth spec = + Int_arg_helper.parse spec ~update:max_inlining_depth + ~help_text:"Syntax: -max-inlining-depth | =[,...]" + let _o s = output_name := Some s + let _o2 () = + simplify_rounds := 2; + use_inlining_arguments_set ~round:1 o1_arguments; + use_inlining_arguments_set ~round:2 o2_arguments + let _o3 () = + simplify_rounds := 3; + use_inlining_arguments_set ~round:1 o1_arguments; + use_inlining_arguments_set ~round:2 o2_arguments; + use_inlining_arguments_set ~round:3 o3_arguments + let _no_inline_recursive_functions = clear inline_recursive_functions + let _remove_unused_arguments = set remove_unused_arguments + let _unbox_closures = set unbox_closures + let _drawclambda = set dump_rawclambda + let _dclambda = set dump_clambda + let _dflambda = set dump_flambda + let _dflambda_let stamp = dump_flambda_let := Some stamp + let _dflambda_verbose () = + set dump_flambda (); + set dump_flambda_verbose () + let _dflambda_invariants = set flambda_invariant_checks let _labels = clear classic let _no_alias_deps = set transparent_modules let _no_app_funct = clear applicative_functors @@ -98,6 +156,7 @@ module Options = Main_args.Make_opttop_options (struct let _dtypedtree = set dump_typedtree let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda + let _drawclambda = set dump_rawclambda let _dclambda = set dump_clambda let _dcmm = set dump_cmm let _dsel = set dump_selection @@ -121,6 +180,7 @@ module Options = Main_args.Make_opttop_options (struct end);; let main () = + native_code := true; Arg.parse Options.list file_argument usage; if not (prepare Format.err_formatter) then exit 2; Opttoploop.loop Format.std_formatter diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml index 991a42557..efc8158db 100644 --- a/toplevel/topmain.ml +++ b/toplevel/topmain.ml @@ -96,6 +96,7 @@ module Options = Main_args.Make_bytetop_options (struct let _dsource = set dump_source let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda + let _dflambda = set dump_flambda let _dtimings = set print_timings let _dinstr = set dump_instr diff --git a/utils/clflags.ml b/utils/clflags.ml index 1a190d62e..f63284b49 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -120,7 +120,7 @@ let dump_combine = ref false (* -dcombine *) let native_code = ref false (* set to true under ocamlopt *) let o2 = ref false (* -O2 *) let o3 = ref false (* -O3 *) -let default_inline_threshold = 10. /. 8. +let default_inline_threshold = if Config.flambda then 10. else 10. /. 8. let inline_threshold = ref (Float_arg_helper.default default_inline_threshold) let inlining_stats = ref false let simplify_rounds = ref 1 @@ -152,7 +152,6 @@ let runtime_variant = ref "";; (* -runtime-variant *) let keep_docs = ref false (* -keep-docs *) let keep_locs = ref false (* -keep-locs *) let unsafe_string = ref true;; (* -safe-string / -unsafe-string *) -let print_timings = ref false (* -dtimings *) let inline_toplevel_multiplier = 16 let default_inline_toplevel_threshold = From 4145e68dad729a5afc80928a8997fb46e26972dd Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Sat, 29 Aug 2015 04:42:50 +0100 Subject: [PATCH 137/145] Allow ``[]`` as a user-defined constructor --- parsing/parser.mly | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parsing/parser.mly b/parsing/parser.mly index 6851ba68a..afb23f21d 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -2222,7 +2222,7 @@ operator: ; constr_ident: UIDENT { $1 } -/* | LBRACKET RBRACKET { "[]" } */ + | LBRACKET RBRACKET { "[]" } | LPAREN RPAREN { "()" } | COLONCOLON { "::" } /* | LPAREN COLONCOLON RPAREN { "::" } */ From e2d26d1a16d2a5fb60efa2f99c35c0cc20bccffe Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Thu, 24 Sep 2015 08:34:41 -0700 Subject: [PATCH 138/145] Allow ``::`` surrounded by parenthesis as... constructor name --- parsing/parser.mly | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parsing/parser.mly b/parsing/parser.mly index afb23f21d..e3a2387d5 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -2225,7 +2225,7 @@ constr_ident: | LBRACKET RBRACKET { "[]" } | LPAREN RPAREN { "()" } | COLONCOLON { "::" } -/* | LPAREN COLONCOLON RPAREN { "::" } */ + | LPAREN COLONCOLON RPAREN { "::" } | FALSE { "false" } | TRUE { "true" } ; From 80260ef6574d1891f7b3db3bf335f4ac08c8dd51 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Thu, 8 Oct 2015 13:37:25 -0700 Subject: [PATCH 139/145] Disallow ``::'' for consistency --- parsing/parser.mly | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parsing/parser.mly b/parsing/parser.mly index e3a2387d5..e9c5842ca 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -2224,7 +2224,7 @@ constr_ident: UIDENT { $1 } | LBRACKET RBRACKET { "[]" } | LPAREN RPAREN { "()" } - | COLONCOLON { "::" } + /* | COLONCOLON { "::" } */ | LPAREN COLONCOLON RPAREN { "::" } | FALSE { "false" } | TRUE { "true" } From e51be28926c460b4fc2862cfbb4ad5ada4cb52d2 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Tue, 13 Oct 2015 10:41:48 -0700 Subject: [PATCH 140/145] Add test case and update changelog --- Changes | 3 ++ testsuite/tests/basic/patmatch.ml | 41 ++++++++++++++++++++++++ testsuite/tests/basic/patmatch.reference | 2 ++ 3 files changed, 46 insertions(+) diff --git a/Changes b/Changes index 5ce607682..d79a2a9b8 100644 --- a/Changes +++ b/Changes @@ -60,6 +60,9 @@ Language features: - PR#6681 GPR#326: signature items are now accepted as payloads for extension and attributes, using the syntax [%foo: SIG ] or [@foo: SIG ]. (Alain Frisch and Gabriel Radanne) +- GPR#234: allow "[]" as a user-defined type constructor. Demand parenthesis + around "::" when using "::" as type constructor. + (Runhang Li) Compilers: - PR#4080, PR#6537, PR#5333: fix stack overflow in the compiler when -pack'ing diff --git a/testsuite/tests/basic/patmatch.ml b/testsuite/tests/basic/patmatch.ml index 0f759bc40..f46a4166b 100644 --- a/testsuite/tests/basic/patmatch.ml +++ b/testsuite/tests/basic/patmatch.ml @@ -1610,3 +1610,44 @@ let f = function | _ -> false let () = printf "PR#6676=Ok\n%!" + +(* GPR#234, allow ``[]`` as a user defined constructor *) +module GPR234HList = struct + + type _ cell = + | Int : int -> int cell + | Pair : int * int -> (int * int) cell + | StrInt : string -> string cell + + type hlist = + | [] : hlist + | ( :: ) : 'a cell * hlist -> hlist + + type 'b foldf = { + f: 'a. 'a cell -> 'b -> 'b + } + + let fold_hlist : 'b foldf -> 'b -> hlist -> 'b = fun f init l -> + let rec loop : hlist -> 'b -> 'b = fun l acc -> + match l with + | [] -> acc + | hd :: tl -> loop tl (f.f hd acc) in + loop l init + + let to_int_fold : type a. a cell -> int -> int = fun cell acc -> + match cell with + | Int x -> x + acc + | Pair (x, y) -> x + y + acc + | StrInt str -> int_of_string str + acc + + let sum l = fold_hlist {f=to_int_fold} 0 l + + let l = [Int 3; Pair (4, 5); StrInt "30"] + + let test () = Printf.printf "%d\n" (sum l) + +end + +let () = GPR234HList.test () + +let () = printf "GPR#234=Ok\n%!" diff --git a/testsuite/tests/basic/patmatch.reference b/testsuite/tests/basic/patmatch.reference index aafc1b5c4..031a520a3 100644 --- a/testsuite/tests/basic/patmatch.reference +++ b/testsuite/tests/basic/patmatch.reference @@ -73,3 +73,5 @@ PR#6322=Ok PR#6646=Ok PR#6646=Ok PR#6676=Ok +42 +GPR#234=Ok From 59806f481206e7d613232c1f1154a1e91b03878c Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Tue, 13 Oct 2015 13:11:57 -0700 Subject: [PATCH 141/145] Update test case --- testsuite/tests/basic/patmatch.ml | 8 ++++++-- testsuite/tests/basic/patmatch.reference | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/basic/patmatch.ml b/testsuite/tests/basic/patmatch.ml index f46a4166b..861a264ec 100644 --- a/testsuite/tests/basic/patmatch.ml +++ b/testsuite/tests/basic/patmatch.ml @@ -1618,6 +1618,7 @@ module GPR234HList = struct | Int : int -> int cell | Pair : int * int -> (int * int) cell | StrInt : string -> string cell + | List : int list -> int list cell type hlist = | [] : hlist @@ -1639,12 +1640,15 @@ module GPR234HList = struct | Int x -> x + acc | Pair (x, y) -> x + y + acc | StrInt str -> int_of_string str + acc + | List l -> acc + List.fold_left (+) 0 l let sum l = fold_hlist {f=to_int_fold} 0 l - let l = [Int 3; Pair (4, 5); StrInt "30"] + let l = List [1; 2; 3] (* still fine to use normal list here *) - let test () = Printf.printf "%d\n" (sum l) + let ll = [Int 3; Pair (4, 5); StrInt "30"; l] + + let test () = Printf.printf "%d\n" (sum ll) end diff --git a/testsuite/tests/basic/patmatch.reference b/testsuite/tests/basic/patmatch.reference index 031a520a3..868bcf535 100644 --- a/testsuite/tests/basic/patmatch.reference +++ b/testsuite/tests/basic/patmatch.reference @@ -73,5 +73,5 @@ PR#6322=Ok PR#6646=Ok PR#6646=Ok PR#6676=Ok -42 +48 GPR#234=Ok From 4f2ad78e865f086a361c3d723221f1a5c8a0a563 Mon Sep 17 00:00:00 2001 From: Runhang Li Date: Wed, 14 Oct 2015 08:19:53 -0700 Subject: [PATCH 142/145] Use "*" since GPR#234 breaks existing program --- Changes | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index d79a2a9b8..853cf10c3 100644 --- a/Changes +++ b/Changes @@ -60,9 +60,9 @@ Language features: - PR#6681 GPR#326: signature items are now accepted as payloads for extension and attributes, using the syntax [%foo: SIG ] or [@foo: SIG ]. (Alain Frisch and Gabriel Radanne) -- GPR#234: allow "[]" as a user-defined type constructor. Demand parenthesis - around "::" when using "::" as type constructor. - (Runhang Li) +* GPR#234: allow "[]" as a user-defined constructor. Demand parenthesis + around "::" when using "::" as user-defined constructor. + (Runhang Li, review by Damien Doligez) Compilers: - PR#4080, PR#6537, PR#5333: fix stack overflow in the compiler when -pack'ing From 5938aae8bd81e1bacf8eb2b1498528941e843445 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 29 Jan 2016 14:22:08 +0100 Subject: [PATCH 143/145] fix typo in Changes --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 853cf10c3..a6e9c32d8 100644 --- a/Changes +++ b/Changes @@ -322,7 +322,7 @@ OCamlbuild: (Vincent Laporte) OCamldep: -- GRP#286: add support for module aliases +- GPR#286: add support for module aliases (jacques Garrigue) Manual: From 4863299e4a14cfc723caeecce9283c534d15cdb2 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 29 Jan 2016 14:22:39 +0100 Subject: [PATCH 144/145] ignore generated files "testsuite/_retries" --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 70221c1fb..1256e279f 100644 --- a/.gitignore +++ b/.gitignore @@ -216,6 +216,8 @@ /testsuite/**/program /testsuite/**/_log +/testsuite/_retries + /testsuite/tests/asmcomp/codegen /testsuite/tests/asmcomp/parsecmm.ml /testsuite/tests/asmcomp/parsecmm.mli From af2669f0a031af44fbb12769976380d174ebf00c Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Fri, 29 Jan 2016 14:34:00 +0100 Subject: [PATCH 145/145] disable lib-threads/signal.ml test on msvc and mingw --- testsuite/tests/lib-threads/signal.precheck | 1 + 1 file changed, 1 insertion(+) create mode 100644 testsuite/tests/lib-threads/signal.precheck diff --git a/testsuite/tests/lib-threads/signal.precheck b/testsuite/tests/lib-threads/signal.precheck new file mode 100644 index 000000000..d04af9a43 --- /dev/null +++ b/testsuite/tests/lib-threads/signal.precheck @@ -0,0 +1 @@ +test "$TOOLCHAIN" != "msvc" -a "$TOOLCHAIN" != "mingw"